diff --git a/thys/Irrationality_J_Hancl/Irrationality_J_Hancl.thy b/thys/Irrationality_J_Hancl/Irrationality_J_Hancl.thy
--- a/thys/Irrationality_J_Hancl/Irrationality_J_Hancl.thy
+++ b/thys/Irrationality_J_Hancl/Irrationality_J_Hancl.thy
@@ -1,1090 +1,1087 @@
 (*
   File: Irrationality_J_Hancl.thy
   Authors:  Angeliki Koutsoukou-Argyraki and Wenda Li,
             Computer Laboratory, University of Cambridge, UK.
   Email: ak2110@cam.ac.uk, wl302@cam.ac.uk  
 *)
 
 section \<open>Irrational Rapidly Convergent Series\<close>
 theory Irrationality_J_Hancl
   imports "HOL-Analysis.Analysis" "HOL-Decision_Procs.Approximation"
 begin
 
 text \<open>This is the formalisation of a proof by J. Hancl, in particular of the proof of his Theorem 3 in
 the paper: Irrational Rapidly Convergent Series, Rend. Sem. Mat. Univ. Padova, Vol 107 (2002).
 
 The statement asserts the irrationality of the sum of a series consisting of rational numbers
 defined using sequences that fulfill certain properties. Even though the statement
 is number-theoretic, the proof uses only arguments from introductory Analysis.\<close>
 
 text \<open>We show the central result (theorem Hancl3) by proof by contradiction, by making use of some of 
  the auxiliary lemmas. To this end, assuming that the sum is a rational number, for a quantity 
  $\textrm{ALPHA}(n)$ we show that $\textrm{ALPHA}(n) \geq 1$ for all $n \in \mathbb{N}$. After that we show that we can find an 
   $n \in \mathbb{N}$ for which $\textrm{ALPHA}(n) < 1$ which yields a contradiction and we thus conclude that the 
   sum of the series is a rational number. We finally give an immediate application of theorem Hancl3
  for a specific series (corollary Hancl3corollary, requiring lemma
  summable\_ln\_plus) which corresponds to Corollary 2 in the original
 paper by J. Hancl. 
 \<close>
 
 hide_const floatarith.Max
 
 subsection \<open>Misc\<close>
 
 lemma filterlim_sequentially_iff:
   "filterlim f F1 sequentially \<longleftrightarrow> filterlim (\<lambda>x. f (x+k)) F1 sequentially"
   unfolding filterlim_iff
   apply (subst eventually_sequentially_seg)
   by auto
 
 lemma filterlim_realpow_sequentially_at_top:
   "(x::real) > 1 \<Longrightarrow> filterlim ((^) x) at_top sequentially"
   apply (rule LIMSEQ_divide_realpow_zero[THEN filterlim_inverse_at_top,of _ 1,simplified])
   by auto
 
 lemma filterlim_at_top_powr_real:
   fixes g::"'b \<Rightarrow> real"
   assumes "filterlim f at_top F" "(g \<longlongrightarrow> g') F" "g'>1"
   shows "filterlim (\<lambda>x. g x powr f x) at_top F"
 proof -
   have "filterlim (\<lambda>x. ((g'+1)/2) powr f x) at_top F" 
   proof (subst filterlim_at_top_gt[of _ _ 1],rule+)
     fix Z assume "Z>(1::real)"
     have "\<forall>\<^sub>F x in F. ln Z \<le> ln (((g' + 1) / 2) powr f x)"
       using assms(1)[unfolded filterlim_at_top,rule_format,of "ln Z / ln ((g' + 1) / 2)"]
       apply (eventually_elim)
       using \<open>g'>1\<close> by (auto simp:ln_powr divide_simps)
     then show "\<forall>\<^sub>F x in F. Z \<le> ((g' + 1) / 2) powr f x"
       apply (eventually_elim)
       apply (subst (asm) ln_le_cancel_iff)
       using \<open>Z>1\<close> \<open>g'>1\<close> by auto
   qed
   moreover have "\<forall>\<^sub>F x in F. ((g'+1)/2) powr f x \<le> g x powr f x" 
   proof -
     have "\<forall>\<^sub>F x in F. g x > (g'+1)/2"
       apply (rule order_tendstoD[OF assms(2)])
       using \<open>g'>1\<close> by auto
     moreover have "\<forall>\<^sub>F x in F. f x>0" 
       using assms(1)[unfolded filterlim_at_top_dense,rule_format,of 0] .
     ultimately show ?thesis
       apply eventually_elim
       using \<open>g'>1\<close> by (auto intro!: powr_mono2)
   qed
   ultimately show ?thesis using filterlim_at_top_mono by fast
 qed
 
 lemma powrfinitesum:
   fixes a::real and s::nat assumes  "s \<le> n"
   shows " (\<Prod>j=s..(n::nat).(a powr (2^j)))  = a powr (\<Sum>j=s..(n::nat).(2^j)) "
   using \<open>s \<le> n\<close> 
 proof(induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   have ?case when "s\<le>n" using Suc.hyps 
     by (metis Suc.prems add.commute linorder_not_le powr_add prod.nat_ivl_Suc' sum.cl_ivl_Suc that)
   moreover have ?case when "s=Suc n"   
   proof-
     have "(\<Prod>j = s..Suc n. a powr 2 ^ j) =(a powr 2 ^(Suc n))  " 
       using \<open>s=Suc n\<close> by simp
     also have "(a powr 2 ^(Suc n) ) =  a powr sum ((^) 2) {s..Suc n}   " using that by auto
     ultimately show " (\<Prod>j = s..Suc n. a powr 2 ^ j) = a powr sum ((^) 2) {s..Suc n}"
       using \<open>s\<le>Suc n\<close> by linarith
   qed
   ultimately show ?case using \<open>s\<le>Suc n\<close> by linarith
 qed
 
 lemma summable_ratio_test_tendsto:
   fixes f :: "nat \<Rightarrow> 'a::banach"
   assumes "c < 1" and "\<forall>n. f n\<noteq>0" and "(\<lambda>n. norm (f (Suc n)) / norm (f n)) \<longlonglongrightarrow> c"
   shows "summable f"
 proof -
   obtain N where N_dist:"\<forall>n\<ge>N. dist (norm (f (Suc n)) / norm (f n)) c < (1-c)/2"
     using assms unfolding tendsto_iff eventually_sequentially 
     by (meson diff_gt_0_iff_gt zero_less_divide_iff zero_less_numeral)
   have "norm (f (Suc n)) / norm (f n) \<le> (1+c)/2" when "n\<ge>N" for n
     using N_dist[rule_format,OF that] \<open>c<1\<close> 
     apply (auto simp add:field_simps dist_norm)
     by argo
   then have "norm (f (Suc n))  \<le> (1+c)/2 * norm (f n)" when "n\<ge>N" for n
     using that assms(2)[rule_format, of n] by (auto simp add:divide_simps)
   moreover have "(1+c)/2 < 1" using \<open>c<1\<close> by auto 
   ultimately show ?thesis
     using summable_ratio_test[of _ N f] by blast
 qed
 
 lemma summable_ln_plus:
   fixes f::"nat \<Rightarrow> real" 
   assumes "summable f" "\<forall>n. f n>0"
   shows "summable (\<lambda>n. ln (1+f n))"
 proof (rule summable_comparison_test_ev[OF _ assms(1)])
   have "ln (1 + f n) > 0" for n by (simp add: assms(2) ln_gt_zero)
   moreover have "ln (1 + f n) \<le> f n" for n 
     apply (rule ln_add_one_self_le_self2)
     using assms(2)[rule_format,of n] by auto 
   ultimately show "\<forall>\<^sub>F n in sequentially. norm (ln (1 + f n)) \<le> f n"
     by (auto intro!: eventuallyI simp add:less_imp_le) 
 qed
 
 lemma suminf_real_offset_le:
   fixes f :: "nat \<Rightarrow> real"
   assumes f: "\<And>i. 0 \<le> f i" and "summable f"
   shows "(\<Sum>i. f (i + k)) \<le> suminf f"
 proof -
   have "(\<lambda>n. \<Sum>i<n. f (i + k)) \<longlonglongrightarrow> (\<Sum>i. f (i + k))"
     using summable_sums[OF \<open>summable f\<close>] 
     by (simp add: assms(2) summable_LIMSEQ summable_ignore_initial_segment)
   moreover have "(\<lambda>n. \<Sum>i<n. f i) \<longlonglongrightarrow> (\<Sum>i. f i)"
     using summable_sums[OF \<open>summable f\<close>] by (simp add: sums_def atLeast0LessThan f)
   then have "(\<lambda>n. \<Sum>i<n + k. f i) \<longlonglongrightarrow> (\<Sum>i. f i)"
     by (rule LIMSEQ_ignore_initial_segment)
   ultimately show ?thesis
   proof (rule LIMSEQ_le, safe intro!: exI[of _ k])
     fix n assume "k \<le> n"
     have "(\<Sum>i<n. f (i + k)) = (\<Sum>i<n. (f \<circ> (\<lambda>i. i + k)) i)"
       by simp
     also have "\<dots> = (\<Sum>i\<in>(\<lambda>i. i + k) ` {..<n}. f i)"
       by (subst sum.reindex) auto
     also have "\<dots> \<le> sum f {..<n + k}"
       by (intro sum_mono2) (auto simp: f)
     finally show "(\<Sum>i<n. f (i + k)) \<le> sum f {..<n + k}" .
   qed
 qed
 
 
 
 lemma factt:
   fixes s n ::nat assumes "s \<le> n" 
   shows " (\<Sum>i=s..n. 2^i) < (2^(n+1) :: real) " using assms
 proof (induct n)
   case 0
   show ?case by  auto 
 next
   case (Suc n)
   have ?case when  "s=n+1" using that by auto
   moreover have ?case when  "s \<noteq> n+1" 
   proof -
     have"(\<Sum>i=s..(n+1). 2^i ) = (\<Sum>i=s..n. 2^i ) + (2::real)^(n+1) "
       using sum.cl_ivl_Suc \<open>s \<le> Suc n \<close>
       by (auto simp add:add.commute)
     also have "... < (2) ^ (n +1) + (2)^(n+1)" 
     proof -
       have "s \<le>n" using that  \<open>s \<le> Suc n \<close> by auto
       then show ?thesis
         using Suc.hyps \<open>s \<le> n\<close> by linarith
     qed
     also have "... = 2^(n+2)" by simp
     finally show "(\<Sum>i=s..(Suc n). 2^i )< (2::real)^(Suc n+1)" by auto
   qed
   ultimately show ?case by blast
 qed
 
 subsection \<open>Auxiliary lemmas and the main proof\<close>
 
 lemma showpre7:
   fixes a b ::"nat\<Rightarrow>int " and q p::int
   assumes "q>0" and "p>0"and a: "\<forall>n. a n>0" and "\<forall>n. b n>0" and 
     assumerational:"(\<lambda> n. b (n+1) / a (n+1) )  sums (p/q)"
   shows "q*((\<Prod>j=1..n. of_int( a j)))*(suminf (\<lambda>(j::nat). (b (j+n+1)/ a (j+n+1 )))) 
         = ((\<Prod>j=1..n. of_int( a j)))*(p -q* (\<Sum>j=1..n. b j / a j))       " 
 proof -
   define aa where "aa=(\<Prod>j = 1..n. real_of_int (a j))"
   define ff where "ff=(\<lambda>i. real_of_int (b (i+1)) / real_of_int (a (i+1)))"
 
   have "(\<Sum>j. ff (j+n)) =  (\<Sum>n. ff n) - sum ff {..<n}"
     apply (rule suminf_minus_initial_segment)
     using assumerational unfolding ff_def by (simp add: sums_summable)
   also have "... = p/q - sum ff {..<n}"
     using assumerational unfolding ff_def by (simp add: sums_iff)
   also have "... = p/q - (\<Sum>j=1..n. ff (j-1))"
   proof -
     have "sum ff {..<n} = (\<Sum>j=1..n. ff (j-1))"
       apply (subst sum_bounds_lt_plus1[symmetric])
       by simp
     then show ?thesis unfolding ff_def by auto
   qed
   finally have "(\<Sum>j. ff (j + n)) = p / q - (\<Sum>j = 1..n. ff (j - 1))" .
   then have "q*(\<Sum>j. ff (j + n)) = p - q*(\<Sum>j = 1..n. ff (j - 1))"
     using \<open>q>0\<close> by (auto simp add:field_simps)
   then have "aa*q*(\<Sum>j. ff (j + n)) = aa*(p - q*(\<Sum>j = 1..n. ff (j - 1)))" 
     by auto
   then show ?thesis unfolding aa_def ff_def by auto
 qed
 
 lemma show7:
   fixes d::"nat\<Rightarrow>real" and a b::"nat\<Rightarrow>int " and q p::int
   assumes "q \<ge>1" and "p \<ge> 1" and a: "\<forall>n. a n \<ge> 1" and "\<forall>n. b n \<ge> 1"
     and assumerational:"(\<lambda> n. b (n+1) / a (n+1) ) sums (p/q)"
   shows "q*((\<Prod>j=1..n. of_int( a j)))*( suminf (\<lambda> (j::nat). (b (j+n+1)/ a (j+n+1 )))) \<ge> 1 "
     (is "?L \<ge> _")
 proof-
   define LL where "LL=?L"
   define aa where "aa=(\<Prod>j = 1..n. real_of_int (a j))"
   define ff where "ff=(\<lambda>i. real_of_int (b (i+1)) / real_of_int (a (i+1)))"
 
   have "?L > 0"
   proof -
     have "aa > 0"
       unfolding aa_def using a
       apply (induct n,auto)
       by (simp add: int_one_le_iff_zero_less prod_pos)
     moreover have "(\<Sum>j. ff (j + n)) > 0"
     proof (rule suminf_pos)
       have "summable ff" unfolding ff_def using assumerational
         using summable_def by blast
       then show " summable (\<lambda>j. ff (j + n))" using summable_iff_shift[of ff n] by auto
       show " \<forall>i. 0 < ff (i + n)" unfolding ff_def using a assms(4) int_one_le_iff_zero_less by auto
     qed
     ultimately show ?thesis unfolding aa_def ff_def using \<open>q\<ge>1\<close> by auto
   qed
   moreover have "?L \<in> \<int>"
   proof -
     have "?L = aa *(p -q* ( \<Sum>j=1..n. b j / a j))"
       unfolding aa_def
       apply (rule showpre7)
       using assms int_one_le_iff_zero_less by auto
     also have "... = aa * p - q * (\<Sum>j=1..n. aa * b j / a j)"
       by (auto simp add:algebra_simps sum_distrib_left)
     also have "... = prod a {1..n} * p - q * (\<Sum>j = 1..n. b j * prod a ({1..n} - {j}))"
     proof -
       have "(\<Sum>j=1..n. aa * b j / a j) = (\<Sum>j=1..n. b j * prod a ({1..n} - {j}))"
         unfolding of_int_sum
       proof (rule sum.cong)
         fix x assume "x \<in> {1..n}"
         then have "(\<Prod>i = 1..n. real_of_int (a i)) = a x * (\<Prod>i\<in>{1..n} - {x}. real_of_int (a i))"
           apply (rule_tac prod.remove)
           by auto
         then have "aa / real_of_int (a x) = prod a ({1..n} - {x})"
           unfolding aa_def using a[rule_format,of x] by (auto simp add:field_simps)
         then show "aa * b x / a x = b x * prod a ({1..n} - {x})"
           by (metis mult.commute of_int_mult times_divide_eq_right)
       qed simp
       moreover have "aa * p = (\<Prod>j = 1..n.  (a j)) *  p"
         unfolding aa_def by auto
       ultimately show ?thesis by force
     qed
     also have "... \<in> \<int>" using Ints_of_int by blast
     finally show ?thesis .
   qed
   ultimately show ?thesis 
     apply (fold LL_def)
     by (metis Ints_cases int_one_le_iff_zero_less not_less of_int_0_less_iff of_int_less_1_iff)
 qed
 
 lemma show8:
   fixes d ::"nat\<Rightarrow>real " and a :: "nat\<Rightarrow>int" and s k::nat 
   assumes "A > 1" and d: "\<forall>n. d n> 1"  and a:"\<forall>n. a n>0" and "s>0"
     and "convergent_prod d"
     and assu2: "\<forall>n \<ge> s. ( A/ (of_int (a n)) powr(1/of_int (2^n)))> prodinf (\<lambda>j. d(n +j))"
   shows "\<forall>n\<ge>s. prodinf (\<lambda>j. d(j+n)) < A/(Max ((\<lambda>(j::nat). 
                   (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n}))"
 proof(rule,rule)
   fix n assume "s \<le> n"
   define sp where "sp = (\<lambda>n. prodinf (\<lambda>j. d(j+n)))"
   define ff where "ff = (\<lambda>(j::nat). (real_of_int (a j)) powr(1 /of_int (2^j)))"
   have "sp i \<ge> sp n" when "i\<le>n" for i
   proof -
     have "(\<Prod>j. d (j + i)) = (\<Prod>ia. d (ia + (n - i) + i)) * (\<Prod>ia<n - i. d (ia + i))"
       apply (rule prodinf_split_initial_segment) 
       subgoal using \<open>convergent_prod d\<close> convergent_prod_iff_shift[of d i] by simp
       subgoal for j using d[rule_format,of "j+i"] by auto
       done
     then have "sp i = sp n * (\<Prod>j<n - i. d (i + j))"
       unfolding sp_def using \<open>n\<ge>i\<close> by (auto simp:algebra_simps)
     moreover have "sp i>1" "sp n>1" 
       unfolding sp_def using convergent_prod_iff_shift \<open>convergent_prod d\<close> d 
       by (auto intro!:less_1_prodinf)
     moreover have "(\<Prod>j<n - i. d (i + j)) \<ge>1" 
       apply (rule prod_ge_1)
       using d less_imp_le by auto
     ultimately show ?thesis by auto
   qed
   moreover have "\<forall>j\<ge>s. A / ff j > sp j" 
     unfolding ff_def sp_def using assu2 by (auto simp:algebra_simps)
   ultimately have "\<forall>j. s\<le>j \<and> j\<le>n \<longrightarrow> A / ff j > sp n" by force
   then show "sp n< A / Max (ff ` {s..n})" 
     by (metis (mono_tags, hide_lams) Max_in \<open>n\<ge>s\<close> atLeastAtMost_iff empty_iff 
         finite_atLeastAtMost finite_imageI imageE image_is_empty order_refl)
 qed
 
 lemma auxiliary1_9:
   fixes d ::"nat\<Rightarrow>real" and a::"nat\<Rightarrow>int " and s m::nat 
   assumes d: "\<forall>n. d n> 1"  and a: "\<forall>n. a n>0" and "s>0" and "n \<ge> m" and " m \<ge> s"
     and auxifalse_assu: "\<forall>n\<ge>m. (of_int (a (n+1))) powr(1 /of_int (2^(n+1))) <
               (d (n+1))* (Max ((\<lambda> (j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n} ))"
   shows "(of_int (a (n+1))) powr(1 /of_int (2^(n+1))) <
     (\<Prod>j=(m+1)..(n+1). d j) * (Max ((\<lambda> (j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..m}))"
 proof-
   define ff where "ff = (\<lambda>(j::nat). (real_of_int (a j)) powr(1 /of_int (2^j)))"
   have [simp]:"ff j > 0" for j
     unfolding ff_def by (metis a less_numeral_extra(3) of_int_0_less_iff powr_gt_zero)
 
   have ff_asm:"ff (n+1) < d (n+1) * Max (ff ` {s..n})" when "n\<ge>m" for n
     using auxifalse_assu that unfolding ff_def by simp
   from \<open>n\<ge>m\<close>
   have Q: "(Max( ff ` {s..n} )) \<le> (\<Prod>j=(m+1)..n. d j)* (Max (ff ` {s..m}))"
   proof(induct n)
     case 0
     then show ?case using \<open>m\<ge>s\<close> by simp 
   next
     case (Suc n)
     have ?case when "m=Suc n"
       using that by auto
     moreover have ?case when "m\<noteq>Suc n" 
     proof -
       have "m \<le> n" using that Suc(2) by simp
       then have IH:"Max (ff ` {s..n}) \<le> prod d {m + 1..n} * Max (ff ` {s..m})"
         using Suc(1) by linarith
       have "Max (ff ` {s..Suc n}) = Max (ff ` {s..n} \<union> {ff (Suc n)})"
         using Suc.prems assms(5) atLeastAtMostSuc_conv by auto
       also have "... = max (Max (ff ` {s..n})) (ff (Suc n))"
         using Suc.prems assms(5) max_def sup_assoc that by auto
       also have "... \<le> max (Max (ff ` {s..n})) (d (n+1) * Max (ff ` {s..n}))"
         apply (rule max.mono)
         using ff_asm[of n] \<open> m \<le> Suc n\<close> that \<open>s\<le>m\<close> by auto
       also have "... \<le> Max (ff ` {s..n}) * max 1 (d (n+1))"
       proof -
         have "Max (ff ` {s..n}) \<ge>0" 
           by (metis (mono_tags, hide_lams) Max_in \<open>\<And>j. 0 < ff j\<close> \<open>m \<le> n\<close> assms(5) 
               atLeastAtMost_iff empty_iff finite_atLeastAtMost finite_imageI imageE 
               image_is_empty less_eq_real_def)
         then show ?thesis using max_mult_distrib_right 
           by (simp add: max_mult_distrib_right mult.commute)
       qed
       also have "... = Max (ff ` {s..n}) * d (n+1)"
         using d[rule_format, of "n+1"] by auto
       also have "... \<le>  prod d {m + 1..n} * Max (ff ` {s..m}) * d (n+1)"
         using IH d[rule_format, of "n+1"] by auto
       also have "... = prod d {m + 1..n+1} * Max (ff ` {s..m})"
         using \<open>n\<ge>m\<close> by (simp add:prod.nat_ivl_Suc' algebra_simps)
       finally show ?case by simp
     qed
     ultimately show ?case by blast
   qed
   then have "d (n+1) * Max (ff ` {s..n} ) \<le> (\<Prod>j=(m+1)..(n+1). d j)* (Max (ff ` {s..m}))"
     using \<open>m\<le>n\<close> d[rule_format,of "Suc n"] by (simp add:prod.nat_ivl_Suc')
   then show ?thesis using ff_asm[of n] \<open>s\<le>m\<close> \<open>m\<le>n\<close> unfolding ff_def by auto
 qed
 
 lemma show9:
   fixes d ::"nat\<Rightarrow>real " and a :: "nat\<Rightarrow>int " and s ::nat and A::real
   assumes   "A > 1" and  d: "\<forall>n. d n> 1"  and a: "\<forall>n. a n>0" and "s>0"  
     and assu1: "(( \<lambda> n. (of_int (a n)) powr(1 /of_int (2^n)))\<longlongrightarrow> A) sequentially "
     and "convergent_prod d"
     and 8: "\<forall>n\<ge>s. prodinf (\<lambda>j. d( n+j)) 
                   < A/(Max ((\<lambda>(j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n})) "
   shows "\<forall>m \<ge>s. \<exists>n\<ge>m.  ( (of_int (a (n+1))) powr(1 /of_int (2^(n+1))) \<ge>
           (d (n+1))* (Max ( ( \<lambda> (j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n} )))"
 proof (rule ccontr)
   define ff where "ff = (\<lambda>(j::nat). (real_of_int (a j)) powr(1 /of_int (2^j)))"
   assume assumptioncontra: " \<not> (\<forall>m \<ge>s. \<exists>n\<ge>m.  ( (ff (n+1)) \<ge> (d (n+1))* (Max ( ff  ` {s..n}))))"
 
   then obtain  t where "t\<ge>s" and
     ttt: "  \<forall>n\<ge>t.  ( (ff (n+1)) < (d (n+1))* (Max ( ff ` {s..n} ) ))"               
     by fastforce
   define B where "B=prodinf (\<lambda>j. d(t+1+j))"
   have "B>0" unfolding B_def 
     apply (rule less_0_prodinf)
     subgoal using convergent_prod_iff_shift[of d "t+1"] \<open>convergent_prod d\<close> 
       by (auto simp:algebra_simps)
     subgoal using d le_less_trans zero_le_one by blast
     done
 
   have "A \<le> B * Max ( ff ` {s..t})"
   proof (rule tendsto_le[of sequentially "\<lambda>n. (\<Prod>j=(t+1)..(n+1). d j) * Max ( ff ` {s..t})" _ 
         "\<lambda>n. ff (n+1)"])
     show "(\<lambda>n. ff (n + 1)) \<longlonglongrightarrow> A"
       using assu1[folded ff_def] LIMSEQ_ignore_initial_segment by blast
     have "(\<lambda>n. prod d {t + 1..n + 1}) \<longlonglongrightarrow> B"
     proof -
       have "(\<lambda>n. \<Prod>i\<le>n. d (t + 1 + i)) \<longlonglongrightarrow> B"
         apply (rule convergent_prod_LIMSEQ[of "(\<lambda>j. d(t+1+j))",folded B_def])
         using \<open>convergent_prod d\<close> convergent_prod_iff_shift[of d "t+1"] by (simp add:algebra_simps)
       then have "(\<lambda>n. \<Prod>i\<in>{0..n}. d (i+(t + 1))) \<longlonglongrightarrow> B"
         using atLeast0AtMost by (auto simp:algebra_simps)
       then have "(\<lambda>n. prod d {(t + 1)..n + (t + 1)}) \<longlonglongrightarrow> B" 
         apply (subst (asm) prod.shift_bounds_cl_nat_ivl[symmetric])
         by simp
       from seq_offset_neg[OF this,of "t"]
       show "(\<lambda>n. prod d {t + 1..n+1}) \<longlonglongrightarrow> B"
         apply (elim Lim_transform)
         apply (rule LIMSEQ_I)
         apply (rule exI[where x="t+1"])
         by auto
     qed
     then show "(\<lambda>n. prod d {t + 1..n + 1} * Max (ff ` {s..t})) \<longlonglongrightarrow> B * Max (ff ` {s..t})" 
       by (auto intro:tendsto_eq_intros)
     have "\<forall>\<^sub>F n in sequentially. (ff (n+1)) < (\<Prod>j=(t+1)..(n+1). d j) * (Max ( ff ` {s..t}))"
       unfolding eventually_sequentially ff_def
       using auxiliary1_9[OF d a \<open>s>0\<close> _ \<open>t\<ge>s\<close> ttt[unfolded ff_def]]
       by blast
     then show "\<forall>\<^sub>F n in sequentially. (ff (n+1)) \<le> (\<Prod>j=(t+1)..(n+1). d j) * (Max ( ff ` {s..t}))"
       by (eventually_elim,simp)
   qed simp
   also have "... \<le> B * Max ( ff ` {s..t+1})"
   proof -
     have "Max (ff ` {s..t}) \<le> Max (ff ` {s..t + 1})"
       apply (rule Max_mono)
       using \<open>t\<ge>s\<close> by auto
     then show ?thesis using \<open>B>0\<close> by auto
   qed
   finally have "A \<le> B * Max (ff ` {s..t + 1})" 
     unfolding B_def .
   moreover have "B < A / Max (ff ` {s..t + 1})"
     using 8[rule_format, of "t+1",folded ff_def B_def] \<open>s\<le>t\<close> by auto
   moreover have "Max (ff ` {s..t+1})>0"
     using \<open>A \<le> B * Max (ff ` {s..t + 1})\<close> \<open>B>0\<close> \<open>A>1\<close>
       zero_less_mult_pos [of B "Max (ff ` {s..Suc t})"]
     by simp
   ultimately show False by (auto simp add:field_simps)
 qed
 
 lemma show10:
   fixes d ::"nat\<Rightarrow>real " and  a ::"nat\<Rightarrow>int " and s::nat
   assumes d: "\<forall>n. d n> 1" and a: "\<forall>n. a n>0"  and " s>0"
     and 9: "\<forall>m \<ge>s. \<exists>n\<ge>m.  ((of_int (a (n+1))) powr(1 /of_int (2^(n+1))) \<ge>
           (d (n+1))* (Max ((\<lambda>(j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n} )))"
   shows "\<forall>m\<ge>s. \<exists>n\<ge>m. (((d (n+1))powr(2^(n+1))) * (\<Prod>j=1..n. of_int( a j)) * 
             (1/ (\<Prod>j=1..s-1. (of_int( a j) )))) \<le> (a (n+1)) "
 proof (rule,rule)
   fix m assume "s \<le> m" 
   from 9[rule_format,OF this]
   obtain n where "n\<ge>m" and asm_9:"( (of_int (a (n+1))) powr(1 /of_int (2^(n+1))) \<ge>
           (d (n+1))* (Max ( ( \<lambda> (j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n} )))"
     by auto
   with \<open>s\<le>m\<close> have "s\<le>n" by auto
 
   have prod:"(\<Prod>j=1..n. real_of_int( a j)) * ( 1/ (\<Prod>j=1..s-1. (of_int( a j) )))
           = (\<Prod>j=s..n. of_int( a j))"
   proof -
     define f where "f= (\<lambda>j. real_of_int( a j))"
     have "{Suc 0..n}= {Suc 0..s - Suc 0} \<union> {s..n}" using \<open>n\<ge>s\<close>  \<open>s >0\<close>
       by auto
     then have "(\<Prod>j=1..n. f j) = (\<Prod>j=1..s-1. f j) * (\<Prod>j=s..n. f j)"
       apply (subst prod.union_disjoint[symmetric])
       by auto
     moreover have "(\<Prod>j=1..s-1. f j) > 0 "
       apply (rule linordered_semidom_class.prod_pos)
       using a unfolding f_def by auto
     then have "(\<Prod>j=1..s-1. f j) \<noteq> 0" by argo
     ultimately show ?thesis unfolding f_def by auto 
   qed
   then have " (((d (n+1))powr(2^(n+1) )) * (\<Prod>j=1..n. of_int( a j)) * ( 1/ (\<Prod>j=1..s-1. (of_int( a j) ))))
                 =(((d (n+1))powr(2^(n+1) )) * (\<Prod>j=s..n. of_int( a j)))" 
   proof -
     define f where "f= (\<lambda>j. real_of_int( a j))"
     define c where "c = (d (n+1))powr(2^(n+1))"
     show ?thesis using prod
       apply (fold f_def c_def)
       by (metis mult.assoc) 
   qed
   also have
     "... \<le> ((d (n+1))powr(2^(n+1) ) * (\<Prod>i=s..n. (Max(( \<lambda> (j::nat). ( of_int( a j) powr(1 /real_of_int (2^j)) )) ` {s..n  } ))   powr(2^i)) )"
   proof (rule mult_left_mono)
     show "0 \<le> (d (n + 1)) powr 2 ^ (n + 1)"
       by auto
     show "(\<Prod>j = s..n. real_of_int (a j))
     \<le> (\<Prod>i = s..n.
            Max ((\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) `
                 {s..n}) powr
            2 ^ i)"
     proof (rule prod_mono)
       fix i assume i: "i \<in> {s..n}"
       have "real_of_int (a i) = (real_of_int (a i) powr (1 / real_of_int (2 ^ i))) powr 2 ^ i"
         unfolding powr_powr by (simp add: a less_eq_real_def)
       also have  "\<dots> \<le>  (Max(( \<lambda> (j::nat). ( real_of_int( a j) powr(1 /real_of_int (2^j)))) ` {s..n}))powr(2^i)" 
       proof (rule powr_mono2)
         show "real_of_int (a i) powr (1 / real_of_int (2 ^ i))
                   \<le> Max ((\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) ` {s..n})" 
           apply (rule Max_ge)
            apply auto
           using i by blast
       qed simp_all
       finally have "real_of_int (a i) \<le> Max ((\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) ` {s..n}) powr 2 ^ i" .
       then show "0 \<le> real_of_int (a i) \<and>
          real_of_int (a i)
          \<le> Max ((\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) `
                  {s..n}) powr
             2 ^ i"
         using a i
         by (metis \<open>real_of_int (a i) = (real_of_int (a i) powr (1 / real_of_int (2 ^ i))) powr 2 ^ i\<close> 
             powr_ge_pzero)
     qed
   qed
   also have "... = ((d (n+1))powr(2^(n+1) )) * (Max(( \<lambda> (j::nat). ( of_int( a j) powr 
                       (1 /of_int (2^j)) )) ` {s..n  } )) powr (\<Sum>i=s..n. 2^i ) "
   proof-
     have  "((d (n+1))powr(2^(n+1) ))\<ge>1  "
       by (metis Transcendental.log_one  d le_powr_iff zero_le_numeral zero_le_power zero_less_one)
     moreover have "(\<Prod>i=s..n. (Max(( \<lambda> (j::nat). ( of_int( a j) powr(1 /real_of_int (2^j)) )) ` {s..n  } ) )   powr(2^i))     = (Max(( \<lambda> (j::nat). ( of_int( a j) powr(1 /of_int (2^j)) )) ` {s..n  } )) powr (\<Sum>i=s..n. 2^i )  "
     proof -
       define ff where "ff = Max (( \<lambda> (j::nat). ( of_int( a j) powr(1 /real_of_int (2^j)) )) ` {s..n  } )"
       show ?thesis apply (fold ff_def)
         using \<open>s\<le>n\<close>  powrfinitesum by auto
     qed 
     ultimately show ?thesis by auto
   qed
   also have "... \<le>   ((d (n+1))powr(2^(n+1) )) * 
                 (Max(( \<lambda> (j::nat).( of_int( a j) powr(1 /of_int (2^j)) )) ` {s..n  })) powr(2^(n+1))   "
 
   proof -
     define ff where "ff = Max (( \<lambda> (j::nat). ( of_int( a j) powr(1 /real_of_int (2^j)) )) ` {s..n  } )"
     have " sum ((^) 2) {s..n} < (2::real) ^ (n + 1)" using factt \<open>s\<le>n\<close>  by auto
     moreover have "1 \<le> ff" 
     proof -
       define S where "S=(\<lambda>(j::nat). ( of_int( a j) powr(1 /real_of_int (2^j)) )) ` {s..n  }"
       have "finite S" unfolding S_def by auto
       moreover have "S\<noteq>{}" unfolding S_def using \<open>s\<le>n\<close>  by auto
       moreover have "\<exists>x\<in>S. x\<ge>1"
       proof-
         have " ( of_int( a s) powr(1 /real_of_int (2^s)) ) \<ge> 1  "  
           apply (rule ge_one_powr_ge_zero)
            apply auto
           by (simp add: a int_one_le_iff_zero_less)
         moreover have " ( of_int( a s) powr(1 /real_of_int (2^s)) ) \<in> S" 
           unfolding S_def
           apply (rule rev_image_eqI[where x=s])
           using \<open>s\<le>n\<close> by auto
         ultimately show ?thesis by auto
       qed
       ultimately show ?thesis 
         using Max_ge_iff[of S 1] unfolding S_def ff_def by blast
     qed
     moreover have "0 \<le> (d (n + 1)) powr 2 ^ (n + 1)" by auto
     ultimately show ?thesis
       apply(fold ff_def)
       apply (rule mult_left_mono)
        apply (rule powr_mono)
       by auto
   qed
 
   also have "... =  ((d (n+1)) * 
                       (Max((\<lambda>j. (of_int( a j) powr(1 /of_int (2^j)))) ` {s..n}))) powr(2^(n+1))"
   proof -
     define ss where "ss = (\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) ` {s..n}"
     have "d (n + 1) \<ge>0" using d[rule_format,of "n+1"] by argo
     moreover have "Max ss \<ge>0" 
     proof -
       have "(a s) powr (1 /  (2 ^ s)) \<ge> 0" by auto
       moreover have "(a s) powr (1 /  (2 ^ s)) \<in> ss" unfolding ss_def 
         apply (rule_tac x=s in rev_image_eqI)
         using \<open>s\<le>n\<close> by auto
       moreover have "finite ss" "ss \<noteq> {}" unfolding ss_def using \<open>s\<le>n\<close> by auto
       ultimately show ?thesis using Max_ge_iff[of ss 0] by blast
     qed
     ultimately show ?thesis 
       apply (fold ss_def)
       using powr_mult by auto
   qed
   also have "... \<le> (real_of_int (a (n + 1)) powr (1 / real_of_int (2 ^ (n + 1)))) powr 2 ^ (n + 1)"
   proof - 
     define ss where "ss = (\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) ` {s..n}"
     show ?thesis 
     proof (fold ss_def,rule powr_mono2)
       have "Max ss \<ge>0" \<comment> \<open>NOTE: we are repeating the same proof, so it may be a good idea to put 
                             this conclusion in an outer block so that it can be reused 
                             (without reproving).\<close>
       proof -
         have "(a s) powr (1 /  (2 ^ s)) \<ge> 0" by auto
         moreover have "(a s) powr (1 /  (2 ^ s)) \<in> ss" unfolding ss_def 
           apply (rule_tac x=s in rev_image_eqI)
           using \<open>s\<le>n\<close> by auto
         moreover have "finite ss" "ss \<noteq> {}" unfolding ss_def using \<open>s\<le>n\<close> by auto
         ultimately show ?thesis using Max_ge_iff[of ss 0] by blast
       qed
       moreover have "d (n + 1) \<ge>0" 
         using d[rule_format,of "n+1"] by argo
       ultimately show "0 \<le> (d (n + 1)) * Max ss" by auto
       show "(d (n + 1)) * Max ss \<le> real_of_int (a (n + 1)) powr (1 / real_of_int (2 ^ (n + 1)))"
         using asm_9[folded ss_def] .
     qed simp    
   qed
   also have "... =  (of_int (a (n+1)))" 
     by (simp add: a less_eq_real_def pos_add_strict powr_powr)
   finally show "\<exists>n\<ge>m. d (n + 1) powr 2 ^ (n + 1) * (\<Prod>j = 1..n. real_of_int (a j)) *
                 (1 / (\<Prod>j = 1..s - 1. real_of_int (a j)))
                 \<le> real_of_int (a (n + 1))" using \<open>n\<ge>m\<close> \<open>m\<ge>s\<close> 
     apply (rule_tac x=n in exI)
     by auto
 qed
 
 lemma lasttoshow:
   fixes d ::"nat\<Rightarrow>real " and a b ::"nat\<Rightarrow>int " and q::int and s::nat
   assumes d: "\<forall>n. d n> 1" and a:"\<forall>n. a n>0" and "s>0" and "q>0"  
     and "A > 1" and b:"\<forall>n. b n>0" and 9:
     "\<forall>m\<ge>s. \<exists>n\<ge>m. ((of_int (a (n+1))) powr(1 /of_int (2^(n+1))) \<ge>
           (d (n+1))* (Max ((\<lambda>(j::nat). (of_int (a j)) powr(1 /of_int (2^j))) ` {s..n} )))"
     and assu3: "filterlim( \<lambda> n. (d n)^(2^n)/ b n) at_top sequentially "
     and 5: "\<forall>\<^sub>F n in sequentially. (\<Sum>j. (b (n + j)) /  (a (n + j))) \<le> 2 * b n / a n"
   shows "\<exists>n. q*((\<Prod>j=1..n. real_of_int(a j))) * suminf (\<lambda>(j::nat). (b (j+n+1)/ a (j+n+1)))<1"
 proof-
   define as where "as=(\<Prod>j = 1..s - 1. real_of_int (a j))"
   obtain n where "n\<ge>s" and n_def1:"real_of_int q * as * 2 
       * real_of_int (b (n + 1)) / d (n + 1) powr 2 ^ (n + 1) < 1"
     and n_def2:"d (n + 1) powr 2 ^ (n + 1) * (\<Prod>j = 1..n. real_of_int (a j)) * (1 / as) 
           \<le> real_of_int (a (n + 1))"
     and n_def3:"(\<Sum>j. (b (n+1 + j)) /  (a (n+1 + j))) \<le> 2 * b (n+1) / a (n+1)"
   proof -
     have *:"(\<lambda>n. real_of_int (b n) / d n ^ 2 ^ n) \<longlonglongrightarrow> 0"
       using tendsto_inverse_0_at_top[OF assu3] by auto
     then have "(\<lambda>n. real_of_int (b n) / d n powr 2 ^ n) \<longlonglongrightarrow> 0"
     proof -
       have "d n ^ 2 ^ n = d n powr (of_nat (2 ^ n))" for n 
         apply (subst powr_realpow)
         using d[rule_format, of n] by auto
       then show ?thesis using * by auto
     qed
     from tendsto_mult_right_zero[OF this,of "q * as * 2"] 
     have "(\<lambda>n. q * as * 2 * b n / d n powr 2 ^ n) \<longlonglongrightarrow> 0"
       by auto
     then have "\<forall>\<^sub>F n in sequentially. q * as * 2 * b n / d n powr 2 ^ n < 1"
       by (elim order_tendstoD) simp
     then have "\<forall>\<^sub>F n in sequentially. q * as * 2 * b n / d n powr 2 ^ n < 1 
                   \<and> (\<Sum>j. (b (n + j)) /  (a (n + j))) \<le> 2 * b n / a n"
       using 5 by eventually_elim auto
     then obtain N where N_def:"\<forall>n\<ge>N. q * as * 2 * b n / d n powr 2 ^ n < 1 
             \<and> (\<Sum>j. (b (n + j)) /  (a (n + j))) \<le> 2 * b n / a n"
       unfolding eventually_sequentially by auto
     obtain n where "n\<ge>s" and "n\<ge>N" and n_def:"d (n + 1) powr 2 ^ (n + 1) 
                 * (\<Prod>j = 1..n. of_int (a j)) * (1 / as) \<le> real_of_int (a (n + 1))"
       using show10[OF d a \<open>s>0\<close> 9,folded as_def,rule_format,of "max s N"] by auto
     with N_def[rule_format, of "n+1"] that[of n]  show ?thesis by auto
   qed
 
   define pa where "pa = (\<Prod>j = 1..n. real_of_int (a j))"
   define dn where "dn = d (n + 1) powr 2 ^ (n + 1)"
   have [simp]:"dn >0" "as > 0" 
     subgoal unfolding dn_def by (metis d not_le numeral_One powr_gt_zero zero_le_numeral)
     subgoal unfolding as_def by (simp add: a prod_pos)
     done
   have [simp]:"pa>0"
     unfolding pa_def using a by (simp add: prod_pos)
 
   have K: "q* (\<Prod>j=1..n. real_of_int (a j)) * suminf (\<lambda> (j::nat). (b (j+n+1)/ a (j+n+1)))
               \<le>q* (\<Prod>j=1..n. real_of_int (a j)) *2* (b (n+1))/(a( n+1))"
     apply (fold pa_def)
     using mult_left_mono[OF n_def3,of "real_of_int q * pa"] 
       \<open>n\<ge>s\<close> \<open>pa>0\<close> \<open>q>0\<close> by (auto simp add:algebra_simps) 
   also have KK:"... \<le> 2*q* (\<Prod>j=1..n. real_of_int (a j)) * (b(n+1))*
       ((\<Prod>j=1..s-1. real_of_int( a j))/((d (n+1))powr(2^(n+1)) * (\<Prod>j=1..n. real_of_int ( a j))))" 
   proof -
     have " dn * pa * (1 / as) \<le> real_of_int (a (n + 1))"
       using n_def2 unfolding dn_def pa_def .
     then show ?thesis 
       apply (fold pa_def dn_def as_def)
       using \<open>pa>0\<close> \<open>q>0\<close> a[rule_format, of "Suc n"] b[rule_format, of "Suc n"]
       by (auto simp add:divide_simps algebra_simps)
   qed
   also have KKK: "... = (q* ((\<Prod>j=1..(s-1). real_of_int( a j)))*2
                                 * (b (n+1)))/ ((d (n+1))powr(2^(n+1)))"
     apply (fold as_def pa_def dn_def)
     apply simp
     using \<open>0 < pa\<close> by blast
   also have KKKK: "... < 1" using n_def1 unfolding as_def by simp
   finally show ?thesis by auto
 qed
 
 lemma 
   fixes d ::"nat\<Rightarrow>real " and  a b ::"nat\<Rightarrow>int " and A::real
   assumes "A > 1" and d: "\<forall>n. d n> 1" and a: "\<forall>n. a n>0" and b:"\<forall>n. b n>0" 
     and assu1: "(( \<lambda> n. (of_int (a n)) powr(1 /of_int (2^n)))\<longlongrightarrow> A) sequentially "
     and assu3: "filterlim ( \<lambda> n. (d n)^(2^n)/ b n) at_top sequentially"
     and "convergent_prod d"
   shows issummable: "summable (\<lambda>j. b j / a j)"
     and show5: "\<forall>\<^sub>F n in sequentially. (\<Sum>j. (b (n + j)) / (a (n + j))) \<le> 2 * b n / a n"
 proof-
   define c where "c = (\<lambda>j. b j / a j)"
   have c_pos:"c j>0" for j 
     using a b unfolding c_def by simp
   have c_ratio_tendsto:"(\<lambda>n. c (n+1) / c n ) \<longlonglongrightarrow> 0"
   proof -
     define nn where "nn=(\<lambda>n. (2::int)^ (Suc n))"
     define ff where "ff=(\<lambda> n. (a n / a (Suc n)) powr(1 /nn n)*(d(Suc n)))"
     have nn_pos:"nn n>0" and ff_pos:"ff n>0" for n
       subgoal unfolding nn_def by simp
       subgoal unfolding ff_def
         using d[rule_format, of "Suc n"] a[rule_format, of n] a[rule_format, of "Suc n"]
         by auto
       done
     have ff_tendsto:"ff \<longlonglongrightarrow> 1/ sqrt A" 
     proof -
       have "(of_int (a n)) powr(1 / (nn n)) = sqrt(of_int (a n) powr(1 /of_int (2^n)))" for n
         unfolding nn_def using a
         by (simp add: powr_half_sqrt [symmetric] powr_powr ac_simps)
       moreover have "(( \<lambda> n. sqrt(of_int (a n) powr(1 /of_int (2^n))))\<longlongrightarrow> sqrt A) sequentially " 
         using assu1 tendsto_real_sqrt by blast
       ultimately have "(( \<lambda> n. (of_int (a n)) powr(1 /of_int (nn n)))\<longlongrightarrow> sqrt A) sequentially " 
         by auto
       from tendsto_divide[OF this assu1[THEN LIMSEQ_ignore_initial_segment[where k=1]]] 
       have "(\<lambda>n. (a n / a (Suc n)) powr(1 /nn n)) \<longlonglongrightarrow> 1/sqrt A"
         using \<open>A>1\<close> a unfolding nn_def
-        by (auto simp add:powr_divide inverse_eq_divide sqrt_divide_self_eq)
+        by (auto simp add:powr_divide less_imp_le inverse_eq_divide sqrt_divide_self_eq)
       moreover have "(\<lambda>n. d (Suc n))\<longlonglongrightarrow> 1" 
         apply (rule convergent_prod_imp_LIMSEQ)
         using convergent_prod_iff_shift[of d 1] \<open>convergent_prod d\<close> by auto
       ultimately show ?thesis
         unfolding ff_def by (auto intro:tendsto_eq_intros)
     qed
     have "(\<lambda>n. (ff n) powr nn n) \<longlonglongrightarrow> 0" 
     proof -
       define aa where "aa=(1+1/sqrt A) / 2"
       have "eventually (\<lambda>n. ff n<aa) sequentially"
         apply (rule order_tendstoD[OF ff_tendsto])
         unfolding aa_def using \<open>A>1\<close> by (auto simp add:field_simps)
       moreover have "(\<lambda>n. aa powr nn n) \<longlonglongrightarrow> 0" 
       proof -
         have "(\<lambda>y. aa ^ (nat \<circ> nn) y) \<longlonglongrightarrow> 0"
           apply (rule tendsto_power_zero)
           subgoal unfolding nn_def comp_def
             apply (rule filterlim_subseq)
             by (auto intro:strict_monoI)
           subgoal unfolding aa_def using \<open>A>1\<close> by auto
           done
         then show ?thesis
         proof (elim filterlim_mono_eventually)
           have "aa>0" unfolding aa_def using \<open>A>1\<close> 
             by  (auto simp add:field_simps pos_add_strict)
           then show " \<forall>\<^sub>F x in sequentially. aa ^ (nat \<circ> nn) x = aa powr real_of_int (nn x)"
             by (auto simp: powr_int order.strict_implies_order[OF nn_pos])
         qed auto
       qed
       ultimately show ?thesis
         apply (elim metric_tendsto_imp_tendsto)
         apply (auto intro!:powr_mono2 elim!:eventually_mono)
         using nn_pos ff_pos by (meson le_cases not_le)+
     qed
     then have "(\<lambda>n. (d (Suc n))^(nat (nn n)) * (a n / a (Suc n))) \<longlonglongrightarrow> 0" 
     proof (elim filterlim_mono_eventually)
       show "\<forall>\<^sub>F x in sequentially. ff x powr  (nn x) = d (Suc x) ^ nat (nn x) * (a x / a (Suc x))" 
         apply (rule eventuallyI)
         subgoal for x
           unfolding ff_def
           using a[rule_format,of x] a[rule_format,of "Suc x"] d[rule_format,of "Suc x"] nn_pos[of x]
           apply (auto simp add:field_simps powr_divide powr_powr powr_mult )
           by (simp add: powr_int)
         done
     qed auto 
     moreover have "(\<lambda>n. b (Suc n) / (d (Suc n))^(nat (nn n))) \<longlonglongrightarrow> 0"
       using tendsto_inverse_0_at_top[OF assu3,THEN LIMSEQ_ignore_initial_segment[where k=1]]
       unfolding nn_def by (auto simp add:field_simps nat_mult_distrib nat_power_eq)
     ultimately have "(\<lambda>n. b (Suc n) * (a n / a (Suc n))) \<longlonglongrightarrow> 0" 
       apply -
       subgoal premises asm
         using tendsto_mult[OF asm,simplified]
         apply (elim filterlim_mono_eventually)
         using d by (auto simp add:algebra_simps,metis (mono_tags, lifting) always_eventually 
             not_one_less_zero)
       done
     then have "(\<lambda>n. (b (Suc n) / b n) * (a n / a (Suc n))) \<longlonglongrightarrow> 0" 
       apply (elim Lim_transform_bound[rotated])
       apply (rule eventuallyI)
       subgoal for x using a[rule_format, of x] a[rule_format, of "Suc x"] 
           b[rule_format, of x] b[rule_format, of "Suc x"]
         by (auto simp add:field_simps)
       done
     then show ?thesis unfolding c_def by (auto simp add:algebra_simps)
   qed
   from c_ratio_tendsto
   have "(\<lambda>n. norm (b (Suc n) / a (Suc n)) / norm (b n / a n)) \<longlonglongrightarrow> 0" 
     unfolding c_def
     using a b by (force simp add:divide_simps abs_of_pos intro: Lim_transform_eventually)
   from summable_ratio_test_tendsto[OF _ _ this] a b 
   show "summable c" unfolding c_def
     apply auto 
     by (metis less_irrefl)
   have "\<forall>\<^sub>F n in sequentially. (\<Sum>j. c (n + j)) \<le> 2 * c n"
   proof -
     obtain N where N_ratio:"\<forall>n\<ge>N. c (n + 1) / c n < 1 / 2" 
     proof -
       have "eventually (\<lambda>n. c (n+1) / c n < 1/2) sequentially" 
         using c_ratio_tendsto[unfolded tendsto_iff,rule_format, of "1/2",simplified]
         apply eventually_elim
         subgoal for n using c_pos[of n] c_pos[of "Suc n"] by auto
         done
       then show ?thesis using that unfolding eventually_sequentially by auto
     qed
     have "(\<Sum>j. c (j + n)) \<le> 2 * c n" when "n\<ge>N" for n
     proof -
       have "(\<Sum>j<m. c (j + n)) \<le> 2*c n * (1 - 1 / 2^(m+1))" for m
       proof (induct m)
         case 0
         then show ?case using c_pos[of n] by simp
       next
         case (Suc m)
         have "(\<Sum>j<Suc m. c (j + n)) = c n + (\<Sum>i<m. c (Suc i + n)) "
           unfolding sum.lessThan_Suc_shift by simp
         also have "... \<le> c n + (\<Sum>i<m. c (i + n) / 2)"
         proof -
           have "c (Suc i + n) \<le> c (i + n) / 2" for i
             using N_ratio[rule_format,of "i+n"] \<open>n\<ge>N\<close> c_pos[of "i+n"]  by simp
           then show ?thesis by (auto intro:sum_mono)
         qed
         also have "... = c n + (\<Sum>i<m. c (i + n)) / 2"
           unfolding sum_divide_distrib by simp
         also have "... \<le> c n + c n * (1 - 1 / 2 ^ (m + 1))"
           using Suc by auto
         also have "... = 2 * c n * (1 - 1 / 2 ^ (Suc m + 1))"
           by (auto simp add:field_simps)
         finally show ?case .
       qed
       then have "(\<Sum>j<m. c (j + n)) \<le> 2*c n" for m
         using c_pos[of n] 
         by (smt divide_le_eq_1_pos divide_pos_pos nonzero_mult_div_cancel_left zero_less_power)
       moreover have "summable (\<lambda>j. c (j + n))" 
         using \<open>summable c\<close> by (simp add: summable_iff_shift)
       ultimately show ?thesis using suminf_le_const[of "\<lambda>j. c (j+n)" "2*c n"] by auto
     qed
     then show ?thesis unfolding eventually_sequentially by (auto simp add:algebra_simps)
   qed
   then show "\<forall>\<^sub>F n in sequentially. (\<Sum>j. (b (n + j)) /  (a (n + j))) \<le> 2 * b n / a n"
     unfolding c_def by simp
 qed
 
 
 theorem Hancl3:
   fixes d ::"nat\<Rightarrow>real " and  a b ::"nat\<Rightarrow>int "
   assumes "A > 1" and d:"\<forall>n. d n> 1" and a: "\<forall>n. a n>0" and b:"\<forall>n. b n>0" and "s>0"
     and assu1: "(( \<lambda> n. (of_int (a n)) powr(1 /of_int (2^n)))\<longlongrightarrow> A) sequentially "
     and assu2: "\<forall>n \<ge> s. (A/ (of_int (a n)) powr(1 /of_int (2^n)))> prodinf (\<lambda>j. d(n +j))"
     and assu3: "filterlim (\<lambda> n. (d n)^(2^n)/ b n) at_top sequentially"
     and "convergent_prod d" 
   shows "suminf(\<lambda> n. b n / a n ) \<notin> Rats"
 proof(rule ccontr)
   assume asm:"\<not> (suminf(\<lambda> n. b n / a n ) \<notin> Rats)"
   have ab_sum:"summable (\<lambda>j. b j / a j)"
     using issummable[OF \<open>A>1\<close> d a b assu1 assu3 \<open>convergent_prod d\<close>] .
   obtain p q ::int where "q>0" and pq_def:"(\<lambda> n. b (n+1) / a (n+1) ) sums (p/q)"
   proof -
     from asm have "suminf(\<lambda> n. b n / a n ) \<in> Rats" by auto
     then have "suminf(\<lambda> n. b (n+1) / a (n+1)) \<in> Rats" 
       apply (subst suminf_minus_initial_segment[OF ab_sum,of 1])
       by auto   
     then obtain p' q' ::int where "q'\<noteq>0" and pq_def:"(\<lambda> n. b (n+1) / a (n+1) ) sums (p'/q')"
       unfolding Rats_eq_int_div_int
       using summable_ignore_initial_segment[OF ab_sum,of 1,THEN summable_sums]
       by force
     define p q where "p=(if q'<0 then - p' else p')" and "q=(if q'<0 then - q' else q')"
     have "p'/q'=p/q" "q>0" using \<open>q'\<noteq>0\<close> unfolding p_def q_def by auto
     then show ?thesis using that[of q p] pq_def by auto
   qed
 
   define ALPHA where 
     "ALPHA = (\<lambda>n. (of_int q)*((\<Prod>j=1..n. of_int(a j)))*(suminf (\<lambda> (j::nat). 
                       (b (j+n+1)/a (j+n+1)))))"
   have "ALPHA n \<ge> 1" for n 
   proof -
     have "suminf(\<lambda> n. b (n+1) / a (n+1)) > 0"
       apply (rule suminf_pos)
       subgoal using summable_ignore_initial_segment[OF ab_sum,of 1] by auto
       subgoal using a b by simp
       done
     then have "p/q > 0" using sums_unique[OF pq_def,symmetric] by auto
     then have "q\<ge>1" "p\<ge>1" using \<open>q>0\<close> by (auto simp add:divide_simps)
     moreover have "\<forall>n. 1 \<le> a n" "\<forall>n. 1 \<le> b n" using a b 
       by (auto simp add: int_one_le_iff_zero_less)
     ultimately show ?thesis unfolding ALPHA_def
       using show7[OF _ _ _ _ pq_def] by auto
   qed
   moreover have "\<exists>n. ALPHA n < 1" unfolding ALPHA_def
   proof (rule lasttoshow[OF d a \<open>s>0\<close> \<open>q>0\<close> \<open>A>1\<close> b _ assu3])
     show "\<forall>\<^sub>F n in sequentially. (\<Sum>j. real_of_int (b (n + j)) / real_of_int (a (n + j)))
                     \<le> real_of_int (2 * b n) / real_of_int (a n)"
       using show5[OF \<open>A>1\<close> d a b assu1 assu3 \<open>convergent_prod d\<close>] by simp
     show "\<forall>m\<ge>s. \<exists>n\<ge>m. d (n + 1) * Max ((\<lambda>j. real_of_int (a j) powr (1 / real_of_int (2 ^ j))) ` {s..n})
                  \<le> real_of_int (a (n + 1)) powr (1 / real_of_int (2 ^ (n + 1)))"
       apply (rule show9[OF \<open>A>1\<close> d a \<open>s>0\<close> assu1 \<open>convergent_prod d\<close>])
       using show8[OF \<open>A>1\<close> d a \<open>s>0\<close> \<open>convergent_prod d\<close> assu2] by (simp add:algebra_simps)
   qed
   ultimately show False using not_le by blast
 qed
 
 corollary Hancl3corollary:
   fixes A::real and  a b ::"nat\<Rightarrow>int "
   assumes "A > 1" and a: "\<forall>n. a n>0" and b:"\<forall>n. b n>0"
     and assu1: "((\<lambda> n. (of_int (a n)) powr(1 /of_int (2^n)))\<longlongrightarrow> A) sequentially "
     and asscor2: "\<forall>n \<ge>6. (of_int (a n)) powr(1 /of_int (2^n ))*(1+ 4*(2/3)^n) \<le> A
                     \<and> (b n \<le>2 powr((4/3)^(n-1)) )   "
   shows "suminf(\<lambda> n. b n / a n ) \<notin> Rats"
 proof-
   define d::"nat\<Rightarrow>real" where "d= (\<lambda> n. 1+(2/3)^(n+1))" 
 
   have dgt1:"\<forall>n. 1 < d n " unfolding d_def by auto
   moreover have "convergent_prod d"
     unfolding d_def
     apply (rule abs_convergent_prod_imp_convergent_prod)
     apply (rule summable_imp_abs_convergent_prod)
     using summable_ignore_initial_segment[OF complete_algebra_summable_geometric
           [of "2/3::real",simplified],of 1] by simp
   moreover have "\<forall>n\<ge>6. (\<Prod>j. d (n + j)) 
                     < A / real_of_int (a n) powr (1 / real_of_int (2 ^ n))"
   proof rule+
     fix n::nat assume "6 \<le> n"
     have d_sum:"summable (\<lambda>j. ln (d j))" unfolding d_def
       apply (rule summable_ln_plus)
       apply (rule summable_ignore_initial_segment[OF complete_algebra_summable_geometric
           [of "2/3::real",simplified],of 1])
       by simp 
 
     have "(\<Sum>j. ln (d (n + j))) < ln (1+4 * (2 / 3) ^ n)"
     proof -
       define c::real where "c=(2 / 3) ^ n"
       have "0<c" "c<1/8" 
       proof -
         have "c=(2 / 3)^6 * (2 / 3)  ^ (n-6)"
           unfolding c_def using \<open>n\<ge>6\<close>
           apply (subst power_add[symmetric])
           by auto
         also have "... \<le> (2 / 3)^6" by (auto intro:power_le_one)
         also have "... < 1/8" by (auto simp add:field_simps)
         finally show "c<1/8" .
       qed (simp add:c_def)
 
       have "(\<Sum>j. ln (d (n + j))) \<le> (\<Sum>j. (2 / 3) ^ (n + j + 1))"
         apply (rule suminf_le)
         subgoal unfolding d_def 
           apply (intro allI ln_add_one_self_le_self2 )
           apply (rule order.strict_trans[of _ 0])
           by auto
         subgoal using summable_ignore_initial_segment[OF d_sum,of n] 
           by (auto simp add:algebra_simps)
         subgoal using summable_geometric[THEN summable_ignore_initial_segment,of "2/3" "n+1"]
           by (auto simp add:algebra_simps)
         done
       also have "... = (\<Sum>j. (2 / 3)^(n+1)*(2 / 3) ^ j)"
         by (auto simp add:algebra_simps power_add)
       also have "... = (2 / 3)^(n+1) * (\<Sum>j. (2 / 3) ^ j)"
         apply (rule suminf_mult)
         by (auto intro:summable_geometric)
       also have "... = 2 * c"
         unfolding c_def
         apply (subst suminf_geometric)
         by auto
       also have "... <  4 * c - (4 * c)\<^sup>2"
         using \<open>0<c\<close> \<open>c<1/8\<close>
         by (sos "((((A<0 * A<1) * R<1) + ((A<=0 * R<1) * (R<1/16 * [1]^2))))")
       also have "... \<le> ln (1 + 4 * c)"
         apply (rule ln_one_plus_pos_lower_bound)
         using \<open>0<c\<close> \<open>c<1/8\<close> by auto
       finally show ?thesis unfolding c_def by simp
     qed
     then have "exp (\<Sum>j. ln (d (n + j))) < 1 + 4 * (2 / 3) ^ n"
       by (metis Groups.mult_ac(2) add.right_neutral add_mono_thms_linordered_field(5) 
           divide_inverse divide_less_eq_numeral1(1) divide_pos_pos exp_gt_zero less_eq_real_def
           ln_exp ln_less_cancel_iff mult_zero_left rel_simps(27) rel_simps(76) zero_less_one
           zero_less_power)
     moreover have "exp (\<Sum>j. ln (d (n + j))) = (\<Prod>j. d (n + j))"
     proof (subst exp_suminf_prodinf_real [symmetric])
       show "\<And>k. 0 \<le> ln (d (n + k))" 
         using dgt1 by (simp add: less_imp_le)
       show "abs_convergent_prod (\<lambda>na. exp (ln (d (n + na))))"
         apply (subst exp_ln)
         subgoal for j using dgt1[rule_format,of "n+j"] by auto
         subgoal unfolding abs_convergent_prod_def real_norm_def
           apply (subst abs_of_nonneg)
           using convergent_prod_iff_shift[of d n] \<open>convergent_prod d\<close> 
           by (auto simp add: dgt1 less_imp_le algebra_simps)
         done
       show "(\<Prod>na. exp (ln (d (n + na)))) = (\<Prod>j. d (n + j))"
         apply (subst exp_ln)
         subgoal using dgt1 le_less_trans zero_le_one by blast
         subgoal by simp
         done
     qed
     ultimately have "(\<Prod>j. d (n + j))  < 1 + 4 * (2 / 3) ^ n"
       by simp
     also have "... \<le> A / (a n) powr (1 / of_int (2 ^ n))" 
     proof -
       have "a n powr (1 / real_of_int (2 ^ n)) > 0"
         using a[rule_format,of n] by auto
       then show ?thesis using asscor2[rule_format,OF \<open>6\<le>n\<close>] 
         by (auto simp add:field_simps)
     qed
     finally show "(\<Prod>j. d (n + j)) < A / real_of_int (a n) powr (1 / of_int (2 ^ n))" .
   qed
   moreover have "LIM n sequentially. d n ^ 2 ^ n / real_of_int (b n) :> at_top" 
   proof -
     have "LIM n sequentially. d n ^ 2 ^ n / 2 powr((4/3)^(n-1)) :> at_top"
     proof -
       define n1 where "n1=(\<lambda>n. (2::real)* (3/2)^(n-1))"
       define n2 where "n2=(\<lambda>n. ((4::real)/3)^(n-1))"
       have "LIM n sequentially. (((1+(8/9)/(n1 n)) powr (n1 n))/2) powr (n2 n) :> at_top" 
       proof (rule filterlim_at_top_powr_real[where g'="exp (8/9) / (2::real)"])
         define e1 where "e1=exp (8/9) / (2::real)"
         show "e1>1" unfolding e1_def by (approximation 4)
         show "(\<lambda>n. ((1+(8/9)/(n1 n)) powr (n1 n))/2) \<longlonglongrightarrow> e1"
         proof -
           have "(\<lambda>n. (1+(8/9)/(n1 n)) powr (n1 n)) \<longlonglongrightarrow> exp (8/9)"
             apply (rule filterlim_compose[OF tendsto_exp_limit_at_top])
             unfolding n1_def
             by (auto intro!: filterlim_tendsto_pos_mult_at_top 
                 filterlim_realpow_sequentially_at_top
                 simp:filterlim_sequentially_iff[of "\<lambda>x. (3 / 2) ^ (x - Suc 0)" _ 1])
           then show ?thesis unfolding e1_def
             by (intro tendsto_intros,auto)
         qed
         show "filterlim n2 at_top sequentially"
           unfolding n2_def
           apply (subst filterlim_sequentially_iff[of "\<lambda>n. (4 / 3) ^ (n - 1)" _ 1])
           by (auto intro:filterlim_realpow_sequentially_at_top)
       qed
       moreover have "\<forall>\<^sub>F n in sequentially. (((1+(8/9)/(n1 n)) powr (n1 n))/2) powr (n2 n)
         = d n ^ 2 ^ n / 2 powr((4/3)^(n-1))"
       proof (rule eventually_sequentiallyI[of 1])
         fix x assume "x\<ge>(1::nat)"
         have " ((1 + 8 / 9 / n1 x) powr n1 x / 2) powr n2 x 
                     = (((1 + 8 / 9 / n1 x) powr n1 x) powr n2 x) / 2 powr (4 / 3) ^ (x - 1)"
-          apply (subst powr_divide)
-            apply (simp_all add:n1_def n2_def)
-          by (smt divide_nonneg_nonneg zero_le_power)
+          by (simp add:n1_def n2_def powr_divide)
         also have "... = (1 + 8 / 9 / n1 x) powr (n1 x * n2 x) / 2 powr (4 / 3) ^ (x - 1)"
-          apply (subst powr_powr)
-          by simp
+          by (simp add: powr_powr)
         also have "... = (1 + 8 / 9 / n1 x) powr (2 ^ x) / 2 powr (4 / 3) ^ (x - 1)"
         proof -
           have "n1 x * n2 x = 2 ^ x" 
             unfolding n1_def n2_def
             apply (subst mult.assoc)
             apply (subst power_mult_distrib[symmetric])
-            using \<open>x\<ge>1\<close> by (auto simp add:power_Suc[symmetric] simp del:power_Suc)
+            using \<open>x\<ge>1\<close> by (auto simp flip:power_Suc)
           then show ?thesis by simp
         qed
         also have "... = (1 + 8 / 9 / n1 x) ^ (2 ^ x) / 2 powr (4 / 3) ^ (x - 1)"
           apply (subst (3) powr_realpow[symmetric])
            apply (simp_all add: n1_def)
           by (smt zero_le_divide_iff zero_le_power)
         also have "... = d x ^ 2 ^ x / 2 powr (4 / 3) ^ (x - 1)"
         proof -
           define x1 where "x1=x-1"
           have *:"x=x1+1" unfolding x1_def using \<open>x\<ge>1\<close> by simp
           have **: "8 / 9 / n1 x = (2 / 3) ^ (x + 1)" 
             unfolding n1_def using \<open>x\<ge>1\<close>
             apply (fold x1_def *[symmetric])
             by (auto simp add:divide_simps)
           then show ?thesis 
             unfolding d_def 
             apply (subst **)
             by auto
         qed
         finally show "((1 + 8 / 9 / n1 x) powr n1 x / 2) powr n2 x 
                         = d x ^ 2 ^ x / 2 powr (4 / 3) ^ (x - 1) " .
       qed
       ultimately show ?thesis using filterlim_cong by fast
     qed
     moreover have "\<forall>\<^sub>F n in sequentially. d n ^ 2 ^ n / 2 powr((4/3)^(n-1)) 
         \<le> d n ^ 2 ^ n / real_of_int (b n)"
       apply (rule eventually_sequentiallyI[of 6])
       apply (rule divide_left_mono)
       subgoal for x
         using asscor2[rule_format,of x] by auto
       subgoal for x
         using \<open>\<forall>n. 1 < d n\<close>[rule_format, of x] by auto
       subgoal for x
         using b by auto
       done
     ultimately show ?thesis by (auto elim: filterlim_at_top_mono)
   qed
   ultimately show ?thesis using Hancl3[OF \<open>A>1\<close> _ a b _ assu1,of d 6] by force
 qed
 
 end
diff --git a/thys/QHLProver/Matrix_Limit.thy b/thys/QHLProver/Matrix_Limit.thy
--- a/thys/QHLProver/Matrix_Limit.thy
+++ b/thys/QHLProver/Matrix_Limit.thy
@@ -1,1769 +1,1769 @@
 section \<open>Matrix limits\<close>
 
 theory Matrix_Limit
   imports Complex_Matrix
 begin
 
 subsection \<open>Definition of limit of matrices\<close>
 
 definition limit_mat :: "(nat \<Rightarrow> complex mat) \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> bool" where
   "limit_mat X A m \<longleftrightarrow> (\<forall> n. X n \<in> carrier_mat m m \<and> A \<in> carrier_mat m m \<and>
                        (\<forall> i < m. \<forall> j < m. (\<lambda> n. (X n) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))))"
 
 lemma limit_mat_unique:
   assumes limA: "limit_mat X A m" and limB: "limit_mat X B m"
   shows "A = B"
 proof -
   have dim: "A \<in> carrier_mat m m" "B \<in> carrier_mat m m" using limA limB limit_mat_def by auto
   {
     fix i j assume i: "i < m" and j: "j < m"
     have "(\<lambda> n. (X n) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))" using limit_mat_def limA i j by auto
     moreover have "(\<lambda> n. (X n) $$ (i, j)) \<longlonglongrightarrow> (B $$ (i, j))" using limit_mat_def limB i j by auto
     ultimately have "(A $$ (i, j)) = (B $$ (i, j))" using LIMSEQ_unique by auto
   }
   then show "A = B" using mat_eq_iff dim by auto
 qed
 
 lemma limit_mat_const:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat m m"
   shows "limit_mat (\<lambda>k. A) A m"
   unfolding limit_mat_def using assms by auto
 
 lemma limit_mat_scale:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat"
   assumes limX: "limit_mat X A m"
   shows "limit_mat (\<lambda>n. c \<cdot>\<^sub>m X n) (c \<cdot>\<^sub>m A) m"
 proof -
   have dimA: "A \<in> carrier_mat m m" using limX limit_mat_def by auto
   have dimX: "\<And>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have "\<And>i j. i < m \<Longrightarrow> j < m \<Longrightarrow> (\<lambda>n. (c \<cdot>\<^sub>m X n) $$ (i, j)) \<longlonglongrightarrow> (c \<cdot>\<^sub>m A) $$ (i, j)"
   proof -
     fix i j assume i: "i < m" and j: "j < m"
     have "(\<lambda>n. (X n) $$ (i, j)) \<longlonglongrightarrow> A$$(i, j)" using limX limit_mat_def i j by auto
     moreover have "(\<lambda>n. c) \<longlonglongrightarrow> c" by auto
     ultimately have "(\<lambda>n. c * (X n) $$ (i, j)) \<longlonglongrightarrow> c * A$$(i, j)"
       using tendsto_mult[of "\<lambda>n. c" c] limX limit_mat_def by auto
     moreover have "(c \<cdot>\<^sub>m X n) $$ (i, j) = c * (X n) $$ (i, j)" for n
       using index_smult_mat(1)[of i "X n" j c] i j dimX[of n] by auto
     moreover have "(c \<cdot>\<^sub>m A) $$ (i, j) = c * A $$ (i, j)"
       using index_smult_mat(1)[of i "A" j c] i j dimA by auto
     ultimately show "(\<lambda>n. (c \<cdot>\<^sub>m X n) $$ (i, j)) \<longlonglongrightarrow> (c \<cdot>\<^sub>m A) $$ (i, j)" by auto
   qed
   then show ?thesis unfolding limit_mat_def using dimA dimX by auto
 qed
 
 lemma limit_mat_add:
   fixes X :: "nat \<Rightarrow> complex mat" and Y :: "nat \<Rightarrow> complex mat" and A :: "complex mat"
     and m :: nat and B :: "complex mat"
   assumes limX: "limit_mat X A m" and limY: "limit_mat Y B m"
   shows "limit_mat (\<lambda>k. X k + Y k) (A + B) m"
 proof -
   have dimA: "A \<in> carrier_mat m m" using limX limit_mat_def by auto
   have dimB: "B \<in> carrier_mat m m" using limY limit_mat_def by auto
   have dimX: "\<And>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have dimY: "\<And>n. Y n \<in> carrier_mat m m" using limY unfolding limit_mat_def by auto
   then have dimXAB: "\<forall>n. X n + Y n \<in> carrier_mat m m \<and> A + B \<in> carrier_mat m m" using dimA dimB dimX dimY
     by (simp)
 
   have "(\<And>i j. i < m \<Longrightarrow> j < m \<Longrightarrow> (\<lambda>n. (X n + Y n) $$ (i, j)) \<longlonglongrightarrow> (A + B) $$ (i, j))"
   proof -
     fix i j assume i: "i < m" and j: "j < m"
     have "(\<lambda>n. (X n) $$ (i, j)) \<longlonglongrightarrow> A$$(i, j)" using limX limit_mat_def i j by auto
     moreover have "(\<lambda>n. (Y n) $$ (i, j)) \<longlonglongrightarrow> B$$(i, j)" using limY limit_mat_def i j by auto
     ultimately have "(\<lambda>n. (X n)$$(i, j) + (Y n) $$ (i, j)) \<longlonglongrightarrow> (A$$(i, j) + B$$(i, j))"
       using tendsto_add[of "\<lambda>n. (X n) $$ (i, j)" "A $$ (i, j)"] by auto
     moreover have "(X n + Y n) $$ (i, j) = (X n)$$(i, j) + (Y n) $$ (i, j)" for n
       using i j dimX dimY index_add_mat(1)[of i "Y n" j "X n"] by fastforce
     moreover have "(A + B) $$ (i, j) = A$$(i, j) + B$$(i, j)"
       using i j dimA dimB by fastforce
     ultimately show "(\<lambda>n. (X n + Y n) $$ (i, j)) \<longlonglongrightarrow> (A + B) $$ (i, j)" by auto
   qed
   then show ?thesis
     unfolding limit_mat_def using dimXAB by auto
 qed
 
 lemma limit_mat_minus:
   fixes X :: "nat \<Rightarrow> complex mat" and Y :: "nat \<Rightarrow> complex mat" and A :: "complex mat"
     and m :: nat and B :: "complex mat"
   assumes limX: "limit_mat X A m" and limY: "limit_mat Y B m"
   shows "limit_mat (\<lambda>k. X k - Y k) (A - B) m"
 proof -
   have dimA: "A \<in> carrier_mat m m" using limX limit_mat_def by auto
   have dimB: "B \<in> carrier_mat m m" using limY limit_mat_def by auto
   have dimX: "\<And>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have dimY: "\<And>n. Y n \<in> carrier_mat m m" using limY unfolding limit_mat_def by auto
   have "-1 \<cdot>\<^sub>m Y n = - Y n" for n using dimY by auto
   moreover have "-1 \<cdot>\<^sub>m B = - B" using dimB by auto
   ultimately have "limit_mat (\<lambda>n. - Y n) (- B) m" using limit_mat_scale[OF limY, of "-1"] by auto
   then have "limit_mat (\<lambda>n. X n + (- Y n)) (A + (- B)) m" using limit_mat_add limX by auto
   moreover have "X n + (- Y n) = X n - Y n" for n using dimX dimY by auto
   moreover have "A + (- B) = A - B" by auto
   ultimately show ?thesis by auto
 qed
 
 lemma limit_mat_mult:
   fixes X :: "nat \<Rightarrow> complex mat" and Y :: "nat \<Rightarrow> complex mat" and A :: "complex mat"
     and m :: nat and B :: "complex mat"
   assumes limX: "limit_mat X A m" and limY: "limit_mat Y B m"
   shows "limit_mat (\<lambda>k. X k * Y k) (A * B) m"
 proof -
   have dimA: "A \<in> carrier_mat m m" using limX limit_mat_def by auto
   have dimB: "B \<in> carrier_mat m m" using limY limit_mat_def by auto
   have dimX: "\<And>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have dimY: "\<And>n. Y n \<in> carrier_mat m m" using limY unfolding limit_mat_def by auto
   then have dimXAB: "\<forall>n. X n * Y n \<in> carrier_mat m m \<and> A * B \<in> carrier_mat m m" using dimA dimB dimX dimY
     by fastforce
 
   have "(\<And>i j. i < m \<Longrightarrow> j < m \<Longrightarrow> (\<lambda>n. (X n * Y n) $$ (i, j)) \<longlonglongrightarrow> (A * B) $$ (i, j))"
   proof -
     fix i j assume i: "i < m" and j: "j < m"
     have eqn: "(X n * Y n) $$ (i, j) = (\<Sum>k=0..<m. (X n)$$(i, k) * (Y n)$$(k, j))" for n
       using i j dimX[of n] dimY[of n] by (auto simp add: scalar_prod_def)
     have eq: "(A * B) $$ (i, j) = (\<Sum>k=0..<m. A$$(i,k) * B$$(k,j))"
       using i j dimB dimA by (auto simp add: scalar_prod_def)
     have "(\<lambda>n. (X n) $$ (i, k)) \<longlonglongrightarrow> A$$(i, k)" if "k < m" for k using limX limit_mat_def that i by auto
     moreover have "(\<lambda>n. (Y n) $$ (k, j)) \<longlonglongrightarrow> B$$(k, j)" if "k < m" for k using limY limit_mat_def that j by auto
     ultimately have "(\<lambda>n. (X n)$$(i, k) * (Y n)$$(k,j)) \<longlonglongrightarrow> A$$(i, k) * B$$(k, j)" if "k < m" for k
       using tendsto_mult[of "\<lambda>n. (X n) $$ (i, k)" "A$$(i, k)" _ "\<lambda>n. (Y n)$$(k, j)" "B$$(k, j)"] that by auto
     then have "(\<lambda>n. (\<Sum>k=0..<m. (X n)$$(i,k) * (Y n)$$(k,j))) \<longlonglongrightarrow> (\<Sum>k=0..<m. A$$(i,k) * B$$(k,j))"
       using tendsto_sum[of "{0..<m}" "\<lambda>k n. (X n)$$(i,k) * (Y n)$$(k,j)" "\<lambda>k. A$$(i, k) * B$$(k, j)"] by auto
     then show "(\<lambda>n. (X n * Y n) $$ (i, j)) \<longlonglongrightarrow> (A * B) $$ (i, j)" using eqn eq by auto
   qed
   then show ?thesis
     unfolding limit_mat_def using dimXAB by fastforce
 qed
 
 text \<open>Adding matrix A to the sequence X\<close>
 definition mat_add_seq ::  "complex mat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> nat \<Rightarrow> complex mat" where
   "mat_add_seq A X = (\<lambda>n. A + X n)"
 
 lemma mat_add_limit:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat"
   assumes dimB: "B \<in> carrier_mat m m" and limX: "limit_mat X A m"
   shows "limit_mat (mat_add_seq B X) (B + A) m"
   unfolding mat_add_seq_def using limit_mat_add limit_mat_const[OF dimB] limX by auto
 
 lemma mat_minus_limit:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat"
   assumes dimB: "B \<in> carrier_mat m m" and limX: "limit_mat X A m"
   shows "limit_mat (\<lambda>n. B - X n) (B - A) m"
   using limit_mat_minus limit_mat_const[OF dimB] limX by auto
 
 text \<open>Multiply matrix A by the sequence X\<close>
 definition mat_mult_seq ::  "complex mat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> nat \<Rightarrow> complex mat" where
   "mat_mult_seq A X = (\<lambda>n. A * X n)"
 
 lemma mat_mult_limit:
   fixes X :: "nat \<Rightarrow> complex mat" and A B :: "complex mat" and m :: nat
   assumes dimB: "B \<in> carrier_mat m m" and limX: "limit_mat X A m"
   shows "limit_mat (mat_mult_seq B X) (B * A) m"
   unfolding mat_mult_seq_def using limit_mat_mult limit_mat_const[OF dimB] limX by auto
 
 lemma mult_mat_limit:
   fixes X :: "nat \<Rightarrow> complex mat" and A B :: "complex mat" and m :: nat
   assumes dimB: "B \<in> carrier_mat m m" and limX: "limit_mat X A m"
   shows "limit_mat (\<lambda>k. X k * B) (A * B) m"
   unfolding mat_mult_seq_def using limit_mat_mult limit_mat_const[OF dimB] limX by auto
 
 lemma quadratic_form_mat:
   fixes A :: "complex mat" and v :: "complex vec" and m :: nat
   assumes dimv: "dim_vec v = m" and dimA: "A \<in> carrier_mat m m"
   shows "inner_prod v (A *\<^sub>v v) = (\<Sum>i=0..<m. (\<Sum>j=0..<m. conjugate (v$i) * A$$(i, j) * v$j))"
 proof -
   have  "inner_prod v (A *\<^sub>v v) = (\<Sum>i=0..<m. (\<Sum>j=0..<m.
                 conjugate (v$i) * A$$(i, j) * v$j))"
   unfolding scalar_prod_def using dimv dimA
     apply (simp add: scalar_prod_def sum_distrib_right)
     apply (rule sum.cong, auto, rule sum.cong, auto)
   done
   then show ?thesis by auto
 qed
 
 lemma sum_subtractff:
   fixes h g :: "nat \<Rightarrow> nat \<Rightarrow>'a::ab_group_add"
   shows "(\<Sum>x\<in>A. \<Sum>y\<in>B. h x y - g x y) = (\<Sum>x\<in>A. \<Sum>y\<in>B. h x y) - (\<Sum>x\<in>A. \<Sum>y\<in>B. g x y)"
 proof -
   have "\<forall> x \<in> A. (\<Sum>y\<in>B. h x y - g x y) = (\<Sum>y\<in>B. h x y) - (\<Sum>y\<in>B. g x y)"
   proof -
     {
       fix x assume x: "x \<in> A"
       have "(\<Sum>y\<in>B. h x y - g x y) = (\<Sum>y\<in>B. h x y) - (\<Sum>y\<in>B. g x y)"
         using sum_subtractf by auto
      }
     then show ?thesis  using sum_subtractf by blast
   qed
   then have "(\<Sum>x\<in>A.\<Sum>y\<in>B. h x y - g x y) = (\<Sum>x\<in>A. ((\<Sum>y\<in>B. h x y) - (\<Sum>y\<in>B. g x y)))" by auto
   also have "\<dots> = (\<Sum>x\<in>A. \<Sum>y\<in>B. h x y) - (\<Sum>x\<in>A. \<Sum>y\<in>B. g x y)"
     by (simp add: sum_subtractf)
   finally have " (\<Sum>x\<in>A. \<Sum>y\<in>B. h x y - g x y) = (\<Sum>x\<in>A. sum (h x) B) - (\<Sum>x\<in>A. sum (g x) B)" by auto
   then show ?thesis by auto
 qed
 
 lemma sum_abs_complex:
   fixes h  :: "nat \<Rightarrow> nat \<Rightarrow> complex"
   shows "cmod (\<Sum>x\<in>A.\<Sum>y\<in>B. h x y) \<le> (\<Sum>x\<in>A. \<Sum>y\<in>B. cmod(h x y))"
 proof -
   have B: "\<forall> x \<in> A. cmod( \<Sum>y\<in>B .h x y) \<le> (\<Sum>y\<in>B. cmod(h x y))" using sum_abs norm_sum by blast
   have "cmod (\<Sum>x\<in>A.\<Sum>y\<in>B. h x y) \<le> (\<Sum>x\<in>A.  cmod( \<Sum>y\<in>B .h x y))" using sum_abs norm_sum by blast
   also have "\<dots> \<le> (\<Sum>x\<in>A. \<Sum>y\<in>B. cmod(h x y))" using sum_abs norm_sum B
     by (simp add: sum_mono)
   finally have "cmod (\<Sum>x\<in>A. \<Sum>y\<in>B. h x y) \<le> (\<Sum>x\<in>A. \<Sum>y\<in>B. cmod (h x y))" by auto
   then show ?thesis by auto
 qed
 
 lemma hermitian_mat_lim_is_hermitian:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat
   assumes limX: "limit_mat X A m" and herX: "\<forall> n. hermitian (X n)"
   shows "hermitian A"
 proof -
   have  dimX: "\<forall>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have dimA : "A \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
 
   from herX have herXn: "\<forall> n. adjoint (X n) = (X n)" unfolding hermitian_def by auto
   from limX have limXn: "\<forall>i<m. \<forall>j<m. (\<lambda>n. X n $$ (i, j)) \<longlonglongrightarrow> A $$ (i, j)" unfolding limit_mat_def by auto
   have "\<forall>i<m. \<forall>j<m.(adjoint A)$$ (i, j) = A$$ (i, j)"
   proof -
     {
       fix i j assume i: "i < m" and j: "j < m"
       have aij: "(adjoint A)$$ (i, j) = conjugate (A $$ (j,i))" using adjoint_eval i j dimA by blast
       have ij: "(\<lambda>n. X n $$ (i, j)) \<longlonglongrightarrow> A $$ (i, j)" using limXn i j by auto
       have ji: "(\<lambda>n. X n $$ (j, i)) \<longlonglongrightarrow> A $$ (j, i)" using limXn i j by auto
       then have "\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (conjugate (X n $$ (j, i))) (conjugate (A $$ (j, i))) < r"
       proof -
         {
           fix r :: real assume r : "r > 0"
           have "\<exists>no. \<forall>n\<ge>no. cmod (X n $$ (j, i) - A $$ (j, i)) < r" using ji r unfolding  LIMSEQ_def dist_norm by auto
           then obtain no where Xji: "\<forall>n\<ge>no. cmod (X n $$ (j, i) - A $$ (j, i)) < r" by auto
           then have "\<forall>n\<ge>no. cmod (conjugate (X n $$ (j, i) - A $$ (j, i))) < r"
             using complex_mod_cnj conjugate_complex_def by presburger
           then have "\<forall>n\<ge>no. dist (conjugate (X n $$ (j, i))) (conjugate (A $$ (j, i))) < r" unfolding dist_norm by auto
           then have "\<exists>no. \<forall>n\<ge>no. dist (conjugate (X n $$ (j, i))) (conjugate (A $$ (j, i))) < r" by auto
         }
         then show ?thesis by auto
       qed
       then have conjX: "(\<lambda>n. conjugate (X n $$ (j, i))) \<longlonglongrightarrow>  conjugate (A $$ (j, i))" unfolding LIMSEQ_def by auto
 
       from herXn have "\<forall> n. conjugate (X n $$ (j,i)) = X n$$ (i, j)"  using adjoint_eval i j dimX
         by (metis adjoint_dim_col carrier_matD(1))
       then have "(\<lambda>n. X n $$ (i, j)) \<longlonglongrightarrow>  conjugate (A $$ (j, i))" using conjX by auto
       then have "conjugate (A $$ (j,i)) = A$$ (i, j)" using ij by (simp add: LIMSEQ_unique)
       then have "(adjoint A)$$ (i, j) = A$$ (i, j)" using adjoint_eval i j by (simp add:aij)
     }
     then show ?thesis by auto
   qed
   then have "hermitian A" using hermitian_def dimA
     by (metis adjoint_dim carrier_matD(1) carrier_matD(2) eq_matI)
   then show ?thesis by auto
 qed
 
 lemma quantifier_change_order_once:
   fixes P :: "nat \<Rightarrow> nat \<Rightarrow> bool" and m :: nat
   shows "\<forall>j<m. \<exists>no. \<forall>n\<ge>no. P n j \<Longrightarrow> \<exists>no. \<forall>j<m. \<forall>n\<ge>no. P n j"
 proof (induct m)
     case 0
     then show ?case by auto
   next
     case (Suc m)
     then show ?case
     proof -
       have mm: "\<exists>no. \<forall>j<m. \<forall>n\<ge>no. P n j" using Suc by auto
       then obtain M where MM: "\<forall>j<m. \<forall>n\<ge>M. P n j" by auto
       have sucm: "\<exists>no. \<forall>n\<ge>no. P n m" using Suc(2) by auto
       then obtain N where NN: "\<forall>n\<ge>N. P n m" by auto
       let ?N = "max M N"
       from MM NN have "\<forall>j<Suc m. \<forall>n\<ge>?N. P n j"
         by (metis less_antisym max.boundedE)
       then have "\<exists>no. \<forall>j<Suc m. \<forall>n\<ge>no. P n j" by blast
       then show ?thesis by auto
     qed
   qed
 
 lemma quantifier_change_order_twice:
   fixes P :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" and m n :: nat
   shows "\<forall>i<m. \<forall>j<n. \<exists> no. \<forall>n\<ge>no. P n i j \<Longrightarrow> \<exists>no. \<forall>i<m. \<forall>j<n. \<forall>n\<ge>no. P n i j"
 proof -
   assume fact: "\<forall>i<m. \<forall>j<n. \<exists> no. \<forall>n\<ge>no. P n i j"
   have one: "\<forall>i<m. \<exists>no.\<forall>j<n. \<forall>n\<ge>no. P n i j"
     using fact quantifier_change_order_once by auto
   have two: "\<forall>i<m. \<exists>no.\<forall>j<n. \<forall>n\<ge>no. P n i j \<Longrightarrow> \<exists>no. \<forall>i<m. \<forall>j<n. \<forall>n\<ge>no. P n i j"
   proof (induct m)
     case 0
     then show ?case by auto
   next
     case (Suc m)
     then show ?case
     proof -
       obtain M where MM: "\<forall>i<m. \<forall>j<n. \<forall>n\<ge>M. P n i j" using Suc by auto
       obtain N where NN: "\<forall>j<n. \<forall>n\<ge>N. P n m j" using Suc(2) by blast
       let ?N = "max M N"
       from MM NN have "\<forall>i<Suc m. \<forall>j<n. \<forall>n\<ge>?N. P n i j"
         by (metis less_antisym max.boundedE)
       then have "\<exists>no. \<forall>i<Suc m. \<forall>j<n. \<forall>n\<ge>no. P n i j" by blast
       then show ?thesis by auto
     qed
   qed
   with fact show ?thesis using one by auto
 qed
 
 lemma pos_mat_lim_is_pos:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat
   assumes limX: "limit_mat X A m" and posX: "\<forall>n. positive (X n)"
   shows "positive A"
 proof (rule ccontr)
   have  dimX : "\<forall>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have dimA : "A \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   have herX : "\<forall> n. hermitian (X n)" using posX positive_is_hermitian by auto
   then have herA : "hermitian A"  using hermitian_mat_lim_is_hermitian limX by auto
   then have herprod: "\<forall> v. dim_vec v = dim_col A \<longrightarrow> inner_prod v (A *\<^sub>v v) \<in> Reals"
     using hermitian_inner_prod_real dimA by auto
 
   assume npA: " \<not> positive A"
   from npA have "\<not> (A \<in> carrier_mat (dim_col A) (dim_col A)) \<or> \<not> (\<forall>v. dim_vec v = dim_col A \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v))"
     unfolding positive_def by blast
   then have evA: "\<exists> v. dim_vec v = dim_col A \<and> \<not> inner_prod v (A *\<^sub>v v) \<ge> 0" using dimA by blast
   then have "\<exists> v. dim_vec v = dim_col A \<and>  inner_prod v (A *\<^sub>v v) < 0"
   proof -
     obtain v where vA: "dim_vec v = dim_col A \<and> \<not> inner_prod v (A *\<^sub>v v) \<ge> 0" using evA by auto
     from vA herprod have "\<not> 0 \<le> inner_prod v (A *\<^sub>v v) \<and> inner_prod v (A *\<^sub>v v) \<in> Reals" by auto
     then have "inner_prod v (A *\<^sub>v v) < 0"
       using complex_is_Real_iff by auto
     then have  "\<exists> v. dim_vec v = dim_col A \<and>  inner_prod v (A *\<^sub>v v) < 0" using vA by auto
     then show ?thesis by auto
   qed
 
   then obtain v where neg: "dim_vec v = dim_col A \<and> inner_prod v (A *\<^sub>v v) < 0" by auto
 
   have   nzero: "v \<noteq> 0\<^sub>v m"
   proof (rule ccontr)
     assume nega: " \<not> v \<noteq> 0\<^sub>v m"
     have zero: "v = 0\<^sub>v m" using nega by auto
     have "(A *\<^sub>v v) = 0\<^sub>v m" unfolding mult_mat_vec_def using zero
       using dimA by auto
     then have zerov: "inner_prod v (A *\<^sub>v v) = 0" by (simp add: zero)
     from neg zerov have "\<not> v \<noteq> 0\<^sub>v m \<Longrightarrow> False"  using dimA by auto
     with nega show False by auto
   qed
 
   have invgeq: "inner_prod v v > 0"
   proof -
     have "inner_prod v v = vec_norm v * vec_norm v" unfolding vec_norm_def
       by (metis carrier_matD(2) carrier_vec_dim_vec dimA mult_cancel_left1 neg normalized_cscalar_prod normalized_vec_norm nzero vec_norm_def)
     moreover have "vec_norm v > 0" using nzero vec_norm_ge_0 neg dimA
       by (metis carrier_matD(2) carrier_vec_dim_vec)
     ultimately have "inner_prod v v > 0" by auto
     then show ?thesis by auto
   qed
 
   have invv: "inner_prod v v = (\<Sum>i = 0..<m. cmod (conjugate (v $ i) * (v $ i)))"
   proof -
     {
       have "\<forall> i < m. conjugate (v $ i) * (v $ i) \<ge> 0" using conjugate_square_smaller_0 by simp
       then have vi: "\<forall> i < m. conjugate (v $ i) * (v $ i) = cmod (conjugate (v $ i) * (v $ i))" using cmod_eq_Re
         by (simp add: complex.expand)
 
       have "inner_prod v v= (\<Sum>i = 0..<m. ((v $ i) * conjugate (v $ i)))"
         unfolding scalar_prod_def conjugate_vec_def using neg dimA by auto
       also have "\<dots> = (\<Sum>i = 0..<m. (conjugate (v $ i) * (v $ i)))"
         by (meson mult.commute)
       also have "\<dots> = (\<Sum>i = 0..<m. cmod (conjugate (v $ i) * (v $ i)))" using vi by auto
       finally have  "inner_prod v v = (\<Sum>i = 0..<m. cmod (conjugate (v $ i) * (v $ i)))" by auto
     }
     then show ?thesis by auto
   qed
 
   let ?r = "inner_prod v (A *\<^sub>v v)" have rl: "?r < 0" using neg by auto
   have vAv: "inner_prod v (A *\<^sub>v v) =  (\<Sum>i=0..<m. (\<Sum>j=0..<m.
                 conjugate (v$i) * A$$(i, j) * v$j))" using quadratic_form_mat dimA neg by auto
   from limX have limij: "\<forall>i<m. \<forall>j<m. (\<lambda>n. X n $$ (i, j)) \<longlonglongrightarrow> A $$ (i, j)" unfolding limit_mat_def by auto
   then have limXv: "(\<lambda> n. inner_prod v ((X n) *\<^sub>v v)) \<longlonglongrightarrow> inner_prod v (A *\<^sub>v v)"
   proof -
     have XAless: "cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) \<le>
       (\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j))" for n
     proof -
       have "\<forall> i < m. \<forall> j < m. conjugate (v$i) * X n $$(i, j) * v$j - conjugate (v$i) * A$$(i, j) * v$j =
         conjugate (v$i) * (X n $$(i, j)-A$$(i, j)) * v$j"
         by (simp add: mult.commute right_diff_distrib)
       then have ele: "\<forall> i < m.(\<Sum>j=0..<m.(conjugate (v$i) * X n $$(i, j) * v$j - conjugate (v$i) * A$$(i, j) * v$j)) = (\<Sum>j=0..<m.(
               conjugate (v$i) * (X n $$(i, j)-A$$(i, j)) * v$j))" by auto
       have "\<forall> i < m. \<forall> j < m. cmod(conjugate (v $ i) * (X n $$ (i, j) - A $$ (i, j)) * v $ j) =
                 cmod(conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod(v $ j)"
         by (simp add: norm_mult)
       then have less: "\<forall> i < m.(\<Sum>j = 0..<m. cmod(conjugate (v $ i) * (X n $$ (i, j) - A $$ (i, j)) * v $ j)) =
                 (\<Sum>j = 0..<m. cmod(conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod(v $ j))" by auto
 
       have "inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v) = (\<Sum>i=0..<m. (\<Sum>j=0..<m.
               conjugate (v$i) * X n $$(i, j) * v$j)) - (\<Sum>i=0..<m. (\<Sum>j=0..<m.
               conjugate (v$i) * A$$(i, j) * v$j))"  using quadratic_form_mat neg dimA dimX by auto
       also have "\<dots> = (\<Sum>i=0..<m. (\<Sum>j=0..<m.(
               conjugate (v$i) * X n $$(i, j) * v$j - conjugate (v$i) * A$$(i, j) * v$j)))"
         using sum_subtractff[of "\<lambda> i j. conjugate (v $ i) * X n $$ (i, j) * v $ j" "\<lambda> i j. conjugate (v $ i) * A $$ (i, j) * v $ j" "{0..<m}"] by auto
       also have "\<dots> = (\<Sum>i=0..<m. (\<Sum>j=0..<m.(
               conjugate (v$i) * (X n $$(i, j)-A$$(i, j)) * v$j)))"  using ele by auto
       finally have minusXA: "inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v) = (\<Sum>i = 0..<m. \<Sum>j = 0..<m. conjugate (v $ i) * (X n $$ (i, j) - A $$ (i, j)) * v $ j)" by auto
 
       from minusXA have "cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) =
               cmod (\<Sum>i = 0..<m. \<Sum>j = 0..<m. conjugate (v $ i) * (X n $$ (i, j) - A $$ (i, j)) * v $ j)" by auto
       also have "\<dots> \<le> (\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod(conjugate (v $ i) * (X n $$ (i, j) - A $$ (i, j)) * v $ j))"
         using sum_abs_complex by simp
       also have "\<dots> = (\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod(conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod(v $ j))"
         using less by auto
       finally show ?thesis by auto
     qed
 
     from limij have limijm: " \<forall>i<m. \<forall>j<m. \<forall>r>0. \<exists>no. \<forall>n\<ge>no. cmod (X n $$ (i, j) - A $$ (i, j)) < r"
       unfolding LIMSEQ_def dist_norm by auto
     from limX have mg: "m > 0" using limit_mat_def
       by (metis carrier_matD(1) carrier_matD(2) mat_eq_iff neq0_conv not_less0 npA posX)
 
     have cmoda: "\<exists>no. \<forall>n\<ge>no. (\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)) < r"
       if r: "r > 0" for r
     proof -
       let ?u = "(\<Sum>i = 0..<m. \<Sum>j = 0..<m.((cmod (conjugate (v $ i)) * cmod (v $ j))))"
       have ug: "?u > 0"
       proof -
         have ur: "?u = (\<Sum>i = 0..<m. (cmod (conjugate (v $ i)) * (\<Sum>j = 0..<m.( cmod (v $ j)))))"  by (simp add: sum_distrib_left)
         have "(\<Sum>j = 0..<m.( cmod (v $ j))) \<ge> cmod (v $ i)" if i: "i < m" for i
           using member_le_sum[of i "{0..<m}" "\<lambda> j. cmod (v$j)"] cmod_def i by simp
         then have "\<forall> i < m. (cmod (conjugate (v $ i)) * (\<Sum>j = 0..<m.( cmod (v $ j)))) \<ge> (cmod (conjugate (v $ i)) * cmod (v $ i))"
           by (simp add: mult_left_mono)
         then have "?u \<ge> (\<Sum>i = 0..<m. (cmod (conjugate (v $ i)) *cmod (v $ i)))"
           using ur sum_mono[of "{0..<m}" "\<lambda> i.  cmod (conjugate (v $ i)) * cmod (v $ i)" "\<lambda> i. cmod (conjugate (v $ i)) * (\<Sum>j = 0..<m. cmod (v $ j))"]
           by auto
         moreover have "(\<Sum>i = 0..<m. cmod (conjugate (v $ i)  *cmod (v $ i))) = (\<Sum>i = 0..<m. cmod (conjugate (v $ i) * (v $ i)))"
           using norm_ge_zero norm_mult norm_of_real by (metis (no_types, hide_lams) abs_of_nonneg)
         moreover have "(\<Sum>i = 0..<m. cmod (conjugate (v $ i) * (v $ i))) = inner_prod v v" using invv by auto
         ultimately have "?u \<ge>  inner_prod v v"
           by (metis (no_types, lifting) Im_complex_of_real Re_complex_of_real invv less_eq_complex_def norm_mult sum.cong)
         then have "?u > 0"  using invgeq by auto
         then show ?thesis by auto
       qed
 
       let ?s = "r / (2 * ?u)"
       have sgz: "?s > 0" using ug rl
         by (smt divide_pos_pos dual_order.strict_iff_order linordered_semiring_strict_class.mult_pos_pos zero_less_norm_iff r)
       from limijm have sij: "\<exists>no. \<forall>n\<ge>no. cmod (X n $$ (i, j) - A $$ (i, j)) < ?s" if i: "i < m" and j: "j < m" for i j
       proof -
         obtain N where Ns: "\<forall>n\<ge>N. cmod (X n $$ (i, j) - A $$ (i, j)) < ?s" using sgz limijm i j by blast
         then show ?thesis by auto
       qed
       then have "\<exists>no. \<forall>i<m. \<forall>j<m. \<forall>n\<ge>no. cmod (X n $$ (i, j) - A $$ (i, j)) < ?s"
         using quantifier_change_order_twice[of m m "\<lambda> n i j. (cmod (X n $$ (i, j) - A $$ (i, j))<?s)"] by auto
       then obtain N where Nno: "\<forall>i<m. \<forall>j<m. \<forall>n\<ge>N. cmod (X n $$ (i, j) - A $$ (i, j)) < ?s" by auto
       then have mmN: "cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)
                        \<le> ?s * (cmod (conjugate (v $ i)) * cmod (v $ j))"
         if i: "i < m" and j: "j < m" and n: "n \<ge> N" for i j n
       proof -
         have geq: "cmod (conjugate (v $ i)) \<ge> 0 \<and> cmod (v $ j)\<ge>0" by simp
         then have "cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) \<le>cmod (conjugate (v $ i)) * ?s" using Nno i j n
           by (smt mult_left_mono)
         then have "cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)
                     \<le> cmod (conjugate (v $ i)) *?s * cmod (v $ j)" using geq mult_right_mono by blast
         also have "\<dots> = ?s * (cmod (conjugate (v $ i)) * cmod (v $ j))" by simp
         finally show ?thesis by auto
       qed
       then have "(\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)) < r"
         if n: "n \<ge> N" for n
       proof -
         have mmX: "\<forall>i<m. \<forall>j<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)
                    \<le> ?s * (cmod (conjugate (v $ i)) * cmod (v $ j))" using n mmN by blast
         have "(\<Sum>j = 0..<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j))
                    \<le> (\<Sum>j = 0..<m.(?s * (cmod (conjugate (v $ i)) * cmod (v $ j))))" if i: "i < m" for i
         proof -
           have "\<forall>j<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)
                  \<le> ?s * (cmod (conjugate (v $ i)) * cmod (v $ j))" using mmX i by auto
           then show ?thesis
           using sum_mono[of "{0..<m}" "\<lambda> j. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)" "\<lambda> j. (?s * (cmod (conjugate (v $ i)) * cmod (v $ j)))"]
             atLeastLessThan_iff by blast
         qed
         then have "(\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j))
                   \<le> (\<Sum>i = 0..<m. \<Sum>j = 0..<m.(?s * (cmod (conjugate (v $ i)) * cmod (v $ j))))" using sum_mono atLeastLessThan_iff
           by (metis (no_types, lifting))
         also have "\<dots> = ?s * (\<Sum>i = 0..<m. \<Sum>j = 0..<m.((cmod (conjugate (v $ i)) * cmod (v $ j))))"  by (simp add: sum_distrib_left)
         also have "\<dots> = r / 2" using nonzero_mult_divide_mult_cancel_right sgz by fastforce
         finally show ?thesis using r by auto
       qed
       then show ?thesis by auto
     qed
     then have XnAv:"\<exists>no. \<forall>n\<ge>no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < r" if r: "r > 0" for r
     proof -
       obtain no where nno: "\<forall>n\<ge>no. (\<Sum>i = 0..<m. \<Sum>j = 0..<m. cmod (conjugate (v $ i)) * cmod (X n $$ (i, j) - A $$ (i, j)) * cmod (v $ j)) < r"
         using r cmoda neg by auto
       then have "\<forall>n\<ge>no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < r" using XAless neg by smt
       then show ?thesis by auto
     qed
     then have "(\<lambda>n. inner_prod v (X n *\<^sub>v v)) \<longlonglongrightarrow> inner_prod v (A *\<^sub>v v)" unfolding LIMSEQ_def dist_norm by auto
     then show ?thesis by auto
   qed
 
   from limXv have "\<forall>r>0. \<exists>no. \<forall>n\<ge>no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < r" unfolding LIMSEQ_def dist_norm by auto
   then have "\<exists>no. \<forall>n\<ge>no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" using rl by auto
   then obtain N where Ng: "\<forall>n\<ge>N. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" by auto
   then have XN: "cmod (inner_prod v (X N *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" by auto
 
   from posX have "positive (X N)" by auto
   then have XNv:"inner_prod v (X N *\<^sub>v v) \<ge> 0"
     by (metis Complex_Matrix.positive_def carrier_matD(2) dimA dimX neg)
 
   from rl XNv have XX: "cmod (inner_prod v (X N *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) = cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v))"
     using XN cmod_eq_Re by auto
   then have YY: "cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v)) < -?r" using XN by auto
   then have "cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v)) < cmod(inner_prod v (A *\<^sub>v v))" using rl cmod_eq_Re by auto
   then have  "cmod(inner_prod v (X N *\<^sub>v v)) < 0"  using XNv XX YY cmod_eq_Re by auto
   then have "False" using XNv by simp
   with npA show False by auto
 qed
 
 lemma limit_mat_ignore_initial_segment:
   "limit_mat g A d \<Longrightarrow> limit_mat (\<lambda>n. g (n + k)) A d"
 proof -
   assume asm: "limit_mat g A d"
   then have lim: "\<forall> i < d. \<forall> j < d. (\<lambda> n. (g n) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))" using limit_mat_def by auto
   then have limk: "\<forall> i < d. \<forall> j < d. (\<lambda> n. (g (n + k)) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))"
   proof -
     {
       fix i j assume dims: "i < d" "j < d"
       then have "(\<lambda> n. (g n) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))" using lim by auto
       then have "(\<lambda> n. (g (n + k)) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))" using LIMSEQ_ignore_initial_segment by auto
     }
     then show "\<forall> i < d. \<forall> j < d. (\<lambda> n. (g (n + k)) $$ (i, j)) \<longlonglongrightarrow> (A $$ (i, j))" by auto
   qed
   have "\<forall> n. g n \<in> carrier_mat d d" using asm unfolding limit_mat_def by auto
   then have "\<forall> n. g (n + k) \<in> carrier_mat d d" by auto
   moreover have "A \<in> carrier_mat d d" using asm limit_mat_def by auto
   ultimately show "limit_mat (\<lambda>n. g (n + k)) A d" using limit_mat_def limk by auto
 qed
 
 lemma mat_trace_limit:
   "limit_mat g A d \<Longrightarrow> (\<lambda>n. trace (g n)) \<longlonglongrightarrow> trace A"
 proof -
   assume lim: "limit_mat g A d"
   then have dgn: "g n \<in> carrier_mat d d" for n using limit_mat_def by auto
   from lim have dA: "A \<in> carrier_mat d d" using limit_mat_def by auto
   have trg: "trace (g n) = (\<Sum>k=0..<d. (g n)$$(k, k))" for n unfolding trace_def using carrier_matD[OF dgn] by auto
   have "\<forall>k < d. (\<lambda>n. (g n)$$(k, k)) \<longlonglongrightarrow> A$$(k, k)" using limit_mat_def lim by auto
   then have "(\<lambda>n. (\<Sum>k=0..<d. (g n)$$(k, k))) \<longlonglongrightarrow> (\<Sum>k=0..<d. A$$(k, k))"
     using tendsto_sum[where ?I = "{0..<d}" and ?f = "(\<lambda>k n. (g n)$$(k, k))"] by auto
   then show "(\<lambda>n. trace (g n)) \<longlonglongrightarrow> trace A" unfolding trace_def
     using trg carrier_matD[OF dgn] carrier_matD[OF dA] by auto
 qed
 
 subsection \<open>Existence of least upper bound for the L\"{o}wner order\<close>
 
 definition lowner_is_lub :: "(nat \<Rightarrow> complex mat) \<Rightarrow> complex mat \<Rightarrow> bool" where
   "lowner_is_lub f M \<longleftrightarrow> (\<forall>n. f n \<le>\<^sub>L M) \<and> (\<forall>M'. (\<forall>n. f n \<le>\<^sub>L M') \<longrightarrow> M \<le>\<^sub>L M')"
 
 locale matrix_seq =
   fixes dim :: nat
     and f :: "nat \<Rightarrow> complex mat"
   assumes
     dim: "\<And>n. f n \<in> carrier_mat dim dim" and
     pdo: "\<And>n. partial_density_operator (f n)" and
     inc: "\<And>n. lowner_le (f n) (f (Suc n))"
 begin
 
 definition lowner_is_lub :: "complex mat \<Rightarrow> bool" where
   "lowner_is_lub M \<longleftrightarrow> (\<forall>n. f n \<le>\<^sub>L M) \<and> (\<forall>M'. (\<forall>n. f n \<le>\<^sub>L M') \<longrightarrow> M \<le>\<^sub>L M')"
 
 lemma lowner_is_lub_dim:
   assumes "lowner_is_lub M"
   shows "M \<in> carrier_mat dim dim"
 proof -
   have "f 0 \<le>\<^sub>L M" using assms lowner_is_lub_def by auto
   then have 1: "dim_row (f 0) = dim_row M \<and> dim_col (f 0) = dim_col M"
     using lowner_le_def by auto
   moreover have 2: "f 0 \<in> carrier_mat dim dim"
     using dim by auto
   ultimately show ?thesis by auto
 qed
 
 lemma trace_adjoint_eq_u:
   fixes A :: "complex mat"
   shows "trace (A * adjoint A) = (\<Sum> i \<in> {0 ..< dim_row A}. \<Sum> j \<in> {0 ..< dim_col A}. (norm(A $$ (i,j)))\<^sup>2)"
 proof -
   have "trace (A * adjoint A) = (\<Sum> i \<in> {0 ..< dim_row A}. row A i \<bullet> conjugate (row A i))"
     by (simp add: trace_def cmod_def adjoint_def scalar_prod_def)
   also have "\<dots> = (\<Sum> i \<in> {0 ..< dim_row A}. \<Sum> j \<in> {0 ..< dim_col A}. (norm(A $$ (i,j)))\<^sup>2)"
     proof (simp add: scalar_prod_def cmod_def)
       have cnjmul: "\<forall> i ia. A $$ (i, ia) * cnj (A $$ (i, ia)) =
                    ((complex_of_real (Re (A $$ (i, ia))))\<^sup>2 + (complex_of_real (Im (A $$ (i, ia))))\<^sup>2)"
         by (simp add: complex_mult_cnj)
       then have "\<forall> i. (\<Sum>ia = 0..<dim_col A. A $$ (i, ia) * cnj (A $$ (i, ia))) =
                       (\<Sum>ia = 0..<dim_col A.  ((complex_of_real (Re (A $$ (i, ia))))\<^sup>2 + (complex_of_real (Im (A $$ (i, ia))))\<^sup>2))"
         by auto
       then show"(\<Sum>i = 0..<dim_row A. \<Sum>ia = 0..<dim_col A. A $$ (i, ia) * cnj (A $$ (i, ia))) =
         (\<Sum>x = 0..<dim_row A. \<Sum>xa = 0..<dim_col A. (complex_of_real (Re (A $$ (x, xa))))\<^sup>2) +
         (\<Sum>x = 0..<dim_row A. \<Sum>xa = 0..<dim_col A. (complex_of_real (Im (A $$ (x, xa))))\<^sup>2)"
         by auto
     qed
   finally show ?thesis .
 qed
 
 lemma trace_adjoint_element_ineq:
   fixes A :: "complex mat"
   assumes rindex: "i \<in> {0 ..< dim_row A}"
      and  cindex: "j \<in> {0 ..< dim_col A}"
   shows "(norm(A $$ (i,j)))\<^sup>2 \<le> trace (A * adjoint A)"
 proof (simp add: trace_adjoint_eq_u)
   have ineqi: "(cmod (A $$ (i, j)))\<^sup>2 \<le> (\<Sum>xa = 0..<dim_col A. (cmod (A $$ (i, xa)))\<^sup>2)"
     using cindex member_le_sum[of j " {0 ..< dim_col A}" "\<lambda> x. (cmod (A $$ (i, x)))\<^sup>2"] by auto
   also have ineqj: "\<dots> \<le> (\<Sum>x = 0..<dim_row A. \<Sum>xa = 0..<dim_col A. (cmod (A $$ (x, xa)))\<^sup>2)"
     using rindex member_le_sum[of i " {0 ..< dim_row A}" "\<lambda> x. \<Sum>xa = 0..<dim_col A. (cmod (A $$ (x, xa)))\<^sup>2"]
     by (simp add: sum_nonneg)
   then show "(cmod (A $$ (i, j)))\<^sup>2 \<le> (\<Sum>x = 0..<dim_row A. \<Sum>xa = 0..<dim_col A. (cmod (A $$ (x, xa)))\<^sup>2)"
   using ineqi by linarith
  qed
 
 lemma positive_is_normal:
   fixes A :: "complex mat"
   assumes pos: "positive A"
   shows "A * adjoint A = adjoint A * A"
 proof -
   have hA: "hermitian A" using positive_is_hermitian pos by auto
   then show ?thesis by (simp add: hA hermitian_is_normal)
 qed
 
 lemma diag_mat_mul_diag_diag:
   fixes A B ::  "complex mat"
   assumes dimA: "A \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n"
     and dA: "diagonal_mat A"  and dB: "diagonal_mat B"
   shows "diagonal_mat (A * B)"
 proof  -
   have AB: "A * B = mat n n (\<lambda>(i,j). (if (i = j) then (A$$(i, i)) * (B$$(i, i)) else 0))"
     using diag_mat_mult_diag_mat[of A n B] dimA dimB dA dB by auto
   then have dAB: "\<forall>i<n. \<forall>j<n. i \<noteq> j \<longrightarrow> (A*B) $$ (i,j) = 0"
   proof -
     {
       fix i j assume i: "i < n" and j: "j < n" and ij: "i \<noteq> j"
       have "(A*B) $$ (i,j) = 0" using AB i j ij by auto
     }
     then show ?thesis by auto
   qed
   then show ?thesis using diagonal_mat_def dAB dimA dimB
     by (metis carrier_matD(1) carrier_matD(2) index_mult_mat(2) index_mult_mat(3))
 qed
 
 lemma diag_mat_mul_diag_ele:
   fixes A B :: "complex mat"
   assumes dimA: "A \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n"
     and dA: "diagonal_mat A" and dB: "diagonal_mat B"
   shows "\<forall>i<n. (A*B) $$ (i,i) = A$$(i, i) * B$$(i, i)"
 proof -
   have AB: "A * B = mat n n (\<lambda>(i,j). if i = j then (A$$(i, i)) * (B$$(i, i)) else 0)"
     using diag_mat_mult_diag_mat[of A n B] dimA dimB dA dB by auto
   then show ?thesis
     using AB by auto
 qed
 
 lemma trace_square_less_square_trace:
   fixes B ::  "complex mat"
   assumes dimB: "B \<in> carrier_mat n n"
       and dB: "diagonal_mat B" and pB: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0"
     shows "trace (B*B) \<le> (trace B)\<^sup>2"
 proof -
   have tB:  "trace B = (\<Sum> i \<in> {0 ..<n}. B $$ (i,i))" using assms trace_def[of B] carrier_mat_def by auto
   then have tBtB: "(trace B)\<^sup>2 = (\<Sum> i \<in> {0 ..<n}.\<Sum> j \<in> {0 ..<n}. B $$ (i,i)*B $$ (j,j))"
   proof -
     show ?thesis
       by (metis (no_types) semiring_normalization_rules(29) sum_product tB)
   qed
   have BB: "\<And>i. i < n \<Longrightarrow> (B*B) $$ (i,i) = (B$$(i, i))\<^sup>2" using diag_mat_mul_diag_ele[of B n B] dimB dB
       by (metis numeral_1_eq_Suc_0 power_Suc0_right power_add_numeral semiring_norm(2))
   have tBB:  "trace (B*B) = (\<Sum> i \<in> {0 ..<n}. (B*B) $$ (i,i))" using assms trace_def[of "B*B"] carrier_mat_def by auto
   also have "\<dots> =  (\<Sum> i \<in> {0 ..<n}. (B$$(i, i))\<^sup>2)" using BB by auto
   finally have BBt: " trace (B * B) = (\<Sum>i = 0..<n. (B $$ (i, i))\<^sup>2)" by auto
   have lesseq: "\<forall>i \<in> {0 ..<n}. (B $$ (i, i))\<^sup>2 \<le> (\<Sum> j \<in> {0 ..<n}. B $$ (i,i)*B $$ (j,j))"
   proof -
     {
       fix i assume i: "i < n"
       have "(\<Sum>j = 0..<n. B $$ (i, i) * B $$ (j, j)) = (B $$ (i, i))\<^sup>2  + sum (\<lambda> j. (B $$ (i, i) * B $$ (j, j))) ({0 ..<n} - {i})"
         by (metis (no_types, lifting) BB atLeastLessThan_iff dB diag_mat_mul_diag_ele dimB finite_atLeastLessThan i not_le not_less_zero sum.remove)
       moreover have "(sum (\<lambda> j. (B $$ (i, i) * B $$ (j, j))) ({0 ..<n} - {i})) \<ge> 0"
       proof (cases "{0..<n} - {i} \<noteq> {}")
         case True
         then show ?thesis using pB i sum_nonneg[of "{0..<n} - {i}" "\<lambda> j. (B $$ (i, i) * B $$ (j, j))"] by auto
        next
          case False
          have "(\<Sum>j\<in>{0..<n} - {i}. B $$ (i, i) * B $$ (j, j)) = 0" using False by fastforce
        then show ?thesis by auto
      qed
      ultimately have "(\<Sum>j = 0..<n. B $$ (i, i) * B $$ (j, j)) \<ge> (B $$ (i, i))\<^sup>2" by auto
    }
    then show ?thesis by auto
  qed
   from tBtB BBt lesseq have "trace (B*B) \<le> (trace B)\<^sup>2"
     using sum_mono[of "{0..<n}" "\<lambda> i. (B $$ (i, i))\<^sup>2" "\<lambda> i. (\<Sum>j = 0..<n. B $$ (i, i) * B $$ (j, j))"]
     by (metis (no_types, lifting))
   then show ?thesis by auto
 qed
 
 lemma trace_positive_eq:
    fixes A :: "complex mat"
    assumes pos: "positive A"
    shows "trace (A * adjoint A) \<le> (trace A)\<^sup>2"
 proof -
   from assms  have normal: "A * adjoint A = adjoint A * A" by (rule positive_is_normal)
   moreover
   from assms positive_dim_eq obtain n where cA: "A \<in> carrier_mat n n" by auto
   moreover
   from assms complex_mat_char_poly_factorizable cA obtain es where charpo: " char_poly A =  (\<Prod> a \<leftarrow> es. [:- a, 1:]) \<and> length es = n" by auto
   moreover
   obtain B P Q where B: "unitary_schur_decomposition A es = (B,P,Q)" by (cases "unitary_schur_decomposition A es", auto)
   ultimately have
     smw: "similar_mat_wit A B P (adjoint P)"
     and ut: "diagonal_mat B"
     and uP:  "unitary P"
     and dB: "diag_mat B = es"
     and QaP: "Q = adjoint P"
     using normal_complex_mat_has_spectral_decomposition[of A n es B P Q]  unitary_schur_decomposition by auto
   from smw cA QaP uP have cB: "B \<in> carrier_mat n n" and cP: "P \<in> carrier_mat n n" and cQ: "Q \<in> carrier_mat n n"
     unfolding  similar_mat_wit_def Let_def unitary_def by auto
   then have caP: "adjoint P \<in> carrier_mat n n" using adjoint_dim[of P n] by auto
   from smw QaP cA have A: "A = P * B * adjoint P" and traceA: "trace A = trace (P * B * Q)" and PB: "P * Q = 1\<^sub>m n \<and> Q * P = 1\<^sub>m n"
     unfolding similar_mat_wit_def by auto
   have traceAB: "trace (P * B * Q) = trace ((Q*P)*B)"
     using cQ cP cB by (mat_assoc n)
   also have traceelim: "\<dots> = trace B" using traceAB PB cA cB cP cQ left_mult_one_mat[of "P*Q" n n]
     using similar_mat_wit_sym by auto
   finally have traceAB: "trace A = trace B" using traceA by auto
   from A cB cP have aAa: "adjoint A = adjoint((P * B) * adjoint P)" by auto
   have aA: "adjoint A = P * adjoint B * adjoint P"
     unfolding aAa using cP cB by (mat_assoc n)
   have hA: "hermitian A" using pos positive_is_hermitian by auto
   then have AaA: "A = adjoint A" using hA hermitian_def[of A] by auto
   then have PBaP: "P * B * adjoint P = P * adjoint B * adjoint P" using A aA by auto
   then have BaB: "B = adjoint B" using unitary_elim[of B n "adjoint B" P] uP cP cB adjoint_dim[of B n] by auto
   have aPP: "adjoint P * P = 1\<^sub>m n" using uP PB QaP by blast
   have "A * A = P * B * (adjoint P * P) * B * adjoint P"
     unfolding A using cP cB by (mat_assoc n)
   also have "\<dots> = P * B * B * adjoint P"
     unfolding aPP using cP cB by (mat_assoc n)
   finally have AA: "A * A = P * B * B * adjoint P" by auto
   then have tAA: "trace (A*A) = trace (P * B * B * adjoint P)" by auto
   also have tBB: "\<dots> = trace (adjoint P * P * B * B)" using cP cB by (mat_assoc n)
   also have "\<dots> = trace (B * B)" using uP unitary_def[of P] inverts_mat_def[of P "adjoint P"]
     using PB QaP cB by auto
   finally have traceAABB: "trace (A * A) = trace (B * B)" by auto
   have BP: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0"
   proof -
      {
        fix i assume i: "i < n"
        then have "B$$(i, i) \<ge> 0" using positive_eigenvalue_positive[of A n es B P Q i] cA pos charpo B by auto
        then show "B$$(i, i) \<ge> 0" by auto
      }
    qed
    have Brel: "trace (B*B) \<le> (trace B)\<^sup>2" using trace_square_less_square_trace[of B n] cB ut BP by auto
    from AaA traceAABB traceAB Brel have "trace (A*adjoint A) \<le> (trace A)\<^sup>2" by auto
    then show ?thesis by auto
  qed
 
 lemma lowner_le_transitive:
   fixes m n :: nat
   assumes re: "n \<ge> m"
   shows "positive (f n - f m)"
 proof -
   from re show "positive (f n - f m)"
   proof (induct n)
     case 0
     then show ?case using positive_zero
           by (metis dim le_0_eq minus_r_inv_mat)
   next
     case (Suc n)
     then show ?case
     proof (cases "Suc n = m")
       case True
       then show ?thesis using positive_zero
           by (metis dim minus_r_inv_mat)
     next
       case False
       then show ?thesis
       proof -
         from False Suc have nm: "n  \<ge> m" by linarith
         from Suc nm have pnm:  "positive (f n - f m)" by auto
         from inc have "positive (f (Suc n) - f n)" unfolding lowner_le_def by auto
         then have pf:  "positive ((f (Suc n) - f n) + (f n - f m))" using positive_add dim pnm
           by (meson minus_carrier_mat)
         have "(f (Suc n) - f n) + (f n - f m) = f (Suc n) + ((- f n) + f n) + (- f m)"
           using local.dim by (mat_assoc dim, auto)
         also have "\<dots> = f (Suc n) + 0\<^sub>m dim dim + (- f m)"
           using local.dim by (subst uminus_l_inv_mat[where nc=dim and nr=dim], auto)
         also have "\<dots> = f (Suc n) - f m"
           using local.dim by (mat_assoc dim, auto)
         finally have re: "f (Suc n) - f n + (f n - f m) = f (Suc n) - f m" .
         from pf re have "positive (f (Suc n) - f m)" by auto
         then show ?thesis by auto
       qed
     qed
   qed
 qed
 
 text \<open>The sequence of matrices converges pointwise.\<close>
 lemma inc_partial_density_operator_converge:
   assumes  i: "i \<in> {0 ..<dim}" and j: "j \<in> {0 ..<dim}"
   shows "convergent (\<lambda>n. f n $$ (i, j))"
 proof-
   have tracefn: "trace (f n) \<ge> 0 \<and> trace (f n) \<le> 1" for n
   proof -
     from pdo show ?thesis
       unfolding partial_density_operator_def using positive_trace[of "f n"]
       using dim by blast
   qed
   from tracefn have normf: "norm(trace (f n)) \<le> norm(trace (f (Suc n))) \<and> norm(trace (f n)) \<le> 1" for n
   proof -
     have trless: "trace (f n) \<le> trace (f (Suc n))"
     using pdo inc dim positive_trace[of "f(Suc n) - f n"] trace_minus_linear[of "f (Suc n)" dim "f n"]
     unfolding partial_density_operator_def lowner_le_def
     using Complex_Matrix.positive_def by force
     moreover from trless tracefn  have "norm(trace (f n)) \<le> norm(trace (f (Suc n)))" unfolding cmod_def by simp
     moreover from trless tracefn have "norm(trace (f n)) \<le> 1" using pdo partial_density_operator_def cmod_def by simp
     ultimately show ?thesis by auto
   qed
   then have inctrace: "incseq (\<lambda> n. norm(trace (f n)))" by (simp add: incseq_SucI)
   then have tr_sup: "(\<lambda> n. norm(trace (f n))) \<longlonglongrightarrow> (SUP i. norm (trace (f i)))"
     using LIMSEQ_incseq_SUP[of "\<lambda> n. norm(trace (f n))"] pdo partial_density_operator_def normf  by (meson bdd_aboveI2)
   then have tr_cauchy: "Cauchy (\<lambda> n. norm(trace (f n)))" using  Cauchy_convergent_iff convergent_def by blast
   then have tr_cauchy_def: "\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist(norm(trace (f n))) (norm(trace (f m))) < e" unfolding Cauchy_def by blast
   moreover have "\<forall>m n. dist(norm(trace (f m))) (norm(trace (f n))) = norm(trace (f m) - trace (f n))"
     using tracefn cmod_eq_Re dist_real_def by auto
   ultimately have norm_trace: "\<forall>e>0.\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm((trace (f n)) - (trace (f m))) < e" by auto
 
   have eq_minus: "\<forall> m n. trace (f m) - trace (f n) = trace (f m - f n)" using trace_minus_linear dim by metis
   from eq_minus norm_trace have norm_trace_cauchy: "\<forall>e>0.\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm((trace (f n - f m))) < e" by auto
   then have norm_trace_cauchy_iff: "\<forall>e>0.\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. norm((trace (f n - f m))) < e"
     by (meson order_trans_rules(23))
   then have norm_square: "\<forall>e>0.\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. (norm((trace (f n - f m))))\<^sup>2 < e\<^sup>2"
     by (metis abs_of_nonneg norm_ge_zero order_less_le real_sqrt_abs real_sqrt_less_iff)
 
   have tr_re: "\<forall> m. \<forall> n \<ge> m. trace ((f n - f m) * adjoint (f n - f m)) \<le> ((trace (f n- f m)))\<^sup>2"
     using trace_positive_eq lowner_le_transitive by auto
   have tr_re_g: "\<forall> m. \<forall> n \<ge> m. trace ((f n - f m) * adjoint (f n - f m)) \<ge> 0"
     using lowner_le_transitive positive_trace trace_adjoint_positive by auto
   have norm_trace_fmn: "norm(trace ((f n - f m) * adjoint (f n - f m))) \<le> (norm(trace (f n - f m)))\<^sup>2" if nm: "n \<ge> m" for m n
   proof -
     have mnA: "trace ((f n - f m) * adjoint (f n - f m)) \<le> (trace (f n - f m))\<^sup>2" using tr_re nm by auto
     have mnB: "trace ((f n - f m) * adjoint (f n - f m)) \<ge> 0" using tr_re_g nm by auto
     from mnA mnB show ?thesis
       by (smt cmod_eq_Re less_eq_complex_def norm_power zero_complex.sel(1) zero_complex.sel(2))
   qed
   then have cauchy_adj: "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. norm(trace ((f n- f m) * adjoint (f n - f m))) < e\<^sup>2" if e: "e > 0" for e
   proof -
     have "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. (cmod (trace (f n - f m)))\<^sup>2 < e\<^sup>2" using norm_square e by auto
     then obtain M where " \<forall>m\<ge>M. \<forall>n\<ge>m. (cmod (trace (f n - f m)))\<^sup>2 < e\<^sup>2" by auto
     then have "\<forall>m\<ge>M. \<forall>n\<ge>m. norm(trace ((f n- f m) * adjoint (f n - f m))) < e\<^sup>2" using norm_trace_fmn  by fastforce
     then show ?thesis by auto
   qed
 
   have norm_minus: "\<forall> m. \<forall> n \<ge> m. (norm ((f n - f m) $$ (i, j)))\<^sup>2 \<le> trace ((f n - f m) * adjoint (f n - f m))"
     using trace_adjoint_element_ineq i j
     by (smt adjoint_dim_row carrier_matD(1) index_minus_mat(2) index_mult_mat(2) lowner_le_transitive matrix_seq_axioms matrix_seq_def positive_is_normal)
   then have norm_minus_le: "(norm ((f n - f m) $$ (i, j)))\<^sup>2 \<le> norm (trace ((f n - f m) * adjoint (f n - f m)))" if nm: "n \<ge> m" for n m
   proof -
     have "(norm ((f n - f m) $$ (i, j)))\<^sup>2 \<le> (trace ((f n - f m) * adjoint (f n - f m)))" using norm_minus nm by auto
     also have "\<dots> = norm (trace ((f n - f m) * adjoint (f n - f m)))" using tr_re_g nm
       by (smt Re_complex_of_real less_eq_complex_def matrix_seq.trace_adjoint_eq_u matrix_seq_axioms mult_cancel_left2 norm_one norm_scaleR of_real_def of_real_hom.hom_zero)
     finally show ?thesis by auto
   qed
 
   from norm_minus_le cauchy_adj have cauchy_ij: "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. (norm ((f n - f m) $$ (i, j)))\<^sup>2  < e\<^sup>2" if e: "e > 0" for e
   proof -
     have "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. norm(trace ((f n- f m) * adjoint (f n - f m))) < e\<^sup>2" using cauchy_adj e by auto
     then obtain M where " \<forall>m\<ge>M. \<forall>n\<ge>m. norm(trace ((f n - f m) * adjoint (f n - f m))) < e\<^sup>2" by auto
     then have "\<forall>m\<ge>M. \<forall>n\<ge>m. (norm ((f n - f m) $$ (i, j)))\<^sup>2 < e\<^sup>2" using norm_minus_le by fastforce
     then show ?thesis by auto
   qed
   then have cauchy_ij_norm: "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. (norm ((f n - f m) $$ (i, j))) < e" if e: "e > 0" for e
   proof -
     have "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>m. (norm ((f n - f m) $$ (i, j)))\<^sup>2 < e\<^sup>2" using cauchy_ij e by auto
     then obtain M where mn: "\<forall>m\<ge>M. \<forall>n\<ge>m. (norm ((f n - f m) $$ (i, j)))\<^sup>2 < e\<^sup>2" by auto
     have "(norm ((f n - f m) $$ (i, j))) < e" if m: "m \<ge> M" and n: "n \<ge> m" for m n :: nat
     proof -
       from m n mn have "(norm ((f n- f m) $$ (i, j)))\<^sup>2 < e\<^sup>2" by auto
       then show ?thesis
       using e power_less_imp_less_base by fastforce
     qed
     then show ?thesis by auto
   qed
 
   have cauchy_final: "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm ((f m) $$ (i, j) - (f n) $$ (i, j)) < e" if e: "e > 0" for e
   proof -
     obtain M where mnm: "\<forall>m\<ge>M. \<forall>n\<ge>m. norm ((f n - f m) $$ (i, j)) < e" using cauchy_ij_norm e by auto
     have "norm ((f m) $$ (i, j) - (f n) $$ (i, j)) < e" if m: "m \<ge> M" and n: "n \<ge> M" for m n
     proof (cases "n \<ge> m")
       case True
       then show ?thesis
       proof -
         from mnm m True have "norm ((f n) $$ (i, j) - (f m) $$ (i, j)) < e"
           by (metis atLeastLessThan_iff carrier_matD(1) carrier_matD(2) dim i index_minus_mat(1) j)
         then have "norm ((f m) $$ (i, j) - (f n) $$ (i, j)) < e" by (simp add: norm_minus_commute)
         then show ?thesis by auto
       qed
     next
       case False
       then show ?thesis
       proof -
         from False n mnm have norm: "norm ((f m - f n) $$ (i, j)) < e" by auto
         have minus: "(f m - f n) $$ (i, j)   =  f m  $$ (i, j) -f n $$ (i, j)"
           by (metis atLeastLessThan_iff carrier_matD(1) carrier_matD(2) dim i index_minus_mat(1) j)
         also have "\<dots> = - (f n - f m) $$ (i, j)" using dim
           by (metis atLeastLessThan_iff carrier_matD(1) carrier_matD(2) i index_minus_mat(1) j minus_diff_eq)
         finally have fmn: "(f m - f n) $$ (i, j) = - (f n - f m) $$ (i, j)" by auto
         then have "norm ((- (f n - f m)) $$ (i, j)) < e" using norm
           by (metis (no_types, lifting) atLeastLessThan_iff carrier_matD(1) carrier_matD(2) i
               index_minus_mat(2) index_minus_mat(3) index_uminus_mat(1) j matrix_seq_axioms matrix_seq_def)
         then have "norm (((f n - f m)) $$ (i, j)) < e" using fmn norm by auto
         then have "norm (f n $$ (i, j) - f m $$ (i, j)) < e"
           by (metis minus norm norm_minus_commute)
         then have "norm (f m $$ (i, j) - f n $$ (i, j)) < e" by (simp add: norm_minus_commute)
         then show ?thesis by auto
       qed
     qed
     then show ?thesis by auto
   qed
 
   from cauchy_final have "Cauchy (\<lambda> n. f n $$ (i, j))" by (simp add: Cauchy_def dist_norm)
   then show ?thesis by (simp add: Cauchy_convergent_iff)
 qed
 
 
 definition mat_seq_minus ::  "(nat \<Rightarrow> complex mat) \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> complex mat" where
   "mat_seq_minus X A = (\<lambda>n. X n - A)"
 
 definition minus_mat_seq :: "complex mat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> nat \<Rightarrow> complex mat" where
   "minus_mat_seq A X = (\<lambda>n. A - X n)"
 
 lemma pos_mat_lim_is_pos_aux:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat
   assumes limX: "limit_mat X A m" and posX: "\<exists>k. \<forall>n\<ge>k. positive (X n)"
   shows "positive A"
 proof -
   from posX obtain k where posk: "\<forall> n\<ge>k. positive (X n)" by auto
   let ?Y = "\<lambda>n. X (n + k)"
   have posY: "\<forall>n. positive (?Y n)" using posk by auto
 
   from limX have dimXA: "\<forall>n. X (n + k) \<in> carrier_mat m m \<and> A \<in> carrier_mat m m"
     unfolding limit_mat_def by auto
 
   have "(\<lambda>n. X (n + k) $$ (i, j)) \<longlonglongrightarrow> A $$ (i, j)" if i: "i < m" and j: "j < m" for i j
   proof -
     have "(\<lambda>n. X n $$ (i, j)) \<longlonglongrightarrow> A $$ (i, j)" using limX limit_mat_def i j by auto
     then have limseqX: "\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (X n $$ (i, j)) (A $$ (i, j)) < r" unfolding LIMSEQ_def by auto
     then have "\<exists>no. \<forall>n\<ge>no. dist (X (n + k) $$ (i, j)) (A $$ (i, j)) < r" if r: "r > 0" for r
     proof -
       obtain no where "\<forall>n\<ge>no. dist (X n $$ (i, j)) (A $$ (i, j)) < r" using limseqX r by auto
       then have "\<forall>n\<ge>no. dist (X (n + k) $$ (i, j)) (A $$ (i, j)) < r" by auto
       then show ?thesis by auto
     qed
     then show ?thesis unfolding LIMSEQ_def by auto
   qed
   then have limXA: "limit_mat (\<lambda>n. X (n + k)) A m" unfolding limit_mat_def using dimXA by auto
 
   from posY limXA have "positive A" using pos_mat_lim_is_pos[of ?Y A m] by auto
   then show ?thesis by auto
 qed
 
 lemma minus_mat_limit:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat"
   assumes dimB: "B \<in> carrier_mat m m" and limX: "limit_mat X A m"
   shows "limit_mat (mat_seq_minus X B) (A - B) m"
 proof -
   have dimXAB: "\<forall>n. X n - B \<in> carrier_mat m m \<and> A - B \<in> carrier_mat m m" using index_minus_mat dimB by auto
   have "(\<lambda>n. (X n - B) $$ (i, j)) \<longlonglongrightarrow> (A - B) $$ (i, j)" if i: "i < m" and j: "j < m" for i j
   proof -
     from limX i j have "(\<lambda>n. (X n) $$ (i, j)) \<longlonglongrightarrow> (A) $$ (i, j)" unfolding limit_mat_def by auto
     then have X: "\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (X n $$ (i, j)) (A $$ (i, j)) < r" unfolding LIMSEQ_def by auto
     then have XB: "\<exists>no. \<forall>n\<ge>no. dist ((X n - B) $$ (i, j)) ((A - B) $$ (i, j)) < r" if r: "r > 0" for r
     proof -
       obtain no where "\<forall>n\<ge>no. dist (X n $$ (i, j)) (A $$ (i, j)) < r"  using r X by auto
       then have dist:  "\<forall>n\<ge>no. norm (X n $$ (i, j) - A $$ (i, j)) < r" unfolding dist_norm  by auto
       then have "norm ((X n - B) $$ (i, j) - (A - B) $$ (i, j)) < r" if n: "n \<ge> no" for n
       proof -
         have "(X n - B) $$ (i, j) - (A - B) $$ (i, j) = (X n) $$ (i, j) -  A $$ (i, j)"
           using dimB i j by auto
         then have "norm ((X n - B) $$ (i, j) - (A - B) $$ (i, j)) = norm ((X n) $$ (i, j) -  A $$ (i, j))" by auto
         then show ?thesis using dist n by auto
       qed
       then show ?thesis using dist_norm by metis
     qed
     then show ?thesis unfolding LIMSEQ_def by auto
   qed
   then show ?thesis
     unfolding limit_mat_def mat_seq_minus_def using dimXAB by auto
 qed
 
 lemma mat_minus_limit:
   fixes X :: "nat \<Rightarrow> complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat"
   assumes dimA: "A \<in> carrier_mat m m" and limX: "limit_mat X A m"
   shows "limit_mat (minus_mat_seq B X) (B - A) m"
 proof-
   have dimX : "\<forall>n. X n \<in> carrier_mat m m" using limX unfolding limit_mat_def by auto
   then have dimXAB: "\<forall>n. B - X n \<in> carrier_mat m m \<and> B - A \<in> carrier_mat m m" using index_minus_mat dimA
     by (simp add: minus_carrier_mat)
 
   have "(\<lambda>n. (B - X n) $$ (i, j)) \<longlonglongrightarrow> (B - A) $$ (i, j)" if i: "i < m" and j: "j < m" for i j
   proof -
     from limX i j have "(\<lambda>n. (X n) $$ (i, j)) \<longlonglongrightarrow> (A) $$ (i, j)" unfolding limit_mat_def by auto
     then have X: "\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (X n $$ (i, j)) (A $$ (i, j)) < r" unfolding LIMSEQ_def by auto
     then have XB: "\<exists>no. \<forall>n\<ge>no. dist ((B - X n) $$ (i, j)) ((B - A) $$ (i, j)) < r" if r: "r > 0" for r
     proof -
       obtain no where "\<forall>n\<ge>no. dist (X n $$ (i, j)) (A $$ (i, j)) < r" using r X by auto
       then have dist: "\<forall>n\<ge>no. norm (X n $$ (i, j) - A $$ (i, j)) < r" unfolding dist_norm by auto
       then have "norm ((B - X n) $$ (i, j) - (B - A) $$ (i, j)) < r" if n: "n \<ge> no" for n
       proof -
         have "(B - X n) $$ (i, j) - (B - A) $$ (i, j) = - ((X n) $$ (i, j) -  A $$ (i, j))"
           using dimA i j
           by (smt cancel_ab_semigroup_add_class.diff_right_commute cancel_comm_monoid_add_class.diff_cancel carrier_matD(1) carrier_matD(2) diff_add_cancel dimX index_minus_mat(1) minus_diff_eq)
         then have "norm ((B - X n) $$ (i, j) - (B - A) $$ (i, j)) = norm ((X n) $$ (i, j) -  A $$ (i, j))"
           by (metis norm_minus_cancel)
         then show ?thesis using dist n by auto
       qed
       then show ?thesis using dist_norm by metis
     qed
     then show ?thesis unfolding LIMSEQ_def by auto
   qed
   then have "limit_mat (minus_mat_seq B X) (B - A) m"
     unfolding limit_mat_def minus_mat_seq_def using dimXAB by auto
   then show ?thesis by auto
 qed
 
 lemma lowner_lub_form:
   "lowner_is_lub (mat dim dim (\<lambda> (i, j). (lim (\<lambda> n. (f n) $$ (i, j)))))"
 proof -
   from inc_partial_density_operator_converge
   have conf: "\<forall> i \<in> {0 ..<dim}.  \<forall> j \<in> {0 ..<dim}. convergent (\<lambda> n. f n $$ (i, j))" by auto
   let ?A = "mat dim dim (\<lambda> (i, j). (lim (\<lambda> n. (f n) $$ (i, j))))"
   have dim_A: "?A \<in> carrier_mat dim dim" by auto
   have lim_A: "(\<lambda>n. f n $$ (i, j)) \<longlonglongrightarrow> mat dim dim (\<lambda>(i, j). lim (\<lambda>n. f n $$ (i, j))) $$ (i, j)"
     if i: "i < dim" and j: "j < dim" for i j
   proof -
     from i j have ij: "mat dim dim (\<lambda>(i, j). lim (\<lambda>n. f n $$ (i, j))) $$ (i, j) = lim (\<lambda>n. f n $$ (i, j))"
       by (metis case_prod_conv index_mat(1))
     have "convergent (\<lambda>n. f n $$ (i, j))" using conf i j by auto
     then have "(\<lambda>n. f n $$ (i, j))  \<longlonglongrightarrow> lim (\<lambda>n. f n $$ (i, j)) " using convergent_LIMSEQ_iff by auto
     then show ?thesis using ij by auto
   qed
 
   from dim dim_A lim_A have lim_mat_A: "limit_mat f ?A dim" unfolding limit_mat_def by auto
 
   have is_ub: "f n \<le>\<^sub>L ?A" for n
   proof -
     have "\<forall> m \<ge> n. positive (f m - f n)" using lowner_le_transitive by auto
     then have le: "\<forall> m \<ge> n. f n \<le>\<^sub>L f m " unfolding lowner_le_def using dim
       by (metis carrier_matD(1) carrier_matD(2))
     have dimn: "f n \<in> carrier_mat dim dim" using dim by auto
     then have limAf: "limit_mat (mat_seq_minus f (f n)) (?A - f n) dim" using minus_mat_limit lim_mat_A by auto
 
     have " \<forall>m\<ge>n. positive (f m - f n)" using lowner_le_transitive by auto
     then have "\<exists>k. \<forall>m\<ge>k. positive (f m - f n)" by auto
     then have posAf: "\<exists> k. \<forall> m \<ge> k. positive ((mat_seq_minus f (f n)) m)" unfolding mat_seq_minus_def by auto
 
     from limAf posAf have "positive (?A - f n)" using pos_mat_lim_is_pos_aux by auto
     then have "f n \<le>\<^sub>L mat dim dim (\<lambda>(i, j). lim (\<lambda>n. f n $$ (i, j)))" unfolding lowner_le_def using dim by auto
     then show ?thesis by auto
   qed
 
   have is_lub: "?A \<le>\<^sub>L M'" if ub: "\<forall>n. f n \<le>\<^sub>L M'" for M'
   proof -
     have dim_M: "M' \<in> carrier_mat dim dim" using ub unfolding lowner_le_def using dim
       by (metis carrier_matD(1) carrier_matD(2) carrier_mat_triv)
     from ub have posAf: "\<forall> n. positive (minus_mat_seq M' f n)" unfolding minus_mat_seq_def lowner_le_def by auto
     have limAf: "limit_mat (minus_mat_seq M' f) (M' - ?A) dim"
       using mat_minus_limit dim_A lim_mat_A by auto
     from posAf limAf have  "positive (M' - ?A)" using pos_mat_lim_is_pos_aux by auto
     then have "?A \<le>\<^sub>L M'" unfolding lowner_le_def using dim dim_A dim_M by auto
     then show ?thesis by auto
   qed
 
   from is_ub is_lub show ?thesis unfolding lowner_is_lub_def by auto
 qed
 
 text \<open>Lowner partial order is a complete partial order.\<close>
 lemma lowner_lub_exists: "\<exists>M. lowner_is_lub M"
   using lowner_lub_form by auto
 
 lemma lowner_lub_unique: "\<exists>!M. lowner_is_lub M"
 proof (rule HOL.ex_ex1I)
   show "\<exists>M. lowner_is_lub M"
     by (rule lowner_lub_exists)
 next
   fix M N
   assume M: "lowner_is_lub M" and N: "lowner_is_lub N"
   have Md: "M \<in> carrier_mat dim dim" using M by (rule lowner_is_lub_dim)
   have Nd: "N \<in> carrier_mat dim dim" using N by (rule lowner_is_lub_dim)
   have MN: "M \<le>\<^sub>L N" using M N by (simp add: lowner_is_lub_def)
   have NM: "N \<le>\<^sub>L M" using M N by (simp add: lowner_is_lub_def)
   show "M = N" using MN NM by (auto intro: lowner_le_antisym[OF Md Nd])
 qed
 
 definition lowner_lub :: "complex mat" where
   "lowner_lub = (THE M. lowner_is_lub M)"
 
 lemma lowner_lub_prop: "lowner_is_lub lowner_lub"
   unfolding lowner_lub_def
   apply (rule HOL.theI')
   by (rule lowner_lub_unique)
 
 lemma lowner_lub_is_limit:
   "limit_mat f lowner_lub dim"
 proof -
   define A where "A = lowner_lub"
   then have "A = (THE M. lowner_is_lub M)" using lowner_lub_def by auto
   then have Af: "A = (mat dim dim (\<lambda> (i, j). (lim (\<lambda> n.  (f n) $$ (i, j)))))"
     using lowner_lub_form lowner_lub_unique by auto
   show "limit_mat f A dim" unfolding Af limit_mat_def
     apply (auto simp add: dim)
   proof -
     fix i j assume dims: "i < dim" "j < dim"
     then have "convergent  (\<lambda>n. f n $$ (i, j))" using inc_partial_density_operator_converge by auto
     then show "(\<lambda>n. f n $$ (i, j)) \<longlonglongrightarrow> lim (\<lambda>n. f n $$ (i, j))" using convergent_LIMSEQ_iff by auto
   qed
 qed
 
 lemma lowner_lub_trace:
   assumes "\<forall> n. trace (f n) \<le> x"
   shows "trace lowner_lub \<le> x"
 proof -
   have "\<forall> n. trace (f n) \<ge> 0" using positive_trace pdo unfolding partial_density_operator_def
     using dim by blast
   then have Re: "\<forall> n. Re (trace (f n)) \<ge> 0 \<and> Im (trace (f n)) = 0" by auto
   then have lex: "\<forall> n. Re (trace (f n)) \<le> Re x \<and> Im x = 0" using assms by auto
 
   have "limit_mat f lowner_lub dim"  using lowner_lub_is_limit by auto
   then have conv: "(\<lambda>n. trace (f n)) \<longlonglongrightarrow> trace lowner_lub" using mat_trace_limit by auto
   then have "(\<lambda>n. Re (trace (f n))) \<longlonglongrightarrow> Re (trace lowner_lub)"
     by (simp add: tendsto_Re)
   then have Rell: "Re (trace lowner_lub) \<le> Re x"
     using lex Lim_bounded[of "(\<lambda>n. Re (trace (f n)))" "Re (trace lowner_lub)" 0 "Re x"] by simp
 
   from conv have "(\<lambda>n. Im (trace (f n))) \<longlonglongrightarrow> Im (trace lowner_lub)"
     by (simp add: tendsto_Im)
   then  have Imll: "Im (trace lowner_lub) = 0" using Re
     by (simp add: Lim_bounded Lim_bounded2 dual_order.antisym)
 
   from Rell Imll lex show ?thesis by simp
 qed
 
 lemma lowner_lub_is_positive:
   shows "positive lowner_lub"
   using lowner_lub_is_limit pos_mat_lim_is_pos pdo unfolding partial_density_operator_def by auto
 
 end
 
 subsection \<open>Finite sum of matrices\<close>
 
 text \<open>Add f in the interval [0, n)\<close>
 fun matrix_sum :: "nat \<Rightarrow> (nat \<Rightarrow> 'b::semiring_1 mat) \<Rightarrow> nat \<Rightarrow> 'b mat" where
   "matrix_sum d f 0 = 0\<^sub>m d d"
 | "matrix_sum d f (Suc n) = f n + matrix_sum d f n"
 
 definition matrix_inf_sum :: "nat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> complex mat" where
   "matrix_inf_sum d f = matrix_seq.lowner_lub (\<lambda>n. matrix_sum d f n)"
 
 lemma matrix_sum_dim:
   fixes f :: "nat \<Rightarrow> 'b::semiring_1 mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> matrix_sum d f n \<in> carrier_mat d d"
 proof (induct n)
   case 0
   show ?case by auto
 next
   case (Suc n)
   then have "f n \<in> carrier_mat d d" by auto
   then show ?case using Suc by auto
 qed
 
 lemma matrix_sum_cong:
   fixes f :: "nat \<Rightarrow> 'b::semiring_1 mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k = f' k) \<Longrightarrow> matrix_sum d f n = matrix_sum d f' n"
 proof (induct n)
   case 0
   show ?case by auto
 next
   case (Suc n)
   then show ?case unfolding matrix_sum.simps by auto
 qed
 
 lemma matrix_sum_add:
   fixes f :: "nat \<Rightarrow> 'b::semiring_1 mat" and  g :: "nat \<Rightarrow> 'b::semiring_1 mat" and  h :: "nat \<Rightarrow> 'b::semiring_1 mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> g k \<in> carrier_mat d d) \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> h k \<in> carrier_mat d d) \<Longrightarrow>
      (\<And>k. k < n \<Longrightarrow> f k = g k + h k) \<Longrightarrow> matrix_sum d f n = matrix_sum d g n + matrix_sum d h n"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   then show ?case
   proof -
     have gh: "matrix_sum d g n \<in> carrier_mat d d \<and> matrix_sum d h n \<in> carrier_mat d d"
       using matrix_sum_dim Suc(3, 4) by (simp add: matrix_sum_dim)
 
     have nSuc: "n < Suc n" by auto
     have sumf: "matrix_sum d f n = matrix_sum d g n + matrix_sum d h n" using Suc by auto
     have "matrix_sum d f (Suc n) = matrix_sum d g (Suc n) + matrix_sum d h (Suc n)"
       unfolding matrix_sum.simps Suc(5)[OF nSuc] sumf
       apply (mat_assoc d) using gh Suc by auto
     then show ?thesis by auto
   qed
 qed
 
 lemma matrix_sum_smult:
   fixes f :: "nat \<Rightarrow> 'b::semiring_1 mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow>
         matrix_sum d (\<lambda> k. c \<cdot>\<^sub>m f k) n = c \<cdot>\<^sub>m matrix_sum d f n"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   then show ?case
     apply auto
     using add_smult_distrib_left_mat Suc matrix_sum_dim
     by (metis lessI less_SucI)
 qed
 
 lemma matrix_sum_remove:
   fixes f :: "nat \<Rightarrow> 'b::semiring_1 mat"
   assumes j: "j < n"
     and df: "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d)"
     and f': "(\<And>k. f' k = (if k = j then 0\<^sub>m d d else f k))"
   shows "matrix_sum d f n = f j + matrix_sum d f' n"
 proof -
   have df': "\<And>k. k < n \<Longrightarrow> f' k \<in> carrier_mat d d" using f' df by auto
   have dsf: "k < n \<Longrightarrow> matrix_sum d f k \<in> carrier_mat d d" for k using matrix_sum_dim[OF df] by auto
   have dsf': "k < n \<Longrightarrow> matrix_sum d f' k \<in> carrier_mat d d" for k using matrix_sum_dim[OF df'] by auto
   have flj: "\<And>k. k < j \<Longrightarrow> f' k = f k" using j f' by auto
   then have "matrix_sum d f j = matrix_sum d f' j" using matrix_sum_cong[of j f' f, OF flj] df df' j by auto
   then have eqj: "matrix_sum d f (Suc j) = f j + matrix_sum d f' (Suc j)" unfolding matrix_sum.simps
     by (subst (1) f', simp add: df dsf' j)
   have lm: "(j + 1) + l \<le> n \<Longrightarrow> matrix_sum d f ((j + 1) + l) = f j + matrix_sum d f' ((j + 1) + l)" for l
   proof (induct l)
     case 0
     show ?case using j eqj by auto
   next
     case (Suc l) then have eq: "matrix_sum d f ((j + 1) + l) = f j + matrix_sum d f' ((j + 1) + l)" by auto
     have s: "((j + 1) + Suc l) = Suc ((j + 1) + l)" by simp
     have eqf': "f' (j + 1 + l) = f (j + 1 + l)" using f' Suc by auto
     have dims: "f (j + 1 + l) \<in> carrier_mat d d" "f j \<in> carrier_mat d d" "matrix_sum d f' (j + 1 + l) \<in> carrier_mat d d" using df df' dsf' Suc by auto
     show ?case apply (subst (1 2) s) unfolding matrix_sum.simps
       apply (subst eq, subst eqf')
       apply (mat_assoc d) using dims by auto
   qed
   have p: "(j + 1) + (n - j - 1) \<le> n" using j by auto
   show ?thesis using lm[OF p] j by auto
 qed
 
 lemma matrix_sum_Suc_remove_head:
   fixes f :: "nat \<Rightarrow> complex mat"
   shows "(\<And>k. k < n + 1 \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow>
     matrix_sum d f (n + 1) = f 0 + matrix_sum d (\<lambda>k. f (k + 1)) n"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   then have dSS: "\<And>k. k < Suc (Suc n) \<Longrightarrow> f k \<in> carrier_mat d d" by auto
   have ds: "matrix_sum d (\<lambda>k. f (k + 1)) n \<in> carrier_mat d d" using matrix_sum_dim[OF dSS, of "n" "\<lambda>k. k + 1"] by auto
   have "matrix_sum d f (Suc n + 1) = f (n + 1) + matrix_sum d f (n + 1)" by auto
   also have "\<dots> = f (n + 1) + (f 0 + matrix_sum d (\<lambda>k. f (k + 1)) n)" using Suc by auto
   also have "\<dots> = f 0 + (f (n + 1) + matrix_sum d (\<lambda>k. f (k + 1)) n)"
     using ds apply (mat_assoc d) using dSS by auto
   finally show ?case by auto
 qed
 
 lemma matrix_sum_positive:
   fixes f :: "nat \<Rightarrow> complex mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> positive (f k))
     \<Longrightarrow> positive (matrix_sum d f n)"
 proof (induct n)
   case 0
   show ?case using positive_zero by auto
 next
   case (Suc n)
   then have dfn: "f n \<in> carrier_mat d d" and psn: "positive (matrix_sum d f n)" and pn: "positive (f n)" and d: "k < n \<Longrightarrow> f k \<in> carrier_mat d d" for k by auto
   then have dsn: "matrix_sum d f n \<in> carrier_mat d d" using matrix_sum_dim by auto
   show ?case unfolding matrix_sum.simps using positive_add[OF pn psn dfn dsn] by auto
 qed
 
 lemma matrix_sum_mult_right:
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> A \<in> carrier_mat d d
     \<Longrightarrow> matrix_sum d (\<lambda>k. (f k) * A) n = matrix_sum d (\<lambda>k. f k) n * A"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   then have "k < n \<Longrightarrow> f k \<in> carrier_mat d d" and dfn: "f n \<in> carrier_mat d d" for k by auto
   then have dsfn: "matrix_sum d f n \<in> carrier_mat d d" using matrix_sum_dim by auto
   have "(f n + matrix_sum d f n) * A = f n * A + matrix_sum d f n * A"
     apply (mat_assoc d) using Suc dsfn by auto
   also have "\<dots> = f n * A + matrix_sum d (\<lambda>k. f k * A) n" using Suc by auto
   finally show ?case by auto
 qed
 
 lemma matrix_sum_add_distrib:
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> g k \<in> carrier_mat d d)
     \<Longrightarrow> matrix_sum d (\<lambda>k. (f k) + (g k)) n = matrix_sum d f n + matrix_sum d g n"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   then have dfn: "f n \<in> carrier_mat d d" and dgn: "g n \<in> carrier_mat d d"
     and dfk: "k < n \<Longrightarrow> f k \<in> carrier_mat d d" and dgk: "k < n \<Longrightarrow> g k \<in> carrier_mat d d"
     and eq: "matrix_sum d (\<lambda>k. f k + g k) n = matrix_sum d f n + matrix_sum d g n" for k by auto
   have dsf: "matrix_sum d f n \<in> carrier_mat d d" using matrix_sum_dim dfk by auto
   have dsg: "matrix_sum d g n \<in> carrier_mat d d" using matrix_sum_dim dgk by auto
   show ?case unfolding matrix_sum.simps eq
     using dfn dgn dsf dsg by (mat_assoc d)
 qed
 
 lemma matrix_sum_minus_distrib:
   fixes f g :: "nat \<Rightarrow> complex mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> g k \<in> carrier_mat d d)
     \<Longrightarrow> matrix_sum d (\<lambda>k. (f k) - (g k)) n = matrix_sum d f n - matrix_sum d g n"
 proof -
   have eq: "-1 \<cdot>\<^sub>m g k = - g k" for k by auto
   assume dfk: "\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d" and dgk: "\<And>k. k < n \<Longrightarrow> (g k) \<in> carrier_mat d d"
   then have "k < n \<Longrightarrow> (f k) - (g k) = (f k) + (- (g k))" for k by auto
   then have "matrix_sum d (\<lambda>k. (f k) - (g k)) n = matrix_sum d (\<lambda>k. (f k) + (- (g k))) n"
     using matrix_sum_cong[of n "\<lambda>k. (f k) - (g k)"] dfk dgk by auto
   also have "\<dots> = matrix_sum d f n + matrix_sum d (\<lambda>k. - (g k)) n"
     using matrix_sum_add_distrib[of n "f"] dfk dgk by auto
   also have "\<dots> = matrix_sum d f n - matrix_sum d g n"
     apply (subgoal_tac "matrix_sum d (\<lambda>k. - (g k)) n = - matrix_sum d g n", auto)
     apply (subgoal_tac "- 1 \<cdot>\<^sub>m matrix_sum d g n = - matrix_sum d g n")
     by (simp add: matrix_sum_smult[of n g d "-1", OF dgk, simplified eq, simplified], auto)
   finally show ?thesis .
 qed
 
 lemma matrix_sum_shift_Suc:
   shows "(\<And>k. k < (Suc n) \<Longrightarrow> f k \<in> carrier_mat d d)
     \<Longrightarrow> matrix_sum d f (Suc n) = f 0 + matrix_sum d (\<lambda>k. f (Suc k)) n"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   have dfk: "k < Suc (Suc n) \<Longrightarrow> f k \<in> carrier_mat d d" for k using Suc by auto
   have dsSk: "k < Suc n \<Longrightarrow> matrix_sum d (\<lambda>k. f (Suc k)) n \<in> carrier_mat d d" for k using matrix_sum_dim[of _ "\<lambda>k. f (Suc k)"] dfk by fastforce
   have "matrix_sum d f (Suc (Suc n)) = f (Suc n) + matrix_sum d f (Suc n)" by auto
   also have "\<dots> = f (Suc n) + f 0 + matrix_sum d (\<lambda>k. f (Suc k)) n" using Suc dsSk assoc_add_mat[of "f (Suc n)" d d "f 0"] by fastforce
   also have "\<dots> = f 0 + (f (Suc n) + matrix_sum d (\<lambda>k. f (Suc k)) n)" apply (mat_assoc d) using dsSk dfk by auto
   also have "\<dots> = f 0 + matrix_sum d (\<lambda>k. f (Suc k)) (Suc n)"  by auto
   finally show ?case .
 qed
 
 lemma lowner_le_matrix_sum:
   fixes f g :: "nat \<Rightarrow> complex mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> g k \<in> carrier_mat d d)
     \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> f k \<le>\<^sub>L g k)
     \<Longrightarrow> matrix_sum d f n \<le>\<^sub>L matrix_sum d g n"
 proof (induct n)
   case 0
   show ?case unfolding matrix_sum.simps using lowner_le_refl[of "0\<^sub>m d d" d] by auto
 next
   case (Suc n)
   then have dfn: "f n \<in> carrier_mat d d" and dgn: "g n \<in> carrier_mat d d" and le1: "f n \<le>\<^sub>L g n" by auto
   then have le2: "matrix_sum d f n \<le>\<^sub>L matrix_sum d g n" using Suc by auto
   have "k < n \<Longrightarrow> f k \<in> carrier_mat d d" for k using Suc by auto
   then have dsf: "matrix_sum d f n \<in> carrier_mat d d" using matrix_sum_dim by auto
   have "k < n \<Longrightarrow> g k \<in> carrier_mat d d" for k using Suc by auto
   then have dsg: "matrix_sum d g n \<in> carrier_mat d d" using matrix_sum_dim by auto
   show ?case unfolding matrix_sum.simps using lowner_le_add dfn dsf dgn dsg le1 le2 by auto
 qed
 
 lemma lowner_lub_add:
   assumes "matrix_seq d f" "matrix_seq d g" "\<forall> n. trace (f n + g n) \<le> 1"
   shows "matrix_seq.lowner_lub (\<lambda>n. f n + g n) = matrix_seq.lowner_lub f + matrix_seq.lowner_lub g"
 proof -
   have msf: "matrix_seq.lowner_is_lub f (matrix_seq.lowner_lub f)" using assms(1) matrix_seq.lowner_lub_prop by auto
   then have "limit_mat f (matrix_seq.lowner_lub f) d" using matrix_seq.lowner_lub_is_limit assms by auto
   then have lim1: "\<forall>i<d. \<forall>j<d. (\<lambda>n. f n $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub f) $$ (i, j)" using limit_mat_def assms by auto
 
   have msg: "matrix_seq.lowner_is_lub g (matrix_seq.lowner_lub g)" using assms(2) matrix_seq.lowner_lub_prop by auto
   then have "limit_mat g (matrix_seq.lowner_lub g) d" using matrix_seq.lowner_lub_is_limit assms by auto
   then have lim2: "\<forall>i<d. \<forall>j<d. (\<lambda>n. g n $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub g) $$ (i, j)" using limit_mat_def assms by auto
 
   have "\<forall>n. f n + g n \<in> carrier_mat d d" using assms unfolding matrix_seq_def by fastforce
   moreover have "\<forall>n. partial_density_operator (f n + g n)" using assms
     unfolding matrix_seq_def partial_density_operator_def using positive_add by blast
   moreover have "(f n + g n) \<le>\<^sub>L (f (Suc n) + g (Suc n))" for n
     using assms
     unfolding matrix_seq_def using lowner_le_add[of "f n" d  "f (Suc n)" "g n" "g (Suc n)"] by auto
   ultimately have msfg: "matrix_seq d (\<lambda>n. f n + g n)" using assms unfolding matrix_seq_def by auto
   then have mslfg: "matrix_seq.lowner_is_lub (\<lambda>n. f n + g n) (matrix_seq.lowner_lub (\<lambda>n. f n + g n))"
     using matrix_seq.lowner_lub_prop by auto
   then have "limit_mat (\<lambda>n. f n + g n) (matrix_seq.lowner_lub (\<lambda>n. f n + g n)) d" using matrix_seq.lowner_lub_is_limit msfg by auto
   then have lim3: "\<forall>i<d. \<forall>j<d. (\<lambda>n. (f n + g n) $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub (\<lambda>n. f n + g n)) $$ (i, j)" using limit_mat_def assms by auto
 
   have "\<forall> i<d. \<forall> j<d. \<forall> n. (f n + g n) $$ (i, j) = f n $$ (i, j) + g n $$ (i, j)" using assms unfolding matrix_seq_def
     by (metis carrier_matD(1) carrier_matD(2) index_add_mat(1))
   then have add: "\<forall>i<d. \<forall>j<d. (\<lambda>n. f n $$ (i, j) + g n $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub (\<lambda>n. f n + g n)) $$ (i, j)" using lim3 by auto
   have "matrix_seq.lowner_lub f $$ (i, j) + matrix_seq.lowner_lub g $$ (i, j) = matrix_seq.lowner_lub (\<lambda>n. f n + g n) $$ (i, j)"
     if i: "i < d" and j: "j < d" for i j
   proof -
     have "(\<lambda>n. f n $$ (i, j)) \<longlonglongrightarrow> matrix_seq.lowner_lub f $$ (i, j)" using lim1 i j by auto
     moreover have "(\<lambda>n. g n $$ (i, j)) \<longlonglongrightarrow> matrix_seq.lowner_lub g $$ (i, j)" using lim2 i j by auto
     ultimately have "(\<lambda>n. f n $$ (i, j) + g n $$ (i, j)) \<longlonglongrightarrow> matrix_seq.lowner_lub f $$ (i, j) + matrix_seq.lowner_lub g $$ (i, j)"
-      using tendsto_intros(12)[of "\<lambda>n. f n $$ (i, j)" "matrix_seq.lowner_lub f $$ (i, j)" sequentially "\<lambda>n. g n $$ (i, j)" "matrix_seq.lowner_lub g $$ (i, j)"] by auto
+      using tendsto_add[of "\<lambda>n. f n $$ (i, j)" "matrix_seq.lowner_lub f $$ (i, j)" sequentially "\<lambda>n. g n $$ (i, j)" "matrix_seq.lowner_lub g $$ (i, j)"] by auto
     moreover have "(\<lambda>n. f n $$ (i, j) + g n $$ (i, j)) \<longlonglongrightarrow> matrix_seq.lowner_lub (\<lambda>n. f n + g n) $$ (i, j)"  using add i j by auto
     ultimately show ?thesis using LIMSEQ_unique by auto
   qed
   moreover have "matrix_seq.lowner_lub f \<in> carrier_mat d d" using matrix_seq.lowner_is_lub_dim assms(1) msf unfolding matrix_seq_def by auto
   moreover have "matrix_seq.lowner_lub g \<in> carrier_mat d d" using matrix_seq.lowner_is_lub_dim assms(2) msg unfolding matrix_seq_def by auto
   moreover have "matrix_seq.lowner_lub (\<lambda>n. f n + g n) \<in> carrier_mat d d" using matrix_seq.lowner_is_lub_dim  msfg mslfg unfolding matrix_seq_def by auto
   ultimately show ?thesis  unfolding matrix_seq_def using mat_eq_iff by auto
 qed
 
 lemma lowner_lub_scale:
   fixes c :: real
   assumes "matrix_seq d f"  "\<forall> n. trace (c \<cdot>\<^sub>m f n) \<le> 1"  "c\<ge>0"
   shows "matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n) = c \<cdot>\<^sub>m matrix_seq.lowner_lub f"
 proof -
   have msf: "matrix_seq.lowner_is_lub f (matrix_seq.lowner_lub f)"
     using assms(1) matrix_seq.lowner_lub_prop by auto
   then have "limit_mat f (matrix_seq.lowner_lub f) d"
     using matrix_seq.lowner_lub_is_limit assms by auto
   then have lim1: "\<forall>i<d. \<forall>j<d. (\<lambda>n. f n $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub f) $$ (i, j)"
     using limit_mat_def assms by auto
 
   have dimcf: "\<forall>n. c \<cdot>\<^sub>m f n \<in> carrier_mat d d" using assms unfolding matrix_seq_def by fastforce
   moreover have "\<forall>n. partial_density_operator (c \<cdot>\<^sub>m f n)" using assms
     unfolding matrix_seq_def partial_density_operator_def using positive_scale by blast
   moreover have "\<forall>n.  c \<cdot>\<^sub>m f n \<le>\<^sub>L  c \<cdot>\<^sub>m f (Suc n)" using lowner_le_smult assms(1,3)
     unfolding matrix_seq_def partial_density_operator_def by blast
   ultimately have mscf: "matrix_seq d (\<lambda>n. c \<cdot>\<^sub>m f n)"  unfolding matrix_seq_def by auto
   then have mslfg: "matrix_seq.lowner_is_lub (\<lambda>n. c \<cdot>\<^sub>m f n) (matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n))"
     using matrix_seq.lowner_lub_prop by auto
   then have "limit_mat (\<lambda>n. c \<cdot>\<^sub>m f n) (matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n)) d"
     using matrix_seq.lowner_lub_is_limit mscf by auto
   then have lim3: "\<forall>i<d. \<forall>j<d. (\<lambda>n. (c \<cdot>\<^sub>m f n) $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n)) $$ (i, j)"
     using limit_mat_def assms by auto
 
   from mslfg mscf have dleft: "matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n) \<in> carrier_mat d d"
     using matrix_seq.lowner_is_lub_dim by auto
   have dllf: "matrix_seq.lowner_lub f \<in> carrier_mat d d"
     using matrix_seq.lowner_is_lub_dim assms(1) msf unfolding matrix_seq_def by auto
   then  have dright: "c \<cdot>\<^sub>m matrix_seq.lowner_lub f \<in> carrier_mat d d" using index_smult_mat(2,3) by auto
   have "\<forall> i<d. \<forall> j<d. \<forall> n. (c \<cdot>\<^sub>m f n) $$ (i, j) = c * f n $$ (i, j)"
     using assms(1) unfolding matrix_seq_def using index_smult_mat(1)
     by (metis carrier_matD(1-2))
   then have smult: "\<forall>i<d. \<forall>j<d. (\<lambda>n.  c * f n $$ (i, j)) \<longlonglongrightarrow> (matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n)) $$ (i, j)"
     using lim3 by auto
   have ij: "(c \<cdot>\<^sub>m matrix_seq.lowner_lub f) $$ (i, j) = (matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m f n)) $$ (i, j)"
     if i: "i < d" and j: "j < d" for i j
   proof -
     have "(\<lambda>n. f n $$ (i, j)) \<longlonglongrightarrow> matrix_seq.lowner_lub f $$ (i, j)" using lim1 i j by auto
     moreover have "\<forall>i<d. \<forall>j<d.(c \<cdot>\<^sub>m matrix_seq.lowner_lub f) $$ (i, j) =  c *  matrix_seq.lowner_lub f $$ (i, j)"
       using index_smult_mat dllf by fastforce
     ultimately have "\<forall>i<d. \<forall>j<d. (\<lambda>n.  c * f n $$ (i, j)) \<longlonglongrightarrow>(c \<cdot>\<^sub>m matrix_seq.lowner_lub f) $$ (i, j)"
       using tendsto_intros(18)[of "\<lambda>n. c" "c" sequentially "\<lambda>n. f n $$ (i, j)" "matrix_seq.lowner_lub f $$ (i, j)"] i j
       by (simp add: lim1 tendsto_mult_left)
     then show ?thesis using smult i j LIMSEQ_unique by metis
   qed
 
   from dleft dright ij show ?thesis
     using mat_eq_iff[of "matrix_seq.lowner_lub  (\<lambda>n. c \<cdot>\<^sub>m f n)" "c \<cdot>\<^sub>m matrix_seq.lowner_lub f"]
     by (metis (mono_tags) carrier_matD(1) carrier_matD(2))
 qed
 
 lemma trace_matrix_sum_linear:
   fixes f :: "nat \<Rightarrow> complex mat"
   shows "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> trace (matrix_sum d f n) = sum (\<lambda>k. trace (f k)) {0..<n}"
 proof (induct n)
   case 0
   show ?case by auto
 next
   case (Suc n)
   then have "\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d" by auto
   then have ds: "matrix_sum d f n \<in> carrier_mat d d" using matrix_sum_dim by auto
   have "trace (matrix_sum d f (Suc n)) = trace (f n) + trace (matrix_sum d f n)"
     unfolding matrix_sum.simps apply (mat_assoc d) using ds Suc by auto
   also have "\<dots> = sum (trace \<circ> f) {0..<n} + (trace \<circ> f) n" using Suc by auto
   also have "\<dots> = sum (trace \<circ> f) {0..<Suc n}" by auto
   finally show ?case by auto
 qed
 
 lemma matrix_sum_distrib_left:
   fixes f :: "nat \<Rightarrow> complex mat"
   shows "P \<in> carrier_mat d d \<Longrightarrow> (\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d) \<Longrightarrow> matrix_sum d (\<lambda>k. P * (f k)) n = P * (matrix_sum d f n)"
 proof (induct n)
   case 0
   show ?case unfolding matrix_sum.simps using 0 by auto
 next
   case (Suc n)
   then have "\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d" by auto
   then have ds: "matrix_sum d f n \<in> carrier_mat d d" using matrix_sum_dim by auto
   then have dPf: "\<And>k. k < n \<Longrightarrow> P * f k \<in> carrier_mat d d" using Suc by auto
   then have "matrix_sum d (\<lambda>k. P * f k) n \<in> carrier_mat d d" using matrix_sum_dim[OF dPf] by auto
   have "matrix_sum d (\<lambda>k. P * f k) (Suc n) = P * f n + matrix_sum d (\<lambda>k. P * f k) n " unfolding matrix_sum.simps using Suc(2) by auto
   also have "\<dots> = P * f n + P * matrix_sum d f n" using Suc by auto
   also have "\<dots> = P * (f n + matrix_sum d f n)" apply (mat_assoc d) using ds dPf Suc by auto
   finally show "matrix_sum d (\<lambda>k. P * f k) (Suc n) = P * (matrix_sum d f (Suc n))" by auto
 qed
 
 subsection \<open>Measurement\<close>
 
 definition measurement :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> bool" where
   "measurement d n M \<longleftrightarrow> (\<forall>j < n. M j \<in> carrier_mat d d)
                         \<and> matrix_sum d (\<lambda>j. (adjoint (M j)) * M j) n = 1\<^sub>m d"
 
 lemma measurement_dim:
   assumes "measurement d n M"
   shows "\<And>k. k < n \<Longrightarrow> (M k) \<in> carrier_mat d d"
   using assms unfolding measurement_def by auto
 
 lemma measurement_id2:
   assumes "measurement d 2 M"
   shows "adjoint (M 0) * M 0 + adjoint (M 1) * M 1 = 1\<^sub>m d"
 proof -
   have ssz: "(Suc (Suc 0)) = 2" by auto
   have "M 0 \<in> carrier_mat d d" "M 1 \<in> carrier_mat d d" using assms measurement_def by auto
   then have "adjoint (M 0) * M 0 + adjoint (M 1) * M 1 = matrix_sum d (\<lambda>j. (adjoint (M j)) * M j) (Suc (Suc 0)) "
     by auto
   also have "\<dots> = matrix_sum d (\<lambda>j. (adjoint (M j)) * M j) (2::nat)" by (subst ssz, auto)
   also have "\<dots> = 1\<^sub>m d" using measurement_def[of d 2 M] assms by auto
   finally show ?thesis by auto
 qed
 
 text \<open>Result of measurement on $\rho$ by matrix M\<close>
 definition measurement_res :: "complex mat \<Rightarrow> complex mat \<Rightarrow> complex mat" where
   "measurement_res M \<rho> = M * \<rho> * adjoint M"
 
 lemma add_positive_le_reduce1:
   assumes dA: "A \<in> carrier_mat n n" and dB: "B \<in> carrier_mat n n" and dC: "C \<in> carrier_mat n n"
     and pB: "positive B" and le: "A + B \<le>\<^sub>L C"
   shows "A \<le>\<^sub>L C"
   unfolding lowner_le_def positive_def
 proof (auto simp add: carrier_matD[OF dA] carrier_matD[OF dC] simp del: less_eq_complex_def)
   have eq: "C - (A + B) = (C - A + (-B))" using dA dB dC by auto
   have "positive (C - (A + B))" using le lowner_le_def dA dB dC by auto
   with eq have p: "positive (C - A + (-B))" by auto
   fix v :: "complex vec" assume " n = dim_vec v"
   then have dv: "v \<in> carrier_vec n" by auto
   have ge: "inner_prod v (B *\<^sub>v v) \<ge> 0" using pB dv dB positive_def by auto
   have "0 \<le> inner_prod v ((C - A + (-B)) *\<^sub>v v) " using p positive_def dv dA dB dC by auto
   also have "\<dots> = inner_prod v ((C - A)*\<^sub>v v + (-B) *\<^sub>v v) "
     using dv dA dB dC add_mult_distrib_mat_vec[OF minus_carrier_mat[OF dA]] by auto
   also have "\<dots> = inner_prod v ((C - A) *\<^sub>v v) + inner_prod v ((-B) *\<^sub>v v)"
     apply (subst inner_prod_distrib_right)
     by (rule dv, auto simp add: mult_mat_vec_carrier[OF minus_carrier_mat[OF dA]] mult_mat_vec_carrier[OF uminus_carrier_mat[OF dB]] dv)
   also have "\<dots> = inner_prod v ((C - A) *\<^sub>v v) - inner_prod v (B *\<^sub>v v)" using dB dv by auto
   also have "\<dots> \<le> inner_prod v ((C - A) *\<^sub>v v)" using ge by auto
   finally show "0 \<le> inner_prod v ((C - A) *\<^sub>v v)".
 qed
 
 lemma add_positive_le_reduce2:
   assumes dA: "A \<in> carrier_mat n n" and dB: "B \<in> carrier_mat n n" and dC: "C \<in> carrier_mat n n"
     and pB: "positive B" and le: "B + A \<le>\<^sub>L C"
   shows "A \<le>\<^sub>L C"
   apply (subgoal_tac "B + A = A + B") using add_positive_le_reduce1[of A n B C] assms by auto
 
 lemma measurement_le_one_mat:
   assumes "measurement d n f"
   shows "\<And>j. j < n \<Longrightarrow> adjoint (f j) * f j \<le>\<^sub>L 1\<^sub>m d"
 proof -
   fix j assume j: "j < n"
   define M where "M = adjoint (f j) * f j"
   have df: "k < n \<Longrightarrow> f k \<in> carrier_mat d d" for k using assms measurement_dim by auto
   have daf: "k < n \<Longrightarrow> adjoint (f k) * f k \<in> carrier_mat d d" for k
   proof -
     assume "k < n"
     then have "f k \<in> carrier_mat d d" "adjoint (f k) \<in> carrier_mat d d" using df adjoint_dim by auto
     then show "adjoint (f k) * f k \<in> carrier_mat d d" by auto
   qed
   have pafj: "k < n \<Longrightarrow> positive (adjoint (f k) * (f k)) "  for k
     apply (subst (2) adjoint_adjoint[of "f k", symmetric])
     by (metis adjoint_adjoint daf positive_if_decomp)
   define f' where "\<And>k. f' k = (if k = j then 0\<^sub>m d d else adjoint (f k) * f k)"
   have pf': "k < n \<Longrightarrow> positive (f' k)" for k unfolding f'_def using positive_zero pafj j by auto
   have df': "k < n \<Longrightarrow> f' k \<in> carrier_mat d d" for k using daf j zero_carrier_mat f'_def by auto
   then have dsf': "matrix_sum d f' n \<in> carrier_mat d d" using matrix_sum_dim[of n f' d] by auto
   have psf': "positive (matrix_sum d f' n)" using matrix_sum_positive pafj df' pf' by auto
   have "M + matrix_sum d f' n = matrix_sum d (\<lambda>k. adjoint (f k) * f k) n"
     using matrix_sum_remove[OF j , of "(\<lambda>k. adjoint (f k) * f k)", OF daf, of f'] f'_def unfolding M_def by auto
   also have "\<dots> = 1\<^sub>m d" using measurement_def assms by auto
   finally have "M + matrix_sum d f' n = 1\<^sub>m d".
   moreover have "1\<^sub>m d \<le>\<^sub>L 1\<^sub>m d" using lowner_le_refl[of _ d] by auto
   ultimately have "(M + matrix_sum d f' n) \<le>\<^sub>L 1\<^sub>m d" by auto
   then show "M \<le>\<^sub>L 1\<^sub>m d" unfolding M_def using add_positive_le_reduce1[OF _ dsf' one_carrier_mat psf'] daf j by auto
 qed
 
 lemma pdo_close_under_measurement:
   fixes M \<rho> :: "complex mat"
   assumes dM: "M \<in> carrier_mat n n" and dr: "\<rho> \<in> carrier_mat n n"
     and pdor: "partial_density_operator \<rho>"
     and le: "adjoint M * M \<le>\<^sub>L 1\<^sub>m n"
   shows "partial_density_operator (M * \<rho> * adjoint M)"
   unfolding partial_density_operator_def
 proof
   show "positive (M * \<rho> * adjoint M)"
     using positive_close_under_left_right_mult_adjoint[OF dM dr] pdor partial_density_operator_def by auto
 next
   have daM: "adjoint M \<in> carrier_mat n n" using dM by auto
   then have daMM: "adjoint M * M \<in> carrier_mat n n" using dM by auto
   have "trace (M * \<rho> * adjoint M) = trace (adjoint M * M * \<rho>)"
     using dM dr by (mat_assoc n)
   also have "\<dots> \<le> trace (1\<^sub>m n * \<rho>)"
     using lowner_le_trace[where ?B = "1\<^sub>m n" and ?A = "adjoint M * M", OF daMM one_carrier_mat] le dr pdor by auto
   also have "\<dots> = trace \<rho>" using dr by auto
   also have "\<dots> \<le> 1" using pdor partial_density_operator_def by auto
   finally show "trace (M * \<rho> * adjoint M) \<le> 1" by auto
 qed
 
 lemma trace_measurement:
   assumes m: "measurement d n M" and dA: "A \<in> carrier_mat d d"
   shows "trace (matrix_sum d (\<lambda>k. (M k) * A * adjoint (M k)) n) = trace A"
 proof -
   have dMk: "k < n \<Longrightarrow> (M k) \<in> carrier_mat d d" for k using m unfolding measurement_def by auto
   then have daMk: "k < n \<Longrightarrow> adjoint (M k) \<in> carrier_mat d d" for k using m adjoint_dim unfolding measurement_def by auto
   have d1: "k < n \<Longrightarrow> M k * A * adjoint (M k) \<in> carrier_mat d d"for k using dMk daMk dA by fastforce
   then have ds1: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. M k * A * adjoint (M k)) k \<in> carrier_mat d d" for k
     using matrix_sum_dim[of k "\<lambda>k. M k * A * adjoint (M k)" d] by auto
   have d2: "k < n \<Longrightarrow> adjoint (M k) *M k * A  \<in> carrier_mat d d" for k using daMk dMk dA by fastforce
   then have ds2: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. adjoint (M k) *M k * A) k \<in> carrier_mat d d" for k
     using matrix_sum_dim[of k "\<lambda>k. adjoint (M k) *M k * A" d] by auto
   have daMMk: "k < n \<Longrightarrow> adjoint (M k) * M k \<in> carrier_mat d d" for k using dMk by fastforce
   have "k \<le> n \<Longrightarrow> trace (matrix_sum d (\<lambda>k. (M k) * A * adjoint (M k)) k) = trace (matrix_sum d (\<lambda>k. adjoint (M k) * (M k) * A) k)" for k
   proof (induct k)
     case 0
     then show ?case by auto
   next
     case (Suc k)
     then have k: "k < n" by auto
     have "trace (M k * A * adjoint (M k)) = trace (adjoint (M k) * M k * A)"
       using dA apply (mat_assoc d) using dMk k by auto
     then show ?case unfolding matrix_sum.simps using ds1 ds2 d1 d2 k Suc daMk dMk dA
       by (subst trace_add_linear[of _ d], auto)+
   qed
   then have "trace (matrix_sum d (\<lambda>k. (M k) * A * adjoint (M k)) n) = trace (matrix_sum d (\<lambda>k. adjoint (M k) * (M k) * A) n)" by auto
   also have "\<dots> = trace (matrix_sum d (\<lambda>k. adjoint (M k) * (M k)) n * A)" using matrix_sum_mult_right[OF daMMk, of n id A] dA by auto
   also have "\<dots> = trace A" using m dA unfolding measurement_def by auto
   finally show ?thesis by auto
 qed
 
 lemma mat_inc_seq_positive_transform:
   assumes dfn: "\<And>n. f n \<in> carrier_mat d d"
     and inc: "\<And>n. f n \<le>\<^sub>L f (Suc n)"
   shows "\<And>n. f n - f 0 \<in> carrier_mat d d" and "\<And>n. (f n - f 0) \<le>\<^sub>L (f (Suc n) - f 0)"
 proof -
   show "\<And>n. f n - f 0 \<in> carrier_mat d d" using dfn by fastforce
   have "f 0 \<le>\<^sub>L f 0" using lowner_le_refl[of "f 0" d] dfn by auto
   then show "(f n - f 0) \<le>\<^sub>L (f (Suc n) - f 0)" for n
     using lowner_le_minus[of "f n" d "f (Suc n)" "f 0" "f 0"] dfn inc by fastforce
 qed
 
 lemma mat_inc_seq_lub:
   assumes dfn: "\<And>n. f n \<in> carrier_mat d d"
     and inc: "\<And>n. f n \<le>\<^sub>L f (Suc n)"
     and ub: "\<And>n. f n \<le>\<^sub>L A"
   shows "\<exists>B. lowner_is_lub f B \<and> limit_mat f B d"
 proof -
   have dmfn0: "\<And>n. f n - f 0 \<in> carrier_mat d d" and incm0: "\<And>n. (f n - f 0) \<le>\<^sub>L (f (Suc n) - f 0)"
     using mat_inc_seq_positive_transform[OF dfn, of id] assms by auto
   define c where "c = 1 / (trace (A - f 0) + 1)"
   have "f 0 \<le>\<^sub>L A" using ub by auto
   then have dA: "A \<in> carrier_mat d d" using ub unfolding lowner_le_def using dfn[of 0] by fastforce
   then have dAmf0: "A - f 0 \<in> carrier_mat d d" using dfn[of 0] by auto
   have "positive (A - f 0)" using ub lowner_le_def by auto
   then have tgeq0: "trace (A - f 0) \<ge> 0" using positive_trace dAmf0 by auto
   then have "trace (A - f 0) + 1 > 0" by auto
   then have gtc: "c > 0" unfolding c_def using complex_is_Real_iff by auto
   then have gtci: "(1 / c) > 0" using complex_is_Real_iff by auto
 
   have "trace (c \<cdot>\<^sub>m (A - f 0)) = c * trace (A - f 0)"
     using trace_smult dAmf0 by auto
   also have "\<dots> = (1 / (trace (A - f 0) + 1)) * trace (A - f 0)" unfolding c_def by auto
   also have "\<dots> < 1" using tgeq0 by (simp add: complex_is_Real_iff)
   finally have lt1: "trace (c \<cdot>\<^sub>m (A - f 0)) < 1".
 
   have le0: "- f 0 \<le>\<^sub>L - f 0" using lowner_le_refl[of "- f 0" d] dfn by auto
 
   have dmf0: "- f 0 \<in> carrier_mat d d" using dfn by auto
   have mf0smcle: "(c \<cdot>\<^sub>m (X - f 0)) \<le>\<^sub>L (c \<cdot>\<^sub>m (Y - f 0))" if "X \<le>\<^sub>L Y" and "X \<in> carrier_mat d d" and "Y \<in> carrier_mat d d" for X Y
   proof -
     have "(X - f 0) \<le>\<^sub>L (Y - f 0)"
       using lowner_le_minus[of "X" d "Y" "f 0" "f 0"] that dfn lowner_le_refl by auto
     then show ?thesis using lowner_le_smultc[of c "(X - f 0)" "Y - f 0" d] using that dfn gtc by fastforce
   qed
   have "(c \<cdot>\<^sub>m (f n - f 0)) \<le>\<^sub>L (c \<cdot>\<^sub>m (A - f 0))" for n
     using mf0smcle ub dfn dA by auto
   then have "trace (c \<cdot>\<^sub>m (f n - f 0)) \<le> trace (c \<cdot>\<^sub>m (A - f 0))" for n
     using lowner_le_imp_trace_le[of "c \<cdot>\<^sub>m (f n - f 0)" d] dmfn0 dAmf0 by auto
   then have trlt1: "trace (c \<cdot>\<^sub>m (f n - f 0)) < 1" for n using lt1 by fastforce
 
   have "f 0 \<le>\<^sub>L f n" for n
   proof (induct n)
     case 0
     then show ?case using dfn lowner_le_refl by auto
   next
     case (Suc n)
     then show ?case using dfn lowner_le_trans[of "f 0" d "f n"] inc by auto
   qed
   then have "positive (f n - f 0)" for n using lowner_le_def by auto
   then have p: "positive (c \<cdot>\<^sub>m (f n - f 0))" for n 
     by (intro positive_smult, insert gtc dmfn0, auto)
 
   have inc': "c \<cdot>\<^sub>m (f n - f 0) \<le>\<^sub>L c \<cdot>\<^sub>m (f (Suc n) - f 0)" for n
     using incm0 lowner_le_smultc[of c "f n - f 0"] gtc dmfn0 by fastforce
 
   define g where "g n = c \<cdot>\<^sub>m (f n - f 0)" for n
   then have "positive (g n)" and "trace (g n) < 1" and "(g n) \<le>\<^sub>L (g (Suc n))" and dgn: "(g n) \<in> carrier_mat d d" for n
     unfolding g_def using p trlt1 inc' dmfn0 by auto
   then have ms: "matrix_seq d g" unfolding matrix_seq_def partial_density_operator_def by fastforce
   then have uniM: "\<exists>!M. matrix_seq.lowner_is_lub g M" using matrix_seq.lowner_lub_unique by auto
   then obtain M where M: "matrix_seq.lowner_is_lub g M" by auto
   then have leg: "g n \<le>\<^sub>L M" and lubg: "\<And>M'. (\<forall>n. g n \<le>\<^sub>L M') \<longrightarrow> M \<le>\<^sub>L M'" for n
     unfolding matrix_seq.lowner_is_lub_def[OF ms] by auto
   have "M = matrix_seq.lowner_lub g"
     using matrix_seq.lowner_lub_def[OF ms] M uniM theI_unique[of "matrix_seq.lowner_is_lub g"] by auto
   then have limg: "limit_mat g M d" using M matrix_seq.lowner_lub_is_limit[OF ms] by auto
   then have dM: "M \<in> carrier_mat d d" unfolding limit_mat_def by auto
 
   define B where "B = f 0 + (1 / c) \<cdot>\<^sub>m M"
   have eqinv: "f 0 + (1 / c) \<cdot>\<^sub>m (c \<cdot>\<^sub>m (X - f 0)) = X" if "X \<in> carrier_mat d d" for X
   proof -
     have "f 0 + (1 / c) \<cdot>\<^sub>m (c \<cdot>\<^sub>m (X - f 0)) = f 0 + (1 / c * c) \<cdot>\<^sub>m (X - f 0)"
       apply (subgoal_tac "(1 / c) \<cdot>\<^sub>m (c \<cdot>\<^sub>m (X - f 0)) = (1 / c * c) \<cdot>\<^sub>m (X - f 0)", simp)
       using smult_smult_mat dfn that by auto
     also have "\<dots> = f 0 + 1 \<cdot>\<^sub>m (X - f 0)" using gtc by auto
     also have "\<dots> = f 0 + (X - f 0)" by auto
     also have "\<dots> = (- f 0) + f 0 + X" apply (mat_assoc d) using that dfn by auto
     also have "\<dots> = 0\<^sub>m d d + X" using dfn uminus_l_inv_mat[of "f 0" d d] by fastforce
     also have "\<dots> = X" using that by auto
     finally show ?thesis by auto
   qed
   have "limit_mat (\<lambda>n. (1 / c) \<cdot>\<^sub>m g n) ((1 / c) \<cdot>\<^sub>m M) d" using limit_mat_scale[OF limg] gtci by auto
   then have "limit_mat (\<lambda>n. f 0 + (1 / c) \<cdot>\<^sub>m g n) (f 0 + (1 / c) \<cdot>\<^sub>m M ) d"
     using mat_add_limit[of "f 0"] limg dfn unfolding mat_add_seq_def by auto
   then have limf: "limit_mat f B d" using eqinv[OF dfn] unfolding B_def g_def by auto
 
   have f0acmcile: "(f 0 + (1 / c) \<cdot>\<^sub>m X) \<le>\<^sub>L (f 0 + (1 / c) \<cdot>\<^sub>m Y )" if "X \<le>\<^sub>L Y" and "X \<in> carrier_mat d d" and "Y \<in> carrier_mat d d" for X Y
   proof -
     have "((1 / c) \<cdot>\<^sub>m X) \<le>\<^sub>L ((1 / c) \<cdot>\<^sub>m Y)"
       using lowner_le_smultc[of "1/c"] that gtci by fastforce
     then show "(f 0 + (1 / c) \<cdot>\<^sub>m X) \<le>\<^sub>L (f 0 + (1 / c) \<cdot>\<^sub>m Y)"
       using lowner_le_add[of _ d _ "(1 / c) \<cdot>\<^sub>m X" "(1 / c) \<cdot>\<^sub>m Y"]
         that gtci dfn lowner_le_refl[of "f 0", OF dfn] by fastforce
   qed
 
   have "(f 0 + (1 / c) \<cdot>\<^sub>m g n) \<le>\<^sub>L (f 0 + (1 / c) \<cdot>\<^sub>m M )" for n
     using f0acmcile[OF leg dgn dM] by auto
   then have lubf: "f n \<le>\<^sub>L B" for n using eqinv[OF dfn] g_def B_def by auto
 
   {
     fix B' assume asm: "\<forall>n. f n \<le>\<^sub>L B'"
     then have "f 0 \<le>\<^sub>L B'" by auto
     then have dB': "B' \<in> carrier_mat d d" unfolding lowner_le_def using dfn[of 0] by auto
     have "f n \<le>\<^sub>L B'" for n using asm by auto
     then have "(c \<cdot>\<^sub>m (f n - f 0)) \<le>\<^sub>L (c \<cdot>\<^sub>m (B' - f 0))" for n
       using mf0smcle[of "f n" B'] dfn dB' by auto
     then have "g n \<le>\<^sub>L (c \<cdot>\<^sub>m (B' - f 0))" for n using g_def by auto
     then have "M \<le>\<^sub>L  (c \<cdot>\<^sub>m (B' - f 0))" using lubg by auto
     then have "(f 0 + (1 / c) \<cdot>\<^sub>m M) \<le>\<^sub>L (f 0 + (1 / c) \<cdot>\<^sub>m (c \<cdot>\<^sub>m (B' - f 0)))"
       using f0acmcile[of "M" "(c \<cdot>\<^sub>m (B' - f 0))", OF _ dM] using dB' dfn by fastforce
     then have "B \<le>\<^sub>L B'" unfolding B_def using eqinv[OF dB'] by auto
   }
   with limf lubf have "((\<forall>n. f n \<le>\<^sub>L B) \<and> (\<forall>M'. (\<forall>n. f n \<le>\<^sub>L M') \<longrightarrow> B \<le>\<^sub>L M')) \<and> limit_mat f B d" by auto
   then show ?thesis unfolding lowner_is_lub_def by auto
 qed
 
 end
diff --git a/thys/QHLProver/Quantum_Hoare.thy b/thys/QHLProver/Quantum_Hoare.thy
--- a/thys/QHLProver/Quantum_Hoare.thy
+++ b/thys/QHLProver/Quantum_Hoare.thy
@@ -1,1417 +1,1417 @@
 section \<open>Partial and total correctness\<close>
 
 theory Quantum_Hoare
   imports Quantum_Program
 begin
 
 context state_sig
 begin
 
 definition density_states :: "state set" where
   "density_states = {\<rho> \<in> carrier_mat d d. partial_density_operator \<rho>}"
 
 lemma denote_density_states:
   "\<rho> \<in> density_states \<Longrightarrow> well_com S \<Longrightarrow> denote S \<rho> \<in> density_states"
   by (simp add: denote_dim_pdo density_states_def)
 
 definition is_quantum_predicate :: "complex mat \<Rightarrow> bool" where
   "is_quantum_predicate P \<longleftrightarrow> P \<in> carrier_mat d d \<and> positive P \<and> P \<le>\<^sub>L 1\<^sub>m d"
 
 lemma trace_measurement2:
   assumes m: "measurement n 2 M" and dA: "A \<in> carrier_mat n n"
   shows "trace ((M 0) * A * adjoint (M 0)) + trace ((M 1) * A * adjoint (M 1)) = trace A"
 proof -
   from m have dM0: "M 0 \<in> carrier_mat n n" and dM1: "M 1 \<in> carrier_mat n n" and id: "adjoint (M 0) * (M 0) + adjoint (M 1) * (M 1) = 1\<^sub>m n" 
     using measurement_def measurement_id2 by auto
   have "trace (M 1 * A * adjoint (M 1)) + trace (M 0 * A * adjoint (M 0))
     = trace ((adjoint (M 0) * M 0 + adjoint (M 1) * M 1) * A)"
     using dM0 dM1 dA by (mat_assoc n)
   also have "\<dots> = trace (1\<^sub>m n * A)" using id by auto
   also have "\<dots> = trace A" using dA by auto
   finally show ?thesis
     using dA dM0 dM1 local.id state_sig.trace_measure2_id by blast
 qed
 
 lemma qp_close_under_unitary_operator:
   fixes U P :: "complex mat"
   assumes dU: "U \<in> carrier_mat d d"
     and u: "unitary U"
     and qp: "is_quantum_predicate P"
   shows "is_quantum_predicate (adjoint U * P * U)"
   unfolding is_quantum_predicate_def
 proof (auto)
   have dP: "P \<in> carrier_mat d d" using qp is_quantum_predicate_def by auto
   show "adjoint U * P * U \<in> carrier_mat d d" using dU dP by fastforce
   have "positive P" using qp is_quantum_predicate_def by auto
   then show "positive (adjoint U * P * U)" 
     using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dU] dP, simplified adjoint_adjoint] by fastforce
   have "adjoint U * U = 1\<^sub>m d" apply (subgoal_tac "inverts_mat (adjoint U) U")
     subgoal unfolding inverts_mat_def using dU by auto
     using u unfolding unitary_def using inverts_mat_symm[OF dU adjoint_dim[OF dU]] by auto
   then have u': "adjoint U * 1\<^sub>m d * U = 1\<^sub>m d" using dU by auto
   have le: "P \<le>\<^sub>L 1\<^sub>m d" using qp is_quantum_predicate_def by auto
   show "adjoint U * P * U \<le>\<^sub>L 1\<^sub>m d" 
     using lowner_le_keep_under_measurement[OF dU dP one_carrier_mat le] u' by auto
 qed
 
 lemma qps_after_measure_is_qp:
   assumes m: "measurement d n M " and qpk: "\<And>k. k < n \<Longrightarrow> is_quantum_predicate (P k)"
   shows "is_quantum_predicate (matrix_sum d (\<lambda>k. adjoint (M k) * P k  * M k) n)"
   unfolding is_quantum_predicate_def 
 proof (auto)
   have dMk: "k < n \<Longrightarrow> M k \<in> carrier_mat d d" for k using m measurement_def by auto
   moreover have dPk: "k < n \<Longrightarrow> P k \<in> carrier_mat d d" for k using qpk is_quantum_predicate_def by auto
   ultimately have dk: "k < n \<Longrightarrow> adjoint (M k) * P k  * M k \<in> carrier_mat d d" for k by fastforce
   then show d: "matrix_sum d (\<lambda>k. adjoint (M k) * P k  * M k) n \<in> carrier_mat d d" 
     using matrix_sum_dim[of n "\<lambda>k. adjoint (M k) * P k  * M k"] by auto
   have "k < n \<Longrightarrow> positive (P k)" for k using qpk is_quantum_predicate_def by auto
   then have "k < n \<Longrightarrow> positive (adjoint (M k) * P k * M k)" for k 
     using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dMk] dPk, simplified adjoint_adjoint] by fastforce
   then show "positive (matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) n)" using matrix_sum_positive dk by auto
   have "k < n \<Longrightarrow> P k \<le>\<^sub>L 1\<^sub>m d" for k using qpk is_quantum_predicate_def by auto
   then have "k < n \<Longrightarrow> positive (1\<^sub>m d - P k)" for k using lowner_le_def by auto
   then have p: "k < n \<Longrightarrow> positive (adjoint (M k) * (1\<^sub>m d - P k) * M k)" for k 
     using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dMk], simplified adjoint_adjoint, of _ "1\<^sub>m d - P k"] dPk by fastforce
   {
     fix k assume k: "k < n"
     have "adjoint (M k) * (1\<^sub>m d - P k) * M k = adjoint (M k) * M k - adjoint (M k) * P k * M k"
       apply (mat_assoc d) using dMk dPk k by auto
   }
   note split = this
   have dk': "k < n \<Longrightarrow> adjoint (M k) * M k - adjoint (M k) * P k * M k \<in> carrier_mat d d" for k using dMk dPk by fastforce
   have "k < n \<Longrightarrow> positive (adjoint (M k) * M k - adjoint (M k) * P k * M k)" for k using p split by auto
   then have p': "positive (matrix_sum d (\<lambda>k. adjoint (M k) * M k - adjoint (M k) * P k * M k) n)" 
     using matrix_sum_positive[OF dk', of n id, simplified] by auto
   have daMMk: "k < n \<Longrightarrow> adjoint (M k) * M k \<in> carrier_mat d d" for k using dMk by fastforce
   have daMPMk: "k < n \<Longrightarrow> adjoint (M k) * P k * M k \<in> carrier_mat d d" for k using dMk dPk by fastforce
   have "matrix_sum d (\<lambda>k. adjoint (M k) * M k - adjoint (M k) * P k * M k) n 
     = matrix_sum d (\<lambda>k. adjoint (M k) * M k) n - matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) n"
     using matrix_sum_minus_distrib[OF daMMk daMPMk] by auto
   also have "\<dots> = 1\<^sub>m d - matrix_sum d (\<lambda>k. adjoint (M k) * P k  * M k) n" using m measurement_def by auto
   finally have "positive (1\<^sub>m d - matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) n)" using p' by auto
   then show "matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) n \<le>\<^sub>L 1\<^sub>m d" using lowner_le_def d by auto
 qed
 
 definition hoare_total_correct :: "complex mat \<Rightarrow> com \<Rightarrow> complex mat \<Rightarrow> bool" ("\<Turnstile>\<^sub>t {(1_)}/ (_)/ {(1_)}" 50) where
   "\<Turnstile>\<^sub>t {P} S {Q} \<longleftrightarrow> (\<forall>\<rho>\<in>density_states. trace (P * \<rho>) \<le> trace (Q * denote S \<rho>))"
 
 definition hoare_partial_correct :: "complex mat \<Rightarrow> com \<Rightarrow> complex mat \<Rightarrow> bool" ("\<Turnstile>\<^sub>p {(1_)}/ (_)/ {(1_)}" 50) where
   "\<Turnstile>\<^sub>p {P} S {Q} \<longleftrightarrow> (\<forall>\<rho>\<in>density_states. trace (P * \<rho>) \<le> trace (Q * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>)))"
 
 (* Proposition 6.1 (1) *)
 lemma total_implies_partial:
   assumes S: "well_com S"
     and total: "\<Turnstile>\<^sub>t {P} S {Q}"
   shows "\<Turnstile>\<^sub>p {P} S {Q}"
 proof -
   have "trace (P * \<rho>) \<le> trace (Q * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>))" if \<rho>: "\<rho> \<in> density_states" for \<rho>
   proof -
     have "trace (P * \<rho>) \<le> trace (Q * denote S \<rho>)"
       using total hoare_total_correct_def \<rho> by auto
     moreover have "trace (denote S \<rho>) \<le> trace \<rho>"
       using denote_trace[OF S] \<rho> density_states_def by auto
     ultimately show ?thesis by auto
   qed
   then show ?thesis
     using hoare_partial_correct_def by auto
 qed
 
 lemma predicate_prob_positive:
   assumes "0\<^sub>m d d \<le>\<^sub>L P"
     and "\<rho> \<in> density_states"
   shows "0 \<le> trace (P * \<rho>)"
 proof -
   have "trace (0\<^sub>m d d * \<rho>) \<le> trace (P * \<rho>)"
     apply (rule lowner_le_traceD)
     using assms unfolding lowner_le_def density_states_def by auto
   then show ?thesis
     using assms(2) density_states_def by auto
 qed
 
 (* Proposition 6.1 (2a) *)
 lemma total_pre_zero:
   assumes S: "well_com S"
     and Q: "is_quantum_predicate Q"
   shows "\<Turnstile>\<^sub>t {0\<^sub>m d d} S {Q}"
 proof -
   have "trace (0\<^sub>m d d * \<rho>) \<le> trace (Q * denote S \<rho>)" if \<rho>: "\<rho> \<in> density_states" for \<rho>
   proof -
     have 1: "trace (0\<^sub>m d d * \<rho>) = 0"
       using \<rho> unfolding density_states_def by auto
     show ?thesis
       apply (subst 1)
       apply (rule predicate_prob_positive)
       subgoal apply (simp add: lowner_le_def, subgoal_tac "Q - 0\<^sub>m d d = Q") using Q is_quantum_predicate_def[of Q] by auto
       subgoal using denote_density_states \<rho> S by auto
       done
   qed
   then show ?thesis
     using hoare_total_correct_def by auto
 qed
 
 (* Proposition 6.1 (2b) *)
 lemma partial_post_identity:
   assumes S: "well_com S"
     and P: "is_quantum_predicate P"
   shows "\<Turnstile>\<^sub>p {P} S {1\<^sub>m d}"
 proof -
   have "trace (P * \<rho>) \<le> trace (1\<^sub>m d * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>))" if \<rho>: "\<rho> \<in> density_states" for \<rho>
   proof -
     have "denote S \<rho> \<in> carrier_mat d d"
       using S denote_dim \<rho> density_states_def by auto
     then have "trace (1\<^sub>m d * denote S \<rho>) = trace (denote S \<rho>)"
       by auto
     moreover have "trace (P * \<rho>) \<le> trace (1\<^sub>m d * \<rho>)"
       apply (rule lowner_le_traceD)
       using \<rho> unfolding density_states_def apply auto
       using P is_quantum_predicate_def by auto
     ultimately show ?thesis
       using density_states_def that by auto
   qed
   then show ?thesis
     using hoare_partial_correct_def by auto
 qed
 
 subsection \<open>Weakest liberal preconditions\<close>
 
 definition is_weakest_liberal_precondition :: "complex mat \<Rightarrow> com \<Rightarrow> complex mat \<Rightarrow> bool"  where
   "is_weakest_liberal_precondition W S P \<longleftrightarrow>
     is_quantum_predicate W \<and> \<Turnstile>\<^sub>p {W} S {P} \<and> (\<forall>Q. is_quantum_predicate Q \<longrightarrow> \<Turnstile>\<^sub>p {Q} S {P} \<longrightarrow> Q \<le>\<^sub>L W)"
 
 definition wlp_measure :: "nat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> ((complex mat \<Rightarrow> complex mat) list) \<Rightarrow> complex mat \<Rightarrow> complex mat" where
 "wlp_measure n M WS P = matrix_sum d (\<lambda>k. adjoint (M k) * ((WS!k) P) * (M k)) n"
 
 fun wlp_while_n :: "complex mat \<Rightarrow> complex mat \<Rightarrow> (complex mat \<Rightarrow> complex mat) \<Rightarrow> nat \<Rightarrow> complex mat \<Rightarrow> complex mat" where
   "wlp_while_n M0 M1 WS 0 P = 1\<^sub>m d"
 | "wlp_while_n M0 M1 WS (Suc n) P = adjoint M0 * P * M0 + adjoint M1 * (WS (wlp_while_n M0 M1 WS n P)) * M1"
 
 lemma measurement2_leq_one_mat:
   assumes dP: "P \<in> carrier_mat d d" and dQ: "Q \<in> carrier_mat d d"
     and leP: "P \<le>\<^sub>L 1\<^sub>m d" and leQ: "Q \<le>\<^sub>L 1\<^sub>m d" and m: "measurement d 2 M"
   shows "(adjoint (M 0) * P * (M 0) + adjoint (M 1) * Q * (M 1)) \<le>\<^sub>L 1\<^sub>m d"
 proof -
   define M0 where "M0 = M 0" 
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using m M0_def M1_def measurement_def by auto
 
   have "adjoint M1 * Q * M1 \<le>\<^sub>L adjoint M1 * 1\<^sub>m d * M1"
     using lowner_le_keep_under_measurement[OF dM1 dQ _ leQ] by auto
   then have le1: "adjoint M1 * Q * M1 \<le>\<^sub>L adjoint M1 * M1" using dM1 dQ by fastforce
   have "adjoint M0 * P * M0 \<le>\<^sub>L adjoint M0 * 1\<^sub>m d * M0"
     using lowner_le_keep_under_measurement[OF dM0 dP _ leP] by auto
   then have le0: "adjoint M0 * P * M0 \<le>\<^sub>L adjoint M0 * M0"
     using dM0 dP by fastforce
   have "adjoint M0 * P * M0 + adjoint M1 * Q * M1 \<le>\<^sub>L adjoint M0 * M0 + adjoint M1 * M1"
     apply (rule lowner_le_add[of "adjoint M0 * P * M0" d "adjoint M0 * M0" "adjoint M1 * Q * M1" "adjoint M1 * M1"])
     using dM0 dP dM1 dQ le0 le1 by auto
   also have "\<dots> = 1\<^sub>m d" using m M0_def M1_def measurement_id2 by auto
   finally show "adjoint M0 * P * M0 + adjoint M1 * Q * M1 \<le>\<^sub>L 1\<^sub>m d".
 qed
 
 lemma wlp_while_n_close:
   assumes close: "\<And>P. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate (WS P)"
     and m: "measurement d 2 M" and qpP: "is_quantum_predicate P"
   shows "is_quantum_predicate (wlp_while_n (M 0) (M 1) WS k P)"
 proof (induct k)
   case 0
   then show ?case 
     unfolding wlp_while_n.simps is_quantum_predicate_def using positive_one[of d] lowner_le_refl[of "1\<^sub>m d"] by fastforce
 next
   case (Suc k)
   define M0 where "M0 = M 0" 
   define M1 where "M1 = M 1"
   define W where "W k = wlp_while_n M0 M1 WS k P" for k
   show ?case unfolding wlp_while_n.simps is_quantum_predicate_def
   proof (fold M0_def M1_def, fold W_def, auto)
     have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using m M0_def M1_def measurement_def by auto
     have dP:  "P \<in> carrier_mat d d" using qpP is_quantum_predicate_def by auto
     have qpWk: "is_quantum_predicate (W k)" using Suc M0_def M1_def W_def by auto
     then have qpWWk: "is_quantum_predicate (WS (W k))" using close by auto
     from qpWk have dWk: "W k \<in> carrier_mat d d" using is_quantum_predicate_def by auto
     from qpWWk have dWWk: "WS (W k) \<in> carrier_mat d d" using is_quantum_predicate_def by auto
     show "adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1 \<in> carrier_mat d d" using dM0 dP dM1 dWWk by auto
 
     have pP: "positive P" using qpP is_quantum_predicate_def by auto
     then have pM0P: "positive (adjoint M0 * P * M0)" 
       using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM0]] dM0 dP adjoint_adjoint[of M0] by auto
     have pWWk: "positive (WS (W k))" using qpWWk is_quantum_predicate_def by auto
     then have pM1WWk: "positive (adjoint M1 * WS (W k) * M1)"
       using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM1]] dM1 dWWk adjoint_adjoint[of M1] by auto
     then show "positive (adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1)"
       using positive_add[OF pM0P pM1WWk] dM0 dP dM1 dWWk by fastforce
 
     have leWWk: "WS (W k) \<le>\<^sub>L 1\<^sub>m d" using qpWWk is_quantum_predicate_def by auto
     have leP: "P \<le>\<^sub>L 1\<^sub>m d" using qpP is_quantum_predicate_def by auto
     show "(adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1) \<le>\<^sub>L 1\<^sub>m d " 
       using measurement2_leq_one_mat[OF dP dWWk leP leWWk m] M0_def M1_def by auto
   qed
 qed
 
 lemma wlp_while_n_mono:
   assumes "\<And>P. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate (WS P)"
     and "\<And>P Q. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> P \<le>\<^sub>L Q \<Longrightarrow> WS P \<le>\<^sub>L WS Q"
     and "measurement d 2 M"
     and "is_quantum_predicate P"
     and "is_quantum_predicate Q"
     and "P \<le>\<^sub>L Q"
   shows "(wlp_while_n (M 0) (M 1) WS k P) \<le>\<^sub>L (wlp_while_n (M 0) (M 1) WS k Q)"
 proof (induct k)
   case 0
   then show ?case unfolding wlp_while_n.simps using lowner_le_refl[of "1\<^sub>m d"] by fastforce
 next
   case (Suc k)
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using assms M0_def M1_def measurement_def by auto
   define W where "W P k = wlp_while_n M0 M1 WS k P" for k P
 
   have dP: "P \<in> carrier_mat d d" and dQ: "Q \<in> carrier_mat d d" using assms is_quantum_predicate_def by auto
 
   have eq1: "W P (Suc k) = adjoint M0 * P * M0 + adjoint M1 * (WS (W P k)) * M1" unfolding W_def wlp_while_n.simps by auto
   have eq2: "W Q (Suc k) = adjoint M0 * Q * M0 + adjoint M1 * (WS (W Q k)) * M1" unfolding W_def wlp_while_n.simps by auto
   have le1: "adjoint M0 * P * M0 \<le>\<^sub>L adjoint M0 * Q * M0" using lowner_le_keep_under_measurement dM0 dP dQ assms by auto
   have leWk: "(W P k) \<le>\<^sub>L (W Q k)" unfolding W_def M0_def M1_def using Suc by auto
   have qpWPk: "is_quantum_predicate (W P k)" unfolding W_def M0_def M1_def using wlp_while_n_close assms by auto
   then have "is_quantum_predicate (WS (W P k))" unfolding W_def M0_def M1_def using assms by auto
   then have dWWPk: "(WS (W P k)) \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   have qpWQk: "is_quantum_predicate (W Q k)" unfolding W_def M0_def M1_def using wlp_while_n_close assms by auto
   then have "is_quantum_predicate (WS (W Q k))" unfolding W_def M0_def M1_def using assms by auto
   then have dWWQk: "(WS (W Q k)) \<in> carrier_mat d d" using is_quantum_predicate_def by auto
 
   have "(WS (W P k)) \<le>\<^sub>L (WS (W Q k))" using qpWPk qpWQk leWk assms by auto
   then have le2: "adjoint M1 * (WS (W P k)) * M1 \<le>\<^sub>L adjoint M1 * (WS (W Q k)) * M1"
     using lowner_le_keep_under_measurement dM1 dWWPk dWWQk by auto
 
   have "(adjoint M0 * P * M0 + adjoint M1 * (WS (W P k)) * M1) \<le>\<^sub>L (adjoint M0 * Q * M0 + adjoint M1 * (WS (W Q k)) * M1)"
     using lowner_le_add[OF _ _ _ _ le1 le2] dM0 dP dM1 dQ dWWPk dWWQk le1 le2 by fastforce
 
   then have "W P (Suc k) \<le>\<^sub>L W Q (Suc k)" using eq1 eq2 by auto
   then show ?case unfolding W_def M0_def M1_def by auto
 qed
 
 definition wlp_while :: "complex mat \<Rightarrow> complex mat \<Rightarrow> (complex mat \<Rightarrow> complex mat) \<Rightarrow> complex mat \<Rightarrow> complex mat" where
   "wlp_while M0 M1 WS P = (THE Q. limit_mat (\<lambda>n. wlp_while_n M0 M1 WS n P) Q d)"
 
 lemma wlp_while_exists:
   assumes "\<And>P. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate (WS P)"
     and "\<And>P Q. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> P \<le>\<^sub>L Q \<Longrightarrow> WS P \<le>\<^sub>L WS Q"
     and m: "measurement d 2 M"
     and qpP: "is_quantum_predicate P"
   shows "is_quantum_predicate (wlp_while (M 0) (M 1) WS P) 
     \<and> (\<forall>n. (wlp_while (M 0) (M 1) WS P) \<le>\<^sub>L (wlp_while_n (M 0) (M 1) WS n P))
     \<and> (\<forall>W'. (\<forall>n. W' \<le>\<^sub>L (wlp_while_n (M 0) (M 1) WS n P)) \<longrightarrow> W' \<le>\<^sub>L (wlp_while (M 0) (M 1) WS P))
     \<and> limit_mat (\<lambda>n. wlp_while_n (M 0) (M 1) WS n P) (wlp_while (M 0) (M 1) WS P) d"
 proof (auto)
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using assms M0_def M1_def measurement_def by auto
   define W where "W k = wlp_while_n M0 M1 WS k P" for k
   have leP: "P \<le>\<^sub>L 1\<^sub>m d" and dP: "P \<in> carrier_mat d d" and pP: "positive P" using qpP is_quantum_predicate_def by auto
   have pM0P: "positive (adjoint M0 * P * M0)" 
     using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM0]] adjoint_adjoint[of "M0"] dP pP by  auto
 
   have le_qp: "W (Suc k) \<le>\<^sub>L W k \<and> is_quantum_predicate (W k)" for k
   proof (induct k)
     case 0
     have "is_quantum_predicate (1\<^sub>m d)" 
       unfolding is_quantum_predicate_def using positive_one lowner_le_refl[of "1\<^sub>m d"] by fastforce
     then have "is_quantum_predicate (WS (1\<^sub>m d))" using assms by auto
     then have "(WS (1\<^sub>m d)) \<in> carrier_mat d d" and "(WS (1\<^sub>m d)) \<le>\<^sub>L 1\<^sub>m d" using is_quantum_predicate_def by auto
     then have "W 1 \<le>\<^sub>L W 0" unfolding W_def wlp_while_n.simps M0_def M1_def
       using measurement2_leq_one_mat[OF dP _ leP _ m] by auto
     moreover have "is_quantum_predicate (W 0)" unfolding W_def wlp_while_n.simps is_quantum_predicate_def
       using positive_one lowner_le_refl[of "1\<^sub>m d"] by fastforce
     ultimately show ?case by auto
   next
     case (Suc k)
     then have leWSk: "W (Suc k) \<le>\<^sub>L W k" and qpWk: "is_quantum_predicate (W k)"  by auto
     then have "is_quantum_predicate (WS (W k))" using assms by auto
     then have dWWk: "WS (W k) \<in> carrier_mat d d" and leWWk1: "(WS (W k)) \<le>\<^sub>L 1\<^sub>m d" and pWWk: "positive (WS (W k))"
       using is_quantum_predicate_def by auto
     then have leWSk1: "W (Suc k) \<le>\<^sub>L 1\<^sub>m d" using measurement2_leq_one_mat[OF dP dWWk leP leWWk1 m]
       unfolding W_def wlp_while_n.simps M0_def M1_def by auto
     then have dWSk: "W (Suc k) \<in> carrier_mat d d" using lowner_le_def by fastforce
     have pM1WWk: "positive (adjoint M1 * (WS (W k)) * M1)" 
       using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM1] dWWk pWWk] adjoint_adjoint[of "M1"] by auto
     have pWSk: "positive (W (Suc k))" unfolding W_def wlp_while_n.simps apply (fold W_def)
       using positive_add[OF pM0P pM1WWk] dM0 dP dM1 by fastforce
     have qpWSk:"is_quantum_predicate (W (Suc k))" unfolding is_quantum_predicate_def using dWSk pWSk leWSk1 by auto
     then have qpWWSk: "is_quantum_predicate (WS (W (Suc k)))" using assms(1) by auto
     then have dWWSk: "(WS (W (Suc k))) \<in> carrier_mat d d" using is_quantum_predicate_def by auto
 
     have "WS (W (Suc k)) \<le>\<^sub>L WS (W k)" using assms(2)[OF qpWSk qpWk] leWSk by auto
     then have "adjoint M1 * WS (W (Suc k)) * M1 \<le>\<^sub>L adjoint M1 * WS (W k) * M1"
       using lowner_le_keep_under_measurement[OF dM1 dWWSk dWWk] by auto
     then have "(adjoint M0 * P * M0 + adjoint M1 * WS (W (Suc k)) * M1)
               \<le>\<^sub>L (adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1)"
       using lowner_le_add[of _ d _ "adjoint M1 * WS (W (Suc k)) * M1" "adjoint M1 * WS (W k) * M1", 
             OF _ _ _ _ lowner_le_refl[of "adjoint M0 * P * M0"]] dM0 dM1 dP dWWSk dWWk by fastforce
     then have "W (Suc (Suc k)) \<le>\<^sub>L W (Suc k)" unfolding W_def wlp_while_n.simps by auto
     with qpWSk show ?case by auto
   qed
   then have dWk: "W k \<in> carrier_mat d d" for k using is_quantum_predicate_def by auto
   then have dmWk: "- W k \<in> carrier_mat d d" for k by auto
   have incmWk: "- (W k) \<le>\<^sub>L - (W (Suc k))" for k using lowner_le_swap[of "W (Suc k)" d "W k"] dWk le_qp by auto
   have pWk: "positive (W k)" for k using le_qp is_quantum_predicate_def by auto
   have ubmWk: "- W k \<le>\<^sub>L 0\<^sub>m d d" for k
   proof -
     have "0\<^sub>m d d \<le>\<^sub>L W k" for k using zero_lowner_le_positiveI dWk pWk by auto
     then have "- W k \<le>\<^sub>L - 0\<^sub>m d d" for k using lowner_le_swap[of "0\<^sub>m d d" d "W k"] dWk by auto
     moreover have "(- 0\<^sub>m d d :: complex mat) = (0\<^sub>m d d)" by auto
     ultimately show ?thesis by auto
   qed
 
   have "\<exists>B. lowner_is_lub (\<lambda>k. - W k) B \<and> limit_mat (\<lambda>k. - W k) B d" 
     using mat_inc_seq_lub[of "\<lambda>k. - W k" d "0\<^sub>m d d"] dmWk incmWk ubmWk by auto
   then obtain B where lubB: "lowner_is_lub (\<lambda>k. - W k) B" and limB: "limit_mat (\<lambda>k. - W k) B d" by auto
   then have dB: "B \<in> carrier_mat d d" using limit_mat_def by auto
   define A where "A = - B"
   then have dA: "A \<in> carrier_mat d d" using dB by auto
   have "limit_mat (\<lambda>k. (-1) \<cdot>\<^sub>m (- W k)) (-1 \<cdot>\<^sub>m B) d" using limit_mat_scale[OF limB] by auto
   moreover have "W k = -1 \<cdot>\<^sub>m (- W k)" for k using dWk by auto
   moreover have "-1 \<cdot>\<^sub>m B = - B" by auto
   ultimately have limA: "limit_mat W A d" using A_def by auto
   moreover have "(limit_mat W A' d \<Longrightarrow> A' = A)" for A' using limit_mat_unique[of W A d] limA by auto
   ultimately have eqA: "(wlp_while (M 0) (M 1) WS P) = A" unfolding wlp_while_def W_def M0_def M1_def 
     using the_equality[of "\<lambda>X. limit_mat (\<lambda>n. wlp_while_n (M 0) (M 1) WS n P) X d" A] by fastforce
 
   show "limit_mat (\<lambda>n. wlp_while_n (M 0) (M (Suc 0)) WS n P) (wlp_while (M 0) (M (Suc 0)) WS P) d" 
     using limA eqA unfolding W_def M0_def M1_def by auto
 
   have "- W k \<le>\<^sub>L B" for k using lubB lowner_is_lub_def by auto
   then have glbA: "A \<le>\<^sub>L W k" for k unfolding A_def using lowner_le_swap[of "- W k" d] dB dWk by fastforce
   then show "\<And>n. wlp_while (M 0) (M (Suc 0)) WS P \<le>\<^sub>L wlp_while_n (M 0) (M (Suc 0)) WS n P" using eqA unfolding W_def M0_def M1_def by auto
 
   have "W k \<le>\<^sub>L 1\<^sub>m d" for k using le_qp unfolding is_quantum_predicate_def by auto
   then have "positive (1\<^sub>m d - W k)" for k using lowner_le_def by auto
   moreover have "limit_mat (\<lambda>k. 1\<^sub>m d - W k) (1\<^sub>m d - A) d" using mat_minus_limit limA by auto
   ultimately have "positive (1\<^sub>m d - A)" using pos_mat_lim_is_pos by auto
   then have leA1: "A \<le>\<^sub>L 1\<^sub>m d" using dA lowner_le_def by auto
 
   have pA: "positive A" using pos_mat_lim_is_pos limA pWk by auto
 
   show "is_quantum_predicate (wlp_while (M 0) (M (Suc 0)) WS P)" unfolding is_quantum_predicate_def using pA dA leA1 eqA by auto
 
   {
     fix W' assume asmW': "\<forall>k. W' \<le>\<^sub>L W k"  
     then have dW': "W' \<in> carrier_mat d d" unfolding lowner_le_def using carrier_matD[OF dWk] by auto
     then have "- W k \<le>\<^sub>L - W'" for k using lowner_le_swap dWk asmW' by auto
     then have "B \<le>\<^sub>L - W'" using lubB unfolding lowner_is_lub_def by auto
     then have "W' \<le>\<^sub>L A" unfolding A_def 
       using lowner_le_swap[of "B" d "- W'"] dB dW'  by auto
     then have "W' \<le>\<^sub>L wlp_while (M 0) (M 1) WS P" using eqA by auto
   }
   then show "\<And>W'. \<forall>n. W' \<le>\<^sub>L wlp_while_n (M 0) (M (Suc 0)) WS n P \<Longrightarrow> W' \<le>\<^sub>L wlp_while (M 0) (M (Suc 0)) WS P"
     unfolding W_def M0_def M1_def by auto
 qed
 
 lemma wlp_while_mono:
   assumes "\<And>P. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate (WS P)"
     and "\<And>P Q. is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> P \<le>\<^sub>L Q \<Longrightarrow> WS P \<le>\<^sub>L WS Q"
     and "measurement d 2 M"
     and "is_quantum_predicate P"
     and "is_quantum_predicate Q"
     and "P \<le>\<^sub>L Q"
   shows "wlp_while (M 0) (M 1) WS P \<le>\<^sub>L wlp_while (M 0) (M 1) WS Q"
 proof -
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using assms M0_def M1_def measurement_def by auto
   define Wn where "Wn P k = wlp_while_n M0 M1 WS k P" for P k
   define W where "W P = wlp_while M0 M1 WS P" for P
   have lePQk: "Wn P k \<le>\<^sub>L Wn Q k" for k unfolding Wn_def M0_def M1_def 
     using wlp_while_n_mono assms by auto
   have "is_quantum_predicate (Wn P k)" for k unfolding Wn_def M0_def M1_def using wlp_while_n_close assms by auto
   then have dWPk: "Wn P k \<in> carrier_mat d d" for k using is_quantum_predicate_def by auto
   have "is_quantum_predicate (Wn Q k)" for k unfolding Wn_def M0_def M1_def using wlp_while_n_close assms by auto
   then have dWQk:"Wn Q k \<in> carrier_mat d d" for k using is_quantum_predicate_def by auto
   have "is_quantum_predicate (W P)" and lePk: "(W P) \<le>\<^sub>L (Wn P k)" and "limit_mat (Wn P) (W P) d" for k
     unfolding W_def Wn_def M0_def M1_def using wlp_while_exists assms by auto
   then have dWP: "W P \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   have "is_quantum_predicate (W Q)" and "(W Q) \<le>\<^sub>L (Wn Q k)" 
     and glb:"(\<forall>k. W' \<le>\<^sub>L (Wn Q k)) \<longrightarrow> W' \<le>\<^sub>L (W Q)" and "limit_mat (Wn Q) (W Q) d" for k W'
     unfolding W_def Wn_def M0_def M1_def using wlp_while_exists assms by auto
 
   have "W P \<le>\<^sub>L Wn Q k" for k using lowner_le_trans[of "W P" d "Wn P k" "Wn Q k"] lePk lePQk dWPk dWQk dWP by auto
   then show "W P \<le>\<^sub>L W Q" using glb by auto
 qed
 
 fun wlp :: "com \<Rightarrow> complex mat \<Rightarrow> complex mat" where
   "wlp SKIP P = P"
 | "wlp (Utrans U) P = adjoint U * P * U"
 | "wlp (Seq S1 S2) P = wlp S1 (wlp S2 P)"
 | "wlp (Measure n M S) P = wlp_measure n M (map wlp S) P"
 | "wlp (While M S) P = wlp_while (M 0) (M 1) (wlp S) P"
 
 lemma wlp_measure_expand_m:
   assumes m: "m \<le> n" and wc: "well_com (Measure n M S)"  
   shows "wlp (Measure m M S) P = matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * (M k)) m"
   unfolding wlp.simps wlp_measure_def
 proof -
   have "k < m \<Longrightarrow> map wlp S ! k = wlp (S!k)" for k using wc m by auto
   then have "k < m \<Longrightarrow> (map wlp S ! k) P = wlp (S!k) P" for k by auto
   then show "matrix_sum d (\<lambda>k. adjoint (M k) * ((map wlp S ! k) P) * (M k)) m
     = matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * (M k)) m" 
     using matrix_sum_cong[of m "\<lambda>k. adjoint (M k) * ((map wlp S ! k) P) * (M k)" "\<lambda>k. adjoint (M k) * (wlp (S!k) P) * (M k)"] by auto
 qed
 
 lemma wlp_measure_expand:
   assumes wc: "well_com (Measure n M S)"  
   shows "wlp (Measure n M S) P = matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * (M k)) n"
   using wlp_measure_expand_m[OF Nat.le_refl[of n]] wc by auto
 
 lemma wlp_mono_and_close:
   shows "well_com S \<Longrightarrow> is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> P \<le>\<^sub>L Q 
         \<Longrightarrow> is_quantum_predicate (wlp S P) \<and> wlp S P \<le>\<^sub>L wlp S Q"
 proof (induct S arbitrary: P Q)
   case SKIP
   then show ?case by auto
 next
   case (Utrans U)
   then have dU: "U \<in> carrier_mat d d" and u: "unitary U" and qp: "is_quantum_predicate P"  and le: "P \<le>\<^sub>L Q"
     and dP: "P \<in> carrier_mat d d" and dQ: "Q \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   then have qp': "is_quantum_predicate (wlp (Utrans U) P)" using qp_close_under_unitary_operator by auto
   moreover have "adjoint U * P * U \<le>\<^sub>L adjoint U * Q * U" using lowner_le_keep_under_measurement[OF dU dP dQ le] by auto
   ultimately show ?case by auto
 next
   case (Seq S1 S2)
   then have qpP: "is_quantum_predicate P" and qpQ: "is_quantum_predicate Q" and wc1: "well_com S1" and wc2: "well_com S2" 
     and dP: "P \<in> carrier_mat d d" and dQ: "Q \<in> carrier_mat d d" and le: "P \<le>\<^sub>L Q"using is_quantum_predicate_def by auto
   have qpP2: "is_quantum_predicate (wlp S2 P)" using Seq qpP wc2 by auto
   have qpQ2: "is_quantum_predicate (wlp S2 Q)" using Seq(2)[OF wc2 qpQ qpQ] lowner_le_refl dQ by blast
   have qpP1: "is_quantum_predicate (wlp S1 (wlp S2 P))" 
     using Seq(1)[OF wc1 qpP2 qpP2] qpP2 is_quantum_predicate_def[of "wlp S2 P"] lowner_le_refl by auto
   have "wlp S2 P \<le>\<^sub>L wlp S2 Q" using Seq(2) wc2 qpP qpQ le by auto
   then have "wlp S1 (wlp S2 P) \<le>\<^sub>L wlp S1 (wlp S2 Q)" using Seq(1) wc1 qpP2 qpQ2 by auto
   then show ?case using qpP1 by auto
 next
   case (Measure n M S)
   then have wc: "well_com (Measure n M S)" and wck: "k < n \<Longrightarrow> well_com (S!k)" and l: "length S = n"
     and m: "measurement d n M" and le: "P \<le>\<^sub>L Q"
     and qpP: "is_quantum_predicate P" and dP: "P \<in> carrier_mat d d" 
     and qpQ: "is_quantum_predicate Q" and dQ: "Q \<in> carrier_mat d d"
     for k using measure_well_com is_quantum_predicate_def by auto
   have dMk: "k < n \<Longrightarrow> M k \<in> carrier_mat d d" for k using m measurement_def by auto
   have set: "k < n \<Longrightarrow> S!k \<in> set S" for k using l by auto
   have qpk: "k < n \<Longrightarrow> is_quantum_predicate (wlp (S!k) P)" for k 
     using Measure(1)[OF set wck qpP qpP] lowner_le_refl[of P] dP by auto
   then have dWkP: "k < n \<Longrightarrow> wlp (S!k) P \<in> carrier_mat d d" for k using is_quantum_predicate_def by auto
   then have dMkP: "k < n \<Longrightarrow> adjoint (M k) * (wlp (S!k) P) * (M k) \<in> carrier_mat d d" for k using dMk by fastforce
   have "k < n \<Longrightarrow> is_quantum_predicate (wlp (S!k) Q)" for k 
     using Measure(1)[OF set wck qpQ qpQ] lowner_le_refl[of Q] dQ by auto
   then have dWkQ: "k < n \<Longrightarrow> wlp (S!k) Q \<in> carrier_mat d d" for k using is_quantum_predicate_def by auto
   then have dMkQ: "k < n \<Longrightarrow> adjoint (M k) * (wlp (S!k) Q) * (M k) \<in> carrier_mat d d" for k using dMk by fastforce
   have "k < n \<Longrightarrow> wlp (S!k) P \<le>\<^sub>L wlp (S!k) Q" for k 
     using Measure(1)[OF set wck qpP qpQ le] by auto
   then have "k < n \<Longrightarrow> adjoint (M k) * (wlp (S!k) P) * (M k) \<le>\<^sub>L adjoint (M k) * (wlp (S!k) Q) * (M k)" for k
     using lowner_le_keep_under_measurement[OF dMk dWkP dWkQ] by auto
   then have le': "wlp (Measure n M S) P \<le>\<^sub>L wlp (Measure n M S) Q" unfolding wlp_measure_expand[OF wc]
     using lowner_le_matrix_sum dMkP dMkQ by auto
   have qp': "is_quantum_predicate (wlp (Measure n M S) P)" unfolding wlp_measure_expand[OF wc]
     using qps_after_measure_is_qp[OF m] qpk by auto
   show ?case using le' qp' by auto
 next
   case (While M S)
   then have m: "measurement d 2 M" and wcs: "well_com S" 
     and qpP: "is_quantum_predicate P"
     by auto
   have closeWS: "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate (wlp S P)" for P
   proof -
     assume asm: "is_quantum_predicate P"
     then have dP: "P \<in> carrier_mat d d" using is_quantum_predicate_def by auto
     then show "is_quantum_predicate (wlp S P)" using While(1)[OF wcs asm asm lowner_le_refl] dP by auto
   qed
   have monoWS: "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> P \<le>\<^sub>L Q \<Longrightarrow> wlp S P \<le>\<^sub>L wlp S Q" for P Q
     using While(1)[OF wcs] by auto
   have "is_quantum_predicate (wlp (While M S) P)"
     using wlp_while_exists[of "wlp S" M P] closeWS monoWS m qpP by auto
   moreover have "wlp (While M S) P \<le>\<^sub>L wlp (While M S) Q"
     using wlp_while_mono[of "wlp S" M P Q] closeWS monoWS m While by auto
   ultimately show ?case by auto
 qed
 
 lemma wlp_close:
   assumes wc: "well_com S" and qp: "is_quantum_predicate P"
   shows "is_quantum_predicate (wlp S P)" 
   using wlp_mono_and_close[OF wc qp qp] is_quantum_predicate_def[of P] qp lowner_le_refl by auto
 
 lemma wlp_soundness:
   "well_com S \<Longrightarrow> 
     (\<And>P. (is_quantum_predicate P \<Longrightarrow> 
       (\<forall>\<rho> \<in> density_states. trace (wlp S P * \<rho>) = trace (P * (denote S \<rho>)) + trace \<rho> - trace (denote S \<rho>))))"
 proof (induct S)
   case SKIP
 then show ?case by auto
 next
   case (Utrans U)
   then have dU: "U \<in> carrier_mat d d" and u: "unitary U" and wc: "well_com (Utrans U)" 
     and qp: "is_quantum_predicate P" and dP: "P \<in> carrier_mat d d"  using is_quantum_predicate_def by auto
   have qp': "is_quantum_predicate (wlp (Utrans U) P)" using wlp_close[OF wc qp] by auto
   have eq1: "trace (adjoint U * P * U * \<rho>) = trace (P * (U * \<rho> * adjoint U))" if dr: "\<rho> \<in> carrier_mat d d" for \<rho>
     using dr dP apply (mat_assoc d) using wc by auto
   have eq2: "trace (U * \<rho> * adjoint U) = trace \<rho>" if dr: "\<rho> \<in> carrier_mat d d" for \<rho>
     using unitary_operator_keep_trace[OF adjoint_dim[OF dU] dr unitary_adjoint[OF dU u]] adjoint_adjoint[of U] by auto
   show ?case using qp' eq1 eq2 density_states_def by auto
 next
   case (Seq S1 S2)
   then have qp: "is_quantum_predicate P" and wc1: "well_com S1" and wc2: "well_com S2" by auto
   then have qp2: "is_quantum_predicate (wlp S2 P)" using wlp_close by auto
   then have qp1: "is_quantum_predicate (wlp S1 (wlp S2 P))" using wlp_close wc1 by auto
   have eq1: "trace (wlp S2 P * \<rho>) = trace (P * denote S2 \<rho>) + trace \<rho> - trace (denote S2 \<rho>)" 
     if ds: "\<rho> \<in> density_states" for \<rho> using Seq(2) wc2 qp ds by auto
   have eq2: "trace (wlp S1 (wlp S2 P) * \<rho>) = trace ((wlp S2 P) * denote S1 \<rho>) + trace \<rho> - trace (denote S1 \<rho>)" 
     if ds: "\<rho> \<in> density_states" for \<rho> using Seq(1) wc1 qp2 ds by auto
   have eq3: "trace (wlp S1 (wlp S2 P) * \<rho>) = trace (P * (denote S2 (denote S1 \<rho>))) + trace \<rho> - trace (denote S2 (denote S1 \<rho>))" 
     if ds: "\<rho> \<in> density_states" for \<rho>
   proof -
     have "denote S1 \<rho> \<in> density_states"
       using ds denote_density_states wc1  by auto
     then have  "trace ((wlp S2 P) * denote S1 \<rho>) = trace (P * denote S2 (denote S1 \<rho>)) + trace (denote S1 \<rho>) - trace (denote S2 (denote S1 \<rho>))"
       using eq1 by auto
     then show "trace (wlp S1 (wlp S2 P) * \<rho>) = trace (P * (denote S2 (denote S1 \<rho>))) + trace \<rho> - trace (denote S2 (denote S1 \<rho>))"
       using eq2 ds by auto
   qed
   then show ?case using qp1 by auto
 next
   case (Measure n M S)
   then have wc: "well_com (Measure n M S)"
     and wck: "k < n \<Longrightarrow> well_com (S!k)"
     and qpP: "is_quantum_predicate P"
     and dP: "P \<in> carrier_mat d d"
     and qpWk: "k < n \<Longrightarrow> is_quantum_predicate (wlp (S!k) P)"
     and dWk: "k < n \<Longrightarrow> (wlp (S!k) P) \<in> carrier_mat d d"
     and c: "k < n \<Longrightarrow> \<rho> \<in> density_states \<Longrightarrow> trace (wlp (S!k) P * \<rho>) = trace (P * denote (S!k) \<rho>) + trace \<rho> - trace (denote (S!k) \<rho>)" 
     and m: "measurement d n M"
     and aMMkleq: "k < n \<Longrightarrow> adjoint (M k) * M k \<le>\<^sub>L 1\<^sub>m d"
     and dMk: "k < n \<Longrightarrow> M k \<in> carrier_mat d d"
     for k \<rho> using is_quantum_predicate_def measurement_def measure_well_com measurement_le_one_mat wlp_close by auto
     {
     fix \<rho> assume \<rho>: "\<rho> \<in> density_states"
     then have dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def by auto
     have dsr: "k < n \<Longrightarrow> (M k) * \<rho> * adjoint (M k) \<in> density_states" for k unfolding density_states_def 
       using dMk pdo_close_under_measurement[OF dMk dr pdor aMMkleq] dr by fastforce
     then have leqk: "k < n \<Longrightarrow> trace (wlp (S!k) P * ((M k) * \<rho> * adjoint (M k))) = 
       trace (P * (denote (S!k) ((M k) * \<rho> * adjoint (M k)))) + 
       (trace ((M k) * \<rho> * adjoint (M k)) - trace (denote (S ! k) ((M k) * \<rho> * adjoint (M k))))" for k 
       using c by auto
     have "k < n \<Longrightarrow> M k * \<rho> * adjoint (M k) \<in> carrier_mat d d" for k using dMk dr by fastforce
     then have dsMrk: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. (M k * \<rho> * adjoint (M k))) k \<in> carrier_mat d d" for k 
       using matrix_sum_dim[of k "\<lambda>k. (M k * \<rho> * adjoint (M k))" d] by fastforce
     have "k < n \<Longrightarrow> adjoint (M k) * (wlp (S!k) P) * M k \<in> carrier_mat d d" for k using dMk by fastforce
     then have dsMW: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k) k \<in> carrier_mat d d" for k 
       using matrix_sum_dim[of k "\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k" d] by fastforce
     have dSMrk: "k < n \<Longrightarrow> denote (S ! k) (M k * \<rho> * adjoint (M k)) \<in> carrier_mat d d" for k 
       using denote_dim[OF wck, of k "M k * \<rho> * adjoint (M k)"] dsr density_states_def by fastforce
     have dsSMrk: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k \<in> carrier_mat d d" for k
       using matrix_sum_dim[of k "\<lambda>k. denote (S ! k) (M k * \<rho> * adjoint (M k))" d, OF dSMrk] by fastforce
     have "k \<le> n \<Longrightarrow> 
         trace (matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k) k * \<rho>)
        = trace (P * (denote (Measure k M S) \<rho>)) + (trace (matrix_sum d (\<lambda>k. (M k) * \<rho> * adjoint (M k)) k) - trace (denote (Measure k M S) \<rho>))" for k 
       unfolding denote_measure_expand[OF _ wc]
     proof (induct k)
       case 0
       then show ?case unfolding matrix_sum.simps using dP dr by auto
     next
       case (Suc k)
       then have k: "k < n" by auto
       have eq1: "trace (matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k) (Suc k) * \<rho>) 
         = trace (adjoint (M k) * (wlp (S!k) P) * M k * \<rho>) + trace (matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k) k * \<rho>)"
         unfolding matrix_sum.simps
         using dMk[OF k] dWk[OF k] dr dsMW[OF k] by (mat_assoc d)
 
       have "trace (adjoint (M k) * (wlp (S!k) P) * M k * \<rho>) = trace ((wlp (S!k) P) * (M k * \<rho> * adjoint (M k)))" 
         using dMk[OF k] dWk[OF k] dr by (mat_assoc d)
       also have "\<dots> = trace (P * (denote (S!k) ((M k) * \<rho> * adjoint (M k)))) + 
         (trace ((M k) * \<rho> * adjoint (M k)) - trace (denote (S ! k) ((M k) * \<rho> * adjoint (M k))))" using leqk k by auto
       finally have eq2: "trace (adjoint (M k) * (wlp (S!k) P) * M k * \<rho>) = trace (P * (denote (S!k) ((M k) * \<rho> * adjoint (M k)))) + 
         (trace ((M k) * \<rho> * adjoint (M k)) - trace (denote (S ! k) ((M k) * \<rho> * adjoint (M k))))" .
 
       have eq3: "trace (P * matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) (Suc k)) 
         = trace (P * (denote (S!k) (M k * \<rho> * adjoint (M k)))) + trace (P * matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k)"
         unfolding matrix_sum.simps
         using dP dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d)
 
       have eq4: "trace (denote (S ! k) (M k * \<rho> * adjoint (M k)) + matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k)
         = trace (denote (S ! k) (M k * \<rho> * adjoint (M k))) + trace (matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k)"
         using dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d)
 
       show ?case
         apply (subst eq1) apply (subst eq3) 
         apply (simp del: less_eq_complex_def) 
         apply (subst trace_add_linear[of "M k * \<rho> * adjoint (M k)" d "matrix_sum d (\<lambda>k. M k * \<rho> * adjoint (M k)) k"])
           apply (simp add: dMk adjoint_dim[OF dMk] dr mult_carrier_mat[of _ d d _ d] k)
          apply (simp add: dsMrk k)
         apply (subst eq4)
         apply (insert eq2 Suc(1) k, fastforce)
         done
     qed
     then have leq: "trace (matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k) n * \<rho>)
        = trace (P * denote (Measure n M S) \<rho>) + 
           (trace (matrix_sum d (\<lambda>k. (M k) * \<rho> * adjoint (M k)) n) - trace (denote (Measure n M S) \<rho>))"
       by auto
     have "trace (matrix_sum d (\<lambda>k. (M k) * \<rho> * adjoint (M k)) n) = trace \<rho>" using trace_measurement m dr by auto
 
     with leq have "trace (matrix_sum d (\<lambda>k. adjoint (M k) * (wlp (S!k) P) * M k) n * \<rho>)
        = trace (P * denote (Measure n M S) \<rho>) + (trace \<rho> - trace (denote (Measure n M S) \<rho>))"
       unfolding denote_measure_def by auto
   }
   then show ?case unfolding wlp_measure_expand[OF wc] by auto
 next
   case (While M S)
   then have qpP: "is_quantum_predicate P" and dP: "P \<in> carrier_mat d d" 
     and wcS: "well_com S" and m: "measurement d 2 M" and wc: "well_com (While M S)"
     using is_quantum_predicate_def by auto
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using m measurement_def M0_def M1_def by auto
   have leM1: "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat m M1_def by auto
   define W where "W k = wlp_while_n M0 M1 (wlp S) k P" for k
   define DS where "DS = denote S"
   define D0 where "D0 = denote_while_n M0 M1 DS"
   define D1 where "D1 = denote_while_n_comp M0 M1 DS"
   define D where "D = denote_while_n_iter M0 M1 DS"
 
   have eqk: "\<rho> \<in> density_states \<Longrightarrow> trace ((W k) * \<rho>) = (\<Sum>k=0..<k. trace (P * (D0 k \<rho>))) + trace \<rho> - (\<Sum>k=0..<k. trace (D0 k \<rho>))" for k \<rho> 
   proof (induct k arbitrary: \<rho>)
     case 0
     then have dsr: "\<rho> \<in> density_states" by auto
     show ?case unfolding W_def wlp_while_n.simps using dsr density_states_def by auto 
   next
     case (Suc k)
     then have dsr: "\<rho> \<in> density_states" and dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def by auto
     then have dsM1r: "M1 * \<rho> * adjoint M1 \<in> density_states" unfolding density_states_def using pdo_close_under_measurement[OF dM1 dr pdor leM1] dr dM1 by auto
     then have dsDSM1r: "(DS (M1 * \<rho> * adjoint M1)) \<in> density_states" unfolding density_states_def DS_def 
       using denote_dim[OF wcS] denote_partial_density_operator[OF wcS] dsM1r by auto
     have qpWk: "is_quantum_predicate (W k)" 
       using wlp_while_n_close[OF _ m qpP, folded M0_def M1_def, of "wlp S", folded W_def] wlp_close[OF wcS] by auto
     then have "is_quantum_predicate (wlp S (W k))" using wlp_close[OF wcS] by auto
     then have dWWk: "wlp S (W k) \<in> carrier_mat d d" using is_quantum_predicate_def by auto
 
     have "trace (P * (M0 * \<rho> * adjoint M0)) + (\<Sum>k=0..<k. trace (P * (D0 k (DS (M1 * \<rho> * adjoint M1)))))
       = trace (P * (D0 0 \<rho>)) + (\<Sum>k=0..<k. trace (P * (D0 (Suc k) \<rho>)))"
       unfolding D0_def by auto
     also have "\<dots> = trace (P * (D0 0 \<rho>)) + (\<Sum>k=1..<(Suc k). trace (P * (D0 k \<rho>)))"
       using sum.shift_bounds_Suc_ivl[symmetric, of "\<lambda>k. trace (P * (D0 k \<rho>))"] by auto
     also have "\<dots> = (\<Sum>k=0..<(Suc k). trace (P * (D0 k \<rho>)))" using sum.atLeast_Suc_lessThan[of 0 "Suc k" "\<lambda>k. trace (P * (D0 k \<rho>))"] by auto
     finally have eq1: "trace (P * (M0 * \<rho> * adjoint M0)) + (\<Sum>k=0..<k. trace (P * (D0 k (DS (M1 * \<rho> * adjoint M1))))) 
       = (\<Sum>k=0..<(Suc k). trace (P * (D0 k \<rho>)))".
 
     have eq2: "trace (M1 * \<rho> * adjoint M1) = trace \<rho> - trace (M0 * \<rho> * adjoint M0)" 
       unfolding M0_def M1_def using m trace_measurement2[OF m dr] dr by (simp add: algebra_simps)
 
     have "trace (M0 * \<rho> * adjoint M0) + (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1))))
        = trace (D0 0 \<rho>) + (\<Sum>k=0..<k. trace (D0 (Suc k) \<rho>))" unfolding D0_def by auto
     also have "\<dots> = trace (D0 0 \<rho>) + (\<Sum>k=1..<(Suc k). trace (D0 k \<rho>))"
       using sum.shift_bounds_Suc_ivl[symmetric, of "\<lambda>k. trace (D0 k \<rho>)"] by auto
     also have "\<dots> = (\<Sum>k=0..<(Suc k). trace (D0 k \<rho>))"
       using sum.atLeast_Suc_lessThan[of 0 "Suc k" "\<lambda>k. trace (D0 k \<rho>)"] by auto
     finally have eq3: "trace (M0 * \<rho> * adjoint M0) + (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1)))) = (\<Sum>k=0..<(Suc k). trace (D0 k \<rho>))".
 
     then have "trace (M1 * \<rho> * adjoint M1) - (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1))))
       = trace \<rho> - (trace (M0 * \<rho> * adjoint M0) + (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1)))))"
       by (simp add: algebra_simps eq2)
     then have eq4: "trace (M1 * \<rho> * adjoint M1) - (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1)))) = trace \<rho> - (\<Sum>k=0..<(Suc k). trace (D0 k \<rho>))"
       by (simp add: eq3)
 
     have "trace ((W (Suc k)) * \<rho>) = trace (P * (M0 * \<rho> * adjoint M0)) + trace ((wlp S (W k)) * (M1 * \<rho> * adjoint M1))"
       unfolding W_def wlp_while_n.simps
       apply (fold W_def) using dM0 dP dM1 dWWk dr by (mat_assoc d)
     also have "\<dots> = trace (P * (M0 * \<rho> * adjoint M0)) + trace ((W k) * (DS (M1 * \<rho> * adjoint M1))) + trace (M1 * \<rho> * adjoint M1) - trace (DS (M1 * \<rho> * adjoint M1))"
       using While(1)[OF wcS, of "W k"] qpWk dsM1r DS_def by auto
     also have "\<dots> = trace (P * (M0 * \<rho> * adjoint M0))
       + (\<Sum>k=0..<k. trace (P * (D0 k (DS (M1 * \<rho> * adjoint M1))))) + trace (DS (M1 * \<rho> * adjoint M1)) - (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1))))
       + trace (M1 * \<rho> * adjoint M1) - trace (DS (M1 * \<rho> * adjoint M1))"
       using Suc(1)[OF dsDSM1r] by auto
     also have "\<dots> = trace (P * (M0 * \<rho> * adjoint M0)) + (\<Sum>k=0..<k. trace (P * (D0 k (DS (M1 * \<rho> * adjoint M1))))) 
       + trace (M1 * \<rho> * adjoint M1) - (\<Sum>k=0..<k. trace (D0 k (DS (M1 * \<rho> * adjoint M1))))"
       by auto
     also have "\<dots> = (\<Sum>k=0..<(Suc k). trace (P * (D0 k \<rho>))) + trace \<rho> - (\<Sum>k=0..<(Suc k). trace (D0 k \<rho>))"
       by (simp add: eq1 eq4)
     finally show ?case.
   qed
 
   {
     fix \<rho> assume dsr: "\<rho> \<in> density_states"
     then have dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def by auto
     have limDW: "limit_mat (\<lambda>n. matrix_sum d (\<lambda>k. D0 k \<rho>) (n)) (denote (While M S) \<rho>) d"
       using limit_mat_denote_while_n[OF wc dr pdor] unfolding D0_def M0_def M1_def DS_def by auto
     then have "limit_mat (\<lambda>n. (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n)))) (P * (denote (While M S) \<rho>)) d"
       using mat_mult_limit[OF dP] unfolding mat_mult_seq_def by auto
     then have limtrPm: "(\<lambda>n. trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n)))) \<longlonglongrightarrow> trace (P * (denote (While M S) \<rho>))"
       using mat_trace_limit by auto
 
     with limDW have limtrDW:"(\<lambda>n. trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n))) \<longlonglongrightarrow> trace (denote (While M S) \<rho>)"
       using mat_trace_limit by auto
 
     have limm: "(\<lambda>n. trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n))) \<longlonglongrightarrow> trace (denote (While M S) \<rho>)"
       using mat_trace_limit limDW by auto
 
     have closeWS: "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate (wlp S P)" for P
     proof -
       assume asm: "is_quantum_predicate P"
       then have dP: "P \<in> carrier_mat d d" using is_quantum_predicate_def by auto
       then show "is_quantum_predicate (wlp S P)" using wlp_mono_and_close[OF wcS asm asm] lowner_le_refl by auto
     qed
     have monoWS: "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> P \<le>\<^sub>L Q \<Longrightarrow> wlp S P \<le>\<^sub>L wlp S Q" for P Q
       using wlp_mono_and_close[OF wcS] by auto
   
     have "is_quantum_predicate (wlp (While M S) P)"
       using wlp_while_exists[of "wlp S" M P] closeWS monoWS m qpP by auto
                                                                         
     have "limit_mat W (wlp_while M0 M1 (wlp S) P) d" unfolding W_def M0_def M1_def 
       using wlp_while_exists[of "wlp S" M P] closeWS monoWS m qpP by auto
     then have "limit_mat (\<lambda>k. (W k) * \<rho>) ((wlp_while M0 M1 (wlp S) P) * \<rho>) d" using mult_mat_limit dr by auto
     then have lim1: "(\<lambda>k. trace ((W k) * \<rho>)) \<longlonglongrightarrow> trace ((wlp_while M0 M1 (wlp S) P) * \<rho>)" 
       using mat_trace_limit by auto
 
     have dD0kr: "D0 k \<rho> \<in> carrier_mat d d" for k unfolding D0_def 
       using denote_while_n_dim[OF dr dM0 dM1 pdor] denote_positive_trace_dim[OF wcS, folded DS_def] by auto
     then have "(P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n))) = matrix_sum d (\<lambda>k. P * (D0 k \<rho>)) n" for n
       using matrix_sum_distrib_left[OF dP] by auto
     moreover have "trace (matrix_sum d (\<lambda>k. P * (D0 k \<rho>)) n) = (\<Sum>k=0..<n. trace (P * (D0 k \<rho>)))" for n
       using trace_matrix_sum_linear dD0kr dP by auto
     ultimately have eqPsD0kr: "trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n))) = (\<Sum>k=0..<n. trace (P * (D0 k \<rho>)))" for n by auto
     with limtrPm have lim2: "(\<lambda>k. (\<Sum>k=0..<k. trace (P * (D0 k \<rho>)))) \<longlonglongrightarrow> trace (P * (denote (While M S) \<rho>))" by auto
 
     have "trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n)) = (\<Sum>k=0..<n. trace (D0 k \<rho>))" for n
       using trace_matrix_sum_linear dD0kr by auto
     with limtrDW have lim3: "(\<lambda>k. (\<Sum>k=0..<k. trace (D0 k \<rho>))) \<longlonglongrightarrow> trace (denote (While M S) \<rho>)" by auto
 
     have "(\<lambda>k. (\<Sum>k=0..<k. trace (P * (D0 k \<rho>))) + trace \<rho>) \<longlonglongrightarrow> trace (P * (denote (While M S) \<rho>)) + trace \<rho>"
       using tendsto_add[of "\<lambda>k. (\<Sum>k=0..<k. trace (P * (D0 k \<rho>)))"] lim2 by auto
     then have "(\<lambda>k. (\<Sum>k=0..<k. trace (P * (D0 k \<rho>))) + trace \<rho> - (\<Sum>k=0..<k. trace (D0 k \<rho>)))
        \<longlonglongrightarrow> trace (P * (denote (While M S) \<rho>)) + trace \<rho> -  trace (denote (While M S) \<rho>)"
       using tendsto_diff[of _ _ _ "\<lambda>k. (\<Sum>k=0..<k. trace (D0 k \<rho>))"] lim3 by auto
     then have lim4: "(\<lambda>k. trace ((W k) * \<rho>)) \<longlonglongrightarrow> trace (P * (denote (While M S) \<rho>)) + trace \<rho> -  trace (denote (While M S) \<rho>)"
       using eqk[OF dsr] by auto
 
     then have "trace ((wlp_while M0 M1 (wlp S) P) * \<rho>) = trace (P * (denote (While M S) \<rho>)) + trace \<rho> -  trace (denote (While M S) \<rho>)"
       using eqk[OF dsr] tendsto_unique[OF _ lim1 lim4] by auto
   }
   then show ?case unfolding M0_def M1_def DS_def wlp.simps by auto
 qed
 
 lemma denote_while_split:
   assumes wc: "well_com (While M S)" and dsr: "\<rho> \<in> density_states"
   shows "denote (While M S) \<rho> = (M 0) * \<rho> * adjoint (M 0) + denote (While M S) (denote S (M 1 * \<rho> * adjoint (M 1)))"
 proof -
   have m: "measurement d 2 M" using wc by auto
   have wcs: "well_com S" using wc by auto
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using m measurement_def M0_def M1_def by auto
   have M1leq: "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat m M1_def by auto
   define DS where "DS = denote S"
   define D0 where "D0 = denote_while_n M0 M1 DS"
   define D1 where "D1 = denote_while_n_comp M0 M1 DS"
   define D where "D = denote_while_n_iter M0 M1 DS"
   define DW where "DW \<rho> = denote (While M S) \<rho>" for \<rho>
 
   {
     fix \<rho> assume dsr: "\<rho> \<in> density_states"
     then have dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def by auto
     have pdoDkr: "\<And>k. partial_density_operator (D k \<rho>)" unfolding D_def
     using pdo_denote_while_n_iter[OF dr pdor dM1 M1leq]
       denote_partial_density_operator[OF wcs] denote_dim[OF wcs, folded DS_def] 
     apply (fold DS_def) by auto
     then have pDkr: "\<And>k. positive (D k \<rho>)" unfolding partial_density_operator_def by auto
     have dDkr: "\<And>k. D k \<rho> \<in> carrier_mat d d" 
       using denote_while_n_iter_dim[OF dr pdor dM1 M1leq denote_dim_pdo[OF wcs, folded DS_def], of id M0, simplified, folded D_def] by auto
     then have dD0kr: "\<And>k. D0 k \<rho> \<in> carrier_mat d d" unfolding D0_def denote_while_n.simps apply (fold D_def) using dM0 by auto
   }
   note dD0k = this
   have "matrix_sum d (\<lambda>k. D0 k \<rho>) k \<in> carrier_mat d d" if dsr: "\<rho> \<in> density_states" for \<rho> k 
     using matrix_sum_dim[OF dD0k, of _ "\<lambda>k. \<rho>" id, OF dsr] dsr by auto
   {
     fix k
     have "matrix_sum d (\<lambda>k. D0 k \<rho>) (Suc k) = (D0 0 \<rho>) + matrix_sum d (\<lambda>k. D0 (Suc k) \<rho>) k"
       using matrix_sum_shift_Suc[of _ "\<lambda>k. D0 k \<rho>"] dD0k[OF dsr] by fastforce
     also have "\<dots> = M0 * \<rho> * adjoint M0 + matrix_sum d (\<lambda>k. D0 k (DS (M1 * \<rho> * adjoint M1))) k"
       unfolding D0_def by auto
     finally have "matrix_sum d (\<lambda>k. D0 k \<rho>) (Suc k) = M0 * \<rho> * adjoint M0 + matrix_sum d (\<lambda>k. D0 k (DS (M1 * \<rho> * adjoint M1))) k".
   }
   note eqk = this
 
   have dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def dsr by auto 
   then have "M1 * \<rho> * adjoint M1 \<in> carrier_mat d d" and "partial_density_operator (M1 * \<rho> * adjoint M1)"
     using dM1 dr pdo_close_under_measurement[OF dM1 dr pdor M1leq] by auto
   then have dSM1r: "(DS (M1 * \<rho> * adjoint M1)) \<in> carrier_mat d d" and pdoSM1r: "partial_density_operator (DS (M1 * \<rho> * adjoint M1))"
     unfolding DS_def using denote_dim_pdo[OF wcs] by auto
 
   have "limit_mat (matrix_sum d (\<lambda>k. D0 k \<rho>)) (DW \<rho>) d" unfolding M0_def M1_def D0_def DS_def DW_def
     using limit_mat_denote_while_n[OF wc dr pdor] by auto
   then have liml: "limit_mat (\<lambda>k. matrix_sum d (\<lambda>k. D0 k \<rho>) (Suc k)) (DW \<rho>) d"
     using limit_mat_ignore_initial_segment[of "matrix_sum d (\<lambda>k. D0 k \<rho>)" "DW \<rho>" d 1] by auto
 
   have dM0r: "M0 * \<rho> * adjoint M0 \<in> carrier_mat d d" using dM0 dr by fastforce
   have "limit_mat (matrix_sum d (\<lambda>k. D0 k (DS (M1 * \<rho> * adjoint M1)))) (DW (DS (M1 * \<rho> * adjoint M1))) d"
     using limit_mat_denote_while_n[OF wc dSM1r pdoSM1r] unfolding M0_def M1_def D0_def DS_def DW_def by auto
   then have 
     limr: "limit_mat 
       (mat_add_seq (M0 * \<rho> * adjoint M0) (matrix_sum d (\<lambda>k. D0 k (DS (M1 * \<rho> * adjoint M1)))))
       (M0 * \<rho> * adjoint M0 + (DW (DS (M1 * \<rho> * adjoint M1))))
       d"
     using mat_add_limit[OF dM0r] by auto
   moreover have 
     "(\<lambda>k. matrix_sum d (\<lambda>k. D0 k \<rho>) (Suc k))
      = (mat_add_seq (M0 * \<rho> * adjoint M0) (matrix_sum d (\<lambda>k. D0 k (DS (M1 * \<rho> * adjoint M1)))))"
     using eqk mat_add_seq_def by auto
   ultimately have 
     "limit_mat
       (\<lambda>k. matrix_sum d (\<lambda>k. D0 k \<rho>) (Suc k))
       (M0 * \<rho> * adjoint M0 + (DW (DS (M1 * \<rho> * adjoint M1))))
       d" by auto
   with liml limit_mat_unique have 
     "DW \<rho> = (M0 * \<rho> * adjoint M0 + (DW (DS (M1 * \<rho> * adjoint M1))))" by auto
   then show ?thesis unfolding DW_def M0_def M1_def DS_def by auto
 qed
 
 lemma wlp_while_split:
   assumes wc: "well_com (While M S)" and qpP: "is_quantum_predicate P"
   shows "wlp (While M S) P = adjoint (M 0) * P * (M 0) + adjoint (M 1) * (wlp S (wlp (While M S) P)) * (M 1)"
 proof -
   have m: "measurement d 2 M" using wc by auto
   have wcs: "well_com S" using wc by auto
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   have dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" using m measurement_def M0_def M1_def by auto
   have M1leq: "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat m M1_def by auto
   define DS where "DS = denote S"
   define D0 where "D0 = denote_while_n M0 M1 DS"
   define D1 where "D1 = denote_while_n_comp M0 M1 DS"
   define D where "D = denote_while_n_iter M0 M1 DS"
   define DW where "DW \<rho> = denote (While M S) \<rho>" for \<rho>
 
   have dP: "P \<in> carrier_mat d d" using qpP is_quantum_predicate_def by auto
   have qpWP: "is_quantum_predicate (wlp (While M S) P)" using qpP wc wlp_close[OF wc qpP] by auto
   then have "is_quantum_predicate (wlp S (wlp (While M S) P))" using wc wlp_close[OF wcs] by auto
   then have dWWP: "(wlp S (wlp (While M S) P)) \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   have dWP: "(wlp (While M S) P) \<in> carrier_mat d d" using qpWP is_quantum_predicate_def by auto
   {
     fix \<rho> assume dsr: "\<rho> \<in> density_states"
     then have dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def by auto
     have dsM1r: "M1 * \<rho> * adjoint M1 \<in> density_states" unfolding density_states_def
       using pdo_close_under_measurement[OF dM1 dr pdor] M1leq dM1 dr by fastforce
     then have dsDSM1r: "DS (M1 * \<rho> * adjoint M1) \<in> density_states" unfolding density_states_def DS_def
       using denote_dim_pdo[OF wcs] by auto
     have dM0r: "M0 * \<rho> * adjoint M0 \<in> carrier_mat d d" using dM0 dr by fastforce
     have dDWDSM1r: "DW (DS (M1 * \<rho> * adjoint M1)) \<in> carrier_mat d d" 
       unfolding DW_def using denote_dim[OF wc] dsDSM1r density_states_def by auto
     
     have eq2: "trace ((wlp (While M S) P) * DS (M1 * \<rho> * adjoint M1))
           = trace (P * (DW (DS (M1 * \<rho> * adjoint M1)))) + trace (DS (M1 * \<rho> * adjoint M1)) - trace (DW (DS (M1 * \<rho> * adjoint M1)))"
       unfolding DW_def using wlp_soundness[OF wc qpP] dsDSM1r by auto
     have eq3: "trace (M1 * \<rho> * adjoint M1) = trace \<rho> - trace (M0 * \<rho> * adjoint M0)" 
       unfolding M0_def M1_def using m trace_measurement2[OF m dr] dr by (simp add: algebra_simps)
   
     have "trace (adjoint M1 * (wlp S (wlp (While M S) P)) * M1 * \<rho>)
           = trace ((wlp S (wlp (While M S) P)) * (M1 * \<rho> * adjoint M1))" using dWWP dM1 dr by (mat_assoc d)
     also have "\<dots> = trace ((wlp (While M S) P) * DS (M1 * \<rho> * adjoint M1)) 
                   + trace (M1 * \<rho> * adjoint M1) - trace (DS (M1 * \<rho> * adjoint M1))"
       unfolding DS_def using wlp_soundness[OF wcs qpWP] dsM1r by auto
     also have "\<dots> = trace (P * (DW (DS (M1 * \<rho> * adjoint M1)))) 
                   + trace (M1 * \<rho> * adjoint M1)  - trace (DW (DS (M1 * \<rho> * adjoint M1)))"
       using eq2 by auto
     also have "\<dots> = trace (P * (DW (DS (M1 * \<rho> * adjoint M1)))) + trace \<rho> - (trace (M0 * \<rho> * adjoint M0) + trace (DW (DS (M1 * \<rho> * adjoint M1))))" 
       using eq3 by auto
     finally have eq4: "trace (adjoint M1 * (wlp S (wlp (While M S) P)) * M1 * \<rho>) 
       = trace (P * (DW (DS (M1 * \<rho> * adjoint M1)))) + trace \<rho> - (trace (M0 * \<rho> * adjoint M0) + trace (DW (DS (M1 * \<rho> * adjoint M1))))".
   
     have "trace (adjoint M0 * P * M0 * \<rho>) + trace (P * (DW (DS (M1 * \<rho> * adjoint M1))))
       = trace (P * ((M0 * \<rho> * adjoint M0) + (DW (DS (M1 * \<rho> * adjoint M1)))))"
       using dP dr dM0 dDWDSM1r by (mat_assoc d)
     also have "\<dots> = trace (P * (DW \<rho>))" unfolding DW_def M0_def M1_def DS_def using denote_while_split[OF wc dsr] by auto
     finally have eq5: "trace (adjoint M0 * P * M0 * \<rho>) + trace (P * (DW (DS (M1 * \<rho> * adjoint M1)))) = trace (P * (DW \<rho>))".
   
     have "trace (M0 * \<rho> * adjoint M0) + trace (DW (DS (M1 * \<rho> * adjoint M1)))
       = trace (M0 * \<rho> * adjoint M0 + (DW (DS (M1 * \<rho> * adjoint M1))))"
       using dr dM0 dDWDSM1r by (mat_assoc d)
     also have "\<dots> = trace (DW \<rho>)"
       unfolding DW_def DS_def M0_def M1_def denote_while_split[OF wc dsr] by auto
     finally have eq6: "trace (M0 * \<rho> * adjoint M0) + trace (DW (DS (M1 * \<rho> * adjoint M1))) = trace (DW \<rho>)".
   
     from eq5 eq4 eq6 have
       eq7: "trace (adjoint M0 * P * M0 * \<rho>) + trace (adjoint M1 * wlp S (wlp (While M S) P) * M1 * \<rho>)
       = trace (P * DW \<rho>) + trace \<rho> - trace (DW \<rho>)" by auto
     have eq8: "trace (adjoint M0 * P * M0 * \<rho>) + trace (adjoint M1 * wlp S (wlp (While M S) P) * M1 * \<rho>)
       = trace ((adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1) * \<rho>)"
       using dM0 dM1 dr dP dWWP by (mat_assoc d)
     from eq7 eq8 have 
       eq9: "trace ((adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1) * \<rho>) = trace (P * DW \<rho>) + trace \<rho> - trace (DW \<rho>)" by auto
     have eq10: "trace ((wlp (While M S) P) * \<rho>) = trace (P * DW \<rho>) + trace \<rho> - trace (DW \<rho>)" 
       unfolding DW_def using wlp_soundness[OF wc qpP] dsr by auto
     with eq9 have "trace ((wlp (While M S) P) * \<rho>) = trace ((adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1) * \<rho>)" by auto
   }
   then have "(wlp (While M S) P) = (adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1)"
     using trace_pdo_eq_imp_eq[OF dWP, of "adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1"] 
       dM0 dP dM1 dWWP density_states_def by fastforce
   then show ?thesis using M0_def M1_def by auto
 qed
 
 lemma wlp_is_weakest_liberal_precondition:
   assumes "well_com S" and "is_quantum_predicate P"
   shows "is_weakest_liberal_precondition (wlp S P) S P"
   unfolding is_weakest_liberal_precondition_def
 proof (auto)
   show qpWP: "is_quantum_predicate (wlp S P)" using wlp_close assms by auto
   have eq: "trace (wlp S P * \<rho>) = trace (P * (denote S \<rho>)) + trace \<rho> - trace (denote S \<rho>)" if dsr: "\<rho> \<in> density_states" for \<rho> 
     using wlp_soundness assms dsr by auto
   then show "\<Turnstile>\<^sub>p {wlp S P} S {P}" unfolding hoare_partial_correct_def by auto
   fix Q assume qpQ: "is_quantum_predicate Q" and p: "\<Turnstile>\<^sub>p {Q} S {P}"
   {
     fix \<rho> assume dsr: "\<rho> \<in> density_states"
     then have "trace (Q * \<rho>) \<le> trace (P * (denote S \<rho>)) + trace \<rho> - trace (denote S \<rho>)" 
       using hoare_partial_correct_def p by auto
     then have "trace (Q * \<rho>) \<le> trace (wlp S P * \<rho>)" using eq[symmetric] dsr by auto
   }
   then show "Q \<le>\<^sub>L wlp S P" using lowner_le_trace density_states_def qpQ qpWP is_quantum_predicate_def by auto
 qed
 
 subsection \<open>Hoare triples for partial correctness\<close>
 
 inductive hoare_partial :: "complex mat \<Rightarrow> com \<Rightarrow> complex mat \<Rightarrow> bool" ("\<turnstile>\<^sub>p ({(1_)}/ (_)/ {(1_)})" 50) where
   "is_quantum_predicate P \<Longrightarrow> \<turnstile>\<^sub>p {P} SKIP {P}"
 | "is_quantum_predicate P \<Longrightarrow> \<turnstile>\<^sub>p {adjoint U * P * U} Utrans U {P}"
 | "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> is_quantum_predicate R \<Longrightarrow>
    \<turnstile>\<^sub>p {P} S1 {Q} \<Longrightarrow> \<turnstile>\<^sub>p {Q} S2 {R} \<Longrightarrow>
    \<turnstile>\<^sub>p {P} Seq S1 S2 {R}"
 | "(\<And>k. k < n \<Longrightarrow> is_quantum_predicate (P k)) \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow>
    (\<And>k. k < n \<Longrightarrow> \<turnstile>\<^sub>p {P k} S ! k {Q}) \<Longrightarrow>
    \<turnstile>\<^sub>p {matrix_sum d (\<lambda>k. adjoint (M k) * P k  * M k) n} Measure n M S {Q}"
 | "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow>
    \<turnstile>\<^sub>p {Q} S {adjoint (M 0) * P * M 0 + adjoint (M 1) * Q * M 1} \<Longrightarrow>
    \<turnstile>\<^sub>p {adjoint (M 0) * P * M 0 + adjoint (M 1) * Q * M 1} While M S {P}"
 | "is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> is_quantum_predicate P' \<Longrightarrow> is_quantum_predicate Q' \<Longrightarrow>
    P \<le>\<^sub>L P' \<Longrightarrow> \<turnstile>\<^sub>p {P'} S {Q'} \<Longrightarrow> Q' \<le>\<^sub>L Q \<Longrightarrow> \<turnstile>\<^sub>p {P} S {Q}"
 
 theorem hoare_partial_sound:
   "\<turnstile>\<^sub>p {P} S {Q} \<Longrightarrow> well_com S \<Longrightarrow> \<Turnstile>\<^sub>p {P} S {Q}"
 proof (induction rule: hoare_partial.induct)
   case (1 P)
   then show ?case
     unfolding hoare_partial_correct_def by auto
 next
   case (2 P U) (*utrans*)
   then have dU: "U \<in> carrier_mat d d" and "unitary U" and dP: "P \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   then have uU: "adjoint U * U = 1\<^sub>m d" using unitary_def by auto
   show ?case
     unfolding hoare_partial_correct_def denote.simps(2)
   proof 
     fix \<rho> assume "\<rho> \<in> density_states"
     then have dr: "\<rho> \<in> carrier_mat d d" using density_states_def by auto
     have e1: "trace (U * \<rho> * adjoint U) = trace ((adjoint U * U) * \<rho>)"
       using dr dU by (mat_assoc d)
     also have "\<dots> = trace \<rho>"
       using uU dr by auto
     finally have e1: "trace (U * \<rho> * adjoint U) = trace \<rho>" .
     have e2: "trace (P * (U * \<rho> * adjoint U)) = trace (adjoint U * P * U * \<rho>)"
       using dU dP dr by (mat_assoc d)
     with e1 have "trace (P * (U * \<rho> * adjoint U)) + (trace \<rho> - trace (U * \<rho> * adjoint U)) = trace (adjoint U * P * U * \<rho>)"
       using e1 by auto
     then show "trace (adjoint U * P * U * \<rho>) \<le> trace (P * (U * \<rho> * adjoint U)) + (trace \<rho> - trace (U * \<rho> * adjoint U))" by auto
   qed
 next
   case (3 P Q R S1 S2) (*seq*)
   then have wc1: "\<Turnstile>\<^sub>p {P} S1 {Q}" and wc2: "\<Turnstile>\<^sub>p {Q} S2 {R}" by auto
   show ?case
     unfolding hoare_partial_correct_def denote.simps(3)
   proof clarify
     fix \<rho> assume \<rho>: "\<rho> \<in> density_states"
     have 1: "trace (P * \<rho>) \<le> trace (Q * denote S1 \<rho>) + (trace \<rho> - trace (denote S1 \<rho>))"
       using wc1 hoare_partial_correct_def \<rho> by auto
     have \<rho>': "denote S1 \<rho> \<in> density_states"
       using 3(8) denote_density_states \<rho> by auto
     have 2: "trace (Q * denote S1 \<rho>) \<le> trace (R * denote S2 (denote S1 \<rho>)) + (trace (denote S1 \<rho>) - trace (denote S2 (denote S1 \<rho>)))"
       using wc2 hoare_partial_correct_def \<rho>' by auto
     show "trace (P * \<rho>) \<le> trace (R * denote S2 (denote S1 \<rho>)) + (trace \<rho> - trace (denote S2 (denote S1 \<rho>)))"
       using 1 2 by auto
   qed
 next
   case (4 n P Q S M) (*if*)
   then have wc: "k < n \<Longrightarrow> well_com (S!k)"
     and c: "k < n \<Longrightarrow> \<Turnstile>\<^sub>p {P k} (S!k) {Q}" and m: "measurement d n M"
     and dMk: "k < n \<Longrightarrow> M k \<in> carrier_mat d d"
     and aMMkleq: "k < n \<Longrightarrow> adjoint (M k) * M k \<le>\<^sub>L 1\<^sub>m d"
     and dPk: "k < n \<Longrightarrow> P k \<in> carrier_mat d d"
     and dQ: "Q \<in> carrier_mat d d"
     for k using is_quantum_predicate_def measurement_def measure_well_com measurement_le_one_mat by auto
 
     {
       fix \<rho> assume \<rho>: "\<rho> \<in> density_states"
       then have dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>" using density_states_def by auto
       have dsr: "k < n \<Longrightarrow> (M k) * \<rho> * adjoint (M k) \<in> density_states" for k unfolding density_states_def 
         using dMk pdo_close_under_measurement[OF dMk dr pdor aMMkleq] dr by fastforce
       then have leqk: "k < n \<Longrightarrow> trace ((P k) * ((M k) * \<rho> * adjoint (M k))) \<le> 
         trace (Q * (denote (S!k) ((M k) * \<rho> * adjoint (M k)))) + 
         (trace ((M k) * \<rho> * adjoint (M k)) - trace (denote (S ! k) ((M k) * \<rho> * adjoint (M k))))" for k 
         using c unfolding hoare_partial_correct_def by auto
       have "k < n \<Longrightarrow> M k * \<rho> * adjoint (M k) \<in> carrier_mat d d" for k using dMk dr by fastforce
       then have dsMrk: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. (M k * \<rho> * adjoint (M k))) k \<in> carrier_mat d d" for k 
         using matrix_sum_dim[of k "\<lambda>k. (M k * \<rho> * adjoint (M k))" d] by fastforce
       have "k < n \<Longrightarrow> adjoint (M k) * P k * M k \<in> carrier_mat d d" for k using dMk dPk by fastforce
       then have dsMP: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) k \<in> carrier_mat d d" for k 
         using matrix_sum_dim[of k "\<lambda>k. adjoint (M k) * P k * M k" d] by fastforce
       have dSMrk: "k < n \<Longrightarrow> denote (S ! k) (M k * \<rho> * adjoint (M k)) \<in> carrier_mat d d" for k 
         using denote_dim[OF wc, of k "M k * \<rho> * adjoint (M k)"] dsr density_states_def by fastforce
       have dsSMrk: "k < n \<Longrightarrow> matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k \<in> carrier_mat d d" for k
         using matrix_sum_dim[of k "\<lambda>k. denote (S ! k) (M k * \<rho> * adjoint (M k))" d, OF dSMrk] by fastforce
       have "k \<le> n \<Longrightarrow> 
           trace (matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) k * \<rho>)
          \<le> trace (Q * (denote (Measure k M S) \<rho>)) + (trace (matrix_sum d (\<lambda>k. (M k) * \<rho> * adjoint (M k)) k) - trace (denote (Measure k M S) \<rho>))" for k 
         unfolding denote_measure_expand[OF _ 4(5)]
       proof (induct k)
         case 0
         then show ?case using dQ dr pdor partial_density_operator_def positive_trace by auto
       next
         case (Suc k)
         then have k: "k < n" by auto
         have eq1: "trace (matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) (Suc k) * \<rho>) 
           = trace (adjoint (M k) * P k * M k * \<rho>) + trace (matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) k * \<rho>)"
           unfolding matrix_sum.simps
           using dMk[OF k] dPk[OF k] dr dsMP[OF k] by (mat_assoc d)
   
         have "trace (adjoint (M k) * P k * M k * \<rho>) = trace (P k * (M k * \<rho> * adjoint (M k)))" 
           using dMk[OF k] dPk[OF k] dr by (mat_assoc d)
         also have "\<dots> \<le> trace (Q * (denote (S!k) ((M k) * \<rho> * adjoint (M k)))) + 
           (trace ((M k) * \<rho> * adjoint (M k)) - trace (denote (S ! k) ((M k) * \<rho> * adjoint (M k))))" using leqk k by auto
         finally have eq2: "trace (adjoint (M k) * P k * M k * \<rho>) \<le> trace (Q * (denote (S!k) ((M k) * \<rho> * adjoint (M k)))) + 
           (trace ((M k) * \<rho> * adjoint (M k)) - trace (denote (S ! k) ((M k) * \<rho> * adjoint (M k))))".
   
         have eq3: "trace (Q * matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) (Suc k)) 
           = trace (Q * (denote (S!k) (M k * \<rho> * adjoint (M k)))) + trace (Q * matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k)"
           unfolding matrix_sum.simps 
           using dQ dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d)
   
         have eq4: "trace (denote (S ! k) (M k * \<rho> * adjoint (M k)) + matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k)
           = trace (denote (S ! k) (M k * \<rho> * adjoint (M k))) + trace (matrix_sum d (\<lambda>k. denote (S!k) (M k * \<rho> * adjoint (M k))) k)"
           using dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d)
   
         show ?case
           apply (subst eq1) apply (subst eq3) 
           apply (simp del: less_eq_complex_def) 
           apply (subst trace_add_linear[of "M k * \<rho> * adjoint (M k)" d "matrix_sum d (\<lambda>k. M k * \<rho> * adjoint (M k)) k"])
             apply (simp add: dMk adjoint_dim[OF dMk] dr mult_carrier_mat[of _ d d _ d] k)
            apply (simp add: dsMrk k)
           apply (subst eq4)
           apply (insert eq2 Suc(1) k, fastforce)
           done
       qed
       then have leq: "trace (matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) n * \<rho>)
          \<le> trace (Q * denote (Measure n M S) \<rho>) + 
             (trace (matrix_sum d (\<lambda>k. (M k) * \<rho> * adjoint (M k)) n) - trace (denote (Measure n M S) \<rho>))"
         by auto
       have "trace (matrix_sum d (\<lambda>k. (M k) * \<rho> * adjoint (M k)) n) = trace \<rho>" using trace_measurement m dr by auto
   
       with leq have "trace (matrix_sum d (\<lambda>k. adjoint (M k) * P k * M k) n * \<rho>)
          \<le> trace (Q * denote (Measure n M S) \<rho>) + (trace \<rho> - trace (denote (Measure n M S) \<rho>))"
         unfolding denote_measure_def by auto
     }
     then show ?case unfolding hoare_partial_correct_def by auto
 next
   case (5 P Q S M) (*while*)
   define M0 where "M0 = M 0"
   define M1 where "M1 = M 1"
   from 5 have wcs: "well_com S" and c: "\<Turnstile>\<^sub>p {Q} S {adjoint M0 * P * M0 + adjoint M1 * Q * M1}" 
     and m: "measurement d 2 M"
     and dM0: "M0 \<in> carrier_mat d d" and dM1: "M1 \<in> carrier_mat d d" 
     and dP: "P \<in> carrier_mat d d" and dQ: "Q \<in> carrier_mat d d" 
     and qpQ: "is_quantum_predicate Q"
     and wc: "well_com (While M S)"
     using measurement_def is_quantum_predicate_def M0_def M1_def by auto
   then have M0leq: "adjoint M0 * M0 \<le>\<^sub>L 1\<^sub>m d" and M1leq: "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat[OF m] M0_def M1_def by auto
   define DS where "DS = denote S"
 
   have "\<forall>\<rho> \<in> density_states. trace (Q * \<rho>) \<le> trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * DS \<rho>) + trace \<rho> - trace (DS \<rho>)" 
     using hoare_partial_correct_def[of Q S "adjoint M0 * P * M0 + adjoint M1 * Q * M1"] c DS_def by auto
   define D0 where "D0 = denote_while_n M0 M1 DS"
   define D1 where "D1 = denote_while_n_comp M0 M1 DS"
   define D where "D = denote_while_n_iter M0 M1 DS"
   {
     fix \<rho> assume dsr: "\<rho> \<in> density_states"
     then have dr: "\<rho> \<in> carrier_mat d d" and pr: "positive \<rho>" and pdor: "partial_density_operator \<rho>" 
       using density_states_def partial_density_operator_def by auto
     have pdoDkr: "\<And>k. partial_density_operator (D k \<rho>)" unfolding D_def
       using pdo_denote_while_n_iter[OF dr pdor dM1 M1leq]
         denote_partial_density_operator[OF wcs] denote_dim[OF wcs, folded DS_def] 
       apply (fold DS_def) by auto
     then have pDkr: "\<And>k. positive (D k \<rho>)" unfolding partial_density_operator_def by auto
     have dDkr: "\<And>k. D k \<rho> \<in> carrier_mat d d" 
       using denote_while_n_iter_dim[OF dr pdor dM1 M1leq denote_dim_pdo[OF wcs, folded DS_def], of id M0, simplified, folded D_def] by auto
     then have dD0kr: "\<And>k. D0 k \<rho> \<in> carrier_mat d d" unfolding D0_def denote_while_n.simps apply (fold D_def) using dM0 by auto
     then have dPD0kr: "\<And>k. P * (D0 k \<rho>) \<in> carrier_mat d d" using dP by auto
     have "\<And>k. positive (D0 k \<rho>)" unfolding D0_def denote_while_n.simps 
       by (fold D_def, rule positive_close_under_left_right_mult_adjoint[OF dM0 dDkr pDkr])
     then have trge0: "\<And>k. trace (D0 k \<rho>) \<ge> 0" using positive_trace dD0kr by blast
     have DSr: "\<rho> \<in> density_states \<Longrightarrow> DS \<rho> \<in> density_states" for "\<rho>" unfolding DS_def density_states_def
       using denote_partial_density_operator denote_dim wcs by auto
     have dsD1nr: "D1 n \<rho> \<in> density_states" for n unfolding D1_def denote_while_n_comp.simps 
       apply (fold D_def) unfolding density_states_def
       apply (auto)
        apply (insert dDkr dM1 adjoint_dim[OF dM1], auto)
       apply (rule pdo_close_under_measurement[OF dM1 spec[OF allI[OF dDkr], of "\<lambda>x. n"] spec[OF allI[OF pdoDkr], of "\<lambda>x. n"] M1leq])
       done
   
     have leQn: "trace (Q * D1 n \<rho>) 
           \<le> trace (P * D0 (Suc n) \<rho>) + trace (Q * D1 (Suc n) \<rho>)
           + trace (D1 n \<rho>) - trace (D (Suc n) \<rho>)" for n
     proof -
       have "(\<forall>\<rho>\<in>density_states. trace (Q * \<rho>) \<le> trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>)))"
         using c hoare_partial_correct_def by auto
       then have leQn': "trace (Q * (D1 n \<rho>)) 
           \<le> trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * (DS (D1 n \<rho>))) 
           + (trace (D1 n \<rho>) - trace (DS (D1 n \<rho>)))"
         using dsD1nr[of n] DS_def by auto
       have "(DS (D1 n \<rho>)) \<in> carrier_mat d d" unfolding DS_def using denote_dim[OF wcs] dsD1nr density_states_def by auto
       then have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * (DS (D1 n \<rho>)))
         = trace (P * (M0 * (DS (D1 n \<rho>)) * adjoint M0))
         + trace (Q * (M1 * (DS (D1 n \<rho>)) * adjoint M1))" using dP dQ dM0 dM1 by (mat_assoc d)
       moreover have "trace (P * (M0 * (DS (D1 n \<rho>)) * adjoint M0)) = trace (P * D0 (Suc n) \<rho>)" 
         unfolding D0_def denote_while_n.simps
         apply (subst denote_while_n_iter_assoc)
         by (fold denote_while_n_comp.simps D1_def, auto)
       moreover have "trace (Q * (M1 * (DS (D1 n \<rho>)) * adjoint M1)) = trace (Q * D1 (Suc n) \<rho>)"
         apply (subst (2) D1_def) unfolding denote_while_n_comp.simps
         apply (subst denote_while_n_iter_assoc)
         by (fold denote_while_n_comp.simps D1_def, auto)
       ultimately have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * (DS (D1 n \<rho>))) 
         = trace (P * D0 (Suc n) \<rho>) + trace (Q * D1 (Suc n) \<rho>)" by auto
       moreover have "trace (DS (D1 n \<rho>)) = trace (D (Suc n) \<rho>)"
         unfolding D_def 
         apply (subst denote_while_n_iter_assoc)
         by (fold denote_while_n_comp.simps D1_def, auto)
       ultimately show ?thesis using leQn' by auto
     qed
   
     have 12: "trace (P * (M0 * \<rho> * adjoint M0)) + trace (Q * (M1 * \<rho> * adjoint M1))
     \<le> (\<Sum>k=0..<(n+2). trace (P * (D0 k \<rho>))) + trace (Q * (D1 (n+1) \<rho>))
       + (\<Sum>k=0..<(n+1). trace (D1 k \<rho>) - trace (D (k+1) \<rho>))" for n
     proof (induct n)
       case 0
       show ?case apply (simp del: less_eq_complex_def) 
         unfolding D0_def D1_def D_def  denote_while_n_comp.simps denote_while_n.simps denote_while_n_iter.simps 
         using leQn[of 0] unfolding D1_def D0_def D_def denote_while_n.simps denote_while_n_comp.simps denote_while_n_iter.simps by auto
     next
       case (Suc n)
       have "trace (Q * D1 (n + 1) \<rho>) 
           \<le> trace (P * D0 (Suc (Suc n)) \<rho>) + trace (Q * D1 (Suc (Suc n)) \<rho>)
           + trace (D1 (Suc n) \<rho>) - trace (D (Suc (Suc n)) \<rho>)" using leQn[of "n + 1"] by auto
       with Suc show ?case apply (simp del: less_eq_complex_def) by auto
     qed
   
     have tr_measurement: "\<rho> \<in> carrier_mat d d
       \<Longrightarrow> trace (M0 * \<rho> * adjoint M0) + trace (M1 * \<rho> * adjoint M1) = trace \<rho>" for \<rho>
       using trace_measurement2[OF m, folded M0_def M1_def] by auto
   
     have 14: "(\<Sum>k=0..<(n+1). trace (D1 k \<rho>) - trace (D (k+1) \<rho>)) = trace \<rho> - trace (D (n+1) \<rho>) - (\<Sum>k=0..<(n+1). trace (D0 k \<rho>))" for n
     proof (induct n)
       case 0
       show ?case apply (simp) unfolding D1_def D0_def denote_while_n_comp.simps denote_while_n.simps denote_while_n_iter.simps
         using tr_measurement[OF dr] by (auto simp add: algebra_simps)
     next
       case (Suc n)
       have "trace (D0 (Suc n) \<rho>) + trace (D1 (Suc n) \<rho>) = trace (D (Suc n) \<rho>)" 
         unfolding D0_def D1_def denote_while_n.simps denote_while_n_comp.simps apply (fold D_def)
         using tr_measurement dDkr by auto
       then have "trace (D1 (Suc n) \<rho>) = trace (D (Suc n) \<rho>) - trace (D0 (Suc n) \<rho>)"
         by (auto simp add: algebra_simps)
       then show ?case using Suc by simp
     qed  
   
     have 15: "trace (Q * (D1 n \<rho>)) \<le> trace (D n \<rho>) - trace (D0 n \<rho>)" for n
     proof -
       have QleId: "Q \<le>\<^sub>L 1\<^sub>m d" using is_quantum_predicate_def qpQ by auto
       then have "trace (Q * (D1 n \<rho>)) \<le> trace (1\<^sub>m d * (D1 n \<rho>))" using 
           dsD1nr[of n] unfolding density_states_def lowner_le_trace[OF dQ one_carrier_mat] by auto
       also have "\<dots> = trace (D1 n \<rho>)" using dsD1nr[of n] unfolding density_states_def by auto
       also have "\<dots> = trace (M1 * (D n \<rho>) * adjoint M1)" unfolding D1_def denote_while_n_comp.simps D_def by auto
       also have "\<dots> = trace (D n \<rho>) - trace (M0 * (D n \<rho>) * adjoint M0)" 
         using tr_measurement[OF dDkr[of n]] by (simp add: algebra_simps)
       also have "\<dots> = trace (D n \<rho>) - trace (D0 n \<rho>)" unfolding D0_def denote_while_n.simps by (fold D_def, auto)
       finally show ?thesis.
     qed
   
     have tmp: "\<And>a b c. 0 \<le> a \<Longrightarrow> b \<le> c - a \<Longrightarrow> b \<le> (c::complex)" by simp
     then have 151: "\<And>n. trace (Q * (D1 n \<rho>)) \<le> trace (D n \<rho>)" 
       by (auto simp add: tmp[OF trge0 15] simp del: less_eq_complex_def)
   
     have main_leq: "\<And>n. trace (P * (M0 * \<rho> * adjoint M0)) + trace (Q * (M1 * \<rho> * adjoint M1))
           \<le> trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))) + trace \<rho> - trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))"
     proof -
       fix n
       have "(\<Sum>k=0..<(n+2). trace (P * (D0 k \<rho>))) + trace (Q * (D1 (n+1) \<rho>))
             + (\<Sum>k=0..<(n+1). trace (D1 k \<rho>) - trace (D (k+1) \<rho>))
             \<le> (\<Sum>k=0..<(n+2). trace (P * (D0 k \<rho>))) + trace (Q * (D1 (n+1) \<rho>))
             + trace \<rho> - trace (D (n+1) \<rho>) - (\<Sum>k=0..<(n+1). trace (D0 k \<rho>))"
         by (subst 14, auto)
       also have 
         "\<dots> \<le> (\<Sum>k=0..<(n+2). trace (P * (D0 k \<rho>))) + trace (D (n+1) \<rho>) - trace (D0 (n+1) \<rho>)
             + trace \<rho> - trace (D (n+1) \<rho>) - (\<Sum>k=0..<(n+1). trace (D0 k \<rho>))"
         using 15[of "n+1"] by auto
       also have "\<dots> = (\<Sum>k=0..<(n+2). trace (P * (D0 k \<rho>))) + trace \<rho> - (\<Sum>k=0..<(n+2). trace (D0 k \<rho>))" by auto
       also have "\<dots> = trace (matrix_sum d (\<lambda>k. (P * (D0 k \<rho>))) (n+2)) + trace \<rho> - (\<Sum>k=0..<(n+2). trace (D0 k \<rho>))"
         using trace_matrix_sum_linear[of "n+2" "\<lambda>k. (P * (D0 k \<rho>))" d, symmetric] dPD0kr by auto
       also have "\<dots> = trace (matrix_sum d (\<lambda>k. (P * (D0 k \<rho>))) (n+2)) + trace \<rho> - trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))"
         using trace_matrix_sum_linear[of "n+2" "\<lambda>k. D0 k \<rho>" d, symmetric] dD0kr by auto
       also have "\<dots> = trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))) + trace \<rho> - trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))"
         using matrix_sum_distrib_left[OF dP dD0kr, of id "n+2"] by auto
       finally have 
         "(\<Sum>k=0..<(n+2). trace (P * (D0 k \<rho>))) + trace (Q * (D1 (n+1) \<rho>))
          + (\<Sum>k=0..<(n+1). trace (D1 k \<rho>) - trace (D (k+1) \<rho>))
         \<le> trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))) + trace \<rho> - trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))" .
       then show "trace (P * (M0 * \<rho> * adjoint M0)) + trace (Q * (M1 * \<rho> * adjoint M1))
           \<le> trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))) + trace \<rho> - trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))" using 12[of n] by auto
     qed
   
     have "limit_mat (\<lambda>n. matrix_sum d (\<lambda>k. D0 k \<rho>) (n)) (denote (While M S) \<rho>) d"
       using limit_mat_denote_while_n[OF wc dr pdor] unfolding D0_def M0_def M1_def DS_def by auto
     then have limp2: "limit_mat (\<lambda>n. matrix_sum d (\<lambda>k. D0 k \<rho>) (n + 2)) (denote (While M S) \<rho>) d"
       using limit_mat_ignore_initial_segment[of "\<lambda>n. matrix_sum d (\<lambda>k. D0 k \<rho>) (n)" "(denote (While M S) \<rho>)" d 2] by auto
     then have "limit_mat (\<lambda>n. (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2)))) (P * (denote (While M S) \<rho>)) d"
       using mat_mult_limit[OF dP] unfolding mat_mult_seq_def by auto
     then have limPm: "(\<lambda>n. trace (P * (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2)))) \<longlonglongrightarrow> trace (P * (denote (While M S) \<rho>))"
       using mat_trace_limit by auto
   
     have limm: "(\<lambda>n. trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n+2))) \<longlonglongrightarrow> trace (denote (While M S) \<rho>)"
       using mat_trace_limit limp2 by auto
   
     have leq_lim: "trace (P * (M0 * \<rho> * adjoint M0)) + trace (Q * (M1 * \<rho> * adjoint M1)) 
       \<le> trace (P * (denote (While M S) \<rho>)) + trace \<rho> - trace (denote (While M S) \<rho>)" (is "?lhs \<le> ?rhs")
       using main_leq
     proof -
       define seq where "seq n = trace (P * matrix_sum d (\<lambda>k. D0 k \<rho>) (n + 2)) - trace (matrix_sum d (\<lambda>k. D0 k \<rho>) (n + 2)) " for n
       define seqlim where "seqlim = trace (P * (denote (While M S) \<rho>)) - trace (denote (While M S) \<rho>)"
       have main_leq': "?lhs \<le> trace \<rho> + seq n" for n 
         unfolding seq_def using main_leq by (simp add: algebra_simps)
       have limseq: "seq \<longlonglongrightarrow> seqlim"
-        unfolding seq_def seqlim_def using tendsto_intros(15)[OF limPm limm]  by auto
+        unfolding seq_def seqlim_def using tendsto_diff[OF limPm limm]  by auto
       have limrs: "(\<lambda>n. trace \<rho> + seq n) \<longlonglongrightarrow> (trace \<rho> + seqlim)" using tendsto_add[OF _ limseq] by auto
   
       have limrsRe: "(\<lambda>n. Re (trace \<rho> + seq n)) \<longlonglongrightarrow> Re (trace \<rho> + seqlim)" using tendsto_Re[OF limrs] by auto
       have main_leq_Re: "Re ?lhs \<le> Re (trace \<rho> + seq n)" for n using main_leq' by auto
       have Re: "Re ?lhs \<le> Re (trace \<rho> + seqlim)" 
         using Lim_bounded2[OF limrsRe ]  main_leq_Re by auto
   
       have limrsIm: "(\<lambda>n. Im (trace \<rho> + seq n)) \<longlonglongrightarrow> Im (trace \<rho> + seqlim)" using tendsto_Im[OF limrs] by auto
       have main_leq_Im: "Im ?lhs = Im (trace \<rho> + seq n)" for n using main_leq' unfolding less_eq_complex_def by auto
       then have limIm: "(\<lambda>n. Im (trace \<rho> + seq n)) \<longlonglongrightarrow> Im ?lhs" using tendsto_intros(1) by auto
       have Im: "Im ?lhs = Im (trace \<rho> + seqlim)" 
         using tendsto_unique[OF _ limIm limrsIm] by auto
   
       have "?lhs \<le> trace \<rho> + seqlim" using Re Im by auto
       then show "?lhs \<le> ?rhs" unfolding seqlim_def by auto
     qed
   
     have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * \<rho>) =
       trace (P * (M0 * \<rho> * adjoint M0)) + trace (Q * (M1 * \<rho> * adjoint M1))"
       using dr dM0 dM1 dP dQ by (mat_assoc d)
     then have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * \<rho>) \<le> 
       trace (P * (denote (While M S) \<rho>)) + (trace \<rho> - trace (denote (While M S) \<rho>))"
       using leq_lim by auto
   }
   then show ?case unfolding hoare_partial_correct_def denote.simps(5) 
     apply (fold M0_def M1_def DS_def D0_def D1_def) by auto
 next
   case (6 P Q P' Q' S)
   then have wcs: "well_com S" and c: "\<Turnstile>\<^sub>p {P'} S {Q'}" 
     and dP: "P \<in> carrier_mat d d" and dQ: "Q \<in> carrier_mat d d"
     and dP': "P' \<in> carrier_mat d d" and dQ': "Q' \<in> carrier_mat d d"
     using is_quantum_predicate_def by auto
   show ?case unfolding hoare_partial_correct_def
   proof 
     fix \<rho> assume pds: "\<rho> \<in> density_states"
     then have pdor: "partial_density_operator \<rho>" and dr: "\<rho> \<in> carrier_mat d d" 
       using density_states_def by auto
     have pdoSr: "partial_density_operator (denote S \<rho>)" 
       using denote_partial_density_operator pdor dr wcs by auto
     have dSr: "denote S \<rho> \<in> carrier_mat d d"  
       using denote_dim pdor dr wcs by auto
     have "trace (P * \<rho>) \<le> trace (P' * \<rho>)" using lowner_le_trace[OF dP dP'] 6 dr pdor by auto
     also have "\<dots> \<le> trace (Q' * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>))"
       using c unfolding hoare_partial_correct_def using pds by auto
     also have "\<dots> \<le> trace (Q * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>))" using lowner_le_trace[OF dQ' dQ] 6 dSr pdoSr by auto
     finally show "trace (P * \<rho>) \<le> trace (Q * denote S \<rho>) + (trace \<rho> - trace (denote S \<rho>)) ".
   qed
 qed
 
 lemma wlp_complete:
   "well_com S \<Longrightarrow> is_quantum_predicate P \<Longrightarrow> \<turnstile>\<^sub>p {wlp S P} S {P}"
 proof (induct S arbitrary: P)
   case SKIP
   then show ?case unfolding wlp.simps using hoare_partial.intros by auto
 next
   case (Utrans U)
   then show ?case unfolding wlp.simps using hoare_partial.intros by auto
 next
   case (Seq S1 S2)
   then have wc1: "well_com S1" and wc2: "well_com S2" and qpP: "is_quantum_predicate P" 
     and p2: "\<turnstile>\<^sub>p {wlp S2 P} S2 {P}" by auto
   have qpW2P: "is_quantum_predicate (wlp S2 P)" using wlp_close[OF wc2 qpP] by auto
   then have p1: "\<turnstile>\<^sub>p {wlp S1 (wlp S2 P)} S1 {wlp S2 P}" using Seq by auto
   have qpW1W2P: "is_quantum_predicate (wlp S1 (wlp S2 P))" using wlp_close[OF wc1 qpW2P] by auto
   then show ?case unfolding wlp.simps using hoare_partial.intros qpW1W2P qpW2P qpP p1 p2 by auto
 next
   case (Measure n M S)
   then have wc: "well_com (Measure n M S)" and qpP: "is_quantum_predicate P" by auto
   have set: "k < n \<Longrightarrow> (S!k) \<in> set S" for k using wc by auto
   have wck: "k < n \<Longrightarrow> well_com (S!k)" for k using wc measure_well_com by auto
   then have qpWkP: "k < n \<Longrightarrow> is_quantum_predicate (wlp (S!k) P)" for k using wlp_close qpP by auto
   have pk: "k < n \<Longrightarrow> \<turnstile>\<^sub>p {(wlp (S!k) P)} (S!k) {P}" for k using Measure(1) set wck qpP by auto
   show ?case unfolding wlp_measure_expand[OF wc] using hoare_partial.intros qpWkP qpP pk  by auto
 next
   case (While M S)
   then have wc: "well_com (While M S)" and wcS: "well_com S" and qpP: "is_quantum_predicate P " by auto
   have qpWP: "is_quantum_predicate (wlp (While M S) P)" using wlp_close[OF wc qpP] by auto
   then have qpWWP: "is_quantum_predicate (wlp S (wlp (While M S) P))" using wlp_close wcS by auto
   have "\<turnstile>\<^sub>p {wlp S (wlp (While M S) P)} S {wlp (While M S) P}" using While(1) wcS qpWP by auto
   moreover have eq: "wlp (While M S) P = adjoint (M 0) * P * M 0 + adjoint (M 1) * wlp S (wlp (While M S) P) * M 1"
     using wlp_while_split wc qpP by auto
   ultimately have p: "\<turnstile>\<^sub>p {wlp S (wlp (While M S) P)} S {adjoint (M 0) * P * M 0 + adjoint (M 1) * wlp S (wlp (While M S) P) * M 1}" by auto    
   then show ?case using hoare_partial.intros(5)[OF qpP qpWWP p] eq by auto 
 qed
 
 theorem hoare_partial_complete:
   "\<Turnstile>\<^sub>p {P} S {Q} \<Longrightarrow> well_com S \<Longrightarrow> is_quantum_predicate P \<Longrightarrow> is_quantum_predicate Q \<Longrightarrow> \<turnstile>\<^sub>p {P} S {Q}"
 proof -
   assume p: "\<Turnstile>\<^sub>p {P} S {Q}" and wc: "well_com S" and qpP: "is_quantum_predicate P" and qpQ: "is_quantum_predicate Q"
   then have dQ: "Q \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   have qpWP: "is_quantum_predicate (wlp S Q)" using wlp_close wc qpQ by auto
   then have dWP: "wlp S Q \<in> carrier_mat d d" using is_quantum_predicate_def by auto
   have eq: "trace (wlp S Q * \<rho>) = trace (Q * (denote S \<rho>)) + trace \<rho> - trace (denote S \<rho>)" if dsr: "\<rho> \<in> density_states" for \<rho> 
     using wlp_soundness wc qpQ dsr by auto
   then have "\<Turnstile>\<^sub>p {wlp S Q} S {Q}" unfolding hoare_partial_correct_def by auto
   {
     fix \<rho> assume dsr: "\<rho> \<in> density_states"
     then have "trace (P * \<rho>) \<le> trace (Q * (denote S \<rho>)) + trace \<rho> - trace (denote S \<rho>)" 
       using hoare_partial_correct_def p by auto
     then have "trace (P * \<rho>) \<le> trace (wlp S Q * \<rho>)" using eq[symmetric] dsr by auto
   }
   then have le: "P \<le>\<^sub>L wlp S Q" using lowner_le_trace density_states_def qpP qpWP is_quantum_predicate_def by auto
   moreover have wlp: "\<turnstile>\<^sub>p {wlp S Q} S {Q}" using wlp_complete wc qpQ by auto
   ultimately show "\<turnstile>\<^sub>p {P} S {Q}" using hoare_partial.intros(6)[OF qpP qpQ qpWP qpQ] lowner_le_refl[OF dQ] by auto
 qed
 
 subsection \<open>Consequences of completeness\<close>
 
 lemma hoare_patial_seq_assoc_sem:
   shows "\<Turnstile>\<^sub>p {A} (S1 ;; S2) ;; S3 {B} \<longleftrightarrow> \<Turnstile>\<^sub>p {A} S1 ;; (S2 ;; S3) {B}"
   unfolding hoare_partial_correct_def denote.simps by auto
 
 lemma hoare_patial_seq_assoc:
   assumes "well_com S1" and "well_com S2" and "well_com S3"
     and "is_quantum_predicate A" and "is_quantum_predicate B"
   shows "\<turnstile>\<^sub>p {A} (S1 ;; S2) ;; S3 {B} \<longleftrightarrow> \<turnstile>\<^sub>p {A} S1 ;; (S2 ;; S3) {B}"
 proof 
   assume "\<turnstile>\<^sub>p {A} S1;; S2;; S3 {B}"
   then have "\<Turnstile>\<^sub>p {A} (S1 ;; S2) ;; S3 {B}" using hoare_partial_sound assms by auto
   then have "\<Turnstile>\<^sub>p {A} S1 ;; (S2 ;; S3) {B}" using hoare_patial_seq_assoc_sem by auto
   then show "\<turnstile>\<^sub>p {A} S1 ;; (S2 ;; S3) {B}" using hoare_partial_complete assms by auto
 next
   assume "\<turnstile>\<^sub>p {A} S1;; (S2;; S3) {B}"
   then have "\<Turnstile>\<^sub>p {A} S1;; (S2;; S3) {B}" using hoare_partial_sound assms by auto
   then have "\<Turnstile>\<^sub>p {A} S1;; S2;; S3 {B}" using hoare_patial_seq_assoc_sem by auto
   then show "\<turnstile>\<^sub>p {A} S1;; S2;; S3 {B}" using hoare_partial_complete assms by auto
 qed
 
 end
 
 end
diff --git a/thys/Transcendence_Series_Hancl_Rucki/Transcendence_Series.thy b/thys/Transcendence_Series_Hancl_Rucki/Transcendence_Series.thy
--- a/thys/Transcendence_Series_Hancl_Rucki/Transcendence_Series.thy
+++ b/thys/Transcendence_Series_Hancl_Rucki/Transcendence_Series.thy
@@ -1,1042 +1,1042 @@
 (* Title:     Transcendence_Series.thy
    Authors:   Angeliki Koutsoukou-Argyraki and Wenda Li, University of Cambridge
 *)
 
 section \<open>The transcendence of certain infinite series\<close>
 theory "Transcendence_Series" imports
     "HOL-Analysis.Multivariate_Analysis"
     "HOL-Computational_Algebra.Polynomial"
     Prime_Number_Theorem.Prime_Number_Theorem_Library
 begin
 
 text \<open>
 We formalise the proofs of two transcendence criteria by J. Han\v{c}l and P. Rucki that
 assert the transcendence of the sums of certain infinite series built up by sequences that 
 fulfil certain properties (Theorems 2.1 and 2.2 in \cite{hancl2005}, HanclRucki1 and HanclRucki2 
 here respectively). Both proofs make use of Roth's celebrated theorem on diophantine approximations 
 to algebraic numbers from 1955 \cite{roth_1955} which we assume and implement within the locale 
 RothsTheorem.
 
 A small mistake was detected in the original proof of Theorem 2.1, and the authors suggested
 to us a fix for the problem (in communication by email). 
 Our formalised proof incorporates this correction (see the Remark in the proof of HanclRucki1).
 \<close>
 
 subsection \<open>Misc\<close>
 
 lemma powr_less_inverse_iff:
   fixes x y z::real
   assumes "x>0""y>0""z>0"
   shows "x powr y < z \<longleftrightarrow> x < z powr (inverse y)"
 proof
   assume "x powr y < z"
   from powr_less_mono2[OF _ _ this,of "inverse y"] 
   show "x < z powr inverse y" 
     using assms by (auto simp:powr_powr)
 next
   assume *:"x < z powr inverse y"
   from powr_less_mono2[OF _ _ *,of y] show "x powr y < z"
     using assms by (auto simp:powr_powr)
 qed
 
 lemma powr_less_inverse_iff':
   fixes x y z::real
   assumes "x>0""y>0""z>0"
   shows "z< x powr y \<longleftrightarrow> z powr (inverse y) < x"
   using powr_less_inverse_iff[symmetric,of _ "inverse y"] assms by auto
 
 lemma powr_less_eq_inverse_iff:
   fixes x y z::real
   assumes "x>0""y>0""z>0"
   shows "x powr y \<le> z \<longleftrightarrow> x \<le> z powr (inverse y)"
   by (meson assms(1) assms(2) assms(3) not_less powr_less_inverse_iff')
 
 lemma powr_less_eq_inverse_iff':
   fixes x y z::real
   assumes "x>0""y>0""z>0"
   shows "z\<le> x powr y \<longleftrightarrow> z powr (inverse y) \<le> x"
   by (simp add: assms(1) assms(2) assms(3) powr_less_eq_inverse_iff)
 
 lemma tendsto_PInfty_mono:
   assumes "(ereal o f) \<longlonglongrightarrow> \<infinity>" "\<forall>\<^sub>F x in sequentially. f x \<le> g x"
   shows "(ereal o g) \<longlonglongrightarrow> \<infinity>"
   using assms unfolding comp_def tendsto_PInfty_eq_at_top
   by (elim filterlim_at_top_mono, simp)
 
 lemma limsup_infinity_imp_Inf_many:
   assumes "limsup f = \<infinity>"
   shows "(\<forall> m. (\<exists>\<^sub>\<infinity>i. f i > ereal m))" unfolding INFM_nat
 proof (clarify,rule ccontr)
   fix m k assume "\<not> (\<exists>n>k. ereal m < f n)"
   then have "\<forall>n>k. f n \<le> ereal m" by auto
   then have "\<forall>\<^sub>F n in sequentially. f n \<le> ereal m"
     using eventually_at_top_dense by blast
   then have "limsup f \<le> ereal m" using Limsup_bounded by auto
   then show False using assms by simp
 qed
 
 lemma snd_quotient_plus_leq:
   defines "de\<equiv>(snd o quotient_of)"
   shows "de (x+y) \<le> de x * de y "
 proof -                                
   obtain x1 x2 y1 y2 where xy: "quotient_of x = (x1,x2)" "quotient_of y=(y1,y2)"
     by (meson surj_pair)
   have "x2>0" "y2>0" using xy quotient_of_denom_pos by blast+
   then show ?thesis
     unfolding de_def comp_def rat_plus_code xy 
     apply (auto split:prod.split simp:Rat.normalize_def Let_def)
     by (smt div_by_1 gcd_pos_int int_div_less_self mult_eq_0_iff mult_sign_intros(1))
 qed
 
 lemma quotient_of_inj: "inj quotient_of"
   unfolding inj_def by (simp add: quotient_of_inject)
 
 lemma infinite_inj_imageE:
   assumes "infinite A" "inj_on f A" "f ` A \<subseteq> B"
   shows "infinite B"
   using assms inj_on_finite by blast
 
 lemma incseq_tendsto_limsup:
   fixes f::"nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
   assumes "incseq f"
   shows "f \<longlonglongrightarrow> limsup f"
   using LIMSEQ_SUP assms convergent_def convergent_ereal tendsto_Limsup 
           trivial_limit_sequentially by blast
 
 subsection \<open>Main proofs\<close>
 
 text \<open>Since the proof of Roths theorem has not been formalized yet, we implement it into a locale 
       and used it as an assumption.\<close>
 locale RothsTheorem = 
   assumes RothsTheorem:"\<forall>\<xi> \<kappa>. algebraic \<xi> \<and> \<xi> \<notin> \<rat> \<and> infinite {(p,q). q>0 \<and> 
             coprime p q \<and> \<bar>\<xi> - of_int p / of_int q\<bar> < 1 / q powr \<kappa>} \<longrightarrow> \<kappa> \<le> 2"
 
 theorem (in RothsTheorem) HanclRucki1:
   fixes a b ::"nat\<Rightarrow>int" and \<delta> ::real 
   defines "aa\<equiv>(\<lambda>n. real_of_int (a n))" and "bb\<equiv>(\<lambda>n. real_of_int (b n))"
   assumes a_pos:"\<forall> k. a k >0" and b_pos:"\<forall> k. b k >0" and "\<delta> >0"
       and limsup_infy:"limsup (\<lambda> k. aa (k+1)/(\<Prod>i = 0..k. aa i)powr(2+\<delta>)*(1/bb (k+1))) = \<infinity>" 
       and liminf_1:"liminf (\<lambda>k. aa (k+1) / aa k * bb k / bb (k+1)) > 1"
   shows "\<not> algebraic(suminf  (\<lambda> k. bb k / aa k))" 
 proof -
   have summable:"summable (\<lambda> k. bb k / aa k)" 
   proof (rule ratio_test_convergence)
     have [simp]:"aa k>0" "bb k>0" for k
       unfolding aa_def bb_def using a_pos b_pos by auto
     show "\<forall>\<^sub>F n in sequentially. 0 < bb n / aa n"
       apply (rule eventuallyI)
       by auto
     show "1 < liminf (\<lambda>n. ereal (bb n / aa n / (bb (Suc n) / aa (Suc n))))" 
       using liminf_1 by (auto simp:algebra_simps) 
   qed
   have [simp]: "aa k>0" "bb k>0" for k unfolding aa_def bb_def 
     by (auto simp add: a_pos b_pos)
   have ab_1:"aa k\<ge>1" "bb k\<ge>1" for k
     unfolding aa_def bb_def using a_pos b_pos 
     by (auto simp add: int_one_le_iff_zero_less)
 
   define B where "B=liminf (\<lambda>x. ereal (aa (x + 1) / aa x * bb x / bb (x + 1)))"
   define M where "M= (case B of ereal m \<Rightarrow> (m+1)/2 | _ \<Rightarrow> 2)"
   have "M > 1" "M < B"
     using liminf_1 unfolding M_def 
     apply (fold B_def)
     by (cases B,auto)+
 
   text \<open>
 Remark:
 In the original proof of Theorem 2.1 in \cite{hancl2005}
 it was claimed in p.534 that from assumption (3) (i.e. @{thm liminf_1}),
 we obtain that:
 $\forall A>1~\exists k_0~ \forall k > k_0~ \frac{1}{A} \frac{b_k}{ a_k} > \frac{ b_{k+1}}{ a_{k+1}} $,
  however note the counterexample  where
 $a_{k+1}= k (a_1 a_2 ... a_k)^{\lceil 2+ \delta \rceil}$ if k is odd, and
 $a_{k+1} = 2 a_k$ otherwise, with $b_k =1$ for all $k$.
 In commmunication by email the authors suggested to replace the claim 
 $\forall A>1~\exists k_0~ \forall k > k_0~ \frac{1}{A} \frac{b_k}{ a_k} > \frac{ b_{k+1}}{ a_{k+1}} $
 with
 $\exists A>1~\exists k_0~ \forall k > k_0~ \frac{1}{A} \frac{b_k}{ a_k} > \frac{ b_{k+1}}{ a_{k+1}} $
 which solves the problem and the proof proceeds as in the paper.
 The witness for $\exists A>1 $ is denoted by $M$ here.\<close>
 
   have bb_aa_event:"\<forall>\<^sub>F k in sequentially. (1/M)*(bb k / aa k)> bb(k+1)/ aa (k+1)"
     using less_LiminfD[OF \<open>M < B\<close>[unfolded B_def],simplified] 
     apply eventually_elim
     using \<open>M > 1\<close> by (auto simp:divide_simps algebra_simps)
 
   have bb_aa_p:"\<forall>\<^sub>F k in sequentially. \<forall>p. bb(k+p)/ aa (k+p) \<le> (1/M^p)*(bb k / aa k)" 
   proof -
     obtain k0 where k0_ineq:
         "\<forall>n\<ge>k0. bb (n + 1) / aa (n + 1) < 1 / M * (bb n / aa n)" 
       using bb_aa_event unfolding eventually_sequentially
       by auto
     have "bb(k+p)/ aa (k+p) \<le> (1/M^p)*(bb k / aa k)" when "k\<ge>k0" for p k
     proof (induct p)
       case 0
       then show ?case by auto
     next
       case (Suc p)
       have " bb (k + Suc p) / aa (k + Suc p)  < 1 / M * (bb (k+p) / aa (k+p))"
         using k0_ineq[rule_format,of "k+p"] that by auto
       also have "... \<le> 1 / M ^(Suc p) * (bb k / aa k)"
         using Suc \<open>M>1\<close> by (auto simp add:field_simps)
       finally show ?case by auto
     qed
     then show ?thesis unfolding eventually_sequentially by auto
   qed
 
   define \<xi> where "\<xi> = suminf (\<lambda> k. bb k / aa k)"
   have \<xi>_Inf_many:"\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar> <  1 / prod aa {0..k} powr (2 + \<delta>)" 
   proof -
     have "\<bar>\<xi> - (\<Sum>i = 0..k. bb i / aa i)\<bar> = \<bar>\<Sum>i. bb (i+(k+1)) / aa (i+(k+1))\<bar>"
       for k
       unfolding \<xi>_def
       apply (subst suminf_minus_initial_segment[of _ "k+1",OF summable])
       using atLeast0AtMost lessThan_Suc_atMost by auto
     
     moreover have "\<exists>\<^sub>\<infinity> k. \<bar>\<Sum>i. bb(i+(k+1))/ aa (i+(k+1))\<bar>
                             <  1 / prod aa {0..k} powr (2 + \<delta>)" 
     proof -
       define P where "P = (\<lambda> i. \<forall>p. bb (i + 1 + p) / aa (i + 1 + p)
                                           \<le> 1 / M ^ p * (bb (i + 1) / aa (i + 1)))"
       define Q where "Q= (\<lambda> i. ereal (M / (M - 1)) 
                     < ereal (aa (i + 1) / prod aa {0..i} powr (2 + \<delta>) * (1 / bb (i + 1))))"
       have "\<forall>\<^sub>\<infinity> i. P i"
         using bb_aa_p[THEN sequentially_offset, of 1] cofinite_eq_sequentially
         unfolding P_def by auto
       moreover have "\<exists>\<^sub>\<infinity>i. Q i"
         using limsup_infy[THEN limsup_infinity_imp_Inf_many,rule_format,of "(M / (M -1))"]
         unfolding Q_def .
       moreover have "\<bar>\<Sum>i. bb(i+(k+1))/ aa (i+(k+1))\<bar>
                             <  1 / prod aa {0..k} powr (2 + \<delta>)"
         when "P k" "Q k" for k
       proof -
         have summable_M:"summable (\<lambda>i. 1 / M ^ i)"
           apply (rule summable_ratio_test[of "1/M"])
           using \<open>M>1\<close> by auto
         
         have "(\<Sum>i. bb (i + (k + 1)) / aa (i + (k + 1))) \<ge> 0"
           apply (rule suminf_nonneg)
           subgoal using summable_ignore_initial_segment[OF summable,of "k+1"] by auto 
           subgoal by (simp add: less_imp_le)
           done
         then have "\<bar>\<Sum>i. bb (i + (k + 1)) / aa (i + (k + 1))\<bar> 
                       = (\<Sum>i. bb (i + (k + 1)) / aa (i + (k + 1)))"
           by auto
         also have "... \<le> (\<Sum>i. 1 / M ^ i * (bb (k + 1) / aa (k + 1)))"
           apply (rule suminf_le)
           subgoal using that(1) unfolding P_def by (auto simp add:algebra_simps)
           subgoal using summable_ignore_initial_segment[OF summable,of "k+1"] by auto
           subgoal using summable_mult2[OF summable_M,of " bb (k + 1) / aa (k + 1)"] 
             by auto
           done
         also have "... = (bb (k + 1) / aa (k + 1)) * (\<Sum>i. 1 / M ^ i)"
           using suminf_mult2[OF summable_M,of " bb (k + 1) / aa (k + 1)"]
           by (auto simp:algebra_simps)
         also have "... = (bb (k + 1) / aa (k + 1)) * (\<Sum>i. (1 / M) ^ i)"
           using \<open>M>1\<close> by (auto simp: field_simps)
         also have "... = (bb (k + 1) / aa (k + 1)) * (M / (M -1))"
           apply (subst suminf_geometric) 
           using \<open>M>1\<close>  by (auto simp: field_simps)
         also have "... < (bb (k + 1) / aa (k + 1)) * (aa (k + 1) / 
                             prod aa {0..k} powr (2 + \<delta>) * (1 / bb (k + 1)))"
           apply (subst mult_less_cancel_left_pos)
           using that(2) unfolding Q_def by auto
         also have "... = 1/ prod aa {0..k} powr (2 + \<delta>)"
           using ab_1[of "Suc k"] by auto
         finally show ?thesis .
       qed
       ultimately show ?thesis by (smt INFM_conjI INFM_mono)
     qed
     ultimately show ?thesis by auto
   qed
 
   define pq where "pq = (\<lambda>k. quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)))"
   define p q where "p = fst \<circ> pq" and "q = snd \<circ> pq"
   have coprime_pq:"coprime (p k) (q k)"
         and q_pos:"q k > 0" and pq_sum:"p k / q k = (\<Sum>i=0..k. b i / a i)" for k
   proof -
     have eq: "quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)) = (p k, q k)"
       by (simp add: p_def q_def pq_def)
     from quotient_of_coprime[OF eq] show "coprime (p k) (q k)" .
     from quotient_of_denom_pos[OF eq] show "q k > 0" .
     have "(\<Sum>i=0..k. b i / a i) = of_rat (\<Sum>i=0..k. of_int (b i) / of_int (a i))"
       by (simp add: of_rat_sum of_rat_divide)
     also have "(\<Sum>i=0..k. rat_of_int (b i) / rat_of_int (a i)) =
                  rat_of_int (p k) / rat_of_int (q k)"
       using quotient_of_div[OF eq] by simp
     finally show "p k / q k = (\<Sum>i=0..k. b i / a i)" by (simp add:of_rat_divide)
   qed
 
   have \<xi>_Inf_many2:"\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - p k / q k\<bar> 
                         <  1 / q k powr (2 + \<delta>)"
     using \<xi>_Inf_many
   proof (elim INFM_mono)
     fix k assume asm:"\<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar> < 1 / prod aa {0..k} powr (2 + \<delta>)"
     have "\<bar>\<xi> - real_of_int (p k) / real_of_int (q k)\<bar> 
               = \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>"
       using pq_sum unfolding aa_def bb_def by auto
     also have "... < 1 / prod aa {0..k} powr (2 + \<delta>)"
       using asm by auto
     also have "... \<le> 1 / q k powr (2 + \<delta>)"
     proof -
       have "q k \<le> prod aa {0..k}"
       proof (induct k)
         case 0
         then show ?case unfolding q_def pq_def aa_def 
           apply (simp add:rat_divide_code of_int_rat quotient_of_Fract)
           using ab_1[of 0,unfolded aa_def bb_def] unfolding Let_def normalize_def 
           apply auto
           by (metis div_by_1 gcd_pos_int less_imp_le less_trans nonneg1_imp_zdiv_pos_iff 
                 not_less zdiv_mono2)  
       next
         case (Suc k)
         define de where "de=snd \<circ> quotient_of"
         have "real_of_int (q (Suc k)) 
                   = de (\<Sum>i=0..Suc k. of_int (b i) / of_int (a i))"
           unfolding q_def pq_def de_def by simp
         also have "... = de ((\<Sum>i=0..k. of_int (b i) / of_int (a i)) 
                                 + of_int (b (Suc k)) / of_int (a (Suc k)))"
           by simp
         also have "... \<le> de (\<Sum>i=0..k. of_int (b i) / of_int (a i)) 
                                 * de (of_int (b (Suc k)) / of_int (a (Suc k)))"          
           using snd_quotient_plus_leq[folded de_def] by presburger
         also have "... = q k * de (of_int (b (Suc k)) / of_int (a (Suc k)))"
           unfolding q_def pq_def de_def by auto
         also have "... = q k * snd (Rat.normalize (b (Suc k), a (Suc k)))"
           by (simp add:rat_divide_code of_int_rat quotient_of_Fract de_def)
         also have "... \<le> q k * aa (Suc k)"
           using ab_1[of "Suc k"] q_pos[of "k"] 
           unfolding normalize_def aa_def bb_def Let_def
           apply auto
           by (metis div_by_1 int_one_le_iff_zero_less less_trans 
                   nonneg1_imp_zdiv_pos_iff not_less zdiv_mono2 zero_less_one)
         also have "... \<le>  prod aa {0..k} * aa (Suc k)"
           using Suc ab_1[of "Suc k"] by auto
         also have "... = prod aa {0..Suc k}"
           by (simp add: prod.atLeast0_atMost_Suc)
         finally show ?case .
       qed 
       then show ?thesis 
         by (smt \<open>0 < \<delta>\<close> frac_le of_int_0 of_int_le_iff powr_gt_zero 
                   powr_mono2 q_pos)
     qed
     finally show "\<bar>\<xi> - real_of_int (p k) / real_of_int (q k)\<bar> < 1 / real_of_int (q k) powr (2 + \<delta>)" .
   qed
 
   define pqs where "pqs={(p, q). q>0 \<and> coprime p q 
       \<and> \<bar>\<xi> - real_of_int p / real_of_int q\<bar> < 1 / q powr (2 + \<delta>)}"
   have \<xi>_infinite:"infinite pqs"
   proof -
     define A where "A={k. \<bar>\<xi> -  (p k) /  (q k)\<bar> < 1 / (q k) powr (2 + \<delta>)}" 
     have "\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - p k / q k\<bar> <  1 / q k powr (2 + \<delta>)"
       using \<xi>_Inf_many2 .
     then have "infinite A"
       unfolding Inf_many_def A_def by auto
     moreover have "inj_on (\<lambda>k. (p k, q k)) A"
     proof -
       define g where "g=(\<lambda>i. rat_of_int (b i) / rat_of_int (a i))"
       define f where "f=(\<lambda>k. \<Sum>i = 0..k. g i)"
       have g_pos:"g i>0" for i
         unfolding g_def by (simp add: a_pos b_pos)
       have "strict_mono f" unfolding strict_mono_def f_def
       proof safe
         fix x y::nat assume "x < y"
         then have "sum g {0..y} - sum g {0..x} = sum g {x<..y}" 
           apply (subst  Groups_Big.sum_diff[symmetric])
           by (auto intro:arg_cong2[where f=sum])
         also have "... > 0"
           apply (rule ordered_comm_monoid_add_class.sum_pos)
           using \<open>x<y\<close> g_pos by auto
         finally have "sum g {0..y} - sum g {0..x} >0" .
         then show "sum g {0..x} < sum g {0..y}" by auto
       qed
       then have "inj f" using strict_mono_imp_inj_on by auto
       then have "inj (quotient_of o f)" by (simp add: inj_compose quotient_of_inj)
       then have "inj (\<lambda>k. (p k, q k))"
         unfolding f_def p_def q_def pq_def comp_def
         apply (fold g_def)
         by auto
       then show ?thesis by (auto elim:subset_inj_on)
     qed
     moreover have "(\<lambda>k. (p k, q k)) ` A \<subseteq> pqs"
       unfolding A_def pqs_def using coprime_pq q_pos by auto
     ultimately show ?thesis
       apply (elim infinite_inj_imageE)
       by auto
   qed
   moreover have "finite pqs" if "\<xi> \<in> \<rat>"
   proof -
     obtain m n where \<xi>_mn:"\<xi> = (of_int m / of_int n)" and "coprime m n" "n>0"
     proof -
       obtain m n where mn:"\<bar>\<xi>\<bar> = (of_nat m / of_nat n)" "coprime m n" "n\<noteq>0"
         using Rats_abs_nat_div_natE[OF \<open>\<xi> \<in> \<rat>\<close> Rats_abs_nat_div_natE]
         by metis
       define m' and n'::int 
         where "m'=(if \<xi> > 0 then nat m else -nat m)" and "n'=nat n"
       then have "\<xi> = (of_int m' / of_int n')" "coprime m' n'" "n'>0"
         using mn by auto
       then show ?thesis using that by auto
     qed
     have "pqs \<subseteq> {(m,n)} \<union> {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }"
     proof (rule subsetI)
       fix x assume "x \<in> pqs"
       define p q where "p=fst x" and "q=snd x"
       have "q>0" "coprime p q" and pq_less:"\<bar>\<xi> - p / q\<bar> < 1 / q powr (2 + \<delta>)"
         using \<open>x\<in>pqs\<close> unfolding p_def q_def pqs_def by auto
       have q_lt_n:"q<n" when "m\<noteq>p \<or> n\<noteq>q" 
       proof -
         have "m * q \<noteq> n * p" using that \<open>coprime m n\<close> \<open>coprime p q\<close> \<open>q>0\<close> \<open>n>0\<close> 
           by (metis eq_rat(1) fst_conv int_one_le_iff_zero_less mult.commute normalize_stable 
                 not_one_le_zero quotient_of_Fract snd_conv)
         then have "1/(n*q) \<le> \<bar>m/n - p/q\<bar>"
           using \<open>q>0\<close> \<open>n>0\<close>  
           apply (auto simp:field_simps)
           by (metis add_diff_cancel_left' diff_diff_eq2 diff_zero less_irrefl not_le of_int_diff 
                 of_int_lessD of_int_mult)
         also have "...  < 1 / q powr (2 + \<delta>)"
           using pq_less unfolding \<xi>_mn by auto
         also have "... \<le> 1 / q ^2"
         proof -
           have "real_of_int (q\<^sup>2) = q powr 2"
             apply (subst powr_numeral)
             unfolding power2_eq_square using \<open>q>0\<close> by auto
           also have "... \<le> q powr (2 + \<delta>)"
             apply (rule powr_mono)
             using \<open>q>0\<close> \<open>\<delta>>0\<close> by auto
           finally have "real_of_int (q\<^sup>2) \<le> real_of_int q powr (2 + \<delta>)" .
           moreover have "real_of_int q powr (2 + \<delta>) > 0" using \<open>0 < q\<close> by auto
           ultimately show ?thesis by (auto simp:field_simps)
         qed 
         finally have " 1 /  (n * q) < 1 / q\<^sup>2" .
         then show ?thesis  using \<open>q>0\<close> \<open>n>0\<close> 
           unfolding power2_eq_square by (auto simp:field_simps)
       qed
       moreover have "- \<bar>m\<bar> - 1 \<le> p \<and> p \<le> \<bar>m\<bar> + 1" when "m\<noteq>p \<or> n\<noteq>q" 
       proof -
         define qn where "qn=q/n"
         have "0<qn" "qn<1" unfolding qn_def using q_lt_n[OF \<open>m\<noteq>p \<or> n\<noteq>q\<close>] \<open>q>0\<close> by auto
 
         have "\<bar>m/n - p / q\<bar> < 1 / q powr (2 + \<delta>)" using pq_less unfolding \<xi>_mn by simp
         then have "\<bar>p / q - m/n\<bar> < 1 / q powr (2 + \<delta>)" by simp
         then have " m/n- 1 / q powr (2 + \<delta>) < p/q \<and> p/q < m/n + 1 / q powr (2 + \<delta>)"
           unfolding abs_diff_less_iff by auto
         then have "qn*m- q / q powr (2 + \<delta>) < p \<and> p < qn*m + q / q powr (2 + \<delta>)"
           unfolding qn_def using \<open>q>0\<close> by (auto simp:field_simps)
         moreover have "- \<bar>m\<bar> - 1 \<le> qn*m- q / q powr (2 + \<delta>)"
         proof -
           have "- \<bar>m\<bar> \<le> qn*m" using \<open>0<qn\<close> \<open>qn<1\<close> 
             apply (cases "m\<ge>0")
             subgoal 
               apply simp 
               by (meson less_eq_real_def mult_nonneg_nonneg neg_le_0_iff_le of_int_0_le_iff order_trans)
             subgoal by simp
             done
           moreover have "- 1 \<le> - q / q powr (2 + \<delta>)" 
           proof -
             have "q = q powr 1" using \<open>0 < q\<close> by auto
             also have "... \<le>q powr (2 + \<delta>)"
               apply (rule powr_mono)
               using \<open>q>0\<close> \<open>\<delta>>0\<close> by auto
             finally have "q \<le> q powr (2 + \<delta>)" .
             then show ?thesis using \<open>0 < q\<close> by auto
           qed
           ultimately show ?thesis by auto
         qed
         moreover have "qn*m + q / q powr (2 + \<delta>) \<le> \<bar>m\<bar> + 1"
         proof -
           have "qn*m \<le> \<bar>m\<bar>" using \<open>0<qn\<close> \<open>qn<1\<close> 
             apply (cases "m\<ge>0")
             subgoal by (simp add: mult_left_le_one_le)
             subgoal by (smt of_int_0_le_iff zero_le_mult_iff)
             done
           moreover have "q / q powr (2 + \<delta>) \<le> 1"
           proof -
             have "q = q powr 1" using \<open>0 < q\<close> by auto
             also have "... \<le>q powr (2 + \<delta>)"
               apply (rule powr_mono)
               using \<open>q>0\<close> \<open>\<delta>>0\<close> by auto
             finally have "q \<le> q powr (2 + \<delta>)" .
             then show ?thesis using \<open>0 < q\<close> by auto
           qed
           ultimately show ?thesis by auto
         qed
         ultimately show ?thesis by auto
       qed
       ultimately show "x \<in> {(m, n)} \<union> {x \<in> pqs. - \<bar>m\<bar> - 1 \<le> fst x \<and> fst x \<le> \<bar>m\<bar> + 1 
                           \<and> 0 < snd x \<and> snd x < n}" 
         using \<open>x \<in> pqs\<close> \<open>q>0\<close> unfolding p_def q_def by force
     qed
     moreover have "finite {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }" 
     proof -
       have "finite ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})" by blast
       moreover have "{x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n } \<subseteq> 
                 ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})"
         by auto
       ultimately show ?thesis 
         apply (elim rev_finite_subset)
         by blast
     qed
     ultimately show ?thesis using finite_subset by auto
   qed
   ultimately show ?thesis 
     apply (fold \<xi>_def)
     using RothsTheorem[rule_format,of \<xi> "2 + \<delta>",folded pqs_def] \<open>\<delta> >0\<close> by auto
 qed
 
 
 theorem (in RothsTheorem) HanclRucki2: 
   fixes a b ::"nat\<Rightarrow>int" and \<delta> \<epsilon> ::real 
   defines "aa\<equiv>(\<lambda>n. real_of_int (a n))" and "bb\<equiv>(\<lambda>n. real_of_int (b n))"
   assumes a_pos:"\<forall> k. a k >0" and b_pos:"\<forall> k. b k >0" and "\<delta> >0"
     and "\<epsilon> >0" 
     and limsup_infi:"limsup (\<lambda> k.(aa (k+1)/(\<Prod>i = 0..k. aa i)powr(2+(2/\<epsilon>) + \<delta>))
           * (1/(bb (k+1)))) = \<infinity>"
     and ratio_large:"\<forall> k. ( k \<ge> t \<longrightarrow>  (( aa(k+1)/bb( k+1)) ) powr(1/(1+\<epsilon>)) 
               \<ge>  (( aa k/bb k) powr(1/(1+\<epsilon>)))+1)"
   shows "\<not> algebraic(suminf (\<lambda> k. bb k /aa k))  "
 proof-
   have aa_bb_pos[simp]:"aa k>0" "bb k>0" for k
     unfolding aa_def bb_def using a_pos b_pos by auto
   have summable:"summable (\<lambda> k. bb k / aa k)"
   proof -
     define c0 where "c0\<equiv>(aa t/bb t) powr(1/(1+\<epsilon>)) - t"
     have ab_k:"(aa k / bb k) powr(1/(1+\<epsilon>)) \<ge> k + c0" when "k\<ge>t" for k
       using that
     proof (induct k)
       case 0
       then show ?case unfolding c0_def by simp
     next
       case (Suc k)
       have ?case when "\<not> t\<le>k"
       proof -
         have "t = Suc k" using that Suc.prems by linarith
         then show ?thesis unfolding c0_def by auto
       qed
       moreover have ?case when "t \<le> k"
       proof -
         have "(aa(k+1)/bb(k+1)) powr(1/(1+\<epsilon>))
               \<ge> ( aa k/bb k) powr(1/(1+\<epsilon>))+1" 
           using ratio_large[rule_format,OF that] by blast
         then show ?thesis using Suc(1)[OF that] by simp
       qed
       ultimately show ?case by auto
     qed
     have "summable (\<lambda>k. 1 / (k + c0) powr (1+\<epsilon>))"
     proof -
       have "c0 + t > 0" unfolding c0_def
         using aa_bb_pos[of t] by (simp,linarith)
       then have "summable (\<lambda>k. 1 / (k + (c0+t)) powr (1+\<epsilon>))"
         using summable_hurwitz_zeta_real[of "1+\<epsilon>" "c0+t"]
         apply (subst (asm) powr_minus_divide)
         using \<open>\<epsilon>>0\<close> by auto
       then show ?thesis
         apply (rule_tac summable_offset[of _ t])
         by (auto simp:algebra_simps)
     qed
     moreover have "bb k / aa k \<le> 1 / (k + c0) powr (1+\<epsilon>)" when "k\<ge>t" for k
     proof -
       have "(aa t / bb t) powr (1 / (1 + \<epsilon>)) > 0"
         apply simp
         by (metis \<open>\<And>k. 0 < aa k\<close> \<open>\<And>k. 0 < bb k\<close> less_numeral_extra(3))
       then have "k + c0 >0" unfolding c0_def using that by linarith 
       then have "aa k / bb k \<ge> (k + c0) powr (1+\<epsilon>)" 
         using ab_k[OF that] 
         apply (subst (asm) powr_less_eq_inverse_iff')
         using \<open>\<epsilon> >0\<close> by auto
       then have "inverse (aa k / bb k) \<le> inverse ((k + c0) powr (1+\<epsilon>))" 
         apply (elim le_imp_inverse_le)
         using \<open>k + c0 >0\<close> by auto
       then show ?thesis by (simp add: inverse_eq_divide)
     qed
     ultimately show ?thesis 
       apply (elim summable_comparison_test'[where N=t])
       using aa_bb_pos by (simp add: less_eq_real_def)
   qed
 
   have 7:"\<exists>\<^sub>\<infinity> k. 1 / (M powr (\<epsilon>/(1+\<epsilon>)) * (\<Prod>i = 0..k. aa i)
                   powr(2+ \<delta> * \<epsilon> / (1+\<epsilon>))) > (bb (k+1) / aa(k+1)) powr (\<epsilon> / (1+\<epsilon>))"
       when "M > 0" for M
   proof -
     define tt where "tt= (\<lambda>i. prod aa {0..i} powr (2 + 2 / \<epsilon> + \<delta>))"
     have tt_pos:"tt i > 0" for i 
       unfolding tt_def
       apply(subst powr_gt_zero,induct i)
       subgoal by (metis aa_bb_pos(1) order_less_irrefl prod_pos)
       subgoal by (metis \<open>\<And>k. 0 < aa k\<close> order_less_irrefl prod_pos)
       done
     have "\<exists>\<^sub>\<infinity>i. M < (aa (i + 1) / tt i * (1 / bb (i + 1)))"
       using limsup_infinity_imp_Inf_many[OF limsup_infi,rule_format,of M]
       unfolding tt_def by auto
     then have "\<exists>\<^sub>\<infinity>i. 1 / (M * tt i) > (bb (i+1) / aa (i+1))"
       apply (elim INFM_mono)
       using \<open>M>0\<close> tt_pos by (auto simp:divide_simps algebra_simps)
     then have "\<exists>\<^sub>\<infinity>i. (1 / (M * tt i)) powr (\<epsilon>/(1+\<epsilon>)) 
                         > (bb (i+1) / aa (i+1)) powr (\<epsilon>/(1+\<epsilon>))"
       apply (elim INFM_mono powr_less_mono2[rotated 2])
       by (simp_all add: assms(6) pos_add_strict less_eq_real_def)
     moreover have "tt i  powr (\<epsilon>/(1+\<epsilon>)) = prod aa {0..i} powr (2 + \<delta> * \<epsilon> / (1+\<epsilon>))"
         for i
       unfolding tt_def
       apply (auto simp:powr_powr)
       using \<open>\<epsilon>>0\<close> by (simp add:divide_simps,simp add:algebra_simps)
     ultimately show ?thesis 
       apply (elim INFM_mono)
       by (smt nonzero_mult_div_cancel_left powr_divide powr_mult powr_one_eq_one
                 that tt_pos zero_less_divide_iff)
   qed
 
   have 8:"\<forall>\<^sub>F k in sequentially. \<forall>s.  (( aa(k+s)/bb( k+s))) \<ge> 
                     ((( aa k/bb k) powr(1/(1+\<epsilon>))) +s)powr(1+\<epsilon>)" 
     using eventually_ge_at_top[of t]
   proof eventually_elim
     case (elim k)
     define ff where "ff=(\<lambda>k. (aa k / bb k) powr (1 / (1 + \<epsilon>)))"
     have 11:"ff k+s \<le> ff (k+s)" for s
     proof (induct s)
       case 0
       then show ?case unfolding ff_def by auto
     next
       case (Suc s)
       then have "ff k + Suc s \<le> ff (k+Suc s)"
         using ratio_large[rule_format,of "k+s"] \<open> t \<le> k\<close> unfolding ff_def by auto
       then show ?case by simp
     qed
     then have "(ff k+s) powr (1+\<epsilon>) \<le> ff (k+s) powr (1+\<epsilon>)" for s
       apply (rule powr_mono2[of "1+\<epsilon>",rotated 2])
       unfolding ff_def using \<open>\<epsilon>>0\<close> by auto
     then show ?case unfolding ff_def using \<open>\<epsilon>>0\<close> 
       apply (auto simp add:powr_powr)
       by (simp add: a_pos aa_def b_pos bb_def le_less)
   qed
 
   have 9: "(\<Sum>r. 1/((z+real r)powr(1+\<epsilon>))) \<le> 1/(\<epsilon> *(z-1) powr \<epsilon>)" 
       "summable (\<lambda>i. 1/((z+ real i)powr(1+\<epsilon>)))"
     when "z>1" for z
   proof -
     define f where "f= (\<lambda>r. 1/((z+ r)powr(1+\<epsilon>)))"
     have "((\<lambda>x. f (x - 1)) has_integral ((z-1) powr - \<epsilon>) / \<epsilon>) {0..}"
     proof -
        have "((\<lambda>x. (z-1 + x) powr (- 1 - \<epsilon>)) has_integral ((z-1) powr - \<epsilon>) / \<epsilon>) {0<..}"
         using powr_has_integral_at_top[of 0 "z-1" "- 1 - \<epsilon>",simplified] \<open>z>1\<close> \<open>\<epsilon>>0\<close>
         by auto
       then have "((\<lambda>x. (z-1 + x) powr (- 1 - \<epsilon>)) has_integral ((z-1) powr - \<epsilon>) / \<epsilon>) {0..}"
         apply (subst (asm) has_integral_closure[symmetric])
         by (auto simp add: negligible_convex_frontier)
       then show ?thesis 
         apply (rule has_integral_cong[THEN iffD1, rotated 1])
         unfolding f_def by (smt powr_minus_divide)
     qed
     moreover have "\<And>x. 0 \<le> x \<Longrightarrow> 0 \<le> f (x - 1)" unfolding f_def by simp
     moreover have "\<And>x y. 0 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> f (y - 1) \<le> f (x - 1)" unfolding f_def 
       by (smt assms(6) frac_le powr_mono2 powr_nonneg_iff that)
     ultimately have "summable (\<lambda>i. f (real i))" "(\<Sum>i. f (real i)) \<le> (z - 1) powr - \<epsilon> / \<epsilon>"
       using decreasing_sum_le_integral[of "\<lambda>x. f (x-1)" "((z-1) powr - \<epsilon>) / \<epsilon>",simplified]
       by auto
     moreover have "(z - 1) powr - \<epsilon> / \<epsilon> = 1/(\<epsilon> *(z-1) powr \<epsilon>)"
       by (simp add: powr_minus_divide)
     ultimately show "(\<Sum>i. f (real i)) \<le> 1/(\<epsilon> *(z-1) powr \<epsilon>)" by auto
     show "summable (\<lambda>i. f (real i))" using \<open>summable (\<lambda>i. f (real i))\<close> .
   qed
 
   have u:"(\<lambda>k.( aa k / bb k)) \<longlonglongrightarrow> \<infinity>" 
   proof -
     define ff where "ff\<equiv>(\<lambda>x. ereal (aa x / bb x))"
     have "limsup ff =  \<infinity>" 
     proof -
       define tt where "tt= (\<lambda>i. prod aa {0..i} powr (2 + 2 / \<epsilon> + \<delta>))"
       have "tt i \<ge> 1" for i
         unfolding tt_def
         apply (rule ge_one_powr_ge_zero)
         subgoal 
           apply (rule linordered_nonzero_semiring_class.prod_ge_1)
           by (simp add: a_pos aa_def int_one_le_iff_zero_less)
         subgoal by (simp add: \<open>\<epsilon>>0\<close> \<open>\<delta>>0\<close> less_imp_le)
         done
       then have "limsup (\<lambda>x.  (aa (x + 1) / tt x * (1 / bb (x + 1))))
                   \<le> limsup (\<lambda>x.  aa (x + 1) / bb (x + 1))"
         apply (intro Limsup_mono eventuallyI)
         apply (auto simp add:field_simps order.order_iff_strict)
         by (metis aa_bb_pos(1) div_by_1 frac_less2 less_irrefl less_numeral_extra(1) 
             not_le)
       also have "... = limsup (\<lambda>x.  aa x / bb x)"
         by (subst limsup_shift,simp)
       finally have "limsup (\<lambda>x. ereal (aa (x + 1) / tt x * (1 / bb (x + 1))))
                       \<le> limsup (\<lambda>x. ereal (aa x / bb x))" .
       moreover have "limsup (\<lambda>x. ereal (aa (x + 1) / tt x * (1 / bb (x + 1))))
                         = \<infinity>" using limsup_infi unfolding tt_def by auto
       ultimately show ?thesis 
         unfolding ff_def using ereal_infty_less_eq2(1) by blast
     qed
     then have "limsup (\<lambda>k. ff (k+t)) =  \<infinity>" 
       by (simp add: limsup_shift_k)
     moreover have "incseq (\<lambda>k. ff (k+t))"
     proof (rule incseq_SucI)
       fix k::nat 
       define gg where "gg\<equiv>(\<lambda>x. (aa x / bb x))"
       have "(gg (k+t)) powr (1 / (1 + \<epsilon>)) + 1 
                 \<le> (gg (Suc (k+t))) powr (1 / (1 + \<epsilon>))"
         using ratio_large[rule_format, of "k+t",simplified] unfolding gg_def
         by auto
       then have "(gg (k+t)) powr (1 / (1 + \<epsilon>))
                       \<le> (gg (Suc (k+t))) powr (1 / (1 + \<epsilon>))"
         by auto
       then have "gg (k+t)\<le> gg (Suc (k+t))"
         by (smt aa_bb_pos(1) aa_bb_pos(2) assms(6) divide_pos_pos gg_def 
                 powr_less_mono2)
       then show "ff (k + t) \<le> ff (Suc k + t)" 
         unfolding gg_def ff_def by auto
     qed
     ultimately have "(\<lambda>k. ff (k+t)) \<longlonglongrightarrow> \<infinity>" using incseq_tendsto_limsup
       by fastforce
     then show ?thesis unfolding ff_def 
       unfolding tendsto_def
       apply (subst eventually_sequentially_seg[symmetric,of _ t])
       by simp
   qed
 
   define \<xi> where "\<xi> = suminf (\<lambda> k. bb k / aa k)"
   have 10:"\<forall>\<^sub>F k in sequentially. \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar> 
                         < 2 / \<epsilon> * (bb (k+1) / aa (k+1)) powr (\<epsilon> / (1+\<epsilon>))" 
     using 8[THEN sequentially_offset,of 1] eventually_ge_at_top[of t]
             u[unfolded tendsto_PInfty,rule_format,THEN sequentially_offset
                         ,of "(2 powr (1/\<epsilon>) / (2 powr (1/\<epsilon>) - 1)) powr (1+\<epsilon>)" 1]
   proof eventually_elim
     case (elim k)
     define tt where "tt=(aa (k + 1) / bb (k + 1)) powr (1 / (1 + \<epsilon>))"
     have "tt>1"
     proof -
       have "(aa k / bb k) powr (1 / (1 + \<epsilon>)) > 0"
         by (metis a_pos aa_def b_pos bb_def divide_eq_0_iff less_irrefl 
                 of_int_eq_0_iff powr_gt_zero)
       then show ?thesis using ratio_large[rule_format,OF \<open>k\<ge>t\<close>] unfolding tt_def by argo
     qed
     have "\<bar>\<xi> - (\<Sum>i = 0..k. bb i / aa i)\<bar> = \<bar>\<Sum>i. bb (i+(k+1)) / aa (i+(k+1))\<bar>"
       unfolding \<xi>_def
       apply (subst suminf_minus_initial_segment[of _ "k+1",OF summable])
       using atLeast0AtMost lessThan_Suc_atMost by auto
     also have "... = (\<Sum>i. bb (i+(k+1)) / aa (i+(k+1)))"
     proof -
       have "(\<Sum>i. bb (i+(k+1)) / aa (i+(k+1))) > 0"
         apply (rule suminf_pos)
         subgoal using summable[THEN summable_ignore_initial_segment,of "k+1"] .
         subgoal by (simp add: a_pos aa_def b_pos bb_def)
         done
       then show ?thesis by auto
     qed
     also have "... \<le> (\<Sum>i. 1 / (tt + i) powr (1 + \<epsilon>))"
     proof (rule suminf_le)
       define ff where "ff=(\<lambda>k n. (aa (k+1) / bb (k+1)) powr (1 / (1 + \<epsilon>)) + real n)"
       have "bb (n + (k + 1)) / aa (n + (k + 1)) \<le> 1 / (ff k n) powr (1 + \<epsilon>)" for n
       proof -
         have "ff k n powr (1 + \<epsilon>) \<le> aa (k + n +1 ) / bb (k + n+1 )"
           using elim(1)[rule_format,of n] unfolding ff_def by auto
         moreover have "ff k n powr (1 + \<epsilon>) > 0" 
           unfolding ff_def by (smt elim(2) of_nat_0_le_iff powr_gt_zero ratio_large)
         ultimately have "1 / ff k n powr (1 + \<epsilon>) \<ge>  bb (k + (n + 1)) / aa (k + (n + 1))"
           apply (drule_tac le_imp_inverse_le)
           by (auto simp add: inverse_eq_divide)
         then show ?thesis by (auto simp:algebra_simps)
       qed
       then show " \<forall>n. bb (n + (k + 1)) / aa (n + (k + 1)) \<le> 1 / (tt + real n) powr (1 + \<epsilon>)"
         unfolding ff_def tt_def by auto
       show "summable (\<lambda>i. bb (i + (k + 1)) / aa (i + (k + 1)))" 
         using summable[THEN summable_ignore_initial_segment,of "k+1"] .
       show "summable (\<lambda>x. 1 / (tt + real x) powr (1 + \<epsilon>))" 
         using 9(2)[OF \<open>tt>1\<close>] .
     qed
     also have "... \<le> 1/(\<epsilon> *(tt-1) powr \<epsilon>)" 
       using 9[OF \<open>tt>1\<close>] by simp
     also have "... < 2 / (\<epsilon> *tt powr \<epsilon>)"
     proof -
       have "((2 powr (1/\<epsilon>) / (2 powr (1/\<epsilon>) - 1)) powr (1 + \<epsilon>)) < (aa (k+1) / bb (k+1))"
         using elim(3) by auto
       then have "2 powr (1/\<epsilon>) / (2 powr (1/\<epsilon>) - 1) < tt"
         unfolding tt_def 
         apply (drule_tac powr_less_mono2[rotated 2,where a="1/ (1 + \<epsilon>)"])
         using \<open>\<epsilon>>0\<close> apply (auto simp:powr_powr )
         by (subst (asm) powr_one,auto simp add:field_simps)
       then have " tt < (tt-1) * (2 powr (1/\<epsilon>))"
         using \<open>\<epsilon>>0\<close> by (auto simp:divide_simps algebra_simps) 
       then have "tt powr \<epsilon> < 2 * (tt - 1) powr \<epsilon>"
         apply (drule_tac powr_less_mono2[rotated 2,where a="\<epsilon>"])
         using \<open>\<epsilon>>0\<close> \<open>tt>1\<close> by (auto simp:powr_powr powr_mult)
       then show ?thesis 
         using \<open>\<epsilon>>0\<close> \<open>tt>1\<close> by (auto simp:divide_simps)
     qed
     also have "... =  2 / \<epsilon> * (bb (k + 1) / aa (k + 1)) powr (\<epsilon> / (1 + \<epsilon>))"
       unfolding tt_def 
       using \<open>\<epsilon>>0\<close> 
-      by (auto simp:powr_powr divide_simps algebra_simps powr_divide)
+      by (auto simp:powr_powr divide_simps algebra_simps powr_divide less_imp_le)
     finally show ?case .
   qed
 
   define pq where "pq = (\<lambda>k. quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)))"
   define p q where "p = fst \<circ> pq" and "q = snd \<circ> pq"
   have coprime_pq:"coprime (p k) (q k)"
         and q_pos:"q k > 0" and pq_sum:"p k / q k = (\<Sum>i=0..k. b i / a i)" for k
   proof -
     have eq: "quotient_of (\<Sum>i=0..k. of_int (b i) / of_int (a i)) = (p k, q k)"
       by (simp add: p_def q_def pq_def)
     from quotient_of_coprime[OF eq] show "coprime (p k) (q k)" .
     from quotient_of_denom_pos[OF eq] show "q k > 0" .
     have "(\<Sum>i=0..k. b i / a i) = of_rat (\<Sum>i=0..k. of_int (b i) / of_int (a i))"
       by (simp add: of_rat_sum of_rat_divide)
     also have "(\<Sum>i=0..k. rat_of_int (b i) / rat_of_int (a i)) =
                  rat_of_int (p k) / rat_of_int (q k)"
       using quotient_of_div[OF eq] by simp
     finally show "p k / q k = (\<Sum>i=0..k. b i / a i)" by (simp add:of_rat_divide)
   qed
 
   have \<xi>_Inf_many:"\<exists>\<^sub>\<infinity> k. \<bar>\<xi> - p k / q k\<bar> <  1 / q k powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
   proof -
     have *:"\<exists>\<^sub>\<infinity>k. (bb (Suc k) / aa (Suc k)) powr (\<epsilon> / (1 + \<epsilon>))
               < \<epsilon> / (2 * prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)))"
       using 7[of "(2 / \<epsilon>) powr ((1+\<epsilon>)/ \<epsilon>)"] \<open>\<epsilon>>0\<close> 
       by (auto simp:powr_powr)
     have **:"\<forall>\<^sub>\<infinity>k. \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>
                 < 2 / \<epsilon> * (bb (k + 1) / aa (k + 1)) powr (\<epsilon> / (1 + \<epsilon>))"
       using 10[unfolded cofinite_eq_sequentially[symmetric]] .
     from INFM_conjI[OF * **] show ?thesis 
     proof (elim INFM_mono)
       fix k assume asm:"(bb (Suc k) / aa (Suc k)) powr (\<epsilon> / (1 + \<epsilon>))
                          < \<epsilon> / (2 * prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))) \<and>
                           \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar> 
                         < 2 / \<epsilon> * (bb (k + 1) / aa (k + 1)) powr (\<epsilon> / (1 + \<epsilon>))"
       have "\<bar>\<xi> - real_of_int (p k) / real_of_int (q k)\<bar> 
               = \<bar>\<xi> - (\<Sum>k = 0..k. bb k / aa k)\<bar>"
         using pq_sum unfolding aa_def bb_def by auto
       also have "... < (2 / \<epsilon>) * (bb (k+1) / aa (k+1)) powr (\<epsilon> / (1+\<epsilon>))"
         using asm by auto
       also have "... <  (2 / \<epsilon>) * (\<epsilon> / (2 * prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))))"
         apply (rule mult_strict_left_mono)
         using asm \<open>\<epsilon>>0\<close> by auto
       also have "... = 1/ prod aa {0..k} powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
         using \<open>\<epsilon>>0\<close> by auto
       also have "... \<le> 1 / q k powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
       proof -
         have "q k \<le> prod aa {0..k}"
         proof (induct k)
           case 0
           then show ?case unfolding q_def pq_def aa_def 
             apply (simp add:rat_divide_code of_int_rat quotient_of_Fract)
             using aa_bb_pos[of 0,unfolded aa_def bb_def] unfolding Let_def normalize_def 
             apply auto
             by (metis div_by_1 less_imp_le less_trans nonneg1_imp_zdiv_pos_iff 
                 not_less zdiv_mono2)  
         next
           case (Suc k)
           define de where "de=snd \<circ> quotient_of"
           have "real_of_int (q (Suc k)) 
                   = de (\<Sum>i=0..Suc k. of_int (b i) / of_int (a i))"
             unfolding q_def pq_def de_def by simp
           also have "... = de ((\<Sum>i=0..k. of_int (b i) / of_int (a i)) 
                                 + of_int (b (Suc k)) / of_int (a (Suc k)))"
             by simp
           also have "... \<le> de (\<Sum>i=0..k. of_int (b i) / of_int (a i)) 
                                 * de (of_int (b (Suc k)) / of_int (a (Suc k)))"          
             using snd_quotient_plus_leq[folded de_def] by presburger
           also have "... = q k * de (of_int (b (Suc k)) / of_int (a (Suc k)))"
             unfolding q_def pq_def de_def by auto
           also have "... = q k * snd (Rat.normalize (b (Suc k), a (Suc k)))"
             by (simp add:rat_divide_code of_int_rat quotient_of_Fract de_def)
           also have "... \<le> q k * aa (Suc k)"
             using aa_bb_pos[of "Suc k"] q_pos[of "k"] 
             unfolding normalize_def aa_def bb_def Let_def
             apply auto
             by (metis div_by_1 int_one_le_iff_zero_less less_trans 
                   nonneg1_imp_zdiv_pos_iff not_less zdiv_mono2 zero_less_one)
           also have "... \<le>  prod aa {0..k} * aa (Suc k)"
             using Suc aa_bb_pos[of "Suc k"] by auto
           also have "... = prod aa {0..Suc k}"
             by (simp add: prod.atLeast0_atMost_Suc)
           finally show ?case .
         qed 
         then show ?thesis
           apply (rule_tac divide_left_mono)
           apply (rule powr_mono2)
           using \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> q_pos[of k] 
            apply (auto simp:powr_mult[symmetric])
           by (metis aa_bb_pos(1) less_irrefl)
       qed 
       finally show "\<bar>\<xi> -  p k / q k\<bar> < 1 /  q k powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
     qed
   qed
 
   define pqs where "pqs={(p, q). q>0 \<and> coprime p q \<and> \<bar>\<xi> - real_of_int p / real_of_int q\<bar> 
                   < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))}"
   have \<xi>_infinite:"infinite pqs"
   proof -
     define A where "A={k. \<bar>\<xi> -  (p k) /  (q k)\<bar> < 1 / (q k) powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))}" 
     note \<xi>_Inf_many
     then have "infinite A"
       unfolding Inf_many_def A_def by auto
     moreover have "inj_on (\<lambda>k. (p k, q k)) A"
     proof -
       define g where "g=(\<lambda>i. rat_of_int (b i) / rat_of_int (a i))"
       define f where "f=(\<lambda>k. \<Sum>i = 0..k. g i)"
       have g_pos:"g i>0" for i
         unfolding g_def by (simp add: a_pos b_pos)
       have "strict_mono f" unfolding strict_mono_def f_def
       proof safe
         fix x y::nat assume "x < y"
         then have "sum g {0..y} - sum g {0..x} = sum g {x<..y}" 
           apply (subst  Groups_Big.sum_diff[symmetric])
           by (auto intro:arg_cong2[where f=sum])
         also have "... > 0"
           apply (rule ordered_comm_monoid_add_class.sum_pos)
           using \<open>x<y\<close> g_pos by auto
         finally have "sum g {0..y} - sum g {0..x} >0" .
         then show "sum g {0..x} < sum g {0..y}" by auto
       qed
       then have "inj f" using strict_mono_imp_inj_on by auto
       then have "inj (quotient_of o f)" by (simp add: inj_compose quotient_of_inj)
       then have "inj (\<lambda>k. (p k, q k))"
         unfolding f_def p_def q_def pq_def comp_def
         apply (fold g_def)
         by auto
       then show ?thesis by (auto elim:subset_inj_on)
     qed
     moreover have "(\<lambda>k. (p k, q k)) ` A \<subseteq> pqs"
       unfolding A_def pqs_def using coprime_pq q_pos by auto
     ultimately show ?thesis
       apply (elim infinite_inj_imageE)
       by auto
   qed
   moreover have "finite pqs" if "\<xi> \<in> \<rat>"
   proof -
     obtain m n where \<xi>_mn:"\<xi> = (of_int m / of_int n)" and "coprime m n" "n>0"
     proof -
       obtain m n where mn:"\<bar>\<xi>\<bar> = (of_nat m / of_nat n)" "coprime m n" "n\<noteq>0"
         using Rats_abs_nat_div_natE[OF \<open>\<xi> \<in> \<rat>\<close> Rats_abs_nat_div_natE]
         by metis
       define m' and n'::int 
         where "m'=(if \<xi> > 0 then nat m else -nat m)" and "n'=nat n"
       then have "\<xi> = (of_int m' / of_int n')" "coprime m' n'" "n'>0"
         using mn by auto
       then show ?thesis using that by auto
     qed
     have "pqs \<subseteq> {(m,n)} \<union> {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }"
     proof (rule subsetI)
       fix x assume "x \<in> pqs"
       define p q where "p=fst x" and "q=snd x"
       have "q>0" "coprime p q" and pq_less:"\<bar>\<xi> - p / q\<bar> 
           < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
         using \<open>x\<in>pqs\<close> unfolding p_def q_def pqs_def by auto
       have q_lt_n:"q<n" when "m\<noteq>p \<or> n\<noteq>q" 
       proof -
         have "m * q \<noteq> n * p" using that \<open>coprime m n\<close> \<open>coprime p q\<close> \<open>q>0\<close> \<open>n>0\<close> 
           by (metis eq_rat(1) fst_conv int_one_le_iff_zero_less mult.commute normalize_stable 
                 not_one_le_zero quotient_of_Fract snd_conv)
         then have "1/(n*q) \<le> \<bar>m/n - p/q\<bar>"
           using \<open>q>0\<close> \<open>n>0\<close>  
           apply (auto simp:field_simps)
           by (metis add_diff_cancel_left' diff_diff_eq2 diff_zero less_irrefl not_le of_int_diff 
                 of_int_lessD of_int_mult)
         also have "...  < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
           using pq_less unfolding \<xi>_mn by auto
         also have "... \<le> 1 / q ^2"
         proof -
           have "real_of_int (q\<^sup>2) = q powr 2"
             apply (subst powr_numeral)
             unfolding power2_eq_square using \<open>q>0\<close> by auto
           also have "... \<le> q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
             apply (rule powr_mono)
             using \<open>q>0\<close> \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> by auto
           finally have "real_of_int (q\<^sup>2) 
                           \<le> real_of_int q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
           moreover have "real_of_int q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) > 0" using \<open>0 < q\<close> by auto
           ultimately show ?thesis by (auto simp:field_simps)
         qed 
         finally have " 1 /  (n * q) < 1 / q\<^sup>2" .
         then show ?thesis  using \<open>q>0\<close> \<open>n>0\<close> 
           unfolding power2_eq_square by (auto simp:field_simps)
       qed
       moreover have "- \<bar>m\<bar> - 1 \<le> p \<and> p \<le> \<bar>m\<bar> + 1" when "m\<noteq>p \<or> n\<noteq>q" 
       proof -
         define qn where "qn=q/n"
         have "0<qn" "qn<1" unfolding qn_def using q_lt_n[OF \<open>m\<noteq>p \<or> n\<noteq>q\<close>] \<open>q>0\<close> by auto
 
         have "\<bar>m/n - p / q\<bar> < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" 
           using pq_less unfolding \<xi>_mn by simp
         then have "\<bar>p / q - m/n\<bar> < 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" by simp
         then have " m/n- 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) 
             < p/q \<and> p/q < m/n + 1 / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
           unfolding abs_diff_less_iff by auto
         then have "qn*m- q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) < p 
             \<and> p < qn*m + q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
           unfolding qn_def using \<open>q>0\<close> by (auto simp:field_simps)
         moreover have "- \<bar>m\<bar> - 1 \<le> qn*m- q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
         proof -
           have "- \<bar>m\<bar> \<le> qn*m" using \<open>0<qn\<close> \<open>qn<1\<close> 
             apply (cases "m\<ge>0")
             subgoal 
               apply simp 
               by (meson less_eq_real_def mult_nonneg_nonneg neg_le_0_iff_le of_int_0_le_iff 
                           order_trans)
             subgoal by simp
             done
           moreover have "- 1 \<le> - q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" 
           proof -
             have "q = q powr 1" using \<open>0 < q\<close> by auto
             also have "... \<le>q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
               apply (rule powr_mono)
               using \<open>q>0\<close> \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> by auto
             finally have "q \<le> q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
             then show ?thesis using \<open>0 < q\<close> by auto
           qed
           ultimately show ?thesis by auto
         qed
         moreover have "qn*m + q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) \<le> \<bar>m\<bar> + 1"
         proof -
           have "qn*m \<le> \<bar>m\<bar>" using \<open>0<qn\<close> \<open>qn<1\<close> 
             apply (cases "m\<ge>0")
             subgoal by (simp add: mult_left_le_one_le)
             subgoal by (smt of_int_0_le_iff zero_le_mult_iff)
             done
           moreover have "q / q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>)) \<le> 1"
           proof -
             have "q = q powr 1" using \<open>0 < q\<close> by auto
             also have "... \<le>q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))"
               apply (rule powr_mono)
               using \<open>q>0\<close> \<open>\<delta>>0\<close> \<open>\<epsilon>>0\<close> by auto
             finally have "q \<le> q powr (2 + \<delta> * \<epsilon> / (1 + \<epsilon>))" .
             then show ?thesis using \<open>0 < q\<close> by auto
           qed
           ultimately show ?thesis by auto
         qed
         ultimately show ?thesis by auto
       qed
       ultimately show "x \<in> {(m, n)} \<union> {x \<in> pqs. - \<bar>m\<bar> - 1 \<le> fst x \<and> fst x \<le> \<bar>m\<bar> + 1 
                           \<and> 0 < snd x \<and> snd x < n}" 
         using \<open>x \<in> pqs\<close> \<open>q>0\<close> unfolding p_def q_def by force
     qed
     moreover have "finite {x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n }" 
     proof -
       have "finite ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})" by blast
       moreover have "{x. x \<in>pqs \<and> - \<bar>m\<bar> - 1 \<le>fst x \<and> fst x \<le> \<bar>m\<bar> + 1 \<and> 0<snd x \<and> snd x < n } \<subseteq> 
                 ({- \<bar>m\<bar> - 1..\<bar>m\<bar> +1} \<times> {0<..<n})"
         by auto
       ultimately show ?thesis 
         apply (elim rev_finite_subset)
         by blast
     qed
     ultimately show ?thesis using finite_subset by auto
   qed
   ultimately show ?thesis 
     apply (fold \<xi>_def)
     using RothsTheorem[rule_format,of \<xi> "2 + \<delta> * \<epsilon> / (1 + \<epsilon>)",folded pqs_def] 
       \<open>\<delta> >0\<close> \<open>\<epsilon>>0\<close> 
     apply (auto simp:divide_simps )
     by (meson mult_le_0_iff not_less)
 qed
 
 subsection\<open> Acknowledgements\<close>
 
 text\<open>A.K.-A. and W.L. were supported by the ERC Advanced Grant ALEXANDRIA (Project 742178)
  funded by the European Research Council and led by Professor Lawrence Paulson
  at the University of Cambridge, UK. Thanks to Iosif Pinelis for his clarification on
 MathOverflow regarding the summmability of the series in @{thm [source] RothsTheorem.HanclRucki2}
 @{url "https://mathoverflow.net/questions/323069/why-is-this-series-summable"}
 and to Manuel Eberl for his helpful comments.\<close>
 
 end
\ No newline at end of file