diff --git a/thys/E_Transcendental/E_Transcendental.thy b/thys/E_Transcendental/E_Transcendental.thy
--- a/thys/E_Transcendental/E_Transcendental.thy
+++ b/thys/E_Transcendental/E_Transcendental.thy
@@ -1,687 +1,677 @@
 (*
   File:       E_Transcendental.thy
   Author:     Manuel Eberl <manuel@pruvisto.org>
 
   A proof that e (Euler's number) is transcendental.
   Could possibly be extended to a transcendence proof for pi or
   the very general Lindemann-Weierstrass theorem.
 *)
 section \<open>Proof of the Transcendence of $e$\<close>
 theory E_Transcendental
   imports
     "HOL-Complex_Analysis.Complex_Analysis"
     "HOL-Number_Theory.Number_Theory"
     "HOL-Computational_Algebra.Polynomial"
 begin
 
+hide_const (open) UnivPoly.coeff  UnivPoly.up_ring.monom 
+hide_const (open) Module.smult  Coset.order
+
 (* TODO: Lots of stuff to move to the distribution *)
   
 subsection \<open>Various auxiliary facts\<close>
 
 lemma fact_dvd_pochhammer:
   assumes "m \<le> n + 1"
   shows   "fact m dvd pochhammer (int n - int m + 1) m"
 proof -
   have "(real n gchoose m) * fact m = of_int (pochhammer (int n - int m + 1) m)"
     by (simp add: gbinomial_pochhammer' pochhammer_of_int [symmetric])
   also have "(real n gchoose m) * fact m = of_int (int (n choose m) * fact m)"
     by (simp add: binomial_gbinomial)
   finally have "int (n choose m) * fact m = pochhammer (int n - int m + 1) m"
     by (subst (asm) of_int_eq_iff)
   from this [symmetric] show ?thesis by simp
 qed
 
-lemma of_nat_eq_1_iff [simp]: "of_nat x = (1 :: 'a :: semiring_char_0) \<longleftrightarrow> x = 1"
-  by (fact of_nat_eq_1_iff)
-
 lemma prime_elem_int_not_dvd_neg1_power:
   "prime_elem (p :: int) \<Longrightarrow> \<not>p dvd (-1) ^ n"
-  by (rule notI, frule (1) prime_elem_dvd_power, cases "p \<ge> 0") (auto simp: prime_elem_def)
+  by (metis dvdI minus_one_mult_self unit_imp_no_prime_divisors)
 
 lemma nat_fact [simp]: "nat (fact n) = fact n"
-  by (subst of_nat_fact [symmetric]) (rule nat_int)
+  by (metis nat_int of_nat_fact of_nat_fact)
 
 lemma prime_dvd_fact_iff_int:
   "p dvd fact n \<longleftrightarrow> p \<le> int n" if "prime p"
   using that prime_dvd_fact_iff [of "nat \<bar>p\<bar>" n]
   by auto (simp add: prime_ge_0_int)
 
-lemma filterlim_minus_nat_at_top:
-  "filterlim (\<lambda>n. n - k :: nat) at_top at_top"
-proof -
-  have "sequentially = filtermap (\<lambda>n. n + k) at_top"
-    by (auto simp: filter_eq_iff eventually_filtermap)
-  also have "filterlim (\<lambda>n. n - k :: nat) at_top \<dots>"
-    by (simp add: filterlim_filtermap filterlim_ident)
-  finally show ?thesis .
-qed
-
 lemma power_over_fact_tendsto_0:
   "(\<lambda>n. (x :: real) ^ n / fact n) \<longlonglongrightarrow> 0"
   using summable_exp[of x] by (intro summable_LIMSEQ_zero) (simp add: sums_iff field_simps)
 
 lemma power_over_fact_tendsto_0':
   "(\<lambda>n. c * (x :: real) ^ n / fact n) \<longlonglongrightarrow> 0"
   using tendsto_mult[OF tendsto_const[of c] power_over_fact_tendsto_0[of x]] by simp
 
 
 subsection \<open>Lifting integer polynomials\<close>
 
 lift_definition of_int_poly :: "int poly \<Rightarrow> 'a :: comm_ring_1 poly" is "\<lambda>g x. of_int (g x)"
   by (auto elim: eventually_mono)
 
 lemma coeff_of_int_poly [simp]: "coeff (of_int_poly p) n = of_int (coeff p n)"
-  by transfer' simp
+  by (simp add: of_int_poly.rep_eq)
 
 lemma of_int_poly_0 [simp]: "of_int_poly 0 = 0"
   by transfer (simp add: fun_eq_iff)
 
 lemma of_int_poly_pCons [simp]: "of_int_poly (pCons c p) = pCons (of_int c) (of_int_poly p)"
   by transfer' (simp add: fun_eq_iff split: nat.splits)
 
 lemma of_int_poly_smult [simp]: "of_int_poly (smult c p) = smult (of_int c) (of_int_poly p)"
   by transfer simp
 
 lemma of_int_poly_1 [simp]: "of_int_poly 1 = 1"
   by (simp add: one_pCons)
 
 lemma of_int_poly_add [simp]: "of_int_poly (p + q) = of_int_poly p + of_int_poly q"
   by transfer' (simp add: fun_eq_iff)
 
 lemma of_int_poly_mult [simp]: "of_int_poly (p * q) = (of_int_poly p * of_int_poly q)"
   by (induction p) simp_all
 
 lemma of_int_poly_sum [simp]: "of_int_poly (sum f A) = sum (\<lambda>x. of_int_poly (f x)) A"
   by (induction A rule: infinite_finite_induct) simp_all
 
 lemma of_int_poly_prod [simp]: "of_int_poly (prod f A) = prod (\<lambda>x. of_int_poly (f x)) A"
   by (induction A rule: infinite_finite_induct) simp_all
 
 lemma of_int_poly_power [simp]: "of_int_poly (p ^ n) = of_int_poly p ^ n"
   by (induction n) simp_all
 
 lemma of_int_poly_monom [simp]: "of_int_poly (monom c n) = monom (of_int c) n"
   by transfer (simp add: fun_eq_iff)
 
 lemma poly_of_int_poly [simp]: "poly (of_int_poly p) (of_int x) = of_int (poly p x)"
   by (induction p) simp_all
 
 lemma poly_of_int_poly_of_nat [simp]: "poly (of_int_poly p) (of_nat x) = of_int (poly p (int x))"
   by (induction p) simp_all
 
 lemma poly_of_int_poly_0 [simp]: "poly (of_int_poly p) 0 = of_int (poly p 0)"
   by (induction p) simp_all
 
 lemma poly_of_int_poly_1 [simp]: "poly (of_int_poly p) 1 = of_int (poly p 1)"
   by (induction p) simp_all
 
 lemma poly_of_int_poly_of_real [simp]:
     "poly (of_int_poly p) (of_real x) = of_real (poly (of_int_poly p) x)"
   by (induction p) simp_all
 
 lemma of_int_poly_eq_iff [simp]:
   "of_int_poly p = (of_int_poly q :: 'a :: {comm_ring_1, ring_char_0} poly) \<longleftrightarrow> p = q"
   by (simp add: poly_eq_iff)
 
 lemma of_int_poly_eq_0_iff [simp]:
   "of_int_poly p = (0 :: 'a :: {comm_ring_1, ring_char_0} poly) \<longleftrightarrow> p = 0"
   using of_int_poly_eq_iff[of p 0] by (simp del: of_int_poly_eq_iff)
 
 lemma degree_of_int_poly [simp]:
   "degree (of_int_poly p :: 'a :: {comm_ring_1, ring_char_0} poly) = degree p"
   by (simp add: degree_def)
 
 lemma pderiv_of_int_poly [simp]: "pderiv (of_int_poly p) = of_int_poly (pderiv p)"
   by (induction p) (simp_all add: pderiv_pCons)
 
 lemma higher_pderiv_of_int_poly [simp]:
   "(pderiv ^^ n) (of_int_poly p) = of_int_poly ((pderiv ^^ n) p)"
   by (induction n) simp_all
 
 lemma int_polyE:
   assumes "\<And>n. coeff (p :: 'a :: {comm_ring_1, ring_char_0} poly) n \<in> \<int>"
   obtains p' where "p = of_int_poly p'"
 proof -
   from assms have "\<forall>n. \<exists>c. coeff p n = of_int c" by (auto simp: Ints_def)
   hence "\<exists>c. \<forall>n. of_int (c n) = coeff p n" by (simp add: choice_iff eq_commute)
   then obtain c where c: "of_int (c n) = coeff p n" for n by blast
   have [simp]: "coeff (Abs_poly c) = c"
   proof (rule poly.Abs_poly_inverse, clarify)
     have "eventually (\<lambda>n. n > degree p) at_top" by (rule eventually_gt_at_top)
     hence "eventually (\<lambda>n. coeff p n = 0) at_top"
       by eventually_elim (simp add: coeff_eq_0)
     thus "eventually (\<lambda>n. c n = 0) cofinite"
       by (simp add: c [symmetric] cofinite_eq_sequentially)
   qed
   have "p = of_int_poly (Abs_poly c)"
     by (rule poly_eqI) (simp add: c)
   thus ?thesis by (rule that)
 qed
 
 
 subsection \<open>General facts about polynomials\<close>
 
 lemma pderiv_power:
   "pderiv (p ^ n) = smult (of_nat n) (p ^ (n - 1) * pderiv p)"
   by (cases n) (simp_all add: pderiv_power_Suc del: power_Suc)
 
 lemma degree_prod_sum_eq:
   "(\<And>x. x \<in> A \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow>
      degree (prod f A :: 'a :: idom poly) = (\<Sum>x\<in>A. degree (f x))"
   by (induction A rule: infinite_finite_induct) (auto simp: degree_mult_eq)
 
 lemma pderiv_monom:
   "pderiv (monom c n) = monom (of_nat n * c) (n - 1)"
   by (cases n)
      (simp_all add: monom_altdef pderiv_power_Suc pderiv_smult pderiv_pCons mult_ac del: power_Suc)
 
 lemma power_poly_const [simp]: "[:c:] ^ n = [:c ^ n:]"
   by (induction n) (simp_all add: power_commutes)
 
 lemma monom_power: "monom c n ^ k = monom (c ^ k) (n * k)"
   by (induction k) (simp_all add: mult_monom)
 
 lemma coeff_higher_pderiv:
   "coeff ((pderiv ^^ m) f) n = pochhammer (of_nat (Suc n)) m * coeff f (n + m)"
   by (induction m arbitrary: n) (simp_all add: coeff_pderiv pochhammer_rec algebra_simps)
 
 lemma higher_pderiv_add: "(pderiv ^^ n) (p + q) = (pderiv ^^ n) p + (pderiv ^^ n) q"
   by (induction n arbitrary: p q) (simp_all del: funpow.simps add: funpow_Suc_right pderiv_add)
 
 lemma higher_pderiv_smult: "(pderiv ^^ n) (smult c p) = smult c ((pderiv ^^ n) p)"
   by (induction n arbitrary: p) (simp_all del: funpow.simps add: funpow_Suc_right pderiv_smult)
 
 lemma higher_pderiv_0 [simp]: "(pderiv ^^ n) 0 = 0"
   by (induction n) simp_all
 
 lemma higher_pderiv_monom:
   "m \<le> n + 1 \<Longrightarrow> (pderiv ^^ m) (monom c n) = monom (pochhammer (int n - int m + 1) m * c) (n - m)"
 proof (induction m arbitrary: c n)
   case (Suc m)
   thus ?case
     by (cases n)
        (simp_all del: funpow.simps add: funpow_Suc_right pderiv_monom pochhammer_rec' Suc.IH)
 qed simp_all
 
 lemma higher_pderiv_monom_eq_zero:
   "m > n + 1 \<Longrightarrow> (pderiv ^^ m) (monom c n) = 0"
 proof (induction m arbitrary: c n)
   case (Suc m)
   thus ?case
     by (cases n)
        (simp_all del: funpow.simps add: funpow_Suc_right pderiv_monom pochhammer_rec' Suc.IH)
 qed simp_all
 
 lemma higher_pderiv_sum: "(pderiv ^^ n) (sum f A) = (\<Sum>x\<in>A. (pderiv ^^ n) (f x))"
   by (induction A rule: infinite_finite_induct) (simp_all add: higher_pderiv_add)
 
 lemma fact_dvd_higher_pderiv:
   "[:fact n :: int:] dvd (pderiv ^^ n) p"
 proof -
   have "[:fact n:] dvd (pderiv ^^ n) (monom c k)" for c :: int and k :: nat
     by (cases "n \<le> k + 1")
        (simp_all add: higher_pderiv_monom higher_pderiv_monom_eq_zero
           fact_dvd_pochhammer const_poly_dvd_iff)
   hence "[:fact n:] dvd (pderiv ^^ n) (\<Sum>k\<le>degree p. monom (coeff p k) k)"
     by (simp_all add: higher_pderiv_sum dvd_sum)
   thus ?thesis by (simp add: poly_as_sum_of_monoms)
 qed
 
 lemma fact_dvd_poly_higher_pderiv_aux:
   "(fact n :: int) dvd poly ((pderiv ^^ n) p) x"
 proof -
   have "[:fact n:] dvd (pderiv ^^ n) p" by (rule fact_dvd_higher_pderiv)
   then obtain q where "(pderiv ^^ n) p = [:fact n:] * q" by (erule dvdE)
   thus ?thesis by simp
 qed
 
 lemma fact_dvd_poly_higher_pderiv_aux':
   "m \<le> n \<Longrightarrow> (fact m :: int) dvd poly ((pderiv ^^ n) p) x"
-  by (rule dvd_trans[OF fact_dvd fact_dvd_poly_higher_pderiv_aux]) simp_all
+  by (meson dvd_trans fact_dvd fact_dvd_poly_higher_pderiv_aux)
 
 lemma algebraicE':
   assumes "algebraic (x :: 'a :: field_char_0)"
   obtains p where "p \<noteq> 0" "poly (of_int_poly p) x = 0"
 proof -
   from assms obtain q where "\<And>i. coeff q i \<in> \<int>" "q \<noteq> 0" "poly q x = 0"
     by (erule algebraicE)
   moreover from this(1) obtain q' where "q = of_int_poly q'" by (erule int_polyE)
   ultimately show ?thesis by (intro that[of q']) simp_all
 qed
 
 lemma algebraicE'_nonzero:
   assumes "algebraic (x :: 'a :: field_char_0)" "x \<noteq> 0"
   obtains p where "p \<noteq> 0" "coeff p 0 \<noteq> 0" "poly (of_int_poly p) x = 0"
 proof -
   from assms(1) obtain p where p: "p \<noteq> 0" "poly (of_int_poly p) x = 0"
     by (erule algebraicE')
   define n :: nat where "n = order 0 p"
   have "monom 1 n dvd p" by (simp add: monom_1_dvd_iff p n_def)
   then obtain q where q: "p = monom 1 n * q" by (erule dvdE)
   from p have "q \<noteq> 0" "poly (of_int_poly q) x = 0" by (auto simp: q poly_monom assms(2))
   moreover from this have "order 0 p = n + order 0 q" by (simp add: q order_mult)
   hence "order 0 q = 0" by (simp add: n_def)
   with \<open>q \<noteq> 0\<close> have "poly q 0 \<noteq> 0" by (simp add: order_root)
   ultimately show ?thesis using that[of q] by (auto simp: poly_0_coeff_0)
 qed
 
 lemma algebraic_of_real_iff [simp]:
    "algebraic (of_real x :: 'a :: {real_algebra_1,field_char_0}) \<longleftrightarrow> algebraic x"
 proof
   assume "algebraic (of_real x :: 'a)"
   then obtain p where "p \<noteq> 0" "poly (of_int_poly p) (of_real x :: 'a) = 0"
     by (erule algebraicE')
   hence "(of_int_poly p :: real poly) \<noteq> 0"
         "poly (of_int_poly p :: real poly) x = 0" by simp_all
   thus "algebraic x" by (intro algebraicI[of "of_int_poly p"]) simp_all
 next
   assume "algebraic x"
   then obtain p where "p \<noteq> 0" "poly (of_int_poly p) x = 0" by (erule algebraicE')
   hence "of_int_poly p \<noteq> (0 :: 'a poly)" "poly (of_int_poly p) (of_real x :: 'a) = 0"
     by simp_all
   thus "algebraic (of_real x)" by (intro algebraicI[of "of_int_poly p"]) simp_all
 qed
 
 
 subsection \<open>Main proof\<close>
 
 lemma lindemann_weierstrass_integral:
   fixes u :: complex and f :: "complex poly"
   defines "df \<equiv> \<lambda>n. (pderiv ^^ n) f"
   defines "m \<equiv> degree f"
   defines "I \<equiv> \<lambda>f u. exp u * (\<Sum>j\<le>degree f. poly ((pderiv ^^ j) f) 0) -
                        (\<Sum>j\<le>degree f. poly ((pderiv ^^ j) f) u)"
   shows "((\<lambda>t. exp (u - t) * poly f t) has_contour_integral I f u) (linepath 0 u)"
 proof -
   note [derivative_intros] =
     exp_scaleR_has_vector_derivative_right vector_diff_chain_within
   let ?g = "\<lambda>t. 1 - t" and ?f = "\<lambda>t. -exp (t *\<^sub>R u)"
   have "((\<lambda>t. exp ((1 - t) *\<^sub>R u) * u) has_integral
           (?f \<circ> ?g) 1 - (?f \<circ> ?g) 0) {0..1}"
     by (rule fundamental_theorem_of_calculus)
        (auto intro!: derivative_eq_intros simp del: o_apply)
   hence aux_integral: "((\<lambda>t. exp (u - t *\<^sub>R u) * u) has_integral exp u - 1) {0..1}"
     by (simp add: algebra_simps)
 
   have "((\<lambda>t. exp (u - t *\<^sub>R u) * u * poly f (t *\<^sub>R u)) has_integral I f u) {0..1}"
     unfolding df_def m_def
   proof (induction "degree f" arbitrary: f)
     case 0
     then obtain c where c: "f = [:c:]" by (auto elim: degree_eq_zeroE)
     have "((\<lambda>t. c * (exp (u - t *\<^sub>R u) * u)) has_integral c * (exp u - 1)) {0..1}"
       using aux_integral by (rule has_integral_mult_right)
     with c show ?case by (simp add: algebra_simps I_def)
   next
     case (Suc m)
     define df where "df = (\<lambda>j. (pderiv ^^ j) f)"
     show ?case
     proof (rule integration_by_parts[OF bounded_bilinear_mult])
       fix t :: real assume "t \<in> {0..1}"
       have "((?f \<circ> ?g) has_vector_derivative exp (u - t *\<^sub>R u) * u) (at t)"
         by (auto intro!: derivative_eq_intros simp: algebra_simps simp del: o_apply)
       thus "((\<lambda>t. -exp (u - t *\<^sub>R u)) has_vector_derivative exp (u - t *\<^sub>R u) * u) (at t)"
         by (simp add: algebra_simps o_def)
     next
       fix t :: real assume "t \<in> {0..1}"
       have "(poly f \<circ> (\<lambda>t. t *\<^sub>R u) has_vector_derivative u * poly (pderiv f) (t *\<^sub>R u)) (at t)"
         by (rule field_vector_diff_chain_at) (auto intro!: derivative_eq_intros)
       thus "((\<lambda>t. poly f (t *\<^sub>R u)) has_vector_derivative u * poly (pderiv f) (t *\<^sub>R u)) (at t)"
         by (simp add: o_def)
     next
       from Suc(2) have m: "m = degree (pderiv f)" by (simp add: degree_pderiv)
       from Suc(1)[OF this] this
         have "((\<lambda>t. exp (u - t *\<^sub>R u) * u * poly (pderiv f) (t *\<^sub>R u)) has_integral
                 exp u * (\<Sum>j=0..m. poly (df (Suc j)) 0) - (\<Sum>j=0..m. poly (df (Suc j)) u)) {0..1}"
         by (simp add: df_def funpow_swap1 atMost_atLeast0 I_def)
       also have "(\<Sum>j=0..m. poly (df (Suc j)) 0) = (\<Sum>j=Suc 0..Suc m. poly (df j) 0)"
         by (rule sum.shift_bounds_cl_Suc_ivl [symmetric])
       also have "\<dots> = (\<Sum>j=0..Suc m. poly (df j) 0) - poly f 0"
         by (subst (2) sum.atLeast_Suc_atMost) (simp_all add: df_def)
       also have "(\<Sum>j=0..m. poly (df (Suc j)) u) = (\<Sum>j=Suc 0..Suc m. poly (df j) u)"
         by (rule sum.shift_bounds_cl_Suc_ivl [symmetric])
       also have "\<dots> = (\<Sum>j=0..Suc m. poly (df j) u) - poly f u"
         by (subst (2) sum.atLeast_Suc_atMost) (simp_all add: df_def)
       finally have "((\<lambda>t. - (exp (u - t *\<^sub>R u) * u * poly (pderiv f) (t *\<^sub>R u))) has_integral
                         -(exp u * ((\<Sum>j = 0..Suc m. poly (df j) 0) - poly f 0) -
                                   ((\<Sum>j = 0..Suc m. poly (df j) u) - poly f u))) {0..1}"
           (is "(_ has_integral ?I) _") by (rule has_integral_neg)
       also have "?I = - exp (u - 1 *\<^sub>R u) * poly f (1 *\<^sub>R u) -
                        - exp (u - 0 *\<^sub>R u) * poly f (0 *\<^sub>R u) - I f u"
         by (simp add: df_def algebra_simps Suc(2) atMost_atLeast0 I_def)
       finally show "((\<lambda>t. - exp (u - t *\<^sub>R u) * (u * poly (pderiv f) (t *\<^sub>R u)))
                         has_integral \<dots>) {0..1}" by (simp add: algebra_simps)
     qed (auto intro!: continuous_intros)
   qed
   thus ?thesis by (simp add: has_contour_integral_linepath algebra_simps)
 qed
 
 locale lindemann_weierstrass_aux =
   fixes f :: "complex poly"
 begin
 
 definition I :: "complex \<Rightarrow> complex" where
   "I u = exp u * (\<Sum>j\<le>degree f. poly ((pderiv ^^ j) f) 0) -
                        (\<Sum>j\<le>degree f. poly ((pderiv ^^ j) f) u)"
 
 lemma lindemann_weierstrass_integral_bound:
   fixes u :: complex
   assumes "C \<ge> 0" "\<And>t. t \<in> closed_segment 0 u \<Longrightarrow> norm (poly f t) \<le> C"
   shows "norm (I u) \<le> norm u * exp (norm u) * C"
 proof -
   have "I u = contour_integral (linepath 0 u) (\<lambda>t. exp (u - t) * poly f t)"
     using contour_integral_unique[OF lindemann_weierstrass_integral[of u f]] unfolding I_def ..
   also have "norm \<dots> \<le> exp (norm u) * C * norm (u - 0)"
   proof (intro contour_integral_bound_linepath)
     fix t assume t: "t \<in> closed_segment 0 u"
     then obtain s where s: "s \<in> {0..1}" "t = s *\<^sub>R u" by (auto simp: closed_segment_def)
     hence "s * norm u \<le> 1 * norm u" by (intro mult_right_mono) simp_all
     with s have norm_t: "norm t \<le> norm u" by auto
 
     from s have "Re u - Re t = (1 - s) * Re u" by (simp add: algebra_simps)
     also have "\<dots> \<le> norm u"
     proof (cases "Re u \<ge> 0")
       case True
       with \<open>s \<in> {0..1}\<close> have "(1 - s) * Re u \<le> 1 * Re u" by (intro mult_right_mono) simp_all
       also have "Re u \<le> norm u" by (rule complex_Re_le_cmod)
       finally show ?thesis by simp
     next
       case False
       with \<open>s \<in> {0..1}\<close> have "(1 - s) * Re u \<le> 0" by (intro mult_nonneg_nonpos) simp_all
       also have "\<dots> \<le> norm u" by simp
       finally show ?thesis .
     qed
     finally have "exp (Re u - Re t) \<le> exp (norm u)" by simp
 
     hence "exp (Re u - Re t) * norm (poly f t) \<le> exp (norm u) * C"
       using assms t norm_t by (intro mult_mono) simp_all
     thus "norm (exp (u - t) * poly f t) \<le> exp (norm u) * C"
       by (simp add: norm_mult exp_diff norm_divide field_simps)
   qed (auto simp: intro!: mult_nonneg_nonneg contour_integrable_continuous_linepath
                           continuous_intros assms)
   finally show ?thesis by (simp add: mult_ac)
 qed
 
 end
 
 lemma poly_higher_pderiv_aux1:
   fixes c :: "'a :: idom"
   assumes "k < n"
   shows   "poly ((pderiv ^^ k) ([:-c, 1:] ^ n * p)) c = 0"
   using assms
 proof (induction k arbitrary: n p)
   case (Suc k n p)
   from Suc.prems obtain n' where n: "n = Suc n'" by (cases n) auto
   from Suc.prems n have "k < n'" by simp
   have "(pderiv ^^ Suc k) ([:- c, 1:] ^ n * p) =
           (pderiv ^^ k) ([:- c, 1:] ^ n * pderiv p + [:- c, 1:] ^ n' * smult (of_nat n) p)"
     by (simp only: funpow_Suc_right o_def pderiv_mult n pderiv_power_Suc,
         simp only: n [symmetric]) (simp add: pderiv_pCons mult_ac)
   also from Suc.prems \<open>k < n'\<close> have "poly \<dots> c = 0"
     by (simp add: higher_pderiv_add Suc.IH del: mult_smult_right)
   finally show ?case .
 qed simp_all
 
 lemma poly_higher_pderiv_aux1':
   fixes c :: "'a :: idom"
   assumes "k < n" "[:-c, 1:] ^ n dvd p"
   shows   "poly ((pderiv ^^ k) p) c = 0"
 proof -
   from assms(2) obtain q where "p = [:-c, 1:] ^ n * q" by (elim dvdE)
   also from assms(1) have "poly ((pderiv ^^ k) \<dots>) c = 0"
     by (rule poly_higher_pderiv_aux1)
   finally show ?thesis .
 qed
 
 lemma poly_higher_pderiv_aux2:
   fixes c :: "'a :: {idom, semiring_char_0}"
   shows   "poly ((pderiv ^^ n) ([:-c, 1:] ^ n * p)) c = fact n * poly p c"
 proof (induction n arbitrary: p)
   case (Suc n p)
   have "(pderiv ^^ Suc n) ([:- c, 1:] ^ Suc n * p) =
           (pderiv ^^ n) ([:- c, 1:] ^ Suc n * pderiv p) +
             (pderiv ^^ n) ([:- c, 1:] ^ n * smult (1 + of_nat n) p)"
     by (simp del: funpow.simps power_Suc add: funpow_Suc_right pderiv_mult
           pderiv_power_Suc higher_pderiv_add pderiv_pCons mult_ac)
   also have "[:- c, 1:] ^ Suc n * pderiv p = [:- c, 1:] ^ n * ([:-c, 1:] * pderiv p)"
     by (simp add: algebra_simps)
   finally show ?case by (simp add: Suc.IH del: mult_smult_right power_Suc)
 qed simp_all
 
 lemma poly_higher_pderiv_aux3:
   fixes c :: "'a :: {idom,semiring_char_0}"
   assumes "k \<ge> n"
   shows   "\<exists>q. poly ((pderiv ^^ k) ([:-c, 1:] ^ n * p)) c = fact n * poly q c"
   using assms
 proof (induction k arbitrary: n p)
   case (Suc k n p)
   show ?case
   proof (cases n)
     fix n' assume n: "n = Suc n'"
     have "poly ((pderiv ^^ Suc k) ([:-c, 1:] ^ n * p)) c =
             poly ((pderiv ^^ k) ([:- c, 1:] ^ n * pderiv p)) c +
               of_nat n * poly ((pderiv ^^ k) ([:-c, 1:] ^ n' * p)) c"
       by (simp del: funpow.simps power_Suc add: funpow_Suc_right pderiv_power_Suc
             pderiv_mult n pderiv_pCons higher_pderiv_add mult_ac higher_pderiv_smult)
     also have "\<exists>q1. poly ((pderiv ^^ k) ([:-c, 1:] ^ n * pderiv p)) c = fact n * poly q1 c"
       using Suc.prems Suc.IH[of n "pderiv p"]
       by (cases "n' = k") (auto simp: n poly_higher_pderiv_aux1 simp del: power_Suc of_nat_Suc
                                 intro: exI[of _ "0::'a poly"])
     then obtain q1
       where "poly ((pderiv ^^ k) ([:-c, 1:] ^ n * pderiv p)) c = fact n * poly q1 c" ..
     also from Suc.IH[of n' p] Suc.prems obtain q2
       where "poly ((pderiv ^^ k) ([:-c, 1:] ^ n' * p)) c = fact n' * poly q2 c"
       by (auto simp: n)
     finally show ?case by (auto intro!: exI[of _ "q1 + q2"] simp: n algebra_simps)
   qed auto
 qed auto
 
 lemma poly_higher_pderiv_aux3':
   fixes c :: "'a :: {idom, semiring_char_0}"
   assumes "k \<ge> n" "[:-c, 1:] ^ n dvd p"
   shows   "fact n dvd poly ((pderiv ^^ k) p) c"
 proof -
   from assms(2) obtain q where "p = [:-c, 1:] ^ n * q" by (elim dvdE)
   with poly_higher_pderiv_aux3[OF assms(1), of c q] show ?thesis by auto
 qed
 
 lemma e_transcendental_aux_bound:
   obtains C where "C \<ge> 0"
     "\<And>x. x \<in> closed_segment 0 (of_nat n) \<Longrightarrow>
         norm (\<Prod>k\<in>{1..n}. (x - of_nat k :: complex)) \<le> C"
 proof -
   let ?f = "\<lambda>x. (\<Prod>k\<in>{1..n}. (x - of_nat k))"
   define C where "C = max 0 (Sup (cmod ` ?f ` closed_segment 0 (of_nat n)))"
   have "C \<ge> 0" by (simp add: C_def)
   moreover {
     fix x :: complex assume "x \<in> closed_segment 0 (of_nat n)"
     hence "cmod (?f x) \<le> Sup ((cmod \<circ> ?f) ` closed_segment 0 (of_nat n))"
       by (intro cSup_upper bounded_imp_bdd_above compact_imp_bounded compact_continuous_image)
          (auto intro!: continuous_intros)
     also have "\<dots> \<le> C" by (simp add: C_def image_comp)
     finally have "cmod (?f x) \<le> C" .
   }
   ultimately show ?thesis by (rule that)
 qed
 
 
 theorem e_transcendental_complex: "\<not> algebraic (exp 1 :: complex)"
 proof
   assume "algebraic (exp 1 :: complex)"
   then obtain q :: "int poly"
     where q: "q \<noteq> 0" "coeff q 0 \<noteq> 0" "poly (of_int_poly q) (exp 1 :: complex) = 0"
       by (elim algebraicE'_nonzero) simp_all
 
   define n :: nat where "n = degree q"
   from q have [simp]: "n \<noteq> 0" by (intro notI) (auto simp: n_def elim!: degree_eq_zeroE)
   define qmax where "qmax = Max (insert 0 (abs ` set (coeffs q)))"
   have qmax_nonneg [simp]: "qmax \<ge> 0" by (simp add: qmax_def)
   have qmax: "\<bar>coeff q k\<bar> \<le> qmax" for k
     by (cases "k \<le> degree q")
        (auto simp: qmax_def coeff_eq_0 coeffs_def simp del: upt_Suc intro: Max.coboundedI)
   obtain C where C: "C \<ge> 0"
     "\<And>x. x \<in> closed_segment 0 (of_nat n) \<Longrightarrow> norm (\<Prod>k\<in>{1..n}. (x - of_nat k :: complex)) \<le> C"
     by (erule e_transcendental_aux_bound)
   define E where "E = (1 + real n) * real_of_int qmax * real n * exp (real n) / real n"
   define F where "F = real n * C"
 
   have ineq: "fact (p - 1) \<le> E * F ^ p" if p: "prime p" "p > n" "p > abs (coeff q 0)" for p
   proof -
     from p(1) have p_pos: "p > 0" by (simp add: prime_gt_0_nat)
     define f :: "int poly"
       where "f = monom 1 (p - 1) * (\<Prod>k\<in>{1..n}. [:-of_nat k, 1:] ^ p)"
     have poly_f: "poly (of_int_poly f) x = x ^ (p - 1) * (\<Prod>k\<in>{1..n}. (x - of_nat k)) ^ p"
       for x :: complex by (simp add: f_def poly_prod poly_monom prod_power_distrib)
     define m :: nat where "m = degree f"
     from p_pos have m: "m = (n + 1) * p - 1"
       by (simp add: m_def f_def degree_mult_eq degree_monom_eq degree_prod_sum_eq degree_linear_power)
 
     define M :: int where "M = (- 1) ^ (n * p) * fact n ^ p"
     with p have p_not_dvd_M: "\<not>int p dvd M"
       by (auto simp: M_def prime_elem_int_not_dvd_neg1_power prime_dvd_power_iff
             prime_gt_0_nat prime_dvd_fact_iff_int prime_dvd_mult_iff)
 
     interpret lindemann_weierstrass_aux "of_int_poly f" .
     define J :: complex where "J = (\<Sum>k\<le>n. of_int (coeff q k) * I (of_nat k))"
     define idxs where "idxs = ({..n}\<times>{..m}) - {(0, p - 1)}"
 
     hence "J = (\<Sum>k\<le>n. of_int (coeff q k) * exp 1 ^ k) * (\<Sum>n\<le>m. of_int (poly ((pderiv ^^ n) f) 0)) -
                  of_int (\<Sum>k\<le>n. \<Sum>n\<le>m. coeff q k * poly ((pderiv ^^ n) f) (int k))"
       by (simp add: J_def I_def algebra_simps sum_subtractf sum_distrib_left m_def
                     exp_of_nat_mult [symmetric])
     also have "(\<Sum>k\<le>n. of_int (coeff q k) * exp 1 ^ k) = poly (of_int_poly q) (exp 1 :: complex)"
       by (simp add: poly_altdef n_def)
     also have "\<dots> = 0" by fact
     finally have "J = of_int (-(\<Sum>(k,n)\<in>{..n}\<times>{..m}. coeff q k * poly ((pderiv ^^ n) f) (int k)))"
       by (simp add: sum.cartesian_product)
     also have "{..n}\<times>{..m} = insert (0, p - 1) idxs" by (auto simp: m idxs_def)
     also have "-(\<Sum>(k,n)\<in>\<dots>. coeff q k * poly ((pderiv ^^ n) f) (int k)) =
        - (coeff q 0 * poly ((pderiv ^^ (p - 1)) f) 0) -
          (\<Sum>(k, n)\<in>idxs. coeff q k * poly ((pderiv ^^ n) f) (of_nat k))"
       by (subst sum.insert) (simp_all add: idxs_def)
     also have "coeff q 0 * poly ((pderiv ^^ (p - 1)) f) 0 = coeff q 0 * M * fact (p - 1)"
     proof -
       have "f = [:-0, 1:] ^ (p - 1) * (\<Prod>k = 1..n. [:- of_nat k, 1:] ^ p)"
         by (simp add: f_def monom_altdef)
       also have "poly ((pderiv ^^ (p - 1)) \<dots>) 0 =
                    fact (p - 1) * poly (\<Prod>k = 1..n. [:- of_nat k, 1:] ^ p) 0"
         by (rule poly_higher_pderiv_aux2)
       also have "poly (\<Prod>k = 1..n. [:- of_nat k :: int, 1:] ^ p) 0 = (-1)^(n*p) * fact n ^ p"
         by (induction n) (simp_all add: prod.nat_ivl_Suc' power_mult_distrib mult_ac
                             power_minus' power_add del: of_nat_Suc)
       finally show ?thesis by (simp add: mult_ac M_def)
     qed
     also obtain N where "(\<Sum>(k, n)\<in>idxs. coeff q k * poly ((pderiv ^^ n) f) (int k)) = fact p * N"
     proof -
       have "\<forall>(k, n)\<in>idxs. fact p dvd poly ((pderiv ^^ n) f) (of_nat k)"
       proof clarify
         fix k j assume idxs: "(k, j) \<in> idxs"
         then consider "k = 0" "j < p - 1" | "k = 0" "j > p - 1" | "k \<noteq> 0" "j < p" | "k \<noteq> 0" "j \<ge> p"
           by (fastforce simp: idxs_def)
         thus "fact p dvd poly ((pderiv ^^ j) f) (of_nat k)"
         proof cases
           case 1
           thus ?thesis
             by (simp add: f_def poly_higher_pderiv_aux1' monom_altdef)
         next
           case 2
           thus ?thesis
             by (simp add: f_def poly_higher_pderiv_aux3' monom_altdef fact_dvd_poly_higher_pderiv_aux')
         next
           case 3
           thus ?thesis unfolding f_def
             by (subst poly_higher_pderiv_aux1'[of _ p])
                (insert idxs, auto simp: idxs_def intro!: dvd_mult)
         next
           case 4
           thus ?thesis unfolding f_def
             by (intro poly_higher_pderiv_aux3') (insert idxs, auto intro!: dvd_mult simp: idxs_def)
         qed
       qed
       hence "fact p dvd (\<Sum>(k, n)\<in>idxs. coeff q k * poly ((pderiv ^^ n) f) (int k))"
         by (auto intro!: dvd_sum dvd_mult simp del: of_int_fact)
       with that show thesis
         by blast
     qed
     also from p have "- (coeff q 0 * M * fact (p - 1)) - fact p * N =
                         - fact (p - 1) * (coeff q 0 * M + p * N)"
       by (subst fact_reduce[of p]) (simp_all add: algebra_simps)
     finally have J: "J = -of_int (fact (p - 1) * (coeff q 0 * M + p * N))" by simp
 
     from p q(2) have "\<not>p dvd coeff q 0 * M + p * N"
       by (auto simp: dvd_add_left_iff p_not_dvd_M prime_dvd_fact_iff_int prime_dvd_mult_iff
                dest: dvd_imp_le_int)
     hence "coeff q 0 * M + p * N \<noteq> 0" by (intro notI) simp_all
     hence "abs (coeff q 0 * M + p * N) \<ge> 1" by simp
     hence "norm (of_int (coeff q 0 * M + p * N) :: complex) \<ge> 1" by (simp only: norm_of_int)
     hence "fact (p - 1) * \<dots> \<ge> fact (p - 1) * 1" by (intro mult_left_mono) simp_all
     hence J_lower: "norm J \<ge> fact (p - 1)" unfolding J norm_minus_cancel of_int_mult of_int_fact
       by (simp add: norm_mult)
 
     have "norm J \<le> (\<Sum>k\<le>n. norm (of_int (coeff q k) * I (of_nat k)))"
       unfolding J_def by (rule norm_sum)
     also have "\<dots> \<le> (\<Sum>k\<le>n. of_int qmax * (real n * exp (real n) * real n ^ (p - 1) * C ^ p))"
     proof (intro sum_mono)
       fix k assume k: "k \<in> {..n}"
       have "n > 0" by (rule ccontr) simp
       {
         fix x :: complex assume x: "x \<in> closed_segment 0 (of_nat k)"
         then obtain t where t: "t \<ge> 0" "t \<le> 1" "x = of_real t * of_nat k"
           by (auto simp: closed_segment_def scaleR_conv_of_real)
         hence "norm x = t * real k" by (simp add: norm_mult)
         also from \<open>t \<le> 1\<close> k have *: "\<dots> \<le> 1 * real n" by (intro mult_mono) simp_all
         finally have x': "norm x \<le> real n" by simp
         from t \<open>n > 0\<close> * have x'': "x \<in> closed_segment 0 (of_nat n)"
           by (auto simp: closed_segment_def scaleR_conv_of_real field_simps
                    intro!: exI[of _ "t * real k / real n"] )
         have "norm (poly (of_int_poly f) x) =
                 norm x ^ (p - 1) * cmod (\<Prod>i = 1..n. x - i) ^ p"
           by (simp add: poly_f norm_mult norm_power)
         also from x x' x'' have "\<dots> \<le> of_nat n ^ (p - 1) * C ^ p"
           by (intro mult_mono C power_mono) simp_all
         finally have "norm (poly (of_int_poly f) x) \<le> real n ^ (p - 1) * C ^ p" .
       } note A = this
 
       have "norm (I (of_nat k)) \<le>
                       cmod (of_nat k) * exp (cmod (of_nat k)) * (of_nat n ^ (p - 1) * C ^ p)"
         by (intro lindemann_weierstrass_integral_bound[OF _ A]
               C mult_nonneg_nonneg zero_le_power) auto
       also have "\<dots> \<le> cmod (of_nat n) * exp (cmod (of_nat n)) * (of_nat n ^ (p - 1) * C ^ p)"
         using k by (intro mult_mono zero_le_power mult_nonneg_nonneg C) simp_all
       finally show "cmod (of_int (coeff q k) * I (of_nat k)) \<le>
                       of_int qmax * (real n * exp (real n) * real n ^ (p - 1) * C ^ p)"
         unfolding norm_mult
         by (intro mult_mono) (simp_all add: qmax of_int_abs [symmetric] del: of_int_abs)
     qed
     also have "\<dots> = E * F ^ p" using p_pos
       by (simp add: power_diff power_mult_distrib E_def F_def)
     finally show "fact (p - 1) \<le> E * F ^ p" using J_lower by linarith
   qed
 
   have "(\<lambda>n. E * F * F ^ (n - 1) / fact (n - 1)) \<longlonglongrightarrow> 0" (is ?P)
-    by (intro filterlim_compose[OF power_over_fact_tendsto_0' filterlim_minus_nat_at_top])
+    by (intro filterlim_compose[OF power_over_fact_tendsto_0' filterlim_minus_const_nat_at_top])
   also have "?P \<longleftrightarrow> (\<lambda>n. E * F ^ n / fact (n - 1)) \<longlonglongrightarrow> 0"
     by (intro filterlim_cong refl eventually_mono[OF eventually_gt_at_top[of "0::nat"]])
        (auto simp: power_Suc [symmetric] simp del: power_Suc)
   finally have "eventually (\<lambda>n. E * F ^ n / fact (n - 1) < 1) at_top"
     by (rule order_tendstoD) simp_all
   hence "eventually (\<lambda>n. E * F ^ n < fact (n - 1)) at_top" by eventually_elim simp
   then obtain P where P: "\<And>n. n \<ge> P \<Longrightarrow> E * F ^ n < fact (n - 1)"
     by (auto simp: eventually_at_top_linorder)
 
   have "\<exists>p. prime p \<and> p > Max {nat (abs (coeff q 0)), n, P}" by (rule bigger_prime)
   then obtain p where "prime p" "p > Max {nat (abs (coeff q 0)), n, P}" by blast
   hence "int p > abs (coeff q 0)" "p > n" "p \<ge> P" by auto
   with ineq[of p] \<open>prime p\<close> have "fact (p - 1) \<le> E * F ^ p" by simp
   moreover from \<open>p \<ge> P\<close> have "fact (p - 1) > E * F ^ p" by (rule P)
   ultimately show False by linarith
 qed
 
 corollary e_transcendental_real: "\<not> algebraic (exp 1 :: real)"
 proof -
   have "\<not>algebraic (exp 1 :: complex)" by (rule e_transcendental_complex)
   also have "(exp 1 :: complex) = of_real (exp 1)" using exp_of_real[of 1] by simp
   also have "algebraic \<dots> \<longleftrightarrow> algebraic (exp 1 :: real)" by simp
   finally show ?thesis .
 qed
 
 end
diff --git a/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy b/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy
--- a/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy
+++ b/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy
@@ -1,1824 +1,1824 @@
 (*
   File:    Formal_Puiseux_Series.thy
   Author:  Manuel Eberl, TU München
 *)
 section \<open>Formal Puiseux Series\<close>
 theory Formal_Puiseux_Series
-  imports Puiseux_Laurent_Library FPS_Hensel
+  imports FPS_Hensel
 begin
 
 subsection \<open>Auxiliary facts and definitions\<close>
 
 lemma div_dvd_self:
   fixes a b :: "'a :: {semidom_divide}"
   shows "b dvd a \<Longrightarrow> a div b dvd a"
   by (elim dvdE; cases "b = 0") simp_all
 
 lemma quotient_of_int [simp]: "quotient_of (of_int n) = (n, 1)"
   using Rat.of_int_def quotient_of_int by auto
 
 lemma of_int_div_of_int_in_Ints_iff:
   "(of_int n / of_int m :: 'a :: field_char_0) \<in> \<int> \<longleftrightarrow> m = 0 \<or> m dvd n"
 proof
   assume *: "(of_int n / of_int m :: 'a) \<in> \<int>"
   {
     assume "m \<noteq> 0"
     from * obtain k where k: "(of_int n / of_int m :: 'a) = of_int k"
       by (auto elim!: Ints_cases)
     hence "of_int n = (of_int k * of_int m :: 'a)"
       using \<open>m \<noteq> 0\<close> by (simp add: field_simps)
     also have "\<dots> = of_int (k * m)"
       by simp
     finally have "n = k * m"
       by (subst (asm) of_int_eq_iff)
     hence "m dvd n" by auto
   }
   thus "m = 0 \<or> m dvd n" by blast
 qed auto
 
 lemma rat_eq_quotientD:
   assumes "r = rat_of_int a / rat_of_int b" "b \<noteq> 0"
   shows   "fst (quotient_of r) dvd a" "snd (quotient_of r) dvd b"
 proof -
   define a' b' where "a' = fst (quotient_of r)" and "b' = snd (quotient_of r)"
   define d where "d = gcd a b"
   have "b' > 0"
     by (auto simp: b'_def quotient_of_denom_pos')
 
   have "coprime a' b'"
     by (rule quotient_of_coprime[of r]) (simp add: a'_def b'_def)
   have r: "r = rat_of_int a' / rat_of_int b'"
     by (simp add: a'_def b'_def quotient_of_div)
   from assms \<open>b' > 0\<close> have "rat_of_int (a' * b) = rat_of_int (a * b')"
     unfolding of_int_mult by (simp add: field_simps r)
   hence eq: "a' * b = a * b'"
     by (subst (asm) of_int_eq_iff)
 
   have "a' dvd a * b'"
     by (simp flip: eq)
   hence "a' dvd a"
     by (subst (asm) coprime_dvd_mult_left_iff) fact
   moreover have "b' dvd a' * b"
     by (simp add: eq)
   hence "b' dvd b"
     by (subst (asm) coprime_dvd_mult_right_iff) (use \<open>coprime a' b'\<close> in \<open>simp add: coprime_commute\<close>)
   ultimately show "fst (quotient_of r) dvd a" "snd (quotient_of r) dvd b"
     unfolding a'_def b'_def by blast+
 qed
 
 lemma quotient_of_denom_add_dvd:
   "snd (quotient_of (x + y)) dvd snd (quotient_of x) * snd (quotient_of y)"
 proof -
   define a b where "a = fst (quotient_of x)" and "b = snd (quotient_of x)"
   define c d where "c = fst (quotient_of y)" and "d = snd (quotient_of y)"
   have "b > 0" "d > 0"
     by (auto simp: b_def d_def quotient_of_denom_pos')
   have xy: "x = rat_of_int a / rat_of_int b" "y = rat_of_int c / rat_of_int d"
     unfolding a_def b_def c_def d_def by (simp_all add: quotient_of_div)
 
   show "snd (quotient_of (x + y)) dvd b * d"
   proof (rule rat_eq_quotientD)
     show "x + y = rat_of_int (a * d + c * b) / rat_of_int (b * d)"
       using \<open>b > 0\<close> \<open>d > 0\<close> by (simp add: field_simps xy)
   qed (use \<open>b > 0\<close> \<open>d > 0\<close> in auto)
 qed
 
 lemma quotient_of_denom_diff_dvd:
   "snd (quotient_of (x - y)) dvd snd (quotient_of x) * snd (quotient_of y)"
   using quotient_of_denom_add_dvd[of x "-y"]
   by (simp add: rat_uminus_code Let_def case_prod_unfold)
 
 
 definition supp :: "('a \<Rightarrow> ('b :: zero)) \<Rightarrow> 'a set" where
   "supp f = f -` (-{0})"
 
 lemma supp_0 [simp]: "supp (\<lambda>_. 0) = {}"
   and supp_const: "supp (\<lambda>_. c) = (if c = 0 then {} else UNIV)"
   and supp_singleton [simp]: "c \<noteq> 0 \<Longrightarrow> supp (\<lambda>x. if x = d then c else 0) = {d}"
   by (auto simp: supp_def)
 
 lemma supp_uminus [simp]: "supp (\<lambda>x. -f x :: 'a :: group_add) = supp f"
   by (auto simp: supp_def)
 
 
 subsection \<open>Definition\<close>
 
 text \<open>
   Similarly to formal power series $R[[X]]$ and formal Laurent series $R((X))$, we define the ring
   of formal Puiseux series $R\{\{X\}\}$ as functions from the rationals into a ring such that
 
     \<^enum> the support is bounded from below, and 
 
     \<^enum> the denominators of the numbers in the support have a common multiple other than 0
 
   One can also think of a formal Puiseux series in the paramter $X$ as a formal Laurent series
   in the parameter $X^{1/d}$ for some positive integer $d$. This is often written in the
   following suggestive notation:
   \[ R\{\{X\}\} = \bigcup_{d\geq 1} R((X^{1/d})) \]
 
   Many operations will be defined in terms of this correspondence between Puiseux and Laurent
   series, and many of the simple properties proven that way.
 \<close>
 
 definition is_fpxs :: "(rat \<Rightarrow> 'a :: zero) \<Rightarrow> bool" where
   "is_fpxs f \<longleftrightarrow> bdd_below (supp f) \<and> (LCM r\<in>supp f. snd (quotient_of r)) \<noteq> 0"
 
 typedef (overloaded) 'a fpxs = "{f::rat \<Rightarrow> 'a :: zero. is_fpxs f}"
   morphisms fpxs_nth Abs_fpxs
   by (rule exI[of _ "\<lambda>_. 0"]) (auto simp: is_fpxs_def supp_def)
 
 setup_lifting type_definition_fpxs
 
 lemma fpxs_ext: "(\<And>r. fpxs_nth f r = fpxs_nth g r) \<Longrightarrow> f = g"
   by transfer auto
 
 lemma fpxs_eq_iff: "f = g \<longleftrightarrow> (\<forall>r. fpxs_nth f r = fpxs_nth g r)"
   by transfer auto
 
 lift_definition fpxs_supp :: "'a :: zero fpxs \<Rightarrow> rat set" is supp .
 
 lemma fpxs_supp_altdef: "fpxs_supp f = {x. fpxs_nth f x \<noteq> 0}"
   by transfer (auto simp: supp_def)
 
 
 text \<open>
   The following gives us the ``root order'' of \<open>f\<close>i, i.e. the smallest positive integer \<open>d\<close>
   such that \<open>f\<close> is in $R((X^{1/p}))$.
 \<close>
 lift_definition fpxs_root_order :: "'a :: zero fpxs \<Rightarrow> nat" is
   "\<lambda>f. nat (LCM r\<in>supp f. snd (quotient_of r))" .
 
 lemma fpxs_root_order_pos [simp]: "fpxs_root_order f > 0"
 proof transfer
   fix f :: "rat \<Rightarrow> 'a" assume f: "is_fpxs f"
   hence "(LCM r\<in>supp f. snd (quotient_of r)) \<noteq> 0"
     by (auto simp: is_fpxs_def)
   moreover have "(LCM r\<in>supp f. snd (quotient_of r)) \<ge> 0"
     by simp
   ultimately show "nat (LCM r\<in>supp f. snd (quotient_of r)) > 0"
     by linarith
 qed
 
 lemma fpxs_root_order_nonzero [simp]: "fpxs_root_order f \<noteq> 0"
   using fpxs_root_order_pos[of f] by linarith
 
 
 text \<open>
   Let \<open>d\<close> denote the root order of a Puiseux series \<open>f\<close>, i.e. the smallest number \<open>d\<close> such that
   all monomials with non-zero coefficients can be written in the form $X^{n/d}$ for some \<open>n\<close>.
   Then \<open>f\<close> can be written as a Laurent series in \<open>X^{1/d}\<close>. The following operation gives us
   this Laurent series.
 \<close>
 lift_definition fls_of_fpxs :: "'a :: zero fpxs \<Rightarrow> 'a fls" is
   "\<lambda>f n. f (of_int n / of_int (LCM r\<in>supp f. snd (quotient_of r)))"
 proof -
   fix f :: "rat \<Rightarrow> 'a"
   assume f: "is_fpxs f"
   hence "bdd_below (supp f)"
     by (auto simp: is_fpxs_def)
   then obtain r0 where "\<forall>x\<in>supp f. r0 \<le> x"
     by (auto simp: bdd_below_def)
   hence r0: "f x = 0" if "x < r0" for x
     using that by (auto simp: supp_def vimage_def)
   define d :: int where "d = (LCM r\<in>supp f. snd (quotient_of r))"
   have "d \<ge> 0" by (simp add: d_def)
   moreover have "d \<noteq> 0"
     using f by (auto simp: d_def is_fpxs_def)
   ultimately have "d > 0" by linarith
 
   have *: "f (of_int n / of_int d) = 0" if "n < \<lfloor>r0 * of_int d\<rfloor>" for n
   proof -
     have "rat_of_int n < r0 * rat_of_int d"
       using that by linarith
     thus ?thesis
       using \<open>d > 0\<close> by (intro r0) (auto simp: field_simps)
   qed
   have "eventually (\<lambda>n. n > -\<lfloor>r0 * of_int d\<rfloor>) at_top"
     by (rule eventually_gt_at_top)
   hence "eventually (\<lambda>n. f (of_int (-n) / of_int d) = 0) at_top"
     by (eventually_elim) (rule *, auto)
   hence "eventually (\<lambda>n. f (of_int (-int n) / of_int d) = 0) at_top"
     by (rule eventually_compose_filterlim) (rule filterlim_int_sequentially)
   thus "eventually (\<lambda>n. f (of_int (-int n) / of_int d) = 0) cofinite"
     by (simp add: cofinite_eq_sequentially)
 qed
 
 lemma fls_nth_of_fpxs:
   "fls_nth (fls_of_fpxs f) n = fpxs_nth f (of_int n / of_nat (fpxs_root_order f))"
   by transfer simp
 
 
 subsection \<open>Basic algebraic typeclass instances\<close>
 
 instantiation fpxs :: (zero) zero
 begin
 
 lift_definition zero_fpxs :: "'a fpxs" is "\<lambda>r::rat. 0 :: 'a"
   by (auto simp: is_fpxs_def supp_def)
 
 instance ..
 
 end
 
 instantiation fpxs :: ("{one, zero}") one
 begin
 
 lift_definition one_fpxs :: "'a fpxs" is "\<lambda>r::rat. if r = 0 then 1 else 0 :: 'a"
   by (cases "(1 :: 'a) = 0") (auto simp: is_fpxs_def cong: if_cong)
 
 instance ..
 
 end
 
 lemma fls_of_fpxs_0 [simp]: "fls_of_fpxs 0 = 0"
   by transfer auto
 
 lemma fpxs_nth_0 [simp]: "fpxs_nth 0 r = 0"
   by transfer auto
 
 lemma fpxs_nth_1: "fpxs_nth 1 r = (if r = 0 then 1 else 0)"
   by transfer auto
 
 lemma fpxs_nth_1': "fpxs_nth 1 0 = 1" "r \<noteq> 0 \<Longrightarrow> fpxs_nth 1 r = 0"
   by (auto simp: fpxs_nth_1)
 
 instantiation fpxs :: (monoid_add) monoid_add
 begin
 
 lift_definition plus_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" is
   "\<lambda>f g x. f x + g x"
 proof -
   fix f g :: "rat \<Rightarrow> 'a"
   assume fg: "is_fpxs f" "is_fpxs g"
   show "is_fpxs (\<lambda>x. f x + g x)"
     unfolding is_fpxs_def
   proof
     have supp: "supp (\<lambda>x. f x + g x) \<subseteq> supp f \<union> supp g"
       by (auto simp: supp_def)
     show "bdd_below (supp (\<lambda>x. f x + g x))"
       by (rule bdd_below_mono[OF _ supp]) (use fg in \<open>auto simp: is_fpxs_def\<close>)
     have "(LCM r\<in>supp (\<lambda>x. f x + g x). snd (quotient_of r)) dvd
             (LCM r\<in>supp f \<union> supp g. snd (quotient_of r))"
       by (intro Lcm_subset image_mono supp)
     also have "\<dots> = lcm (LCM r\<in>supp f. snd (quotient_of r)) (LCM r\<in>supp g. snd (quotient_of r))"
       unfolding image_Un Lcm_Un ..
     finally have "(LCM r\<in>supp (\<lambda>x. f x + g x). snd (quotient_of r)) dvd
                     lcm (LCM r\<in>supp f. snd (quotient_of r)) (LCM r\<in>supp g. snd (quotient_of r))" .
     moreover have "lcm (LCM r\<in>supp f. snd (quotient_of r)) (LCM r\<in>supp g. snd (quotient_of r)) \<noteq> 0"
       using fg by (auto simp: is_fpxs_def)
     ultimately show "(LCM r\<in>supp (\<lambda>x. f x + g x). snd (quotient_of r)) \<noteq> 0"
       by auto
   qed
 qed
 
 instance 
   by standard (transfer; simp add: algebra_simps fun_eq_iff)+
 
 end
 
 instance fpxs :: (comm_monoid_add) comm_monoid_add
 proof
   fix f g :: "'a fpxs"
   show "f + g = g + f"
     by transfer (auto simp: add_ac)
 qed simp_all
 
 lemma fpxs_nth_add [simp]: "fpxs_nth (f + g) r = fpxs_nth f r + fpxs_nth g r"
   by transfer auto
 
 lift_definition fpxs_of_fls :: "'a :: zero fls \<Rightarrow> 'a fpxs" is
   "\<lambda>f r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0"
 proof -
   fix f :: "int \<Rightarrow> 'a"
   assume "eventually (\<lambda>n. f (-int n) = 0) cofinite"
   hence "eventually (\<lambda>n. f (-int n) = 0) at_top"
     by (simp add: cofinite_eq_sequentially)
   then obtain N where N: "f (-int n) = 0" if "n \<ge> N" for n
     by (auto simp: eventually_at_top_linorder)
   
   show "is_fpxs (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0)"
     unfolding is_fpxs_def
   proof
     have "bdd_below {-(of_nat N::rat)..}"
       by simp
     moreover have "supp (\<lambda>r::rat. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0) \<subseteq> {-of_nat N..}"
     proof
       fix r :: rat assume "r \<in> supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0)"
       then obtain m where [simp]: "r = of_int m" "f m \<noteq> 0"
         by (auto simp: supp_def elim!: Ints_cases split: if_splits)
       have "m \<ge> -int N"
         using N[of "nat (-m)"] by (cases "m \<ge> 0"; cases "-int N \<le> m") (auto simp: le_nat_iff)
       thus "r \<in> {-of_nat N..}" by simp
     qed
     ultimately show "bdd_below (supp (\<lambda>r::rat. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0))"
       by (rule bdd_below_mono)
   next
     have "(LCM r\<in>supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0). snd (quotient_of r)) dvd 1"
       by (intro Lcm_least) (auto simp: supp_def elim!: Ints_cases split: if_splits)
     thus "(LCM r\<in>supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0). snd (quotient_of r)) \<noteq> 0"
       by (intro notI) simp
   qed
 qed
 
 instantiation fpxs :: (group_add) group_add
 begin
 
 lift_definition uminus_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs" is "\<lambda>f x. -f x"
   by (auto simp: is_fpxs_def)
 
 definition minus_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" where
   "minus_fpxs f g = f + (-g)"
 
 instance proof
   fix f :: "'a fpxs"
   show "-f + f = 0"
     by transfer auto
 qed (auto simp: minus_fpxs_def)
 
 end
 
 lemma fpxs_nth_uminus [simp]: "fpxs_nth (-f) r = -fpxs_nth f r"
   by transfer auto
 
 lemma fpxs_nth_minus [simp]: "fpxs_nth (f - g) r = fpxs_nth f r - fpxs_nth g r"
   unfolding minus_fpxs_def fpxs_nth_add fpxs_nth_uminus by simp
 
 lemma fpxs_of_fls_eq_iff [simp]: "fpxs_of_fls f = fpxs_of_fls g \<longleftrightarrow> f = g"
   by transfer (force simp: fun_eq_iff Ints_def)
 
 lemma fpxs_of_fls_0 [simp]: "fpxs_of_fls 0 = 0"
   by transfer auto
 
 lemma fpxs_of_fls_1 [simp]: "fpxs_of_fls 1 = 1"
   by transfer (auto simp: fun_eq_iff elim!: Ints_cases)
 
 lemma fpxs_of_fls_add [simp]: "fpxs_of_fls (f + g) = fpxs_of_fls f + fpxs_of_fls g"
   by transfer (auto simp: fun_eq_iff elim!: Ints_cases)
 
 lemma fps_to_fls_sum [simp]: "fps_to_fls (sum f A) = (\<Sum>x\<in>A. fps_to_fls (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma fpxs_of_fls_sum [simp]: "fpxs_of_fls (sum f A) = (\<Sum>x\<in>A. fpxs_of_fls (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma fpxs_nth_of_fls:
   "fpxs_nth (fpxs_of_fls f) r = (if r \<in> \<int> then fls_nth f \<lfloor>r\<rfloor> else 0)"
   by transfer auto
 
 lemma fpxs_of_fls_eq_0_iff [simp]: "fpxs_of_fls f = 0 \<longleftrightarrow> f = 0"
   using fpxs_of_fls_eq_iff[of f 0] by (simp del: fpxs_of_fls_eq_iff)
 
 lemma fpxs_of_fls_eq_1_iff [simp]: "fpxs_of_fls f = 1 \<longleftrightarrow> f = 1"
   using fpxs_of_fls_eq_iff[of f 1] by (simp del: fpxs_of_fls_eq_iff)
 
 lemma fpxs_root_order_of_fls [simp]: "fpxs_root_order (fpxs_of_fls f) = 1"
 proof (transfer, goal_cases)
   case (1 f)
   have "supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0) = rat_of_int ` {n. f n \<noteq> 0}"
     by (force simp: supp_def Ints_def)
   also have "(LCM r\<in>\<dots>. snd (quotient_of r)) = nat (LCM x\<in>{n. f n \<noteq> 0}. 1)"
     by (simp add: image_image)
   also have "\<dots> = 1"
     by simp
   also have "nat 1 = 1"
     by simp
   finally show ?case  .
 qed
 
 
 
 subsection \<open>The substitution $X \mapsto X^r$\<close>
 
 text \<open>
   This operation turns a formal Puiseux series $f(X)$ into $f(X^r)$, where
   $r$ can be any positive rational number:
 \<close>
 lift_definition fpxs_compose_power :: "'a :: zero fpxs \<Rightarrow> rat \<Rightarrow> 'a fpxs" is
   "\<lambda>f r x. if r > 0 then f (x / r) else 0"
 proof -
   fix f :: "rat \<Rightarrow> 'a" and r :: rat
   assume f: "is_fpxs f"
   have "is_fpxs (\<lambda>x. f (x / r))" if "r > 0"
     unfolding is_fpxs_def
   proof
     define r' where "r' = inverse r"
     have "r' > 0"
       using \<open>r > 0\<close> by (auto simp: r'_def)
     have "(\<lambda>x. x / r') ` supp f = supp (\<lambda>x. f (x * r'))"
       using \<open>r' > 0\<close> by (auto simp: supp_def image_iff vimage_def field_simps)
     hence eq: "(\<lambda>x. x * r) ` supp f = supp (\<lambda>x. f (x / r))"
       using \<open>r > 0\<close> by (simp add: r'_def field_simps)
 
     from f have "bdd_below (supp f)"
       by (auto simp: is_fpxs_def)
     hence "bdd_below ((\<lambda>x. x * r) ` supp f)"
       using \<open>r > 0\<close> by (intro bdd_below_image_mono) (auto simp: mono_def divide_right_mono)
     also note eq
     finally show "bdd_below (supp (\<lambda>x. f (x / r)))" .
 
     define a b where "a = fst (quotient_of r)" and "b = snd (quotient_of r)"
     have "b > 0" by (simp add: b_def quotient_of_denom_pos')
     have [simp]: "quotient_of r = (a, b)"
       by (simp add: a_def b_def)
     have "r = of_int a / of_int b"
       by (simp add: quotient_of_div)
     with \<open>r > 0\<close> and \<open>b > 0\<close> have \<open>a > 0\<close>
       by (simp add: field_simps)
 
     have "(LCM r\<in>supp (\<lambda>x. f (x / r)). snd (quotient_of r)) =
             (LCM x\<in>supp f. snd (quotient_of (x * r)))"
       by (simp add: eq [symmetric] image_image)
     also have "\<dots> dvd (LCM x\<in>supp f. snd (quotient_of x) * b)"
       using \<open>a > 0\<close> \<open>b > 0\<close>
       by (intro Lcm_mono)
          (simp add: rat_times_code case_prod_unfold Let_def Rat.normalize_def
                     quotient_of_denom_pos' div_dvd_self)
     also have "\<dots> dvd normalize (b * (LCM x\<in>supp f. snd (quotient_of x)))"
     proof (cases "supp f = {}")
       case False
       thus ?thesis using Lcm_mult[of "(\<lambda>x. snd (quotient_of x)) ` supp f" b]
         by (simp add: mult_ac image_image)
     qed auto
     hence "(LCM x\<in>supp f. snd (quotient_of x) * b) dvd
              b * (LCM x\<in>supp f. snd (quotient_of x))" by simp
     finally show "(LCM r\<in>supp (\<lambda>x. f (x / r)). snd (quotient_of r)) \<noteq> 0"
       using \<open>b > 0\<close> f by (auto simp: is_fpxs_def)
   qed
   thus "is_fpxs (\<lambda>x. if r > 0 then f (x / r) else 0)"
     by (cases "r > 0") (auto simp: is_fpxs_def supp_def)
 qed
 
 lemma fpxs_as_fls:
   "fpxs_compose_power (fpxs_of_fls (fls_of_fpxs f)) (1 / of_nat (fpxs_root_order f)) = f"
 proof (transfer, goal_cases)
   case (1 f)
   define d where "d = (LCM r\<in>supp f. snd (quotient_of r))"
   have "d \<ge> 0" by (simp add: d_def)
   moreover have "d \<noteq> 0" using 1 by (simp add: is_fpxs_def d_def)
   ultimately have "d > 0" by linarith
 
   have "(if rat_of_int d * x \<in> \<int> then f (rat_of_int \<lfloor>rat_of_int d * x\<rfloor> / rat_of_int d) else 0) = f x" for x
   proof (cases "rat_of_int d * x \<in> \<int>")
     case True
     then obtain n where n: "rat_of_int d * x = of_int n"
       by (auto elim!: Ints_cases)
     have "f (rat_of_int \<lfloor>rat_of_int d * x\<rfloor> / rat_of_int d) = f (rat_of_int n / rat_of_int d)"
       by (simp add: n)
     also have "rat_of_int n / rat_of_int d = x"
       using n \<open>d > 0\<close> by (simp add: field_simps)
     finally show ?thesis
       using True by simp
   next
     case False
     have "x \<notin> supp f"
     proof
       assume "x \<in> supp f"
       hence "snd (quotient_of x) dvd d"
         by (simp add: d_def)
       hence "rat_of_int (fst (quotient_of x) * d) / rat_of_int (snd (quotient_of x)) \<in> \<int>"
         by (intro of_int_divide_in_Ints) auto
       also have "rat_of_int (fst (quotient_of x) * d) / rat_of_int (snd (quotient_of x)) =
                  rat_of_int d * (rat_of_int (fst (quotient_of x)) / rat_of_int (snd (quotient_of x)))"
         by (simp only: of_int_mult mult_ac times_divide_eq_right)
       also have "\<dots> = rat_of_int d * x"
         by (metis Fract_of_int_quotient Rat_cases normalize_stable prod.sel(1) prod.sel(2) quotient_of_Fract)
       finally have "rat_of_int d * x \<in> \<int>" .
       with False show False by contradiction
     qed
     thus ?thesis using False by (simp add: supp_def)
   qed
   thus ?case
     using \<open>d > 0\<close> by (simp add: is_fpxs_def d_def mult_ac fun_eq_iff cong: if_cong)
 qed
 
 lemma fpxs_compose_power_0 [simp]: "fpxs_compose_power 0 r = 0"
   by transfer simp
 
 lemma fpxs_compose_power_1 [simp]: "r > 0 \<Longrightarrow> fpxs_compose_power 1 r = 1"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fls_of_fpxs_eq_0_iff [simp]: "fls_of_fpxs x = 0 \<longleftrightarrow> x = 0"
   by (metis fls_of_fpxs_0 fpxs_as_fls fpxs_compose_power_0 fpxs_of_fls_0)
 
 lemma fpxs_of_fls_compose_power [simp]:
   "fpxs_of_fls (fls_compose_power f d) = fpxs_compose_power (fpxs_of_fls f) (of_nat d)"
 proof (transfer, goal_cases)
   case (1 f d)
   show ?case
   proof (cases "d = 0")
     case False
     show ?thesis
     proof (intro ext, goal_cases)
       case (1 r)
       show ?case
       proof (cases "r \<in> \<int>")
         case True
         then obtain n where [simp]: "r = of_int n"
           by (cases r rule: Ints_cases)
         show ?thesis
         proof (cases "d dvd n")
           case True
           thus ?thesis by (auto elim!: Ints_cases)
         next
           case False
           hence "rat_of_int n / rat_of_int (int d) \<notin> \<int>"
             using \<open>d \<noteq> 0\<close> by (subst of_int_div_of_int_in_Ints_iff) auto
           thus ?thesis using False by auto
         qed
       next
         case False
         hence "r / rat_of_nat d \<notin> \<int>"
           using \<open>d \<noteq> 0\<close> by (auto elim!: Ints_cases simp: field_simps)
         thus ?thesis using False by auto
       qed
     qed
   qed auto
 qed
 
 lemma fpxs_compose_power_add [simp]:
   "fpxs_compose_power (f + g) r = fpxs_compose_power f r + fpxs_compose_power g r"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fpxs_compose_power_distrib:
   "r1 > 0 \<or> r2 > 0 \<Longrightarrow> 
      fpxs_compose_power (fpxs_compose_power f r1) r2 = fpxs_compose_power f (r1 * r2)"
   by transfer (auto simp: fun_eq_iff algebra_simps zero_less_mult_iff)
 
 lemma fpxs_compose_power_divide_right:
   "r1 > 0 \<Longrightarrow> r2 > 0 \<Longrightarrow> 
      fpxs_compose_power f (r1 / r2) = fpxs_compose_power (fpxs_compose_power f r1) (inverse r2)"
   by (simp add: fpxs_compose_power_distrib field_simps)
 
 lemma fpxs_compose_power_1_right [simp]: "fpxs_compose_power f 1 = f"
   by transfer auto
 
 lemma fpxs_compose_power_eq_iff [simp]:
   assumes "r > 0"
   shows   "fpxs_compose_power f r = fpxs_compose_power g r \<longleftrightarrow> f = g"
   using assms
 proof (transfer, goal_cases)
   case (1 r f g)
   have "f x = g x" if "\<And>x. f (x / r) = g (x / r)" for x
     using that[of "x * r"] \<open>r > 0\<close> by auto
   thus ?case using \<open>r > 0\<close> by (auto simp: fun_eq_iff)
 qed
 
 lemma fpxs_compose_power_eq_1_iff [simp]:
   assumes "l > 0"
   shows   "fpxs_compose_power p l = 1 \<longleftrightarrow> p = 1"
 proof -
   have "fpxs_compose_power p l = 1 \<longleftrightarrow> fpxs_compose_power p l = fpxs_compose_power 1 l"
     by (subst fpxs_compose_power_1) (use assms in auto)
   also have "\<dots> \<longleftrightarrow> p = 1"
     using assms by (subst fpxs_compose_power_eq_iff) auto
   finally show ?thesis .
 qed
 
 lemma fpxs_compose_power_eq_0_iff [simp]:
   assumes "r > 0"
   shows   "fpxs_compose_power f r = 0 \<longleftrightarrow> f = 0"
   using fpxs_compose_power_eq_iff[of r f 0] assms by (simp del: fpxs_compose_power_eq_iff)
 
 lemma fls_of_fpxs_of_fls [simp]: "fls_of_fpxs (fpxs_of_fls f) = f"
   using fpxs_as_fls[of "fpxs_of_fls f"] by simp
 
 lemma fpxs_as_fls':
   assumes "fpxs_root_order f dvd d" "d > 0"
   obtains f' where "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
 proof -
   define D where "D = fpxs_root_order f"
   have "D > 0"
     by (auto simp: D_def)
   define f' where "f' = fls_of_fpxs f"
   from assms obtain d' where d': "d = D * d'"
     by (auto simp: D_def)
   have "d' > 0"
     using assms by (auto intro!: Nat.gr0I simp: d')
   define f'' where "f'' = fls_compose_power f' d'"
   have "fpxs_compose_power (fpxs_of_fls f'') (1 / of_nat d) = f"
     using \<open>D > 0\<close> \<open>d' > 0\<close>
     by (simp add: d' D_def f''_def f'_def fpxs_as_fls fpxs_compose_power_distrib)
   thus ?thesis using that[of f''] by blast
 qed
 
 
 subsection \<open>Mutiplication and ring properties\<close>
 
 instantiation fpxs :: (comm_semiring_1) comm_semiring_1
 begin
 
 lift_definition times_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" is
   "\<lambda>f g x. (\<Sum>(y,z) | y \<in> supp f \<and> z \<in> supp g \<and> x = y + z. f y * g z)"
 proof -
   fix f g :: "rat \<Rightarrow> 'a"
   assume fg: "is_fpxs f" "is_fpxs g"
   show "is_fpxs (\<lambda>x. \<Sum>(y,z) | y \<in> supp f \<and> z \<in> supp g \<and> x = y + z. f y * g z)"
     (is "is_fpxs ?h") unfolding is_fpxs_def
   proof
     from fg obtain bnd1 bnd2 where bnds: "\<forall>x\<in>supp f. x \<ge> bnd1" "\<forall>x\<in>supp g. x \<ge> bnd2"
       by (auto simp: is_fpxs_def bdd_below_def)
     have "supp ?h \<subseteq> (\<lambda>(x,y). x + y) ` (supp f \<times> supp g)"
     proof
       fix x :: rat
       assume "x \<in> supp ?h"
       have "{(y,z). y \<in> supp f \<and> z \<in> supp g \<and> x = y + z} \<noteq> {}"
       proof
         assume eq: "{(y,z). y \<in> supp f \<and> z \<in> supp g \<and> x = y + z} = {}"
         hence "?h x = 0"
           by (simp only:) auto
         with \<open>x \<in> supp ?h\<close> show False by (auto simp: supp_def)
       qed
       thus "x \<in> (\<lambda>(x,y). x + y) ` (supp f \<times> supp g)"
         by auto
     qed
     also have "\<dots> \<subseteq> {bnd1 + bnd2..}"
       using bnds by (auto intro: add_mono)
     finally show "bdd_below (supp ?h)"
       by auto
   next
     define d1 where "d1 = (LCM r\<in>supp f. snd (quotient_of r))"
     define d2 where "d2 = (LCM r\<in>supp g. snd (quotient_of r))"
     have "(LCM r\<in>supp ?h. snd (quotient_of r)) dvd (d1 * d2)"
     proof (intro Lcm_least, safe)
       fix r :: rat
       assume "r \<in> supp ?h"
       hence "(\<Sum>(y, z) | y \<in> supp f \<and> z \<in> supp g \<and> r = y + z. f y * g z) \<noteq> 0"
         by (auto simp: supp_def)
       hence "{(y, z). y \<in> supp f \<and> z \<in> supp g \<and> r = y + z} \<noteq> {}"
         by (intro notI) simp_all
       then obtain y z where yz: "y \<in> supp f" "z \<in> supp g" "r = y + z"
         by auto
       have "snd (quotient_of r) = snd (quotient_of y) * snd (quotient_of z) div
               gcd (fst (quotient_of y) * snd (quotient_of z) +
                    fst (quotient_of z) * snd (quotient_of y))
                   (snd (quotient_of y) * snd (quotient_of z))"
         by (simp add: \<open>r = _\<close> rat_plus_code case_prod_unfold Let_def
                       Rat.normalize_def quotient_of_denom_pos')
       also have "\<dots> dvd snd (quotient_of y) * snd (quotient_of z)"
         by (metis dvd_def dvd_div_mult_self gcd_dvd2)
       also have "\<dots> dvd d1 * d2"
         using yz by (auto simp: d1_def d2_def intro!: mult_dvd_mono)
       finally show "snd (quotient_of r) dvd d1 * d2"
         by (simp add: d1_def d2_def)
     qed
     moreover have "d1 * d2 \<noteq> 0"
       using fg by (auto simp: d1_def d2_def is_fpxs_def)
     ultimately show "(LCM r\<in>supp ?h. snd (quotient_of r)) \<noteq> 0"
       by auto
   qed
 qed
 
 lemma fpxs_nth_mult:
   "fpxs_nth (f * g) r =
      (\<Sum>(y,z) | y \<in> fpxs_supp f \<and> z \<in> fpxs_supp g \<and> r = y + z. fpxs_nth f y * fpxs_nth g z)"
   by transfer simp
 
 lemma fpxs_compose_power_mult [simp]:
   "fpxs_compose_power (f * g) r = fpxs_compose_power f r * fpxs_compose_power g r"
 proof (transfer, rule ext, goal_cases)
   case (1 f g r x)
   show ?case
   proof (cases "r > 0")
     case True
     have "(\<Sum>x\<in>{(y, z). y \<in> supp f \<and> z \<in> supp g \<and> x / r = y + z}.
             case x of (y, z) \<Rightarrow> f y * g z) =
           (\<Sum>x\<in>{(y, z). y \<in> supp (\<lambda>x. f (x / r)) \<and> z \<in> supp (\<lambda>x. g (x / r)) \<and> x = y + z}.
             case x of (y, z) \<Rightarrow> f (y / r) * g (z / r))"
       by (rule sum.reindex_bij_witness[of _ "\<lambda>(x,y). (x/r,y/r)" "\<lambda>(x,y). (x*r,y*r)"])
          (use \<open>r > 0\<close> in \<open>auto simp: supp_def field_simps\<close>)
     thus ?thesis
       by (auto simp: fun_eq_iff)
   qed auto
 qed
 
 lemma fpxs_supp_of_fls: "fpxs_supp (fpxs_of_fls f) = of_int ` supp (fls_nth f)"
   by (force simp: fpxs_supp_def fpxs_nth_of_fls supp_def elim!: Ints_cases)
 
 lemma fpxs_of_fls_mult [simp]: "fpxs_of_fls (f * g) = fpxs_of_fls f * fpxs_of_fls g"
 proof (rule fpxs_ext)
   fix r :: rat
   show "fpxs_nth (fpxs_of_fls (f * g)) r = fpxs_nth (fpxs_of_fls f * fpxs_of_fls g) r"
   proof (cases "r \<in> \<int>")
     case True
     define h1 where "h1 = (\<lambda>(x, y). (\<lfloor>x::rat\<rfloor>, \<lfloor>y::rat\<rfloor>))"
     define h2 where "h2 = (\<lambda>(x, y). (of_int x :: rat, of_int y :: rat))"
     define df dg where [simp]: "df = fls_subdegree f" "dg = fls_subdegree g"
     from True obtain n where [simp]: "r = of_int n"
       by (cases rule: Ints_cases)
     have "fpxs_nth (fpxs_of_fls f * fpxs_of_fls g) r =
             (\<Sum>(y,z) | y \<in> fpxs_supp (fpxs_of_fls f) \<and> z \<in> fpxs_supp (fpxs_of_fls g) \<and> rat_of_int n = y + z.
               (if y \<in> \<int> then fls_nth f \<lfloor>y\<rfloor> else 0) * (if z \<in> \<int> then fls_nth g \<lfloor>z\<rfloor> else 0))"
       by (auto simp: fpxs_nth_mult fpxs_nth_of_fls)
     also have "\<dots> = (\<Sum>(y,z) | y \<in> supp (fls_nth f) \<and> z \<in> supp (fls_nth g) \<and> n = y + z.
                       fls_nth f y * fls_nth g z)"
       by (rule sum.reindex_bij_witness[of _ h2 h1]) (auto simp: h1_def h2_def fpxs_supp_of_fls)
     also have "\<dots> = (\<Sum>y | y - fls_subdegree g \<in> supp (fls_nth f) \<and> fls_subdegree g + n - y \<in> supp (fls_nth g).
                       fls_nth f (y - fls_subdegree g) * fls_nth g (fls_subdegree g + n - y))"
       by (rule sum.reindex_bij_witness[of _ "\<lambda>y. (y - fls_subdegree g, fls_subdegree g + n - y)" "\<lambda>z. fst z + fls_subdegree g"])
          auto
     also have "\<dots> = (\<Sum>i = fls_subdegree f + fls_subdegree g..n.
               fls_nth f (i - fls_subdegree g) * fls_nth g (fls_subdegree g + n - i))"
       using fls_subdegree_leI[of f] fls_subdegree_leI [of g]
       by (intro sum.mono_neutral_left; force simp: supp_def)
     also have "\<dots> = fpxs_nth (fpxs_of_fls (f * g)) r"
       by (auto simp: fls_times_nth fpxs_nth_of_fls)
     finally show ?thesis ..
   next
     case False
     have "fpxs_nth (fpxs_of_fls f * fpxs_of_fls g) r =
             (\<Sum>(y,z) | y \<in> fpxs_supp (fpxs_of_fls f) \<and> z \<in> fpxs_supp (fpxs_of_fls g) \<and> r = y + z.
               (if y \<in> \<int> then fls_nth f \<lfloor>y\<rfloor> else 0) * (if z \<in> \<int> then fls_nth g \<lfloor>z\<rfloor> else 0))"
       by (simp add: fpxs_nth_mult fpxs_nth_of_fls)
     also have "\<dots> = 0"
       using False by (intro sum.neutral ballI) auto
     also have "0 = fpxs_nth (fpxs_of_fls (f * g)) r"
       using False by (simp add: fpxs_nth_of_fls)
     finally show ?thesis ..
   qed
 qed
 
 instance proof
   show "0 \<noteq> (1 :: 'a fpxs)"
     by transfer (auto simp: fun_eq_iff)
 next
   fix f :: "'a fpxs"
   show "1 * f = f"
   proof (transfer, goal_cases)
     case (1 f)
     have "{(y, z). y \<in> supp (\<lambda>r. if r = 0 then (1::'a) else 0) \<and> z \<in> supp f \<and> x = y + z} =
             (if x \<in> supp f then {(0, x)} else {})" for x
       by (auto simp: supp_def split: if_splits)
     thus ?case
       by (auto simp: fun_eq_iff supp_def)
   qed
 next
   fix f :: "'a fpxs"
   show "0 * f = 0"
     by transfer (auto simp: fun_eq_iff supp_def)
   show "f * 0 = 0"
     by transfer (auto simp: fun_eq_iff supp_def)
 next
   fix f g :: "'a fpxs"
   show "f * g = g * f"
   proof (transfer, rule ext, goal_cases)
     case (1 f g x)
     show "(\<Sum>(y, z)\<in>{(y, z). y \<in> supp f \<and> z \<in> supp g \<and> x = y + z}. f y * g z) =
           (\<Sum>(y, z)\<in>{(y, z). y \<in> supp g \<and> z \<in> supp f \<and> x = y + z}. g y * f z)"
       by (rule sum.reindex_bij_witness[of _ "\<lambda>(x,y). (y,x)" "\<lambda>(x,y). (y,x)"])
          (auto simp: mult_ac)
   qed    
 next
   fix f g h :: "'a fpxs"
   define d where "d = (LCM F\<in>{f,g,h}. fpxs_root_order F)"
   have "d > 0"
     by (auto simp: d_def intro!: Nat.gr0I)
   obtain f' where f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
     using fpxs_as_fls'[of f d] \<open>d > 0\<close> by (auto simp: d_def)
   obtain g' where g: "g = fpxs_compose_power (fpxs_of_fls g') (1 / of_nat d)"
     using fpxs_as_fls'[of g d] \<open>d > 0\<close> by (auto simp: d_def)
   obtain h' where h: "h = fpxs_compose_power (fpxs_of_fls h') (1 / of_nat d)"
     using fpxs_as_fls'[of h d] \<open>d > 0\<close> by (auto simp: d_def)
   show "(f * g) * h = f * (g * h)"
     by (simp add: f g h mult_ac
              flip: fpxs_compose_power_mult fpxs_compose_power_add fpxs_of_fls_mult)
   show "(f + g) * h = f * h + g * h"
     by (simp add: f g h ring_distribs
              flip: fpxs_compose_power_mult fpxs_compose_power_add fpxs_of_fls_mult fpxs_of_fls_add)
 qed
 
 end
 
 instance fpxs :: (comm_ring_1) comm_ring_1
   by intro_classes auto
 
 instance fpxs :: ("{comm_semiring_1,semiring_no_zero_divisors}") semiring_no_zero_divisors
 proof
   fix f g :: "'a fpxs"
   assume fg: "f \<noteq> 0" "g \<noteq> 0"
   define d where "d = lcm (fpxs_root_order f) (fpxs_root_order g)"
   have "d > 0"
     by (auto simp: d_def intro!: lcm_pos_nat)
   obtain f' where f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
     using fpxs_as_fls'[of f d] \<open>d > 0\<close> by (auto simp: d_def)
   obtain g' where g: "g = fpxs_compose_power (fpxs_of_fls g') (1 / of_nat d)"
     using fpxs_as_fls'[of g d] \<open>d > 0\<close> by (auto simp: d_def)
   show "f * g \<noteq> 0"
     using \<open>d > 0\<close> fg
     by (simp add: f g flip: fpxs_compose_power_mult fpxs_of_fls_mult)
 qed
 
 lemma fpxs_of_fls_power [simp]: "fpxs_of_fls (f ^ n) = fpxs_of_fls f ^ n"
   by (induction n) auto
 
 lemma fpxs_compose_power_power [simp]:
   "r > 0 \<Longrightarrow> fpxs_compose_power (f ^ n) r = fpxs_compose_power f r ^ n"
   by (induction n) simp_all
 
 
 subsection \<open>Constant Puiseux series and the series \<open>X\<close>\<close>
 
 lift_definition fpxs_const :: "'a :: zero \<Rightarrow> 'a fpxs" is
   "\<lambda>c n. if n = 0 then c else 0"
 proof -
   fix c :: 'a
   have "supp (\<lambda>n::rat. if n = 0 then c else 0) = (if c = 0 then {} else {0})"
     by auto
   thus "is_fpxs (\<lambda>n::rat. if n = 0 then c else 0)"
     unfolding is_fpxs_def by auto
 qed
 
 lemma fpxs_const_0 [simp]: "fpxs_const 0 = 0"
   by transfer auto
 
 lemma fpxs_const_1 [simp]: "fpxs_const 1 = 1"
   by transfer auto
 
 lemma fpxs_of_fls_const [simp]: "fpxs_of_fls (fls_const c) = fpxs_const c"
   by transfer (auto simp: fun_eq_iff Ints_def)
 
 lemma fls_of_fpxs_const [simp]: "fls_of_fpxs (fpxs_const c) = fls_const c"
   by (metis fls_of_fpxs_of_fls fpxs_of_fls_const)
 
 lemma fls_of_fpxs_1 [simp]: "fls_of_fpxs 1 = 1"
   using fls_of_fpxs_const[of 1] by (simp del: fls_of_fpxs_const)
   
 lift_definition fpxs_X :: "'a :: {one, zero} fpxs" is
   "\<lambda>x. if x = 1 then (1::'a) else 0"
   by (cases "1 = (0 :: 'a)") (auto simp: is_fpxs_def cong: if_cong)
 
 lemma fpxs_const_altdef: "fpxs_const x = fpxs_of_fls (fls_const x)"
   by transfer auto
 
 lemma fpxs_const_add [simp]: "fpxs_const (x + y) = fpxs_const x + fpxs_const y"
   by transfer auto
 
 lemma fpxs_const_mult [simp]:
   fixes x y :: "'a::{comm_semiring_1}"
   shows "fpxs_const (x * y) = fpxs_const x * fpxs_const y"
   unfolding fpxs_const_altdef fls_const_mult_const[symmetric] fpxs_of_fls_mult ..
 
 lemma fpxs_const_eq_iff [simp]:
   "fpxs_const x = fpxs_const y \<longleftrightarrow> x = y"
   by transfer (auto simp: fun_eq_iff)
 
 lemma of_nat_fpxs_eq: "of_nat n = fpxs_const (of_nat n)"
   by (induction n) auto
 
 lemma fpxs_const_uminus [simp]: "fpxs_const (-x) = -fpxs_const x"
   by transfer auto
 
 lemma fpxs_const_diff [simp]: "fpxs_const (x - y) = fpxs_const x - fpxs_const y"
   unfolding minus_fpxs_def by transfer auto
 
 lemma of_int_fpxs_eq: "of_int n = fpxs_const (of_int n)"
   by (induction n) (auto simp: of_nat_fpxs_eq)
 
 
 subsection \<open>More algebraic typeclass instances\<close>
 
 instance fpxs :: ("{comm_semiring_1,semiring_char_0}") semiring_char_0
 proof
   show "inj (of_nat :: nat \<Rightarrow> 'a fpxs)"
     by (intro injI) (auto simp: of_nat_fpxs_eq)
 qed
 
 instance fpxs :: ("{comm_ring_1,ring_char_0}") ring_char_0 ..
 
 instance fpxs :: (idom) idom ..
 
 instantiation fpxs :: (field) field
 begin
 
 definition inverse_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs" where
   "inverse_fpxs f =
      fpxs_compose_power (fpxs_of_fls (inverse (fls_of_fpxs f))) (1 / of_nat (fpxs_root_order f))"
 
 definition divide_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" where
   "divide_fpxs f g = f * inverse g"
 
 instance proof
   fix f :: "'a fpxs"
   assume "f \<noteq> 0"
   define f' where "f' = fls_of_fpxs f"
   define d where "d = fpxs_root_order f"
   have "d > 0" by (auto simp: d_def)
   have f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
     by (simp add: f'_def d_def fpxs_as_fls)
 
   have "inverse f * f = fpxs_compose_power (fpxs_of_fls (inverse f')) (1 / of_nat d) * f"
     by (simp add: inverse_fpxs_def f'_def d_def)
   also have "fpxs_compose_power (fpxs_of_fls (inverse f')) (1 / of_nat d) * f =
              fpxs_compose_power (fpxs_of_fls (inverse f' * f')) (1 / of_nat d)"
     by (simp add: f)
   also have "inverse f' * f' = 1"
     using \<open>f \<noteq> 0\<close> \<open>d > 0\<close> by (simp add: f field_simps)
   finally show "inverse f * f = 1"
     using \<open>d > 0\<close> by simp
 qed (auto simp: divide_fpxs_def inverse_fpxs_def)
 
 end
 
 instance fpxs :: (field_char_0) field_char_0 ..
 
 
 subsection \<open>Valuation\<close>
 
 definition fpxs_val :: "'a :: zero fpxs \<Rightarrow> rat" where
   "fpxs_val f =
      of_int (fls_subdegree (fls_of_fpxs f)) / rat_of_nat (fpxs_root_order f)"
 
 lemma fpxs_val_of_fls [simp]: "fpxs_val (fpxs_of_fls f) = of_int (fls_subdegree f)"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_nth_compose_power [simp]:
   assumes "r > 0"
   shows   "fpxs_nth (fpxs_compose_power f r) n = fpxs_nth f (n / r)"
   using assms by transfer auto
 
 lemma fls_of_fpxs_uminus [simp]: "fls_of_fpxs (-f) = -fls_of_fpxs f"
   by transfer auto
 
 lemma fpxs_root_order_uminus [simp]: "fpxs_root_order (-f) = fpxs_root_order f"
   by transfer auto
 
 lemma fpxs_val_uminus [simp]: "fpxs_val (-f) = fpxs_val f"
   unfolding fpxs_val_def by simp
 
 lemma fpxs_val_minus_commute: "fpxs_val (f - g) = fpxs_val (g - f)"
   by (subst fpxs_val_uminus [symmetric]) (simp del: fpxs_val_uminus)
 
 lemma fpxs_val_const [simp]: "fpxs_val (fpxs_const c) = 0"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_val_1 [simp]: "fpxs_val 1 = 0"
   by (simp add: fpxs_val_def)
 
 lemma of_int_fls_subdegree_of_fpxs:
   "rat_of_int (fls_subdegree (fls_of_fpxs f)) = fpxs_val f * of_nat (fpxs_root_order f)"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_nth_val_nonzero: 
   assumes "f \<noteq> 0"
   shows   "fpxs_nth f (fpxs_val f) \<noteq> 0"
 proof -
   define N where "N = fpxs_root_order f"
   define f' where "f' = fls_of_fpxs f"
   define M where "M = fls_subdegree f'"
   have val: "fpxs_val f = of_int M / of_nat N"
     by (simp add: M_def fpxs_val_def N_def f'_def)
   have *: "f = fpxs_compose_power (fpxs_of_fls f') (1 / rat_of_nat N)"
     by (simp add: fpxs_as_fls N_def f'_def)
   also have "fpxs_nth \<dots> (fpxs_val f) =
              fpxs_nth (fpxs_of_fls f') (fpxs_val f * rat_of_nat (fpxs_root_order f))"
     by (subst fpxs_nth_compose_power) (auto simp: N_def)
   also have "\<dots> = fls_nth f' M"
     by (subst fpxs_nth_of_fls) (auto simp: val N_def)
   also have "f' \<noteq> 0"
     using * assms by auto
   hence "fls_nth f' M \<noteq> 0"
     unfolding M_def by simp
   finally show "fpxs_nth f (fpxs_val f) \<noteq> 0" .
 qed
 
 lemma fpxs_nth_below_val:
   assumes n: "n < fpxs_val f"
   shows   "fpxs_nth f n = 0"
 proof (cases "f = 0")
   case False
   define N where "N = fpxs_root_order f"
   define f' where "f' = fls_of_fpxs f"
   define M where "M = fls_subdegree f'"
   have val: "fpxs_val f = of_int M / of_nat N"
     by (simp add: M_def fpxs_val_def N_def f'_def)
   have *: "f = fpxs_compose_power (fpxs_of_fls f') (1 / rat_of_nat N)"
     by (simp add: fpxs_as_fls N_def f'_def)
   have "fpxs_nth f n = fpxs_nth (fpxs_of_fls f') (n * rat_of_nat N)"
     by (subst *, subst fpxs_nth_compose_power) (auto simp: N_def)
   also have "\<dots> = 0"
   proof (cases "rat_of_nat N * n \<in> \<int>")
     case True
     then obtain n' where n': "of_int n' = rat_of_nat N * n"
       by (elim Ints_cases) auto
     have "of_int n' < rat_of_nat N * fpxs_val f"
       unfolding n' using n by (intro mult_strict_left_mono) (auto simp: N_def)
     also have "\<dots> = of_int M"
       by (simp add: val N_def)
     finally have "n' < M" by linarith
     
     have "fpxs_nth (fpxs_of_fls f') (rat_of_nat N * n) = fls_nth f' n'"
       unfolding n'[symmetric] by (subst fpxs_nth_of_fls) (auto simp: N_def)
     also from \<open>n' < M\<close> have "\<dots> = 0"
       unfolding M_def by simp
     finally show ?thesis by (simp add: mult_ac)
   qed (auto simp: fpxs_nth_of_fls mult_ac)
   finally show "fpxs_nth f n = 0" .
 qed auto
 
 lemma fpxs_val_leI: "fpxs_nth f r \<noteq> 0 \<Longrightarrow> fpxs_val f \<le> r"
   using fpxs_nth_below_val[of r f]
   by (cases "f = 0"; cases "fpxs_val f" r rule: linorder_cases) auto
 
 lemma fpxs_val_0 [simp]: "fpxs_val 0 = 0"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_val_geI: 
   assumes "f \<noteq> 0" "\<And>r. r < r' \<Longrightarrow> fpxs_nth f r = 0"
   shows   "fpxs_val f \<ge> r'"
   using fpxs_nth_val_nonzero[of f] assms by force  
 
 lemma fpxs_val_compose_power [simp]:
   assumes "r > 0"
   shows   "fpxs_val (fpxs_compose_power f r) = fpxs_val f * r"
 proof (cases "f = 0")
   case [simp]: False
   show ?thesis
   proof (intro antisym)
     show "fpxs_val (fpxs_compose_power f r) \<le> fpxs_val f * r"
       using assms by (intro fpxs_val_leI) (simp add: fpxs_nth_val_nonzero)
   next
     show "fpxs_val f * r \<le> fpxs_val (fpxs_compose_power f r)"
     proof (intro fpxs_val_geI)
       show "fpxs_nth (fpxs_compose_power f r) r' = 0" if "r' < fpxs_val f * r" for r'
         unfolding fpxs_nth_compose_power[OF assms]
         by (rule fpxs_nth_below_val) (use that assms in \<open>auto simp: field_simps\<close>)
     qed (use assms in auto)
   qed
 qed auto
 
 lemma fpxs_val_add_ge:
   assumes "f + g \<noteq> 0"
   shows   "fpxs_val (f + g) \<ge> min (fpxs_val f) (fpxs_val g)"
 proof (rule ccontr)
   assume "\<not>(fpxs_val (f + g) \<ge> min (fpxs_val f) (fpxs_val g))" (is "\<not>(?n \<ge> _)")
   hence "?n < fpxs_val f" "?n < fpxs_val g"
     by auto
   hence "fpxs_nth f ?n = 0" "fpxs_nth g ?n = 0"
     by (intro fpxs_nth_below_val; simp; fail)+
   hence "fpxs_nth (f + g) ?n = 0"
     by simp
   moreover have "fpxs_nth (f + g) ?n \<noteq> 0"
     by (intro fpxs_nth_val_nonzero assms)
   ultimately show False by contradiction
 qed
 
 lemma fpxs_val_diff_ge:
   assumes "f \<noteq> g"
   shows   "fpxs_val (f - g) \<ge> min (fpxs_val f) (fpxs_val g)"
   using fpxs_val_add_ge[of f "-g"] assms by simp  
 
 lemma fpxs_nth_mult_val:
   "fpxs_nth (f * g) (fpxs_val f + fpxs_val g) = fpxs_nth f (fpxs_val f) * fpxs_nth g (fpxs_val g)"
 proof (cases "f = 0 \<or> g = 0")
   case False
   have "{(y, z). y \<in> fpxs_supp f \<and> z \<in> fpxs_supp g \<and> fpxs_val f + fpxs_val g = y + z} \<subseteq>
         {(fpxs_val f, fpxs_val g)}"
     using False fpxs_val_leI[of f] fpxs_val_leI[of g] by (force simp: fpxs_supp_def supp_def)
   hence "fpxs_nth (f * g) (fpxs_val f + fpxs_val g) = 
         (\<Sum>(y, z)\<in>{(fpxs_val f, fpxs_val g)}. fpxs_nth f y * fpxs_nth g z)"
     unfolding fpxs_nth_mult
     by (intro sum.mono_neutral_left) (auto simp: fpxs_supp_def supp_def)
   thus ?thesis by simp
 qed auto
 
 lemma fpxs_val_mult [simp]:
   fixes f g :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} fpxs"
   assumes "f \<noteq> 0" "g \<noteq> 0"
   shows "fpxs_val (f * g) = fpxs_val f + fpxs_val g"
 proof (intro antisym fpxs_val_leI fpxs_val_geI)
   fix r :: rat
   assume r: "r < fpxs_val f + fpxs_val g"
   show "fpxs_nth (f * g) r = 0"
     unfolding fpxs_nth_mult using assms fpxs_val_leI[of f] fpxs_val_leI[of g] r
     by (intro sum.neutral; force)
 qed (use assms in \<open>auto simp: fpxs_nth_mult_val fpxs_nth_val_nonzero\<close>)
 
 lemma fpxs_val_power [simp]:
   fixes f :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} fpxs"
   assumes "f \<noteq> 0 \<or> n > 0"
   shows "fpxs_val (f ^ n) = of_nat n * fpxs_val f"
 proof (cases "f = 0")
   case False
   have [simp]: "f ^ n \<noteq> 0" for n
     using False by (induction n) auto
   thus ?thesis using False
     by (induction n) (auto simp: algebra_simps)
 qed (use assms in \<open>auto simp: power_0_left\<close>)
 
 lemma fpxs_nth_power_val [simp]:
   fixes f :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} fpxs"
   shows "fpxs_nth (f ^ r) (rat_of_nat r * fpxs_val f) = fpxs_nth f (fpxs_val f) ^ r"
 proof (cases "f \<noteq> 0")
   case True
   show ?thesis
   proof (induction r)
     case (Suc r)
     have "fpxs_nth (f ^ Suc r) (rat_of_nat (Suc r) * fpxs_val f) =
           fpxs_nth (f * f ^ r) (fpxs_val f + fpxs_val (f ^ r))"
       using True by (simp add: fpxs_nth_mult_val ring_distribs)
     also have "\<dots> = fpxs_nth f (fpxs_val f) ^ Suc r"
       using Suc True by (subst fpxs_nth_mult_val) auto
     finally show ?case .
   qed (auto simp: fpxs_nth_1')
 next
   case False
   thus ?thesis
     by (cases r) (auto simp: fpxs_nth_1')
 qed
 
 
 subsection \<open>Powers of \<open>X\<close> and shifting\<close>
 
 lift_definition fpxs_X_power :: "rat \<Rightarrow> 'a :: {zero, one} fpxs" is
   "\<lambda>r n :: rat. if n = r then 1 else (0 :: 'a)"
 proof -
   fix r :: rat
   have "supp (\<lambda>n. if n = r then 1 else (0 :: 'a)) = (if (1 :: 'a) = 0 then {} else {r})"
     by (auto simp: supp_def)
   thus "is_fpxs (\<lambda>n. if n = r then 1 else (0 :: 'a))"
     using quotient_of_denom_pos'[of r] by (auto simp: is_fpxs_def)
 qed
 
 lemma fpxs_X_power_0 [simp]: "fpxs_X_power 0 = 1"
   by transfer auto
 
 lemma fpxs_X_power_add: "fpxs_X_power (a + b) = fpxs_X_power a * fpxs_X_power b"
 proof (transfer, goal_cases)
   case (1 a b)
   have *: "{(y,z). y \<in> supp (\<lambda>n. if n=a then (1::'a) else 0) \<and>
                z \<in> supp (\<lambda>n. if n=b then (1::'a) else 0) \<and> x=y+z} =
            (if x = a + b then {(a, b)} else {})" for x
     by (auto simp: supp_def fun_eq_iff)
   show ?case
     unfolding * by (auto simp: fun_eq_iff case_prod_unfold)
 qed
 
 lemma fpxs_X_power_mult: "fpxs_X_power (rat_of_nat n * m) = fpxs_X_power m ^ n"
   by (induction n) (auto simp: ring_distribs fpxs_X_power_add)
 
 lemma fpxs_of_fls_X_power [simp]: "fpxs_of_fls (fls_shift n 1) = fpxs_X_power (-rat_of_int n)"
   by transfer (auto simp: fun_eq_iff Ints_def simp flip: of_int_minus)
 
 lemma fpxs_X_power_neq_0 [simp]: "fpxs_X_power r \<noteq> (0 :: 'a :: zero_neq_one fpxs)"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fpxs_X_power_eq_1_iff [simp]: "fpxs_X_power r = (1 :: 'a :: zero_neq_one fpxs) \<longleftrightarrow> r = 0"
   by transfer (auto simp: fun_eq_iff)
 
 
 lift_definition fpxs_shift :: "rat \<Rightarrow> 'a :: zero fpxs \<Rightarrow> 'a fpxs" is
   "\<lambda>r f n. f (n + r)"
 proof -
   fix r :: rat and f :: "rat \<Rightarrow> 'a"
   assume f: "is_fpxs f"
   have subset: "supp (\<lambda>n. f (n + r)) \<subseteq> (\<lambda>n. n + r) -` supp f"
     by (auto simp: supp_def)
   have eq: "(\<lambda>n. n + r) -` supp f = (\<lambda>n. n - r) ` supp f"
     by (auto simp: image_iff algebra_simps)
 
   show "is_fpxs (\<lambda>n. f (n + r))"
     unfolding is_fpxs_def
   proof
     have "bdd_below ((\<lambda>n. n + r) -` supp f)"
       unfolding eq by (rule bdd_below_image_mono) (use f in \<open>auto simp: is_fpxs_def mono_def\<close>)
     thus "bdd_below (supp (\<lambda>n. f (n + r)))"
       by (rule bdd_below_mono[OF _ subset])
   next
     have "(LCM r\<in>supp (\<lambda>n. f (n + r)). snd (quotient_of r)) dvd
           (LCM r\<in>(\<lambda>n. n + r) -` supp f. snd (quotient_of r))"
       by (intro Lcm_subset image_mono subset)
     also have "\<dots> = (LCM x\<in>supp f. snd (quotient_of (x - r)))"
       by (simp only: eq image_image o_def)
     also have "\<dots> dvd (LCM x\<in>supp f. snd (quotient_of r) * snd (quotient_of x))"
       by (subst mult.commute, intro Lcm_mono quotient_of_denom_diff_dvd)
     also have "\<dots> = Lcm ((\<lambda>x. snd (quotient_of r) * x) ` (\<lambda>x. snd (quotient_of x)) ` supp f)"
       by (simp add: image_image o_def)
     also have "\<dots> dvd normalize (snd (quotient_of r) * (LCM x\<in>supp f. snd (quotient_of x)))"
     proof (cases "supp f = {}")
       case False
       thus ?thesis by (subst Lcm_mult) auto
     qed auto
     finally show "(LCM r\<in>supp (\<lambda>n. f (n + r)). snd (quotient_of r)) \<noteq> 0"
       using quotient_of_denom_pos'[of r] f by (auto simp: is_fpxs_def)
   qed
 qed
 
 lemma fpxs_nth_shift [simp]: "fpxs_nth (fpxs_shift r f) n = fpxs_nth f (n + r)"
   by transfer simp_all
 
 lemma fpxs_shift_0_left [simp]: "fpxs_shift 0 f = f"
   by transfer auto
 
 lemma fpxs_shift_add_left: "fpxs_shift (m + n) f = fpxs_shift m (fpxs_shift n f)"
   by transfer (simp_all add: add_ac)
 
 lemma fpxs_shift_diff_left: "fpxs_shift (m - n) f = fpxs_shift m (fpxs_shift (-n) f)"
   by (subst fpxs_shift_add_left [symmetric]) auto
 
 lemma fpxs_shift_0 [simp]: "fpxs_shift r 0 = 0"
   by transfer simp_all
 
 lemma fpxs_shift_add [simp]: "fpxs_shift r (f + g) = fpxs_shift r f + fpxs_shift r g"
   by transfer auto
 
 lemma fpxs_shift_uminus [simp]: "fpxs_shift r (-f) = -fpxs_shift r f"
   by transfer auto
 
 lemma fpxs_shift_shift_uminus [simp]: "fpxs_shift r (fpxs_shift (-r) f) = f"
   by (simp flip: fpxs_shift_add_left)
 
 lemma fpxs_shift_shift_uminus' [simp]: "fpxs_shift (-r) (fpxs_shift r f) = f"
   by (simp flip: fpxs_shift_add_left)
 
 lemma fpxs_shift_diff [simp]: "fpxs_shift r (f - g) = fpxs_shift r f - fpxs_shift r g"
   unfolding minus_fpxs_def by (subst fpxs_shift_add) auto
 
 lemma fpxs_shift_compose_power [simp]:
   "fpxs_shift r (fpxs_compose_power f s) = fpxs_compose_power (fpxs_shift (r / s) f) s"
   by transfer (simp_all add: add_divide_distrib add_ac cong: if_cong)
 
 lemma rat_of_int_div_dvd: "d dvd n \<Longrightarrow> rat_of_int (n div d) = rat_of_int n / rat_of_int d"
   by auto
 
 lemma fpxs_of_fls_shift [simp]:
   "fpxs_of_fls (fls_shift n f) = fpxs_shift (of_int n) (fpxs_of_fls f)"
 proof (transfer, goal_cases)
   case (1 n f)
   show ?case
   proof
     fix r :: rat
     have eq: "r + rat_of_int n \<in> \<int> \<longleftrightarrow> r \<in> \<int>"
       by (metis Ints_add Ints_diff Ints_of_int add_diff_cancel_right')
     show "(if r \<in> \<int> then f (\<lfloor>r\<rfloor> + n) else 0) =
           (if r + rat_of_int n \<in> \<int> then f \<lfloor>r + rat_of_int n\<rfloor> else 0)"
       unfolding eq by auto
   qed
 qed
 
 lemma fpxs_shift_mult: "f * fpxs_shift r g = fpxs_shift r (f * g)"
                        "fpxs_shift r f * g = fpxs_shift r (f * g)"
 proof -
   obtain a b where ab: "r = of_int a / of_nat b" and "b > 0"
     by (metis Fract_of_int_quotient of_int_of_nat_eq quotient_of_unique zero_less_imp_eq_int)
 
   define s where "s = lcm b (lcm (fpxs_root_order f) (fpxs_root_order g))"
   have "s > 0" using \<open>b > 0\<close>
     by (auto simp: s_def intro!: Nat.gr0I)
   obtain f' where f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / rat_of_nat s)"
     using fpxs_as_fls'[of f s] \<open>s > 0\<close> by (auto simp: s_def)
   obtain g' where g: "g = fpxs_compose_power (fpxs_of_fls g') (1 / rat_of_nat s)"
     using fpxs_as_fls'[of g s] \<open>s > 0\<close> by (auto simp: s_def)
 
   define n where "n = (a * s) div b"
   have "b dvd s"
     by (auto simp: s_def)
   have sr_eq: "r * rat_of_nat s = rat_of_int n"
     using \<open>b > 0\<close> \<open>b dvd s\<close>
     by (simp add: ab field_simps of_rat_divide of_rat_mult n_def rat_of_int_div_dvd)
 
   show "f * fpxs_shift r g = fpxs_shift r (f * g)" "fpxs_shift r f * g = fpxs_shift r (f * g)"
     unfolding f g using \<open>s > 0\<close>
     by (simp_all flip: fpxs_compose_power_mult fpxs_of_fls_mult fpxs_of_fls_shift
                  add: sr_eq fls_shifted_times_simps mult_ac)
 qed
 
 lemma fpxs_shift_1: "fpxs_shift r 1 = fpxs_X_power (-r)"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fpxs_X_power_conv_shift: "fpxs_X_power r = fpxs_shift (-r) 1"
   by (simp add: fpxs_shift_1)
 
 lemma fpxs_shift_power [simp]: "fpxs_shift n x ^ m = fpxs_shift (of_nat m * n) (x ^ m)"
   by (induction m) (simp_all add: algebra_simps fpxs_shift_mult flip: fpxs_shift_add_left)
 
 lemma fpxs_compose_power_X_power [simp]:
   "s > 0 \<Longrightarrow> fpxs_compose_power (fpxs_X_power r) s = fpxs_X_power (r * s)"
   by transfer (simp add: field_simps)
 
 
 subsection \<open>The \<open>n\<close>-th root of a Puiseux series\<close>
 
 text \<open>
   In this section, we define the formal root of a Puiseux series. This is done using the
   same concept for formal power series. There is still one interesting theorems that is missing
   here, e.g.\ the uniqueness (which could probably be lifted over from FPSs) somehow.
 \<close>
 
 definition fpxs_radical :: "(nat \<Rightarrow> 'a :: field_char_0 \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" where
   "fpxs_radical rt r f = (if f = 0 then 0 else
      (let f' = fls_base_factor_to_fps (fls_of_fpxs f);
           f'' = fpxs_of_fls (fps_to_fls (fps_radical rt r f'))
       in  fpxs_shift (-fpxs_val f / rat_of_nat r)
             (fpxs_compose_power f'' (1 / rat_of_nat (fpxs_root_order f)))))"
 
 lemma fpxs_radical_0 [simp]: "fpxs_radical rt r 0 = 0"
   by (simp add: fpxs_radical_def)
 
 lemma 
   fixes r :: nat
   assumes r: "r > 0"
   shows fpxs_power_radical:
         "rt r (fpxs_nth f (fpxs_val f)) ^ r = fpxs_nth f (fpxs_val f) \<Longrightarrow> fpxs_radical rt r f ^ r = f"
     and fpxs_radical_lead_coeff:
           "f \<noteq> 0 \<Longrightarrow> fpxs_nth (fpxs_radical rt r f) (fpxs_val f / rat_of_nat r) =
                        rt r (fpxs_nth f (fpxs_val f))"
 proof -
   define q where "q = fpxs_root_order f"
   define f' where "f' = fls_base_factor_to_fps (fls_of_fpxs f)"
   have [simp]: "fps_nth f' 0 = fpxs_nth f (fpxs_val f)"
     by (simp add: f'_def fls_nth_of_fpxs of_int_fls_subdegree_of_fpxs)
   define f'' where "f'' = fpxs_of_fls (fps_to_fls (fps_radical rt r f'))"
   have eq1: "fls_of_fpxs f = fls_shift (-fls_subdegree (fls_of_fpxs f)) (fps_to_fls f')"
     by (subst fls_conv_base_factor_to_fps_shift_subdegree) (simp add: f'_def)
   have eq2: "fpxs_compose_power (fpxs_of_fls (fls_of_fpxs f)) (1 / of_nat q) = f"
     unfolding q_def by (rule fpxs_as_fls)
   also note eq1
   also have "fpxs_of_fls (fls_shift (- fls_subdegree (fls_of_fpxs f)) (fps_to_fls f')) =
              fpxs_shift (- (fpxs_val f * rat_of_nat q)) (fpxs_of_fls (fps_to_fls f'))"
     by (simp add: of_int_fls_subdegree_of_fpxs q_def)
   finally have eq3: "fpxs_compose_power (fpxs_shift (- (fpxs_val f * rat_of_nat q))
                        (fpxs_of_fls (fps_to_fls f'))) (1 / rat_of_nat q) = f" .
 
   {
     assume rt: "rt r (fpxs_nth f (fpxs_val f)) ^ r = fpxs_nth f (fpxs_val f)"
     show "fpxs_radical rt r f ^ r = f"
     proof (cases "f = 0")
       case [simp]: False
       have "f'' ^ r = fpxs_of_fls (fps_to_fls (fps_radical rt r f' ^ r))"
         by (simp add: fps_to_fls_power f''_def)
       also have "fps_radical rt r f' ^ r = f'"
         using power_radical[of f' rt "r - 1"] r rt by (simp add: fpxs_nth_val_nonzero)
       finally have "f'' ^ r = fpxs_of_fls (fps_to_fls f')" .
   
       have "fpxs_shift (-fpxs_val f / rat_of_nat r) (fpxs_compose_power f'' (1 / of_nat q)) ^ r =
               fpxs_shift (-fpxs_val f) (fpxs_compose_power (f'' ^ r) (1 / of_nat q))"
         unfolding q_def using r
         by (subst fpxs_shift_power, subst fpxs_compose_power_power [symmetric]) simp_all
       also have "f'' ^ r = fpxs_of_fls (fps_to_fls f')"
         by fact
       also have "fpxs_shift (-fpxs_val f) (fpxs_compose_power
                    (fpxs_of_fls (fps_to_fls f')) (1 / of_nat q)) = f"
         using r eq3 by simp
       finally show "fpxs_radical rt r f ^ r = f"
         by (simp add: fpxs_radical_def f'_def f''_def q_def)
     qed (use r in auto)
   }
 
   assume [simp]: "f \<noteq> 0"
   have "fpxs_nth (fpxs_shift (-fpxs_val f / of_nat r) (fpxs_compose_power f'' (1 / of_nat q)))
           (fpxs_val f / of_nat r) = fpxs_nth f'' 0"
     using r by (simp add: q_def)
   also have "fpxs_shift (-fpxs_val f / of_nat r) (fpxs_compose_power f'' (1 / of_nat q)) =
                fpxs_radical rt r f"
     by (simp add: fpxs_radical_def q_def f'_def f''_def)
   also have "fpxs_nth f'' 0 = rt r (fpxs_nth f (fpxs_val f))"
     using r by (simp add: f''_def fpxs_nth_of_fls)
   finally show "fpxs_nth (fpxs_radical rt r f) (fpxs_val f / rat_of_nat r) =
                   rt r (fpxs_nth f (fpxs_val f))" .
 qed
 
 lemma fls_base_factor_power:
   fixes f :: "'a::{semiring_1, semiring_no_zero_divisors} fls"
   shows "fls_base_factor (f ^ n) = fls_base_factor f ^ n"
 proof (cases "f = 0")
   case False
   have [simp]: "f ^ n \<noteq> 0" for n
     by (induction n) (use False in auto)
   show ?thesis using False
     by (induction n) (auto simp: fls_base_factor_mult simp flip: fls_times_both_shifted_simp)
 qed (cases n; simp)
 
 (* TODO: Uniqueness of radical. Also: composition and composition inverse *)
 
 hide_const (open) supp
 
 
 subsection \<open>Algebraic closedness\<close>
 
 text \<open>
   We will now show that the field of formal Puiseux series over an algebraically closed field of
   characteristic 0 is again algebraically closed.
 
   The typeclass constraint \<^class>\<open>field_gcd\<close> is a technical constraint that mandates that
   the field has a (trivial) GCD operation defined on it. It comes from some peculiarities of
   Isabelle's typeclass system and can be considered unimportant, since any concrete type of
   class \<^class>\<open>field\<close> can easily be made an instance of \<^class>\<open>field_gcd\<close>.
 
   It would be possible to get rid of this constraint entirely here, but it is not worth
   the effort.
 
   The proof is a fairly standard one that uses Hensel's lemma. Some preliminary tricks are
   required to be able to use it, however, namely a number of non-obvious changes of variables
   to turn the polynomial with Puiseux coefficients into one with formal power series coefficients.
   The overall approach was taken from an article by Nowak~\<^cite>\<open>"nowak2000"\<close>.
 
   Basically, what we need to show is this: Let 
   \[p(X,Z) = a_n(Z) X^n + a_{n-1}(Z) X^{n-1} + \ldots + a_0(Z)\]
   be a polynomial in \<open>X\<close> of degree at least 2
   with coefficients that are formal Puiseux series in \<open>Z\<close>. Then \<open>p\<close> is reducible, i.e. it splits
   into two non-constant factors.
 
   Due to work we have already done elsewhere, we may assume here that $a_n = 1$, $a_{n-1} = 0$, and
   $a_0 \neq 0$, all of which will come in very useful.
 \<close>
 
 instance fpxs :: ("{alg_closed_field, field_char_0, field_gcd}") alg_closed_field
 proof (rule alg_closedI_reducible_coeff_deg_minus_one_eq_0)
   fix p :: "'a fpxs poly"
   assume deg_p: "degree p > 1"  and lc_p: "lead_coeff p = 1"
   assume coeff_deg_minus_1: "coeff p (degree p - 1) = 0"
   assume "coeff p 0 \<noteq> 0"
   define N where "N = degree p"
 
   text \<open>
     Let $a_0, \ldots, a_n$ be the coefficients of \<open>p\<close> with $a_n = 1$. Now let \<open>r\<close> be the maximum of
     $-\frac{\text{val}(a_i)}{n-i}$ ranging over all $i < n$ such that $a_i \neq 0$.
   \<close>
   define r :: rat
     where "r = (MAX i\<in>{i\<in>{..<N}. coeff p i \<noteq> 0}.
                   -fpxs_val (poly.coeff p i) / (rat_of_nat N - rat_of_nat i))"
 
   text \<open>
     We write $r = a / b$ such that all the $a_i$ can be written as Laurent series in
     $X^{1/b}$, i.e. the root orders of all the $a_i$ divide $b$:
   \<close>
   obtain a b where ab: "b > 0" "r = of_int a / of_nat b" "\<forall>i\<le>N. fpxs_root_order (coeff p i) dvd b"
   proof -
     define b where "b = lcm (nat (snd (quotient_of r))) (LCM i\<in>{..N}. fpxs_root_order (coeff p i))"
     define x where "x = b div nat (snd (quotient_of r))"
     define a where "a = fst (quotient_of r) * int x"
 
     show ?thesis
     proof (rule that)
       show "b > 0"
         using quotient_of_denom_pos'[of r] by (auto simp: b_def intro!: Nat.gr0I)
       have b_eq: "b = nat (snd (quotient_of r)) * x"
         by (simp add: x_def b_def)
       have "x > 0"
         using b_eq \<open>b > 0\<close> by (auto intro!: Nat.gr0I)
       have "r = rat_of_int (fst (quotient_of r)) / rat_of_int (int (nat (snd (quotient_of r))))"
         using quotient_of_denom_pos'[of r] quotient_of_div[of r] by simp
       also have "\<dots> = rat_of_int a / rat_of_nat b"
         using \<open>x > 0\<close> by (simp add: a_def b_eq)
       finally show "r = rat_of_int a / rat_of_nat b" .
       show "\<forall>i\<le>N. fpxs_root_order (poly.coeff p i) dvd b"
         by (auto simp: b_def)
     qed
   qed
 
   text \<open>
     We write all the coefficients of \<open>p\<close> as Laurent series in $X^{1/b}$:
   \<close>
   have "\<exists>c. coeff p i = fpxs_compose_power (fpxs_of_fls c) (1 / rat_of_nat b)" if i: "i \<le> N" for i
   proof -
     have "fpxs_root_order (coeff p i) dvd b"
       using ab(3) i by auto
     from fpxs_as_fls'[OF this \<open>b > 0\<close>] show ?thesis by metis
   qed
   then obtain c_aux where c_aux:
     "coeff p i = fpxs_compose_power (fpxs_of_fls (c_aux i)) (1 / rat_of_nat b)" if "i \<le> N" for i
     by metis
   define c where "c = (\<lambda>i. if i \<le> N then c_aux i else 0)"
   have c: "coeff p i = fpxs_compose_power (fpxs_of_fls (c i)) (1 / rat_of_nat b)" for i
     using c_aux[of i] by (auto simp: c_def N_def coeff_eq_0)
   have c_eq_0 [simp]: "c i = 0" if "i > N" for i
     using that by (auto simp: c_def)
   have c_eq: "fpxs_of_fls (c i) = fpxs_compose_power (coeff p i) (rat_of_nat b)" for i
     using c[of i] \<open>b > 0\<close> by (simp add: fpxs_compose_power_distrib)
 
   text \<open>
     We perform another change of variables and multiply with a suitable power of \<open>X\<close> to turn our
     Laurent coefficients into FPS coefficients:
   \<close>
   define c' where "c' = (\<lambda>i. fls_X_intpow ((int N - int i) * a) * c i)"
   have "c' N = 1"
     using c[of N] \<open>lead_coeff p = 1\<close> \<open>b > 0\<close> by (simp add: c'_def N_def)
 
   have subdegree_c: "of_int (fls_subdegree (c i)) = fpxs_val (coeff p i) * rat_of_nat b"
     if i: "i \<le> N" for i
   proof -
     have "rat_of_int (fls_subdegree (c i)) = fpxs_val (fpxs_of_fls (c i))"
       by simp
     also have "fpxs_of_fls (c i) = fpxs_compose_power (poly.coeff p i) (rat_of_nat b)"
       by (subst c_eq) auto
     also have "fpxs_val \<dots> = fpxs_val (coeff p i) * rat_of_nat b"
       using \<open>b > 0\<close> by simp
     finally show ?thesis .
   qed
 
   text \<open>
     We now write all the coefficients as FPSs:
   \<close>
   have "\<exists>c''. c' i = fps_to_fls c''" if "i \<le> N" for i
   proof (cases "i = N")
     case True
     hence "c' i = fps_to_fls 1"
       using \<open>c' N = 1\<close> by simp
     thus ?thesis by metis
   next
     case i: False
     show ?thesis
     proof (cases "c i = 0")
       case True
       hence "c' i = 0" by (auto simp: c'_def)
-      thus ?thesis by auto
+      thus ?thesis
+        by (metis fps_zero_to_fls)
     next
       case False
       hence "coeff p i \<noteq> 0"
         using c_eq[of i] by auto
       hence r_ge: "r \<ge> -fpxs_val (poly.coeff p i) / (rat_of_nat N - rat_of_nat i)"
         unfolding r_def using i that False by (intro Max.coboundedI) auto
 
       have "fls_subdegree (c' i) = fls_subdegree (c i) + (int N - int i) * a"
         using i that False by (simp add: c'_def fls_X_intpow_times_conv_shift subdegree_c)
       also have "rat_of_int \<dots> =
                    fpxs_val (poly.coeff p i) * of_nat b + (of_nat N - of_nat i) * of_int a"
         using i that False by (simp add: subdegree_c)
       also have "\<dots> = of_nat b * (of_nat N - of_nat i) *
                         (fpxs_val (poly.coeff p i) / (of_nat N - of_nat i) + r)"
         using \<open>b > 0\<close> i by (auto simp: field_simps ab(2))
       also have "\<dots> \<ge> 0"
         using r_ge that by (intro mult_nonneg_nonneg) auto
       finally have "fls_subdegree (c' i) \<ge> 0" by simp
       hence "\<exists>c''. c' i = fls_shift 0 (fps_to_fls c'')"
         by (intro fls_as_fps') (auto simp: algebra_simps)
       thus ?thesis by simp
     qed
   qed
   then obtain c''_aux where c''_aux: "c' i = fps_to_fls (c''_aux i)" if "i \<le> N" for i
     by metis
   define c'' where "c'' = (\<lambda>i. if i \<le> N then c''_aux i else 0)"
   have c': "c' i = fps_to_fls (c'' i)" for i
   proof (cases "i \<le> N")
     case False
     thus ?thesis by (auto simp: c'_def c''_def)
   qed (auto simp: c''_def c''_aux)
   have c''_eq: "fps_to_fls (c'' i) = c' i" for i
     using c'[of i] by simp
 
   define p' where "p' = Abs_poly c''"
   have coeff_p': "coeff p' = c''"
     unfolding p'_def
   proof (rule coeff_Abs_poly)
     fix i assume "i > N"
     hence "coeff p i = 0"
       by (simp add: N_def coeff_eq_0)
-    thus "c'' i = 0" using c'[of i] c[of i] \<open>b > 0\<close>
-      by (auto simp: c'_def fls_shift_eq0_iff)
+    thus "c'' i = 0" using c'[of i] c[of i] \<open>b > 0\<close> \<open>N < i\<close> c''_def by auto
   qed
 
   text \<open>
     We set up some homomorphisms to convert between the two polynomials:
   \<close>
   interpret comppow: map_poly_inj_idom_hom "(\<lambda>x::'a fpxs. fpxs_compose_power x (1/rat_of_nat b))"
     by unfold_locales (use \<open>b > 0\<close> in simp_all)
   define lift_poly :: "'a fps poly \<Rightarrow> 'a fpxs poly" where
     "lift_poly = (\<lambda>p. pcompose p [:0, fpxs_X_power r:]) \<circ>
                   (map_poly ((\<lambda>x. fpxs_compose_power x (1/rat_of_nat b)) \<circ> fpxs_of_fls \<circ> fps_to_fls))"
   have [simp]: "degree (lift_poly q) = degree q" for q
     unfolding lift_poly_def by (simp add: degree_map_poly)
   
   interpret fps_to_fls: map_poly_inj_idom_hom fps_to_fls
     by unfold_locales (simp_all add: fls_times_fps_to_fls)
   interpret fpxs_of_fls: map_poly_inj_idom_hom fpxs_of_fls
     by unfold_locales simp_all
   interpret lift_poly: inj_idom_hom lift_poly
     unfolding lift_poly_def
     by (intro inj_idom_hom_compose inj_idom_hom_pcompose inj_idom_hom.inj_idom_hom_map_poly
               fps_to_fls.base.inj_idom_hom_axioms fpxs_of_fls.base.inj_idom_hom_axioms
               comppow.base.inj_idom_hom_axioms) simp_all
   interpret lift_poly: map_poly_inj_idom_hom lift_poly
     by unfold_locales
 
   define C :: "'a fpxs" where "C = fpxs_X_power (- (rat_of_nat N * r))"
   have [simp]: "C \<noteq> 0"
     by (auto simp: C_def)
 
   text \<open>
     Now, finally: the original polynomial and the new polynomial are related through the
     \<^term>\<open>lift_poly\<close> homomorphism:
   \<close>
   have p_eq: "p = smult C (lift_poly p')"
     using \<open>b > 0\<close>
     by (intro poly_eqI)
        (simp_all add: coeff_map_poly coeff_pcompose_linear coeff_p' c c''_eq c'_def C_def
                       ring_distribs fpxs_X_power_conv_shift fpxs_shift_mult lift_poly_def ab(2)
                  flip: fpxs_X_power_add fpxs_X_power_mult fpxs_shift_add_left)
   have [simp]: "degree p' = N"
     unfolding N_def using \<open>b > 0\<close> by (simp add: p_eq)
   have lc_p': "lead_coeff p' = 1"
     using c''_eq[of N] by (simp add: coeff_p' \<open>c' N = 1\<close>)
   have "coeff p' (N - 1) = 0"
     using coeff_deg_minus_1 \<open>b > 0\<close> unfolding N_def [symmetric]
     by (simp add: p_eq lift_poly_def coeff_map_poly coeff_pcompose_linear)
 
   text \<open>
     We reduce $p'(X,Z)$ to $p'(X,0)$:
   \<close>
   define p'_proj where "p'_proj = reduce_fps_poly p'"
   have [simp]: "degree p'_proj = N"
     unfolding p'_proj_def using lc_p' by (subst degree_reduce_fps_poly_monic) simp_all
   have lc_p'_proj: "lead_coeff p'_proj = 1"
     unfolding p'_proj_def using lc_p' by (subst reduce_fps_poly_monic) simp_all
   hence [simp]: "p'_proj \<noteq> 0"
     by auto
   have "coeff p'_proj (N - 1) = 0"
     using \<open>coeff p' (N - 1) = 0\<close> by (simp add: p'_proj_def reduce_fps_poly_def)
 
   text \<open>
     We now show that \<^term>\<open>p'_proj\<close> splits into non-trivial coprime factors. To do this, we
     have to show that it has two distinct roots, i.e. that it is not of the form $(X - c)^n$.
   \<close>
   obtain g h where gh: "degree g > 0" "degree h > 0" "coprime g h" "p'_proj = g * h"
   proof -
     have "degree p'_proj > 1"
       using deg_p by (auto simp: N_def)
     text \<open>Let \<open>x\<close> be an arbitrary root of \<^term>\<open>p'_proj\<close>:\<close>
     then obtain x where x: "poly p'_proj x = 0"
       using alg_closed_imp_poly_has_root[of p'_proj] by force
 
     text \<open>Assume for the sake of contradiction that \<^term>\<open>p'_proj\<close> were equal to $(1-x)^n$:\<close>
     have not_only_one_root: "p'_proj \<noteq> [:-x, 1:] ^ N"
     proof safe
       assume *: "p'_proj = [:-x, 1:] ^ N"
 
       text \<open>
         If \<open>x\<close> were non-zero, all the coefficients of \<open>p'_proj\<close> would also be non-zero by the
         Binomial Theorem. Since we know that the coefficient of \<open>n - 1\<close> \<^emph>\<open>is\<close> zero, this means
         that \<open>x\<close> must be zero:
       \<close>
       have "coeff p'_proj (N - 1) = 0" by fact
       hence "x = 0"
         by (subst (asm) *, subst (asm) coeff_linear_poly_power) auto
 
       text \<open>
         However, by our choice of \<open>r\<close>, we know that there is an index \<open>i\<close> such that \<open>c' i\<close> has
         is non-zero and has valuation (i.e. subdegree) 0, which means that the \<open>i\<close>-th coefficient
         of \<^term>\<open>p'_proj\<close> must also be non-zero.
       \<close>
       have "0 < N \<and> coeff p 0 \<noteq> 0"
         using deg_p \<open>coeff p 0 \<noteq> 0\<close> by (auto simp: N_def)
       hence "{i\<in>{..<N}. coeff p i \<noteq> 0} \<noteq> {}"
         by blast
       hence "r \<in> (\<lambda>i. -fpxs_val (poly.coeff p i) / (rat_of_nat N - rat_of_nat i)) `
               {i\<in>{..<N}. coeff p i \<noteq> 0}"
         unfolding r_def using deg_p by (intro Max_in) (auto simp: N_def)
       then obtain i where i: "i < N" "coeff p i \<noteq> 0"
                              "-fpxs_val (coeff p i) / (rat_of_nat N - rat_of_nat i) = r"
         by blast
       hence [simp]: "c' i \<noteq> 0"
         using i c[of i] by (auto simp: c'_def)
       have "fpxs_val (poly.coeff p i) = rat_of_int (fls_subdegree (c i)) / rat_of_nat b"
         using subdegree_c[of i] i \<open>b > 0\<close> by (simp add: field_simps)
       also have "fpxs_val (coeff p i) = -r * (rat_of_nat N - rat_of_nat i)"
         using i by (simp add: field_simps)
       finally have "rat_of_int (fls_subdegree (c i)) = - r * (of_nat N - of_nat i) * of_nat b"
         using \<open>b > 0\<close> by (simp add: field_simps)
       also have "c i = fls_shift ((int N - int i) * a) (c' i)"
         using i by (simp add: c'_def ring_distribs fls_X_intpow_times_conv_shift
                          flip: fls_shifted_times_simps(2))
       also have "fls_subdegree \<dots> = fls_subdegree (c' i) - (int N - int i) * a"
         by (subst fls_shift_subdegree) auto
       finally have "fls_subdegree (c' i) = 0"
         using \<open>b > 0\<close> by (simp add: ab(2))
       hence "subdegree (coeff p' i) = 0"
         by (simp flip: c''_eq add: fls_subdegree_fls_to_fps coeff_p')
       moreover have "coeff p' i \<noteq> 0"
         using \<open>c' i \<noteq> 0\<close> c' coeff_p' by auto
       ultimately have "coeff p' i $ 0 \<noteq> 0"
         using subdegree_eq_0_iff by blast
 
       also have "coeff p' i $ 0 = coeff p'_proj i"
         by (simp add: p'_proj_def reduce_fps_poly_def)
       also have "\<dots> = 0"
         by (subst *, subst coeff_linear_poly_power) (use i \<open>x = 0\<close> in auto)
       finally show False by simp
     qed
 
     text \<open>
       We can thus obtain our second root \<open>y\<close> from the factorisation:
     \<close>
     have "\<exists>y. x \<noteq> y \<and> poly p'_proj y = 0"
     proof (rule ccontr)
       assume *: "\<not>(\<exists>y. x \<noteq> y \<and> poly p'_proj y = 0)"
       have "p'_proj \<noteq> 0" by simp
       then obtain A where A: "size A = degree p'_proj"
                              "p'_proj = smult (lead_coeff p'_proj) (\<Prod>x\<in>#A. [:-x, 1:])"
         using alg_closed_imp_factorization[of p'_proj] by blast
       have "set_mset A = {x. poly p'_proj x = 0}"
         using lc_p'_proj by (subst A) (auto simp: poly_prod_mset)
       also have "\<dots> = {x}"
         using x * by auto
       finally have "A = replicate_mset N x"
         using set_mset_subset_singletonD[of A x] A(1) by simp
       with A(2) have "p'_proj = [:- x, 1:] ^ N"
         using lc_p'_proj by simp
       with not_only_one_root show False 
         by contradiction
     qed
     then obtain y where "x \<noteq> y" "poly p'_proj y = 0"
       by blast
 
     text \<open>
       It now follows easily that \<^term>\<open>p'_proj\<close> splits into non-trivial and coprime factors:
     \<close>
     show ?thesis
     proof (rule alg_closed_imp_poly_splits_coprime)
       show "degree p'_proj > 1"
         using deg_p by (simp add: N_def)
       show "x \<noteq> y" "poly p'_proj x = 0" "poly p'_proj y = 0"
         by fact+
     qed (use that in metis)
   qed
 
   text \<open>
     By Hensel's lemma, these factors give rise to corresponding factors of \<open>p'\<close>:
   \<close>
   interpret hensel: fps_hensel p' p'_proj g h
   proof unfold_locales
     show "lead_coeff p' = 1"
       using lc_p' by simp
   qed (use gh \<open>coprime g h\<close> in \<open>simp_all add: p'_proj_def\<close>) 
 
   text \<open>All that remains now is to undo the variable substitutions we did above:\<close>
   have "p = [:C:] * lift_poly hensel.G * lift_poly hensel.H"
     unfolding p_eq by (subst hensel.F_splits) (simp add: hom_distribs)
   thus "\<not>irreducible p"
     by (rule reducible_polyI) (use hensel.deg_G hensel.deg_H gh in simp_all)
 qed
 
 text \<open>
   We do not actually show that this is the algebraic closure since this cannot be stated
   idiomatically in the typeclass setting and is probably not very useful either, but it can
   be motivated like this:
 
   Suppose we have an algebraically closed extension $L$ of the field of Laurent series. Clearly,
   $X^{a/b}\in L$ for any integer \<open>a\<close> and any positive integer \<open>b\<close> since
   $(X^{a/b})^b - X^a = 0$. But any Puiseux series $F(X)$ with root order \<open>b\<close> can
   be written as
   \[F(X) = \sum_{k=0}^{b-1} X^{k/b} F_k(X)\]
   where the Laurent series $F_k(X)$ are defined as follows:
   \[F_k(X) := \sum_{n = n_{0,k}}^\infty [X^{n + k/b}] F(X) X^n\]
   Thus, $F(X)$ can be written as a finite sum of products of elements in $L$ and must therefore
   also be in $L$. Thus, the Puiseux series are all contained in $L$.
 \<close>
 
 
 subsection \<open>Metric and topology\<close>
 
 text \<open>
   Formal Puiseux series form a metric space with the usual metric for formal series:
   Two series are ``close'' to one another if they have many initial coefficients in common.
 \<close>
 
 instantiation fpxs :: (zero) norm
 begin
 
 definition norm_fpxs :: "'a fpxs \<Rightarrow> real" where
   "norm f = (if f = 0 then 0 else 2 powr (-of_rat (fpxs_val f)))"
 
 instance ..
 
 end
 
 
 instantiation fpxs :: (group_add) dist
 begin
 
 definition dist_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> real" where
   "dist f g = (if f = g then 0 else 2 powr (-of_rat (fpxs_val (f - g))))"
 
 instance ..
 
 end
 
 
 instantiation fpxs :: (group_add) metric_space
 begin
 
 definition uniformity_fpxs_def [code del]:
   "(uniformity :: ('a fpxs \<times> 'a fpxs) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_fpxs_def [code del]:
   "open (U :: 'a fpxs set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance proof
   fix f g h :: "'a fpxs"
   show "dist f g \<le> dist f h + dist g h"
   proof (cases "f \<noteq> g \<and> f \<noteq> h \<and> g \<noteq> h")
     case True
     have "dist f g \<le> 2 powr -real_of_rat (min (fpxs_val (f - h)) (fpxs_val (g - h)))"
       using fpxs_val_add_ge[of "f - h" "h - g"] True
       by (auto simp: algebra_simps fpxs_val_minus_commute dist_fpxs_def of_rat_less_eq)
     also have "\<dots> \<le> dist f h + dist g h"
       using True by (simp add: dist_fpxs_def min_def)
     finally show ?thesis .
   qed (auto simp: dist_fpxs_def fpxs_val_minus_commute)
 qed (simp_all add: uniformity_fpxs_def open_fpxs_def dist_fpxs_def)
 
 end
 
 
 instance fpxs :: (group_add) dist_norm
   by standard (auto simp: dist_fpxs_def norm_fpxs_def)
 
 end
\ No newline at end of file
diff --git a/thys/Formal_Puiseux_Series/Puiseux_Laurent_Library.thy b/thys/Formal_Puiseux_Series/Puiseux_Laurent_Library.thy
deleted file mode 100644
--- a/thys/Formal_Puiseux_Series/Puiseux_Laurent_Library.thy
+++ /dev/null
@@ -1,212 +0,0 @@
-(*
-  File:    Puiseux_Laurent_Library.thy
-  Author:  Manuel Eberl, TU München
-*)
-subsection \<open>Facts about Laurent series\<close>
-theory Puiseux_Laurent_Library
-  imports "HOL-Computational_Algebra.Computational_Algebra"
-begin
-
-lemma filterlim_at_top_div_const_nat:
-  assumes "c > 0"
-  shows   "filterlim (\<lambda>x::nat. x div c) at_top at_top"
-  unfolding filterlim_at_top
-proof
-  fix C :: nat
-  have *: "n div c \<ge> C" if "n \<ge> C * c" for n
-    using assms that by (metis div_le_mono div_mult_self_is_m)
-  have "eventually (\<lambda>n. n \<ge> C * c) at_top"
-    by (rule eventually_ge_at_top)
-  thus "eventually (\<lambda>n. n div c \<ge> C) at_top"
-    by eventually_elim (use * in auto)
-qed
-
-lemma fls_eq_iff: "f = g \<longleftrightarrow> (\<forall>n. fls_nth f n = fls_nth g n)"
-  by transfer auto
-
-lemma fls_shift_eq_1_iff: "fls_shift n f = 1 \<longleftrightarrow> f = fls_shift (-n) 1"
-proof -
-  have "fls_shift n f = 1 \<longleftrightarrow> fls_shift n f = fls_shift n (fls_shift (-n) 1)"
-    by (simp del: fls_shift_eq_iff)
-  also have "\<dots> \<longleftrightarrow> f = fls_shift (-n) 1"
-    by (subst fls_shift_eq_iff) auto
-  finally show ?thesis .
-qed
-
-lemma fps_to_fls_eq_iff [simp]: "fps_to_fls f = fps_to_fls g \<longleftrightarrow> f = g"
-proof safe
-  assume "fps_to_fls f = fps_to_fls g"
-  hence *: "n < 0 \<or> f $ nat n = g $ nat n" for n
-    by (force simp: fls_eq_iff split: if_splits)
-  have "f $ n = g $ n" for n
-    using *[of "int n"] by auto
-  thus "f = g"
-    by (auto simp: fps_eq_iff)
-qed
-
-lemma fps_to_fls_eq_0_iff [simp]: "fps_to_fls f = 0 \<longleftrightarrow> f = 0"
-  using fps_to_fls_eq_iff[of f 0] by (simp del: fps_to_fls_eq_iff)
-
-lemma fps_to_fls_eq_1_iff [simp]: "fps_to_fls f = 1 \<longleftrightarrow> f = 1"
-  using fps_to_fls_eq_iff[of f 1] by (simp del: fps_to_fls_eq_iff)
-
-lemma fps_to_fls_power: "fps_to_fls (f ^ n) = fps_to_fls f ^ n"
-  by (induction n) (auto simp: fls_times_fps_to_fls)
-
-lemma fls_as_fps:
-  fixes f :: "'a :: zero fls" and n :: int
-  assumes n: "n \<ge> -fls_subdegree f"
-  obtains f' where "f = fls_shift n (fps_to_fls f')"
-proof -
-  have "fls_subdegree (fls_shift (- n) f) \<ge> 0"
-    by (rule fls_shift_nonneg_subdegree) (use n in simp)
-  hence "f = fls_shift n (fps_to_fls (fls_regpart (fls_shift (-n) f)))"
-    by (subst fls_regpart_to_fls_trivial) simp_all
-  thus ?thesis
-    by (rule that)
-qed
-
-lemma fls_as_fps':
-  fixes f :: "'a :: zero fls" and n :: int
-  assumes n: "n \<ge> -fls_subdegree f"
-  shows "\<exists>f'. f = fls_shift n (fps_to_fls f')"
-  using fls_as_fps[OF assms] by metis
-
-
-definition fls_compose_fps :: "'a :: field fls \<Rightarrow> 'a fps \<Rightarrow> 'a fls" where
-  "fls_compose_fps f g =
-     (if f = 0 then 0
-      else if fls_subdegree f \<ge> 0 then fps_to_fls (fps_compose (fls_regpart f) g)
-      else fps_to_fls (fps_compose (fls_base_factor_to_fps f) g) /
-             fps_to_fls g ^ nat (-fls_subdegree f))"
-
-lemma fls_compose_fps_fps [simp]:
-  "fls_compose_fps (fps_to_fls f) g = fps_to_fls (fps_compose f g)"
-  by (auto simp: fls_compose_fps_def fls_subdegree_fls_to_fps)
-
-lemma fls_const_transfer [transfer_rule]:
-  "rel_fun (=) (pcr_fls (=))
-     (\<lambda>c n. if n = 0 then c else 0) fls_const"
-  by (auto simp: fls_const_def rel_fun_def pcr_fls_def OO_def cr_fls_def)
-
-lemma fls_shift_transfer [transfer_rule]:
-  "rel_fun (=) (rel_fun (pcr_fls (=)) (pcr_fls (=)))
-     (\<lambda>n f k. f (k+n)) fls_shift"
-  by (auto simp: fls_const_def rel_fun_def pcr_fls_def OO_def cr_fls_def)
-
-lift_definition fls_compose_power :: "'a :: zero fls \<Rightarrow> nat \<Rightarrow> 'a fls" is
-  "\<lambda>f d n. if d > 0 \<and> int d dvd n then f (n div int d) else 0"
-proof -
-  fix f :: "int \<Rightarrow> 'a" and d :: nat
-  assume *: "eventually (\<lambda>n. f (-int n) = 0) cofinite"
-  show "eventually (\<lambda>n. (if d > 0 \<and> int d dvd -int n then f (-int n div int d) else 0) = 0) cofinite"
-  proof (cases "d = 0")
-    case False
-    from * have "eventually (\<lambda>n. f (-int n) = 0) at_top"
-      by (simp add: cofinite_eq_sequentially)
-    hence "eventually (\<lambda>n. f (-int (n div d)) = 0) at_top"
-      by (rule eventually_compose_filterlim[OF _ filterlim_at_top_div_const_nat]) (use False in auto)
-    hence "eventually (\<lambda>n. (if d > 0 \<and> int d dvd -int n then f (-int n div int d) else 0) = 0) at_top"
-      by eventually_elim (auto simp: zdiv_int dvd_neg_div)
-    thus ?thesis
-      by (simp add: cofinite_eq_sequentially)
-  qed auto
-qed
-
-lemma fls_nth_compose_power:
-  assumes "d > 0"
-  shows   "fls_nth (fls_compose_power f d) n = (if int d dvd n then fls_nth f (n div int d) else 0)"
-  using assms by transfer auto
-     
-
-lemma fls_compose_power_0_left [simp]: "fls_compose_power 0 d = 0"
-  by transfer auto
-
-lemma fls_compose_power_1_left [simp]: "d > 0 \<Longrightarrow> fls_compose_power 1 d = 1"
-  by transfer (auto simp: fun_eq_iff)
-
-lemma fls_compose_power_const_left [simp]:
-  "d > 0 \<Longrightarrow> fls_compose_power (fls_const c) d = fls_const c"
-  by transfer (auto simp: fun_eq_iff)
-
-lemma fls_compose_power_shift [simp]:
-  "d > 0 \<Longrightarrow> fls_compose_power (fls_shift n f) d = fls_shift (d * n) (fls_compose_power f d)"
-  by transfer (auto simp: fun_eq_iff add_ac mult_ac)
-
-lemma fls_compose_power_X_intpow [simp]:
-  "d > 0 \<Longrightarrow> fls_compose_power (fls_X_intpow n) d = fls_X_intpow (int d * n)"
-  by simp
-
-lemma fls_compose_power_X [simp]:
-  "d > 0 \<Longrightarrow> fls_compose_power fls_X d = fls_X_intpow (int d)"
-  by transfer (auto simp: fun_eq_iff)
-
-lemma fls_compose_power_X_inv [simp]:
-  "d > 0 \<Longrightarrow> fls_compose_power fls_X_inv d = fls_X_intpow (-int d)"
-  by (simp add: fls_X_inv_conv_shift_1)
-
-lemma fls_compose_power_0_right [simp]: "fls_compose_power f 0 = 0"
-  by transfer auto
-
-lemma fls_compose_power_add [simp]:
-  "fls_compose_power (f + g) d = fls_compose_power f d + fls_compose_power g d"
-  by transfer auto
-
-lemma fls_compose_power_diff [simp]:
-  "fls_compose_power (f - g) d = fls_compose_power f d - fls_compose_power g d"
-  by transfer auto
-
-lemma fls_compose_power_uminus [simp]:
-  "fls_compose_power (-f) d = -fls_compose_power f d"
-  by transfer auto
-
-lemma fps_nth_compose_X_power:
-  "fps_nth (f oo (fps_X ^ d)) n = (if d dvd n then fps_nth f (n div d) else 0)"
-proof -
-  have "fps_nth (f oo (fps_X ^ d)) n = (\<Sum>i = 0..n. f $ i * (fps_X ^ (d * i)) $ n)"
-    unfolding fps_compose_def by (simp add: power_mult)
-  also have "\<dots> = (\<Sum>i\<in>(if d dvd n then {n div d} else {}). f $ i * (fps_X ^ (d * i)) $ n)"
-    by (intro sum.mono_neutral_right) auto
-  also have "\<dots> = (if d dvd n then fps_nth f (n div d) else 0)"
-    by auto
-  finally show ?thesis .
-qed
-
-lemma fls_compose_power_fps_to_fls:
-  assumes "d > 0"
-  shows   "fls_compose_power (fps_to_fls f) d = fps_to_fls (fps_compose f (fps_X ^ d))"
-  using assms
-  by (intro fls_eqI) (auto simp: fls_nth_compose_power fps_nth_compose_X_power
-                                 pos_imp_zdiv_neg_iff div_neg_pos_less0 nat_div_distrib
-                           simp flip: int_dvd_int_iff)
-
-lemma fls_compose_power_mult [simp]:
-  "fls_compose_power (f * g :: 'a :: idom fls) d = fls_compose_power f d * fls_compose_power g d"
-proof (cases "d > 0")
-  case True
-  define n where "n = nat (max 0 (max (- fls_subdegree f) (- fls_subdegree g)))"
-  have n_ge: "-fls_subdegree f \<le> int n" "-fls_subdegree g \<le> int n"
-    unfolding n_def by auto
-  obtain f' where f': "f = fls_shift n (fps_to_fls f')"
-    using fls_as_fps[OF n_ge(1)] by (auto simp: n_def)
-  obtain g' where g': "g = fls_shift n (fps_to_fls g')"
-    using fls_as_fps[OF n_ge(2)] by (auto simp: n_def)
-  show ?thesis using \<open>d > 0\<close>
-    by (simp add: f' g' fls_shifted_times_simps mult_ac fls_compose_power_fps_to_fls
-                  fps_compose_mult_distrib flip: fls_times_fps_to_fls)
-qed auto
-
-lemma fls_compose_power_power [simp]:
-  assumes "d > 0 \<or> n > 0"
-  shows   "fls_compose_power (f ^ n :: 'a :: idom fls) d = fls_compose_power f d ^ n"
-proof (cases "d > 0")
-  case True
-  thus ?thesis by (induction n) auto
-qed (use assms in auto)
-
-lemma fls_nth_compose_power' [simp]:
-  "d = 0 \<or> \<not>d dvd n \<Longrightarrow> fls_nth (fls_compose_power f d) n = 0"
-  "d dvd n \<Longrightarrow> d > 0 \<Longrightarrow> fls_nth (fls_compose_power f d) n = fls_nth f (n div d)"
-  by (transfer; force; fail)+
-
-end
\ No newline at end of file
diff --git a/thys/Formal_Puiseux_Series/ROOT b/thys/Formal_Puiseux_Series/ROOT
--- a/thys/Formal_Puiseux_Series/ROOT
+++ b/thys/Formal_Puiseux_Series/ROOT
@@ -1,15 +1,14 @@
 chapter AFP
 
 session Formal_Puiseux_Series (AFP) = "HOL-Computational_Algebra" +
   options [timeout = 1200]
   sessions
     Polynomial_Interpolation
   theories
     Puiseux_Polynomial_Library
-    Puiseux_Laurent_Library
     FPS_Hensel
     Formal_Puiseux_Series
   document_files
     "root.tex"
     "root.bib"
 
diff --git a/thys/Hermite_Lindemann/Hermite_Lindemann.thy b/thys/Hermite_Lindemann/Hermite_Lindemann.thy
--- a/thys/Hermite_Lindemann/Hermite_Lindemann.thy
+++ b/thys/Hermite_Lindemann/Hermite_Lindemann.thy
@@ -1,2558 +1,2561 @@
 (*
   File:     Hermite_Lindemann.thy
   Author:   Manuel Eberl, TU München
 *)
 section \<open>The Hermite--Lindemann--Weierstraß Transcendence Theorem\<close>
 theory Hermite_Lindemann
 imports 
   Pi_Transcendental.Pi_Transcendental
   Algebraic_Numbers.Algebraic_Numbers
   Algebraic_Integer_Divisibility
   More_Min_Int_Poly
   Complex_Lexorder
   More_Polynomial_HLW
   More_Multivariate_Polynomial_HLW
   More_Algebraic_Numbers_HLW
   Misc_HLW
 begin
 
+hide_const (open) Henstock_Kurzweil_Integration.content  Module.smult
+
+
 text \<open>
   The Hermite--Lindemann--Weierstraß theorem answers questions about the transcendence of
   the exponential function and other related complex functions. It proves that a large number of
   combinations of exponentials is always transcendental.
 
   A first (much weaker) version of the theorem was proven by Hermite. Lindemann and Weierstraß then
   successively generalised it shortly afterwards, and finally Baker gave another, arguably more
   elegant formulation (which is the one that we will prove, and then derive the traditional version
   from it).
 
   To honour the contributions of all three of these 19th-century mathematicians, I refer to the
   theorem as the Hermite--Lindemann--Weierstraß theorem, even though in other literature it is
   often called Hermite--Lindemann or Lindemann--Weierstraß. To keep things short, the Isabelle
   name of the theorem, however, will omit Weierstraß's name.
 \<close>
 
 subsection \<open>Main proof\<close>
 
 text \<open>
   Following Baker, We first prove the following special form of the theorem:
   Let $m > 0$ and $q_1, \ldots, q_m \in\mathbb{Z}[X]$ be irreducible, non-constant,
   and pairwise coprime polynomials. Let $\beta_1, \ldots, \beta_m$ be non-zero integers. Then
   \[\sum_{i=1}^m \beta_i \sum_{q_i(\alpha) = 0} e^\alpha \neq 0\]
 
   The difference to the final theorem is that
 
     \<^enum> The coefficients $\beta_i$ are non-zero integers (as opposed to arbitrary algebraic numbers)
 
     \<^enum> The exponents $\alpha_i$ occur in full sets of conjugates, and each set has the same
       coefficient.
 
   In a similar fashion to the proofs of the transcendence of \<open>e\<close> and \<open>\<pi>\<close>, we define some number
   $J$ depending on the $\alpha_i$ and $\beta_i$ and an arbitrary sufficiently large prime \<open>p\<close>. We
   then show that, on one hand, $J$ is an integer multiple of $(p-1)!$, but on the other hand it
   is bounded from above by a term of the form $C_1 \cdot C_2^p$. This is then clearly a
   contradiction if \<open>p\<close> is chosen large enough.
 \<close>
 
 lemma Hermite_Lindemann_aux1:
   fixes P :: "int poly set" and \<beta> :: "int poly \<Rightarrow> int"
   assumes "finite P" and "P \<noteq> {}"
   assumes distinct: "pairwise Rings.coprime P"
   assumes irred: "\<And>p. p \<in> P \<Longrightarrow> irreducible p"
   assumes nonconstant: "\<And>p. p \<in> P \<Longrightarrow> Polynomial.degree p > 0"
   assumes \<beta>_nz: "\<And>p. p \<in> P \<Longrightarrow> \<beta> p \<noteq> 0"
   defines "Roots \<equiv> (\<lambda>p. {\<alpha>::complex. poly (of_int_poly p) \<alpha> = 0})"
   shows   "(\<Sum>p\<in>P. of_int (\<beta> p) * (\<Sum>\<alpha>\<in>Roots p. exp \<alpha>)) \<noteq> 0"
 proof
   note [intro] = \<open>finite P\<close>
   assume sum_eq_0: "(\<Sum>p\<in>P. of_int (\<beta> p) * (\<Sum>\<alpha>\<in>Roots p. exp \<alpha>)) = 0"
 
   define Roots' where "Roots' = (\<Union>p\<in>P. Roots p)"
   have finite_Roots [intro]: "finite (Roots p)" if "p \<in> P" for p
     using nonconstant[of p] that by (auto intro: poly_roots_finite simp: Roots_def)
   have [intro]: "finite Roots'"
     by (auto simp: Roots'_def)
   have [simp]: "0 \<notin> P"
     using nonconstant[of 0] by auto
   have [simp]: "p \<noteq> 0" if "p \<in> P" for p
     using that by auto
 
   text \<open>
     The polynomials in \<^term>\<open>P\<close> do not have multiple roots:
   \<close>
   have rsquarefree: "rsquarefree (of_int_poly q :: complex poly)" if "q \<in> P" for q
     by (rule irreducible_imp_rsquarefree_of_int_poly) (use that in \<open>auto intro: irred nonconstant\<close>)
 
   text \<open>
     No two different polynomials in \<^term>\<open>P\<close> have roots in common:
   \<close>
   have disjoint: "disjoint_family_on Roots P"
     using distinct
   proof (rule pairwise_imp_disjoint_family_on)
     fix p q assume P: "p \<in> P" "q \<in> P" and "Rings.coprime p q"
     hence "Rings.coprime (of_int_poly p :: complex poly) (of_int_poly q)"
       by (intro coprime_of_int_polyI)
     thus "Roots p \<inter> Roots q = {}"
       using poly_eq_0_coprime[of "of_int_poly p" "of_int_poly q :: complex poly"] P
       by (auto simp: Roots_def)
   qed
 
   define n_roots :: "int poly \<Rightarrow> nat" ("\<sharp>_")
     where "n_roots = (\<lambda>p. card (Roots p))"
   define n where "n = (\<Sum>p\<in>P. \<sharp>p)"
   have n_altdef: "n = card Roots'"
     unfolding n_def Roots'_def n_roots_def using disjoint
     by (subst card_UN_disjoint) (auto simp: disjoint_family_on_def)
   have Roots_nonempty: "Roots p \<noteq> {}" if "p \<in> P" for p
     using nonconstant[OF that] by (auto simp: Roots_def fundamental_theorem_of_algebra constant_degree)
   have "Roots' \<noteq> {}"
     using Roots_nonempty \<open>P \<noteq> {}\<close> by (auto simp: Roots'_def)
   have "n > 0"
     using \<open>Roots' \<noteq> {}\<close> \<open>finite Roots'\<close> by (auto simp: n_altdef)
 
   text \<open>
     We can split each polynomial in \<open>P\<close> into a product of linear factors:
   \<close>
   have of_int_poly_P:
      "of_int_poly q = Polynomial.smult (Polynomial.lead_coeff q) (\<Prod>x\<in>Roots q. [:-x, 1:])"
      if "q \<in> P" for q
     using complex_poly_decompose_rsquarefree[OF rsquarefree[OF that]] by (simp add: Roots_def)
 
   text \<open>
     We let \<open>l\<close> be an integer such that $l\alpha$ is an algebraic integer for all our roots \<open>\<alpha>\<close>:
   \<close>
   define l where "l = (LCM q\<in>P. Polynomial.lead_coeff q)"
   have alg_int: "algebraic_int (of_int l * x)" if "x \<in> Roots'" for x
   proof -
     from that obtain q where q: "q \<in> P" "ipoly q x = 0"
       by (auto simp: Roots'_def Roots_def)
     show ?thesis
       by (rule algebraic_imp_algebraic_int'[of q]) (use q in \<open>auto simp: l_def\<close>)
   qed
   have "l \<noteq> 0"
     using \<open>finite P\<close> by (auto simp: l_def Lcm_0_iff)
   moreover have "l \<ge> 0"
     unfolding l_def by (rule Lcm_int_greater_eq_0)
   ultimately have "l > 0" by linarith
 
   text \<open>
     We can split the product of all the polynomials in \<open>P\<close> into linear factors:
   \<close>
   define lc_factor where "lc_factor = (\<Prod>q\<in>P. l ^ Polynomial.degree q div Polynomial.lead_coeff q)"
   have lc_factor: "Polynomial.smult (of_int l ^ n) (\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>',1:]) =
                       of_int_poly (Polynomial.smult lc_factor (\<Prod>P))"
   proof -
     define lc where "lc = (\<lambda>q. Polynomial.lead_coeff q :: int)"
     define d where "d = (Polynomial.degree :: int poly \<Rightarrow> nat)"
     have "(\<Prod>q\<in>P. of_int_poly q) =
           (\<Prod>q\<in>P. Polynomial.smult (lc q) (\<Prod>x\<in>Roots q. [:-x, 1:]) :: complex poly)"
       unfolding lc_def by (intro prod.cong of_int_poly_P refl)
     also have "\<dots> = Polynomial.smult (\<Prod>q\<in>P. lc q) (\<Prod>q\<in>P. (\<Prod>x\<in>Roots q. [:-x, 1:]))"
       by (simp add: prod_smult)
     also have "(\<Prod>q\<in>P. (\<Prod>x\<in>Roots q. [:-x, 1:])) = (\<Prod>x\<in>Roots'. [:-x, 1:])"
       unfolding Roots'_def using disjoint
       by (intro prod.UNION_disjoint [symmetric]) (auto simp: disjoint_family_on_def)
     also have "Polynomial.smult (of_int lc_factor) (Polynomial.smult (\<Prod>q\<in>P. lc q) \<dots>) =
                Polynomial.smult (\<Prod>q\<in>P. of_int (l ^ d q div lc q * lc q)) (\<Prod>x\<in>Roots'. pCons (- x) 1)"
       by (simp add: lc_factor_def prod.distrib lc_def d_def)
     also have "(\<Prod>q\<in>P. of_int (l ^ d q div lc q * lc q)) = (\<Prod>q\<in>P. of_int l ^ d q :: complex)"
     proof (intro prod.cong, goal_cases)
       case (2 q)
       have "lc q dvd l"
         unfolding l_def lc_def using 2 by auto
       also have "\<dots> dvd l ^ d q"
         using 2 nonconstant[of q] by (intro dvd_power) (auto simp: d_def)
       finally show ?case by simp
     qed auto
     also have "\<dots> = l ^ (\<Sum>q\<in>P. d q)"
       by (simp add: power_sum)
     also have "(\<Sum>q\<in>P. d q) = (\<Sum>q\<in>P. n_roots q)"
     proof (intro sum.cong, goal_cases)
       case (2 q)
       thus ?case using rsquarefree[OF 2]
         by (subst (asm) rsquarefree_card_degree) (auto simp: d_def n_roots_def Roots_def)
     qed auto
     also have "\<dots> = n"
       by (simp add: n_def)
     finally show ?thesis
       by (simp add: of_int_hom.map_poly_hom_smult of_int_poly_hom.hom_prod)
   qed
 
   text \<open>
     We define \<open>R\<close> to be the radius of the smallest circle around the origin in which all our
     roots lie:
   \<close>
   define R :: real where "R = Max (norm ` Roots')"
   have R_ge: "R \<ge> norm \<alpha>" if "\<alpha> \<in> Roots'" for \<alpha>
     unfolding R_def using that by (intro Max_ge) auto
   have "R \<ge> 0"
   proof -
     from \<open>Roots' \<noteq> {}\<close> obtain \<alpha> where "\<alpha> \<in> Roots'"
       by auto
     have "0 \<le> norm \<alpha>"
       by simp
     also have "\<dots> \<le> R"
       by (intro R_ge) fact
     finally show "R \<ge> 0"
       by simp
   qed
 
   text \<open>
     Now the main part of the proof: for any sufficiently large prime \<open>p\<close>, our assumptions
     imply $(p-1)! ^ n \leq C' l^{np} (2R)^{np-1}$ for some constant $C'$:    
   \<close>
   define C :: "nat \<Rightarrow> real" where "C = (\<lambda>p. l ^ (n * p) * (2*R) ^ (n * p - 1))"
   define C' where
     "C' = (\<Prod>x\<in>Roots'. \<Sum>q\<in>P. real_of_int \<bar>\<beta> q\<bar> * (\<Sum>\<alpha>\<in>Roots q. cmod \<alpha> * exp (cmod \<alpha>)))"
 
   text \<open>
     We commence with the proof of the main inequality.
   \<close>
   have ineq: "fact (p - 1) ^ n \<le> C' * C p ^ n"
     if p: "prime p" 
     and p_ineqs: "\<forall>q\<in>P. p > \<bar>\<beta> q\<bar>"
                  "real p > norm (\<Prod>\<alpha>\<in>Roots'. of_int (l^n) * (\<Prod>x\<in>Roots'-{\<alpha>}. \<alpha> - x))"
     for p :: nat
   proof -
     have "p > 1"
       using prime_gt_1_nat[OF p] .
 
     text \<open>
       We define the polynomial function
         \[f_i(X) = l^{np} \frac{\prod_\alpha (X-\alpha)^p}{X - \alpha_i}\]
       where the product runs over all roots $\alpha$.
     \<close>
     define f_poly :: "complex \<Rightarrow> complex poly" where
       "f_poly = (\<lambda>\<alpha>. Polynomial.smult (l^(n*p)) ((\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>', 1:]^p) div [:-\<alpha>, 1:]))"
     have f_poly_altdef: "f_poly \<alpha> = Polynomial.smult (l^(n*p))
                            ((\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>', 1:]^(if \<alpha>' = \<alpha> then p - 1 else p)))"
       if "\<alpha> \<in> Roots'" for \<alpha>
     proof -
       have "(\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>', 1:] ^ (if \<alpha>'=\<alpha> then p-1 else p)) * [:-\<alpha>, 1:] =
             [:- \<alpha>, 1:] ^ (p - 1) * (\<Prod>x\<in>Roots' - {\<alpha>}. [:- x, 1:] ^ p) * [:- \<alpha>, 1:]"
         using that by (subst prod.If_eq) (auto simp: algebra_simps)
       also have "\<dots> = (\<Prod>x\<in>Roots' - {\<alpha>}. [:- x, 1:] ^ p) * [:- \<alpha>, 1:] ^ Suc (p - 1)"
         by (simp only: power_Suc mult_ac)
       also have "Suc (p - 1) = p"
         using \<open>p > 1\<close> by auto
       also have "(\<Prod>x\<in>Roots' - {\<alpha>}. [:- x, 1:] ^ p) * [:- \<alpha>, 1:] ^ p = (\<Prod>x\<in>Roots'. [:- x, 1:] ^ p)"
         using that by (subst prod.remove[of _ \<alpha>]) auto
       finally have eq: "(\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>', 1:] ^ (if \<alpha>'=\<alpha> then p-1 else p)) * [:-\<alpha>, 1:] =
                         (\<Prod>x\<in>Roots'. [:- x, 1:] ^ p)" .
       show ?thesis
         unfolding f_poly_def eq[symmetric] by (subst nonzero_mult_div_cancel_right) auto
     qed
   
     define f :: "complex \<Rightarrow> complex \<Rightarrow> complex"
       where "f = (\<lambda>\<alpha> x. l^(n*p) * (\<Prod>\<alpha>'\<in>Roots'. (x - \<alpha>')^(if \<alpha>' = \<alpha> then p - 1 else p)))"
     have eval_f: "poly (f_poly \<alpha>) x = f \<alpha> x" if "\<alpha> \<in> Roots'" for \<alpha> x
       using that by (simp add: f_poly_altdef poly_prod f_def)
     have deg_f: "Polynomial.degree (f_poly \<alpha>) = n * p - 1" if "\<alpha> \<in> Roots'" for \<alpha>
     proof -
       have "Polynomial.degree (f_poly \<alpha>) = p - 1 + (n - 1) * p"
         unfolding f_poly_altdef[OF that] using that \<open>l > 0\<close> \<open>finite Roots'\<close>
         by (subst prod.If_eq) (auto simp: degree_prod_eq degree_power_eq degree_mult_eq n_altdef)
       also have "p - 1 + (n - 1) * p = n * p - 1"
         using \<open>n > 0\<close> \<open>p > 1\<close> by (cases n) auto
       finally show ?thesis .
     qed
 
     text \<open>
       Next, we define the function $I_i(z) = \int_0^z e^{z-t} f_i(t) \text{d}t$, and,
       based on that, the numbers $J_i = \sum_{i=1}^m \beta_i \sum_{q_i(x) = 0} I_i(x)$,
       and the number $J$, which is the product of all the $J_i$:
     \<close>
     define I :: "complex \<Rightarrow> complex \<Rightarrow> complex"
       where "I = (\<lambda>\<alpha> x. lindemann_weierstrass_aux.I (f_poly \<alpha>) x)"
     define J :: "complex \<Rightarrow> complex"
       where "J = (\<lambda>\<alpha>. \<Sum>q\<in>P. \<beta> q * (\<Sum>x\<in>Roots q. I \<alpha> x))"
 
     define J' :: complex
       where "J' = (\<Prod>\<alpha>\<in>Roots'. J \<alpha>)"
 
     text \<open>
       Reusing some of the machinery from the proof that \<open>e\<close> is transcendental,
       we find the following equality for $J_i$:
     \<close>
     have J_eq: "J \<alpha> = -(\<Sum>q\<in>P. of_int (\<beta> q) * (\<Sum>x\<in>Roots q. \<Sum>j<n*p. poly ((pderiv ^^ j) (f_poly \<alpha>)) x))"
       if "\<alpha> \<in> Roots'" for \<alpha>
     proof -
       have "n * p \<ge> 1 * 2"
         using \<open>n > 0\<close> \<open>p > 1\<close> by (intro mult_mono) auto
       hence [simp]: "{..n*p-Suc 0} = {..<n*p}"
         by auto
       have "J \<alpha> = (\<Sum>q\<in>P. \<beta> q * (\<Sum>x\<in>Roots q. I \<alpha> x))"
         unfolding J_def ..
       also have "\<dots> = (\<Sum>q\<in>P. of_int (\<beta> q) * (\<Sum>x\<in>Roots q. exp x * (\<Sum>j<n*p. poly ((pderiv ^^ j) (f_poly \<alpha>)) 0))) -
                       (\<Sum>q\<in>P. of_int (\<beta> q) * (\<Sum>x\<in>Roots q. \<Sum>j<n*p. poly ((pderiv ^^ j) (f_poly \<alpha>)) x))"
         unfolding I_def lindemann_weierstrass_aux.I_def
         by (simp add: deg_f that ring_distribs sum_subtractf sum_distrib_left sum_distrib_right mult_ac)
       also have "\<dots> = -(\<Sum>q\<in>P. of_int (\<beta> q) * (\<Sum>x\<in>Roots q. \<Sum>j<n*p. poly ((pderiv ^^ j) (f_poly \<alpha>)) x))"
         unfolding sum_distrib_right [symmetric] mult.assoc [symmetric] sum_eq_0 by simp
       finally show ?thesis .
     qed
 
     text \<open>
       The next big step is to show that $(p-1)! \mid J_i$ as an algebraic integer (i.e.
       $J_i / (p-1)!$ is an algebraic integer), but $p \not\mid J_i$. This is done by brute force:
       We show that every summand in the above sum has $p!$ as a factor, except for
       the one corresponding to $x = \alpha_i$, $j = p - 1$, which has $(p-1)!$ as a factor but
       not \<open>p\<close>.
     \<close>
     have J: "fact (p - 1) alg_dvd J \<alpha>" "\<not>of_nat p alg_dvd J \<alpha>" if \<alpha>: "\<alpha> \<in> Roots'" for \<alpha>
     proof -
       define h where "h = (\<lambda>\<alpha>' j. poly ((pderiv ^^ j) (f_poly \<alpha>)) \<alpha>')"
       from \<alpha> obtain q where q: "q \<in> P" "\<alpha> \<in> Roots q"
         by (auto simp: Roots'_def)
   
       have "J \<alpha> = -(\<Sum>(q, \<alpha>')\<in>Sigma P Roots. \<Sum>j<n*p. of_int (\<beta> q) * h \<alpha>' j)"
         unfolding J_eq[OF \<alpha>] h_def sum_distrib_left by (subst (2) sum.Sigma) auto
       also have "\<dots> = -(\<Sum>((q,\<alpha>'),i)\<in>Sigma P Roots\<times>{..<n*p}. of_int (\<beta> q) * h \<alpha>' i)"
         by (subst (2) sum.Sigma [symmetric]) (auto simp: case_prod_unfold)
       finally have J_eq': "J \<alpha> = - (\<Sum>((q, \<alpha>'), i)\<in>Sigma P Roots \<times> {..<n * p}. of_int (\<beta> q) * h \<alpha>' i)" .
   
       have h_\<alpha>_pm1_eq: "h \<alpha> (p-1) = of_int (l^(n*p)) * fact (p-1) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (\<alpha>-\<alpha>')^p)"
       proof -
         have "h \<alpha> (p - 1) = of_int (l ^ (n * p)) *
                 poly ((pderiv ^^ (p-1)) (\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>',1:] ^ (if \<alpha>' = \<alpha> then p - 1 else p))) \<alpha>"
           unfolding h_def f_poly_altdef[OF \<alpha>] higher_pderiv_smult poly_smult ..
         also have "(\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>',1:] ^ (if \<alpha>' = \<alpha> then p - 1 else p)) =
                     [:-\<alpha>,1:]^(p-1) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. [:-\<alpha>',1:]^p)"
           using \<alpha> by (subst prod.If_eq) auto
         also have "poly ((pderiv ^^ (p-1)) \<dots>) \<alpha> = fact (p - 1) * (\<Prod>\<alpha>'\<in>Roots' - {\<alpha>}. (\<alpha> - \<alpha>') ^ p)"
           by (subst poly_higher_pderiv_aux2) (simp_all add: poly_prod)
         finally show ?thesis by (simp only: mult.assoc)
       qed
   
       have "fact (p-1) alg_dvd h \<alpha> (p-1)"
       proof -
         have "fact (p-1) alg_dvd fact (p-1) * (of_int (l^p) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (l*\<alpha>-l*\<alpha>')^p))"
           by (intro alg_dvd_triv_left algebraic_int_times[of "of_int (l^p)"]
                     algebraic_int_prod algebraic_int_power algebraic_int_diff
                     alg_int \<alpha> algebraic_int_of_int) auto
         also have "(\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (l*\<alpha>-l*\<alpha>')^p) = (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. of_int l^p * (\<alpha>-\<alpha>')^p)"
           by (subst power_mult_distrib [symmetric]) (simp_all add: algebra_simps)
         also have "\<dots> = of_int (l ^ (p * (n-1))) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (\<alpha>-\<alpha>')^p)"
           using \<alpha> by (subst prod.distrib) (auto simp: card_Diff_subset n_altdef simp flip: power_mult)
         also have "of_int (l^p) * \<dots> = of_int (l^(p+p*(n-1))) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (\<alpha>-\<alpha>')^p)"
           unfolding mult.assoc [symmetric] power_add [symmetric] of_int_power ..
         also have "p + p * (n - 1) = n * p"
           using \<open>n > 0\<close> by (cases n) (auto simp: mult_ac)
         also have "fact (p - 1) * (of_int (l^(n*p)) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (\<alpha>-\<alpha>')^p)) = h \<alpha> (p-1)"
           unfolding h_\<alpha>_pm1_eq by (simp add: mult_ac)
         finally show ?thesis .
       qed
  
       have "\<not>of_nat p alg_dvd of_int (\<beta> q) * h \<alpha> (p-1)"
         unfolding h_\<alpha>_pm1_eq mult.assoc [symmetric] of_int_mult [symmetric]
       proof
         define r where "r = (\<lambda>\<alpha>. of_int (l^n) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. \<alpha>-\<alpha>'))"
         have alg_int_r: "algebraic_int (r \<alpha>)" if "\<alpha> \<in> Roots'" for \<alpha>
         proof -
           have "algebraic_int (of_int l * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. of_int l * \<alpha> - of_int l * \<alpha>'))"
             by (intro algebraic_int_times[OF algebraic_int_of_int] algebraic_int_prod 
                       algebraic_int_power algebraic_int_diff alg_int that) auto
           also have "\<dots> = of_int l * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. of_int l * (\<alpha> - \<alpha>'))"
             by (simp add: algebra_simps flip: power_mult_distrib)
           also have "\<dots> = of_int (l^(1 + (n-1))) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. \<alpha> - \<alpha>')"
             using that by (simp add: r_def prod.distrib card_Diff_subset
                                      n_altdef power_add mult_ac flip: power_mult)
           also have "1 + (n - 1) = n"
             using \<open>n > 0\<close> by auto
           finally show "algebraic_int (r \<alpha>)"
             unfolding r_def .
         qed
 
         have "(\<Prod>\<alpha>'\<in>Roots'. r \<alpha>') \<in> \<rat>"
         proof -
           obtain Root where Root_bij: "bij_betw Root {..<n} Roots'"
             using ex_bij_betw_nat_finite[OF \<open>finite Roots'\<close>] unfolding n_altdef atLeast0LessThan by metis
           have Root_in_Roots': "Root i \<in> Roots'" if "i < n" for i
             using Root_bij that by (auto simp: bij_betw_def)
 
           define R :: "complex mpoly" where
             "R = (\<Prod>i<n. Const (of_int (l^n)) * (\<Prod>j\<in>{..<n}-{i}. Var i - Var j))"
           have "insertion Root R \<in> \<rat>"
           proof (rule symmetric_poly_of_roots_in_subring)
             show "symmetric_mpoly {..<n} R"
               unfolding R_def
             proof (rule symmetric_mpoly_symmetric_prod'[of _ "\<lambda>\<pi>. \<pi>"], goal_cases)
               case (2 i \<pi>)
               from \<open>\<pi> permutes {..<n}\<close> have [simp]: "bij \<pi>"
                 by (rule permutes_bij)
               have "mpoly_map_vars \<pi> (Const (of_int (l ^ n)) *
                       (\<Prod>j\<in>{..<n} - {i}. Var i - Var j):: complex mpoly) =
                     Const (of_int l ^ n) * (\<Prod>j\<in>{..<n} - {i}. Var (\<pi> i) - Var (\<pi> j))"
                 by simp
               also have "(\<Prod>j\<in>{..<n} - {i}. Var (\<pi> i) - Var (\<pi> j)) =
                          (\<Prod>j\<in>{..<n} - {\<pi> i}. Var (\<pi> i) - Var j)"
                 using 2 permutes_in_image[OF 2(2), of i]
                 by (intro prod.reindex_bij_betw bij_betw_Diff permutes_imp_bij[OF 2(2)])
                    (auto simp: bij_betw_singleton)
               finally show ?case by simp
             qed
           next
             show "vars R \<subseteq> {..<n}" unfolding R_def
               by (intro order.trans[OF vars_prod] UN_least order.trans[OF vars_mult]
                         Un_least order.trans[OF vars_power] order.trans[OF vars_diff])
                  (auto simp: vars_Var)
           next
             show "ring_closed (\<rat> :: complex set)"
               by unfold_locales auto
             then interpret ring_closed "\<rat> :: complex set" .              
             show "\<forall>m. MPoly_Type.coeff R m \<in> \<rat>"
               unfolding R_def
               by (intro allI coeff_prod_closed coeff_mult_closed coeff_power_closed)
                  (auto simp: mpoly_coeff_Const coeff_Var when_def)
           next
             let ?lc = "of_int (\<Prod>p\<in>P. Polynomial.lead_coeff p) :: complex"
             have "(\<Prod>q\<in>P. of_int_poly q) = (\<Prod>q\<in>P. Polynomial.smult
                     (of_int (Polynomial.lead_coeff q)) (\<Prod>x\<in>Roots q. [:-x, 1:]))"
               by (intro prod.cong of_int_poly_P refl)
             also have "\<dots> = Polynomial.smult ?lc (\<Prod>q\<in>P. \<Prod>x\<in>Roots q. [:-x, 1:])"
               by (simp add: prod_smult)
             also have "(\<Prod>q\<in>P. \<Prod>x\<in>Roots q. [:-x, 1:]) = (\<Prod>x\<in>Roots'. [:-x, 1:])"
               unfolding Roots'_def using disjoint
               by (intro prod.UNION_disjoint [symmetric]) (auto simp: disjoint_family_on_def)
             also have "\<dots> = (\<Prod>i<n. [:- Root i, 1:])"
               by (intro prod.reindex_bij_betw [symmetric] Root_bij)
             finally show "of_int_poly (\<Prod>P) = Polynomial.smult ?lc (\<Prod>i<n. [:- Root i, 1:])"
               by (simp add: of_int_poly_hom.hom_prod)
             have "prod Polynomial.lead_coeff P \<noteq> 0"
               by (intro prod_nonzeroI) auto
             thus "inverse ?lc * ?lc = 1" "inverse ?lc \<in> \<rat>"
               by (auto simp: field_simps simp flip: of_int_prod)
           qed auto
           also have "insertion Root R = (\<Prod>i<n. of_int (l^n) * (\<Prod>j\<in>{..<n}-{i}. Root i - Root j))"
             by (simp add: R_def insertion_prod insertion_mult insertion_power insertion_diff)
           also have "\<dots> = (\<Prod>i<n. of_int (l^n) * (\<Prod>\<alpha>'\<in>Roots'-{Root i}. Root i - \<alpha>'))"
           proof (intro prod.cong, goal_cases)
             case (2 i)
             hence "(\<Prod>j\<in>{..<n}-{i}. Root i - Root j) = (\<Prod>\<alpha>'\<in>Roots'-{Root i}. Root i - \<alpha>')"
               by (intro prod.reindex_bij_betw bij_betw_Diff Root_bij)
                  (auto intro: Root_in_Roots' simp: bij_betw_singleton)
             thus ?case by simp
           qed auto
           also have "\<dots> = (\<Prod>\<alpha>'\<in>Roots'. r \<alpha>')"
             unfolding r_def by (intro prod.reindex_bij_betw Root_bij)
           finally show "(\<Prod>\<alpha>'\<in>Roots'. r \<alpha>') \<in> \<rat>" .
         qed
         moreover have "algebraic_int (\<Prod>\<alpha>'\<in>Roots'. r \<alpha>')"
           by (intro algebraic_int_prod alg_int_r)
         ultimately have is_int: "(\<Prod>\<alpha>'\<in>Roots'. r \<alpha>') \<in> \<int>"
           using rational_algebraic_int_is_int by blast
         then obtain R' where R': "(\<Prod>\<alpha>'\<in>Roots'. r \<alpha>') = of_int R'"
           by (elim Ints_cases)
         have "(\<Prod>\<alpha>'\<in>Roots'. r \<alpha>') \<noteq> 0"
           using \<open>l > 0\<close> by (intro prod_nonzeroI) (auto simp: r_def \<open>finite Roots'\<close>)
         with R' have [simp]: "R' \<noteq> 0"
           by auto
 
         assume "of_nat p alg_dvd of_int (\<beta> q * l^(n*p)) * fact (p-1) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (\<alpha>-\<alpha>') ^ p)"
         also have "\<dots> = of_int (\<beta> q) * fact (p-1) * r \<alpha> ^ p"
           by (simp add: r_def mult_ac power_mult_distrib power_mult prod_power_distrib)
         also have "\<dots> alg_dvd of_int (\<beta> q) * fact (p-1) * r \<alpha> ^ p * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. r \<alpha>') ^ p"
           by (intro alg_dvd_triv_left algebraic_int_prod alg_int_r algebraic_int_power) auto
         also have "\<dots> = of_int (\<beta> q) * fact (p-1) * (\<Prod>\<alpha>'\<in>Roots'. r \<alpha>') ^ p"
           using \<alpha> by (subst (2) prod.remove[of _ "\<alpha>"]) (auto simp: mult_ac power_mult_distrib)
         also have "\<dots> = of_int (\<beta> q * fact (p - 1) * R' ^ p)"
           by (simp add: R')
         also have "of_nat p = of_int (int p)"
           by simp
         finally have "int p dvd \<beta> q * fact (p - 1) * R' ^ p" 
           by (subst (asm) alg_dvd_of_int_iff)
         moreover have "prime (int p)"
           using \<open>prime p\<close> by auto
         ultimately have "int p dvd \<beta> q \<or> int p dvd fact (p - 1) \<or> int p dvd R' ^ p"
           by (simp add: prime_dvd_mult_iff)
         moreover have "\<not>int p dvd \<beta> q"
         proof
           assume "int p dvd \<beta> q"
           hence "int p \<le> \<bar>\<beta> q\<bar>"
             using \<beta>_nz[of q] dvd_imp_le_int[of "\<beta> q" "int p"] q by auto
           with p_ineqs(1) q show False by auto
         qed
         moreover have "\<not>int p dvd fact (p - 1)"
         proof -
           have "\<not>p dvd fact (p - 1)"
             using \<open>p > 1\<close> p by (subst prime_dvd_fact_iff) auto
           hence "\<not>int p dvd int (fact (p - 1))"
             by (subst int_dvd_int_iff)
           thus ?thesis unfolding of_nat_fact .
         qed
         moreover have "\<not>int p dvd R' ^ p"
         proof
           assume "int p dvd R' ^ p"
           hence "int p dvd R'"
             using \<open>prime (int p)\<close> prime_dvd_power by metis
           hence "int p \<le> \<bar>R'\<bar>"
             using \<beta>_nz[of q] dvd_imp_le_int[of R' "int p"] q by auto
           hence "real p \<le> real_of_int \<bar>R'\<bar>"
             by linarith
           also have "\<dots> = norm (\<Prod>\<alpha>\<in>Roots'. r \<alpha>)"
             unfolding R' by simp
           finally show False unfolding r_def using p_ineqs(2)
             by linarith
         qed
         ultimately show False
           by blast
       qed
   
       have fact_p_dvd: "fact p alg_dvd h \<alpha>' j" if "\<alpha>' \<in> Roots'" "\<alpha>' \<noteq> \<alpha> \<or> j \<noteq> p - 1" for \<alpha>' j
       proof (cases "j \<ge> p")
         case False
         with that have j: "j < (if \<alpha>' = \<alpha> then p - 1 else p)"
           by auto
         have "h \<alpha>' j = 0"
           unfolding h_def f_poly_altdef[OF \<alpha>]
           by (intro poly_higher_pderiv_aux1'[OF j] dvd_smult dvd_prodI that) auto
         thus ?thesis by simp
       next
         case True
         define e where "e = (\<lambda>x. if x = \<alpha> then p - 1 else p)"
         define Q where "Q = (\<Prod>x\<in>Roots'. [:-x, 1:] ^ e x)"
         define Q' where "Q' = Polynomial.smult (of_int (l^(n*p+j))) (pcompose Q [:0, 1 / of_int l:])"
         have "poly ((pderiv ^^ j) Q) \<alpha>' / l ^ j =
                 poly ((pderiv ^^ j) (pcompose Q [:0, 1 / of_int l:])) (l * \<alpha>')"
           using \<open>l > 0\<close> by (simp add: higher_pderiv_pcompose_linear poly_pcompose field_simps)
 
         have "sum e Roots' = (n - 1) * p + (p - 1)"
           unfolding e_def using \<alpha>
           by (subst sum.If_eq) (auto simp: card_Diff_subset n_altdef algebra_simps)
         also have "\<dots> = n * p - 1"
           using \<open>n > 0\<close> \<open>p > 1\<close> by (cases n) auto
         finally have [simp]: "sum e Roots' = n * p - 1" .
 
         have "h \<alpha>' j = of_int (l^(n*p)) * poly ((pderiv ^^ j) Q) \<alpha>'"
           unfolding h_def f_poly_altdef[OF \<alpha>] higher_pderiv_smult poly_smult e_def Q_def ..
         also have "poly ((pderiv ^^ j) Q) \<alpha>' =
                      of_int l ^ j * poly ((pderiv ^^ j) (pcompose Q [:0, 1 / of_int l:])) (l * \<alpha>')"
           using \<open>l > 0\<close> by (simp add: higher_pderiv_pcompose_linear poly_pcompose field_simps)
         also have "of_int (l ^ (n * p)) * \<dots> = poly ((pderiv ^^ j) Q') (l * \<alpha>')"
           by (simp add: Q'_def higher_pderiv_smult power_add)
         also have "fact p alg_dvd \<dots>"
         proof (rule fact_alg_dvd_poly_higher_pderiv)
           show "j \<ge> p" by fact
           show "algebraic_int (of_int l * \<alpha>')"
             by (rule alg_int) fact
           interpret alg_int: ring_closed "{x::complex. algebraic_int x}"
             by standard auto
           show "algebraic_int (poly.coeff Q' i)" for i
           proof (cases "i \<le> Polynomial.degree Q'")
             case False
             thus ?thesis
               by (simp add: coeff_eq_0)
           next
             case True
             hence "i \<le> n * p - 1" using \<open>l > 0\<close>
               by (simp add: Q'_def degree_prod_eq Q_def degree_power_eq)
             also have "n * p > 0"
               using \<open>n > 0\<close> \<open>p > 1\<close> by auto
             hence "n * p - 1 < n * p"
               by simp
             finally have i: "i < n * p" .
 
             have "poly.coeff Q' i = of_int l ^ (n * p + j) / of_int l ^ i * poly.coeff Q i"
               by (simp add: Q'_def coeff_pcompose_linear field_simps)
             also have "of_int l ^ (n * p + j) = (of_int l ^ (n * p + j - i) :: complex) * of_int l ^ i"
               unfolding power_add [symmetric] using i by simp
             hence "of_int l ^ (n * p + j) / of_int l ^ i = (of_int l ^ (n * p + j - i) :: complex)"
               using \<open>l > 0\<close> by (simp add: field_simps)
             also have "\<dots> * poly.coeff Q i =
                 (\<Sum>X\<in>{X. X \<subseteq> (SIGMA x:Roots'. {..<e x}) \<and> i = n * p - Suc (card X)}.
                 of_int l ^ (n * p + j - (n * p - Suc (card X))) * ((- 1) ^ card X * prod fst X))"
               unfolding Q_def by (subst coeff_prod_linear_factors) (auto simp: sum_distrib_left)
             also have "algebraic_int \<dots>"
             proof (intro algebraic_int_sum, goal_cases)
               case (1 X)
               hence X: "X \<subseteq> (SIGMA x:Roots'. {..<e x})"
                 by auto
               have card_eq: "card (SIGMA x:Roots'. {..<e x}) = n * p - 1"
                 by (subst card_SigmaI) auto
               from X have "card X \<le> card (SIGMA x:Roots'. {..<e x})"
                 by (intro card_mono) auto
               hence "card X \<le> n * p - 1"
                 using card_eq by auto
               also have "\<dots> < n * p"
                 using  \<open>n * p > 0\<close> by simp
               finally have card_less: "card X < n * p" .
               have "algebraic_int ((-1) ^ card X * of_int l ^ (j + 1) * (\<Prod>x\<in>X. of_int l * fst x))"
                 using X by (intro algebraic_int_times algebraic_int_prod alg_int) auto
               thus ?case
                 using card_less by (simp add: power_add prod.distrib mult_ac)
             qed
             finally show ?thesis .
           qed
         qed
         finally show ?thesis .
       qed
   
       have p_dvd: "of_nat p alg_dvd h \<alpha>' j" if "\<alpha>' \<in> Roots'" "\<alpha>' \<noteq> \<alpha> \<or> j \<noteq> p - 1" for \<alpha>' j
       proof -
         have "of_nat p alg_dvd (of_nat (fact p) :: complex)"
           by (intro alg_dvd_of_nat dvd_fact) (use \<open>p > 1\<close> in auto)
         hence "of_nat p alg_dvd (fact p :: complex)"
           by simp
         also have "\<dots> alg_dvd h \<alpha>' j"
           using that by (intro fact_p_dvd)
         finally show ?thesis .
       qed
   
       show "fact (p - 1) alg_dvd J \<alpha>"
         unfolding J_eq'
       proof (intro alg_dvd_uminus_right alg_dvd_sum, safe intro!: alg_dvd_mult algebraic_int_of_int)
         fix q \<alpha>' j
         assume "q \<in> P" "\<alpha>' \<in> Roots q" "j < n * p"
         hence "\<alpha>' \<in> Roots'"
           by (auto simp: Roots'_def)
         show "fact (p - 1) alg_dvd h \<alpha>' j"
         proof (cases "\<alpha>' = \<alpha> \<and> j = p - 1")
           case True
           thus ?thesis using \<open>fact (p - 1) alg_dvd h \<alpha> (p - 1)\<close>
             by simp
         next
           case False
           have "of_int (fact (p - 1)) alg_dvd (of_int (fact p) :: complex)"
             by (intro alg_dvd_of_int fact_dvd) auto
           hence "fact (p - 1) alg_dvd (fact p :: complex)"
             by simp
           also have "\<dots> alg_dvd h \<alpha>' j"
             using False \<open>\<alpha>' \<in> Roots'\<close> by (intro fact_p_dvd) auto
           finally show ?thesis .
         qed
       qed
   
       show "\<not>of_nat p alg_dvd J \<alpha>"
         unfolding J_eq' alg_dvd_uminus_right_iff
       proof (rule not_alg_dvd_sum)
         have "p - 1 < 1 * p"
           using \<open>p > 1\<close> by simp
         also have "1 * p \<le> n * p"
           using \<open>n > 0\<close> by (intro mult_right_mono) auto
         finally show "((q, \<alpha>), p - 1) \<in> Sigma P Roots \<times> {..<n*p}"
           using q \<open>n > 0\<close> by auto
       next
         fix z assume z: "z \<in> Sigma P Roots \<times> {..<n*p}-{((q,\<alpha>),p-1)}"
         from z have "snd (fst z) \<in> Roots'"
           by (auto simp: Roots'_def)
         moreover have "fst (fst z) = q" if "\<alpha> \<in> Roots (fst (fst z))"
         proof -
           have "\<alpha> \<in> Roots (fst (fst z)) \<inter> Roots q" "q \<in> P" "fst (fst z) \<in> P"
             using that q z by auto
           with disjoint show ?thesis
             unfolding disjoint_family_on_def by blast
         qed
         ultimately have "of_nat p alg_dvd h (snd (fst z)) (snd z)"
           using z by (intro p_dvd) auto
         thus  "of_nat p alg_dvd (case z of (x, xa) \<Rightarrow> (case x of (q, \<alpha>') \<Rightarrow> \<lambda>i. of_int (\<beta> q) * h \<alpha>' i) xa)"
           using z by auto
       qed (use \<open>\<not>of_nat p alg_dvd of_int (\<beta> q) * h \<alpha> (p-1)\<close> in auto)
     qed
 
     text \<open>
       Our next goal is to show that $J$ is rational. This is done by repeated applications
       of the fundamental theorem of symmetric polynomials, exploiting the fact that $J$ is
       symmetric in all the $\alpha_i$ for each set of conjugates.
     \<close>
     define g :: "int poly poly"
       where "g = synthetic_div (map_poly (\<lambda>x. [:x:])
                    ((Polynomial.smult lc_factor (\<Prod>P)) ^ p)) [:0, 1:]"
     have g: "map_poly (\<lambda>p. ipoly p \<alpha>) g = f_poly \<alpha>" if \<alpha>: "\<alpha> \<in> Roots'" for \<alpha>
     proof -
       interpret \<alpha>: comm_ring_hom "\<lambda>p. ipoly p \<alpha>"
         by standard (auto simp: of_int_hom.poly_map_poly_eval_poly of_int_poly_hom.hom_mult)
       define Q :: "int poly" where "Q = (Polynomial.smult lc_factor (\<Prod>P)) ^ p"
       have "f_poly \<alpha> = Polynomial.smult (of_int (l^(n*p))) ((\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>',1:])^p) div [:-\<alpha>,1:]"
         unfolding f_poly_def div_smult_left [symmetric] prod_power_distrib[symmetric] ..
       also have "of_int (l^(n*p)) = (of_int l^n)^p"
         by (simp add: power_mult)
       also have "Polynomial.smult \<dots> ((\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>',1:])^p) =
                    (Polynomial.smult (of_int l ^ n) (\<Prod>\<alpha>'\<in>Roots'. [:-\<alpha>',1:])) ^ p"
         by (simp only: smult_power)
       also have "\<dots> = of_int_poly Q"
         by (subst lc_factor) (simp_all add: Q_def of_int_poly_hom.hom_power)
       also have "\<dots> div [:-\<alpha>, 1:] = synthetic_div (of_int_poly Q) \<alpha>"
         unfolding synthetic_div_altdef ..
       also have "\<dots> = synthetic_div (map_poly (\<lambda>p. ipoly p \<alpha>) (map_poly (\<lambda>x. [:x:]) Q)) (ipoly [:0, 1:] \<alpha>)"
         by (simp add: map_poly_map_poly o_def)
       also have "\<dots> = map_poly (\<lambda>p. ipoly p \<alpha>) g"
         unfolding g_def Q_def by (rule \<alpha>.synthetic_div_hom)
       finally show ?thesis ..
     qed
 
     obtain Q where Q: "J \<alpha> = -(\<Sum>q\<in>P. of_int (\<beta> q) * eval_poly of_rat (Q q) \<alpha>)"
       if "\<alpha> \<in> Roots'" for \<alpha>
     proof -
       define g' :: "nat \<Rightarrow> complex poly poly"
         where "g' = (\<lambda>j.  (map_poly of_int_poly ((pderiv ^^ j) g)))"
       obtain root :: "int poly \<Rightarrow> nat \<Rightarrow> complex"
         where root: "\<And>q. q \<in> P \<Longrightarrow> bij_betw (root q) {..<\<sharp>q} (Roots q)"
         using ex_bij_betw_nat_finite[OF finite_Roots] unfolding n_roots_def atLeast0LessThan
         by metis
       have "\<exists>Q'. map_poly of_rat Q' = (\<Sum>x\<in>Roots q. poly (g' j) [:x:])" if q: "q \<in> P" for q j
       proof -
         define Q :: "nat \<Rightarrow> complex poly mpoly"
           where "Q = (\<lambda>j. (\<Sum>i<\<sharp>q. mpoly_of_poly i (g' j)))"
         define ratpolys :: "complex poly set" where "ratpolys = {p. \<forall>i. poly.coeff p i \<in> \<rat>}"
         have "insertion ((\<lambda>x. [:x:]) \<circ> root q) (Q j) \<in> ratpolys"
         proof (rule symmetric_poly_of_roots_in_subring)
           show "ring_closed ratpolys"
             by standard (auto simp: ratpolys_def intro!: coeff_mult_semiring_closed)
           show "\<forall>m. MPoly_Type.coeff (Q j) m \<in> ratpolys"
             by (auto simp: Q_def ratpolys_def Polynomial.coeff_sum coeff_mpoly_of_poly when_def g'_def
                      intro!: sum_in_Rats)
           show "vars (Q j) \<subseteq> {..<\<sharp>q}" unfolding Q_def
             by (intro order.trans[OF vars_sum] UN_least order.trans[OF vars_mpoly_of_poly]) auto
           show "symmetric_mpoly {..<\<sharp>q} (Q j)" unfolding Q_def
             by (rule symmetric_mpoly_symmetric_sum[of _ id]) (auto simp: permutes_bij)
           interpret coeff_lift_hom: map_poly_idom_hom "\<lambda>x. [:x:]"
             by standard
           define lc :: complex where "lc = of_int (Polynomial.lead_coeff q)"
           have "of_int_poly q = Polynomial.smult (Polynomial.lead_coeff q) (\<Prod>x\<in>Roots q. [:-x, 1:])"
             by (rule of_int_poly_P) fact
           also have "poly_lift \<dots> = Polynomial.smult [:lc:] (\<Prod>a\<in>Roots q. [:-[:a:], 1:])"
             by (simp add: poly_lift_def map_poly_smult coeff_lift_hom.hom_prod lc_def)
           also have "(\<Prod>a\<in>Roots q. [:-[:a:], 1:]) = (\<Prod>i<\<sharp>q. [:-[:root q i:], 1:])"
             by (intro prod.reindex_bij_betw [symmetric] root q)
           also have "\<dots> = (\<Prod>i<\<sharp>q. [:- ((\<lambda>x. [:x:]) \<circ> root q) i, 1:])"
             by simp
           finally show "poly_lift (Ring_Hom_Poly.of_int_poly q) = Polynomial.smult [:lc:] \<dots>" .
           have "lc \<noteq> 0"
             using q by (auto simp: lc_def)
           thus "[:inverse lc:] * [:lc:] = 1"
             by (simp add: field_simps)
         qed (auto simp: ratpolys_def coeff_pCons split: nat.splits)
 
         also have "insertion ((\<lambda>x. [:x:]) \<circ> root q) (Q j) = (\<Sum>i<\<sharp>q. poly (g' j) [:root q i:])"
           by (simp add: Q_def insertion_sum poly_sum)
         also have "\<dots> = (\<Sum>x\<in>Roots q. poly (g' j) [:x:])"
           by (intro sum.reindex_bij_betw root q)
         finally have "\<forall>i. poly.coeff (\<Sum>x\<in>Roots q. poly (g' j) [:x:]) i \<in> \<rat>"
           by (auto simp: ratpolys_def)
         thus ?thesis
           using ratpolyE by metis
       qed
       then obtain Q where Q: "\<And>q j. q \<in> P \<Longrightarrow> map_poly of_rat (Q q j) = (\<Sum>x\<in>Roots q. poly (g' j) [:x:])"
         by metis
       define Q' where "Q' = (\<lambda>q. \<Sum>j<n*p. Q q j)"
 
       have "J \<alpha> = - (\<Sum>q\<in>P. of_int (\<beta> q) * eval_poly of_rat (Q' q) \<alpha>)" if \<alpha>: "\<alpha> \<in> Roots'" for \<alpha>
       proof -
         have "J \<alpha> = -(\<Sum>q\<in>P. of_int (\<beta> q) * (\<Sum>x\<in>Roots q. \<Sum>j<n * p. poly ((pderiv ^^ j) (f_poly \<alpha>)) x))"
           (is "_ = -?S") unfolding J_eq[OF \<alpha>] ..
         also have "?S = (\<Sum>q\<in>P. of_int (\<beta> q) * eval_poly of_rat (Q' q) \<alpha>)"
         proof (rule sum.cong, goal_cases)
           case q: (2 q)
           interpret \<alpha>: idom_hom "\<lambda>p. ipoly p \<alpha>"
             by standard (auto simp: of_int_hom.poly_map_poly_eval_poly of_int_poly_hom.hom_mult)
   
           have "(\<Sum>x\<in>Roots q. \<Sum>j<n * p. poly ((pderiv ^^ j) (f_poly \<alpha>)) x) =
                 (\<Sum>j<n * p. \<Sum>x\<in>Roots q. poly ((pderiv ^^ j) (f_poly \<alpha>)) x)"
             by (rule sum.swap)
           also have "\<dots> = (\<Sum>j<n * p. eval_poly of_rat (Q q j) \<alpha>)"
           proof (rule sum.cong, goal_cases)
             case j: (2 j)
             have "(\<Sum>x\<in>Roots q. poly ((pderiv ^^ j) (f_poly \<alpha>)) x) =
                   (\<Sum>x\<in>Roots q. poly (poly (g' j) [:x:]) \<alpha>)"
             proof (rule sum.cong, goal_cases)
               case (2 x)
               have "poly ((pderiv ^^ j) (f_poly \<alpha>)) x =
                     poly ((pderiv ^^ j) (map_poly (\<lambda>p. ipoly p \<alpha>) g)) x"
                 by (subst g[OF \<alpha>, symmetric]) (rule refl)
               also have "\<dots> = poly (eval_poly ((\<lambda>p. [:poly p \<alpha>:]) \<circ> of_int_poly) ((pderiv ^^ j) g) [:0, 1:]) x"
                 unfolding o_def \<alpha>.map_poly_higher_pderiv [symmetric]
                 by (simp only: \<alpha>.map_poly_eval_poly)
               also have "\<dots> = poly (eval_poly (\<lambda>p. [:poly p \<alpha>:])
                                 (map_poly of_int_poly ((pderiv ^^ j) g)) [:0, 1:]) x"
                 unfolding eval_poly_def by (subst map_poly_map_poly) auto
               also have "\<dots> = poly (poly (map_poly of_int_poly ((pderiv ^^ j) g)) [:x:]) \<alpha>"
                 by (rule poly_poly_eq [symmetric])
               also have "\<dots> = poly (poly (g' j) [:x:]) \<alpha>"
                 by (simp add: g'_def)
               finally show ?case .
             qed auto
             also have "\<dots> = poly (\<Sum>x\<in>Roots q. poly (g' j) [:x:]) \<alpha>"
               by (simp add: poly_sum)
             also have "\<dots> = eval_poly of_rat (Q q j) \<alpha>"
               using q by (simp add: Q eval_poly_def)
             finally show ?case .
           qed auto
           also have "\<dots> = eval_poly of_rat (Q' q) \<alpha>"
             by (simp add: Q'_def of_rat_hom.eval_poly_sum)
           finally show ?case by simp
         qed auto
         finally show "J \<alpha> = - (\<Sum>q\<in>P. of_int (\<beta> q) * eval_poly of_rat (Q' q) \<alpha>)" .
       qed
       thus ?thesis using that[of Q'] by metis
     qed
 
     have "J' \<in> \<rat>"
     proof -
       have "(\<Prod>\<alpha>\<in>Roots q. J \<alpha>) \<in> \<rat>" if q: "q \<in> P" for q
       proof -
         obtain root where root: "bij_betw root {..<\<sharp>q} (Roots q)"
           using ex_bij_betw_nat_finite[OF finite_Roots[OF q]]
           unfolding atLeast0LessThan n_roots_def by metis
         define Q' :: "complex poly"
           where "Q' = -(\<Sum>q\<in>P. Polynomial.smult (of_int (\<beta> q)) (map_poly of_rat (Q q)))"
 
         have "(\<Prod>\<alpha>\<in>Roots q. J \<alpha>) = (\<Prod>\<alpha>\<in>Roots q. -(\<Sum>q\<in>P. of_int (\<beta> q) * eval_poly of_rat (Q q) \<alpha>))"
           by (intro prod.cong refl Q) (auto simp: Roots'_def q)
         also have "\<dots> = (\<Prod>\<alpha>\<in>Roots q. poly Q' \<alpha>)"
           by (simp add: Q'_def poly_sum eval_poly_def)
         also have "\<dots> = (\<Prod>i<\<sharp>q. poly Q' (root i))"
           by (intro prod.reindex_bij_betw [symmetric] root)
         also have "\<dots> = insertion root (\<Prod>i<\<sharp>q. mpoly_of_poly i Q')"
           by (simp add: insertion_prod)
         also have "\<dots> \<in> \<rat>"
         proof (rule symmetric_poly_of_roots_in_subring)
           show "ring_closed (\<rat> :: complex set)"
             by standard auto
           then interpret Q: ring_closed "\<rat> :: complex set" .
           show "\<forall>m. MPoly_Type.coeff (\<Prod>i<\<sharp>q. mpoly_of_poly i Q') m \<in> \<rat>"
             by (auto intro!: Q.coeff_prod_closed sum_in_Rats
                      simp: coeff_mpoly_of_poly when_def Q'_def Polynomial.coeff_sum)
           show "symmetric_mpoly {..<\<sharp>q} (\<Prod>i<\<sharp>q. mpoly_of_poly i Q')"
             by (intro symmetric_mpoly_symmetric_prod'[of _ id]) (auto simp: permutes_bij)
           show "vars (\<Prod>i<\<sharp>q. mpoly_of_poly i Q') \<subseteq> {..<\<sharp>q}"
             by (intro order.trans[OF vars_prod] order.trans[OF vars_mpoly_of_poly] UN_least) auto
           define lc where "lc = (of_int (Polynomial.lead_coeff q) :: complex)"
           have "of_int_poly q = Polynomial.smult lc (\<Prod>x\<in>Roots q. [:- x, 1:])"
             unfolding lc_def by (rule of_int_poly_P) fact
           also have "(\<Prod>x\<in>Roots q. [:- x, 1:]) = (\<Prod>i<\<sharp>q. [:- root i, 1:])"
             by (intro prod.reindex_bij_betw [symmetric] root)
           finally show "of_int_poly q = Polynomial.smult lc (\<Prod>i<\<sharp>q. [:- root i, 1:])" .
           have "lc \<noteq> 0"
             using q by (auto simp: lc_def)
           thus "inverse lc * lc = 1" "inverse lc \<in> \<rat>"
             by (auto simp: lc_def)
         qed auto
         finally show ?thesis .
       qed
       hence "(\<Prod>q\<in>P. \<Prod>\<alpha>\<in>Roots q. J \<alpha>) \<in> \<rat>"
         by (rule prod_in_Rats)
       also have "(\<Prod>q\<in>P. \<Prod>\<alpha>\<in>Roots q. J \<alpha>) = J'"
         unfolding Roots'_def J'_def using disjoint
         by (intro prod.UNION_disjoint [symmetric]) (auto simp: disjoint_family_on_def)
       finally show "J' \<in> \<rat>" .
     qed
 
     text \<open>
       Since \<open>J'\<close> is clearly an algebraic integer, we now know that it is in fact an integer.
     \<close>
     moreover have "algebraic_int J'"
       unfolding J'_def 
     proof (intro algebraic_int_prod)
       fix x assume "x \<in> Roots'"
       hence "fact (p - 1) alg_dvd J x"
         by (intro J)
       thus "algebraic_int (J x)"
         by (rule alg_dvd_imp_algebraic_int) auto
     qed
     ultimately have "J' \<in> \<int>"
       using rational_algebraic_int_is_int by blast
 
     text \<open>
       It is also non-zero, as none of the $J_i$ have $p$ as a factor and such cannot be zero.
     \<close>
     have "J' \<noteq> 0"
       unfolding J'_def
     proof (intro prod_nonzeroI)
       fix \<alpha> assume "\<alpha> \<in> Roots'"
       hence "\<not>of_nat p alg_dvd J \<alpha>"
         using J(2)[of \<alpha>] by auto
       thus "J \<alpha> \<noteq> 0"
         by auto
     qed
 
     text \<open>
       It then clearly follows that $(p-1)!^n \leq J$:
     \<close>
     have "fact (p - 1) ^ n alg_dvd J'"
     proof -
       have "fact (p - 1) ^ n = (\<Prod>\<alpha>\<in>Roots'. fact (p - 1))"
         by (simp add: n_altdef)
       also have "\<dots> alg_dvd J'"
         unfolding J'_def by (intro prod_alg_dvd_prod J(1))
       finally show ?thesis .
     qed
   
     have "fact (p - 1) ^ n \<le> norm J'"
     proof -
       from \<open>J' \<in> \<int>\<close> obtain J'' where [simp]: "J' = of_int J''"
         by (elim Ints_cases)
       have "of_int (fact (p - 1) ^ n) = (fact (p - 1) ^ n :: complex)"
         by simp
       also have "\<dots> alg_dvd J'"
         by fact
       also have "J' = of_int J''"
         by fact
       finally have "fact (p - 1) ^ n dvd J''"
         by (subst (asm) alg_dvd_of_int_iff)
       moreover from \<open>J' \<noteq> 0\<close> have "J'' \<noteq> 0"
         by auto
       ultimately have "\<bar>J''\<bar> \<ge> \<bar>fact (p - 1) ^ n\<bar>"
         by (intro dvd_imp_le_int)
       hence "real_of_int \<bar>J''\<bar> \<ge> real_of_int \<bar>fact (p - 1) ^ n\<bar>"
         by linarith
       also have "real_of_int \<bar>J''\<bar> = norm J'"
         by simp
       finally show ?thesis
         by simp
     qed
 
     text \<open>The standard M-L bound for $I_i(x)$ shows the following inequality:\<close>
     also have "norm J' \<le> C' * C p ^ n"
     proof -
       have "norm J' = (\<Prod>x\<in>Roots'. norm (J x))"
         unfolding J'_def prod_norm [symmetric] ..
       also have "\<dots> \<le> (\<Prod>x\<in>Roots'. \<Sum>q\<in>P. real_of_int \<bar>\<beta> q\<bar> * (\<Sum>\<alpha>\<in>Roots q. cmod \<alpha> * exp (cmod \<alpha>) * C p))"
       proof (intro prod_mono conjI)
         fix x assume x: "x \<in> Roots'"
         show "norm (J x) \<le> (\<Sum>q\<in>P. real_of_int \<bar>\<beta> q\<bar> * (\<Sum>\<alpha>\<in>Roots q. norm \<alpha> * exp (norm \<alpha>) * C p))"
           unfolding J_def
         proof (intro sum_norm_le)
           fix q assume "q \<in> P"
           show "norm (of_int (\<beta> q) * sum (I x) (Roots q)) \<le>
                   real_of_int \<bar>\<beta> q\<bar> * (\<Sum>\<alpha>\<in>Roots q. norm \<alpha> * exp (norm \<alpha>) * C p)"
             unfolding norm_mult norm_of_int of_int_abs
           proof (intro mult_left_mono sum_norm_le)
             fix \<alpha> assume "\<alpha> \<in> Roots q"
             hence \<alpha>: "\<alpha> \<in> Roots'"
               using \<open>q \<in> P\<close> by (auto simp: Roots'_def)
             show "norm (I x \<alpha>) \<le> norm \<alpha> * exp (norm \<alpha>) * C p"
               unfolding I_def
             proof (intro lindemann_weierstrass_aux.lindemann_weierstrass_integral_bound)
               fix t assume "t \<in> closed_segment 0 \<alpha>"
               also have "closed_segment 0 \<alpha> \<subseteq> cball 0 R"
                 using \<open>R \<ge> 0\<close> R_ge[OF \<alpha>] by (intro closed_segment_subset) auto
               finally have "norm t \<le> R" by simp
   
               have norm_diff_le: "norm (t - y) \<le> 2 * R" if "y \<in> Roots'" for y
               proof -
                 have "norm (t - y) \<le> norm t + norm y"
                   by (meson norm_triangle_ineq4)
                 also have "\<dots> \<le> R + R"
                   by (intro add_mono[OF \<open>norm t \<le> R\<close> R_ge] that)
                 finally show ?thesis by simp
               qed
   
               have "norm (poly (f_poly x) t) =
                       \<bar>real_of_int l\<bar> ^ (n * p) * (\<Prod>y\<in>Roots'. cmod (t - y) ^ (if y = x then p - 1 else p))"
                 by (simp add: eval_f x f_def norm_mult norm_power flip: prod_norm)
               also have "\<dots> \<le> \<bar>real_of_int l\<bar> ^ (n * p) * (\<Prod>y\<in>Roots'. (2*R) ^ (if y = x then p - 1 else p))"
                 by (intro mult_left_mono prod_mono conjI power_mono norm_diff_le) auto
               also have "\<dots> = \<bar>real_of_int l\<bar>^(n*p) * (2^(p-1) * R^(p-1) * (2^p*R^p)^(n-1))"
                 using x by (subst prod.If_eq) (auto simp: card_Diff_subset n_altdef)
               also have "2^(p-1) * R^(p-1) * (2^p*R^p)^(n-1) = (2^((p-1)+p*(n-1))) * (R^((p-1)+p*(n-1)))"
                 unfolding power_mult power_mult_distrib power_add by (simp add: mult_ac)
               also have "(p-1)+p*(n-1) = p*n - 1"
                 using \<open>n > 0\<close> \<open>p > 1\<close> by (cases n) (auto simp: algebra_simps)
               also have "2 ^ (p * n - 1) * R ^ (p * n - 1) = (2*R)^(n * p-1)"
                 unfolding power_mult_distrib by (simp add: mult_ac)
               finally show "norm (poly (f_poly x) t) \<le> C p"
                 unfolding C_def using \<open>l > 0\<close> by simp
             qed (use \<open>R \<ge> 0\<close> \<open>l > 0\<close> in \<open>auto simp: C_def\<close>)
           qed auto
         qed
       qed auto
       also have "\<dots> = C' * C p ^ n"
         by (simp add: C'_def power_mult_distrib n_altdef flip: sum_distrib_right mult.assoc)
       finally show ?thesis .
     qed
 
     text \<open>And with that, we have our inequality:\<close>
     finally show "fact (p - 1) ^ n \<le> C' * C p ^ n" .
   qed
 
   text \<open>
     Some simple asymptotic estimates show that this is clearly a contradiction, since
     the left-hand side grows much faster than the right-hand side and there are infinitely many
     sufficiently large primes:
   \<close>
   have freq: "frequently prime sequentially"
     using frequently_prime_cofinite unfolding cofinite_eq_sequentially .
   have ev: "eventually (\<lambda>p. (\<forall>q\<in>P.  int p > \<bar>\<beta> q\<bar>) \<and>
               real p > norm (\<Prod>\<alpha>\<in>Roots'. of_int (l^n) * (\<Prod>\<alpha>'\<in>Roots'-{\<alpha>}. (\<alpha>-\<alpha>')))) sequentially"
     by (intro eventually_ball_finite \<open>finite P\<close> ballI eventually_conj filterlim_real_sequentially
           eventually_compose_filterlim[OF eventually_gt_at_top] filterlim_int_sequentially)
 
   have "frequently (\<lambda>p. fact (p - 1) ^ n \<le> C' * C p ^ n) sequentially"
     by (rule frequently_eventually_mono[OF freq ev]) (use ineq in blast)
   moreover have "eventually (\<lambda>p. fact (p - 1) ^ n > C' * C p ^ n) sequentially"
   proof (cases "R = 0")
     case True
     have "eventually (\<lambda>p. p * n > 1) at_top" using \<open>n > 0\<close>
       by (intro eventually_compose_filterlim[OF eventually_gt_at_top] mult_nat_right_at_top)
     thus ?thesis 
       by eventually_elim (use \<open>n > 0\<close> True in \<open>auto simp: C_def power_0_left mult_ac\<close>)
   next
     case False
     hence "R > 0"
       using \<open>R \<ge> 0\<close> by auto
     define D :: real where "D = (2 * R * \<bar>real_of_int l\<bar>) ^ n" 
     have "D > 0"
       using \<open>R > 0\<close> \<open>l > 0\<close> unfolding D_def by (intro zero_less_power) auto
 
     have "(\<lambda>p. C' * C p ^ n) \<in> O(\<lambda>p. C p ^ n)"
       by simp
     also have "(\<lambda>p. C p ^ n) \<in> O(\<lambda>p. ((2 * R * l) ^ (n * p)) ^ n)"
     proof (rule landau_o.big_power[OF bigthetaD1])
       have np: "eventually (\<lambda>p. p * n > 0) at_top" using \<open>n > 0\<close>
         by (intro eventually_compose_filterlim[OF eventually_gt_at_top] mult_nat_right_at_top)
       have "eventually (\<lambda>p. (2 * R) * C p = (2 * R * l) ^ (n * p)) at_top"
         using np
       proof eventually_elim
         case (elim p)
         have "2 * R * C p = l ^ (n * p) * (2 * R) ^ (Suc (n * p - 1))"
           by (simp add: C_def algebra_simps)
         also have "Suc (n * p - 1) = n * p"
           using elim by auto
         finally show ?case
           by (simp add: algebra_simps)
       qed
       hence "(\<lambda>p. (2 * R) * C p) \<in> \<Theta>(\<lambda>p. (2 * R * l) ^ (n * p))"
         by (intro bigthetaI_cong)
       thus "C \<in> \<Theta>(\<lambda>p. (2 * R * l) ^ (n * p))"
         using \<open>R > 0\<close> by simp
     qed
     also have "\<dots> = O(\<lambda>p. (D ^ p) ^ n)"
       using \<open>l > 0\<close> by (simp flip: power_mult add: power2_eq_square mult_ac D_def)
     also have "(\<lambda>p. (D ^ p) ^ n) \<in> o(\<lambda>p. fact (p - 1) ^ n)"
     proof (intro landau_o.small_power)
       have "eventually (\<lambda>p. D ^ p = D * D ^ (p - 1)) at_top"
         using eventually_gt_at_top[of 0]
         by eventually_elim (use \<open>D > 0\<close> in \<open>auto simp flip: power_Suc\<close>)
       hence "(\<lambda>p. D ^ p) \<in> \<Theta>(\<lambda>p. D * D ^ (p - 1))"
         by (intro bigthetaI_cong)
       hence "(\<lambda>p. D ^ p) \<in> \<Theta>(\<lambda>p. D ^ (p - 1))"
         using \<open>D > 0\<close> by simp
       also have "(\<lambda>p. D ^ (p - 1)) \<in> o(\<lambda>p. fact (p - 1))"
         by (intro smalloI_tendsto[OF filterlim_compose[OF power_over_fact_tendsto_0]]
-                  filterlim_minus_nat_at_top) auto
+                  filterlim_minus_const_nat_at_top) auto
       finally show "(\<lambda>p. D ^ p) \<in> o(\<lambda>x. fact (x - 1))" .
     qed fact+
     finally have smallo: "(\<lambda>p. C' * C p ^ n) \<in> o(\<lambda>p. fact (p - 1) ^ n)" .
     have "eventually (\<lambda>p. \<bar>C' * C p ^ n\<bar> \<le> 1/2 * fact (p - 1) ^ n) at_top"
       using landau_o.smallD[OF smallo, of "1/2"] by simp
     thus "eventually (\<lambda>p. C' * C p ^ n < fact (p - 1) ^ n) at_top"
     proof eventually_elim
       case (elim p)
       have "C' * C p ^ n \<le> \<bar>C' * C p ^ n\<bar>"
         by simp
       also have "\<dots> \<le> 1/2 * fact (p - 1) ^ n"
         by fact
       also have "\<dots> < fact (p - 1) ^ n"
         by simp
       finally show ?case .
     qed
   qed
   ultimately have "frequently (\<lambda>p::nat. False) sequentially"
     by (rule frequently_eventually_mono) auto
   thus False
     by simp
 qed
 
 
 subsection \<open>Removing the restriction of full sets of conjugates\<close>
 
 text \<open>
   We will now remove the restriction that the $\alpha_i$ must occur in full sets of conjugates
   by multiplying the equality with all permutations of roots.
 \<close>
 lemma Hermite_Lindemann_aux2:
   fixes X :: "complex set" and \<beta> :: "complex \<Rightarrow> int"
   assumes "finite X"
   assumes nz:   "\<And>x. x \<in> X \<Longrightarrow> \<beta> x \<noteq> 0"
   assumes alg:  "\<And>x. x \<in> X \<Longrightarrow> algebraic x"
   assumes sum0: "(\<Sum>x\<in>X. of_int (\<beta> x) * exp x) = 0"
   shows   "X = {}"
 proof (rule ccontr)
   assume "X \<noteq> {}"
   note [intro] = \<open>finite X\<close>
 
   text \<open>
     Let \<open>P\<close> be the smallest integer polynomial whose roots are a superset of \<open>X\<close>:
   \<close>
   define P :: "int poly" where "P = \<Prod>(min_int_poly ` X)"
   define Roots :: "complex set" where "Roots = {x. ipoly P x = 0}"
   have [simp]: "P \<noteq> 0"
     using \<open>finite X\<close> by (auto simp: P_def)
   have [intro]: "finite Roots"
     unfolding Roots_def by (intro poly_roots_finite) auto
 
   have "X \<subseteq> Roots"
   proof safe
     fix x assume "x \<in> X"
     hence "ipoly (min_int_poly x) x = 0"
       by (intro ipoly_min_int_poly alg)
     thus "x \<in> Roots"
       using \<open>finite X\<close> \<open>x \<in> X\<close>
       by (auto simp: Roots_def P_def of_int_poly_hom.hom_prod poly_prod)
   qed
 
   have "squarefree (of_int_poly P :: complex poly)"
     unfolding P_def of_int_poly_hom.hom_prod
   proof (rule squarefree_prod_coprime; safe)
     fix x assume "x \<in> X"
     thus "squarefree (of_int_poly (min_int_poly x) :: complex poly)"
       by (intro squarefree_of_int_polyI) auto
   next
     fix x y assume xy: "x \<in> X" "y \<in> X" "min_int_poly x \<noteq> min_int_poly y"
     thus "Rings.coprime (of_int_poly (min_int_poly x)) (of_int_poly (min_int_poly y) :: complex poly)"
       by (intro coprime_of_int_polyI[OF primes_coprime]) auto
   qed
 
   text \<open>
     Since we will need a numbering of these roots, we obtain one:
   \<close>
   define n where "n = card Roots"
   obtain Root where Root: "bij_betw Root {..<n} Roots"
     using ex_bij_betw_nat_finite[OF \<open>finite Roots\<close>] unfolding n_def atLeast0LessThan by metis
   define unRoot :: "complex \<Rightarrow> nat" where "unRoot = inv_into {..<n} Root"
   have unRoot: "bij_betw unRoot Roots {..<n}"
     unfolding unRoot_def by (intro bij_betw_inv_into Root)
   have unRoot_Root [simp]: "unRoot (Root i) = i" if "i < n" for i
     unfolding unRoot_def using Root that by (subst inv_into_f_f) (auto simp: bij_betw_def)
   have Root_unRoot [simp]: "Root (unRoot x) = x" if "x \<in> Roots" for x
     unfolding unRoot_def using Root that by (subst f_inv_into_f) (auto simp: bij_betw_def)
   have [simp, intro]: "Root i \<in> Roots" if "i < n" for i
     using Root that by (auto simp: bij_betw_def)
   have [simp, intro]: "unRoot x < n" if "x \<in> Roots" for x
     using unRoot that by (auto simp: bij_betw_def)
 
   text \<open>
     We will also need to convert between permutations of natural numbers less than \<open>n\<close> and
     permutations of the roots:
   \<close>
   define convert_perm :: "(nat \<Rightarrow> nat) \<Rightarrow> (complex \<Rightarrow> complex)" where
     "convert_perm = (\<lambda>\<sigma> x. if x \<in> Roots then Root (\<sigma> (unRoot x)) else x)"
   have bij_convert: "bij_betw convert_perm {\<sigma>. \<sigma> permutes {..<n}} {\<sigma>. \<sigma> permutes Roots}"
     using bij_betw_permutations[OF Root] unfolding convert_perm_def unRoot_def .
   have permutes_convert_perm [intro]: "convert_perm \<sigma> permutes Roots" if "\<sigma> permutes {..<n}" for \<sigma>
     using that bij_convert unfolding bij_betw_def by blast
   have convert_perm_compose: "convert_perm (\<pi> \<circ> \<sigma>) = convert_perm \<pi> \<circ> convert_perm \<sigma>"
     if "\<pi> permutes {..<n}" "\<sigma> permutes {..<n}" for \<sigma> \<pi>
   proof (intro ext)
     fix x show "convert_perm (\<pi> \<circ> \<sigma>) x = (convert_perm \<pi> \<circ> convert_perm \<sigma>) x"
     proof (cases "x \<in> Roots")
       case True
       thus ?thesis
         using permutes_in_image[OF that(2), of "unRoot x"]
         by (auto simp: convert_perm_def bij_betw_def)
     qed (auto simp: convert_perm_def)
   qed
 
   text \<open>
     We extend the coefficient vector to the new roots by setting their coefficients to 0:
   \<close>
   define \<beta>' where "\<beta>' = (\<lambda>x. if x \<in> X then \<beta> x else 0)"
 
   text \<open>
     We now define the set of all permutations of our roots:
   \<close>
   define perms where "perms = {\<pi>. \<pi> permutes Roots}"
   have [intro]: "finite perms"
     unfolding perms_def by (rule finite_permutations) auto
   have [simp]: "card perms = fact n"
     unfolding perms_def n_def by (intro card_permutations) auto
 
   text \<open>
     The following is the set of all \<open>n!\<close>-tuples of roots, disregarding permutation of components.
     In other words: all multisets of roots with size \<open>n!\<close>.
   \<close>
   define Roots_ms :: "complex multiset set" where
     "Roots_ms = {X. set_mset X \<subseteq> Roots \<and> size X = fact n}"
   have [intro]: "finite Roots_ms"
     unfolding Roots_ms_def by (rule finite_multisets_of_size) auto
 
   text \<open>
     Next, the following is the set of \<open>n!\<close>-tuples whose entries are precisely the multiset \<open>X\<close>:
   \<close>
   define tuples :: "complex multiset \<Rightarrow> ((complex \<Rightarrow> complex) \<Rightarrow> complex) set" where
     "tuples = (\<lambda>X. {f\<in>perms \<rightarrow>\<^sub>E Roots. image_mset f (mset_set perms) = X})"
   have fin_tuples [intro]: "finite (tuples X)" for X
     unfolding tuples_def by (rule finite_subset[of _ "perms \<rightarrow>\<^sub>E Roots", OF _ finite_PiE]) auto
   define tuples' :: "(complex multiset \<times> ((complex \<Rightarrow> complex) \<Rightarrow> complex)) set" where
     "tuples' = (SIGMA X:Roots_ms. tuples X)"
 
   text \<open>
     The following shows that our \<^term>\<open>tuples\<close> definition is stable under permutation of
     the roots.
   \<close>
   have bij_convert': "bij_betw (\<lambda>f. f \<circ> (\<lambda>g. \<sigma> \<circ> g)) (tuples X) (tuples X)"
     if \<sigma>: "\<sigma> permutes Roots" for \<sigma> X
   proof (rule bij_betwI)
     have *: "(\<lambda>f. f \<circ> (\<circ>) \<sigma>) \<in> tuples X \<rightarrow> tuples X" if \<sigma>: "\<sigma> permutes Roots" for \<sigma>
     proof
       fix f assume f: "f \<in> tuples X"
       show "f \<circ> (\<circ>) \<sigma> \<in> tuples X"
         unfolding tuples_def
       proof safe
         fix \<sigma>'
         assume \<sigma>': "\<sigma>' \<in> perms"
         show "(f \<circ> (\<circ>) \<sigma>) \<sigma>' \<in> Roots"
           using permutes_compose[OF _ \<sigma>, of \<sigma>'] \<sigma> \<sigma>' f by (auto simp: perms_def tuples_def)
       next
         fix \<sigma>'
         assume \<sigma>': "\<sigma>' \<notin> perms"
         have "\<not>(\<sigma> \<circ> \<sigma>') permutes Roots"
         proof
           assume "(\<sigma> \<circ> \<sigma>') permutes Roots"
           hence "inv_into UNIV \<sigma> \<circ> (\<sigma> \<circ> \<sigma>') permutes Roots"
             by (rule permutes_compose) (use permutes_inv[OF \<sigma>] in simp_all)
           also have "inv_into UNIV \<sigma> \<circ> (\<sigma> \<circ> \<sigma>') = \<sigma>'"
             by (auto simp: fun_eq_iff permutes_inverses[OF \<sigma>])
           finally show False using \<sigma>' by (simp add: perms_def)
         qed
         thus "(f \<circ> (\<circ>) \<sigma>) \<sigma>' = undefined"
           using f by (auto simp: perms_def tuples_def)
       next
         have "image_mset (f \<circ> (\<circ>) \<sigma>) (mset_set perms) =
               image_mset f (image_mset ((\<circ>) \<sigma>) (mset_set perms))"
           by (rule multiset.map_comp [symmetric])
         also have "image_mset ((\<circ>) \<sigma>) (mset_set perms) = mset_set perms"
           using bij_betw_permutes_compose_left[OF \<sigma>]
           by (subst image_mset_mset_set) (auto simp: bij_betw_def perms_def)
         also have "image_mset f \<dots> = X"
           using f by (auto simp: tuples_def)
         finally show "image_mset (f \<circ> (\<circ>) \<sigma>) (mset_set perms) = X" .
       qed
     qed
 
     show "(\<lambda>f. f \<circ> (\<circ>) \<sigma>) \<in> tuples X \<rightarrow> tuples X"
       by (rule *) fact
     show "(\<lambda>f. f \<circ> (\<circ>) (inv_into UNIV \<sigma>)) \<in> tuples X \<rightarrow> tuples X"
       by (intro * permutes_inv) fact
     show "f \<circ> (\<circ>) \<sigma> \<circ> (\<circ>) (inv_into UNIV \<sigma>) = f" if "f \<in> tuples X" for f
       by (auto simp: fun_eq_iff o_def permutes_inverses[OF \<sigma>])
     show "f \<circ> (\<circ>) (inv_into UNIV \<sigma>) \<circ> (\<circ>) \<sigma> = f" if "f \<in> tuples X" for f
       by (auto simp: fun_eq_iff o_def permutes_inverses[OF \<sigma>])
   qed
 
   text \<open>
     Next, we define the multiset of of possible exponents that we can get for a given
     \<open>n!\<close>-multiset of roots,
   \<close>
   define R :: "complex multiset \<Rightarrow> complex multiset" where
     "R = (\<lambda>X. image_mset (\<lambda>f. \<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)) (mset_set (tuples X)))"
 
   text \<open>
     We show that, for each such multiset, there is a content-free integer polynomial that has
     exactly these exponents as roots. This shows that they form a full set of conjugates (but
     note this polynomial is not necessarily squarefree).
 
     The proof is yet another application of the fundamental theorem of symmetric polynomials.
   \<close>
   obtain Q :: "complex multiset \<Rightarrow> int poly"
     where Q: "\<And>X. X \<in> Roots_ms \<Longrightarrow> poly_roots (of_int_poly (Q X)) = R X"
              "\<And>X. X \<in> Roots_ms \<Longrightarrow> content (Q X) = 1"
   proof -
     {
       fix X :: "complex multiset"
       assume X: "X \<in> Roots_ms"
       define Q :: "complex poly mpoly" where
         "Q = (\<Prod>f\<in>tuples X. Const [:0, 1:] -
                  (\<Sum>\<sigma> | \<sigma> permutes {..<n}. Var (\<sigma> (unRoot (f (convert_perm \<sigma>))))))"
       define Q1 where "Q1 = (\<Prod>f\<in>tuples X. [:- (\<Sum>\<sigma> | \<sigma> permutes Roots. \<sigma> (f \<sigma>)), 1:])"
       define ratpolys :: "complex poly set" where "ratpolys = {p. \<forall>i. poly.coeff p i \<in> \<rat>}"
 
       have "insertion (\<lambda>x. [:Root x:]) Q \<in> ratpolys"
       proof (rule symmetric_poly_of_roots_in_subring[where l = "\<lambda>x. [:x:]"])
         show "ring_closed ratpolys"
           unfolding ratpolys_def by standard (auto intro: coeff_mult_semiring_closed)
         then interpret ratpolys: ring_closed ratpolys .
         have "pCons 0 1 \<in> ratpolys "
           by (auto simp: ratpolys_def coeff_pCons split: nat.splits)
         thus "\<forall>m. MPoly_Type.coeff Q m \<in> ratpolys"
           unfolding Q_def
           by (intro allI ratpolys.coeff_prod_closed)
              (auto intro!: ratpolys.minus_closed ratpolys.sum_closed ratpolys.uminus_closed simp: coeff_Var mpoly_coeff_Const when_def)
       next
         show "ring_homomorphism (\<lambda>x::complex. [:x:])" ..
       next
         have "\<sigma> (unRoot (f (convert_perm \<sigma>))) < n" if "f \<in> tuples X" "\<sigma> permutes {..<n}" for f \<sigma>
         proof -
           have "convert_perm \<sigma> \<in> perms"
             using bij_convert that(2) by (auto simp: bij_betw_def perms_def)
           hence "f (convert_perm \<sigma>) \<in> Roots"
             using that by (auto simp: tuples_def)
           thus ?thesis
             using permutes_in_image[OF that(2)] by simp
         qed
         thus "vars Q \<subseteq> {..<n}"
           unfolding Q_def
           by (intro order.trans[OF vars_prod] UN_least order.trans[OF vars_sum]
                 order.trans[OF vars_diff] Un_least) (auto simp: vars_Var)
       next
         define lc :: complex where "lc = of_int (Polynomial.lead_coeff P)"
         show "[:inverse lc:] \<in> ratpolys"
           by (auto simp: ratpolys_def coeff_pCons lc_def split: nat.splits)
         show "\<forall>i. [:poly.coeff (of_int_poly P) i:] \<in> ratpolys"
           by (auto simp: ratpolys_def coeff_pCons split: nat.splits)
         have "lc \<noteq> 0"
           by (auto simp: lc_def)
         thus "[:inverse lc:] * [:lc:] = 1"
           by auto
         have "rsquarefree (of_int_poly P :: complex poly)"
           using \<open>squarefree (of_int_poly P :: complex poly)\<close> by (intro squarefree_imp_rsquarefree)
         hence "of_int_poly P = Polynomial.smult lc (\<Prod>x\<in>Roots. [:-x, 1:])"
           unfolding lc_def Roots_def of_int_hom.hom_lead_coeff[symmetric]
           by (rule complex_poly_decompose_rsquarefree [symmetric])
         also have "(\<Prod>x\<in>Roots. [:-x, 1:]) = (\<Prod>i<n. [:-Root i, 1:])"
           by (rule prod.reindex_bij_betw[OF Root, symmetric])
         finally show "of_int_poly P = Polynomial.smult lc (\<Prod>i<n. [:- Root i, 1:])" .
       next
         show "symmetric_mpoly {..<n} Q"
           unfolding symmetric_mpoly_def
         proof safe
           fix \<pi> assume \<pi>: "\<pi> permutes {..<n}"
           have "mpoly_map_vars \<pi> Q = (\<Prod>f\<in>tuples X. Const (pCons 0 1) - (\<Sum> \<sigma> | \<sigma> permutes {..<n}.
                   Var ((\<pi> \<circ> \<sigma>) (unRoot (f (convert_perm \<sigma>))))))"
             by (simp add: Q_def permutes_bij[OF \<pi>])
           also have "\<dots> = (\<Prod>f\<in>tuples X. Const (pCons 0 1) - (\<Sum> \<sigma> | \<sigma> permutes {..<n}.
                   Var ((\<pi> \<circ> \<sigma>) (unRoot ((f \<circ> (\<lambda>\<sigma>. convert_perm \<pi> \<circ> \<sigma>)) (convert_perm \<sigma>))))))"
             using \<pi> by (intro prod.reindex_bij_betw [OF bij_convert', symmetric]) auto
           also have "\<dots> = Q"
             unfolding Q_def
           proof (rule prod.cong, goal_cases)
             case (2 f)
             have "(\<Sum> \<sigma> | \<sigma> permutes {..<n}. Var ((\<pi> \<circ> \<sigma>) (unRoot ((f \<circ> (\<lambda>\<sigma>. convert_perm \<pi> \<circ> \<sigma>)) (convert_perm \<sigma>))))) =
                   (\<Sum> \<sigma> | \<sigma> permutes {..<n}. Var ((\<pi> \<circ> \<sigma>) (unRoot (f (convert_perm (\<pi> \<circ> \<sigma>))))))"
               using \<pi> by (intro sum.cong refl, subst convert_perm_compose) simp_all
             also have "\<dots> = (\<Sum> \<sigma> | \<sigma> permutes {..<n}. Var (\<sigma> (unRoot (f (convert_perm \<sigma>)))))"
               using \<pi> by (rule setum_permutations_compose_left [symmetric])
             finally show ?case by simp
           qed auto
           finally show "mpoly_map_vars \<pi> Q = Q" .
         qed
       qed auto
       also have "insertion (\<lambda>x. [:Root x:]) Q = Q1"
         unfolding Q_def Q1_def insertion_prod insertion_sum insertion_diff insertion_Const insertion_Var
       proof (intro prod.cong, goal_cases)
         case f: (2 f)
         have "(\<Sum>\<sigma> | \<sigma> permutes {..<n}. [:Root (\<sigma> (unRoot (f (convert_perm \<sigma>)))):]) =
               (\<Sum>\<sigma> | \<sigma> permutes {..<n}. [:convert_perm \<sigma> (f (convert_perm \<sigma>)):])"
         proof (rule sum.cong, goal_cases)
           case (2 \<sigma>)
           have "convert_perm \<sigma> permutes Roots"
             using bij_convert 2 by (auto simp: bij_betw_def)
           hence "f (convert_perm \<sigma>) \<in> Roots"
             using f by (auto simp: tuples_def perms_def)
           thus ?case by (simp add: convert_perm_def)
         qed simp_all
         also have "\<dots> = (\<Sum>\<sigma> | \<sigma> permutes Roots. [:\<sigma> (f \<sigma>):])"
           by (rule sum.reindex_bij_betw[OF bij_convert])
         finally show ?case
           by (simp flip: pCons_one coeff_lift_hom.hom_sum)
       qed simp_all
       finally have "Q1 \<in> ratpolys"
         by auto
       then obtain Q2 :: "rat poly" where Q2: "Q1 = map_poly of_rat Q2"
         unfolding ratpolys_def using ratpolyE[of Q1] by blast
 
       have "Q1 \<noteq> 0"
         unfolding Q1_def using fin_tuples[of X] by auto
       with Q2 have "Q2 \<noteq> 0"
         by auto
       obtain Q3 :: "int poly" and lc :: rat
         where Q3: "Q2 = Polynomial.smult lc (of_int_poly Q3)" and "lc > 0" and "content Q3 = 1"
         using rat_to_normalized_int_poly_exists[OF \<open>Q2 \<noteq> 0\<close>] by metis
 
       have "poly_roots (of_int_poly Q3) = poly_roots (map_poly (of_rat \<circ> of_int) Q3)"
         by simp
       also have "map_poly (of_rat \<circ> of_int) Q3 = map_poly of_rat (map_poly of_int Q3)"
         by (subst map_poly_map_poly) auto
       also have "poly_roots \<dots> = poly_roots (Polynomial.smult (of_rat lc) \<dots>)"
         using \<open>lc > 0\<close> by simp
       also have "Polynomial.smult (of_rat lc) (map_poly of_rat (map_poly of_int Q3)) =
                  map_poly of_rat (Polynomial.smult lc (map_poly of_int Q3))"
         by (simp add: of_rat_hom.map_poly_hom_smult)
       also have "\<dots> = Q1"
         by (simp only: Q3 [symmetric] Q2 [symmetric])
       also have "poly_roots Q1 = R X"
         unfolding Q1_def
         by (subst poly_roots_prod, force, subst poly_roots_linear)
            (auto simp: R_def perms_def sum_mset_image_mset_singleton sum_unfold_sum_mset)
       finally have "\<exists>Q. poly_roots (of_int_poly Q) = R X \<and> content Q = 1"
         using \<open>content Q3 = 1\<close> by metis
     }
     hence "\<exists>Q. \<forall>X\<in>Roots_ms. poly_roots (of_int_poly (Q X)) = R X \<and> content (Q X) = 1"
       by metis
     thus ?thesis using that by metis
   qed
 
   text \<open>
     We can now collect all the $e^{\sum \alpha_i}$ that happen to be equal and let the following
     be their coefficients:
   \<close>
   define \<beta>'' :: "int poly \<Rightarrow> int"
     where "\<beta>'' = (\<lambda>q. \<Sum>X\<in>Roots_ms. int (count (prime_factorization (Q X)) q) * (\<Prod>x\<in>#X. \<beta>' x))"
   have supp_\<beta>'': "{q. \<beta>'' q \<noteq> 0} \<subseteq> (\<Union>X\<in>Roots_ms. prime_factors (Q X))"
     unfolding \<beta>''_def using sum.not_neutral_contains_not_neutral by fastforce
 
   text \<open>
     We have to prove that \<open>\<beta>''\<close> is not zero everywhere. We do this by selecting the nonzero term
     with the maximal exponent (w.r.t. the lexicographic ordering on the complex numbers) in every
     factor of the product and show that there is no other summand corresponding to these, so
     that their non-zero coefficient cannot get cancelled.
   \<close>
   have "{q. \<beta>'' q \<noteq> 0} \<noteq> {}"
   proof -
     define f where "f = restrict (\<lambda>\<sigma>. inv_into UNIV \<sigma> (complex_lex.Max (\<sigma> ` X))) perms"
     have f: "f \<in> perms \<rightarrow> X"
     proof
       fix \<sigma> assume \<sigma>: "\<sigma> \<in> perms"
       have "complex_lex.Max (\<sigma> ` X) \<in> \<sigma> ` X"
         using \<open>X \<noteq> {}\<close> by (intro complex_lex.Max_in finite_imageI) auto
       thus "f \<sigma> \<in> X"
         using \<sigma> by (auto simp: f_def permutes_inverses[of \<sigma> Roots] perms_def)
     qed
     hence f': "f \<in> perms \<rightarrow>\<^sub>E Roots"
       using \<open>X \<subseteq> Roots\<close> by (auto simp: f_def PiE_def)
 
     define Y where "Y = image_mset f (mset_set perms)"
     have "Y \<in> Roots_ms" using f' \<open>finite perms\<close>
       by (auto simp: Roots_ms_def Y_def)
 
     have "(\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)) \<in># R Y"
     proof -
       from f' have "f \<in> tuples Y"
         unfolding tuples_def Y_def by simp
       thus ?thesis
         unfolding R_def using fin_tuples[of Y] by auto
     qed
     also have "R Y = poly_roots (of_int_poly (Q Y))"
       by (rule Q(1) [symmetric]) fact
     also have "\<dots> = (\<Sum>p\<in>#prime_factorization (Q Y). poly_roots (of_int_poly p))"
       by (rule poly_roots_of_int_conv_sum_prime_factors)
     finally obtain q where q: "q \<in> prime_factors (Q Y)" "(\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)) \<in># poly_roots (of_int_poly q)"
       by auto
 
     have "\<beta>'' q = (\<Sum>X\<in>{Y}. int (count (prime_factorization (Q X)) q) * prod_mset (image_mset \<beta>' X))"
       unfolding \<beta>''_def
     proof (intro sum.mono_neutral_right ballI)
       fix Y' assume Y': "Y' \<in> Roots_ms - {Y}"
       show "int (count (prime_factorization (Q Y')) q) * \<Prod>\<^sub># (image_mset \<beta>' Y') = 0"
       proof (cases "set_mset Y' \<subseteq> X")
         case Y'_subset: True
         have "q \<notin> prime_factors (Q Y')"
         proof
           assume q': "q \<in> prime_factors (Q Y')"
           have "poly_roots (of_int_poly q :: complex poly) \<subseteq>#
                          poly_roots (of_int_poly (Q Y'))"
             using q' by (intro dvd_imp_poly_roots_subset of_int_poly_hom.hom_dvd) auto
           with q(2) have "(\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)) \<in># poly_roots (of_int_poly (Q Y'))"
             by (meson mset_subset_eqD)
           also have "poly_roots (of_int_poly (Q Y')) = R Y'"
             using Q(1)[of Y'] Y' by auto
           finally obtain g where g: "g \<in> tuples Y'" "(\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)) = (\<Sum>\<sigma>\<in>perms. \<sigma> (g \<sigma>))"
             unfolding R_def using fin_tuples[of Y'] by auto
 
           moreover have "(\<Sum>\<sigma>\<in>perms. \<sigma> (g \<sigma>)) <\<^sub>\<complex> (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>))"
           proof (rule sum_strict_mono_ex1_complex_lex)
             show le: "\<forall>\<sigma>\<in>perms. \<sigma> (g \<sigma>) \<le>\<^sub>\<complex> \<sigma> (f \<sigma>)"
             proof
               fix \<sigma> assume \<sigma>: "\<sigma> \<in> perms"
               hence \<sigma>': "\<sigma> permutes Roots"
                 by (auto simp: perms_def)
               have "image_mset g (mset_set perms) = Y'"
                 using g by (auto simp: tuples_def)
               also have "set_mset \<dots> \<subseteq> X"
                 by fact
               finally have "g ` perms \<subseteq> X"
                 using \<open>finite perms\<close> by auto
               hence "\<sigma> (g \<sigma>) \<le>\<^sub>\<complex> complex_lex.Max (\<sigma> ` X)"
                 using \<open>finite perms\<close> \<sigma>
                 by (intro complex_lex.Max.coboundedI finite_imageI imageI)
                    (auto simp: tuples_def)
               also have "\<dots> = \<sigma> (f \<sigma>)"
                 using \<sigma> by (simp add: f_def permutes_inverses[OF \<sigma>'])
               finally show "\<sigma> (g \<sigma>) \<le>\<^sub>\<complex> \<sigma> (f \<sigma>)" .
             qed
 
             have "image_mset g (mset_set perms) \<noteq> image_mset f (mset_set perms)"
               using Y' g by (auto simp: tuples_def Y_def)
             then obtain \<sigma> where \<sigma>: "\<sigma> \<in># mset_set perms" "g \<sigma> \<noteq> f \<sigma>"
               by (meson multiset.map_cong)
             have "\<sigma> permutes Roots"
               using \<sigma> \<open>finite perms\<close> by (auto simp: perms_def)
             have "\<sigma> (g \<sigma>) \<noteq> \<sigma> (f \<sigma>)"
               using permutes_inj[OF \<open>\<sigma> permutes Roots\<close>] \<sigma> by (auto simp: inj_def)
             moreover have "\<sigma> (g \<sigma>) \<le>\<^sub>\<complex> \<sigma> (f \<sigma>)"
               using le \<sigma> \<open>finite perms\<close> by auto
             ultimately have "\<sigma> (g \<sigma>) <\<^sub>\<complex> \<sigma> (f \<sigma>)"
               by simp
             thus "\<exists>\<sigma>\<in>perms. \<sigma> (g \<sigma>) <\<^sub>\<complex> \<sigma> (f \<sigma>)"
               using \<sigma> \<open>finite perms\<close> by auto
           qed (use \<open>finite perms\<close> in simp_all)
           ultimately show False by simp
         qed
         thus ?thesis by auto
       qed (auto simp: \<beta>'_def)
     qed (use \<open>Y \<in> Roots_ms\<close> in auto)
     also have "\<dots> = int (count (prime_factorization (Q Y)) q) * prod_mset (image_mset \<beta>' Y)"
       by simp
     also have "\<dots> \<noteq> 0"
       using q nz \<open>finite X\<close> \<open>X \<noteq> {}\<close> \<open>finite perms\<close> f by (auto simp: \<beta>'_def Y_def)
     finally show "{q. \<beta>'' q \<noteq> 0} \<noteq> {}"
       by auto
   qed
 
   text \<open>
     We are now ready for the final push: we start with the original sum that we know to be zero,
     multiply it with the other permutations, and then multiply out the sum.
   \<close>
   have "0 = (\<Sum>x\<in>X. \<beta> x * exp x)"
     using sum0 ..
   also have "\<dots> = (\<Sum>x\<in>Roots. \<beta>' x * exp x)"
     by (intro sum.mono_neutral_cong_left \<open>X \<subseteq> Roots\<close>) (auto simp: \<beta>'_def)
   also have "\<dots> dvd (\<Prod>\<sigma>\<in>perms. \<Sum>x\<in>Roots. \<beta>' x * exp (\<sigma> x))"
     by (rule dvd_prodI[OF \<open>finite perms\<close>])
        (use permutes_id[of Roots] in \<open>simp_all add: id_def perms_def\<close>)
   also have "\<dots> = (\<Sum>f\<in>perms \<rightarrow>\<^sub>E Roots. \<Prod>\<sigma>\<in>perms. \<beta>' (f \<sigma>) * exp (\<sigma> (f \<sigma>)))"
     by (rule prod_sum_PiE) auto
   also have "\<dots> = (\<Sum>f\<in>perms \<rightarrow>\<^sub>E Roots. (\<Prod>\<sigma>\<in>perms. \<beta>' (f \<sigma>)) * exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)))"
     using \<open>finite perms\<close> by (simp add: prod.distrib exp_sum)
   also have "\<dots> = (\<Sum>(X,f)\<in>tuples'. (\<Prod>\<sigma>\<in>perms. \<beta>' (f \<sigma>)) * exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)))"
     using \<open>finite perms\<close>
     by (intro sum.reindex_bij_witness[of _ snd "\<lambda>f. (image_mset f (mset_set perms), f)"])
        (auto simp: tuples'_def tuples_def Roots_ms_def PiE_def Pi_def)
   also have "\<dots> = (\<Sum>(X,f)\<in>tuples'. (\<Prod>x\<in>#X. \<beta>' x) * exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)))"
   proof (safe intro!: sum.cong)
     fix X :: "complex multiset" and f :: "(complex \<Rightarrow> complex) \<Rightarrow> complex"
     assume "(X, f) \<in> tuples'"
     hence X: "X \<in> Roots_ms" "X = image_mset f (mset_set perms)" and f: "f \<in> perms \<rightarrow>\<^sub>E Roots"
       by (auto simp: tuples'_def tuples_def)
     have "(\<Prod>\<sigma>\<in>perms. \<beta>' (f \<sigma>)) = (\<Prod>\<sigma>\<in>#mset_set perms. \<beta>' (f \<sigma>))"
       by (meson prod_unfold_prod_mset)
     also have "\<dots> = (\<Prod>x\<in>#X. \<beta>' x)"
       unfolding X(2) by (simp add: multiset.map_comp o_def)
     finally show "(\<Prod>\<sigma>\<in>perms. \<beta>' (f \<sigma>)) * exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)) =
                   (\<Prod>x\<in>#X. \<beta>' x) * exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>))" by simp
   qed
   also have "\<dots> = (\<Sum>X\<in>Roots_ms. \<Sum>f\<in>tuples X. (\<Prod>x\<in>#X. \<beta>' x) * exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>)))"
     unfolding tuples'_def by (intro sum.Sigma [symmetric]) auto
   also have "\<dots> = (\<Sum>X\<in>Roots_ms. of_int (\<Prod>x\<in>#X. \<beta>' x) * (\<Sum>f\<in>tuples X. exp (\<Sum>\<sigma>\<in>perms. \<sigma> (f \<sigma>))))"
     by (simp add: sum_distrib_left)
   also have "\<dots> = (\<Sum>X\<in>Roots_ms. of_int (\<Prod>x\<in>#X. \<beta>' x) * (\<Sum>x\<in>#R X. exp x))"
     by (simp only: R_def multiset.map_comp o_def sum_unfold_sum_mset)
   also have "\<dots> = (\<Sum>X\<in>Roots_ms. of_int (\<Prod>x\<in>#X. \<beta>' x) * (\<Sum>x\<in>#poly_roots (of_int_poly (Q X)). exp x))"
     by (intro sum.cong) (simp_all flip: Q)
 
   text \<open>
     Our problem now is that the polynomials \<open>Q X\<close> can still contain multiple roots and that their
     roots might not be disjoint. We therefore split them all into irreducible factors and collect
     equal terms.
   \<close>
   also have "\<dots> = (\<Sum>X\<in>Roots_ms. (\<Sum>p. of_int (int (count (prime_factorization (Q X)) p) *
                       (\<Prod>x\<in>#X. \<beta>' x)) * (\<Sum>x | ipoly p x = 0. exp x)))"
   proof (rule sum.cong, goal_cases)
     case (2 X)
     have "(\<Sum>x\<in>#poly_roots (of_int_poly (Q X) :: complex poly). exp x) =
           (\<Sum>x \<in># (\<Sum>p\<in>#prime_factorization (Q X). poly_roots (of_int_poly p)). exp x)"
       by (subst poly_roots_of_int_conv_sum_prime_factors) (rule refl)
     also have "\<dots> = (\<Sum>p\<in>#prime_factorization (Q X). \<Sum>x\<in>#poly_roots (of_int_poly p). exp x)"
       by (rule sum_mset_image_mset_sum_mset_image_mset)
     also have "rsquarefree (of_int_poly p :: complex poly)" if "p \<in> prime_factors (Q X)" for p
     proof (rule irreducible_imp_rsquarefree_of_int_poly)
       have "prime p"
         using that by auto
       thus "irreducible p"
         by blast
     next
       show "Polynomial.degree p > 0"
         by (intro content_1_imp_nonconstant_prime_factors[OF Q(2) that] 2)
     qed
     hence "(\<Sum>p\<in>#prime_factorization (Q X). \<Sum>x\<in>#poly_roots (of_int_poly p). exp x) =
            (\<Sum>p\<in>#prime_factorization (Q X). \<Sum>x | ipoly p x = 0. exp (x :: complex))"
       unfolding sum_unfold_sum_mset
       by (intro arg_cong[of _ _ sum_mset] image_mset_cong sum.cong refl,
           subst rsquarefree_poly_roots_eq) auto
     also have "\<dots> = (\<Sum>p. count (prime_factorization (Q X)) p * (\<Sum>x | ipoly p x = 0. exp (x :: complex)))"
       by (rule sum_mset_conv_Sum_any)
     also have "of_int (\<Prod>x\<in>#X. \<beta>' x) * \<dots> =
                (\<Sum>p. of_int (int (count (prime_factorization (Q X)) p) * (\<Prod>x\<in>#X. \<beta>' x)) * (\<Sum>x | ipoly p x = 0. exp x))"
       by (subst Sum_any_right_distrib) (auto simp: mult_ac)
     finally show ?case by simp
   qed auto
   also have "\<dots> = (\<Sum>q. of_int (\<beta>'' q) * (\<Sum>x | ipoly q x = 0. exp x))"
     unfolding \<beta>''_def of_int_sum
     by (subst Sum_any_sum_swap [symmetric]) (auto simp: sum_distrib_right)
   also have "\<dots> = (\<Sum>q | \<beta>'' q \<noteq> 0. of_int (\<beta>'' q) * (\<Sum>x | ipoly q x = 0. exp x))"
     by (intro Sum_any.expand_superset finite_subset[OF supp_\<beta>'']) auto
   finally have "(\<Sum>q | \<beta>'' q \<noteq> 0. of_int (\<beta>'' q) * (\<Sum>x | ipoly q x = 0. exp (x :: complex))) = 0"
     by simp
 
   text \<open>
     We are now in the situation of our the specialised Hermite--Lindemann Theorem we proved
     earlier and can easily derive a contradiction.
   \<close>
   moreover have "(\<Sum>q | \<beta>'' q \<noteq> 0. of_int (\<beta>'' q) * (\<Sum>x | ipoly q x = 0. exp (x :: complex))) \<noteq> 0"
   proof (rule Hermite_Lindemann_aux1)
     show "finite {q. \<beta>'' q \<noteq> 0}"
       by (rule finite_subset[OF supp_\<beta>'']) auto
   next
     show "pairwise Rings.coprime {q. \<beta>'' q \<noteq> 0}"
     proof (rule pairwiseI, clarify)
       fix p q assume pq: "p \<noteq> q" "\<beta>'' p \<noteq> 0" "\<beta>'' q \<noteq> 0"
       hence "prime p" "prime q"
         using supp_\<beta>'' Q(2) by auto
       with pq show "Rings.coprime p q"
         by (simp add: primes_coprime)
     qed
   next
     fix q :: "int poly"
     assume q: "q \<in> {q. \<beta>'' q \<noteq> 0}"
     also note supp_\<beta>''
     finally obtain X where X: "X \<in> Roots_ms" "q \<in> prime_factors (Q X)"
       by blast
     show "irreducible q"
       using X by (intro prime_elem_imp_irreducible prime_imp_prime_elem) auto
     show "Polynomial.degree q > 0" using X
       by (intro content_1_imp_nonconstant_prime_factors[OF Q(2)[of X]])
   qed (use \<open>{x. \<beta>'' x \<noteq> 0} \<noteq> {}\<close> in auto)
 
   ultimately show False by contradiction
 qed
 
 
 subsection \<open>Removing the restriction to integer coefficients\<close>
 
 text \<open>
   Next, we weaken the restriction that the $\beta_i$ must be integers to the restriction
   that they must be rationals. This is done simply by multiplying with the least common multiple
   of the demoninators.
 \<close>
 lemma Hermite_Lindemann_aux3:
   fixes X :: "complex set" and \<beta> :: "complex \<Rightarrow> rat"
   assumes "finite X"
   assumes nz:   "\<And>x. x \<in> X \<Longrightarrow> \<beta> x \<noteq> 0"
   assumes alg:  "\<And>x. x \<in> X \<Longrightarrow> algebraic x"
   assumes sum0: "(\<Sum>x\<in>X. of_rat (\<beta> x) * exp x) = 0"
   shows   "X = {}"
 proof -
   define l :: int where "l = Lcm ((snd \<circ> quotient_of \<circ> \<beta>) ` X)"
   have [simp]: "snd (quotient_of r) \<noteq> 0" for r
     using quotient_of_denom_pos'[of r] by simp
   have [simp]: "l \<noteq> 0"
     using \<open>finite X\<close> by (auto simp: l_def Lcm_0_iff)
 
   have "of_int l * \<beta> x \<in> \<int>" if "x \<in> X" for x
   proof -
     define a b where "a = fst (quotient_of (\<beta> x))" and "b = snd (quotient_of (\<beta> x))"
     have "b > 0"
       using quotient_of_denom_pos'[of "\<beta> x"] by (auto simp: b_def)
     have "\<beta> x = of_int a / of_int b"
       by (intro quotient_of_div) (auto simp: a_def b_def)
     also have "of_int l * \<dots> = of_int (l * a) / of_int b"
       using \<open>b > 0\<close> by (simp add: field_simps)
     also have "\<dots> \<in> \<int>" using that
       by (intro of_int_divide_in_Ints) (auto simp: l_def b_def)
     finally show ?thesis .
   qed
   hence "\<forall>x\<in>X. \<exists>n. of_int n = of_int l * \<beta> x"
     using Ints_cases by metis
   then obtain \<beta>' where \<beta>': "of_int (\<beta>' x) = of_int l * \<beta> x" if "x \<in> X" for x
     by metis
 
   show ?thesis
   proof (rule Hermite_Lindemann_aux2)
     have "0 = of_int l * (\<Sum>x\<in>X. of_rat (\<beta> x) * exp x :: complex)"
       by (simp add: sum0)
     also have "\<dots> = (\<Sum>x\<in>X. of_int (\<beta>' x) * exp x)"
       unfolding sum_distrib_left
     proof (rule sum.cong, goal_cases)
       case (2 x)
       have "of_int l * of_rat (\<beta> x) = of_rat (of_int l * \<beta> x)"
         by (simp add: of_rat_mult)
       also have "of_int l * \<beta> x = of_int (\<beta>' x)"
         using 2 by (rule \<beta>' [symmetric])
       finally show ?case by (simp add: mult_ac)
     qed simp_all
     finally show "\<dots> = 0" ..
   next
     fix x assume "x \<in> X"
     hence "of_int (\<beta>' x) \<noteq> (0 :: rat)" using nz
       by (subst \<beta>') auto
     thus "\<beta>' x \<noteq> 0"
       by auto
   qed (use alg \<open>finite X\<close> in auto)
 qed
 
 text \<open>
   Next, we weaken the restriction that the $\beta_i$ must be rational to them being algebraic.
   Similarly to before, this is done by multiplying over all possible permutations of the $\beta_i$
   (in some sense) to introduce more symmetry, from which it then follows by the fundamental theorem
   of symmetric polynomials that the resulting coefficients are rational.
 \<close>
 lemma Hermite_Lindemann_aux4:
   fixes \<beta> :: "complex \<Rightarrow> complex"
   assumes [intro]: "finite X"
   assumes alg1: "\<And>x. x \<in> X \<Longrightarrow> algebraic x"
   assumes alg2: "\<And>x. x \<in> X \<Longrightarrow> algebraic (\<beta> x)"
   assumes nz:   "\<And>x. x \<in> X \<Longrightarrow> \<beta> x \<noteq> 0"
   assumes sum0: "(\<Sum>x\<in>X. \<beta> x * exp x) = 0"
   shows   "X = {}"
 proof (rule ccontr)
   assume X: "X \<noteq> {}"
   note [intro!] = finite_PiE
 
   text \<open>
     We now take more or less the same approach as before, except that now we find a polynomial
     that has all of the conjugates of the coefficients \<open>\<beta>\<close> as roots. Note that this is a slight
     deviation from Baker's proof, who picks one polynomial for each \<open>\<beta>\<close> independently. I did it
     this way because, as Bernard~\<^cite>\<open>"bernard"\<close> observed, it makes the proof a bit easier.
   \<close>
   define P :: "int poly" where "P = \<Prod>((min_int_poly \<circ> \<beta>) ` X)"
   define Roots :: "complex set" where "Roots = {x. ipoly P x = 0}"
   have "0 \<notin> Roots" using \<open>finite X\<close> alg2 nz
     by (auto simp: Roots_def P_def poly_prod)
   have [simp]: "P \<noteq> 0"
     using \<open>finite X\<close> by (auto simp: P_def)
   have [intro]: "finite Roots"
     unfolding Roots_def by (intro poly_roots_finite) auto
 
   have "\<beta> ` X \<subseteq> Roots"
   proof safe
     fix x assume "x \<in> X"
     hence "ipoly (min_int_poly (\<beta> x)) (\<beta> x) = 0"
       by (intro ipoly_min_int_poly alg2)
     thus "\<beta> x \<in> Roots"
       using \<open>finite X\<close> \<open>x \<in> X\<close>
       by (auto simp: Roots_def P_def of_int_poly_hom.hom_prod poly_prod)
   qed
 
   have "squarefree (of_int_poly P :: complex poly)"
     unfolding P_def of_int_poly_hom.hom_prod o_def
   proof (rule squarefree_prod_coprime; safe)
     fix x assume "x \<in> X"
     thus "squarefree (of_int_poly (min_int_poly (\<beta> x)) :: complex poly)"
       by (intro squarefree_of_int_polyI) auto
   next
     fix x y assume xy: "x \<in> X" "y \<in> X" "min_int_poly (\<beta> x) \<noteq> min_int_poly (\<beta> y)"
     thus "Rings.coprime (of_int_poly (min_int_poly (\<beta> x)))
             (of_int_poly (min_int_poly (\<beta> y)) :: complex poly)"
       by (intro coprime_of_int_polyI[OF primes_coprime]) auto
   qed
 
   define n where "n = card Roots"
   define m where "m = card X"
   have "Roots \<noteq> {}"
     using \<open>\<beta> ` X \<subseteq> Roots\<close> \<open>X \<noteq> {}\<close> by auto
   hence "n > 0" "m > 0"
     using \<open>finite Roots\<close> \<open>finite X\<close> \<open>X \<noteq> {}\<close> by (auto simp: n_def m_def)
   have fin1 [simp]: "finite (X \<rightarrow>\<^sub>E Roots)"
     by auto
   have [simp]: "card (X \<rightarrow>\<^sub>E Roots) = n ^ m"
     by (subst card_PiE) (auto simp: m_def n_def)
 
   text \<open>
     We again find a bijection between the roots and the natural numbers less than \<open>n\<close>:
   \<close>
   obtain Root where Root: "bij_betw Root {..<n} Roots"
     using ex_bij_betw_nat_finite[OF \<open>finite Roots\<close>] unfolding n_def atLeast0LessThan by metis
   define unRoot :: "complex \<Rightarrow> nat" where "unRoot = inv_into {..<n} Root"
   have unRoot: "bij_betw unRoot Roots {..<n}"
     unfolding unRoot_def by (intro bij_betw_inv_into Root)
   have unRoot_Root [simp]: "unRoot (Root i) = i" if "i < n" for i
     unfolding unRoot_def using Root that by (subst inv_into_f_f) (auto simp: bij_betw_def)
   have Root_unRoot [simp]: "Root (unRoot x) = x" if "x \<in> Roots" for x
     unfolding unRoot_def using Root that by (subst f_inv_into_f) (auto simp: bij_betw_def)
   have [simp, intro]: "Root i \<in> Roots" if "i < n" for i
     using Root that by (auto simp: bij_betw_def)
   have [simp, intro]: "unRoot x < n" if "x \<in> Roots" for x
     using unRoot that by (auto simp: bij_betw_def)
 
   text \<open>
     And we again define the set of multisets and tuples that we will get in the expanded product.
   \<close>
   define Roots_ms :: "complex multiset set" where
     "Roots_ms = {Y. set_mset Y \<subseteq> X \<and> size Y = n ^ m}"
   have [intro]: "finite Roots_ms"
     unfolding Roots_ms_def by (rule finite_multisets_of_size) auto
   define tuples :: "complex multiset \<Rightarrow> ((complex \<Rightarrow> complex) \<Rightarrow> complex) set"
     where "tuples = (\<lambda>Y. {f\<in>(X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X. image_mset f (mset_set (X \<rightarrow>\<^sub>E Roots)) = Y})"
   have [intro]: "finite (tuples Y)" for Y
     unfolding tuples_def by (rule finite_subset[of _ "(X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X"]) auto
 
   text \<open>
     We will also need to convert permutations over the natural and over the roots again.
   \<close>
   define convert_perm :: "(nat \<Rightarrow> nat) \<Rightarrow> (complex \<Rightarrow> complex)" where
     "convert_perm = (\<lambda>\<sigma> x. if x \<in> Roots then Root (\<sigma> (unRoot x)) else x)"
   have bij_convert: "bij_betw convert_perm {\<sigma>. \<sigma> permutes {..<n}} {\<sigma>. \<sigma> permutes Roots}"
     using bij_betw_permutations[OF Root] unfolding convert_perm_def unRoot_def .
   have permutes_convert_perm [intro]: "convert_perm \<sigma> permutes Roots" if "\<sigma> permutes {..<n}" for \<sigma>
     using that bij_convert unfolding bij_betw_def by blast
 
   text \<open>
     We also need a small lemma showing that our tuples are stable under permutation of the roots.
   \<close>
   have bij_betw_compose_perm: 
     "bij_betw (\<lambda>f. restrict (\<lambda>g. f (restrict (\<pi> \<circ> g) X)) (X \<rightarrow>\<^sub>E Roots)) (tuples Y) (tuples Y)"
     if \<pi>: "\<pi> permutes Roots" and "Y \<in> Roots_ms" for \<pi> Y
   proof (rule bij_betwI)
     have *: "(\<lambda>f. restrict (\<lambda>g. f (restrict (\<pi> \<circ> g) X)) (X \<rightarrow>\<^sub>E Roots)) \<in> tuples Y \<rightarrow> tuples Y"
       if \<pi>: "\<pi> permutes Roots" for \<pi>
     proof
       fix f assume f: "f \<in> tuples Y"
       hence f': "f \<in> (X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X"
         by (auto simp: tuples_def)
       define f' where "f' = (\<lambda>g. f (restrict (\<pi> \<circ> g) X))"
       have "f' \<in> (X \<rightarrow>\<^sub>E Roots) \<rightarrow> X" unfolding f'_def
         using f' bij_betw_apply[OF bij_betw_compose_left_perm_PiE[OF \<pi>, of X]] by blast
       hence "restrict f' (X \<rightarrow>\<^sub>E Roots) \<in> (X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X"
         by simp
       moreover have "image_mset (restrict f' (X \<rightarrow>\<^sub>E Roots)) (mset_set (X \<rightarrow>\<^sub>E Roots)) = Y"
       proof -
         have "image_mset (restrict f' (X \<rightarrow>\<^sub>E Roots)) (mset_set (X \<rightarrow>\<^sub>E Roots)) =
               image_mset f' (mset_set (X \<rightarrow>\<^sub>E Roots))"
           by (intro image_mset_cong) auto
         also have "\<dots> = image_mset f (image_mset (\<lambda>g. restrict (\<pi> \<circ> g) X) (mset_set (X \<rightarrow>\<^sub>E Roots)))"
           unfolding f'_def o_def multiset.map_comp by (simp add: o_def)
         also have "image_mset (\<lambda>g. restrict (\<pi> \<circ> g) X) (mset_set (X \<rightarrow>\<^sub>E Roots)) =
                    mset_set (X \<rightarrow>\<^sub>E Roots)"
           by (intro bij_betw_image_mset_set bij_betw_compose_left_perm_PiE \<pi>)
         also have "image_mset f \<dots> = Y"
           using f by (simp add: tuples_def)
         finally show ?thesis .
       qed
       ultimately show "restrict f' (X \<rightarrow>\<^sub>E Roots) \<in> tuples Y"
         by (auto simp: tuples_def)
     qed
     show "(\<lambda>f. restrict (\<lambda>g. f (restrict (\<pi> \<circ> g) X)) (X \<rightarrow>\<^sub>E Roots)) \<in> tuples Y \<rightarrow> tuples Y"
       by (intro * \<pi>)
     show "(\<lambda>f. restrict (\<lambda>g. f (restrict (inv_into UNIV \<pi> \<circ> g) X)) (X \<rightarrow>\<^sub>E Roots)) \<in> tuples Y \<rightarrow> tuples Y"
       by (intro * permutes_inv \<pi>)
   next
     have *: "(\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. (\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. f (restrict (\<pi> \<circ> g) X))
                 (restrict (inv_into UNIV \<pi> \<circ> g) X)) = f" (is "?lhs = _")
       if f: "f \<in> tuples Y" and \<pi>: "\<pi> permutes Roots" for f \<pi>
     proof
       fix g show "?lhs g = f g"
       proof (cases "g \<in> X \<rightarrow>\<^sub>E Roots")
         case True
         have "restrict (\<pi> \<circ> restrict (inv_into UNIV \<pi> \<circ> g) X) X = g"
           using True
           by (intro ext) (auto simp: permutes_inverses[OF \<pi>])
         thus ?thesis using True
           by (auto simp: permutes_in_image[OF permutes_inv[OF \<pi>]])
       qed (use f in \<open>auto simp: tuples_def\<close>)
     qed
     show "(\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. (\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. f (restrict (\<pi> \<circ> g) X))
                 (restrict (inv_into UNIV \<pi> \<circ> g) X)) = f" if "f \<in> tuples Y" for f
       using *[OF that \<pi>] .
     show "(\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. (\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. f (restrict (inv_into UNIV \<pi> \<circ> g) X))
                 (restrict (\<pi> \<circ> g) X)) = f" if "f \<in> tuples Y" for f
       using *[OF that permutes_inv[OF \<pi>]] permutes_inv_inv[OF \<pi>] by simp
   qed
 
   text \<open>
     We show that the coefficients in the expanded new sum are rational -- again using the 
     fundamental theorem of symmetric polynomials.
   \<close>
   define \<beta>' :: "complex multiset \<Rightarrow> complex"
     where "\<beta>' = (\<lambda>Y. \<Sum>f\<in>tuples Y. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g (f g))"
 
   have "\<beta>' Y \<in> \<rat>" if Y: "Y \<in> Roots_ms" for Y
   proof -
     define Q :: "complex mpoly"
       where "Q = (\<Sum>f\<in>tuples Y. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (unRoot (g (f g))))"
 
     have "insertion Root Q \<in> \<rat>"
     proof (rule symmetric_poly_of_roots_in_subring)
       show "ring_closed (\<rat> :: complex set)"
         by standard auto
       then interpret ring_closed "\<rat> :: complex set" .
       show "\<forall>m. coeff Q m \<in> \<rat>"
         by (auto simp: Q_def coeff_Var when_def intro!: sum_in_Rats coeff_prod_closed)
     next
       show "symmetric_mpoly {..<n} Q"
         unfolding symmetric_mpoly_def
       proof safe
         fix \<pi> assume \<pi>: "\<pi> permutes {..<n}"
         define \<pi>' where "\<pi>' = convert_perm (inv_into UNIV \<pi>)"
         have \<pi>': "\<pi>' permutes Roots"
           unfolding \<pi>'_def by (intro permutes_convert_perm permutes_inv \<pi>)
         have "mpoly_map_vars \<pi> Q = (\<Sum>f\<in>tuples Y. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (\<pi> (unRoot (g (f g)))))"
           unfolding Q_def by (simp add: permutes_bij[OF \<pi>])
         also have "\<dots> = (\<Sum>f\<in>tuples Y. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (unRoot (g (f (restrict (\<pi>' \<circ> g) X)))))"
         proof (rule sum.cong, goal_cases)
           case (2 f)
           have f: "f \<in> (X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X"
             using 2 by (auto simp: tuples_def)
           have "(\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (\<pi> (unRoot (g (f g))))) =
                 (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (\<pi> (unRoot (restrict (\<pi>' \<circ> g) X (f (restrict (\<pi>' \<circ> g) X))))))"
             using \<pi>' by (intro prod.reindex_bij_betw [symmetric] bij_betw_compose_left_perm_PiE)
           also have "\<dots> = (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (unRoot (g (f (restrict (\<pi>' \<circ> g) X)))))"
           proof (intro prod.cong refl arg_cong[of _ _ Var])
             fix g assume g: "g \<in> X \<rightarrow>\<^sub>E Roots"
             have "restrict (\<pi>' \<circ> g) X \<in> X \<rightarrow>\<^sub>E Roots"
               using bij_betw_compose_left_perm_PiE[OF \<pi>', of X] g unfolding bij_betw_def by blast
             hence *: "f (restrict (\<pi>' \<circ> g) X) \<in> X"
               by (rule PiE_mem[OF f])
             hence **: "g (f (restrict (\<pi>' \<circ> g) X)) \<in> Roots"
               by (rule PiE_mem[OF g])
 
             have "unRoot (restrict (\<pi>' \<circ> g) X (f (restrict (\<pi>' \<circ> g) X))) =
                    unRoot (Root (inv_into UNIV \<pi> (unRoot (g (f (restrict (\<pi>' \<circ> g) X))))))"
               using * ** by (subst \<pi>'_def) (auto simp: convert_perm_def)
             also have "inv_into UNIV \<pi> (unRoot (g (f (restrict (\<pi>' \<circ> g) X)))) \<in> {..<n}"
               using ** by (subst permutes_in_image[OF permutes_inv[OF \<pi>]]) auto
             hence "unRoot (Root (inv_into UNIV \<pi> (unRoot (g (f (restrict (\<pi>' \<circ> g) X)))))) =
                    inv_into UNIV \<pi> (unRoot (g (f (restrict (\<pi>' \<circ> g) X))))"
               by (intro unRoot_Root) auto
             also have "\<pi> \<dots> = unRoot (g (f (restrict (\<pi>' \<circ> g) X)))"
               by (rule permutes_inverses[OF \<pi>])
             finally show "\<pi> (unRoot (restrict (\<pi>' \<circ> g) X (f (restrict (\<pi>' \<circ> g) X)))) =
                           unRoot (g (f (restrict (\<pi>' \<circ> g) X)))" .
           qed
           finally show ?case .
         qed simp_all
         also have "\<dots> = (\<Sum>x\<in>tuples Y. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Var (unRoot (g ((\<lambda>g\<in>X \<rightarrow>\<^sub>E Roots. x (restrict (\<pi>' \<circ> g) X)) g))))"
           by (intro sum.cong prod.cong refl) auto
         also have "\<dots> = Q"
           unfolding Q_def
           by (rule sum.reindex_bij_betw[OF bij_betw_compose_perm]) (use \<pi>' Y in simp_all)
         finally show "mpoly_map_vars \<pi> Q = Q" .
       qed
     next
       show "vars Q \<subseteq> {..<n}"
         unfolding Q_def
         by (intro order.trans[OF vars_sum] UN_least order.trans[OF vars_prod])
            (auto simp: vars_Var tuples_def)
     next
       define lc where "lc = Polynomial.lead_coeff P"
       have "lc \<noteq> 0"
         unfolding lc_def by auto
       thus "inverse (of_int lc) * (of_int lc :: complex) = 1" and "inverse (of_int lc) \<in> \<rat>"
         by auto
       have "rsquarefree (of_int_poly P :: complex poly)"
         using \<open>squarefree (of_int_poly P :: complex poly)\<close> by (intro squarefree_imp_rsquarefree)
       hence "of_int_poly P = Polynomial.smult (of_int lc) (\<Prod>x\<in>Roots. [:-x, 1:])"
         unfolding lc_def of_int_hom.hom_lead_coeff[symmetric] Roots_def
         by (rule complex_poly_decompose_rsquarefree [symmetric])
       also have "(\<Prod>x\<in>Roots. [:-x, 1:]) = (\<Prod>i<n. [:-Root i, 1:])"
         by (rule prod.reindex_bij_betw[OF Root, symmetric])
       finally show "of_int_poly P = Polynomial.smult (of_int lc) (\<Prod>i<n. [:- Root i, 1:])" .
     qed auto
     also have "insertion Root Q = (\<Sum>f\<in>tuples Y. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. Root (unRoot (g (f g))))"
       by (simp add: Q_def insertion_sum insertion_prod)
     also have "\<dots> = \<beta>' Y"
       unfolding \<beta>'_def by (intro sum.cong prod.cong refl Root_unRoot) (auto simp: tuples_def)
     finally show ?thesis .
   qed
   hence "\<forall>Y\<in>Roots_ms. \<exists>x. \<beta>' Y = of_rat x"
     by (auto elim!: Rats_cases)
   then obtain \<beta>'' :: "complex multiset \<Rightarrow> rat"
     where \<beta>'': "\<And>Y. Y \<in> Roots_ms \<Longrightarrow> \<beta>' Y = of_rat (\<beta>'' Y)"
     by metis
 
   text \<open>
     We again collect all the terms that happen to have equal exponents and call their
     coefficients \<open>\<beta>''\<close>:
   \<close>
   define \<beta>''' :: "complex \<Rightarrow> rat" where "\<beta>''' = (\<lambda>\<alpha>. \<Sum>Y\<in>Roots_ms. (\<beta>'' Y when \<Sum>\<^sub>#Y = \<alpha>))"
   have supp_\<beta>''': "{x. \<beta>''' x \<noteq> 0} \<subseteq> sum_mset ` Roots_ms"
     by (auto simp: \<beta>'''_def when_def elim!: sum.not_neutral_contains_not_neutral split: if_splits)
 
   text \<open>
     We again start with the sum that we now to be zero and multiply it with all the sums that can
     be obtained with different choices for the roots.
   \<close>
   have "0 = (\<Sum>x\<in>X. \<beta> x * exp x)"
     using sum0 ..
   also have "\<dots> = (\<Sum>x\<in>X. restrict \<beta> X x * exp x)"
     by (intro sum.cong) auto
   also have "\<dots> dvd (\<Prod>f \<in> X \<rightarrow>\<^sub>E Roots. \<Sum>x\<in>X. f x * exp x)"
     by (rule dvd_prodI) (use \<open>\<beta> ` X \<subseteq> Roots\<close> in \<open>auto simp: id_def\<close>)
   also have "\<dots> = (\<Sum>f\<in>(X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X. \<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g (f g) * exp (f g))"
     by (rule prod_sum_PiE) auto
   also have "\<dots> = (\<Sum>f\<in>(X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X. (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g (f g)) * exp (\<Sum>g\<in>X \<rightarrow>\<^sub>E Roots. f g))"
     by (simp add: prod.distrib exp_sum)
   also have "\<dots> = (\<Sum>(Y,f)\<in>Sigma Roots_ms tuples.
                     (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g (f g)) * exp (\<Sum>g\<in>X \<rightarrow>\<^sub>E Roots. f g))"
     by (intro sum.reindex_bij_witness[of _ snd "\<lambda>f. (image_mset f (mset_set (X \<rightarrow>\<^sub>E Roots)), f)"])
        (auto simp: Roots_ms_def tuples_def)
   also have "\<dots> = (\<Sum>(Y,f)\<in>Sigma Roots_ms tuples. (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g (f g)) * exp (\<Sum>\<^sub>#Y))"
     by (intro sum.cong) (auto simp: tuples_def sum_unfold_sum_mset)
   also have "\<dots> = (\<Sum>Y\<in>Roots_ms. \<beta>' Y * exp (\<Sum>\<^sub>#Y))"
     unfolding \<beta>'_def sum_distrib_right by (rule sum.Sigma [symmetric]) auto
   also have "\<dots> = (\<Sum>Y\<in>Roots_ms. of_rat (\<beta>'' Y) * exp (\<Sum>\<^sub>#Y))"
     by (intro sum.cong) (auto simp: \<beta>'')
   also have "\<dots> = (\<Sum>Y\<in>Roots_ms. Sum_any (\<lambda>\<alpha>. of_rat (\<beta>'' Y when \<Sum>\<^sub># Y = \<alpha>) * exp \<alpha>))"
   proof (rule sum.cong, goal_cases)
     case (2 Y)
     have "Sum_any (\<lambda>\<alpha>. of_rat (\<beta>'' Y when \<Sum>\<^sub># Y = \<alpha>) * exp \<alpha>) =
           (\<Sum>\<alpha>\<in>{\<Sum>\<^sub># Y}. of_rat (\<beta>'' Y when \<Sum>\<^sub># Y = \<alpha>) * exp \<alpha>)"
       by (intro Sum_any.expand_superset) auto
     thus ?case by simp
   qed auto
   also have "\<dots> = Sum_any (\<lambda>\<alpha>. of_rat (\<beta>''' \<alpha>) * exp \<alpha>)"
     unfolding \<beta>'''_def of_rat_sum sum_distrib_right by (subst Sum_any_sum_swap) auto
   also have "\<dots> = (\<Sum>\<alpha> | \<beta>''' \<alpha> \<noteq> 0. of_rat (\<beta>''' \<alpha>) * exp \<alpha>)"
     by (intro Sum_any.expand_superset finite_subset[OF supp_\<beta>''']) auto
   finally have "(\<Sum>\<alpha> | \<beta>''' \<alpha> \<noteq> 0. of_rat (\<beta>''' \<alpha>) * exp \<alpha>) = 0"
     by auto
 
   text \<open>
     We are now in the situation of our previous version of the theorem and can apply it to find
     that all the coefficients are zero.
   \<close>
   have "{\<alpha>. \<beta>''' \<alpha> \<noteq> 0} = {}"
   proof (rule Hermite_Lindemann_aux3)
     show "finite {\<alpha>. \<beta>''' \<alpha> \<noteq> 0}"
       by (rule finite_subset[OF supp_\<beta>''']) auto
   next
     show "(\<Sum>\<alpha> | \<beta>''' \<alpha> \<noteq> 0. of_rat (\<beta>''' \<alpha>) * exp \<alpha>) = 0"
     by fact
   next
     fix \<alpha> assume \<alpha>: "\<alpha> \<in> {\<alpha>. \<beta>''' \<alpha> \<noteq> 0}"
     then obtain Y where Y: "Y \<in> Roots_ms" "\<alpha> = sum_mset Y"
       using supp_\<beta>''' by auto
     thus "algebraic \<alpha>" using alg1
       by (auto simp: Roots_ms_def)
   qed auto
 
   text \<open>
     However, similarly to before, we can show that the coefficient corresponding to the
     term with the lexicographically greatest exponent (which is obtained by picking the
     term with the lexicographically greatest term in each of the factors of our big product)
     is non-zero.
   \<close>
   moreover have "\<exists>\<alpha>. \<beta>''' \<alpha> \<noteq> 0"
   proof -
     define \<alpha>_max where "\<alpha>_max = complex_lex.Max X"
     have [simp]: "\<alpha>_max \<in> X"
       unfolding \<alpha>_max_def using \<open>X \<noteq> {}\<close> by (intro complex_lex.Max_in) auto
     define Y_max :: "complex multiset" where "Y_max = replicate_mset (n ^ m) \<alpha>_max"
     define f_max where "f_max = restrict (\<lambda>_. \<alpha>_max) (X \<rightarrow>\<^sub>E Roots)"
     have [simp]: "Y_max \<in> Roots_ms"
       by (auto simp: Y_max_def Roots_ms_def)
     have "tuples Y_max = {f_max}"
     proof safe
       have "image_mset (\<lambda>_\<in>X \<rightarrow>\<^sub>E Roots. \<alpha>_max) (mset_set (X \<rightarrow>\<^sub>E Roots)) =
             image_mset (\<lambda>_. \<alpha>_max) (mset_set (X \<rightarrow>\<^sub>E Roots))"
         by (intro image_mset_cong) auto
       thus "f_max \<in> tuples Y_max"
         by (auto simp: f_max_def tuples_def Y_max_def image_mset_const_eq)
     next
       fix f assume "f \<in> tuples Y_max"
       hence f: "f \<in> (X \<rightarrow>\<^sub>E Roots) \<rightarrow>\<^sub>E X" "image_mset f (mset_set (X \<rightarrow>\<^sub>E Roots)) = Y_max"
         by (auto simp: tuples_def)
       hence "\<forall>g \<in># mset_set (X \<rightarrow>\<^sub>E Roots). f g = \<alpha>_max"
         by (intro image_mset_eq_replicate_msetD[where n = "n ^ m"]) (auto simp: Y_max_def)
       thus "f = f_max"
         using f by (auto simp: Y_max_def fun_eq_iff f_max_def)
     qed
 
     have "\<beta>''' (of_nat (n ^ m) * \<alpha>_max) = (\<Sum>Y\<in>Roots_ms. \<beta>'' Y when \<Sum>\<^sub># Y = of_nat (n ^ m) * \<alpha>_max)"
       unfolding \<beta>'''_def Roots_ms_def ..
     also have "\<Sum>\<^sub># Y \<noteq> of_nat n ^ m * \<alpha>_max" if "Y \<in> Roots_ms" "Y \<noteq> Y_max" for Y
     proof -
       have "\<not>set_mset Y \<subseteq> {\<alpha>_max}"
         using set_mset_subset_singletonD[of Y "\<alpha>_max"] that
         by (auto simp: Roots_ms_def Y_max_def split: if_splits)
       then obtain y where y: "y \<in># Y" "y \<noteq> \<alpha>_max"
         by auto
       have "y \<in> X" "set_mset (Y - {#y#}) \<subseteq> X"
         using y that by (auto simp: Roots_ms_def dest: in_diffD)
       hence "y \<le>\<^sub>\<complex> \<alpha>_max"
         using y unfolding \<alpha>_max_def by (intro complex_lex.Max_ge) auto
       with y have "y <\<^sub>\<complex> \<alpha>_max"
         by auto
       have *: "Y = {#y#} + (Y - {#y#})"
         using y by simp
       have "sum_mset Y = y + sum_mset (Y - {#y#})"
         by (subst *) auto
       also have "\<dots> <\<^sub>\<complex> \<alpha>_max + sum_mset (Y - {#y#})"
         by (intro complex_lex.add_strict_right_mono) fact
       also have "\<dots> \<le>\<^sub>\<complex> \<alpha>_max + sum_mset (replicate_mset (n ^ m - 1) \<alpha>_max)"
         unfolding \<alpha>_max_def using that y \<open>set_mset (Y - {#y#}) \<subseteq> X\<close>
         by (intro complex_lex.add_left_mono sum_mset_mono_complex_lex
                   rel_mset_replicate_mset_right complex_lex.Max_ge)
            (auto simp: Roots_ms_def size_Diff_singleton)
       also have "\<dots> = of_nat (Suc (n ^ m - 1)) * \<alpha>_max"
         by (simp add: algebra_simps)
       also have "Suc (n ^ m - 1) = n ^ m"
         using \<open>n > 0\<close> by simp
       finally show ?thesis by simp
     qed
     hence "(\<Sum>Y\<in>Roots_ms. \<beta>'' Y when \<Sum>\<^sub># Y = of_nat (n ^ m) * \<alpha>_max) = (\<Sum>Y\<in>{Y_max}. \<beta>'' Y when \<Sum>\<^sub># Y = of_nat (n ^ m) * \<alpha>_max)"
       by (intro sum.mono_neutral_right ballI) auto
     also have "\<dots> = \<beta>'' Y_max"
       by (auto simp: when_def Y_max_def)
     also have "of_rat \<dots> = \<beta>' Y_max"
       using \<beta>''[of Y_max] by auto
     also have "\<dots> = (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g (f_max g))"
       by (auto simp: \<beta>'_def \<open>tuples Y_max = {f_max}\<close>)
     also have "\<dots> = (\<Prod>g\<in>X \<rightarrow>\<^sub>E Roots. g \<alpha>_max)"
       by (intro prod.cong) (auto simp: f_max_def)
     also have "\<dots> \<noteq> 0"
       using \<open>0 \<notin> Roots\<close> \<open>\<alpha>_max \<in> X\<close> by (intro prod_nonzeroI) (metis PiE_mem)
     finally show ?thesis by blast
   qed
 
   ultimately show False by blast
 qed
 
 
 subsection \<open>The final theorem\<close>
 
 text \<open>
   We now additionally allow some of the $\beta_i$ to be zero:
 \<close>
 lemma Hermite_Lindemann':
   fixes \<beta> :: "complex \<Rightarrow> complex"
   assumes "finite X"
   assumes "\<And>x. x \<in> X \<Longrightarrow> algebraic x"
   assumes "\<And>x. x \<in> X \<Longrightarrow> algebraic (\<beta> x)"
   assumes "(\<Sum>x\<in>X. \<beta> x * exp x) = 0"
   shows   "\<forall>x\<in>X. \<beta> x = 0"
 proof -
   have "{x\<in>X. \<beta> x \<noteq> 0} = {}"
   proof (rule Hermite_Lindemann_aux4)
     have "(\<Sum>x | x \<in> X \<and> \<beta> x \<noteq> 0. \<beta> x * exp x) = (\<Sum>x\<in>X. \<beta> x * exp x)"
       by (intro sum.mono_neutral_left assms(1)) auto
     also have "\<dots> = 0"
       by fact
     finally show "(\<Sum>x | x \<in> X \<and> \<beta> x \<noteq> 0. \<beta> x * exp x) = 0" .
   qed (use assms in auto)
   thus ?thesis by blast
 qed
 
 text \<open>
   Lastly, we switch to indexed summation in order to obtain a version of the theorem that
   is somewhat nicer to use:
 \<close>
 theorem Hermite_Lindemann:
   fixes \<alpha> \<beta> :: "'a \<Rightarrow> complex"
   assumes "finite I"
   assumes "\<And>x. x \<in> I \<Longrightarrow> algebraic (\<alpha> x)"
   assumes "\<And>x. x \<in> I \<Longrightarrow> algebraic (\<beta> x)"
   assumes "inj_on \<alpha> I"
   assumes "(\<Sum>x\<in>I. \<beta> x * exp (\<alpha> x)) = 0"
   shows   "\<forall>x\<in>I. \<beta> x = 0"
 proof -
   define f where "f = inv_into I \<alpha>"
   have [simp]: "f (\<alpha> x) = x" if "x \<in> I" for x
     using that by (auto simp: f_def inv_into_f_f[OF assms(4)])
   have "\<forall>x\<in>\<alpha>`I. (\<beta> \<circ> f) x = 0"
   proof (rule Hermite_Lindemann')
     have "0 = (\<Sum>x\<in>I. \<beta> x * exp (\<alpha> x))"
       using assms(5) ..
     also have "\<dots> = (\<Sum>x\<in>I. (\<beta> \<circ> f) (\<alpha> x) * exp (\<alpha> x))"
       by (intro sum.cong) auto
     also have "\<dots> = (\<Sum>x\<in>\<alpha>`I. (\<beta> \<circ> f) x * exp x)"
       using assms(4) by (subst sum.reindex) auto
     finally show "(\<Sum>x\<in>\<alpha> ` I. (\<beta> \<circ> f) x * exp x) = 0" ..
   qed (use assms in auto)
   thus ?thesis by auto
 qed
 
 text \<open>
   The following version using lists instead of sequences is even more convenient to use
   in practice:
 \<close>
 corollary Hermite_Lindemann_list:
   fixes xs :: "(complex \<times> complex) list"
   assumes alg:      "\<forall>(x,y)\<in>set xs. algebraic x \<and> algebraic y"
   assumes distinct: "distinct (map snd xs)"
   assumes sum0:     "(\<Sum>(c,\<alpha>)\<leftarrow>xs. c * exp \<alpha>) = 0"
   shows   "\<forall>c\<in>(fst ` set xs). c = 0"
 proof -
   define n where "n = length xs"
   have *: "\<forall>i\<in>{..<n}. fst (xs ! i) = 0"
   proof (rule Hermite_Lindemann)
     from distinct have "inj_on (\<lambda>i. map snd xs ! i) {..<n}"
       by (intro inj_on_nth) (auto simp: n_def)
     also have "?this \<longleftrightarrow> inj_on (\<lambda>i. snd (xs ! i)) {..<n}"
       by (intro inj_on_cong) (auto simp: n_def)
     finally show "inj_on (\<lambda>i. snd (xs ! i)) {..<n}" .
   next
     have "0 = (\<Sum>(c,\<alpha>)\<leftarrow>xs. c * exp \<alpha>)"
       using sum0 ..
     also have "\<dots> = (\<Sum>i<n. fst (xs ! i) * exp (snd (xs ! i)))"
       unfolding sum_list_sum_nth
       by (intro sum.cong) (auto simp: n_def case_prod_unfold)
     finally show "\<dots> = 0" ..
   next
     fix i assume i: "i \<in> {..<n}"
     hence "(fst (xs ! i), snd (xs ! i)) \<in> set xs"
       by (auto simp: n_def)
     with alg show "algebraic (fst (xs ! i))" "algebraic (snd (xs ! i))"
       by blast+
   qed auto
 
   show ?thesis
   proof (intro ballI, elim imageE)
     fix c x assume cx: "c = fst x" "x \<in> set xs"
     then obtain i where "i \<in> {..<n}" "x = xs ! i"
       by (auto simp: set_conv_nth n_def)
     with * cx show "c = 0" by blast
   qed
 qed
 
 
 subsection \<open>The traditional formulation of the theorem\<close>
 
 text \<open>
   What we proved above was actually Baker's reformulation of the theorem. Thus, we now also derive
   the original one, which uses linear independence and algebraic independence.
 
   It states that if $\alpha_1, \ldots, \alpha_n$ are algebraic numbers that are linearly
   independent over \<open>\<int>\<close>, then $e^{\alpha_1}, \ldots, e^{\alpha_n}$ are algebraically independent
   over \<open>\<rat>\<close>.
 \<close>
 
 text \<open>
   Linear independence over the integers is just independence of a set of complex numbers when
   viewing the complex numbers as a \<open>\<int>\<close>-module.
 \<close>
 definition linearly_independent_over_int :: "'a :: field_char_0 set \<Rightarrow> bool" where
   "linearly_independent_over_int = module.independent (\<lambda>r x. of_int r * x)"
 
 text \<open>
   Algebraic independence over the rationals means that the given set \<open>X\<close> of numbers fulfils
   no non-trivial polynomial equation with rational coefficients, i.e. there is no non-zero
   multivariate polynomial with rational coefficients that, when inserting the numbers from \<open>X\<close>,
   becomes zero.
 
   Note that we could easily replace `rational coefficients' with `algebraic coefficients' here
   and the proof would still go through without any modifications.
 \<close>
 definition algebraically_independent_over_rat :: "nat \<Rightarrow> (nat \<Rightarrow> 'a :: field_char_0) \<Rightarrow> bool" where
   "algebraically_independent_over_rat n a \<longleftrightarrow>
      (\<forall>p. vars p \<subseteq> {..<n} \<and> (\<forall>m. coeff p m \<in> \<rat>) \<and> insertion a p = 0 \<longrightarrow> p = 0)"
 
 corollary Hermite_Lindemann_original:
   fixes n :: nat and \<alpha> :: "nat \<Rightarrow> complex"
   assumes "inj_on \<alpha> {..<n}"
   assumes "\<And>i. i < n \<Longrightarrow> algebraic (\<alpha> i)"
   assumes "linearly_independent_over_int (\<alpha> ` {..<n})"
   shows   "algebraically_independent_over_rat n (\<lambda>i. exp (\<alpha> i))"
   unfolding algebraically_independent_over_rat_def
 proof safe
   fix p assume p: "vars p \<subseteq> {..<n}" "\<forall>m. coeff p m \<in> \<rat>" "insertion (\<lambda>i. exp (\<alpha> i)) p = 0"
   define \<alpha>' where "\<alpha>' = (\<lambda>m. \<Sum>i<n. of_nat (lookup m i) * \<alpha> i)"
   define I where "I = {m. coeff p m \<noteq> 0}"
 
   have lookup_eq_0: "lookup m i = 0" if "m \<in> I" "i \<notin> {..<n}" for i m
   proof -
     have "keys m \<subseteq> vars p"
       using that coeff_notin_vars[of m p] by (auto simp: I_def)
     thus "lookup m i = 0"
       using in_keys_iff[of i m] that p(1) by blast
   qed
 
   have "\<forall>x\<in>I. coeff p x = 0"
   proof (rule Hermite_Lindemann)
     show "finite I"
       by (auto simp: I_def)
   next
     show "algebraic (\<alpha>' m)" if "m \<in> I" for m
       unfolding \<alpha>'_def using assms(2) by fastforce
   next
     show "algebraic (coeff p m)" if "m \<in> I" for m
       unfolding \<alpha>'_def using p(2) by blast
   next
     show "inj_on \<alpha>' I"
     proof
       fix m1 m2 assume m12: "m1 \<in> I" "m2 \<in> I" "\<alpha>' m1 = \<alpha>' m2"
       define lu :: "(nat \<Rightarrow>\<^sub>0 nat) \<Rightarrow> nat \<Rightarrow> int" where "lu = (\<lambda>m i. int (lookup m i))"
       interpret int: Modules.module "\<lambda>r x. of_int r * (x :: complex)"
         by standard (auto simp: algebra_simps of_rat_mult of_rat_add)
       define idx where "idx = inv_into {..<n} \<alpha>"
 
       have "lu m1 i = lu m2 i" if "i < n" for i
       proof -
         have "lu m1 (idx (\<alpha> i)) - lu m2 (idx (\<alpha> i)) = 0"
         proof (rule int.independentD)
           show "int.independent (\<alpha> ` {..<n})"
             using assms(3) by (simp add: linearly_independent_over_int_def)
         next
           have "(\<Sum>x\<in>\<alpha>`{..<n}. of_int (lu m1 (idx x) - lu m2 (idx x)) * x) =
                 (\<Sum>i<n. of_int (lu m1 (idx (\<alpha> i)) - lu m2 (idx (\<alpha> i))) * \<alpha> i)"
             using assms(1) by (subst sum.reindex) auto
           also have "\<dots> = (\<Sum>i<n. of_int (lu m1 i - lu m2 i) * \<alpha> i)"
             by (intro sum.cong) (auto simp: idx_def inv_into_f_f[OF assms(1)])
           also have "\<dots> = 0"
             using m12 by (simp add: \<alpha>'_def ring_distribs of_rat_diff sum_subtractf lu_def)
           finally show "(\<Sum>x\<in>\<alpha>`{..<n}. of_int (lu m1 (idx x) - lu m2 (idx x)) * x) = 0"
             by (simp add: \<alpha>'_def ring_distribs of_rat_diff sum_subtractf lu_def)
         qed (use that in auto)
         thus ?thesis
           using that by (auto simp: idx_def inv_into_f_f[OF assms(1)])
       qed
       hence "lookup m1 i = lookup m2 i" for i
         using m12 by (cases "i < n") (auto simp: lu_def lookup_eq_0)
       thus "m1 = m2"
         by (rule poly_mapping_eqI)
     qed
   next
     have "0 = insertion (\<lambda>i. exp (\<alpha> i)) p"
       using p(3) ..
     also have "\<dots> = (\<Sum>m\<in>I. coeff p m * Prod_any (\<lambda>i. exp (\<alpha> i) ^ lookup m i))"
       unfolding insertion_altdef by (rule Sum_any.expand_superset) (auto simp: I_def)
     also have "\<dots> = (\<Sum>m\<in>I. coeff p m * exp (\<alpha>' m))"
     proof (intro sum.cong, goal_cases)
       case (2 m)
       have "Prod_any (\<lambda>i. exp (\<alpha> i) ^ lookup m i) = (\<Prod>i<n. exp (\<alpha> i) ^ lookup m i)"
         using 2 lookup_eq_0[of m] by (intro Prod_any.expand_superset; force)
       also have "\<dots> = exp (\<alpha>' m)"
         by (simp add: exp_sum exp_of_nat_mult \<alpha>'_def)
       finally show ?case by simp
     qed simp_all
     finally show "(\<Sum>m\<in>I. coeff p m * exp (\<alpha>' m)) = 0" ..
   qed
   thus "p = 0"
     by (intro mpoly_eqI) (auto simp: I_def)
 qed
 
 
 subsection \<open>Simple corollaries\<close>
 
 text \<open>
   Now, we derive all the usual obvious corollaries of the theorem in the obvious way.
 
   First, the exponential of a non-zero algebraic number is transcendental.
 \<close>
 corollary algebraic_exp_complex_iff:
   assumes "algebraic x"
   shows   "algebraic (exp x :: complex) \<longleftrightarrow> x = 0"
   using Hermite_Lindemann_list[of "[(1, x), (-exp x, 0)]"] assms by auto
 
 text \<open>
   More generally, any sum of exponentials with algebraic coefficients and exponents is
   transcendental if the exponents are all distinct and non-zero and at least one coefficient
   is non-zero.
 \<close>
 corollary sum_of_exp_transcendentalI:
   fixes xs :: "(complex \<times> complex) list"
   assumes "\<forall>(x,y)\<in>set xs. algebraic x \<and> algebraic y \<and> y \<noteq> 0"
   assumes "\<exists>x\<in>fst`set xs. x \<noteq> 0"
   assumes distinct: "distinct (map snd xs)"
   shows   "\<not>algebraic (\<Sum>(c,\<alpha>)\<leftarrow>xs. c * exp \<alpha>)"
 proof
   define S where "S = (\<Sum>(c,\<alpha>)\<leftarrow>xs. c * exp \<alpha>)"
   assume S: "algebraic S"
   have "\<forall>c\<in>fst`set ((-S,0) # xs). c = 0"
   proof (rule Hermite_Lindemann_list)
     show "(\<Sum>(c, \<alpha>)\<leftarrow>(- S, 0) # xs. c * exp \<alpha>) = 0"
       by (auto simp: S_def)
   qed (use S assms in auto)
   with assms(2) show False
     by auto
 qed
 
 text \<open>
   Any complex logarithm of an algebraic number other than 1 is transcendental
   (no matter which branch cut).
 \<close>
 corollary transcendental_complex_logarithm:
   assumes "algebraic x" "exp y = (x :: complex)" "x \<noteq> 1"
   shows   "\<not>algebraic y"
   using algebraic_exp_complex_iff[of y] assms by auto
 
 text \<open>
   In particular, this holds for the standard branch of the logarithm.
 \<close>
 corollary transcendental_Ln:
   assumes "algebraic x" "x \<noteq> 0" "x \<noteq> 1"
   shows   "\<not>algebraic (Ln x)"
   by (rule transcendental_complex_logarithm) (use assms in auto)
 
 text \<open>
   The transcendence of \<open>e\<close> and \<open>\<pi>\<close>, which I have already formalised directly in other AFP
   entries, now follows as a simple corollary.
 \<close>
 corollary exp_1_complex_transcendental: "\<not>algebraic (exp 1 :: complex)"
   by (subst algebraic_exp_complex_iff) auto
 
 corollary pi_transcendental: "\<not>algebraic pi"
 proof -
   have "\<not>algebraic (\<i> * pi)"
     by (rule transcendental_complex_logarithm[of "-1"]) auto
   thus ?thesis by simp
 qed
 
 
 subsection \<open>Transcendence of the trigonometric and hyperbolic functions\<close>
 
 text \<open>
   In a similar fashion, we can also prove the transcendence of all the trigonometric and
   hyperbolic functions such as $\sin$, $\tan$, $\sinh$, $\arcsin$, etc.
 \<close>
 
 lemma transcendental_sinh:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (sinh z :: complex)"
 proof -
   have "\<not>algebraic (\<Sum>(a,b)\<leftarrow>[(1/2, z), (-1/2, -z)]. a * exp b)"
     using assms by (intro sum_of_exp_transcendentalI) auto
   also have "(\<Sum>(a,b)\<leftarrow>[(1/2, z), (-1/2, -z)]. a * exp b) = sinh z"
     by (simp add: sinh_def field_simps scaleR_conv_of_real)
   finally show ?thesis .
 qed
 
 lemma transcendental_cosh:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (cosh z :: complex)"
 proof -
   have "\<not>algebraic (\<Sum>(a,b)\<leftarrow>[(1/2, z), (1/2, -z)]. a * exp b)"
     using assms by (intro sum_of_exp_transcendentalI) auto
   also have "(\<Sum>(a,b)\<leftarrow>[(1/2, z), (1/2, -z)]. a * exp b) = cosh z"
     by (simp add: cosh_def field_simps scaleR_conv_of_real)
   finally show ?thesis .
 qed
 
 lemma transcendental_sin:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (sin z :: complex)"
   unfolding sin_conv_sinh using transcendental_sinh[of "\<i> * z"] assms by simp
 
 lemma transcendental_cos:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (cos z :: complex)"
   unfolding cos_conv_cosh using transcendental_cosh[of "\<i> * z"] assms by simp
 
 (* TODO: Move? *)
 lemma tan_square_neq_neg1: "tan (z :: complex) ^ 2 \<noteq> -1"
 proof
   assume "tan z ^ 2 = -1"
   hence "sin z ^ 2 = -(cos z ^ 2)"
     by (auto simp: tan_def divide_simps split: if_splits)
   also have "cos z ^ 2 = 1 - sin z ^ 2"
     by (simp add: cos_squared_eq)
   finally show False
     by simp
 qed
 
 lemma transcendental_tan:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (tan z :: complex)"
 proof
   assume "algebraic (tan z)"
 
   have nz1: "real_of_int n + 1 / 2 \<noteq> 0" for n
   proof -
     have "real_of_int (2 * n + 1) / real_of_int 2 \<notin> \<int>"
       by (intro fraction_not_in_ints) auto
     also have "real_of_int (2 * n + 1) / real_of_int 2 = real_of_int n + 1 / 2"
       by simp
     finally show "\<dots> \<noteq> 0"
       by auto
   qed
 
   have nz2: "1 + tan z ^ 2 \<noteq> 0"
     using tan_square_neq_neg1[of z] by (subst add_eq_0_iff) 
 
   have nz3: "cos z \<noteq> 0"
   proof
     assume "cos z = 0"
     then obtain n where "z = complex_of_real (real_of_int n * pi) + complex_of_real pi / 2"
       by (subst (asm) cos_eq_0) blast
     also have "\<dots> = complex_of_real ((real_of_int n + 1 / 2) * pi)"
       by (simp add: ring_distribs)
     also have "algebraic \<dots> \<longleftrightarrow> algebraic ((real_of_int n + 1 / 2) * pi)"
       by (rule algebraic_of_real_iff)
     also have "\<not>algebraic ((real_of_int n + 1 / 2) * pi)"
       using nz1[of n] transcendental_pi by simp
     finally show False using assms(1) by contradiction
   qed
 
   from nz3 have *: "sin z ^ 2 = tan z ^ 2 * cos z ^ 2"
     by (simp add: tan_def field_simps)
   also have "cos z ^ 2 = 1 - sin z ^ 2"
     by (simp add: cos_squared_eq)
   finally have "sin z ^ 2 * (1 + tan z ^ 2) = tan z ^ 2"
     by (simp add: algebra_simps)
   hence "sin z ^ 2 = tan z ^ 2 / (1 + tan z ^ 2)"
     using nz2 by (simp add: field_simps)
   also have "algebraic (tan z ^ 2 / (1 + tan z ^ 2))"
     using \<open>algebraic (tan z)\<close> by auto
   finally have "algebraic (sin z ^ 2)" .
   hence "algebraic (sin z)"
     by simp
   thus False
     using transcendental_sin[OF \<open>algebraic z\<close> \<open>z \<noteq> 0\<close>] by contradiction
 qed
 
 lemma transcendental_cot:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (cot z :: complex)"
 proof -
   have "\<not>algebraic (tan z)"
     by (rule transcendental_tan) fact+
   also have "algebraic (tan z) \<longleftrightarrow> algebraic (inverse (tan z))"
     by simp
   also have "inverse (tan z) = cot z"
     by (simp add: cot_def tan_def)
   finally show ?thesis .
 qed
 
 lemma transcendental_tanh:
   assumes "algebraic z" "z \<noteq> 0" "cosh z \<noteq> 0"
   shows   "\<not>algebraic (tanh z :: complex)"
   using transcendental_tan[of "\<i> * z"] assms unfolding tanh_conv_tan by simp
 
 lemma transcendental_Arcsin:
   assumes "algebraic z" "z \<noteq> 0"
   shows   "\<not>algebraic (Arcsin z)"
 proof -
   have "\<i> * z + csqrt (1 - z\<^sup>2) \<noteq> 0"
     using Arcsin_body_lemma by blast
   moreover have "\<i> * z + csqrt (1 - z\<^sup>2) \<noteq> 1"
   proof
     assume "\<i> * z + csqrt (1 - z\<^sup>2) = 1"
     hence "Arcsin z = 0"
       by (simp add: Arcsin_def)
     hence "sin (Arcsin z) = 0"
       by (simp only: sin_zero)
     also have "sin (Arcsin z) = z"
       by simp
     finally show False using \<open>z \<noteq> 0\<close> by simp
   qed
   ultimately have "\<not> algebraic (Ln (\<i> * z + csqrt (1 - z\<^sup>2)))"
     using assms by (intro transcendental_Ln) auto
   thus ?thesis
     by (simp add: Arcsin_def)
 qed
 
 lemma transcendental_Arccos:
   assumes "algebraic z" "z \<noteq> 1"
   shows   "\<not>algebraic (Arccos z)"
 proof -
   have "z + \<i> * csqrt (1 - z\<^sup>2) \<noteq> 0"
     using Arccos_body_lemma by blast
   moreover have "z + \<i> * csqrt (1 - z\<^sup>2) \<noteq> 1"
   proof
     assume "z + \<i> * csqrt (1 - z\<^sup>2) = 1"
     hence "Arccos z = 0"
       by (simp add: Arccos_def)
     hence "cos (Arccos z) = 1"
       by (simp only: cos_zero)
     also have "cos (Arccos z) = z"
       by simp
     finally show False using \<open>z \<noteq> 1\<close> by simp
   qed
   ultimately have "\<not> algebraic (Ln (z + \<i> * csqrt (1 - z\<^sup>2)))"
     using assms by (intro transcendental_Ln) auto
   thus ?thesis
     by (simp add: Arccos_def)
 qed
 
 lemma transcendental_Arctan:
   assumes "algebraic z" "z \<notin> {0, \<i>, -\<i>}"
   shows   "\<not>algebraic (Arctan z)"
 proof -
   have "\<i> * z \<noteq> 1" "1 + \<i> * z \<noteq> 0"
     using assms(2) by (auto simp: complex_eq_iff)
   hence "\<not> algebraic (Ln ((1 - \<i> * z) / (1 + \<i> * z)))"
     using assms by (intro transcendental_Ln) auto
   thus ?thesis
     by (simp add: Arctan_def)
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Zeta_3_Irrational/Zeta_3_Irrational.thy b/thys/Zeta_3_Irrational/Zeta_3_Irrational.thy
--- a/thys/Zeta_3_Irrational/Zeta_3_Irrational.thy
+++ b/thys/Zeta_3_Irrational/Zeta_3_Irrational.thy
@@ -1,2089 +1,2092 @@
 (*
   File:   Zeta_3_Irrational.thy
   Author: Manuel Eberl, TU München
 *)
 section \<open>The Irrationality of $\zeta(3)$\<close>
 theory Zeta_3_Irrational
 imports
   "E_Transcendental.E_Transcendental"
   "Prime_Number_Theorem.Prime_Number_Theorem"
   "Prime_Distribution_Elementary.PNT_Consequences"
 begin
 
+hide_const (open) UnivPoly.coeff  UnivPoly.up_ring.monom
+hide_const (open) Module.smult  Coset.order
+
 text \<open>
   Ap\'{e}ry's original proof of the irrationality of $\zeta(3)$ contained several
   tricky identities of sums involving binomial coefficients that are difficult to
   prove. I instead follow Beukers's proof, which consists of several fairly
   straightforward manipulations of integrals with absolutely no caveats.
 
   Both Ap\'{e}ry and Beukers make use of an asymptotic upper bound on
   $\text{lcm}\{1\ldots n\}$ -- namely $\text{lcm}\{1\ldots n\} \in o(c^n)$ for
   any $c > e$, which is a consequence of the Prime Number Theorem (which, fortunately,
   is available in the \emph{Archive of Formal Proofs}~\<^cite>\<open>"afp_primes1" and "afp_primes2"\<close>).
 
   I follow the concise presentation of Beukers's proof in Filaseta's lecture
   notes~\<^cite>\<open>"filaseta"\<close>, which turned out to be very amenable to formalisation.
 
   There is another earlier formalisation of the irrationality of $\zeta(3)$ by
   Mahboubi\ \emph{et al.}~\<^cite>\<open>"mahboubi"\<close>, who followed Ap\'{e}ry's original proof,
   but were ultimately forced to find a more elementary way to prove the asymptotics
   of $\text{lcm}\{1\ldots n\}$ than the Prime Number Theorem.
 
   First, we will require some auxiliary material before we get started with the actual
   proof.
 \<close>
 
 (* TODO: A lot of this (if not all of it) should really be in the library *)
 subsection \<open>Auxiliary facts about polynomials\<close>
 
 lemma degree_higher_pderiv: "degree ((pderiv ^^ n) p) = degree p - n"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
   by (induction n arbitrary: p) (auto simp: degree_pderiv)
 
 lemma pcompose_power_left: "pcompose (p ^ n) q = pcompose p q ^ n"
   by (induction n) (auto simp: pcompose_mult pcompose_1)
 
 lemma pderiv_sum: "pderiv (\<Sum>x\<in>A. f x) = (\<Sum>x\<in>A. pderiv (f x))"
   by (induction A rule: infinite_finite_induct) (auto simp: pderiv_add)
 
 lemma higher_pderiv_minus: "(pderiv ^^ n) (-p :: 'a :: idom poly) = -(pderiv ^^ n) p"
   by (induction n) (auto simp: pderiv_minus)
 
 lemma pderiv_power: "pderiv (p ^ n) = smult (of_nat n) (p ^ (n - 1)) * pderiv p"
   by (cases n) (simp_all add: pderiv_power_Suc del: power_Suc)
 
 lemma pderiv_monom: "pderiv (monom c n) = monom (of_nat n * c) (n - 1)"
   by (simp add: monom_altdef pderiv_smult pderiv_power pderiv_pCons mult_ac)
 
 lemma higher_pderiv_monom:
   "k \<le> n \<Longrightarrow> (pderiv ^^ k) (monom c n) = monom (of_nat (pochhammer (n - k + 1) k) * c) (n - k)"
   by (induction k) (auto simp: pderiv_monom pochhammer_rec Suc_diff_le Suc_diff_Suc mult_ac)
 
 lemma higher_pderiv_mult:
   "(pderiv ^^ n) (p * q) =
      (\<Sum>k\<le>n. Polynomial.smult (of_nat (n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (n - k)) q))"
 proof (induction n)
   case (Suc n)
   have eq: "(Suc n choose k) = (n choose k) + (n choose (k-1))" if "k > 0" for k
     using that by (cases k) auto
   have "(pderiv ^^ Suc n) (p * q) =
           (\<Sum>k\<le>n. smult (of_nat (n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q)) +
           (\<Sum>k\<le>n. smult (of_nat (n choose k)) ((pderiv ^^ Suc k) p * (pderiv ^^ (n - k)) q))"
     by (simp add: Suc pderiv_sum pderiv_smult pderiv_mult sum.distrib smult_add_right algebra_simps Suc_diff_le)
   also have "(\<Sum>k\<le>n. smult (of_nat (n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q)) =
              (\<Sum>k\<in>insert 0 {1..n}. smult (of_nat (n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q))"
     by (intro sum.cong) auto
   also have "\<dots> = (\<Sum>k=1..n. smult (of_nat (n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q)) + p * (pderiv ^^ Suc n) q"
     by (subst sum.insert) (auto simp: add_ac)
   also have "(\<Sum>k\<le>n. smult (of_nat (n choose k)) ((pderiv ^^ Suc k) p * (pderiv ^^ (n - k)) q)) =
              (\<Sum>k=1..n+1. smult (of_nat (n choose (k-1))) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q))"
     by (intro sum.reindex_bij_witness[of _ "\<lambda>k. k - 1" Suc]) auto
   also have "\<dots> = (\<Sum>k\<in>insert (n+1) {1..n}. smult (of_nat (n choose (k-1))) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q))"
     by (intro sum.cong) auto
   also have "\<dots> = (\<Sum>k=1..n. smult (of_nat (n choose (k-1))) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q)) + (pderiv ^^ Suc n) p * q"
     by (subst sum.insert) (auto simp: add_ac)
   also have "(\<Sum>k=1..n. smult (of_nat (n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q)) +
                  p * (pderiv ^^ Suc n) q + \<dots> =
              (\<Sum>k=1..n. smult (of_nat (Suc n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q)) +
                  p * (pderiv ^^ Suc n) q + (pderiv ^^ Suc n) p * q"
     by (simp add: sum.distrib algebra_simps smult_add_right eq smult_add_left)
   also have "\<dots> = (\<Sum>k\<in>{1..n}\<union>{0,Suc n}. smult (of_nat (Suc n choose k)) ((pderiv ^^ k) p * (pderiv ^^ (Suc n - k)) q))"
     by (subst sum.union_disjoint) (auto simp: algebra_simps)
   also have "{1..n}\<union>{0,Suc n} = {..Suc n}" by auto
   finally show ?case .
 qed auto
 
 subsection \<open>Auxiliary facts about integrals\<close>
 
 theorem (in pair_sigma_finite) Fubini_set_integrable:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "set_borel_measurable (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f"
     and integ1: "set_integrable M1 A (\<lambda>x. \<integral>y\<in>B. norm (f (x, y)) \<partial>M2)"
     and integ2: "AE x\<in>A in M1. set_integrable M2 B (\<lambda>y. f (x, y))"
   shows "set_integrable (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f"
   unfolding set_integrable_def
 proof (rule Fubini_integrable)
   note integ1
   also have "set_integrable M1 A (\<lambda>x. \<integral>y\<in>B. norm (f (x, y)) \<partial>M2) \<longleftrightarrow>
         integrable M1 (\<lambda>x. LINT y|M2. norm (indicat_real (A \<times> B) (x, y) *\<^sub>R f (x, y)))"
     unfolding set_integrable_def
     by (intro Bochner_Integration.integrable_cong) (auto simp: indicator_def set_lebesgue_integral_def)
   finally show \<dots> .
 next
   from integ2 show "AE x in M1. integrable M2 (\<lambda>y. indicat_real (A \<times> B) (x, y) *\<^sub>R f (x, y))"
   proof eventually_elim
     case (elim x)
     show "integrable M2 (\<lambda>y. indicat_real (A \<times> B) (x, y) *\<^sub>R f (x, y))"
     proof (cases "x \<in> A")
       case True
       with elim have "set_integrable M2 B (\<lambda>y. f (x, y))" by simp
       also have "?this \<longleftrightarrow> ?thesis"
         unfolding set_integrable_def using True
         by (intro Bochner_Integration.integrable_cong) (auto simp: indicator_def)
       finally show ?thesis .
     qed auto
   qed
 qed (insert assms, auto simp: set_borel_measurable_def)
 
 lemma (in pair_sigma_finite) set_integral_fst':
   fixes f :: "_ \<Rightarrow> 'c :: {second_countable_topology, banach}"
   assumes "set_integrable (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f"
   shows   "set_lebesgue_integral (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f =
              (\<integral>x\<in>A. (\<integral>y\<in>B. f (x, y) \<partial>M2) \<partial>M1)"
 proof -
   have "set_lebesgue_integral (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f =
           (\<integral>z. indicator (A \<times> B) z *\<^sub>R f z \<partial>(M1 \<Otimes>\<^sub>M M2))"
     by (simp add: set_lebesgue_integral_def)
   also have "\<dots> = (\<integral>x. \<integral>y. indicator (A \<times> B) (x,y) *\<^sub>R f (x,y) \<partial>M2 \<partial>M1)"
     using assms by (subst integral_fst' [symmetric]) (auto simp: set_integrable_def)
   also have "\<dots> = (\<integral>x\<in>A. (\<integral>y\<in>B. f (x,y) \<partial>M2) \<partial>M1)"
     unfolding set_lebesgue_integral_def
     by (intro Bochner_Integration.integral_cong refl) (auto simp: indicator_def)
   finally show ?thesis .
 qed
 
 lemma (in pair_sigma_finite) set_integral_snd:
   fixes f :: "_ \<Rightarrow> 'c :: {second_countable_topology, banach}"
   assumes "set_integrable (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f"
   shows   "set_lebesgue_integral (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f =
              (\<integral>y\<in>B. (\<integral>x\<in>A. f (x, y) \<partial>M1) \<partial>M2)"
 proof -
   have "set_lebesgue_integral (M1 \<Otimes>\<^sub>M M2) (A \<times> B) f =
           (\<integral>z. indicator (A \<times> B) z *\<^sub>R f z \<partial>(M1 \<Otimes>\<^sub>M M2))"
     by (simp add: set_lebesgue_integral_def)
   also have "\<dots> = (\<integral>y. \<integral>x. indicator (A \<times> B) (x,y) *\<^sub>R f (x,y) \<partial>M1 \<partial>M2)"
     using assms by (subst integral_snd) (auto simp: set_integrable_def case_prod_unfold)
   also have "\<dots> = (\<integral>y\<in>B. (\<integral>x\<in>A. f (x,y) \<partial>M1) \<partial>M2)"
     unfolding set_lebesgue_integral_def
     by (intro Bochner_Integration.integral_cong refl) (auto simp: indicator_def)
   finally show ?thesis .
 qed
 
 proposition (in pair_sigma_finite) Fubini_set_integral:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes f: "set_integrable (M1 \<Otimes>\<^sub>M M2) (A \<times> B) (case_prod f)"
   shows "(\<integral>y\<in>B. (\<integral>x\<in>A. f x y \<partial>M1) \<partial>M2) = (\<integral>x\<in>A. (\<integral>y\<in>B. f x y \<partial>M2) \<partial>M1)"
 proof -
   have "(\<integral>y\<in>B. (\<integral>x\<in>A. f x y \<partial>M1) \<partial>M2) = (\<integral>y. (\<integral>x. indicator (A \<times> B) (x, y) *\<^sub>R f x y \<partial>M1) \<partial>M2)"
     unfolding set_lebesgue_integral_def
     by (intro Bochner_Integration.integral_cong) (auto simp: indicator_def)
   also have "\<dots> = (\<integral>x. (\<integral>y. indicator (A \<times> B) (x, y) *\<^sub>R f x y \<partial>M2) \<partial>M1)"
     using assms by (intro Fubini_integral) (auto simp: set_integrable_def case_prod_unfold)
   also have "\<dots> = (\<integral>x\<in>A. (\<integral>y\<in>B. f x y \<partial>M2) \<partial>M1)"
     unfolding set_lebesgue_integral_def
     by (intro Bochner_Integration.integral_cong) (auto simp: indicator_def)
   finally show ?thesis .
 qed
 
 lemma (in pair_sigma_finite) nn_integral_swap:
   assumes [measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<integral>\<^sup>+x. f x \<partial>(M1 \<Otimes>\<^sub>M M2)) = (\<integral>\<^sup>+(y,x). f (x,y) \<partial>(M2 \<Otimes>\<^sub>M M1))"
   by (subst distr_pair_swap, subst nn_integral_distr) (auto simp: case_prod_unfold)
 
 lemma set_integrable_bound:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
     and g :: "'a \<Rightarrow> 'c::{banach, second_countable_topology}"
   shows "set_integrable M A f \<Longrightarrow> set_borel_measurable M A g \<Longrightarrow>
            (AE x in M. x \<in> A \<longrightarrow> norm (g x) \<le> norm (f x)) \<Longrightarrow> set_integrable M A g"
   unfolding set_integrable_def
   apply (erule Bochner_Integration.integrable_bound)
    apply (simp add: set_borel_measurable_def)
   apply (erule eventually_mono)
   apply (auto simp: indicator_def)
   done
 
 lemma set_integrableI_nonneg:
   fixes f :: "'a \<Rightarrow> real"
   assumes "set_borel_measurable M A f"
   assumes "AE x in M. x \<in> A \<longrightarrow> 0 \<le> f x" "(\<integral>\<^sup>+x\<in>A. f x \<partial>M) < \<infinity>"
   shows "set_integrable M A f"
   unfolding set_integrable_def
 proof (rule integrableI_nonneg)
   from assms show "(\<lambda>x. indicator A x *\<^sub>R f x) \<in> borel_measurable M"
     by (simp add: set_borel_measurable_def)
   from assms(2) show "AE x in M. 0 \<le> indicat_real A x *\<^sub>R f x"
     by eventually_elim (auto simp: indicator_def)
   have "(\<integral>\<^sup>+x. ennreal (indicator A x *\<^sub>R f x) \<partial>M) = (\<integral>\<^sup>+x\<in>A. f x \<partial>M)"
     by (intro nn_integral_cong) (auto simp: indicator_def)
   also have "\<dots> < \<infinity>" by fact
   finally show "(\<integral>\<^sup>+x. ennreal (indicator A x *\<^sub>R f x) \<partial>M) < \<infinity>" .
 qed
 
 lemma set_integral_eq_nn_integral:
   assumes "set_borel_measurable M A f"
   assumes "set_nn_integral M A f = ennreal x" "x \<ge> 0"
   assumes "AE x in M. x \<in> A \<longrightarrow> f x \<ge> 0"
   shows   "set_integrable M A f"
     and   "set_lebesgue_integral M A f = x"
 proof -
   have eq: "(\<lambda>x. (if x \<in> A then 1 else 0) * f x) = (\<lambda>x. if x \<in> A then f x else 0)"
            "(\<lambda>x. if x \<in> A then ennreal (f x) else 0) =
               (\<lambda>x. ennreal (f x) * (if x \<in> A then 1 else 0))"
            "(\<lambda>x. ennreal (f x * (if x \<in> A then 1 else 0))) =
               (\<lambda>x. ennreal (f x) * (if x \<in> A then 1 else 0))"
     by auto
   from assms show *: "set_integrable M A f"
     by (intro set_integrableI_nonneg) auto
 
   have "set_lebesgue_integral M A f = enn2real (set_nn_integral M A f)"
     unfolding set_lebesgue_integral_def using assms(1,4) * eq
     by (subst integral_eq_nn_integral)
        (auto intro!: nn_integral_cong simp: indicator_def of_bool_def set_integrable_def mult_ac)
   also have "\<dots> = x" using assms by simp
   finally show "set_lebesgue_integral M A f = x" .
 qed
 
 lemma set_integral_0 [simp, intro]: "set_integrable M A (\<lambda>y. 0)"
   by (simp add: set_integrable_def)
 
 lemma set_integrable_sum:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "finite B"
   assumes "\<And>x. x \<in> B \<Longrightarrow> set_integrable M A (f x)"
   shows "set_integrable M A (\<lambda>y. \<Sum>x\<in>B. f x y)"
   using assms by (induction rule: finite_induct) (auto intro!: set_integral_add)
 
 lemma set_integral_sum:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "finite B"
   assumes "\<And>x. x \<in> B \<Longrightarrow> set_integrable M A (f x)"
   shows "set_lebesgue_integral M A (\<lambda>y. \<Sum>x\<in>B. f x y) = (\<Sum>x\<in>B. set_lebesgue_integral M A (f x))"
   using assms
   apply (induction rule: finite_induct)
   apply simp
   apply simp
   apply (subst set_integral_add)
     apply (auto intro!: set_integrable_sum)
   done
 
 lemma set_nn_integral_cong:
   assumes "M = M'" "A = B" "\<And>x. x \<in> space M \<inter> A \<Longrightarrow> f x = g x"
   shows   "set_nn_integral M A f = set_nn_integral M' B g"
   using assms unfolding assms(1,2) by (intro nn_integral_cong) (auto simp: indicator_def)
 
 lemma set_nn_integral_mono:
   assumes "\<And>x. x \<in> space M \<inter> A \<Longrightarrow> f x \<le> g x"
   shows   "set_nn_integral M A f \<le> set_nn_integral M A g"
   using assms by (intro nn_integral_mono) (auto simp: indicator_def)
 
 lemma
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
   assumes deriv: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> (F has_field_derivative f x) (at x within {a..b})"
   assumes cont: "continuous_on {a..b} f"
   shows has_bochner_integral_FTC_Icc_real:
       "has_bochner_integral lborel (\<lambda>x. f x * indicator {a .. b} x) (F b - F a)" (is ?has)
     and integral_FTC_Icc_real: "(\<integral>x. f x * indicator {a .. b} x \<partial>lborel) = F b - F a" (is ?eq)
 proof -
   have 1: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> (F has_vector_derivative f x) (at x within {a .. b})"
     unfolding has_real_derivative_iff_has_vector_derivative[symmetric]
     using deriv by auto
   show ?has ?eq
     using has_bochner_integral_FTC_Icc[OF \<open>a \<le> b\<close> 1 cont] integral_FTC_Icc[OF \<open>a \<le> b\<close> 1 cont]
     by (auto simp: mult.commute)
 qed
 
 lemma integral_by_parts_integrable:
   fixes f g F G::"real \<Rightarrow> real"
   assumes "a \<le> b"
   assumes cont_f[intro]: "continuous_on {a..b} f"
   assumes cont_g[intro]: "continuous_on {a..b} g"
   assumes [intro]: "\<And>x. x \<in> {a..b} \<Longrightarrow> (F has_field_derivative f x) (at x within {a..b})"
   assumes [intro]: "\<And>x. x \<in> {a..b} \<Longrightarrow> (G has_field_derivative g x) (at x within {a..b})"
   shows  "integrable lborel (\<lambda>x.((F x) * (g x) + (f x) * (G x)) * indicator {a .. b} x)"
 proof -
   have "integrable lborel (\<lambda>x. indicator {a..b} x *\<^sub>R ((F x) * (g x) + (f x) * (G x)))"
     by (intro borel_integrable_compact continuous_intros assms)
        (auto intro!: DERIV_continuous_on assms)
   thus ?thesis by (simp add: mult_ac)
 qed
 
 lemma integral_by_parts:
   fixes f g F G::"real \<Rightarrow> real"
   assumes [arith]: "a \<le> b"
   assumes cont_f[intro]: "continuous_on {a..b} f"
   assumes cont_g[intro]: "continuous_on {a..b} g"
   assumes [intro]: "\<And>x. x \<in> {a..b} \<Longrightarrow> (F has_field_derivative f x) (at x within {a..b})"
   assumes [intro]: "\<And>x. x \<in> {a..b} \<Longrightarrow> (G has_field_derivative g x) (at x within {a..b})"
   shows "(\<integral>x. (F x * g x) * indicator {a .. b} x \<partial>lborel)
             =  F b * G b - F a * G a - \<integral>x. (f x * G x) * indicator {a .. b} x \<partial>lborel"
 proof-
   have 0: "(\<integral>x. (F x * g x + f x * G x) * indicator {a .. b} x \<partial>lborel) = F b * G b - F a * G a"
     by (rule integral_FTC_Icc_real, auto intro!: derivative_eq_intros continuous_intros)
        (auto intro!: assms DERIV_continuous_on)
   have [continuous_intros]: "continuous_on {a..b} F"
     by (rule DERIV_continuous_on assms)+
   have [continuous_intros]: "continuous_on {a..b} G"
     by (rule DERIV_continuous_on assms)+
 
   have "(\<integral>x. indicator {a..b} x *\<^sub>R (F x * g x + f x * G x) \<partial>lborel) =
     (\<integral>x. indicator {a..b} x *\<^sub>R(F x * g x) \<partial>lborel) + \<integral>x. indicator {a..b} x *\<^sub>R (f x * G x) \<partial>lborel"
     apply (subst Bochner_Integration.integral_add[symmetric])
       apply (rule borel_integrable_compact; force intro!: continuous_intros assms)
      apply (rule borel_integrable_compact; force intro!: continuous_intros assms)
     apply (simp add: algebra_simps)
     done
 
   thus ?thesis using 0 by (simp add: algebra_simps)
 qed
 
 lemma interval_lebesgue_integral_by_parts:
   assumes "a \<le> b"
   assumes cont_f[intro]: "continuous_on {a..b} f"
   assumes cont_g[intro]: "continuous_on {a..b} g"
   assumes [intro]: "\<And>x. x \<in> {a..b} \<Longrightarrow> (F has_field_derivative f x) (at x within {a..b})"
   assumes [intro]: "\<And>x. x \<in> {a..b} \<Longrightarrow> (G has_field_derivative g x) (at x within {a..b})"
   shows "(LBINT x=a..b. F x * g x) = F b * G b - F a * G a - (LBINT x=a..b. f x * G x)"
   using integral_by_parts[of a b f g F G] assms
   by (simp add: interval_integral_Icc set_lebesgue_integral_def mult_ac)
 
 lemma interval_lebesgue_integral_by_parts_01:
   assumes cont_f[intro]: "continuous_on {0..1} f"
   assumes cont_g[intro]: "continuous_on {0..1} g"
   assumes [intro]: "\<And>x. x \<in> {0..1} \<Longrightarrow> (F has_field_derivative f x) (at x within {0..1})"
   assumes [intro]: "\<And>x. x \<in> {0..1} \<Longrightarrow> (G has_field_derivative g x) (at x within {0..1})"
   shows "(LBINT x=0..1. F x * g x) = F 1 * G 1 - F 0 * G 0 - (LBINT x=0..1. f x * G x)"
   using interval_lebesgue_integral_by_parts[of 0 1 f g F G] assms
   by (simp add: zero_ereal_def one_ereal_def)
 
 lemma continuous_on_imp_set_integrable_cbox:
   fixes h :: "'a :: euclidean_space \<Rightarrow> real"
   assumes "continuous_on (cbox a b) h"
   shows   "set_integrable lborel (cbox a b) h"
 proof -
   from assms have "h absolutely_integrable_on cbox a b"
     by (rule absolutely_integrable_continuous)
   moreover have "(\<lambda>x. indicat_real (cbox a b) x *\<^sub>R h x) \<in> borel_measurable borel"
     by (rule borel_measurable_continuous_on_indicator) (use assms in auto)
   ultimately show ?thesis
     unfolding set_integrable_def using assms by (subst (asm) integrable_completion) auto
 qed
 
 
 subsection \<open>Shifted Legendre polynomials\<close>
 
 text \<open>
   The first ingredient we need to show Apéry's theorem is the \<^emph>\<open>shifted
   Legendre polynomials\<close>
     \[P_n(X) = \frac{1}{n!} \frac{\partial^n}{\partial X^n} (X^n(1-X)^n)\]
   and the auxiliary polynomials
     \[Q_{n,k}(X) = \frac{\partial^k}{\partial X^k} (X^n(1-X)^n)\ .\]
   Note that $P_n$ is in fact an \emph{integer} polynomial.
 
   Only some very basic properties of these will be proven, since that is all we will need.
 \<close>
 
 context
   fixes n :: nat
 begin
 
 definition gen_shleg_poly :: "nat \<Rightarrow> int poly" where
   "gen_shleg_poly k = (pderiv ^^ k) ([:0, 1, -1:] ^ n)"
 
 definition shleg_poly where "shleg_poly = gen_shleg_poly n div [:fact n:]"
 
 text \<open>
   We can easily prove the following more explicit formula for $Q_{n,k}$:
   \[Q_{n,k}(X) = \sum_{i=0}^k (-1)^{k-1} {k \choose i}
       n^{\underline{i}}\, n^{\underline{k-i}}\, X^{n-i}\, (1-X)^{n-k+i}\]
 \<close>
 lemma gen_shleg_poly_altdef:
   assumes "k \<le> n"
   shows "gen_shleg_poly k =
             (\<Sum>i\<le>k. smult ((-1)^(k-i) * of_nat (k choose i) *
                     pochhammer (n-i+1) i * pochhammer (n-k+i+1) (k-i))
                     ([:0, 1:] ^ (n - i) * [:1, -1:] ^ (n-k+i)))"
 proof -
   have *: "(pderiv ^^ i) (x \<circ>\<^sub>p [:1, -1:]) =
           smult ((-1) ^ i) ((pderiv ^^ i) x \<circ>\<^sub>p [:1, -1:])" for i and x :: "int poly"
     by (induction i arbitrary: x)
        (auto simp: pderiv_smult pderiv_pcompose funpow_Suc_right pderiv_pCons
                    higher_pderiv_minus simp del: funpow.simps(2))
 
   have "gen_shleg_poly k = (pderiv ^^ k) ([:0, 1, -1:] ^ n)"
     by (simp add: gen_shleg_poly_def)
   also have "[:0, 1, -1::int:] = [:0, 1:] * [:1, -1:]"
     by simp
   also have "\<dots> ^ n = [:0, 1:] ^ n * [:1, -1:] ^ n"
     by (simp flip: power_mult_distrib)
   also have "(pderiv ^^ k) \<dots> =
                (\<Sum>i\<le>k. smult (of_nat (k choose i)) ((pderiv ^^ i)
                  ([:0, 1:] ^ n) * (pderiv ^^ (k - i)) ([:1, -1:] ^ n)))"
     by (simp add: higher_pderiv_mult)
   also have "\<dots> = (\<Sum>i\<le>k. smult (of_nat (k choose i))
                     ((pderiv ^^ i) (monom 1 n) * (pderiv ^^ (k - i)) (monom 1 n \<circ>\<^sub>p [:1, -1:])))"
     by (simp add: monom_altdef pcompose_pCons pcompose_power_left)
   also have "\<dots> = (\<Sum>i\<le>k. smult ((-1) ^ (k - i) * of_nat (k choose i))
                    ((pderiv ^^ i) (monom 1 n) * ((pderiv ^^ (k - i)) (monom 1 n) \<circ>\<^sub>p [:1, -1:])))"
     by (simp add: * mult_ac)
   also have "\<dots> = (\<Sum>i\<le>k. smult ((-1) ^ (k - i) * of_nat (k choose i))
                    (monom (pochhammer (n - i + 1) i) (n - i) *
                     monom (pochhammer (n - k + i + 1) (k - i)) (n - k + i) \<circ>\<^sub>p [:1, -1:]))"
     using assms by (simp add: higher_pderiv_monom)
   also have "\<dots> = (\<Sum>i\<le>k. smult ((-1) ^ (k - i) * of_nat (k choose i) * pochhammer (n - i + 1) i * pochhammer (n - k + i + 1) (k - i))
                    ([:0, 1:] ^ (n - i) * [:1, -1:] ^ (n - k + i)))"
     by (simp add: monom_altdef algebra_simps pcompose_smult pcompose_power_left pcompose_pCons)
   finally show ?thesis .
 qed
 
 lemma degree_gen_shleg_poly [simp]: "degree (gen_shleg_poly k) = 2 * n - k"
   by (simp add: gen_shleg_poly_def degree_higher_pderiv degree_power_eq)
 
 lemma gen_shleg_poly_n: "gen_shleg_poly n = smult (fact n) shleg_poly"
 proof -
   obtain r where r: "gen_shleg_poly n = [:fact n:] * r"
     unfolding gen_shleg_poly_def using fact_dvd_higher_pderiv[of n "[:0,1,-1:]^n"] by blast
   have "smult (fact n) shleg_poly = smult (fact n) (gen_shleg_poly n div [:fact n:])"
     by (simp add: shleg_poly_def)
   also note r
   also have "[:fact n:] * r div [:fact n:] = r"
     by (rule nonzero_mult_div_cancel_left) auto
   finally show ?thesis
     by (simp add: r)
 qed
 
 lemma degree_shleg_poly [simp]: "degree shleg_poly = n"
   using degree_gen_shleg_poly[of n] by (simp add: gen_shleg_poly_n)
 
 lemma pderiv_gen_shleg_poly [simp]: "pderiv (gen_shleg_poly k) = gen_shleg_poly (Suc k)"
   by (simp add: gen_shleg_poly_def)
 
 
 text \<open>
   The following functions are the interpretation of the shifted Legendre polynomials
   and the auxiliary polynomials as a function from reals to reals.
 \<close>
 definition Gen_Shleg :: "nat \<Rightarrow> real \<Rightarrow> real"
   where "Gen_Shleg k x = poly (of_int_poly (gen_shleg_poly k)) x"
 
 definition Shleg :: "real \<Rightarrow> real" where "Shleg = poly (of_int_poly shleg_poly)"
 
 lemma Gen_Shleg_altdef:
   assumes "k \<le> n"
   shows   "Gen_Shleg k x = (\<Sum>i\<le>k. (-1)^(k-i) * of_nat (k choose i) *
                             of_int (pochhammer (n-i+1) i * pochhammer (n-k+i+1) (k-i)) *
                             x ^ (n - i) * (1 - x) ^ (n-k+i))"
   using assms by (simp add: Gen_Shleg_def gen_shleg_poly_altdef poly_sum mult_ac)
 
 lemma Gen_Shleg_0 [simp]: "k < n \<Longrightarrow> Gen_Shleg k 0 = 0"
   by (simp add: Gen_Shleg_altdef zero_power)
 
 lemma Gen_Shleg_1 [simp]: "k < n \<Longrightarrow> Gen_Shleg k 1 = 0"
   by (simp add: Gen_Shleg_altdef zero_power)
 
 lemma Gen_Shleg_n_0 [simp]: "Gen_Shleg n 0 = fact n"
 proof -
   have "Gen_Shleg n 0 = (\<Sum>i\<le>n. (-1) ^ (n-i) * real (n choose i) *
         (real (pochhammer (Suc (n-i)) i) *
          real (pochhammer (Suc i) (n-i))) * 0 ^ (n - i))"
     by (simp add: Gen_Shleg_altdef)
   also have "\<dots> = (\<Sum>i\<in>{n}. (-1) ^ (n-i) * real (n choose i) *
         (real (pochhammer (Suc (n-i)) i) *
          real (pochhammer (Suc i) (n-i))) * 0 ^ (n - i))"
     by (intro sum.mono_neutral_right) auto
   also have "\<dots> = fact n"
     by (simp add: pochhammer_fact flip: pochhammer_of_nat)
   finally show ?thesis .
 qed
 
 lemma Gen_Shleg_n_1 [simp]: "Gen_Shleg n 1 = (-1) ^ n * fact n"
 proof -
   have "Gen_Shleg n 1 = (\<Sum>i\<le>n. (-1) ^ (n-i) * real (n choose i) *
         (real (pochhammer (Suc (n-i)) i) *
          real (pochhammer (Suc i) (n-i))) * 0 ^ i)"
     by (simp add: Gen_Shleg_altdef)
   also have "\<dots> = (\<Sum>i\<in>{0}. (-1) ^ (n-i) * real (n choose i) *
         (real (pochhammer (Suc (n-i)) i) *
          real (pochhammer (Suc i) (n-i))) * 0 ^ i)"
     by (intro sum.mono_neutral_right) auto
   also have "\<dots> = (-1) ^ n * fact n"
     by (simp add: pochhammer_fact flip: pochhammer_of_nat)
   finally show ?thesis .
 qed
 
 lemma Shleg_altdef: "Shleg x = Gen_Shleg n x / fact n"
   by (simp add: Shleg_def Gen_Shleg_def gen_shleg_poly_n)
 
 lemma Shleg_0 [simp]: "Shleg 0 = 1" and Shleg_1 [simp]: "Shleg 1 = (-1) ^ n"
   by (simp_all add: Shleg_altdef)
 
 lemma Gen_Shleg_0_left: "Gen_Shleg 0 x = x ^ n * (1 - x) ^ n"
   by (simp add: Gen_Shleg_def gen_shleg_poly_def power_mult_distrib)
 
 lemma has_field_derivative_Gen_Shleg:
   "(Gen_Shleg k has_field_derivative Gen_Shleg (Suc k) x) (at x)"
 proof -
   note [derivative_intros] = poly_DERIV
   show ?thesis unfolding Gen_Shleg_def
     by (rule derivative_eq_intros) auto
 qed
 
 lemma continuous_on_Gen_Shleg: "continuous_on A (Gen_Shleg k)"
   by (auto simp: Gen_Shleg_def intro!: continuous_intros)
 
 lemma continuous_on_Gen_Shleg' [continuous_intros]:
   "continuous_on A f \<Longrightarrow> continuous_on A (\<lambda>x. Gen_Shleg k (f x))"
   by (rule continuous_on_compose2[OF continuous_on_Gen_Shleg[of UNIV]]) auto
 
 lemma continuous_on_Shleg: "continuous_on A Shleg"
   by (auto simp: Shleg_def intro!: continuous_intros)
 
 lemma continuous_on_Shleg' [continuous_intros]:
   "continuous_on A f \<Longrightarrow> continuous_on A (\<lambda>x. Shleg (f x))"
   by (rule continuous_on_compose2[OF continuous_on_Shleg[of UNIV]]) auto
 
 lemma measurable_Gen_Shleg [measurable]: "Gen_Shleg n \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_on_Gen_Shleg)
 
 lemma measurable_Shleg [measurable]: "Shleg \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_on_Shleg)
 
 end
 
 
 subsection \<open>Auxiliary facts about the \<open>\<zeta>\<close> function\<close>
 
 lemma Re_zeta_ge_1:
   assumes "x > 1"
   shows   "Re (zeta (of_real x)) \<ge> 1"
 proof -
   have *: "(\<lambda>n. real (Suc n) powr -x) sums Re (zeta (complex_of_real x))"
     using sums_Re[OF sums_zeta[of "of_real x"]] assms by (simp add: powr_Reals_eq)
   show "Re (zeta (of_real x)) \<ge> 1"
   proof (rule sums_le[OF _ _ *])
     show "(\<lambda>n. if n = 0 then 1 else 0) sums 1"
       by (rule sums_single)
   qed auto
 qed
 
 lemma sums_zeta_of_nat_offset:
   fixes r :: nat
   assumes n: "n > 1"
   shows "(\<lambda>k. 1 / (r + k + 1) ^ n) sums (zeta (of_nat n) - (\<Sum>k=1..r. 1 / k ^ n))"
 proof -
   have "(\<lambda>k. 1 / (k + 1) ^ n) sums zeta (of_nat n)"
     using sums_zeta[of "of_nat n"] n
     by (simp add: powr_minus field_simps flip: of_nat_Suc)
   from sums_split_initial_segment[OF this, of r]
   have "(\<lambda>k. 1 / (r + k + 1) ^ n) sums (zeta (of_nat n) - (\<Sum>k<r. 1 / Suc k ^ n))"
     by (simp add: algebra_simps)
   also have "(\<Sum>k<r. 1 / Suc k ^ n) = (\<Sum>k=1..r. 1 / k ^ n)"
     by (intro sum.reindex_bij_witness[of _ "\<lambda>k. k - 1" Suc]) auto
   finally show ?thesis .
 qed
 
 lemma sums_Re_zeta_of_nat_offset:
   fixes r :: nat
   assumes n: "n > 1"
   shows "(\<lambda>k. 1 / (r + k + 1) ^ n) sums (Re (zeta (of_nat n)) - (\<Sum>k=1..r. 1 / k ^ n))"
 proof -
   have "(\<lambda>k. Re (1 / (r + k + 1) ^ n)) sums (Re (zeta (of_nat n) - (\<Sum>k=1..r. 1 / k ^ n)))"
     by (intro sums_Re sums_zeta_of_nat_offset assms)
   thus ?thesis by simp
 qed
 
 
 subsection \<open>Divisor of a sum of rationals\<close>
 
 text \<open>
   A finite sum of rationals of the form $\frac{a_1}{b_1} + \ldots + \frac{a_n}{b_n}$
   can be brought into the form $\frac{c}{d}$, where $d$ is the LCM of the $b_i$ (or
   some integer multiple thereof).
 \<close>
 lemma sum_rationals_common_divisor:
   fixes f g :: "'a \<Rightarrow> int"
   assumes "finite A"
   assumes "\<And>x. x \<in> A \<Longrightarrow> g x \<noteq> 0"
   shows   "\<exists>c. (\<Sum>x\<in>A. f x / g x) = real_of_int c / (LCM x\<in>A. g x)"
   using assms
 proof (induction rule: finite_induct)
   case empty
   thus ?case by auto
 next
   case (insert x A)
   define d where "d = (LCM x\<in>A. g x)"
   from insert have [simp]: "d \<noteq> 0"
     by (auto simp: d_def Lcm_0_iff)
   from insert have [simp]: "g x \<noteq> 0" by auto
   from insert obtain c where c: "(\<Sum>x\<in>A. f x / g x) = real_of_int c / real_of_int d"
     by (auto simp: d_def)
   define e1 where "e1 = lcm d (g x) div d"
   define e2 where "e2 = lcm d (g x) div g x"
   have "(\<Sum>y\<in>insert x A. f y / g y) = c / d + f x / g x"
     using insert c by simp
   also have "c / d = (c * e1) / lcm d (g x)"
     by (simp add: e1_def real_of_int_div)
   also have "f x / g x = (f x * e2) / lcm d (g x)"
     by (simp add: e2_def real_of_int_div)
   also have "(c * e1) / lcm d (g x) + \<dots> = (c * e1 + f x * e2) / (LCM x\<in>insert x A. g x)"
     using insert by (simp add: add_divide_distrib lcm.commute d_def)
   finally show ?case ..
 qed
 
 lemma sum_rationals_common_divisor':
   fixes f g :: "'a \<Rightarrow> int"
   assumes "finite A"
   assumes "\<And>x. x \<in> A \<Longrightarrow> g x \<noteq> 0" and "(\<And>x. x \<in> A \<Longrightarrow> g x dvd d)" and "d \<noteq> 0"
   shows   "\<exists>c. (\<Sum>x\<in>A. f x / g x) = real_of_int c / real_of_int d"
 proof -
   define d' where "d' = (LCM x\<in>A. g x)"
   have "d' dvd d"
     unfolding d'_def using assms(3) by (auto simp: Lcm_dvd_iff)
   then obtain e where e: "d = d' * e" by blast
   have "\<exists>c. (\<Sum>x\<in>A. f x / g x) = real_of_int c / (LCM x\<in>A. g x)"
     by (rule sum_rationals_common_divisor) fact+
   then obtain c where c: "(\<Sum>x\<in>A. f x / g x) = real_of_int c / real_of_int d'"
     unfolding d'_def ..
   also have "\<dots> = real_of_int (c * e) / real_of_int d"
     using \<open>d \<noteq> 0\<close> by (simp add: e)
   finally show ?thesis ..
 qed
 
 
 subsection \<open>The first double integral\<close>
 
 text \<open>
   We shall now investigate the double integral
   \[I_1 := \int_0^1 \int_0^1 -\frac{\ln(xy)}{1-xy}\,x^r y^s\, \text{d}x\,\text{d}y\ .\]
   Since everything is non-negative for now, we can work over the extended non-negative
   real numbers and the issues of integrability or summability do not arise at all.
 \<close>
 
 definition beukers_nn_integral1 :: "nat \<Rightarrow> nat \<Rightarrow> ennreal" where
   "beukers_nn_integral1 r s =
      (\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. ennreal (-ln (x*y) / (1 - x*y) * x^r * y^s) \<partial>lborel)"
 
 definition beukers_integral1 :: "nat \<Rightarrow> nat \<Rightarrow> real" where
   "beukers_integral1 r s = (\<integral>(x,y)\<in>{0<..<1}\<times>{0<..<1}. (-ln (x*y) / (1 - x*y) * x^r * y^s) \<partial>lborel)"
 
 lemma
   fixes x y z :: real
   assumes xyz: "x \<in> {0<..<1}" "y \<in> {0<..<1}" "z \<in> {0..1}"
   shows beukers_denom_ineq: "(1 - x * y) * z < 1" and beukers_denom_neq: "(1 - x * y) * z \<noteq> 1"
 proof -
   from xyz have *: "x * y < 1 * 1"
     by (intro mult_strict_mono) auto
   from * have "(1 - x * y) * z \<le> (1 - x * y) * 1"
     using xyz by (intro mult_left_mono) auto
   also have "\<dots> < 1 * 1"
     using xyz by (intro mult_strict_right_mono) auto
   finally show "(1 - x * y) * z < 1" "(1 - x * y) * z \<noteq> 1" by simp_all
 qed
 
 text \<open>
   We first evaluate the improper integral
     \[\int_0^1 -\ln x \cdot x^e\,\text{d}x = \frac{1}{(e+1)^2}\ .\]
   for any $e>-1$.
 \<close>
 lemma integral_0_1_ln_times_powr:
   assumes "e > -1"
   shows   "(LBINT x=0..1. -ln x * x powr e) = 1 / (e + 1)\<^sup>2"
     and   "interval_lebesgue_integrable lborel 0 1 (\<lambda>x. -ln x * x powr e)"
 proof -
   define f where "f = (\<lambda>x. -ln x * x powr e)"
   define F where "F = (\<lambda>x. x powr (e + 1) * (1 - (e + 1) * ln x) / (e + 1) ^ 2)"
 
   have 0: "isCont f x" if "x \<in> {0<..<1}" for x
     using that by (auto intro!: continuous_intros simp: f_def)
   have 1: "(F has_real_derivative f x) (at x)" if "x \<in> {0<..<1}" for x
   proof -
     show "(F has_real_derivative f x) (at x)"
       unfolding F_def f_def using that assms
       apply (insert that assms)
       apply (rule derivative_eq_intros refl | simp)+
       apply (simp add: divide_simps)
       apply (simp add: power2_eq_square algebra_simps powr_add power_numeral_reduce)
       done
   qed
   have 2: "AE x in lborel. ereal 0 < ereal x \<longrightarrow> ereal x < ereal 1 \<longrightarrow> 0 \<le> f x"
     by (intro AE_I2) (auto simp: f_def mult_nonpos_nonneg)
   have 3: "((F \<circ> real_of_ereal) \<longlongrightarrow> 0) (at_right (ereal 0))"
     unfolding ereal_tendsto_simps F_def using assms by real_asymp
   have 4: "((F \<circ> real_of_ereal) \<longlongrightarrow> F 1) (at_left (ereal 1))"
     unfolding ereal_tendsto_simps F_def
     using assms by real_asymp (simp add: field_simps)
 
   have "(LBINT x=ereal 0..ereal 1. f x) = F 1 - 0"
     by (rule interval_integral_FTC_nonneg[where F = F])
        (use 0 1 2 3 4 in auto)
   thus "(LBINT x=0..1. -ln x * x powr e) = 1 / (e + 1)\<^sup>2"
     by (simp add: F_def zero_ereal_def one_ereal_def f_def)
   have "set_integrable lborel (einterval (ereal 0) (ereal 1)) f"
     by (rule interval_integral_FTC_nonneg)
        (use 0 1 2 3 4 in auto)
   thus "interval_lebesgue_integrable lborel 0 1 f"
     by (simp add: interval_lebesgue_integrable_def einterval_def)
 qed
 
 lemma interval_lebesgue_integral_lborel_01_cong:
   assumes "\<And>x. x \<in> {0<..<1} \<Longrightarrow> f x = g x"
   shows   "interval_lebesgue_integral lborel 0 1 f =
            interval_lebesgue_integral lborel 0 1 g"
   using assms
   by (subst (1 2) interval_integral_Ioo)
      (auto intro!: set_lebesgue_integral_cong assms)
 
 lemma nn_integral_0_1_ln_times_powr:
   assumes "e > -1"
   shows    "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y powr e) \<partial>lborel) = ennreal (1 / (e + 1)\<^sup>2)"
 proof -
   have *: "(LBINT x=0..1. - ln x * x powr e = 1 / (e + 1)\<^sup>2)"
           "interval_lebesgue_integrable lborel 0 1 (\<lambda>x. - ln x * x powr e)"
     using integral_0_1_ln_times_powr[OF assms] by simp_all
   have eq: "(\<lambda>y. (if 0 < y \<and> y < 1 then 1 else 0) * ln y * y powr e) =
             (\<lambda>y. if 0 < y \<and> y < 1 then ln y * y powr e else 0)"
     by auto
 
   have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y powr e) \<partial>lborel) =
            (\<integral>\<^sup>+y. ennreal (-ln y * y powr e * indicator {0<..<1} y) \<partial>lborel)"
     by (intro nn_integral_cong) (auto simp: indicator_def)
   also have "\<dots> = ennreal (1 / (e + 1)\<^sup>2)"
     using * eq
     by (subst nn_integral_eq_integral)
        (auto intro!: AE_I2 simp: indicator_def interval_lebesgue_integrable_def
                set_integrable_def one_ereal_def zero_ereal_def interval_integral_Ioo
                 mult_ac mult_nonpos_nonneg set_lebesgue_integral_def)
   finally show ?thesis .
 qed
 
 lemma nn_integral_0_1_ln_times_power:
   "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y ^ n) \<partial>lborel) = ennreal (1 / (n + 1)\<^sup>2)"
 proof -
   have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y ^ n) \<partial>lborel) =
           (\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y powr real n) \<partial>lborel)"
     by (intro set_nn_integral_cong) (auto simp: powr_realpow)
   also have "\<dots> = ennreal (1 / (n + 1)^2)"
     by (subst nn_integral_0_1_ln_times_powr) auto
   finally show ?thesis by simp
 qed
 
 text \<open>
   Next, we also evaluate the more trivial integral
     \[\int_0^1 x^n\ \text{d}x\ .\]
 \<close>
 lemma nn_integral_0_1_power:
   "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (y ^ n) \<partial>lborel) = ennreal (1 / (n + 1))"
 proof -
   have *: "((\<lambda>a. a ^ (n + 1) / real (n + 1)) has_real_derivative x ^ n) (at x)" for x
     by (rule derivative_eq_intros refl | simp)+
   have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (y ^ n) \<partial>lborel) = (\<integral>\<^sup>+y\<in>{0..1}. ennreal (y ^ n) \<partial>lborel)"
     by (intro nn_integral_cong_AE AE_I[of _ _ "{0,1}"])
        (auto simp: indicator_def emeasure_lborel_countable)
   also have "\<dots> = ennreal (1 ^ (n + 1) / (n + 1) - 0 ^ (n + 1) / (n + 1))"
     using * by (intro nn_integral_FTC_Icc) auto
   also have "\<dots> = ennreal (1 / (n + 1))"
     by simp
   finally show ?thesis by simp
 qed
 
 text \<open>
   $I_1$ can alternatively be written as the triple integral
     \[\int_0^1\int_0^1\int_0^1
         \frac{x^r y^s}{1-(1-xy)w}\ \text{d}x\,\text{d}y\,\text{d}w\ .\]
 \<close>
 lemma beukers_nn_integral1_altdef:
   "beukers_nn_integral1 r s =
      (\<integral>\<^sup>+(w,x,y)\<in>{0<..<1}\<times>{0<..<1}\<times>{0<..<1}.
        ennreal (1 / (1-(1-x*y)*w) * x^r * y^s) \<partial>lborel)"
 proof -
   have "(\<integral>\<^sup>+(w,x,y)\<in>{0<..<1}\<times>{0<..<1}\<times>{0<..<1}.
            ennreal (1 / (1-(1-x*y)*w) * x^r * y^s) \<partial>lborel) =
         (\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. (\<integral>\<^sup>+w\<in>{0<..<1}.
            ennreal (1 / (1-(1-x*y)*w) * x^r * y^s) \<partial>lborel) \<partial>lborel)"
     by (subst lborel_prod [symmetric], subst lborel_pair.nn_integral_snd [symmetric])
        (auto simp: case_prod_unfold indicator_def simp flip: lborel_prod intro!: nn_integral_cong)
   also have "\<dots> = (\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. ennreal (-ln (x*y)/(1-x*y) * x^r * y^s) \<partial>lborel)"
   proof (intro nn_integral_cong, clarify)
     fix x y :: real
     have "(\<integral>\<^sup>+w\<in>{0<..<1}. ennreal (1/(1-(1-x*y)*w)*x^r*y^s) \<partial>lborel) =
              ennreal (-ln (x*y)*x^r*y^s/(1-x*y))"
       if xy: "(x, y) \<in> {0<..<1} \<times> {0<..<1}"
     proof -
       from xy have "x * y < 1"
         using mult_strict_mono[of x 1 y 1] by simp
       have deriv: "((\<lambda>w. -ln (1-(1-x*y)*w) / (1-x*y)) has_real_derivative
               1/(1-(1-x*y)*w)) (at w)" if w: "w \<in> {0..1}" for w
         by (insert xy w \<open>x*y<1\<close> beukers_denom_ineq[of x y w])
            (rule derivative_eq_intros refl | simp add: divide_simps)+
       have "(\<integral>\<^sup>+w\<in>{0<..<1}. ennreal (1/(1-(1-x*y)*w)*x^r*y^s) \<partial>lborel) =
               ennreal (x^r*y^s) * (\<integral>\<^sup>+w\<in>{0<..<1}. ennreal (1/(1-(1-x*y)*w)) \<partial>lborel)"
         using xy by (subst nn_integral_cmult [symmetric])
                     (auto intro!: nn_integral_cong simp: indicator_def simp flip: ennreal_mult')
       also have "(\<integral>\<^sup>+w\<in>{0<..<1}. ennreal (1/(1-(1-x*y)*w)) \<partial>lborel) =
                  (\<integral>\<^sup>+w\<in>{0..1}. ennreal (1/(1-(1-x*y)*w)) \<partial>lborel)"
         by (intro nn_integral_cong_AE AE_I[of _ _ "{0,1}"])
            (auto simp: emeasure_lborel_countable indicator_def)
       also have "(\<integral>\<^sup>+w\<in>{0..1}. ennreal (1/(1-(1-x*y)*w)) \<partial>lborel) =
                    ennreal (-ln (1-(1-x*y)*1)/(1-x*y) - (-ln (1-(1-x*y)*0)/(1-x*y)))"
         using xy deriv less_imp_le[OF beukers_denom_ineq[of x y]]
         by (intro nn_integral_FTC_Icc) auto
       finally show ?thesis using xy
         by (simp flip: ennreal_mult' ennreal_mult'' add: mult_ac)
     qed
     thus "(\<integral>\<^sup>+w\<in>{0<..<1}. ennreal (1/(1-(1-x*y)*w)*x^r*y^s) \<partial>lborel) * indicator ({0<..<1}\<times>{0<..<1}) (x, y) =
            ennreal (-ln (x*y)/(1-x*y)*x^r*y^s) * indicator ({0<..<1}\<times>{0<..<1}) (x, y)"
       by (auto simp: indicator_def)
   qed
   also have "\<dots> = beukers_nn_integral1 r s"
     by (simp add: beukers_nn_integral1_def)
   finally show ?thesis ..
 qed
 
 context
   fixes r s :: nat and I1 I2' :: real and I2 :: ennreal and D :: "(real \<times> real \<times> real) set"
   assumes rs: "s \<le> r"
   defines "D \<equiv> {0<..<1}\<times>{0<..<1}\<times>{0<..<1}"
 begin
 
 text \<open>
   By unfolding the geometric series, pulling the summation out and evaluating the integrals,
   we find that
     \[I_1 = \sum_{k=0}^\infty \frac{1}{(k+r+1)^2(k+s+1)} + \frac{1}{(k+r+1)(k+s+1)^2}\ .\]
 \<close>
 lemma beukers_nn_integral1_series:
   "beukers_nn_integral1 r s = (\<Sum>k. ennreal (1/((k+r+1)^2*(k+s+1)) + 1/((k+r+1)*(k+s+1)^2)))"
 proof -
   have "beukers_nn_integral1 r s =
           (\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. (\<Sum>k. ennreal (-ln (x*y) * x^(k+r) * y^(k+s))) \<partial>lborel)"
     unfolding beukers_nn_integral1_def
   proof (intro set_nn_integral_cong refl, clarify)
     fix x y :: real assume xy: "x \<in> {0<..<1}" "y \<in> {0<..<1}"
     from xy have "x * y < 1" using mult_strict_mono[of x 1 y 1] by simp
     have "(\<Sum>k. ennreal (-ln (x*y) * x^(k+r) * y^(k+s))) =
              ennreal (-ln (x*y) * x^r * y^s) * (\<Sum>k. ennreal ((x*y)^k))"
       using xy by (subst ennreal_suminf_cmult [symmetric], subst ennreal_mult'' [symmetric])
                   (auto simp: power_add mult_ac power_mult_distrib)
     also have "(\<Sum>k. ennreal ((x*y)^k)) = ennreal (1 / (1 - x*y))"
       using geometric_sums[of "x*y"] \<open>x * y < 1\<close> xy by (intro suminf_ennreal_eq) auto
     also have "ennreal (-ln (x*y) * x^r * y^s) * \<dots> =
                  ennreal (-ln (x*y) / (1 - x*y) * x^r * y^s)"
       using \<open>x * y < 1\<close> by (subst ennreal_mult'' [symmetric]) auto
     finally show "ennreal (-ln (x*y) / (1 - x*y) * x^r * y^s) =
                     (\<Sum>k. ennreal (-ln (x*y) * x^(k+r) * y^(k+s)))" ..
   qed
   also have "\<dots> = (\<Sum>k. (\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. (ennreal (-ln (x*y) * x^(k+r) * y^(k+s))) \<partial>lborel))"
     unfolding case_prod_unfold by (subst nn_integral_suminf [symmetric]) (auto simp flip: borel_prod)
   also have "\<dots> = (\<Sum>k. ennreal (1 / ((k+r+1)^2*(k+s+1)) + 1 / ((k+r+1)*(k+s+1)^2)))"
   proof (rule suminf_cong)
     fix k :: nat
     define F where "F = (\<lambda>x y::real. x + y)"
     have "(\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. ennreal (-ln (x*y) * x^(k+r) * y^(k+s)) \<partial>lborel) =
             (\<integral>\<^sup>+x\<in>{0<..<1}. (\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln (x*y) * x^(k+r) * y^(k+s)) \<partial>lborel) \<partial>lborel)"
       unfolding case_prod_unfold lborel_prod [symmetric]
       by (subst lborel.nn_integral_fst [symmetric]) (auto intro!: nn_integral_cong simp: indicator_def)
     also have "\<dots> = (\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (-ln x * x^(k+r) / (k+s+1) + x^(k+r)/(k+s+1)^2) \<partial>lborel)"
     proof (intro set_nn_integral_cong refl, clarify)
       fix x :: real assume x: "x \<in> {0<..<1}"
       have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln (x*y) * x^(k+r) * y^(k+s)) \<partial>lborel) =
               (\<integral>\<^sup>+y\<in>{0<..<1}. (ennreal (-ln x * x^(k+r) * y^(k+s)) + ennreal (-ln y * x^(k+r) * y^(k+s))) \<partial>lborel)"
         by (intro set_nn_integral_cong)
            (use x in \<open>auto simp: ln_mult ring_distribs mult_nonpos_nonneg simp flip: ennreal_plus\<close>)
       also have "\<dots> = (\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln x * x^(k+r) * y^(k+s)) \<partial>lborel) +
                       (\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * x^(k+r) * y^(k+s)) \<partial>lborel)"
         by (subst nn_integral_add [symmetric]) (auto intro!: nn_integral_cong simp: indicator_def)
       also have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln x * x^(k+r) * y^(k+s)) \<partial>lborel) =
                  ennreal (-ln x * x^(k+r)) * (\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (y^(k+s)) \<partial>lborel)"
         by (subst nn_integral_cmult [symmetric])
            (auto intro!: nn_integral_cong simp: indicator_def simp flip: ennreal_mult'')
       also have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (y^(k+s)) \<partial>lborel) = ennreal (1/(k+s+1))"
         by (subst nn_integral_0_1_power) simp
       also have "ennreal (-ln x * x^(k+r)) * \<dots> = ennreal (-ln x * x^(k+r) / (k+s+1))"
         by (subst ennreal_mult'' [symmetric]) auto
       also have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * x^(k+r) * y^(k+s)) \<partial>lborel) =
                    ennreal (x^(k+r)) * (\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y^(k+s)) \<partial>lborel)"
         by (subst nn_integral_cmult [symmetric])
            (use x in \<open>auto intro!: nn_integral_cong simp: indicator_def mult_ac simp flip: ennreal_mult'\<close>)
       also have "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln y * y^(k+s)) \<partial>lborel) = ennreal (1 / (k + s + 1)\<^sup>2)"
         by (subst nn_integral_0_1_ln_times_power) simp
       also have "ennreal (x ^ (k + r)) * \<dots> = ennreal (x ^ (k + r) / (k + s + 1) ^ 2)"
         by (subst ennreal_mult'' [symmetric]) auto
       also have "ennreal (- ln x * x ^ (k + r) / (k + s + 1)) + \<dots> =
                    ennreal (-ln x * x^(k+r) / (k+s+1) + x^(k+r)/(k+s+1)^2)"
         using x by (subst ennreal_plus) (auto simp: mult_nonpos_nonneg divide_nonpos_nonneg)
       finally show "(\<integral>\<^sup>+y\<in>{0<..<1}. ennreal (-ln (x*y) * x^(k+r) * y^(k+s)) \<partial>lborel) =
                       ennreal (-ln x * x^(k+r) / (k+s+1) + x^(k+r)/(k+s+1)^2)" .
     qed
     also have "\<dots> = (\<integral>\<^sup>+x\<in>{0<..<1}. (ennreal (-ln x * x^(k+r) / (k+s+1)) +
                        ennreal (x^(k+r)/(k+s+1)^2)) \<partial>lborel)"
       by (intro set_nn_integral_cong refl, subst ennreal_plus)
          (auto simp: mult_nonpos_nonneg divide_nonpos_nonneg)
     also have "\<dots> = (\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (-ln x * x^(k+r) / (k+s+1)) \<partial>lborel) +
                     (\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (x^(k+r)/(k+s+1)^2) \<partial>lborel)"
       by (subst nn_integral_add [symmetric]) (auto intro!: nn_integral_cong simp: indicator_def)
     also have "(\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (-ln x * x^(k+r) / (k+s+1)) \<partial>lborel) =
                   ennreal (1 / (k+s+1)) * (\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (-ln x * x^(k+r)) \<partial>lborel)"
       by (subst nn_integral_cmult [symmetric])
          (auto intro!: nn_integral_cong simp: indicator_def simp flip: ennreal_mult')
     also have "\<dots> = ennreal (1 / ((k+s+1) * (k+r+1)^2))"
       by (subst nn_integral_0_1_ln_times_power, subst ennreal_mult [symmetric]) (auto simp: algebra_simps)
     also have "(\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (x^(k+r)/(k+s+1)^2) \<partial>lborel) =
                   ennreal (1/(k+s+1)^2) * (\<integral>\<^sup>+x\<in>{0<..<1}. ennreal (x^(k+r)) \<partial>lborel)"
       by (subst nn_integral_cmult [symmetric])
          (auto intro!: nn_integral_cong simp: indicator_def simp flip: ennreal_mult')
     also have "\<dots> = ennreal (1/((k+r+1)*(k+s+1)^2))"
       by (subst nn_integral_0_1_power, subst ennreal_mult [symmetric]) (auto simp: algebra_simps)
     also have "ennreal (1 / ((k+s+1) * (k+r+1)^2)) + \<dots> =
                  ennreal (1/((k+r+1)^2*(k+s+1)) + 1/((k+r+1)*(k+s+1)^2))"
       by (subst ennreal_plus [symmetric]) (auto simp: algebra_simps)
     finally show "(\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. ennreal (-ln (x*y) * x^(k+r) * y^(k+s)) \<partial>lborel) = \<dots>" .
   qed
   finally show ?thesis .
 qed
 
 text \<open>
   Remembering that $\zeta(3) = \sum k^{-3}$, it is easy to see that if $r = s$, this sum is simply
     \[2\left(\zeta(3) - \sum_{k=1}^r \frac{1}{k^3}\right)\ .\]
 \<close>
 lemma beukers_nn_integral1_same:
   assumes "r = s"
   shows   "beukers_nn_integral1 r s = ennreal (2 * (Re (zeta 3) - (\<Sum>k=1..r. 1 / k ^ 3)))"
     and   "2 * (Re (zeta 3) - (\<Sum>k=1..r. 1 / k ^ 3)) \<ge> 0"
 proof -
   from assms have [simp]: "s = r" by simp
   have *: "Suc 2 = 3" by simp
   have "beukers_nn_integral1 r s = (\<Sum>k. ennreal (2 / (r + k + 1) ^ 3))"
     unfolding beukers_nn_integral1_series
     by (simp only: assms power_Suc [symmetric] mult.commute[of "x ^ 2" for x] *
                    times_divide_eq_right mult_1_right add_ac flip: mult_2)
   also have **: "(\<lambda>k. 2 / (r + k + 1) ^ 3) sums
               (2 * (Re (zeta 3) - (\<Sum>k=1..r. 1 / k ^ 3)))"
     using sums_mult[OF sums_Re_zeta_of_nat_offset[of 3], of 2] by simp
   hence "(\<Sum>k. ennreal (2 / (r + k + 1) ^ 3)) = ennreal \<dots>"
     by (intro suminf_ennreal_eq) auto
   finally show "beukers_nn_integral1 r s = ennreal (2 * (Re (zeta 3) - (\<Sum>k=1..r. 1 / k ^ 3)))" .
   show "2 * (Re (zeta 3) - (\<Sum>k=1..r. 1 / k ^ 3)) \<ge> 0"
     by (rule sums_le[OF _ sums_zero **]) auto
 qed
 
 lemma beukers_integral1_same:
   assumes "r = s"
   shows   "beukers_integral1 r s = 2 * (Re (zeta 3) - (\<Sum>k=1..r. 1 / k ^ 3))"
 proof -
   have "ln (a * b) * a ^ r * b ^ s / (1 - a * b) \<le> 0" if "a \<in> {0<..<1}" "b \<in> {0<..<1}" for a b :: real
     using that mult_strict_mono[of a 1 b 1] by (intro mult_nonpos_nonneg divide_nonpos_nonneg) auto
   thus ?thesis
     using beukers_nn_integral1_same[OF assms]
     unfolding beukers_nn_integral1_def beukers_integral1_def
     by (intro set_integral_eq_nn_integral AE_I2)
        (auto simp flip: lborel_prod simp: case_prod_unfold set_borel_measurable_def
              intro: divide_nonpos_nonneg mult_nonpos_nonneg)
 qed
 
 text \<open>
   In contrast, for \<open>r > s\<close>, we find that
     \[I_1 = \frac{1}{r-s} \sum_{k=s+1}^r \frac{1}{k^2}\ .\]
 \<close>
 lemma beukers_nn_integral1_different:
   assumes "r > s"
   shows   "beukers_nn_integral1 r s = ennreal ((\<Sum>k\<in>{s<..r}. 1 / k ^ 2) / (r - s))"
 proof -
   have "(\<lambda>k. 1 / (r - s) * (1 / (s + k + 1) ^ 2 - 1 / (r + k + 1) ^ 2))
           sums (1 / (r - s) * ((Re (zeta (of_nat 2)) - (\<Sum>k=1..s. 1/k^2)) -
                                (Re (zeta (of_nat 2)) - (\<Sum>k=1..r. 1/k^2))))"
     (is "_ sums ?S") by (intro sums_mult sums_diff sums_Re_zeta_of_nat_offset) auto
   also have "?S = ((\<Sum>k=1..r. 1/k^2) - (\<Sum>k=1..s. 1/k^2)) / (r - s)"
     by (simp add: algebra_simps diff_divide_distrib)
   also have "(\<Sum>k=1..r. 1/k^2) - (\<Sum>k=1..s. 1/k^2) = (\<Sum>k\<in>{1..r}-{1..s}. 1/k^2)"
     using assms by (subst Groups_Big.sum_diff) auto
   also have "{1..r} - {1..s} = {s<..r}" by auto
 
   also have "(\<lambda>k. 1 / (r - s) * (1 / (s + k + 1) ^ 2 - 1 / (r + k + 1) ^ 2)) =
                (\<lambda>k. 1 / ((k+r+1) * (k+s+1)^2) + 1 / ((k+r+1)^2 * (k+s+1)))"
   proof (intro ext, goal_cases)
     case (1 k)
     define x where "x = real (k + r + 1)"
     define y where "y = real (k + s + 1)"
     have [simp]: "x \<noteq> 0" "y \<noteq> 0" by (auto simp: x_def y_def)
     have "(x\<^sup>2 * y + x * y\<^sup>2) * (real r - real s) = x * y * (x\<^sup>2 - y\<^sup>2)"
       by (simp add: algebra_simps power2_eq_square x_def y_def)
     hence "1 / (x*y^2) + 1 / (x^2*y) = 1 / (r - s) * (1 / y^2 - 1 / x^2)"
       using assms by (simp add: divide_simps of_nat_diff)
     thus ?case by (simp add: x_def y_def algebra_simps)
   qed
   finally show ?thesis
     unfolding beukers_nn_integral1_series by (intro suminf_ennreal_eq) (auto simp: add_ac)
 qed
 
 lemma beukers_integral1_different:
   assumes "r > s"
   shows   "beukers_integral1 r s = (\<Sum>k\<in>{s<..r}. 1 / k ^ 2) / (r - s)"
 proof -
   have "ln (a * b) * a ^ r * b ^ s / (1 - a * b) \<le> 0" if "a \<in> {0<..<1}" "b \<in> {0<..<1}" for a b :: real
     using that mult_strict_mono[of a 1 b 1] by (intro mult_nonpos_nonneg divide_nonpos_nonneg) auto
     thus ?thesis
     using beukers_nn_integral1_different[OF assms]
     unfolding beukers_nn_integral1_def beukers_integral1_def
     by (intro set_integral_eq_nn_integral AE_I2)
        (auto simp flip: lborel_prod simp: case_prod_unfold set_borel_measurable_def
              intro: divide_nonpos_nonneg mult_nonpos_nonneg intro!: sum_nonneg divide_nonneg_nonneg)
 qed
 
 end
 
 text \<open>
   It is also easy to see that if we exchange \<open>r\<close> and \<open>s\<close>, nothing changes.
 \<close>
 lemma beukers_nn_integral1_swap:
   "beukers_nn_integral1 r s = beukers_nn_integral1 s r"
   unfolding beukers_nn_integral1_def lborel_prod [symmetric]
   by (subst lborel_pair.nn_integral_swap, simp)
      (intro nn_integral_cong, auto simp: indicator_def algebra_simps split: if_splits)
 
 lemma beukers_nn_integral1_finite: "beukers_nn_integral1 r s < \<infinity>"
   using beukers_nn_integral1_different[of r s] beukers_nn_integral1_different[of s r]
   by (cases r s rule: linorder_cases)
      (simp_all add: beukers_nn_integral1_same beukers_nn_integral1_swap)
 
 lemma beukers_integral1_integrable:
   "set_integrable lborel ({0<..<1}\<times>{0<..<1})
      (\<lambda>(x,y). (-ln (x*y) / (1 - x*y) * x^r * y^s :: real))"
 proof (intro set_integrableI_nonneg AE_I2; clarify?)
   fix x y :: real assume xy: "x \<in> {0<..<1}" "y \<in> {0<..<1}"
   have "0 \<ge> ln (x * y) / (1 - x * y) * x ^ r * y ^ s"
     using mult_strict_mono[of x 1 y 1]
     by (intro mult_nonpos_nonneg divide_nonpos_nonneg) (use xy in auto)
   thus "0 \<le> - ln (x * y) / (1 - x * y) * x ^ r * y ^ s" by simp
 next
   show "\<integral>\<^sup>+x\<in>{0<..<1}\<times>{0<..<1}. ennreal (case x of (x, y) \<Rightarrow>
            - ln (x * y) / (1 - x * y) * x ^ r * y ^ s) \<partial>lborel < \<infinity>"
     using beukers_nn_integral1_finite by (simp add: beukers_nn_integral1_def case_prod_unfold)
 qed (simp_all flip: lborel_prod add: set_borel_measurable_def)
 
 lemma beukers_integral1_integrable':
   "set_integrable lborel ({0<..<1}\<times>{0<..<1}\<times>{0<..<1})
      (\<lambda>(z,x,y). (x^r * y^s / (1 - (1 - x*y) * z) :: real))"
 proof (intro set_integrableI_nonneg AE_I2; clarify?)
   fix x y z :: real assume xyz: "x \<in> {0<..<1}" "y \<in> {0<..<1}" "z \<in> {0<..<1}"
   show "0 \<le> x^r * y^s / (1 - (1 - x*y) * z)"
     using mult_strict_mono[of x 1 y 1] xyz beukers_denom_ineq[of x y z]
     by (intro mult_nonneg_nonneg divide_nonneg_nonneg) auto
 next
   show "\<integral>\<^sup>+x\<in>{0<..<1}\<times>{0<..<1}\<times>{0<..<1}. ennreal (case x of (z,x,y) \<Rightarrow>
            x ^ r * y ^ s / (1-(1-x*y)*z)) \<partial>lborel < \<infinity>"
     using beukers_nn_integral1_finite
     by (simp add: beukers_nn_integral1_altdef case_prod_unfold)
 qed (simp_all flip: lborel_prod add: set_borel_measurable_def)
 
 lemma beukers_integral1_conv_nn_integral:
   "beukers_integral1 r s = enn2real (beukers_nn_integral1 r s)"
 proof -
   have "ln (a * b) * a ^ r * b ^ s / (1 - a * b) \<le> 0" if "a \<in> {0<..<1}" "b \<in> {0<..<1}"
     for a b :: real
     using mult_strict_mono[of a 1 b 1] that by (intro divide_nonpos_nonneg mult_nonpos_nonneg) auto
   thus ?thesis unfolding beukers_integral1_def using beukers_nn_integral1_finite[of r s]
     by (intro set_integral_eq_nn_integral)
        (auto simp: case_prod_unfold beukers_nn_integral1_def
                    set_borel_measurable_def simp flip: borel_prod
              intro!: AE_I2 intro: divide_nonpos_nonneg mult_nonpos_nonneg)
 qed
 
 lemma beukers_integral1_swap: "beukers_integral1 r s = beukers_integral1 s r"
   by (simp add: beukers_integral1_conv_nn_integral beukers_nn_integral1_swap)
 
 
 subsection \<open>The second double integral\<close>
 
 context
   fixes n :: nat
   fixes D :: "(real \<times> real) set" and D' :: "(real \<times> real \<times> real) set"
   fixes P :: "real \<Rightarrow> real" and Q :: "nat \<Rightarrow> real \<Rightarrow> real"
   defines "D \<equiv> {0<..<1} \<times> {0<..<1}" and "D' \<equiv> {0<..<1} \<times> {0<..<1} \<times> {0<..<1}"
   defines "Q \<equiv> Gen_Shleg n" and "P \<equiv> Shleg n"
 begin
 
 text \<open>
   The next integral to consider is the following variant of $I_1$:
   \[I_2 :=
       \int_0^1 \int_0^1 -\frac{\ln(xy)}{1-xy} P_n(x) P_n(y)\,\text{d}x\,\text{d}y\ .\]
 \<close>
 
 definition beukers_integral2 :: real where
   "beukers_integral2 = (\<integral>(x,y)\<in>D. (-ln (x*y) / (1-x*y) * P x * P y) \<partial>lborel)"
 
 text \<open>
   $I_2$ is simply a sum of integrals of type $I_1$, so using our results for
   $I_1$, we can write $I_2$ in the form $A \zeta(3) + \frac{B}{\text{lcm}\{1\ldots n\}^3}$
   where $A$ and $B$ are integers and $A > 0$:
 \<close>
 lemma beukers_integral2_conv_int_combination:
   obtains A B :: int where "A > 0" and
     "beukers_integral2 = of_int A * Re (zeta 3) + of_int B / of_nat (Lcm {1..n} ^ 3)"
 proof -
   let ?I1 = "(\<lambda>i. (i, i)) ` {..n}"
   let ?I2 = "Set.filter (\<lambda>(i,j). i \<noteq> j) ({..n}\<times>{..n})"
   let ?I3 = "Set.filter (\<lambda>(i,j). i < j) ({..n}\<times>{..n})"
   let ?I4 = "Set.filter (\<lambda>(i,j). i > j) ({..n}\<times>{..n})"
   define p where "p = shleg_poly n"
   define I where "I = (SIGMA i:{..n}. {1..i})"
   define J where "J = (SIGMA (i,j):?I4. {j<..i})"
   define h where "h = beukers_integral1"
   define A :: int where "A = (\<Sum>i\<le>n. 2 * poly.coeff p i ^ 2)"
   define B1 where "B1 = (\<Sum>(i,k)\<in>I. real_of_int (-2 * coeff p i ^ 2) / real_of_int (k ^ 3))"
   define B2 where "B2 = (\<Sum>((i,j),k)\<in>J. real_of_int (2 * coeff p i * coeff p j) / real_of_int (k^2*(i-j)))"
   define d where "d = Lcm {1..n} ^ 3"
 
   have [simp]: "h i j = h j i" for i j
     by (simp add: h_def beukers_integral1_swap)
 
   have "beukers_integral2 =
         (\<integral>(x,y)\<in>D. (\<Sum>(i,j)\<in>{..n}\<times>{..n}. coeff p i * coeff p j *
            -ln (x*y) / (1-x*y) * x ^ i * y ^ j) \<partial>lborel)"
     unfolding beukers_integral2_def
     by (subst sum.cartesian_product [symmetric])
        (simp add: poly_altdef P_def Shleg_def mult_ac case_prod_unfold p_def
                   sum_distrib_left sum_distrib_right sum_negf sum_divide_distrib)
   also have "\<dots> = (\<Sum>(i,j)\<in>{..n}\<times>{..n}. coeff p i * coeff p j * h i j)"
     unfolding case_prod_unfold
   proof (subst set_integral_sum)
     fix ij :: "nat \<times> nat"
     have "set_integrable lborel D
           (\<lambda>(x,y). real_of_int (coeff p (fst ij) * coeff p (snd ij)) *
                  (-ln (x*y) / (1-x*y) * x ^ fst ij * y ^ snd ij))"
       unfolding case_prod_unfold using beukers_integral1_integrable[of "fst ij" "snd ij"]
       by (intro set_integrable_mult_right) (auto simp: D_def case_prod_unfold)
     thus "set_integrable lborel D
           (\<lambda>pa. real_of_int (coeff p (fst ij) * coeff p (snd ij)) *
                  -ln (fst pa * snd pa) / (1 - fst pa * snd pa) * fst pa ^ fst ij * snd pa ^ snd ij)"
       by (simp add: mult_ac case_prod_unfold)
   qed (auto simp: beukers_integral1_def h_def case_prod_unfold mult.assoc D_def
             simp flip: set_integral_mult_right)
   also have "\<dots> = (\<Sum>(i,j)\<in>?I1\<union>?I2. coeff p i * coeff p j * h i j)"
     by (intro sum.cong) auto
   also have "\<dots> = (\<Sum>(i,j)\<in>?I1. coeff p i * coeff p j * h i j) +
                   (\<Sum>(i,j)\<in>?I2. coeff p i * coeff p j * h i j)"
     by (intro sum.union_disjoint) auto
   also have "(\<Sum>(i,j)\<in>?I1. coeff p i * coeff p j * h i j) =
                (\<Sum>i\<le>n. coeff p i ^ 2 * h i i)"
     by (subst sum.reindex) (auto intro: inj_onI simp: case_prod_unfold power2_eq_square)
   also have "\<dots> = (\<Sum>i\<le>n. coeff p i ^ 2 * 2 * (Re (zeta 3) - (\<Sum>k=1..i. 1 / k ^ 3)))"
     unfolding h_def D_def
     by (intro sum.cong refl, subst beukers_integral1_same) auto
   also have "\<dots> = of_int A * Re (zeta 3) -
                     (\<Sum>i\<le>n. 2 * coeff p i ^ 2 * (\<Sum>k=1..i. 1 / k ^ 3))"
     by (simp add: sum_subtractf sum_distrib_left sum_distrib_right algebra_simps A_def)
   also have "\<dots> = of_int A * Re (zeta 3) + B1"
     unfolding I_def B1_def by (subst sum.Sigma [symmetric]) (auto simp: sum_distrib_left sum_negf)
   also have "(\<Sum>(i,j)\<in>?I2. coeff p i * coeff p j * h i j) =
                (\<Sum>(i,j)\<in>?I3\<union>?I4. coeff p i * coeff p j * h i j)"
     by (intro sum.cong) auto
   also have "\<dots> = (\<Sum>(i,j)\<in>?I3. coeff p i * coeff p j * h i j) +
                   (\<Sum>(i,j)\<in>?I4. coeff p i * coeff p j * h i j)"
     by (intro sum.union_disjoint) auto
   also have "(\<Sum>(i,j)\<in>?I3. coeff p i * coeff p j * h i j) =
                (\<Sum>(i,j)\<in>?I4. coeff p i * coeff p j * h i j)"
     by (intro sum.reindex_bij_witness[of _ "\<lambda>(i,j). (j,i)" "\<lambda>(i,j). (j,i)"]) auto
   also have "\<dots> + \<dots> = 2 * \<dots>" by simp
   also have "\<dots> = (\<Sum>(i,j)\<in>?I4. \<Sum>k\<in>{j<..i}. 2 * coeff p i * coeff p j / k ^ 2 / (i - j))"
     unfolding sum_distrib_left
     by (intro sum.cong refl)
        (auto simp: h_def beukers_integral1_different sum_divide_distrib sum_distrib_left mult_ac)
   also have "\<dots> = B2"
     unfolding J_def B2_def by (subst sum.Sigma [symmetric]) (auto simp: case_prod_unfold)
 
   also have "\<exists>B1'. B1 = real_of_int B1' / real_of_int d"
     unfolding B1_def case_prod_unfold
     by (rule sum_rationals_common_divisor') (auto simp: d_def I_def)
   then obtain B1' where "B1 = real_of_int B1' / real_of_int d" ..
 
   also have "\<exists>B2'. B2 = real_of_int B2' / real_of_int d"
     unfolding B2_def case_prod_unfold J_def
   proof (rule sum_rationals_common_divisor'; clarsimp?)
     fix i j k :: nat assume ijk: "i \<le> n" "j < k" "k \<le> i"
     have "int (k ^ 2 * (i - j)) dvd int (Lcm {1..n} ^ 2 * Lcm {1..n})"
       unfolding int_dvd_int_iff using ijk
       by (intro mult_dvd_mono dvd_power_same dvd_Lcm) auto
     also have "\<dots> = d"
       by (simp add: d_def power_numeral_reduce)
     finally show "int k ^ 2 * int (i - j) dvd int d" by simp
   qed(auto simp: d_def J_def intro!: Nat.gr0I)
   then obtain B2' where "B2 = real_of_int B2' / real_of_int d" ..
 
   finally have "beukers_integral2 =
                   of_int A * Re (zeta 3) + of_int (B1' + B2') / of_nat (Lcm {1..n} ^ 3)"
     by (simp add: add_divide_distrib d_def)
 
   moreover have "coeff p 0 = P 0"
     unfolding P_def p_def Shleg_def by (simp add: poly_0_coeff_0)
   hence "coeff p 0 = 1"
     by (simp add: P_def)
   hence "A > 0"
     unfolding A_def by (intro sum_pos2[of _ 0]) auto
 
   ultimately show ?thesis
     by (intro that[of A "B1' + B2'"]) auto
 qed
 
 lemma beukers_integral2_integrable:
   "set_integrable lborel D (\<lambda>(x,y). -ln (x*y) / (1 - x*y) * P x * P y)"
 proof -
   have "bounded (P ` {0..1})"
     unfolding P_def Shleg_def
     by (intro compact_imp_bounded compact_continuous_image continuous_intros) auto
   then obtain C where C: "\<And>x. x \<in> {0..1} \<Longrightarrow> norm (P x) \<le> C"
     unfolding bounded_iff by fast
   have [measurable]: "P \<in> borel_measurable borel" by (simp add: P_def)
   from C[of 0] have "C \<ge> 0" by simp
   show ?thesis
   proof (rule set_integrable_bound[OF _ _ AE_I2]; clarify?)
     show "set_integrable lborel D (\<lambda>(x,y). C ^ 2 * (-ln (x*y) / (1 - x*y)))"
       using beukers_integral1_integrable[of 0 0] unfolding case_prod_unfold
       by (intro set_integrable_mult_right) (auto simp: D_def)
   next
     fix x y :: real
     assume xy: "(x, y) \<in> D"
     from xy have "x * y < 1"
       using mult_strict_mono[of x 1 y 1] by (simp add: D_def)
     have "norm (-ln (x*y) / (1 - x*y) * P x * P y) = (-ln (x*y)) / (1 - x*y) * norm (P x) * norm (P y)"
       using xy \<open>x * y < 1\<close> by (simp add: abs_mult abs_divide D_def)
     also have "\<dots> \<le> (-ln (x*y)) / (1-x*y) * C * C"
       using xy C[of x] C[of y] \<open>x * y < 1\<close> \<open>C \<ge> 0\<close>
       by (intro mult_mono divide_left_mono)
          (auto simp: D_def divide_nonpos_nonneg mult_nonpos_nonneg)
     also have "\<dots> = norm ((-ln (x*y)) / (1-x*y) * C * C)"
       using xy \<open>x * y < 1\<close> \<open>C \<ge> 0\<close> by (simp add: abs_divide abs_mult D_def)
     finally show "norm (-ln (x*y) / (1 - x*y) * P x * P y)
            \<le> norm (case (x, y) of (x, y) \<Rightarrow> C\<^sup>2 * (- ln (x * y) / (1 - x * y)))"
       by (auto simp: algebra_simps power2_eq_square abs_mult abs_divide)
   qed (auto simp: D_def set_borel_measurable_def case_prod_unfold simp flip: lborel_prod)
 qed
 
 
 subsection \<open>The triple integral\<close>
 
 text \<open>
   Lastly, we turn to the triple integral
   \[I_3 := \int_0^1 \int_0^1 \int_0^1
       \frac{(x(1-x)y(1-y)w(1-w))^n}{(1-(1-xy)w)^{n+1}}\ \text{d}x\,\text{d}y\,\text{d}w\ .\]
 \<close>
 
 definition beukers_nn_integral3 :: ennreal where
   "beukers_nn_integral3 =
      (\<integral>\<^sup>+(w,x,y)\<in>D'. ((x*(1-x)*y*(1-y)*w*(1-w))^n / (1-(1-x*y)*w)^(n+1)) \<partial>lborel)"
 
 definition beukers_integral3 :: real where
   "beukers_integral3 =
      (\<integral>(w,x,y)\<in>D'. ((x*(1-x)*y*(1-y)*w*(1-w))^n / (1-(1-x*y)*w)^(n+1)) \<partial>lborel)"
 
 text \<open>
   We first prove the following bound
   (which is a consequence of the arithmetic--geometric mean inequality)
   that will help us to bound the triple integral.
 \<close>
 lemma beukers_integral3_integrand_bound:
   fixes x y z :: real
   assumes xyz: "x \<in> {0<..<1}" "y \<in> {0<..<1}" "z \<in> {0<..<1}"
   shows   "(x*(1-x)*y*(1-y)*z*(1-z)) / (1-(1-x*y)*z) \<le> 1 / 27" (is "?lhs \<le> _")
 proof -
   have ineq1: "x * (1 - x) \<le> 1 / 4" if x: "x \<in> {0..1}" for x :: real
   proof -
     have "x * (1 - x) - 1 / 4 = -((x - 1 / 2) ^ 2)"
       by (simp add: algebra_simps power2_eq_square)
     also have "\<dots> \<le> 0"
       by simp
     finally show ?thesis by simp
   qed
 
   have ineq2: "x * (1 - x) ^ 2 \<le> 4 / 27" if x: "x \<in> {0..1}" for x :: real
   proof -
     have "x * (1 - x) ^ 2 - 4 / 27 = (x - 4 / 3) * (x - 1 / 3) ^ 2"
       by (simp add: algebra_simps power2_eq_square)
     also have "\<dots> \<le> 0"
       by (rule mult_nonpos_nonneg) (use x in auto)
     finally show ?thesis by simp
   qed
 
   have "1 - (1-x*y)*z = (1 - z) + x * y * z"
     by (simp add: algebra_simps)
   also have "\<dots> \<ge> 2 * sqrt (1 - z) * sqrt x * sqrt y * sqrt z"
     using arith_geo_mean_sqrt[of "1 - z" "x * y * z"] xyz
     by (auto simp: real_sqrt_mult)
 
   finally have *: "?lhs \<le> (x*(1-x)*y*(1-y)*z*(1-z)) / (2 * sqrt (1 - z) * sqrt x * sqrt y * sqrt z)"
     using xyz beukers_denom_ineq[of x y z]
     by (intro divide_left_mono mult_nonneg_nonneg mult_pos_pos) auto
 
   have "(x*(1-x)*y*(1-y)*z*(1-z)) = (sqrt x * sqrt x * (1-x) * sqrt y * sqrt y *
                (1-y) * sqrt z * sqrt z * sqrt (1-z) * sqrt (1-z))"
     using xyz by simp
   also have "\<dots> / (2 * sqrt (1 - z) * sqrt x * sqrt y * sqrt z) =
                sqrt (x * (1 - x) ^ 2) * sqrt (y * (1 - y) ^ 2) * sqrt (z * (1 - z)) / 2"
     using xyz by (simp add: divide_simps real_sqrt_mult del: real_sqrt_mult_self)
   also have "\<dots> \<le> sqrt (4 / 27) * sqrt (4 / 27) * sqrt (1 / 4) / 2"
     using xyz by (intro divide_right_mono mult_mono real_sqrt_le_mono ineq1 ineq2) auto
   also have "\<dots> = 1 / 27"
     by (simp add: real_sqrt_divide)
   finally show ?thesis using * by argo
 qed
 
 text \<open>
   Connecting the above bound with our results of $I_1$, it is easy to see that
   $I_3 \leq 2 \cdot 27^{-n} \cdot \zeta(3)$:
 \<close>
 lemma beukers_nn_integral3_le:
   "beukers_nn_integral3 \<le> ennreal (2 * (1 / 27) ^ n * Re (zeta 3))"
 proof -
   have D' [measurable]: "D' \<in> sets (borel \<Otimes>\<^sub>M borel \<Otimes>\<^sub>M borel)"
     unfolding D'_def by (simp flip: borel_prod)
   have "beukers_nn_integral3 =
           (\<integral>\<^sup>+(w,x,y)\<in>D'. ((x*(1-x)*y*(1-y)*w*(1-w))^n / (1-(1-x*y)*w)^(n+1)) \<partial>lborel)"
     by (simp add: beukers_nn_integral3_def)
   also have "\<dots> \<le> (\<integral>\<^sup>+(w,x,y)\<in>D'. ((1 / 27) ^ n / (1-(1-x*y)*w)) \<partial>lborel)"
   proof (intro set_nn_integral_mono ennreal_leI, clarify, goal_cases)
     case (1 w x y)
     have "(x*(1-x)*y*(1-y)*w*(1-w))^n / (1-(1-x*y)*w)^(n+1) =
             ((x*(1-x)*y*(1-y)*w*(1-w)) / (1-(1-x*y)*w)) ^ n / (1-(1-x*y)*w)"
       by (simp add: divide_simps)
     also have "\<dots> \<le> (1 / 27) ^ n / (1 - (1 - x * y) * w)"
       using beukers_denom_ineq[of x y w] 1
       by (intro divide_right_mono power_mono beukers_integral3_integrand_bound)
          (auto simp: D'_def)
     finally show ?case .
   qed
   also have "\<dots> = ennreal ((1 / 27) ^ n) * (\<integral>\<^sup>+(w,x,y)\<in>D'. (1 / (1-(1-x*y)*w)) \<partial>lborel)"
     unfolding lborel_prod [symmetric] case_prod_unfold
     by (subst nn_integral_cmult [symmetric])
        (auto intro!: nn_integral_cong simp: indicator_def simp flip: ennreal_mult')
   also have "(\<integral>\<^sup>+(w,x,y)\<in>D'. (1 / (1-(1-x*y)*w)) \<partial>lborel) =
                (\<integral>\<^sup>+(x,y)\<in>{0<..<1}\<times>{0<..<1}. ennreal (- (ln (x * y) / (1 - x * y))) \<partial>lborel)"
     using beukers_nn_integral1_altdef[of 0 0]
     by (simp add: beukers_nn_integral1_def D'_def case_prod_unfold)
   also have "\<dots> = ennreal (2 * Re (zeta 3))"
     using beukers_nn_integral1_same[of 0 0] by (simp add: D_def beukers_nn_integral1_def)
   also have "ennreal ((1 / 27) ^ n) * \<dots> = ennreal (2 * (1 / 27) ^ n * Re (zeta 3))"
     by (subst ennreal_mult' [symmetric]) (simp_all add: mult_ac)
   finally show ?thesis .
 qed
 
 lemma beukers_nn_integral3_finite: "beukers_nn_integral3 < \<infinity>"
   by (rule le_less_trans, rule beukers_nn_integral3_le) simp_all
 
 lemma beukers_integral3_integrable:
   "set_integrable lborel D' (\<lambda>(w,x,y). (x*(1-x)*y*(1-y)*w*(1-w))^n / (1-(1-x*y)*w)^(n+1))"
   unfolding case_prod_unfold using less_imp_le[OF beukers_denom_ineq] beukers_nn_integral3_finite
   by (intro set_integrableI_nonneg AE_I2 impI)
      (auto simp: D'_def set_borel_measurable_def beukers_nn_integral3_def case_prod_unfold
            simp flip: lborel_prod intro!: divide_nonneg_nonneg mult_nonneg_nonneg)
 
 lemma beukers_integral3_conv_nn_integral:
   "beukers_integral3 = enn2real beukers_nn_integral3"
   unfolding beukers_integral3_def using beukers_nn_integral3_finite less_imp_le[OF beukers_denom_ineq]
   by (intro set_integral_eq_nn_integral AE_I2 impI)
      (auto simp: D'_def set_borel_measurable_def beukers_nn_integral3_def case_prod_unfold
            simp flip: lborel_prod)
 
 lemma beukers_integral3_le: "beukers_integral3 \<le> 2 * (1 / 27) ^ n * Re (zeta 3)"
 proof -
   have "beukers_integral3 = enn2real beukers_nn_integral3"
     by (rule beukers_integral3_conv_nn_integral)
   also have "\<dots> \<le> enn2real (ennreal (2 * (1 / 27) ^ n * Re (zeta 3)))"
     by (intro enn2real_mono beukers_nn_integral3_le) auto
   also have "\<dots> = 2 * (1 / 27) ^ n * Re (zeta 3)"
     using Re_zeta_ge_1[of 3] by (intro enn2real_ennreal mult_nonneg_nonneg) auto
   finally show ?thesis .
 qed
 
 text \<open>
   It is also easy to see that $I_3 > 0$.
 \<close>
 lemma beukers_nn_integral3_pos: "beukers_nn_integral3 > 0"
 proof -
   have D' [measurable]: "D' \<in> sets (borel \<Otimes>\<^sub>M borel \<Otimes>\<^sub>M borel)"
     unfolding D'_def by (simp flip: borel_prod)
 
   have *: "\<not>(AE (w,x,y) in lborel. ennreal ((x*(1-x)*y*(1-y)*w*(1-w))^n /
              (1-(1-x*y)*w)^(n+1)) * indicator D' (w,x,y) \<le> 0)"
             (is "\<not>(AE z in lborel. ?P z)")
   proof -
     {
       fix w x y :: real assume xyw: "(w,x,y) \<in> D'"
       hence "(x*(1-x)*y*(1-y)*w*(1-w))^n / (1-(1-x*y)*w)^(n+1) > 0"
         using beukers_denom_ineq[of x y w]
         by (intro divide_pos_pos mult_pos_pos zero_less_power) (auto simp: D'_def)
       with xyw have "\<not>?P (w,x,y)"
         by (auto simp: indicator_def D'_def)
     }
     hence *: "\<not>?P z" if "z \<in> D'" for z using that by blast
     hence "{z\<in>space lborel. \<not>?P z} = D'" by auto
     moreover have "emeasure lborel D' = 1"
     proof -
       have "D' = box (0,0,0) (1,1,1)"
         by (auto simp: D'_def box_def Basis_prod_def)
       also have "emeasure lborel \<dots> = 1"
         by (subst emeasure_lborel_box) (auto simp: Basis_prod_def)
       finally show ?thesis by simp
     qed
     ultimately show ?thesis
       by (subst AE_iff_measurable[of D']) (simp_all flip: borel_prod)
   qed
 
   hence "nn_integral lborel (\<lambda>_::real\<times>real\<times>real. 0) < beukers_nn_integral3"
     unfolding beukers_nn_integral3_def
     by (intro nn_integral_less) (simp_all add: case_prod_unfold flip: lborel_prod)
   thus ?thesis by simp
 qed
 
 lemma beukers_integral3_pos: "beukers_integral3 > 0"
 proof -
   have "0 < enn2real beukers_nn_integral3"
     using beukers_nn_integral3_pos beukers_nn_integral3_finite
     by (subst enn2real_positive_iff) auto
   also have "\<dots> = beukers_integral3"
     by (rule beukers_integral3_conv_nn_integral [symmetric])
   finally show ?thesis .
 qed
 
 
 subsection \<open>Connecting the double and triple integral\<close>
 
 text \<open>
   In this section, we will prove the most technically involved part,
   namely that $I_2 = I_3$. I will not go into detail about how this works --
   the reader is advised to simply look at Filaseta's presentation of the proof.
 
   The basic idea is to integrate by parts \<open>n\<close> times with respect to \<open>y\<close> to eliminate
   the factor $P(y)$, then change variables $z = \frac{1-w}{1-(1-xy)w}$, and then
   apply the same integration by parts \<open>n\<close> times to \<open>x\<close> to eliminate $P(x)$.
 \<close>
 
 text \<open>
   The first expand \[-\frac{\ln (xy)}{1-xy} = \int_0^1 \frac{1}{1-(1-xy)z}\,\text{d}z\ .\]
 \<close>
 lemma beukers_aux_ln_conv_integral:
   fixes x y :: real
   assumes xy: "x \<in> {0<..<1}" "y \<in> {0<..<1}"
   shows "-ln (x*y) / (1-x*y) = (LBINT z=0..1. 1 / (1-(1-x*y)*z))"
 proof -
   have "x * y < 1"
     using mult_strict_mono[of x 1 y 1] xy by simp
   have less: "(1 - x * y) * u < 1" if u: "u \<in> {0..1}" for u
   proof -
     from u \<open>x * y < 1\<close> have "(1 - x * y) * u \<le> (1 - x * y) * 1"
       by (intro mult_left_mono) auto
     also have "\<dots> < 1 * 1"
       using xy by (intro mult_strict_right_mono) auto
     finally show "(1 - x * y) * u < 1" by simp
   qed
   have neq: "(1 - x * y) * u \<noteq> 1" if "u \<in> {0..1}" for u
     using less[of u] that by simp
 
   let ?F = "\<lambda>z. ln (1-(1-x*y)*z)/(x*y-1)"
   have "(LBINT z=ereal 0..ereal 1. 1 / (1-(1-x*y)*z)) = ?F 1 - ?F 0"
   proof (rule interval_integral_FTC_finite, goal_cases cont deriv)
     case cont
     show ?case
       using neq by (intro continuous_intros) auto
   next
     case (deriv z)
     show ?case
       unfolding has_real_derivative_iff_has_vector_derivative [symmetric]
       by (insert less[of z] xy \<open>x * y < 1\<close> deriv)
          (rule derivative_eq_intros refl | simp)+
   qed
   also have "\<dots> = -ln (x*y) / (1-x*y)"
     using \<open>x * y < 1\<close> by (simp add: field_simps)
   finally show ?thesis
     by (simp add: zero_ereal_def one_ereal_def)
 qed
 
 text \<open>
   The first part we shall show is the integration by parts.
 \<close>
 lemma beukers_aux_by_parts_aux:
   assumes xz: "x \<in> {0<..<1}" "z \<in> {0<..<1}" and "k \<le> n"
   shows "(LBINT y=0..1. Q n y * (1/(1-(1-x*y)*z))) =
          (LBINT y=0..1. Q (n-k) y * (fact k * (x*z)^k / (1-(1-x*y)*z) ^ (k+1)))"
   using assms(3)
 proof (induction k)
   case (Suc k)
   note [derivative_intros] = DERIV_chain2[OF has_field_derivative_Gen_Shleg]
   define G where "G = (\<lambda>y. -fact k * (x*z)^k / (1-(1-x*y)*z) ^ (k+1))"
   define g where "g = (\<lambda>y. fact (Suc k) * (x*z)^Suc k / (1-(1-x*y)*z) ^ (k+2))"
 
   have less: "(1 - x * y) * z < 1" and neq: "(1 - x * y) * z \<noteq> 1"
     if y: "y \<in> {0..1}" for y
   proof -
     from y xz have "x * y \<le> x * 1"
       by (intro mult_left_mono) auto
     also have "\<dots> < 1"
       using xz by simp
     finally have "(1 - x * y) * z \<le> 1 * z"
       using xz y by (intro mult_right_mono) auto
     also have "\<dots> < 1"
       using xz by simp
     finally show "(1 - x * y) * z < 1" by simp
     thus "(1 - x * y) * z \<noteq> 1" by simp
   qed
 
   have cont: "continuous_on {0..1} g"
     using neq by (auto simp: g_def intro!: continuous_intros)
   have deriv: "(G has_real_derivative g y) (at y within {0..1})" if y: "y \<in> {0..1}" for y
     unfolding G_def
     by (insert neq xz y, (rule derivative_eq_intros refl power_not_zero)+)
        (auto simp: divide_simps g_def)
   have deriv2: "(Q (n - Suc k) has_real_derivative Q (n - k) y) (at y within {0..1})" for y
     using Suc.prems by (auto intro!: derivative_eq_intros simp: Suc_diff_Suc Q_def)
 
   have "(LBINT y=0..1. Q (n-Suc k) y * (fact (Suc k) * (x*z)^Suc k / (1-(1-x*y)*z) ^ (k+2))) =
         (LBINT y=0..1. Q (n-Suc k) y * g y)"
     by (simp add: g_def)
   also have "(LBINT y=0..1. Q (n-Suc k) y * g y) = -(LBINT y=0..1. Q (n-k) y * G y)"
     using Suc.prems deriv deriv2 cont
     by (subst interval_lebesgue_integral_by_parts_01[where f = "Q (n-k)" and G = G])
        (auto intro!: continuous_intros simp: Q_def)
   also have "\<dots> = (LBINT y=0..1. Q (n-k) y * (fact k * (x*z)^k / (1-(1-x*y)*z) ^ (k+1)))"
     by (simp add: G_def flip: interval_lebesgue_integral_uminus)
   finally show ?case using Suc by simp
 qed auto
 
 lemma beukers_aux_by_parts:
   assumes xz: "x \<in> {0<..<1}" "z \<in> {0<..<1}"
   shows "(LBINT y=0..1. P y / (1-(1-x*y)*z)) =
          (LBINT y=0..1. (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z) ^ (n+1))"
 proof -
   have "(LBINT y=0..1. P y * (1/(1-(1-x*y)*z))) =
            1 / fact n * (LBINT y=0..1. Q n y * (1/(1-(1-x*y)*z)))"
     unfolding interval_lebesgue_integral_mult_right [symmetric]
     by (simp add: P_def Q_def Shleg_altdef)
   also have "\<dots> = (LBINT y=0..1. (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z) ^ (n+1))"
     by (subst beukers_aux_by_parts_aux[OF assms, of n], simp,
         subst interval_lebesgue_integral_mult_right [symmetric])
        (simp add: Q_def mult_ac Gen_Shleg_0_left power_mult_distrib)
   finally show ?thesis by simp
 qed
 
 text \<open>
   We then get the following by applying the integration by parts to \<open>y\<close>:
 \<close>
 lemma beukers_aux_integral_transform1:
   fixes z :: real
   assumes z: "z \<in> {0<..<1}"
   shows   "(LBINT (x,y):D. P x * P y / (1-(1-x*y)*z)) =
            (LBINT (x,y):D. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1))"
 proof -
   have cbox: "cbox (0, 0) (1, 1) = ({0..1} \<times> {0..1} :: (real \<times> real) set)"
     by (auto simp: cbox_def Basis_prod_def inner_prod_def)
   have box: "box (0, 0) (1, 1) = ({0<..<1} \<times> {0<..<1} :: (real \<times> real) set)"
     by (auto simp: box_def Basis_prod_def inner_prod_def)
   have "set_integrable lborel (cbox (0,0) (1,1))
           (\<lambda>(x, y). P x * P y / (1 - (1 - x * y) * z))"
     unfolding lborel_prod case_prod_unfold P_def
   proof (intro continuous_on_imp_set_integrable_cbox continuous_intros ballI)
     fix p :: "real \<times> real" assume p: "p \<in> cbox (0, 0) (1, 1)"
     have "(1 - fst p * snd p) * z \<le> 1 * z"
       using mult_mono[of "fst p" 1 "snd p" 1] p z cbox by (intro mult_right_mono) auto
     also have "\<dots> < 1" using z by simp
     finally show "1 - (1 - fst p * snd p) * z \<noteq> 0" by simp
   qed
   hence integrable: "set_integrable lborel (box (0,0) (1,1))
           (\<lambda>(x, y). P x * P y / (1 - (1 - x * y) * z))"
     by (rule set_integrable_subset) (auto simp:  box simp flip: borel_prod)
 
   have "set_integrable lborel (cbox (0,0) (1,1))
           (\<lambda>(x, y). P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1))"
     unfolding lborel_prod case_prod_unfold P_def
   proof (intro continuous_on_imp_set_integrable_cbox continuous_intros ballI)
     fix p :: "real \<times> real" assume p: "p \<in> cbox (0, 0) (1, 1)"
     have "(1 - fst p * snd p) * z \<le> 1 * z"
       using mult_mono[of "fst p" 1 "snd p" 1] p z cbox by (intro mult_right_mono) auto
     also have "\<dots> < 1" using z by simp
     finally show "(1 - (1 - fst p * snd p) * z) ^ (n + 1) \<noteq> 0" by simp
   qed
   hence integrable': "set_integrable lborel D
           (\<lambda>(x, y). P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1))"
     by (rule set_integrable_subset) (auto simp: box D_def simp flip: borel_prod)
 
   have "(LBINT (x,y):D. P x * P y / (1-(1-x*y)*z)) =
           (LBINT x=0..1. (LBINT y=0..1. P x * P y / (1-(1-x*y)*z)))"
     unfolding D_def lborel_prod [symmetric] using box integrable
     by (subst lborel_pair.set_integral_fst') (simp_all add: interval_integral_Ioo lborel_prod)
   also have "\<dots> = (LBINT x=0..1. P x * (LBINT y=0..1. P y / (1-(1-x*y)*z)))"
     by (subst interval_lebesgue_integral_mult_right [symmetric]) (simp add: mult_ac)
   also have "\<dots> = (LBINT x=0..1. P x * (LBINT y=0..1. (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)))"
     using z by (intro interval_lebesgue_integral_lborel_01_cong, subst beukers_aux_by_parts) auto
   also have "\<dots> = (LBINT x=0..1. (LBINT y=0..1. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)))"
     by (subst interval_lebesgue_integral_mult_right [symmetric]) (simp add: mult_ac)
   also have "\<dots> = (LBINT (x,y):D. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1))"
     unfolding D_def lborel_prod [symmetric] using box integrable'
     by (subst lborel_pair.set_integral_fst')
        (simp_all add: D_def interval_integral_Ioo lborel_prod)
   finally show "(LBINT (x,y):D. P x * P y / (1-(1-x*y)*z)) = \<dots>" .
 qed
 
 text \<open>
   We then change variables for \<open>z\<close>:
 \<close>
 lemma beukers_aux_integral_transform2:
   assumes xy: "x \<in> {0<..<1}" "y \<in> {0<..<1}"
   shows "(LBINT z=0..1. (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)) =
          (LBINT w=0..1. (1-w)^n * (1-y)^n / (1-(1-x*y)*w))"
 proof -
   define g where "g = (\<lambda>z. (1 - z) / (1-(1-x*y)*z))"
   define g' where "g' = (\<lambda>z. -x*y / (1-(1-x*y)*z)^2)"
   have "x * y < 1"
     using mult_strict_mono[of x 1 y 1] xy by simp
   have less: "(1 - (x * y)) * w < 1" and neq: "(1 - (x * y)) * w \<noteq> 1"
     if w: "w \<in> {0..1}" for w
   proof -
     have "(1 - (x * y)) * w \<le> (1 - (x * y)) * 1"
       using w \<open>x * y < 1\<close> by (intro mult_left_mono) auto
     also have "\<dots> < 1"
       using xy by simp
     finally show "(1 - (x * y)) * w < 1" .
     thus "(1 - (x * y)) * w \<noteq> 1" by simp
   qed
 
   have deriv: "(g has_real_derivative g' w) (at w within {0..1})" if "w \<in> {0..1}" for w
     unfolding g_def g'_def
     apply (insert that xy neq)
     apply (rule derivative_eq_intros refl)+
      apply (simp_all add: divide_simps power2_eq_square)
      apply (auto simp: algebra_simps)
     done
   have "continuous_on {0..1} (\<lambda>xa. (1 - xa) ^ n / (1 - (1 - x * y) * xa))"
     using neq by (auto intro!: continuous_intros)
   moreover have "g ` {0..1} \<subseteq> {0..1}"
   proof clarify
     fix w :: real assume w: "w \<in> {0..1}"
     have "(1 - x * y) * w \<le> 1 * w"
       using \<open>x * y < 1\<close> xy w by (intro mult_right_mono) auto
     thus "g w \<in> {0..1}"
       unfolding g_def using less[of w] w by (auto simp: divide_simps)
   qed
   ultimately have cont: "continuous_on (g ` {0..1}) (\<lambda>xa. (1 - xa) ^ n / (1 - (1 - x * y) * xa))"
     by (rule continuous_on_subset)
   have cont': "continuous_on {0..1} g'"
     using neq by (auto simp: g'_def intro!: continuous_intros)
 
   have "(LBINT w=0..1. (1-w)^n * (1-y)^n / (1-(1-x*y)*w)) =
           (1-y)^n * (LBINT w=0..1. (1 - w)^n / (1-(1-x*y)*w))"
     unfolding interval_lebesgue_integral_mult_right [symmetric]
     by (simp add: algebra_simps power_mult_distrib)
   also have "(LBINT w=0..1. (1 - w)^n / (1-(1-x*y)*w)) =
         -(LBINT w=g 0..g 1. (1 - w)^n / (1-(1-x*y)*w))"
     by (subst interval_integral_endpoints_reverse)(simp add: g_def zero_ereal_def one_ereal_def)
   also have "(LBINT w=g 0..g 1. (1 - w)^n / (1-(1-x*y)*w)) =
              (LBINT w=0..1. g' w * ((1 - g w) ^ n / (1 - (1-x*y) * g w)))"
     using deriv cont cont'
     by (subst interval_integral_substitution_finite [symmetric, where g = g and g' = g'])
        (simp_all add: zero_ereal_def one_ereal_def)
   also have "-\<dots> = (LBINT z=0..1. ((x*y)^n * z^n / (1-(1-x*y)*z)^(n+1)))"
     unfolding interval_lebesgue_integral_uminus [symmetric] using xy
     apply (intro interval_lebesgue_integral_lborel_01_cong)
     apply (simp add: divide_simps g_def g'_def)
     apply (auto simp: algebra_simps power_mult_distrib power2_eq_square)
     done
   also have "(1-y)^n * \<dots> = (LBINT z=0..1. (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1))"
     unfolding interval_lebesgue_integral_mult_right [symmetric]
     by (simp add: algebra_simps power_mult_distrib)
   finally show "\<dots> = (LBINT w=0..1. (1-w)^n * (1-y)^n / (1-(1-x*y)*w))" ..
 qed
 
 text \<open>
   Lastly, we apply the same integration by parts to \<open>x\<close>:
 \<close>
 lemma beukers_aux_integral_transform3:
   assumes w: "w \<in> {0<..<1}"
   shows   "(LBINT (x,y):D. P x * (1-y)^n / (1-(1-x*y)*w)) =
            (LBINT (x,y):D. (1-y)^n * (x*y*w)^n * (1-x)^n / (1-(1-x*y)*w)^(n+1))"
 proof -
   have cbox: "cbox (0, 0) (1, 1) = ({0..1} \<times> {0..1} :: (real \<times> real) set)"
     by (auto simp: cbox_def Basis_prod_def inner_prod_def)
   have box: "box (0, 0) (1, 1) = ({0<..<1} \<times> {0<..<1} :: (real \<times> real) set)"
     by (auto simp: box_def Basis_prod_def inner_prod_def)
 
   have "set_integrable lborel
           (cbox (0,0) (1,1)) (\<lambda>(x,y). P x * (1-y)^n/(1-(1-x*y)*w))"
     unfolding lborel_prod case_prod_unfold P_def
   proof (intro continuous_on_imp_set_integrable_cbox continuous_intros ballI)
     fix p :: "real \<times> real" assume p: "p \<in> cbox (0,0) (1,1)"
     have "(1 - fst p * snd p) * w \<le> 1 * w"
       using p cbox w by (intro mult_right_mono) auto
     also have "\<dots> < 1" using w by simp
     finally have "(1 - fst p * snd p) * w < 1" by simp
     thus "1 - (1 - fst p * snd p) * w \<noteq> 0" by simp
   qed
   hence integrable: "set_integrable lborel D (\<lambda>(x,y). P x * (1-y)^n/(1-(1-x*y)*w))"
     by (rule set_integrable_subset) (auto simp: D_def simp flip: borel_prod)
 
   have "set_integrable lborel (cbox (0,0) (1,1))
           (\<lambda>(x,y). (1-y)^n * (x*y*w)^n * (1-x)^n / (1-(1-x*y)*w)^(n+1))"
     unfolding lborel_prod case_prod_unfold P_def
   proof (intro continuous_on_imp_set_integrable_cbox continuous_intros ballI)
     fix p :: "real \<times> real" assume p: "p \<in> cbox (0,0) (1,1)"
     have "(1 - fst p * snd p) * w \<le> 1 * w"
       using p cbox w by (intro mult_right_mono) auto
     also have "\<dots> < 1" using w by simp
     finally have "(1 - fst p * snd p) * w < 1" by simp
     thus "(1 - (1 - fst p * snd p) * w) ^ (n + 1) \<noteq> 0" by simp
   qed
   hence integrable': "set_integrable lborel D
                         (\<lambda>(x,y). (1-y)^n * (x*y*w)^n * (1-x)^n / (1-(1-x*y)*w)^(n+1))"
     by (rule set_integrable_subset) (auto simp: D_def simp flip: borel_prod)
 
   have "(LBINT (x,y):D. P x * (1-y)^n / (1-(1-x*y)*w)) =
           (LBINT y=0..1. (LBINT x=0..1. P x * (1-y)^n / (1-(1-x*y)*w)))"
     using integrable unfolding case_prod_unfold D_def lborel_prod [symmetric]
     by (subst lborel_pair.set_integral_snd) (auto simp: interval_integral_Ioo)
   also have "\<dots> = (LBINT y=0..1. (1-y)^n * (LBINT x=0..1. P x / (1-(1-y*x)*w)))"
     by (subst interval_lebesgue_integral_mult_right [symmetric]) (auto simp: mult_ac)
   also have "\<dots> = (LBINT y=0..1. (1-y)^n * (LBINT x=0..1. (x*y*w)^n * (1-x)^n / (1-(1-x*y)*w)^(n+1)))"
     using w by (intro interval_lebesgue_integral_lborel_01_cong, subst beukers_aux_by_parts) (auto simp: mult_ac)
   also have "\<dots> = (LBINT y=0..1. (LBINT x=0..1.
                      (1-y)^n * (x*y*w)^n * (1-x)^n / (1-(1-x*y)*w)^(n+1)))"
     by (subst interval_lebesgue_integral_mult_right [symmetric]) (auto simp: mult_ac)
   also have "\<dots> = (LBINT (x,y):D. (1-y)^n * (x*y*w)^n * (1-x)^n / (1-(1-x*y)*w)^(n+1))"
     using integrable' unfolding case_prod_unfold D_def lborel_prod [symmetric]
     by (subst lborel_pair.set_integral_snd) (auto simp: interval_integral_Ioo)
   finally show ?thesis .
 qed
 
 text \<open>
   We need to show the existence of some of these triple integrals.
 \<close>
 lemma beukers_aux_integrable1:
   "set_integrable lborel (({0<..<1} \<times> {0<..<1}) \<times> {0<..<1})
      (\<lambda>((x,y),z). P x * P y / (1-(1-x*y)*z))"
 proof -
   have D [measurable]: "D \<in> sets (borel \<Otimes>\<^sub>M borel)"
     unfolding D_def by (simp flip: borel_prod)
   have "bounded (P ` {0..1})"
     unfolding P_def by (intro compact_imp_bounded compact_continuous_image continuous_intros) auto
   then obtain C where C: "\<And>x. x \<in> {0..1} \<Longrightarrow> norm (P x) \<le> C"
     unfolding bounded_iff by fast
   show ?thesis unfolding D'_def case_prod_unfold
   proof (subst lborel_prod [symmetric],
          intro lborel_pair.Fubini_set_integrable AE_I2 impI; clarsimp?)
     fix x y :: real
     assume xy: "x > 0" "x < 1" "y > 0" "y < 1"
     have "x * y < 1" using xy mult_strict_mono[of x 1 y 1] by simp
     show "set_integrable lborel {0<..<1} (\<lambda>z. P x * P y / (1-(1-x*y)*z))"
       by (rule set_integrable_subset[of _ "{0..1}"], rule borel_integrable_atLeastAtMost')
          (use \<open>x*y<1\<close> beukers_denom_neq[of x y] xy in \<open>auto intro!: continuous_intros simp: P_def\<close>)
   next
     have "set_integrable lborel D
              (\<lambda>(x,y). (\<integral>z\<in>{0<..<1}. norm (P x * P y / (1-(1-x*y)*z)) \<partial>lborel))"
     proof (rule set_integrable_bound[OF _ _ AE_I2]; clarify?)
       show "set_integrable lborel D (\<lambda>(x,y). C\<^sup>2 * (-ln (x*y) / (1 - x*y)))"
         using beukers_integral1_integrable[of 0 0]
         unfolding case_prod_unfold by (intro set_integrable_mult_right) (auto simp: D_def)
     next
       fix x y assume xy: "(x, y) \<in> D"
       have "norm (LBINT z:{0<..<1}. norm (P x * P y / (1-(1-x*y)*z))) =
               norm (LBINT z:{0<..<1}. \<bar>P x\<bar> * \<bar>P y\<bar> * (1 / (1-(1-x*y)*z)))"
       proof (intro arg_cong[where f = norm] set_lebesgue_integral_cong allI impI, goal_cases)
         case (2 z)
         with beukers_denom_ineq[of x y z] xy show ?case
           by (auto simp: abs_mult D_def)
       qed (auto simp: abs_mult D_def)
       also have "\<dots> = norm (\<bar>P x\<bar> * \<bar>P y\<bar> * (LBINT z=0..1. (1 / (1-(1-x*y)*z))))"
         by (subst set_integral_mult_right) (auto simp: interval_integral_Ioo)
       also have "\<dots> = norm (norm (P x) * norm (P y) * (- ln (x * y) / (1 - x * y)))"
         using beukers_aux_ln_conv_integral[of x y] xy by (simp add: D_def)
       also have "\<dots> = norm (P x) * norm (P y) * (- ln (x * y) / (1 - x * y))"
         using xy mult_strict_mono[of x 1 y 1]
         by (auto simp: D_def divide_nonpos_nonneg abs_mult)
       also have "norm (P x) * norm (P y) * (- ln (x * y) / (1 - x * y)) \<le>
                    norm (C * C * (- ln (x * y) / (1 - x * y)))"
         using xy C[of x] C[of y] mult_strict_mono[of x 1 y 1] unfolding norm_mult norm_divide
         by (intro mult_mono C) (auto simp: D_def divide_nonpos_nonneg)
       finally show "norm (LBINT z:{0<..<1}. norm (P x * P y / (1-(1-x*y)*z)))
            \<le> norm (case (x, y) of (x, y) \<Rightarrow> C\<^sup>2 * (- ln (x * y) / (1 - x * y)))"
         by (simp add: power2_eq_square mult_ac)
     next
       show "set_borel_measurable lborel D (\<lambda>(x, y).
               LBINT z:{0<..<1}. norm (P x * P y / (1 - (1 - x * y) * z)))"
         unfolding lborel_prod [symmetric] set_borel_measurable_def
                   case_prod_unfold set_lebesgue_integral_def P_def
         by measurable
     qed
     thus "set_integrable lborel ({0<..<1} \<times> {0<..<1})
             (\<lambda>x. LBINT y:{0<..<1}. \<bar>P (fst x) * P (snd x)\<bar> / \<bar>1 - (1 - fst x * snd x) * y\<bar>)"
       by (simp add: case_prod_unfold D_def)
   qed (auto simp: case_prod_unfold lborel_prod [symmetric] set_borel_measurable_def P_def)
 qed
 
 lemma beukers_aux_integrable2:
   "set_integrable lborel D' (\<lambda>(z,x,y). P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z) ^ (n+1))"
 proof -
   have [measurable]: "P \<in> borel_measurable borel" unfolding P_def
     by (intro borel_measurable_continuous_onI continuous_intros)
   have "bounded (P ` {0..1})"
     unfolding P_def by (intro compact_imp_bounded compact_continuous_image continuous_intros) auto
   then obtain C where C: "\<And>x. x \<in> {0..1} \<Longrightarrow> norm (P x) \<le> C"
     unfolding bounded_iff by fast
   show ?thesis unfolding D'_def
   proof (rule set_integrable_bound[OF _ _ AE_I2]; clarify?)
     show "set_integrable lborel ({0<..<1} \<times> {0<..<1} \<times> {0<..<1})
             (\<lambda>(z,x,y). C * (1 / (1-(1-x*y)*z)))"
       unfolding case_prod_unfold
       using beukers_integral1_integrable'[of 0 0]
       by (intro set_integrable_mult_right) (auto simp: lborel_prod case_prod_unfold)
   next
     fix x y z :: real assume xyz: "x \<in> {0<..<1}" "y \<in> {0<..<1}" "z \<in> {0<..<1}"
     have "norm (P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)) =
             norm (P x) * (1-y)^n * ((x*y*z) / (1-(1-x*y)*z))^n / (1-(1-x*y)*z)"
       using xyz beukers_denom_ineq[of x y z] by (simp add: abs_mult power_divide mult_ac)
     also have "(x*y*z) / (1-(1-x*y)*z) = 1/((1-z)/(z*x*y)+1)"
       using xyz by (simp add: field_simps)
     also have "norm (P x) * (1-y)^n * \<dots>^n / (1-(1-x*y)*z) \<le>
                C * 1^n * 1^n / (1-(1-x*y)*z)"
       using xyz C[of x] beukers_denom_ineq[of x y z]
       by (intro mult_mono divide_right_mono power_mono zero_le_power mult_nonneg_nonneg divide_nonneg_nonneg)
          (auto simp: field_simps)
     also have "\<dots> \<le> \<bar>C * 1^n * 1^n / (1-(1-x*y)*z)\<bar>"
       by linarith
     finally show "norm (P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)) \<le>
                     norm (case (z,x,y) of (z,x,y) \<Rightarrow> C * (1 / (1-(1-x*y)*z)))"
       by (simp add: case_prod_unfold)
   qed (simp_all add: case_prod_unfold set_borel_measurable_def flip: borel_prod)
 qed
 
 lemma beukers_aux_integrable3:
   "set_integrable lborel D' (\<lambda>(w,x,y). P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w))"
 proof -
   have [measurable]: "P \<in> borel_measurable borel" unfolding P_def
     by (intro borel_measurable_continuous_onI continuous_intros)
   have "bounded (P ` {0..1})"
     unfolding P_def by (intro compact_imp_bounded compact_continuous_image continuous_intros) auto
   then obtain C where C: "\<And>x. x \<in> {0..1} \<Longrightarrow> norm (P x) \<le> C"
     unfolding bounded_iff by fast
   show ?thesis unfolding D'_def
   proof (rule set_integrable_bound[OF _ _ AE_I2]; clarify?)
     show "set_integrable lborel ({0<..<1} \<times> {0<..<1} \<times> {0<..<1})
             (\<lambda>(z,x,y). C * (1 / (1-(1-x*y)*z)))"
       unfolding case_prod_unfold
       using beukers_integral1_integrable'[of 0 0]
       by (intro set_integrable_mult_right) (auto simp: lborel_prod case_prod_unfold)
   next
     fix x y w :: real assume xyw: "x \<in> {0<..<1}" "y \<in> {0<..<1}" "w \<in> {0<..<1}"
     have "norm (P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w)) =
             norm (P x) * (1-w)^n * (1-y)^n / (1-(1-x*y)*w)"
       using xyw beukers_denom_ineq[of x y w] by (simp add: abs_mult power_divide mult_ac)
     also have "\<dots> \<le> C * 1^n * 1^n / (1-(1-x*y)*w)"
       using xyw C[of x] beukers_denom_ineq[of x y w]
       by (intro mult_mono divide_right_mono power_mono zero_le_power mult_nonneg_nonneg divide_nonneg_nonneg)
          (auto simp: field_simps)
     also have "\<dots> \<le> \<bar>C * 1^n * 1^n / (1-(1-x*y)*w)\<bar>"
       by linarith
     finally show "norm (P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w)) \<le>
                     norm (case (w,x,y) of (z,x,y) \<Rightarrow> C * (1 / (1-(1-x*y)*z)))"
       by (simp add: case_prod_unfold)
   qed (simp_all add: case_prod_unfold set_borel_measurable_def flip: borel_prod)
 qed
 
 text \<open>
   Now we only need to put all of these results together:
 \<close>
 lemma beukers_integral2_conv_3: "beukers_integral2 = beukers_integral3"
 proof -
   have cont_P: "continuous_on {0..1} P"
     by (auto simp: P_def intro: continuous_intros)
   have D [measurable]: "D \<in> sets borel" "D \<in> sets (borel \<Otimes>\<^sub>M borel)"
     unfolding D_def by (simp_all flip: borel_prod)
   have [measurable]: "P \<in> borel_measurable borel" unfolding P_def
     by (intro borel_measurable_continuous_onI continuous_intros)
 
   have "beukers_integral2 = (LBINT (x,y):D. P x * P y * (LBINT z=0..1. 1 / (1-(1-x*y)*z)))"
     unfolding beukers_integral2_def case_prod_unfold
     by (intro set_lebesgue_integral_cong allI impI, measurable)
        (subst beukers_aux_ln_conv_integral, auto simp: D_def)
   also have "\<dots> = (LBINT (x,y):D. (LBINT z=0..1. P x * P y / (1-(1-x*y)*z)))"
       by (subst interval_lebesgue_integral_mult_right [symmetric]) auto
   also have "\<dots> = (LBINT (x,y):D. (LBINT z:{0<..<1}. P x * P y / (1-(1-x*y)*z)))"
     by (simp add: interval_integral_Ioo)
   also have "\<dots> = (LBINT z:{0<..<1}. (LBINT (x,y):D. P x * P y / (1-(1-x*y)*z)))"
   proof (subst lborel_pair.Fubini_set_integral [symmetric])
     have "set_integrable lborel (({0<..<1} \<times> {0<..<1}) \<times> {0<..<1})
             (\<lambda>((x, y), z). P x * P y / (1 - (1 - x * y) * z))"
       using beukers_aux_integrable1 by simp
     also have "?this \<longleftrightarrow> set_integrable (lborel \<Otimes>\<^sub>M lborel) ({0<..<1} \<times> D)
                            (\<lambda>(z,x,y). P x * P y / (1 - (1 - x * y) * z))"
       unfolding set_integrable_def
       by (subst lborel_pair.integrable_product_swap_iff [symmetric], intro Bochner_Integration.integrable_cong)
          (auto simp: indicator_def case_prod_unfold lborel_prod D_def)
     finally show \<dots> .
   qed (auto simp: case_prod_unfold)
   also have "\<dots> = (LBINT z:{0<..<1}. (LBINT (x,y):D. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)))"
     by (rule set_lebesgue_integral_cong) (use beukers_aux_integral_transform1 in simp_all)
   also have "\<dots> = (LBINT (x,y):D. (LBINT z:{0<..<1}. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)))"
     using beukers_aux_integrable2
     by (subst lborel_pair.Fubini_set_integral [symmetric])
        (auto simp: case_prod_unfold lborel_prod D_def D'_def)
   also have "\<dots> = (LBINT (x,y):D. (LBINT w:{0<..<1}. P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w)))"
   proof (intro set_lebesgue_integral_cong allI impI; clarify?)
     fix x y :: real
     assume xy: "(x, y) \<in> D"
     have "(LBINT z:{0<..<1}. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)) =
             P x * (LBINT z=0..1. (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1))"
       by (subst interval_lebesgue_integral_mult_right [symmetric])
          (simp add: mult_ac interval_integral_Ioo)
     also have "\<dots> = P x * (LBINT w=0..1. (1-w)^n * (1-y)^n / (1-(1-x*y)*w))"
       using xy by (subst beukers_aux_integral_transform2) (auto simp: D_def)
     also have "\<dots> = (LBINT w:{0<..<1}. P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w))"
       by (subst interval_lebesgue_integral_mult_right [symmetric])
          (simp add: mult_ac interval_integral_Ioo)
     finally show "(LBINT z:{0<..<1}. P x * (x*y*z)^n * (1-y)^n / (1-(1-x*y)*z)^(n+1)) =
                     (LBINT w:{0<..<1}. P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w))" .
   qed (auto simp: D_def simp flip: borel_prod)
   also have "\<dots> = (LBINT w:{0<..<1}. (LBINT (x,y):D. P x * (1-w)^n * (1-y)^n / (1-(1-x*y)*w)))"
     using beukers_aux_integrable3
     by (subst lborel_pair.Fubini_set_integral [symmetric])
        (auto simp: case_prod_unfold lborel_prod D_def D'_def)
   also have "\<dots> = (LBINT w=0..1. (1-w)^n * (LBINT (x,y):D. P x * (1-y)^n / (1-(1-x*y)*w)))"
     unfolding case_prod_unfold
     by (subst set_integral_mult_right [symmetric]) (simp add: mult_ac interval_integral_Ioo)
   also have "\<dots> = (LBINT w=0..1. (1-w)^n * (LBINT (x,y):D. (x*y*w*(1-x)*(1-y))^n / (1-(1-x*y)*w)^(n+1)))"
     by (intro interval_lebesgue_integral_lborel_01_cong, subst beukers_aux_integral_transform3)
        (auto simp: mult_ac power_mult_distrib)
   also have "\<dots> = (LBINT w=0..1. (LBINT (x,y):D. (x*y*w*(1-x)*(1-y)*(1-w))^n / (1-(1-x*y)*w)^(n+1)))"
     by (subst set_integral_mult_right [symmetric])
        (auto simp: case_prod_unfold mult_ac power_mult_distrib)
   also have "\<dots> = beukers_integral3"
     using beukers_integral3_integrable unfolding D'_def D_def beukers_integral3_def
     by (subst (2) lborel_prod [symmetric], subst lborel_pair.set_integral_fst')
        (auto simp: case_prod_unfold interval_integral_Ioo lborel_prod algebra_simps)
   finally show ?thesis .
 qed
 
 
 subsection \<open>The main result\<close>
 
 text \<open>
   Combining all of the results so far, we can derive the key inequalities
   \[0 < A\zeta(3) + B < 2 \zeta(3) \cdot 27^{-n} \cdot \text{lcm}\{1\ldots n\}^3\]
   for integers $A$, $B$ with $A > 0$.
 \<close>
 lemma zeta_3_linear_combination_bounds:
   obtains A B :: int
   where "A > 0"
         "A * Re (zeta 3) + B \<in> {0 <.. 2 * Re (zeta 3) * Lcm {1..n} ^ 3 / 27 ^ n}"
 proof -
   define I where "I = beukers_integral2"
   define d where "d = Lcm {1..n} ^ 3"
   have "d > 0" by (auto simp: d_def intro!: Nat.gr0I)
   from beukers_integral2_conv_int_combination obtain A' B :: int
     where *: "A' > 0" "I = A' * Re (zeta 3) + B / d" unfolding I_def d_def .
   define A where "A = A' * d"
   from * have A: "A > 0" "I = (A * Re (zeta 3) + B) / d"
     using \<open>d > 0\<close> by (simp_all add: A_def field_simps)
 
   have "0 < I"
     using beukers_integral3_pos by (simp add: I_def beukers_integral2_conv_3)
   with \<open>d > 0\<close> have "A * Re (zeta 3) + B > 0"
     by (simp add: field_simps A)
 
   moreover have "I \<le> 2 * (1 / 27) ^ n * Re (zeta 3)"
     using beukers_integral2_conv_3 beukers_integral3_le by (simp add: I_def)
   hence "A * Re (zeta 3) + B \<le> 2 * Re (zeta 3) * d / 27 ^ n"
     using \<open>d > 0\<close> by (simp add: A field_simps)
 
   ultimately show ?thesis
     using A by (intro that[of A B]) (auto simp: d_def)
 qed
 
 text \<open>
   If $\zeta(3) = \frac{a}{b}$ for some integers $a$ and $b$, we can thus derive
   the inequality $2b\zeta(3) \cdot 27^{-n} \cdot \text{lcm}\{1\ldots n\}^3\geq 1$ for any
   natural number $n$.
 \<close>
 lemma beukers_key_inequality:
   fixes a :: int and b :: nat
   assumes "b > 0" and ab: "Re (zeta 3) = a / b"
   shows   "2 * b * Re (zeta 3) * Lcm {1..n} ^ 3 / 27 ^ n \<ge> 1"
 proof -
   from zeta_3_linear_combination_bounds obtain A B :: int
     where AB: "A > 0"
               "A * Re (zeta 3) + B \<in> {0 <.. 2 * Re (zeta 3) * Lcm {1..n} ^ 3 / 27 ^ n}" .
   from AB have "0 < (A * Re (zeta 3) + B) * b"
     using \<open>b > 0\<close> by (intro mult_pos_pos) auto
   also have "\<dots> = A * (Re (zeta 3) * b) + B * b"
     using \<open>b > 0\<close> by (simp add: algebra_simps)
   also have "Re (zeta 3) * b = a"
     using \<open>b > 0\<close> by (simp add: ab)
   also have "of_int A * of_int a + of_int (B * b) = of_int (A * a + B * b)"
     by simp
   finally have "1 \<le> A * a + B * b"
     by linarith
   hence "1 \<le> real_of_int (A * a + B * b)"
     by linarith
   also have "\<dots> = (A * (a / b) + B) * b"
     using \<open>b > 0\<close> by (simp add: ring_distribs)
   also have "a / b = Re (zeta 3)"
     by (simp add: ab)
   also have "A * Re (zeta 3) + B \<le> 2 * Re (zeta 3) * Lcm {1..n} ^ 3 / 27 ^ n"
     using AB by simp
   finally show "2 * b * Re (zeta 3) * Lcm {1..n} ^ 3 / 27 ^ n \<ge> 1"
     using \<open>b > 0\<close> by (simp add: mult_ac)
 qed
 
 end
 
 (* TODO: Move *)
 lemma smallo_power: "n > 0 \<Longrightarrow> f \<in> o[F](g) \<Longrightarrow> (\<lambda>x. f x ^ n) \<in> o[F](\<lambda>x. g x ^ n)"
   by (induction n rule: nat_induct_non_zero) (auto intro: landau_o.small.mult)
 
 text \<open>
   This is now a contradiction, since $\text{lcm}\{1\ldots n\} \in o(3^n)$ by the
   Prime Number Theorem -- hence the main result.
 \<close>
 theorem zeta_3_irrational: "zeta 3 \<notin> \<rat>"
 proof
   assume "zeta 3 \<in> \<rat>"
   obtain a :: int and b :: nat where "b > 0" and ab': "zeta 3 = a / b"
   proof -
     from \<open>zeta 3 \<in> \<rat>\<close> obtain r where r: "zeta 3 = of_rat r"
       by (elim Rats_cases)
     also have "r = rat_of_int (fst (quotient_of r)) / rat_of_int (snd (quotient_of r))"
       by (intro quotient_of_div) auto
     also have "of_rat \<dots> = (of_int (fst (quotient_of r)) / of_int (snd (quotient_of r)) :: complex)"
       by (simp add: of_rat_divide)
     also have "of_int (snd (quotient_of r)) = of_nat (nat (snd (quotient_of r)))"
       using quotient_of_denom_pos'[of r] by auto
     finally have "zeta 3 = of_int (fst (quotient_of r)) / of_nat (nat (snd (quotient_of r)))" .
     thus ?thesis
       using quotient_of_denom_pos'[of r]
       by (intro that[of "nat (snd (quotient_of r))" "fst (quotient_of r)"]) auto
   qed
   hence ab: "Re (zeta 3) = a / b" by simp
 
   interpret prime_number_theorem
     by standard (rule prime_number_theorem)
 
   have Lcm_upto_smallo: "(\<lambda>n. real (Lcm {1..n})) \<in> o(\<lambda>n. c ^ n)" if c: "c > exp 1" for c
   proof -
     have "0 < exp (1::real)" by simp
     also note c
     finally have "c > 0" .
     have "(\<lambda>n. real (Lcm {1..n})) = (\<lambda>n. real (Lcm {1..nat \<lfloor>real n\<rfloor>}))"
       by simp
     also have "\<dots> \<in> o(\<lambda>n. c powr real n)"
       using Lcm_upto.smallo'
       by (rule landau_o.small.compose) (simp_all add: c filterlim_real_sequentially)
     also have "(\<lambda>n. c powr real n) = (\<lambda>n. c ^ n)"
       using c \<open>c > 0\<close> by (subst powr_realpow) auto
     finally show ?thesis .
   qed
 
   have "(\<lambda>n. 2 * b * Re (zeta 3) * real (Lcm {1..n}) ^ 3 / 27 ^ n) \<in>
           O(\<lambda>n. real (Lcm {1..n}) ^ 3 / 27 ^ n)"
     using \<open>b > 0\<close> Re_zeta_ge_1[of 3] by simp
   also have "exp 1 < (3 :: real)"
     using e_approx_32 by (simp add: abs_if split: if_splits)
   hence "(\<lambda>n. real (Lcm {1..n}) ^ 3 / 27 ^ n) \<in> o(\<lambda>n. (3 ^ n) ^ 3 / 27 ^ n)"
     unfolding of_nat_power
     by (intro landau_o.small.divide_right smallo_power Lcm_upto_smallo) auto
   also have "(\<lambda>n. (3 ^ n) ^ 3 / 27 ^ n :: real) = (\<lambda>_. 1)"
     by (simp add: power_mult [of 3, symmetric] mult.commute[of _ 3] power_mult[of _ 3])
   finally have *: "(\<lambda>n. 2 * b * Re (zeta 3) * real (Lcm {1..n}) ^ 3 / 27 ^ n) \<in> o(\<lambda>_. 1)" .
   have lim: "(\<lambda>n. 2 * b * Re (zeta 3) * real (Lcm {1..n}) ^ 3 / 27 ^ n) \<longlonglongrightarrow> 0"
     using smalloD_tendsto[OF *] by simp
 
   moreover have "1 \<le> real (2 * b) * Re (zeta 3) * real (Lcm {1..n} ^ 3) / 27 ^ n" for n
     using beukers_key_inequality[of b a] ab \<open>b > 0\<close> by simp
 
   ultimately have "1 \<le> (0 :: real)"
     by (intro tendsto_lowerbound[OF lim] always_eventually allI) auto
   thus False by simp
 qed
 
 end
\ No newline at end of file