diff --git a/thys/Banach_Steinhaus/Banach_Steinhaus.thy b/thys/Banach_Steinhaus/Banach_Steinhaus.thy
--- a/thys/Banach_Steinhaus/Banach_Steinhaus.thy
+++ b/thys/Banach_Steinhaus/Banach_Steinhaus.thy
@@ -1,485 +1,485 @@
 (*
   File:   Banach_Steinhaus.thy
   Author: Dominique Unruh, University of Tartu
   Author: Jose Manuel Rodriguez Caballero, University of Tartu
 *)
 section \<open>Banach-Steinhaus theorem\<close>
 
 theory Banach_Steinhaus
   imports Banach_Steinhaus_Missing
 begin
 
 text \<open>
   We formalize Banach-Steinhaus theorem as theorem @{text banach_steinhaus}. This theorem was 
   originally proved in Banach-Steinhaus's paper~\cite{banach1927principe}. For the proof, we follow
   Sokal's approach~\cite{sokal2011really}. Furthermore, we prove as a corollary a result about
   pointwise convergent sequences of bounded operators whose domain is a Banach space.
 \<close>
 
 subsection \<open>Preliminaries for Sokal's proof of Banach-Steinhaus theorem\<close>
 
 lemma linear_plus_norm:
   includes notation_norm
   assumes \<open>linear f\<close>
   shows \<open>\<parallel>f \<xi>\<parallel> \<le> max \<parallel>f (x + \<xi>)\<parallel> \<parallel>f (x - \<xi>)\<parallel>\<close>
   text \<open>
   Explanation: For arbitrary \<^term>\<open>x\<close> and a linear operator \<^term>\<open>f\<close>,
   \<^term>\<open>norm (f \<xi>)\<close> is upper bounded by the maximum of the norms
   of the shifts of \<^term>\<open>f\<close> (i.e., \<^term>\<open>f (x + \<xi>)\<close> and \<^term>\<open>f (x - \<xi>)\<close>).
 \<close>
 proof-
   have \<open>norm (f \<xi>) = norm ( (inverse (of_nat 2)) *\<^sub>R (f (x + \<xi>) - f (x - \<xi>)) )\<close>
     by (smt add_diff_cancel_left' assms diff_add_cancel diff_diff_add linear_diff midpoint_def 
         midpoint_plus_self of_nat_1 of_nat_add one_add_one scaleR_half_double)
   also have \<open>\<dots> = inverse (of_nat 2) * norm (f (x + \<xi>) - f (x - \<xi>))\<close>
     using Real_Vector_Spaces.real_normed_vector_class.norm_scaleR by simp
   also have \<open>\<dots> \<le> inverse (of_nat 2) * (norm (f (x + \<xi>)) + norm (f (x - \<xi>)))\<close>
     by (simp add: norm_triangle_ineq4)
   also have \<open>\<dots> \<le>  max (norm (f (x + \<xi>))) (norm (f (x - \<xi>)))\<close>
     by auto
   finally show ?thesis by blast
 qed
 
 lemma onorm_Sup_on_ball:
   includes notation_norm
   assumes \<open>r > 0\<close>
   shows "\<parallel>f\<parallel> \<le> Sup ( (\<lambda>x. \<parallel>f *\<^sub>v x\<parallel>) ` (ball x r) ) / r"
   text \<open>
   Explanation: Let \<^term>\<open>f\<close> be a bounded operator and let \<^term>\<open>x\<close> be a point. For any \<^term>\<open>r > 0\<close>, 
   the operator norm of \<^term>\<open>f\<close> is bounded above by the supremum of $f$ applied to the open ball of 
   radius \<^term>\<open>r\<close> around \<^term>\<open>x\<close>, divided by \<^term>\<open>r\<close>.
 \<close>
 proof-
   have bdd_above_3: \<open>bdd_above ((\<lambda>x. \<parallel>f *\<^sub>v x\<parallel>) ` (ball 0 r))\<close>
   proof -
     obtain M where \<open>\<And> \<xi>.  \<parallel>f *\<^sub>v \<xi>\<parallel> \<le> M * norm \<xi>\<close> and \<open>M \<ge> 0\<close>
       using norm_blinfun norm_ge_zero by blast      
     hence \<open>\<And> \<xi>. \<xi> \<in> ball 0 r \<Longrightarrow> \<parallel>f *\<^sub>v \<xi>\<parallel> \<le> M * r\<close>
       using \<open>r > 0\<close> by (smt mem_ball_0 mult_left_mono) 
     thus ?thesis by (meson bdd_aboveI2)     
   qed
   have bdd_above_2: \<open>bdd_above ((\<lambda> \<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` (ball 0 r))\<close>
   proof-
     have \<open>bdd_above ((\<lambda> \<xi>. \<parallel>f *\<^sub>v x\<parallel>) ` (ball 0 r))\<close>
       by auto          
     moreover have \<open>bdd_above ((\<lambda> \<xi>. \<parallel>f *\<^sub>v \<xi>\<parallel>) ` (ball 0 r))\<close>
       using bdd_above_3 by blast
     ultimately have \<open>bdd_above ((\<lambda> \<xi>. \<parallel>f *\<^sub>v x\<parallel> + \<parallel>f *\<^sub>v \<xi>\<parallel>) ` (ball 0 r))\<close>
       by (rule bdd_above_plus)
     then obtain M where \<open>\<And> \<xi>. \<xi> \<in> ball 0 r \<Longrightarrow> \<parallel>f *\<^sub>v x\<parallel> + \<parallel>f *\<^sub>v \<xi>\<parallel> \<le> M\<close>
       unfolding bdd_above_def by (meson image_eqI)
     moreover have \<open>\<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<le> \<parallel>f *\<^sub>v x\<parallel> + \<parallel>f *\<^sub>v \<xi>\<parallel>\<close> for \<xi>
       by (simp add: blinfun.add_right norm_triangle_ineq)                
     ultimately have \<open>\<And> \<xi>. \<xi> \<in> ball 0 r \<Longrightarrow> \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<le> M\<close>
       by (simp add: blinfun.add_right norm_triangle_le)
     thus ?thesis by (meson bdd_aboveI2)                          
   qed 
   have bdd_above_4: \<open>bdd_above ((\<lambda> \<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r))\<close>
   proof-
     obtain K where K_def: \<open>\<And> \<xi>. \<xi> \<in> ball 0 r \<Longrightarrow> \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<le> K\<close>
       using  \<open>bdd_above ((\<lambda> \<xi>. norm (f (x + \<xi>))) ` (ball 0 r))\<close> unfolding bdd_above_def 
       by (meson image_eqI)
     have \<open>\<xi> \<in> ball (0::'a) r \<Longrightarrow> -\<xi> \<in> ball 0 r\<close> for \<xi>
       by auto
     thus ?thesis by (metis K_def ab_group_add_class.ab_diff_conv_add_uminus bdd_aboveI2)
   qed
   have bdd_above_1: \<open>bdd_above ((\<lambda> \<xi>. max \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>  \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r))\<close>
   proof-
     have \<open>bdd_above ((\<lambda> \<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` (ball 0 r))\<close>
       using bdd_above_2 by blast
     moreover have \<open>bdd_above ((\<lambda> \<xi>.  \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r))\<close>
       using bdd_above_4 by blast
     ultimately show ?thesis
       unfolding max_def apply auto apply (meson bdd_above_Int1 bdd_above_mono image_Int_subset)
       by (meson bdd_above_Int1 bdd_above_mono image_Int_subset)   
   qed 
   have bdd_above_6: \<open>bdd_above ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball x r)\<close>
   proof-
     have \<open>bounded (ball x r)\<close>
       by simp            
     hence \<open>bounded ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball x r)\<close>
       by (metis (no_types) add.left_neutral bdd_above_2 bdd_above_norm bounded_norm_comp 
           image_add_ball image_image)
     thus ?thesis
       by (simp add: bounded_imp_bdd_above)
   qed
   have norm_1: \<open>(\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` ball 0 r = (\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball x r\<close>
     by (metis add.right_neutral ball_translation image_image)   
   have bdd_above_5: \<open>bdd_above ((\<lambda>\<xi>. norm (f (x + \<xi>))) ` ball 0 r)\<close>
     by (simp add: bdd_above_2)   
   have norm_2: \<open>\<parallel>\<xi>\<parallel> < r \<Longrightarrow> \<parallel>f *\<^sub>v (x - \<xi>)\<parallel> \<in> (\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` ball 0 r\<close> for \<xi>
   proof-
     assume \<open>\<parallel>\<xi>\<parallel> < r\<close>
     hence \<open>\<xi> \<in> ball (0::'a) r\<close>
       by auto
     hence \<open>-\<xi> \<in> ball (0::'a) r\<close>
       by auto
     thus ?thesis 
       by (metis (no_types, lifting) ab_group_add_class.ab_diff_conv_add_uminus image_iff) 
   qed
   have norm_2': \<open>\<parallel>\<xi>\<parallel> < r \<Longrightarrow> \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<in> (\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` ball 0 r\<close> for \<xi>
   proof-
     assume \<open>norm \<xi> < r\<close>
     hence \<open>\<xi> \<in> ball (0::'a) r\<close>
       by auto
     hence \<open>-\<xi> \<in> ball (0::'a) r\<close>
       by auto
     thus ?thesis 
       by (metis (no_types, lifting) diff_minus_eq_add image_iff)          
   qed
   have bdd_above_6: \<open>bdd_above ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` ball 0 r)\<close>
     by (simp add: bdd_above_4)   
   have Sup_2: \<open>(SUP \<xi>\<in>ball 0 r. max \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) =
                  max (SUP \<xi>\<in>ball 0 r. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) (SUP \<xi>\<in>ball 0 r. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>)\<close>
   proof-
     have \<open>ball (0::'a) r \<noteq> {}\<close>
       using \<open>r > 0\<close> by auto
     moreover have \<open>bdd_above ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` ball 0 r)\<close>
       using bdd_above_5 by blast
     moreover have \<open>bdd_above ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` ball 0 r)\<close>
       using bdd_above_6 by blast
     ultimately show ?thesis
       using max_Sup
       by (metis (mono_tags, lifting) Banach_Steinhaus_Missing.pointwise_max_def image_cong) 
   qed 
   have Sup_3': \<open>\<parallel>\<xi>\<parallel> < r \<Longrightarrow> \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<in> (\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` ball 0 r\<close> for \<xi>::'a
     by (simp add: norm_2')
   have Sup_3'': \<open>\<parallel>\<xi>\<parallel> < r \<Longrightarrow> \<parallel>f *\<^sub>v (x - \<xi>)\<parallel> \<in> (\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` ball 0 r\<close> for \<xi>::'a
     by (simp add: norm_2)  
   have Sup_3: \<open>max (SUP \<xi>\<in>ball 0 r. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) (SUP \<xi>\<in>ball 0 r.  \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) =
         (SUP \<xi>\<in>ball 0 r. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>)\<close>
   proof-
     have \<open>(\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` (ball 0 r) = (\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r)\<close>
       apply auto using Sup_3' apply auto using Sup_3'' by blast
     hence \<open>Sup ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` (ball 0 r))=Sup ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r))\<close>
       by simp
     thus ?thesis by simp
   qed
   have Sup_1: \<open>Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 r)) \<le> Sup ( (\<lambda>\<xi>. \<parallel>f *\<^sub>v \<xi>\<parallel>) ` (ball x r) )\<close> 
   proof-
     have \<open>(\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) \<xi> \<le> max \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>\<close> for \<xi>
       apply(rule linear_plus_norm) apply (rule bounded_linear.linear)
       by (simp add: blinfun.bounded_linear_right)
     moreover have \<open>bdd_above ((\<lambda> \<xi>. max \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>  \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r))\<close> 
       using bdd_above_1 by blast
     moreover have \<open>ball (0::'a) r \<noteq> {}\<close>
       using \<open>r > 0\<close> by auto      
     ultimately have \<open>Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 r)) \<le>
                      Sup ((\<lambda>\<xi>. max \<parallel>f *\<^sub>v (x + \<xi>)\<parallel> \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r))\<close>
       using cSUP_mono by smt 
     also have \<open>\<dots> = max (Sup ((\<lambda>\<xi>.  \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` (ball 0 r)))
                         (Sup ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x - \<xi>)\<parallel>) ` (ball 0 r)))\<close> 
       using Sup_2 by blast
     also have \<open>\<dots> = Sup ((\<lambda>\<xi>. \<parallel>f *\<^sub>v (x + \<xi>)\<parallel>) ` (ball 0 r))\<close>
       using Sup_3 by blast
     also have \<open>\<dots> = Sup ((\<lambda>\<xi>. \<parallel>f *\<^sub>v \<xi>\<parallel>) ` (ball x r))\<close>
       by (metis  add.right_neutral ball_translation image_image)      
     finally show ?thesis by blast
   qed
   have \<open>\<parallel>f\<parallel> = (SUP x\<in>ball 0 r. \<parallel>f *\<^sub>v x\<parallel>) / r\<close>
     using \<open>0 < r\<close> onorm_r by blast
   moreover have \<open>Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 r)) / r \<le> Sup ((\<lambda>\<xi>. \<parallel>f *\<^sub>v \<xi>\<parallel>) ` (ball x r)) / r\<close>
     using Sup_1 \<open>0 < r\<close> divide_right_mono by fastforce 
   ultimately have \<open>\<parallel>f\<parallel> \<le> Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball x r) / r\<close>
     by simp
   thus ?thesis by simp    
 qed
 
 lemma onorm_Sup_on_ball':
   includes notation_norm
   assumes \<open>r > 0\<close> and \<open>\<tau> < 1\<close>
   shows \<open>\<exists>\<xi>\<in>ball x r.  \<tau> * r * \<parallel>f\<parallel> \<le> \<parallel>f *\<^sub>v \<xi>\<parallel>\<close>
   text \<open>                 
   In the proof of Banach-Steinhaus theorem, we will use this variation of the 
   lemma @{text onorm_Sup_on_ball}.
 
   Explanation: Let \<^term>\<open>f\<close> be a bounded operator, let \<^term>\<open>x\<close> be a point and let \<^term>\<open>r\<close> be a 
   positive real number. For any real number \<^term>\<open>\<tau> < 1\<close>, there is a point \<^term>\<open>\<xi>\<close> in the open ball 
   of radius \<^term>\<open>r\<close> around \<^term>\<open>x\<close> such that \<^term>\<open>\<tau> * r * \<parallel>f\<parallel> \<le> \<parallel>f *\<^sub>v \<xi>\<parallel>\<close>.
 \<close>
 proof(cases  \<open>f = 0\<close>)
   case True
   thus ?thesis by (metis assms(1) centre_in_ball mult_zero_right norm_zero order_refl 
         zero_blinfun.rep_eq) 
 next
   case False
   have bdd_above_1: \<open>bdd_above ((\<lambda>t. \<parallel>(*\<^sub>v) f t\<parallel>) ` ball x r)\<close> for f::\<open>'a \<Rightarrow>\<^sub>L 'b\<close>
     using assms(1) bounded_linear_image by (simp add: bounded_linear_image 
         blinfun.bounded_linear_right bounded_imp_bdd_above bounded_norm_comp) 
   have  \<open>norm f > 0\<close>
     using \<open>f \<noteq> 0\<close> by auto
   have \<open>norm f \<le>  Sup ( (\<lambda>\<xi>.  \<parallel>(*\<^sub>v) f \<xi>\<parallel>) ` (ball x r) ) / r\<close>
     using \<open>r > 0\<close> by (simp add: onorm_Sup_on_ball)  
   hence \<open>r * norm f \<le>  Sup ( (\<lambda>\<xi>.  \<parallel>(*\<^sub>v) f \<xi>\<parallel>) ` (ball x r) )\<close>
     using \<open>0 < r\<close> by (smt divide_strict_right_mono nonzero_mult_div_cancel_left) 
   moreover have \<open>\<tau> * r * norm f < r * norm f\<close>
     using  \<open>\<tau> < 1\<close> using \<open>0 < norm f\<close> \<open>0 < r\<close> by auto
   ultimately have \<open>\<tau> * r * norm f < Sup ( (norm \<circ> ((*\<^sub>v) f)) ` (ball x r) )\<close>
     by simp
   moreover have \<open>(norm \<circ> ( (*\<^sub>v) f)) ` (ball x r) \<noteq> {}\<close>
     using \<open>0 < r\<close> by auto    
   moreover have \<open>bdd_above ((norm \<circ> ( (*\<^sub>v) f)) ` (ball x r))\<close>
     using bdd_above_1 apply transfer by simp
   ultimately have \<open>\<exists>t \<in> (norm \<circ> ( (*\<^sub>v) f)) ` (ball x r). \<tau> * r * norm f < t\<close> 
     by (simp add: less_cSup_iff)    
   thus ?thesis by (smt comp_def image_iff) 
 qed
 
 subsection \<open>Banach-Steinhaus theorem\<close>
 
 theorem banach_steinhaus:
   fixes f::\<open>'c \<Rightarrow> ('a::banach \<Rightarrow>\<^sub>L 'b::real_normed_vector)\<close>
   assumes \<open>\<And>x. bounded (range (\<lambda>n. (f n) *\<^sub>v x))\<close>
   shows  \<open>bounded (range f)\<close>
   text\<open>
   This is Banach-Steinhaus Theorem.
 
   Explanation: If a family of bounded operators on a Banach space
   is pointwise bounded, then it is uniformly bounded.
 \<close>
 proof(rule classical)
   assume \<open>\<not>(bounded (range f))\<close>
   have sum_1: \<open>\<exists>K. \<forall>n. sum (\<lambda>k. inverse (real_of_nat 3^k)) {0..n} \<le> K\<close>
   proof-
     have \<open>summable (\<lambda>n. (inverse (real_of_nat 3))^n)\<close>
       using Series.summable_geometric_iff [where c = "inverse (real_of_nat 3)"] by auto
     moreover have \<open>(inverse (real_of_nat 3))^n = inverse (real_of_nat 3^n)\<close> for n::nat
       using power_inverse by blast        
     ultimately have \<open>summable (\<lambda>n. inverse (real_of_nat 3^n))\<close>
       by auto
     hence \<open>bounded (range (\<lambda>n. sum (\<lambda> k. inverse (real 3 ^ k)) {0..<n}))\<close>
       using summable_imp_sums_bounded[where f = "(\<lambda>n. inverse (real_of_nat 3^n))"]
         lessThan_atLeast0 by auto
     hence \<open>\<exists>M. \<forall>h\<in>(range (\<lambda>n. sum (\<lambda> k. inverse (real 3 ^ k)) {0..<n})). norm h \<le> M\<close>
       using bounded_iff by blast
     then obtain M where \<open>h\<in>range (\<lambda>n. sum (\<lambda> k. inverse (real 3 ^ k)) {0..<n}) \<Longrightarrow> norm h \<le> M\<close> 
       for h
       by blast      
     have sum_2: \<open>sum (\<lambda>k. inverse (real_of_nat 3^k)) {0..n} \<le> M\<close> for n
     proof-
       have  \<open>norm (sum (\<lambda> k. inverse (real 3 ^ k)) {0..< Suc n}) \<le> M\<close>
         using \<open>\<And>h. h\<in>(range (\<lambda>n. sum (\<lambda> k. inverse (real 3 ^ k)) {0..<n})) \<Longrightarrow> norm h \<le> M\<close> 
         by blast
       hence  \<open>norm (sum (\<lambda> k. inverse (real 3 ^ k)) {0..n}) \<le> M\<close>
         by (simp add: atLeastLessThanSuc_atLeastAtMost)        
       hence  \<open>(sum (\<lambda> k. inverse (real 3 ^ k)) {0..n}) \<le> M\<close>
         by auto
       thus ?thesis  by blast
     qed
     have \<open>sum (\<lambda>k. inverse (real_of_nat 3^k)) {0..n} \<le> M\<close> for n 
       using sum_2 by blast
     thus ?thesis  by blast
   qed
   have \<open>of_rat 2/3 < (1::real)\<close>
     by auto
   hence \<open>\<forall>g::'a \<Rightarrow>\<^sub>L 'b. \<forall>x. \<forall>r. \<exists>\<xi>. g \<noteq> 0 \<and> r > 0
                \<longrightarrow> (\<xi>\<in>ball x r \<and> (of_rat 2/3) * r * norm g \<le> norm ((*\<^sub>v) g \<xi>))\<close> 
     using onorm_Sup_on_ball' by blast
   hence \<open>\<exists>\<xi>. \<forall>g::'a \<Rightarrow>\<^sub>L 'b. \<forall>x. \<forall>r. g \<noteq> 0 \<and> r > 0
            \<longrightarrow> ((\<xi> g x r)\<in>ball x r \<and> (of_rat 2/3) * r * norm g \<le> norm ((*\<^sub>v) g (\<xi> g x r)))\<close> 
     by metis
   then obtain \<xi> where f1: \<open>\<lbrakk>g \<noteq> 0; r > 0\<rbrakk> \<Longrightarrow> 
         \<xi> g x r \<in> ball x r \<and>  (of_rat 2/3) * r * norm g \<le> norm ((*\<^sub>v) g (\<xi> g x r))\<close>
     for g::\<open>'a \<Rightarrow>\<^sub>L 'b\<close> and x and r
     by blast
   have \<open>\<forall>n. \<exists>k. norm (f k) \<ge> 4^n\<close>
     using \<open>\<not>(bounded (range f))\<close> by (metis (mono_tags, hide_lams) boundedI image_iff linear)
   hence  \<open>\<exists>k. \<forall>n. norm (f (k n)) \<ge> 4^n\<close>
     by metis
   hence  \<open>\<exists>k. \<forall>n. norm ((f \<circ> k) n) \<ge> 4^n\<close>
     by simp
   then obtain k where \<open>norm ((f \<circ> k) n) \<ge> 4^n\<close> for n
     by blast
   define T where \<open>T = f \<circ> k\<close>
   have \<open>T n \<in> range f\<close> for n
     unfolding T_def by simp        
   have \<open>norm (T n) \<ge> of_nat (4^n)\<close> for n
     unfolding T_def using \<open>\<And> n. norm ((f \<circ> k) n) \<ge> 4^n\<close> by auto
   hence \<open>T n \<noteq> 0\<close> for n
     by (smt T_def \<open>\<And>n. 4 ^ n \<le> norm ((f \<circ> k) n)\<close> norm_zero power_not_zero zero_le_power)
   have \<open>inverse (of_nat 3^n) > (0::real)\<close> for n
     by auto
   define y::\<open>nat \<Rightarrow> 'a\<close> where \<open>y = rec_nat 0 (\<lambda>n x. \<xi> (T n) x (inverse (of_nat 3^n)))\<close>
   have \<open>y (Suc n) \<in> ball (y n) (inverse (of_nat 3^n))\<close> for n
     using f1 \<open>\<And> n. T n \<noteq> 0\<close> \<open>\<And> n. inverse (of_nat 3^n) > 0\<close> unfolding y_def by auto
   hence \<open>norm (y (Suc n) - y n) \<le> inverse (of_nat 3^n)\<close> for n
     unfolding ball_def apply auto using dist_norm by (smt norm_minus_commute) 
   moreover have \<open>\<exists>K. \<forall>n. sum (\<lambda>k. inverse (real_of_nat 3^k)) {0..n} \<le> K\<close>
     using sum_1 by blast
   moreover have \<open>Cauchy y\<close>
     using convergent_series_Cauchy[where a = "\<lambda>n. inverse (of_nat 3^n)" and \<phi> = y] dist_norm
     by (metis calculation(1) calculation(2))
   hence \<open>\<exists> x. y \<longlonglongrightarrow> x\<close>
     by (simp add: convergent_eq_Cauchy)
   then obtain x where \<open>y \<longlonglongrightarrow> x\<close>
     by blast
   have norm_2: \<open>norm (x - y (Suc n)) \<le> (inverse (of_nat 2))*(inverse (of_nat 3^n))\<close> for n
   proof-
     have \<open>inverse (real_of_nat 3) < 1\<close>
       by simp        
     moreover have \<open>y 0 = 0\<close>
       using y_def by auto
     ultimately have \<open>norm (x - y (Suc n)) 
     \<le> (inverse (of_nat 3)) * inverse (1 - (inverse (of_nat 3))) * ((inverse (of_nat 3)) ^ n)\<close>
       using bound_Cauchy_to_lim[where c = "inverse (of_nat 3)" and y = y and x = x]
         power_inverse semiring_norm(77)  \<open>y \<longlonglongrightarrow> x\<close>
         \<open>\<And> n. norm (y (Suc n) - y n) \<le> inverse (of_nat 3^n)\<close> by (metis divide_inverse)
     moreover have \<open>inverse (real_of_nat 3) * inverse (1 - (inverse (of_nat 3)))
                    = inverse (of_nat 2)\<close>
       by auto
     ultimately show ?thesis 
       by (metis power_inverse) 
   qed
   have \<open>norm (x - y (Suc n)) \<le> (inverse (of_nat 2))*(inverse (of_nat 3^n))\<close> for n
     using norm_2 by blast
   have \<open>\<exists> M. \<forall> n. norm ((*\<^sub>v) (T n) x) \<le> M\<close>
     unfolding T_def apply auto
     by (metis \<open>\<And>x. bounded (range (\<lambda>n. (*\<^sub>v) (f n) x))\<close> bounded_iff rangeI)
   then obtain M where \<open>norm ((*\<^sub>v) (T n) x) \<le> M\<close> for n
     by blast
   have norm_1: \<open>norm (T n) * norm (y (Suc n) - x) + norm ((*\<^sub>v) (T n) x)
        \<le> inverse (real 2) * inverse (real 3 ^ n) * norm (T n) + norm ((*\<^sub>v) (T n) x)\<close> for n
   proof-   
     have \<open>norm (y (Suc n) - x) \<le> (inverse (of_nat 2))*(inverse (of_nat 3^n))\<close>
       using \<open>norm (x - y (Suc n)) \<le> (inverse (of_nat 2))*(inverse (of_nat 3^n))\<close> 
       by (simp add: norm_minus_commute)
     moreover have \<open>norm (T n) \<ge> 0\<close>
       by auto
     ultimately have \<open>norm (T n) * norm (y (Suc n) - x) 
                      \<le> (inverse (of_nat 2))*(inverse (of_nat 3^n))*norm (T n)\<close>
       by (simp add: \<open>\<And>n. T n \<noteq> 0\<close>)
     thus ?thesis by simp      
   qed 
   have inverse_2: \<open>(inverse (of_nat 6)) * inverse (real 3 ^ n) * norm (T n) 
                   \<le> norm ((*\<^sub>v) (T n) x)\<close> for n
   proof-
     have \<open>(of_rat 2/3)*(inverse (of_nat 3^n))*norm (T n) \<le> norm ((*\<^sub>v) (T n) (y (Suc n)))\<close> 
       using f1 \<open>\<And> n. T n \<noteq> 0\<close> \<open>\<And> n. inverse (of_nat 3^n) > 0\<close> unfolding y_def by auto
     also have \<open>\<dots> = norm ((*\<^sub>v) (T n) ((y (Suc n) - x) + x))\<close>
       by auto
     also have \<open>\<dots> = norm ((*\<^sub>v) (T n) (y (Suc n) - x) + (*\<^sub>v) (T n) x)\<close>
       apply transfer apply auto by (metis diff_add_cancel linear_simps(1))
     also have \<open>\<dots> \<le> norm ((*\<^sub>v) (T n) (y (Suc n) - x)) + norm ((*\<^sub>v) (T n) x)\<close>
       by (simp add: norm_triangle_ineq)
     also have \<open>\<dots> \<le> norm (T n) * norm (y (Suc n) - x) + norm ((*\<^sub>v) (T n) x)\<close>
       apply transfer apply auto using onorm by auto 
     also have \<open>\<dots> \<le> (inverse (of_nat 2))*(inverse (of_nat 3^n))*norm (T n) 
                 + norm ((*\<^sub>v) (T n) x)\<close>
       using norm_1 by blast
     finally have \<open>(of_rat 2/3) * inverse (real 3 ^ n) * norm (T n)
                 \<le> inverse (real 2) * inverse (real 3 ^ n) * norm (T n) 
                 + norm ((*\<^sub>v) (T n) x)\<close>
       by blast
     hence \<open>(of_rat 2/3) * inverse (real 3 ^ n) * norm (T n) 
              - inverse (real 2) * inverse (real 3 ^ n) * norm (T n) \<le> norm ((*\<^sub>v) (T n) x)\<close>
       by linarith
     moreover have \<open>(of_rat 2/3) * inverse (real 3 ^ n) * norm (T n) 
              - inverse (real 2) * inverse (real 3 ^ n) * norm (T n)
              = (inverse (of_nat 6)) * inverse (real 3 ^ n) * norm (T n)\<close>
       by fastforce
     ultimately show \<open>(inverse (of_nat 6)) * inverse (real 3 ^ n) * norm (T n) \<le> norm ((*\<^sub>v) (T n) x)\<close>
       by linarith      
   qed
   have inverse_3: \<open>(inverse (of_nat 6)) * (of_rat (4/3)^n) 
                     \<le> (inverse (of_nat 6)) * inverse (real 3 ^ n) * norm (T n)\<close> for n
   proof-
     have \<open>of_rat (4/3)^n = inverse (real 3 ^ n) * (of_nat 4^n)\<close>
       apply auto by (metis divide_inverse_commute of_rat_divide power_divide of_rat_numeral_eq) 
     also have \<open>\<dots> \<le>  inverse (real 3 ^ n) * norm (T n)\<close>
       using \<open>\<And>n. norm (T n) \<ge> of_nat (4^n)\<close> by simp
     finally have \<open>of_rat (4/3)^n \<le> inverse (real 3 ^ n) * norm (T n)\<close>
       by blast
     moreover have \<open>inverse (of_nat 6) > (0::real)\<close>
       by auto
     ultimately show ?thesis by auto
   qed
   have inverse_1: \<open>(inverse (of_nat 6)) * (of_rat (4/3)^n) \<le> M\<close> for n
   proof-
     have \<open>(inverse (of_nat 6)) * (of_rat (4/3)^n) 
           \<le> (inverse (of_nat 6)) * inverse (real 3 ^ n) * norm (T n)\<close> 
       using inverse_3 by blast
     also have \<open>\<dots> \<le> norm ((*\<^sub>v) (T n) x)\<close> 
       using inverse_2 by blast
     finally have \<open>(inverse (of_nat 6)) * (of_rat (4/3)^n) \<le> norm ((*\<^sub>v) (T n) x)\<close>
       by auto
     thus ?thesis using \<open>\<And> n. norm ((*\<^sub>v) (T n) x) \<le> M\<close> by smt
   qed
   have \<open>\<exists>n. M < (inverse (of_nat 6)) * (of_rat (4/3)^n)\<close>
     using Real.real_arch_pow by auto
   moreover have \<open>(inverse (of_nat 6)) * (of_rat (4/3)^n) \<le> M\<close> for n
     using inverse_1 by blast                      
   ultimately show ?thesis by smt
 qed
 
 subsection \<open>A consequence of Banach-Steinhaus theorem\<close>
 
 corollary bounded_linear_limit_bounded_linear:
   fixes f::\<open>nat \<Rightarrow> ('a::banach \<Rightarrow>\<^sub>L 'b::real_normed_vector)\<close>
   assumes \<open>\<And>x. convergent (\<lambda>n. (f n) *\<^sub>v x)\<close>
   shows  \<open>\<exists>g. (\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> (*\<^sub>v) g\<close>
   text\<open>
   Explanation: If a sequence of bounded operators on a Banach space converges
   pointwise, then the limit is also a bounded operator.
 \<close>
 proof-
   have \<open>\<exists>l. (\<lambda>n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> l\<close> for x
     by (simp add:  \<open>\<And>x. convergent (\<lambda>n. (*\<^sub>v) (f n) x)\<close> convergentD)
   hence \<open>\<exists>F. (\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> F\<close>
     unfolding pointwise_convergent_to_def by metis
   obtain F where \<open>(\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> F\<close>
     using \<open>\<exists>F. (\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> F\<close> by auto
   have \<open>\<And>x. (\<lambda> n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> F x\<close>
     using \<open>(\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> F\<close> apply transfer
     by (simp add: pointwise_convergent_to_def)
   have \<open>bounded (range f)\<close>
     using \<open>\<And>x. convergent (\<lambda>n. (*\<^sub>v) (f n) x)\<close> banach_steinhaus
       \<open>\<And>x. \<exists>l. (\<lambda>n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> l\<close> convergent_imp_bounded by blast
   have norm_f_n: \<open>\<exists> M. \<forall> n. norm (f n) \<le> M\<close>
     unfolding bounded_def
     by (meson UNIV_I \<open>bounded (range f)\<close> bounded_iff image_eqI)
   have \<open>isCont (\<lambda> t::'b. norm t) y\<close> for y::'b
     using Limits.isCont_norm by simp
   hence \<open>(\<lambda> n. norm ((*\<^sub>v) (f n) x)) \<longlonglongrightarrow> (norm (F x))\<close> for x
     using \<open>\<And> x::'a. (\<lambda> n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> F x\<close> by (simp add: tendsto_norm)
   hence norm_f_n_x: \<open>\<exists> M. \<forall> n. norm ((*\<^sub>v) (f n) x) \<le> M\<close> for x
     using Elementary_Metric_Spaces.convergent_imp_bounded
     by (metis UNIV_I \<open>\<And> x::'a. (\<lambda> n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> F x\<close> bounded_iff image_eqI)
   have norm_f: \<open>\<exists>K. \<forall>n. \<forall>x. norm ((*\<^sub>v) (f n) x) \<le> norm x * K\<close>
   proof-
     have \<open>\<exists> M. \<forall> n. norm ((*\<^sub>v) (f n) x) \<le> M\<close> for x
       using norm_f_n_x  \<open>\<And>x. (\<lambda>n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> F x\<close> by blast
     hence \<open>\<exists> M. \<forall> n. norm (f n) \<le> M\<close>
       using norm_f_n by simp 
     then obtain M::real where \<open>\<exists> M. \<forall> n. norm (f n) \<le> M\<close>
       by blast
     have \<open>\<forall> n. \<forall>x. norm ((*\<^sub>v) (f n) x) \<le> norm x * norm (f n)\<close>
       apply transfer apply auto by (metis mult.commute onorm) 
     thus  ?thesis using \<open>\<exists> M. \<forall> n. norm (f n) \<le> M\<close>
       by (metis (no_types, hide_lams) dual_order.trans norm_eq_zero order_refl 
-          real_mult_le_cancel_iff2 vector_space_over_itself.scale_zero_left zero_less_norm_iff)
+          mult_le_cancel_iff2 vector_space_over_itself.scale_zero_left zero_less_norm_iff)
   qed 
   have norm_F_x: \<open>\<exists>K. \<forall>x. norm (F x) \<le> norm x * K\<close>
   proof-
     have "\<exists>K. \<forall>n. \<forall>x. norm ((*\<^sub>v) (f n) x) \<le> norm x * K"
       using norm_f \<open>\<And>x. (\<lambda>n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> F x\<close> by auto
     thus ?thesis
       using  \<open>\<And> x::'a. (\<lambda> n. (*\<^sub>v) (f n)  x) \<longlonglongrightarrow> F x\<close> apply transfer 
       by (metis Lim_bounded tendsto_norm)   
   qed
   have \<open>linear F\<close>
   proof(rule linear_limit_linear)
     show \<open>linear ((*\<^sub>v) (f n))\<close> for n
       apply transfer apply auto by (simp add: bounded_linear.linear) 
     show \<open>f \<midarrow>pointwise\<rightarrow> F\<close>
       using \<open>(\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> F\<close> by auto
   qed
   moreover have \<open>bounded_linear_axioms F\<close>
     using norm_F_x by (simp add: \<open>\<And>x. (\<lambda>n. (*\<^sub>v) (f n) x) \<longlonglongrightarrow> F x\<close> bounded_linear_axioms_def) 
   ultimately have \<open>bounded_linear F\<close> 
     unfolding bounded_linear_def by blast
   hence \<open>\<exists>g. (*\<^sub>v) g = F\<close>
     using bounded_linear_Blinfun_apply by auto
   thus ?thesis using \<open>(\<lambda>n. (*\<^sub>v) (f n)) \<midarrow>pointwise\<rightarrow> F\<close> apply transfer by auto
 qed
 
 end
diff --git a/thys/Banach_Steinhaus/Banach_Steinhaus_Missing.thy b/thys/Banach_Steinhaus/Banach_Steinhaus_Missing.thy
--- a/thys/Banach_Steinhaus/Banach_Steinhaus_Missing.thy
+++ b/thys/Banach_Steinhaus/Banach_Steinhaus_Missing.thy
@@ -1,898 +1,898 @@
 (*
   File:   Banach_Steinhaus_Missing.thy
   Author: Dominique Unruh, University of Tartu
   Author: Jose Manuel Rodriguez Caballero, University of Tartu
 *)
 section \<open>Missing results for the proof of Banach-Steinhaus theorem\<close>
 
 theory Banach_Steinhaus_Missing
   imports
     "HOL-Analysis.Infinite_Set_Sum"
 
 begin
 subsection \<open>Results missing for the proof of Banach-Steinhaus theorem\<close>
 text \<open>
   The results proved here are preliminaries for the proof of Banach-Steinhaus theorem using Sokal's 
   approach, but they do not explicitly appear in Sokal's paper ~\cite{sokal2011reall}.
 \<close>
 
 text\<open>Notation for the norm\<close>
 bundle notation_norm begin
 notation norm ("\<parallel>_\<parallel>")
 end
 
 bundle no_notation_norm begin
 no_notation norm ("\<parallel>_\<parallel>")
 end
 
 unbundle notation_norm
 
 text\<open>Notation for apply bilinear function\<close>
 bundle notation_blinfun_apply begin
 notation blinfun_apply (infixr "*\<^sub>v" 70)
 end
 
 bundle no_notation_blinfun_apply begin
 no_notation blinfun_apply (infixr "*\<^sub>v" 70)
 end
 
 unbundle notation_blinfun_apply
 
 lemma bdd_above_plus:
   fixes f::\<open>'a \<Rightarrow> real\<close>
   assumes \<open>bdd_above (f ` S)\<close> and \<open>bdd_above (g ` S)\<close> 
   shows \<open>bdd_above ((\<lambda> x. f x + g x) ` S)\<close>
   text \<open>
   Explanation: If the images of two real-valued functions \<^term>\<open>f\<close>,\<^term>\<open>g\<close> are bounded above on a 
   set \<^term>\<open>S\<close>, then the image of their sum is bounded on \<^term>\<open>S\<close>.
 \<close>
 proof-
   obtain M where \<open>\<And> x. x\<in>S \<Longrightarrow> f x \<le> M\<close>
     using \<open>bdd_above (f ` S)\<close> unfolding bdd_above_def by blast
   obtain N where \<open>\<And> x. x\<in>S \<Longrightarrow> g x \<le> N\<close>
     using \<open>bdd_above (g ` S)\<close> unfolding bdd_above_def by blast
   have \<open>\<And> x. x\<in>S \<Longrightarrow> f x + g x \<le> M + N\<close>
     using \<open>\<And>x. x \<in> S \<Longrightarrow> f x \<le> M\<close> \<open>\<And>x. x \<in> S \<Longrightarrow> g x \<le> N\<close> by fastforce
   thus ?thesis unfolding bdd_above_def by blast
 qed
 
 text\<open>The maximum of two functions\<close>
 definition pointwise_max:: "('a \<Rightarrow> 'b::ord) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" where
   \<open>pointwise_max f g = (\<lambda>x. max (f x) (g x))\<close>
 
 lemma max_Sup_absorb_left:
   fixes f g::\<open>'a \<Rightarrow> real\<close>
   assumes \<open>X \<noteq> {}\<close> and \<open>bdd_above (f ` X)\<close> and \<open>bdd_above (g ` X)\<close> and \<open>Sup (f ` X) \<ge> Sup (g ` X)\<close>
   shows \<open>Sup ((pointwise_max f g) ` X) = Sup (f ` X)\<close>
 
   text \<open>Explanation: For real-valued functions \<^term>\<open>f\<close> and \<^term>\<open>g\<close>, if the supremum of \<^term>\<open>f\<close> is 
     greater-equal the supremum of \<^term>\<open>g\<close>, then the supremum of \<^term>\<open>max f g\<close> equals the supremum of
     \<^term>\<open>f\<close>. (Under some technical conditions.)\<close>
 
 proof-
   have y_Sup: \<open>y \<in> ((\<lambda> x. max (f x) (g x)) ` X) \<Longrightarrow> y \<le> Sup (f ` X)\<close> for y
   proof-
     assume \<open>y \<in> ((\<lambda> x. max (f x) (g x)) ` X)\<close>
     then obtain x where \<open>y = max (f x) (g x)\<close> and \<open>x \<in> X\<close>
       by blast
     have \<open>f x \<le> Sup (f ` X)\<close>
       by (simp add:  \<open>x \<in> X\<close> \<open>bdd_above (f ` X)\<close> cSUP_upper) 
     moreover have  \<open>g x \<le> Sup (g ` X)\<close>
       by (simp add:  \<open>x \<in> X\<close> \<open>bdd_above (g ` X)\<close> cSUP_upper) 
     ultimately have \<open>max (f x) (g x) \<le> Sup (f ` X)\<close>
       using  \<open>Sup (f ` X) \<ge> Sup (g ` X)\<close> by auto
     thus ?thesis by (simp add: \<open>y = max (f x) (g x)\<close>) 
   qed
   have y_f_X: \<open>y \<in> f ` X \<Longrightarrow> y \<le> Sup ((\<lambda> x. max (f x) (g x)) ` X)\<close> for y
   proof-
     assume \<open>y \<in> f ` X\<close>
     then obtain x where \<open>x \<in> X\<close> and \<open>y = f x\<close>
       by blast
     have  \<open>bdd_above ((\<lambda> \<xi>. max (f \<xi>) (g \<xi>)) ` X)\<close>
       by (metis (no_types) \<open>bdd_above (f ` X)\<close> \<open>bdd_above (g ` X)\<close> bdd_above_image_sup sup_max)
     moreover have \<open>e > 0 \<Longrightarrow> \<exists> k \<in> (\<lambda> \<xi>. max (f \<xi>) (g \<xi>)) ` X. y \<le> k + e\<close>
       for e::real
       using \<open>Sup (f ` X) \<ge> Sup (g ` X)\<close> by (smt \<open>x \<in> X\<close> \<open>y = f x\<close> image_eqI)        
     ultimately show ?thesis
       using \<open>x \<in> X\<close> \<open>y = f x\<close> cSUP_upper by fastforce
   qed
   have \<open>Sup ((\<lambda> x. max (f x) (g x)) ` X) \<le> Sup (f ` X)\<close>
     using y_Sup by (simp add: \<open>X \<noteq> {}\<close> cSup_least) 
   moreover have \<open>Sup ((\<lambda> x. max (f x) (g x)) ` X) \<ge> Sup (f ` X)\<close>
     using y_f_X by (metis (mono_tags) cSup_least calculation empty_is_image)  
   ultimately show ?thesis unfolding pointwise_max_def by simp
 qed
 
 lemma max_Sup_absorb_right:
   fixes f g::\<open>'a \<Rightarrow> real\<close>
   assumes \<open>X \<noteq> {}\<close> and \<open>bdd_above (f ` X)\<close> and \<open>bdd_above (g ` X)\<close> and \<open>Sup (f ` X) \<le> Sup (g ` X)\<close>
   shows \<open>Sup ((pointwise_max f g) ` X) = Sup (g ` X)\<close>
   text \<open>
   Explanation: For real-valued functions \<^term>\<open>f\<close> and \<^term>\<open>g\<close> and a nonempty set \<^term>\<open>X\<close>, such that 
   the \<^term>\<open>f\<close> and \<^term>\<open>g\<close> are bounded above on \<^term>\<open>X\<close>, if the supremum of \<^term>\<open>f\<close> on \<^term>\<open>X\<close> is 
   lower-equal the supremum of \<^term>\<open>g\<close> on \<^term>\<open>X\<close>, then the supremum of \<^term>\<open>pointwise_max f g\<close> on \<^term>\<open>X\<close>
   equals the supremum of \<^term>\<open>g\<close>. This is the right analog of @{text max_Sup_absorb_left}.
 \<close>
 proof-
   have \<open>Sup ((pointwise_max g f) ` X) = Sup (g ` X)\<close>
     using  assms by (simp add: max_Sup_absorb_left)     
   moreover have \<open>pointwise_max g f = pointwise_max f g\<close>
     unfolding pointwise_max_def  by auto
   ultimately show ?thesis by simp
 qed
 
 lemma max_Sup:
   fixes f g::\<open>'a \<Rightarrow> real\<close>
   assumes \<open>X \<noteq> {}\<close> and \<open>bdd_above (f ` X)\<close> and \<open>bdd_above (g ` X)\<close>
   shows \<open>Sup ((pointwise_max f g) ` X) = max (Sup (f ` X)) (Sup (g ` X))\<close>
   text \<open>
   Explanation: Let \<^term>\<open>X\<close> be a nonempty set. Two supremum over \<^term>\<open>X\<close> of the maximum of two 
   real-value functions is equal to the maximum of their suprema over \<^term>\<open>X\<close>, provided that the
   functions are bounded above on \<^term>\<open>X\<close>.
 \<close>
 proof(cases \<open>Sup (f ` X) \<ge> Sup (g ` X)\<close>)
   case True thus ?thesis by (simp add: assms(1) assms(2) assms(3) max_Sup_absorb_left)
 next
   case False 
   have f1: "\<not> 0 \<le> Sup (f ` X) + - 1 * Sup (g ` X)"
     using False by linarith
   hence "Sup (Banach_Steinhaus_Missing.pointwise_max f g ` X) = Sup (g ` X)"
     by (simp add: assms(1) assms(2) assms(3) max_Sup_absorb_right)
   thus ?thesis
     using f1 by linarith
 qed
 
 
 lemma identity_telescopic:
   fixes x :: \<open>_ \<Rightarrow> 'a::real_normed_vector\<close>
   assumes \<open>x \<longlonglongrightarrow> l\<close>
   shows \<open>(\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N}) \<longlonglongrightarrow> l - x n\<close>
   text\<open>
   Expression of a limit as a telescopic series.
   Explanation: If \<^term>\<open>x\<close> converges to \<^term>\<open>l\<close> then the sum \<^term>\<open>sum (\<lambda> k. x (Suc k) - x k) {n..N}\<close>
   converges to \<^term>\<open>l - x n\<close> as \<^term>\<open>N\<close> goes to infinity.
 \<close>
 proof-
   have \<open>(\<lambda> p. x (p + Suc n)) \<longlonglongrightarrow> l\<close>
     using \<open>x \<longlonglongrightarrow> l\<close> by (rule LIMSEQ_ignore_initial_segment)
   hence \<open>(\<lambda> p. x (Suc n + p)) \<longlonglongrightarrow> l\<close>   
     by (simp add: add.commute)
   hence \<open>(\<lambda> p. x (Suc (n + p))) \<longlonglongrightarrow> l\<close>
     by simp 
   hence \<open>(\<lambda> t. (- (x n)) + (\<lambda> p.  x (Suc (n + p))) t ) \<longlonglongrightarrow> (- (x n))  + l\<close>
     using tendsto_add_const_iff by metis 
   hence f1: \<open>(\<lambda> p. x (Suc (n + p)) - x n)\<longlonglongrightarrow> l - x n\<close>
     by simp
   have \<open>sum (\<lambda> k. x (Suc k) - x k) {n..n+p} = x (Suc (n+p)) - x n\<close> for p
     by (simp add: sum_Suc_diff)
   moreover have \<open>(\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N}) (n + t) 
                = (\<lambda> p. sum (\<lambda> k. x (Suc k) - x k) {n..n+p}) t\<close> for t
     by blast
   ultimately have  \<open>(\<lambda> p. (\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N}) (n + p)) \<longlonglongrightarrow> l - x n\<close>
     using f1 by simp
   hence \<open>(\<lambda> p. (\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N}) (p + n)) \<longlonglongrightarrow> l - x n\<close>
     by (simp add: add.commute)
   hence  \<open>(\<lambda> p. (\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N}) p) \<longlonglongrightarrow> l - x n\<close>
     using Topological_Spaces.LIMSEQ_offset[where f = "(\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N})" 
         and a = "l - x n" and k = n] by blast
   hence  \<open>(\<lambda> M. (\<lambda> N. sum (\<lambda> k. x (Suc k) - x k) {n..N}) M) \<longlonglongrightarrow> l - x n\<close>
     by simp
   thus ?thesis by blast
 qed
 
 lemma bound_Cauchy_to_lim:
   assumes \<open>y \<longlonglongrightarrow> x\<close> and \<open>\<And>n. \<parallel>y (Suc n) - y n\<parallel> \<le> c^n\<close> and \<open>y 0 = 0\<close> and \<open>c < 1\<close>
   shows \<open>\<parallel>x - y (Suc n)\<parallel> \<le> (c / (1 - c)) * c ^ n\<close>
   text\<open>
   Inequality about a sequence of approximations assuming that the sequence of differences is bounded
   by a geometric progression.
   Explanation: Let \<^term>\<open>y\<close> be a sequence converging to \<^term>\<open>x\<close>.
   If \<^term>\<open>y\<close> satisfies the inequality \<open>\<parallel>y (Suc n) - y n\<parallel> \<le> c ^ n\<close> for some \<^term>\<open>c < 1\<close> and 
   assuming \<^term>\<open>y 0 = 0\<close> then the inequality \<open>\<parallel>x - y (Suc n)\<parallel> \<le> (c / (1 - c)) * c ^ n\<close> holds.
 \<close>
 proof-
   have \<open>c \<ge> 0\<close>
     using \<open>\<And> n. \<parallel>y (Suc n) - y n\<parallel> \<le> c^n\<close> by (smt norm_imp_pos_and_ge power_Suc0_right)
   have norm_1: \<open>norm (\<Sum>k = Suc n..N. y (Suc k) - y k) \<le> (c ^ Suc n)/(1 - c)\<close> for N
   proof(cases \<open>N < Suc n\<close>)
     case True
     hence \<open>\<parallel>sum (\<lambda>k. y (Suc k) - y k) {Suc n .. N}\<parallel> = 0\<close>
       by auto
     thus ?thesis  using  \<open>c \<ge> 0\<close> \<open>c < 1\<close> by auto       
   next
     case False
     hence \<open>N \<ge> Suc n\<close>
       by auto
     have \<open>c^(Suc N) \<ge> 0\<close>
       using \<open>c \<ge> 0\<close> by auto
     have \<open>1 - c > 0\<close>
       by (simp add: \<open>c < 1\<close>)
     hence \<open>(1 - c)/(1 - c) = 1\<close>
       by auto
     have \<open>\<parallel>sum (\<lambda>k. y (Suc k) - y k) {Suc n .. N}\<parallel> \<le> (sum (\<lambda>k. \<parallel>y (Suc k) - y k\<parallel>) {Suc n .. N})\<close>
       by (simp add: sum_norm_le)
     hence \<open>\<parallel>sum (\<lambda>k. y (Suc k) - y k) {Suc n .. N}\<parallel> \<le> (sum (power c) {Suc n .. N})\<close>
       by (simp add: assms(2) sum_norm_le)
     hence \<open>(1 - c) * \<parallel>sum (\<lambda>k. y (Suc k) - y k) {Suc n .. N}\<parallel>
                    \<le> (1 - c) * (sum (power c) {Suc n .. N})\<close>
-      using \<open>0 < 1 - c\<close> real_mult_le_cancel_iff2 by blast      
+      using \<open>0 < 1 - c\<close> mult_le_cancel_iff2 by blast      
     also have \<open>\<dots> = c^(Suc n) - c^(Suc N)\<close>
       using Set_Interval.sum_gp_multiplied \<open>Suc n \<le> N\<close> by blast
     also have \<open>\<dots> \<le> c^(Suc n)\<close>
       using \<open>c^(Suc N) \<ge> 0\<close> by auto
     finally have \<open>(1 - c) * \<parallel>\<Sum>k = Suc n..N. y (Suc k) - y k\<parallel> \<le> c ^ Suc n\<close>
       by blast
     hence \<open>((1 - c) * \<parallel>\<Sum>k = Suc n..N. y (Suc k) - y k\<parallel>)/(1 - c)
                    \<le> (c ^ Suc n)/(1 - c)\<close>
       using \<open>0 < 1 - c\<close> by (smt divide_right_mono)      
     thus \<open>\<parallel>\<Sum>k = Suc n..N. y (Suc k) - y k\<parallel> \<le> (c ^ Suc n)/(1 - c)\<close>
       using \<open>0 < 1 - c\<close> by auto 
   qed
   have \<open>(\<lambda> N. (sum (\<lambda>k. y (Suc k) - y k) {Suc n .. N})) \<longlonglongrightarrow> x - y (Suc n)\<close>
     by (metis (no_types) \<open>y \<longlonglongrightarrow> x\<close> identity_telescopic)     
   hence \<open>(\<lambda> N. \<parallel>sum (\<lambda>k. y (Suc k) - y k) {Suc n .. N}\<parallel>) \<longlonglongrightarrow> \<parallel>x - y (Suc n)\<parallel>\<close>
     using tendsto_norm by blast
   hence \<open>\<parallel>x - y (Suc n)\<parallel> \<le> (c ^ Suc n)/(1 - c)\<close>
     using norm_1 Lim_bounded by blast
   hence  \<open>\<parallel>x - y (Suc n)\<parallel> \<le> (c ^ Suc n)/(1 - c)\<close>
     by auto
   moreover have \<open>(c ^ Suc n)/(1 - c) = (c / (1 - c)) * (c ^ n)\<close>
     by (simp add: divide_inverse_commute)    
   ultimately show \<open>\<parallel>x - y (Suc n)\<parallel> \<le> (c / (1 - c)) * (c ^ n)\<close> by linarith
 qed
 
 lemma onorm_open_ball:
   includes notation_norm
   shows \<open>\<parallel>f\<parallel> = Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1 }\<close>
   text \<open>
   Explanation: Let \<^term>\<open>f\<close> be a bounded linear operator. The operator norm of \<^term>\<open>f\<close> is the
   supremum of \<^term>\<open>norm (f x)\<close> for \<^term>\<open>x\<close> such that \<^term>\<open>norm x < 1\<close>.
 \<close>
 proof(cases \<open>(UNIV::'a set) = 0\<close>)
   case True
   hence \<open>x = 0\<close> for x::'a
     by auto
   hence \<open>f *\<^sub>v x = 0\<close> for x
     by (metis (full_types) blinfun.zero_right)
   hence \<open>\<parallel>f\<parallel> = 0\<close>
     by (simp add: blinfun_eqI zero_blinfun.rep_eq)      
   have \<open>{ \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1} = {0}\<close>
     by (smt Collect_cong \<open>\<And>x. f *\<^sub>v x = 0\<close> norm_zero singleton_conv)      
   hence \<open>Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1} = 0\<close>
     by simp    
   thus ?thesis using \<open>\<parallel>f\<parallel> = 0\<close> by auto      
 next
   case False
   hence \<open>(UNIV::'a set) \<noteq> 0\<close>
     by simp
   have nonnegative: \<open>\<parallel>f *\<^sub>v x\<parallel> \<ge> 0\<close> for x
     by simp
   have \<open>\<exists> x::'a. x \<noteq> 0\<close>
     using \<open>UNIV \<noteq> 0\<close> by auto
   then obtain x::'a where \<open>x \<noteq> 0\<close>
     by blast
   hence \<open>\<parallel>x\<parallel> \<noteq> 0\<close>
     by auto
   define y where \<open>y = x /\<^sub>R \<parallel>x\<parallel>\<close>
   have \<open>norm y = \<parallel> x /\<^sub>R \<parallel>x\<parallel> \<parallel>\<close>
     unfolding y_def by auto
   also have \<open>\<dots> = \<parallel>x\<parallel> /\<^sub>R \<parallel>x\<parallel>\<close>
     by auto
   also have \<open>\<dots> = 1\<close>
     using \<open>\<parallel>x\<parallel> \<noteq> 0\<close> by auto
   finally have \<open>\<parallel>y\<parallel> = 1\<close>
     by blast
   hence norm_1_non_empty: \<open>{ \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1} \<noteq> {}\<close>
     by blast
   have norm_1_bounded: \<open>bdd_above { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
     unfolding bdd_above_def apply auto
     by (metis norm_blinfun)
   have norm_less_1_non_empty: \<open>{\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1} \<noteq> {}\<close>
     by (metis (mono_tags, lifting) Collect_empty_eq_bot bot_empty_eq empty_iff norm_zero 
         zero_less_one)   
   have norm_less_1_bounded: \<open>bdd_above {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close>
   proof-
     have \<open>\<exists>r. \<parallel>a r\<parallel> < 1 \<longrightarrow> \<parallel>f *\<^sub>v (a r)\<parallel> \<le> r\<close> for a :: "real \<Rightarrow> 'a"
     proof-
       obtain r :: "('a \<Rightarrow>\<^sub>L 'b) \<Rightarrow> real" where
         "\<And>f x. 0 \<le> r f \<and> (bounded_linear f \<longrightarrow> \<parallel>f *\<^sub>v x\<parallel> \<le> \<parallel>x\<parallel> * r f)"
         using bounded_linear.nonneg_bounded by moura
       have \<open>\<not> \<parallel>f\<parallel> < 0\<close>
         by simp          
       hence "(\<exists>r. \<parallel>f\<parallel> * \<parallel>a r\<parallel> \<le> r) \<or> (\<exists>r. \<parallel>a r\<parallel> < 1 \<longrightarrow> \<parallel>f *\<^sub>v a r\<parallel> \<le> r)"
         by (meson less_eq_real_def mult_le_cancel_left2) 
       thus ?thesis using dual_order.trans norm_blinfun by blast
     qed
     hence \<open>\<exists> M. \<forall> x. \<parallel>x\<parallel> < 1 \<longrightarrow> \<parallel>f *\<^sub>v x\<parallel> \<le> M\<close>
       by metis
     thus ?thesis by auto 
   qed
   have Sup_non_neg: \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<ge> 0\<close>
     by (smt Collect_empty_eq cSup_upper mem_Collect_eq nonnegative norm_1_bounded norm_1_non_empty)      
   have \<open>{0::real} \<noteq> {}\<close>
     by simp
   have \<open>bdd_above {0::real}\<close>
     by simp
   show \<open>\<parallel>f\<parallel> = Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close>
   proof(cases \<open>\<forall>x. f *\<^sub>v x = 0\<close>)
     case True
     have \<open>\<parallel>f *\<^sub>v x\<parallel> = 0\<close> for x
       by (simp add: True)
     hence \<open>{\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1 } \<subseteq> {0}\<close>
       by blast        
     moreover have \<open>{\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1 } \<supseteq> {0}\<close>
       using calculation norm_less_1_non_empty by fastforce                        
     ultimately have \<open>{\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1 } = {0}\<close>  
       by blast
     hence Sup1: \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1 } = 0\<close> 
       by simp
     have \<open>\<parallel>f\<parallel> = 0\<close>
       by (simp add: True blinfun_eqI)        
     moreover have \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1} = 0\<close>
       using Sup1 by blast
     ultimately show ?thesis by simp
   next
     case False
     have norm_f_eq_leq: \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1} \<Longrightarrow> 
                          y \<le> Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close> for y
     proof-
       assume \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
       hence \<open>\<exists> x. y = \<parallel>f *\<^sub>v x\<parallel> \<and> \<parallel>x\<parallel> = 1\<close>
         by blast
       then obtain x where \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close> and \<open>\<parallel>x\<parallel> = 1\<close>
         by auto
       define y' where \<open>y' n = (1 - (inverse (real (Suc n)))) *\<^sub>R y\<close> for n
       have \<open>y' n \<in> {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close> for n
       proof-
         have \<open>y' n = (1 - (inverse (real (Suc n)))) *\<^sub>R \<parallel>f *\<^sub>v x\<parallel>\<close>
           using y'_def \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close> by blast
         also have \<open>... = \<bar>(1 - (inverse (real (Suc n))))\<bar> *\<^sub>R \<parallel>f *\<^sub>v x\<parallel>\<close>
           by (metis (mono_tags, hide_lams) \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close> abs_1 abs_le_self_iff abs_of_nat 
               abs_of_nonneg add_diff_cancel_left' add_eq_if cancel_comm_monoid_add_class.diff_cancel
               diff_ge_0_iff_ge eq_iff_diff_eq_0 inverse_1 inverse_le_iff_le nat.distinct(1) of_nat_0
               of_nat_Suc of_nat_le_0_iff zero_less_abs_iff zero_neq_one)
         also have \<open>... = \<parallel>f *\<^sub>v ((1 - (inverse (real (Suc n)))) *\<^sub>R  x)\<parallel>\<close>
           by (simp add: blinfun.scaleR_right)            
         finally have y'_1: \<open>y' n = \<parallel>f *\<^sub>v ( (1 - (inverse (real (Suc n)))) *\<^sub>R x)\<parallel>\<close> 
           by blast
         have \<open>\<parallel>(1 - (inverse (Suc n))) *\<^sub>R x\<parallel> = (1 - (inverse (real (Suc n)))) * \<parallel>x\<parallel>\<close>
           by (simp add: linordered_field_class.inverse_le_1_iff)                
         hence \<open>\<parallel>(1 - (inverse (Suc n))) *\<^sub>R x\<parallel> < 1\<close>
           by (simp add: \<open>\<parallel>x\<parallel> = 1\<close>) 
         thus ?thesis using y'_1 by blast 
       qed
       have \<open>(\<lambda>n. (1 - (inverse (real (Suc n)))) ) \<longlonglongrightarrow> 1\<close>
         using Limits.LIMSEQ_inverse_real_of_nat_add_minus by simp
       hence \<open>(\<lambda>n. (1 - (inverse (real (Suc n)))) *\<^sub>R y) \<longlonglongrightarrow> 1 *\<^sub>R y\<close>
         using Limits.tendsto_scaleR by blast
       hence \<open>(\<lambda>n. (1 - (inverse (real (Suc n)))) *\<^sub>R y) \<longlonglongrightarrow> y\<close>
         by simp
       hence \<open>(\<lambda>n. y' n) \<longlonglongrightarrow> y\<close>
         using y'_def by simp
       hence \<open>y' \<longlonglongrightarrow> y\<close> 
         by simp
       have \<open>y' n \<le> Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close> for n
         using cSup_upper \<open>\<And>n. y' n \<in> {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> < 1}\<close> norm_less_1_bounded by blast
       hence \<open>y \<le> Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close>
         using \<open>y' \<longlonglongrightarrow> y\<close> Topological_Spaces.Sup_lim by (meson LIMSEQ_le_const2)
       thus ?thesis by blast
     qed
     hence \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1} \<le> Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close>
       by (metis (lifting) cSup_least norm_1_non_empty)
     have \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1} \<Longrightarrow> y \<le> Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close> for y
     proof(cases \<open>y = 0\<close>)
       case True thus ?thesis by (simp add: Sup_non_neg) 
     next
       case False
       hence \<open>y \<noteq> 0\<close> by blast
       assume \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close>
       hence \<open>\<exists> x. y = \<parallel>f *\<^sub>v x\<parallel> \<and> \<parallel>x\<parallel> < 1\<close>
         by blast
       then obtain x where \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close> and \<open>\<parallel>x\<parallel> < 1\<close>
         by blast
       have \<open>(1/\<parallel>x\<parallel>) * y = (1/\<parallel>x\<parallel>) * \<parallel>f x\<parallel>\<close>
         by (simp add: \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close>)
       also have \<open>... = \<bar>1/\<parallel>x\<parallel>\<bar> * \<parallel>f *\<^sub>v x\<parallel>\<close>
         by simp
       also have \<open>... = \<parallel>(1/\<parallel>x\<parallel>) *\<^sub>R (f *\<^sub>v x)\<parallel>\<close>
         by simp
       also have \<open>... = \<parallel>f *\<^sub>v ((1/\<parallel>x\<parallel>) *\<^sub>R x)\<parallel>\<close>
         by (simp add: blinfun.scaleR_right)          
       finally have \<open>(1/\<parallel>x\<parallel>) * y  = \<parallel>f *\<^sub>v ((1/\<parallel>x\<parallel>) *\<^sub>R x)\<parallel>\<close>
         by blast
       have \<open>x \<noteq> 0\<close>
         using  \<open>y \<noteq> 0\<close> \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close> blinfun.zero_right by auto 
       have \<open>\<parallel> (1/\<parallel>x\<parallel>) *\<^sub>R x \<parallel> = \<bar> (1/\<parallel>x\<parallel>) \<bar> * \<parallel>x\<parallel>\<close>
         by simp
       also have \<open>... = (1/\<parallel>x\<parallel>) * \<parallel>x\<parallel>\<close>
         by simp
       finally have  \<open>\<parallel>(1/\<parallel>x\<parallel>) *\<^sub>R x\<parallel> = 1\<close>
         using \<open>x \<noteq> 0\<close> by simp
       hence \<open>(1/\<parallel>x\<parallel>) * y \<in> { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
         using \<open>1 / \<parallel>x\<parallel> * y = \<parallel>f *\<^sub>v (1 / \<parallel>x\<parallel>) *\<^sub>R x\<parallel>\<close> by blast
       hence \<open>(1/\<parallel>x\<parallel>) * y \<le> Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
         by (simp add: cSup_upper norm_1_bounded)
       moreover have \<open>y \<le> (1/\<parallel>x\<parallel>) * y\<close>
         by (metis \<open>\<parallel>x\<parallel> < 1\<close> \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close> mult_le_cancel_right1 norm_not_less_zero 
             order.strict_implies_order \<open>x \<noteq> 0\<close> less_divide_eq_1_pos zero_less_norm_iff)
       ultimately show ?thesis by linarith 
     qed
     hence \<open>Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1} \<le> Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
       by (smt cSup_least norm_less_1_non_empty) 
     hence \<open>Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1} = Sup { \<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1}\<close>
       using \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> |x. norm x = 1} \<le> Sup { \<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> < 1}\<close> by linarith
     have f1: \<open>(SUP x. \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>) = Sup { \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> | x. True}\<close>
       by (simp add: full_SetCompr_eq)
     have \<open>y \<in> { \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True} \<Longrightarrow> y \<in> { \<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0}\<close>
       for y
     proof-
       assume \<open>y \<in> { \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True}\<close> show ?thesis
       proof(cases \<open>y = 0\<close>)
         case True  thus ?thesis by simp 
       next
         case False
         have \<open>\<exists> x. y = \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>\<close>
           using \<open>y \<in> { \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True}\<close> by auto
         then obtain x where \<open>y = \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>\<close>
           by blast
         hence \<open>y = \<bar>(1/\<parallel>x\<parallel>)\<bar> * \<parallel> f *\<^sub>v x \<parallel>\<close>
           by simp
         hence \<open>y = \<parallel>(1/\<parallel>x\<parallel>) *\<^sub>R (f *\<^sub>v x)\<parallel>\<close>
           by simp
         hence \<open>y = \<parallel>f ((1/\<parallel>x\<parallel>) *\<^sub>R x)\<parallel>\<close>
           by (simp add: blinfun.scaleR_right)            
         moreover have \<open>\<parallel> (1/\<parallel>x\<parallel>) *\<^sub>R x \<parallel> = 1\<close>
           using False \<open>y = \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>\<close> by auto
         ultimately have \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}\<close>
           by blast
         thus ?thesis by blast
       qed
     qed
     moreover have \<open>y \<in> {\<parallel>f x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0} \<Longrightarrow> y \<in> {\<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True}\<close>
       for y
     proof(cases \<open>y = 0\<close>)
       case True thus ?thesis by auto 
     next
       case False
       hence \<open>y \<notin> {0}\<close>
         by simp
       moreover assume \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0}\<close>
       ultimately have \<open>y \<in> {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}\<close>
         by simp
       then obtain x where \<open>\<parallel>x\<parallel> = 1\<close> and \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close>
         by auto
       have \<open>y = \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>\<close> using  \<open>\<parallel>x\<parallel> = 1\<close>  \<open>y = \<parallel>f *\<^sub>v x\<parallel>\<close>
         by simp 
       thus ?thesis by auto 
     qed
     ultimately have \<open>{\<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True} = {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0}\<close>
       by blast
     hence \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True} = Sup ({\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0})\<close>
       by simp
     have "\<And>r s. \<not> (r::real) \<le> s \<or> sup r s = s"
       by (metis (lifting) sup.absorb_iff1 sup_commute)
     hence \<open>Sup ({\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {(0::real)})
              = max (Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}) (Sup {0::real})\<close>
       using \<open>0 \<le> Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}\<close> \<open>bdd_above {0}\<close> \<open>{0} \<noteq> {}\<close> cSup_singleton 
         cSup_union_distrib max.absorb_iff1 sup_commute norm_1_bounded norm_1_non_empty
       by (metis (no_types, lifting) )
     moreover have \<open>Sup {(0::real)} = (0::real)\<close>
       by simp          
     ultimately have \<open>Sup ({\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0}) = Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}\<close>
       using Sup_non_neg by linarith
     moreover have \<open>Sup ( {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0}) 
                     = max (Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}) (Sup {0}) \<close>
       using Sup_non_neg  \<open>Sup ({\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0}) 
         = max (Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1}) (Sup {0})\<close> 
       by auto           
     ultimately have f2: \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> | x. True} = Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
       using \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel> |x. True} = Sup ({\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} \<union> {0})\<close> by linarith
     have \<open>(SUP x. \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>) = Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> = 1}\<close>
       using f1 f2 by linarith
     hence \<open>(SUP x. \<parallel>f *\<^sub>v x\<parallel> / \<parallel>x\<parallel>) = Sup {\<parallel>f *\<^sub>v x\<parallel> | x. \<parallel>x\<parallel> < 1 }\<close>
       by (simp add: \<open>Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> = 1} = Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> < 1}\<close>)        
     thus ?thesis apply transfer by (simp add: onorm_def) 
   qed      
 qed
 
 lemma onorm_r:
   includes notation_norm
   assumes \<open>r > 0\<close>
   shows \<open>\<parallel>f\<parallel> = Sup ((\<lambda>x. \<parallel>f *\<^sub>v x\<parallel>) ` (ball 0 r)) / r\<close>
   text \<open>
   Explanation: The norm of \<^term>\<open>f\<close> is \<^term>\<open>1/r\<close> of the supremum of the norm of \<^term>\<open>f *\<^sub>v x\<close> for
   \<^term>\<open>x\<close> in the ball of radius \<^term>\<open>r\<close> centered at the origin.
 \<close>
 proof-
   have \<open>\<parallel>f\<parallel> = Sup {\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> < 1}\<close>
     using onorm_open_ball by blast
   moreover have \<open>{\<parallel>f *\<^sub>v x\<parallel> |x. \<parallel>x\<parallel> < 1} = (\<lambda>x. \<parallel>f *\<^sub>v x\<parallel>) ` (ball 0 1)\<close>
     unfolding ball_def by auto
   ultimately have onorm_f: \<open>\<parallel>f\<parallel> = Sup ((\<lambda>x. \<parallel>f *\<^sub>v x\<parallel>) ` (ball 0 1))\<close>
     by simp
   have s2: \<open>x \<in> (\<lambda>t. r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<Longrightarrow> x \<le> r * Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1)\<close> for x
   proof-
     assume \<open>x \<in> (\<lambda>t. r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1\<close>
     hence \<open>\<exists> t. x = r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel> \<and> \<parallel>t\<parallel> < 1\<close>
       by auto
     then obtain t where \<open>x = r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>\<close> and \<open>\<parallel>t\<parallel> < 1\<close>
       by blast
     define y where \<open>y = x /\<^sub>R r\<close>
     have \<open>x = r * (inverse r * x)\<close>
       using \<open>x = r *\<^sub>R norm (f t)\<close> by auto
     hence \<open>x - (r * (inverse r * x)) \<le> 0\<close>
       by linarith
     hence \<open>x \<le> r * (x /\<^sub>R r)\<close>
       by auto
     have \<open>y \<in> (\<lambda>k. \<parallel>f *\<^sub>v k\<parallel>) ` ball 0 1\<close>
       unfolding y_def by (smt \<open>x \<in> (\<lambda>t. r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1\<close> assms image_iff 
           inverse_inverse_eq pos_le_divideR_eq positive_imp_inverse_positive) 
     moreover have \<open>x \<le> r * y\<close>          
       using \<open>x \<le> r * (x /\<^sub>R r)\<close> y_def by blast
     ultimately have y_norm_f: \<open>y \<in> (\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<and> x \<le> r * y\<close>
       by blast
     have \<open>(\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<noteq> {}\<close>
       by simp        
     moreover have \<open>bdd_above ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1)\<close>
       by (simp add: bounded_linear_image blinfun.bounded_linear_right bounded_imp_bdd_above 
           bounded_norm_comp) 
     moreover have \<open>\<exists> y. y \<in> (\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<and> x \<le> r * y\<close>
       using y_norm_f by blast
     ultimately show ?thesis
       by (smt \<open>0 < r\<close> cSup_upper ordered_comm_semiring_class.comm_mult_left_mono) 
   qed
   have s3: \<open>(\<And>x. x \<in> (\<lambda>t. r * \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<Longrightarrow> x \<le> y) \<Longrightarrow>
          r * Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1) \<le> y\<close> for y
   proof-
     assume \<open>\<And>x. x \<in> (\<lambda>t. r * \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<Longrightarrow> x \<le> y\<close> 
     have x_leq: \<open>x \<in> (\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<Longrightarrow> x \<le> y / r\<close> for x
     proof-
       assume \<open>x \<in> (\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1\<close>
       then obtain t where \<open>t \<in> ball (0::'a) 1\<close> and \<open>x = \<parallel>f *\<^sub>v t\<parallel>\<close>
         by auto
       define x' where \<open>x' = r *\<^sub>R x\<close>
       have \<open>x' = r * \<parallel>f *\<^sub>v t\<parallel>\<close>
         by (simp add: \<open>x = \<parallel>f *\<^sub>v t\<parallel>\<close> x'_def)
       hence \<open>x' \<in> (\<lambda>t. r * \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1\<close>
         using \<open>t \<in> ball (0::'a) 1\<close> by auto
       hence \<open>x' \<le> y\<close>
         using \<open>\<And>x. x \<in> (\<lambda>t. r * \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<Longrightarrow> x \<le> y\<close> by blast        
       thus \<open>x \<le> y / r\<close>
         unfolding x'_def using \<open>r > 0\<close> by (simp add: mult.commute pos_le_divide_eq) 
     qed
     have \<open>(\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1 \<noteq> {}\<close>
       by simp        
     moreover have \<open>bdd_above ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1)\<close>
       by (simp add: bounded_linear_image blinfun.bounded_linear_right bounded_imp_bdd_above 
           bounded_norm_comp) 
     ultimately have \<open>Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1) \<le> y/r\<close>
       using x_leq by (simp add: \<open>bdd_above ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 1)\<close> cSup_least) 
     thus ?thesis using \<open>r > 0\<close>
       by (smt divide_strict_right_mono nonzero_mult_div_cancel_left)  
   qed
   have norm_scaleR: \<open>norm \<circ> ((*\<^sub>R) r) = ((*\<^sub>R) \<bar>r\<bar>) \<circ> (norm::'a \<Rightarrow> real)\<close>
     by auto
   have f_x1: \<open>f (r *\<^sub>R x) = r *\<^sub>R f x\<close> for x
     by (simp add: blinfun.scaleR_right)    
   have \<open>ball (0::'a) r = ((*\<^sub>R) r) ` (ball 0 1)\<close>
     by (smt assms ball_scale nonzero_mult_div_cancel_left right_inverse_eq scale_zero_right)
   hence \<open>Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 r)) = Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` (((*\<^sub>R) r) ` (ball 0 1)))\<close>
     by simp
   also have \<open>\<dots> = Sup (((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) \<circ> ((*\<^sub>R) r)) ` (ball 0 1))\<close>
     using Sup.SUP_image by auto
   also have \<open>\<dots> = Sup ((\<lambda>t. \<parallel>f *\<^sub>v (r *\<^sub>R t)\<parallel>) ` (ball 0 1))\<close>
     using f_x1 by (simp add: comp_assoc) 
   also have \<open>\<dots> = Sup ((\<lambda>t. \<bar>r\<bar> *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 1))\<close>
     using norm_scaleR f_x1 by auto 
   also have \<open>\<dots> = Sup ((\<lambda>t. r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 1))\<close>
     using \<open>r > 0\<close> by auto
   also have \<open>\<dots> = r * Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` (ball 0 1))\<close>
     apply (rule cSup_eq_non_empty) apply simp using s2 apply auto using s3 by auto
   also have \<open>\<dots> = r * \<parallel>f\<parallel>\<close>
     using onorm_f by auto
   finally have \<open>Sup ((\<lambda>t. \<parallel>f *\<^sub>v t\<parallel>) ` ball 0 r) = r * \<parallel>f\<parallel>\<close>
     by blast    
   thus \<open>\<parallel>f\<parallel> = Sup ((\<lambda>x. \<parallel>f *\<^sub>v x\<parallel>) ` (ball 0 r)) / r\<close> using \<open>r > 0\<close> by simp
 qed
 
 text\<open>Pointwise convergence\<close>
 definition pointwise_convergent_to :: 
   \<open>( nat \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) ) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool\<close> 
   (\<open>((_)/ \<midarrow>pointwise\<rightarrow> (_))\<close> [60, 60] 60) where
   \<open>pointwise_convergent_to x l = (\<forall> t::'a. (\<lambda> n. (x n) t) \<longlonglongrightarrow> l t)\<close>
 
 lemma linear_limit_linear:
   fixes f :: \<open>_ \<Rightarrow> ('a::real_vector \<Rightarrow> 'b::real_normed_vector)\<close>
   assumes  \<open>\<And>n. linear (f n)\<close> and \<open>f \<midarrow>pointwise\<rightarrow> F\<close>
   shows \<open>linear F\<close>
   text\<open>
   Explanation: If a family of linear operators converges pointwise, then the limit is also a linear
   operator.
 \<close>
 proof
   show "F (x + y) = F x + F y" for x y
   proof-
     have "\<forall>a. F a = lim (\<lambda>n. f n a)"
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def by (metis (full_types) limI)
     moreover have "\<forall>f b c g. (lim (\<lambda>n. g n + f n) = (b::'b) + c \<or> \<not> f \<longlonglongrightarrow> c) \<or> \<not> g \<longlonglongrightarrow> b"
       by (metis (no_types) limI tendsto_add)
     moreover have "\<And>a. (\<lambda>n. f n a) \<longlonglongrightarrow> F a"
       using assms(2) pointwise_convergent_to_def by force
     ultimately have 
       lim_sum: \<open>lim (\<lambda> n. (f n) x + (f n) y) = lim (\<lambda> n. (f n) x) + lim (\<lambda> n. (f n) y)\<close>
       by metis
     have \<open>(f n) (x + y) = (f n) x + (f n) y\<close> for n
       using \<open>\<And> n.  linear (f n)\<close> unfolding linear_def using Real_Vector_Spaces.linear_iff assms(1) 
       by auto
     hence \<open>lim (\<lambda> n. (f n) (x + y)) = lim (\<lambda> n. (f n) x + (f n) y)\<close>
       by simp
     hence \<open>lim (\<lambda> n. (f n) (x + y)) = lim (\<lambda> n. (f n) x) + lim (\<lambda> n. (f n) y)\<close>
       using lim_sum by simp
     moreover have \<open>(\<lambda> n. (f n) (x + y)) \<longlonglongrightarrow> F (x + y)\<close>
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def by blast
     moreover have \<open>(\<lambda> n. (f n) x) \<longlonglongrightarrow> F x\<close>
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def by blast
     moreover have \<open>(\<lambda> n. (f n) y) \<longlonglongrightarrow> F y\<close>
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def by blast
     ultimately show ?thesis
       by (metis limI) 
   qed
   show "F (r *\<^sub>R x) = r *\<^sub>R F x" for r and x
   proof-
     have \<open>(f n) (r *\<^sub>R x) = r *\<^sub>R (f n) x\<close> for n
       using  \<open>\<And> n.  linear (f n)\<close> 
       by (simp add: Real_Vector_Spaces.linear_def real_vector.linear_scale)
     hence \<open>lim (\<lambda> n. (f n) (r *\<^sub>R x)) = lim (\<lambda> n. r *\<^sub>R (f n) x)\<close>
       by simp
     have \<open>convergent (\<lambda> n. (f n) x)\<close>
       by (metis assms(2) convergentI pointwise_convergent_to_def)
     moreover have \<open>isCont (\<lambda> t::'b. r *\<^sub>R t) tt\<close> for tt
       by (simp add: bounded_linear_scaleR_right)
     ultimately have \<open>lim (\<lambda> n. r *\<^sub>R ((f n) x)) =  r *\<^sub>R lim (\<lambda> n. (f n) x)\<close>
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def 
       by (metis (mono_tags) isCont_tendsto_compose limI)
     hence \<open>lim (\<lambda> n.  (f n) (r *\<^sub>R x)) = r *\<^sub>R lim (\<lambda> n. (f n) x)\<close> 
       using \<open>lim (\<lambda> n. (f n) (r *\<^sub>R x)) = lim (\<lambda> n. r *\<^sub>R (f n) x)\<close> by simp
     moreover have \<open>(\<lambda> n. (f n) x) \<longlonglongrightarrow> F x\<close>
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def by blast
     moreover have \<open>(\<lambda> n.  (f n) (r *\<^sub>R x)) \<longlonglongrightarrow> F (r *\<^sub>R x)\<close>
       using \<open>f \<midarrow>pointwise\<rightarrow> F\<close> unfolding pointwise_convergent_to_def by blast
     ultimately show ?thesis
       by (metis limI) 
   qed
 qed
 
 
 lemma non_Cauchy_unbounded:
   fixes a ::\<open>_ \<Rightarrow> real\<close> 
   assumes \<open>\<And>n. a n \<ge> 0\<close> and \<open>e > 0\<close> 
     and \<open>\<forall>M. \<exists>m. \<exists>n. m \<ge> M \<and> n \<ge> M \<and> m > n \<and> sum a {Suc n..m} \<ge> e\<close>
   shows \<open>(\<lambda>n. (sum a  {0..n})) \<longlonglongrightarrow> \<infinity>\<close>
   text\<open>
   Explanation: If the sequence of partial sums of nonnegative terms is not Cauchy, then it converges
   to infinite.
 \<close>
 proof-
   define S::"ereal set" where \<open>S = range (\<lambda>n. sum a  {0..n})\<close>
   have \<open>\<exists>s\<in>S.  k*e \<le> s\<close> for k::nat
   proof(induction k)
     case 0
     from \<open>\<forall>M. \<exists>m. \<exists>n. m \<ge> M \<and> n \<ge> M \<and> m > n \<and> sum a {Suc n..m} \<ge> e\<close>
     obtain m n where \<open>m \<ge> 0\<close> and \<open>n \<ge> 0\<close> and \<open>m > n\<close> and \<open>sum a {Suc n..m} \<ge> e\<close> by blast
     have \<open>n < Suc n\<close>
       by simp
     hence \<open>{0..n} \<union> {Suc n..m} = {0..m}\<close>
       using Set_Interval.ivl_disj_un(7) \<open>n < m\<close> by auto
     moreover have \<open>finite {0..n}\<close>
       by simp
     moreover have \<open>finite {Suc n..m}\<close>
       by simp
     moreover have \<open>{0..n} \<inter> {Suc n..m} = {}\<close>
       by simp
     ultimately have \<open>sum a {0..n} + sum a {Suc n..m} = sum a {0..m}\<close>
       by (metis sum.union_disjoint) 
     moreover have \<open>sum a {Suc n..m} > 0\<close>
       using \<open>e > 0\<close> \<open>sum a {Suc n..m} \<ge> e\<close> by linarith
     moreover have \<open>sum a {0..n} \<ge> 0\<close>
       by (simp add: assms(1) sum_nonneg)
     ultimately have \<open>sum a {0..m} > 0\<close>
       by linarith      
     moreover have \<open>sum a {0..m} \<in> S\<close>
       unfolding S_def by blast
     ultimately have \<open>\<exists>s\<in>S. 0 \<le> s\<close>
       using ereal_less_eq(5) by fastforce    
     thus ?case
       by (simp add: zero_ereal_def)  
   next
     case (Suc k)
     assume \<open>\<exists>s\<in>S. k*e \<le> s\<close>
     then obtain s where \<open>s\<in>S\<close> and \<open>ereal (k * e) \<le> s\<close>
       by blast
     have \<open>\<exists>N. s = sum a {0..N}\<close>
       using \<open>s\<in>S\<close> unfolding S_def by blast
     then obtain N where \<open>s = sum a {0..N}\<close>
       by blast
     from \<open>\<forall>M. \<exists>m. \<exists>n. m \<ge> M \<and> n \<ge> M \<and> m > n \<and> sum a {Suc n..m} \<ge> e\<close>
     obtain m n where \<open>m \<ge> Suc N\<close> and \<open>n \<ge> Suc N\<close> and \<open>m > n\<close> and \<open>sum a {Suc n..m} \<ge> e\<close>
       by blast
     have \<open>finite {Suc N..n}\<close>
       by simp
     moreover have \<open>finite {Suc n..m}\<close>
       by simp
     moreover have \<open>{Suc N..n} \<union> {Suc n..m} = {Suc N..m}\<close>
       using Set_Interval.ivl_disj_un
       by (smt \<open>Suc N \<le> n\<close> \<open>n < m\<close> atLeastSucAtMost_greaterThanAtMost less_imp_le_nat)
     moreover have \<open>{} = {Suc N..n} \<inter> {Suc n..m}\<close>
       by simp
     ultimately have \<open>sum a {Suc N..m} = sum a {Suc N..n} + sum a {Suc n..m}\<close>
       by (metis sum.union_disjoint)
     moreover have \<open>sum a {Suc N..n} \<ge> 0\<close>
       using  \<open>\<And>n. a n \<ge> 0\<close> by (simp add: sum_nonneg) 
     ultimately have \<open>sum a {Suc N..m} \<ge> e\<close>
       using \<open>e \<le> sum a {Suc n..m}\<close> by linarith
     have \<open>finite {0..N}\<close>
       by simp
     have \<open>finite {Suc N..m}\<close>
       by simp
     moreover have \<open>{0..N} \<union> {Suc N..m} = {0..m}\<close>
       using Set_Interval.ivl_disj_un(7) \<open>Suc N \<le> m\<close> by auto          
     moreover have \<open>{0..N} \<inter> {Suc N..m} = {}\<close>
       by simp
     ultimately have \<open>sum a {0..N} + sum a {Suc N..m} =  sum a {0..m}\<close> 
       by (metis \<open>finite {0..N}\<close> sum.union_disjoint)    
     hence \<open>e + k * e \<le> sum a {0..m}\<close>
       using \<open>ereal (real k * e) \<le> s\<close> \<open>s = ereal (sum a {0..N})\<close> \<open>e \<le> sum a {Suc N..m}\<close> by auto 
     moreover have \<open>e + k * e = (Suc k) * e\<close>
       by (simp add: semiring_normalization_rules(3))
     ultimately have \<open>(Suc k) * e \<le> sum a {0..m}\<close>
       by linarith
     hence \<open>ereal ((Suc k) * e) \<le> sum a {0..m}\<close>
       by auto
     moreover have \<open>sum a {0..m}\<in>S\<close>
       unfolding S_def by blast
     ultimately show ?case by blast
   qed
   hence \<open>\<exists>s\<in>S. (real n) \<le> s\<close> for n
     by (meson assms(2) ereal_le_le ex_less_of_nat_mult less_le_not_le)
   hence  \<open>Sup S = \<infinity>\<close>
     using Sup_le_iff Sup_subset_mono dual_order.strict_trans1 leD less_PInf_Ex_of_nat subsetI 
     by metis
   hence Sup: \<open>Sup ((range (\<lambda> n. (sum a  {0..n})))::ereal set) = \<infinity>\<close> using S_def 
     by blast
   have \<open>incseq (\<lambda>n. (sum a  {..<n}))\<close>
     using \<open>\<And>n. a n \<ge> 0\<close> using Extended_Real.incseq_sumI by auto
   hence \<open>incseq (\<lambda>n. (sum a  {..< Suc n}))\<close>
     by (meson incseq_Suc_iff)
   hence \<open>incseq (\<lambda>n. (sum a  {0..n})::ereal)\<close>
     using incseq_ereal by (simp add: atLeast0AtMost lessThan_Suc_atMost) 
   hence \<open>(\<lambda>n. sum a  {0..n}) \<longlonglongrightarrow> Sup (range (\<lambda>n. (sum a  {0..n})::ereal))\<close>
     using LIMSEQ_SUP by auto
   thus ?thesis using Sup PInfty_neq_ereal by auto 
 qed
 
 lemma sum_Cauchy_positive:
   fixes a ::\<open>_ \<Rightarrow> real\<close>
   assumes \<open>\<And>n. a n \<ge> 0\<close> and \<open>\<exists>K. \<forall>n. (sum a  {0..n}) \<le> K\<close>
   shows \<open>Cauchy (\<lambda>n. sum a {0..n})\<close>
   text\<open>
   Explanation: If a series of nonnegative reals is bounded, then the series is 
   Cauchy.
 \<close>
 proof (unfold Cauchy_altdef2, rule, rule)
   fix e::real
   assume \<open>e>0\<close>       
   have \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {Suc n..m} < e\<close>
   proof(rule classical)
     assume \<open>\<not>(\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {Suc n..m} < e)\<close>
     hence \<open>\<forall>M. \<exists>m. \<exists>n. m \<ge> M \<and> n \<ge> M \<and> m > n \<and> \<not>(sum a {Suc n..m} < e)\<close>
       by blast
     hence \<open>\<forall>M. \<exists>m. \<exists>n. m \<ge> M \<and> n \<ge> M \<and> m > n \<and> sum a {Suc n..m} \<ge> e\<close>
       by fastforce
     hence \<open>(\<lambda>n. (sum a  {0..n}) ) \<longlonglongrightarrow> \<infinity>\<close>
       using non_Cauchy_unbounded \<open>0 < e\<close> assms(1) by blast
     from  \<open>\<exists>K. \<forall>n. sum a  {0..n} \<le> K\<close>
     obtain K where  \<open>\<forall>n. sum a {0..n} \<le> K\<close>
       by blast
     from  \<open>(\<lambda>n. sum a {0..n})  \<longlonglongrightarrow> \<infinity>\<close>
     have \<open>\<forall>B. \<exists>N. \<forall>n\<ge>N. (\<lambda> n. (sum a  {0..n}) ) n \<ge> B\<close>
       using Lim_PInfty by simp
     hence  \<open>\<exists>n. (sum a {0..n}) \<ge> K+1\<close>
       using ereal_less_eq(3) by blast        
     thus ?thesis using  \<open>\<forall>n. (sum a  {0..n}) \<le> K\<close> by smt       
   qed
   have \<open>sum a {Suc n..m} = sum a {0..m} - sum a {0..n}\<close>
     if "m > n" for m n
     apply (simp add: that atLeast0AtMost) using sum_up_index_split 
     by (smt less_imp_add_positive that)
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {0..m} - sum a {0..n} < e\<close>
     using \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {Suc n..m} < e\<close> by smt     
   from \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {0..m} - sum a {0..n} < e\<close>
   obtain M where \<open>\<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {0..m} - sum a {0..n} < e\<close>
     by blast
   moreover have \<open>m > n \<Longrightarrow> sum a {0..m} \<ge> sum a {0..n}\<close> for m n
     using \<open>\<And> n. a n \<ge> 0\<close> by (simp add: sum_mono2)
   ultimately have \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> \<bar>sum a {0..m} - sum a {0..n}\<bar> < e\<close>
     by auto
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m \<ge> n \<longrightarrow> \<bar>sum a {0..m} - sum a {0..n}\<bar> < e\<close>
     by (metis \<open>0 < e\<close> abs_zero cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq' 
         less_irrefl_nat linorder_neqE_nat zero_less_diff)      
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. \<bar>sum a {0..m} - sum a {0..n}\<bar> < e\<close>
     by (metis abs_minus_commute nat_le_linear)
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (sum a {0..m}) (sum a {0..n}) < e\<close>
     by (simp add: dist_real_def)      
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (sum a {0..m}) (sum a {0..n}) < e\<close> by blast
   thus \<open>\<exists>N. \<forall>n\<ge>N. dist (sum a {0..n}) (sum a {0..N}) < e\<close> by auto
 qed
 
 lemma convergent_series_Cauchy:
   fixes a::\<open>nat \<Rightarrow> real\<close> and \<phi>::\<open>nat \<Rightarrow> 'a::metric_space\<close>
   assumes \<open>\<exists>M. \<forall>n. sum a {0..n} \<le> M\<close> and \<open>\<And>n. dist (\<phi> (Suc n)) (\<phi> n) \<le> a n\<close>
   shows \<open>Cauchy \<phi>\<close>
   text\<open>
   Explanation: Let \<^term>\<open>a\<close> be a real-valued sequence and let \<^term>\<open>\<phi>\<close> be sequence in a metric space.
   If the partial sums of \<^term>\<open>a\<close> are uniformly bounded and the distance between consecutive terms of \<^term>\<open>\<phi>\<close>
   are bounded by the sequence \<^term>\<open>a\<close>, then \<^term>\<open>\<phi>\<close> is Cauchy.\<close>
 proof (unfold Cauchy_altdef2, rule, rule)
   fix e::real
   assume \<open>e > 0\<close>
   have \<open>\<And>k. a k \<ge> 0\<close>
     using \<open>\<And>n. dist (\<phi> (Suc n)) (\<phi> n) \<le> a n\<close> dual_order.trans zero_le_dist by blast
   hence \<open>Cauchy (\<lambda>k. sum a {0..k})\<close>
     using  \<open>\<exists>M. \<forall>n. sum a {0..n} \<le> M\<close> sum_Cauchy_positive by blast
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (sum a {0..m}) (sum a {0..n}) < e\<close>
     unfolding Cauchy_def using \<open>e > 0\<close> by blast
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> dist (sum a {0..m}) (sum a {0..n}) < e\<close>
     by blast
   have \<open>dist (sum a {0..m}) (sum a {0..n}) = sum a {Suc n..m}\<close> if \<open>n<m\<close> for m n
   proof -
     have \<open>n < Suc n\<close>
       by simp
     have \<open>finite {0..n}\<close>
       by simp
     moreover have \<open>finite {Suc n..m}\<close>
       by simp
     moreover have \<open>{0..n} \<union> {Suc n..m} = {0..m}\<close>
       using \<open>n < Suc n\<close> \<open>n < m\<close> by auto
     moreover have  \<open>{0..n} \<inter> {Suc n..m} = {}\<close>
       by simp
     ultimately have sum_plus: \<open>(sum a {0..n}) + sum a {Suc n..m} = (sum a {0..m})\<close>
       by (metis sum.union_disjoint)
     have \<open>dist (sum a {0..m}) (sum a {0..n}) = \<bar>(sum a {0..m}) - (sum a {0..n})\<bar>\<close>
       using dist_real_def by blast
     moreover have \<open>(sum a {0..m}) - (sum a {0..n}) = sum a {Suc n..m}\<close>
       using sum_plus by linarith 
     ultimately show ?thesis
       by (simp add: \<open>\<And>k. 0 \<le> a k\<close> sum_nonneg)
   qed
   hence sum_a: \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {Suc n..m} < e\<close>
     by (metis \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (sum a {0..m}) (sum a {0..n}) < e\<close>) 
   obtain M where \<open>\<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {Suc n..m} < e\<close>
     using sum_a \<open>e > 0\<close> by blast
   hence  \<open>\<forall>m. \<forall>n. Suc m \<ge> Suc M \<and> Suc n \<ge> Suc M \<and> Suc m > Suc n \<longrightarrow> sum a {Suc n..Suc m - 1} < e\<close>
     by simp
   hence  \<open>\<forall>m\<ge>1. \<forall>n\<ge>1. m \<ge> Suc M \<and> n \<ge> Suc M \<and> m > n \<longrightarrow> sum a {n..m - 1} < e\<close>
     by (metis Suc_le_D)
   hence sum_a2: \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {n..m-1} < e\<close>
     by (meson add_leE)
   have \<open>dist (\<phi> (n+p+1)) (\<phi> n) \<le> sum a {n..n+p}\<close> for p n :: nat
   proof(induction p)
     case 0 thus ?case  by (simp add: assms(2))
   next
     case (Suc p) thus ?case
       by (smt Suc_eq_plus1 add_Suc_right add_less_same_cancel1 assms(2) dist_self dist_triangle2 
           gr_implies_not0 sum.cl_ivl_Suc)  
   qed
   hence \<open>m > n \<Longrightarrow> dist (\<phi> m) (\<phi> n) \<le> sum a {n..m-1}\<close> for m n :: nat
     by (metis Suc_eq_plus1 Suc_le_D diff_Suc_1  gr0_implies_Suc less_eq_Suc_le less_imp_Suc_add 
         zero_less_Suc)
   hence \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> dist (\<phi> m) (\<phi> n) < e\<close> 
     using sum_a2 \<open>e > 0\<close> by smt
   thus "\<exists>N. \<forall>n\<ge>N. dist (\<phi> n) (\<phi> N) < e"
     using \<open>0 < e\<close> by fastforce
 qed
 
 unbundle notation_blinfun_apply
 
 unbundle no_notation_norm
 
 end
diff --git a/thys/Differential_Dynamic_Logic/Differential_Axioms.thy b/thys/Differential_Dynamic_Logic/Differential_Axioms.thy
--- a/thys/Differential_Dynamic_Logic/Differential_Axioms.thy
+++ b/thys/Differential_Dynamic_Logic/Differential_Axioms.thy
@@ -1,2648 +1,2648 @@
 theory "Differential_Axioms" 
 imports
   Ordinary_Differential_Equations.ODE_Analysis
   "Ids"
   "Lib"
   "Syntax"     
   "Denotational_Semantics"
   "Frechet_Correctness"
   "Axioms"
   "Coincidence"
 begin context ids begin
 section \<open>Differential Axioms\<close>
 text \<open>Differential axioms fall into two categories:
 Axioms for computing the derivatives of terms and axioms for proving properties of ODEs.
 The derivative axioms are all corollaries of the frechet correctness theorem. The ODE
 axioms are more involved, often requiring extensive use of the ODE libraries.\<close> 
 
 subsection \<open>Derivative Axioms\<close>
 definition diff_const_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_const_axiom \<equiv> Equals (Differential ($f fid1 empty)) (Const 0)"
 
 definition diff_var_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_var_axiom \<equiv> Equals (Differential (Var vid1)) (DiffVar vid1)"
   
 definition state_fun ::"'sf \<Rightarrow> ('sf, 'sz) trm"
 where [axiom_defs]:"state_fun f = ($f f (\<lambda>i. Var i))"
   
 definition diff_plus_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_plus_axiom \<equiv> Equals (Differential (Plus (state_fun fid1) (state_fun fid2))) 
     (Plus (Differential (state_fun fid1)) (Differential (state_fun fid2)))"
 
 definition diff_times_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_times_axiom \<equiv> Equals (Differential (Times (state_fun fid1) (state_fun fid2))) 
     (Plus (Times (Differential (state_fun fid1)) (state_fun fid2)) 
           (Times (state_fun fid1) (Differential (state_fun fid2))))"
 
 \<comment> \<open>\<open>[y=g(x)][y'=1](f(g(x))' = f(y)')\<close>\<close>
 definition diff_chain_axiom::"('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_chain_axiom \<equiv> [[Assign vid2 (f1 fid2 vid1)]]([[DiffAssign vid2 (Const 1)]] 
   (Equals (Differential ($f fid1 (singleton (f1 fid2 vid1)))) (Times (Differential (f1 fid1 vid2)) (Differential (f1 fid2 vid1)))))"
 
 subsection \<open>ODE Axioms\<close>
 definition DWaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DWaxiom = ([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid1))"
 
 definition DWaxiom' :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DWaxiom' = ([[EvolveODE (OSing vid1 (Function fid1 (singleton (Var vid1)))) (Prop vid2 (singleton (Var vid1)))]](Prop vid2 (singleton (Var vid1))))"
   
 definition DCaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DCaxiom = (
 ([[EvolveODE (OVar vid1) (Predicational pid1)]]Predicational pid3) \<rightarrow>
 (([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid2)) 
   \<leftrightarrow>  
    ([[EvolveODE (OVar vid1) (And (Predicational pid1) (Predicational pid3))]]Predicational pid2)))"
 
 definition DEaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DEaxiom = 
 (([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]] (P pid1))
 \<leftrightarrow>
  ([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]]
     [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
   
 definition DSaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DSaxiom = 
 (([[EvolveODE (OSing vid1 (f0 fid1)) (p1 vid2 vid1)]]p1 vid3 vid1)
 \<leftrightarrow> 
 (Forall vid2 
  (Implies (Geq (Var vid2) (Const 0)) 
  (Implies 
    (Forall vid3 
      (Implies (And (Geq (Var vid3) (Const 0)) (Geq (Var vid2) (Var vid3)))
         (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))))
    ([[Assign vid1 (Plus (Var vid1) (Times (f0 fid1) (Var vid2)))]]p1 vid3 vid1)))))"
 
 \<comment> \<open>\<open>(Q \<rightarrow> [c&Q](f(x)' \<ge> g(x)'))\<close>\<close> 
 \<comment> \<open>\<open>\<rightarrow>\<close>\<close>
 \<comment> \<open>\<open>([c&Q](f(x) \<ge> g(x))) --> (Q \<rightarrow> (f(x) \<ge> g(x))\<close>\<close> 
 definition DIGeqaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DIGeqaxiom = 
 Implies 
   (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
   (Implies
      (Implies(Prop vid1 empty) (Geq (f1 fid1 vid1) (f1 fid2 vid1)))
      ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (f1 fid1 vid1) (f1 fid2 vid1))))"
 
 
 \<comment> \<open>\<open>g(x) > h(x) \<rightarrow> [x'=f(x), c & p(x)](g(x)' \<ge> h(x)') \<rightarrow> [x'=f(x), c & p(x)]g(x) > h(x)\<close>\<close> 
 
 \<comment> \<open>\<open>(Q \<rightarrow> [c&Q](f(x)' \<ge> g(x)'))\<close>\<close> 
 \<comment> \<open>\<open>\<rightarrow>\<close>\<close>
 \<comment> \<open>\<open>([c&Q](f(x) > g(x))) <-> (Q \<rightarrow> (f(x) > g(x))\<close>\<close>
 definition DIGraxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DIGraxiom = 
 Implies 
   (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
   (Implies
      (Implies(Prop vid1 empty) (Greater (f1 fid1 vid1) (f1 fid2 vid1)))
      ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Greater (f1 fid1 vid1) (f1 fid2 vid1))))"
 
 \<comment> \<open>\<open>[{1' = 1(1) & 1(1)}]2(1) <->\<close>\<close>
 \<comment> \<open>\<open>\<exists>2. [{1'=1(1), 2' = 2(1)*2 + 3(1) & 1(1)}]2(1)*)\<close>\<close>
 definition DGaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DGaxiom = (([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid1 vid1)]]p1 vid2 vid1) \<leftrightarrow> 
   (Exists vid2 
     ([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (Var vid2)) (f1 fid3 vid1)))) (p1 vid1 vid1)]]
        p1 vid2 vid1)))"
 
 subsection \<open>Proofs for Derivative Axioms\<close>
 lemma constant_deriv_inner:
  assumes interp:"\<forall>x i. (Functions I i has_derivative FunctionFrechet I i x) (at x)"
  shows "FunctionFrechet I id1 (vec_lambda (\<lambda>i. sterm_sem I (empty i) (fst \<nu>))) (vec_lambda(\<lambda>i. frechet I (empty i) (fst \<nu>) (snd \<nu>)))= 0"
 proof -
   have empty_zero:"(vec_lambda(\<lambda>i. frechet I (empty i) (fst \<nu>) (snd \<nu>))) = 0"
     using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
     apply auto
     apply(rule vec_extensionality)
     using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
     by (simp add: local.empty_def)
   let ?x = "(vec_lambda (\<lambda>i. sterm_sem I (empty i) (fst \<nu>)))"
   from interp
   have has_deriv:"(Functions I id1 has_derivative FunctionFrechet I id1 ?x) (at ?x)"
     by auto
   then have f_linear:"linear (FunctionFrechet I id1 ?x)"
     using Deriv.has_derivative_linear by auto
   then show ?thesis using empty_zero f_linear linear_0 by (auto)
 qed
 
 lemma constant_deriv_zero:"is_interp I \<Longrightarrow> directional_derivative I ($f id1 empty) \<nu> = 0"
   apply(simp only: is_interp_def directional_derivative_def frechet.simps frechet_correctness)
   apply(rule constant_deriv_inner)
   apply(auto)
 done
 
 theorem diff_const_axiom_valid: "valid diff_const_axiom"
   apply(simp only: valid_def diff_const_axiom_def equals_sem)
   apply(rule allI | rule impI)+
   apply(simp only: dterm_sem.simps constant_deriv_zero sterm_sem.simps)
 done
 
 theorem diff_var_axiom_valid: "valid diff_var_axiom"
   apply(auto simp add: diff_var_axiom_def valid_def directional_derivative_def)
   by (metis inner_prod_eq)
   
 theorem diff_plus_axiom_valid: "valid diff_plus_axiom"
   apply(auto simp add: diff_plus_axiom_def valid_def)
   subgoal for I a b
     using frechet_correctness[of I "(Plus (state_fun fid1) (state_fun fid2))" b] 
     unfolding state_fun_def apply (auto intro: dfree.intros)
     unfolding directional_derivative_def by auto
  done
   
 theorem diff_times_axiom_valid: "valid diff_times_axiom"
   apply(auto simp add: diff_times_axiom_def valid_def)
   subgoal for I a b
     using frechet_correctness[of I "(Times (state_fun fid1) (state_fun fid2))" b] 
     unfolding state_fun_def apply (auto intro: dfree.intros)
     unfolding directional_derivative_def by auto
   done
   
 subsection \<open>Proofs for ODE Axioms\<close>
  
 lemma DW_valid:"valid DWaxiom"
   apply(unfold DWaxiom_def valid_def Let_def impl_sem )
   apply(safe)
   apply(auto simp only: fml_sem.simps prog_sem.simps box_sem)
   subgoal for I aa ba ab bb sol t using mk_v_agree[of I "(OVar vid1)" "(ab,bb)" "sol t"]
     Vagree_univ[of "aa" "ba" "sol t" "ODEs I vid1 (sol t)"] solves_ode_domainD
     by (fastforce)
   done
 
 lemma DE_lemma:
   fixes ab bb::"'sz simple_state"
   and sol::"real \<Rightarrow> 'sz simple_state"
   and I::"('sf, 'sc, 'sz) interp"
   shows
   "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
    = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
 proof
   have set_eq:" {Inl vid1, Inr vid1} = {Inr vid1, Inl vid1}" by auto
   have agree:"Vagree (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) (mk_xode I (OSing vid1 (f1 fid1 vid1)) (sol t))
       {Inl vid1, Inr vid1}" 
     using mk_v_agree[of I "(OSing vid1 (f1 fid1 vid1))" "(ab, bb)" "(sol t)"] 
     unfolding semBV.simps using set_eq by auto
   have fact:"dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))
           = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1"
     using agree unfolding Vagree_def dterm_sem.simps f1_def mk_xode.simps
   proof -
     assume alls:"(\<forall>i. Inl i \<in> {Inl vid1, Inr vid1} \<longrightarrow>
         fst (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
         fst (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i) \<and>
       (\<forall>i. Inr i \<in> {Inl vid1, Inr vid1} \<longrightarrow>
         snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
         snd (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i)"
     hence atVid'':"snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1 = sterm_sem I ($f fid1 (singleton (trm.Var vid1))) (sol t)" 
       by auto
     have argsEq:"(\<chi> i. dterm_sem I (singleton (trm.Var vid1) i)
           (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)))
           = (\<chi> i.  sterm_sem I (singleton (trm.Var vid1) i) (sol t))"
       using alls f1_def by auto
     thus "Functions I fid1 (\<chi> i. dterm_sem I (singleton (trm.Var vid1) i)
           (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t))) 
         = snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1"
       by (simp only: atVid'' ODE_sem.simps sterm_sem.simps dterm_sem.simps)
   qed
   have eqSnd:"(\<chi> y. if vid1 = y then snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1
         else snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ y) = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
     by (simp add: vec_extensionality)
   have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
         (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
       = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
     using fact by (auto simp only: eqSnd repd.simps fact prod.collapse split: if_split)
   thus "fst (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
           (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
     fst (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
 
     "snd (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
       (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
     snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) " 
     by auto
 qed
 
 lemma DE_valid:"valid DEaxiom"
 proof -
   have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
   have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
     by (simp add: osafe_Sing dfree_Const) 
   have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
     using dsafe dsafe_Fun_simps image_iff
     by (simp add: dfree_Const)
   show "valid DEaxiom"
     apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
      apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem)
    proof -
      fix I::"('sf,'sc,'sz) interp"
        and aa ba ab bb sol 
        and t::real
        and ac bc
      assume "is_interp I"
      assume allw:"\<forall>\<omega>. (\<exists>\<nu> sol t.
                   ((ab, bb), \<omega>) = (\<nu>, mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> (sol t)) \<and>
                   0 \<le> t \<and>
                   (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                    {x. mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
                   (sol 0) = (fst \<nu>) ) \<longrightarrow>
               \<omega> \<in> fml_sem I (P pid1)"
      assume t:"0 \<le> t"
      assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
      assume solve:" (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
          {x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
      assume sol0:" (sol 0) = (fst (ab, bb)) "
      assume rep:"   (ac, bc) =
         repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
          (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))"
      have aaba_sem:"(aa,ba) \<in> fml_sem I (P pid1)" using allw t aaba solve sol0 rep by blast
      have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
           (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
      = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
        using DE_lemma by auto
      show "
         repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
          (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
         \<in> fml_sem I (P pid1)" using aaba aaba_sem truth by (auto)
    next
      fix I::"('sf,'sc,'sz) interp" and  aa ba ab bb sol and t::real
        assume "is_interp I"
        assume all:"\<forall>\<omega>. (\<exists>\<nu> sol t.
                 ((ab, bb), \<omega>) = (\<nu>, mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> (sol t)) \<and>
                 0 \<le> t \<and>
                 (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                  {x. mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
                  (sol 0) = (fst \<nu>) ) \<longrightarrow>
             (\<forall>\<omega>'. \<omega>' = repd \<omega> vid1 (dterm_sem I (f1 fid1 vid1) \<omega>) \<longrightarrow> \<omega>' \<in> fml_sem I (P pid1))"
        hence justW:"(\<exists>\<nu> sol t.
                 ((ab, bb), (aa, ba)) = (\<nu>, mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> (sol t)) \<and>
                 0 \<le> t \<and>
                 (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                  {x. mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
                 (sol 0) = (fst \<nu>)) \<longrightarrow>
             (\<forall>\<omega>'. \<omega>' = repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) \<longrightarrow> \<omega>' \<in> fml_sem I (P pid1))"
          by (rule allE)
        assume t:"0 \<le> t"
        assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
        assume sol:"(sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
         {x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
        assume sol0:" (sol 0) = (fst (ab, bb))"
        have "repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) \<in> fml_sem I (P pid1)"
          using justW t aaba sol sol0 by auto
        hence foo:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))) \<in> fml_sem I (P pid1)"
          using aaba by auto
        hence "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
              = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)" using DE_lemma by auto
        thus "mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t) \<in> fml_sem I (P pid1)" using foo by auto
   qed
 qed
 
 lemma ODE_zero:"\<And>i. Inl i \<notin> BVO ODE \<Longrightarrow> Inr i \<notin> BVO ODE \<Longrightarrow> ODE_sem I ODE \<nu> $ i= 0"
   by(induction ODE, auto)
 
 lemma DE_sys_valid:
   assumes disj:"{Inl vid1, Inr vid1} \<inter> BVO ODE = {}"
   shows "valid (([[EvolveODE (OProd  (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) \<leftrightarrow>
  ([[EvolveODE ((OProd  (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
     [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
 proof -
   have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
   have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
     by (simp add: osafe_Sing dfree_Const) 
   have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
     using dsafe dsafe_Fun_simps image_iff
     by (simp add: dfree_Const)
   show "valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) \<leftrightarrow>
  ([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1)) ODE)) (p1 vid2 vid1)]]
     [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
     apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
     apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem f1_def p1_def P_def expand_singleton)
    proof -
      fix I ::"('sf,'sc,'sz) interp"
        and aa ba ab bb sol 
        and t::real
        and ac bc
      assume good:"is_interp I"
      assume bigAll:"
      \<forall>\<omega>. (\<exists>\<nu> sol t. ((ab, bb), \<omega>) = (\<nu>, mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) ODE) \<nu> (sol t)) \<and>
                     0 \<le> t \<and>
                     (sol solves_ode (\<lambda>_. ODE_sem I (OProd(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) ODE ))) {0..t}
                      {x. Predicates I vid2
                           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                  (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                     sol 0 = fst \<nu>) \<longrightarrow>
           \<omega> \<in> fml_sem I (Pc pid1)"
      let ?my\<omega> = "mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab,bb) (sol t)"
      assume t:"0 \<le> t"
      assume aaba:"(aa, ba) = mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
      assume sol:"(sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
       {x. Predicates I vid2
            (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                   (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
      assume sol0:"sol 0 = fst (ab, bb)"
      assume acbc:"(ac, bc) =
      repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
       (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
         (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
      have bigEx:"(\<exists>\<nu> sol t. ((ab, bb), ?my\<omega>) = (\<nu>, mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> (sol t)) \<and>
                     0 \<le> t \<and>
                     (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                      {x. Predicates I vid2
                           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                  (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                     sol 0 = fst \<nu>)"
        apply(rule exI[where x="(ab, bb)"])
        apply(rule exI[where x="sol"])
        apply(rule exI[where x="t"])
        apply(rule conjI) 
         apply(rule refl)
        apply(rule conjI)
         apply(rule t)
        apply(rule conjI)
         using sol apply blast
        by (rule sol0)
      have bigRes:"?my\<omega> \<in> fml_sem I (Pc pid1)" using bigAll bigEx by blast
      have notin1:"Inl vid1 \<notin> BVO ODE" using disj by auto
      have notin2:"Inr vid1 \<notin> BVO ODE" using disj by auto
      have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
        using ODE_zero notin1 notin2 
        by blast 
      have vec_eq:"(\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t)) =
            (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
        apply(rule vec_extensionality)
        apply simp
        using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
        by(simp add: Vagree_def)
      have sem_eq:"(?my\<omega> \<in> fml_sem I (Pc pid1)) = ((repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
      (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
        (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))) \<in> fml_sem I (Pc pid1))"
        apply(rule coincidence_formula)
          subgoal by simp
         subgoal by (rule Iagree_refl)
        using mk_v_agree[of "I" "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
        unfolding Vagree_def 
        apply simp
        apply(erule conjE)+
        apply(erule allE[where x="vid1"])+
        apply(simp add: ODE_sem)
        using vec_eq by simp
      show  "repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
       (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
         (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))
      \<in> fml_sem I (Pc pid1)"
        using bigRes sem_eq by blast
    next
      fix I::"('sf,'sc,'sz)interp" 
      and aa ba ab bb sol 
      and t::real
      assume good_interp:"is_interp I"
      assume all:"\<forall>\<omega>. (\<exists>\<nu> sol t. ((ab, bb), \<omega>) = (\<nu>, mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> (sol t)) \<and>
                        0 \<le> t \<and>
                        (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                         {x. Predicates I vid2
                              (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                     (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                        sol 0 = fst \<nu>) \<longrightarrow>
              (\<forall>\<omega>'. \<omega>' = repd \<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<omega>) \<longrightarrow> \<omega>' \<in> fml_sem I (Pc pid1))"
       let ?my\<omega> = "mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)" 
       assume t:"0 \<le> t"
       assume aaba:"(aa, ba) = mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
       assume sol:"
         (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
          {x. Predicates I vid2
               (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                     (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
       assume sol0:"sol 0 = fst (ab, bb)"
       have bigEx:"(\<exists>\<nu> sol t. ((ab, bb), ?my\<omega>) = (\<nu>, mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> (sol t)) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                        {x. Predicates I vid2
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                       sol 0 = fst \<nu>)"
         apply(rule exI[where x="(ab, bb)"])
         apply(rule exI[where x=sol])
         apply(rule exI[where x=t])
         apply(rule conjI)
          apply(rule refl)
         apply(rule conjI)
          apply(rule t)
         apply(rule conjI)
          using sol sol0 by(blast)+
       have rep_sem_eq:"repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
                  (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
                    (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))  \<in> fml_sem I (Pc pid1)
          = (repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<in> fml_sem I (Pc pid1))"
         apply(rule coincidence_formula)
           subgoal by simp
          subgoal by (rule Iagree_refl)
         by(simp add: Vagree_def)
       have notin1:"Inl vid1 \<notin> BVO ODE" using disj by auto
       have notin2:"Inr vid1 \<notin> BVO ODE" using disj by auto
       have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
         using ODE_zero notin1 notin2 
         by blast 
       have vec_eq:"
       (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
              (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) =
       (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t))"
         apply(rule vec_extensionality)
         using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
         by (simp add: Vagree_def)
       have sem_eq:
         "(repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<in> fml_sem I (Pc pid1)) 
      = (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) \<in> fml_sem I (Pc pid1)) "
         apply(rule coincidence_formula)
           subgoal by simp
          subgoal by (rule Iagree_refl)
         using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
         unfolding Vagree_def apply simp
         apply(erule conjE)+
         apply(erule allE[where x=vid1])+
         by (simp add: ODE_sem vec_eq)
       have some_sem:"repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
                 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
                   (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) \<in> fml_sem I (Pc pid1)"
         using rep_sem_eq 
         using all bigEx by blast
       have bigImp:"(\<forall>\<omega>'. \<omega>' = repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<longrightarrow> \<omega>' \<in> fml_sem I (Pc pid1))"
         apply(rule allI)
         apply(rule impI)
         apply auto
         using some_sem by auto
       have fml_sem:"repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<in> fml_sem I (Pc pid1)"
         using sem_eq bigImp by blast
      show "mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) \<in> fml_sem I (Pc pid1)"
        using fml_sem sem_eq by blast
    qed
 qed
 
 lemma DC_valid:"valid DCaxiom" 
 proof (auto simp only: fml_sem.simps prog_sem.simps DCaxiom_def valid_def iff_sem impl_sem box_sem, auto)
   fix I::"('sf,'sc,'sz) interp" and aa ba bb sol t
   assume "is_interp I"
     and all3:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                   (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                         0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<longrightarrow>
            (a, b) \<in> Contexts I pid3 UNIV"
     and all2:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                    (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                         0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<longrightarrow>
            (a, b) \<in> Contexts I pid2 UNIV"
     and t:"0 \<le> t"
     and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
     and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
        {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV \<and> mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid3 UNIV}"
     from sol have
           sol1:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV}"
       by (metis (mono_tags, lifting) Collect_mono solves_ode_supset_range)
     from all2 have all2':"\<And>v. (\<exists>sola. sol 0 = sola 0 \<and>
                    (\<exists>t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                         0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<Longrightarrow>
            v \<in> Contexts I pid2 UNIV" by auto
     show "mk_v I (OVar vid1) (sol 0, bb) (sol t) \<in> Contexts I pid2 UNIV" 
       apply(rule all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"])
       apply(rule exI[where x=sol])
       apply(rule conjI)
        subgoal by (rule refl)
       subgoal using t sol1 by auto
      done
 next
   fix I::"('sf,'sc,'sz) interp" and  aa ba bb sol t
   assume "is_interp I"
   and all3:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<longrightarrow>
         (a, b) \<in> Contexts I pid3 UNIV"
   and all2:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and>
                      (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                        {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV \<and>
                           mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid3 UNIV})) \<longrightarrow>
         (a, b) \<in> Contexts I pid2 UNIV"
   and t:"0 \<le> t"
   and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
   and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV}"
   from all2 
   have all2':"\<And>v. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and>
                      (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                       {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV \<and>
                           mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid3 UNIV})) \<Longrightarrow>
         v \<in> Contexts I pid2 UNIV"
     by auto
   from all3
   have all3':"\<And>v. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<Longrightarrow>
         v \<in> Contexts I pid3 UNIV"
     by auto
   have inp1:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid1 UNIV"
     using sol solves_odeD atLeastAtMost_iff by blast
   have inp3:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid3 UNIV"
     apply(rule all3')
     subgoal for s 
       apply(rule exI [where x=sol])
       apply(rule conjI)
        subgoal by (rule refl)
       apply(rule exI [where x=s])
       apply(rule conjI)
        subgoal by (rule refl)
       apply(rule conjI)
        subgoal by assumption
       subgoal using sol by (meson atLeastatMost_subset_iff order_refl solves_ode_subset)
       done
    done
    have inp13:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid1 UNIV \<and> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid3 UNIV"
      using inp1 inp3 by auto
    have sol13:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
      {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV \<and> mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid3 UNIV}"
      apply(rule solves_odeI)
       subgoal using sol by (rule solves_odeD)
      subgoal for s using inp13[of s] by auto
      done
   show "mk_v I (OVar vid1) (sol 0, bb) (sol t) \<in> Contexts I pid2 UNIV"
     using t sol13 all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"] by auto
 qed
 
 lemma DS_valid:"valid DSaxiom"
 proof -
   have dsafe:"dsafe($f fid1 (\<lambda>i. Const 0))"
     using dsafe_Const by auto
   have osafe:"osafe(OSing vid1 (f0 fid1))"
     unfolding f0_def empty_def
     using dsafe osafe.intros
     by (simp add: osafe_Sing dfree_Const)
   have fsafe:"fsafe(p1 vid2 vid1)"
     unfolding p1_def
     apply(rule fsafe_Prop)
     using singleton.simps dsafe_Const by (auto intro: dfree.intros)
   show "valid DSaxiom"
     apply(auto simp only: DSaxiom_def valid_def Let_def iff_sem impl_sem box_sem)
      apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq  iff_sem impl_sem box_sem forall_sem)
   proof -
     fix I::"('sf,'sc,'sz) interp" 
       and a b r aa ba
     assume good_interp:"is_interp I"
     assume allW:"\<forall>\<omega>. (\<exists>\<nu> sol t.
              ((a, b), \<omega>) = (\<nu>, mk_v I (OSing vid1 (f0 fid1)) \<nu> (sol t)) \<and>
              0 \<le> t \<and>
              (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
               {x. mk_v I (OSing vid1 (f0 fid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
               (sol 0) = (fst \<nu>)) \<longrightarrow>
          \<omega> \<in> fml_sem I (p1 vid3 vid1)"
     assume "dterm_sem I (Const 0) (repv (a, b) vid2 r) \<le> dterm_sem I (trm.Var vid2) (repv (a, b) vid2 r)"
     hence leq:"0 \<le> r" by (auto)
     assume "\<forall>ra. repv (repv (a, b) vid2 r) vid3 ra
          \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
             {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
          Predicates I vid2
           (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                  (repv (repv (a, b) vid2 r) vid3 ra))"
     hence constraint:"\<forall>ra. (0 \<le> ra \<and> ra \<le> r) \<longrightarrow> 
          (repv (repv (a, b) vid2 r) vid3 ra) 
        \<in> fml_sem I (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))"
       using leq by auto
     assume aaba:" (aa, ba) =
      repv (repv (a, b) vid2 r) vid1
       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
     let ?abba = "repv (repd (a, b) vid1 (Functions I fid1 (\<chi> i. 0))) vid1
       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
     from allW have thisW:"(\<exists>\<nu> sol t.
             ((a, b), ?abba) = (\<nu>, mk_v I (OSing vid1 (f0 fid1)) \<nu> (sol t)) \<and>
             0 \<le> t \<and>
             (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
              {x. mk_v I (OSing vid1 (f0 fid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
              (sol 0) = (fst \<nu>)) \<longrightarrow>
         ?abba \<in> fml_sem I (p1 vid3 vid1)" by blast
     let ?c = "Functions I fid1 (\<chi> _. 0)"
     let ?sol = "(\<lambda>t. \<chi> i. if i = vid1 then (a $ i) + ?c * t else (a $ i))"
     have agrees:"Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r)) (a, b) (- semBV I (OSing vid1 (f0 fid1))) 
   \<and> Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r))
    (mk_xode I (OSing vid1 (f0 fid1)) (?sol r)) (semBV I (OSing vid1 (f0 fid1)))" 
        using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(a,b)" "(?sol r)"] by auto
     have prereq1a:"fst ?abba
      = fst (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
       using  agrees aaba 
       apply (auto simp add: aaba Vagree_def)
        apply (rule vec_extensionality)
        subgoal for i
          apply (cases "i = vid1")
           using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def)
          done
       apply (rule vec_extensionality)
       subgoal for i
         apply (cases "i = vid1")
          apply(auto  simp add: f0_def empty_def)
       done
     done
   have prereq1b:"snd (?abba) = snd (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
     using agrees aaba 
     apply (auto simp add: aaba Vagree_def)
     apply (rule vec_extensionality)
     subgoal for i
       apply (cases "i = vid1")
        using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def )
       done
     done  
   have "?abba = mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r)"
     using prod_eq_iff prereq1a prereq1b by blast
   hence req1:"((a, b), ?abba) = ((a, b), mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))" by auto
   have "sterm_sem I ($f fid1 (\<lambda>i. Const 0)) b = Functions I fid1 (\<chi> i. 0)" by auto
   hence vec_simp:"(\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I ($f fid1 (\<lambda>i. Const 0)) b else 0) 
       = (\<lambda>a b. \<chi> i. if i = vid1 then Functions I fid1 (\<chi> i. 0) else 0)"
     by (auto simp add: vec_eq_iff cong: if_cong)
   have sub: "{0..r} \<subseteq> UNIV" by auto
   have sub2:"{x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x \<in> fml_sem I (p1 vid2 vid1)} \<subseteq> UNIV" by auto
   have req3:"(?sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..r}
             {x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x \<in> fml_sem I (p1 vid2 vid1)}" 
     apply(auto simp add: f0_def empty_def vec_simp) 
     apply(rule solves_odeI)
      apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
      apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
       defer
       apply (rule ext)
       apply (subst scaleR_vec_def)
       apply (rule refl)
      apply (auto intro!: derivative_eq_intros)
     \<comment> \<open>Domain constraint satisfied\<close>
     using constraint apply (auto)
     subgoal for t
       apply(erule allE[where x="t"])
       apply(auto simp add: p1_def)
     proof -
       have eq:"(\<chi> i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
             (\<chi> y. if vid3 = y then t else fst (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) =
             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
               (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (a, b)
                 (\<chi> i. if i = vid1 then a $ i + Functions I fid1 (\<chi> _. 0) * t else a $ i)))"
         using vne12 vne13 mk_v_agree[of "I" "(OSing vid1 ($f fid1 (\<lambda>i. Const 0)))" "(a, b)" "(\<chi> i. if i = vid1 then a $ i + Functions I fid1 (\<chi> _. 0) * t else a $ i)"]
         by (auto simp add: vec_eq_iff f0_def empty_def Vagree_def)
       show "0 \<le> t \<Longrightarrow>
     t \<le> r \<Longrightarrow>
     Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
             (\<chi> y. if vid3 = y then t else fst (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) \<Longrightarrow>
     Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (a, b)
               (\<chi> i. if i = vid1 then a $ i + Functions I fid1 (\<chi> _. 0) * t else a $ i)))" 
         using eq by auto
     qed
     done
   have req4':"?sol 0 = fst (a,b)" by (auto simp: vec_eq_iff)
   then have req4: " (?sol 0) = (fst (a,b))"
     using VSagree_refl[of a] req4' unfolding VSagree_def by auto
   have inPred:"?abba \<in> fml_sem I (p1 vid3 vid1)"  
     using req1 leq req3 req4 thisW by fastforce
   have sem_eq:"?abba \<in> fml_sem I (p1 vid3 vid1) \<longleftrightarrow> (aa,ba) \<in> fml_sem I (p1 vid3 vid1)"
     apply (rule coincidence_formula)
       apply (auto simp add: aaba Vagree_def p1_def f0_def empty_def)
     subgoal using Iagree_refl by auto
     done
   from inPred sem_eq have  inPred':"(aa,ba) \<in> fml_sem I (p1 vid3 vid1)"
     by auto
   \<comment> \<open>thus by lemma 6 consequence for formulas\<close>
   show "repv (repv (a, b) vid2 r) vid1
        (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))
        \<in> fml_sem I (p1 vid3 vid1)" 
     using aaba inPred' by (auto)
 next
   fix I::"('sf,'sc,'sz) interp"
   and aa ba ab bb sol 
   and t:: real
   assume good_interp:"is_interp I"
   assume all:"
        \<forall>r. dterm_sem I (Const 0) (repv (ab, bb) vid2 r) \<le> dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 r) \<longrightarrow>
            (\<forall>ra. repv (repv (ab, bb) vid2 r) vid3 ra
                  \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                     {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                  Predicates I vid2
                   (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                          (repv (repv (ab, bb) vid2 r) vid3 ra))) \<longrightarrow>
                          
            (\<forall>\<omega>. \<omega> = repv (repv (ab, bb) vid2 r) vid1
                       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 r)) \<longrightarrow>
                  \<omega> \<in> fml_sem I (p1 vid3 vid1))"
   assume t:"0 \<le> t"
   assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t)"
   assume sol:"(sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
         {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
   hence constraint:"\<And>s. s \<in> {0 .. t} \<Longrightarrow> sol s \<in> {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
     using solves_ode_domainD by fastforce
   \<comment> \<open>\<open>sol 0 = fst (ab, bb)\<close>\<close>
   assume sol0:"  (sol 0) = (fst (ab, bb)) "
   have impl:"dterm_sem I (Const 0) (repv (ab, bb) vid2 t) \<le> dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 t) \<longrightarrow>
            (\<forall>ra. repv (repv (ab, bb) vid2 t) vid3 ra
                  \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                     {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                  Predicates I vid2
                   (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                          (repv (repv (ab, bb) vid2 t) vid3 ra))) \<longrightarrow>
            (\<forall>\<omega>. \<omega> = repv (repv (ab, bb) vid2 t) vid1
                       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) \<longrightarrow>
                  \<omega> \<in> fml_sem I (p1 vid3 vid1))" using all by auto
   interpret ll:ll_on_open_it UNIV "(\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))" "UNIV" 0
     apply(standard)
         apply(auto)
      unfolding local_lipschitz_def f0_def empty_def sterm_sem.simps 
      using gt_ex lipschitz_on_constant by blast
   have eq_UNIV:"ll.existence_ivl 0 (sol 0) = UNIV"
     apply(rule ll.existence_ivl_eq_domain)
         apply(auto)
     subgoal for tm tM t
       apply(unfold f0_def empty_def sterm_sem.simps)
       by(metis add.right_neutral mult_zero_left order_refl)
     done
   \<comment> \<open>Combine with \<open>flow_usolves_ode\<close> and \<open>equals_flowI\<close> to get uniqueness of solution\<close>
   let ?f = "(\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))"
   have sol_UNIV: "\<And>t x. (ll.flow 0 x usolves_ode ?f from 0) (ll.existence_ivl 0 x) UNIV"
     using ll.flow_usolves_ode by auto    
   from sol have sol':
     "(sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t} UNIV"
     apply (rule solves_ode_supset_range)
     by auto
   from sol' have sol'':"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
     by (simp add: solves_ode_subset)
   have sol0_eq:"sol 0 = ll.flow  0 (sol 0) 0"
     using ll.general.flow_initial_time_if by auto
   have isFlow:"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> sol s = ll.flow 0 (sol 0) s"
     apply(rule ll.equals_flowI)
          apply(auto)
       subgoal using eq_UNIV by auto
      subgoal using sol'' closed_segment_eq_real_ivl t by (auto simp add: solves_ode_singleton)
     subgoal using eq_UNIV sol sol0_eq by auto
     done
   let ?c = "Functions I fid1 (\<chi> _. 0)"
   let ?sol = "(\<lambda>t. \<chi> i. if i = vid1 then (ab $ i) + ?c * t else (ab $ i))"
   have vec_simp:"(\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I ($f fid1 (\<lambda>i. Const 0)) b else 0) 
       = (\<lambda>a b. \<chi> i. if i = vid1 then Functions I fid1 (\<chi> i. 0) else 0)"
     by (auto simp add: vec_eq_iff cong: if_cong)
   have exp_sol:"(?sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
     UNIV"
     apply(auto simp add: f0_def empty_def vec_simp) 
     apply(rule solves_odeI)
      apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
     apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
      defer
      apply (rule ext)
      apply (subst scaleR_vec_def)
      apply (rule refl)
     apply (auto intro!: derivative_eq_intros)
     done
   from exp_sol have exp_sol':"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> (?sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
     by (simp add: solves_ode_subset)
   have exp_sol0_eq:"?sol 0 = ll.flow  0 (?sol 0) 0"
     using ll.general.flow_initial_time_if by auto
   have more_eq:"(\<chi> i. if i = vid1 then ab $ i + Functions I fid1 (\<chi> _. 0) * 0 else ab $ i) = sol 0"
     using sol0 
     apply auto 
     apply(rule vec_extensionality)
     by(auto)
   have exp_isFlow:"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> ?sol s = ll.flow 0 (sol 0) s"
     apply(rule ll.equals_flowI)
          apply(auto)
       subgoal using eq_UNIV by auto
      defer
      subgoal for s 
        using eq_UNIV apply auto
        subgoal using exp_sol exp_sol0_eq more_eq 
          apply(auto)
          done
        done
     using exp_sol' closed_segment_eq_real_ivl t apply(auto)
     by (simp add: solves_ode_singleton)
   have sol_eq_exp:"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> ?sol s = sol s"
     unfolding exp_isFlow isFlow by auto
   then have sol_eq_exp_t:"?sol t = sol t"
     using t by auto
   then have sol_eq_exp_t':"sol t $ vid1 = ?sol t $ vid1" by auto
   then have useful:"?sol t $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * t"
     by auto
   from sol_eq_exp_t' useful have useful':"sol t $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * t"
     by auto
   have sol_int:"((ll.flow 0 (sol 0)) usolves_ode ?f from 0) {0..t} {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
     apply (rule usolves_ode_subset_range[of "(ll.flow 0 (sol 0))" "?f" "0" "{0..t}" "UNIV" "{x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"]) 
       subgoal using eq_UNIV sol_UNIV[of "(sol 0)"] apply (auto)
         apply (rule usolves_ode_subset)
            using t by(auto)
     apply(auto)
     using sol apply(auto  dest!: solves_ode_domainD)
     subgoal for xa using isFlow[of xa] by(auto)
     done
   have thing:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (?sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * s"
     subgoal for s
       using mk_v_agree[of I "(OSing vid1 ($f fid1 (\<lambda>i. Const 0)))" "(ab, bb)" "(?sol s)"] apply auto
       unfolding Vagree_def by auto
     done
   have thing':"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow>  fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * s"
     subgoal for s using thing[of s] sol_eq_exp[of s] by auto done
   have another_eq:"\<And>i s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                 (mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol s))
 
         =  dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
                 (\<chi> y. if vid3 = y then s else fst (\<chi> y. if vid2 = y then s else fst (ab, bb) $ y, bb) $ y, bb)"
     using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol s)"]  vne12 vne23 vne13
     apply(auto simp add: f0_def p1_def empty_def)
     unfolding Vagree_def apply(simp add: f0_def empty_def)
     subgoal for s using thing' by auto
     done
   have allRa':"(\<forall>ra. repv (repv (ab, bb) vid2 t) vid3 ra
                \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                   {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                Predicates I vid2
                 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                 (mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol ra))))"
     apply(rule allI)
     subgoal for ra
       using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
          vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
     done
   done
   have anotherFact:"\<And>ra. 0 \<le> ra \<Longrightarrow> ra \<le> t \<Longrightarrow> (\<chi> i. if i = vid1 then ab $ i + Functions I fid1 (\<chi> _. 0) * ra else ab $ i) $ vid1 =
      ab $ vid1 + dterm_sem I (f0 fid1) (\<chi> y. if vid3 = y then ra else fst (\<chi> y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) * ra "
     subgoal for ra
       apply simp
       apply(rule disjI2)
       by (auto simp add: f0_def empty_def)
     done
   have thing':"\<And>ra i. 0 \<le> ra \<Longrightarrow> ra \<le> t \<Longrightarrow> dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (sol ra))
       =  dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
             (\<chi> y. if vid3 = y then ra else fst (\<chi> y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) "
     subgoal for ra i
       using vne12 vne13 mk_v_agree[of I "OSing vid1 ($f fid1 (\<lambda>i. Const 0))" "(ab,bb)" "(sol ra)"] 
       apply (auto)
       unfolding Vagree_def apply(safe)
       apply(erule allE[where x="vid1"])+
       using sol_eq_exp[of ra] anotherFact[of ra] by auto
     done
   have allRa:"(\<forall>ra. repv (repv (ab, bb) vid2 t) vid3 ra
                \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                   {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                Predicates I vid2
                 (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                        (repv (repv (ab, bb) vid2 t) vid3 ra)))"
     apply(rule allI)
     subgoal for ra
       using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
          vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
       using sol_eq_exp[of ra]  apply (auto simp add: f0_def empty_def Vagree_def vec_eq_iff)
       using thing' by auto
     done
   have fml3:"\<And>ra. 0 \<le> ra \<Longrightarrow> ra \<le> t \<Longrightarrow>
            (\<forall>\<omega>. \<omega> = repv (repv (ab, bb) vid2 t) vid1
                       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) \<longrightarrow>
                  \<omega> \<in> fml_sem I (p1 vid3 vid1))"
     using impl allRa by auto       
   have someEq:"(\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (\<chi> y. if vid1 = y then (if vid2 = vid1 then t else fst (ab, bb) $ vid1) + Functions I fid1 (\<chi> i. 0) * t
                   else fst (\<chi> y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y,
              bb)) 
              = (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (sol t)))"
     apply(rule vec_extensionality)
     using vne12 sol_eq_exp t thing by auto
   show "mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t) \<in> fml_sem I (p1 vid3 vid1)"
     using mk_v_agree[of I "OSing vid1 (f0 fid1)" "(ab, bb)" "sol t"] fml3[of t]
     unfolding f0_def p1_def empty_def Vagree_def 
     using someEq by(auto simp add:  sol_eq_exp_t' t vec_extensionality  vne12)
 qed qed
 
 lemma MVT0_within:
   fixes f ::"real \<Rightarrow> real"
     and f'::"real \<Rightarrow> real \<Rightarrow> real"
     and s t :: real
   assumes f':"\<And>x. x \<in> {0..t} \<Longrightarrow> (f has_derivative (f' x)) (at x  within {0..t})"
   assumes geq':"\<And>x. x \<in> {0..t} \<Longrightarrow> f' x s \<ge> 0"
   assumes int_s:"s > 0 \<and> s \<le> t"
   assumes t: "0 < t"
   shows "f s \<ge> f 0"
 proof -
   have "f 0 + 0 \<le> f s"   
     apply (rule Lib.MVT_ivl'[OF f', of 0 s 0])
       subgoal for x by assumption
      subgoal for x using geq' by auto 
     using t int_s t apply auto
     subgoal for x
-      by (metis int_s mult.commute mult.right_neutral order.trans real_mult_le_cancel_iff2)
+      by (metis int_s mult.commute mult.right_neutral order.trans mult_le_cancel_iff2)
     done
   then show "?thesis" by auto 
 qed
 
 lemma MVT':
   fixes f g ::"real \<Rightarrow> real"
   fixes f' g'::"real \<Rightarrow> real \<Rightarrow> real"
   fixes s t ::real
   assumes f':"\<And>s. s \<in> {0..t} \<Longrightarrow> (f has_derivative (f' s)) (at s within {0..t})"
   assumes g':"\<And>s. s \<in> {0..t} \<Longrightarrow> (g has_derivative (g' s)) (at s within {0..t})"
   assumes geq':"\<And>x. x \<in> {0..t} \<Longrightarrow> f' x s \<ge> g' x s"
   assumes geq0:"f 0 \<ge> g 0"
   assumes int_s:"s > 0 \<and> s \<le> t"
   assumes t:"t > 0"
   shows "f s \<ge> g s"
 proof -
   let ?h = "(\<lambda>x. f x - g x)"
   let ?h' = "(\<lambda>s x. f' s x - g' s x)"
   have "?h s \<ge> ?h 0"
     apply(rule MVT0_within[of t ?h "?h'" s])
        subgoal for s using f'[of s] g'[of s] by auto
       subgoal for sa using geq'[of sa] by auto
      subgoal using int_s by auto
     subgoal using t by auto
     done
   then show "?thesis" using geq0 by auto
 qed
 
 lemma MVT'_gr:
   fixes f g ::"real \<Rightarrow> real"
   fixes f' g'::"real \<Rightarrow> real \<Rightarrow> real"
   fixes s t ::real
   assumes f':"\<And>s. s \<in> {0..t} \<Longrightarrow> (f has_derivative (f' s)) (at s within {0..t})"
   assumes g':"\<And>s. s \<in> {0..t} \<Longrightarrow> (g has_derivative (g' s)) (at s within {0..t})"
   assumes geq':"\<And>x. x \<in> {0..t} \<Longrightarrow> f' x s \<ge> g' x s"
   assumes geq0:"f 0 > g 0"
   assumes int_s:"s > 0 \<and> s \<le> t"
   assumes t:"t > 0"
   shows "f s > g s"
 proof -
   let ?h = "(\<lambda>x. f x - g x)"
   let ?h' = "(\<lambda>s x. f' s x - g' s x)"
   have "?h s \<ge> ?h 0"
     apply(rule MVT0_within[of t ?h "?h'" s])
        subgoal for s using f'[of s] g'[of s] by auto
       subgoal for sa using geq'[of sa] by auto
      subgoal using int_s by auto
     subgoal using t by auto
     done
   then show "?thesis" using geq0 by auto
 qed
 
 lemma frech_linear:
   fixes x \<theta> \<nu> \<nu>' I
   assumes good_interp:"is_interp I"
   assumes free:"dfree \<theta>"
   shows "x * frechet I \<theta> \<nu> \<nu>' = frechet I \<theta> \<nu> (x *\<^sub>R \<nu>')"
   using frechet_linear[OF good_interp free]
   by (simp add: linear_simps)
     
 lemma rift_in_space_time:
   fixes sol I ODE \<psi> \<theta> t s b
   assumes good_interp:"is_interp I"
   assumes free:"dfree \<theta>"
   assumes osafe:"osafe ODE"
   assumes sol:"(sol solves_ode (\<lambda>_ \<nu>'. ODE_sem I ODE \<nu>')) {0..t} 
           {x. mk_v I ODE (sol 0, b) x \<in> fml_sem I \<psi>}"
   assumes FVT:"FVT \<theta> \<subseteq> semBV I ODE"  
   assumes ivl:"s \<in> {0..t}"
   shows "((\<lambda>t. sterm_sem I \<theta> (fst (mk_v I ODE (sol 0, b) (sol t))))
     \<comment> \<open>This is Frechet derivative, so equivalent to:\<close>
     \<comment> \<open>\<open>has_real_derivative frechet I \<theta> (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})\<close>\<close>
     has_derivative (\<lambda>t'. t' * frechet I \<theta> (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})"
 proof -
   let ?\<phi> = "(\<lambda>t. (mk_v I ODE (sol 0, b) (sol t)))"
   let ?\<phi>s = "(\<lambda>t. fst (?\<phi> t))"
   have sol_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow> (sol has_derivative (\<lambda>xa. xa *\<^sub>R ODE_sem I ODE (sol s))) (at s within {0..t})"
     using sol apply simp 
     apply (drule solves_odeD(1))
     unfolding has_vderiv_on_def has_vector_derivative_def
     by auto
   have sol_dom:"\<And>s. s\<in> {0..t} \<Longrightarrow> ?\<phi> s \<in> fml_sem I \<psi>"
     using sol apply simp
     apply (drule solves_odeD(2))
      by auto
   let ?h = "(\<lambda>t. sterm_sem I \<theta> (?\<phi>s t))"
   let ?g = "(\<lambda>\<nu>. sterm_sem I \<theta> \<nu>)"
   let ?f = "?\<phi>s"
   let ?f' = "(\<lambda>t'. t' *\<^sub>R (\<chi> i. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
   let ?g' = "(frechet I \<theta> (?\<phi>s s))"
   have heq:"?h = ?g \<circ> ?f" by (auto)
   have fact1:"\<And>i. i \<in> ODE_vars I ODE \<Longrightarrow> (\<lambda>t. ?\<phi>s(t) $ i) = (\<lambda>t. sol t $ i)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have fact2:"\<And>i. i \<in> ODE_vars I ODE \<Longrightarrow> (\<lambda>t. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (\<lambda>t. ODE_sem I ODE (sol t) $ i)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have fact3:"\<And>i. i \<in> (-ODE_vars I ODE) \<Longrightarrow> (\<lambda>t. ?\<phi>s(t) $ i) = (\<lambda>t. sol 0 $ i)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have fact4:"\<And>i. i \<in> (-ODE_vars I ODE) \<Longrightarrow> (\<lambda>t. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (\<lambda>t. 0)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have some_eq:"(\<lambda>v'. \<chi> i. v' *\<^sub>R ODE_sem I ODE (sol s) $ i) = (\<lambda>v'. v' *\<^sub>R ODE_sem I ODE (sol s))"
     apply(rule ext)
     apply(rule vec_extensionality)
     by auto
   have some_sol:"(sol has_derivative (\<lambda>v'. v' *\<^sub>R ODE_sem I ODE (sol s))) (at s within {0..t})"
     using sol ivl unfolding solves_ode_def has_vderiv_on_def has_vector_derivative_def by auto
   have some_eta:"(\<lambda>t. \<chi> i. sol t $ i) = sol" by (rule ext, rule vec_extensionality, auto)
   have ode_deriv:"\<And>i. i \<in> ODE_vars I ODE \<Longrightarrow> 
     ((\<lambda>t. sol t $ i) has_derivative (\<lambda> v'. v' *\<^sub>R ODE_sem I ODE (sol s) $ i)) (at s within {0..t})"
     subgoal for i
       apply(rule has_derivative_proj)
       using some_eq some_sol some_eta by auto
     done
   have eta:"(\<lambda>t. (\<chi> i. ?f t $ i)) = ?f" by(rule ext, rule vec_extensionality, auto)
   have eta_esque:"(\<lambda>t'. \<chi> i. t' * (if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)) =  
                   (\<lambda>t'. t' *\<^sub>R (\<chi> i. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
     apply(rule ext | rule vec_extensionality)+
     subgoal for t' i by auto done
   have "((\<lambda>t. (\<chi> i. ?f t $ i)) has_derivative (\<lambda>t'. (\<chi> i. ?f' t' $ i))) (at s within {0..t})"
     apply (rule has_derivative_vec)
     subgoal for i       
       apply(cases "i \<in> ODE_vars I ODE")
        subgoal using fact1[of i] fact2[of i] ode_deriv[of i] by auto 
       subgoal using fact3[of i] fact4[of i] by auto 
     done
   done
   then have fderiv:"(?f has_derivative ?f') (at s within {0..t})" using eta eta_esque by auto
   have gderiv:"(?g has_derivative ?g') (at (?f s) within ?f ` {0..t})"
      using has_derivative_at_withinI 
      using frechet_correctness free good_interp 
      by blast
   have chain:"((?g \<circ> ?f) has_derivative (?g' \<circ> ?f')) (at s within {0..t})"
     using fderiv gderiv diff_chain_within by blast
   let ?co\<nu>1 = "(fst (mk_v I ODE (sol 0, b) (sol s)), ODE_sem I ODE (fst (mk_v I ODE (sol 0, b) (sol s))))"
   let ?co\<nu>2 = "(fst (mk_v I ODE (sol 0, b) (sol s)), snd (mk_v I ODE (sol 0, b) (sol s)))"
   have sub_cont:"\<And>a .a \<notin> ODE_vars I ODE \<Longrightarrow> Inl a \<in> FVT \<theta> \<Longrightarrow> False"
     using FVT by auto
   have sub_cont2:"\<And>a .a \<notin> ODE_vars I ODE \<Longrightarrow> Inr a \<in> FVT \<theta> \<Longrightarrow> False"
     using FVT by auto
   have "Vagree (mk_v I ODE (sol 0, b) (sol s)) (sol s, b) (Inl ` ODE_vars I ODE)"
     using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
     unfolding Vagree_def by auto
   let ?co'\<nu>1 = "(\<lambda>x. (fst (mk_v I ODE (sol 0, b) (sol s)), x *\<^sub>R (\<chi> i. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)))"
   let ?co'\<nu>2 = "(\<lambda>x. (fst (mk_v I ODE (sol 0, b) (sol s)), x *\<^sub>R snd (mk_v I ODE (sol 0, b) (sol s))))"
   have co_agree_sem:"\<And>s. Vagree (?co'\<nu>1 s) (?co'\<nu>2 s) (semBV I ODE)"
     subgoal for sa
       using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
       unfolding Vagree_def by auto
     done
   have co_agree_help:"\<And>s. Vagree (?co'\<nu>1 s) (?co'\<nu>2 s) (FVT \<theta>)"
     using agree_sub[OF FVT co_agree_sem] by auto
   have co_agree':"\<And>s. Vagree (?co'\<nu>1 s) (?co'\<nu>2 s) (FVDiff \<theta>)"
     subgoal for s
       using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
       unfolding Vagree_def apply auto
       subgoal for i x
         apply(cases x)
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            by (simp | metis (no_types, lifting) FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            by (simp | metis (no_types, lifting) FVT Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
         done
       subgoal for i x
         apply(cases x)
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
            by auto
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            apply(erule allE[where x=i])+
            using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
            by auto
         done
       done
     done 
   have heq'':"(?g' \<circ> ?f') = (\<lambda>t'. t' *\<^sub>R frechet I \<theta> (?\<phi>s s) (snd (?\<phi> s)))"
     using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
     unfolding comp_def
     apply auto
     apply(rule ext | rule vec_extensionality)+
     subgoal for x
       using frech_linear[of I \<theta> x "(fst (mk_v I ODE (sol 0, b) (sol s)))" "(snd (mk_v I ODE (sol 0, b) (sol s)))", OF good_interp free]
       using coincidence_frechet[OF free, of "(?co'\<nu>1 x)" "(?co'\<nu>2 x)", OF co_agree'[of x], of I]
       by auto
     done
   have "((?g \<circ> ?f) has_derivative (?g' \<circ> ?f')) (at s within {0..t})"
     using chain by auto
   then have "((?g \<circ> ?f) has_derivative (\<lambda>t'. t' * frechet I \<theta> (?\<phi>s s) (snd (?\<phi> s)))) (at s within {0..t})"
     using heq'' by auto
   then have result:"((\<lambda>t. sterm_sem I \<theta> (?\<phi>s t))  has_derivative (\<lambda>t. t * frechet I \<theta> (?\<phi>s s) (snd (?\<phi> s)))) (at s within {0..t})"
     using heq by auto
   then show "?thesis" by auto
 qed
 
 lemma dterm_sterm_dfree:
    "dfree \<theta> \<Longrightarrow> (\<And>\<nu> \<nu>'. sterm_sem I \<theta> \<nu> = dterm_sem I \<theta> (\<nu>, \<nu>'))"
   by(induction rule: dfree.induct, auto)
 
 \<comment> \<open>\<open>g(x)\<ge> h(x) \<rightarrow>  [x'=f(x), c & p(x)](g(x)' \<ge> h(x)') \<rightarrow> [x'=f(x), c]g(x) \<ge> h(x)\<close>\<close>  
 lemma DIGeq_valid:"valid DIGeqaxiom"
   unfolding DIGeqaxiom_def
   apply(unfold DIGeqaxiom_def valid_def impl_sem iff_sem)
   apply(auto) (* 4 goals*)
   proof -
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume t:"0 \<le> t"
       and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
       and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
     have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
     from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
       using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
     then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
       using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
       unfolding Vagree_def by (auto simp add: empty_def)
     show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
       using notin incon by auto
   next
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume t:"0 \<le> t"
       and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
       and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
     have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
     from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
       using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
     then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
       using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
       unfolding Vagree_def by (auto simp add: empty_def)
     show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
       using notin incon by auto
   next
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume t:"0 \<le> t"
     assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
         {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
     assume notin:"\<not> Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (sol 0, b))"
     have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
     from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
       using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
     then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
       using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
       unfolding Vagree_def by (auto simp add: empty_def)
     show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
        \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
       using incon notin by auto
 next
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume good_interp:"is_interp I"
     assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
     assume t:"0 \<le> t"
     assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
         {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
     assume box:"\<forall>a ba. (\<exists>sola. sol 0 = sola 0 \<and>
                       (\<exists>t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) \<and>
                            0 \<le> t \<and>
                            (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                             {x. Predicates I vid1
                                  (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) \<longrightarrow>
               directional_derivative I (f1 fid2 vid1) (a, ba) \<le> directional_derivative I (f1 fid1 vid1) (a, ba)"
     assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) \<le> dterm_sem I (f1 fid1 vid1) (sol 0, b)"
     have free1:"dfree ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
       by (auto intro: dfree.intros)
     have free2:"dfree ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
       by (auto intro: dfree.intros)
     from geq0 
     have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) \<le> sterm_sem I (f1 fid1 vid1) (sol 0)"
       unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b] 
       by auto  
     let ?\<phi>s = "\<lambda>x. fst (?\<phi> x)"
     let ?\<phi>t = "\<lambda>x. snd (?\<phi> x)"
     let ?df1 = "(\<lambda>t. dterm_sem I (f1 fid2 vid1) (?\<phi> t))"
     let ?f1 = "(\<lambda>t. sterm_sem I (f1 fid2 vid1) (?\<phi>s t))"
     let ?f1' = "(\<lambda> s t'. t' * frechet I (f1 fid2 vid1) (?\<phi>s s) (?\<phi>t s))"
     have dfeq:"?df1 = ?f1" 
       apply(rule ext)
       subgoal for t
         using dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"] unfolding f1_def expand_singleton by auto
       done
     have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
     let ?df2 = "(\<lambda>t. dterm_sem I (f1 fid1 vid1) (?\<phi> t))"
     let ?f2 = "(\<lambda>t. sterm_sem I (f1 fid1 vid1) (?\<phi>s t))"
     let ?f2' = "(\<lambda>s t' . t' * frechet I (f1 fid1 vid1) (?\<phi>s s) (?\<phi>t s))"
     let ?int = "{0..t}"
     have bluh:"\<And>x i. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
       using good_interp unfolding is_interp_def by auto
     have blah:"(Functions I fid2 has_derivative (THE f'. \<forall>x. (Functions I fid2 has_derivative f' x) (at x)) (\<chi> i. if i = vid1 then sol t $ vid1 else 0)) (at (\<chi> i. if i = vid1 then sol t $ vid1 else 0))"
       using bluh by auto
     have bigEx:"\<And>s. s \<in> {0..t} \<Longrightarrow>(\<exists>sola. sol 0 = sola 0 \<and>
          (\<exists>ta. (fst (?\<phi> s),
                 snd (?\<phi> s)) =
                mk_v I (OVar vid1) (sola 0, b) (sola ta) \<and>
                0 \<le> ta \<and>
                (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..ta}
                 {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
       subgoal for s
         apply(rule exI[where x=sol])
         apply(rule conjI)
          subgoal by (rule refl)
         apply(rule exI[where x=s])
         apply(rule conjI)
          subgoal by auto 
         apply(rule conjI)
          subgoal by auto
         using sol
         using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
         by (metis (no_types, lifting) subsetI)
       done
     have box':"\<And>s. s \<in> {0..t} \<Longrightarrow> directional_derivative I (f1 fid2 vid1) (?\<phi>s s, ?\<phi>t s) 
                                 \<le> directional_derivative I (f1 fid1 vid1) (?\<phi>s s, ?\<phi>t s)"
       subgoal for s
       using box 
       apply simp
       apply (erule allE[where x="?\<phi>s s"])
       apply (erule allE[where x="?\<phi>t s"])
       using bigEx[of s] by auto 
     done
     have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
     have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
     have agree1:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid2 vid1))"
       using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
       unfolding f1_def Vagree_def expand_singleton 
       apply auto
       by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
     have agree2:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid1 vid1))"
       using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
       unfolding f1_def Vagree_def expand_singleton 
       apply auto
       by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
     have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?\<phi> 0)"
       using coincidence_dterm[OF dsafe1 agree1] by auto
     then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?\<phi>s 0)"
       using dterm_sterm_dfree[OF free1, of I "sol 0" "b"] 
             dterm_sterm_dfree[OF free1, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
       unfolding f1_def expand_singleton by auto
     have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?\<phi> 0)"
       using coincidence_dterm[OF dsafe2 agree2] by auto
     then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?\<phi>s 0)" 
       using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
       unfolding f1_def expand_singleton by auto
     have good_interp':"\<And>i x. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
       using good_interp unfolding is_interp_def by auto
     have chain :  
       "\<And>f f' g g' x s.
         (f has_derivative f') (at x within s) \<Longrightarrow>
         (g has_derivative g') (at (f x) within f ` s) \<Longrightarrow> (g \<circ> f has_derivative g' \<circ> f') (at x within s)"
       by(auto intro: derivative_intros)
     have sol1:"(sol solves_ode (\<lambda>_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x \<in> fml_sem I (Prop vid1 empty)}"
       using sol unfolding p1_def singleton_def empty_def by auto
     have FVTsub1:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
       apply auto
       subgoal for x xa
         apply(cases "xa = vid1")
          by auto
       done
     have FVTsub2:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
       apply auto
       subgoal for x xa
         apply(cases "xa = vid1")
          by auto
       done
     have osafe:"osafe (OVar vid1)"
       by auto
     have deriv1:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f1 has_derivative (?f1' s)) (at s within {0..t})"
       subgoal for s
         using  rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
         unfolding f1_def expand_singleton directional_derivative_def
         by blast
       done
     have deriv2:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f2 has_derivative (?f2' s)) (at s within {0..t})"
       subgoal for s
         using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s] 
         unfolding f1_def expand_singleton directional_derivative_def
         by blast
       done
     have leq:"\<And>s . s \<in> ?int \<Longrightarrow> ?f1' s 1 \<le> ?f2' s 1"
       subgoal for s using box'[of s] 
         by (simp add: directional_derivative_def)
       done
     have preserve_agree1:"vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
       using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
       unfolding Vagree_def VSagree_def
       by auto
     have preserve_coincide1:
       "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
       sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
      = sterm_sem I (f1 fid2 vid1) (sol 0)" 
       using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
       preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
     have preserve_coincide2:
       "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
       sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
      = sterm_sem I (f1 fid1 vid1) (sol 0)" 
       using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
       preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
     have "?f1 t \<le> ?f2 t"
       apply(cases "t = 0")
        subgoal using geq0' sem_eq1' sem_eq2' by auto  
       subgoal
         apply(cases "vid1 \<in> ODE_vars I (OVar vid1)")
         subgoal
           apply (rule MVT'[OF deriv2 deriv1, of t]) (* 8 subgoals *)
                  subgoal by auto
                 subgoal by auto
                subgoal for s using deriv2[of s] using leq by auto
               using t leq geq0' sem_eq1' sem_eq2' by auto
         subgoal
           using geq0 
           using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
           using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
           using preserve_coincide1 preserve_coincide2
           by(simp add: f1_def)
         done
       done
     then 
     show "       dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
        \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
 "
       using t 
       dterm_sterm_dfree[OF free2, of I "?\<phi>s t" "snd (?\<phi> t)"]
       dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"]
       by (simp add: f1_def)
 qed 
   
   
 lemma DIGr_valid:"valid DIGraxiom"
   unfolding DIGraxiom_def
   apply(unfold DIGraxiom_def valid_def impl_sem iff_sem)
   apply(auto) (* 4 subgoals*)
 proof -
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
     and sol::"real \<Rightarrow> 'sz simple_state" 
     and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume t:"0 \<le> t"
     and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
     {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
     and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
   have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
   from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
     using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
   then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
     using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
     unfolding Vagree_def by (auto simp add: empty_def)
   show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using notin incon by auto
 next
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
     and sol::"real \<Rightarrow> 'sz simple_state" 
     and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume t:"0 \<le> t"
     and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
     {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
     and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
   have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
   from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
     using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
   then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
     using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
     unfolding Vagree_def by (auto simp add: empty_def)
   show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using notin incon by auto
 next
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
     and sol::"real \<Rightarrow> 'sz simple_state" 
     and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume t:"0 \<le> t"
   assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
   assume notin:"\<not> Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (sol 0, b))"
   have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
   from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
     using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
   then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
     using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
     unfolding Vagree_def by (auto simp add: empty_def) 
   show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
      < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using incon notin by auto
 next
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
   and sol::"real \<Rightarrow> 'sz simple_state" 
   and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume good_interp:"is_interp I"
   assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
   assume t:"0 \<le> t"
   assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
   assume box:"\<forall>a ba. (\<exists>sola. sol 0 = sola 0 \<and>
                     (\<exists>t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) \<and>
                          0 \<le> t \<and>
                          (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                           {x. Predicates I vid1
                                (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) \<longrightarrow>
             directional_derivative I (f1 fid2 vid1) (a, ba) \<le> directional_derivative I (f1 fid1 vid1) (a, ba)"
   assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) < dterm_sem I (f1 fid1 vid1) (sol 0, b)"
   have free1:"dfree ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
     by (auto intro: dfree.intros)
   have free2:"dfree ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
     by (auto intro: dfree.intros)
   from geq0 
   have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) < sterm_sem I (f1 fid1 vid1) (sol 0)"
     unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b] 
     by auto  
   let ?\<phi>s = "\<lambda>x. fst (?\<phi> x)"
   let ?\<phi>t = "\<lambda>x. snd (?\<phi> x)"
   let ?df1 = "(\<lambda>t. dterm_sem I (f1 fid2 vid1) (?\<phi> t))"
   let ?f1 = "(\<lambda>t. sterm_sem I (f1 fid2 vid1) (?\<phi>s t))"
   let ?f1' = "(\<lambda> s t'. t' * frechet I (f1 fid2 vid1) (?\<phi>s s) (?\<phi>t s))"
   have dfeq:"?df1 = ?f1" 
     apply(rule ext)
     subgoal for t
       using dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"] unfolding f1_def expand_singleton by auto
     done
   have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
   let ?df2 = "(\<lambda>t. dterm_sem I (f1 fid1 vid1) (?\<phi> t))"
   let ?f2 = "(\<lambda>t. sterm_sem I (f1 fid1 vid1) (?\<phi>s t))"
   let ?f2' = "(\<lambda>s t' . t' * frechet I (f1 fid1 vid1) (?\<phi>s s) (?\<phi>t s))"
   let ?int = "{0..t}"
   have bluh:"\<And>x i. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
     using good_interp unfolding is_interp_def by auto
   have blah:"(Functions I fid2 has_derivative (THE f'. \<forall>x. (Functions I fid2 has_derivative f' x) (at x)) (\<chi> i. if i = vid1 then sol t $ vid1 else 0)) (at (\<chi> i. if i = vid1 then sol t $ vid1 else 0))"
     using bluh by auto
   have bigEx:"\<And>s. s \<in> {0..t} \<Longrightarrow>(\<exists>sola. sol 0 = sola 0 \<and>
        (\<exists>ta. (fst (?\<phi> s),
               snd (?\<phi> s)) =
              mk_v I (OVar vid1) (sola 0, b) (sola ta) \<and>
              0 \<le> ta \<and>
              (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..ta}
               {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
     subgoal for s
       apply(rule exI[where x=sol])
       apply(rule conjI)
        subgoal by (rule refl)
       apply(rule exI[where x=s])
       apply(rule conjI)
        subgoal by auto 
       apply(rule conjI)
        subgoal by auto
       using sol
       using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
       by (metis (no_types, lifting) subsetI)
     done
   have box':"\<And>s. s \<in> {0..t} \<Longrightarrow> directional_derivative I (f1 fid2 vid1) (?\<phi>s s, ?\<phi>t s) 
                               \<le> directional_derivative I (f1 fid1 vid1) (?\<phi>s s, ?\<phi>t s)"
     subgoal for s
     using box 
     apply simp
     apply (erule allE[where x="?\<phi>s s"])
     apply (erule allE[where x="?\<phi>t s"])
     using bigEx[of s] by auto 
   done
   have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
   have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
   have agree1:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid2 vid1))"
     using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
     unfolding f1_def Vagree_def expand_singleton 
     apply auto
     by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
   have agree2:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid1 vid1))"
     using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
     unfolding f1_def Vagree_def expand_singleton 
     apply auto
     by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
   have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?\<phi> 0)"
     using coincidence_dterm[OF dsafe1 agree1] by auto
   then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?\<phi>s 0)"
     using dterm_sterm_dfree[OF free1, of I "sol 0" "b"] 
           dterm_sterm_dfree[OF free1, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
     unfolding f1_def expand_singleton by auto
   have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?\<phi> 0)"
     using coincidence_dterm[OF dsafe2 agree2] by auto
   then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?\<phi>s 0)" 
     using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
     unfolding f1_def expand_singleton by auto
   have good_interp':"\<And>i x. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
     using good_interp unfolding is_interp_def by auto
   have chain :  
     "\<And>f f' g g' x s.
       (f has_derivative f') (at x within s) \<Longrightarrow>
       (g has_derivative g') (at (f x) within f ` s) \<Longrightarrow> (g \<circ> f has_derivative g' \<circ> f') (at x within s)"
     by(auto intro: derivative_intros)
   have sol1:"(sol solves_ode (\<lambda>_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x \<in> fml_sem I (Prop vid1 empty)}"
     using sol unfolding p1_def singleton_def empty_def by auto
   have FVTsub1:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
     apply auto
     subgoal for x xa
       apply(cases "xa = vid1")
        by auto
     done
   have FVTsub2:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
     apply auto
     subgoal for x xa
       apply(cases "xa = vid1")
        by auto
     done
   have osafe:"osafe (OVar vid1)"
     by auto
   have deriv1:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f1 has_derivative (?f1' s)) (at s within {0..t})"
     subgoal for s
       using  rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
       unfolding f1_def expand_singleton directional_derivative_def
       by blast
     done
   have deriv2:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f2 has_derivative (?f2' s)) (at s within {0..t})"
     subgoal for s
       using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s] 
       unfolding f1_def expand_singleton directional_derivative_def
       by blast
     done
   have leq:"\<And>s . s \<in> ?int \<Longrightarrow> ?f1' s 1 \<le> ?f2' s 1"
     subgoal for s using box'[of s] 
       by (simp add: directional_derivative_def)
     done
   have preserve_agree1:"vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
     using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
     unfolding Vagree_def VSagree_def
     by auto
   have preserve_coincide1:
     "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
     sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
    = sterm_sem I (f1 fid2 vid1) (sol 0)" 
     using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
     preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
   have preserve_coincide2:
     "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
     sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
    = sterm_sem I (f1 fid1 vid1) (sol 0)" 
     using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
     preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
   have "?f1 t < ?f2 t"
     apply(cases "t = 0")
      subgoal using geq0' sem_eq1' sem_eq2' by auto  
     subgoal
       apply(cases "vid1 \<in> ODE_vars I (OVar vid1)")
       subgoal
         apply (rule MVT'_gr[OF deriv2 deriv1, of t])
                subgoal by auto
               subgoal by auto
              subgoal for s using deriv2[of s] using leq by auto
             using t leq geq0' sem_eq1' sem_eq2' by auto
       subgoal
         using geq0 
         using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
         using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
         using preserve_coincide1 preserve_coincide2
         by(simp add: f1_def)
       done
     done
   then 
   show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
      < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using t 
     dterm_sterm_dfree[OF free2, of I "?\<phi>s t" "snd (?\<phi> t)"]
     dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"]
     using geq0 f1_def
     by (simp add: f1_def)
 qed 
 
 lemma DG_valid:"valid DGaxiom"
 proof -
   have osafe:"osafe (OSing vid1 (f1 fid1 vid1))" 
     by(auto simp add: osafe_Sing dfree_Fun dfree_Const f1_def expand_singleton)
   have fsafe:"fsafe (p1 vid1 vid1)" 
     by(auto simp add: p1_def dfree_Const)
   have osafe2:"osafe (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))))"
     by(auto simp add: f1_def expand_singleton osafe.intros dfree.intros vne12)
   note sem = ode_alt_sem[OF osafe fsafe]
   note sem2 = ode_alt_sem[OF osafe2 fsafe]
   have p2safe:"fsafe (p1 vid2 vid1)" by(auto simp add: p1_def dfree_Const)
   show "valid DGaxiom"
     apply(auto simp  del: prog_sem.simps(8) simp add: DGaxiom_def valid_def sem sem2)
      apply(rule exI[where x=0], auto simp add: f1_def p1_def expand_singleton)
      subgoal for I a b aa ba sol t
      proof -
        assume good_interp:"is_interp I"
        assume "
 \<forall>aa ba. (\<exists>sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                        {x. Predicates I vid1
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} \<and>
                       VSagree (sol 0) a {uu. uu = vid1 \<or>
                             Inl uu \<in> Inl ` {x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<or>
                             (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
              Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
        then have 
          bigAll:"
 \<And>aa ba. (\<exists>sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                        {x. Predicates I vid1
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} \<and>
                       VSagree (sol 0) a {uu. uu = vid1 \<or> (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
              Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
          by (auto)
        assume aaba:"(aa, ba) =
   mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
            (OSing vid2
              (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
    (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)"
        assume t:"0 \<le> t"
        assume sol:"
      (sol solves_ode
    (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
    {0..t} {x. Predicates I vid1
                (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                       (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                                 (OSing vid2
                                   (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                     ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                         (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) x))}"
      assume VSag:"VSagree (sol 0) (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y)
      {x. x = vid2 \<or> x = vid1 \<or> x = vid2 \<or> x = vid1 \<or> Inl x \<in> Inl ` {x. x = vid2 \<or> x = vid1} \<or> x = vid1}"
        let ?sol = "(\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0)"
        let ?aaba' = "mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)"
      from bigAll[of "fst ?aaba'" "snd ?aaba'"] 
      have bigEx:"(\<exists>sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) \<and>
                         0 \<le> t \<and>
                         (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                          {x. Predicates I vid1
                               (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                      (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} \<and>
                         VSagree (sol 0) a {uu. uu = vid1 \<or> (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
                Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?aaba'))" 
        by simp
      have pre1:"?aaba' = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)" 
        by (rule refl)
      have agreeL:"\<And>s. fst (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                      (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                        ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
            (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) $ vid1 = sol s $ vid1"
        subgoal for s
          using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))" "(\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol s)"]
          unfolding Vagree_def by auto done
        have agreeR:"\<And>s. fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)) $ vid1 = sol s $ vid1" 
          subgoal for s
            using mk_v_agree[of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(\<chi> i. if i = vid1 then sol s $ vid1 else 0)"]
            unfolding Vagree_def by auto
          done
        have FV:"(FVF (p1 vid1 vid1)) = {Inl vid1}" unfolding p1_def expand_singleton
          apply auto subgoal for x xa apply(cases "xa = vid1") by auto done
        have agree:"\<And>s. Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
              (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)) (FVF (p1 vid1 vid1))"
          using agreeR agreeL unfolding Vagree_def FV by auto
        note con_sem_eq = coincidence_formula[OF fsafe Iagree_refl agree]
        have constraint:"\<And>s. 0 \<le> s \<and> s \<le> t \<Longrightarrow>
          Predicates I vid1
          (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)))"
          using sol apply simp
          apply(drule solves_odeD(2))
           apply auto[1]
          subgoal for s using con_sem_eq by (auto simp add: p1_def expand_singleton)
          done
        have eta:"sol = (\<lambda>t. \<chi> i. sol t $ i)" by (rule ext, rule vec_extensionality, simp)
        have yet_another_eq:"\<And>x. (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)))
  = (\<lambda>xa. (\<chi> i. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i))"
          subgoal for x by (rule ext, rule vec_extensionality, simp) done
        have sol_deriv:"\<And>x. x \<in>{0..t} \<Longrightarrow>
            (sol has_derivative
             (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))))
             (at x within {0..t})"
          using sol apply simp
          apply(drule solves_odeD(1))
          unfolding has_vderiv_on_def has_vector_derivative_def by auto
        then have sol_deriv:"\<And>x. x \<in> {0..t} \<Longrightarrow>
            ((\<lambda>t. \<chi> i. sol t $ i) has_derivative
             (\<lambda>xa. (\<chi> i. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i)))
             (at x within {0..t})" using yet_another_eq eta by auto
        have sol_deriv1: "\<And>x. x \<in> {0..t} \<Longrightarrow>
           ((\<lambda>t. sol t $ vid1) has_derivative
            (\<lambda>xa. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                          (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)) $ vid1)))
            (at x within {0..t})"
          subgoal for s
            (* I heard higher-order unification is hard.*)
          apply(rule has_derivative_proj[of "(\<lambda> i t. sol t $ i)" "(\<lambda>j xa. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0) +
                          (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol s) else 0)) $ j))" "at s within {0..t}""vid1"])
          using sol_deriv[of s] by auto done
       have hmm:"\<And>s. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol s)) = (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (\<chi> i. if i = vid1 then sol s $ vid1 else 0))"
         by(rule vec_extensionality, auto)
       have aha:"\<And>s. (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) = (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0))"
         subgoal for s
           apply(rule ext)
           subgoal for xa using hmm by (auto simp add: f1_def) done done 
       let ?sol' = "(\<lambda>s. (\<lambda>xa. \<chi> i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0))"
       let ?project_me_plz = "(\<lambda>t. (\<chi> i. if i = vid1 then ?sol t $ vid1 else 0))"
       have sol_deriv_eq:"\<And>s. s \<in>{0..t} \<Longrightarrow>
      ((\<lambda>t. (\<chi> i. if i = vid1 then ?sol t $ vid1 else 0)) has_derivative ?sol' s) (at s within {0..t})"
         subgoal for s
           apply(rule has_derivative_vec)
           subgoal for i
             apply (cases "i = vid1", cases "i = vid2", auto)
              using vne12 apply simp
             using sol_deriv1[of s] using aha by auto
           done done
       have yup:"(\<lambda>t. (\<chi> i. if i = vid1 then ?sol t $ vid1 else 0) $ vid1) = (\<lambda>t. sol t $ vid1)"
         by(rule ext, auto)
       have maybe:"\<And>s. (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)) = (\<lambda>xa. (\<chi> i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0) $ vid1) "
         by(rule ext, auto)
       have almost:"(\<lambda>x. if vid1 = vid1 then (\<chi> i. if i = vid1 then sol x $ vid1 else 0) $ vid1 else 0) =
 (\<lambda>x.  (\<chi> i. if i = vid1 then sol x $ vid1 else 0) $ vid1)" by(rule ext, auto)
       have almost':"\<And>s. (\<lambda>h. if vid1 = vid1 then h * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0) = (\<lambda>h. h * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0))"
         by(rule ext, auto)
       have deriv':" \<And>x. x \<in> {0..t} \<Longrightarrow>
      ((\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0) has_derivative
       (\<lambda>xa. (\<chi> i. xa *\<^sub>R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol x $ vid1 else 0) else 0))))
       (at x within {0..t})"
         subgoal for s
           apply(rule has_derivative_vec)
           subgoal for i
             apply(cases "i = vid1")
              prefer 2 subgoal by auto
             apply auto              
             using has_derivative_proj[OF sol_deriv_eq[of s], of vid1] using  yup maybe[of s] almost almost'[of s] 
             by fastforce
           done 
         done
       have derEq:"\<And>s. (\<lambda>xa. (\<chi> i. xa *\<^sub>R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0)))
  = (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0))"
         subgoal for s apply (rule ext, rule vec_extensionality) by auto done
       have "\<And>x. x \<in> {0..t} \<Longrightarrow>
      ((\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0) has_derivative
       (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol x $ vid1 else 0) else 0)))
       (at x within {0..t})" subgoal for s using deriv'[of s] derEq[of s] by auto done
       then have deriv:"((\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0) has_vderiv_on
         (\<lambda>t. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol t $ vid1 else 0) else 0))
         {0..t}"
         unfolding has_vderiv_on_def has_vector_derivative_def
         by auto 
       have pre2:"(?sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
      {x. Predicates I vid1
           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                  (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
         apply(rule solves_odeI)
          subgoal by (rule deriv)
         subgoal for s using constraint by auto
         done
       have pre3:"VSagree (?sol 0) a {u. u = vid1 \<or> (\<exists>x. Inl u \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
         using vne12 VSag unfolding VSagree_def by simp 
       have bigPre:"(\<exists>sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then Var vid1 else Const 0))) (a, b) (sol t) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                        {x. Predicates I vid1
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then Var vid1 else Const 0))) (a, b) x))} \<and>
                       VSagree (sol 0) a {u. u = vid1 \<or> (\<exists>x. Inl u \<in> FVT (if x = vid1 then Var vid1 else Const 0))})"
         apply(rule exI[where x="?sol"])
         apply(rule exI[where x=t])
         apply(rule conjI)
          apply(rule pre1)
         apply(rule conjI)
          apply(rule t)
         apply(rule conjI)
          apply(rule pre2)
         by(rule pre3)
       have pred2:"Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
         using bigEx bigPre by auto
       then have pred2':"?aaba' \<in> fml_sem I (p1 vid2 vid1)" unfolding p1_def expand_singleton by auto
       let ?res_state = "(mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
             (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))"
       have aabaX:"(fst ?aaba') $ vid1 = sol t $ vid1" 
         using aaba mk_v_agree[of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))"
  "(a, b)" "(?sol t)"] 
       proof -
         assume " Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol t $ vid1 else 0))
      (a, b) (- semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))) \<and>
    Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol t $ vid1 else 0))
      (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (\<chi> i. if i = vid1 then sol t $ vid1 else 0))
      (semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))"
         then have ag:" Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
    (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t))
    (semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))"
           by auto
         have sembv:"(semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))) = {Inl vid1, Inr vid1}"
           by auto
         have sub:"{Inl vid1} \<subseteq> {Inl vid1, Inr vid1}" by auto
         have ag':"Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
           (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) {Inl vid1}" 
           using ag agree_sub[OF sub] sembv by auto
         then have eq1:"fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)) $ vid1 
           = fst (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) $ vid1" unfolding Vagree_def by auto
         moreover have "... = sol t $ vid1" by auto
         ultimately show ?thesis by auto
       qed
       have res_stateX:"(fst ?res_state) $ vid1 = sol t $ vid1" 
         using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))"
             "(\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol t)"]
       proof -
         assume "Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
              (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
      (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b)
      (- semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))) \<and>
     Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
              (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
      (mk_xode I
        (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
          (OSing vid2
            (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
              ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
        (sol t))
      (semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                 (OSing vid2
                   (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                     ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))))"
         then have ag:" Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
          (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
  (mk_xode I
    (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
      (OSing vid2
        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
    (sol t))
  (semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
             (OSing vid2
               (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                 ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))))" by auto
         have sembv:"(semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
             (OSing vid2
               (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                 ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))) = {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
         have sub:"{Inl vid1} \<subseteq> {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
         have ag':"Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
          (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
    (mk_xode I
      (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
        (OSing vid2
          (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
            ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
      (sol t)) {Inl vid1}" using ag sembv agree_sub[OF sub] by auto
         then have "fst ?res_state $ vid1 = fst ((mk_xode I
      (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
        (OSing vid2
          (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
            ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
      (sol t))) $ vid1" unfolding Vagree_def by blast
         moreover have "... = sol t $ vid1" by auto
         ultimately show "?thesis" by linarith
       qed
      have agree:"Vagree ?aaba' (?res_state) (FVF (p1 vid2 vid1))"
        unfolding p1_def Vagree_def using aabaX res_stateX by auto
      have fml_sem_eq:"(?res_state \<in> fml_sem I (p1 vid2 vid1)) = (?aaba' \<in> fml_sem I (p1 vid2 vid1))"
        using coincidence_formula[OF p2safe Iagree_refl agree, of I] by auto
      then show "Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                       (OSing vid2
                         (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                           ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
               (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)))"
      using pred2 unfolding p1_def expand_singleton by auto
   qed
 subgoal for I a b r aa ba sol t
 proof -
   assume good_interp:"is_interp I"
   assume bigAll:"    \<forall>aa ba. (\<exists>sol t. (aa, ba) =
                      mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                               (OSing vid2
                                 (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                   ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                       (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (sol t) \<and>
                      0 \<le> t \<and>
                      (sol solves_ode
                       (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
                              (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
                       {0..t} {x. Predicates I vid1
                                   (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                          (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                                                    (OSing vid2
                                                      (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                                        ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                                            (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) x))} \<and>
                      VSagree (sol 0) (\<chi> y. if vid2 = y then r else fst (a, b) $ y)
                       {uu. uu = vid2 \<or>
                             uu = vid1 \<or>
                             uu = vid2 \<or>
                             uu = vid1 \<or>
                             Inl uu
                             \<in> Inl ` ({x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<union>
                                       {x. x = vid2 \<or> (\<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) \<or>
                             (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
             Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
     assume aaba:"(aa, ba) = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)"
     assume t:"0 \<le> t"
     assume sol:"(sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
      {x. Predicates I vid1
           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                  (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
     assume VSA:"VSagree (sol 0) a
      {uu. uu = vid1 \<or>
            Inl uu \<in> Inl ` {x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<or>
            (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
     let ?xode = "(\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
     let ?xconstraint = UNIV
     let ?ivl = "ll_on_open.existence_ivl {0 .. t} ?xode ?xconstraint 0 (sol 0)"
     have freef1:"dfree ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
       by(auto simp add: dfree_Fun dfree_Const)
     have simple_term_inverse':"\<And>\<theta>. dfree \<theta> \<Longrightarrow> raw_term (simple_term \<theta>) = \<theta>"
       using simple_term_inverse by auto
     have old_lipschitz:"local_lipschitz (UNIV::real set) UNIV (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
       apply(rule c1_implies_local_lipschitz[where f'="(\<lambda> (t,b). blinfun_vec(\<lambda> i. if i = vid1 then blin_frechet (good_interp I) (simple_term (Function fid1 (\<lambda> i. if i = vid1 then Var vid1 else Const 0))) b else Blinfun(\<lambda> _. 0)))"])
          apply auto
        subgoal for x
          apply(rule has_derivative_vec)
          subgoal for i
            apply(auto simp add:  bounded_linear_Blinfun_apply good_interp_inverse good_interp)
            apply(auto simp add: simple_term_inverse'[OF freef1])
            apply(cases "i = vid1")
             apply(auto simp add: f1_def expand_singleton)
          proof -
            let ?h = "(\<lambda>b. Functions I fid1 (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
            let ?h' = "(\<lambda>b'. FunctionFrechet I fid1 (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x) (\<chi> i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))" 
            let ?f = "(\<lambda> b. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
            let ?f' = "(\<lambda> b'. (\<chi> i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))"
            let ?g = "Functions I fid1"
            let ?g'= "FunctionFrechet I fid1 (?f x)"
            have heq:"?h = ?g \<circ> ?f" by(rule ext, auto)
            have heq':"?h' = ?g' \<circ> ?f'" by(rule ext, auto)
            have fderiv:"(?f has_derivative ?f') (at x)"
              apply(rule has_derivative_vec)
              by (auto simp add: svar_deriv axis_def)
            have gderiv:"(?g has_derivative ?g') (at (?f x))"
              using good_interp unfolding is_interp_def by blast
            have gfderiv: "((?g \<circ> ?f) has_derivative(?g' \<circ> ?f')) (at x)"
              using fderiv gderiv diff_chain_at by blast
            have boring_eq:"(\<lambda>b. Functions I fid1 (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b)) =
              sterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
              by(rule ext, auto)
            have "(?h has_derivative ?h') (at x)" using gfderiv heq heq' by auto
            then show "(sterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) has_derivative
  (\<lambda>v'. (THE f'. \<forall>x. (Functions I fid1 has_derivative f' x) (at x)) (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x)
         (\<chi> i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x v')))
  (at x)"
              using boring_eq by auto
          qed
          done
     proof -
       have the_thing:"continuous_on (UNIV::('sz Rvec set)) 
         (\<lambda>b.
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0)))"
          apply(rule continuous_blinfun_vec')
          subgoal for i
            apply(cases "i = vid1")
             apply(auto)
             using frechet_continuous[OF good_interp freef1] by (auto simp add: continuous_on_const)           
          done
        have another_cont:"continuous_on (UNIV) 
         (\<lambda>x.
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
                 else Blinfun (\<lambda>_. 0)))"
          apply(rule continuous_on_compose2[of UNIV "(\<lambda>b. blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0)))"])
            apply(rule the_thing)
           by (auto intro!: continuous_intros)
        have ext:"(\<lambda>x. case x of
         (t, b) \<Rightarrow>
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0))) =(\<lambda>x.
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
            else Blinfun (\<lambda>_. 0))) " apply(rule ext, auto) 
          by (metis snd_conv)
        then show  "continuous_on (UNIV) 
         (\<lambda>x. case x of
         (t, b) \<Rightarrow>
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0)))"
          using another_cont
          by (simp add: another_cont local.ext)
     qed
     have old_continuous:" \<And>x. x \<in> UNIV \<Longrightarrow> continuous_on UNIV (\<lambda>t. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) x else 0)"
       by(rule continuous_on_const)
     interpret ll_old: ll_on_open_it "UNIV" ?xode ?xconstraint 0 
       apply(standard)
           subgoal by auto
          prefer 3 subgoal by auto
         prefer 3 subgoal by auto
        apply(rule old_lipschitz)
       by (rule old_continuous)
     let ?ivl = "(ll_old.existence_ivl 0 (sol 0))"
     let ?flow = "ll_old.flow 0 (sol 0)"
     have tclosed:"{0..t} = {0--t}" using t real_Icc_closed_segment by auto
     have "(sol  solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t} UNIV"
       apply(rule solves_ode_supset_range)
        apply(rule sol)
       by auto
     then have sol':"(sol  solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0--t} UNIV"
       using tclosed by auto
     have sub:"{0--t} \<subseteq> ll_old.existence_ivl 0 (sol 0)"
       apply(rule ll_old.closed_segment_subset_existence_ivl)
       apply(rule ll_old.existence_ivl_maximal_segment)
         apply(rule sol')
        apply(rule refl)
       by auto
     have usol_old:"(?flow  usolves_ode ?xode from 0) ?ivl UNIV"
       by(rule ll_old.flow_usolves_ode, auto)
     have sol_old:"(ll_old.flow 0 (sol 0) solves_ode ?xode) ?ivl UNIV"
       by(rule ll_old.flow_solves_ode, auto)
     have another_sub:"\<And>s. s \<in> {0..t} \<Longrightarrow> {s--0} \<subseteq> {0..t}"
       unfolding closed_segment_def
       apply auto
       by (metis diff_0_right diff_left_mono mult.commute mult_left_le order.trans)
     have sol_eq_flow:"\<And>s. s \<in> {0..t} \<Longrightarrow> sol s = ?flow s"
       using usol_old apply simp
       apply(drule usolves_odeD(4)) (* 7 subgoals*)
             apply auto
        subgoal for s x
        proof -
          assume xs0:"x \<in> {s--0}"
          assume s0:"0 \<le> s" and st: "s \<le> t"
          have "{s--0} \<subseteq> {0..t}" using another_sub[of s] s0 st by auto
          then have "x \<in> {0..t}" using xs0 by auto
          then have "x \<in> {0--t}" using tclosed by auto
          then show "x \<in> ll_old.existence_ivl 0 (sol 0)"
            using sub by auto
        qed
        apply(rule solves_ode_subset)
         using sol' apply auto[1]
        subgoal for s
        proof - 
          assume s0:"0 \<le> s" and st:"s \<le> t"
          show "{s--0} \<subseteq> {0--t}"
            using tclosed unfolding closed_segment using s0 st
            using another_sub intervalE by blast
        qed
       done
     have sol_deriv_orig:"\<And>s. s\<in>?ivl \<Longrightarrow>  (?flow has_derivative (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
       using sol_old apply simp
       apply(drule solves_odeD(1))
       by (auto simp add: has_vderiv_on_def has_vector_derivative_def)
     have sol_eta:"(\<lambda>t. \<chi> i. ?flow t $ i) = ?flow" by(rule ext, rule vec_extensionality, auto)
     have sol_deriv_eq1:"\<And>s i. (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (\<lambda>xa. \<chi> i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
       by(rule ext, rule vec_extensionality, auto)
     have sol_deriv_proj:"\<And>s i. s\<in>?ivl \<Longrightarrow>  ((\<lambda>t. ?flow t $ i) has_derivative (\<lambda>xa. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)) (at s within ?ivl)"         
       subgoal for s i
         apply(rule has_derivative_proj[of "(\<lambda> i t. ?flow t $ i)" "(\<lambda> i t'. (t' *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)" "(at s within ?ivl)" "i"])
         using sol_deriv_orig[of s] sol_eta sol_deriv_eq1 by auto
       done
     have sol_deriv_eq2:"\<And>s i. (\<lambda>xa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (\<lambda>xa. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)"
       by(rule ext, auto)
     have sol_deriv_proj':"\<And>s i. s\<in>?ivl \<Longrightarrow>  ((\<lambda>t. ?flow t $ i) has_derivative (\<lambda>xa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
       subgoal for s i using sol_deriv_proj[of s i] sol_deriv_eq2[of i s] by metis done  
     have sol_deriv_proj_vid1:"\<And>s. s\<in>?ivl \<Longrightarrow>  ((\<lambda>t. ?flow t $ vid1) has_derivative (\<lambda>xa. xa * (sterm_sem I (f1 fid1 vid1) (?flow s)))) (at s within ?ivl)"
       subgoal for s
         using sol_deriv_proj'[of s vid1] by auto done
     have deriv1_args:"\<And>s. s \<in> ?ivl \<Longrightarrow> ((\<lambda> t. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t))) has_derivative ((\<lambda> t'. \<chi> i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))) (at s within ?ivl)"
       apply(rule has_derivative_vec)
       by (auto simp add: sol_deriv_proj_vid1)          
     have con_fid:"\<And>fid. continuous_on ?ivl (\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x))"
       subgoal for fid
       apply(rule has_derivative_continuous_on[of "?ivl" "(\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x))"
           "(\<lambda>t t'.  FunctionFrechet I fid (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t)) (\<chi> i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow t) else 0)))"])
     proof -
       fix s
       assume ivl:"s \<in> ?ivl"
       let ?h = "(\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x))"
       let ?g = "Functions I fid"
       let ?f = "(\<lambda>x. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow x)))"
       let ?h' = "(\<lambda>t'. FunctionFrechet I fid (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
               (\<chi> i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))"
       let ?g' = "FunctionFrechet I fid (?f s)"
       let ?f' = "(\<lambda> t'. \<chi> i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
       have heq:"?h = ?g \<circ> ?f" unfolding comp_def f1_def expand_singleton by auto
       have heq':"?h' = ?g' \<circ> ?f'" unfolding comp_def by auto
       have fderiv:"(?f has_derivative ?f') (at s within ?ivl)"
         using deriv1_args[OF ivl] by auto
       have gderiv:"(?g has_derivative ?g') (at (?f s) within (?f ` ?ivl))"
         using good_interp unfolding is_interp_def 
         using  has_derivative_subset by blast
       have gfderiv:"((?g \<circ> ?f) has_derivative (?g' \<circ> ?f')) (at s within ?ivl)"
         using fderiv gderiv diff_chain_within by blast
       show "((\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x)) has_derivative
        (\<lambda>t'. FunctionFrechet I fid (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
               (\<chi> i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))))
        (at s within ?ivl)"
         using heq heq' gfderiv by auto
     qed
     done
     have con:"\<And>x. continuous_on (?ivl) (\<lambda>t. x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
       apply(rule continuous_on_add)
        apply(rule continuous_on_mult_left)
        apply(rule con_fid[of fid2])
       by(rule con_fid[of fid3])
     let ?axis = "(\<lambda> i. Blinfun(axis i))"
     have bounded_linear_deriv:"\<And>t. bounded_linear (\<lambda>y' . y' *\<^sub>R  sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))" 
       using bounded_linear_scaleR_left by blast
     have ll:"local_lipschitz (ll_old.existence_ivl 0 (sol 0)) UNIV (\<lambda>t y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
       apply(rule c1_implies_local_lipschitz[where f'="(\<lambda> (t,y). Blinfun(\<lambda>y' . y' *\<^sub>R  sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"])
          apply auto
        subgoal for t x
          apply(rule has_derivative_add_const)
          proof -
            have deriv:"((\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative (\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))) (at x)"
              by(auto intro: derivative_eq_intros)
            have eq:"(\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) = blinfun_apply (Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"
              apply(rule ext)
              using bounded_linear_deriv[of t]  by (auto simp add:  bounded_linear_Blinfun_apply)
            show "((\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative
               blinfun_apply (Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))))
               (at x)" using deriv eq by auto
          qed
       apply(auto intro: continuous_intros simp add: split_beta')
     proof -
       have bounded_linear:"\<And>x. bounded_linear (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x)" 
         by (simp add: bounded_linear_mult_left)
       have eq:"(\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x)) = (\<lambda>x. (sterm_sem I (f1 fid2 vid1) x) *\<^sub>R id_blinfun)"
         apply(rule ext, rule blinfun_eqI)
         subgoal for x i
           using bounded_linear[of x] apply(auto simp add: bounded_linear_Blinfun_apply)
           by (simp add: blinfun.scaleR_left)
         done
       have conFlow:"continuous_on (ll_old.existence_ivl 0 (sol 0)) (ll_old.flow 0 (sol 0))"
         using ll_old.general.flow_continuous_on by blast
       have conF':"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0)) 
             (\<lambda>x. (sterm_sem I (f1 fid2 vid1) x) *\<^sub>R id_blinfun)"
         apply(rule continuous_on_scaleR)
          apply(auto intro: continuous_intros)
         apply(rule sterm_continuous')
          apply(rule good_interp)
         by(auto simp add: f1_def intro: dfree.intros) 
       have conF:"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0)) 
             (\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x))"
         apply(rule continuous_on_compose2[of "UNIV" "(\<lambda>x. Blinfun (\<lambda>y'. y' * x))" "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "sterm_sem I (f1 fid2 vid1)"]) 
           subgoal by (metis blinfun_mult_left.abs_eq bounded_linear_blinfun_mult_left continuous_on_eq linear_continuous_on)
          apply(rule sterm_continuous')
           apply(rule good_interp)
         by(auto simp add: f1_def intro: dfree.intros) 
       show "continuous_on (ll_old.existence_ivl 0 (sol 0) \<times> UNIV) (\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) (fst x))))"
         apply(rule continuous_on_compose2[of "ll_old.existence_ivl 0 (sol 0)" "(\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x)))" "(ll_old.existence_ivl 0 (sol 0) \<times> UNIV)" "fst"])
           apply(rule continuous_on_compose2[of "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "(\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x))" 
                 "(ll_old.existence_ivl 0 (sol 0))" "(ll_old.flow 0 (sol 0))"])
             using conF conFlow by (auto intro!: continuous_intros)
       qed
     let ?ivl = "ll_old.existence_ivl 0 (sol 0)"
     \<comment> \<open>Construct solution to ODE for \<open>y'\<close> here:\<close>
     let ?yode = "(\<lambda>t y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
     let ?ysol0 = r
     interpret ll_new: ll_on_open_it "?ivl" "?yode" "UNIV" 0
       apply(standard)
           apply(auto)
        apply(rule ll)
       by(rule con)
     have sol_new:"(ll_new.flow 0 r solves_ode ?yode) (ll_new.existence_ivl 0 r) UNIV"
       by(rule ll_new.flow_solves_ode, auto)
     have more_lipschitz:"\<And>tm tM. tm \<in> ll_old.existence_ivl 0 (sol 0) \<Longrightarrow>
          tM \<in> ll_old.existence_ivl 0 (sol 0) \<Longrightarrow>
          \<exists>M L. \<forall>t\<in>{tm..tM}. \<forall>x. \<bar>x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t)\<bar> \<le> M + L * \<bar>x\<bar>"
     proof -
       fix tm tM
       assume tm:"tm \<in> ll_old.existence_ivl 0 (sol 0)"
       assume tM:"tM \<in> ll_old.existence_ivl 0 (sol 0)"
       let ?f2 = "(\<lambda>t. sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))"
       let ?f3 = "(\<lambda>t. sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) t))"
       let ?boundLP = "(\<lambda>L t . (tm \<le> t \<and> t \<le> tM \<longrightarrow> \<bar>?f2 t\<bar> \<le> L))"
       let ?boundL = "(SOME L. (\<forall>t. ?boundLP L t))"
       have compactT:"compact {tm..tM}" by auto
       have sub:"{tm..tM} \<subseteq> ll_old.existence_ivl 0 (sol 0)"
         by (metis atLeastatMost_empty_iff empty_subsetI ll_old.general.segment_subset_existence_ivl real_Icc_closed_segment tM tm)
       let ?f2abs = "(\<lambda>x. abs(?f2 x))"
       have neg_compact:"\<And>S::real set. compact S \<Longrightarrow> compact ((\<lambda>x. -x) ` S)"
         by(rule compact_continuous_image, auto intro: continuous_intros)
       have compactf2:"compact (?f2 ` {tm..tM})"
         apply(rule compact_continuous_image)
          apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid2 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
            apply(rule sterm_continuous)
             apply(rule good_interp)
            subgoal by (auto intro: dfree.intros simp add: f1_def)
           apply(rule continuous_on_subset)
            prefer 2 apply (rule sub)
           subgoal using ll_old.general.flow_continuous_on by blast
          by auto
       then have boundedf2:"bounded (?f2 ` {tm..tM})" using compact_imp_bounded by auto
       then have boundedf2neg:"bounded ((\<lambda>x. -x) ` ?f2 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
       then have bdd_above_f2neg:"bdd_above ((\<lambda>x. -x) ` ?f2 ` {tm..tM})" by (rule bounded_imp_bdd_above)
       then have bdd_above_f2:"bdd_above ( ?f2 ` {tm..tM})" using bounded_imp_bdd_above boundedf2 by auto
       have bdd_above_f2_abs:"bdd_above (abs ` ?f2 ` {tm..tM})" 
         using bdd_above_f2neg bdd_above_f2 unfolding bdd_above_def
         apply auto
         subgoal for M1 M2
           apply(rule exI[where x="max M1 M2"])
           by fastforce
         done
       then have theBound:"\<exists>L. (\<forall>t. ?boundLP L t)" 
         unfolding bdd_above_def norm_conv_dist 
         by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
       then have boundLP:"\<forall>t. ?boundLP (?boundL) t" using someI[of "(\<lambda> L. \<forall>t. ?boundLP L t)"] by blast
       let ?boundMP = "(\<lambda>M t. (tm \<le> t \<and> t \<le> tM \<longrightarrow> \<bar>?f3 t\<bar> \<le> M))"
       let ?boundM = "(SOME M. (\<forall>t. ?boundMP M t))"
       have compactf3:"compact (?f3 ` {tm..tM})"
         apply(rule compact_continuous_image)
          apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid3 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
            apply(rule sterm_continuous)
             apply(rule good_interp)
            subgoal by (auto intro: dfree.intros simp add: f1_def)
           apply(rule continuous_on_subset)
            prefer 2 apply (rule sub)
           subgoal using ll_old.general.flow_continuous_on by blast
          by auto
       then have boundedf3:"bounded (?f3 ` {tm..tM})" using compact_imp_bounded by auto
       then have boundedf3neg:"bounded ((\<lambda>x. -x) ` ?f3 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
       then have bdd_above_f3neg:"bdd_above ((\<lambda>x. -x) ` ?f3 ` {tm..tM})" by (rule bounded_imp_bdd_above)
       then have bdd_above_f3:"bdd_above ( ?f3 ` {tm..tM})" using bounded_imp_bdd_above boundedf3 by auto
       have bdd_above_f3_abs:"bdd_above (abs ` ?f3 ` {tm..tM})" 
         using bdd_above_f3neg bdd_above_f3 unfolding bdd_above_def
         apply auto
         subgoal for M1 M2
           apply(rule exI[where x="max M1 M2"])
           by fastforce
         done
       then have theBound:"\<exists>L. (\<forall>t. ?boundMP L t)"
         unfolding bdd_above_def norm_conv_dist
         by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
       then have boundMP:"\<forall>t. ?boundMP (?boundM) t" using someI[of "(\<lambda> M. \<forall>t. ?boundMP M t)"] by blast
       show "\<exists>M L. \<forall>t\<in>{tm..tM}. \<forall>x. \<bar>x * ?f2 t + ?f3 t\<bar> \<le> M + L * \<bar>x\<bar>"
         apply(rule exI[where x="?boundM"])
         apply(rule exI[where x="?boundL"])
         apply auto
       proof -
         fix t and x :: real
         assume ttm:"tm \<le> t"
         assume ttM:"t \<le> tM"
         from ttm ttM have ttmM:"tm \<le> t \<and> t \<le> tM" by auto 
         have leqf3:"\<bar>?f3 t\<bar> \<le> ?boundM" using boundMP ttmM by auto
         have leqf2:"\<bar>?f2 t\<bar> \<le> ?boundL" using boundLP ttmM by auto
         have gr0:" \<bar>x\<bar> \<ge> 0" by auto
         have leqf2x:"\<bar>?f2 t\<bar> * \<bar>x\<bar> \<le> ?boundL * \<bar>x\<bar>" using gr0 leqf2
           by (metis (no_types, lifting) real_scaleR_def scaleR_right_mono)
         have "\<bar>x * ?f2 t + ?f3 t\<bar> \<le> \<bar>x\<bar> * \<bar>?f2 t\<bar> + \<bar>?f3 t\<bar>"
           proof -
             have f1: "\<And>r ra. \<bar>r::real\<bar> * \<bar>ra\<bar> = \<bar>r * ra\<bar>"
               by (metis norm_scaleR real_norm_def real_scaleR_def)
             have "\<And>r ra. \<bar>(r::real) + ra\<bar> \<le> \<bar>r\<bar> + \<bar>ra\<bar>"
               by (metis norm_triangle_ineq real_norm_def)
               then show ?thesis
               using f1 by presburger
           qed
         moreover have "... = \<bar>?f3 t\<bar> + \<bar>?f2 t\<bar> * \<bar>x\<bar>"
           by auto
         moreover have "... \<le> ?boundM + \<bar>?f2 t\<bar> * \<bar>x\<bar>"
           using leqf3 by linarith
         moreover have "... \<le> ?boundM + ?boundL * \<bar>x\<bar>"
           using leqf2x  by linarith
         ultimately show "\<bar>x * ?f2 t + ?f3 t\<bar> \<le> ?boundM + ?boundL * \<bar>x\<bar>"
           by linarith
       qed
     qed
     have ivls_eq:"(ll_new.existence_ivl 0 r) = (ll_old.existence_ivl 0 (sol 0))"
       apply(rule ll_new.existence_ivl_eq_domain)
           apply auto
       apply (rule more_lipschitz)
       by auto
     have sub':"{0--t} \<subseteq> ll_new.existence_ivl 0 r"
       using sub ivls_eq by auto
     have sol_new':"(ll_new.flow 0 r solves_ode ?yode) {0--t} UNIV"
       by(rule solves_ode_subset, rule sol_new, rule sub')
     let ?soly = "ll_new.flow 0 r"
     let ?sol' = "(\<lambda>t. \<chi> i. if i = vid2 then ?soly t else sol t $ i)"
     let ?aaba' = "mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                              (OSing vid2
                                (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                  ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                          (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b)
                          (?sol' t)"
     have duh:"(fst ?aaba', snd ?aaba') = ?aaba'" by auto
     note bigEx = spec[OF spec[OF bigAll, where x="fst ?aaba'"], where x="snd ?aaba'"]
     have sol_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow> (sol has_derivative (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))) (at s within {0..t})"
        using sol apply simp
        by(drule solves_odeD(1), auto simp add: has_vderiv_on_def has_vector_derivative_def)
      have silly_eq1:"(\<lambda>t. \<chi> i. sol t $ i) = sol"
        by(rule ext, rule vec_extensionality, auto)
      have silly_eq2:"\<And>s. (\<lambda>xa. \<chi> i. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i) = (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))"
        by(rule ext, rule vec_extensionality, auto)
      have sol_proj_deriv:"\<And>s i. s \<in> {0..t} \<Longrightarrow> ((\<lambda> t. sol t $ i) has_derivative (\<lambda>xa. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i)) (at s within {0..t})"
        subgoal for s i
          apply(rule has_derivative_proj)
          using sol_deriv[of s] silly_eq1 silly_eq2[of s] by auto
        done
      have sol_proj_deriv_vid1:"\<And>s. s \<in> {0..t} \<Longrightarrow> ((\<lambda> t. sol t $ vid1) has_derivative (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (sol s))) (at s within {0..t})"
        subgoal for s using sol_proj_deriv[of s vid1] by auto done
      have sol_proj_deriv_other:"\<And>s i. s \<in> {0..t} \<Longrightarrow> i \<noteq> vid1 \<Longrightarrow> ((\<lambda> t. sol t $ i) has_derivative (\<lambda>xa. 0)) (at s within {0..t})"
        subgoal for s i using sol_proj_deriv[of s i] by auto done
      have fact:"\<And>x. x \<in>{0..t} \<Longrightarrow>
    (ll_new.flow 0 r has_derivative
     (\<lambda>xa. xa *\<^sub>R (ll_new.flow 0 r x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x) +
                   sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) x))))
     (at x within {0 .. t})"
        using sol_new' apply simp
        apply(drule solves_odeD(1))
        using tclosed unfolding has_vderiv_on_def has_vector_derivative_def by auto
      have new_sol_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow> (ll_new.flow 0 r has_derivative
       (\<lambda>xa. xa *\<^sub>R (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s))))
       (at s within {0.. t})"
        subgoal for s
          using fact[of s] tclosed sol_eq_flow[of s] by auto
        done
      have sterm_agree:"\<And>s. Vagree (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) {Inl vid1}"
        subgoal for s unfolding Vagree_def using vne12 by auto done
      have FVF:"(FVT (f1 fid2 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
      have FVF2:"(FVT (f1 fid3 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
      have sterm_agree_FVF:"\<And>s. Vagree (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid2 vid1))"
        using sterm_agree FVF by auto
      have sterm_agree_FVF2:"\<And>s. Vagree (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid3 vid1))"
        using sterm_agree FVF2 by auto
      have y_component_sem_eq2:"\<And>s. sterm_sem I (f1 fid2 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
         = sterm_sem I (f1 fid2 vid1) (sol s)"
        using coincidence_sterm[OF sterm_agree_FVF, of I] by auto
      have y_component_sem_eq3:"\<And>s. sterm_sem I (f1 fid3 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
         = sterm_sem I (f1 fid3 vid1) (sol s)"
        using coincidence_sterm[OF sterm_agree_FVF2, of I] by auto
      have y_component_ode_eq:"\<And>s. s \<in> {0..t} \<Longrightarrow> 
        (\<lambda>xa. xa * (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s)))
      = (\<lambda>xa. xa * (sterm_sem I (f1 fid2 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) * ll_new.flow 0 r s +
              sterm_sem I (f1 fid3 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s
          apply(rule ext)
          subgoal for xa
            using y_component_sem_eq2 y_component_sem_eq3 by auto
          done
        done
      have agree_vid1:"\<And>s. Vagree (sol s, undefined) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) {Inl vid1}"
        unfolding Vagree_def using vne12 by auto
      have FVT_vid1:"FVT(f1 fid1 vid1) = {Inl vid1}" apply(auto simp add: f1_def) subgoal for x xa apply(cases "xa = vid1") by auto done
      have agree_vid1_FVT:"\<And>s. Vagree (sol s, undefined) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (FVT (f1 fid1 vid1))"
        using FVT_vid1 agree_vid1 by auto
      have sterm_eq_vid1:"\<And>s. sterm_sem I (f1 fid1 vid1) (sol s) = sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"
        subgoal for  s
          using coincidence_sterm[OF agree_vid1_FVT[of s], of I] by auto
        done
      have vid1_deriv_eq:"\<And>s. (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) =
        (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
        subgoal for s
          apply(rule ext)
          subgoal for x'
            using sterm_eq_vid1[of s] by auto
          done done
      have inner_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow>
    ((\<lambda>t. \<chi> i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative (\<lambda>xa. (\<chi> i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
                                          if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))))
                                          (at s within {0..t})"
        subgoal for s
          apply(rule has_derivative_vec)
          subgoal for i
            apply(cases "i = vid2")
            subgoal
              using vne12
              using new_sol_deriv[of s]
              using y_component_ode_eq by auto
            subgoal 
              apply(cases "i = vid1")
              using sol_proj_deriv_vid1[of s] vid1_deriv_eq[of s] sol_proj_deriv_other[of s i] by auto
            done
          done
        done
      have deriv_eta:"\<And>s. (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
                (\<chi> i. if i = vid2
                      then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
                            (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
                      else 0)))
                      = (\<lambda>xa. (\<chi> i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
                                          if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))) "
        subgoal for s
          apply(rule ext)
          apply(rule vec_extensionality)
          using vne12 by auto
        done
      have sol'_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow>
    ((\<lambda>t. \<chi> i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative
     (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
                   (\<chi> i. if i = vid2
                         then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
                               (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
                         else 0))))
     (at s within {0..t})"
        subgoal for s
          using inner_deriv[of s] deriv_eta[of s] by auto done
      have FVT:"\<And>i. FVT (if i = vid1 then trm.Var vid1 else Const 0) \<subseteq> {Inl vid1}" by auto
      have agree:"\<And>s. Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) {Inl vid1}"
        subgoal for s
          using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol s)"]
          using mk_v_agree [of I "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))" "(\<chi> y. if vid2 = y then r else fst (a, b) $ y, b)" "(\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"]
          unfolding Vagree_def using vne12 by simp
        done
      have agree':"\<And>s i. Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) (FVT (if i = vid1 then trm.Var vid1 else Const 0))"
        subgoal for s i using agree_sub[OF FVT[of i] agree[of s]] by auto done
      have safe:"\<And>i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)" subgoal for i apply(cases "i = vid1", auto) done done           
      have dterm_sem_eq:"\<And>s i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) 
        = dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
        (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
        subgoal for s i using coincidence_dterm[OF safe[of i] agree'[of s i], of I] by auto done
      have dterm_vec_eq:"\<And>s. (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)))
        = (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
        (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s
          apply(rule vec_extensionality)
          subgoal for i using dterm_sem_eq[of i s] by auto
          done done
      have pred_same:"\<And>s. s \<in> {0..t} \<Longrightarrow> Predicates I vid1
         (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s))) \<Longrightarrow>
 Predicates I vid1
  (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
         (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s using dterm_vec_eq[of s] by auto done
    have sol'_domain:"\<And>s. 0 \<le> s \<Longrightarrow>
   s \<le> t \<Longrightarrow>
   Predicates I vid1
    (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
           (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                         (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s
          using sol apply simp
          apply(drule solves_odeD(2))
          using pred_same[of s] by auto
        done
      have sol':"(?sol' solves_ode
  (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
         (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
  {0..t} {x. Predicates I vid1
              (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                     (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                               (OSing vid2
                                 (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                   ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                       (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) x))}"
        apply(rule solves_odeI)
        subgoal
          unfolding has_vderiv_on_def has_vector_derivative_def
          using sol'_deriv by auto
        by(auto, rule sol'_domain, auto)
      have set_eq:"{y. y = vid2 \<or> y = vid1 \<or> y = vid2 \<or> y = vid1 \<or> (\<exists>x. Inl y \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))} = {vid1, vid2}"
        by auto
      have "VSagree (?sol' 0) (\<chi> y. if vid2 = y then r else fst (a, b) $ y) {vid1, vid2}"
        using VSA unfolding VSagree_def by simp 
      then have VSA':" VSagree (?sol' 0) (\<chi> y. if vid2 = y then r else fst (a, b) $ y)
        
  {y. y = vid2 \<or> y = vid1 \<or> y = vid2 \<or> y = vid1 \<or> (\<exists>x. Inl y \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))} "
        by (auto simp add: set_eq)
      have bigPre:"(\<exists>sol t. (fst ?aaba', snd ?aaba') =
                     mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                              (OSing vid2
                                (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                  ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                      ((\<chi> y. if vid2 = y then r else fst (a,b) $ y), b) (sol t) \<and>
                     0 \<le> t \<and>
                     (sol solves_ode
                      (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
                             (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
                      {0..t} {x. Predicates I vid1
                                  (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                         (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                                                   (OSing vid2
                                                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                                           ((\<chi> y. if vid2 = y then r else (fst (a,b)) $ y), b) x))} \<and>
                     VSagree (sol 0) (\<chi> y. if vid2 = y then r else fst (a,b) $ y)
                      {uu. uu = vid2 \<or>
                     uu = vid1 \<or>
                     uu = vid2 \<or>
                     uu = vid1 \<or>
                     Inl uu \<in> Inl ` ({x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<union>
                                      {x. x = vid2 \<or> (\<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) \<or>
                     (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))})"
        apply(rule exI[where x="?sol'"])
        apply(rule exI[where x=t])
        apply(rule conjI)
         subgoal by simp
        apply(rule conjI)
         subgoal by (rule t)
        apply(rule conjI)
         apply(rule sol')
         using VSA' unfolding VSagree_def by auto
      have pred_sem:"Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
        using mp[OF bigEx bigPre] by auto
      let ?other_state = "(mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t))"
      have agree:"Vagree (?aaba') (?other_state) {Inl vid1} "
        using mk_v_agree [of "I" "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))"
          "(\<chi> y. if vid2 = y then r else fst (a, b) $ y, b)" "(?sol' t)"]
        using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol t)"]
        unfolding Vagree_def using vne12 by simp
      have sub:"\<And>i. FVT (if i = vid1 then trm.Var vid1 else Const 0) \<subseteq> {Inl vid1}"
        by auto
      have agree':"\<And>i. Vagree (?aaba') (?other_state) (FVT (if i = vid1 then trm.Var vid1 else Const 0)) "
        subgoal for i using agree_sub[OF sub[of i] agree] by auto done
      have silly_safe:"\<And>i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)"
        subgoal for i
          apply(cases "i = vid1")
           by (auto simp add: dsafe_Var dsafe_Const)
        done
      have dsem_eq:"(\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')  = 
         (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?other_state)"
        apply(rule vec_extensionality)
        subgoal for i
          using coincidence_dterm[OF silly_safe[of i] agree'[of i], of I] by auto
        done
      show
     "Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)))"
      using pred_sem dsem_eq by auto
  qed
 
 
 done
 qed
 end end
 
diff --git a/thys/Ergodic_Theory/Gouezel_Karlsson.thy b/thys/Ergodic_Theory/Gouezel_Karlsson.thy
--- a/thys/Ergodic_Theory/Gouezel_Karlsson.thy
+++ b/thys/Ergodic_Theory/Gouezel_Karlsson.thy
@@ -1,1810 +1,1810 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     License: BSD
 *)
 
 section \<open>Gouezel-Karlsson\<close>
 
 theory Gouezel_Karlsson
   imports Asymptotic_Density Kingman
 begin
 
 text \<open>This section is devoted to the proof of the main ergodic result of
 the article "Subadditive and multiplicative ergodic theorems" by Gouezel and
 Karlsson~\cite{gouezel_karlsson}. It is a version of Kingman
 theorem ensuring that, for subadditive cocycles, there are almost surely
 many times $n$ where the cocycle is nearly additive at \emph{all} times
 between $0$ and $n$.
 
 This theorem is then used in this article to construct horofunctions
 characterizing the behavior at infinity of compositions
 of semi-contractions. This requires too many further notions to be implemented
 in current Isabelle/HOL, but the main ergodic result is completely
 proved below, in Theorem~\verb+Gouezel_Karlsson+, following the arguments in the paper (but in a
 slightly more general setting here as we are not making any ergodicity assumption).
 
 To simplify the exposition, the theorem is proved assuming that the limit of the subcocycle
 vanishes almost everywhere, in the locale \verb+Gouezel_Karlsson_Kingman+.
 The final result is proved by an easy reduction to this case.
 
 The main steps of the proof are as follows:
 \begin{itemize}
 \item assume first that the map is invertible, and consider the inverse map and the corresponding
 inverse subcocycle. With combinatorial arguments that only work for this inverse subcocycle, we
 control the density of bad times given some allowed error $d>0$, in a precise quantitative way, in
 Lemmas~\verb+upper_density_all_times+ and~\verb+upper_density_large_k+. We put these estimates
 together in Lemma~\verb+upper_density_delta+.
 \item These estimates are then transfered to the original time direction and the original subcocycle in
 Lemma~\verb+upper_density_good_direction_invertible+. The fact that we have quantitative estimates
 in terms of asymptotic densities is central here, just having some infiniteness statement would not be
 enough.
 \item The invertibility assumption is removed in Lemma~\verb+upper_density_good_direction+ by
 using the result in the natural extension.
 \item Finally, the main result is deduced in Lemma~\verb+infinite_AE+ (still assuming that the
 asymptotic limit vanishes almost everywhere), and in full generality in
 Theorem~\verb+Gouezel_Karlsson_Kingman+.
 \end{itemize}
 \<close>
 
 
 lemma upper_density_eventually_measure:
   fixes a::real
   assumes [measurable]: "\<And>n. {x \<in> space M. P x n} \<in> sets M"
     and "emeasure M {x \<in> space M. upper_asymptotic_density {n. P x n} < a} > b"
   shows "\<exists>N. emeasure M {x \<in> space M. \<forall>n \<ge> N. card ({n. P x n} \<inter> {..<n}) < a * n} > b"
 proof -
   define G where "G = {x \<in> space M. upper_asymptotic_density {n. P x n} < a}"
   define H where "H = (\<lambda>N. {x \<in> space M. \<forall>n \<ge> N. card ({n. P x n} \<inter> {..<n}) < a * n})"
   have [measurable]: "G \<in> sets M" "\<And>N. H N \<in> sets M" unfolding G_def H_def by auto
   have "G \<subseteq> (\<Union>N. H N)"
   proof
     fix x assume "x \<in> G"
     then have "x \<in> space M" unfolding G_def by simp
     have "eventually (\<lambda>n. card({n. P x n} \<inter> {..<n}) < a * n) sequentially"
       using \<open>x \<in> G\<close> unfolding G_def using upper_asymptotic_densityD by auto
     then obtain N where "\<And>n. n \<ge> N \<Longrightarrow> card({n. P x n} \<inter> {..<n}) < a * n"
       using eventually_sequentially by auto
     then have "x \<in> H N" unfolding H_def using \<open>x \<in> space M\<close> by auto
     then show "x \<in> (\<Union>N. H N)" by blast
   qed
   have "b < emeasure M G" using assms(2) unfolding G_def by simp
   also have "... \<le> emeasure M (\<Union>N. H N)"
     apply (rule emeasure_mono) using \<open>G \<subseteq> (\<Union>N. H N)\<close> by auto
   finally have "emeasure M (\<Union>N. H N) > b" by simp
   moreover have "(\<lambda>N. emeasure M (H N)) \<longlonglongrightarrow> emeasure M (\<Union>N. H N)"
     apply (rule Lim_emeasure_incseq) unfolding H_def incseq_def by auto
   ultimately have "eventually (\<lambda>N. emeasure M (H N) > b) sequentially"
     by (simp add: order_tendsto_iff)
   then obtain N where "emeasure M (H N) > b"
     using eventually_False_sequentially eventually_mono by blast
   then show ?thesis unfolding H_def by blast
 qed
 
 
 locale Gouezel_Karlsson_Kingman = pmpt +
   fixes u::"nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes subu: "subcocycle u"
     and subu_fin: "subcocycle_avg_ereal u > -\<infinity>"
     and subu_0: "AE x in M. subcocycle_lim u x = 0"
 begin
 
 lemma int_u [measurable]:
   "integrable M (u n)"
 using subu unfolding subcocycle_def by auto
 
 text \<open>Next lemma is Lemma 2.1 in~\cite{gouezel_karlsson}.\<close>
 
 lemma upper_density_all_times:
   assumes "d > (0::real)"
   shows "\<exists>c> (0::real).
         emeasure M {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - c * l} < d} > 1 - d"
 proof -
   define f where "f = (\<lambda>x. abs (u 1 x))"
   have [measurable]: "f \<in> borel_measurable M" unfolding f_def by auto
   define G where "G = {x \<in> space M. (\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x
                       \<and> (\<lambda>n. u n x / n) \<longlonglongrightarrow> 0}"
   have [measurable]: "G \<in> sets M" unfolding G_def by auto
   have "AE x in M. (\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
     apply (rule birkhoff_theorem_AE_nonergodic) using subu unfolding f_def subcocycle_def by auto
   moreover have "AE x in M. (\<lambda>n. u n x / n) \<longlonglongrightarrow> 0"
     using subu_0 kingman_theorem_nonergodic(1)[OF subu subu_fin] by auto
   ultimately have "AE x in M. x \<in> G" unfolding G_def by auto
   then have "emeasure M G = 1" by (simp add: emeasure_eq_1_AE)
 
   define V where "V = (\<lambda>c x. {n. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - c * l})"
   define Good where "Good = (\<lambda>c. {x \<in> G. upper_asymptotic_density (V c x) < d})"
   have [measurable]: "Good c \<in> sets M" for c unfolding Good_def V_def by auto
 
   have I: "upper_asymptotic_density (V c x) \<le> real_cond_exp M Invariants f x / c" if "c>0" "x \<in> G" for c x
   proof -
     have [simp]: "c>0" "c \<noteq> 0" "c \<ge> 0" using \<open>c>0\<close> by auto
     define U where "U = (\<lambda>n. abs(u 0 x) + birkhoff_sum f n x - c * card (V c x \<inter> {1..n}))"
     have main: "u n x \<le> U n" for n
     proof (rule nat_less_induct)
       fix n assume H: "\<forall>m<n. u m x \<le> U m"
       consider "n = 0" | "n\<ge>1 \<and> n \<notin> V c x" | "n\<ge>1 \<and> n \<in> V c x" by linarith
       then show "u n x \<le> U n"
       proof (cases)
         assume "n = 0"
         then show ?thesis unfolding U_def by auto
       next
         assume A: "n\<ge>1 \<and> n \<notin> V c x"
         then have "n \<ge> 1" by simp
         then have "n-1<n" by simp
         have "{1..n} = {1..n-1} \<union> {n}" using \<open>1 \<le> n\<close> atLeastLessThanSuc by auto
         then have *: "card (V c x \<inter> {1..n}) = card (V c x \<inter> {1..n-1})" using A by auto
         have "u n x \<le> u (n-1) x + u 1 ((T^^(n-1)) x)"
           using \<open>n\<ge>1\<close> subu unfolding subcocycle_def by (metis le_add_diff_inverse2)
         also have "... \<le> U (n-1) + f ((T^^(n-1)) x)" unfolding f_def using H \<open>n-1<n\<close> by auto
         also have "... = abs(u 0 x) + birkhoff_sum f (n-1) x + f ((T^^(n-1)) x) - c * card (V c x \<inter> {1..n-1})"
           unfolding U_def by auto
         also have "... = abs(u 0 x) + birkhoff_sum f n x - c * card (V c x \<inter> {1..n})"
           using * birkhoff_sum_cocycle[of f "n-1" 1 x] \<open>1 \<le> n\<close> by auto
         also have "... = U n" unfolding U_def by simp
         finally show ?thesis by auto
       next
         assume B: "n\<ge>1 \<and> n \<in> V c x"
         then obtain l where l: "l\<in>{1..n}" "u n x - u (n-l) x \<le> - c * l" unfolding V_def by blast
         then have "n-l < n" by simp
         have m: "- (r * ra) - r * rb = - (r * (rb + ra))" for r ra rb::real
           by (simp add: algebra_simps)
 
         have "card(V c x \<inter> {1..n}) \<le> card ((V c x \<inter> {1..n-l}) \<union> {n-l+1..n})"
           by (rule card_mono, auto)
         also have "... \<le> card (V c x \<inter> {1..n-l}) + card {n-l+1..n}"
           by (rule card_Un_le)
         also have "... \<le> card (V c x \<inter> {1..n-l}) + l" by auto
         finally have "card(V c x \<inter> {1..n}) \<le> card (V c x \<inter> {1..n-l}) + real l" by auto
         then have *: "-c * card (V c x \<inter> {1..n-l}) - c * l \<le> -c * card(V c x \<inter> {1..n})"
           using m by auto
 
         have "birkhoff_sum f ((n-l) + l) x = birkhoff_sum f (n-l) x + birkhoff_sum f l ((T^^(n-l))x)"
           by (rule birkhoff_sum_cocycle)
         moreover have "birkhoff_sum f l ((T^^(n-l))x) \<ge> 0"
           unfolding f_def birkhoff_sum_def using sum_nonneg by auto
         ultimately have **: "birkhoff_sum f (n-l) x \<le> birkhoff_sum f n x" using l(1) by auto
 
         have "u n x \<le> u (n-l) x - c * l" using l by simp
         also have "... \<le> U (n-l) - c* l" using H \<open>n-l < n\<close> by auto
         also have "... = abs(u 0 x) + birkhoff_sum f (n-l) x - c * card (V c x \<inter> {1..n-l}) - c*l"
           unfolding U_def by auto
         also have "... \<le> abs(u 0 x) + birkhoff_sum f n x - c * card (V c x \<inter> {1..n})"
           using * ** by simp
         finally show ?thesis unfolding U_def by auto
       qed
     qed
 
     have "(\<lambda>n. abs(u 0 x) * (1/n) + birkhoff_sum f n x / n - u n x / n) \<longlonglongrightarrow> abs(u 0 x) * 0 + real_cond_exp M Invariants f x - 0"
       apply (intro tendsto_intros) using \<open>x \<in> G\<close> unfolding G_def by auto
     moreover have "(abs(u 0 x) + birkhoff_sum f n x - u n x)/n = abs(u 0 x) * (1/n) + birkhoff_sum f n x / n - u n x / n" for n
       by (auto simp add: add_divide_distrib diff_divide_distrib)
     ultimately have "(\<lambda>n. (abs(u 0 x) + birkhoff_sum f n x - u n x)/n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
       by auto
     then have a: "limsup (\<lambda>n. (abs(u 0 x) + birkhoff_sum f n x - u n x)/n) = real_cond_exp M Invariants f x"
       by (simp add: assms lim_imp_Limsup)
 
     have "c * card (V c x \<inter> {1..n})/n \<le> (abs(u 0 x) + birkhoff_sum f n x - u n x)/n" for n
       using main[of n] unfolding U_def by (simp add: divide_right_mono)
     then have "limsup (\<lambda>n. c * card (V c x \<inter> {1..n})/n) \<le> limsup (\<lambda>n. (abs(u 0 x) + birkhoff_sum f n x - u n x)/n)"
       by (simp add: Limsup_mono)
     then have b: "limsup (\<lambda>n. c * card (V c x \<inter> {1..n})/n) \<le> real_cond_exp M Invariants f x"
       using a by simp
 
     have "ereal(upper_asymptotic_density (V c x)) = limsup (\<lambda>n. card (V c x \<inter> {1..n})/n)"
       using upper_asymptotic_density_shift[of "V c x" 1 0] by auto
     also have "... = limsup (\<lambda>n. ereal(1/c) * ereal(c * card (V c x \<inter> {1..n})/n))"
       by auto
     also have "... = (1/c) * limsup (\<lambda>n. c * card (V c x \<inter> {1..n})/n)"
       by (rule limsup_ereal_mult_left, auto)
     also have "... \<le> ereal (1/c) * real_cond_exp M Invariants f x"
       by (rule ereal_mult_left_mono[OF b], auto)
     finally show "upper_asymptotic_density (V c x) \<le> real_cond_exp M Invariants f x / c"
       by auto
   qed
 
   {
     fix r::real
     obtain c::nat where "r / d < c" using reals_Archimedean2 by auto
     then have "r/d < real c+1" by auto
     then have "r / (real c+1) < d" using \<open>d>0\<close> by (simp add: divide_less_eq mult.commute)
     then have "\<exists>c::nat. r / (real c+1) < d" by auto
   }
   then have unG: "(\<Union>c::nat. {x \<in> G. real_cond_exp M Invariants f x / (c+1) < d}) = G"
     by auto
 
   have *: "r < d * (real n + 1)" if "m \<le> n" "r < d * (real m + 1)" for m n r
   proof -
     have "d * (real m + 1) \<le> d * (real n + 1)" using \<open>d>0\<close> \<open>m \<le> n\<close> by auto
     then show ?thesis using \<open>r < d * (real m + 1)\<close> by auto
   qed
   have "(\<lambda>c. emeasure M {x \<in> G. real_cond_exp M Invariants f x / (real c+1) < d})
           \<longlonglongrightarrow> emeasure M (\<Union>c::nat. {x \<in> G. real_cond_exp M Invariants f x / (c+1) < d})"
     apply (rule Lim_emeasure_incseq) unfolding incseq_def by (auto simp add: divide_simps *)
   then have "(\<lambda>c. emeasure M {x \<in> G. real_cond_exp M Invariants f x / (real c+1) < d}) \<longlonglongrightarrow> emeasure M G"
     using unG by auto
   then have "(\<lambda>c. emeasure M {x \<in> G. real_cond_exp M Invariants f x / (real c+1) < d}) \<longlonglongrightarrow> 1"
     using \<open>emeasure M G = 1\<close> by simp
   then have "eventually (\<lambda>c. emeasure M {x \<in> G. real_cond_exp M Invariants f x / (real c+1) < d} > 1 - d) sequentially"
     apply (rule order_tendstoD)
     apply (insert \<open>0<d\<close>, auto simp add: ennreal_1[symmetric] ennreal_lessI simp del: ennreal_1)
     done
   then obtain c0 where c0: "emeasure M {x \<in> G. real_cond_exp M Invariants f x / (real c0+1) < d} > 1 - d"
     using eventually_sequentially by auto
   define c where "c = real c0 + 1"
   then have "c > 0" by auto
   have *: "emeasure M {x \<in> G. real_cond_exp M Invariants f x / c < d} > 1 - d"
     unfolding c_def using c0 by auto
   have "{x \<in> G. real_cond_exp M Invariants f x / c < d} \<subseteq> {x \<in> space M. upper_asymptotic_density (V c x) < d}"
     apply auto
     using G_def apply blast
     using I[OF \<open>c>0\<close>] by fastforce
   then have "emeasure M {x \<in> G. real_cond_exp M Invariants f x / c < d} \<le> emeasure M {x \<in> space M. upper_asymptotic_density (V c x) < d}"
     apply (rule emeasure_mono) unfolding V_def by auto
   then have "emeasure M {x \<in> space M. upper_asymptotic_density (V c x) < d} > 1 - d" using * by auto
   then show ?thesis unfolding V_def using \<open>c>0\<close> by auto
 qed
 
 text \<open>Next lemma is Lemma 2.2 in~\cite{gouezel_karlsson}.\<close>
 
 lemma upper_density_large_k:
   assumes "d > (0::real)" "d \<le> 1"
   shows "\<exists>k::nat.
         emeasure M {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} < d} > 1 - d"
 proof -
   have [simp]: "d>0" "d \<noteq> 0" "d \<ge> 0" using \<open>d>0\<close> by auto
   define rho where "rho = d * d * d / 4"
   have [simp]: "rho > 0" "rho \<noteq> 0" "rho \<ge> 0" unfolding rho_def using assms by auto
 
   text \<open>First step: choose a time scale $s$ at which all the computations will be done. the
   integral of $u_s$ should be suitably small -- how small precisely is given by $\rho$.\<close>
   have "ennreal(\<integral>x. abs(u n x / n) \<partial>M) = (\<integral>\<^sup>+x. abs(u n x /n - subcocycle_lim u x) \<partial>M)" for n
   proof -
     have "ennreal(\<integral>x. abs(u n x / n) \<partial>M) = (\<integral>\<^sup>+x. abs(u n x /n) \<partial>M)"
       apply (rule nn_integral_eq_integral[symmetric]) using int_u by auto
     also have "... = (\<integral>\<^sup>+x. abs(u n x /n - subcocycle_lim u x) \<partial>M)"
       apply (rule nn_integral_cong_AE) using subu_0 by auto
     finally show ?thesis by simp
   qed
   moreover have "(\<lambda>n. \<integral>\<^sup>+x. abs(u n x /n - subcocycle_lim u x) \<partial>M) \<longlonglongrightarrow> 0"
     by (rule kingman_theorem_nonergodic(3)[OF subu subu_fin])
   ultimately have "(\<lambda>n. ennreal(\<integral>x. abs(u n x / n) \<partial>M)) \<longlonglongrightarrow> 0"
     by auto
   then have "(\<lambda>n. (\<integral>x. abs(u n x / n) \<partial>M)) \<longlonglongrightarrow> 0"
     by (simp add: ennreal_0[symmetric] del: ennreal_0)
   then have "eventually (\<lambda>n. (\<integral>x. abs(u n x / n) \<partial>M) < rho) sequentially"
     by (rule order_tendstoD(2), auto)
   then obtain s::nat where [simp]: "s>0" and s_int: "(\<integral>x. abs(u s x / s) \<partial>M) < rho"
     by (metis (mono_tags, lifting) neq0_conv eventually_sequentially gr_implies_not0
         linorder_not_le of_nat_0_eq_iff order_refl zero_neq_one)
 
   text \<open>Second step: a truncation argument, to decompose $|u_1|$ as a sum of a constant (its
   contribution will be small if $k$ is large at the end of the argument) and of a function with
   small integral).\<close>
 
   have "(\<lambda>n. (\<integral>x. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x \<partial>M)) \<longlonglongrightarrow> (\<integral>x. 0 \<partial>M)"
   proof (rule integral_dominated_convergence[where ?w = "\<lambda>x. abs(u 1 x)"])
     show "AE x in M. norm (abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x) \<le> abs(u 1 x)" for n
       unfolding indicator_def by auto
     {
       fix x
       have "abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x = (0::real)" if "n > abs(u 1 x)" for n::nat
         unfolding indicator_def using that by auto
       then have "eventually (\<lambda>n. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x = 0) sequentially"
         by (metis (mono_tags, lifting) eventually_at_top_linorder reals_Archimedean2 less_le_trans of_nat_le_iff)
       then have "(\<lambda>n. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x) \<longlonglongrightarrow> 0"
         by (rule tendsto_eventually)
     }
     then show "AE x in M. (\<lambda>n. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x) \<longlonglongrightarrow> 0"
       by simp
   qed (auto simp add: int_u)
   then have "eventually (\<lambda>n. (\<integral>x. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> n} x \<partial>M) < rho) sequentially"
     by (rule order_tendstoD(2), auto)
   then obtain Knat::nat where Knat: "Knat > 0" "(\<integral>x. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> Knat} x \<partial>M) < rho"
     by (metis (mono_tags, lifting) eventually_sequentially gr_implies_not0 neq0_conv
         linorder_not_le of_nat_0_eq_iff order_refl zero_neq_one)
   define K where "K = real Knat"
   then have [simp]: "K \<ge> 0" "K>0" and K: "(\<integral>x. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> K} x \<partial>M) < rho"
     using Knat by auto
 
   define F where "F = (\<lambda>x. abs(u 1 x) * indicator {x. abs(u 1 x) \<ge> K} x)"
   have int_F [measurable]: "integrable M F"
     unfolding F_def apply (rule Bochner_Integration.integrable_bound[where ?f = "\<lambda>x. abs(u 1 x)"])
     unfolding indicator_def by (auto simp add: int_u)
   have "(\<integral>x. F x \<partial>M) = (\<integral>x. abs(u 1 x) * indicator {x \<in> space M. abs(u 1 x) \<ge> K} x \<partial>M)"
     apply (rule integral_cong_AE) unfolding F_def by (auto simp add: indicator_def)
   then have F_int: "(\<integral>x. F x \<partial>M) < rho" using K by auto
   have F_pos: "F x \<ge> 0" for x unfolding F_def by auto
   have u1_bound: "abs(u 1 x) \<le> K + F x" for x
     unfolding F_def indicator_def apply (cases "x \<in> {x \<in> space M. K \<le> \<bar>u 1 x\<bar>}") by auto
 
   define F2 where "F2 = (\<lambda>x. F x + abs(u s x/s))"
   have int_F2 [measurable]: "integrable M F2"
     unfolding F2_def using int_F int_u[of s] by auto
   have F2_pos: "F2 x \<ge> 0" for x unfolding F2_def using F_pos by auto
   have "(\<integral>x. F2 x \<partial>M) = (\<integral>x. F x \<partial>M) + (\<integral>x. abs(u s x/s) \<partial>M)"
     unfolding F2_def apply (rule Bochner_Integration.integral_add) using int_F int_u by auto
   then have F2_int: "(\<integral>x. F2 x \<partial>M) < 2 * rho"
     using F_int s_int by auto
 
   text \<open>We can now choose $k$, large enough. The reason for our choice will only appear
   at the end of the proof.\<close>
   define k where "k = max (2 * s + 1) (nat(ceiling((2 * d * s + 2 * K * s)/(d/2))))"
   have "k > 2 * s" unfolding k_def by auto
   have "k \<ge> (2 * d * s + 2 * K * s)/(d/2)"
     unfolding k_def by linarith
   then have "(2 * d * s + 2 * K * s)/k \<le> d/2"
     using \<open>k > 2 * s\<close> by (simp add: divide_simps mult.commute)
 
 
   text \<open>Third step: definition of a good set $G$ where everything goes well.\<close>
 
   define G where "G = {x \<in> space M. (\<lambda>n. u n x / n) \<longlonglongrightarrow> 0
                       \<and> (\<lambda>n. birkhoff_sum (\<lambda>x. abs(u s x / s)) n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. abs(u s x / s)) x
                       \<and> (\<lambda>n. birkhoff_sum F n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants F x
                       \<and> real_cond_exp M Invariants F x + real_cond_exp M Invariants (\<lambda>x. abs(u s x / s)) x = real_cond_exp M Invariants F2 x}"
   have [measurable]: "G \<in> sets M" unfolding G_def by auto
   have "AE x in M. (\<lambda>n. u n x / n) \<longlonglongrightarrow> 0"
     using kingman_theorem_nonergodic(1)[OF subu subu_fin] subu_0 by auto
   moreover have "AE x in M.(\<lambda>n. birkhoff_sum (\<lambda>x. abs(u s x / s)) n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. abs(u s x / s)) x"
     apply (rule birkhoff_theorem_AE_nonergodic) using int_u[of s] by auto
   moreover have "AE x in M. (\<lambda>n. birkhoff_sum F n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants F x"
     by (rule birkhoff_theorem_AE_nonergodic[OF int_F])
   moreover have "AE x in M. real_cond_exp M Invariants F x + real_cond_exp M Invariants (\<lambda>x. abs(u s x / s)) x = real_cond_exp M Invariants F2 x"
     unfolding F2_def apply (rule AE_symmetric[OF real_cond_exp_add]) using int_u[of s] int_F int_u[of s] by auto
   ultimately have "AE x in M. x \<in> G" unfolding G_def by auto
   then have "emeasure M G = 1" by (simp add: emeasure_eq_1_AE)
 
   text \<open>Estimation of asymptotic densities of bad times, for points in $G$.
   There is a trivial part, named $U$ below, that has to be treated separately because it creates
   problematic boundary effects.\<close>
 
   define U where "U = (\<lambda>x. {n. \<exists>l \<in> {n-s<..n}. u n x - u (n-l) x \<le> - d * l})"
   define V where "V = (\<lambda>x. {n. \<exists>l \<in> {k..n-s}. u n x - u (n-l) x \<le> - d * l})"
 
   text \<open>Trivial estimate for $U(x)$: this set is finite for $x\in G$.\<close>
 
   have densU: "upper_asymptotic_density (U x) = 0" if "x \<in> G" for x
   proof -
     define C where "C = Max {abs(u m x) |m. m<s} + d * s"
     have *: "U x \<subseteq> {n. u n x \<le> C - d * n}"
     proof (auto)
       fix n assume "n \<in> U x"
       then obtain l where l: "l\<in> {n-s <..n}" "u n x - u (n-l) x \<le> - d * l" unfolding U_def by auto
       define m where "m = n-l"
       have "m < s" unfolding m_def using l by auto
       have "u n x \<le> u m x - d * l" using l m_def by auto
       also have "... \<le> abs(u m x) - d * n + d * m" unfolding m_def using l
         by (simp add: algebra_simps of_nat_diff)
       also have "... \<le> Max {abs(u m x) |m. m<s} - d * n + d * m"
         using \<open>m < s\<close> apply (auto) by (rule Max_ge, auto)
       also have "... \<le> Max {abs(u m x) |m. m<s} + d * s - d * n"
         using \<open>m < s\<close> \<open>d>0\<close> by auto
       finally show "u n x \<le> C - d * n"
         unfolding C_def by auto
     qed
     have "eventually (\<lambda>n. u n x / n > -d/2) sequentially"
       apply (rule order_tendstoD(1)) using \<open>x \<in> G\<close> \<open>d>0\<close> unfolding G_def by auto
     then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> u n x / n > - d/2"
       using eventually_sequentially by auto
     {
       fix n assume *: "u n x \<le> C - d * n" "n > N"
       then have "n \<ge> N" "n > 0" by auto
       have "2 * u n x \<le> 2 * C - 2 * d * n" using * by auto
       moreover have "2 * u n x \<ge> - d * n" using N[OF \<open>n \<ge> N\<close>] \<open>n > 0\<close> by (simp add: divide_simps)
       ultimately have "- d * n \<le> 2 * C - 2 * d * n" by auto
       then have "d * n \<le> 2 * C" by auto
       then have "n \<le> 2 * C / d" using \<open>d>0\<close> by (simp add: mult.commute divide_simps)
     }
     then have "{n. u n x \<le> C - d * n} \<subseteq> {..max (nat (floor(2*C/d))) N}"
       by (auto, meson le_max_iff_disj le_nat_floor not_le)
     then have "finite {n. u n x \<le> C - d * n}"
       using finite_subset by blast
     then have "finite (U x)" using * finite_subset by blast
     then show ?thesis using upper_asymptotic_density_finite by auto
   qed
 
   text \<open>Main step: control of $u$ along the sequence $ns+t$, with a term
   $-(d/2) Card(V(x) \cap [1,ns+t])$ on the right.
   Then, after averaging in $t$, Birkhoff theorem will imply that
   $Card(V(x) \cap [1,n])$ is suitably small.\<close>
 
   define Z where "Z = (\<lambda>t n x. Max {u i x|i. i< s} + (\<Sum>i<n. abs(u s ((T^^(i * s + t))x)))
                   + birkhoff_sum F (n * s + t) x - (d/2) * card(V x \<inter> {1..n * s + t}))"
   have Main: "u (n * s + t) x \<le> Z t n x" if "t < s" for n x t
   proof (rule nat_less_induct[where ?n = n])
     fix n assume H: "\<forall>m<n. u (m * s + t) x \<le> Z t m x"
     consider "n = 0"|"n>0 \<and> V x \<inter> {(n-1) * s+t<..n * s+t} = {}"|"n>0 \<and> V x \<inter> {(n-1) * s+t<..n * s+t} \<noteq> {}" by auto
     then show "u (n * s+t) x \<le> Z t n x"
     proof (cases)
       assume "n = 0"
       then have "V x \<inter> {1..n * s + t} = {}" unfolding V_def using \<open>t<s\<close> \<open>k>2* s\<close> by auto
       then have *: "card(V x \<inter> {1..n * s+t}) = 0" by simp
       have **: "0 \<le> (\<Sum>i<t. F ((T ^^ i) x))" by (rule sum_nonneg, simp add: F_pos)
       have "u (n * s + t) x = u t x" using \<open>n = 0\<close> by auto
       also have "... \<le> Max {u i x|i. i< s}" by (rule Max_ge, auto simp add: \<open>t<s\<close>)
       also have "... \<le> Z t n x"
         unfolding Z_def birkhoff_sum_def using \<open>n = 0\<close> * ** by auto
       finally show ?thesis by simp
     next
       assume A: "n>0 \<and> V x \<inter> {(n-1) * s+t<..n * s+t} = {}"
       then have "n\<ge>1" by simp
       have "n * s + t = (n-1) * s + t + s" using \<open>n\<ge>1\<close> by (simp add: add.commute add.left_commute mult_eq_if)
       have "V x \<inter> {1..n * s + t} = V x \<inter> {1..(n-1) * s + t} \<union> V x \<inter> {(n-1) * s + t<..n * s + t}"
         using \<open>n\<ge>1\<close> by (auto, simp add: mult_eq_if)
       then have *: "card(V x \<inter> {1..n * s+t}) = card(V x \<inter> {1..(n-1) * s+t})" using A by auto
 
       have **: "birkhoff_sum F ((n-1) * s + t) x \<le> birkhoff_sum F (n * s + t) x"
         unfolding birkhoff_sum_def apply (rule sum_mono2)
         using \<open>n * s+t = (n-1) * s+t + s\<close> F_pos by auto
 
       have "(\<Sum>i<n-1. abs(u s ((T^^(i * s+t))x))) + u s ((T^^((n-1) * s+t)) x)
         \<le> (\<Sum>i<n-1. abs(u s ((T^^(i * s+t))x))) + abs(u s ((T^^((n-1) * s+t)) x))" by auto
       also have "... \<le> (\<Sum>i<n. abs(u s ((T^^(i* s+t))x)))"
         using \<open>n\<ge>1\<close> lessThan_Suc_atMost sum.lessThan_Suc[of "\<lambda>i. abs(u s ((T^^(i* s+t))x))" "n-1", symmetric] by auto
       finally have ***: "(\<Sum>i<n-1. abs(u s ((T^^(i* s+t))x))) + u s ((T^^((n-1) * s+t)) x) \<le> (\<Sum>i<n. abs(u s ((T^^(i* s+t))x)))"
         by simp
 
       have "u (n * s+t) x = u ((n-1) * s+t + s) x"
         using \<open>n\<ge>1\<close> by (simp add: add.commute add.left_commute mult_eq_if)
       also have "... \<le> u ((n-1) * s+t) x + u s ((T^^((n-1) * s+t)) x)"
         using subcocycle_ineq[OF subu, of "(n-1) * s+t" s x] by simp
       also have "... \<le> Max {u i x|i. i< s} + (\<Sum>i<n-1. abs(u s ((T^^(i* s+t))x)))
         + birkhoff_sum F ((n-1) * s+t) x - (d/2) * card(V x \<inter> {1..(n-1) * s+t}) + u s ((T^^((n-1) * s+t)) x)"
         using H \<open>n\<ge>1\<close> unfolding Z_def by auto
       also have "... \<le> Max {u i x|i. i< s} + (\<Sum>i<n. abs(u s ((T^^(i* s+t))x)))
         + birkhoff_sum F (n * s+t) x - (d/2) * card(V x \<inter> {1..n * s+t})"
         using * ** *** by auto
       also have "... \<le> Z t n x" unfolding Z_def by (auto simp add: divide_simps)
       finally show ?thesis by simp
     next
       assume B: "n>0 \<and> V x \<inter> {(n-1) * s+t<..n * s+t} \<noteq> {}"
       then have [simp]: "n>0" "n\<ge>1" "n \<noteq> 0" by auto
       obtain m where m: "m \<in> V x \<inter> {(n-1) * s + t<..n * s + t}" using B by blast
       then obtain l where l: "l \<in> {k..m-s}" "u m x - u (m-l) x \<le> - d * l" unfolding V_def by auto
       then have "m-s>0" using \<open>k>2* s\<close> by auto
       then have "m-l \<ge> s" using l by auto
       define p where "p = (m-l-t) div s"
       have p1: "m-l \<ge> p * s + t"
         unfolding p_def using \<open>m-l \<ge> s\<close> \<open>s>t\<close> minus_mod_eq_div_mult [symmetric, of "m - l - t" s]
         by simp
       have p2: "m-l < p* s + t + s"
         unfolding p_def using \<open>m-l \<ge> s\<close> \<open>s>t\<close>
         div_mult_mod_eq[of "m-l-t" s] mod_less_divisor[OF \<open>s>0\<close>, of "m-l-t"] by linarith
       then have "l \<ge> m - p * s - t -s" by auto
       then have "l \<ge> (n-1) * s + t -p * s - t- s" using m by auto
       then have "l + 2 * s\<ge> (n * s + t) - (p * s+t)" by (simp add: diff_mult_distrib)
       have "(p+1) * s + t \<le> (n-1) * s + t"
         using \<open>k> 2 * s\<close> m l(1) p1 by (auto simp add: algebra_simps)
       then have "p+1 \<le> n-1"
         using \<open>s>0\<close> by (meson add_le_cancel_right mult_le_cancel2)
       then have "p \<le> n-1" "p<n" by auto
       have "(p* s + t) + k \<le> (n * s + t)"
         using m l(1) p1 by (auto simp add: algebra_simps)
       then have "(1::real) \<le> ((n * s + t) - (p* s + t)) / k"
         using \<open>k > 2* s\<close> by auto
 
       have In: "u (n * s + t) x \<le> u m x + (\<Sum>i \<in> {(n-1) * s + t..<n * s + t}. abs(u 1 ((T^^i) x)))"
       proof (cases "m = n * s + t")
         case True
         have "(\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x))) \<ge> 0"
           by (rule sum_nonneg, auto)
         then show ?thesis using True by auto
       next
         case False
         then have m2: "n * s + t - m >0" "(n-1) * s+t \<le> m" using m by auto
         have "birkhoff_sum (u 1) (n * s+t-m) ((T^^m) x) = (\<Sum>i<n * s+t-m. u 1 ((T^^i)((T^^m) x)))"
           unfolding birkhoff_sum_def by auto
         also have "... = (\<Sum>i<n * s+t-m. u 1 ((T^^(i+m)) x))"
           by (simp add: funpow_add)
         also have "... = (\<Sum>j \<in> {m..<n * s+t}. u 1 ((T^^j) x))"
           by (rule sum.reindex_bij_betw, rule bij_betw_byWitness[where ?f' = "\<lambda>i. i - m"], auto)
         also have "... \<le> (\<Sum>j \<in> {m..<n * s+t}. abs(u 1 ((T^^j) x)))"
           by (rule sum_mono, auto)
         also have "... \<le> (\<Sum>j \<in> {(n-1) * s+t..<m}. abs(u 1 ((T^^j) x))) + (\<Sum>j \<in> {m..<n * s+t}. abs(u 1 ((T^^j) x)))"
           by auto
         also have "... = (\<Sum>j \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^j) x)))"
           apply (rule sum.atLeastLessThan_concat) using m2 by auto
         finally have *: "birkhoff_sum (u 1) (n * s+t-m) ((T^^m) x) \<le> (\<Sum>j \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^j) x)))"
           by auto
 
         have "u (n * s+t) x \<le> u m x + u (n * s+t-m) ((T^^m) x)"
           using subcocycle_ineq[OF subu, of m "n * s+t-m"] m2 by auto
         also have "... \<le> u m x + birkhoff_sum (u 1) (n * s+t-m) ((T^^m) x)"
           using subcocycle_bounded_by_birkhoff1[OF subu \<open>n * s+t - m >0\<close>, of "(T^^m)x"] by simp
         finally show ?thesis using * by auto
       qed
 
       have Ip: "u (m-l) x \<le> u (p* s+t) x + (\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x)))"
       proof (cases "m-l = p* s+t")
         case True
         have "(\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x))) \<ge> 0"
           by (rule sum_nonneg, auto)
         then show ?thesis using True by auto
       next
         case False
         then have "m-l - (p* s+t) > 0" using p1 by auto
         have I: "p * s + t + (m - l - (p * s + t)) = m - l" using p1 by auto
 
         have "birkhoff_sum (u 1) (m-l - (p* s+t)) ((T^^(p* s+t)) x) = (\<Sum>i<m-l - (p* s+t). u 1 ((T^^i) ((T^^(p* s+t)) x)))"
           unfolding birkhoff_sum_def by auto
         also have "... = (\<Sum>i<m-l - (p* s+t). u 1 ((T^^(i+p* s+t)) x))"
           by (simp add: funpow_add)
         also have "... = (\<Sum>j \<in> {p* s+t..<m-l}. u 1 ((T^^j) x))"
           by (rule sum.reindex_bij_betw, rule bij_betw_byWitness[where ?f' = "\<lambda>i. i - (p* s+t)"], auto)
         also have "... \<le> (\<Sum>j \<in> {p* s+t..<m-l}. abs(u 1 ((T^^j) x)))"
           by (rule sum_mono, auto)
         also have "... \<le> (\<Sum>j \<in> {p* s+t..<m-l}. abs(u 1 ((T^^j) x))) + (\<Sum>j \<in> {m-l..<(p+1)* s+t}. abs(u 1 ((T^^j) x)))"
           by auto
         also have "... = (\<Sum>j \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^j) x)))"
           apply (rule sum.atLeastLessThan_concat) using p1 p2 by auto
         finally have *: "birkhoff_sum (u 1) (m-l - (p* s+t)) ((T^^(p* s+t)) x)
           \<le> (\<Sum>j \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^j) x)))"
           by auto
 
         have "u (m-l) x \<le> u (p* s+t) x + u (m-l - (p* s+t)) ((T^^(p* s+t)) x)"
           using subcocycle_ineq[OF subu, of "p* s+t" "m-l - (p* s+t)" x] I by auto
         also have "... \<le> u (p* s+t) x + birkhoff_sum (u 1) (m-l - (p* s+t)) ((T^^(p* s+t)) x)"
           using subcocycle_bounded_by_birkhoff1[OF subu \<open>m-l - (p* s+t) > 0\<close>, of "(T^^(p* s+t)) x"] by simp
         finally show ?thesis using * by auto
       qed
 
       have "(\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x))) \<le> (\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. K + F ((T^^i) x))"
         apply (rule sum_mono) using u1_bound by auto
       moreover have "(\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x))) \<le> (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. K + F ((T^^i) x))"
         apply (rule sum_mono) using u1_bound by auto
       ultimately have "(\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x))) + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x)))
         \<le> (\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. K + F ((T^^i) x)) + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. K + F ((T^^i) x))"
         by auto
       also have "... = 2* K* s + (\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. F ((T^^i) x)) + (\<Sum>i \<in>{(n-1) * s+t..<n * s+t}. F ((T^^i) x))"
         by (auto simp add: mult_eq_if sum.distrib)
       also have "... \<le> 2* K * s + (\<Sum>i \<in> {p* s+t..<(n-1) * s+t}. F ((T^^i) x)) + (\<Sum>i \<in>{(n-1) * s+t..<n * s+t}. F ((T^^i) x))"
         apply (auto, rule sum_mono2) using \<open>(p+1)* s+t\<le>(n-1) * s+t\<close> F_pos by auto
       also have "... = 2* K * s + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x))"
         apply (auto, rule sum.atLeastLessThan_concat) using \<open>p\<le>n-1\<close> by auto
       finally have A0: "(\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x))) + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x)))
         \<le> 2* K * s + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x))"
         by simp
 
       have "card(V x \<inter> {p * s + t<.. n * s+t}) \<le> card {p * s + t<.. n * s+t}" by (rule card_mono, auto)
       have "2 * d * s + 2 * K * s > 0" using \<open>K>0\<close> \<open>s>0\<close> \<open>d>0\<close>
         by (metis add_pos_pos mult_2 mult_zero_left of_nat_0_less_iff pos_divide_less_eq times_divide_eq_right)
       then have "2 * d * s + 2 * K * s \<le> ((n * s + t) - (p* s + t)) * ((2 * d * s + 2 * K * s) / k)"
         using \<open>1 \<le> ((n * s + t) - (p* s + t)) / k\<close> by (simp add: le_divide_eq_1 pos_le_divide_eq)
       also have "... \<le> ((n * s + t) - (p* s + t)) * (d/2)"
         apply (rule mult_left_mono) using \<open>(2 * d * s + 2 * K * s)/k \<le> d/2\<close> by auto
       finally have "2 * d * s + 2 * K * s \<le> ((n * s + t) - (p* s + t)) * (d/2)"
         by auto
       then have "-d * ((n * s+t) - (p* s+t)) + 2 * d * s + 2 * K * s \<le> -d * ((n * s+t) - (p* s+t)) + ((n * s + t) - (p* s + t)) * (d/2)"
         by linarith
       also have "... = (-d/2) * card {p * s + t<.. n * s+t}"
         by auto
       also have "... \<le> (-d/2) * card(V x \<inter> {p * s + t<.. n * s+t})"
         using \<open>card(V x \<inter> {p * s + t<.. n * s+t}) \<le> card {p * s + t<.. n * s+t}\<close> by auto
       finally have A1: "-d * ((n * s+t) - (p* s+t)) + 2 * d * s + 2 * K * s \<le> (-d/2) * card(V x \<inter> {p * s + t<.. n * s+t})"
         by simp
 
       have "V x \<inter> {1.. n * s+t} = V x \<inter> {1..p * s + t} \<union> V x \<inter> {p * s + t<.. n * s+t}"
         using \<open>p * s + t + k \<le> n * s + t\<close> by auto
       then have "card (V x \<inter> {1.. n * s+t}) = card(V x \<inter> {1..p * s + t} \<union> V x \<inter> {p * s + t<.. n * s+t})"
         by auto
       also have "... = card (V x \<inter> {1..p * s + t}) + card (V x \<inter> {p * s + t<.. n * s+t})"
         by (rule card_Un_disjoint, auto)
       finally have A2: "card (V x \<inter> {1..p * s + t}) + card (V x \<inter> {p * s + t<.. n * s+t}) = card (V x \<inter> {1.. n * s+t})"
         by simp
 
       have A3: "(\<Sum>i<p. abs(u s ((T ^^ (i * s + t)) x))) \<le> (\<Sum>i<n. abs(u s ((T ^^ (i * s + t)) x)))"
         apply (rule sum_mono2) using \<open>p\<le>n-1\<close> by auto
 
       have A4: "birkhoff_sum F (p * s + t) x + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x)) = birkhoff_sum F (n * s + t) x"
         unfolding birkhoff_sum_def apply (subst atLeast0LessThan[symmetric])+ apply (rule sum.atLeastLessThan_concat)
         using \<open>p\<le>n-1\<close> by auto
 
       have "u (n * s+t) x \<le> u m x + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x)))"
         using In by simp
       also have "... \<le> (u m x - u (m-l) x) + u (m-l) x + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x)))"
         by simp
       also have "... \<le> - d * l + u (p* s+t) x + (\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x))) + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x)))"
         using Ip l by auto
       also have "... \<le> - d * ((n * s+t) - (p* s+t)) + 2*d* s + u (p* s+t) x + (\<Sum>i \<in> {p* s+t..<(p+1)* s+t}. abs(u 1 ((T^^i) x))) + (\<Sum>i \<in> {(n-1) * s+t..<n * s+t}. abs(u 1 ((T^^i) x)))"
         using \<open>l + 2* s\<ge> (n * s+t) - (p* s+t)\<close> apply (auto simp add: algebra_simps)
-        by (metis assms(1) distrib_left mult.commute mult_2 of_nat_add of_nat_le_iff real_mult_le_cancel_iff2)
+        by (metis assms(1) distrib_left mult.commute mult_2 of_nat_add of_nat_le_iff mult_le_cancel_iff2)
       also have "... \<le> -d * ((n * s+t) - (p* s+t)) + 2*d* s + Z t p x + 2* K * s + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x))"
         using A0 H \<open>p<n\<close> by auto
       also have "... \<le> Z t p x - d/2 * card(V x \<inter> {p * s + t<.. n * s+t}) + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x))"
         using A1 by auto
       also have "... = Max {u i x |i. i < s} + (\<Sum>i<p. abs(u s ((T ^^ (i * s + t)) x))) + birkhoff_sum F (p * s + t) x
           - d / 2 * card (V x \<inter> {1..p * s + t}) - d/2 * card(V x \<inter> {p * s + t<.. n * s+t}) + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x))"
         unfolding Z_def by auto
       also have "... \<le> Max {u i x |i. i < s} + (\<Sum>i<n. abs(u s ((T ^^ (i * s + t)) x)))
         + (birkhoff_sum F (p * s + t) x + (\<Sum>i \<in> {p* s+t..<n * s+t}. F ((T^^i) x)))
         - d/2 * card (V x \<inter> {1..p * s + t}) - d/2 * card(V x \<inter> {p * s + t<.. n * s+t})"
         using A3 by auto
       also have "... = Z t n x"
         unfolding Z_def using A2 A4 by (auto simp add: algebra_simps, metis distrib_left of_nat_add)
       finally show ?thesis by simp
     qed
   qed
 
   have Main2: "(d/2) * card(V x \<inter> {1..n}) \<le> Max {u i x|i. i< s} + birkhoff_sum (\<lambda>x. abs(u s x/ s)) (n+2* s) x
     + birkhoff_sum F (n + 2 * s) x + (1/s) * (\<Sum>i< 2 * s. abs(u (n+i) x))" for n x
   proof -
     define N where "N = (n div s) + 1"
     then have "n \<le> N * s"
       using \<open>s > 0\<close> dividend_less_div_times less_or_eq_imp_le by auto
     have "N * s \<le> n + s"
       by (auto simp add: N_def)
     have eq_t: "(d/2) * card(V x \<inter> {1..n}) \<le> abs(u(N* s+t) x) + (Max {u i x|i. i< s} + birkhoff_sum F (n + 2* s) x)
             + (\<Sum>i<N. abs(u s ((T^^(i * s+t))x)))"
       if "t<s" for t
     proof -
       have *: "birkhoff_sum F (N * s+t) x \<le> birkhoff_sum F (n+ 2* s) x"
         unfolding birkhoff_sum_def apply (rule sum_mono2) using F_pos \<open>N * s \<le> n + s\<close> \<open>t<s\<close> by auto
 
       have "card(V x \<inter> {1..n}) \<le> card(V x \<inter> {1..N* s+t})"
         apply (rule card_mono) using \<open>n \<le> N * s\<close> by auto
       then have "(d/2) * card(V x \<inter> {1..n}) \<le> (d/2) * card(V x \<inter> {1..N* s+t})"
         by auto
       also have "... \<le> - u (N* s+t) x + Max {u i x|i. i< s} + (\<Sum>i<N. abs(u s ((T^^(i* s+t))x))) + birkhoff_sum F (N * s+t) x"
         using Main[OF \<open>t < s\<close>, of N x] unfolding Z_def by auto
       also have "... \<le> abs(u(N* s+t) x) + Max {u i x|i. i< s} + birkhoff_sum F (n + 2* s) x + (\<Sum>i<N. abs(u s ((T^^(i* s+t))x)))"
         using * by auto
       finally show ?thesis by simp
     qed
 
     have "(\<Sum>t<s. abs(u(N* s+t) x)) = (\<Sum>i\<in>{N* s..<N* s+s}. abs (u i x))"
       by (rule sum.reindex_bij_betw, rule bij_betw_byWitness[where ?f' = "\<lambda>i. i - N* s"], auto)
     also have "... \<le> (\<Sum>i\<in>{n..<n + 2* s}. abs (u i x))"
       apply (rule sum_mono2) using \<open>n \<le> N * s\<close> \<open>N * s \<le> n + s\<close> by auto
     also have "... = (\<Sum>i<2* s. abs (u (n+i) x))"
       by (rule sum.reindex_bij_betw[symmetric], rule bij_betw_byWitness[where ?f' = "\<lambda>i. i - n"], auto)
     finally have **: "(\<Sum>t<s. abs(u(N* s+t) x)) \<le> (\<Sum>i<2* s. abs (u (n+i) x))"
       by simp
 
     have "(\<Sum>t<s. (\<Sum>i<N. abs(u s ((T^^(i* s+t))x)))) = (\<Sum>i<N* s. abs(u s ((T^^i) x)))"
       by (rule sum_arith_progression)
     also have "... \<le> (\<Sum>i<n + 2* s. abs(u s ((T^^i) x)))"
       apply (rule sum_mono2) using \<open>N * s \<le> n + s\<close> by auto
     finally have ***: "(\<Sum>t<s. (\<Sum>i<N. abs(u s ((T^^(i* s+t))x)))) \<le> s * birkhoff_sum (\<lambda>x. abs(u s x/ s)) (n+2* s) x"
       unfolding birkhoff_sum_def using \<open>s>0\<close> by (auto simp add: sum_divide_distrib[symmetric])
 
     have ****: "s * (\<Sum>i<n + 2* s. abs(u s ((T^^i) x)) /s) = (\<Sum>i<n + 2* s. abs(u s ((T^^i) x)))"
       by (auto simp add: sum_divide_distrib[symmetric])
 
     have "s * (d/2) * card(V x \<inter> {1..n}) = (\<Sum>t<s. (d/2) * card(V x \<inter> {1..n}))"
       by auto
     also have "... \<le> (\<Sum>t<s. abs(u(N* s+t) x) + (Max {u i x|i. i< s} + birkhoff_sum F (n + 2* s) x)
             + (\<Sum>i<N. abs(u s ((T^^(i* s+t))x))))"
       apply (rule sum_mono) using eq_t by auto
     also have "... = (\<Sum>t<s. abs(u(N* s+t) x)) + (\<Sum>t<s. Max {u i x|i. i< s} + birkhoff_sum F (n + 2* s) x) + (\<Sum>t<s. (\<Sum>i<N. abs(u s ((T^^(i* s+t))x))))"
       by (auto simp add: sum.distrib)
     also have "... \<le> (\<Sum>i<2* s. abs (u (n+i) x)) + s * (Max {u i x|i. i< s} + birkhoff_sum F (n + 2* s) x) + s * birkhoff_sum (\<lambda>x. abs(u s x/ s)) (n+2* s) x"
       using ** *** by auto
     also have "... = s * ((1/s) * (\<Sum>i<2* s. abs (u (n+i) x)) + Max {u i x|i. i< s} + birkhoff_sum F (n + 2* s) x + birkhoff_sum (\<lambda>x. abs(u s x/ s)) (n+2* s) x)"
       by (auto simp add: divide_simps mult.commute distrib_left)
     finally show ?thesis
       by auto
   qed
 
   have densV: "upper_asymptotic_density (V x) \<le> (2/d) * real_cond_exp M Invariants F2 x" if "x \<in> G" for x
   proof -
     have *: "(\<lambda>n. abs(u n x/n)) \<longlonglongrightarrow> 0"
       apply (rule tendsto_rabs_zero) using \<open>x\<in>G\<close> unfolding G_def by auto
 
     define Bound where "Bound = (\<lambda>n. (Max {u i x|i. i< s}*(1/n) + birkhoff_sum (\<lambda>x. abs(u s x/ s)) (n+2* s) x / n
       + birkhoff_sum F (n + 2* s) x / n + (1/s) * (\<Sum>i<2* s. abs(u (n+i) x) / n)))"
     have "Bound \<longlonglongrightarrow> (Max {u i x|i. i< s} * 0 + real_cond_exp M Invariants (\<lambda>x. abs(u s x/s)) x
                       + real_cond_exp M Invariants F x + (1/s) * (\<Sum>i < 2 * s. 0))"
       unfolding Bound_def apply (intro tendsto_intros)
       using \<open>x\<in>G\<close> * unfolding G_def by auto
     moreover have "real_cond_exp M Invariants (\<lambda>x. abs(u s x/s)) x + real_cond_exp M Invariants F x = real_cond_exp M Invariants F2 x"
       using \<open>x \<in> G\<close> unfolding G_def by auto
     ultimately have B_conv: "Bound \<longlonglongrightarrow> real_cond_exp M Invariants F2 x" by simp
 
     have *: "(d/2) * card(V x \<inter> {1..n}) / n \<le> Bound n" for n
     proof -
       have "(d/2) * card(V x \<inter> {1..n}) / n \<le> (Max {u i x|i. i< s} + birkhoff_sum (\<lambda>x. abs(u s x/ s)) (n+2* s) x
         + birkhoff_sum F (n + 2* s) x + (1/s) * (\<Sum>i<2* s. abs(u (n+i) x)))/n"
         using Main2[of x n] using divide_right_mono of_nat_0_le_iff by blast
       also have "... = Bound n"
         unfolding Bound_def by (auto simp add: add_divide_distrib sum_divide_distrib[symmetric])
       finally show ?thesis by simp
     qed
 
     have "ereal(d/2 * upper_asymptotic_density (V x)) = ereal(d/2) * ereal(upper_asymptotic_density (V x))"
       by auto
     also have "... = ereal (d/2) * limsup(\<lambda>n. card(V x \<inter> {1..n}) / n)"
       using upper_asymptotic_density_shift[of "V x" 1 0] by auto
     also have "... = limsup(\<lambda>n. ereal (d/2) * (card(V x \<inter> {1..n}) / n))"
       by (rule limsup_ereal_mult_left[symmetric], auto)
     also have "... \<le> limsup Bound"
       apply (rule Limsup_mono) using * not_eventuallyD by auto
     also have "... = ereal(real_cond_exp M Invariants F2 x)"
       using B_conv convergent_limsup_cl convergent_def convergent_real_imp_convergent_ereal limI by force
     finally have "d/2 * upper_asymptotic_density (V x) \<le> real_cond_exp M Invariants F2 x"
       by auto
     then show ?thesis
       by (simp add: divide_simps mult.commute)
   qed
 
   define epsilon where "epsilon = 2 * rho / d"
   have [simp]: "epsilon > 0" "epsilon \<noteq> 0" "epsilon \<ge> 0" unfolding epsilon_def by auto
   have "emeasure M {x\<in>space M. real_cond_exp M Invariants F2 x \<ge> epsilon} \<le> (1/epsilon) * (\<integral>x. real_cond_exp M Invariants F2 x \<partial>M)"
     apply (intro integral_Markov_inequality real_cond_exp_pos real_cond_exp_int(1))
     by (auto simp add: int_F2 F2_pos)
   also have "... = (1/epsilon) * (\<integral>x. F2 x \<partial>M)"
     apply (intro arg_cong[where f = ennreal])
     by (simp, rule real_cond_exp_int(2), simp add: int_F2)
   also have "... < (1/epsilon) * 2 * rho"
     using F2_int by (intro ennreal_lessI) (auto simp add: divide_simps)
   also have "... = d"
     unfolding epsilon_def by auto
   finally have *: "emeasure M {x\<in>space M. real_cond_exp M Invariants F2 x \<ge> epsilon} < d"
     by simp
 
   define G2 where "G2 = {x \<in> G. real_cond_exp M Invariants F2 x < epsilon}"
   have [measurable]: "G2 \<in> sets M" unfolding G2_def by simp
   have "1 = emeasure M G"
     using \<open>emeasure M G = 1\<close> by simp
   also have "... \<le> emeasure M (G2 \<union> {x\<in>space M. real_cond_exp M Invariants F2 x \<ge> epsilon})"
     apply (rule emeasure_mono) unfolding G2_def using sets.sets_into_space[OF \<open>G \<in> sets M\<close>] by auto
   also have "... \<le> emeasure M G2 + emeasure M {x\<in>space M. real_cond_exp M Invariants F2 x \<ge> epsilon}"
     by (rule emeasure_subadditive, auto)
   also have "... < emeasure M G2 + d"
     using * by auto
   finally have "1 - d < emeasure M G2"
     using emeasure_eq_measure \<open>d \<le> 1\<close> by (auto intro!: ennreal_less_iff[THEN iffD2] simp del: ennreal_plus simp add: ennreal_plus[symmetric])
 
   have "upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} < d"
     if "x \<in> G2" for x
   proof -
     have "x \<in> G" using \<open>x \<in> G2\<close> unfolding G2_def by auto
     have "{n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} \<subseteq> U x \<union> V x"
       unfolding U_def V_def by fastforce
     then have "upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} \<le> upper_asymptotic_density (U x \<union> V x)"
       by (rule upper_asymptotic_density_subset)
     also have "... \<le> upper_asymptotic_density (U x) + upper_asymptotic_density (V x)"
       by (rule upper_asymptotic_density_union)
     also have "... \<le> (2/d) * real_cond_exp M Invariants F2 x"
       using densU[OF \<open>x \<in> G\<close>] densV[OF \<open>x \<in> G\<close>] by auto
     also have "... < (2/d) * epsilon"
       using \<open>x \<in> G2\<close> unfolding G2_def by (simp add: divide_simps)
     text \<open>This is where the choice of $\rho$ at the beginning of the proof is relevant:
     we choose it so that the above term is at most $d$.\<close>
     also have "... = d" unfolding epsilon_def rho_def by auto
     finally show ?thesis by simp
   qed
   then have "G2 \<subseteq> {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} < d}"
     using sets.sets_into_space[OF \<open>G2 \<in> sets M\<close>] by blast
   then have "emeasure M G2 \<le> emeasure M {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} < d}"
     by (rule emeasure_mono, auto)
   then have "emeasure M {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - d * l} < d} > 1 -d"
     using \<open>emeasure M G2 > 1 - d\<close> by auto
   then show ?thesis by blast
 qed
 
 text \<open>The two previous lemmas are put together in the following lemma,
 corresponding to Lemma 2.3 in~\cite{gouezel_karlsson}.\<close>
 
 lemma upper_density_delta:
   fixes d::real
   assumes "d > 0" "d \<le> 1"
   shows "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
         emeasure M {x \<in> space M. \<forall>(N::nat). card {n \<in>{..<N}. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - delta l * l} \<le> d * N} > 1 - d"
 proof -
   define d2 where "d2 = d/2"
   have [simp]: "d2 > 0" unfolding d2_def using assms by simp
   then have "\<not> d2 < 0" using not_less [of d2 0] by (simp add: less_le)
   have "d2/2 > 0" by simp
   obtain c0 where c0: "c0> (0::real)" "emeasure M {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - c0 * l} < d2/2} > 1 - (d2/2)"
     using upper_density_all_times[OF \<open>d2/2 > 0\<close>] by blast
   have "\<exists>N. emeasure M {x \<in> space M. \<forall>n \<ge> N. card ({n. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - c0 * l} \<inter> {..<n}) < (d2/2) * n} > 1 - (d2/2)"
     apply (rule upper_density_eventually_measure) using c0(2) by auto
   then obtain N1 where N1: "emeasure M {x \<in> space M. \<forall>B \<ge> N1. card ({n. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - c0 * l} \<inter> {..<B}) < (d2/2) * B} > 1 - (d2/2)"
     by blast
   define O1 where "O1 = {x \<in> space M. \<forall>B \<ge> N1. card ({n. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - c0 * l} \<inter> {..<B}) < (d2/2) * B}"
   have [measurable]: "O1 \<in> sets M" unfolding O1_def by auto
   have "emeasure M O1 > 1 - (d2/2)" unfolding O1_def using N1 by auto
 
   have *: "\<exists>N. emeasure M {x \<in> space M. \<forall>B \<ge> N. card({n. \<exists>l \<in> {N..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B} > 1 - e"
     if "e>0" "e \<le> 1" for e::real
   proof -
     obtain k where k: "emeasure M {x \<in> space M. upper_asymptotic_density {n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - e * l} < e} > 1 - e"
       using upper_density_large_k[OF \<open>e>0\<close> \<open>e \<le> 1\<close>] by blast
     then obtain N0 where N0: "emeasure M {x \<in> space M. \<forall>B \<ge> N0. card({n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B} > 1 - e"
       using upper_density_eventually_measure[OF _ k] by auto
     define N where "N = max k N0"
     have "emeasure M {x \<in> space M. \<forall>B \<ge> N0. card({n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B}
             \<le> emeasure M {x \<in> space M. \<forall>B \<ge> N. card({n. \<exists>l \<in> {N..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B}"
     proof (rule emeasure_mono, auto)
       fix x B assume H: "x \<in> space M" "\<forall>B\<ge>N0. card ({n. \<exists>l\<in>{k..n}. u n x - u (n - l) x \<le> - (e * real l)} \<inter> {..<B}) < e * B" "N \<le> B"
 
       have "card({n. \<exists>l \<in> {N..n}. u n x - u (n-l) x \<le> - (e * real l)} \<inter> {..<B}) \<le> card({n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> -(e * real l)} \<inter> {..<B})"
         unfolding N_def by (rule card_mono, auto)
       then have "real(card({n. \<exists>l \<in> {N..n}. u n x - u (n-l) x \<le> - (e * real l)} \<inter> {..<B})) \<le> card({n. \<exists>l \<in> {k..n}. u n x - u (n-l) x \<le> -(e * real l)} \<inter> {..<B})"
         by simp
       also have "... < e * B" using H(2) \<open>B\<ge>N\<close> unfolding N_def by auto
       finally show "card ({n. \<exists>l\<in>{N..n}. u n x - u (n - l) x \<le> - (e * real l)} \<inter> {..<B}) < e * B"
         by auto
     qed
     then have "emeasure M {x \<in> space M. \<forall>B \<ge> N. card({n. \<exists>l \<in> {N..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B} > 1 - e"
       using N0 by simp
     then show ?thesis by auto
   qed
 
   define Ne where "Ne = (\<lambda>(e::real). SOME N. emeasure M {x \<in> space M. \<forall>B \<ge> N. card({n. \<exists>l \<in> {N..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B} > 1 - e)"
   have Ne: "emeasure M {x \<in> space M. \<forall>B \<ge> Ne e. card({n. \<exists>l \<in> {Ne e..n}. u n x - u (n-l) x \<le> - e * l} \<inter> {..<B}) < e * B} > 1 - e"
     if "e>0" "e \<le> 1" for e::real
   unfolding Ne_def by (rule someI_ex[OF *[OF that]])
   define eps where "eps = (\<lambda>(n::nat). d2 * (1/2)^n)"
   have [simp]: "eps n > 0" for n unfolding eps_def by auto
   then have [simp]: "eps n \<ge> 0" for n by (rule less_imp_le)
 
   have "eps n \<le> (1 / 2) * 1" for n
     unfolding eps_def d2_def
     using \<open>d \<le> 1\<close> by (intro mult_mono power_le_one) auto
   also have "\<dots> < 1" by auto
   finally have [simp]: "eps n < 1" for n by simp
   then have [simp]: "eps n \<le> 1" for n by (rule less_imp_le)
 
   have "(\<lambda>n. d2 * (1/2)^n) \<longlonglongrightarrow> d2 * 0"
     by (rule tendsto_mult, auto simp add: LIMSEQ_realpow_zero)
   then have "eps \<longlonglongrightarrow> 0" unfolding eps_def by auto
 
   define Nf where "Nf = (\<lambda>N. (if (N = 0) then 0
                 else if (N = 1) then N1 + 1
                 else max (N1+1) (Max {Ne(eps n)|n. n \<le> N}) + N))"
   have "Nf N < Nf (N+1)" for N
   proof -
     consider "N = 0" | "N = 1" | "N>1" by fastforce
     then show ?thesis
     proof (cases)
       assume "N>1"
       have "Max {Ne (eps n) |n. n \<le> N} \<le> Max {Ne (eps n) |n. n \<le> Suc N}"
         by (rule Max_mono, auto)
       then show ?thesis unfolding Nf_def by auto
     qed (auto simp add: Nf_def)
   qed
   then have "strict_mono Nf"
     using strict_mono_Suc_iff by auto
 
   define On where "On = (\<lambda>(N::nat).
     (if (N = 1) then O1
     else {x \<in> space M. \<forall>B \<ge> Nf N. card({n. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N) * l} \<inter> {..<B}) < (eps N) * B}))"
   have [measurable]: "On N \<in> sets M" for N unfolding On_def by auto
   have "emeasure M (On N) > 1 - eps N" if "N>0" for N
   proof -
     consider "N = 1" | "N>1" using \<open>N>0\<close> by linarith
     then show ?thesis
     proof (cases)
       case 1
       then show ?thesis unfolding On_def eps_def using \<open>emeasure M O1 > 1 - (d2/2)\<close> by auto
     next
       case 2
       have "Ne (eps N) \<le> Max {Ne(eps n)|n. n \<le> N}"
         by (rule Max.coboundedI, auto)
       also have "... \<le> Nf N" unfolding Nf_def using \<open>N>1\<close> by auto
       finally have "Ne (eps N) \<le> Nf N" by simp
       have "1 - eps N < emeasure M {x \<in> space M. \<forall>B \<ge> Ne(eps N). card({n. \<exists>l \<in> {Ne(eps N)..n}. u n x - u (n-l) x \<le> - (eps N) * l} \<inter> {..<B}) < (eps N) * B}"
         by (rule Ne) simp_all
       also have "... \<le> emeasure M {x \<in> space M. \<forall>B \<ge> Nf N. card({n. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N) * l} \<inter> {..<B}) < (eps N) * B}"
       proof (rule emeasure_mono, auto)
         fix x n assume H: "x \<in> space M"
                           "\<forall>n\<ge>Ne (eps N). card ({n. \<exists>l\<in>{Ne (eps N)..n}. u n x - u (n - l) x \<le> - (eps N * l)} \<inter> {..<n}) < eps N * n"
                           "Nf N \<le> n"
         have "card({n. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<n}) \<le> card({n. \<exists>l \<in> {Ne(eps N)..n}. u n x - u (n-l) x \<le> -(eps N) * l} \<inter> {..<n})"
           apply (rule card_mono) using \<open>Ne (eps N) \<le> Nf N\<close> by auto
         then have "real(card({n. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<n})) \<le> card({n. \<exists>l \<in> {Ne(eps N)..n}. u n x - u (n-l) x \<le> -(eps N) * l} \<inter> {..<n})"
           by simp
         also have "... < (eps N) * n" using H(2) \<open>n \<ge> Nf N\<close> \<open>Ne (eps N) \<le> Nf N\<close> by auto
         finally show "real (card ({n. \<exists>l\<in>{Nf N..n}. u n x - u (n - l) x \<le> - (eps N * l)} \<inter> {..<n})) < eps N * real n"
           by auto
       qed
       also have "... = emeasure M (On N)"
         unfolding On_def using \<open>N>1\<close> by auto
       finally show ?thesis by simp
     qed
   qed
   then have *: "emeasure M (On (N+1)) > 1 - eps (N+1)" for N by simp
 
   define Ogood where "Ogood = (\<Inter>N. On (N+1))"
   have [measurable]: "Ogood \<in> sets M" unfolding Ogood_def by auto
   have "emeasure M Ogood \<ge> 1 - (\<Sum>N. eps(N+1))"
     unfolding Ogood_def
     apply (intro emeasure_intersection, auto)
     using * by (auto simp add: eps_def summable_mult summable_divide summable_geometric less_imp_le)
   moreover have "(\<Sum>N. eps(N+1)) = d2"
     unfolding eps_def apply (subst suminf_mult)
     using sums_unique[OF power_half_series, symmetric] by (auto intro!: summable_divide summable_geometric)
   finally have "emeasure M Ogood \<ge> 1 - d2" by simp
   then have "emeasure M Ogood > 1 - d" unfolding d2_def using \<open>d>0\<close> \<open>d \<le> 1\<close>
     by (simp add: emeasure_eq_measure field_sum_of_halves ennreal_less_iff)
 
   have Ogood_union: "Ogood = (\<Union>(K::nat). Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)})"
   apply auto using sets.sets_into_space[OF \<open>Ogood \<in> sets M\<close>] apply blast
   proof -
     fix x
     define M where "M = Max {abs(u n x - u (n-l) x)/l | n l. n \<in> {1..Nf 1} \<and> l \<in> {1..n}}"
     obtain N::nat where "N > M" using reals_Archimedean2 by blast
 
     have "finite { (n, l) | n l. n \<in> {1..Nf 1} \<and> l \<in> {1..n}}"
       by (rule finite_subset[where ?B = "{1.. Nf 1} \<times> {1..Nf 1}"], auto)
     moreover have "{abs(u n x - u (n-l) x)/l | n l. n \<in> {1..Nf 1} \<and> l \<in> {1..n}}
       = (\<lambda> (n, l). abs(u n x - u (n-l) x)/l)` { (n, l) | n l. n \<in> {1..Nf 1} \<and> l \<in> {1..n}}"
       by auto
     ultimately have fin: "finite {abs(u n x - u (n-l) x)/l | n l. n \<in> {1..Nf 1} \<and> l \<in> {1..n}}"
       by auto
     {
       fix n l assume nl: "n \<in> {1..Nf 1} \<and> l \<in> {1..n}"
       then have "real l>0" by simp
       have "abs(u n x - u (n-l) x)/l \<le> M"
         unfolding M_def apply (rule Max_ge) using fin nl by auto
       then have "abs(u n x - u (n-l) x)/l < real N" using \<open>N>M\<close> by simp
       then have "abs(u n x - u (n-l) x)< real N * l" using \<open>0 < real l\<close> pos_divide_less_eq by blast
       then have "u n x - u (n-l) x > - (real N * l)" by simp
     }
     then have "\<forall>n\<in>{Suc 0..Nf (Suc 0)}. \<forall>l\<in>{Suc 0..n}. - (real N * real l) < u n x - u (n - l) x"
       by auto
     then show "\<exists>N. \<forall>n\<in>{Suc 0..Nf (Suc 0)}. \<forall>l\<in>{Suc 0..n}. - (real N * real l) < u n x - u (n - l) x"
       by auto
   qed
   have "(\<lambda>K. emeasure M (Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)}))
     \<longlonglongrightarrow> emeasure M (\<Union>(K::nat). Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)})"
     apply (rule Lim_emeasure_incseq, auto)
     unfolding incseq_def apply auto
     proof -
       fix m n x na l
       assume "m \<le> (n::nat)" "\<forall>n\<in>{Suc 0..Nf (Suc 0)}. \<forall>l\<in>{Suc 0..n}. - (real m * real l) < u n x - u (n - l) x"
              "Suc 0 \<le> l" "l \<le> na" "na \<le> Nf (Suc 0)"
       then have "- (real m * real l) < u na x - u (na - l) x" by auto
       moreover have "- (real n * real l) \<le> - (real m * real l)" using \<open>m \<le> n\<close> by (simp add: mult_mono)
       ultimately show "- (real n * real l) < u na x - u (na - l) x" by auto
     qed
   moreover have "emeasure M (\<Union>(K::nat). Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)}) > 1 - d"
     using Ogood_union \<open>emeasure M Ogood > 1 - d\<close> by auto
   ultimately have a: "eventually (\<lambda>K. emeasure M (Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)}) > 1 - d) sequentially"
     by (rule order_tendstoD(1))
   have b: "eventually (\<lambda>K. K \<ge> max c0 d2) sequentially"
     using eventually_at_top_linorder nat_ceiling_le_eq by blast
   have "eventually (\<lambda>K. K \<ge> max c0 d2 \<and> emeasure M (Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)}) > 1 - d) sequentially"
     by (rule eventually_elim2[OF a b], auto)
   then obtain K where K: "K\<ge>max c0 d2" "emeasure M (Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)}) > 1 - d"
     using eventually_False_sequentially eventually_elim2 by blast
 
   define Og where "Og = Ogood \<inter> {x \<in> space M. \<forall>n \<in> {1..Nf 1}. \<forall>l \<in> {1..n}. u n x - u (n-l) x > - (real K * l)}"
   have [measurable]: "Og \<in> sets M" unfolding Og_def by simp
   have "emeasure M Og > 1 - d" unfolding Og_def using K by simp
 
   have fin: "finite {N. Nf N \<le> n}" for n
     using pseudo_inverse_finite_set[OF filterlim_subseq[OF \<open>strict_mono Nf\<close>]] by auto
   define prev_N where "prev_N = (\<lambda>n. Max {N. Nf N \<le> n})"
   define delta where "delta = (\<lambda>l. if (prev_N l \<le> 1) then K else eps (prev_N l))"
   have "\<forall>l. delta l > 0"
     unfolding delta_def using \<open>K\<ge>max c0 d2\<close> \<open>c0>0\<close> by auto
 
   have "LIM n sequentially. prev_N n :> at_top"
     unfolding prev_N_def apply (rule tendsto_at_top_pseudo_inverse2)
     using \<open>strict_mono Nf\<close> by (simp add: filterlim_subseq)
   then have "eventually (\<lambda>l. prev_N l > 1) sequentially"
     by (simp add: filterlim_iff)
   then have "eventually (\<lambda>l. delta l = eps(prev_N l)) sequentially"
     unfolding delta_def by (simp add: eventually_mono)
   moreover have "(\<lambda>l. eps(prev_N l)) \<longlonglongrightarrow> 0"
     by (rule filterlim_compose[OF \<open>eps \<longlonglongrightarrow> 0\<close> \<open>LIM n sequentially. prev_N n :> at_top\<close>])
   ultimately have "delta \<longlonglongrightarrow> 0" by (simp add: filterlim_cong)
 
   have "delta n \<le> K" for n
   proof -
     have *: "d2 * (1 / 2) ^ prev_N n \<le> real K * 1"
       apply (rule mult_mono') using \<open>K \<ge> max c0 d2\<close> \<open>d2>0\<close> by (auto simp add: power_le_one less_imp_le)
     then show ?thesis unfolding delta_def apply auto unfolding eps_def using * by auto
   qed
 
   define bad_times where "bad_times = (\<lambda>x. {n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<union>
                       (\<Union>N\<in>{2..}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)}))"
   have card_bad_times: "card (bad_times x \<inter> {..<B}) \<le> d2 * B" if "x \<in> Og" for x B
   proof -
     have "(\<Sum>N\<in>{..<B}. (1/(2::real))^N) \<le> (\<Sum>N. (1/2)^N)"
       by (rule sum_le_suminf, auto simp add: summable_geometric)
     also have "... = 2" using suminf_geometric[of "1/(2::real)"] by auto
     finally have *: "(\<Sum>N\<in>{..<B}. (1/(2::real))^N) \<le> 2" by simp
 
     have "(\<Sum> N \<in> {2..<B}. eps N * B) \<le> (\<Sum> N \<in> {2..<B+2}. eps N * B)"
       by (rule sum_mono2, auto)
     also have "... = (\<Sum>N\<in>{2..<B+2}. d2 * (1/2)^N * B)"
       unfolding eps_def by auto
     also have "... = (\<Sum>N\<in>{..<B}. d2 * (1/2)^(N+2) * B)"
       by (rule sum.reindex_bij_betw[symmetric],rule bij_betw_byWitness[where ?f' = "\<lambda>i. i-2"], auto)
     also have "... = (\<Sum>N\<in>{..<B}. (d2 * (1/4) * B) * (1/2)^N)"
       by (auto, metis (lifting) mult.commute mult.left_commute)
     also have "... = (d2 * (1/4) * B) * (\<Sum>N\<in>{..<B}. (1/2)^N)"
       by (rule sum_distrib_left[symmetric])
     also have "... \<le> (d2 * (1/4) * B) * 2"
       apply (rule mult_left_mono) using * \<open>d2 > 0\<close> apply auto
       by (metis \<open>0 < d2\<close> mult_eq_0_iff mult_le_0_iff not_le of_nat_eq_0_iff of_nat_le_0_iff)
     finally have I: "(\<Sum> N \<in> {2..<B}. eps N * B) \<le> d2/2 * B"
       by auto
 
     have "x \<in> On 1" using \<open>x \<in> Og\<close> unfolding Og_def Ogood_def by auto
     then have "x \<in> O1" unfolding On_def by auto
     have B1: "real(card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B})) \<le> (d2/2) * B" for B
     proof (cases "B \<ge> N1")
       case True
       have "card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B})
         \<le> card({n. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B})"
         by (rule card_mono, auto)
       also have "... \<le> (d2/2) * B"
         using \<open>x \<in> O1\<close> unfolding O1_def using True by auto
       finally show ?thesis by auto
     next
       case False
       then have "B < Nf 1" unfolding Nf_def by auto
       then have "{n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B} = {}"
         by auto
       then have "card ({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B}) = 0"
         by auto
       also have "... \<le> (d2/2) * B"
         using \<open>\<not> d2 < 0\<close> by simp
       finally show ?thesis by simp
     qed
 
     have BN: "real(card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})) \<le> eps N * B" if "N \<ge> 2" for N B
     proof -
       have "x \<in> On ((N-1) + 1)" using \<open>x \<in> Og\<close> unfolding Og_def Ogood_def by auto
       then have "x \<in> On N" using \<open>N\<ge>2\<close> by auto
       show ?thesis
       proof (cases "B \<ge> Nf N")
         case True
         have "card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B}) \<le>
           card ({n. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})"
           by (rule card_mono, auto)
         also have "... \<le> eps N * B"
           using \<open>x \<in> On N\<close> \<open>N\<ge>2\<close> True unfolding On_def by auto
         finally show ?thesis by simp
       next
         case False
         then have "{n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B} = {}"
           by auto
         then have "card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B}) = 0"
           by auto
         also have "... \<le> eps N * B"
           by (metis \<open>\<And>n. 0 < eps n\<close> le_less mult_eq_0_iff mult_pos_pos of_nat_0 of_nat_0_le_iff)
         finally show ?thesis by simp
       qed
     qed
 
     {
       fix N assume "N \<ge> B"
       have "Nf N \<ge> B" using seq_suble[OF \<open>strict_mono Nf\<close>, of N] \<open>N \<ge> B\<close> by simp
       then have "{Nf N..} \<inter> {..<B} = {}" by auto
       then have "{n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B} = {}" by auto
     }
     then have *: "(\<Union>N\<in>{B..}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B}) = {}"
       by auto
 
     have "{2..} \<subseteq> {2..<B} \<union> {B..}" by auto
     then have "(\<Union>N\<in>{2..}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})
       \<subseteq> (\<Union>N\<in>{2..<B}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})
         \<union> (\<Union>N\<in>{B..}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})"
       by auto
     also have "... = (\<Union>N\<in>{2..<B}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})"
       using * by auto
     finally have *: "bad_times x \<inter> {..<B} \<subseteq> {n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B}
             \<union> (\<Union>N\<in>{2..<B}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})"
       unfolding bad_times_def by auto
     have "card(bad_times x \<inter> {..<B}) \<le> card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B}
         \<union> (\<Union>N\<in>{2..<B}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B}))"
       by (rule card_mono[OF _ *], auto)
     also have "... \<le> card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B}) +
       card (\<Union>N\<in>{2..<B}. {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})"
       by (rule card_Un_le)
     also have "... \<le> card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B}) +
       (\<Sum> N\<in>{2..<B}. card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B}))"
       by (simp del: UN_simps, rule card_UN_le, auto)
     finally have "real (card(bad_times x \<inter> {..<B})) \<le>
       real(card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B})
       + (\<Sum> N\<in>{2..<B}. card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})))"
       by (subst of_nat_le_iff, simp)
     also have "... = real(card({n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)} \<inter> {..<B}))
       + (\<Sum> N\<in>{2..<B}. real(card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})))"
       by auto
     also have "... \<le> (d2/2 * B) + (\<Sum> N\<in>{2..<B}. real(card ({n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)} \<inter> {..<B})))"
       using B1 by simp
     also have "... \<le> (d2/2 * B) + (\<Sum> N \<in> {2..<B}. eps N * B)"
       apply (simp, rule sum_mono) using BN by auto
     also have "... \<le> (d2/2 * B) + (d2/2*B)"
       using I by auto
     finally show ?thesis by simp
   qed
 
   have ineq_on_Og: "u n x - u (n-l) x > - delta l * l" if "l \<in> {1..n}" "n \<notin> bad_times x" "x \<in> Og" for n x l
   proof -
     consider "n < Nf 1" | "n \<ge> Nf 1 \<and> prev_N l \<le> 1" | "n \<ge> Nf 1 \<and> prev_N l \<ge> 2" by linarith
     then show ?thesis
     proof (cases)
       assume "n < Nf 1"
       then have "{N. Nf N \<le> n} = {0}"
         apply auto using \<open>strict_mono Nf\<close> unfolding strict_mono_def
         apply (metis le_trans less_Suc0 less_imp_le_nat linorder_neqE_nat not_less)
         unfolding Nf_def by auto
       then have "prev_N n = 0" unfolding prev_N_def by auto
       moreover have "prev_N l \<le> prev_N n"
         unfolding prev_N_def apply (rule Max_mono) using \<open>l \<in> {1..n}\<close> fin apply auto
         unfolding Nf_def by auto
       ultimately have "prev_N l = 0" using \<open>prev_N l \<le> prev_N n\<close> by auto
       then have "delta l = K" unfolding delta_def by auto
       have "1 \<notin> {N. Nf N \<le> n}" using fin[of n]
         by (metis (full_types) Max_ge \<open>prev_N n = 0\<close> fin not_one_le_zero prev_N_def)
       then have "n < Nf 1" by auto
       moreover have "n \<ge> 1" using \<open>l \<in> {1..n}\<close> by auto
       ultimately have "n \<in> {1..Nf 1}" by auto
       then have "u n x - u (n-l) x > - (real K * l)" using \<open>x \<in> Og\<close> unfolding Og_def using \<open>l \<in> {1..n}\<close> by auto
       then show ?thesis using \<open>delta l = K\<close> by auto
     next
       assume H: "n \<ge> Nf 1 \<and> prev_N l \<le> 1"
       then have "delta l = K" unfolding delta_def by auto
       have "n \<notin> {n \<in> {Nf 1..}. \<exists>l\<in>{1..n}. u n x - u (n-l) x \<le> - (c0 * l)}"
         using \<open>n \<notin> bad_times x\<close> unfolding bad_times_def by auto
       then have "u n x - u (n-l) x > - (c0 * l)"
         using H \<open>l \<in> {1..n}\<close> by force
       moreover have "- (c0 * l) \<ge> - (real K * l)" using K(1) by (simp add: mult_mono)
       ultimately show ?thesis using \<open>delta l = K\<close> by auto
     next
       assume H: "n \<ge> Nf 1 \<and> prev_N l \<ge> 2"
       define N where "N = prev_N l"
       have "N \<ge> 2" unfolding N_def using H by auto
       have "prev_N l \<in> {N. Nf N \<le> l}"
         unfolding prev_N_def apply (rule Max_in, auto simp add: fin)
         unfolding Nf_def by auto
       then have "Nf N \<le> l" unfolding N_def by auto
       then have "Nf N \<le> n" using \<open>l \<in> {1..n}\<close> by auto
       have "n \<notin> {n \<in> {Nf N..}. \<exists>l \<in> {Nf N..n}. u n x - u (n-l) x \<le> - (eps N * l)}"
         using \<open>n \<notin> bad_times x\<close> \<open>N\<ge>2\<close> unfolding bad_times_def by auto
       then have "u n x - u (n-l) x > - (eps N * l)"
         using \<open>Nf N \<le> n\<close> \<open>Nf N \<le> l\<close> \<open>l \<in> {1..n}\<close> by force
       moreover have "eps N = delta l" unfolding delta_def N_def using H by auto
       ultimately show ?thesis by auto
     qed
   qed
 
   have "Og \<subseteq> {x \<in> space M. \<forall>(B::nat). card {n \<in>{..<B}. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - delta l * l} \<le> d * B}"
   proof (auto)
     fix x assume "x \<in> Og"
     then show "x \<in> space M" unfolding Og_def by auto
   next
     fix x B assume "x \<in> Og"
     have *: "{n. n < B \<and> (\<exists>l\<in>{Suc 0..n}. u n x - u (n - l) x \<le> - (delta l * real l))} \<subseteq> bad_times x \<inter> {..<B}"
       using ineq_on_Og \<open>x\<in>Og\<close> by force
     have "card {n. n < B \<and> (\<exists>l\<in>{Suc 0..n}. u n x - u (n - l) x \<le> - (delta l * real l))} \<le> card (bad_times x \<inter> {..<B})"
       apply (rule card_mono, simp) using * by auto
     also have "... \<le> d2 * B" using card_bad_times \<open>x \<in> Og\<close> by auto
     also have "... \<le> d * B" unfolding d2_def using \<open>d>0\<close> by auto
     finally show "card {n. n < B \<and> (\<exists>l\<in>{Suc 0..n}. u n x - u (n - l) x \<le> - (delta l * real l))} \<le> d * B"
       by simp
   qed
   then have "emeasure M Og \<le> emeasure M {x \<in> space M. \<forall>(B::nat). card {n \<in>{..<B}. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - delta l * l} \<le> d * B}"
     by (rule emeasure_mono, auto)
   then have "emeasure M {x \<in> space M. \<forall>(B::nat). card {n \<in>{..<B}. \<exists>l \<in> {1..n}. u n x - u (n-l) x \<le> - delta l * l} \<le> d * B} > 1-d"
     using \<open>emeasure M Og > 1 - d\<close> by auto
   then show ?thesis using \<open>delta \<longlonglongrightarrow> 0\<close> \<open>\<forall>l. delta l > 0\<close> by auto
 qed
 
 text \<open>We go back to the natural time direction, by using the previous result for the inverse map
 and the inverse subcocycle, and a change of variables argument. The price to pay is that the
 estimates we get are weaker: we have a control on a set of upper asymptotic density close to $1$, while
 having a set of lower asymptotic density close to $1$ as before would be stronger. This will
 nevertheless be sufficient for our purposes below.\<close>
 
 lemma upper_density_good_direction_invertible:
   assumes "invertible_qmpt"
           "d>(0::real)" "d \<le> 1"
   shows "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
         emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} \<ge> 1-d} \<ge> ennreal(1-d)"
 proof -
   interpret I: Gouezel_Karlsson_Kingman M Tinv "(\<lambda>n x. u n ((Tinv^^n) x))"
   proof
     show "Tinv \<in> quasi_measure_preserving M M"
       using Tinv_qmpt[OF \<open>invertible_qmpt\<close>] unfolding qmpt_def qmpt_axioms_def by simp
     show "Tinv \<in> measure_preserving M M"
       using Tinv_mpt[OF \<open>invertible_qmpt\<close>] unfolding mpt_def mpt_axioms_def by simp
     show "mpt.subcocycle M Tinv (\<lambda>n x. u n ((Tinv ^^ n) x))"
       using subcocycle_u_Tinv[OF subu \<open>invertible_qmpt\<close>] by simp
     show "- \<infinity> < subcocycle_avg_ereal (\<lambda>n x. u n ((Tinv ^^ n) x))"
       using subcocycle_avg_ereal_Tinv[OF subu \<open>invertible_qmpt\<close>] subu_fin by simp
     show "AE x in M. fmpt.subcocycle_lim M Tinv (\<lambda>n x. u n ((Tinv ^^ n) x)) x = 0"
       using subcocycle_lim_Tinv[OF subu \<open>invertible_qmpt\<close>] subu_0 by auto
   qed
   have bij: "bij T" using \<open>invertible_qmpt\<close> unfolding invertible_qmpt_def by simp
 
   define e where "e = d * d / 2"
   have "e>0" "e\<le>1" unfolding e_def using \<open>d>0\<close> \<open>d \<le> 1\<close>
     by (auto, meson less_imp_le mult_left_le one_le_numeral order_trans)
   obtain delta::"nat \<Rightarrow> real" where d: "\<And>l. delta l > 0"
                                        "delta \<longlonglongrightarrow> 0"
         "emeasure M {x \<in> space M. \<forall>N.
         card {n \<in> {..<N}. \<exists>l\<in>{1..n}. u n ((Tinv ^^ n) x) - u (n - l) ((Tinv ^^ (n - l)) x) \<le> - delta l * real l} \<le> e * real N}
         > 1-e"
     using I.upper_density_delta[OF \<open>e>0\<close> \<open>e\<le>1\<close>] by blast
 
   define S where "S = {x \<in> space M. \<forall>N.
           card {n \<in> {..<N}. \<exists>l\<in>{1..n}. u n ((Tinv ^^ n) x) - u (n - l) ((Tinv ^^ (n - l)) x) \<le> - delta l * real l} \<le> e * real N}"
   have [measurable]: "S \<in> sets M" unfolding S_def by auto
   have "emeasure M S > 1 - e" unfolding S_def using d(3) by simp
 
   define Og where "Og = (\<lambda>n. {x \<in> space M. \<forall>l\<in>{1..n}. u n ((Tinv ^^ n) x) - u (n - l) ((Tinv ^^ (n - l)) x) > - delta l * real l})"
   have [measurable]: "Og n \<in> sets M" for n unfolding Og_def by auto
   define Pg where "Pg = (\<lambda>n. {x \<in> space M. \<forall>l\<in>{1..n}. u n x - u (n - l) ((T^^l) x) > - delta l * real l})"
   have [measurable]: "Pg n \<in> sets M" for n unfolding Pg_def by auto
 
   define Bad where "Bad = (\<lambda>i::nat. {x \<in> space M. \<forall>N\<ge>i. card {n \<in> {..<N}. x \<in> Pg n} \<le> (1-d) * real N})"
   have [measurable]: "Bad i \<in> sets M" for i unfolding Bad_def by auto
   then have "range Bad \<subseteq> sets M" by auto
   have "incseq Bad"
     unfolding Bad_def incseq_def by auto
   have inc: "{x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d}
         \<subseteq> (\<Union>i. Bad i)"
   proof
     fix x assume H: "x \<in> {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d}"
     then have "x \<in> space M" by simp
     define A where "A = {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l}"
     have "upper_asymptotic_density A < 1-d" using H unfolding A_def by simp
     then have "\<exists>i. \<forall>N\<ge>i. card (A \<inter> {..<N}) \<le> (1-d)* real N"
       using upper_asymptotic_densityD[of A "1-d"] by (metis (no_types, lifting) eventually_sequentially less_imp_le)
     then obtain i where "card (A \<inter> {..<N}) \<le> (1-d)* real N" if "N\<ge>i" for N by blast
     moreover have "A \<inter> {..<N} = {n. n<N \<and> (\<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l)}" for N
       unfolding A_def by auto
     ultimately have "x \<in> Bad i" unfolding Bad_def Pg_def using \<open>x \<in> space M\<close>
       by auto
     then show "x \<in> (\<Union>i. Bad i)" by blast
   qed
 
   have "emeasure M (Og n) \<le> emeasure M (Pg n)" for n
   proof -
     have *: "(T^^n)-`(Og n) \<inter> space M \<subseteq> Pg n" for n
     proof
       fix x assume x: "x \<in> (T^^n)-`(Og n) \<inter> space M"
       define y where "y = (T^^n) x"
       then have "y \<in> Og n" using x by auto
       have "y \<in> space M" using sets.sets_into_space[OF \<open>Og n \<in> sets M\<close>] \<open>y \<in> Og n\<close> by auto
       have "x = (Tinv^^n) y"
         unfolding y_def Tinv_def using inv_fn_o_fn_is_id[OF bij, of n] by (metis comp_apply)
       {
         fix l assume "l \<in> {1..n}"
         have "(T^^l) x = (T^^l) ((Tinv^^l) ((Tinv^^(n-l))y))"
           apply (subst \<open>x = (Tinv^^n) y\<close>) using funpow_add[of l "n-l" Tinv] \<open>l \<in> {1..n}\<close> by fastforce
         then have *: "(T^^l) x = (Tinv^^(n-l)) y"
           unfolding Tinv_def using fn_o_inv_fn_is_id[OF bij] by (metis comp_apply)
         then have "u n x - u (n-l) ((T^^l) x) = u n ((Tinv^^n) y) - u (n-l) ((Tinv^^(n-l)) y)"
           using \<open>x = (Tinv^^n) y\<close> by auto
         also have "... > - delta l * real l"
           using \<open>y \<in> Og n\<close> \<open>l \<in> {1..n}\<close> unfolding Og_def by auto
         finally have "u n x - u (n-l) ((T^^l) x) > - delta l * real l" by simp
       }
       then show "x \<in> Pg n"
         unfolding Pg_def using x by auto
     qed
     have "emeasure M (Og n) = emeasure M ((T^^n)-`(Og n) \<inter> space M)"
       using T_vrestr_same_emeasure(2) unfolding vimage_restr_def by auto
     also have "... \<le> emeasure M (Pg n)"
       apply (rule emeasure_mono) using * by auto
     finally show ?thesis by simp
   qed
 
   {
     fix N::nat assume "N \<ge> 1"
     have I: "card {n\<in>{..<N}. x \<in> Og n} \<ge> (1-e) * real N" if "x \<in> S" for x
     proof -
       have "x \<in> space M" using \<open>x \<in> S\<close> sets.sets_into_space[OF \<open>S \<in> sets M\<close>] by auto
       have a: "real (card {n. n < N \<and> (\<exists>l\<in>{Suc 0..n}. u n ((Tinv ^^ n) x) - u (n - l) ((Tinv ^^ (n - l)) x) \<le> - (delta l * real l))}) \<le> e * real N"
         using \<open>x \<in> S\<close> unfolding S_def by auto
       have *: "{n. n < N} = {n. n < N \<and> (\<exists>l\<in>{Suc 0..n}. u n ((Tinv ^^ n) x) - u (n - l) ((Tinv ^^ (n - l)) x) \<le> - (delta l * real l))}
               \<union> {n. n < N \<and> x \<in> Og n}" unfolding Og_def using \<open>x \<in> space M\<close>
         by (auto, meson atLeastAtMost_iff linorder_not_le)
       have "N = card {n. n < N}" by auto
       also have "... = card {n. n < N \<and> (\<exists>l\<in>{Suc 0..n}. u n ((Tinv ^^ n) x) - u (n - l) ((Tinv ^^ (n - l)) x) \<le> - (delta l * real l))}
               + card {n. n < N \<and> x \<in> Og n}"
         apply (subst *, rule card_Un_disjoint) unfolding Og_def by auto
       ultimately have "real N \<le> e * real N + card {n. n < N \<and> x \<in> Og n}"
         using a by auto
       then show ?thesis
         by (auto simp add: algebra_simps)
     qed
 
     define m where "m = measure M (Bad N)"
     have "m \<ge> 0" "1-m \<ge> 0" unfolding m_def by auto
 
     have *: "1-e \<le> emeasure M S" using \<open>emeasure M S > 1 - e\<close> by auto
     have "ennreal((1-e) * ((1-e) * real N)) = ennreal(1-e) * ennreal((1-e) * real N)"
       apply (rule ennreal_mult) using \<open>e \<le> 1\<close> by auto
     also have "... \<le> emeasure M S * ennreal((1-e) * real N)"
       using mult_right_mono[OF *] by simp
     also have "... = (\<integral>\<^sup>+ x\<in>S. ((1-e) * real N) \<partial>M)"
       by (metis \<open>S \<in> events\<close> mult.commute nn_integral_cmult_indicator)
     also have "... \<le> (\<integral>\<^sup>+x \<in> S. ennreal(card {n\<in>{..<N}. x \<in> Og n}) \<partial>M)"
       apply (rule nn_integral_mono) using I unfolding indicator_def by (simp)
     also have "... \<le> (\<integral>\<^sup>+x \<in> space M. ennreal(card {n\<in>{..<N}. x \<in> Og n}) \<partial>M)"
       by (rule nn_set_integral_set_mono, simp only: sets.sets_into_space[OF \<open>S \<in> sets M\<close>])
     also have "... = (\<integral>\<^sup>+x. ennreal(card {n\<in>{..<N}. x \<in> Og n}) \<partial>M)"
       by (rule nn_set_integral_space)
     also have "... = (\<integral>\<^sup>+x. ennreal (\<Sum>n\<in>{..<N}. ((indicator (Og n) x)::nat)) \<partial>M)"
       apply (rule nn_integral_cong) using sum_indicator_eq_card2[of "{..<N}" Og] by auto
     also have "... = (\<integral>\<^sup>+x. (\<Sum>n\<in>{..<N}. indicator (Og n) x) \<partial>M)"
       apply (rule nn_integral_cong, auto, simp only: sum_ennreal[symmetric])
       by (metis ennreal_0 ennreal_eq_1 indicator_eq_1_iff indicator_simps(2) real_of_nat_indicator)
     also have "... = (\<Sum>n \<in>{..<N}. (\<integral>\<^sup>+x. (indicator (Og n) x) \<partial>M))"
       by (rule nn_integral_sum, simp)
     also have "... = (\<Sum>n \<in>{..<N}. emeasure M (Og n))"
       by simp
     also have "... \<le> (\<Sum>n \<in>{..<N}. emeasure M (Pg n))"
       apply (rule sum_mono) using \<open>\<And>n. emeasure M (Og n) \<le> emeasure M (Pg n)\<close> by simp
     also have "... = (\<Sum>n \<in>{..<N}. (\<integral>\<^sup>+x. (indicator (Pg n) x) \<partial>M))"
       by simp
     also have "... = (\<integral>\<^sup>+x. (\<Sum>n\<in>{..<N}. indicator (Pg n) x) \<partial>M)"
       by (rule nn_integral_sum[symmetric], simp)
     also have "... = (\<integral>\<^sup>+x. ennreal (\<Sum>n\<in>{..<N}. ((indicator (Pg n) x)::nat)) \<partial>M)"
       apply (rule nn_integral_cong, auto, simp only: sum_ennreal[symmetric])
       by (metis ennreal_0 ennreal_eq_1 indicator_eq_1_iff indicator_simps(2) real_of_nat_indicator)
     also have "... = (\<integral>\<^sup>+x. ennreal(card {n\<in>{..<N}. x \<in> Pg n}) \<partial>M)"
       apply (rule nn_integral_cong) using sum_indicator_eq_card2[of "{..<N}" Pg] by auto
     also have "... = (\<integral>\<^sup>+x \<in> space M. ennreal(card {n\<in>{..<N}. x \<in> Pg n}) \<partial>M)"
       by (rule nn_set_integral_space[symmetric])
     also have "... = (\<integral>\<^sup>+x \<in> Bad N \<union> (space M - Bad N). ennreal(card {n\<in>{..<N}. x \<in> Pg n}) \<partial>M)"
       apply (rule nn_integral_cong) unfolding indicator_def by auto
     also have "... = (\<integral>\<^sup>+x \<in> Bad N. ennreal(card {n\<in>{..<N}. x \<in> Pg n}) \<partial>M)
                       + (\<integral>\<^sup>+x \<in> space M - Bad N. ennreal(card {n\<in>{..<N}. x \<in> Pg n}) \<partial>M)"
       by (rule nn_integral_disjoint_pair, auto)
     also have "... \<le> (\<integral>\<^sup>+x \<in> Bad N. ennreal((1-d) * real N) \<partial>M) + (\<integral>\<^sup>+x \<in> space M - Bad N. ennreal(real N) \<partial>M)"
       apply (rule add_mono)
       apply (rule nn_integral_mono, simp add: Bad_def indicator_def, auto)
       apply (rule nn_integral_mono, simp add: indicator_def, auto)
       using card_Collect_less_nat[of N] card_mono[of "{n. n < N}"] by (simp add: Collect_mono_iff)
     also have "... = ennreal((1-d) * real N) * emeasure M (Bad N) + ennreal(real N) * emeasure M (space M - Bad N)"
       by (simp add: nn_integral_cmult_indicator)
     also have "... = ennreal((1-d) * real N) * ennreal(m) + ennreal(real N) * ennreal(1-m)"
       unfolding m_def by (simp add: emeasure_eq_measure prob_compl)
     also have "... = ennreal((1-d) * real N * m + real N * (1-m))"
       using \<open>m \<ge> 0\<close> \<open>1-m \<ge> 0\<close> \<open>d \<le> 1\<close> ennreal_plus ennreal_mult by auto
     finally have "ennreal((1-e) * ((1-e) * real N)) \<le> ennreal((1-d) * real N * m + real N * (1-m))"
       by simp
     moreover have "(1-d) * real N * m + real N * (1-m) \<ge> 0"
       using \<open>m \<ge> 0\<close> \<open>1-m \<ge> 0\<close> \<open>d \<le> 1\<close> by auto
     ultimately have "(1-e) * ((1-e) * real N) \<le> (1-d) * real N * m + real N * (1-m)"
       using ennreal_le_iff by auto
     then have "0 \<le> (e * 2 - d * m - e * e) * real N"
       by (auto simp add: algebra_simps)
     then have "0 \<le> e * 2 - d * m - e * e"
       using \<open>N \<ge> 1\<close> by (simp add: zero_le_mult_iff)
     also have "... \<le> e * 2 - d * m"
       using \<open>e > 0\<close> by auto
     finally have "m \<le> e * 2 / d"
       using \<open>d>0\<close> by (auto simp add: algebra_simps divide_simps)
     then have "m \<le> d"
       unfolding e_def using \<open>d>0\<close> by (auto simp add: divide_simps)
     then have "emeasure M (Bad N) \<le> d"
       unfolding m_def by (simp add: emeasure_eq_measure ennreal_leI)
   }
   then have "emeasure M (\<Union>i. Bad i) \<le> d"
     using LIMSEQ_le_const2[OF Lim_emeasure_incseq[OF \<open>range Bad \<subseteq> sets M\<close> \<open>incseq Bad\<close>]] by auto
   then have "emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d} \<le> d"
     using emeasure_mono[OF inc, of M] by auto
   then have *: "measure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d} \<le> d"
     using emeasure_eq_measure \<open>d>0\<close> by fastforce
 
   have "{x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} \<ge> 1-d}
         = space M - {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d}"
     by auto
   then have "measure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} \<ge> 1-d}
     = measure M (space M - {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d})"
     by simp
   also have "... = measure M (space M)
     - measure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} < 1-d}"
     by (rule measure_Diff, auto)
   also have "... \<ge> 1 - d"
     using * prob_space by linarith
   finally have "emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} \<ge> 1-d} \<ge> 1 - d"
     using emeasure_eq_measure by auto
   then show ?thesis using d(1) d(2) by blast
 qed
 
 text \<open>Now, we want to remove the invertibility assumption in the previous lemma. The idea is to
 go to the natural extension of the system, use the result there and project it back.
 However, if the system is not defined on a polish space, there is no reason why it should have
 a natural extension, so we have first to project the original system on a polish space on which
 the subcocycle is defined. This system is obtained by considering the joint distribution of the
 subcocycle and all its iterates (this is indeed a polish system, as a space of functions from
 $\mathbb{N}^2$ to $\mathbb{R}$).\<close>
 
 lemma upper_density_good_direction:
   assumes "d>(0::real)" "d \<le> 1"
   shows "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
         emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l} \<ge> 1-d} \<ge> ennreal(1-d)"
 proof -
   define U where "U = (\<lambda>x. (\<lambda>n. u n x))"
   define projJ where "projJ = (\<lambda>x. (\<lambda>n. U ((T^^n)x)))"
   define MJ where "MJ = (distr M borel (\<lambda>x. (\<lambda>n. U ((T^^n)x))))"
   define TJ::"(nat \<Rightarrow> nat \<Rightarrow> real) \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow> real)" where "TJ = nat_left_shift"
   have *: "mpt_factor projJ MJ TJ"
     unfolding projJ_def MJ_def TJ_def apply (rule fmpt_factor_projection)
     unfolding U_def by (rule measurable_coordinatewise_then_product, simp)
   interpret J: polish_pmpt MJ TJ
     unfolding projJ_def polish_pmpt_def apply (auto)
     apply (rule pmpt_factor) using * apply simp
     unfolding polish_pmpt_axioms_def MJ_def by auto
   have [simp]: "projJ \<in> measure_preserving M MJ" using mpt_factorE(1)[OF *] by simp
   then have [measurable]: "projJ \<in> measurable M MJ" by (simp add: measure_preservingE(1))
 
   text \<open>We define a subcocycle $uJ$ in the projection corresponding to the original
         subcocycle $u$ above. (With the natural definition, it is only a subcocycle almost
         everywhere.) We check that it shares most properties of $u$.\<close>
 
   define uJ::"nat \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow> real) \<Rightarrow> real" where "uJ = (\<lambda>n x. x 0 n)"
   have [measurable]: "uJ n \<in> borel_measurable borel" for n
     unfolding uJ_def by (metis measurable_product_coordinates measurable_product_then_coordinatewise)
   moreover have "measurable borel borel = measurable MJ borel"
     apply (rule measurable_cong_sets) unfolding MJ_def by auto
   ultimately have [measurable]: "uJ n \<in> borel_measurable MJ" for n by fast
   have uJ_proj: "u n x = uJ n (projJ x)" for n x
     unfolding uJ_def projJ_def U_def by auto
   have uJ_int: "integrable MJ (uJ n)" for n
     apply (rule measure_preserving_preserves_integral'(1)[OF \<open>projJ \<in> measure_preserving M MJ\<close>])
     apply (subst uJ_proj[of n, symmetric]) using int_u[of n] by auto
   have uJ_int2: "(\<integral>x. uJ n x \<partial>MJ) = (\<integral>x. u n x \<partial>M)" for n
     unfolding uJ_proj
     apply (rule measure_preserving_preserves_integral'(2)[OF \<open>projJ \<in> measure_preserving M MJ\<close>])
     apply (subst uJ_proj[of n, symmetric]) using int_u[of n] by auto
   have uJ_AE: "AE x in MJ. uJ (n+m) x \<le> uJ n x + uJ m ((TJ^^n) x)" for m n
   proof -
     have "AE x in M. uJ (n+m) (projJ x) \<le> uJ n (projJ x) + uJ m (projJ ((T^^n) x))"
       unfolding uJ_proj[symmetric] using subcocycle_ineq[OF subu] by auto
     moreover have "AE x in M. projJ ((T^^n) x) = (TJ^^n) (projJ x)"
       using qmpt_factor_iterates[OF mpt_factor_is_qmpt_factor[OF *]] by auto
     ultimately have *: "AE x in M. uJ (n+m) (projJ x) \<le> uJ n (projJ x) + uJ m ((TJ^^n) (projJ x))"
       by auto
     show ?thesis
       apply (rule quasi_measure_preserving_AE'[OF measure_preserving_is_quasi_measure_preserving[OF \<open>projJ \<in> measure_preserving M MJ\<close>], OF *])
       by auto
   qed
   have uJ_0: "AE x in MJ. (\<lambda>n. uJ n x / n) \<longlonglongrightarrow> 0"
   proof -
     have "AE x in M. (\<lambda>n. u n x / n) \<longlonglongrightarrow> subcocycle_lim u x"
       by (rule kingman_theorem_nonergodic(1)[OF subu subu_fin])
     moreover have "AE x in M. subcocycle_lim u x = 0"
       using subu_0 by simp
     ultimately have *: "AE x in M. (\<lambda>n. uJ n (projJ x) / n) \<longlonglongrightarrow> 0"
       unfolding uJ_proj by auto
     show ?thesis
       apply (rule quasi_measure_preserving_AE'[OF measure_preserving_is_quasi_measure_preserving[OF \<open>projJ \<in> measure_preserving M MJ\<close>], OF *])
       by auto
   qed
 
   text \<open>Then, we go to the natural extension of $TJ$, to have an invertible system.\<close>
 
   define MI where "MI = J.natural_extension_measure"
   define TI where "TI = J.natural_extension_map"
   define projI where "projI = J.natural_extension_proj"
   interpret I: pmpt MI TI unfolding MI_def TI_def by (rule J.natural_extension(1))
   have "I.mpt_factor projI MJ TJ" unfolding projI_def
     using I.mpt_factorE(1) J.natural_extension(3) MI_def TI_def by auto
   then have [simp]: "projI \<in> measure_preserving MI MJ" using I.mpt_factorE(1) by auto
   then have [measurable]: "projI \<in> measurable MI MJ" by (simp add: measure_preservingE(1))
   have "I.invertible_qmpt"
     using J.natural_extension(2) MI_def TI_def by auto
 
   text \<open>We define a natural subcocycle $uI$ there, and check its properties.\<close>
 
   define uI where uI_proj: "uI = (\<lambda>n x. uJ n (projI x))"
   have [measurable]: "uI n \<in> borel_measurable MI" for n unfolding uI_proj by auto
   have uI_int: "integrable MI (uI n)" for n
     unfolding uI_proj by (rule measure_preserving_preserves_integral(1)[OF \<open>projI \<in> measure_preserving MI MJ\<close> uJ_int])
   have "(\<integral>x. uJ n x \<partial>MJ) = (\<integral>x. uI n x \<partial>MI)" for n
     unfolding uI_proj by (rule measure_preserving_preserves_integral(2)[OF \<open>projI \<in> measure_preserving MI MJ\<close> uJ_int])
   then have uI_int2: "(\<integral>x. uI n x \<partial>MI) = (\<integral>x. u n x \<partial>M)" for n
     using uJ_int2 by simp
   have uI_AE: "AE x in MI. uI (n+m) x \<le> uI n x + uI m (((TI)^^n) x)" for m n
   proof -
     have "AE x in MI. uJ (n+m) (projI x) \<le> uJ n (projI x) + uJ m (((TJ)^^n) (projI x))"
       apply (rule quasi_measure_preserving_AE[OF measure_preserving_is_quasi_measure_preserving[OF \<open>projI \<in> measure_preserving MI MJ\<close>]])
       using uJ_AE by auto
     moreover have "AE x in MI. ((TJ)^^n) (projI x) = projI (((TI)^^n) x)"
       using I.qmpt_factor_iterates[OF I.mpt_factor_is_qmpt_factor[OF \<open>I.mpt_factor projI MJ TJ\<close>]]
       by auto
     ultimately show ?thesis unfolding uI_proj by auto
   qed
   have uI_0: "AE x in MI. (\<lambda>n. uI n x / n) \<longlonglongrightarrow> 0"
     unfolding uI_proj
     apply (rule quasi_measure_preserving_AE[OF measure_preserving_is_quasi_measure_preserving[OF \<open>projI \<in> measure_preserving MI MJ\<close>]])
     using uJ_0 by simp
 
   text \<open>As $uI$ is only a subcocycle almost everywhere, we correct it to get a genuine subcocycle,
         to which we will apply Lemma \verb+upper_density_good_direction_invertible+.\<close>
 
   obtain vI where H: "I.subcocycle vI" "AE x in MI. \<forall>n. vI n x = uI n x"
     using I.subcocycle_AE[OF uI_AE uI_int] by blast
   have [measurable]: "\<And>n. vI n \<in> borel_measurable MI" "\<And>n. integrable MI (vI n)"
     using I.subcocycle_integrable[OF H(1)] by auto
   have "(\<integral>x. vI n x \<partial>MI) = (\<integral>x. uI n x \<partial>MI)" for n
     apply (rule integral_cong_AE) using H(2) by auto
   then have "(\<integral>x. vI n x \<partial>MI) = (\<integral>x. u n x \<partial>M)" for n
     using uI_int2 by simp
   then have "I.subcocycle_avg_ereal vI = subcocycle_avg_ereal u"
     unfolding I.subcocycle_avg_ereal_def subcocycle_avg_ereal_def by auto
   then have vI_fin: "I.subcocycle_avg_ereal vI > -\<infinity>" using subu_fin by simp
   have "AE x in MI. (\<lambda>n. vI n x / n) \<longlonglongrightarrow> 0"
     using uI_0 H(2) by auto
   moreover have "AE x in MI. (\<lambda>n. vI n x / n) \<longlonglongrightarrow> I.subcocycle_lim vI x"
     by (rule I.kingman_theorem_nonergodic(1)[OF H(1) vI_fin])
   ultimately have vI_0: "AE x in MI. I.subcocycle_lim vI x = 0"
     using LIMSEQ_unique by auto
 
   interpret GKK: Gouezel_Karlsson_Kingman MI TI vI
     apply standard
     using H(1) vI_fin vI_0 by auto
   obtain delta where delta: "\<And>l. delta l > 0" "delta \<longlonglongrightarrow> 0"
       "emeasure MI {x \<in> space MI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < vI n x - vI (n - l) ((TI ^^ l) x)} \<ge> 1 - d } \<ge> 1 - d"
     using GKK.upper_density_good_direction_invertible[OF \<open>I.invertible_qmpt\<close> \<open>d>0\<close> \<open>d\<le>1\<close>] by blast
 
   text \<open>Then, we need to go back to the original system, showing that the estimates for $TI$ carry
         over. First, we go to $TJ$.\<close>
 
   have BJ: "emeasure MJ {x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d } \<ge> 1 - d"
   proof -
     have *: "AE x in MI. uJ n (projI x) = vI n x" for n
       using uI_proj H(2) by auto
     have **: "AE x in MI. \<forall>n. uJ n (projI x) = vI n x"
       by (subst AE_all_countable, auto intro: *)
     have "AE x in MI. \<forall>m n. uJ n (projI ((TI^^m) x)) = vI n ((TI^^m) x)"
       by (rule I.T_AE_iterates[OF **])
     then have "AE x in MI. (\<forall>m n. uJ n (projI ((TI^^m) x)) = vI n ((TI^^m) x)) \<and> (\<forall>n. projI ((TI^^n) x) = (TJ^^n) (projI x))"
       using I.qmpt_factor_iterates[OF I.mpt_factor_is_qmpt_factor[OF \<open>I.mpt_factor projI MJ TJ\<close>]] by auto
     then obtain ZI where ZI: "\<And>x. x \<in> space MI - ZI \<Longrightarrow> (\<forall>m n. uJ n (projI ((TI^^m) x)) = vI n ((TI^^m) x)) \<and> (\<forall>n. projI ((TI^^n) x) = (TJ^^n) (projI x))"
                              "ZI \<in> null_sets MI"
       using AE_E3 by blast
 
     have *: "uJ n (projI x) - uJ (n - l) ((TJ ^^ l) (projI x)) = vI n x - vI (n - l) ((TI ^^ l) x)" if "x \<in> space MI - ZI" for x n l
     proof -
       have "(TI^^0) x = x" "(TJ^^0) (projI x) = (projI x)" by auto
       then show ?thesis using ZI(1)[OF that] by metis
     qed
     have "projI-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space MI - ZI
           = {x \<in> space MI - ZI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n (projI x) - uJ (n - l) ((TJ ^^ l) (projI x))} \<ge> 1 - d}"
       by (auto simp add: measurable_space[OF \<open>projI \<in> measurable MI MJ\<close>])
     also have "... = {x \<in> space MI - ZI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < vI n x - vI (n - l) ((TI ^^ l) x)} \<ge> 1 - d}"
       using * by auto
     also have "... = {x \<in> space MI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < vI n x - vI (n - l) ((TI ^^ l) x)} \<ge> 1 - d} - ZI"
       by auto
     finally have *: "projI-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space MI - ZI
       = {x \<in> space MI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < vI n x - vI (n - l) ((TI ^^ l) x)} \<ge> 1 - d} - ZI"
       by simp
 
     have "emeasure MJ {x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d}
           = emeasure MI (projI-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space MI)"
       by (rule measure_preservingE(2)[symmetric], auto)
     also have "... = emeasure MI ((projI-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space MI) - ZI)"
       by (rule emeasure_Diff_null_set[OF \<open>ZI \<in> null_sets MI\<close>, symmetric], measurable)
     also have "... = emeasure MI ({x \<in> space MI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < vI n x - vI (n - l) ((TI ^^ l) x)} \<ge> 1 - d} - ZI)"
       using * by simp
     also have "... = emeasure MI {x \<in> space MI. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < vI n x - vI (n - l) ((TI ^^ l) x)} \<ge> 1 - d}"
       by (rule emeasure_Diff_null_set[OF \<open>ZI \<in> null_sets MI\<close>], measurable)
     also have "... \<ge> 1-d"
       using delta(3) by simp
     finally show ?thesis by simp
   qed
 
   text \<open>Then, we go back to $T$ with virtually the same argument.\<close>
 
   have "emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < u n x - u (n - l) ((T ^^ l) x)} \<ge> 1 - d } \<ge> 1 - d"
   proof -
       obtain Z where Z: "\<And>x. x \<in> space M - Z \<Longrightarrow> (\<forall>n. projJ ((T^^n) x) = (TJ^^n) (projJ x))"
                         "Z \<in> null_sets M"
       using AE_E3[OF qmpt_factor_iterates[OF mpt_factor_is_qmpt_factor[OF \<open>mpt_factor projJ MJ TJ\<close>]]] by blast
 
     have *: "uJ n (projJ x) - uJ (n - l) ((TJ ^^ l) (projJ x)) = u n x - u (n - l) ((T^^ l) x)" if "x \<in> space M - Z" for x n l
     proof -
       have "(T^^0) x = x" "(TJ^^0) (projJ x) = (projJ x)" by auto
       then show ?thesis using Z(1)[OF that] uJ_proj by metis
     qed
     have "projJ-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space M - Z
           = {x \<in> space M - Z. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n (projJ x) - uJ (n - l) ((TJ ^^ l) (projJ x))} \<ge> 1 - d}"
       by (auto simp add: measurable_space[OF \<open>projJ \<in> measurable M MJ\<close>])
     also have "... = {x \<in> space M - Z. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < u n x - u (n - l) ((T ^^ l) x)} \<ge> 1 - d}"
       using * by auto
     also have "... = {x \<in> space M. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < u n x - u (n - l) ((T ^^ l) x)} \<ge> 1 - d} - Z"
       by auto
     finally have *: "projJ-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space M - Z
       = {x \<in> space M. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < u n x - u (n - l) ((T ^^ l) x)} \<ge> 1 - d} - Z"
       by simp
 
     have "emeasure MJ {x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d}
         = emeasure M (projJ-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space M)"
       by (rule measure_preservingE(2)[symmetric], auto)
     also have "... = emeasure M ((projJ-`{x \<in> space MJ. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < uJ n x - uJ (n - l) ((TJ ^^ l) x)} \<ge> 1 - d} \<inter> space M) - Z)"
       by (rule emeasure_Diff_null_set[OF \<open>Z \<in> null_sets M\<close>, symmetric], measurable)
     also have "... = emeasure M ({x \<in> space M. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < u n x - u (n - l) ((T ^^ l) x)} \<ge> 1 - d} - Z)"
       using * by simp
     also have "... = emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l\<in>{1..n}. - delta l * real l < u n x - u (n - l) ((T ^^ l) x)} \<ge> 1 - d}"
       by (rule emeasure_Diff_null_set[OF \<open>Z \<in> null_sets M\<close>], measurable)
     finally show ?thesis using BJ by simp
   qed
   then show ?thesis using delta(1) delta(2) by auto
 qed
 
 text \<open>From the quantitative lemma above, we deduce the qualitative statement we are after,
 still in the setting of the locale.\<close>
 
 lemma infinite_AE:
   shows "AE x in M. \<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l})"
 proof -
   have "\<exists>deltaf::real \<Rightarrow> nat \<Rightarrow> real. \<forall>d. ((d > 0 \<and> d \<le> 1) \<longrightarrow> ((\<forall>l. deltaf d l > 0) \<and> (deltaf d \<longlonglongrightarrow> 0) \<and>
         emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - (deltaf d l) * l} \<ge> 1-d} \<ge> ennreal(1-d)))"
     apply (subst choice_iff'[symmetric]) using upper_density_good_direction by auto
   then obtain deltaf::"real \<Rightarrow> nat \<Rightarrow> real" where H: "\<And>d. d > 0 \<and> d \<le>1 \<Longrightarrow> (\<forall>l. deltaf d l > 0) \<and> (deltaf d \<longlonglongrightarrow> 0) \<and>
       emeasure M {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - (deltaf d l) * l} \<ge> 1-d} \<ge> ennreal(1-d)"
     by blast
 
   define U where "U = (\<lambda>d. {x \<in> space M. upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - (deltaf d l) * l} \<ge> 1-d})"
   have [measurable]: "U d \<in> sets M" for d
     unfolding U_def by auto
   have *: "emeasure M (U d) \<ge> 1 - d" if "d>0 \<and> d\<le> 1" for d
     unfolding U_def using H that by auto
   define V where "V = (\<Union>n::nat. U (1/(n+2)))"
   have [measurable]: "V \<in> sets M"
     unfolding V_def by auto
   have a: "emeasure M V \<ge> 1 - 1 / (n + 2)" for n::nat
   proof -
     have "1 - 1 / (n + 2) = 1 - 1 / (real n + 2)"
       by auto
     also have "... \<le> emeasure M (U (1/(real n+2)))"
       using *[of "1 / (real n + 2)"] by auto
     also have "... \<le> emeasure M V"
       apply (rule Measure_Space.emeasure_mono) unfolding V_def by auto
     finally show ?thesis by simp
   qed
   have b: "(\<lambda>n::nat. 1 - 1 / (n + 2)) \<longlonglongrightarrow> ennreal(1 - 0)"
     by (intro tendsto_intros LIMSEQ_ignore_initial_segment)
   have "emeasure M V \<ge> 1 - 0"
     apply (rule Lim_bounded) using a b by auto
   then have "emeasure M V = 1"
     by (simp add: emeasure_ge_1_iff)
   then have "AE x in M. x \<in> V"
     by (simp add: emeasure_eq_measure prob_eq_1)
   moreover
   {
     fix x assume "x \<in> V"
     then obtain n::nat where "x \<in> U (1/(real n+2))" unfolding V_def by blast
     define d where "d = 1/(real n + 2)"
     have "0 < d" "d\<le>1" unfolding d_def by auto
     have "0 < 1-d" unfolding d_def by auto
     also have "... \<le> upper_asymptotic_density {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - (deltaf d l) * l}"
       using \<open>x \<in> U (1/(real n+2))\<close> unfolding U_def d_def by auto
     finally have "infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - (deltaf d l) * l}"
       using upper_asymptotic_density_finite by force
     then have "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) > - delta l * l})"
       using H \<open>0 < d\<close> \<open>d\<le>1\<close> by auto
   }
   ultimately show ?thesis by auto
 qed
 
 end
 
 text \<open>Finally, we obtain the full statement, by reducing to the previous situation where the
 asymptotic average vanishes.\<close>
 
 theorem (in pmpt) Gouezel_Karlsson_Kingman:
   assumes "subcocycle u" "subcocycle_avg_ereal u > -\<infinity>"
   shows "AE x in M. \<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > - delta l * l})"
 proof -
   have [measurable]: "integrable M (u n)" "u n \<in> borel_measurable M" for n
     using subcocycle_integrable[OF assms(1)] by auto
 
   define v where "v = birkhoff_sum (\<lambda>x. -subcocycle_lim u x)"
   have int [measurable]: "integrable M (\<lambda>x. -subcocycle_lim u x)"
     using kingman_theorem_nonergodic(2)[OF assms] by auto
   have "subcocycle v" unfolding v_def
     apply (rule subcocycle_birkhoff)
     using assms \<open>integrable M (\<lambda>x. -subcocycle_lim u x)\<close> unfolding subcocycle_def by auto
   have "subcocycle_avg_ereal v > - \<infinity>"
     unfolding v_def using subcocycle_avg_ereal_birkhoff[OF int] kingman_theorem_nonergodic(2)[OF assms] by auto
   have "AE x in M. subcocycle_lim v x = real_cond_exp M Invariants (\<lambda>x. -subcocycle_lim u x) x"
     unfolding v_def by (rule subcocycle_lim_birkhoff[OF int])
   moreover have "AE x in M. real_cond_exp M Invariants (\<lambda>x. - subcocycle_lim u x) x = - subcocycle_lim u x"
     by (rule real_cond_exp_F_meas[OF int], auto)
   ultimately have AEv: "AE x in M. subcocycle_lim v x = - subcocycle_lim u x"
     by auto
 
   define w where "w = (\<lambda>n x. u n x + v n x)"
   have a: "subcocycle w"
     unfolding w_def by (rule subcocycle_add[OF assms(1) \<open>subcocycle v\<close>])
   have b: "subcocycle_avg_ereal w > -\<infinity>"
     unfolding w_def by (rule subcocycle_avg_add(1)[OF assms(1) \<open>subcocycle v\<close> assms(2) \<open>subcocycle_avg_ereal v > - \<infinity>\<close>])
   have "AE x in M. subcocycle_lim w x = subcocycle_lim u x + subcocycle_lim v x"
     unfolding w_def by (rule subcocycle_lim_add[OF assms(1) \<open>subcocycle v\<close> assms(2) \<open>subcocycle_avg_ereal v > - \<infinity>\<close>])
   then have c: "AE x in M. subcocycle_lim w x = 0"
     using AEv by auto
 
   interpret Gouezel_Karlsson_Kingman M T w
     apply standard using a b c by auto
   have "AE x in M. \<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. w n x - w (n-l) ((T^^l) x) > - delta l * l})"
     using infinite_AE by auto
   moreover
   {
     fix x assume H: "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. w n x - w (n-l) ((T^^l) x) > - delta l * l})"
             "x \<in> space M"
     have *: "v n x = - n * subcocycle_lim u x" for n
       unfolding v_def using birkhoff_sum_of_invariants[OF _ \<open>x \<in> space M\<close>] by auto
     have **: "v n ((T^^l) x) = - n * subcocycle_lim u x" for n l
     proof -
       have "v n ((T^^l) x) = - n * subcocycle_lim u ((T^^l) x)"
         unfolding v_def using birkhoff_sum_of_invariants[OF _ T_spaceM_stable(2)[OF \<open>x \<in> space M\<close>]] by auto
       also have "... = - n * subcocycle_lim u x"
         using Invariants_func_is_invariant_n[OF subcocycle_lim_meas_Inv(2) \<open>x \<in> space M\<close>] by auto
       finally show ?thesis by simp
     qed
     have "w n x - w (n-l) ((T^^l) x) = u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x" if "l \<in> {1..n}" for n l
       unfolding w_def using *[of n] **[of "n-l" l] that apply (auto simp add: algebra_simps)
       by (metis comm_semiring_class.distrib diff_add_inverse nat_le_iff_add of_nat_add)
     then have "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > - delta l * l})"
       using H(1) by auto
   }
   ultimately show ?thesis by auto
 qed
 
 text \<open>The previous theorem only contains a lower bound. The corresponding upper bound follows
 readily from Kingman's theorem. The next statement combines both upper and lower bounds.\<close>
 
 theorem (in pmpt) Gouezel_Karlsson_Kingman':
   assumes "subcocycle u" "subcocycle_avg_ereal u > -\<infinity>"
   shows "AE x in M. \<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. abs(u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x) < delta l * l})"
 proof -
   {
     fix x assume x: "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > - delta l * l})"
                     "(\<lambda>l. u l x/l) \<longlonglongrightarrow> subcocycle_lim u x"
     then obtain alpha::"nat \<Rightarrow> real" where a: "\<And>l. alpha l > 0" "alpha \<longlonglongrightarrow> 0"
         "infinite {n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > - alpha l * l}"
       by auto
     define delta::"nat \<Rightarrow> real" where "delta = (\<lambda>l. alpha l + norm(u l x / l - subcocycle_lim u x))"
     {
       fix n assume *: "\<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > - alpha l * l"
       have H: "x > -a \<Longrightarrow> x < a \<Longrightarrow> abs x < a" for a x::real by simp
       have "abs(u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x) < delta l * l" if "l\<in>{1..n}" for l
       proof (rule H)
         have "u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x \<le> u l x - l * subcocycle_lim u x"
           using assms(1) subcocycle_ineq[OF assms(1), of l "n-l" x] that by auto
         also have "... \<le> l * norm(u l x/l - subcocycle_lim u x)"
           using that by (auto simp add: algebra_simps divide_simps)
         also have "... < delta l * l"
           unfolding delta_def using a(1)[of l] that by auto
         finally show "u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x < delta l * l" by simp
 
         have "- (delta l * l) \<le> -alpha l * l"
           unfolding delta_def by (auto simp add: algebra_simps)
         also have "... < u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x"
           using * that by auto
         finally show "u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > -(delta l * l)"
           by simp
       qed
       then have "\<forall>l \<in> {1..n}. abs(u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x) < delta l * l"
         by auto
     }
     then have "{n. \<forall>l \<in> {1..n}. u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x > - alpha l * l}
           \<subseteq> {n. \<forall>l \<in> {1..n}. abs(u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x) < delta l * l}"
       by auto
     then have "infinite {n. \<forall>l \<in> {1..n}. abs(u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x) < delta l * l}"
       using a(3) finite_subset by blast
     moreover have "delta \<longlonglongrightarrow> 0 + 0"
       unfolding delta_def using x(2) by (intro tendsto_intros a(2) tendsto_norm_zero LIM_zero)
     moreover have "delta l > 0" for l unfolding delta_def using a(1)[of l] by auto
     ultimately have "\<exists>delta::nat\<Rightarrow>real. (\<forall>l. delta l > 0) \<and> (delta \<longlonglongrightarrow> 0) \<and>
           (infinite {n. \<forall>l \<in> {1..n}. abs(u n x - u (n-l) ((T^^l) x) - l * subcocycle_lim u x) < delta l * l})"
       by auto
   }
   then show ?thesis
     using Gouezel_Karlsson_Kingman[OF assms] kingman_theorem_nonergodic(1)[OF assms] by auto
 qed
 
 end (*of Gouezel_Karlsson.thy*)
diff --git a/thys/Ergodic_Theory/Invariants.thy b/thys/Ergodic_Theory/Invariants.thy
--- a/thys/Ergodic_Theory/Invariants.thy
+++ b/thys/Ergodic_Theory/Invariants.thy
@@ -1,1796 +1,1796 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     License: BSD
 *)
 
 section \<open>The invariant sigma-algebra, Birkhoff theorem\<close>
 
 theory Invariants
   imports Recurrence "HOL-Probability.Conditional_Expectation"
 begin
 
 subsection \<open>The sigma-algebra of invariant subsets\<close>
 
 text \<open>The invariant sigma-algebra of a qmpt is made of those sets that are invariant under the
 dynamics. When the transformation is ergodic, it is made of sets of zero or full measure. In
 general, the Birkhoff theorem is expressed in terms of the conditional expectation of an integrable
 function with respect to the invariant sigma-algebra.\<close>
 
 context qmpt begin
 
 text \<open>We define the invariant sigma-algebra, as the sigma algebra of sets which are invariant
 under the dynamics, i.e., they coincide with their preimage under $T$.\<close>
 
 definition Invariants where "Invariants = sigma (space M) {A \<in> sets M. T-`A \<inter> space M = A}"
 
 text \<open>For this definition to make sense, we need to check that it really defines a sigma-algebra:
 otherwise, the \verb+sigma+ operation would make garbage out of it. This is the content of the next
 lemma.\<close>
 
 lemma Invariants_sets: "sets Invariants = {A \<in> sets M. T-`A \<inter> space M = A}"
 proof -
   have "sigma_algebra (space M) {A \<in> sets M. T-`A \<inter> space M = A}"
   proof -
     define I where "I = {A. T-`A \<inter> space M = A}"
     have i: "\<And>A. A \<in> I \<Longrightarrow> A \<subseteq> space M" unfolding I_def by auto
     have "algebra (space M) I"
     proof (subst algebra_iff_Un)
       have a: "I \<subseteq> Pow (space M)" using i by auto
       have b: "{} \<in> I" unfolding I_def by auto
       {
         fix A assume *: "A \<in> I"
         then have "T-`(space M - A) = T-`(space M) - T-`A" by auto
         then have "T-`(space M - A) \<inter> space M = T-`(space M) \<inter> (space M) - T-`A \<inter> (space M)" by auto
         also have "... = space M - A" using * I_def by (simp add: inf_absorb2 subsetI)
         finally have "space M - A \<in> I" unfolding I_def by simp
       }
       then have c: "(\<forall>a\<in>I. space M - a \<in> I)" by simp
       have d: "(\<forall>a\<in>I. \<forall>b\<in>I. a \<union> b \<in> I)" unfolding I_def by auto
       show "I \<subseteq> Pow (space M) \<and> {} \<in> I \<and> (\<forall>a\<in>I. space M - a \<in> I) \<and> (\<forall>a\<in>I. \<forall>b\<in>I. a \<union> b \<in> I)"
         using a b c d by blast
     qed
     moreover have "(\<forall>F. range F \<subseteq> I \<longrightarrow> (\<Union>i::nat. F i) \<in> I)" unfolding I_def by auto
     ultimately have "sigma_algebra (space M) I" using sigma_algebra_iff by auto
     moreover have "sigma_algebra (space M) (sets M)" using measure_space measure_space_def by auto
     ultimately have "sigma_algebra (space M) (I \<inter> (sets M))" using sigma_algebra_intersection by auto
     moreover have "I \<inter> sets M = {A \<in> sets M. T-`A \<inter> space M = A}" unfolding I_def by auto
     ultimately show ?thesis by simp
   qed
   then show ?thesis unfolding Invariants_def using sigma_algebra.sets_measure_of_eq by blast
 qed
 
 text \<open>By definition, the invariant subalgebra is a subalgebra of the original algebra. This is
 expressed in the following lemmas.\<close>
 
 lemma Invariants_is_subalg: "subalgebra M Invariants"
   unfolding subalgebra_def
   using Invariants_sets Invariants_def by (simp add: space_measure_of_conv)
 
 lemma Invariants_in_sets:
   assumes "A \<in> sets Invariants"
   shows "A \<in> sets M"
 using Invariants_sets assms by blast
 
 lemma Invariants_measurable_func:
   assumes "f \<in> measurable Invariants N"
   shows "f \<in> measurable M N"
 using Invariants_is_subalg measurable_from_subalg assms by auto
 
 text \<open>We give several trivial characterizations of invariant sets or functions.\<close>
 
 lemma Invariants_vrestr:
   assumes "A \<in> sets Invariants"
   shows "T--`A = A"
 using assms Invariants_sets Invariants_in_sets[OF assms] by auto
 
 lemma Invariants_points:
   assumes "A \<in> sets Invariants" "x \<in> A"
   shows "T x \<in> A"
 using assms Invariants_sets by auto
 
 lemma Invariants_func_is_invariant:
   fixes f::"_ \<Rightarrow> 'b::t2_space"
   assumes "f \<in> borel_measurable Invariants" "x \<in> space M"
   shows "f (T x) = f x"
 proof -
   have "{f x} \<in> sets borel" by simp
   then have "f-`({f x}) \<inter> space M \<in> Invariants" using assms(1)
     by (metis (no_types, lifting) Invariants_def measurable_sets space_measure_of_conv)
   moreover have "x \<in> f-`({f x}) \<inter> space M" using assms(2) by blast
   ultimately have "T x \<in> f-`({f x}) \<inter> space M" by (rule Invariants_points)
   then show ?thesis by simp
 qed
 
 lemma Invariants_func_is_invariant_n:
   fixes f::"_ \<Rightarrow> 'b::t2_space"
   assumes "f \<in> borel_measurable Invariants" "x \<in> space M"
   shows "f ((T^^n) x) = f x"
 by (induction n, auto simp add: assms Invariants_func_is_invariant)
 
 lemma Invariants_func_charac:
   assumes [measurable]: "f \<in> measurable M N"
       and "\<And>x. x \<in> space M \<Longrightarrow> f(T x) = f x"
   shows "f \<in> measurable Invariants N"
 proof (rule measurableI)
   fix A assume "A \<in> sets N"
   have "space Invariants = space M" using Invariants_is_subalg subalgebra_def by force
   show "f -` A \<inter> space Invariants \<in> sets Invariants"
     apply (subst Invariants_sets)
     apply (auto simp add: assms \<open>A \<in> sets N\<close> \<open>space Invariants = space M\<close>)
     using \<open>A \<in> sets N\<close> assms(1) measurable_sets by blast
 next
   fix x assume "x \<in> space Invariants"
   have "space Invariants = space M" using Invariants_is_subalg subalgebra_def by force
   then show "f x \<in> space N" using assms(1) \<open>x \<in> space Invariants\<close> by (metis measurable_space)
 qed
 
 lemma birkhoff_sum_of_invariants:
   fixes f::" _ \<Rightarrow> real"
   assumes "f \<in> borel_measurable Invariants" "x \<in> space M"
   shows "birkhoff_sum f n x = n * f x"
 unfolding birkhoff_sum_def using Invariants_func_is_invariant_n[OF assms] by auto
 
 text \<open>There are two possible definitions of the invariant sigma-algebra, competing in the
 literature: one could also use the sets such that $T^{-1}A$ coincides with $A$ up to
 a measure $0$ set. It turns out that this is equivalent to being invariant (in our sense) up
 to a measure $0$ set. Therefore, for all interesting purposes, the two definitions would
 give the same results.
 
 For the proof, we start from an almost invariant set, and build a genuinely invariant set that
 coincides with it by adding or throwing away null parts.
 \<close>
 
 proposition Invariants_quasi_Invariants_sets:
   assumes [measurable]: "A \<in> sets M"
   shows "(\<exists>B \<in> sets Invariants. A \<Delta> B \<in> null_sets M) \<longleftrightarrow> (T--`A \<Delta> A \<in> null_sets M)"
 proof
   assume "\<exists>B \<in> sets Invariants. A \<Delta> B \<in> null_sets M"
   then obtain B where "B \<in> sets Invariants" "A \<Delta> B \<in> null_sets M" by auto
   then have [measurable]: "B \<in> sets M" using Invariants_in_sets by simp
 
   have "B = T--` B" using Invariants_vrestr \<open>B \<in> sets Invariants\<close> by simp
   then have "T--`A \<Delta> B = T--`(A \<Delta> B)" by simp
   moreover have "T--`(A \<Delta> B) \<in> null_sets M"
     by (rule T_quasi_preserves_null2(1)[OF \<open>A \<Delta> B \<in> null_sets M\<close>])
   ultimately have "T--`A \<Delta> B \<in> null_sets M" by simp
   then show "T--`A \<Delta> A \<in> null_sets M"
     by (rule null_sym_diff_transitive) (auto simp add: \<open>A \<Delta> B \<in> null_sets M\<close> Un_commute)
 next
   assume H: "T --` A \<Delta> A \<in> null_sets M"
   have [measurable]: "\<And>n. (T^^n)--`A \<in> sets M" by simp
   {
     fix K assume [measurable]: "K \<in> sets M" and "T--`K \<Delta> K \<in> null_sets M"
     fix n::nat
     have "(T^^n)--`K \<Delta> K \<in> null_sets M"
     proof (induction n)
       case 0
       have "(T^^0)--` K = K" using T_vrestr_0 by simp
       then show ?case using Diff_cancel sup.idem by (metis null_sets.empty_sets)
     next
       case (Suc n)
       have "T--`((T^^n)--`K \<Delta> K) \<in> null_sets M"
         using Suc.IH T_quasi_preserves_null(1)[of "((T^^n)--`K \<Delta> K)"] by simp
       then have *: "(T^^(Suc n))--`K \<Delta> T--`K \<in> null_sets M" using T_vrestr_composed(2)[OF \<open>K \<in> sets M\<close>] by simp
       then show ?case
         by (rule null_sym_diff_transitive, simp add: \<open>T--`K \<Delta> K \<in> null_sets M\<close> \<open>K \<in> sets M\<close>, measurable)
     qed
   } note * = this
 
   define C where "C = (\<Inter>n. (T^^n)--`A)"
   have [measurable]: "C \<in> sets M" unfolding C_def by simp
   have "C \<Delta> A \<subseteq> (\<Union>n. (T^^n)--`A \<Delta> A)" unfolding C_def by auto
   moreover have "(\<Union>n. (T^^n)--`A \<Delta> A) \<in> null_sets M"
     using * null_sets_UN assms \<open>T --` A \<Delta> A \<in> null_sets M\<close> by auto
   ultimately have CA: "C \<Delta> A \<in> null_sets M" by (meson \<open>C \<in> sets M\<close> assms sets.Diff sets.Un null_sets_subset)
   then have "T--`(C \<Delta> A) \<in> null_sets M" by (rule T_quasi_preserves_null2(1))
   then have "T--`C \<Delta> T--`A \<in> null_sets M" by simp
   then have "T--`C \<Delta> A \<in> null_sets M"
     by (rule null_sym_diff_transitive, auto simp add: H)
   then have TCC: "T--`C \<Delta> C \<in> null_sets M"
     apply (rule null_sym_diff_transitive) using CA by (auto simp add: Un_commute)
 
   have "C \<subseteq> (\<Inter>n\<in>{1..}. (T^^n)--`A)" unfolding C_def by auto
   moreover have "T--`C = (\<Inter>n\<in>{1..}. (T^^n)--`A)"
     using T_vrestr_composed(2)[OF assms] by (simp add: C_def atLeast_Suc_greaterThan greaterThan_0)
   ultimately have "C \<subseteq> T--`C" by blast
   then have "(T^^0)--`C \<subseteq> (T^^1)--`C" using T_vrestr_0 by auto
   moreover have "(T^^1)--`C \<subseteq> (\<Union>n\<in>{1..}. (T^^n)--`C)" by auto
   ultimately have "(T^^0)--`C \<subseteq> (\<Union>n\<in>{1..}. (T^^n)--`C)" by auto
   then have "(T^^0)--`C \<union> (\<Union>n\<in>{1..}. (T^^n)--`C) = (\<Union>n\<in>{1..}. (T^^n)--`C)" by auto
   moreover have "(\<Union>n. (T^^n)--`C) = (T^^0)--`C \<union> (\<Union>n\<in>{1..}. (T^^n)--`C)" by (rule union_insert_0)
   ultimately have C2: "(\<Union>n. (T^^n)--`C) = (\<Union>n\<in>{1..}. (T^^n)--`C)" by simp
 
   define B where "B = (\<Union>n. (T^^n)--`C)"
   have [measurable]: "B \<in> sets M" unfolding B_def by simp
   have "B \<Delta> C \<subseteq> (\<Union>n. (T^^n)--`C \<Delta> C)" unfolding B_def by auto
   moreover have "(\<Union>n. (T^^n)--`C \<Delta> C) \<in> null_sets M"
     using * null_sets_UN assms TCC by auto
   ultimately have "B \<Delta> C \<in> null_sets M" by (meson \<open>B \<in> sets M\<close> \<open>C \<in> sets M\<close> assms sets.Diff sets.Un null_sets_subset)
   then have "B \<Delta> A \<in> null_sets M"
     by (rule null_sym_diff_transitive, auto simp add: CA)
   then have a: "A \<Delta> B \<in> null_sets M" by (simp add: Un_commute)
 
   have "T--`B = (\<Union>n\<in>{1..}. (T^^n)--`C)"
     using T_vrestr_composed(2)[OF \<open>C \<in> sets M\<close>] by (simp add: B_def atLeast_Suc_greaterThan greaterThan_0)
   then have "T--`B = B" unfolding B_def using C2 by simp
   then have "B \<in> sets Invariants" using Invariants_sets vimage_restr_def by auto
 
   then show "\<exists>B \<in> sets Invariants. A \<Delta> B \<in> null_sets M" using a by blast
 qed
 
 text \<open>In a conservative setting, it is enough to be included in its image or its preimage to be
 almost invariant: otherwise, since the difference set has disjoint preimages, and is therefore
 null by conservativity.\<close>
 
 lemma (in conservative) preimage_included_then_almost_invariant:
   assumes [measurable]: "A \<in> sets M" and "T--`A \<subseteq> A"
   shows "A \<Delta> (T--`A) \<in> null_sets M"
 proof -
   define B where "B = A - T--`A"
   then have [measurable]: "B \<in> sets M" by simp
   have "(T^^(Suc n))--`A \<subseteq> (T^^n)--`A" for n using T_vrestr_composed(3)[OF assms(1)] vrestr_inclusion[OF assms(2)] by auto
   then have "disjoint_family (\<lambda>n. (T^^n)--`A - (T^^(Suc n))--`A)" by (rule disjoint_family_Suc2[where ?A = "\<lambda>n. (T^^n)--`A"])
   moreover have "(T^^n)--`A - (T^^(Suc n))--`A = (T^^n)--`B" for n unfolding B_def Suc_eq_plus1 using T_vrestr_composed(3)[OF assms(1)] by auto
   ultimately have "disjoint_family (\<lambda>n. (T^^n)--` B)" by simp
   then have "\<And>n. n \<noteq> 0 \<Longrightarrow> ((T^^n)--`B) \<inter> B = {}" unfolding disjoint_family_on_def by (metis UNIV_I T_vrestr_0(1)[OF \<open>B \<in> sets M\<close>])
   then have "\<And>n. n > 0 \<Longrightarrow> (T^^n)-`B \<inter> B = {}" unfolding vimage_restr_def by (simp add: Int_assoc)
   then have "B \<in> null_sets M" using disjoint_then_null[OF \<open>B \<in> sets M\<close>] Int_commute by auto
   then show ?thesis unfolding B_def using assms(2) by (simp add: Diff_mono Un_absorb2)
 qed
 
 lemma (in conservative) preimage_includes_then_almost_invariant:
   assumes [measurable]: "A \<in> sets M" and "A \<subseteq> T--`A"
   shows "A \<Delta> (T--`A) \<in> null_sets M"
 proof -
   define B where "B = T--`A - A"
   then have [measurable]: "B \<in> sets M" by simp
   have "\<And>n. (T^^(Suc n))--`A \<supseteq> (T^^n)--`A" using T_vrestr_composed(3)[OF assms(1)] vrestr_inclusion[OF assms(2)] by auto
   then have "disjoint_family (\<lambda>n. (T^^(Suc n))--`A - (T^^n)--`A)" by (rule disjoint_family_Suc[where ?A = "\<lambda>n. (T^^n)--`A"])
   moreover have "\<And>n. (T^^(Suc n))--`A - (T^^n)--`A = (T^^n)--`B" unfolding B_def Suc_eq_plus1 using T_vrestr_composed(3)[OF assms(1)] by auto
   ultimately have "disjoint_family (\<lambda>n. (T^^n)--` B)" by simp
   then have "\<And>n. n \<noteq> 0 \<Longrightarrow> ((T^^n)--`B) \<inter> B = {}" unfolding disjoint_family_on_def by (metis UNIV_I T_vrestr_0(1)[OF \<open>B \<in> sets M\<close>])
   then have "\<And>n. n > 0 \<Longrightarrow> (T^^n)-`B \<inter> B = {}" unfolding vimage_restr_def by (simp add: Int_assoc)
   then have "B \<in> null_sets M" using disjoint_then_null[OF \<open>B \<in> sets M\<close>] Int_commute by auto
   then show ?thesis unfolding B_def using assms(2) by (simp add: Diff_mono Un_absorb1)
 qed
 
 text \<open>The above properties for sets are also true for functions: if $f$ and $f \circ T$
 coincide almost everywhere, i.e., $f$ is almost invariant, then $f$ coincides almost everywhere
 with a true invariant function.
 
 The idea of the proof is straightforward: throw away the orbits on
 which $f$ is not really invariant (say this is the complement of the good set),
 and replace it by $0$ there. However, this does not work
 directly: the good set is not invariant, some points may have a non-constant value of $f$ on their
 orbit but reach the good set eventually. One can however define $g$ to be equal to the
 eventual value of $f$ along the orbit, if the orbit reaches the good set, and $0$ elsewhere.\<close>
 
 proposition Invariants_quasi_Invariants_functions:
   fixes f::"_ \<Rightarrow> 'b::{second_countable_topology, t2_space}"
   assumes f_meas [measurable]: "f \<in> borel_measurable M"
   shows "(\<exists>g \<in> borel_measurable Invariants. AE x in M. f x = g x) \<longleftrightarrow> (AE x in M. f(T x) = f x)"
 proof
   assume "\<exists>g\<in>borel_measurable Invariants. AE x in M. f x = g x"
   then obtain g where g:"g\<in>borel_measurable Invariants" "AE x in M. f x = g x" by blast
   then have [measurable]: "g \<in> borel_measurable M" using Invariants_measurable_func by auto
   define A where "A = {x \<in> space M. f x = g x}"
   have [measurable]: "A \<in> sets M" unfolding A_def by simp
   define B where "B = space M - A"
   have [measurable]: "B \<in> sets M" unfolding B_def by simp
   moreover have "AE x in M. x \<notin> B" unfolding B_def A_def using g(2) by auto
   ultimately have "B \<in> null_sets M" using AE_iff_null_sets by blast
   then have "T--`B \<in> null_sets M" by (rule T_quasi_preserves_null2(1))
   then have "B \<union> T--`B \<in> null_sets M" using \<open>B \<in> null_sets M\<close> by auto
   then have "AE x in M. x \<notin> (B \<union> T--`B)" using AE_iff_null_sets null_setsD2 by blast
   then have i: "AE x in M. x \<in> space M - (B \<union> T--`B)" by auto
   {
     fix x assume *: "x \<in> space M - (B \<union> T--`B)"
     then have "x \<in> A" unfolding B_def by blast
     then have "f x = g x" unfolding A_def by blast
     have "T x \<in> A" using * B_def by auto
     then have "f(T x) = g(T x)" unfolding A_def by blast
     moreover have "g(T x) = g x"
       apply (rule Invariants_func_is_invariant) using * by (auto simp add: assms \<open>g\<in>borel_measurable Invariants\<close>)
     ultimately have "f(T x) = f x" using \<open>f x = g x\<close> by simp
   }
   then show "AE x in M. f(T x) = f x" using i by auto
 next
   assume *: "AE x in M. f (T x) = f x"
   text \<open>\verb+good_set+ is the set of points for which $f$ is constant on their orbit. Here, we define
   $g = f$. If a point ever enters \verb+good_set+, then we take $g$ to be the value of $f$ there. Otherwise,
   $g$ takes an arbitrary value, say $y_0$.\<close>
   define good_set where "good_set = {x \<in> space M. \<forall>n. f((T^^(Suc n)) x) = f((T^^n) x)}"
   define good_time where "good_time = (\<lambda>x. Inf {n. (T^^n) x \<in> good_set})"
   have "AE x in M. x \<in> good_set" using T_AE_iterates[OF *] by (simp add: good_set_def)
   have [measurable]: "good_set \<in> sets M" unfolding good_set_def by auto
   obtain y0::'b where True by auto
   define g where "g = (\<lambda>x. if (\<exists>n. (T^^n) x \<in> good_set) then f((T^^(good_time x)) x) else y0)"
   have [measurable]: "good_time \<in> measurable M (count_space UNIV)" unfolding good_time_def by measurable
   have [measurable]: "g \<in> borel_measurable M" unfolding g_def by measurable
 
   have "f x = g x" if "x \<in> good_set" for x
   proof -
     have a: "0 \<in> {n. (T^^n) x \<in> good_set}" using that by simp
     have "good_time x = 0"
       unfolding good_time_def apply (intro cInf_eq_non_empty) using a by blast+
     moreover have "{n. (T^^n) x \<in> good_set} \<noteq> {}" using a by blast
     ultimately show "f x = g x" unfolding g_def by auto
   qed
   then have "AE x in M. f x = g x" using \<open>AE x in M. x \<in> good_set\<close> by auto
 
   have *: "f((T^^(Suc 0)) x) = f((T^^0) x)" if "x \<in> good_set" for x
     using that unfolding good_set_def by blast
   have good_1: "T x \<in> good_set \<and> f(T x) = f x" if "x \<in> good_set" for x
     using *[OF that] that unfolding good_set_def apply (auto)
     unfolding T_Tn_T_compose by blast
   then have good_k: "\<And>x. x \<in> good_set \<Longrightarrow> (T^^k) x \<in> good_set \<and> f((T^^k) x) = f x" for k
       by (induction k, auto)
 
   have "g(T x) = g x" if "x \<in> space M" for x
   proof (cases)
     assume *: "\<exists>n. (T^^n) (T x) \<in> good_set"
     define n where "n = Inf {n. (T^^n) (T x) \<in> good_set}"
     have "(T^^n)(T x) \<in> good_set" using * Inf_nat_def1 by (metis empty_iff mem_Collect_eq n_def)
     then have a: "(T^^(n+1)) x \<in> good_set" by (metis Suc_eq_plus1 comp_eq_dest_lhs funpow.simps(2) funpow_swap1)
     then have **: "\<exists>m. (T^^m) x \<in> good_set" by blast
     define m where "m = Inf {m. (T^^m) x \<in> good_set}"
     then have "(T^^m) x \<in> good_set" using ** Inf_nat_def1 by (metis empty_iff mem_Collect_eq)
     have "n+1 \<in> {m. (T^^m) x \<in> good_set}" using a by simp
     then have "m \<le> n+1" using m_def by (simp add: Inf_nat_def Least_le)
     then obtain k where "n+1 = m + k" using le_iff_add by blast
     have "g x = f((T^^m) x)" unfolding g_def good_time_def using ** m_def by simp
     also have "... = f((T^^k) ((T^^m) x))" using \<open>(T^^m) x \<in> good_set\<close> good_k by simp
     also have "... = f((T^^(n+1))x)" using \<open>n+1 = m + k\<close>[symmetric] funpow_add by (metis add.commute comp_apply)
     also have "... = f((T^^n) (T x))" using funpow_Suc_right by (metis Suc_eq_plus1 comp_apply)
     also have "... = g(T x)" unfolding g_def good_time_def using * n_def by simp
     finally show "g(T x) = g x" by simp
   next
     assume *: "\<not>(\<exists>n. (T^^n) (T x) \<in> good_set)"
     then have "g(T x) = y0" unfolding g_def by simp
     have **: "\<not>(\<exists>n. (T^^(Suc n)) x \<in> good_set)" using funpow_Suc_right * by (metis comp_apply)
     have "T x \<notin> good_set" using good_k * by blast
     then have "x \<notin> good_set" using good_1 by auto
     then have "\<not>(\<exists>n. (T^^n) x \<in> good_set)" using ** using good_1 by fastforce
     then have "g x = y0" unfolding g_def by simp
     then show "g(T x) = g x" using \<open>g(T x) = y0\<close> by simp
   qed
   then have "g \<in> borel_measurable Invariants" by (rule Invariants_func_charac[OF \<open>g \<in> borel_measurable M\<close>])
   then show "\<exists>g\<in>borel_measurable Invariants. AE x in M. f x = g x" using \<open>AE x in M. f x = g x\<close> by blast
 qed
 
 text \<open>In a conservative setting, it suffices to have an almost everywhere inequality to get
 an almost everywhere equality, as the set where there is strict inequality has $0$ measure
 as its iterates are disjoint, by conservativity.\<close>
 
 proposition (in conservative) AE_decreasing_then_invariant:
   fixes f::"_ \<Rightarrow> 'b::{linorder_topology, second_countable_topology}"
   assumes "AE x in M. f(T x) \<le> f x"
     and [measurable]: "f \<in> borel_measurable M"
   shows "AE x in M. f(T x) = f x"
 proof -
   obtain D::"'b set" where D: "countable D" "(\<forall>x y. x < y \<longrightarrow> (\<exists>d \<in> D. x \<le> d \<and> d < y))"
     using countable_separating_set_linorder2 by blast
 
   define A where "A = {x \<in> space M. f(T x) \<le> f x}"
   then have [measurable]: "A \<in> sets M" by simp
   define B where "B = {x \<in> space M. \<forall>n. f((T^^(n+1)) x) \<le> f((T^^n)x)}"
   then have [measurable]: "B \<in> sets M" by simp
 
   have "space M - A \<in> null_sets M" unfolding A_def using assms by (simp add: assms(1) AE_iff_null_sets)
   then have "(\<Union>n. (T^^n)--`(space M - A)) \<in> null_sets M" by (metis null_sets_UN T_quasi_preserves_null2(2))
   moreover have "space M - B = (\<Union>n. (T^^n)--`(space M - A))"
     unfolding B_def A_def by auto
   ultimately have "space M - B \<in> null_sets M" by simp
 
   have *: "B = (\<Inter>n. (T^^n)--`A)"
     unfolding B_def A_def by auto
   then have "T--`B = (\<Inter>n. T--` (T^^n)--`A)" by auto
   also have "... = (\<Inter>n. (T^^(n+1))--`A)" using T_vrestr_composed(2)[OF \<open>A \<in> sets M\<close>] by simp
   also have "... \<supseteq> (\<Inter>n. (T^^n)--`A)" by blast
   finally have B1: "B \<subseteq> T--`B" using * by simp
   have "B \<subseteq> A" using * T_vrestr_0[OF \<open>A \<in> sets M\<close>] by blast
   then have B2: "\<And>x. x \<in> B \<Longrightarrow> f(T x) \<le> f x" unfolding A_def by auto
 
   define C where "C = (\<lambda>t. {x \<in> B. f x \<le> t})"
   {
     fix t
     have "C t = B \<inter> f-`{..t} \<inter> space M" unfolding C_def using sets.sets_into_space[OF \<open>B \<in> sets M\<close>] by auto
     then have [measurable]: "C t \<in> sets M" using assms(2) by simp
     have "C t \<subseteq> T--`(C t)" using B1 unfolding C_def vimage_restr_def apply auto using B2 order_trans by blast
     then have "T--`(C t) - C t \<in> null_sets M" by (metis Diff_mono Un_absorb1 preimage_includes_then_almost_invariant[OF \<open>C t \<in> sets M\<close>])
   }
   then have "(\<Union>d\<in>D. T--`(C d) - C d) \<in> null_sets M" using \<open>countable D\<close> by (simp add: null_sets_UN')
   then have "(space M - B) \<union> (\<Union>d\<in>D. T--`(C d) - C d) \<in> null_sets M" using \<open>space M - B \<in> null_sets M\<close> by auto
   then have "AE x in M. x \<notin> (space M - B) \<union> (\<Union>d\<in>D. T--`(C d) - C d)" using AE_not_in by blast
   moreover
   {
     fix x assume x: "x \<in> space M" "x \<notin> (space M - B) \<union> (\<Union>d\<in>D. T--`(C d) - C d)"
     then have "x \<in> B" by simp
     then have "T x \<in> B" using B1 by auto
     have "f(T x) = f x"
     proof (rule ccontr)
       assume "f(T x) \<noteq> f x"
       then have "f(T x) < f x" using B2[OF \<open>x \<in> B\<close>] by simp
       then obtain d where d: "d \<in> D" "f(T x) \<le> d \<and> d < f x" using D by auto
       then have "T x \<in> C d" using \<open>T x \<in> B\<close> unfolding C_def by simp
       then have "x \<in> T--`(C d)" using \<open>x \<in> space M\<close> by simp
       then have "x \<in> C d" using x \<open>d \<in> D\<close> by simp
       then have "f x \<le> d" unfolding C_def by simp
       then show False using d by auto
     qed
   }
   ultimately show ?thesis by auto
 qed
 
 proposition (in conservative) AE_increasing_then_invariant:
   fixes f::"_ \<Rightarrow> 'b::{linorder_topology, second_countable_topology}"
   assumes "AE x in M. f(T x) \<ge> f x"
     and [measurable]: "f \<in> borel_measurable M"
   shows "AE x in M. f(T x) = f x"
 proof -
   obtain D::"'b set" where D: "countable D" "(\<forall>x y. x < y \<longrightarrow> (\<exists>d \<in> D. x < d \<and> d \<le> y))"
     using countable_separating_set_linorder1 by blast
 
   define A where "A = {x \<in> space M. f(T x) \<ge> f x}"
   then have [measurable]: "A \<in> sets M" by simp
   define B where "B = {x \<in> space M. \<forall>n. f((T^^(n+1)) x) \<ge> f((T^^n)x)}"
   then have [measurable]: "B \<in> sets M" by simp
 
   have "space M - A \<in> null_sets M" unfolding A_def using assms by (simp add: assms(1) AE_iff_null_sets)
   then have "(\<Union>n. (T^^n)--`(space M - A)) \<in> null_sets M" by (metis null_sets_UN T_quasi_preserves_null2(2))
   moreover have "space M - B = (\<Union>n. (T^^n)--`(space M - A))"
     unfolding B_def A_def by auto
   ultimately have "space M - B \<in> null_sets M" by simp
 
   have *: "B = (\<Inter>n. (T^^n)--`A)"
     unfolding B_def A_def by auto
   then have "T--`B = (\<Inter>n. T--` (T^^n)--`A)" by auto
   also have "... = (\<Inter>n. (T^^(n+1))--`A)" using T_vrestr_composed(2)[OF \<open>A \<in> sets M\<close>] by simp
   also have "... \<supseteq> (\<Inter>n. (T^^n)--`A)" by blast
   finally have B1: "B \<subseteq> T--`B" using * by simp
   have "B \<subseteq> A" using * T_vrestr_0[OF \<open>A \<in> sets M\<close>] by blast
   then have B2: "\<And>x. x \<in> B \<Longrightarrow> f(T x) \<ge> f x" unfolding A_def by auto
 
   define C where "C = (\<lambda>t. {x \<in> B. f x \<ge> t})"
   {
     fix t
     have "C t = B \<inter> f-`{t..} \<inter> space M" unfolding C_def using sets.sets_into_space[OF \<open>B \<in> sets M\<close>] by auto
     then have [measurable]: "C t \<in> sets M" using assms(2) by simp
     have "C t \<subseteq> T--`(C t)" using B1 unfolding C_def vimage_restr_def apply auto using B2 order_trans by blast
     then have "T--`(C t) - C t \<in> null_sets M" by (metis Diff_mono Un_absorb1 preimage_includes_then_almost_invariant[OF \<open>C t \<in> sets M\<close>])
   }
   then have "(\<Union>d\<in>D. T--`(C d) - C d) \<in> null_sets M" using \<open>countable D\<close> by (simp add: null_sets_UN')
   then have "(space M - B) \<union> (\<Union>d\<in>D. T--`(C d) - C d) \<in> null_sets M" using \<open>space M - B \<in> null_sets M\<close> by auto
   then have "AE x in M. x \<notin> (space M - B) \<union> (\<Union>d\<in>D. T--`(C d) - C d)" using AE_not_in by blast
   moreover
   {
     fix x assume x: "x \<in> space M" "x \<notin> (space M - B) \<union> (\<Union>d\<in>D. T--`(C d) - C d)"
     then have "x \<in> B" by simp
     then have "T x \<in> B" using B1 by auto
     have "f(T x) = f x"
     proof (rule ccontr)
       assume "f(T x) \<noteq> f x"
       then have "f(T x) > f x" using B2[OF \<open>x \<in> B\<close>] by simp
       then obtain d where d: "d \<in> D" "f(T x) \<ge> d \<and> d > f x" using D by auto
       then have "T x \<in> C d" using \<open>T x \<in> B\<close> unfolding C_def by simp
       then have "x \<in> T--`(C d)" using \<open>x \<in> space M\<close> by simp
       then have "x \<in> C d" using x \<open>d \<in> D\<close> by simp
       then have "f x \<ge> d" unfolding C_def by simp
       then show False using d by auto
     qed
   }
   ultimately show ?thesis by auto
 qed
 
 text \<open>For an invertible map, the invariants of $T$ and $T^{-1}$ are the same.\<close>
 
 lemma Invariants_Tinv:
   assumes "invertible_qmpt"
   shows "qmpt.Invariants M Tinv = Invariants"
 proof -
   interpret I: qmpt M Tinv using Tinv_qmpt[OF assms] by auto
   have "(T -` A \<inter> space M = A) \<longleftrightarrow> (Tinv -` A \<inter> space M = A)" if "A \<in> sets M" for A
   proof
     assume "T -` A \<inter> space M = A"
     then show "Tinv -` A \<inter> space M = A"
       using assms that unfolding Tinv_def invertible_qmpt_def
       apply auto
       apply (metis IntE UNIV_I bij_def imageE inv_f_f vimageE)
       apply (metis I.T_spaceM_stable(1) Int_iff Tinv_def bij_inv_eq_iff vimageI)
       done
   next
     assume "Tinv -` A \<inter> space M = A"
     then show "T -` A \<inter> space M = A"
       using assms that unfolding Tinv_def invertible_qmpt_def
       apply auto
       apply (metis IntE bij_def inv_f_f vimageE)
       apply (metis T_Tinv_of_set T_meas Tinv_def assms qmpt.vrestr_of_set qmpt_axioms vrestr_image(3))
       done
   qed
   then have "{A \<in> sets M. Tinv -` A \<inter> space M = A} = {A \<in> sets M. T -` A \<inter> space M = A}"
     by blast
   then show ?thesis unfolding Invariants_def I.Invariants_def by auto
 qed
 
 end
 
 sublocale fmpt \<subseteq> finite_measure_subalgebra M Invariants
   unfolding finite_measure_subalgebra_def finite_measure_subalgebra_axioms_def
   using Invariants_is_subalg by (simp add: finite_measureI)
 
 context fmpt
 begin
 
 text \<open>The conditional expectation with respect to the invariant sigma-algebra is the same
 for $f$ or $f \circ T$, essentially by definition.\<close>
 
 lemma Invariants_of_foTn:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   shows "AE x in M. real_cond_exp M Invariants (f o (T^^n)) x = real_cond_exp M Invariants f x"
 proof (rule real_cond_exp_charact)
   fix A assume [measurable]: "A \<in> sets Invariants"
   then have [measurable]: "A \<in> sets M" using Invariants_in_sets by blast
   then have ind_meas [measurable]: "((indicator A)::('a \<Rightarrow> real)) \<in> borel_measurable Invariants" by auto
 
   have "set_lebesgue_integral M A (f \<circ> (T^^n)) = (\<integral>x. indicator A x * f((T^^n) x) \<partial>M)"
     by (auto simp: comp_def set_lebesgue_integral_def)
   also have "... = (\<integral>x. indicator A ((T^^n) x) * f ((T^^n) x) \<partial>M)"
     by (rule Bochner_Integration.integral_cong, auto simp add: Invariants_func_is_invariant_n[OF ind_meas])
   also have "... = (\<integral>x. indicator A x * f x \<partial>M)"
     apply (rule Tn_integral_preserving(2)) using integrable_mult_indicator[OF \<open>A \<in> sets M\<close> assms] by auto
   also have "... = (\<integral>x. indicator A x * real_cond_exp M Invariants f x \<partial>M)"
     apply (rule real_cond_exp_intg(2)[symmetric]) using integrable_mult_indicator[OF \<open>A \<in> sets M\<close> assms] by auto
   also have "... = set_lebesgue_integral M A (real_cond_exp M Invariants f)"
     by (auto simp: set_lebesgue_integral_def)
   finally show "set_lebesgue_integral M A (f \<circ> (T^^n)) = set_lebesgue_integral M A (real_cond_exp M Invariants f)"
     by simp
 qed (auto simp add: assms real_cond_exp_int Tn_integral_preserving(1)[OF assms] comp_def)
 
 lemma Invariants_of_foT:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   shows "AE x in M. real_cond_exp M Invariants f x = real_cond_exp M Invariants (f o T) x"
 using Invariants_of_foTn[OF assms, where ?n = 1] by auto
 
 lemma birkhoff_sum_Invariants:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   shows "AE x in M. real_cond_exp M Invariants (birkhoff_sum f n) x = n * real_cond_exp M Invariants f x"
 proof -
   define F where "F = (\<lambda>i. f o (T^^i))"
   have [measurable]: "\<And>i. F i \<in> borel_measurable M" unfolding F_def by auto
   have *: "integrable M (F i)" for i unfolding F_def
     by (subst comp_def, rule Tn_integral_preserving(1)[OF assms, of i])
 
   have "AE x in M. n * real_cond_exp M Invariants f x = (\<Sum>i\<in>{..<n}. real_cond_exp M Invariants f x)" by auto
   moreover have "AE x in M. (\<Sum>i\<in>{..<n}. real_cond_exp M Invariants f x) = (\<Sum>i\<in>{..<n}. real_cond_exp M Invariants (F i) x)"
     apply (rule AE_symmetric[OF AE_equal_sum]) unfolding F_def using Invariants_of_foTn[OF assms] by simp
   moreover have "AE x in M. (\<Sum>i\<in>{..<n}. real_cond_exp M Invariants (F i) x) = real_cond_exp M Invariants (\<lambda>x. \<Sum>i\<in>{..<n}. F i x) x"
     by (rule AE_symmetric[OF real_cond_exp_sum [OF *]])
   moreover have "AE x in M. real_cond_exp M Invariants (\<lambda>x. \<Sum>i\<in>{..<n}. F i x) x = real_cond_exp M Invariants (birkhoff_sum f n) x"
     apply (rule real_cond_exp_cong) unfolding F_def using birkhoff_sum_def[symmetric] by auto
   ultimately show ?thesis by auto
 qed
 
 end (* of context fmpt *)
 
 subsection \<open>Birkhoff theorem\<close>
 
 subsubsection \<open>Almost everywhere version of Birkhoff theorem\<close>
 
 text \<open>This paragraph is devoted to the proof of Birkhoff theorem, arguably
 the most fundamental result of ergodic theory.
 This theorem asserts that Birkhoff averages of an integrable function $f$ converge almost surely,
 to the conditional expectation of $f$ with respect to the invariant sigma algebra.
 
 This result implies for instance the strong law of large numbers (in probability theory).
 
 There are numerous proofs of this statement, but none is really easy. We follow the very efficient
 argument given in Katok-Hasselblatt. To help the reader, here is the same proof informally. The
 first part of the proof is formalized in \verb+birkhoff_lemma1+, the second one in
 \verb+birkhoff_lemma+, and the conclusion in \verb+birkhoff_theorem+.
 
 Start with an integrable function $g$. let $G_n(x) = \max_{k\leq n} S_k g(x)$. Then $\limsup S_n g/n
 \leq 0$ outside of $A$, the set where $G_n$ tends to infinity. Moreover, $G_{n+1} - G_n \circ T$ is
 bounded by $g$, and tends to $g$ on $A$. It follows from the dominated convergence theorem that
 $\int_A G_{n+1} - G_n \circ T \to \int_A g$. As $\int_A G_{n+1} - G_n \circ T = \int_A G_{n+1} - G_n
 \geq 0$, we obtain $\int_A g \geq 0$.
 
 Apply now this result to the function $g = f - E(f | I) - \epsilon$, where $\epsilon>0$ is fixed.
 Then $\int_A g = -\epsilon \mu(A)$, then have $\mu(A) = 0$. Thus, almost surely, $\limsup S_n
 g/n\leq 0$, i.e., $\limsup S_n f/n \leq E(f|I)+\epsilon$. Letting $\epsilon$ tend to $0$ gives
 $\limsup S_n f/n \leq E(f|I)$.
 
 Applying the same result to $-f$ gives $S_n f/n \to E(f|I)$.
 \<close>
 
 context fmpt
 begin
 
 lemma birkhoff_aux1:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   defines "A \<equiv> {x \<in> space M. limsup (\<lambda>n. ereal(birkhoff_sum f n x)) = \<infinity>}"
     shows "A \<in> sets Invariants" "(\<integral>x. f x * indicator A x \<partial>M) \<ge> 0"
 proof -
   let ?bsf = "birkhoff_sum f"
   have [measurable]: "A \<in> sets M" unfolding A_def by simp
   have Ainv: "x \<in> A \<longleftrightarrow> T x \<in> A" if "x \<in> space M" for x
   proof -
     have "ereal(?bsf (1 + n) x) = ereal(f x) + ereal(?bsf n (T x))" for n
       unfolding birkhoff_sum_cocycle birkhoff_sum_1 by simp
     moreover have "limsup (\<lambda>n. ereal(f x) + ereal(?bsf n (T x)))
                     = ereal(f x) + limsup(\<lambda>n. ereal(?bsf n (T x)))"
       by (rule ereal_limsup_lim_add, auto)
     moreover have "limsup (\<lambda>n. ereal(?bsf (n+1) x)) = limsup (\<lambda>n. ereal(?bsf n x))" using limsup_shift by simp
     ultimately have "limsup (\<lambda>n. ereal(birkhoff_sum f n x)) = ereal(f x) + limsup (\<lambda>n. ereal(?bsf n (T x)))" by simp
     then have "limsup (\<lambda>n. ereal(?bsf n x)) = \<infinity> \<longleftrightarrow> limsup (\<lambda>n. ereal(?bsf n (T x))) = \<infinity>" by simp
     then show "x \<in> A \<longleftrightarrow> T x \<in> A" using \<open>x \<in> space M\<close> A_def by simp
   qed
   then show "A \<in> sets Invariants" using assms(2) Invariants_sets by auto
 
   define F where "F = (\<lambda>n x. MAX k \<in>{0..n}. ?bsf k x)"
   have [measurable]: "\<And>n. F n \<in> borel_measurable M" unfolding F_def by measurable
   have intFn: "integrable M (F n)" for n
     unfolding F_def by (rule integrable_MAX, auto simp add: birkhoff_sum_integral(1)[OF assms(1)])
 
   have Frec: "F (n+1) x - F n (T x) = max (-F n (T x)) (f x)" for n x
   proof -
     have "{0..n+1} = {0} \<union> {1..n+1}" by auto
     then have "(\<lambda>k. ?bsf k x) ` {0..n+1} = (\<lambda>k. ?bsf k x) ` {0} \<union> (\<lambda>k. ?bsf k x) ` {1..n+1}" by blast
     then have *: "(\<lambda>k. ?bsf k x) ` {0..n+1} = {0} \<union> (\<lambda>k. ?bsf k x) ` {1..n+1}" using birkhoff_sum_1(1) by simp
     have b: "F (n+1) x = max (Max {0}) (MAX k \<in>{1..n+1}. ?bsf k x)"
       by (subst F_def, subst *, rule Max.union, auto)
 
     have "(\<lambda>k. ?bsf k x) ` {1..n+1} = (\<lambda>k. ?bsf (1+k) x) ` {0..n}" using Suc_le_D by fastforce
     also have "... = (\<lambda>k. f x + ?bsf k (T x)) ` {0..n}"
       by (subst birkhoff_sum_cocycle, subst birkhoff_sum_1(2), auto)
     finally have c: "F (n+1) x = max 0 (MAX k \<in>{0..n}. ?bsf k (T x) + f x)" using b by (simp add: add_ac)
 
     have "{f x + birkhoff_sum f k (T x) |k. k \<in>{0..n}} = (+) (f x) ` {birkhoff_sum f k (T x) |k. k \<in>{0..n}}" by blast
     have "(MAX k \<in>{0..n}. ?bsf k (T x) + f x) = (MAX k \<in>{0..n}. ?bsf k (T x)) + f x"
       by (rule Max_add_commute) auto
     also have "... = F n (T x) + f x" unfolding F_def by simp
     finally have "(MAX k \<in>{0..n}. ?bsf k (T x) + f x) = f x + F n (T x)" by simp
     then have "F (n+1) x = max 0 (f x + F n (T x))" using c by simp
     then show "F (n+1) x - F n (T x) = max (-F n (T x)) (f x)" by auto
   qed
 
   have a: "abs((F (n+1) x - F n (T x)) * indicator A x) \<le> abs(f x)" for n x
   proof -
     have "F (n+1) x -F n (T x) \<ge> f x" using Frec by simp
     then have *: "F (n+1) x -F n (T x) \<ge> - abs(f x)" by simp
 
     have "F n (T x) \<ge> birkhoff_sum f 0 (T x)"
       unfolding F_def apply (rule Max_ge, simp) using atLeastAtMost_iff by blast
     then have "F n (T x) \<ge> 0" using birkhoff_sum_1(1) by simp
     then have "-F n (T x) \<le> abs (f x)" by simp
     moreover have "f x \<le> abs(f x)" by simp
     ultimately have "F (n+1) x -F n (T x) \<le> abs(f x)" using Frec by simp
     then have "abs(F (n+1) x - F n (T x)) \<le> abs(f x)" using * by simp
     then show "abs((F (n+1) x - F n (T x)) * indicator A x) \<le> abs(f x)" unfolding indicator_def by auto
   qed
   have b: "(\<lambda>n. (F (n+1) x - F n (T x)) * indicator A x) \<longlonglongrightarrow> f x * indicator A x" for x
   proof (rule tendsto_eventually, cases)
     assume "x \<in> A"
     then have "T x \<in> A" using Ainv A_def by auto
     then have "limsup (\<lambda>n. ereal(birkhoff_sum f n (T x))) > ereal(-f x)" unfolding A_def by simp
     then obtain N where "ereal(?bsf N (T x)) > ereal(-f x)" using Limsup_obtain by blast
     then have *: "?bsf N (T x) > -f x" by simp
     {
       fix n assume "n\<ge>N"
       then have "?bsf N (T x) \<in> (\<lambda>k. ?bsf k (T x)) ` {0..n}" by auto
       then have "F n (T x) \<ge> ?bsf N (T x)" unfolding F_def by simp
       then have "F n (T x) \<ge> -f x" using * by simp
       then have "max (-F n (T x)) (f x) = f x" by simp
       then have "F (n+1) x - F n (T x) = f x" using Frec by simp
       then have "(F (n+1) x - F n (T x)) * indicator A x = f x * indicator A x" by simp
     }
     then show "eventually (\<lambda>n. (F (n+1) x - F n (T x)) * indicator A x = f x * indicator A x) sequentially"
       using eventually_sequentially by blast
   next
     assume "\<not>(x \<in> A)"
     then have "indicator A x = (0::real)" by simp
     then show "eventually (\<lambda>n. (F (n+1) x - F n (T x)) * indicator A x = f x * indicator A x) sequentially" by auto
   qed
   have lim: "(\<lambda>n. (\<integral>x. (F (n+1) x - F n (T x)) * indicator A x \<partial>M)) \<longlonglongrightarrow> (\<integral>x. f x * indicator A x \<partial>M)"
   proof (rule integral_dominated_convergence[where ?w = "(\<lambda>x. abs(f x))"])
     show "integrable M (\<lambda>x. \<bar>f x\<bar>)" using assms(1) by auto
     show "AE x in M. (\<lambda>n. (F (n + 1) x - F n (T x)) * indicator A x) \<longlonglongrightarrow> f x * indicator A x" using b by auto
     show "\<And>n. AE x in M. norm ((F (n + 1) x - F n (T x)) * indicator A x) \<le> \<bar>f x\<bar>" using a by auto
   qed (simp_all)
 
   have "(\<integral>x. (F (n+1) x - F n (T x)) * indicator A x \<partial>M) \<ge> 0" for n
   proof -
     have "(\<integral>x. F n (T x) * indicator A x \<partial>M) = (\<integral>x. (\<lambda>x. F n x * indicator A x) (T x) \<partial>M)"
       by (rule Bochner_Integration.integral_cong, auto simp add: Ainv indicator_def)
     also have "... = (\<integral>x. F n x * indicator A x \<partial>M)"
       by (rule T_integral_preserving, auto simp add: intFn integrable_real_mult_indicator)
     finally have i: "(\<integral>x. F n (T x) * indicator A x \<partial>M) = (\<integral>x. F n x * indicator A x \<partial>M)" by simp
 
     have "(\<integral>x. (F (n+1) x - F n (T x)) * indicator A x \<partial>M) = (\<integral>x. F (n+1) x * indicator A x - F n (T x) * indicator A x \<partial>M)"
       by (simp add: mult.commute right_diff_distrib)
     also have "... = (\<integral>x. F (n+1) x * indicator A x \<partial>M) - (\<integral>x. F n (T x) * indicator A x \<partial>M)"
       by (rule Bochner_Integration.integral_diff, auto simp add: intFn integrable_real_mult_indicator T_meas T_integral_preserving(1))
     also have "... = (\<integral>x. F (n+1) x * indicator A x \<partial>M) - (\<integral>x. F n x * indicator A x \<partial>M)"
       using i by simp
     also have "... = (\<integral>x. F (n+1) x * indicator A x - F n x * indicator A x \<partial>M)"
       by (rule Bochner_Integration.integral_diff[symmetric], auto simp add: intFn integrable_real_mult_indicator)
     also have "... = (\<integral>x. (F (n+1) x - F n x) * indicator A x \<partial>M)"
       by (simp add: mult.commute right_diff_distrib)
     finally have *: "(\<integral>x. (F (n+1) x - F n (T x)) * indicator A x \<partial>M) = (\<integral>x. (F (n+1) x - F n x) * indicator A x \<partial>M)"
       by simp
 
     have "F n x \<le> F (n+1) x" for x unfolding F_def by (rule Max_mono, auto)
     then have "(F (n+1) x - F n x) * indicator A x \<ge> 0" for x by simp
     then have "integral\<^sup>L M (\<lambda>x. 0) \<le> integral\<^sup>L M (\<lambda>x. (F (n+1) x - F n x) * indicator A x)"
       by (auto simp add: intFn integrable_real_mult_indicator intro: integral_mono)
     then have "(\<integral>x. (F (n+1) x - F n x) * indicator A x \<partial>M) \<ge> 0" by simp
     then show "(\<integral>x. (F (n+1) x - F n (T x)) * indicator A x \<partial>M) \<ge> 0" using * by simp
   qed
   then show "(\<integral>x. f x * indicator A x \<partial>M) \<ge> 0" using lim by (simp add: LIMSEQ_le_const)
 qed
 
 lemma birkhoff_aux2:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   shows "AE x in M. limsup (\<lambda>n. ereal(birkhoff_sum f n x / n)) \<le> real_cond_exp M Invariants f x"
 proof -
   {
     fix \<epsilon> assume "\<epsilon> > (0::real)"
     define g where "g = (\<lambda>x. f x - real_cond_exp M Invariants f x - \<epsilon>)"
     then have intg: "integrable M g" using assms real_cond_exp_int(1) assms by auto
     define A where "A = {x \<in> space M. limsup (\<lambda>n. ereal(birkhoff_sum g n x)) = \<infinity>}"
     have Ag: "A \<in> sets Invariants" "(\<integral>x. g x * indicator A x \<partial>M) \<ge> 0"
       unfolding A_def by (rule birkhoff_aux1[where ?f = g, OF intg])+
     then have [measurable]: "A \<in> sets M" by (simp add: Invariants_in_sets)
 
     have eq: "(\<integral>x. indicator A x * real_cond_exp M Invariants f x \<partial>M) = (\<integral>x. indicator A x * f x \<partial>M)"
     proof (rule real_cond_exp_intg[where ?f = "\<lambda>x. (indicator A x)::real" and ?g = f])
       have "(\<lambda>x. indicator A x * f x) = (\<lambda>x. f x * indicator A x)" by auto
       then show "integrable M (\<lambda>x. indicator A x * f x)"
         using integrable_real_mult_indicator[OF \<open>A \<in> sets M\<close> assms] by simp
       show "indicator A \<in> borel_measurable Invariants" using \<open>A \<in> sets Invariants\<close> by measurable
     qed (simp)
 
     have "0 \<le> (\<integral>x. g x * indicator A x \<partial>M)" using Ag by simp
     also have "... = (\<integral>x. f x * indicator A x - real_cond_exp M Invariants f x * indicator A x - \<epsilon> * indicator A x \<partial>M)"
       unfolding g_def by (simp add: left_diff_distrib)
     also have "... = (\<integral>x. f x * indicator A x \<partial>M) - (\<integral>x. real_cond_exp M Invariants f x * indicator A x \<partial>M) - (\<integral>x. \<epsilon> * indicator A x \<partial>M)"
       using assms real_cond_exp_int(1)[OF assms] integrable_real_mult_indicator[OF \<open>A \<in> sets M\<close>]
       by (auto simp: simp del: integrable_mult_left_iff)
     also have "... = - (\<integral>x. \<epsilon> * indicator A x \<partial>M)"
       by (auto simp add: eq mult.commute)
     also have "... = - \<epsilon> * measure M A" by auto
     finally have "0 \<le> - \<epsilon> * measure M A" by simp
     then have "measure M A = 0" using \<open>\<epsilon> > 0\<close> by (simp add: measure_le_0_iff mult_le_0_iff)
     then have "A \<in> null_sets M" by (simp add: emeasure_eq_measure null_setsI)
     then have "AE x in M. x \<in> space M - A" by (metis (no_types, lifting) AE_cong Diff_iff AE_not_in)
     moreover
     {
       fix x assume "x \<in> space M - A"
       then have "limsup (\<lambda>n. ereal(birkhoff_sum g n x)) < \<infinity>" unfolding A_def by auto
       then obtain C where C: "\<And>n. birkhoff_sum g n x \<le> C" using limsup_finite_then_bounded by presburger
       {
         fix n::nat assume "n > 0"
         have "birkhoff_sum g n x = birkhoff_sum f n x - birkhoff_sum (real_cond_exp M Invariants f) n x - birkhoff_sum (\<lambda>x. \<epsilon>) n x"
           unfolding g_def using birkhoff_sum_add birkhoff_sum_diff by auto
         moreover have "birkhoff_sum (real_cond_exp M Invariants f) n x = n * real_cond_exp M Invariants f x"
           using birkhoff_sum_of_invariants using \<open>x \<in> space M - A\<close> by auto
         moreover have "birkhoff_sum (\<lambda>x. \<epsilon>) n x = n * \<epsilon>" unfolding birkhoff_sum_def by auto
         ultimately have "birkhoff_sum g n x = birkhoff_sum f n x - n * real_cond_exp M Invariants f x - n * \<epsilon>"
           by simp
         then have "birkhoff_sum f n x = birkhoff_sum g n x + n * real_cond_exp M Invariants f x + n * \<epsilon>"
           by simp
         then have "birkhoff_sum f n x / n = birkhoff_sum g n x / n + real_cond_exp M Invariants f x + \<epsilon>"
           using \<open>n > 0\<close> by (simp add: field_simps)
         then have "birkhoff_sum f n x / n \<le> C/n + real_cond_exp M Invariants f x + \<epsilon>"
           using C[of n] \<open>n > 0\<close> by (simp add: divide_right_mono)
         then have "ereal(birkhoff_sum f n x / n) \<le> ereal(C/n + real_cond_exp M Invariants f x + \<epsilon>)"
           by simp
       }
       then have "eventually (\<lambda>n. ereal(birkhoff_sum f n x / n) \<le> ereal(C/n + real_cond_exp M Invariants f x + \<epsilon>)) sequentially"
         by (simp add: eventually_at_top_dense)
       then have b: "limsup (\<lambda>n. ereal(birkhoff_sum f n x / n)) \<le> limsup (\<lambda>n. ereal(C/n + real_cond_exp M Invariants f x + \<epsilon>))"
         by (simp add: Limsup_mono)
 
       have "(\<lambda>n. ereal(C*(1/real n) + real_cond_exp M Invariants f x + \<epsilon>)) \<longlonglongrightarrow> ereal(C * 0 + real_cond_exp M Invariants f x + \<epsilon>)"
         by (intro tendsto_intros)
       then have "limsup (\<lambda>n. ereal(C/real n + real_cond_exp M Invariants f x + \<epsilon>)) = real_cond_exp M Invariants f x + \<epsilon>"
         using sequentially_bot tendsto_iff_Liminf_eq_Limsup by force
       then have "limsup (\<lambda>n. ereal(birkhoff_sum f n x / n)) \<le> real_cond_exp M Invariants f x + \<epsilon>"
         using b by simp
     }
     ultimately have "AE x in M. limsup (\<lambda>n. ereal(birkhoff_sum f n x / n)) \<le> real_cond_exp M Invariants f x + \<epsilon>"
       by auto
     then have "AE x in M. limsup (\<lambda>n. ereal(birkhoff_sum f n x / n)) \<le> ereal(real_cond_exp M Invariants f x) + \<epsilon>"
       by auto
   }
   then show ?thesis
     by (rule AE_upper_bound_inf_ereal)
 qed
 
 theorem birkhoff_theorem_AE_nonergodic:
   fixes f::"'a \<Rightarrow> real"
   assumes "integrable M f"
   shows "AE x in M. (\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
 proof -
   {
     fix x assume i: "limsup (\<lambda>n. ereal(birkhoff_sum f n x /n)) \<le> real_cond_exp M Invariants f x"
              and ii: "limsup (\<lambda>n. ereal(birkhoff_sum (\<lambda>x. -f x) n x / n)) \<le> real_cond_exp M Invariants (\<lambda>x. -f x) x"
              and iii: "real_cond_exp M Invariants (\<lambda>x. -f x) x = - real_cond_exp M Invariants f x"
     have "\<And>n. birkhoff_sum (\<lambda>x. -f x) n x = - birkhoff_sum f n x"
       using birkhoff_sum_cmult[where ?c = "-1" and ?f = f] by auto
     then have "\<And>n. ereal(birkhoff_sum (\<lambda>x. -f x) n x / n) = - ereal(birkhoff_sum f n x / n)" by auto
     moreover have "limsup (\<lambda>n. - ereal(birkhoff_sum f n x / n)) = - liminf (\<lambda>n. ereal(birkhoff_sum f n x /n))"
       by (rule ereal_Limsup_uminus)
     ultimately have "-liminf (\<lambda>n. ereal(birkhoff_sum f n x /n)) = limsup (\<lambda>n. ereal(birkhoff_sum (\<lambda>x. -f x) n x / n))"
       by simp
     then have "-liminf (\<lambda>n. ereal(birkhoff_sum f n x /n)) \<le> - real_cond_exp M Invariants f x"
       using ii iii by simp
     then have "liminf (\<lambda>n. ereal(birkhoff_sum f n x /n)) \<ge> real_cond_exp M Invariants f x"
       by (simp add: ereal_uminus_le_reorder)
     then have "(\<lambda>n. birkhoff_sum f n x /n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
       using i by (simp add: limsup_le_liminf_real)
   } note * = this
   moreover have "AE x in M. limsup (\<lambda>n. ereal(birkhoff_sum f n x /n)) \<le> real_cond_exp M Invariants f x"
     using birkhoff_aux2 assms by simp
   moreover have "AE x in M. limsup (\<lambda>n. ereal(birkhoff_sum (\<lambda>x. -f x) n x / n)) \<le> real_cond_exp M Invariants (\<lambda>x. -f x) x"
     using birkhoff_aux2 assms by simp
   moreover have "AE x in M. real_cond_exp M Invariants (\<lambda>x. -f x) x = - real_cond_exp M Invariants f x"
     using real_cond_exp_cmult[where ?c = "-1"] assms by force
   ultimately show ?thesis by auto
 qed
 
 text \<open>If a function $f$ is integrable, then $E(f\circ T - f | I) = E(f\circ T | I) - E(f|I) = 0$.
 Hence, $S_n(f \circ T - f) / n$ converges almost everywhere to $0$, i.e., $f(T^n x)/n \to 0$.
 It is remarkable (and sometimes useful) that this holds under the weaker condition that
 $f\circ T - f$ is integrable (but not necessarily $f$), where this naive argument fails.
 
 The reason is that the Birkhoff sum of $f \circ T - f$ is $f\circ T^n - f$. If $n$ is such that $x$
 and $T^n(x)$ belong to a set where $f$ is bounded, it follows that this Birkhoff sum is also
 bounded. Along such a sequence of times, $S_n(f\circ T - f)/n$ tends to $0$.
 By Poincare recurrence theorem, there are such times for almost every points. As it also converges
 to $E(f \circ T - f | I)$, it follows that this function is almost everywhere $0$. Then
 $f (T^n x)/n = S_n(f\circ T^n - f)/n - f/n$ tends almost surely to $E(f\circ T-f |I) = 0$.
 \<close>
 
 lemma limit_foTn_over_n:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "f \<in> borel_measurable M"
       and "integrable M (\<lambda>x. f(T x) - f x)"
   shows "AE x in M. real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x = 0"
         "AE x in M. (\<lambda>n. f((T^^n) x) / n) \<longlonglongrightarrow> 0"
 proof -
   define E::"nat \<Rightarrow> 'a set" where "E k = {x \<in> space M. \<bar>f x\<bar> \<le> k}" for k
   have [measurable]: "E k \<in> sets M" for k unfolding E_def by auto
   have *: "(\<Union>k. E k) = space M" unfolding E_def by (auto simp add: real_arch_simple)
   define F::"nat \<Rightarrow> 'a set" where "F k = recurrent_subset_infty (E k)" for k
   have [measurable]: "F k \<in> sets M" for k unfolding F_def by auto
   have **: "E k - F k \<in> null_sets M" for k unfolding F_def using Poincare_recurrence_thm by auto
   have "space M - (\<Union>k. F k) \<in> null_sets M"
     apply (rule null_sets_subset[of "(\<Union>k. E k - F k)"]) unfolding *[symmetric] using ** by auto
   with AE_not_in[OF this] have "AE x in M. x \<in> (\<Union>k. F k)" by auto
   moreover have "AE x in M. (\<lambda>n. birkhoff_sum (\<lambda>x. f(T x) - f x) n x / n)
       \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x"
     by (rule birkhoff_theorem_AE_nonergodic[OF assms(2)])
   moreover have "real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x = 0 \<and> (\<lambda>n. f((T^^n) x) / n) \<longlonglongrightarrow> 0"
     if H: "(\<lambda>n. birkhoff_sum (\<lambda>x. f(T x) - f x) n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x"
           "x \<in> (\<Union>k. F k)" for x
   proof -
     have "f((T^^n) x) = birkhoff_sum (\<lambda>x. f(T x) - f x) n x + f x" for n
       unfolding birkhoff_sum_def by (induction n, auto)
     then have "f((T^^n) x) / n = birkhoff_sum (\<lambda>x. f(T x) - f x) n x / n + f x * (1/n)" for n
       by (auto simp add: divide_simps)
     moreover have "(\<lambda>n. birkhoff_sum (\<lambda>x. f(T x) - f x) n x / n + f x * (1/n)) \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x + f x * 0"
       by (intro tendsto_intros H(1))
     ultimately have lim: "(\<lambda>n. f((T^^n) x) / n) \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x"
       by auto
 
     obtain k where "x \<in> F k" using H(2) by auto
     then have "infinite {n. (T^^n) x \<in> E k}"
       unfolding F_def recurrent_subset_infty_inf_returns by auto
     with infinite_enumerate[OF this] obtain r :: "nat \<Rightarrow> nat"
       where r: "strict_mono r" "\<And>n. r n \<in> {n. (T^^n) x \<in> E k}"
       by auto
     have A: "(\<lambda>n. k * (1/r n)) \<longlonglongrightarrow> real k * 0"
       apply (intro tendsto_intros)
       using LIMSEQ_subseq_LIMSEQ[OF lim_1_over_n \<open>strict_mono r\<close>] unfolding comp_def by auto
     have B: "\<bar>f((T^^(r n)) x) / r n\<bar> \<le> k / (r n)" for n
       using r(2) unfolding E_def by (auto simp add: divide_simps)
     have "(\<lambda>n. f((T^^(r n)) x) / r n) \<longlonglongrightarrow> 0"
       apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. k * (1/r n)"])
       using A B by auto
     moreover have "(\<lambda>n. f((T^^(r n)) x) / r n) \<longlonglongrightarrow> real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x"
       using LIMSEQ_subseq_LIMSEQ[OF lim \<open>strict_mono r\<close>] unfolding comp_def by auto
     ultimately have *: "real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x = 0"
       using LIMSEQ_unique by auto
     then have "(\<lambda>n. f((T^^n) x) / n) \<longlonglongrightarrow> 0" using lim by auto
     then show ?thesis using * by auto
   qed
   ultimately show "AE x in M. real_cond_exp M Invariants (\<lambda>x. f(T x) - f x) x = 0"
                   "AE x in M. (\<lambda>n. f((T^^n) x) / n) \<longlonglongrightarrow> 0"
     by auto
 qed
 
 text \<open>We specialize the previous statement to the case where $f$ itself is integrable.\<close>
 
 lemma limit_foTn_over_n':
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   shows "AE x in M. (\<lambda>n. f((T^^n) x) / n) \<longlonglongrightarrow> 0"
 by (rule limit_foTn_over_n, simp, rule Bochner_Integration.integrable_diff)
    (auto intro: assms T_integral_preserving(1))
 
 text \<open>It is often useful to show that a function is cohomologous to a nicer function, i.e., to
 prove that a given $f$ can be written as $f = g + u - u \circ T$ where $g$ is nicer than $f$. We
 show below that any integrable function is cohomologous to a function which is arbitrarily close to
 $E(f|I)$. This is an improved version of Lemma 2.1 in [Benoist-Quint, Annals of maths, 2011]. Note
 that the function $g$ to which $f$ is cohomologous is very nice (and, in particular, integrable),
 but the transfer function is only measurable in this argument. The fact that the control on
 conditional expectation is nevertheless preserved throughout the argument follows from
 Lemma~\verb+limit_foTn_over_n+ above.\<close>
 
 text \<open>We start with the lemma (and the proof) of [BQ2011]. It shows that, if a function has a
 conditional expectation with respect to invariants which is positive, then it is cohomologous to a
 nonnegative function. The argument is the clever remark that $g = \max (0, \inf_n S_n f)$ and $u =
 \min (0, \inf_n S_n f)$ work (where these expressions are well defined as $S_n f$ tends to infinity
 thanks to our assumption).\<close>
 
 lemma cohomologous_approx_cond_exp_aux:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
       and "AE x in M. real_cond_exp M Invariants f x > 0"
     shows "\<exists>u g. u \<in> borel_measurable M \<and> (integrable M g) \<and> (AE x in M. g x \<ge> 0 \<and> g x \<le> max 0 (f x)) \<and> (\<forall>x. f x = g x + u x - u (T x))"
 proof -
   define h::"'a \<Rightarrow> real" where "h = (\<lambda>x. (INF n\<in>{1..}. birkhoff_sum f n x))"
   define u where "u = (\<lambda>x. min (h x) 0)"
   define g where "g = (\<lambda>x. f x - u x + u (T x))"
   have [measurable]: "h \<in> borel_measurable M" "u \<in> borel_measurable M" "g \<in> borel_measurable M"
     unfolding g_def h_def u_def by auto
   have "f x = g x + u x - u (T x)" for x unfolding g_def by auto
   {
     fix x assume H: "real_cond_exp M Invariants f x > 0"
                     "(\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
     have "eventually (\<lambda>n. ereal(birkhoff_sum f n x / n) * ereal n = ereal(birkhoff_sum f n x)) sequentially"
       unfolding eventually_sequentially by (rule exI[of _ 1], auto)
     moreover have "(\<lambda>n. ereal(birkhoff_sum f n x / n) * ereal n) \<longlonglongrightarrow> ereal(real_cond_exp M Invariants f x) * \<infinity>"
       apply (intro tendsto_intros) using H by auto
     ultimately have "(\<lambda>n. ereal(birkhoff_sum f n x)) \<longlonglongrightarrow> ereal(real_cond_exp M Invariants f x) * \<infinity>"
       by (blast intro: Lim_transform_eventually)
     then have "(\<lambda>n. ereal(birkhoff_sum f n x)) \<longlonglongrightarrow> \<infinity>"
       using H by auto
     then have B: "\<exists>C. \<forall>n. C \<le> birkhoff_sum f n x"
       by (intro liminf_finite_then_bounded_below, simp add: liminf_PInfty)
 
     have "h x \<le> f x"
       unfolding h_def apply (rule cInf_lower) using B by force+
 
     have "{birkhoff_sum f n (T x) |n. n \<in> {1..}} = {birkhoff_sum f (1+n) (x) - f x |n. n \<in> {1..}}"
       unfolding birkhoff_sum_cocycle by auto
     also have "... = {birkhoff_sum f n x - f x |n. n \<in> {2..}}"
       by (metis (no_types, hide_lams) Suc_1 Suc_eq_plus1_left Suc_le_D Suc_le_mono atLeast_iff)
     finally have *: "{birkhoff_sum f n (T x) |n. n \<in> {1..}} = (\<lambda>t. t - (f x))`{birkhoff_sum f n x |n. n \<in> {2..}}"
       by auto
 
     have "h(T x) = Inf {birkhoff_sum f n (T x) |n. n \<in> {1..}}"
       unfolding h_def by (metis Setcompr_eq_image)
     also have "... =  (\<Sqinter>t\<in>{birkhoff_sum f n x |n. n \<in> {2..}}. t - f x)"
       by (simp only: *)
     also have "... = (\<lambda>t. t - (f x)) (Inf {birkhoff_sum f n x |n. n \<in> {2..}})"
       using B by (auto intro!: monoI bijI mono_bij_cInf [symmetric])
     finally have I: "Inf {birkhoff_sum f n x |n. n \<in> {2..}} = f x + h (T x)" by auto
     have "max 0 (h x) + u x = h x"
       unfolding u_def by auto
     also have "... = Inf {birkhoff_sum f n x |n. n \<in> {1..}}"
       unfolding h_def by (metis Setcompr_eq_image)
     also have "... = Inf ({birkhoff_sum f n x |n. n \<in> {1}} \<union> {birkhoff_sum f n x |n. n \<in> {2..}})"
       by (auto intro!: arg_cong[of _ _ Inf], metis One_nat_def Suc_1 antisym birkhoff_sum_1(2) not_less_eq_eq, force)
     also have "Inf ({birkhoff_sum f n x |n. n \<in> {1}} \<union> {birkhoff_sum f n x |n. n \<in> {2..}})
       = min (Inf {birkhoff_sum f n x |n. n \<in> {1}}) (Inf {birkhoff_sum f n x |n. n \<in> {2..}})"
       unfolding inf_min[symmetric] apply (intro cInf_union_distrib) using B by auto
     also have "... = min (f x) (f x + h (T x))" using I by auto
     also have "... = f x + u (T x)" unfolding u_def by auto
     finally have "max 0 (h x) = f x + u (T x) - u x" by auto
     then have "g x = max 0 (h x)" unfolding g_def by auto
     then have "g x \<ge> 0 \<and> g x \<le> max 0 (f x)" using \<open>h x \<le> f x\<close> by auto
   }
   then have *: "AE x in M. g x \<ge> 0 \<and> g x \<le> max 0 (f x)"
     using assms(2) birkhoff_theorem_AE_nonergodic[OF assms(1)] by auto
   moreover have "integrable M g"
     apply (rule Bochner_Integration.integrable_bound[of _ f]) using * by (auto simp add: assms)
   ultimately have "u \<in> borel_measurable M \<and> integrable M g \<and> (AE x in M. 0 \<le> g x \<and> g x \<le> max 0 (f x)) \<and> (\<forall>x. f x = g x + u x - u (T x))"
     using \<open>\<And>x. f x = g x + u x - u (T x)\<close> \<open>u \<in> borel_measurable M\<close> by auto
   then show ?thesis by blast
 qed
 
 text \<open>To deduce the stronger version that $f$ is cohomologous to an arbitrarily good approximation
 of $E(f|I)$, we apply the previous lemma twice, to control successively the negative and the
 positive side. The sign control in the conclusion of the previous lemma implies that the second step
 does not spoil the first one.\<close>
 
 lemma cohomologous_approx_cond_exp:
   fixes f::"'a \<Rightarrow> real" and B::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f" "B \<in> borel_measurable M"
       and "AE x in M. B x > 0"
     shows "\<exists>g u. u \<in> borel_measurable M
               \<and> integrable M g
               \<and> (\<forall>x. f x = g x + u x - u (T x))
               \<and> (AE x in M. abs(g x - real_cond_exp M Invariants f x) \<le> B x)"
 proof -
   define C where "C = (\<lambda>x. min (B x) 1)"
   have [measurable]: "integrable M C"
     apply (rule Bochner_Integration.integrable_bound[of _ "\<lambda>_. (1::real)"], auto)
     unfolding C_def using assms(3) by auto
   have "C x \<le> B x" for x unfolding C_def by auto
   have "AE x in M. C x > 0" unfolding C_def using assms(3) by auto
   have AECI: "AE x in M. real_cond_exp M Invariants C x > 0"
     by (intro real_cond_exp_gr_c \<open>integrable M C\<close> \<open>AE x in M. C x > 0\<close>)
 
   define f1 where "f1 = (\<lambda>x. f x - real_cond_exp M Invariants f x)"
   have "integrable M f1"
     unfolding f1_def by (intro Bochner_Integration.integrable_diff \<open>integrable M f\<close> real_cond_exp_int(1))
   have "AE x in M. real_cond_exp M Invariants f1 x = real_cond_exp M Invariants f x - real_cond_exp M Invariants (real_cond_exp M Invariants f) x"
     unfolding f1_def apply (rule real_cond_exp_diff) by (intro Bochner_Integration.integrable_diff
                 \<open>integrable M f\<close> \<open>integrable M C\<close> real_cond_exp_int(1))+
   moreover have "AE x in M. real_cond_exp M Invariants (real_cond_exp M Invariants f) x = real_cond_exp M Invariants f x"
     by (intro real_cond_exp_nested_subalg subalg \<open>integrable M f\<close>, auto)
   ultimately have AEf1: "AE x in M. real_cond_exp M Invariants f1 x = 0" by auto
 
   have A [measurable]: "integrable M (\<lambda>x. f1 x + C x)"
     by (intro Bochner_Integration.integrable_add \<open>integrable M f1\<close> \<open>integrable M C\<close>)
   have "AE x in M. real_cond_exp M Invariants (\<lambda>x. f1 x + C x) x = real_cond_exp M Invariants f1 x + real_cond_exp M Invariants C x"
     by (intro real_cond_exp_add \<open>integrable M f1\<close> \<open>integrable M C\<close>)
   then have B: "AE x in M. real_cond_exp M Invariants (\<lambda>x. f1 x + C x) x > 0"
     using AECI AEf1 by auto
 
   obtain u2 g2 where H2: "u2 \<in> borel_measurable M" "integrable M g2" "AE x in M. g2 x \<ge> 0 \<and> g2 x \<le> max 0 (f1 x + C x)" "\<And>x. f1 x + C x = g2 x + u2 x - u2 (T x)"
     using cohomologous_approx_cond_exp_aux[OF A B] by blast
 
   define f2 where "f2 = (\<lambda>x. (g2 x - C x))"
   have *: "u2(T x) - u2 x = f2 x -f1 x" for x unfolding f2_def using H2(4)[of x] by auto
   have "AE x in M. f2 x \<ge> - C x" using H2(3) unfolding f2_def by auto
   have "integrable M f2"
     unfolding f2_def by (intro Bochner_Integration.integrable_diff \<open>integrable M g2\<close> \<open>integrable M C\<close>)
   have "AE x in M. real_cond_exp M Invariants (\<lambda>x. u2(T x) - u2 x) x = 0"
   proof (rule limit_foTn_over_n)
     show "integrable M (\<lambda>x. u2(T x) - u2 x)"
       unfolding * by (intro Bochner_Integration.integrable_diff \<open>integrable M f1\<close> \<open>integrable M f2\<close>)
   qed (simp add: \<open>u2 \<in> borel_measurable M\<close>)
   then have "AE x in M. real_cond_exp M Invariants (\<lambda>x. f2 x - f1 x) x = 0"
     unfolding * by simp
   moreover have "AE x in M. real_cond_exp M Invariants (\<lambda>x. f2 x - f1 x) x = real_cond_exp M Invariants f2 x - real_cond_exp M Invariants f1 x"
     by (intro real_cond_exp_diff \<open>integrable M f2\<close> \<open>integrable M f1\<close>)
   ultimately have AEf2: "AE x in M. real_cond_exp M Invariants f2 x = 0"
     using AEf1 by auto
 
   have A [measurable]: "integrable M (\<lambda>x. C x - f2 x)"
     by (intro Bochner_Integration.integrable_diff \<open>integrable M f2\<close> \<open>integrable M C\<close>)
   have "AE x in M. real_cond_exp M Invariants (\<lambda>x. C x - f2 x) x = real_cond_exp M Invariants C x - real_cond_exp M Invariants f2 x"
     by (intro real_cond_exp_diff \<open>integrable M f2\<close> \<open>integrable M C\<close>)
   then have B: "AE x in M. real_cond_exp M Invariants (\<lambda>x. C x - f2 x) x > 0"
     using AECI AEf2 by auto
 
   obtain u3 g3 where H3: "u3 \<in> borel_measurable M" "integrable M g3" "AE x in M. g3 x \<ge> 0 \<and> g3 x \<le> max 0 (C x - f2 x)" "\<And>x. C x - f2 x = g3 x + u3 x - u3 (T x)"
     using cohomologous_approx_cond_exp_aux[OF A B] by blast
 
   define f3 where "f3 = (\<lambda>x. C x - g3 x)"
   have "AE x in M. f3 x \<ge> min (C x) (f2 x)" unfolding f3_def using H3(3) by auto
   then have "AE x in M. f3 x \<ge> -C x" using \<open>AE x in M. f2 x \<ge> - C x\<close> \<open>AE x in M. C x > 0\<close> by auto
   moreover have "AE x in M. f3 x \<le> C x" unfolding f3_def using H3(3) by auto
   ultimately have "AE x in M. abs(f3 x) \<le> C x" by auto
   then have *: "AE x in M. abs(f3 x) \<le> B x" using order_trans[OF _ \<open>\<And>x. C x \<le> B x\<close>] by auto
 
   define g where "g = (\<lambda>x. f3 x + real_cond_exp M Invariants f x)"
   define u where "u = (\<lambda>x. u2 x - u3 x)"
   have "AE x in M. abs (g x - real_cond_exp M Invariants f x) \<le> B x"
     unfolding g_def using * by auto
   moreover have "f x = g x + u x - u(T x)" for x
     using H3(4)[of x] H2(4)[of x] unfolding u_def g_def f3_def f2_def f1_def by auto
   moreover have "u \<in> borel_measurable M"
     unfolding u_def using \<open>u2 \<in> borel_measurable M\<close> \<open>u3 \<in> borel_measurable M\<close> by auto
   moreover have "integrable M g"
     unfolding g_def f3_def by (intro Bochner_Integration.integrable_add Bochner_Integration.integrable_diff
     \<open>integrable M C\<close> \<open>integrable M g3\<close> \<open>integrable M f\<close> real_cond_exp_int(1))
   ultimately show ?thesis by auto
 qed
 
 
 subsubsection \<open>$L^1$ version of Birkhoff theorem\<close>
 
 text \<open>The $L^1$ convergence in Birkhoff theorem follows from the almost everywhere convergence and
 general considerations on $L^1$ convergence (Scheffe's lemma) explained
 in \verb+AE_and_int_bound_implies_L1_conv2+.
 This argument works neatly for nonnegative functions, the general case reduces to this one by taking
 the positive and negative parts of a given function.
 
 One could also prove it by truncation: for bounded functions, the $L^1$ convergence follows
 from the boundedness and almost sure convergence. The general case follows by density, but it
 is a little bit tedious to write as one need to make sure that the conditional expectation
 of the truncation converges to the conditional expectation of the original function. This is true
 in $L^1$ as the conditional expectation is a contraction in $L^1$, it follows almost everywhere
 after taking a subsequence. All in all, the argument based on Scheffe's lemma seems more
 economical.\<close>
 
 lemma birkhoff_lemma_L1:
   fixes f::"'a \<Rightarrow> real"
   assumes "\<And>x. f x \<ge> 0"
       and [measurable]: "integrable M f"
   shows "(\<lambda>n. \<integral>\<^sup>+x. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<partial>M) \<longlonglongrightarrow> 0"
 proof (rule Scheffe_lemma2)
   show i: "integrable M (real_cond_exp M Invariants f)" using assms by (simp add: real_cond_exp_int(1))
   show "AE x in M. (\<lambda>n. birkhoff_sum f n x / real n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
     using birkhoff_theorem_AE_nonergodic assms by simp
   fix n
   have [measurable]: "(\<lambda>x. ennreal \<bar>birkhoff_sum f n x\<bar>) \<in> borel_measurable M" by measurable
   show [measurable]: "(\<lambda>x. birkhoff_sum f n x / real n) \<in> borel_measurable M" by measurable
 
   have "AE x in M. real_cond_exp M Invariants f x \<ge> 0" using assms(1) real_cond_exp_pos by simp
   then have *: "AE x in M. norm (real_cond_exp M Invariants f x) = real_cond_exp M Invariants f x" by auto
   have **: "(\<integral> x. norm (real_cond_exp M Invariants f x) \<partial>M) = (\<integral> x. real_cond_exp M Invariants f x \<partial>M)"
     apply (rule integral_cong_AE) using * by auto
 
   have "(\<integral>\<^sup>+x. ennreal (norm (real_cond_exp M Invariants f x)) \<partial>M) = (\<integral> x. norm (real_cond_exp M Invariants f x) \<partial>M)"
     by (rule nn_integral_eq_integral) (auto simp add: i)
   also have "... = (\<integral> x. real_cond_exp M Invariants f x \<partial>M)"
     using ** by simp
   also have "... = (\<integral> x. f x \<partial>M)"
     using real_cond_exp_int(2) assms(2) by auto
   also have "... = (\<integral>x. norm(f x) \<partial>M)" using assms by auto
   also have "... = (\<integral>\<^sup>+x. norm(f x) \<partial>M)"
     by (rule nn_integral_eq_integral[symmetric], auto simp add: assms(2))
   finally have eq: "(\<integral>\<^sup>+ x. norm (real_cond_exp M Invariants f x) \<partial>M) = (\<integral>\<^sup>+ x. norm(f x) \<partial>M)" by simp
 
   {
     fix x
     have "norm(birkhoff_sum f n x) \<le> birkhoff_sum (\<lambda>x. norm(f x)) n x"
       using birkhoff_sum_abs by fastforce
     then have "norm(birkhoff_sum f n x) \<le> birkhoff_sum (\<lambda>x. ennreal(norm(f x))) n x"
       unfolding birkhoff_sum_def by auto
   }
   then have "(\<integral>\<^sup>+x. norm(birkhoff_sum f n x) \<partial>M) \<le> (\<integral>\<^sup>+x. birkhoff_sum (\<lambda>x. ennreal(norm(f x))) n x \<partial>M)"
     by (simp add: nn_integral_mono)
   also have "... = n * (\<integral>\<^sup>+x. norm(f x) \<partial>M)"
     by (rule birkhoff_sum_nn_integral, auto)
   also have "... = n * (\<integral>\<^sup>+ x. norm (real_cond_exp M Invariants f x) \<partial>M)"
     using eq by simp
   finally have *: "(\<integral>\<^sup>+x. norm(birkhoff_sum f n x) \<partial>M) \<le> n * (\<integral>\<^sup>+ x. norm (real_cond_exp M Invariants f x) \<partial>M)"
     by simp
 
   show "(\<integral>\<^sup>+ x. ennreal (norm (birkhoff_sum f n x / real n)) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm (real_cond_exp M Invariants f x) \<partial>M)"
   proof (cases)
     assume "n = 0"
     then show ?thesis by auto
   next
     assume "\<not>(n = 0)"
     then have "n > 0" by simp
     then have "1/ennreal(real n) \<ge> 0" by simp
     have "(\<integral>\<^sup>+ x. ennreal (norm (birkhoff_sum f n x / real n)) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (norm (birkhoff_sum f n x)) / ennreal(real n) \<partial>M)"
       using \<open>n > 0\<close> by (auto simp: divide_ennreal)
     also have "... = (\<integral>\<^sup>+ x. (1/ennreal(real n)) * ennreal (norm (birkhoff_sum f n x)) \<partial>M)"
       by (simp add: \<open>0 < n\<close> divide_ennreal_def mult.commute)
     also have "... = (1/ennreal(real n) * (\<integral>\<^sup>+ x. ennreal (norm (birkhoff_sum f n x)) \<partial>M))"
       by (subst nn_integral_cmult) auto
     also have "... \<le> (1/ennreal(real n)) * (ennreal(real n) * (\<integral>\<^sup>+ x. norm (real_cond_exp M Invariants f x) \<partial>M))"
       using * by (intro mult_mono) (auto simp: ennreal_of_nat_eq_real_of_nat)
     also have "... = (\<integral>\<^sup>+ x. norm (real_cond_exp M Invariants f x) \<partial>M)"
       using \<open>n > 0\<close>
       by (auto simp del: ennreal_1 simp add: ennreal_1[symmetric] divide_ennreal ennreal_mult[symmetric] mult.assoc[symmetric])
         simp
     finally show ?thesis by simp
   qed
 qed
 
 theorem birkhoff_theorem_L1_nonergodic:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
   shows "(\<lambda>n. \<integral>\<^sup>+x. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<partial>M) \<longlonglongrightarrow> 0"
 proof -
   define g where "g = (\<lambda>x. max (f x) 0)"
   have g_int [measurable]: "integrable M g" unfolding g_def using assms by auto
   define h where "h = (\<lambda>x. max (-f x) 0)"
   have h_int [measurable]: "integrable M h" unfolding h_def using assms by auto
   have "f = (\<lambda>x. g x - h x)" unfolding g_def h_def by auto
   {
     fix n::nat assume "n > 0"
     have "\<And>x. birkhoff_sum f n x = birkhoff_sum g n x - birkhoff_sum h n x" using birkhoff_sum_diff \<open>f = (\<lambda>x. g x - h x)\<close> by auto
     then have "\<And>x. birkhoff_sum f n x / n = birkhoff_sum g n x / n - birkhoff_sum h n x / n" using \<open>n > 0\<close> by (simp add: diff_divide_distrib)
     moreover have "AE x in M. real_cond_exp M Invariants g x - real_cond_exp M Invariants h x = real_cond_exp M Invariants f x"
       using AE_symmetric[OF real_cond_exp_diff] g_int h_int \<open>f = (\<lambda>x. g x - h x)\<close> by auto
     ultimately have "AE x in M. birkhoff_sum f n x / n - real_cond_exp M Invariants f x =
         (birkhoff_sum g n x / n - real_cond_exp M Invariants g x) - (birkhoff_sum h n x / n - real_cond_exp M Invariants h x)"
       by auto
     then have *: "AE x in M. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<le>
       norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x) + norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x)"
       by auto
     have "(\<integral>\<^sup>+ x. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<partial>M) \<le>
       (\<integral>\<^sup>+ x. ennreal(norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x)) + norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x) \<partial>M)"
       apply (rule nn_integral_mono_AE) using * by (simp add: ennreal_plus[symmetric] del: ennreal_plus)
     also have "... = (\<integral>\<^sup>+ x. norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x) \<partial>M) + (\<integral>\<^sup>+ x. norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x) \<partial>M)"
       apply (rule nn_integral_add) apply auto using real_cond_exp_F_meas borel_measurable_cond_exp2 by measurable
     finally have "(\<integral>\<^sup>+ x. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<partial>M) \<le>
       (\<integral>\<^sup>+ x. norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x) \<partial>M) + (\<integral>\<^sup>+ x. norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x) \<partial>M)"
       by simp
   }
   then have *: "eventually (\<lambda>n. (\<integral>\<^sup>+ x. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<partial>M) \<le>
       (\<integral>\<^sup>+ x. norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x) \<partial>M) + (\<integral>\<^sup>+ x. norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x) \<partial>M))
       sequentially"
     using eventually_at_top_dense by auto
   have **: "eventually (\<lambda>n. (\<integral>\<^sup>+ x. norm(birkhoff_sum f n x / n - real_cond_exp M Invariants f x) \<partial>M) \<ge> 0) sequentially"
     by simp
 
   have "(\<lambda>n. (\<integral>\<^sup>+ x. norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x) \<partial>M)) \<longlonglongrightarrow> 0"
     apply (rule birkhoff_lemma_L1, auto simp add: g_int) unfolding g_def by auto
   moreover have "(\<lambda>n. (\<integral>\<^sup>+ x. norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x) \<partial>M)) \<longlonglongrightarrow> 0"
     apply (rule birkhoff_lemma_L1, auto simp add: h_int) unfolding h_def by auto
   ultimately have "(\<lambda>n. (\<integral>\<^sup>+ x. norm(birkhoff_sum g n x / n - real_cond_exp M Invariants g x) \<partial>M) + (\<integral>\<^sup>+ x. norm(birkhoff_sum h n x / n - real_cond_exp M Invariants h x) \<partial>M)) \<longlonglongrightarrow> 0"
     using tendsto_add[of _ 0 _ _ 0] by auto
   then show ?thesis
     using tendsto_sandwich[OF ** *] by auto
 qed
 
 
 subsubsection \<open>Conservativity of skew products\<close>
 
 text \<open>The behaviour of skew-products of the form $(x, y) \mapsto (Tx, y + f x)$ is directly related
 to Birkhoff theorem, as the iterates involve the Birkhoff sums in the fiber. Birkhoff theorem
 implies that such a skew product is conservative when the function $f$ has vanishing conditional
 expectation.
 
 To prove the theorem, assume by contradiction that a set $A$ with positive measure does not
 intersect its preimages. Replacing $A$ with a smaller set $C$, we can assume that $C$ is bounded in
 the $y$-direction, by a constant $N$, and also that all its nonempty vertical fibers, above the
 projection $Cx$, have a measure bounded from below. Then, by Birkhoff theorem, for any $r>0$, most
 of the first $n$ preimages of $C$ are contained in the set $\{|y| \leq r n+N\}$, of measure $O(r
 n)$. Hence, they can not be disjoint if $r < \mu(C)$. To make this argument rigorous, one should
 only consider the preimages whose $x$-component belongs to a set $Dx$ where the Birkhoff sums are
 small. This condition has a positive measure if $\mu(Cx) + \mu(Dx) > \mu(M)$, which one can ensure
 by taking $Dx$ large enough.\<close>
 
 theorem (in fmpt) skew_product_conservative:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f"
     and "AE x in M. real_cond_exp M Invariants f x = 0"
   shows "conservative_mpt (M \<Otimes>\<^sub>M lborel) (\<lambda>(x,y). (T x, y + f x))"
 proof (rule conservative_mptI)
   let ?TS = "(\<lambda>(x,y). (T x, y + f x))"
   let ?MS = "M \<Otimes>\<^sub>M (lborel::real measure)"
 
   have f_meas [measurable]: "f \<in> borel_measurable M" by auto
   have "mpt M T" by (simp add: mpt_axioms)
   with mpt_skew_product_real[OF this f_meas] show "mpt ?MS ?TS" by simp
   then interpret TS: mpt ?MS ?TS by auto
 
   fix A::"('a \<times> real) set"
   assume A1 [measurable]: "A \<in> sets ?MS" and A2: "emeasure ?MS A > 0"
   have "A = (\<Union>N::nat. A \<inter> {(x,y). abs(y) \<le> N})" by (auto simp add: real_arch_simple)
   then have *: "emeasure ?MS (\<Union>N::nat. A \<inter> {(x,y). abs(y) \<le> N}) > 0"
     using A2 by simp
 
   have "space ?MS = space M \<times> space (lborel::real measure)" using space_pair_measure by auto
   then have A_inc: "A \<subseteq> space M \<times> space (lborel::real measure)" using sets.sets_into_space[OF A1] by auto
 
   {
     fix N::nat
     have "{(x, y). abs(y) \<le> real N \<and> x \<in> space M} = space M \<times> {-(real N)..(real N)}" by auto
     then have "{(x, y). \<bar>y\<bar> \<le> real N \<and> x \<in> space M} \<in> sets ?MS" by auto
     then have "A \<inter> {(x, y). \<bar>y\<bar> \<le> real N \<and> x \<in> space M} \<in> sets ?MS" using A1 by auto
     moreover have "A \<inter> {(x,y). abs(y) \<le> real N} = A \<inter> {(x, y). \<bar>y\<bar> \<le> real N \<and> x \<in> space M}"
       using A_inc by blast
     ultimately have "A \<inter> {(x,y). abs(y) \<le> real N} \<in> sets ?MS" by auto
   }
   then have [measurable]: "\<And>N::nat. A \<inter> {(x, y). \<bar>y\<bar> \<le> real N} \<in> sets (M \<Otimes>\<^sub>M borel)" by auto
 
   have "\<exists>N::nat. emeasure ?MS (A \<inter> {(x,y). abs(y) \<le> N}) > 0"
     apply (rule emeasure_pos_unionE) using * by auto
   then obtain N::nat where N: "emeasure ?MS (A \<inter> {(x,y). abs(y) \<le> N}) > 0"
     by auto
 
   define B where "B = A \<inter> {(x,y). abs(y) \<le> N}"
   have B_meas [measurable]: "B \<in> sets (M \<Otimes>\<^sub>M lborel)" unfolding B_def by auto
   have "0 < emeasure (M \<Otimes>\<^sub>M lborel) B" unfolding B_def using N by auto
   also have "... = (\<integral>\<^sup>+x. emeasure lborel (Pair x -` B) \<partial>M)"
     apply (rule sigma_finite_measure.emeasure_pair_measure_alt)
     using B_meas by (auto simp add: lborel.sigma_finite_measure_axioms)
   finally have *: "(\<integral>\<^sup>+x. emeasure lborel (Pair x -` B) \<partial>M) > 0" by simp
 
   have "\<exists>Cx\<in>sets M. \<exists>e::real>0. emeasure M Cx > 0 \<and> (\<forall>x \<in> Cx. emeasure lborel (Pair x -` B) \<ge> e)"
     by (rule not_AE_zero_int_ennreal_E, auto simp add: *)
   then obtain Cx e where [measurable]: "Cx \<in> sets M" and Cxe: "e>(0::real)" "emeasure M Cx > 0" "\<And>x. x \<in> Cx \<Longrightarrow> emeasure lborel (Pair x -` B) \<ge> e"
     by blast
   define C where "C = B \<inter> (Cx \<times> (UNIV::real set))"
   have C_meas [measurable]: "C \<in> sets (M \<Otimes>\<^sub>M lborel)" unfolding C_def using B_meas by auto
   have Cx_fibers: "\<And>x. x \<in> Cx \<Longrightarrow> emeasure lborel (Pair x -` C) \<ge> e" using Cxe(3) C_def by auto
 
   define c where "c = (measure M Cx)/2"
   have "c > 0" unfolding c_def using Cxe(2) by (simp add: emeasure_eq_measure)
 
   text \<open>We will apply Birkhoff theorem to show that most preimages of $C$ at time $n$ are contained in a cylinder
   of height roughly $r n$, for some suitably small $r$. How small $r$ should be to get a
   contradiction can be determined at the end of the proof. It turns out that the good condition
   is the following one -- this is by no means obvious now.\<close>
 
   define r where "r = (if measure M (space M) = 0 then 1 else e * c / (4 * measure M (space M)))"
   have "r > 0" using \<open>e > 0\<close> \<open>c > 0\<close> unfolding r_def
     apply auto using measure_le_0_iff by fastforce
   have pos: "e*c-2*r*measure M (space M) > 0" using \<open>e > 0\<close> \<open>c > 0\<close> unfolding r_def by auto
 
   define Bgood where "Bgood = {x \<in> space M. (\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> 0}"
   have [measurable]: "Bgood \<in> sets M" unfolding Bgood_def by auto
   have *: "AE x in M. x \<in> Bgood" unfolding Bgood_def using birkhoff_theorem_AE_nonergodic[OF assms(1)] assms(2) by auto
   then have "emeasure M Bgood = emeasure M (space M)"
     by (intro emeasure_eq_AE) auto
 
   {
     fix x assume "x \<in> Bgood"
     then have "x \<in> space M" unfolding Bgood_def by auto
     have "(\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> 0" using \<open>x \<in> Bgood\<close> unfolding Bgood_def by auto
     moreover have "0 \<in> {-r<..<r}" "open {-r<..<r}" using \<open>r>0\<close> by auto
     ultimately have "eventually (\<lambda>n. birkhoff_sum f n x / n \<in> {-r<..<r}) sequentially"
       using topological_tendstoD by blast
     then obtain n0 where n0: "n0>0" "\<And>n. n \<ge> n0 \<Longrightarrow> birkhoff_sum f n x / n \<in> {-r<..<r}"
       using eventually_sequentially by (metis (mono_tags, lifting) le0 le_simps(3) neq0_conv)
     {
       fix n assume "n \<ge> n0"
       then have "n>0" using \<open>n0>0\<close> by auto
       with n0(2)[OF \<open>n \<ge> n0\<close>] have "abs(birkhoff_sum f n x / n) \<le> r" by auto
       then have "abs(birkhoff_sum f n x) \<le> r * n" using \<open>n>0\<close> by (simp add: divide_le_eq)
     }
     then have "x \<in> (\<Union>n0. {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n})" using \<open>x \<in> space M\<close> by blast
   }
   then have "AE x in M. x \<notin> space M - (\<Union>n0. {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n})"
     using * by auto
   then have eqM: "emeasure M (\<Union>n0. {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n}) = emeasure M (space M)"
     by (intro emeasure_eq_AE) auto
 
   have "(\<lambda>n0. emeasure M {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n} + c)
           \<longlonglongrightarrow> emeasure M (\<Union>n0. {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n}) + c"
     by (intro tendsto_intros Lim_emeasure_incseq) (auto simp add: incseq_def)
   moreover have "emeasure M (\<Union>n0. {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n}) + c > emeasure M (space M)"
     using eqM \<open>c > 0\<close> emeasure_eq_measure by auto
   ultimately have "eventually (\<lambda>n0. emeasure M {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n} + c > emeasure M (space M)) sequentially"
     unfolding order_tendsto_iff by auto
   then obtain n0 where n0: "emeasure M {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n} + c > emeasure M (space M)"
     using eventually_sequentially by auto
 
   define Dx where "Dx = {x \<in> space M. \<forall>n\<in>{n0..}. abs(birkhoff_sum f n x) \<le> r * n}"
   have Dx_meas [measurable]: "Dx \<in> sets M" unfolding Dx_def by auto
   have "emeasure M Dx + c \<ge> emeasure M (space M)" using n0 Dx_def by auto
 
   obtain n1::nat where n1: "n1 > max n0 ((measure M (space M) * 2 * N + e*c*n0 - e*c) / (e*c-2*r*measure M (space M)))"
     by (metis mult.commute mult.left_neutral numeral_One reals_Archimedean3 zero_less_numeral)
   then have "n1 > n0" by auto
   have n1_ineq: "n1 * (e*c-2*r*measure M (space M)) > (measure M (space M) * 2 * N + e*c*n0 - e*c)"
     using n1 pos by (simp add: pos_divide_less_eq)
 
   define D where "D = (\<lambda>n. Dx \<times> {-r*n1-N..r*n1+N} \<inter> (?TS^^n)-`C)"
   have Dn_meas [measurable]: "D n \<in> sets (M \<Otimes>\<^sub>M lborel)" for n
     unfolding D_def apply (rule TS.T_intersec_meas(2)) using C_meas by auto
 
   have "emeasure ?MS (D n) \<ge> e * c" if "n \<in> {n0..n1}" for n
   proof -
     have "n \<ge> n0" "n \<le> n1" using that by auto
     {
       fix x assume [simp]: "x \<in> space M"
 
       define F where "F = {y \<in> {-r*n1-N..r*n1+N}. y + birkhoff_sum f n x \<in> Pair ((T^^n)x) -`C}"
       have [measurable]: "F \<in> sets lborel" unfolding F_def by measurable
       {
         fix y::real
         have "(?TS^^n)(x,y) = ((T^^n)x, y + birkhoff_sum f n x)"
           using skew_product_real_iterates by simp
         then have "(indicator C ((?TS^^n) (x,y))::ennreal) = indicator Cx ((T^^n)x) * indicator (Pair ((T^^n)x) -`C) (y + birkhoff_sum f n x)"
           using C_def by (simp add: indicator_def)
         moreover have "(indicator (D n) (x, y)::ennreal) = indicator Dx x * indicator {-r*n1-N..r*n1+N} y * indicator C ((?TS^^n) (x,y))"
           unfolding D_def by (simp add: indicator_def)
         ultimately have "(indicator (D n) (x, y)::ennreal) = indicator Dx x * indicator {-r*n1-N..r*n1+N} y
             * indicator Cx ((T^^n)x) * indicator (Pair ((T^^n)x) -`C) (y + birkhoff_sum f n x)"
           by (simp add: mult.assoc)
         then have "(indicator (D n) (x, y)::ennreal) = indicator (Dx \<inter> (T^^n)-`Cx) x * indicator F y"
           unfolding F_def by (simp add: indicator_def)
       }
       then have "(\<integral>\<^sup>+y. indicator (D n) (x, y) \<partial>lborel) = (\<integral>\<^sup>+y. indicator (Dx \<inter> (T^^n)-`Cx) x * indicator F y \<partial>lborel)"
         by auto
       also have "... = indicator (Dx \<inter> (T^^n)-`Cx) x * (\<integral>\<^sup>+y. indicator F y \<partial>lborel)"
         by (rule nn_integral_cmult, auto)
       also have "... = indicator (Dx \<inter> (T^^n)-`Cx) x * emeasure lborel F" using \<open>F \<in> sets lborel\<close> by auto
       finally have A: "(\<integral>\<^sup>+y. indicator (D n) (x, y) \<partial>lborel) = indicator (Dx \<inter> (T^^n)-`Cx) x * emeasure lborel F"
         by simp
 
       have "(\<integral>\<^sup>+y. indicator (D n) (x, y) \<partial>lborel) \<ge> ennreal e * indicator (Dx \<inter> (T^^n)-`Cx) x"
       proof (cases)
         assume "indicator (Dx \<inter> (T^^n)-`Cx) x = (0::ennreal)"
         then show ?thesis by auto
       next
         assume "\<not>(indicator (Dx \<inter> (T^^n)-`Cx) x = (0::ennreal))"
         then have "x \<in> Dx \<inter> (T^^n)-`Cx" by (simp add: indicator_eq_0_iff)
         then have "x \<in> Dx" "(T^^n) x \<in> Cx" by auto
         then have "abs(birkhoff_sum f n x) \<le> r * n" using \<open>n \<in> {n0..n1}\<close> Dx_def by auto
         then have *: "abs(birkhoff_sum f n x) \<le> r * n1" using \<open>n \<le> n1\<close> \<open>r>0\<close>
-          by (meson of_nat_le_iff order_trans real_mult_le_cancel_iff2)
+          by (meson of_nat_le_iff order_trans mult_le_cancel_iff2)
 
         have F_expr: "F = {-r*n1-N..r*n1+N} \<inter> (+)(birkhoff_sum f n x) -` (Pair ((T^^n)x) -`C)"
           unfolding F_def by (auto simp add: add.commute)
         have "(Pair ((T^^n)x) -`C) \<subseteq> {real_of_int (- int N)..real N}" unfolding C_def B_def by auto
         then have "((+)(birkhoff_sum f n x)) -` (Pair ((T^^n)x) -`C) \<subseteq> {-N-birkhoff_sum f n x..N-birkhoff_sum f n x}"
           by auto
         also have "... \<subseteq> {-r * n1 - N .. r * n1 + N}" using * by auto
         finally have "F = ((+)(birkhoff_sum f n x)) -` (Pair ((T^^n)x) -`C)" unfolding F_expr by auto
 
         then have "emeasure lborel F = emeasure lborel ((+)(birkhoff_sum f n x) -` (Pair ((T^^n)x) -`C))" by auto
         also have "... = emeasure lborel (((+)(birkhoff_sum f n x) -` (Pair ((T^^n)x) -`C)) \<inter> space lborel)" by simp
         also have "... = emeasure (distr lborel borel ((+) (birkhoff_sum f n x))) (Pair ((T^^n)x) -`C)"
           apply (rule emeasure_distr[symmetric]) using C_meas by auto
         also have "... = emeasure lborel (Pair ((T^^n)x) -`C)" using lborel_distr_plus[of "birkhoff_sum f n x"] by simp
         also have "... \<ge> e" using Cx_fibers \<open>(T^^n) x \<in> Cx\<close> by auto
         finally have "emeasure lborel F \<ge> e" by auto
         then show ?thesis using A by (simp add: indicator_def)
       qed
     }
     moreover have "emeasure ?MS (D n) = (\<integral>\<^sup>+x. (\<integral>\<^sup>+y. indicator (D n) (x, y) \<partial>lborel) \<partial>M)"
       using Dn_meas lborel.emeasure_pair_measure by blast
     ultimately have "emeasure ?MS (D n) \<ge> (\<integral>\<^sup>+x. ennreal e * indicator (Dx \<inter> (T ^^ n) -` Cx) x \<partial>M)"
       by (simp add: nn_integral_mono)
     also have "(\<integral>\<^sup>+x. ennreal e * indicator (Dx \<inter> (T ^^ n) -` Cx) x \<partial>M) = e * (\<integral>\<^sup>+x. indicator (Dx \<inter> (T ^^ n) -` Cx) x \<partial>M)"
       apply (rule nn_integral_cmult) using \<open>e>0\<close> by auto
     also have "... = ennreal e * emeasure M (Dx \<inter> (T ^^ n) -` Cx)" by simp
     finally have *: "emeasure ?MS (D n) \<ge> ennreal e * emeasure M (Dx \<inter> (T ^^ n) -` Cx)" by auto
 
     have "c + emeasure M (space M) \<le> emeasure M Dx + emeasure M Cx"
       using \<open>emeasure M Dx + c \<ge> emeasure M (space M)\<close> unfolding c_def
       by (auto simp: emeasure_eq_measure ennreal_plus[symmetric] simp del: ennreal_plus)
     also have "... = emeasure M Dx + emeasure M ((T^^n)--`Cx)"
       by (simp add: T_vrestr_same_emeasure(2))
     also have "... = emeasure M (Dx \<union> ((T^^n)--`Cx)) + emeasure M (Dx \<inter> ((T^^n)--`Cx))"
       by (rule emeasure_Un_Int, auto)
     also have "... \<le> emeasure M (space M) + emeasure M (Dx \<inter> ((T^^n)-`Cx))"
     proof -
       have "emeasure M (Dx \<union> ((T^^n)--`Cx)) \<le> emeasure M (space M)"
         by (rule emeasure_mono, auto simp add: sets.sets_into_space)
       moreover have "Dx \<inter> ((T^^n)--`Cx) = Dx \<inter> ((T^^n)-`Cx)"
         by (simp add: vrestr_intersec_in_space)
       ultimately show ?thesis by (metis add.commute add_left_mono)
     qed
     finally have "emeasure M (Dx \<inter> ((T^^n)-`Cx)) \<ge> c" by (simp add: emeasure_eq_measure)
     then have "ennreal e * emeasure M (Dx \<inter> ((T^^n)-`Cx)) \<ge> ennreal e * c" using \<open>e > 0\<close>
       using mult_left_mono by fastforce
     with * show "emeasure ?MS (D n) \<ge> e * c"
       using \<open>0<c\<close> \<open>0<e\<close> by (auto simp: ennreal_mult[symmetric])
   qed
 
   have "\<not>(disjoint_family_on D {n0..n1})"
   proof
     assume D: "disjoint_family_on D {n0..n1}"
     have "emeasure lborel {-r*n1-N..r*n1+N} = (r * real n1 + real N) - (- r * real n1 - real N)"
       apply (rule emeasure_lborel_Icc) using \<open>r>0\<close> by auto
     then have *: "emeasure lborel {-r*n1-N..r*n1+N} = ennreal(2 * r * real n1 + 2 * real N)"
       by (auto simp: ac_simps)
 
     have "ennreal(e * c) * (real n1 - real n0 + 1) = ennreal(e*c) * card {n0..n1}"
       using \<open>n1 > n0\<close> by (auto simp: ennreal_of_nat_eq_real_of_nat Suc_diff_le ac_simps of_nat_diff)
     also have "... = (\<Sum>n\<in>{n0..n1}. ennreal(e*c))"
       by (simp add: ac_simps)
     also have "... \<le> (\<Sum>n\<in>{n0..n1}. emeasure ?MS (D n))"
       using \<open>\<And>n. n \<in> {n0..n1} \<Longrightarrow> emeasure ?MS (D n) \<ge> e * c\<close> by (meson sum_mono)
     also have "... = emeasure ?MS (\<Union>n\<in>{n0..n1}. D n)"
       apply (rule sum_emeasure) using Dn_meas by (auto simp add: D)
     also have "... \<le> emeasure ?MS (space M \<times> {-r*n1-N..r*n1+N})"
       apply (rule emeasure_mono) unfolding D_def using sets.sets_into_space[OF Dx_meas] by auto
     also have "... = emeasure M (space M) * emeasure lborel {-r*n1-N..r*n1+N}"
       by (rule sigma_finite_measure.emeasure_pair_measure_Times, auto simp add: lborel.sigma_finite_measure_axioms)
     also have "... = emeasure M (space M) * ennreal(2 * r * real n1 + 2 * real N)"
       using * by auto
     finally have "ennreal(e * c) * (real n1- real n0+1) \<le> emeasure M (space M) * ennreal(2 * r * real n1 + 2 * real N)" by simp
     then have "e*c * (real n1- real n0 + 1) \<le> measure M (space M) * (2 * r * real n1 + 2 * real N)"
       using \<open>0<r\<close> \<open>0<e\<close> \<open>0<c\<close> \<open>n0 < n1\<close> emeasure_eq_measure by (auto simp: ennreal_mult'[symmetric] simp del: ennreal_plus)
     then have "0 \<le> measure M (space M) * (2 * r * real n1 + 2 * real N) - e*c * (real n1- real n0 + 1)" by auto
     also have "... = (measure M (space M) * 2 * N + e*c*n0 - e*c) - n1 * (e*c-2*r*measure M (space M))"
       by algebra
     finally have "n1 * (e*c-2*r*measure M (space M)) \<le> measure M (space M) * 2 * N + e*c*n0 - e*c"
       by linarith
     then show False using n1_ineq by auto
   qed
   then obtain n m where nm: "n<m" "D m \<inter> D n \<noteq> {}" unfolding disjoint_family_on_def by (metis inf_sup_aci(1) linorder_cases)
   define k where "k = m-n"
   then have "k>0" "D (n+k) \<inter> D n \<noteq> {}" using nm by auto
   then have "((?TS^^(n+k))-`A) \<inter> ((?TS^^n)-`A) \<noteq> {}" unfolding D_def C_def B_def by auto
   moreover have "((?TS^^(n+k))-`A) \<inter> ((?TS^^n)-`A) = (?TS^^n)-`(((?TS^^k)-`A) \<inter> A)"
     using funpow_add by (simp add: add.commute funpow_add set.compositionality)
   ultimately have "((?TS^^k)-`A) \<inter> A \<noteq> {}" by auto
   then show "\<exists>k>0. ((?TS^^k)-`A) \<inter> A \<noteq> {}" using \<open>k>0\<close> by auto
 qed
 
 
 
 subsubsection \<open>Oscillations around the limit in Birkhoff theorem\<close>
 
 text \<open>In this paragraph, we prove that, in Birkhoff theorem with vanishing limit, the Birkhoff sums
 are infinitely many times arbitrarily close to $0$, both on the positive and the negative side.
 
 In the ergodic case, this statement implies for instance that if the Birkhoff sums of an integrable
 function tend to infinity almost everywhere, then the integral of the function can not vanish, it
 has to be strictly positive (while Birkhoff theorem per se does not exclude the convergence to
 infinity, at a rate slower than linear). This converts a qualitative information (convergence to
 infinity at an unknown rate) to a quantitative information (linear convergence to infinity). This
 result (sometimes known as Atkinson's Lemma) has been reinvented many times, for instance by Kesten
 and by Guivarch. It plays an important role in the study of random products of matrices.
 
 This is essentially a consequence of the conservativity of the corresponding skew-product, proved in
 \verb+skew_product_conservative+. Indeed, this implies that, starting from a small set $X \times
 [-e/2, e/2]$, the skew-product comes back infinitely often to itself, which implies that the
 Birkhoff sums at these times are bounded by $e$.
 
 To show that the Birkhoff sums come back to $[0,e]$ is a little bit more tricky. Argue by
 contradiction, and induce on $A \times [0,e/2]$ where $A$ is the set of points where the Birkhoff
 sums don't come back to $[0,e]$. Then the second coordinate decreases strictly when one iterates the
 skew product, which is not compatible with conservativity.\<close>
 
 lemma birkhoff_sum_small_asymp_lemma:
   assumes [measurable]: "integrable M f"
     and "AE x in M. real_cond_exp M Invariants f x = 0" "e>(0::real)"
   shows "AE x in M. infinite {n. birkhoff_sum f n x \<in> {0..e}}"
 proof -
   have [measurable]: "f \<in> borel_measurable M" by auto
   have [measurable]: "\<And>N. {x \<in> space M. \<exists>N. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}} \<in> sets M" by auto
 
   {
     fix N assume "N>(0::nat)"
     define Ax where "Ax = {x \<in> space M. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}}"
     then have [measurable]: "Ax \<in> sets M" by auto
     define A where "A = Ax \<times> {0..e/2}"
     then have A_meas [measurable]: "A \<in> sets (M \<Otimes>\<^sub>M lborel)" by auto
 
     define TN where "TN = T^^N"
     interpret TN: fmpt M TN
       unfolding TN_def using fmpt_power by auto
     define fN where "fN = birkhoff_sum f N"
     have "TN.birkhoff_sum fN n x = birkhoff_sum f (n*N) x" for n x
     proof (induction n)
       case 0
       then show ?case by auto
     next
       case (Suc n)
       have "TN.birkhoff_sum fN (Suc n) x = TN.birkhoff_sum fN n x + fN ((TN^^n) x)"
         using TN.birkhoff_sum_cocycle[of fN n 1] by auto
       also have "... = birkhoff_sum f (n*N) x + birkhoff_sum f N ((TN^^n) x)"
         using Suc.IH fN_def by auto
       also have "... = birkhoff_sum f (n*N+N) x" unfolding TN_def
         by (subst funpow_mult, subst mult.commute[of N n], rule birkhoff_sum_cocycle[of f "n*N" N x, symmetric])
       finally show ?case by (simp add: add.commute)
     qed
     then have not0e: "\<And>x n. x \<in> Ax \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> TN.birkhoff_sum fN n x \<notin> {0..e}" unfolding Ax_def by auto
 
     let ?TS = "(\<lambda>(x,y). (T x, y + f x))"
     let ?MS = "M \<Otimes>\<^sub>M (lborel::real measure)"
     interpret TS: conservative_mpt ?MS ?TS
       by (rule skew_product_conservative, auto simp add: assms)
 
     let ?TSN = "(\<lambda>(x,y). (TN x, y + fN x))"
     have *:"?TSN = ?TS^^N" unfolding TN_def fN_def using skew_product_real_iterates by auto
     interpret TSN: conservative_mpt ?MS ?TSN
       using * TS.conservative_mpt_power by auto
 
     define MA TA where "MA = restrict_space ?MS A" and "TA = TSN.induced_map A"
     interpret TA: conservative_mpt MA TA unfolding MA_def TA_def
       by (rule TSN.induced_map_conservative_mpt, measurable)
     have *: "\<And> x y. snd (TA (x,y)) = snd (x,y) + TN.birkhoff_sum fN (TSN.return_time_function A (x,y)) x"
       unfolding TA_def TSN.induced_map_def using TN.skew_product_real_iterates Pair_def by auto
     have [measurable]: "snd \<in> borel_measurable ?MS" by auto
     then have [measurable]: "snd \<in> borel_measurable MA" unfolding MA_def using measurable_restrict_space1 by blast
 
     have "AE z in MA. z \<in> TSN.recurrent_subset A"
       unfolding MA_def using TSN.induced_map_recurrent_typical(1)[OF A_meas].
     moreover
     {
       fix z assume z: "z \<in> TSN.recurrent_subset A"
       define x y where "x = fst z" and "y = snd z"
       then have "z = (x,y)" by simp
       have "z \<in> A" using z "TSN.recurrent_subset_incl"(1) by auto
       then have "x \<in> Ax" "y \<in> {0..e/2}" unfolding A_def x_def y_def by auto
       define y2 where "y2 = y + TN.birkhoff_sum fN (TSN.return_time_function A (x,y)) x"
       have "y2 = snd (TA z)" unfolding y2_def using * \<open>z = (x, y)\<close> by force
       moreover have "TA z \<in> A" unfolding TA_def using \<open>z \<in> A\<close> TSN.induced_map_stabilizes_A by auto
       ultimately have "y2 \<in> {0..e/2}" unfolding A_def by auto
 
       have "TSN.return_time_function A (x,y) \<noteq> 0"
         using \<open>z = (x,y)\<close> \<open>z \<in> TSN.recurrent_subset A\<close> TSN.return_time0[of A] by fast
       then have "TN.birkhoff_sum fN (TSN.return_time_function A (x,y)) x \<notin> {0..e}"
         using not0e[OF \<open>x \<in> Ax\<close>] by auto
       moreover have "TN.birkhoff_sum fN (TSN.return_time_function A (x,y)) x \<in> {-e..e}"
         using \<open>y \<in> {0..e/2}\<close> \<open>y2 \<in> {0..e/2}\<close> y2_def by auto
       ultimately have "TN.birkhoff_sum fN (TSN.return_time_function A (x,y)) x \<in> {-e..<0}"
         by auto
       then have "y2 < y" using y2_def by auto
       then have "snd(TA z) < snd z" unfolding y_def using \<open>y2 = snd (TA z)\<close> by auto
     }
     ultimately have a: "AE z in MA. snd(TA z) < snd z" by auto
     then have "AE z in MA. snd(TA z) \<le> snd z" by auto
     then have "AE z in MA. snd(TA z) = snd z" using TA.AE_decreasing_then_invariant[of snd] by auto
     then have "AE z in MA. False" using a by auto
     then have "space MA \<in> null_sets MA" by (simp add: AE_iff_null_sets)
     then have "emeasure MA A = 0" by (metis A_meas MA_def null_setsD1 space_restrict_space2)
     then have "emeasure ?MS A = 0" unfolding MA_def
       by (metis A_meas emeasure_restrict_space sets.sets_into_space sets.top space_restrict_space space_restrict_space2)
     moreover have "emeasure ?MS A = emeasure M Ax * emeasure lborel {0..e/2}"
       unfolding A_def by (intro lborel.emeasure_pair_measure_Times) auto
     ultimately have "emeasure M {x \<in> space M. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}} = 0" using \<open>e>0\<close> Ax_def by simp
     then have "{x \<in> space M. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}} \<in> null_sets M" by auto
   }
   then have "(\<Union>N\<in>{0<..}. {x \<in> space M. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}}) \<in> null_sets M" by (auto simp: greaterThan_0)
   moreover have "{x \<in> space M. \<not>(infinite {n. birkhoff_sum f n x \<in> {0..e}})} \<subseteq> (\<Union>N\<in>{0<..}. {x \<in> space M. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}})"
   proof
     fix x assume H: "x \<in> {x \<in> space M. \<not>(infinite {n. birkhoff_sum f n x \<in> {0..e}})}"
     then have "x \<in> space M" by auto
     have *: "finite {n. birkhoff_sum f n x \<in> {0..e}}" using H by auto
     then obtain N where "\<And>n. n \<ge> N \<Longrightarrow> n \<notin> {n. birkhoff_sum f n x \<in> {0..e}}"
       by (metis finite_nat_set_iff_bounded not_less)
     then have "x \<in> {x \<in> space M. \<forall>n\<in>{N+1..}. birkhoff_sum f n x \<notin> {0..e}}" using \<open>x \<in> space M\<close> by auto
     moreover have "N+1>0" by auto
     ultimately show "x \<in> (\<Union>N\<in>{0<..}. {x \<in> space M. \<forall>n\<in>{N..}. birkhoff_sum f n x \<notin> {0..e}})" by auto
   qed
   ultimately show ?thesis unfolding eventually_ae_filter by auto
 qed
 
 theorem birkhoff_sum_small_asymp_pos_nonergodic:
   assumes [measurable]: "integrable M f" and "e > (0::real)"
   shows "AE x in M. infinite {n. birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x .. n * real_cond_exp M Invariants f x + e}}"
 proof -
   define g where "g = (\<lambda>x. f x - real_cond_exp M Invariants f x)"
   have g_meas [measurable]: "integrable M g" unfolding g_def using real_cond_exp_int(1)[OF assms(1)] assms(1) by auto
   have "AE x in M. real_cond_exp M Invariants (real_cond_exp M Invariants f) x = real_cond_exp M Invariants f x"
     by (rule real_cond_exp_F_meas, auto simp add: real_cond_exp_int(1)[OF assms(1)])
   then have *: "AE x in M. real_cond_exp M Invariants g x = 0"
     unfolding g_def using real_cond_exp_diff[OF assms(1) real_cond_exp_int(1)[OF assms(1)]] by auto
   have "AE x in M. infinite {n. birkhoff_sum g n x \<in> {0..e}}"
     by (rule birkhoff_sum_small_asymp_lemma, auto simp add: \<open>e>0\<close> * g_meas)
   moreover
   {
     fix x assume "x \<in> space M" "infinite {n. birkhoff_sum g n x \<in> {0..e}}"
     {
       fix n assume H: "birkhoff_sum g n x \<in> {0..e}"
       have "birkhoff_sum g n x = birkhoff_sum f n x - birkhoff_sum (real_cond_exp M Invariants f) n x"
         unfolding g_def using birkhoff_sum_diff by auto
       also have "... = birkhoff_sum f n x - n * real_cond_exp M Invariants f x"
         using birkhoff_sum_of_invariants \<open>x \<in> space M\<close> by auto
       finally have "birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x .. n * real_cond_exp M Invariants f x + e}" using H by simp
     }
     then have "{n. birkhoff_sum g n x \<in> {0..e}} \<subseteq> {n. birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x .. n * real_cond_exp M Invariants f x + e}}"
       by auto
     then have "infinite {n. birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x .. n * real_cond_exp M Invariants f x + e}}"
       using \<open>infinite {n. birkhoff_sum g n x \<in> {0..e}}\<close> finite_subset by blast
   }
   ultimately show ?thesis by auto
 qed
 
 theorem birkhoff_sum_small_asymp_neg_nonergodic:
   assumes [measurable]: "integrable M f" and "e > (0::real)"
   shows "AE x in M. infinite {n. birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x - e .. n * real_cond_exp M Invariants f x}}"
 proof -
   define g where "g = (\<lambda>x. real_cond_exp M Invariants f x - f x)"
   have g_meas [measurable]: "integrable M g" unfolding g_def using real_cond_exp_int(1)[OF assms(1)] assms(1) by auto
   have "AE x in M. real_cond_exp M Invariants (real_cond_exp M Invariants f) x = real_cond_exp M Invariants f x"
     by (rule real_cond_exp_F_meas, auto simp add: real_cond_exp_int(1)[OF assms(1)])
   then have *: "AE x in M. real_cond_exp M Invariants g x = 0"
     unfolding g_def using real_cond_exp_diff[OF real_cond_exp_int(1)[OF assms(1)] assms(1)] by auto
   have "AE x in M. infinite {n. birkhoff_sum g n x \<in> {0..e}}"
     by (rule birkhoff_sum_small_asymp_lemma, auto simp add: \<open>e>0\<close> * g_meas)
   moreover
   {
     fix x assume "x \<in> space M" "infinite {n. birkhoff_sum g n x \<in> {0..e}}"
     {
       fix n assume H: "birkhoff_sum g n x \<in> {0..e}"
       have "birkhoff_sum g n x = birkhoff_sum (real_cond_exp M Invariants f) n x - birkhoff_sum f n x"
         unfolding g_def using birkhoff_sum_diff by auto
       also have "... = n * real_cond_exp M Invariants f x - birkhoff_sum f n x"
         using birkhoff_sum_of_invariants \<open>x \<in> space M\<close> by auto
       finally have "birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x - e .. n * real_cond_exp M Invariants f x}" using H by simp
     }
     then have "{n. birkhoff_sum g n x \<in> {0..e}} \<subseteq> {n. birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x - e .. n * real_cond_exp M Invariants f x}}"
       by auto
     then have "infinite {n. birkhoff_sum f n x \<in> {n * real_cond_exp M Invariants f x - e .. n * real_cond_exp M Invariants f x}}"
       using \<open>infinite {n. birkhoff_sum g n x \<in> {0..e}}\<close> finite_subset by blast
   }
   ultimately show ?thesis by auto
 qed
 
 
 subsubsection \<open>Conditional expectation for the induced map\<close>
 
 text \<open>Thanks to Birkhoff theorem, one can relate conditional expectations with respect to the invariant
 sigma algebra, for a map and for a corresponding induced map, as follows.\<close>
 
 proposition Invariants_cond_exp_induced_map:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "A \<in> sets M" "integrable M f"
   defines "MA \<equiv> restrict_space M A" and "TA \<equiv> induced_map A" and "fA \<equiv> induced_function A f"
   shows "AE x in MA. real_cond_exp MA (qmpt.Invariants MA TA) fA x
       = real_cond_exp M Invariants f x * real_cond_exp MA (qmpt.Invariants MA TA) (return_time_function A) x"
 proof -
   interpret A: fmpt MA TA unfolding MA_def TA_def by (rule induced_map_fmpt[OF assms(1)])
 
   have "integrable M fA" unfolding fA_def using induced_function_integral_nonergodic(1) assms by auto
   then have "integrable MA fA" unfolding MA_def
     by (metis assms(1) integrable_mult_indicator integrable_restrict_space sets.Int_space_eq2)
   then have a: "AE x in MA. (\<lambda>n. A.birkhoff_sum fA n x / n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants fA x"
     using A.birkhoff_theorem_AE_nonergodic by auto
 
   have "AE x in M. (\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
     using birkhoff_theorem_AE_nonergodic assms(2) by auto
   then have b: "AE x in MA. (\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
     unfolding MA_def by (metis (mono_tags, lifting) AE_restrict_space_iff assms(1) eventually_mono sets.Int_space_eq2)
 
   define phiA where "phiA = (\<lambda>x. return_time_function A x)"
   have "integrable M phiA" unfolding phiA_def using return_time_integrable by auto
   then have "integrable MA phiA" unfolding MA_def
     by (metis assms(1) integrable_mult_indicator integrable_restrict_space sets.Int_space_eq2)
   then have c: "AE x in MA. (\<lambda>n. A.birkhoff_sum (\<lambda>x. real(phiA x)) n x / n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants phiA x"
     using A.birkhoff_theorem_AE_nonergodic by auto
 
   have "A-recurrent_subset A \<in> null_sets M" using Poincare_recurrence_thm(1)[OF assms(1)] by auto
   then have "A - recurrent_subset A \<in> null_sets MA" unfolding MA_def
     by (metis Diff_subset assms(1) emeasure_restrict_space null_setsD1 null_setsD2 null_setsI sets.Int_space_eq2 sets_restrict_space_iff)
   then have "AE x in MA. x \<in> recurrent_subset A"
     by (simp add: AE_iff_null MA_def null_setsD2 set_diff_eq space_restrict_space2)
   moreover have "\<And>x. x \<in> recurrent_subset A \<Longrightarrow> phiA x > 0" unfolding phiA_def using return_time0 by fastforce
   ultimately have *: "AE x in MA. phiA x > 0" by auto
   have d: "AE x in MA. real_cond_exp MA A.Invariants phiA x > 0"
     by (rule A.real_cond_exp_gr_c, auto simp add: * \<open>integrable MA phiA\<close>)
 
   {
     fix x
     assume A: "(\<lambda>n. A.birkhoff_sum fA n x / n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants fA x"
        and B: "(\<lambda>n. birkhoff_sum f n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x"
        and C: "(\<lambda>n. A.birkhoff_sum (\<lambda>x. real(phiA x)) n x / n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants phiA x"
        and D: "real_cond_exp MA A.Invariants phiA x > 0"
     define R where "R = (\<lambda>n. A.birkhoff_sum phiA n x)"
 
     have D2: "ereal(real_cond_exp MA A.Invariants phiA x) > 0" using D by simp
     have "\<And>n. real(R n)/ n = A.birkhoff_sum (\<lambda>x. real(phiA x)) n x / n" unfolding R_def A.birkhoff_sum_def by auto
     moreover have "(\<lambda>n. A.birkhoff_sum (\<lambda>x. real(phiA x)) n x / n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants phiA x" using C by auto
     ultimately have Rnn: "(\<lambda>n. real(R n)/n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants phiA x" by presburger
 
     have "\<And>n. ereal(real(R n))/ n = ereal(A.birkhoff_sum (\<lambda>x. real(phiA x)) n x / n)" unfolding R_def A.birkhoff_sum_def by auto
     moreover have "(\<lambda>n. ereal(A.birkhoff_sum (\<lambda>x. real(phiA x)) n x / n)) \<longlonglongrightarrow> real_cond_exp MA A.Invariants phiA x" using C by auto
     ultimately have i: "(\<lambda>n. ereal(real(R n))/n) \<longlonglongrightarrow> real_cond_exp MA A.Invariants phiA x" by auto
     have ii: "(\<lambda>n. real n) \<longlonglongrightarrow> \<infinity>" by (rule id_nat_ereal_tendsto_PInf)
     have iii: "(\<lambda>n. ereal(real(R n))/n * real n) \<longlonglongrightarrow> \<infinity>" using tendsto_mult_ereal_PInf[OF i D2 ii] by simp
     have "\<And>n. n > 0 \<Longrightarrow> ereal(real(R n))/n * real n = R n" by auto
     then have "eventually (\<lambda>n. ereal(real(R n))/n * real n = R n) sequentially" using eventually_at_top_dense by auto
     then have "(\<lambda>n. real(R n)) \<longlonglongrightarrow> \<infinity>" using iii by (simp add: filterlim_cong)
     then have "(\<lambda>n. birkhoff_sum f (R n) x / (R n)) \<longlonglongrightarrow> real_cond_exp M Invariants f x" using limit_along_weak_subseq B by auto
     then have l: "(\<lambda>n. (birkhoff_sum f (R n) x / (R n)) * ((R n)/n)) \<longlonglongrightarrow> real_cond_exp M Invariants f x * real_cond_exp MA A.Invariants phiA x"
       by (rule tendsto_mult, simp add: Rnn)
     obtain N where N: "\<And>n. n > N \<Longrightarrow> R n > 0" using \<open>(\<lambda>n. real(R n)) \<longlonglongrightarrow> \<infinity>\<close>
       by (metis (full_types) eventually_at_top_dense filterlim_iff filterlim_weak_subseq)
     then have "\<And>n. n > N \<Longrightarrow> (birkhoff_sum f (R n) x / (R n)) * ((R n)/n) = birkhoff_sum f (R n) x / n"
       by auto
     then have "eventually (\<lambda>n. (birkhoff_sum f (R n) x / (R n)) * ((R n)/n) = birkhoff_sum f (R n) x / n) sequentially"
       by simp
     with tendsto_cong[OF this] have main_limit: "(\<lambda>n. birkhoff_sum f (R n) x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x * real_cond_exp MA A.Invariants phiA x"
       using l by auto
     have "\<And>n. birkhoff_sum f (R n) x = A.birkhoff_sum fA n x"
       unfolding R_def fA_def phiA_def TA_def using induced_function_birkhoff_sum[OF assms(1)] by simp
     then have "\<And>n. birkhoff_sum f (R n) x /n = A.birkhoff_sum fA n x / n" by simp
     then have "(\<lambda>n. A.birkhoff_sum fA n x / n) \<longlonglongrightarrow> real_cond_exp M Invariants f x * real_cond_exp MA A.Invariants phiA x"
       using main_limit by presburger
     then have "real_cond_exp MA A.Invariants fA x = real_cond_exp M Invariants f x * real_cond_exp MA A.Invariants phiA x"
       using A LIMSEQ_unique by auto
   }
   then show ?thesis using a b c d unfolding phiA_def by auto
 qed
 
 corollary Invariants_cond_exp_induced_map_0:
   fixes f::"'a \<Rightarrow> real"
   assumes [measurable]: "A \<in> sets M" "integrable M f" and "AE x in M. real_cond_exp M Invariants f x = 0"
   defines "MA \<equiv> restrict_space M A" and "TA \<equiv> induced_map A" and "fA \<equiv> induced_function A f"
   shows "AE x in MA. real_cond_exp MA (qmpt.Invariants MA TA) fA x = 0"
 proof -
   have "AE x in MA. real_cond_exp M Invariants f x = 0" unfolding MA_def
     apply (subst AE_restrict_space_iff) using assms(3) by auto
   then show ?thesis unfolding MA_def TA_def fA_def using Invariants_cond_exp_induced_map[OF assms(1) assms(2)]
     by auto
 qed
 
 end (*of locale fmpt*)
 end (*of Invariants.thy*)
 
diff --git a/thys/Ergodic_Theory/Normalizing_Sequences.thy b/thys/Ergodic_Theory/Normalizing_Sequences.thy
--- a/thys/Ergodic_Theory/Normalizing_Sequences.thy
+++ b/thys/Ergodic_Theory/Normalizing_Sequences.thy
@@ -1,1448 +1,1448 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     License: BSD
 *)
 
 section \<open>Normalizing sequences\<close>
 
 theory Normalizing_Sequences
   imports Transfer_Operator Asymptotic_Density
 begin
 
 text \<open>In this file, we prove the main result in~\cite{gouezel_normalizing_sequences}: in a
 conservative system, if a renormalized sequence $S_n f/B_n$ converges in distribution towards
 a limit which is not a Dirac mass at $0$, then $B_n$ can not grow exponentially fast. We also prove
 the easier result that, in a probability preserving system, normalizing sequences grow at most
 polynomially.\<close>
 
 
 subsection \<open>Measure of the preimages of disjoint sets.\<close>
 
 text \<open>We start with a general result about conservative maps:
 If $A_n$ are disjoint sets, and $P$ is a finite mass measure which is absolutely continuous
 with respect to $M$, then $T^{-n}A_n$ is most often small: $P(T^{-n} A_n)$ tends to $0$
 in Cesaro average. The proof is written in terms of densities and positive transfer operators,
 so we first write it in ennreal.\<close>
 
 theorem (in conservative) disjoint_sets_emeasure_Cesaro_tendsto_zero:
   fixes P::"'a measure" and A::"nat \<Rightarrow> 'a set"
   assumes [measurable]: "\<And>n. A n \<in> sets M"
       and "disjoint_family A"
           "absolutely_continuous M P" "sets P = sets M"
           "emeasure P (space M) \<noteq> \<infinity>"
   shows "(\<lambda>n. (\<Sum>i<n. emeasure P (space M \<inter> (T^^i)-`(A i)))/n) \<longlonglongrightarrow> 0"
 proof (rule order_tendstoI)
   fix delta::ennreal assume "delta > 0"
 
   have "\<exists>epsilon. epsilon \<noteq> 0 \<and> epsilon \<noteq> \<infinity> \<and> 4 * epsilon < delta"
     apply (cases delta)
      apply (rule exI[of _ "delta/5"]) using \<open>delta>0\<close> apply (auto simp add: ennreal_divide_eq_top_iff ennreal_divide_numeral numeral_mult_ennreal intro!: ennreal_lessI)
     apply (rule exI[of _ 1]) by auto
   then obtain epsilon where "epsilon \<noteq> 0" "epsilon \<noteq> \<infinity>" "4 * epsilon < delta"
     by auto
   then have "epsilon > 0" using not_gr_zero by blast
 
   define L::ennreal where "L = (1/epsilon) * (1+ emeasure P (space M))"
   have "L \<noteq> \<infinity>"
     unfolding L_def using assms(5) divide_ennreal_def ennreal_mult_eq_top_iff \<open>epsilon \<noteq> 0\<close> by auto
   have "L \<noteq> 0"
     unfolding L_def using \<open>epsilon \<noteq> \<infinity>\<close> by (simp add: ennreal_divide_eq_top_iff)
   have "emeasure P (space M) \<le> epsilon * L" unfolding L_def
     using \<open>epsilon \<noteq> 0\<close> \<open>epsilon \<noteq> \<infinity>\<close> \<open>emeasure P (space M) \<noteq> \<infinity>\<close>
     apply (cases epsilon)
     apply (metis (no_types, lifting) add.commute add.right_neutral add_left_mono ennreal_divide_times infinity_ennreal_def mult.left_neutral mult_divide_eq_ennreal zero_le_one)
     by simp
   then have "emeasure P (space M) / L \<le> epsilon"
     using \<open>L \<noteq> 0\<close> \<open>L \<noteq> \<infinity>\<close> by (metis divide_le_posI_ennreal mult.commute not_gr_zero)
   then have "c * (emeasure P (space M)/L) \<le> c * epsilon" for c by (rule mult_left_mono, simp)
 
 
   text \<open>We introduce the density of $P$.\<close>
   define f where "f = RN_deriv M P"
   have [measurable]: "f \<in> borel_measurable M"
     unfolding f_def by auto
   have [simp]: "P = density M f"
     unfolding f_def apply (rule density_RN_deriv[symmetric]) using assms by auto
   have "space P = space M"
     by auto
   interpret Pc: finite_measure P
     apply standard unfolding \<open>space P = space M\<close> using assms(5) by auto
 
   have *: "AE x in P. eventually (\<lambda>n. (\<Sum>i<n. (nn_transfer_operator^^i) f x) > L * f x) sequentially"
   proof -
     have "AE x in M. f x \<noteq> \<infinity>"
       unfolding f_def apply (intro RN_deriv_finite Pc.sigma_finite_measure)
       unfolding \<open>space P = space M\<close> using assms by auto
     moreover have "AE x in M. f x > 0 \<longrightarrow> (\<Sum>n. (nn_transfer_operator^^n) f x) = \<infinity>"
       using recurrence_series_infinite_transfer_operator by auto
     ultimately have "AE x in M. f x > 0 \<longrightarrow> ((\<Sum>n. (nn_transfer_operator^^n) f x) = \<infinity> \<and> f x \<noteq> \<infinity>)"
       by auto
     then have AEP: "AE x in P. (\<Sum>n. (nn_transfer_operator^^n) f x) = \<infinity> \<and> f x \<noteq> \<infinity>"
       unfolding \<open>P = density M f\<close> using AE_density[of f M] by auto
     moreover have "eventually (\<lambda>n. (\<Sum>i<n. (nn_transfer_operator^^i) f x) > L * f x) sequentially"
       if "(\<Sum>n. (nn_transfer_operator^^n) f x) = \<infinity> \<and> f x \<noteq> \<infinity>" for x
     proof -
       have "(\<lambda>n. (\<Sum>i<n. (nn_transfer_operator^^i) f x)) \<longlonglongrightarrow> (\<Sum>i. (nn_transfer_operator^^i) f x)"
         by (simp add: summable_LIMSEQ)
       moreover have "(\<Sum>i. (nn_transfer_operator^^i) f x) > L * f x"
         using that \<open>L \<noteq> \<infinity>\<close> by (auto simp add: ennreal_mult_less_top top.not_eq_extremum)
       ultimately show ?thesis
         by (rule order_tendstoD(1))
     qed
     ultimately show ?thesis
       by auto
   qed
   have "\<exists>U N. U \<in> sets P \<and> (\<forall>n \<ge> N. \<forall>x \<in> U. (\<Sum>i<n. (nn_transfer_operator^^i) f x) > L * f x) \<and> emeasure P (space P - U) < epsilon"
     apply (rule Pc.Egorov_lemma[OF _ *]) using \<open>epsilon\<noteq>0\<close> by (auto simp add: zero_less_iff_neq_zero)
   then obtain U N1 where [measurable]: "U \<in> sets M" and U: "emeasure P (space M - U) < epsilon"
                           "\<And>n x. n \<ge> N1 \<Longrightarrow> x \<in> U \<Longrightarrow> L * f x < (\<Sum>i<n. (nn_transfer_operator^^i) f x)"
     unfolding \<open>sets P = sets M\<close> \<open>space P = space M\<close> by blast
   have "U \<subseteq> space M" by (rule sets.sets_into_space, simp)
 
   define K where "K = N1 + 1"
   have "K \<ge> N1" "K \<ge> 1" unfolding K_def by auto
   have *: "K * emeasure P (space M) / epsilon \<noteq> \<infinity>"
     using \<open>emeasure P (space M) \<noteq> \<infinity>\<close> \<open>epsilon \<noteq> 0\<close> ennreal_divide_eq_top_iff ennreal_mult_eq_top_iff by auto
   obtain N2::nat where N2: "N2 \<ge> K * emeasure P (space M) / epsilon"
     using ennreal_archimedean[OF *] by auto
   define N where "N = 2 * K + N2"
   have "(\<Sum>k\<in>{..<n}. emeasure P (space M \<inter> (T^^k)-`(A k))) / n < delta" if "n \<ge> N" for n
   proof -
     have "n \<ge> 2 * K" "of_nat n \<ge> ((of_nat N2)::ennreal)" using that unfolding N_def by auto
     then have "n \<ge> K * emeasure P (space M) / epsilon"
       using N2 order_trans by blast
     then have "K * emeasure P (space M) \<le> n * epsilon"
       using \<open>epsilon > 0\<close> \<open>epsilon \<noteq> \<infinity>\<close>
       by (smt divide_ennreal_def divide_right_mono_ennreal ennreal_mult_divide_eq ennreal_mult_eq_top_iff infinity_ennreal_def mult.commute not_le order_le_less)
     have "n \<ge> 1" using \<open>n \<ge> 2 * K\<close> \<open>K \<ge> 1\<close> by auto
 
     have *: "((\<Sum>k\<in>{K..<n-K}. indicator (A k) ((T^^k) x))::ennreal) \<le> (\<Sum>i\<in>{K..<n}. indicator (A (i-j)) ((T^^(i-j)) x))"
       if "j < K" for j x
     proof -
       have "(\<Sum>k \<in> {K..<n-K}. indicator (A k) ((T^^k) x)) \<le> ((\<Sum>k\<in>{K-j..<n-j}. indicator (A k) ((T^^k) x))::ennreal)"
         apply (rule sum_mono2) using \<open>j < K\<close> by auto
       also have "... = (\<Sum>i\<in>{K..<n}. indicator (A (i-j)) ((T^^(i-j)) x))"
         apply (rule sum.reindex_bij_betw[symmetric], rule bij_betw_byWitness[of _ "\<lambda>x. x+j"]) using \<open>j < K\<close> by auto
       finally show ?thesis by simp
     qed
 
     have "L * (\<Sum> k \<in> {K..<n-K}. emeasure P (U \<inter> (T^^k)-`(A k))) = L * (\<Sum> k \<in> {K..<n-K}.(\<integral>\<^sup>+x. indicator (U \<inter> (T^^k)-`(A k)) x \<partial>P))"
       by auto
     also have "... = (\<Sum> k \<in> {K..<n-K}. (\<integral>\<^sup>+x. L * indicator (U \<inter> (T^^k)-`(A k)) x \<partial>P))"
       unfolding sum_distrib_left by (intro sum.cong nn_integral_cmult[symmetric], auto)
     also have "... = (\<Sum> k \<in> {K..<n-K}. (\<integral>\<^sup>+x. f x * (L * indicator (U \<inter> (T^^k)-`(A k)) x) \<partial>M))"
       unfolding \<open>P = density M f\<close> by (intro sum.cong nn_integral_density, auto)
     also have "... = (\<Sum> k \<in> {K..<n-K}. (\<integral>\<^sup>+x. f x * L * indicator U x * indicator (A k) ((T^^k) x) \<partial>M))"
       by (intro sum.cong nn_integral_cong, auto simp add: algebra_simps indicator_def)
     also have "... \<le> (\<Sum> k \<in> {K..<n-K}. (\<integral>\<^sup>+x. (\<Sum>j \<in> {..<K}. (nn_transfer_operator^^j) f x) * indicator (A k) ((T^^k) x) \<partial>M))"
       apply (intro sum_mono nn_integral_mono)
       using U(2)[OF \<open>K \<ge> N1\<close>] unfolding indicator_def using less_imp_le by (auto simp add: algebra_simps)
     also have "... = (\<integral>\<^sup>+x. (\<Sum>k\<in>{K..<n-K}. (\<Sum>j \<in> {..<K}. (nn_transfer_operator^^j) f x * indicator (A k) ((T^^k) x))) \<partial>M)"
       apply (subst nn_integral_sum, simp) unfolding sum_distrib_right by auto
     also have "... = (\<integral>\<^sup>+x. (\<Sum>j \<in> {..<K}. (\<Sum>k\<in>{K..<n-K}. (nn_transfer_operator^^j) f x * indicator (A k) ((T^^k) x))) \<partial>M)"
       by (rule nn_integral_cong, rule sum.swap)
     also have "... = (\<Sum>j \<in> {..<K}. (\<integral>\<^sup>+x. (nn_transfer_operator^^j) f x * (\<Sum>k\<in>{K..<n-K}. indicator (A k) ((T^^k) x)) \<partial>M))"
       apply (subst nn_integral_sum, simp) unfolding sum_distrib_left by auto
     also have "... \<le> (\<Sum>j \<in> {..<K}. (\<integral>\<^sup>+x. (nn_transfer_operator^^j) f x * (\<Sum>i\<in>{K..<n}. indicator (A (i-j)) ((T^^(i-j)) x)) \<partial>M))"
       apply (rule sum_mono, rule nn_integral_mono) using * by (auto simp add: mult_left_mono)
     also have "... = (\<Sum>i\<in>{K..<n}. (\<Sum>j \<in> {..<K}. (\<integral>\<^sup>+x. (nn_transfer_operator^^j) f x * indicator (A (i-j)) ((T^^(i-j)) x) \<partial>M)))"
       unfolding sum_distrib_left using sum.swap by (subst nn_integral_sum, auto)
     also have "... = (\<Sum>i\<in>{K..<n}. (\<Sum>j \<in> {..<K}. (\<integral>\<^sup>+x. f x * indicator (A (i-j)) ((T^^(i-j)) ((T^^j) x)) \<partial>M)))"
       by (subst nn_transfer_operator_intg_Tn, auto)
     also have "... = (\<Sum>i\<in>{K..<n}. (\<integral>\<^sup>+x. f x * (\<Sum>j \<in> {..<K}. indicator (A (i-j)) ((T^^(i-j)) ((T^^j) x))) \<partial>M))"
       unfolding sum_distrib_left by (subst nn_integral_sum, auto)
     also have "... = (\<Sum>i\<in>{K..<n}. (\<integral>\<^sup>+x. (\<Sum>j \<in> {..<K}. indicator (A (i-j)) ((T^^((i-j)+j)) x)) \<partial>P))"
       unfolding \<open>P = density M f\<close> funpow_add comp_def apply (rule sum.cong, simp) by (rule nn_integral_density[symmetric], auto)
     also have "... = (\<Sum>i\<in>{K..<n}. (\<integral>\<^sup>+x. (\<Sum>j \<in> {..<K}. indicator (A (i-j)) ((T^^i) x)) \<partial>P))"
       by auto
     also have "... \<le> (\<Sum>i\<in>{K..<n}. (\<integral>\<^sup>+x. (1::ennreal) \<partial>P))"
       apply (rule sum_mono) apply (rule nn_integral_mono) apply (rule disjoint_family_indicator_le_1)
       using assms(2) apply (auto simp add: disjoint_family_on_def)
       by (metis Int_iff diff_diff_cancel equals0D le_less le_trans)
     also have "... \<le> n * emeasure P (space M)"
       using assms(4) by (auto intro!: mult_right_mono)
     finally have *: "L * (\<Sum> k \<in> {K..<n-K}. emeasure P (U \<inter> (T^^k)-`(A k))) \<le> n * emeasure P (space M)"
       by simp
     have Ineq: "(\<Sum> k \<in> {K..<n-K}. emeasure P (U \<inter> (T^^k)-`(A k))) \<le> n * emeasure P (space M) / L"
       using divide_right_mono_ennreal[OF *, of L] \<open>L \<noteq> 0\<close>
       by (metis (no_types, lifting) \<open>L \<noteq> \<infinity>\<close> ennreal_mult_divide_eq infinity_ennreal_def mult.commute)
 
     have I: "{..<K} \<union> {K..<n-K} \<union> {n-K..<n} = {..<n}" using \<open>n \<ge> 2 * K\<close> by auto
     have "(\<Sum>k\<in>{..<n}. emeasure P (space M \<inter> (T^^k)-`(A k))) \<le> (\<Sum>k\<in>{..<n}. emeasure P (U \<inter> (T^^k)-`(A k)) + epsilon)"
     proof (rule sum_mono)
       fix k
       have "emeasure P (space M \<inter> (T^^k)-`(A k)) \<le> emeasure P ((U \<inter> (T^^k)-`(A k)) \<union> (space M - U))"
         by (rule emeasure_mono, auto)
       also have "... \<le> emeasure P (U \<inter> (T^^k)-`(A k)) + emeasure P (space M - U)"
         by (rule emeasure_subadditive, auto)
       also have "... \<le> emeasure P (U \<inter> (T^^k)-`(A k)) + epsilon"
         using U(1) by auto
       finally show "emeasure P (space M \<inter> (T ^^ k) -` A k) \<le> emeasure P (U \<inter> (T ^^ k) -` A k) + epsilon"
         by simp
     qed
     also have "... = (\<Sum>k\<in>{..<K} \<union> {K..<n-K} \<union> {n-K..<n}. emeasure P (U \<inter> (T^^k)-`(A k))) + (\<Sum>k\<in>{..<n}. epsilon)"
       unfolding sum.distrib I by simp
     also have "... = (\<Sum>k\<in>{..<K}. emeasure P (U \<inter> (T^^k)-`(A k))) + (\<Sum>k\<in>{K..<n-K}. emeasure P (U \<inter> (T^^k)-`(A k)))
                       + (\<Sum>k\<in>{n-K..<n}. emeasure P (U \<inter> (T^^k)-`(A k))) + n * epsilon"
       apply (subst sum.union_disjoint) apply simp apply simp using \<open>n \<ge> 2 * K\<close>
       apply (simp add: ivl_disj_int_one(2) ivl_disj_un_one(2))
       by (subst sum.union_disjoint, auto)
     also have "... \<le> (\<Sum>k\<in>{..<K}. emeasure P (space M)) + n * emeasure P (space M) / L + (\<Sum>k\<in>{n-K..<n}. emeasure P (space M)) + n * epsilon"
       apply (intro add_mono sum_mono Ineq emeasure_mono) using \<open>U \<subseteq> space M\<close> by auto
     also have "... = K * emeasure P (space M) + n * emeasure P (space M)/L + K * emeasure P (space M) + n * epsilon"
       using \<open>n \<ge> 2 * K\<close> by auto
     also have "... \<le> n * epsilon + n * epsilon + n * epsilon + n * epsilon"
       apply (intro add_mono)
       using \<open>K * emeasure P (space M) \<le> n * epsilon\<close> \<open>of_nat n * (emeasure P (space M)/L) \<le> of_nat n * epsilon\<close>
       ennreal_times_divide by auto
     also have "... = n * (4 * epsilon)"
       by (metis (no_types, lifting) add.assoc distrib_right mult.left_commute mult_2 numeral_Bit0)
     also have "... < n * delta"
       using \<open>4 * epsilon < delta\<close> \<open>n \<ge> 1\<close>
       by (simp add: ennreal_mult_strict_left_mono ennreal_of_nat_eq_real_of_nat)
     finally show ?thesis
       apply (subst divide_less_ennreal)
       using \<open>n \<ge> 1\<close> of_nat_less_top by (auto simp add: mult.commute)
   qed
   then show "eventually (\<lambda>n. (\<Sum>k\<in>{..<n}. emeasure P (space M \<inter> (T^^k)-`(A k))) / n < delta) sequentially"
     unfolding eventually_sequentially by auto
 qed (simp)
 
 text \<open>We state the previous theorem using measures instead of emeasures. This is clearly
 equivalent, but one has to play with ennreal carefully to prove it.\<close>
 
 theorem (in conservative) disjoint_sets_measure_Cesaro_tendsto_zero:
   fixes P::"'a measure" and A::"nat \<Rightarrow> 'a set"
   assumes [measurable]: "\<And>n. A n \<in> sets M"
       and "disjoint_family A"
           "absolutely_continuous M P" "sets P = sets M"
           "emeasure P (space M) \<noteq> \<infinity>"
   shows "(\<lambda>n. (\<Sum>i<n. measure P (space M \<inter> (T^^i)-`(A i)))/n) \<longlonglongrightarrow> 0"
 proof -
   have "space P = space M"
     using assms(4) sets_eq_imp_space_eq by blast
   moreover have "emeasure P Q \<le> emeasure P (space P)" for Q
     by (simp add: emeasure_space)
   ultimately have [simp]: "emeasure P Q \<noteq> \<top>" for Q
     using \<open>emeasure P (space M) \<noteq> \<infinity>\<close> neq_top_trans by auto
   have *: "ennreal ((\<Sum>i<n. measure P (space M \<inter> (T^^i)-`(A i)))/n) = (\<Sum>i<n. emeasure P (space M \<inter> (T^^i)-`(A i)))/n" if "n > 0" for n
     apply (subst divide_ennreal[symmetric])
       apply (auto intro!: sum_nonneg that simp add: ennreal_of_nat_eq_real_of_nat[symmetric])
     apply(subst sum_ennreal[symmetric], simp)
     apply (subst emeasure_eq_ennreal_measure) by auto
   have "eventually (\<lambda>n. ennreal ((\<Sum>i<n. measure P (space M \<inter> (T^^i)-`(A i)))/n) = (\<Sum>i<n. emeasure P (space M \<inter> (T^^i)-`(A i)))/n) sequentially"
     unfolding eventually_sequentially apply (rule exI[of _ 1]) using * by auto
   then have *: "(\<lambda>n. ennreal ((\<Sum>i<n. measure P (space M \<inter> (T^^i)-`(A i)))/n)) \<longlonglongrightarrow> ennreal 0"
     using disjoint_sets_emeasure_Cesaro_tendsto_zero[OF assms] tendsto_cong by force
   show ?thesis
     apply (subst tendsto_ennreal_iff[symmetric]) using * apply auto
     unfolding eventually_sequentially apply (rule exI[of _ 1])
     by (auto simp add: divide_simps intro!: sum_nonneg)
 qed
 
 text \<open>As convergence to $0$ in Cesaro mean is equivalent to convergence to $0$ along a density
 one sequence, we obtain the equivalent formulation of the previous theorem.\<close>
 
 theorem (in conservative) disjoint_sets_measure_density_one_tendsto_zero:
   fixes P::"'a measure" and A::"nat \<Rightarrow> 'a set"
   assumes [measurable]: "\<And>n. A n \<in> sets M"
       and "disjoint_family A"
           "absolutely_continuous M P" "sets P = sets M"
           "emeasure P (space M) \<noteq> \<infinity>"
   shows "\<exists>B. lower_asymptotic_density B = 1 \<and> (\<lambda>n. measure P (space M \<inter> (T^^n)-`(A n)) * indicator B n) \<longlonglongrightarrow> 0"
 by (rule cesaro_imp_density_one[OF _ disjoint_sets_measure_Cesaro_tendsto_zero[OF assms]], simp)
 
 
 subsection \<open>Normalizing sequences do not grow exponentially in conservative systems\<close>
 
 text \<open>We prove the main result in~\cite{gouezel_normalizing_sequences}: in a
 conservative system, if a renormalized sequence $S_n f/B_n$ converges in distribution towards
 a limit which is not a Dirac mass at $0$, then $B_n$ can not grow exponentially fast. The proof
 is expressed in the following locale. The main theorem is Theorem~\verb+subexponential_growth+
 below. To prove it, we need several preliminary estimates.\<close>
 
 text \<open>We will use the fact that a real random variables which is not the Dirac mass at $0$
 gives positive mass to a set separated away from $0$.\<close>
 
 lemma (in real_distribution) not_Dirac_0_imp_positive_mass_away_0:
   assumes "prob {0} < 1"
   shows "\<exists>a. a > 0 \<and> prob {x. abs(x) > a} > 0"
 proof -
   have "1 = prob UNIV"
     using prob_space by auto
   also have "... = prob {0} + prob (UNIV -{0})"
     by (subst finite_measure_Union[symmetric], auto)
   finally have "0 < prob (UNIV -{0})"
     using assms by auto
   also have "... \<le> prob (\<Union>n::nat. {x. abs(x)>(1/2)^n})"
     apply (rule finite_measure_mono)
     by (auto, meson one_less_numeral_iff reals_power_lt_ex semiring_norm(76) zero_less_abs_iff)
   finally have "prob (\<Union>n::nat. {x. abs(x)>(1/2)^n}) \<noteq> 0"
     by simp
   then have "\<exists>n. prob {x. abs(x)>(1/2)^n} \<noteq> 0"
     using measure_countably_zero[of "\<lambda>n. {x. abs(x)>(1/2)^n}"] by force
   then obtain N where N: "prob {x. abs(x) > (1/2)^N} \<noteq> 0"
     by blast
   show ?thesis
     apply (rule exI[of _ "(1/2)^N"]) using N by (auto simp add: zero_less_measure_iff)
 qed
 
 locale conservative_limit =
   conservative M + PS: prob_space P + PZ: real_distribution Z
     for M::"'a measure" and P::"'a measure" and Z::"real measure" +
   fixes f g::"'a \<Rightarrow> real" and B::"nat \<Rightarrow> real"
   assumes PabsM: "absolutely_continuous M P"
       and Bpos: "\<And>n. B n > 0"
       and M [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M" "sets P = sets M"
       and non_trivial: "PZ.prob {0} < 1"
       and conv: "weak_conv_m (\<lambda>n. distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) Z"
 begin
 
 text \<open>For measurability statements, we want every question about $Z$ or $P$ to reduce to a
 question about Borel sets of $M$. We add in the next lemma all the statements that are needed
 so that this happens automatically.\<close>
 lemma PSZ [simp, measurable_cong]:
   "space P = space M"
   "h \<in> borel_measurable P \<longleftrightarrow> h \<in> borel_measurable M"
   "A \<in> sets P \<longleftrightarrow> A \<in> sets M"
 using M sets_eq_imp_space_eq real_distribution_def by auto
 
 text \<open>The first nontrivial upper bound is the following lemma, asserting that $B_{n+1}$ can not
 be much larger than $\max B_i$ for $i \leq n$. This is proved by saying that $S_{n+1} f = f +
 (S_n f) \circ T$, and we know that $S_n f$ is not too large on a set of very large measure, so
 the same goes for $(S_n f) \circ T$ by a non-singularity argument. Excepted that the measure $P$
 does not have to be nonsingular for the map $T$, so one has to tweak a little bit this idea,
 using transfer operators and conservativity. This is easier to do when the density of $P$ is
 bounded by $1$, so we first give the proof under this assumption, and then we reduce to this
 case by replacing $M$ with $M+P$ in the second lemma below.\<close>
 
 text \<open>First, let us prove the lemma assuming that the density $h$ of $P$ is bounded by $1$.\<close>
 
 lemma upper_bound_C_aux:
   assumes "P = density M h" "\<And>x. h x \<le> 1"
       and [measurable]: "h \<in> borel_measurable M"
   shows "\<exists>C\<ge>1. \<forall>n. B (Suc n) \<le> C * Max {B i|i. i \<le> n}"
 proof -
   obtain a0 where a0: "a0 > 0" "PZ.prob {x. abs(x) > a0} > 0"
     using PZ.not_Dirac_0_imp_positive_mass_away_0[OF non_trivial] by blast
   define a where "a = a0/2"
   have "a > 0" using \<open>a0 > 0\<close> unfolding a_def by auto
   define alpha where "alpha = PZ.prob {x. abs (x) > a0}/4"
   have "alpha > 0" unfolding alpha_def using a0 by auto
   have "PZ.prob {x. abs (x) > 2 * a} > 3 * alpha"
     using a0 unfolding a_def alpha_def by auto
 
   text \<open>First step: choose $K$ such that, with probability $1-\alpha$, one has
   $\sum_{1 \leq k < K} h(T^k x) \geq 1$. This follows directly from conservativity.\<close>
   have "\<exists>K. K \<ge> 1 \<and> PS.prob {x \<in> space M. (\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1} \<ge> 1 - alpha"
   proof -
     have *: "AE x in P. eventually (\<lambda>n. (\<Sum>i<n. h ((T^^i) x)) > 2) sequentially"
     proof -
       have "AE x in M. h x > 0 \<longrightarrow> (\<Sum>i. h ((T^^i) x)) = \<infinity>"
         using recurrence_series_infinite by auto
       then have AEP: "AE x in P. (\<Sum>i. h ((T^^i) x)) = \<infinity>"
         unfolding \<open>P = density M h\<close> using AE_density[of h M] by auto
       moreover have "eventually (\<lambda>n. (\<Sum>i<n. h ((T^^i) x)) > 2) sequentially"
         if "(\<Sum>i. h ((T^^i) x)) = \<infinity>" for x
       proof -
         have "(\<lambda>n. (\<Sum>i<n. h ((T^^i) x))) \<longlonglongrightarrow> (\<Sum>i. h ((T^^i) x))"
           by (simp add: summable_LIMSEQ)
         moreover have "(\<Sum>i. h ((T^^i) x)) > 2"
           using that by auto
         ultimately show ?thesis
           by (rule order_tendstoD(1))
       qed
       ultimately show ?thesis
         by auto
     qed
     have "\<exists>U N. U \<in> sets P \<and> (\<forall>n \<ge> N. \<forall>x \<in> U. (\<Sum>i<n. h ((T^^i) x)) > 2) \<and> emeasure P (space P - U) < alpha"
       apply (rule PS.Egorov_lemma)
         apply measurable using M(3) measurable_ident_sets apply blast
       using * \<open>alpha > 0\<close> by auto
     then obtain U N1 where [measurable]: "U \<in> sets M" and U: "emeasure P (space M - U) < alpha"
                             "\<And>n x. n \<ge> N1 \<Longrightarrow> x \<in> U \<Longrightarrow> 2 < (\<Sum>i<n. h ((T^^i) x))"
       by auto
     have "U \<subseteq> space M" by (rule sets.sets_into_space, simp)
     define K where "K = N1+1"
     then have "K \<ge> 1" by auto
     have Ux: "(\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1" if "x \<in> U" for x
     proof -
       have *: "1 < t" if "2 < 1 + t" for t::ennreal
         apply (cases t) using that apply auto
         by (metis ennreal_add_left_cancel_less ennreal_less_iff ennreal_numeral le_numeral_extra(1) numeral_One one_add_one)
 
       have "2 < (\<Sum>i \<in> {..<K}. h ((T^^i) x))"
         apply (rule U(2)) unfolding K_def using that by auto
       also have "... = (\<Sum>i \<in> {0}. h ((T^^i) x)) + (\<Sum>i \<in> {1..<K}. h ((T^^i) x))"
         apply (subst sum.union_disjoint[symmetric]) apply simp apply simp apply simp
         apply (rule sum.cong) using \<open>K \<ge> 1\<close> by auto
       also have "... = h x + (\<Sum>i \<in> {1..<K}. h ((T^^i) x))"
         by auto
       also have "... \<le> 1 + (\<Sum>i \<in> {1..<K}. h ((T^^i) x))"
         using assms by auto
       finally show ?thesis using less_imp_le[OF *] by auto
     qed
     have "PS.prob {x \<in> space M. (\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1} \<ge> 1 - alpha"
     proof -
       have "PS.prob (space P - U) < alpha"
         using U(1) by (simp add: PS.emeasure_eq_measure ennreal_less_iff)
       then have "1 - alpha < PS.prob U"
         using PS.prob_compl by auto
       also have "... \<le> PS.prob {x \<in> space M. (\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1}"
         apply (rule PS.finite_measure_mono) using Ux sets.sets_into_space[OF \<open>U \<in> sets M\<close>] by auto
       finally show ?thesis by simp
     qed
     then show ?thesis using \<open>K \<ge> 1\<close> by auto
   qed
   then obtain K where K: "K \<ge> 1" "PS.prob {x \<in> space M. (\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1} \<ge> 1 - alpha"
     by blast
 
   text \<open>Second step: obtain $D$ which controls the tails of the $K$ first Birkhoff sums of $f$.\<close>
   have "\<exists>D. PS.prob {x \<in> space M. \<forall>k < K. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<le> D} \<ge> 1 - alpha"
   proof -
     have D: "\<exists>D. PS.prob {x \<in> space P. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D} < alpha/K \<and> D \<ge> 1" for k
       apply (rule PS.random_variable_small_tails) using \<open>K \<ge> 1\<close> \<open>alpha > 0\<close> by auto
     have "\<exists>D. \<forall>k. PS.prob {x \<in> space P. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D k} < alpha/K \<and> D k \<ge> 1"
       apply (rule choice) using D by auto
     then obtain D where D: "\<And>k. PS.prob {x \<in> space P. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D k} < alpha/K"
       by blast
     define D0 where "D0 = Max (D`{..K})"
     have "PS.prob {x \<in> space M. \<forall>k < K. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<le> D0} \<ge> 1 - alpha"
     proof -
       have D1: "PS.prob {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0} < alpha/K" if "k \<le> K" for k
       proof -
         have "D k \<le> D0"
           unfolding D0_def apply (rule Max_ge) using that by auto
         have "PS.prob {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0}
                 \<le> PS.prob {x \<in> space P. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D k}"
           apply (rule PS.finite_measure_mono) using \<open>D k \<le> D0\<close> by auto
         then show ?thesis using D[of k] by auto
       qed
       have "PS.prob (\<Union>k\<in> {..<K}. {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0}) \<le>
               (\<Sum>k \<in> {..<K}. PS.prob {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0})"
         by (rule PS.finite_measure_subadditive_finite, auto)
       also have "... \<le> (\<Sum>k \<in> {..<K}. alpha/K)"
         apply (rule sum_mono) using less_imp_le[OF D1] by auto
       also have "... = alpha"
         using \<open>K \<ge> 1\<close> by auto
       finally have "PS.prob (\<Union>k\<in> {..<K}. {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0}) \<le> alpha"
         by simp
       then have "1 - alpha \<le> 1 - PS.prob (\<Union>k\<in> {..<K}. {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0})"
         by simp
       also have "... = PS.prob (space P - (\<Union>k\<in> {..<K}. {x \<in> space M. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<ge> D0}))"
         by (rule PS.prob_compl[symmetric], auto)
       also have "... \<le> PS.prob {x \<in> space M. \<forall>k < K. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<le> D0}"
         by (rule PS.finite_measure_mono, auto)
       finally show ?thesis by simp
     qed
     then show ?thesis by blast
   qed
   then obtain D where D: "PS.prob {x \<in> space M. \<forall>k < K. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<le> D} \<ge> 1 - alpha"
     by blast
 
   text \<open>Third step: obtain $\epsilon$ small enough so that, for any set $U$ with probability less
   than $\epsilon$ and for any $k\leq K$, one has $\int_U \hat T^k h < \delta$, where $\delta$ is
   very small.\<close>
   define delta where "delta = alpha/(2 * K)"
   then have "delta > 0" using \<open>alpha > 0\<close> \<open>K \<ge> 1\<close> by auto
   have "\<exists>epsilon > (0::real). \<forall>U \<in> sets P. \<forall>k \<le> K. emeasure P U < epsilon \<longrightarrow> (\<integral>\<^sup>+x\<in>U. ((nn_transfer_operator^^k) h) x \<partial>P) \<le> delta"
   proof -
     have *: "\<exists>epsilon>(0::real). \<forall>U\<in>sets P. emeasure P U < epsilon \<longrightarrow> (\<integral>\<^sup>+x\<in>U. ((nn_transfer_operator^^k) h) x \<partial>P) < delta"
       for k
     proof (rule small_nn_integral_on_small_sets[OF _ \<open>0 < delta\<close>])
       have "(\<integral>\<^sup>+x. ((nn_transfer_operator^^k) h) x \<partial>P) = (\<integral>\<^sup>+x. h x * ((nn_transfer_operator^^k) h) x \<partial>M)"
         unfolding \<open>P = density M h\<close> by (rule nn_integral_density, auto)
       also have "... \<le> (\<integral>\<^sup>+x. 1 * ((nn_transfer_operator^^k) h) x \<partial>M)"
         apply (intro nn_integral_mono mult_right_mono) using assms(2) by auto
       also have "... = (\<integral>\<^sup>+x. 1 * h x \<partial>M)"
         by (rule nn_transfer_operator_intTn_g, auto)
       also have "... = emeasure P (space M)"
         using PS.emeasure_space_1 by (simp add: emeasure_density \<open>P = density M h\<close>)
       also have "... < \<infinity>"
         using PS.emeasure_space_1 by simp
       finally show "(\<integral>\<^sup>+x. ((nn_transfer_operator^^k) h) x \<partial>P) \<noteq> \<infinity>"
         by auto
     qed (simp)
     have "\<exists>epsilon. \<forall>k. epsilon k > (0::real) \<and> (\<forall>U\<in>sets P. emeasure P U < epsilon k \<longrightarrow> (\<integral>\<^sup>+x\<in>U. ((nn_transfer_operator^^k) h) x \<partial>P) < delta)"
       apply (rule choice) using * by blast
     then obtain epsilon::"nat \<Rightarrow> real" where E: "\<And>k. epsilon k > 0"
                               "\<And>k U. U \<in> sets P \<Longrightarrow> emeasure P U < epsilon k \<Longrightarrow> (\<integral>\<^sup>+x\<in>U. ((nn_transfer_operator^^k) h) x \<partial>P) < delta"
       by blast
     define epsilon0 where "epsilon0 = Min (epsilon`{..K})"
     have "epsilon0 \<in> epsilon`{..K}" unfolding epsilon0_def by (rule Min_in, auto)
     then have "epsilon0 > 0" using E(1) by auto
     have small_setint: "(\<integral>\<^sup>+x\<in>U. ((nn_transfer_operator^^k) h) x \<partial>P) \<le> delta"
               if "k \<le> K" "U \<in> sets P" "emeasure P U < epsilon0" for k U
     proof -
       have *: "epsilon0 \<le> epsilon k"
         unfolding epsilon0_def apply (rule Min_le) using \<open>k \<le> K\<close> by auto
       show ?thesis
         apply (rule less_imp_le[OF E(2)[OF \<open>U \<in> sets P\<close>]])
         using ennreal_leI[OF *] \<open>emeasure P U < epsilon0\<close> by auto
     qed
     then show ?thesis using \<open>epsilon0 > 0\<close> by auto
   qed
   then obtain epsilon::real where "epsilon > 0" and
     small_setint: "\<And>k U. k \<le> K \<Longrightarrow> U \<in> sets P \<Longrightarrow> emeasure P U < epsilon \<Longrightarrow> (\<integral>\<^sup>+x\<in>U. ((nn_transfer_operator^^k) h) x \<partial>P) \<le> delta"
     by blast
 
   text \<open>Fourth step: obtain an index after which the convergence in distribution ensures that
   the probability to be larger than $2 a$ and to be very large is comparable for $(g+S_n f)/B_n$
   and for $Z$.\<close>
   obtain C0 where "PZ.prob {x. abs(x) \<ge> C0} < epsilon" "C0 \<ge> 1"
     using PZ.random_variable_small_tails[OF \<open>epsilon > 0\<close>, of "\<lambda>x. x"] by auto
   have A: "eventually (\<lambda>n. measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) > 2 * a} > 3 * alpha) sequentially"
     apply (rule open_set_weak_conv_lsc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv \<open>PZ.prob {x. abs (x) > 2 * a} > 3 * alpha\<close>)
   have B: "eventually (\<lambda>n. measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) \<ge> C0} < epsilon) sequentially"
     apply (rule closed_set_weak_conv_usc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv \<open>PZ.prob {x. abs(x) \<ge> C0} < epsilon\<close>)
   obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) > 2 * a} > 3 * alpha"
                     "\<And>n. n \<ge> N \<Longrightarrow> measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) \<ge> C0} < epsilon"
     using eventually_conj[OF A B] unfolding eventually_sequentially by blast
 
   text \<open>Fifth step: obtain a trivial control on $B_n$ for $n$ smaller than $N$.\<close>
   define C1 where "C1 = Max {B k/B 0 |k. k \<le> N+K+1}"
   define C where "C = max (max C0 C1) (max (D / (a * B 0)) (C0/a))"
   have "C \<ge> 1" unfolding C_def using \<open>C0 \<ge> 1\<close> by auto
 
   text \<open>Now, we can put everything together. If $n$ is large enough, we prove that
   $B_{n+1} \leq C \max_{i\leq n} B_i$, by contradiction.\<close>
   have geK: "B (Suc n) \<le> C * Max {B i |i. i \<le> n}" if "n > N + K" for n
   proof (rule ccontr)
     have "Suc n \<ge> N" using that by auto
     let ?h = "(\<lambda>x. (g x + birkhoff_sum f (Suc n) x) / B (Suc n))"
     have "measure (distr P borel ?h) {x. abs (x) > 2 * a}
               = measure P (?h-` {x. abs (x) > 2 * a} \<inter> space P)"
       by (rule measure_distr, auto)
     also have "... = measure P {x \<in> space M. abs(?h x) > 2 * a}"
       by (rule HOL.cong[of "measure P"], auto)
     finally have A: "PS.prob {x \<in> space M. abs(?h x) > 2 * a} > 3 * alpha"
       using N(1)[OF \<open>Suc n \<ge> N\<close>] by auto
 
     have *: "PS.prob {y \<in> space M. C0 \<le> \<bar>g y + birkhoff_sum f (Suc n - k) y\<bar> / \<bar>B (Suc n - k)\<bar>} < epsilon"
       if "k \<in> {1..<K}" for k
     proof -
       have "Suc n - k \<ge> N" using that \<open>n > N + K\<close> by auto
       let ?h = "(\<lambda>x. (g x + birkhoff_sum f (Suc n-k) x) / B (Suc n-k))"
       have "measure (distr P borel ?h) {x. abs (x) \<ge> C0}
                 = measure P (?h-` {x. abs (x) \<ge> C0} \<inter> space P)"
         by (rule measure_distr, auto)
       also have "... = measure P {x \<in> space M. abs(?h x) \<ge> C0}"
         by (rule HOL.cong[of "measure P"], auto)
       finally show ?thesis
         using N(2)[OF \<open>Suc n - k \<ge> N\<close>] by auto
     qed
     have P_le_epsilon: "emeasure P {y \<in> space M. C0 \<le> \<bar>g y + birkhoff_sum f (Suc n - k) y\<bar> / \<bar>B (Suc n - k)\<bar>} < ennreal epsilon"
       if "k \<in> {1..<K}" for k
       using *[OF that] \<open>epsilon > 0\<close> ennreal_lessI unfolding PS.emeasure_eq_measure by auto
 
     assume "\<not>(B (Suc n) \<le> C * Max {B i |i. i \<le> n})"
     then have "C * Max {B i |i. i \<le> n} \<le> B (Suc n)" by simp
     moreover have "C * B 0 \<le> C * Max {B i |i. i \<le> n}"
       apply (rule mult_left_mono, rule Max_ge) using \<open>C \<ge> 1\<close> by auto
     ultimately have "C * B 0 \<le> B (Suc n)"
       by auto
 
     have "(D / (a * B 0)) * B 0 \<le> C * B 0"
       apply (rule mult_right_mono) unfolding C_def using Bpos[of 0] by auto
     then have "(D / (a * B 0)) * B 0 \<le> B (Suc n)"
       using \<open>C * B 0 \<le> B (Suc n)\<close> by simp
     then have "D \<le> a * B (Suc n)"
       using Bpos[of 0] \<open>a > 0\<close> by (auto simp add: divide_simps algebra_simps)
 
     define X where "X = {x \<in> space M. abs((g x + birkhoff_sum f (Suc n) x)/B(Suc n)) > 2 * a}
                         \<inter> {x \<in> space M. \<forall>k < K. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<le> D}
                         \<inter> {x \<in> space M. (\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1}"
     have [measurable]: "X \<in> sets M" unfolding X_def by auto
     have "3 * alpha + (1-alpha) + (1-alpha) \<le>
             PS.prob {x \<in> space M. abs((g x + birkhoff_sum f (Suc n) x)/B(Suc n)) > 2 * a}
           + PS.prob {x \<in> space M. \<forall>k < K. abs(g x + birkhoff_sum f k x - g((T^^k) x)) \<le> D}
           + PS.prob {x \<in> space M. (\<Sum>i\<in>{1..<K}. h ((T^^i) x)) \<ge> 1}"
       using A D K(2) by auto
     also have "... \<le> 2 + PS.prob X"
       unfolding X_def by (rule PS.sum_measure_le_measure_inter3, auto)
     finally have "PS.prob X \<ge> alpha" by auto
 
     have I: "(\<lambda>y. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k))) ((T^^k) x) \<ge> C0" if "x \<in> X" "k \<in> {1..<K}" for x k
     proof -
       have "2 * a * B(Suc n) \<le> abs(g x + birkhoff_sum f (Suc n) x)"
         using \<open>x \<in> X\<close> Bpos[of "Suc n"] unfolding X_def by (auto simp add: divide_simps)
       also have "... = abs(g((T^^k) x) + birkhoff_sum f (Suc n -k) ((T^^k) x) + (g x + birkhoff_sum f k x - g((T^^k) x)))"
         using \<open>n > N+K\<close> \<open>k \<in> {1..<K}\<close> birkhoff_sum_cocycle[of f k "Suc n - k" x] by auto
       also have "... \<le> abs(g((T^^k) x) + birkhoff_sum f (Suc n -k) ((T^^k) x)) + abs(g x + birkhoff_sum f k x - g((T^^k) x))"
         by auto
       also have "... \<le> abs(g((T^^k) x) + birkhoff_sum f (Suc n -k) ((T^^k) x)) + D"
         using \<open>x \<in> X\<close> \<open>k \<in> {1..<K}\<close> unfolding X_def by auto
       also have "... \<le> abs(g((T^^k) x) + birkhoff_sum f (Suc n -k) ((T^^k) x)) + a * B (Suc n)"
         using \<open>D \<le> a * B (Suc n)\<close> by simp
       finally have *: "a * B (Suc n) \<le> abs(g((T^^k) x) + birkhoff_sum f (Suc n -k) ((T^^k) x))"
         by simp
       have "(C0/a) * B (Suc n - k) \<le> C * B (Suc n - k)"
         apply (rule mult_right_mono) unfolding C_def using less_imp_le[OF Bpos] by auto
       also have "... \<le> C * Max {B i |i. i \<le> n}"
         apply (rule mult_left_mono, rule Max_ge) using \<open>k \<in> {1..<K}\<close> \<open>C \<ge> 1\<close> by auto
       also have "... \<le> B (Suc n)"
         by fact
       finally have "C0 * B (Suc n - k) \<le> a * B (Suc n)"
         using \<open>a>0\<close> by (simp add: divide_simps algebra_simps)
       then have "C0 * B (Suc n - k) \<le> abs(g((T^^k) x) + birkhoff_sum f (Suc n -k) ((T^^k) x))"
         using * by auto
       then show ?thesis
         using Bpos[of "Suc n - k"] by (simp add: divide_simps)
     qed
     have J: "1 \<le> (\<Sum>k\<in>{1..<K}. (\<lambda>y. h y * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} y) ((T^^k) x))"
       if "x \<in> X" for x
     proof -
       have "x \<in> space M"
         using \<open>x \<in> X\<close> unfolding X_def by auto
       have "1 \<le> (\<Sum>k \<in> {1..<K}. h ((T^^k) x))"
         using \<open>x \<in> X\<close> unfolding X_def by auto
       also have "... = (\<Sum>k \<in> {1..<K}. h ((T^^k) x) * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} ((T^^k) x))"
         apply (rule sum.cong)
         unfolding indicator_def using I[OF \<open>x \<in> X\<close>] T_spaceM_stable(2)[OF \<open>x \<in> space M\<close>] by auto
       finally show ?thesis by simp
     qed
     have "ennreal alpha \<le> emeasure P X"
       using \<open>PS.prob X \<ge> alpha\<close> by (simp add: PS.emeasure_eq_measure)
     also have "... = (\<integral>\<^sup>+x. indicator X x \<partial>P)"
       by auto
     also have "... \<le> (\<integral>\<^sup>+x. (\<Sum>k\<in>{1..<K}. (\<lambda>y. h y
       * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} y) ((T^^k) x)) \<partial>P)"
       apply (rule nn_integral_mono) using J unfolding indicator_def by fastforce
     also have "... = (\<Sum>k\<in>{1..<K}. (\<integral>\<^sup>+x. (\<lambda>y. h y
       * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} y) ((T^^k) x) \<partial>P))"
       by (rule nn_integral_sum, auto)
     also have "... = (\<Sum>k\<in>{1..<K}. (\<integral>\<^sup>+x. (\<lambda>y. h y
       * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} y) ((T^^k) x) * h x \<partial>M))"
       unfolding \<open>P = density M h\<close> by (auto intro!: sum.cong nn_integral_densityR[symmetric])
     also have "... = (\<Sum>k\<in>{1..<K}. (\<integral>\<^sup>+x. h x
       * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} x * ((nn_transfer_operator^^k) h) x \<partial>M))"
       by (auto intro!: sum.cong nn_transfer_operator_intTn_g[symmetric])
     also have "... = (\<Sum>k\<in>{1..<K}. (\<integral>\<^sup>+x.
         ((nn_transfer_operator^^k) h) x * indicator {y \<in> space M. abs((g y + birkhoff_sum f (Suc n - k) y)/ B (Suc n - k)) \<ge> C0} x \<partial>P))"
       unfolding \<open>P = density M h\<close> by (subst nn_integral_density, auto intro!: sum.cong simp add: algebra_simps)
     also have "... \<le> (\<Sum>k\<in>{1..<K}. ennreal delta)"
       by (rule sum_mono, rule small_setint, auto simp add: P_le_epsilon)
     also have "... = ennreal (\<Sum>k\<in>{1..<K}. delta)"
       using less_imp_le[OF \<open>delta > 0\<close>] by (rule sum_ennreal)
     finally have "alpha \<le> (\<Sum>k\<in>{1..<K}. delta)"
       apply (subst ennreal_le_iff[symmetric]) using \<open>delta > 0\<close> by auto
     also have "... \<le> K * delta"
       using \<open>delta > 0\<close> by auto
     finally show False
       unfolding delta_def using \<open>K \<ge> 1\<close> \<open>alpha > 0\<close> by (auto simp add: divide_simps algebra_simps)
   qed
   text \<open>If $n$ is not large, we get the same bound in a trivial way, as there are only finitely
   many cases to consider and we have adjusted the constant $C$ so that it works for all of them.\<close>
   have leK: "B (Suc n) \<le> C * Max {B i |i. i \<le> n}" if "n \<le> N+K" for n
   proof -
     have "B (Suc n)/B 0 \<le> Max {B k/B 0 |k. k \<le> N+K+1}"
       apply (rule Max_ge, simp) using \<open>n \<le> N+K\<close> by auto
     also have "... \<le> C" unfolding C_def C1_def by auto
     finally have "B (Suc n) \<le> C * B 0"
       using Bpos[of 0] by (simp add: divide_simps)
     also have "... \<le> C * Max {B i |i. i \<le> n}"
       apply (rule mult_left_mono) apply (rule Max_ge) using \<open>C \<ge> 1\<close> by auto
     finally show ?thesis by simp
   qed
   have "B (Suc n) \<le> C * Max {B i |i. i \<le> n}" for n
     using geK[of n] leK[of n] by force
   then show ?thesis
     using \<open>C \<ge> 1\<close> by auto
 qed
 
 text \<open>Then, we prove the lemma without further assumptions, reducing to the previous case by
 replacing $m$ with $m+P$. We do this at the level of densities since the addition of measures
 is not defined in the library (and it would be problematic as measures carry their sigma-algebra,
 so what should one do when the sigma-algebras do not coincide?)\<close>
 
 lemma upper_bound_C:
   "\<exists>C\<ge>1. \<forall>n. B (Suc n) \<le> C * Max {B i|i. i \<le> n}"
 proof -
   text \<open>We introduce the density of $P$, and show that it is almost everywhere finite.\<close>
   define h where "h = RN_deriv M P"
   have [measurable]: "h \<in> borel_measurable M"
     unfolding h_def by auto
   have P [simp]: "P = density M h"
     unfolding h_def apply (rule density_RN_deriv[symmetric]) using PabsM by auto
   have "space P = space M"
     by auto
   have *: "AE x in M. h x \<noteq> \<infinity>"
     unfolding h_def apply (rule RN_deriv_finite)
     using PS.sigma_finite_measure_axioms PabsM by auto
   have **: "null_sets (density M (\<lambda>x. 1 + h x)) = null_sets M"
     by (rule null_sets_density, auto)
 
   text \<open>We introduce the new system with invariant measure $M+P$, given by the density $1+h$.\<close>
   interpret A: conservative "density M (\<lambda>x. 1 + h x)" T
     apply (rule conservative_density) using * by auto
   interpret B: conservative_limit T "density M (\<lambda>x. 1 + h x)" P Z f g B
     apply standard
     using conv Bpos non_trivial absolutely_continuousI_density[OF \<open>h \<in> borel_measurable M\<close>]
     unfolding absolutely_continuous_def ** by auto
 
   text \<open>We obtain the result by applying the result above to the new dynamical system.
   We have to check the additional assumption that the density of $P$ with respect to the new measure
   $M + P$ is bounded by $1$. Since this density if $h/(1+h)$, this is trivial modulo a computation
   in ennreal that is not automated (yet?).\<close>
   have z: "1 = ennreal 1" by auto
   have Trivial: "a = (1+a) * (a/(1+a))" if "a \<noteq> \<top>" for a::ennreal
     apply (cases a) apply auto unfolding z ennreal_plus_if apply (subst divide_ennreal) apply simp apply simp
     apply (subst ennreal_mult'[symmetric]) using that by auto
   have Trivial2: "a / (1+a) \<le> 1" for a::ennreal
     apply (cases a) apply auto unfolding z ennreal_plus_if apply (subst divide_ennreal) by auto
   show ?thesis
     apply (rule B.upper_bound_C_aux[of "\<lambda>x. h x/(1 + h x)"])
     using * Trivial Trivial2 by (auto simp add: density_density_eq density_unique_iff)
 qed
 
 text \<open>The second main upper bound is the following. Again, it proves that
 $B_{n+1} \leq L \max_{i \leq n} B_i$, for some constant $L$, but with two differences. First,
 $L$ only depends on the distribution of $Z$ (which is stronger). Second, this estimate is only
 proved along a density $1$ sequence of times (which is weaker). The first point implies that
 this lemma will also apply to $T^j$, with the same $L$, which amounts to replacing $L$ by $L^{1/j}$,
 making it in practice arbitrarily close to $1$. The second point is problematic at first sight, but
 for the exceptional times we will use the bound of the previous lemma so this will not really
 create problems.
 
 For the proof, we split the sum $S_{n+1} f$ as $S_n f + f \circ T^n$. If $B_{n+1}$ is much larger
 than $B_n$, we deduce that $S_n f$ is much smaller than $S_{n+1}f$ with large probability, which
 means that $f \circ T^n$ is larger than anything that has been seen before. Since preimages of
 distinct events have a measure that tends to $0$ along a density $1$ subsequence, this can only
 happen along a density $0$ subsequence.\<close>
 
 lemma upper_bound_L:
   fixes a::real and L::real and alpha::real
   assumes "a > 0" "alpha > 0" "L > 3"
           "PZ.prob {x. abs (x) > 2 * a} > 3 * alpha"
           "PZ.prob {x. abs (x) \<ge> (L-1) * a} < alpha"
   shows "\<exists>A. lower_asymptotic_density A = 1 \<and> (\<forall>n\<in>A. B (Suc n) \<le> L * Max {B i|i. i \<le> n})"
 proof -
   define m where "m = (\<lambda>n. Max {B i|i. i \<le> n})"
   define K where "K = (\<lambda>n::nat. {x \<in> space M. abs(f x) \<in> {a * L * m n <..< a * L * m (Suc n)}})"
   have [measurable]: "K n \<in> sets M" for n
     unfolding K_def by auto
   have *: "m n \<le> m p" if "n \<le> p" for n p
     unfolding m_def K_def using that by (auto intro!: Max_mono)
   have "K n \<inter> K p = {}" if "n < p" for n p
   proof (auto simp add: K_def)
     fix x assume "\<bar>f x\<bar> < a * L * m (Suc n)" "a * L * m p < \<bar>f x\<bar>"
     moreover have "a * L * m (Suc n) \<le> a * L * m p"
       using *[of "Suc n" p] that \<open>a > 0\<close> \<open>L > 3\<close> by auto
     ultimately show False by auto
   qed
   then have "disjoint_family K"
     unfolding disjoint_family_on_def using nat_neq_iff by auto
 
   have "\<exists>A0. lower_asymptotic_density A0 = 1 \<and>
             (\<lambda>n. measure P (space M \<inter> (T^^n)-`(K n)) * indicator A0 n) \<longlonglongrightarrow> 0"
     apply (rule disjoint_sets_measure_density_one_tendsto_zero) apply fact+
     using PabsM by auto
   then obtain A0 where A0: "lower_asymptotic_density A0 = 1" "(\<lambda>n. measure P (space M \<inter> (T^^n)-`(K n)) * indicator A0 n) \<longlonglongrightarrow> 0"
     by blast
   obtain N0 where N0: "\<And>n. n \<ge> N0 \<Longrightarrow> measure P (space M \<inter> (T^^n)-`(K n)) * indicator A0 n < alpha"
     using order_tendstoD(2)[OF A0(2) \<open>alpha > 0\<close>] unfolding eventually_sequentially by blast
 
   have A: "eventually (\<lambda>n. measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) > 2 * a} > 3 * alpha) sequentially"
     apply (rule open_set_weak_conv_lsc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv assms)
   have B: "eventually (\<lambda>n. measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) \<ge> (L- 1) * a} < alpha) sequentially"
     apply (rule closed_set_weak_conv_usc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv assms)
   obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) > 2 * a} > 3 * alpha"
                     "\<And>n. n \<ge> N \<Longrightarrow> measure (distr P borel (\<lambda>x. (g x + birkhoff_sum f n x) / B n)) {x. abs (x) \<ge> (L-1) * a} < alpha"
     using eventually_conj[OF A B] unfolding eventually_sequentially by blast
 
   have I: "PS.prob {x \<in> space M. abs((g x + birkhoff_sum f n x) / B n) < (L-1) * a} > 1 - alpha" if "n \<ge> N" for n
   proof -
     let ?h = "(\<lambda>x. (g x + birkhoff_sum f n x) / B n)"
     have "measure (distr P borel ?h) {x. abs (x) \<ge> (L-1) * a}
               = measure P (?h-` {x. abs (x) \<ge> (L-1) * a} \<inter> space P)"
       by (rule measure_distr, auto)
     also have "... = measure P {x \<in> space M. abs(?h x) \<ge> (L-1) * a}"
       by (rule HOL.cong[of "measure P"], auto)
     finally have A: "PS.prob {x \<in> space M. abs(?h x) \<ge> (L-1) * a} < alpha"
       using N(2)[OF that] by auto
     have *: "{x \<in> space M. abs(?h x) < (L-1) * a} = space M - {x \<in> space M. abs(?h x) \<ge> (L-1) * a}"
       by auto
     show ?thesis
       unfolding * using A PS.prob_compl by auto
   qed
 
   have Main: "PS.prob (space M \<inter> (T^^n)-`(K n)) > alpha" if "n \<ge> N" "B (Suc n) > L * m n" for n
   proof -
     have "Suc n \<ge> N" using that by auto
     let ?h = "(\<lambda>x. (g x + birkhoff_sum f (Suc n) x) / B (Suc n))"
     have "measure (distr P borel ?h) {x. abs (x) > 2 * a}
               = measure P (?h-` {x. abs (x) > 2 * a} \<inter> space P)"
       by (rule measure_distr, auto)
     also have "... = measure P {x \<in> space M. abs(?h x) > 2 * a}"
       by (rule HOL.cong[of "measure P"], auto)
     finally have A: "PS.prob {x \<in> space M. abs(?h x) > 2 * a} > 3 * alpha"
       using N(1)[OF \<open>Suc n \<ge> N\<close>] by auto
 
     define X where "X = {x \<in> space M. abs((g x + birkhoff_sum f n x) / B n) < (L-1) * a}
                           \<inter> {x \<in> space M. abs((g x + birkhoff_sum f (Suc n) x) / B (Suc n)) < (L-1) * a}
                           \<inter> {x \<in> space M. abs((g x + birkhoff_sum f (Suc n) x) / B (Suc n)) > 2 * a}"
     have "(1 - alpha) + (1 - alpha) + 3 * alpha <
             PS.prob {x \<in> space M. abs((g x + birkhoff_sum f n x) / B n) < (L-1) * a}
           + PS.prob {x \<in> space M. abs((g x + birkhoff_sum f (Suc n) x) / B (Suc n)) < (L-1) * a}
           + PS.prob {x \<in> space M. abs((g x + birkhoff_sum f (Suc n) x) / B (Suc n)) > 2 * a}"
       using A I[OF \<open>n \<ge> N\<close>] I[OF \<open>Suc n \<ge> N\<close>] by auto
     also have "... \<le> 2 + PS.prob X"
       unfolding X_def by (rule PS.sum_measure_le_measure_inter3, auto)
     finally have "PS.prob X > alpha" by auto
 
     have "X \<subseteq> space M \<inter> (T^^n)-`(K n)"
     proof
       have *: "B i \<le> m n" if "i \<le> n" for i
         unfolding m_def by (rule Max_ge, auto simp add: that)
       have **: "B i \<le> B (Suc n)" if "i \<le> Suc n" for i
       proof (cases "i \<le> n")
         case True
         have "m n \<le> B (Suc n) / L"
           using \<open>L * m n < B (Suc n)\<close> \<open>L > 3\<close> by (simp add: divide_simps algebra_simps)
         also have "... \<le> B (Suc n)"
           using Bpos[of "Suc n"] \<open>L > 3\<close> by (simp add: divide_simps algebra_simps)
         finally show ?thesis using *[OF True] by simp
       next
         case False
         then show ?thesis
           using \<open>i \<le> Suc n\<close> le_SucE by blast
       qed
       have "m (Suc n) = B (Suc n)"
         unfolding m_def by (rule Max_eqI, auto simp add: **)
 
       fix x assume "x \<in> X"
       then have "abs (g x + birkhoff_sum f n x) < (L-1) * a * B n"
         unfolding X_def using Bpos[of n] by (auto simp add: algebra_simps divide_simps)
       also have "... \<le> L * a * m n"
         using *[of n] \<open>L > 3\<close> \<open>a > 0\<close> Bpos[of n] by (auto intro!: mult_mono)
       also have "... \<le> a * B (Suc n)"
         using \<open>B (Suc n) > L * m n\<close> less_imp_le \<open>a > 0\<close> by auto
       finally have A: "abs (g x + birkhoff_sum f n x) < a * B (Suc n)"
         by simp
 
       have B: "abs(g x + birkhoff_sum f (Suc n) x) < (L-1) * a * B (Suc n)"
         using \<open>x \<in> X\<close> unfolding X_def using Bpos[of "Suc n"] by (auto simp add: algebra_simps divide_simps)
       have *: "f((T^^n) x) = (g x + birkhoff_sum f (Suc n) x) - (g x + birkhoff_sum f n x)"
         apply (auto simp add: algebra_simps)
         by (metis add.commute birkhoff_sum_1(2) birkhoff_sum_cocycle plus_1_eq_Suc)
       have "abs(f((T^^n) x)) \<le> abs (g x + birkhoff_sum f (Suc n) x) + abs(g x + birkhoff_sum f n x)"
         unfolding * by simp
       also have "... < (L-1) * a * B (Suc n) + a * B (Suc n)"
         using A B by auto
       also have "... = L * a * m (Suc n)"
         using \<open>m (Suc n) = B (Suc n)\<close> by (simp add: algebra_simps)
       finally have Z1: "abs(f((T^^n) x)) < L * a * m (Suc n)"
         by simp
 
       have "2 * a * B (Suc n) < abs (g x + birkhoff_sum f (Suc n) x)"
         using \<open>x \<in> X\<close> unfolding X_def using Bpos[of "Suc n"] by (auto simp add: algebra_simps divide_simps)
       also have "... = abs(f((T^^n) x) + (g x + birkhoff_sum f n x))"
         unfolding * by auto
       also have "... \<le> abs(f((T^^n) x)) + abs (g x + birkhoff_sum f n x)"
         by auto
       also have "... < abs(f((T^^n) x)) + a * B (Suc n)"
         using A by auto
       finally have "abs(f((T^^n) x)) > a * B (Suc n)"
         by simp
       then have Z2: "abs(f((T^^n) x)) > a * L * m n"
         using mult_strict_left_mono[OF \<open>B (Suc n) > L * m n\<close> \<open>a > 0\<close>] by auto
 
       show "x \<in> space M \<inter> (T ^^ n) -` K n"
         using Z1 Z2 \<open>x \<in> X\<close> unfolding K_def X_def by (auto simp add: algebra_simps)
     qed
     have "PS.prob X \<le> PS.prob (space M \<inter> (T^^n)-`(K n))"
       by (rule PS.finite_measure_mono, fact, auto)
     then show "alpha < PS.prob (space M \<inter> (T ^^ n) -` K n)"
       using \<open>alpha < PS.prob X\<close> by simp
   qed
   define A where "A = A0 \<inter> {N + N0..}"
   have "lower_asymptotic_density A = 1"
     unfolding A_def by (rule lower_asymptotic_density_one_intersection, fact, simp)
   moreover have "B (Suc n) \<le> L * m n" if "n \<in> A" for n
   proof (rule ccontr)
     assume "\<not>(B (Suc n) \<le> L * m n)"
     then have "L * m n < B (Suc n)" "n \<ge> N" "n \<ge> N0"
       using \<open>n \<in> A\<close> unfolding A_def by auto
     then have "PS.prob (space M \<inter> (T^^n)-`(K n)) > alpha"
       using Main by auto
     moreover have "PS.prob (space M \<inter> (T^^n)-`(K n)) * indicator A0 n < alpha"
       using N0[OF \<open>n \<ge> N0\<close>] by simp
     moreover have "indicator A0 n = (1::real)"
       using \<open>n \<in> A\<close> unfolding A_def indicator_def by auto
     ultimately show False
       by simp
   qed
   ultimately show ?thesis
     unfolding m_def by blast
 qed
 
 text \<open>Now, we combine the two previous statements to prove the main theorem.\<close>
 
 theorem subexponential_growth:
   "(\<lambda>n. max 0 (ln (B n) /n)) \<longlonglongrightarrow> 0"
 proof -
   obtain a0 where a0: "a0 > 0" "PZ.prob {x. abs (x) > a0} > 0"
     using PZ.not_Dirac_0_imp_positive_mass_away_0[OF non_trivial] by blast
   define a where "a = a0/2"
   have "a > 0" using \<open>a0 > 0\<close> unfolding a_def by auto
   define alpha where "alpha = PZ.prob {x. abs (x) > a0}/4"
   have "alpha > 0" unfolding alpha_def using a0 by auto
   have "PZ.prob {x. abs (x) > 2 * a} > 3 * alpha"
     using a0 unfolding a_def alpha_def by auto
 
   obtain C0 where C0: "PZ.prob {x. abs(x) \<ge> C0} < alpha" "C0 \<ge> 3 * a"
     using PZ.random_variable_small_tails[OF \<open>alpha > 0\<close>, of "\<lambda>x. x"] by auto
   define L where "L = C0/a + 1"
   have "PZ.prob {x. abs(x) \<ge> (L-1) * a} < alpha"
     unfolding L_def using C0 \<open>a>0\<close> by auto
   have "L > 3"
     unfolding L_def using C0 \<open>a > 0\<close> by (auto simp add: divide_simps)
 
   obtain C where C: "\<And>n. B (Suc n) \<le> C * Max {B i|i. i \<le> n}" "C \<ge> 1"
     using upper_bound_C by blast
   have C2: "B n \<le> C * Max {B i|i. i < n}" if "n > 0" for n
   proof -
     obtain m where m: "n = Suc m"
       using \<open>0 < n\<close> gr0_implies_Suc by auto
     have *: "i \<le> m \<longleftrightarrow> i < Suc m" for i by auto
     show ?thesis using C(1)[of m] unfolding m * by auto
   qed
 
   have Mainj: "eventually (\<lambda>n. ln (B n) / n \<le> (1+ln L)/j) sequentially" if "j > 0" for j::nat
   proof -
     have *: "\<exists>A. lower_asymptotic_density A = 1 \<and> (\<forall>n\<in>A. B (j * Suc n + k) \<le> L * Max {B (j * i + k) |i. i \<le> n})" for k
     proof -
       interpret Tj0: conservative M "(T^^j)" using conservative_power[of j] by auto
       have *: "g x + birkhoff_sum f k x + Tj0.birkhoff_sum (\<lambda>x. birkhoff_sum f j ((T ^^ k) x)) n x = g x + birkhoff_sum f (j * n + k) x" for x n
       proof -
         have "birkhoff_sum f (j * n + k) x = (\<Sum>i \<in> {..<k} \<union> {k..<j * n + k}. f ((T ^^ i) x))"
           unfolding birkhoff_sum_def by (rule sum.cong, auto)
         also have "... = (\<Sum>i \<in> {..<k}. f ((T ^^ i) x)) + (\<Sum>i \<in> {k..<j * n + k}. f ((T ^^ i) x))"
           by (auto intro!: sum.union_disjoint)
         also have "... = birkhoff_sum f k x + (\<Sum>s<j. \<Sum>i<n. f ((T ^^ (i * j + s)) ((T^^k) x)))"
           apply (subst sum_arith_progression)
           unfolding birkhoff_sum_def Tj0.birkhoff_sum_def funpow_mult funpow_add'[symmetric]
           by (auto simp add: algebra_simps intro!: sum.reindex_bij_betw[symmetric] bij_betw_byWitness[of _ "\<lambda>a. a-k"])
         also have "... = birkhoff_sum f k x + Tj0.birkhoff_sum (\<lambda>x. birkhoff_sum f j ((T ^^ k) x)) n x"
           unfolding birkhoff_sum_def Tj0.birkhoff_sum_def funpow_mult funpow_add'[symmetric]
           by (auto simp add: algebra_simps intro!: sum.swap)
         finally show ?thesis by simp
       qed
       interpret Tj: conservative_limit "T^^j" M P Z "\<lambda>x. birkhoff_sum f j ((T^^k) x)" "\<lambda>x. g x + birkhoff_sum f k x" "\<lambda>n. B (j * n + k)"
         apply standard
         using PabsM Bpos non_trivial conv \<open>j>0\<close> unfolding * by (auto intro!: weak_conv_m_subseq strict_monoI)
       show ?thesis
         apply (rule Tj.upper_bound_L[OF \<open>a > 0\<close> \<open>alpha > 0\<close>]) by fact+
     qed
     have "\<exists>A. \<forall>k. lower_asymptotic_density (A k) = 1 \<and> (\<forall>n\<in>A k. B (j * Suc n + k) \<le> L * Max {B (j * i + k) |i. i \<le> n})"
       apply (rule choice) using * by auto
     then obtain A where A: "\<And>k. lower_asymptotic_density (A k) = 1" "\<And>k n. n \<in> A k \<Longrightarrow> B (j * Suc n + k) \<le> L * Max {B (j * i + k) |i. i \<le> n}"
       by blast
     define Aj where "Aj = (\<Inter>k<j. A k)"
     have "lower_asymptotic_density Aj = 1"
       unfolding Aj_def using A(1) by (simp add: lower_asymptotic_density_one_finite_Intersection)
     define Bj where "Bj = UNIV - Aj"
     have "upper_asymptotic_density Bj = 0"
       using \<open>lower_asymptotic_density Aj = 1\<close>
       unfolding Bj_def lower_upper_asymptotic_density_complement by simp
 
     define M where "M = (\<lambda>n. Max {B p |p. p < (n+1) * j})"
     have "B 0 \<le> M n" for n
       unfolding M_def apply (rule Max_ge, auto, rule exI[of _ 0]) using \<open>j > 0\<close> by auto
     then have Mpos: "M n > 0" for n
       by (metis Bpos not_le not_less_iff_gr_or_eq order.strict_trans)
     have M_L: "M (Suc n) \<le> L * M n" if "n \<in> Aj" for n
     proof -
       have *: "B s \<le> L * M n" if "s < (n+2) * j" for s
       proof (cases "s < (n+1) * j")
         case True
         have "B s \<le> M n"
           unfolding M_def apply (rule Max_ge) using True by auto
         also have "... \<le> L * M n" using \<open>L > 3\<close> \<open>M n > 0\<close> by auto
         finally show ?thesis by simp
       next
         case False
         then obtain k where "k < j" "s = (n+1) * j + k" using \<open>s < (n+2) * j\<close> le_Suc_ex by force
         then have "B s = B (j * Suc n + k)" by (auto simp add: algebra_simps)
         also have "... \<le> L * Max {B (j * i + k) |i. i \<le> n}"
           using A(2)[of n k] \<open>n \<in> Aj\<close> unfolding Aj_def using \<open>k < j\<close> by auto
         also have "... \<le> L * Max {B a|a. a < (n+1) * j}"
           apply (rule mult_left_mono, rule Max_mono) using \<open>L>3\<close> proof (auto)
           fix i assume "i \<le> n" show "\<exists>a. B (j * i + k) = B a \<and> a < j + n * j"
             apply (rule exI[of _ "j * i + k"]) using \<open>k < j\<close> \<open>i \<le> n\<close>
             by (auto simp add: add_mono_thms_linordered_field(3) algebra_simps)
         qed
         finally show ?thesis unfolding M_def by auto
       qed
       show ?thesis
         unfolding M_def apply (rule Max.boundedI)
         using * unfolding M_def using \<open>j > 0\<close> by auto
     qed
     have M_C: "M (Suc n) \<le> C^j * M n" for n
     proof -
       have I: "Max {B s|s. s < (n+1) * j + k} \<le> C^k * M n" for k
       proof (induction k)
         case 0
         show ?case
           apply (rule Max.boundedI) unfolding M_def using \<open>j > 0\<close> by auto
       next
         case (Suc k)
         have *: "B s \<le> C * C ^ k * M n" if "s < Suc (j + n * j + k)" for s
         proof (cases "s < j + n * j + k")
           case True
           then have "B s \<le> C^k * M n" using iffD1[OF Max_le_iff, OF _ _ Suc.IH] by auto
           also have "... \<le> C * C^k * M n" using \<open>C \<ge> 1\<close> \<open>M n > 0\<close> by auto
           finally show ?thesis by simp
         next
           case False
           then have "s = j + n * j + k" using that by auto
           then have "B s \<le> C * Max {B s|s. s < (n+1) * j + k}" using C2[of s] using \<open>j > 0\<close> by auto
           also have "... \<le> C * C^k * M n" using Suc.IH \<open>C \<ge> 1\<close> by auto
           finally show ?thesis by simp
         qed
         show ?case
           apply (rule Max.boundedI) using \<open>j > 0\<close> * by auto
       qed
       show ?thesis using I[of j] unfolding M_def by (auto simp add: algebra_simps)
     qed
     have I: "ln (M n) \<le> ln (M 0) + n * ln L + card (Bj \<inter> {..<n}) * ln (C^j)" for n
     proof (induction n)
       case 0
       show ?case by auto
     next
       case (Suc n)
       show ?case
       proof (cases "n \<in> Bj")
         case True
         then have *: "Bj \<inter> {..<Suc n} = Bj \<inter> {..<n} \<union> {n}" by auto
         have **: "card (Bj \<inter> {..<Suc n}) = card (Bj \<inter> {..<n}) + card {n}"
           unfolding * by (rule card_Un_disjoint, auto)
 
         have "ln (M (Suc n)) \<le> ln (C^j * M n)"
           using M_C \<open>\<And>n. 0 < M n\<close> less_le_trans ln_le_cancel_iff by blast
         also have "... = ln (M n) + ln (C^j)"
           using \<open>C \<ge> 1\<close> \<open>0 < M n\<close> ln_mult by auto
         also have "... \<le> ln (M 0) + n * ln L + card (Bj \<inter> {..<n}) * ln (C^j) + ln (C^j)"
           using Suc.IH by auto
         also have "... = ln (M 0) + n * ln L + card (Bj \<inter> {..<Suc n}) * ln (C^j)"
           using ** by (auto simp add: algebra_simps)
         also have "... \<le> ln (M 0) + (Suc n) * ln L + card (Bj \<inter> {..<Suc n}) * ln (C^j)"
           using \<open>L > 3\<close> by auto
         finally show ?thesis by auto
       next
         case False
         have "M (Suc n) \<le> L * M n"
           apply (rule M_L) using False unfolding Bj_def by auto
         then have "ln (M (Suc n)) \<le> ln (L * M n)"
           using \<open>\<And>n. 0 < M n\<close> less_le_trans ln_le_cancel_iff by blast
         also have "... = ln (M n) + ln L"
           using \<open>L > 3\<close> \<open>0 < M n\<close> ln_mult by auto
         also have "... \<le> ln (M 0) + Suc n * ln L + card (Bj \<inter> {..<n}) * ln (C^j)"
           using Suc.IH by (auto simp add: algebra_simps)
         also have "... \<le> ln (M 0) + Suc n * ln L + card (Bj \<inter> {..<Suc n}) * ln (C^j)"
           using \<open>C \<ge> 1\<close> by (auto intro!: mult_right_mono card_mono)
         finally show ?thesis by auto
       qed
     qed
     have "ln (M n)/n \<le> ln (M 0)* (1/n) + ln L + (card (Bj \<inter> {..<n})/n) * ln (C^j)" if "n\<ge>1" for n
       using that apply (auto simp add: algebra_simps divide_simps)
       by (metis (no_types, hide_lams) I add.assoc mult.commute mult_left_mono of_nat_0_le_iff semiring_normalization_rules(34))
     then have A: "eventually (\<lambda>n. ln (M n)/n \<le> ln (M 0)* (1/n) + ln L + (card (Bj \<inter> {..<n})/n) * ln (C^j)) sequentially"
       unfolding eventually_sequentially by blast
 
     have *: "(\<lambda>n. ln (M 0)*(1/n) + ln L + (card (Bj \<inter> {..<n})/n) * ln (C^j)) \<longlonglongrightarrow> ln (M 0) * 0 + ln L + 0 *ln (C^j)"
       by (intro tendsto_intros upper_asymptotic_density_zero_lim, fact)
     have B: "eventually (\<lambda>n. ln (M 0)*(1/n) + ln L + (card (Bj \<inter> {..<n})/n) * ln (C^j) < 1 + ln L) sequentially"
       by (rule order_tendstoD[OF *], auto)
     have "eventually (\<lambda>n. ln (M n)/n < 1 + ln L) sequentially"
       using eventually_conj[OF A B] by (simp add: eventually_mono)
     then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> ln (M n)/n < 1 + ln L"
       unfolding eventually_sequentially by blast
     have "ln (B p) / p \<le> (1+ln L) / j" if "p \<ge> (N+1) * j" for p
     proof -
       define n where "n = p div j"
       have "n \<ge> N+1" unfolding n_def using that
         by (metis \<open>0 < j\<close> div_le_mono div_mult_self_is_m)
       then have "n \<ge> N" "n \<ge> 1" by auto
       have *: "p < (n+1) * j" "n * j \<le> p"
         unfolding n_def using \<open>j > 0\<close> dividend_less_div_times by auto
       have "B p \<le> M n"
         unfolding M_def apply (rule Max_ge) using * by auto
       then have "ln (B p) \<le> ln (M n)"
         using Bpos Mpos ln_le_cancel_iff by blast
       also have "... \<le> n * (1+ln L)"
         using N[OF \<open>n \<ge> N\<close>] \<open>n \<ge> 1\<close> by (auto simp add: divide_simps algebra_simps)
       also have "... \<le> (p/j) * (1+ln L)"
         apply (rule mult_right_mono) using *(2) \<open>j > 0\<close> \<open>L > 3\<close>
         apply (auto simp add: divide_simps algebra_simps)
         using of_nat_mono by fastforce
       finally show ?thesis
         using \<open>j > 0\<close> that by (simp add: algebra_simps divide_simps)
     qed
     then show "eventually (\<lambda>p. ln (B p) / p \<le> (1+ln L)/j) sequentially"
       unfolding eventually_sequentially by auto
   qed
   show "(\<lambda>n. max 0 (ln (B n) / real n)) \<longlonglongrightarrow> 0"
   proof (rule order_tendstoI)
     fix e::real assume "e > 0"
     have *: "(\<lambda>j. (1+ln L) * (1/j)) \<longlonglongrightarrow> (1+ln L) * 0"
       by (intro tendsto_intros)
     have "eventually (\<lambda>j. (1+ln L) * (1/j) < e) sequentially"
       apply (rule order_tendstoD[OF *]) using \<open>e > 0\<close> by auto
     then obtain j::nat where j: "j > 0" "(1+ln L) * (1/j) < e"
       unfolding eventually_sequentially using add.right_neutral le_eq_less_or_eq by fastforce
     show "eventually (\<lambda>n. max 0 (ln (B n) / real n) < e) sequentially"
       using Mainj[OF \<open>j > 0\<close>] j(2) \<open>e > 0\<close> by (simp add: eventually_mono)
   qed (simp add: max.strict_coboundedI1)
 qed
 
 
 end (*of locale conservative_limit*)
 
 subsection \<open>Normalizing sequences grow at most polynomially in probability preserving systems\<close>
 
 text \<open>In probability preserving systems, normalizing sequences grow at most polynomially.
 The proof, also given in~\cite{gouezel_normalizing_sequences}, is considerably easier than
 the conservative case. We prove that $B_{n+1} \leq C B_n$ (more precisely, this only holds if
 $B_{n+1}$ is large enough), by arguing that $S_{n+1} f = S_n f + f \circ T^n$, where $f\circ T^n$
 is negligible if $B_{n+1}$ is large thanks to the measure preservation. We also prove that
 $B_{2n} \leq E B_n$, by writing $S_{2n} f = S_n f+ S_n f \circ T^n$ and arguing that the two terms
 on the right have the same distribution. Finally, combining these two estimates, the polynomial
 growth follows readily.\<close>
 
 locale pmpt_limit =
   pmpt M + PZ: real_distribution Z
     for M::"'a measure" and Z::"real measure" +
   fixes f::"'a \<Rightarrow> real" and B::"nat \<Rightarrow> real"
   assumes Bpos: "\<And>n. B n > 0"
       and M [measurable]: "f \<in> borel_measurable M"
       and non_trivial: "PZ.prob {0} < 1"
       and conv: "weak_conv_m (\<lambda>n. distr P borel (\<lambda>x. (birkhoff_sum f n x) / B n)) Z"
 begin
 
 text \<open>First, we prove that $B_{n+1} \leq C B_n$ if $B_{n+1}$ is large enough.\<close>
 
 lemma upper_bound_CD:
   "\<exists>C D. (\<forall>n. B (Suc n) \<le> D \<or> B (Suc n) \<le> C * B n) \<and> C \<ge> 1"
 proof -
   obtain a where a: "a > 0" "PZ.prob {x. abs (x) > a} > 0"
     using PZ.not_Dirac_0_imp_positive_mass_away_0[OF non_trivial] by blast
   define alpha where "alpha = PZ.prob {x. abs (x) > a}/4"
   have "alpha > 0" unfolding alpha_def using a by auto
   have A: "PZ.prob {x. abs (x) > a} > 3 * alpha"
     using a unfolding alpha_def by auto
 
   obtain C0 where C0: "PZ.prob {x. abs(x) \<ge> C0} < alpha" "C0 \<ge> a"
     using PZ.random_variable_small_tails[OF \<open>alpha > 0\<close>, of "\<lambda>x. x"] by auto
 
   have A: "eventually (\<lambda>n. measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs (x) > a} > 3 * alpha) sequentially"
     apply (rule open_set_weak_conv_lsc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv A)
   have B: "eventually (\<lambda>n. measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs (x) \<ge> C0} < alpha) sequentially"
     apply (rule closed_set_weak_conv_usc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv C0)
   obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs x > a} > 3 * alpha"
                     "\<And>n. n \<ge> N \<Longrightarrow> measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs x \<ge> C0} < alpha"
     using eventually_conj[OF A B] unfolding eventually_sequentially by blast
 
   obtain Cf where Cf: "prob {x \<in> space M. abs(f x) \<ge> Cf} < alpha" "Cf \<ge> 1"
     using random_variable_small_tails[OF \<open>alpha > 0\<close> M] by auto
   have Main: "B (Suc n) \<le> (2*C0/a) * B n" if "n \<ge> N" "B (Suc n) \<ge> 2 * Cf/a" for n
   proof -
     have "Suc n \<ge> N" using that by auto
     let ?h = "(\<lambda>x. (birkhoff_sum f (Suc n) x) / B (Suc n))"
     have "measure (distr M borel ?h) {x. abs (x) > a}
               = measure M (?h-` {x. abs (x) > a} \<inter> space M)"
       by (rule measure_distr, auto)
     also have "... = prob {x \<in> space M. abs(?h x) > a}"
       by (rule HOL.cong[of "measure M"], auto)
     finally have A: "prob {x \<in> space M. abs(?h x) > a} > 3 * alpha"
       using N(1)[OF \<open>Suc n \<ge> N\<close>] by auto
 
     let ?h = "(\<lambda>x. (birkhoff_sum f n x) / B n)"
     have "measure (distr M borel ?h) {x. abs (x) \<ge> C0}
               = measure M (?h-` {x. abs (x) \<ge> C0} \<inter> space M)"
       by (rule measure_distr, auto)
     also have "... = measure M {x \<in> space M. abs(?h x) \<ge> C0}"
       by (rule HOL.cong[of "measure M"], auto)
     finally have B0: "prob {x \<in> space M. abs(?h x) \<ge> C0} < alpha"
       using N(2)[OF \<open>n \<ge> N\<close>] by auto
     have *: "{x \<in> space M. abs(?h x) < C0} = space M - {x \<in> space M. abs(?h x) \<ge> C0}"
       by auto
     have B: "prob {x \<in> space M. abs(?h x) < C0} > 1- alpha"
       unfolding * using B0 prob_compl by auto
 
     have "prob {x \<in> space M. abs(f ((T^^n) x)) \<ge> Cf} = prob ((T^^n)-`{x \<in> space M. abs(f x) \<ge> Cf} \<inter> space M)"
       by (rule HOL.cong[of "prob"], auto)
     also have "... = prob {x \<in> space M. abs(f x) \<ge> Cf}"
       using T_vrestr_same_measure(2)[of "{x \<in> space M. abs(f x) \<ge> Cf}" n]
       unfolding vimage_restr_def by auto
     finally have C0: "prob {x \<in> space M. abs(f ((T^^n) x)) \<ge> Cf} < alpha"
       using Cf by simp
     have *: "{x \<in> space M. abs(f ((T^^n) x)) < Cf} = space M - {x \<in> space M. abs(f ((T^^n) x)) \<ge> Cf}"
       by auto
     have C: "prob {x \<in> space M. abs(f ((T^^n) x)) < Cf} > 1- alpha"
       unfolding * using C0 prob_compl by auto
 
     define X where "X = {x \<in> space M. abs((birkhoff_sum f n x) / B n) < C0}
                           \<inter> {x \<in> space M. abs((birkhoff_sum f (Suc n) x) / B (Suc n)) > a}
                           \<inter> {x \<in> space M. abs(f ((T^^n) x)) < Cf}"
     have "(1 - alpha) + 3 * alpha + (1 - alpha) <
             prob {x \<in> space M. abs((birkhoff_sum f n x) / B n) < C0}
           + prob {x \<in> space M. abs((birkhoff_sum f (Suc n) x) / B (Suc n)) > a}
           + prob {x \<in> space M. abs(f ((T^^n) x)) < Cf}"
       using A B C by auto
     also have "... \<le> 2 + prob X"
       unfolding X_def by (rule sum_measure_le_measure_inter3, auto)
     finally have "prob X > alpha" by auto
     then have "X \<noteq> {}" using \<open>alpha > 0\<close> by auto
     then obtain x where "x \<in> X" by auto
     have *: "abs(birkhoff_sum f n x) \<le> C0 * B n"
             "abs(birkhoff_sum f (Suc n) x) \<ge> a * B (Suc n)"
             "abs(f((T^^n) x)) \<le> Cf"
       using \<open>x \<in> X\<close> Bpos[of n] Bpos[of "Suc n"] unfolding X_def by (auto simp add: divide_simps)
     have "a * B (Suc n) \<le> abs(birkhoff_sum f (Suc n) x)"
       using * by simp
     also have "... = abs(birkhoff_sum f n x + f ((T^^n) x))"
       by (metis Groups.add_ac(2) One_nat_def birkhoff_sum_1(3) birkhoff_sum_cocycle plus_1_eq_Suc)
     also have "... \<le> C0 * B n + Cf"
       using * by auto
     also have "... \<le> C0 * B n + (a/2) * B (Suc n)"
       using \<open>B (Suc n) \<ge> 2 * Cf/a\<close> \<open>a > 0\<close> by (auto simp add: divide_simps algebra_simps)
     finally show "B (Suc n) \<le> (2 * C0/a) * B n"
       using \<open>a > 0\<close> by (auto simp add: divide_simps algebra_simps)
   qed
   define C1 where "C1 = Max {B(Suc n)/B n |n. n \<le> N}"
   have *: "B (Suc n) \<le> max ((2 * C0/a)) C1 * B n" if "B (Suc n) > 2 * Cf/a" for n
   proof (cases "n > N")
     case True
     then show ?thesis
       using Main[OF less_imp_le[OF \<open>n > N\<close>] less_imp_le[OF that]] Bpos[of n]
-      by (meson max.cobounded1 order_trans real_mult_le_cancel_iff1)
+      by (meson max.cobounded1 order_trans mult_le_cancel_iff1)
   next
     case False
     then have "n \<le> N" by simp
     have "B(Suc n)/B n \<le> C1"
       unfolding C1_def apply (rule Max_ge) using \<open>n \<le> N\<close> by auto
     then have "B (Suc n) \<le> C1 * B n"
       using Bpos[of n] by (simp add: divide_simps)
     then show ?thesis
-      using Bpos[of n] by (meson max.cobounded2 order_trans real_mult_le_cancel_iff1)
+      using Bpos[of n] by (meson max.cobounded2 order_trans mult_le_cancel_iff1)
   qed
   show ?thesis
     apply (rule exI[of _ "max ((2 * C0/a)) C1"], rule exI[of _ "2 * Cf/a"])
     using * linorder_not_less \<open>C0 \<ge> a\<close> \<open>a > 0\<close> by (auto intro!: max.coboundedI1)
 qed
 
 text \<open>Second, we prove that $B_{2n} \leq E B_n$.\<close>
 
 lemma upper_bound_E:
   "\<exists>E. \<forall>n. B (2 * n) \<le> E * B n"
 proof -
   obtain a where a: "a > 0" "PZ.prob {x. abs (x) > a} > 0"
     using PZ.not_Dirac_0_imp_positive_mass_away_0[OF non_trivial] by blast
   define alpha where "alpha = PZ.prob {x. abs (x) > a}/4"
   have "alpha > 0" unfolding alpha_def using a by auto
   have A: "PZ.prob {x. abs (x) > a} > 3 * alpha"
     using a unfolding alpha_def by auto
 
   obtain C0 where C0: "PZ.prob {x. abs(x) \<ge> C0} < alpha" "C0 \<ge> a"
     using PZ.random_variable_small_tails[OF \<open>alpha > 0\<close>, of "\<lambda>x. x"] by auto
 
   have A: "eventually (\<lambda>n. measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs (x) > a} > 3 * alpha) sequentially"
     apply (rule open_set_weak_conv_lsc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv A)
   have B: "eventually (\<lambda>n. measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs (x) \<ge> C0} < alpha) sequentially"
     apply (rule closed_set_weak_conv_usc[of _ Z])
     by (auto simp add: PZ.real_distribution_axioms conv C0)
   obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs x > a} > 3 * alpha"
                     "\<And>n. n \<ge> N \<Longrightarrow> measure (distr M borel (\<lambda>x. (birkhoff_sum f n x) / B n)) {x. abs x \<ge> C0} < alpha"
     using eventually_conj[OF A B] unfolding eventually_sequentially by blast
 
   have Main: "B (2 * n) \<le> (2*C0/a) * B n" if "n \<ge> N" for n
   proof -
     have "2 * n \<ge> N" using that by auto
     let ?h = "(\<lambda>x. (birkhoff_sum f (2 * n) x) / B (2 * n))"
     have "measure (distr M borel ?h) {x. abs (x) > a}
               = measure M (?h-` {x. abs (x) > a} \<inter> space M)"
       by (rule measure_distr, auto)
     also have "... = prob {x \<in> space M. abs(?h x) > a}"
       by (rule HOL.cong[of "measure M"], auto)
     finally have A: "prob {x \<in> space M. abs((birkhoff_sum f (2 * n) x) / B (2 * n)) > a} > 3 * alpha"
       using N(1)[OF \<open>2 * n \<ge> N\<close>] by auto
 
     let ?h = "(\<lambda>x. (birkhoff_sum f n x) / B n)"
     have "measure (distr M borel ?h) {x. abs (x) \<ge> C0}
               = measure M (?h-` {x. abs (x) \<ge> C0} \<inter> space M)"
       by (rule measure_distr, auto)
     also have "... = measure M {x \<in> space M. abs(?h x) \<ge> C0}"
       by (rule HOL.cong[of "measure M"], auto)
     finally have B0: "prob {x \<in> space M. abs(?h x) \<ge> C0} < alpha"
       using N(2)[OF \<open>n \<ge> N\<close>] by auto
     have *: "{x \<in> space M. abs(?h x) < C0} = space M - {x \<in> space M. abs(?h x) \<ge> C0}"
       by auto
     have B: "prob {x \<in> space M. abs((birkhoff_sum f n x) / B n) < C0} > 1- alpha"
       unfolding * using B0 prob_compl by auto
 
     have "prob {x \<in> space M. abs(?h ((T^^n) x)) < C0} = prob ((T^^n)-`{x \<in> space M. abs(?h x) < C0} \<inter> space M)"
       by (rule HOL.cong[of "prob"], auto)
     also have "... = prob {x \<in> space M. abs(?h x) < C0}"
       using T_vrestr_same_measure(2)[of "{x \<in> space M. abs(?h x) < C0}" n]
       unfolding vimage_restr_def by auto
     finally have C: "prob {x \<in> space M. abs((birkhoff_sum f n ((T^^n) x)) / B n) < C0} > 1- alpha"
       using B by simp
 
     define X where "X = {x \<in> space M. abs((birkhoff_sum f n x) / B n) < C0}
                           \<inter> {x \<in> space M. abs((birkhoff_sum f (2* n) x) / B (2* n)) > a}
                           \<inter> {x \<in> space M. abs((birkhoff_sum f n ((T^^n) x)) / B n) < C0}"
     have "(1 - alpha) + 3 * alpha + (1 - alpha) <
             prob {x \<in> space M. abs((birkhoff_sum f n x) / B n) < C0}
           + prob {x \<in> space M. abs((birkhoff_sum f (2* n) x) / B (2* n)) > a}
           + prob {x \<in> space M. abs((birkhoff_sum f n ((T^^n) x)) / B n) < C0}"
       using A B C by auto
     also have "... \<le> 2 + prob X"
       unfolding X_def by (rule sum_measure_le_measure_inter3, auto)
     finally have "prob X > alpha" by auto
     then have "X \<noteq> {}" using \<open>alpha > 0\<close> by auto
     then obtain x where "x \<in> X" by auto
     have *: "abs(birkhoff_sum f n x) \<le> C0 * B n"
             "abs((birkhoff_sum f (2 * n) x)) \<ge> a * B (2 * n)"
             "abs((birkhoff_sum f n ((T^^n) x))) \<le> C0 * B n"
       using \<open>x \<in> X\<close> Bpos[of n] Bpos[of "2* n"] unfolding X_def by (auto simp add: divide_simps)
     have "a * B (2 * n) \<le> abs(birkhoff_sum f (2 * n) x)"
       using * by simp
     also have "... = abs(birkhoff_sum f n x + birkhoff_sum f n ((T^^n) x))"
       unfolding birkhoff_sum_cocycle[of f n n x, symmetric] by (simp add: mult_2)
     also have "... \<le> 2 * C0 * B n"
       using * by auto
     finally show "B (2 * n) \<le> (2 * C0/a) * B n"
       using \<open>a > 0\<close> by (auto simp add: divide_simps algebra_simps)
   qed
   define C1 where "C1 = Max {B(2 * n)/B n |n. n \<le> N}"
   have *: "B (2*n) \<le> max ((2 * C0/a)) C1 * B n" for n
   proof (cases "n > N")
     case True
     then show ?thesis
       using Main[OF less_imp_le[OF \<open>n > N\<close>]] Bpos[of n]
-      by (meson max.cobounded1 order_trans real_mult_le_cancel_iff1)
+      by (meson max.cobounded1 order_trans mult_le_cancel_iff1)
   next
     case False
     then have "n \<le> N" by simp
     have "B(2*n)/B n \<le> C1"
       unfolding C1_def apply (rule Max_ge) using \<open>n \<le> N\<close> by auto
     then have "B (2*n) \<le> C1 * B n"
       using Bpos[of n] by (simp add: divide_simps)
     then show ?thesis
-      using Bpos[of n] by (meson max.cobounded2 order_trans real_mult_le_cancel_iff1)
+      using Bpos[of n] by (meson max.cobounded2 order_trans mult_le_cancel_iff1)
   qed
   show ?thesis
     apply (rule exI[of _ "max ((2 * C0/a)) C1"])
     using * by auto
 qed
 
 text \<open>Finally, we combine the estimates in the two lemmas above to show that $B_n$ grows
 at most polynomially.\<close>
 
 theorem polynomial_growth:
   "\<exists>C K. \<forall>n>0. B n \<le> C * (real n)^K"
 proof -
   obtain C D where C: "C \<ge> 1" "\<And>n. B (Suc n) \<le> D \<or> B (Suc n) \<le> C * B n"
     using upper_bound_CD by blast
   obtain E where E: "\<And>n. B (2 * n) \<le> E * B n"
     using upper_bound_E by blast
   have "E \<ge> 1" using E[of 0] Bpos[of 0] by auto
 
   obtain k::nat where "log 2 (max C E) \<le> k"
     using real_arch_simple[of "log 2 (max C E)"] by blast
   then have "max C E \<le> 2^k"
     by (meson less_log_of_power not_less one_less_numeral_iff semiring_norm(76))
   then have "C \<le> 2^k" "E \<le> 2^k"
     by auto
 
   define P where "P = max D (B 0)"
   have "P > 0" unfolding P_def using Bpos[of 0] by auto
   have Main: "\<And>n. n < 2^r \<Longrightarrow> B n \<le> P * 2^(2 * k * r)" for r
   proof (induction r)
     case 0
     fix n::nat assume "n < 2^0"
     then show "B n \<le> P * 2 ^ (2 * k * 0)"
       unfolding P_def by auto
   next
     case (Suc r)
     fix n::nat assume "n < 2^(Suc r)"
     consider "even n" | "B n \<le> D" | "odd n \<and> B n > D" by linarith
     then show "B n \<le> P * 2 ^ (2 * k * Suc r)"
     proof (cases)
       case 1
       then obtain m where m: "n = 2 * m" by (rule evenE)
       have "m < 2^r"
         using \<open>n < 2^(Suc r)\<close> unfolding m by auto
       then have *: "B m \<le> P * 2^(2 * k * r)"
         using Suc.IH by auto
       have "B n \<le> E * B m"
         unfolding m using E by simp
       also have "... \<le> 2^k * B m"
         apply (rule mult_right_mono[OF _ less_imp_le[OF Bpos[of m]]])
         using \<open>E \<le> 2^k\<close> by simp
       also have "... \<le> 2^k * (P * 2^(2 * k * r))"
         apply (rule mult_left_mono[OF *]) by auto
       also have "... = P * 2^(2 * k * r + k)"
         by (auto simp add: algebra_simps power_add)
       also have "... \<le> P * 2^(2 * k * Suc r)"
         apply (rule mult_left_mono) using \<open>P > 0\<close> by auto
       finally show ?thesis by simp
     next
       case 2
       have "D \<le> P * 1"
         unfolding P_def by auto
       also have "... \<le> P * 2^(2 * k * Suc r)"
         by (rule mult_left_mono[OF _ less_imp_le[OF \<open>P > 0\<close>]], auto)
       finally show ?thesis using 2 by simp
     next
       case 3
       then obtain m where m: "n = 2 * m + 1"
         using oddE by blast
       have "m < 2^r"
         using \<open>n < 2^(Suc r)\<close> unfolding m by auto
       then have *: "B m \<le> P * 2^(2 * k * r)"
         using Suc.IH by auto
       have "B n > D" using 3 by auto
       then have "B n \<le> C * B (2 * m)"
         unfolding m using C(2)[of "2 * m"] by auto
       also have "... \<le> C * (E * B m)"
         apply (rule mult_left_mono) using \<open>C \<ge> 1\<close> E[of m] by auto
       also have "... \<le> 2^k * (2^k * B m)"
         apply (intro mult_mono) using \<open>C \<le> 2^k\<close> \<open>C \<ge> 1\<close> \<open>E \<ge> 1\<close> \<open>E \<le> 2^k\<close> Bpos[of m] by auto
       also have "... \<le> 2^k * (2^k * (P * 2^(2 * k * r)))"
         apply (intro mult_left_mono) using * by auto
       also have "... = P * 2^(2 * k * Suc r)"
         using \<open>P > 0\<close> by (simp add: algebra_simps divide_simps mult_2_right power_add)
       finally show ?thesis by simp
     qed
   qed
   have I: "B n \<le> (P * 2^(2 * k)) * n^(2 * k)" if "n > 0" for n
   proof -
     define r::nat where "r = nat(floor(log 2 (real n)))"
     have *: "int r = floor(log 2 (real n))"
       unfolding r_def using \<open>0 < n\<close> by auto
     have I: "2^r \<le> n \<and> n < 2^(r+1)"
       using floor_log_nat_eq_powr_iff[OF _ \<open>n > 0\<close>, of 2 r] * by auto
     then have "B n \<le> P * 2^(2 * k * (r+1))"
       using Main[of n "r+1"] by auto
     also have "... = (P * 2^(2 * k)) * ((2^r)^(2*k))"
       by (simp add: power_add power_mult[symmetric])
     also have "... \<le> (P * 2^(2 * k)) * n^(2 * k)"
       apply (rule mult_left_mono) using I \<open>P > 0\<close> by (auto simp add: power_mono)
     finally show ?thesis by simp
   qed
   show ?thesis
     apply (rule exI[of _ "P * 2^(2 * k)"], rule exI[of _ "2 * k"])
     using I by auto
 qed
 
 end (*of locale locale pmpt_limit*)
 
 end (*of Normalizing_Sequences.thy*)
diff --git a/thys/First_Welfare_Theorem/Utility_Functions.thy b/thys/First_Welfare_Theorem/Utility_Functions.thy
--- a/thys/First_Welfare_Theorem/Utility_Functions.thy
+++ b/thys/First_Welfare_Theorem/Utility_Functions.thy
@@ -1,350 +1,350 @@
 (* License: LGPL *)
 (*
 Author: Julian Parsert <julian.parsert@gmail.com>
 Author: Cezary Kaliszyk
 *)
 
 
 section \<open> Utility Functions \<close>
 
 text \<open> Utility functions and results involving them. \<close>
 
 theory Utility_Functions
   imports
     Preferences
 begin
 
 
 subsection "Ordinal utility functions"
 
 text \<open> Ordinal utility function locale \<close>
 
 locale ordinal_utility =
   fixes carrier :: "'a set"
   fixes relation :: "'a relation"
   fixes u :: "'a \<Rightarrow> real"
   assumes util_def[iff]: "x \<in> carrier \<Longrightarrow> y \<in> carrier \<Longrightarrow> x \<succeq>[relation] y \<longleftrightarrow> u x \<ge> u y"
   assumes not_outside: "x \<succeq>[relation] y \<Longrightarrow> x \<in> carrier"
     and "x \<succeq>[relation] y \<Longrightarrow> y \<in> carrier"
 begin
 
 lemma util_def_conf: "x \<in> carrier \<Longrightarrow> y \<in> carrier \<Longrightarrow> u x \<ge> u y \<longleftrightarrow> x \<succeq>[relation] y"
   using util_def by blast
 
 lemma relation_subset_crossp:
   "relation \<subseteq> carrier \<times> carrier"
 proof
   fix x
   assume "x \<in> relation"
   have "\<forall>(a,b) \<in> relation. a \<in> carrier \<and> b \<in> carrier"
     by (metis (no_types, lifting) case_prod_conv ordinal_utility_axioms ordinal_utility_def surj_pair)
   then show "x \<in> carrier \<times> carrier"
     using \<open>x \<in> relation\<close> by auto
 qed
 
 text \<open> Utility function implies totality of relation \<close>
 lemma util_imp_total: "total_on carrier relation"
 proof
   fix x and y
   assume x_inc: "x \<in> carrier" and y_inc : "y \<in> carrier"
   have fst : "u x \<ge> u y \<or> u y \<ge> u x"
     using util_def by auto
   then show  "x \<succeq>[relation] y \<or> y \<succeq>[relation] x"
     by (simp add: x_inc y_inc)
 qed
 
 lemma x_y_in_carrier: "x \<succeq>[relation] y \<Longrightarrow> x \<in> carrier \<and> y \<in> carrier"
   by (meson ordinal_utility_axioms ordinal_utility_def)
 
 text \<open> Utility function implies transitivity of relation. \<close>
 
 lemma util_imp_trans: "trans relation"
 proof (rule transI)
   fix x and y and z
   assume x_y: "x \<succeq>[relation] y"
   assume y_z: "y \<succeq>[relation] z"
   have x_ge_y: "x \<succeq>[relation] y"
     using x_y by auto
   then have x_y: "u x \<ge> u y"
     by (meson x_y_in_carrier ordinal_utility_axioms util_def x_y)
   have "u y \<ge> u z"
     by (meson y_z ordinal_utility_axioms ordinal_utility_def)
   have "x \<in> carrier"
     using x_y_in_carrier[of x y] x_ge_y  by simp
   then have "u x \<ge> u z"
     using \<open>u z \<le> u y\<close> order_trans x_y by blast
   hence "x \<succeq>[relation] z"
     by (meson \<open>x \<in> carrier\<close> ordinal_utility_axioms ordinal_utility_def y_z)
   then show "x \<succeq>[relation] z" .
 qed
 
 lemma util_imp_refl: "refl_on carrier relation"
   by (simp add: refl_on_def relation_subset_crossp)
 
 lemma affine_trans_is_u:
   shows "\<forall>\<alpha>>0. (\<forall>\<beta>. ordinal_utility  carrier relation (\<lambda>x. u(x)*\<alpha> + \<beta>))"
 proof (rule allI, rule impI, rule allI)
   fix \<alpha>::real and \<beta>
   assume *:"\<alpha> > 0"
   show "ordinal_utility carrier relation (\<lambda>x. u x * \<alpha> + \<beta>)"
   proof (subst ordinal_utility_def, rule conjI, goal_cases)
     case 1
     then show ?case
-      by (metis * add.commute add_le_cancel_left not_le real_mult_less_iff1 util_def_conf)
+      by (metis * add.commute add_le_cancel_left not_le mult_less_iff1 util_def_conf)
   next
     case 2
     then show ?case 
       by (meson refl_on_domain util_imp_refl)
   qed
 qed
 
 text \<open> This utility function definition is ordinal.
         Hence they are only unique up to a monotone transformation. \<close>
 
 lemma ordinality_of_utility_function :
   fixes f :: "real \<Rightarrow> real"
   assumes monot: "monotone (>) (>) f"
   shows "(f \<circ> u) x > (f \<circ> u) y \<longleftrightarrow> u x > u y"
 proof -
   let ?func = "(\<lambda>x. f(u x))"
   have "\<forall>m n . u m \<ge> u n \<longleftrightarrow> ?func m \<ge> ?func n"
     by (metis le_less monot monotone_def not_less)
   hence "u x > u y \<longleftrightarrow> ?func x > ?func y"
     using not_le by blast
   thus ?thesis  by auto
 qed
 
 corollary utility_prefs_corresp :
   fixes f :: "real \<Rightarrow> real"
   assumes monotonicity : "monotone (>) (>) f"
   shows "\<forall>x\<in>carrier. \<forall>y\<in>carrier. (x,y) \<in> relation \<longleftrightarrow> (f \<circ> u) x \<ge> (f \<circ> u) y"
   by (meson monotonicity not_less ordinality_of_utility_function util_def_conf)
 
 corollary monotone_comp_is_utility:
   fixes f :: "real \<Rightarrow> real"
   assumes monot: "monotone (>) (>) f"
   shows "ordinal_utility carrier relation (f \<circ> u)"
 proof (rule ordinal_utility.intro, goal_cases)
 case (1 x y)
   then show ?case
     using monot utility_prefs_corresp by blast
 next
   case (2 x y)
   then show ?case
     using not_outside by blast
 next
   case (3 x y)
   then show ?case
     using x_y_in_carrier by blast
 qed
 
 lemma ordinal_utility_left:
   assumes "x \<succeq>[relation] y"
   shows "u x \<ge> u y"
   using assms x_y_in_carrier by blast
 
 lemma add_right:
   assumes "\<And>x y. x \<succeq>[relation] y \<Longrightarrow> f x \<ge> f y"
   shows   "ordinal_utility carrier relation (\<lambda>x. u x + f x)"
 proof (rule ordinal_utility.intro, goal_cases)
   case (1 x y)
   assume xy: "x \<in> carrier" "y \<in> carrier"
   then show ?case
   proof -
     have "u x \<le> u y \<longrightarrow> (\<exists>r. ((x, y) \<notin> relation \<and> \<not> r \<le> u x + f x) \<and> r \<le> u y + f y) \<or> u y \<le> u x"
       by (metis (no_types) add_le_cancel_left add_le_cancel_right assms util_def xy(1) xy(2))
     moreover show ?thesis
       by (meson add_mono assms calculation le_cases order_trans util_def xy(1) xy(2))
   qed
 next
   case (2 x y)
   then show ?case
     using not_outside by blast
 next
   case (3 x y)
   then show ?case
     using x_y_in_carrier by blast
 qed
 
 lemma add_left:
   assumes "\<And>x y. x \<succeq>[relation] y \<Longrightarrow> f x \<ge> f y"
   shows "ordinal_utility carrier relation (\<lambda>x. f x + u x)"
 proof -
   have "ordinal_utility carrier relation (\<lambda>x. u x + f x)"
     by (simp add: add_right assms)
   thus ?thesis using Groups.ab_semigroup_add_class.add.commute
     by (simp add: add.commute)
 qed
 
 
 lemma ordinal_utility_scale_transl:
   assumes "(c::real) > 0"
   shows "ordinal_utility carrier relation (\<lambda>x. c * (u x) + d)"
 proof -
   have "monotone (>) (>) (\<lambda>x. c * x + d)" (is "monotone (>) (>) ?fn" )
     by (simp add: assms monotone_def)
   with monotone_comp_is_utility have "ordinal_utility carrier relation (?fn \<circ> u)"
     by blast
   moreover have "?fn \<circ> u =  (\<lambda>x. c * (u x) + d)"
     by auto
   finally show ?thesis
     by auto
 qed
 
 lemma strict_prefernce_iff_strict_utility:
   assumes "x \<in> carrier"
   assumes "y \<in> carrier"
   shows "x \<succ>[relation] y \<longleftrightarrow> u x > u y"
   by (meson assms(1) assms(2) less_eq_real_def not_less util_def)
 
 end
 
 text \<open> A utility function implies a rational preference relation.
       Hence a utility function contains exactly the same amount of information as a RPR \<close>
 
 sublocale ordinal_utility \<subseteq> rational_preference carrier relation
 proof
   fix x and y
   assume xy: "x \<succeq>[relation] y"
   then show "x \<in> carrier"
     and "y \<in> carrier"
     using not_outside by (simp)
       (meson xy refl_onD2 util_imp_refl)
 next
   show "preorder_on carrier relation"
   proof-
     have "trans relation" using util_imp_trans by auto
     then have "preorder_on carrier relation"
       by (simp add: preorder_on_def util_imp_refl)
     then show ?thesis .
   qed
 next
   show "total_on carrier relation"
     by (simp add: util_imp_total)
 qed
 
 
 text \<open> Given a finite carrier set. We can guarantee that given a rational preference
        relation, there must also exist a utility function representing this relation.
        Construction of witness roughly follows from.\<close>
 
 theorem fnt_carrier_exists_util_fun:
   assumes "finite carrier"
   assumes "rational_preference carrier relation"
   shows "\<exists>u. ordinal_utility carrier relation u"
 proof-
   define f where
     f: "f = (\<lambda>x. card (no_better_than x carrier relation))"
   have "ordinal_utility carrier relation f"
   proof
     fix x y
     assume x_c: "x \<in> carrier"
     assume y_c: "y \<in> carrier"
     show "x \<succeq>[relation] y \<longleftrightarrow> (real (f y) \<le> real (f x))"
     proof
       assume asm: "x \<succeq>[relation] y"
       define yn where
         yn: "yn = no_better_than y carrier relation"
       define xn where
         xn: "xn = no_better_than x carrier relation"
       then have "yn \<subseteq> xn"
         by (simp add: asm yn assms(2) rational_preference.no_better_subset_pref)
       then have "card yn \<le> card xn"
         by (simp add: x_c y_c asm assms(1) assms(2) rational_preference.card_leq_pref xn yn)
       then show "(real (f y) \<le> real (f x))"
         using  f xn yn by simp
     next
       assume "real (f y) \<le> real (f x)"
       then show "x \<succeq>[relation] y"
         using assms(1) assms(2) f rational_preference.card_leq_pref x_c y_c by fastforce
     qed
   next
     fix x y
     assume asm: "x \<succeq>[relation] y"
     show "x \<in> carrier"
       by (meson asm assms(2) preference.not_outside rational_preference.axioms(1))
     show "y \<in> carrier"
       by (meson asm assms(2) preference_def rational_preference_def)
   qed
   then show ?thesis
     by blast
 qed
 
 corollary obt_u_fnt_carrier:
   assumes "finite carrier"
   assumes "rational_preference carrier relation"
   obtains u where "ordinal_utility carrier relation u"
   using assms(1) assms(2) fnt_carrier_exists_util_fun by blast
 
 theorem ordinal_util_imp_rat_prefs:
   assumes "ordinal_utility carrier relation u"
   shows "rational_preference carrier relation"
   by (metis (full_types) assms order_on_defs(1) ordinal_utility.util_imp_refl 
       ordinal_utility.util_imp_total ordinal_utility.util_imp_trans ordinal_utility_def 
       preference.intro rational_preference.intro rational_preference_axioms_def)
 
 subsection \<open> Utility function on  Euclidean Space \<close>
 
 locale eucl_ordinal_utility = ordinal_utility carrier relation u
   for carrier :: "('a::euclidean_space) set"
   and relation :: "'a relation"
   and u :: "'a \<Rightarrow> real"
 
 sublocale eucl_ordinal_utility \<subseteq> rational_preference carrier relation
   using rational_preference_axioms by blast
 
 
 lemma ord_eucl_utility_imp_rpr: "eucl_ordinal_utility s rel u \<longrightarrow> real_vector_rpr s rel"
   using eucl_ordinal_utility.axioms ordinal_util_imp_rat_prefs real_vector_rpr.intro by blast
 
 context eucl_ordinal_utility
 begin
 
 text \<open> Local non-satiation on utility functions \<close>
 
 lemma lns_pref_lns_util [iff]:
   "local_nonsatiation carrier relation \<longleftrightarrow>
   (\<forall>x\<in>carrier. \<forall>e > 0. \<exists>y\<in>carrier.
   norm (y - x) \<le> e \<and> u y > u x)" (is "_ \<longleftrightarrow> ?alt")
 proof
   assume lns: "local_nonsatiation carrier relation"
   have "\<forall>a b. a \<succ> b \<longrightarrow> u a > u b"
     by (metis less_eq_real_def util_def x_y_in_carrier)
   then show "?alt"
     by (meson lns local_nonsatiation_def)
 next
   assume lns: "?alt"
   show "local_nonsatiation carrier relation"
   proof(rule lns_normI)
     fix x and e::real
     assume x_in: "x \<in> carrier"
     assume e: "e > 0"
     have "\<forall>x \<in> carrier. \<forall>e>0. \<exists>y\<in>carrier. norm (y - x) \<le> e \<and> y \<succ> x"
       by (meson less_eq_real_def linorder_not_less lns util_def)
     have "\<exists>y\<in>carrier. norm (y - x) \<le> e \<and> u y > u x"
       using e x_in lns by blast
     then show "\<exists>y\<in>carrier. norm (y - x) \<le> e \<and> y \<succ> x"
       by (meson compl not_less util_def x_in)
   qed
 qed
 
 end
 
 lemma finite_carrier_rpr_iff_u:
   assumes "finite carrier"
     and "(relation::'a relation) \<subseteq> carrier \<times> carrier"
   shows "rational_preference carrier relation \<longleftrightarrow> (\<exists>u. ordinal_utility carrier relation u)"
 proof
   assume "rational_preference carrier relation" 
   then show "\<exists>u. ordinal_utility carrier relation u"
     by (simp add: assms(1) fnt_carrier_exists_util_fun)
 next
   assume "\<exists>u. ordinal_utility carrier relation u"
   then show "rational_preference carrier relation" 
     by (metis (full_types) order_on_defs(1) ordinal_utility.util_imp_refl 
         ordinal_utility.util_imp_total ordinal_utility.util_imp_trans ordinal_utility_def 
         preference.intro rational_preference_axioms_def rational_preference_def)
 qed
 
 
 end
\ No newline at end of file
diff --git a/thys/Fourier/Fourier.thy b/thys/Fourier/Fourier.thy
--- a/thys/Fourier/Fourier.thy
+++ b/thys/Fourier/Fourier.thy
@@ -1,2742 +1,2742 @@
 section\<open>The basics of Fourier series\<close>
 
 text\<open>Ported from HOL Light; thanks to Manuel Eberl for help with the real asymp proof methods\<close>
 
 theory "Fourier"
   imports Periodic Square_Integrable "HOL-Real_Asymp.Real_Asymp" Confine Fourier_Aux2
 begin
 
 subsection\<open>Orthonormal system of L2 functions and their Fourier coefficients\<close>
 
 definition orthonormal_system :: "'a::euclidean_space set \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> bool"
   where "orthonormal_system S w \<equiv> \<forall>m n. l2product S (w m) (w n) = (if m = n then 1 else 0)"
 
 definition orthonormal_coeff :: "'a::euclidean_space set \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> nat \<Rightarrow> real"
   where "orthonormal_coeff S w f n = l2product S (w n) f"
 
 lemma orthonormal_system_eq: "orthonormal_system S w \<Longrightarrow> l2product S (w m) (w n) = (if m = n then 1 else 0)"
   by (simp add: orthonormal_system_def)
 
 lemma orthonormal_system_l2norm:
    "orthonormal_system S w \<Longrightarrow> l2norm S (w i) = 1"
   by (simp add: l2norm_def orthonormal_system_def)
 
 lemma orthonormal_partial_sum_diff:
   assumes os: "orthonormal_system S w" and w: "\<And>i. (w i) square_integrable S"
     and f: "f square_integrable S" and "finite I"
   shows "(l2norm S (\<lambda>x. f x - (\<Sum>i\<in>I. a i * w i x)))\<^sup>2 =
         (l2norm S f)\<^sup>2 + (\<Sum>i\<in>I. (a i)\<^sup>2) -  2 * (\<Sum>i\<in>I. a i * orthonormal_coeff S w f i)"
 proof -
   have "S \<in> sets lebesgue"
     using f square_integrable_def by blast
   then have "(\<lambda>x. \<Sum>i\<in>I. a i * w i x) square_integrable S"
     by (intro square_integrable_sum square_integrable_lmult w \<open>finite I\<close>)
   with assms show ?thesis
     apply (simp add: l2norm_pow_2 orthonormal_coeff_def orthonormal_system_def)
     apply (simp add: l2product_rdiff l2product_sym
            l2product_rsum l2product_rmult algebra_simps power2_eq_square if_distrib [of "\<lambda>x. _ * x"])
     done
 qed
 
 lemma orthonormal_optimal_partial_sum:
   assumes "orthonormal_system S w" "\<And>i. (w i) square_integrable S"
           "f square_integrable S" "finite I"
   shows "l2norm S (\<lambda>x. f x - (\<Sum>i\<in>I. orthonormal_coeff S w f i * w i x))
        \<le> l2norm S (\<lambda>x. f x - (\<Sum>i\<in>I. a i * w i x))"
 proof -
   have "2 * (a i * l2product S f(w i)) \<le> (a i)\<^sup>2 + (l2product S f(w i))\<^sup>2" for i
     using sum_squares_bound [of "a i" "l2product S f(w i)"]
     by (force simp: algebra_simps)
   then have *: "2 * (\<Sum>i\<in>I. a i * l2product S f(w i)) \<le> (\<Sum>i\<in>I. (a i)\<^sup>2 + (l2product S f(w i))\<^sup>2)"
     by (simp add: sum_distrib_left sum_mono)
   have S: "S \<in> sets lebesgue"
     using assms square_integrable_def by blast
   with assms * show ?thesis
     apply (simp add: l2norm_le square_integrable_sum square_integrable_diff square_integrable_lmult flip: l2norm_pow_2)
     apply (simp add: orthonormal_coeff_def orthonormal_partial_sum_diff)
     apply (simp add: l2product_sym power2_eq_square sum.distrib)
     done
 qed
 
 lemma Bessel_inequality:
   assumes "orthonormal_system S w" "\<And>i. (w i) square_integrable S"
     "f square_integrable S" "finite I"
   shows "(\<Sum>i\<in>I. (orthonormal_coeff S w f i)\<^sup>2) \<le> (l2norm S f)\<^sup>2"
   using orthonormal_partial_sum_diff [OF assms, of "orthonormal_coeff S w f"]
   apply (simp add: algebra_simps flip: power2_eq_square)
   by (metis (lifting) add_diff_cancel_left' diff_ge_0_iff_ge zero_le_power2)
 
 lemma Fourier_series_square_summable:
   assumes os: "orthonormal_system S w" and w: "\<And>i. (w i) square_integrable S"
     and f: "f square_integrable S"
   shows "summable (confine (\<lambda>i. (orthonormal_coeff S w f i) ^ 2) I)"
 proof -
   have "incseq (\<lambda>n. \<Sum>i\<in>I \<inter> {..n}. (orthonormal_coeff S w f i)\<^sup>2)"
     by (auto simp: incseq_def intro: sum_mono2)
   moreover have "\<And>i. (\<Sum>i\<in>I \<inter> {..i}. (orthonormal_coeff S w f i)\<^sup>2) \<le> (l2norm S f)\<^sup>2"
     by (simp add: Bessel_inequality assms)
   ultimately obtain L where "(\<lambda>n. \<Sum>i\<in>I \<inter> {..n}. (orthonormal_coeff S w f i)\<^sup>2) \<longlonglongrightarrow> L"
     using incseq_convergent by blast
   then have "\<forall>r>0. \<exists>no. \<forall>n\<ge>no. \<bar>(\<Sum>i\<in>{..n} \<inter> I. (orthonormal_coeff S w f i)\<^sup>2) - L\<bar> < r"
     by (simp add: LIMSEQ_iff Int_commute)
   then show ?thesis
     by (auto simp: summable_def sums_confine_le LIMSEQ_iff)
 qed
 
 lemma orthonormal_Fourier_partial_sum_diff_squared:
   assumes os: "orthonormal_system S w" and w: "\<And>i. (w i) square_integrable S"
     and f: "f square_integrable S" and "finite I"
   shows "(l2norm S (\<lambda>x. f x -(\<Sum>i\<in>I. orthonormal_coeff S w f i * w i x)))\<^sup>2 =
          (l2norm S f)\<^sup>2 - (\<Sum>i\<in>I. (orthonormal_coeff S w f i)\<^sup>2)"
   using orthonormal_partial_sum_diff [OF assms, where a = "orthonormal_coeff S w f"]
   by (simp add: power2_eq_square)
 
 
 lemma Fourier_series_l2_summable:
   assumes os: "orthonormal_system S w" and w: "\<And>i. (w i) square_integrable S"
     and f: "f square_integrable S"
   obtains g where "g square_integrable S"
                   "(\<lambda>n. l2norm S (\<lambda>x. (\<Sum>i\<in>I \<inter> {..n}. orthonormal_coeff S w f i * w i x) - g x))
                    \<longlonglongrightarrow> 0"
 proof -
   have S: "S \<in> sets lebesgue"
     using f square_integrable_def by blast
   let ?\<Theta> = "\<lambda>A x. (\<Sum>i\<in>I \<inter> A. orthonormal_coeff S w f i * w i x)"
   let ?\<Psi> = "confine (\<lambda>i. (orthonormal_coeff S w f i)\<^sup>2) I"
   have si: "?\<Theta> A square_integrable S" if "finite A" for A
     by (force intro: square_integrable_lmult w square_integrable_sum S that)
   have "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. l2norm S (\<lambda>x. ?\<Theta> {..m} x - ?\<Theta> {..n} x) < e"
     if "e > 0" for e
   proof -
     have "summable ?\<Psi>"
       by (rule Fourier_series_square_summable [OF os w f])
     then have "Cauchy (\<lambda>n. sum ?\<Psi> {..n})"
       by (simp add: summable_def sums_def_le convergent_eq_Cauchy)
     then obtain M where M: "\<And>m n. \<lbrakk>m\<ge>M; n\<ge>M\<rbrakk> \<Longrightarrow> dist (sum ?\<Psi> {..m}) (sum ?\<Psi> {..n}) < e\<^sup>2"
       using \<open>e > 0\<close> unfolding Cauchy_def by (drule_tac x="e^2" in spec) auto
     have "\<lbrakk>m\<ge>M; n\<ge>M\<rbrakk> \<Longrightarrow> l2norm S (\<lambda>x. ?\<Theta> {..m} x - ?\<Theta> {..n} x) < e" for m n
     proof (induct m n rule: linorder_class.linorder_wlog)
       case (le m n)
       have sum_diff: "sum f(I \<inter> {..n}) - sum f(I \<inter> {..m}) = sum f(I \<inter> {Suc m..n})" for f :: "nat \<Rightarrow> real"
       proof -
         have "(I \<inter> {..n}) =  (I \<inter> {..m} \<union> I \<inter> {Suc m..n})" "(I \<inter> {..m}) \<inter> (I \<inter> {Suc m..n}) = {}"
           using le by auto
         then show ?thesis
           by (simp add: algebra_simps flip: sum.union_disjoint)
       qed
       have "(l2norm S (\<lambda>x. ?\<Theta> {..n} x - ?\<Theta> {..m} x))^2
             \<le> \<bar>(\<Sum>i\<in>I \<inter> {..n}. (orthonormal_coeff S w f i)\<^sup>2) - (\<Sum>i\<in>I \<inter> {..m}. (orthonormal_coeff S w f i)\<^sup>2)\<bar>"
       proof (simp add: sum_diff)
         have "(l2norm S (?\<Theta> {Suc m..n}))\<^sup>2
             = (\<Sum>i\<in>I \<inter> {Suc m..n}. l2product S (\<lambda>x. \<Sum>j\<in>I \<inter> {Suc m..n}. orthonormal_coeff S w f j * w j x)
                                                (\<lambda>x. orthonormal_coeff S w f i * w i x))"
           by (simp add: l2norm_pow_2 l2product_rsum si w)
         also have "\<dots> = (\<Sum>i\<in>I \<inter> {Suc m..n}. \<Sum>j\<in>I \<inter> {Suc m..n}.
                             orthonormal_coeff S w f j * orthonormal_coeff S w f i * l2product S (w j) (w i))"
           by (simp add: l2product_lsum l2product_lmult l2product_rmult si w flip: mult.assoc)
         also have "\<dots> \<le> \<bar>\<Sum>i\<in>I \<inter> {Suc m..n}. (orthonormal_coeff S w f i)\<^sup>2\<bar>"
           by (simp add: orthonormal_system_eq [OF os] power2_eq_square if_distrib [of "(*)_"] cong: if_cong)
         finally show "(l2norm S (?\<Theta> {Suc m..n}))\<^sup>2 \<le> \<bar>\<Sum>i\<in>I \<inter> {Suc m..n}. (orthonormal_coeff S w f i)\<^sup>2\<bar>" .
       qed
       also have "\<dots> < e\<^sup>2"
         using M [OF \<open>n\<ge>M\<close> \<open>m\<ge>M\<close>]
         by (simp add: dist_real_def sum_confine_eq_Int Int_commute)
       finally have "(l2norm S (\<lambda>x. ?\<Theta> {..m} x - ?\<Theta> {..n} x))^2 < e^2"
         using l2norm_diff [OF si si] by simp
       with \<open>e > 0\<close> show ?case
         by (simp add: power2_less_imp_less)
     next
       case (sym a b)
       then show ?case
         by (subst l2norm_diff) (auto simp: si)
     qed
     then show ?thesis
       by blast
   qed
   with that show thesis
     by (blast intro: si [of "{.._}"] l2_complete [of "\<lambda>n. ?\<Theta> {..n}"])
 qed
 
 lemma Fourier_series_l2_summable_strong:
   assumes os: "orthonormal_system S w" and w: "\<And>i. (w i) square_integrable S"
     and f: "f square_integrable S"
   obtains g where "g square_integrable S"
           "\<And>i. i \<in> I \<Longrightarrow> orthonormal_coeff S w (\<lambda>x. f x - g x) i = 0"
           "(\<lambda>n. l2norm S (\<lambda>x. (\<Sum>i\<in>I \<inter> {..n}. orthonormal_coeff S w f i * w i x) - g x))
            \<longlonglongrightarrow> 0"
 proof -
   have S: "S \<in> sets lebesgue"
     using f square_integrable_def by blast
   obtain g where g: "g square_integrable S"
             and teng: "(\<lambda>n. l2norm S (\<lambda>x. (\<Sum>i\<in>I \<inter> {..n}. orthonormal_coeff S w f i * w i x) - g x))
                        \<longlonglongrightarrow> 0"
     using Fourier_series_l2_summable [OF assms] .
   show thesis
   proof
     show "orthonormal_coeff S w (\<lambda>x. f x - g x) i = 0"
       if "i \<in> I" for i
     proof (rule tendsto_unique)
       let ?\<Theta> = "\<lambda>A x. (\<Sum>i\<in>I \<inter> A. orthonormal_coeff S w f i * w i x)"
       let ?f = "\<lambda>n. l2product S (w i) (\<lambda>x. (f x - ?\<Theta> {..n} x) + (?\<Theta> {..n} x - g x))"
       show "?f \<longlonglongrightarrow> orthonormal_coeff S w (\<lambda>x. f x - g x) i"
         by (simp add: orthonormal_coeff_def)
       have 1: "(\<lambda>n. l2product S (w i) (\<lambda>x. f x - ?\<Theta> {..n} x)) \<longlonglongrightarrow> 0"
         proof (rule tendsto_eventually)
           have "l2product S (w i) (\<lambda>x. f x - ?\<Theta> {..j} x) = 0"
             if "j \<ge> i" for j
             using that \<open>i \<in> I\<close>
             apply (simp add: l2product_rdiff l2product_rsum l2product_rmult orthonormal_coeff_def w f S)
             apply (simp add: orthonormal_system_eq [OF os] if_distrib [of "(*)_"] cong: if_cong)
             done
           then show "\<forall>\<^sub>F n in sequentially. l2product S (w i) (\<lambda>x. f x - ?\<Theta> {..n} x) = 0"
             using eventually_at_top_linorder by blast
         qed
         have 2: "(\<lambda>n. l2product S (w i) (\<lambda>x. ?\<Theta> {..n} x - g x)) \<longlonglongrightarrow> 0"
         proof (intro Lim_null_comparison [OF _ teng] eventuallyI)
           show "norm (l2product S (w i) (\<lambda>x. ?\<Theta> {..n} x - g x)) \<le> l2norm S (\<lambda>x. ?\<Theta> {..n} x - g x)" for n
             using Schwartz_inequality_abs [of "w i" S "(\<lambda>x. ?\<Theta> {..n} x - g x)"]
             by (simp add: S g f w orthonormal_system_l2norm [OF os])
         qed
         show "?f \<longlonglongrightarrow> 0"
           using that tendsto_add [OF 1 2]
           by (subst l2product_radd) (simp_all add: l2product_radd w f g S)
       qed auto
   qed (auto simp: g teng)
 qed
 
 
 subsection\<open>Actual trigonometric orthogonality relations\<close>
 
 lemma integrable_sin_cx:
   "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. sin(x * c))"
   by (intro continuous_imp_integrable_real continuous_intros)
 
 lemma integrable_cos_cx:
   "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. cos(x * c))"
   by (intro continuous_imp_integrable_real continuous_intros)
 
 lemma integral_cos_Z' [simp]:
   assumes "n \<in> \<int>"
   shows "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(n * x)) = (if n = 0 then 2 * pi else 0)"
   by (metis assms integral_cos_Z mult_commute_abs)
 
 lemma integral_sin_and_cos:
   fixes m n::int
   shows
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(m * x) * cos(n * x)) = (if \<bar>m\<bar> = \<bar>n\<bar> then if n = 0 then 2 * pi else pi else 0)"
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(m * x) * sin(n * x)) = 0"
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin(m * x) * cos(n * x)) = 0"
   "\<lbrakk>m \<ge> 0; n \<ge> 0\<rbrakk> \<Longrightarrow> integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin (m * x) * sin (n * x)) = (if m = n \<and> n \<noteq> 0 then pi else 0)"
   "\<bar>integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin (m * x) * sin (n * x))\<bar> = (if \<bar>m\<bar> = \<bar>n\<bar> \<and> n \<noteq> 0 then pi else 0)"
   by (simp_all add: abs_if sin_times_sin cos_times_sin sin_times_cos cos_times_cos
                     integrable_sin_cx integrable_cos_cx mult_ac
                flip: distrib_left distrib_right left_diff_distrib right_diff_distrib)
 
 lemma integral_sin_and_cos_Z [simp]:
   fixes m n::real
   assumes "m \<in> \<int>" "n \<in> \<int>"
   shows
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(m * x) * cos(n * x)) = (if \<bar>m\<bar> = \<bar>n\<bar> then if n = 0 then 2 * pi else pi else 0)"
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(m * x) * sin(n * x)) = 0"
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin(m * x) * cos(n * x)) = 0"
   "\<bar>integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin (m * x) * sin (n * x))\<bar> = (if \<bar>m\<bar> = \<bar>n\<bar> \<and> n \<noteq> 0 then pi else 0)"
   using assms unfolding Ints_def
      apply safe
   unfolding integral_sin_and_cos
      apply auto
   done
 
 lemma integral_sin_and_cos_N [simp]:
   fixes m n::real
   assumes "m \<in> \<nat>" "n \<in> \<nat>"
   shows "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin (m * x) * sin (n * x)) = (if m = n \<and> n \<noteq> 0 then pi else 0)"
   using assms unfolding Nats_altdef1 by (auto simp: integral_sin_and_cos)
 
 
 lemma integrable_sin_and_cos:
   fixes m n::int
   shows "integrable (lebesgue_on {a..b}) (\<lambda>x. cos(x * m) * cos(x * n))"
         "integrable (lebesgue_on {a..b}) (\<lambda>x. cos(x * m) * sin(x * n))"
         "integrable (lebesgue_on {a..b}) (\<lambda>x. sin(x * m) * cos(x * n))"
         "integrable (lebesgue_on {a..b}) (\<lambda>x. sin(x * m) * sin(x * n))"
   by (intro continuous_imp_integrable_real continuous_intros)+
 
 lemma sqrt_pi_ge1: "sqrt pi \<ge> 1"
   using pi_gt3 by auto
 
 definition trigonometric_set :: "nat \<Rightarrow> real \<Rightarrow> real"
   where "trigonometric_set n \<equiv>
     if n = 0 then \<lambda>x. 1 / sqrt(2 * pi)
     else if odd n then \<lambda>x. sin(real(Suc (n div 2)) * x) / sqrt(pi)
     else (\<lambda>x. cos((n div 2) * x) / sqrt pi)"
 
 lemma trigonometric_set:
   "trigonometric_set 0 x = 1 / sqrt(2 * pi)"
   "trigonometric_set (Suc (2 * n)) x = sin(real(Suc n) * x) / sqrt(pi)"
   "trigonometric_set (2 * n + 2) x = cos(real(Suc n) * x) / sqrt(pi)"
   "trigonometric_set (Suc (Suc (2 * n))) x = cos(real(Suc n) * x) / sqrt(pi)"
   by (simp_all add: trigonometric_set_def algebra_simps add_divide_distrib)
 
 lemma trigonometric_set_even:
    "trigonometric_set(2*k) = (if k = 0 then (\<lambda>x. 1 / sqrt(2 * pi)) else (\<lambda>x. cos(k * x) / sqrt pi))"
   by (induction k) (auto simp: trigonometric_set_def add_divide_distrib split: if_split_asm)
 
 lemma orthonormal_system_trigonometric_set:
     "orthonormal_system {-pi..pi} trigonometric_set"
 proof -
   have "l2product {-pi..pi} (trigonometric_set m) (trigonometric_set n) = (if m = n then 1 else 0)" for m n
   proof (induction m rule: odd_even_cases)
     case 0
     show ?case
       by (induction n rule: odd_even_cases) (auto simp: trigonometric_set l2product_def measure_restrict_space)
   next
     case (odd m)
     show ?case
       by (induction n rule: odd_even_cases) (auto simp: trigonometric_set l2product_def double_not_eq_Suc_double)
   next
     case (even m)
     show ?case
       by (induction n rule: odd_even_cases) (auto simp: trigonometric_set l2product_def Suc_double_not_eq_double)
   qed
   then show ?thesis
     unfolding orthonormal_system_def by auto
 qed
 
 
 lemma square_integrable_trigonometric_set:
    "(trigonometric_set i) square_integrable {-pi..pi}"
 proof -
   have "continuous_on {-pi..pi} (\<lambda>x. sin ((1 + real n) * x) / sqrt pi)" for n
     by (intro continuous_intros) auto
   moreover
   have "continuous_on {-pi..pi} (\<lambda>x. cos (real i * x / 2) / sqrt pi) "
     by (intro continuous_intros) auto
   ultimately show ?thesis
     by (simp add: trigonometric_set_def)
 qed
 
 subsection\<open>Weierstrass for trigonometric polynomials\<close>
 
 lemma Weierstrass_trig_1:
   fixes g :: "real \<Rightarrow> real"
   assumes contf: "continuous_on UNIV g" and periodic: "\<And>x. g(x + 2 * pi) = g x" and 1: "norm z = 1"
   shows "continuous (at z within (sphere 0 1)) (g \<circ> Im \<circ> Ln)"
 proof (cases "Re z < 0")
   let ?f = "complex_of_real \<circ> g \<circ> (\<lambda>x. x + pi) \<circ> Im \<circ> Ln \<circ> uminus"
   case True
   have "continuous (at z within (sphere 0 1)) (complex_of_real \<circ> g \<circ> Im \<circ> Ln)"
   proof (rule continuous_transform_within)
     have [simp]: "z \<notin> \<real>\<^sub>\<ge>\<^sub>0"
       using True complex_nonneg_Reals_iff by auto
     show "continuous (at z within (sphere 0 1)) ?f"
       by (intro continuous_within_Ln continuous_intros continuous_on_imp_continuous_within [OF contf]) auto
     show "?f x' =  (complex_of_real \<circ> g \<circ> Im \<circ> Ln) x'"
       if "x' \<in> (sphere 0 1)" and "dist x' z < 1" for x'
     proof -
       have "x' \<noteq> 0"
         using that by auto
       with that show ?thesis
         by (auto simp: Ln_minus add.commute periodic)
     qed
   qed (use 1 in auto)
   then have "continuous (at z within (sphere 0 1)) (Re \<circ> complex_of_real \<circ> g \<circ> Im \<circ> Ln)"
     unfolding o_def by (rule continuous_Re)
   then show ?thesis
     by (simp add: o_def)
 next
   case False
   let ?f = "complex_of_real \<circ> g \<circ> Im \<circ> Ln \<circ> uminus"
   have "z \<noteq> 0"
     using 1 by auto
   with False have "z \<notin> \<real>\<^sub>\<le>\<^sub>0"
     by (auto simp: not_less nonpos_Reals_def)
   then have "continuous (at z within (sphere 0 1)) (complex_of_real \<circ> g \<circ> Im \<circ> Ln)"
     by (intro continuous_within_Ln continuous_intros continuous_on_imp_continuous_within [OF contf]) auto
   then have "continuous (at z within (sphere 0 1)) (Re \<circ> complex_of_real \<circ> g \<circ> Im \<circ> Ln)"
     unfolding o_def by (rule continuous_Re)
   then show ?thesis
     by (simp add: o_def)
 qed
 
 inductive_set cx_poly :: "(complex \<Rightarrow> real) set" where
     Re: "Re \<in> cx_poly"
   | Im: "Im \<in> cx_poly"
   | const: "(\<lambda>x. c) \<in> cx_poly"
   | add:   "\<lbrakk>f \<in> cx_poly; g \<in> cx_poly\<rbrakk> \<Longrightarrow> (\<lambda>x. f x + g x) \<in> cx_poly"
   | mult:  "\<lbrakk>f \<in> cx_poly; g \<in> cx_poly\<rbrakk> \<Longrightarrow> (\<lambda>x. f x * g x) \<in> cx_poly"
 
 declare cx_poly.intros [intro]
 
 
 lemma Weierstrass_trig_polynomial:
   assumes contf: "continuous_on {-pi..pi} f" and fpi: "f(-pi) = f pi" and "0 < e"
   obtains n::nat and a b where
     "\<And>x::real. x \<in> {-pi..pi} \<Longrightarrow> \<bar>f x - (\<Sum>k\<le>n. a k * sin (k * x) + b k * cos (k * x))\<bar> < e"
 proof -
   interpret CR: function_ring_on "cx_poly" "sphere 0 1"
   proof
     show "continuous_on (sphere 0 1) f" if "f \<in> cx_poly" for f
       using that by induction (assumption | intro continuous_intros)+
     fix x y::complex
     assume "x \<in> sphere 0 1" and "y \<in> sphere 0 1" and "x \<noteq> y"
     then consider "Re x \<noteq> Re y" | "Im x \<noteq> Im y"
       using complex_eqI by blast
     then show "\<exists>f\<in>cx_poly. f x \<noteq> f y"
       by (metis cx_poly.Im cx_poly.Re)
   qed (auto simp: cx_poly.intros)
   have "continuous (at z within (sphere 0 1)) (f \<circ> Im \<circ> Ln)" if "norm z = 1" for z
   proof -
     obtain g where contg: "continuous_on UNIV g" and gf: "\<And>x. x \<in> {-pi..pi} \<Longrightarrow> g x = f x"
       and periodic: "\<And>x. g(x + 2*pi) = g x"
       using Tietze_periodic_interval [OF contf fpi] by auto
     let ?f = "(g \<circ> Im \<circ> Ln)"
     show ?thesis
     proof (rule continuous_transform_within)
       show "continuous (at z within (sphere 0 1)) ?f"
         using Weierstrass_trig_1 [OF contg periodic that] by (simp add: sphere_def)
       show "?f x' = (f \<circ> Im \<circ> Ln) x'"
         if "x' \<in> sphere 0 1" "dist x' z < 1" for x'
       proof -
         have "x' \<noteq> 0"
           using that by auto
         then have "Im (Ln x') \<in> {-pi..pi}"
           using Im_Ln_le_pi [of x'] mpi_less_Im_Ln [of x'] by simp
         then show ?thesis
           using gf by simp
       qed
     qed (use that in auto)
   qed
   then have "continuous_on (sphere 0 1) (f \<circ> Im \<circ> Ln)"
     using continuous_on_eq_continuous_within mem_sphere_0 by blast
   then obtain g where "g \<in> cx_poly" and g: "\<And>x. x \<in> sphere 0 1 \<Longrightarrow> \<bar>(f \<circ> Im \<circ> Ln) x - g x\<bar> < e"
     using CR.Stone_Weierstrass_basic [of "f \<circ> Im \<circ> Ln"] \<open>e > 0\<close> by meson
   define trigpoly where
     "trigpoly \<equiv> \<lambda>f. \<exists>n a b. f = (\<lambda>x. (\<Sum>k\<le>n. a k * sin(real k * x) +  b k * cos(real k * x)))"
   have tp_const: "trigpoly(\<lambda>x. c)" for c
     unfolding trigpoly_def
     by (rule_tac x=0 in exI) auto
   have tp_add: "trigpoly(\<lambda>x. f x + g x)" if "trigpoly f" "trigpoly g" for f g
   proof -
     obtain n1 a1 b1 where feq: "f = (\<lambda>x. \<Sum>k\<le>n1. a1 k * sin (real k * x) + b1 k * cos (real k * x))"
       using \<open>trigpoly f\<close> trigpoly_def by blast
     obtain n2 a2 b2 where geq: "g = (\<lambda>x. \<Sum>k\<le>n2. a2 k * sin (real k * x) + b2 k * cos (real k * x))"
       using \<open>trigpoly g\<close> trigpoly_def by blast
     let ?a = "\<lambda>n. (if n \<le> n1 then a1 n else 0) + (if n \<le> n2 then a2 n else 0)"
     let ?b = "\<lambda>n. (if n \<le> n1 then b1 n else 0) + (if n \<le> n2 then b2 n else 0)"
     have eq: "{k. k \<le> max a b \<and> k \<le> a} = {..a}" "{k. k \<le> max a b \<and> k \<le> b} = {..b}" for a b::nat
       by auto
     have "(\<lambda>x. f x + g x) = (\<lambda>x. \<Sum>k \<le> max n1 n2. ?a k * sin (real k * x) + ?b k * cos (real k * x))"
       by (simp add: feq geq algebra_simps eq sum.distrib if_distrib [of "\<lambda>u. _ * u"] cong: if_cong flip: sum.inter_filter)
     then show ?thesis
       unfolding trigpoly_def by meson
   qed
   have tp_sum: "trigpoly(\<lambda>x. \<Sum>i\<in>S. f i x)" if "finite S" "\<And>i. i \<in> S \<Longrightarrow> trigpoly(f i)" for f and S :: "nat set"
     using that
     by induction (auto simp: tp_const tp_add)
   have tp_cmul: "trigpoly(\<lambda>x. c * f x)" if "trigpoly f" for f c
   proof -
     obtain n a b where feq: "f = (\<lambda>x. \<Sum>k\<le>n. a k * sin (real k * x) + b k * cos (real k * x))"
       using \<open>trigpoly f\<close> trigpoly_def by blast
     have "(\<lambda>x. c * f x) = (\<lambda>x. \<Sum>k \<le> n. (c * a k) * sin (real k * x) + (c * b k) * cos (real k * x))"
       by (simp add: feq algebra_simps sum_distrib_left)
     then show ?thesis
       unfolding trigpoly_def by meson
   qed
   have tp_cdiv: "trigpoly(\<lambda>x. f x / c)" if "trigpoly f" for f c
     using tp_cmul [OF \<open>trigpoly f\<close>, of "inverse c"]
     by (simp add: divide_inverse_commute)
   have tp_diff: "trigpoly(\<lambda>x. f x - g x)" if "trigpoly f" "trigpoly g" for f g
     using tp_add [OF \<open>trigpoly f\<close> tp_cmul [OF \<open>trigpoly g\<close>, of "-1"]] by auto
   have tp_sin: "trigpoly(\<lambda>x. sin (n * x))" if "n \<in> \<nat>" for n
     unfolding trigpoly_def
   proof
     obtain k where "n = real k"
       using Nats_cases \<open>n \<in> \<nat>\<close> by blast
     then show "\<exists>a b. (\<lambda>x. sin (n * x)) = (\<lambda>x. \<Sum>i \<le> nat\<lfloor>n\<rfloor>. a i * sin (real i * x) + b i * cos (real i * x))"
       apply (rule_tac x="\<lambda>i. if i = k then 1 else 0" in exI)
       apply (rule_tac x="\<lambda>i. 0" in exI)
       apply (simp add: if_distrib [of "\<lambda>u. u * _"] cong: if_cong)
       done
   qed
   have tp_cos: "trigpoly(\<lambda>x. cos (n * x))" if "n \<in> \<nat>" for n
     unfolding trigpoly_def
   proof
     obtain k where "n = real k"
       using Nats_cases \<open>n \<in> \<nat>\<close> by blast
     then show "\<exists>a b. (\<lambda>x. cos (n * x)) = (\<lambda>x. \<Sum>i \<le> nat\<lfloor>n\<rfloor>. a i * sin (real i * x) + b i * cos (real i * x))"
       apply (rule_tac x="\<lambda>i. 0" in exI)
       apply (rule_tac x="\<lambda>i. if i = k then 1 else 0" in exI)
       apply (simp add: if_distrib [of "\<lambda>u. u * _"] cong: if_cong)
       done
   qed
   have tp_sincos: "trigpoly(\<lambda>x. sin(i * x) * sin(j * x)) \<and> trigpoly(\<lambda>x. sin(i * x) * cos(j * x)) \<and>
                    trigpoly(\<lambda>x. cos(i * x) * sin(j * x)) \<and> trigpoly(\<lambda>x. cos(i * x) * cos(j * x))" (is "?P i j")
     for i j::nat
   proof (rule linorder_wlog [of _ j i])
     show "?P j i" if "i \<le> j" for j i
       using that
       by (simp add: sin_times_sin cos_times_cos sin_times_cos cos_times_sin diff_divide_distrib 
                     tp_add tp_diff tp_cdiv tp_cos tp_sin flip: left_diff_distrib distrib_right)
   qed (simp add: mult_ac)
   have tp_mult: "trigpoly(\<lambda>x. f x * g x)" if "trigpoly f" "trigpoly g" for f g
   proof -
     obtain n1 a1 b1 where feq: "f = (\<lambda>x. \<Sum>k\<le>n1. a1 k * sin (real k * x) + b1 k * cos (real k * x))"
       using \<open>trigpoly f\<close> trigpoly_def by blast
     obtain n2 a2 b2 where geq: "g = (\<lambda>x. \<Sum>k\<le>n2. a2 k * sin (real k * x) + b2 k * cos (real k * x))"
       using \<open>trigpoly g\<close> trigpoly_def by blast
     then show ?thesis
       unfolding feq geq
       by (simp add: algebra_simps sum_product tp_sum tp_add tp_cmul tp_sincos del: mult.commute)
   qed
   have *: "trigpoly(\<lambda>x.  f(exp(\<i> * of_real x)))" if "f \<in> cx_poly" for f
     using that
   proof induction
     case Re
     then show ?case
       using tp_cos [of 1] by (auto simp: Re_exp)
   next
     case Im
     then show ?case
       using tp_sin [of 1] by (auto simp: Im_exp)
   qed (auto simp: tp_const tp_add tp_mult)
   obtain n a b where eq: "(g (iexp x)) = (\<Sum>k\<le>n. a k * sin (real k * x) + b k * cos (real k * x))" for x
     using * [OF \<open>g \<in> cx_poly\<close>] trigpoly_def by meson
   show thesis
     proof
     show "\<bar>f \<theta> - (\<Sum>k\<le>n. a k * sin (real k * \<theta>) + b k * cos (real k * \<theta>))\<bar> < e"
       if "\<theta> \<in> {-pi..pi}" for \<theta>
     proof -
       have "f \<theta> - g (iexp \<theta>) = (f \<circ> Im \<circ> Ln) (iexp \<theta>) - g (iexp \<theta>)"
       proof (cases "\<theta> = -pi")
       case True
         then show ?thesis
           by (simp add: exp_minus fpi)
     next
       case False
       then show ?thesis
         using that by auto
     qed
     then show ?thesis
       using g [of "exp(\<i> * of_real \<theta>)"] by (simp flip: eq)
     qed
   qed
 qed
 
 
 subsection\<open>A bit of extra hacking round so that the ends of a function are OK\<close>
 
 lemma integral_tweak_ends:
   fixes a b :: real
   assumes "a < b" "e > 0"
   obtains f where "continuous_on {a..b} f" "f a = d" "f b = 0" "l2norm {a..b} f < e"
 proof -
   have cont: "continuous_on {a..b}
           (\<lambda>x. if x \<le> a+1 / real(Suc n)
                then ((Suc n) * d) * ((a+1 / (Suc n)) - x) else 0)" for n
   proof (cases "a+1/(Suc n) \<le> b")
     case True
     have *: "1 / (1 + real n) > 0"
       by auto
     have abeq: "{a..b} = {a..a+1/(Suc n)} \<union> {a+1/(Suc n)..b}"
       using \<open>a < b\<close> True
       apply auto
       using "*" by linarith
     show ?thesis
       unfolding abeq
     proof (rule continuous_on_cases)
       show "continuous_on {a..a+1 / real (Suc n)} (\<lambda>x. real (Suc n) * d * (a+1 / real (Suc n) - x))"
         by (intro continuous_intros)
     qed auto
   next
     case False
     show ?thesis
     proof (rule continuous_on_eq [where f = "\<lambda>x. ((Suc n) * d) * ((a+1/(Suc n)) - x)"])
       show " continuous_on {a..b} (\<lambda>x. (Suc n) * d * (a+1 / real (Suc n) - x))"
         by (intro continuous_intros)
     qed (use False in auto)
   qed
   let ?f = "\<lambda>k x. (if x \<le> a+1 / (Suc k) then (Suc k) * d * (a+1 / (Suc k) - x) else 0)\<^sup>2"
   let ?g = "\<lambda>x. if x = a then d\<^sup>2 else 0"
   have bmg: "?g \<in> borel_measurable (lebesgue_on {a..b})"
     apply (rule measurable_restrict_space1)
     using borel_measurable_if_I [of _ "{a}", OF borel_measurable_const] by auto
   have bmf: "?f k \<in> borel_measurable (lebesgue_on {a..b})" for k
   proof -
     have bm: "(\<lambda>x. (Suc k) * d * (a+1 / real (Suc k) - x))
               \<in> borel_measurable (lebesgue_on {..a+1 / (Suc k)})"
       by (intro measurable) (auto simp: measurable_completion measurable_restrict_space1)
     show ?thesis
       apply (intro borel_measurable_power measurable_restrict_space1)
       using borel_measurable_if_I [of _ "{.. a+1 / (Suc k)}", OF bm]  apply auto
       done
   qed
   have int_d2: "integrable (lebesgue_on {a..b}) (\<lambda>x. d\<^sup>2)"
     by (intro continuous_imp_integrable_real continuous_intros)
   have "(\<lambda>k. ?f k x) \<longlonglongrightarrow> ?g x"
     if x: "x \<in> {a..b}" for x
   proof (cases "x = a")
     case False
     then have "x > a"
       using x by auto
     with x obtain N where "N > 0" and N: "1 / real N < x-a"
       using real_arch_invD [of "x-a"]
       by (force simp: inverse_eq_divide)
     then have "x > a+1 / (1 + real k)"
       if "k \<ge> N" for k
     proof -
       have "a+1 / (1 + real k) < a+1 / real N"
         using that \<open>0 < N\<close> by (simp add: field_simps)
       also have "\<dots> < x"
         using N by linarith
       finally show ?thesis .
     qed
     then show ?thesis
       apply (intro tendsto_eventually eventually_sequentiallyI [where c=N])
       by (fastforce simp: False)
   qed auto
   then have tends: "AE x in (lebesgue_on {a..b}). (\<lambda>k. ?f k x) \<longlonglongrightarrow> ?g x"
     by force
   have le_d2: "\<And>k. AE x in (lebesgue_on {a..b}). norm (?f k x) \<le> d\<^sup>2"
   proof
     show "norm ((if x \<le> a+1 / real (Suc k) then real (Suc k) * d * (a+1 / real (Suc k) - x) else 0)\<^sup>2) \<le> d\<^sup>2"
       if "x \<in> space (lebesgue_on {a..b})" for k x
       using that
       apply (simp add: abs_mult divide_simps flip: abs_le_square_iff)
       apply (auto simp: abs_if zero_less_mult_iff mult_left_le)
       done
   qed
   have integ: "integrable (lebesgue_on {a..b}) ?g"
     using integrable_dominated_convergence [OF bmg bmf int_d2 tends le_d2] by auto
   have int: "(\<lambda>k. integral\<^sup>L (lebesgue_on {a..b}) (?f k)) \<longlonglongrightarrow> integral\<^sup>L (lebesgue_on {a..b}) ?g"
     using integral_dominated_convergence [OF bmg bmf int_d2 tends le_d2] by auto
   then obtain N where N: "\<And>k. k \<ge> N \<Longrightarrow> \<bar>integral\<^sup>L (lebesgue_on {a..b}) (?f k) - integral\<^sup>L (lebesgue_on {a..b}) ?g\<bar> < e\<^sup>2"
     apply (simp add: lim_sequentially dist_real_def)
     apply (drule_tac x="e^2" in spec)
     using \<open>e > 0\<close>
     by auto
   obtain M where "M > 0" and M: "1 / real M < b-a"
     using real_arch_invD [of "b-a"]
     by (metis \<open>a < b\<close> diff_gt_0_iff_gt inverse_eq_divide neq0_conv)
   have *: "\<bar>integral\<^sup>L (lebesgue_on {a..b}) (?f (max M N)) - integral\<^sup>L (lebesgue_on {a..b}) ?g\<bar> < e\<^sup>2"
     using N by force
   let ?\<phi> = "\<lambda>x. if x \<le> a+1/(Suc (max M N)) then ((Suc (max M N)) * d) * ((a+1/(Suc (max M N))) - x) else 0"
   show ?thesis
   proof
     show "continuous_on {a..b} ?\<phi>"
       by (rule cont)
     have "1 / (1 + real (max M N)) \<le> 1 / (real M)"
       by (simp add: \<open>0 < M\<close> frac_le)
     then have "\<not> (b \<le> a+1 / (1 + real (max M N)))"
       using M \<open>a < b\<close> \<open>M > 0\<close> max.cobounded1 [of M N]
       by linarith
     then show "?\<phi> b = 0"
       by simp
     have null_a: "{a} \<in> null_sets (lebesgue_on {a..b})"
       using \<open>a < b\<close> by (simp add: null_sets_restrict_space)
     have "LINT x|lebesgue_on {a..b}. ?g x = 0"
       by (force intro: integral_eq_zero_AE AE_I' [OF null_a])
     then have "l2norm {a..b} ?\<phi> < sqrt (e^2)"
       unfolding l2norm_def l2product_def power2_eq_square [symmetric]
       apply (intro real_sqrt_less_mono)
       using "*" by linarith
     then show "l2norm {a..b} ?\<phi> < e"
       using \<open>e > 0\<close> by auto
   qed auto
 qed
 
 
 lemma square_integrable_approximate_continuous_ends:
   assumes f: "f square_integrable {a..b}" and "a < b" "0 < e"
   obtains g where "continuous_on {a..b} g" "g b = g a" "g square_integrable {a..b}" "l2norm {a..b} (\<lambda>x. f x - g x) < e"
 proof -
   obtain g where contg: "continuous_on UNIV g" and "g square_integrable {a..b}"
     and lg: "l2norm {a..b} (\<lambda>x. f x - g x) < e/2"
     using f \<open>e > 0\<close> square_integrable_approximate_continuous
     by (metis (full_types) box_real(2) half_gt_zero_iff lmeasurable_cbox)
   obtain h where conth: "continuous_on {a..b} h" and "h a = g b - g a" "h b = 0"
     and lh: "l2norm {a..b} h < e/2"
     using integral_tweak_ends \<open>e > 0\<close>
     by (metis \<open>a < b\<close> zero_less_divide_iff zero_less_numeral)
   have "h square_integrable {a..b}"
     using \<open>continuous_on {a..b} h\<close> continuous_imp_square_integrable by blast
   show thesis
   proof
     show "continuous_on {a..b} (\<lambda>x. g x + h x)"
       by (blast intro: continuous_on_subset [OF contg] conth continuous_intros)
     then show "(\<lambda>x. g x + h x) square_integrable {a..b}"
       using continuous_imp_square_integrable by blast
     show "g b + h b = g a + h a"
       by (simp add: \<open>h a = g b - g a\<close> \<open>h b = 0\<close>)
     have "l2norm {a..b} (\<lambda>x. (f x - g x) + - h x) < e"
     proof (rule le_less_trans [OF l2norm_triangle [of "\<lambda>x. f x - g x" "{a..b}" "\<lambda>x. - (h x)"]])
       show "(\<lambda>x. f x - g x) square_integrable {a..b}"
         using \<open>g square_integrable {a..b}\<close> f square_integrable_diff by blast
       show "(\<lambda>x. - h x) square_integrable {a..b}"
         by (simp add: \<open>h square_integrable {a..b}\<close>)
       show "l2norm {a..b} (\<lambda>x. f x - g x) + l2norm {a..b} (\<lambda>x. - h x) < e"
         using \<open>h square_integrable {a..b}\<close> l2norm_neg lg lh by auto
     qed
     then show "l2norm {a..b} (\<lambda>x. f x - (g x + h x)) < e"
       by (simp add: field_simps)
   qed
 qed
 
 
 subsection\<open>Hence the main approximation result\<close>
 
 lemma Weierstrass_l2_trig_polynomial:
   assumes f: "f square_integrable {-pi..pi}" and "0 < e"
   obtains n a b where
    "l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>k\<le>n. a k * sin(real k * x) + b k * cos(real k * x))) < e"
 proof -
   let ?\<phi> = "\<lambda>n a b x. \<Sum>k\<le>n. a k * sin(real k * x) + b k * cos(real k * x)"
   obtain g where contg: "continuous_on {-pi..pi} g" and geq: "g(-pi) = g pi"
            and g: "g square_integrable {-pi..pi}" and norm_fg: "l2norm {-pi..pi} (\<lambda>x. f x - g x) < e/2"
     using \<open>e > 0\<close> by (auto intro: square_integrable_approximate_continuous_ends [OF f, of "e/2"])
   then obtain n a b where g_phi_less: "\<And>x. x \<in> {-pi..pi} \<Longrightarrow> \<bar>g x - (?\<phi> n a b x)\<bar> < e/6"
     using \<open>e > 0\<close> Weierstrass_trig_polynomial [OF contg geq, of "e/6"]
     by (meson zero_less_divide_iff zero_less_numeral)
   show thesis
   proof
     have si: "(?\<phi> n u v) square_integrable {-pi..pi}" for n::nat and u v
     proof (intro square_integrable_sum continuous_imp_square_integrable)
       show "continuous_on {-pi..pi} (\<lambda>x. u k * sin (real k * x) + v k * cos (real k * x))"
         if "k \<in> {..n}" for k
         using that by (intro continuous_intros)
     qed auto
     have "l2norm {-pi..pi} (\<lambda>x. f x - (?\<phi> n a b x)) =  l2norm {-pi..pi} (\<lambda>x. (f x - g x) + (g x - (?\<phi> n a b x)))"
       by simp
     also have "\<dots> \<le> l2norm {-pi..pi} (\<lambda>x. f x - g x) + l2norm {-pi..pi} (\<lambda>x. g x - (?\<phi> n a b x))"
     proof (rule l2norm_triangle)
       show "(\<lambda>x. f x - g x) square_integrable {-pi..pi}"
         using f g square_integrable_diff by blast
       show "(\<lambda>x. g x - (?\<phi> n a b x)) square_integrable {-pi..pi}"
         using g si square_integrable_diff by blast
     qed
     also have "\<dots> < e"
     proof -
       have g_phi: "(\<lambda>x. g x - (?\<phi> n a b x)) square_integrable {-pi..pi}"
         using g si square_integrable_diff by blast
       have "l2norm {-pi..pi} (\<lambda>x. g x - (?\<phi> n a b x)) \<le> e/2"
         unfolding l2norm_def l2product_def power2_eq_square [symmetric]
       proof (rule real_le_lsqrt)
         show "0 \<le> LINT x|lebesgue_on {-pi..pi}. (g x - (?\<phi> n a b x))\<^sup>2"
           by (rule integral_nonneg_AE) auto
         have "LINT x|lebesgue_on {-pi..pi}. (g x - (?\<phi> n a b x))\<^sup>2
             \<le> LINT x|lebesgue_on {-pi..pi}. (e / 6) ^ 2"
         proof (rule integral_mono)
           show "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. (g x - (?\<phi> n a b x))\<^sup>2)"
             using g_phi square_integrable_def by auto
           show "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. (e / 6)\<^sup>2)"
             by (intro continuous_intros continuous_imp_integrable_real)
           show "(g x - (?\<phi> n a b x))\<^sup>2 \<le> (e / 6)\<^sup>2" if "x \<in> space (lebesgue_on {-pi..pi})" for x
             using \<open>e > 0\<close> g_phi_less that
             apply (simp add: abs_le_square_iff [symmetric])
             using less_eq_real_def by blast
         qed
         also have "\<dots> \<le> (e / 2)\<^sup>2"
           using \<open>e > 0\<close> pi_less_4 by (auto simp: power2_eq_square measure_restrict_space)
         finally show "LINT x|lebesgue_on {-pi..pi}. (g x - (?\<phi> n a b x))\<^sup>2 \<le> (e / 2)\<^sup>2" .
       qed (use \<open>e > 0\<close> in auto)
       with norm_fg show ?thesis
         by auto
     qed
     finally show "l2norm {-pi..pi} (\<lambda>x. f x - (?\<phi> n a b x)) < e" .
   qed
 qed
 
 
 proposition Weierstrass_l2_trigonometric_set:
   assumes f: "f square_integrable {-pi..pi}" and "0 < e"
   obtains n a where "l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>k\<le>n. a k * trigonometric_set k x)) < e"
 proof -
   obtain n a b where lee:
     "l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>k\<le>n. a k * sin(real k * x) + b k * cos(real k * x))) < e"
     using Weierstrass_l2_trig_polynomial [OF assms] .
   let ?a = "\<lambda>k. if k = 0 then sqrt(2 * pi) * b 0
                 else if even k then sqrt pi * b(k div 2)
                 else if k \<le> 2 * n then sqrt pi * a((Suc k) div 2)
                 else 0"
   show thesis
   proof
     have [simp]: "Suc (i * 2) \<le> n * 2 \<longleftrightarrow> i<n" "{..n} \<inter> {..<n} = {..<n}" for i n
       by auto
     have "(\<Sum>k\<le>n. b k * cos (real k * x)) = (\<Sum>i\<le>n. if i = 0 then b 0 else b i * cos (real i * x))" for x
       by (rule sum.cong) auto
     moreover have "(\<Sum>k\<le>n. a k * sin (real k * x)) = (\<Sum>i\<le>n. (if Suc (2 * i) \<le> 2 * n then sqrt pi * a (Suc i) * sin ((1 + real i) * x) else 0) / sqrt pi)"
                    (is "?lhs = ?rhs") for x
     proof (cases "n=0")
       case False
       then obtain n' where n': "n = Suc n'"
         using not0_implies_Suc by blast
       have "?lhs = (\<Sum>k = Suc 0..n. a k * sin (real k * x))"
         by (simp add: atMost_atLeast0 sum_shift_lb_Suc0_0)
       also have "\<dots> = (\<Sum>i<n. a (Suc i) * sin (x + x * real i))"
       proof (subst sum.reindex_bij_betw [symmetric])
         show "bij_betw Suc {..n'} {Suc 0..n}"
           by (simp add: atMost_atLeast0 n')
         show "(\<Sum>j\<le>n'. a (Suc j) * sin (real (Suc j) * x)) = (\<Sum>i<n. a (Suc i) * sin (x + x * real i))"
         unfolding n' lessThan_Suc_atMost by (simp add: algebra_simps)
       qed
       also have "\<dots> = ?rhs"
         by (simp add: field_simps if_distrib [of "\<lambda>x. x/_"] sum.inter_restrict [where B = "{..<n}", simplified, symmetric] cong: if_cong)
       finally
       show ?thesis .
     qed auto
     ultimately
     have "(\<Sum>k\<le>n. a k * sin(real k * x) + b k * cos(real k * x)) = (\<Sum>k \<le> Suc(2*n). ?a k * trigonometric_set k x)" for x
       unfolding sum.in_pairs_0 trigonometric_set_def
       by (simp add: sum.distrib if_distrib [of "\<lambda>x. x*_"] cong: if_cong)
     with lee show "l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>k \<le> Suc(2*n). ?a k * trigonometric_set k x)) < e"
       by auto
   qed
 qed
 
 subsection\<open>Convergence wrt the L2 norm of trigonometric Fourier series\<close>
 
 definition Fourier_coefficient
   where "Fourier_coefficient \<equiv> orthonormal_coeff {-pi..pi} trigonometric_set"
 
 lemma Fourier_series_l2:
   assumes "f square_integrable {-pi..pi}"
   shows "(\<lambda>n. l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>i\<le>n. Fourier_coefficient f i * trigonometric_set i x)))
          \<longlonglongrightarrow> 0"
 proof (clarsimp simp add: lim_sequentially dist_real_def Fourier_coefficient_def)
   let ?h = "\<lambda>n x. (\<Sum>i\<le>n. orthonormal_coeff {-pi..pi} trigonometric_set f i * trigonometric_set i x)"
   show "\<exists>N. \<forall>n\<ge>N. \<bar>l2norm {-pi..pi} (\<lambda>x. f x - ?h n x)\<bar> < e"
     if "0 < e" for e
   proof -
     obtain N a where lte: "l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>k\<le>N. a k * trigonometric_set k x)) < e"
       using Weierstrass_l2_trigonometric_set by (meson \<open>0 < e\<close> assms)
     show ?thesis
     proof (intro exI allI impI)
       show "\<bar>l2norm {-pi..pi} (\<lambda>x. f x - ?h m x)\<bar> < e"
         if "N \<le> m" for m
       proof -
         have "\<bar>l2norm {-pi..pi} (\<lambda>x. f x - ?h m x)\<bar> = l2norm {-pi..pi} (\<lambda>x. f x - ?h m x)"
         proof (rule abs_of_nonneg)
           show "0 \<le> l2norm {-pi..pi} (\<lambda>x. f x -  ?h m x)"
             apply (intro l2norm_pos_le square_integrable_diff square_integrable_sum square_integrable_lmult
                 square_integrable_trigonometric_set assms, auto)
             done
         qed
         also have "\<dots> \<le> l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>k\<le>N. a k * trigonometric_set k x))"
         proof -
           have "(\<Sum>i\<le>m. (if i \<le> N then a i else 0) * trigonometric_set i x) = (\<Sum>i\<le>N. a i * trigonometric_set i x)" for x
             using sum.inter_restrict [where A = "{..m}" and B = "{..N}", symmetric] that
             by (force simp: if_distrib [of "\<lambda>x. x * _"] min_absorb2 cong: if_cong)
           moreover
           have "l2norm {-pi..pi} (\<lambda>x. f x - ?h m x)
                 \<le> l2norm {-pi..pi} (\<lambda>x. f x - (\<Sum>i\<le>m. (if i \<le> N then a i else 0) * trigonometric_set i x))"
             using orthonormal_optimal_partial_sum
               [OF orthonormal_system_trigonometric_set square_integrable_trigonometric_set assms]
             by simp
           ultimately show ?thesis
             by simp
         qed
         also have "\<dots> < e"
           by (rule lte)
         finally show ?thesis .
       qed
     qed
   qed
 qed
 
 
 
 subsection\<open>Fourier coefficients go to 0 (weak form of Riemann-Lebesgue)\<close>
 
 lemma trigonometric_set_mul_absolutely_integrable:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>x. trigonometric_set n x * f x) absolutely_integrable_on {-pi..pi}"
 proof (rule absolutely_integrable_bounded_measurable_product_real)
   show "trigonometric_set n \<in> borel_measurable (lebesgue_on {-pi..pi})"
     using square_integrable_def square_integrable_trigonometric_set by blast
   show "bounded (trigonometric_set n ` {-pi..pi})"
     unfolding bounded_iff using pi_gt3 sqrt_pi_ge1
     by (rule_tac x=1 in exI)
       (auto simp: trigonometric_set_def dist_real_def
         intro: order_trans [OF abs_sin_le_one] order_trans [OF abs_cos_le_one])
 qed (auto simp: assms)
 
 
 lemma trigonometric_set_mul_integrable:
    "f absolutely_integrable_on {-pi..pi} \<Longrightarrow> integrable (lebesgue_on {-pi..pi}) (\<lambda>x. trigonometric_set n x * f x)"
   using trigonometric_set_mul_absolutely_integrable
   by (simp add: integrable_restrict_space set_integrable_def)
 
 lemma trigonometric_set_integrable [simp]: "integrable (lebesgue_on {-pi..pi}) (trigonometric_set n)"
   using trigonometric_set_mul_integrable [where f = id]
   by simp (metis absolutely_integrable_imp_integrable fmeasurableD interval_cbox lmeasurable_cbox square_integrable_imp_absolutely_integrable square_integrable_trigonometric_set)
 
 lemma absolutely_integrable_sin_product:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>x. sin(k * x) * f x) absolutely_integrable_on {-pi..pi}"
 proof (rule absolutely_integrable_bounded_measurable_product_real)
   show "(\<lambda>x. sin (k * x)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
     by (metis borel_measurable_integrable integrable_sin_cx mult_commute_abs)
   show "bounded ((\<lambda>x. sin (k * x)) ` {-pi..pi})"
     by (metis (mono_tags, lifting) abs_sin_le_one bounded_iff imageE real_norm_def)
 qed (auto simp: assms)
 
 lemma absolutely_integrable_cos_product:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>x. cos(k * x) * f x) absolutely_integrable_on {-pi..pi}"
 proof (rule absolutely_integrable_bounded_measurable_product_real)
   show "(\<lambda>x. cos (k * x)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
     by (metis borel_measurable_integrable integrable_cos_cx mult_commute_abs)
   show "bounded ((\<lambda>x. cos (k * x)) ` {-pi..pi})"
     by (metis (mono_tags, lifting) abs_cos_le_one bounded_iff imageE real_norm_def)
 qed (auto simp: assms)
 
 lemma
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows Fourier_products_integrable_cos: "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. cos(k * x) * f x)"
   and   Fourier_products_integrable_sin: "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. sin(k * x) * f x)"
   using absolutely_integrable_cos_product absolutely_integrable_sin_product assms
   by (auto simp: integrable_restrict_space set_integrable_def)
 
 
 lemma Riemann_lebesgue_square_integrable:
   assumes "orthonormal_system S w" "\<And>i. w i square_integrable S" "f square_integrable S"
   shows "orthonormal_coeff S w f \<longlonglongrightarrow> 0"
   using Fourier_series_square_summable [OF assms, of UNIV] summable_LIMSEQ_zero by force
 
 proposition Riemann_lebesgue:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "Fourier_coefficient f \<longlonglongrightarrow> 0"
   unfolding lim_sequentially
 proof (intro allI impI)
   fix e::real
   assume "e > 0"
   then obtain g where "continuous_on UNIV g" and gabs: "g absolutely_integrable_on {-pi..pi}"
                 and fg_e2: "integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. \<bar>f x - g x\<bar>) < e/2"
     using absolutely_integrable_approximate_continuous [OF assms, of "e/2"]
     by (metis (full_types) box_real(2) half_gt_zero_iff lmeasurable_cbox)
   have "g square_integrable {-pi..pi}"
     using \<open>continuous_on UNIV g\<close> continuous_imp_square_integrable continuous_on_subset by blast
   then have "orthonormal_coeff {-pi..pi} trigonometric_set g \<longlonglongrightarrow> 0"
     using Riemann_lebesgue_square_integrable orthonormal_system_trigonometric_set square_integrable_trigonometric_set by blast
   with \<open>e > 0\<close> obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> \<bar>orthonormal_coeff {-pi..pi} trigonometric_set g n\<bar> < e/2"
     unfolding lim_sequentially by (metis half_gt_zero_iff norm_conv_dist real_norm_def)
   have "\<bar>Fourier_coefficient f n\<bar> < e"
     if "n \<ge> N" for n
   proof -
     have "\<bar>LINT x|lebesgue_on {-pi..pi}. trigonometric_set n x * g x\<bar> < e/2"
       using N [OF \<open>n \<ge> N\<close>] by (auto simp: orthonormal_coeff_def l2product_def)
 
     have "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. trigonometric_set n x * g x)"
       using gabs trigonometric_set_mul_integrable by blast
     moreover have "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. trigonometric_set n x * f x)"
       using assms trigonometric_set_mul_integrable by blast
     ultimately have "\<bar>(LINT x|lebesgue_on {-pi..pi}. trigonometric_set n x * g x) -
                         (LINT x|lebesgue_on {-pi..pi}. trigonometric_set n x * f x)\<bar>
                      = \<bar>(LINT x|lebesgue_on {-pi..pi}. trigonometric_set n x * (g x - f x))\<bar>"
       by (simp add:  algebra_simps flip: Bochner_Integration.integral_diff)
     also have "\<dots> \<le> LINT x|lebesgue_on {-pi..pi}. \<bar>f x - g x\<bar>"
     proof (rule integral_abs_bound_integral)
       show "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. trigonometric_set n x * (g x - f x))"
         by (simp add: gabs assms trigonometric_set_mul_integrable)
       have "(\<lambda>x. f x - g x) absolutely_integrable_on {-pi..pi}"
         using gabs assms by blast
       then show "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. \<bar>f x - g x\<bar>)"
         by (simp add: absolutely_integrable_imp_integrable)
       fix x
       assume "x \<in> space (lebesgue_on {-pi..pi})"
       then have "-pi \<le> x" "x \<le> pi"
         by auto
       have "\<bar>trigonometric_set n x\<bar> \<le> 1"
         using pi_ge_two
         apply (simp add: trigonometric_set_def)
         using sqrt_pi_ge1 abs_sin_le_one order_trans abs_cos_le_one by metis
       then show "\<bar>trigonometric_set n x * (g x - f x)\<bar> \<le> \<bar>f x - g x\<bar>"
         using abs_ge_zero mult_right_mono by (fastforce simp add: abs_mult abs_minus_commute)
     qed
     finally have "\<bar>(LINT x|lebesgue_on {-pi..pi}. trigonometric_set n x * g x) -
            (LINT x|lebesgue_on {-pi..pi}. trigonometric_set n x * f x)\<bar>
           \<le> LINT x|lebesgue_on {-pi..pi}. \<bar>f x - g x\<bar>" .
     then show ?thesis
       using N [OF \<open>n \<ge> N\<close>] fg_e2
       unfolding Fourier_coefficient_def orthonormal_coeff_def l2product_def
       by linarith
   qed
   then show "\<exists>no. \<forall>n\<ge>no. dist (Fourier_coefficient f n) 0 < e"
     by auto
 qed
 
 
 lemma Riemann_lebesgue_sin:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>n. integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin(real n * x) * f x)) \<longlonglongrightarrow> 0"
   unfolding lim_sequentially
 proof (intro allI impI)
   fix e::real
   assume "e > 0"
   then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> \<bar>Fourier_coefficient f n\<bar> < e/4"
     using Riemann_lebesgue [OF assms]
     unfolding lim_sequentially
     by (metis norm_conv_dist real_norm_def zero_less_divide_iff zero_less_numeral)
   have "\<bar>LINT x|lebesgue_on {-pi..pi}. sin (real n * x) * f x\<bar> < e" if "n > N" for n
     using that
   proof (induction n)
     case (Suc n)
     have "\<bar>Fourier_coefficient f(Suc (2 * n))\<bar> < e/4"
       using N Suc.prems by auto
     then have "\<bar>LINT x|lebesgue_on {-pi..pi}. sin ((1 + real n) * x) * f x\<bar> < sqrt pi * e / 4"
       by (simp add: Fourier_coefficient_def orthonormal_coeff_def
           trigonometric_set_def l2product_def field_simps)
     also have "\<dots> \<le> e"
       using \<open>0 < e\<close> pi_less_4 real_sqrt_less_mono by (fastforce simp add: field_simps)
     finally show ?case
       by simp
   qed auto
   then show "\<exists>no. \<forall>n\<ge>no. dist (LINT x|lebesgue_on {-pi..pi}. sin (real n * x) * f x) 0 < e"
     by (metis (full_types) le_neq_implies_less less_add_same_cancel2 less_trans norm_conv_dist real_norm_def zero_less_one)
 qed
 
 lemma Riemann_lebesgue_cos:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>n. integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(real n * x) * f x)) \<longlonglongrightarrow> 0"
   unfolding lim_sequentially
 proof (intro allI impI)
   fix e::real
   assume "e > 0"
   then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> \<bar>Fourier_coefficient f n\<bar> < e/4"
     using Riemann_lebesgue [OF assms]
     unfolding lim_sequentially
     by (metis norm_conv_dist real_norm_def zero_less_divide_iff zero_less_numeral)
   have "\<bar>LINT x|lebesgue_on {-pi..pi}. cos (real n * x) * f x\<bar> < e" if "n > N" for n
     using that
   proof (induction n)
     case (Suc n)
     have eq: "(x * 2 + x * (real n * 2)) / 2 = x + x * (real n)" for x
       by simp
     have "\<bar>Fourier_coefficient f(2*n + 2)\<bar> < e/4"
       using N Suc.prems by auto
     then have "\<bar>LINT x|lebesgue_on {-pi..pi}. f x * cos (x + x * (real n))\<bar> < sqrt pi * e / 4"
       by (simp add: Fourier_coefficient_def orthonormal_coeff_def
           trigonometric_set_def l2product_def field_simps eq)
     also have "\<dots> \<le> e"
       using \<open>0 < e\<close> pi_less_4 real_sqrt_less_mono by (fastforce simp add: field_simps)
     finally show ?case
       by (simp add: field_simps)
   qed auto
   then show "\<exists>no. \<forall>n\<ge>no. dist (LINT x|lebesgue_on {-pi..pi}. cos (real n * x) * f x) 0 < e"
     by (metis (full_types) le_neq_implies_less less_add_same_cancel2 less_trans norm_conv_dist real_norm_def zero_less_one)
 qed
 
 
 lemma Riemann_lebesgue_sin_half:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>n. LINT x|lebesgue_on {-pi..pi}. sin ((real n + 1/2) * x) * f x) \<longlonglongrightarrow> 0"
 proof (simp add: algebra_simps sin_add)
   let ?INT = "integral\<^sup>L (lebesgue_on {-pi..pi})"
   let ?f = "(\<lambda>n. ?INT (\<lambda>x. sin(n * x) * cos(1/2 * x) * f x) +
                  ?INT (\<lambda>x. cos(n * x) * sin(1/2 * x) * f x))"
   show "(\<lambda>n. ?INT (\<lambda>x. f x * (cos (x * real n) * sin (x/2)) + f x * (sin (x * real n) * cos (x/2)))) \<longlonglongrightarrow> 0"
   proof (rule Lim_transform_eventually)
     have sin: "(\<lambda>x. sin (1/2 * x) * f x) absolutely_integrable_on {-pi..pi}"
       by (intro absolutely_integrable_sin_product assms)
     have cos: "(\<lambda>x. cos (1/2 * x) * f x) absolutely_integrable_on {-pi..pi}"
       by (intro absolutely_integrable_cos_product assms)
     show "\<forall>\<^sub>F n in sequentially. ?f n = ?INT (\<lambda>x. f x * (cos (x * real n) * sin (x/2)) + f x * (sin (x * real n) * cos (x/2)))"
       unfolding mult.assoc
       apply (rule eventuallyI)
       apply (subst Bochner_Integration.integral_add [symmetric])
         apply (safe intro!: cos absolutely_integrable_sin_product sin absolutely_integrable_cos_product absolutely_integrable_imp_integrable)
         apply (auto simp: algebra_simps)
       done
     have "?f \<longlonglongrightarrow> 0 + 0"
       unfolding mult.assoc
       by (intro tendsto_add Riemann_lebesgue_sin Riemann_lebesgue_cos sin cos)
     then show "?f \<longlonglongrightarrow> (0::real)" by simp
   qed
 qed
 
 
 lemma Fourier_sum_limit_pair:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>n. \<Sum>k\<le>2 * n. Fourier_coefficient f k * trigonometric_set k t) \<longlonglongrightarrow> l
      \<longleftrightarrow> (\<lambda>n. \<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) \<longlonglongrightarrow> l"
         (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
     unfolding lim_sequentially dist_real_def
   proof (intro allI impI)
     fix e::real
     assume "e > 0"
     then obtain N1 where N1: "\<And>n. n \<ge> N1 \<Longrightarrow> \<bar>Fourier_coefficient f n\<bar> < e/2"
       using Riemann_lebesgue [OF assms] unfolding lim_sequentially
       by (metis norm_conv_dist real_norm_def zero_less_divide_iff zero_less_numeral)
     obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> \<bar>(\<Sum>k\<le>2 * n. Fourier_coefficient f k * trigonometric_set k t) - l\<bar> < e/2"
       using L unfolding lim_sequentially dist_real_def
       by (meson \<open>0 < e\<close> half_gt_zero_iff)
     show "\<exists>no. \<forall>n\<ge>no. \<bar>(\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) - l\<bar> < e"
     proof (intro exI allI impI)
       fix n
       assume n: "N1 + 2*N2 + 1 \<le> n"
       then have "n \<ge> N1" "n \<ge> N2" "n div 2 \<ge> N2"
         by linarith+
       consider "n = 2 * (n div 2)" | "n = Suc(2 * (n div 2))"
         by linarith
       then show "\<bar>(\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) - l\<bar> < e"
       proof cases
         case 1
         show ?thesis
           apply (subst 1)
           using N2 [OF \<open>n div 2 \<ge> N2\<close>] by linarith
       next
         case 2
         have "\<bar>(\<Sum>k\<le>2 * (n div 2). Fourier_coefficient f k * trigonometric_set k t) - l\<bar> < e/2"
           using N2 [OF \<open>n div 2 \<ge> N2\<close>] by linarith
         moreover have "\<bar>Fourier_coefficient f(Suc (2 * (n div 2))) * trigonometric_set (Suc (2 * (n div 2))) t\<bar> < (e/2) * 1"
         proof -
           have "\<bar>trigonometric_set (Suc (2 * (n div 2))) t\<bar> \<le> 1"
             apply (simp add: trigonometric_set)
             using abs_sin_le_one sqrt_pi_ge1 by (blast intro: order_trans)
           moreover have "\<bar>Fourier_coefficient f(Suc (2 * (n div 2)))\<bar> < e/2"
             using N1 \<open>N1 \<le> n\<close> by auto
           ultimately show ?thesis
             unfolding abs_mult
-            by (meson abs_ge_zero le_less_trans mult_left_mono real_mult_less_iff1 zero_less_one)
+            by (meson abs_ge_zero le_less_trans mult_left_mono mult_less_iff1 zero_less_one)
         qed
         ultimately show ?thesis
           apply (subst 2)
           unfolding sum.atMost_Suc by linarith
       qed
     qed
   qed
 next
   assume ?rhs then show ?lhs
     unfolding lim_sequentially
     by (auto simp: elim!: imp_forward ex_forward)
 qed
 
 
 subsection\<open>Express Fourier sum in terms of the special expansion at the origin\<close>
 
 lemma Fourier_sum_0:
   "(\<Sum>k \<le> n. Fourier_coefficient f k * trigonometric_set k 0) =
      (\<Sum>k \<le> n div 2. Fourier_coefficient f(2*k) * trigonometric_set (2*k) 0)"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>k = 2 * 0.. Suc (2 * (n div 2)). Fourier_coefficient f k * trigonometric_set k 0)"
   proof (rule sum.mono_neutral_left)
     show "\<forall>i\<in>{2 * 0..Suc (2 * (n div 2))} - {..n}. Fourier_coefficient f i * trigonometric_set i 0 = 0"
     proof clarsimp
       fix i
       assume "i \<le> Suc (2 * (n div 2))" "\<not> i \<le> n"
 			then have "i = Suc n" "even n"
 			  by presburger+
 			moreover
 			assume "trigonometric_set i 0 \<noteq> 0"
 			ultimately
 			show "Fourier_coefficient f i = 0"
 				by (simp add: trigonometric_set_def)
 		qed
 	qed auto
   also have "\<dots> = ?rhs"
  	  unfolding sum.in_pairs by (simp add: trigonometric_set atMost_atLeast0)
   finally show ?thesis .
 qed
 
 
 lemma Fourier_sum_0_explicit:
   "(\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k 0)
     = (Fourier_coefficient f 0 / sqrt 2 + (\<Sum>k = 1..n div 2. Fourier_coefficient f(2*k))) / sqrt pi"
   (is "?lhs = ?rhs")
 proof -
   have "(\<Sum>k=0..n. Fourier_coefficient f k * trigonometric_set k 0)
         = Fourier_coefficient f 0 * trigonometric_set 0 0 + (\<Sum>k = 1..n. Fourier_coefficient f k * trigonometric_set k 0)"
     by (simp add: Fourier_sum_0 sum.atLeast_Suc_atMost)
   also have "\<dots> = ?rhs"
   proof -
     have "Fourier_coefficient f 0 * trigonometric_set 0 0 = Fourier_coefficient f 0 / (sqrt 2 * sqrt pi)"
       by (simp add: real_sqrt_mult trigonometric_set(1))
     moreover have "(\<Sum>k = Suc 0..n. Fourier_coefficient f k * trigonometric_set k 0) = (\<Sum>k = Suc 0..n div 2. Fourier_coefficient f(2*k)) / sqrt pi"
     proof (induction n)
       case (Suc n)
       show ?case
         by (simp add: Suc) (auto simp: trigonometric_set_def field_simps)
     qed auto
     ultimately show ?thesis
       by (simp add: add_divide_distrib)
   qed
   finally show ?thesis
     by (simp add: atMost_atLeast0)
 qed
 
 lemma Fourier_sum_0_integrals:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k 0) =
           (integral\<^sup>L (lebesgue_on {-pi..pi}) f / 2 +
            (\<Sum>k = Suc 0..n div 2. integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. cos(k * x) * f x))) / pi"
 proof -
   have "integral\<^sup>L (lebesgue_on {-pi..pi}) f / (sqrt (2 * pi) * sqrt 2 * sqrt pi) = integral\<^sup>L (lebesgue_on {-pi..pi}) f / (2 * pi)"
     by (simp add: algebra_simps real_sqrt_mult)
   moreover have "(\<Sum>k = Suc 0..n div 2. LINT x|lebesgue_on {-pi..pi}. trigonometric_set (2*k) x * f x) / sqrt pi
                = (\<Sum>k = Suc 0..n div 2. LINT x|lebesgue_on {-pi..pi}. cos (k * x) * f x) / pi"
     by (simp add: trigonometric_set_def sum_divide_distrib)
   ultimately show ?thesis
     unfolding Fourier_sum_0_explicit
     by (simp add: Fourier_coefficient_def orthonormal_coeff_def l2product_def trigonometric_set add_divide_distrib)
 qed
 
 
 lemma Fourier_sum_0_integral:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k 0) =
        integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. (1/2 + (\<Sum>k = Suc 0..n div 2. cos(k * x))) * f x) / pi"
 proof -
   note * = Fourier_products_integrable_cos [OF assms]
   have "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. \<Sum>n = Suc 0..n div 2. f x * cos (x * real n))"
     using * by (force simp: mult_ac)
   moreover have "integral\<^sup>L (lebesgue_on {-pi..pi}) f / 2 + (\<Sum>k = Suc 0..n div 2. LINT x|lebesgue_on {-pi..pi}. f x * cos (x * real k))
                = (LINT x|lebesgue_on {-pi..pi}. f x / 2) + (LINT x|lebesgue_on {-pi..pi}. (\<Sum>n = Suc 0..n div 2. f x * cos (x * real n)))"
   proof (subst Bochner_Integration.integral_sum)
     show "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. f x * cos (x * real i))"
       if "i \<in> {Suc 0..n div 2}" for i
       using that * [of i] by (auto simp: Bochner_Integration.integral_sum mult_ac)
   qed auto
   ultimately show ?thesis
     using Fourier_products_integrable_cos [OF assms] absolutely_integrable_imp_integrable [OF assms]
     by (simp add: Fourier_sum_0_integrals sum_distrib_left assms algebra_simps)
 qed
 
 
 subsection\<open>How Fourier coefficients behave under addition etc\<close>
 
 lemma Fourier_coefficient_add:
   assumes "f absolutely_integrable_on {-pi..pi}" "g absolutely_integrable_on {-pi..pi}"
   shows "Fourier_coefficient (\<lambda>x. f x + g x) i =
                 Fourier_coefficient f i + Fourier_coefficient g i"
   using assms trigonometric_set_mul_integrable
   by (simp add: Fourier_coefficient_def orthonormal_coeff_def l2product_def distrib_left)
 
 lemma Fourier_coefficient_minus:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "Fourier_coefficient (\<lambda>x. - f x) i = - Fourier_coefficient f i"
   using assms trigonometric_set_mul_integrable
   by (simp add: Fourier_coefficient_def orthonormal_coeff_def l2product_def)
 
 lemma Fourier_coefficient_diff:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and g: "g absolutely_integrable_on {-pi..pi}"
   shows "Fourier_coefficient (\<lambda>x. f x - g x) i = Fourier_coefficient f i - Fourier_coefficient g i"
 proof -
   have mg: "(\<lambda>x. - g x) absolutely_integrable_on {-pi..pi}"
     using g by (simp add: absolutely_integrable_measurable_real)
   show ?thesis
     using Fourier_coefficient_add [OF f mg] Fourier_coefficient_minus [OF g] by simp
 qed
 
 lemma Fourier_coefficient_const:
    "Fourier_coefficient (\<lambda>x. c) i = (if i = 0 then c * sqrt(2 * pi) else 0)"
   by (auto simp: Fourier_coefficient_def orthonormal_coeff_def l2product_def trigonometric_set_def divide_simps measure_restrict_space)
 
 lemma Fourier_offset_term:
   fixes f :: "real \<Rightarrow> real"
   assumes f: "f absolutely_integrable_on {-pi..pi}" and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows  "Fourier_coefficient (\<lambda>x. f(x+t)) (2 * n + 2) * trigonometric_set (2 * n + 2) 0
         = Fourier_coefficient f(2 * n+1) * trigonometric_set (2 * n+1) t
         + Fourier_coefficient f(2 * n + 2) * trigonometric_set (2 * n + 2) t"
 proof -
   have eq: "(2 + 2 * real n) * x / 2 = (1 + real n) * x" for x
     by (simp add: divide_simps)
   have 1: "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. f x * (cos (x + x * n) * cos (t + t * n)))"
     using Fourier_products_integrable_cos [of f "Suc n"] f
     by (simp add: algebra_simps) (simp add: mult.assoc [symmetric])
   have 2: "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. f x * (sin (x + x * n) * sin (t + t * n)))"
     using Fourier_products_integrable_sin [of f "Suc n"] f
     by (simp add: algebra_simps) (simp add: mult.assoc [symmetric])
   have "has_bochner_integral (lebesgue_on {-pi..pi}) (\<lambda>x. cos (real (Suc n) * (x + t - t)) * f(x + t))
                  (LINT x|lebesgue_on {-pi..pi}. cos (real (Suc n) * (x - t)) * f x)"
   proof (rule has_integral_periodic_offset)
     have "(\<lambda>x. cos (real (Suc n) * (x - t)) * f x) absolutely_integrable_on {-pi..pi}"
     proof (rule absolutely_integrable_bounded_measurable_product_real)
       show "(\<lambda>x. cos (real (Suc n) * (x - t))) \<in> borel_measurable (lebesgue_on {-pi..pi})"
         by (intro continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
       show "bounded ((\<lambda>x. cos (real (Suc n) * (x - t))) ` {-pi..pi})"
         by (rule boundedI [where B=1]) auto
     qed (use f in auto)
     then show "has_bochner_integral (lebesgue_on {-pi..pi}) (\<lambda>x. cos ((Suc n) * (x - t)) * f x) (LINT x|lebesgue_on {-pi..pi}. cos (real (Suc n) * (x - t)) * f x)"
       by (simp add: has_bochner_integral_integrable integrable_restrict_space set_integrable_def)
   next
     fix x
     show "cos (real (Suc n) * (x + (pi - - pi) - t)) * f(x + (pi - - pi)) = cos (real (Suc n) * (x - t)) * f x"
       using periodic cos.plus_of_nat [of "(Suc n) * (x - t)" "Suc n"] by (simp add: algebra_simps)
   qed
   then have "has_bochner_integral (lebesgue_on {-pi..pi}) (\<lambda>x. cos (real (Suc n) * x) * f(x + t))
                  (LINT x|lebesgue_on {-pi..pi}. cos (real (Suc n) * (x - t)) * f x)"
     by simp
   then have "LINT x|lebesgue_on {-pi..pi}. cos ((Suc n) * x) * f(x+t)
            = LINT x|lebesgue_on {-pi..pi}. cos ((Suc n) * (x - t)) * f x"
     using has_bochner_integral_integral_eq by blast
   also have "\<dots> = LINT x|lebesgue_on {-pi..pi}. cos ((Suc n) * x - ((Suc n) * t)) * f x"
     by (simp add: algebra_simps)
   also have "\<dots> = cos ((Suc n) * t) * (LINT x|lebesgue_on {-pi..pi}. cos ((Suc n) * x) * f x)
                  + sin ((Suc n) * t) * (LINT x|lebesgue_on {-pi..pi}. sin ((Suc n) * x) * f x)"
     by (simp add: cos_diff algebra_simps 1 2 flip: integral_mult_left_zero integral_mult_right_zero)
   finally have "LINT x|lebesgue_on {-pi..pi}. cos ((Suc n) * x) * f(x+t)
         = cos ((Suc n) * t) * (LINT x|lebesgue_on {-pi..pi}. cos ((Suc n) * x) * f x)
         + sin ((Suc n) * t) * (LINT x|lebesgue_on {-pi..pi}. sin ((Suc n) * x) * f x)" .
   then show ?thesis
     unfolding Fourier_coefficient_def orthonormal_coeff_def trigonometric_set_def
     by (simp add: eq) (simp add: divide_simps algebra_simps l2product_def)
 qed
 
 
 lemma Fourier_sum_offset:
   fixes f :: "real \<Rightarrow> real"
   assumes f: "f absolutely_integrable_on {-pi..pi}" and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows  "(\<Sum>k\<le>2*n. Fourier_coefficient f k * trigonometric_set k t) =
           (\<Sum>k\<le>2*n. Fourier_coefficient (\<lambda>x. f(x+t)) k * trigonometric_set k 0)" (is "?lhs = ?rhs")
 proof -
   have "?lhs = Fourier_coefficient f 0 * trigonometric_set 0 t + (\<Sum>k = Suc 0..2*n. Fourier_coefficient f k * trigonometric_set k t)"
     by (simp add: atMost_atLeast0 sum.atLeast_Suc_atMost)
   moreover have "(\<Sum>k = Suc 0..2*n. Fourier_coefficient f k * trigonometric_set k t) =
                  (\<Sum>k = Suc 0..2*n. Fourier_coefficient (\<lambda>x. f(x+t)) k * trigonometric_set k 0)"
   proof (cases n)
     case (Suc n')
     have "(\<Sum>k = Suc 0..2 * n. Fourier_coefficient f k * trigonometric_set k t)
         = (\<Sum>k = Suc 0.. Suc (Suc (2 * n')). Fourier_coefficient f k * trigonometric_set k t)"
       by (simp add: Suc)
     also have "\<dots> = (\<Sum>k \<le> Suc (2 * n'). Fourier_coefficient f(Suc k) * trigonometric_set (Suc k) t)"
       unfolding atMost_atLeast0 using sum.shift_bounds_cl_Suc_ivl by blast
     also have "\<dots> = (\<Sum>k \<le> Suc (2 * n'). Fourier_coefficient (\<lambda>x. f(x+t)) (Suc k) * trigonometric_set (Suc k) 0)"
       unfolding sum.in_pairs_0
     proof (rule sum.cong [OF refl])
       show "Fourier_coefficient f(Suc (2 * k)) * trigonometric_set (Suc (2 * k)) t + Fourier_coefficient f(Suc (Suc (2 * k))) * trigonometric_set (Suc (Suc (2 * k))) t = Fourier_coefficient (\<lambda>x. f(x + t)) (Suc (2 * k)) * trigonometric_set (Suc (2 * k)) 0 + Fourier_coefficient (\<lambda>x. f(x + t)) (Suc (Suc (2 * k))) * trigonometric_set (Suc (Suc (2 * k))) 0"
         if "k \<in> {..n'}" for k
         using that Fourier_offset_term [OF assms, of t ] by (auto simp: trigonometric_set_def)
     qed
     also have "\<dots> = (\<Sum>k = Suc 0..Suc (Suc (2 * n')). Fourier_coefficient (\<lambda>x. f(x+t)) k * trigonometric_set k 0)"
       by (simp only: atMost_atLeast0 sum.shift_bounds_cl_Suc_ivl)
     also have "\<dots> = (\<Sum>k = Suc 0..2*n. Fourier_coefficient (\<lambda>x. f(x+t)) k * trigonometric_set k 0)"
       by (simp add: Suc)
     finally show ?thesis .
   qed auto
   moreover have "?rhs
            = Fourier_coefficient (\<lambda>x. f(x+t)) 0 * trigonometric_set 0 0 + (\<Sum>k = Suc 0..2*n. Fourier_coefficient (\<lambda>x. f(x+t)) k * trigonometric_set k 0)"
     by (simp add: atMost_atLeast0 sum.atLeast_Suc_atMost)
   moreover have "Fourier_coefficient f 0 * trigonometric_set 0 t
                = Fourier_coefficient (\<lambda>x. f(x+t)) 0 * trigonometric_set 0 0"
     by (simp add: Fourier_coefficient_def orthonormal_coeff_def trigonometric_set_def l2product_def integral_periodic_offset periodic)
   ultimately show ?thesis
     by simp
 qed
 
 
 lemma Fourier_sum_offset_unpaired:
   fixes f :: "real \<Rightarrow> real"
   assumes f: "f absolutely_integrable_on {-pi..pi}" and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows  "(\<Sum>k\<le>2*n. Fourier_coefficient f k * trigonometric_set k t) =
           (\<Sum>k\<le>n. Fourier_coefficient (\<lambda>x. f(x+t)) (2*k) * trigonometric_set (2*k) 0)"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>k\<le>n. Fourier_coefficient (\<lambda>x. f(x+t)) (2*k) *  trigonometric_set (2*k) 0 +
                    Fourier_coefficient (\<lambda>x. f(x+t)) (Suc (2*k)) * trigonometric_set (Suc (2*k)) 0)"
     apply (simp add: assms Fourier_sum_offset)
     apply (subst sum.in_pairs_0 [symmetric])
     by (simp add: trigonometric_set)
   also have "\<dots> = ?rhs"
     by (auto simp: trigonometric_set)
   finally show ?thesis .
 qed
 
 subsection\<open>Express partial sums using Dirichlet kernel\<close>
 
 definition Dirichlet_kernel
   where "Dirichlet_kernel \<equiv>
            \<lambda>n x. if x = 0 then real n + 1/2
                           else sin((real n + 1/2) * x) / (2 * sin(x/2))"
 
 lemma Dirichlet_kernel_0 [simp]:
    "\<bar>x\<bar> < 2 * pi \<Longrightarrow> Dirichlet_kernel 0 x = 1/2"
   by (auto simp: Dirichlet_kernel_def sin_zero_iff)
 
 lemma Dirichlet_kernel_minus [simp]: "Dirichlet_kernel n (-x) = Dirichlet_kernel n x"
   by (auto simp: Dirichlet_kernel_def)
 
 
 lemma Dirichlet_kernel_continuous_strong:
    "continuous_on {-(2 * pi)<..<2 * pi} (Dirichlet_kernel n)"
 proof -
   have "isCont (Dirichlet_kernel n) z" if "-(2 * pi) < z" "z < 2 * pi" for z
   proof (cases "z=0")
     case True
     have *: "(\<lambda>x. sin ((n + 1/2) * x) / (2 * sin (x/2))) \<midarrow>0 \<rightarrow> real n + 1/2"
       by real_asymp
     show ?thesis
       unfolding Dirichlet_kernel_def continuous_at True
       apply (rule Lim_transform_eventually [where f = "\<lambda>x. sin((n + 1/2) * x) / (2 * sin(x/2))"])
        apply (auto simp: * eventually_at_filter)
       done
   next
     case False
     have "continuous (at z) (\<lambda>x. sin((real n + 1/2) * x) / (2 * sin(x/2)))"
       using that False by (intro continuous_intros) (auto simp: sin_zero_iff)
     moreover have "\<forall>\<^sub>F x in nhds z. x \<noteq> 0"
       using False t1_space_nhds by blast
     ultimately show ?thesis
       using False
       by (force simp: Dirichlet_kernel_def continuous_at eventually_at_filter elim: Lim_transform_eventually)
   qed
   then show ?thesis
     by (simp add: continuous_on_eq_continuous_at)
 qed
 
 lemma Dirichlet_kernel_continuous: "continuous_on {-pi..pi} (Dirichlet_kernel n)"
   apply (rule continuous_on_subset [OF Dirichlet_kernel_continuous_strong], clarsimp)
   using pi_gt_zero by linarith
 
 
 lemma absolutely_integrable_mult_Dirichlet_kernel:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>x. Dirichlet_kernel n x * f x) absolutely_integrable_on {-pi..pi}"
 proof (rule absolutely_integrable_bounded_measurable_product_real)
   show "Dirichlet_kernel n \<in> borel_measurable (lebesgue_on {-pi..pi})"
     by (simp add: Dirichlet_kernel_continuous continuous_imp_measurable_on_sets_lebesgue)
   have "compact (Dirichlet_kernel n ` {-pi..pi})"
     by (auto simp: compact_continuous_image [OF Dirichlet_kernel_continuous])
   then show "bounded (Dirichlet_kernel n ` {-pi..pi})"
     using compact_imp_bounded by blast
 qed (use assms in auto)
 
 
 lemma cosine_sum_lemma:
    "(1/2 + (\<Sum>k = Suc 0..n. cos(real k * x))) * sin(x/2) =  sin((real n + 1/2) * x) / 2"
 proof -
   consider "n=0" | "n \<ge> 1" by linarith
   then show ?thesis
   proof cases
     case 2
     then have "(\<Sum>k = Suc 0..n. (sin (real k * x + x/2) * 2 - sin (real k * x - x/2) * 2) / 2)
         = sin (real n * x + x/2) - sin (x/2)"
     proof (induction n)
       case (Suc n)
       show ?case
       proof (cases "n=0")
         case False
         with Suc show ?thesis
           by (simp add: divide_simps algebra_simps)
       qed auto
     qed auto
     then show ?thesis
       by (simp add: distrib_right sum_distrib_right cos_times_sin)
   qed auto
 qed
 
 
 lemma Dirichlet_kernel_cosine_sum:
   assumes "\<bar>x\<bar> < 2 * pi"
   shows "Dirichlet_kernel n x = 1/2 + (\<Sum>k = Suc 0..n. cos(real k * x))"
 proof -
   have "sin ((real n + 1/2) * x) / (2 * sin (x/2)) = 1/2 + (\<Sum>k = Suc 0..n. cos (real k * x))"
     if "x \<noteq> 0"
   proof -
     have "sin(x/2) \<noteq> 0"
       using assms that by (auto simp: sin_zero_iff)
     then show ?thesis
      using cosine_sum_lemma [of x n] by (simp add: divide_simps)
   qed
   then show ?thesis
     by (auto simp: Dirichlet_kernel_def)
 qed
 
 lemma integrable_Dirichlet_kernel: "integrable (lebesgue_on {-pi..pi}) (Dirichlet_kernel n)"
   using Dirichlet_kernel_continuous continuous_imp_integrable_real by blast
 
 lemma integral_Dirichlet_kernel [simp]:
   "integral\<^sup>L (lebesgue_on {-pi..pi}) (Dirichlet_kernel n) = pi"
 proof -
   have "integral\<^sup>L (lebesgue_on {-pi..pi}) (Dirichlet_kernel n) = LINT x|lebesgue_on {-pi..pi}. 1/2 + (\<Sum>k = Suc 0..n. cos (k * x))"
     using pi_ge_two
     by (force intro: Bochner_Integration.integral_cong [OF refl Dirichlet_kernel_cosine_sum])
   also have "\<dots> = (LINT x|lebesgue_on {-pi..pi}. 1/2) + (LINT x|lebesgue_on {-pi..pi}. (\<Sum>k = Suc 0..n. cos (k * x)))"
   proof (rule Bochner_Integration.integral_add)
     show "integrable (lebesgue_on {-pi..pi}) (\<lambda>x. \<Sum>k = Suc 0..n. cos (real k * x))"
       by (rule Bochner_Integration.integrable_sum) (metis integrable_cos_cx mult_commute_abs)
   qed auto
   also have "\<dots> = pi"
   proof -
     have "\<And>i. \<lbrakk>Suc 0 \<le> i; i \<le> n\<rbrakk>
          \<Longrightarrow> integrable (lebesgue_on {-pi..pi}) (\<lambda>x. cos (real i * x))"
       by (metis integrable_cos_cx mult_commute_abs)
     then have "LINT x|lebesgue_on {-pi..pi}. (\<Sum>k = Suc 0..n. cos (real k * x)) = 0"
       by (simp add: Bochner_Integration.integral_sum)
     then show ?thesis
       by (auto simp: measure_restrict_space)
   qed
   finally show ?thesis .
 qed
 
 lemma integral_Dirichlet_kernel_half [simp]:
   "integral\<^sup>L (lebesgue_on {0..pi}) (Dirichlet_kernel n) = pi/2"
 proof -
   have "integral\<^sup>L (lebesgue_on {- pi..0}) (Dirichlet_kernel n) +
         integral\<^sup>L (lebesgue_on {0..pi}) (Dirichlet_kernel n) = pi"
     using integral_combine [OF integrable_Dirichlet_kernel] integral_Dirichlet_kernel by simp
   moreover have "integral\<^sup>L (lebesgue_on {- pi..0}) (Dirichlet_kernel n) = integral\<^sup>L (lebesgue_on {0..pi}) (Dirichlet_kernel n)"
     using integral_reflect_real [of pi 0 "Dirichlet_kernel n"] by simp
   ultimately show ?thesis
     by simp
 qed
 
 
 lemma Fourier_sum_offset_Dirichlet_kernel:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows
    "(\<Sum>k\<le>2*n. Fourier_coefficient f k * trigonometric_set k t) =
             integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. Dirichlet_kernel n x * f(x+t)) / pi"
   (is "?lhs = ?rhs")
 proof -
   have ft: "(\<lambda>x. f(x+t)) absolutely_integrable_on {-pi..pi}"
     using absolutely_integrable_periodic_offset [OF f, of t] periodic by simp
   have "?lhs = (\<Sum>k=0..n. Fourier_coefficient (\<lambda>x. f(x+t)) (2*k) * trigonometric_set (2*k) 0)"
     using Fourier_sum_offset_unpaired assms atMost_atLeast0 by auto
   also have "\<dots> = Fourier_coefficient (\<lambda>x. f(x+t)) 0 / sqrt (2 * pi)
                  + (\<Sum>k = Suc 0..n. Fourier_coefficient (\<lambda>x. f(x+t)) (2*k) / sqrt pi)"
     by (simp add: sum.atLeast_Suc_atMost trigonometric_set_def)
   also have "\<dots> = (LINT x|lebesgue_on {-pi..pi}. f(x+t)) / (2 * pi) +
                    (\<Sum>k = Suc 0..n. (LINT x|lebesgue_on {-pi..pi}. cos (real k * x) * f(x+t)) / pi)"
     by (simp add: Fourier_coefficient_def orthonormal_coeff_def trigonometric_set_def l2product_def)
   also have "\<dots> = LINT x|lebesgue_on {-pi..pi}.
                      f(x+t) / (2 * pi) + (\<Sum>k = Suc 0..n. (cos (real k * x) * f(x+t)) / pi)"
     using Fourier_products_integrable_cos [OF ft] absolutely_integrable_imp_integrable [OF ft] by simp
   also have "\<dots> = (LINT x|lebesgue_on {-pi..pi}.
                      f(x+t) / 2 + (\<Sum>k = Suc 0..n. cos (real k * x) * f(x+t))) / pi"
     by (simp add: divide_simps sum_distrib_right mult.assoc)
   also have "\<dots> = ?rhs"
   proof -
     have "LINT x|lebesgue_on {-pi..pi}. f(x + t) / 2 + (\<Sum>k = Suc 0..n. cos (real k * x) * f(x + t))
         = LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * f(x + t)"
     proof -
       have eq: "f(x+t) / 2 + (\<Sum>k = Suc 0..n. cos (real k * x) * f(x + t))
               = Dirichlet_kernel n x * f(x + t)" if "- pi \<le> x" "x \<le> pi" for x
       proof (cases "x = 0")
         case False
         then have "sin (x/2) \<noteq> 0"
           using that by (auto simp: sin_zero_iff)
         then have "f(x + t) * (1/2 + (\<Sum>k = Suc 0..n. cos(real k * x))) = f(x + t) * sin((real n + 1/2) * x) / 2 / sin(x/2)"
           using cosine_sum_lemma [of x n] by (simp add: divide_simps)
         then show ?thesis
           by (simp add: Dirichlet_kernel_def False field_simps sum_distrib_left)
       qed (simp add: Dirichlet_kernel_def algebra_simps)
       show ?thesis
         by (rule Bochner_Integration.integral_cong [OF refl]) (simp add: eq)
     qed
     then show ?thesis by simp
   qed
   finally show ?thesis .
 qed
 
 
 lemma Fourier_sum_limit_Dirichlet_kernel:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "((\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> l)
      \<longleftrightarrow> (\<lambda>n. LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * f(x + t)) \<longlonglongrightarrow> pi * l"
     (is "?lhs = ?rhs")
 proof -
   have "?lhs \<longleftrightarrow> (\<lambda>n. (LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * f(x + t)) / pi) \<longlonglongrightarrow> l"
     by (simp add: Fourier_sum_limit_pair [OF f, symmetric] Fourier_sum_offset_Dirichlet_kernel assms)
   also have "\<dots> \<longleftrightarrow> (\<lambda>k. (LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel k x * f(x + t)) * inverse pi)
                     \<longlonglongrightarrow> pi * l * inverse pi"
     by (auto simp: divide_simps)
   also have "\<dots> \<longleftrightarrow> ?rhs"
     using tendsto_mult_right_iff [of "inverse pi", symmetric] by auto
   finally show ?thesis .
 qed
 
 subsection\<open>A directly deduced sufficient condition for convergence at a point\<close>
 
 lemma simple_Fourier_convergence_periodic:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and ft: "(\<lambda>x. (f(x+t) - f t) / sin(x/2)) absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> f t"
 proof -
   let ?\<Phi> = "\<lambda>n. \<Sum>k\<le>n. Fourier_coefficient (\<lambda>x. f x - f t) k * trigonometric_set k t"
   let ?\<Psi> = "\<lambda>n. LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * (f(x + t) - f t)"
   have fft: "(\<lambda>x. f x - f t) absolutely_integrable_on {-pi..pi}"
     by (simp add: f absolutely_integrable_measurable_real)
   have fxt: "(\<lambda>x. f(x + t)) absolutely_integrable_on {-pi..pi}"
     using absolutely_integrable_periodic_offset assms by auto
   have *: "?\<Phi> \<longlonglongrightarrow> 0 \<longleftrightarrow> ?\<Psi> \<longlonglongrightarrow> 0"
     by (simp add: Fourier_sum_limit_Dirichlet_kernel fft periodic)
   moreover have "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) - f t) \<longlonglongrightarrow> 0"
     if "?\<Phi> \<longlonglongrightarrow> 0"
   proof (rule Lim_transform_eventually [OF that eventually_sequentiallyI])
     show "(\<Sum>k\<le>n. Fourier_coefficient (\<lambda>x. f x - f t) k * trigonometric_set k t)
         = (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) - f t"
       if "Suc 0 \<le> n" for n
     proof -
       have "(\<Sum>k = Suc 0..n. Fourier_coefficient (\<lambda>x. f x - f t) k * trigonometric_set k t)
           = (\<Sum>k = Suc 0..n. Fourier_coefficient f k * trigonometric_set k t)"
       proof (rule sum.cong [OF refl])
         fix k
         assume k: "k \<in> {Suc 0..n}"
         then have [simp]: "integral\<^sup>L (lebesgue_on {-pi..pi}) (trigonometric_set k) = 0"
           by (auto simp: trigonometric_set_def)
         show "Fourier_coefficient (\<lambda>x. f x - f t) k * trigonometric_set k t = Fourier_coefficient f k * trigonometric_set k t"
           using k unfolding Fourier_coefficient_def orthonormal_coeff_def l2product_def
           by (simp add: right_diff_distrib f absolutely_integrable_measurable_real trigonometric_set_mul_integrable)
       qed
       moreover have "Fourier_coefficient (\<lambda>x. f x - f t) 0 * trigonometric_set 0 t =
                      Fourier_coefficient f 0 * trigonometric_set 0 t - f t"
         using f unfolding Fourier_coefficient_def orthonormal_coeff_def l2product_def
         by (auto simp: divide_simps trigonometric_set absolutely_integrable_imp_integrable measure_restrict_space)
       ultimately show ?thesis
         by (simp add: sum.atLeast_Suc_atMost atMost_atLeast0)
     qed
   qed
   moreover
   have "?\<Psi> \<longlonglongrightarrow> 0"
   proof -
     have eq: "\<And>n. ?\<Psi> n = integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin((n + 1/2) * x) * ((f(x+t) - f t) / sin(x/2) / 2))"
       unfolding Dirichlet_kernel_def
       by (rule Bochner_Integration.integral_cong [OF refl]) (auto simp: divide_simps sin_zero_iff)
     show ?thesis
       unfolding eq
       by (intro ft set_integrable_divide Riemann_lebesgue_sin_half)
   qed
   ultimately show ?thesis
     by (simp add: LIM_zero_cancel)
 qed
 
 
 subsection\<open>A more natural sufficient Hoelder condition at a point\<close>
 
 lemma bounded_inverse_sin_half:
   assumes "d > 0"
   obtains B where "B>0" "\<And>x. x \<in> ({-pi..pi} - {-d<..<d}) \<Longrightarrow> \<bar>inverse (sin (x/2))\<bar> \<le> B"
 proof -
   have "bounded ((\<lambda>x. inverse (sin (x/2))) ` ({-pi..pi} - {- d<..<d}))"
   proof (intro compact_imp_bounded compact_continuous_image)
     have "\<lbrakk>x \<in> {-pi..pi}; x \<noteq> 0\<rbrakk> \<Longrightarrow> sin (x/2) \<noteq> 0" for x
       using \<open>0 < d\<close> by (auto simp: sin_zero_iff)
     then show "continuous_on ({-pi..pi} - {-d<..<d}) (\<lambda>x. inverse (sin (x/2)))"
       using \<open>0 < d\<close> by (intro continuous_intros) auto
     show "compact ({-pi..pi} - {-d<..<d})"
       by (simp add: compact_diff)
   qed
   then show thesis
     using that by (auto simp: bounded_pos)
 qed
 
 proposition Hoelder_Fourier_convergence_periodic:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and "d > 0" "a > 0"
     and ft: "\<And>x. \<bar>x-t\<bar> < d \<Longrightarrow> \<bar>f x - f t\<bar> \<le> M * \<bar>x-t\<bar> powr a"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> f t"
 proof (rule simple_Fourier_convergence_periodic [OF f])
   have half: "((\<lambda>x. sin(x/2)) has_real_derivative 1/2) (at 0)"
     by (rule derivative_eq_intros refl | force)+
   then obtain e0::real where "e0 > 0" and e0: "\<And>x. \<lbrakk>x \<noteq> 0; \<bar>x\<bar> < e0\<rbrakk> \<Longrightarrow> \<bar>sin (x/2) / x - 1/2\<bar> < 1/4"
     apply (simp add: DERIV_def Lim_at dist_real_def)
     apply (drule_tac x="1/4" in spec, auto)
     done
   obtain e where "e > 0" and e: "\<And>x. \<bar>x\<bar> < e \<Longrightarrow> \<bar>(f(x+t) - f t) / sin (x/2)\<bar> \<le> 4 * (\<bar>M\<bar> * \<bar>x\<bar> powr (a-1))"
   proof
     show "min d e0 > 0"
       using \<open>d > 0\<close> \<open>e0 > 0\<close> by auto
   next
     fix x
     assume x: "\<bar>x\<bar> < min d e0"
     show "\<bar>(f(x + t) - f t) / sin (x/2)\<bar> \<le> 4 * (\<bar>M\<bar> * \<bar>x\<bar> powr (a - 1))"
     proof (cases "sin(x/2) = 0 \<or> x=0")
       case False
       have eq: "\<bar>(f(x + t) - f t) / sin (x/2)\<bar> = \<bar>inverse (sin (x/2) / x)\<bar> * (\<bar>f(x + t) - f t\<bar> / \<bar>x\<bar>)"
         by simp
       show ?thesis
         unfolding eq
       proof (rule mult_mono)
         have "\<bar>sin (x/2) / x - 1/2\<bar> < 1/4"
           using e0 [of x] x False by force
         then have "1/4 \<le> \<bar>sin (x/2) / x\<bar>"
           by (simp add: abs_if field_simps split: if_split_asm)
         then show "\<bar>inverse (sin (x/2) / x)\<bar> \<le> 4"
           using False by (simp add: field_simps)
         have "\<bar>f(x + t) - f t\<bar> / \<bar>x\<bar> \<le> M * \<bar>x + t - t\<bar> powr (a - 1)"
           using ft [of "x+t"] x by (auto simp: divide_simps algebra_simps Transcendental.powr_mult_base)
         also have "\<dots> \<le> \<bar>M\<bar> * \<bar>x\<bar> powr (a - 1)"
           by (simp add: mult_mono)
         finally show "\<bar>f(x + t) - f t\<bar> / \<bar>x\<bar> \<le> \<bar>M\<bar> * \<bar>x\<bar> powr (a - 1)" .
       qed auto
     qed auto
   qed
   obtain B where "B>0" and B: "\<And>x. x \<in> ({-pi..pi} - {- e<..<e}) \<Longrightarrow> \<bar>inverse (sin (x/2))\<bar> \<le> B"
     using bounded_inverse_sin_half [OF \<open>e > 0\<close>] by metis
   let ?g = "\<lambda>x. max (B * \<bar>f(x + t) - f t\<bar>) ((4 * \<bar>M\<bar>) * \<bar>x\<bar> powr (a - 1))"
   show "(\<lambda>x. (f(x + t) - f t) / sin (x/2)) absolutely_integrable_on {-pi..pi}"
   proof (rule measurable_bounded_by_integrable_imp_absolutely_integrable)
     have fxt: "(\<lambda>x. f(x + t)) absolutely_integrable_on {-pi..pi}"
       using absolutely_integrable_periodic_offset assms by auto
     show "(\<lambda>x. (f(x + t) - f t) / sin (x/2)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
     proof (intro measurable)
       show "(\<lambda>x. f(x + t)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
         using absolutely_integrable_on_def fxt integrable_imp_measurable by blast
       show "(\<lambda>x. sin (x/2)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
         by (intro continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
     qed auto
     have "(\<lambda>x. f(x + t) - f t) absolutely_integrable_on {-pi..pi}"
       by (intro set_integral_diff fxt) (simp add: set_integrable_def)
     moreover
     have "(\<lambda>x. \<bar>x\<bar> powr (a - 1)) absolutely_integrable_on {-pi..pi}"
     proof -
       have "((\<lambda>x. x powr (a - 1)) has_integral
        inverse a * pi powr a - inverse a * 0 powr a)
        {0..pi}"
       proof (rule fundamental_theorem_of_calculus_interior)
         show "continuous_on {0..pi} (\<lambda>x. inverse a * x powr a)"
           using \<open>a > 0\<close>
           by (intro continuous_on_powr' continuous_intros) auto
         show "((\<lambda>b. inverse a * b powr a) has_vector_derivative x powr (a - 1)) (at x)"
           if "x \<in> {0<..<pi}" for x
           using that \<open>a > 0\<close>
           apply (simp flip: has_field_derivative_iff_has_vector_derivative)
           apply (rule derivative_eq_intros | simp)+
           done
       qed auto
       then have int: "(\<lambda>x. x powr (a - 1)) integrable_on {0..pi}"
         by blast
       show ?thesis
       proof (rule nonnegative_absolutely_integrable_1)
         show "(\<lambda>x. \<bar>x\<bar> powr (a - 1)) integrable_on {-pi..pi}"
         proof (rule Henstock_Kurzweil_Integration.integrable_combine)
           show "(\<lambda>x. \<bar>x\<bar> powr (a - 1)) integrable_on {0..pi}"
             using int integrable_eq by fastforce
           then show "(\<lambda>x. \<bar>x\<bar> powr (a - 1)) integrable_on {- pi..0}"
             using Henstock_Kurzweil_Integration.integrable_reflect_real by fastforce
         qed auto
       qed auto
     qed
     ultimately show "?g integrable_on {-pi..pi}"
       apply (intro set_lebesgue_integral_eq_integral absolutely_integrable_max_1 absolutely_integrable_bounded_measurable_product_real set_integrable_abs measurable)
               apply (auto simp: image_constant_conv)
       done
     show "norm ((f(x + t) - f t) / sin (x/2)) \<le> ?g x" if "x \<in> {-pi..pi}" for x
     proof (cases "\<bar>x\<bar> < e")
       case True
       then show ?thesis
         using e [OF True] by (simp add: max_def)
     next
       case False
       then have "\<bar>inverse (sin (x/2))\<bar> \<le> B"
         using B that by force
       then have "\<bar>inverse (sin (x/2))\<bar> * \<bar>f(x + t) - f t\<bar> \<le> B * \<bar>f(x + t) - f t\<bar>"
         by (simp add: mult_right_mono)
       then have "\<bar>f(x + t) - f t\<bar> / \<bar>sin (x/2)\<bar> \<le> B * \<bar>f(x + t) - f t\<bar>"
         by (simp add: divide_simps split: if_split_asm)
       then show ?thesis
         by auto
     qed
   qed auto
 qed (auto simp: periodic)
 
 
 text\<open>In particular, a Lipschitz condition at the point\<close>
 corollary Lipschitz_Fourier_convergence_periodic:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and "d > 0"
     and ft: "\<And>x. \<bar>x-t\<bar> < d \<Longrightarrow> \<bar>f x - f t\<bar> \<le> M * \<bar>x-t\<bar>"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> f t"
   using Hoelder_Fourier_convergence_periodic [OF f \<open>d > 0\<close>, of 1] assms
   by (fastforce simp add:)
 
 text\<open>In particular, if left and right derivatives both exist\<close>
 proposition bi_differentiable_Fourier_convergence_periodic:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and f_lt: "f differentiable at_left t"
     and f_gt: "f differentiable at_right t"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> f t"
 proof -
   obtain D_lt where D_lt: "\<And>e. e > 0 \<Longrightarrow> \<exists>d>0. \<forall>x<t. 0 < dist x t \<and> dist x t < d \<longrightarrow> dist ((f x - f t) / (x - t)) D_lt < e"
     using f_lt unfolding has_field_derivative_iff real_differentiable_def Lim_within
     by (meson lessThan_iff)
   then obtain d_lt where "d_lt > 0"
     and d_lt: "\<And>x. \<lbrakk>x < t; 0 < \<bar>x - t\<bar>; \<bar>x - t\<bar> < d_lt\<rbrakk> \<Longrightarrow> \<bar>(f x - f t) / (x - t) - D_lt\<bar> < 1"
     unfolding dist_real_def by (metis dist_commute dist_real_def zero_less_one)
   obtain D_gt where D_gt: "\<And>e. e > 0 \<Longrightarrow> \<exists>d>0. \<forall>x>t. 0 < dist x t \<and> dist x t < d \<longrightarrow> dist ((f x - f t) / (x - t)) D_gt < e"
     using f_gt unfolding has_field_derivative_iff real_differentiable_def Lim_within
     by (meson greaterThan_iff)
   then obtain d_gt where "d_gt > 0"
     and d_gt: "\<And>x. \<lbrakk>x > t; 0 < \<bar>x - t\<bar>; \<bar>x - t\<bar> < d_gt\<rbrakk> \<Longrightarrow> \<bar>(f x - f t) / (x - t) - D_gt\<bar> < 1"
     unfolding dist_real_def by (metis dist_commute dist_real_def zero_less_one)
   show ?thesis
   proof (rule Lipschitz_Fourier_convergence_periodic [OF f])
     fix x
     assume "\<bar>x - t\<bar> < min d_lt d_gt"
     then have *: "\<bar>x - t\<bar> < d_lt" "\<bar>x - t\<bar> < d_gt"
       by auto
     consider "x<t" | "x=t" | "x>t"
       by linarith
     then show "\<bar>f x - f t\<bar> \<le> (\<bar>D_lt\<bar> + \<bar>D_gt\<bar> + 1)  * \<bar>x - t\<bar>"
     proof cases
       case 1
       then have "\<bar>(f x - f t) / (x - t) - D_lt\<bar> < 1"
         using d_lt [OF 1] * by auto
       then have "\<bar>(f x - f t) / (x - t)\<bar> - \<bar>D_lt\<bar> < 1"
         by linarith
       then have "\<bar>f x - f t\<bar> \<le> (\<bar>D_lt\<bar> + 1) * \<bar>x - t\<bar>"
         by (simp add: comm_semiring_class.distrib divide_simps split: if_split_asm)
       also have "\<dots> \<le> (\<bar>D_lt\<bar> + \<bar>D_gt\<bar> + 1) * \<bar>x - t\<bar>"
         by (simp add: mult_right_mono)
       finally show ?thesis .
     next
       case 3
       then have "\<bar>(f x - f t) / (x - t) - D_gt\<bar> < 1"
         using d_gt [OF 3] * by auto
       then have "\<bar>(f x - f t) / (x - t)\<bar> - \<bar>D_gt\<bar> < 1"
         by linarith
       then have "\<bar>f x - f t\<bar> \<le> (\<bar>D_gt\<bar> + 1) * \<bar>x - t\<bar>"
         by (simp add: comm_semiring_class.distrib divide_simps split: if_split_asm)
       also have "\<dots> \<le> (\<bar>D_lt\<bar> + \<bar>D_gt\<bar> + 1) * \<bar>x - t\<bar>"
         by (simp add: mult_right_mono)
       finally show ?thesis .
     qed auto
   qed (auto simp: \<open>0 < d_gt\<close> \<open>0 < d_lt\<close> periodic)
 qed
 
 
 text\<open>And in particular at points where the function is differentiable\<close>
 lemma differentiable_Fourier_convergence_periodic:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and fdif: "f differentiable (at t)"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> f t"
   by (rule bi_differentiable_Fourier_convergence_periodic) (auto simp: differentiable_at_withinI assms)
 
 text\<open>Use reflection to halve the region of integration\<close>
 lemma absolutely_integrable_mult_Dirichlet_kernel_reflected:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>x. Dirichlet_kernel n x * f(t+x)) absolutely_integrable_on {-pi..pi}"
         "(\<lambda>x. Dirichlet_kernel n x * f(t-x)) absolutely_integrable_on {-pi..pi}"
         "(\<lambda>x. Dirichlet_kernel n x * c) absolutely_integrable_on {-pi..pi}"
 proof -
   show "(\<lambda>x. Dirichlet_kernel n x * f(t+x)) absolutely_integrable_on {-pi..pi}"
     apply (rule absolutely_integrable_mult_Dirichlet_kernel)
     using absolutely_integrable_periodic_offset [OF f, of t] periodic
     apply simp
     done
   then show "(\<lambda>x. Dirichlet_kernel n x * f(t-x)) absolutely_integrable_on {-pi..pi}"
     by (subst absolutely_integrable_reflect_real [symmetric]) simp
   show "(\<lambda>x. Dirichlet_kernel n x * c) absolutely_integrable_on {-pi..pi}"
     by (simp add: absolutely_integrable_measurable_real borel_measurable_integrable integrable_Dirichlet_kernel)
 qed
 
 
 lemma absolutely_integrable_mult_Dirichlet_kernel_reflected_part:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "d \<le> pi"
   shows "(\<lambda>x. Dirichlet_kernel n x * f(t+x)) absolutely_integrable_on {0..d}"
         "(\<lambda>x. Dirichlet_kernel n x * f(t-x)) absolutely_integrable_on {0..d}"
         "(\<lambda>x. Dirichlet_kernel n x * c) absolutely_integrable_on {0..d}"
   using absolutely_integrable_mult_Dirichlet_kernel_reflected [OF f periodic, of n] \<open>d \<le> pi\<close>
   by (force intro: absolutely_integrable_on_subinterval)+
 
 lemma absolutely_integrable_mult_Dirichlet_kernel_reflected_part2:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "d \<le> pi"
   shows "(\<lambda>x. Dirichlet_kernel n x * (f(t+x) + f(t-x))) absolutely_integrable_on {0..d}"
         "(\<lambda>x. Dirichlet_kernel n x * ((f(t+x) + f(t-x)) - c)) absolutely_integrable_on {0..d}"
   using absolutely_integrable_mult_Dirichlet_kernel_reflected_part assms
   by (simp_all add: distrib_left right_diff_distrib)
 
 lemma integral_reflect_and_add:
   fixes f :: "real \<Rightarrow> 'b::euclidean_space"
   assumes "integrable (lebesgue_on {-a..a}) f"
   shows "integral\<^sup>L (lebesgue_on {-a..a}) f = integral\<^sup>L (lebesgue_on {0..a})  (\<lambda>x. f x + f(-x))"
 proof (cases "a \<ge> 0")
   case True
   have f: "integrable (lebesgue_on {0..a}) f" "integrable (lebesgue_on {-a..0}) f"
     using integrable_subinterval assms by fastforce+
   then have fm: "integrable (lebesgue_on {0..a}) (\<lambda>x. f(-x))"
     using integrable_reflect_real by fastforce
   have "integral\<^sup>L (lebesgue_on {-a..a}) f = integral\<^sup>L (lebesgue_on {-a..0}) f + integral\<^sup>L (lebesgue_on {0..a}) f"
     by (simp add: True assms integral_combine)
   also have "\<dots> = integral\<^sup>L (lebesgue_on {0..a}) (\<lambda>x. f(-x)) + integral\<^sup>L (lebesgue_on {0..a}) f"
     by (metis (no_types) add.inverse_inverse add.inverse_neutral integral_reflect_real)
   also have "\<dots> = integral\<^sup>L (lebesgue_on {0..a}) (\<lambda>x. f x + f(-x))"
     by (simp add: fm f)
   finally show ?thesis .
 qed (use assms in auto)
 
 lemma Fourier_sum_offset_Dirichlet_kernel_half:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<Sum>k\<le>2*n. Fourier_coefficient f k * trigonometric_set k t) - l
        = (LINT x|lebesgue_on {0..pi}. Dirichlet_kernel n x * (f(t+x) + f(t-x) - 2*l)) / pi"
 proof -
   have fxt: "(\<lambda>x. f(x + t)) absolutely_integrable_on {-pi..pi}"
     using absolutely_integrable_periodic_offset assms by auto
   have int: "integrable (lebesgue_on {0..pi}) (Dirichlet_kernel n)"
     using not_integrable_integral_eq by fastforce
   have "LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * f(x + t)
       = LINT x|lebesgue_on {0..pi}. Dirichlet_kernel n x * f(x + t) + Dirichlet_kernel n (- x) * f(- x + t)"
     by (simp add: integral_reflect_and_add absolutely_integrable_imp_integrable absolutely_integrable_mult_Dirichlet_kernel fxt)
   also have "\<dots> = (LINT x|lebesgue_on {0..pi}. Dirichlet_kernel n x * (f(t+x) + f(t-x) - 2*l)) + pi * l"
     using absolutely_integrable_mult_Dirichlet_kernel_reflected_part [OF f periodic order_refl, of n t]
     apply (simp add: algebra_simps absolutely_integrable_imp_integrable int)
     done
   finally show ?thesis
     by (simp add: Fourier_sum_offset_Dirichlet_kernel assms divide_simps)
 qed
 
 lemma Fourier_sum_limit_Dirichlet_kernel_half:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> l
      \<longleftrightarrow> (\<lambda>n. (LINT x|lebesgue_on {0..pi}. Dirichlet_kernel n x * (f(t+x) + f(t-x) - 2*l))) \<longlonglongrightarrow> 0"
   apply (simp flip: Fourier_sum_limit_pair [OF f])
   apply (simp add: Lim_null [where l=l] Fourier_sum_offset_Dirichlet_kernel_half assms)
   done
 
 
 subsection\<open>Localization principle: convergence only depends on values "nearby"\<close>
 
 proposition Riemann_localization_integral:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and g: "g absolutely_integrable_on {-pi..pi}"
     and "d > 0" and d: "\<And>x. \<bar>x\<bar> < d \<Longrightarrow> f x = g x"
   shows "(\<lambda>n. integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. Dirichlet_kernel n x * f x)
             - integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. Dirichlet_kernel n x * g x))
          \<longlonglongrightarrow> 0"  (is "?a \<longlonglongrightarrow> 0")
 proof -
   let ?f = "\<lambda>x. (if \<bar>x\<bar> < d then 0 else f x - g x) / sin(x/2) / 2"
   have eq: "?a n = integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin((n+1/2) * x) * ?f x)" for n
   proof -
     have "?a n = integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. Dirichlet_kernel n x * (if \<bar>x\<bar> < d then 0 else f x - g x))"
       apply (simp add: absolutely_integrable_imp_integrable absolutely_integrable_mult_Dirichlet_kernel f g flip: Bochner_Integration.integral_diff)
       apply (auto simp: d algebra_simps intro: Bochner_Integration.integral_cong)
       done
     also have "\<dots> = integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. sin((n+1/2) * x) * ?f x)"
       using \<open>d > 0\<close> by (auto simp: Dirichlet_kernel_def intro: Bochner_Integration.integral_cong)
     finally show ?thesis .
   qed
   show ?thesis
     unfolding eq
   proof (rule Riemann_lebesgue_sin_half)
     obtain B where "B>0" and B: "\<And>x. x \<in> ({-pi..pi} - {-d<..<d}) \<Longrightarrow> \<bar>inverse (sin (x/2))\<bar> \<le> B"
       using bounded_inverse_sin_half [OF \<open>d > 0\<close>] by metis
     have "(\<lambda>x. (if \<bar>x\<bar> < d then 0 else f x - g x) / sin (x/2)) absolutely_integrable_on {-pi..pi}"
     proof (rule measurable_bounded_by_integrable_imp_absolutely_integrable)
       show "(\<lambda>x. (if \<bar>x\<bar> < d then 0 else f x - g x) / sin (x/2)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
       proof (intro measurable)
         show "f \<in> borel_measurable (lebesgue_on {-pi..pi})" "g \<in> borel_measurable (lebesgue_on {-pi..pi})"
           using absolutely_integrable_on_def f g integrable_imp_measurable by blast+
         show "(\<lambda>x. x) \<in> borel_measurable (lebesgue_on {-pi..pi})"
              "(\<lambda>x. sin (x/2)) \<in> borel_measurable (lebesgue_on {-pi..pi})"
           by (intro continuous_intros continuous_imp_measurable_on_sets_lebesgue | force)+
       qed auto
       have "(\<lambda>x. B * \<bar>f x - g x\<bar>) absolutely_integrable_on {-pi..pi}"
         using \<open>B > 0\<close> by (simp add: f g set_integrable_abs)
       then show "(\<lambda>x. B * \<bar>f x - g x\<bar>) integrable_on {-pi..pi}"
         using absolutely_integrable_on_def by blast
     next
       fix x
       assume x: "x \<in> {-pi..pi}"
       then have [simp]: "sin (x/2) = 0 \<longleftrightarrow> x=0"
         using \<open>0 < d\<close> by (force simp: sin_zero_iff)
       show "norm ((if \<bar>x\<bar> < d then 0 else f x - g x) / sin (x/2)) \<le> B * \<bar>f x - g x\<bar>"
       proof (cases "\<bar>x\<bar> < d")
         case False
         then have "1 \<le> B * \<bar>sin (x/2)\<bar>"
           using \<open>B > 0\<close> B [of x] x \<open>d > 0\<close>
           by (auto simp: abs_less_iff divide_simps split: if_split_asm)
         then have "1 * \<bar>f x - g x\<bar> \<le> B * \<bar>sin (x/2)\<bar> * \<bar>f x - g x\<bar>"
           by (metis (full_types) abs_ge_zero mult.commute mult_left_mono)
         then show ?thesis
           using False by (auto simp: divide_simps algebra_simps)
       qed (simp add: d)
     qed auto
     then show "(\<lambda>x. (if \<bar>x\<bar> < d then 0 else f x - g x) / sin (x/2) / 2) absolutely_integrable_on {-pi..pi}"
       using set_integrable_divide by blast
   qed
 qed
 
 lemma Riemann_localization_integral_range:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and "0 < d" "d \<le> pi"
   shows "(\<lambda>n. integral\<^sup>L (lebesgue_on {-pi..pi}) (\<lambda>x. Dirichlet_kernel n x * f x)
             - integral\<^sup>L (lebesgue_on {-d..d}) (\<lambda>x. Dirichlet_kernel n x * f x))
              \<longlonglongrightarrow> 0"
 proof -
   have *: "(\<lambda>n. (LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * f x)
               - (LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * (if x \<in> {-d..d} then f x else 0)))
            \<longlonglongrightarrow> 0"
   proof (rule Riemann_localization_integral [OF f _ \<open>0 < d\<close>])
     have "f absolutely_integrable_on {-d..d}"
       using f absolutely_integrable_on_subinterval \<open>d \<le> pi\<close> by fastforce
     moreover have "(\<lambda>x. if - pi \<le> x \<and> x \<le> pi then if x \<in> {-d..d} then f x else 0  else 0)
                  = (\<lambda>x. if x \<in> {-d..d} then f x else 0)"
       using \<open>d \<le> pi\<close> by force
     ultimately
     show "(\<lambda>x. if x \<in> {-d..d} then f x else 0) absolutely_integrable_on {-pi..pi}"
       apply (subst absolutely_integrable_restrict_UNIV [symmetric])
       apply (simp flip: absolutely_integrable_restrict_UNIV [of "{-d..d}" f])
       done
   qed auto
   then show ?thesis
     using integral_restrict [of "{-d..d}" "{-pi..pi}" "\<lambda>x. Dirichlet_kernel _ x * f x"] assms
     by (simp add: if_distrib cong: if_cong)
 qed
 
 lemma Riemann_localization:
   assumes f: "f absolutely_integrable_on {-pi..pi}" and g: "g absolutely_integrable_on {-pi..pi}"
     and perf: "\<And>x. f(x + 2*pi) = f x"
     and perg: "\<And>x. g(x + 2*pi) = g x"
     and "d > 0" and d: "\<And>x. \<bar>x-t\<bar> < d \<Longrightarrow> f x = g x"
   shows "(\<lambda>n. \<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) \<longlonglongrightarrow> c
      \<longleftrightarrow> (\<lambda>n. \<Sum>k\<le>n. Fourier_coefficient g k * trigonometric_set k t) \<longlonglongrightarrow> c"
 proof -
   have "(\<lambda>n. LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * f(x + t)) \<longlonglongrightarrow> pi * c
     \<longleftrightarrow> (\<lambda>n. LINT x|lebesgue_on {-pi..pi}. Dirichlet_kernel n x * g (x + t)) \<longlonglongrightarrow> pi * c"
   proof (intro Lim_transform_eq Riemann_localization_integral)
     show "(\<lambda>x. f(x + t)) absolutely_integrable_on {-pi..pi}" "(\<lambda>x. g (x + t)) absolutely_integrable_on {-pi..pi}"
       using assms by (auto intro: absolutely_integrable_periodic_offset)
   qed (use assms in auto)
   then show ?thesis
     by (simp add: Fourier_sum_limit_Dirichlet_kernel assms)
 qed
 
 subsection\<open>Localize the earlier integral\<close>
 
 lemma Riemann_localization_integral_range_half:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and "0 < d" "d \<le> pi"
   shows "(\<lambda>n. (LINT x|lebesgue_on {0..pi}. Dirichlet_kernel n x * (f x + f(-x)))
             - (LINT x|lebesgue_on {0..d}. Dirichlet_kernel n x * (f x + f(-x)))) \<longlonglongrightarrow> 0"
 proof -
   have *: "(\<lambda>x. Dirichlet_kernel n x * f x) absolutely_integrable_on {-d..d}" for n
     by (metis (full_types) absolutely_integrable_mult_Dirichlet_kernel absolutely_integrable_on_subinterval
               \<open>d \<le> pi\<close> atLeastatMost_subset_iff f neg_le_iff_le)
   show ?thesis
     using absolutely_integrable_mult_Dirichlet_kernel [OF f]
     using Riemann_localization_integral_range [OF assms]
     apply (simp add: "*" absolutely_integrable_imp_integrable integral_reflect_and_add)
     apply (simp add: algebra_simps)
     done
 qed
 
 
 lemma Fourier_sum_limit_Dirichlet_kernel_part:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
     and d: "0 < d" "d \<le> pi"
   shows "(\<lambda>n. \<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t) \<longlonglongrightarrow> l
      \<longleftrightarrow> (\<lambda>n. (LINT x|lebesgue_on {0..d}. Dirichlet_kernel n x * ((f(t+x) + f(t-x)) - 2*l))) \<longlonglongrightarrow> 0"
 proof -
   have "(\<lambda>x. f(t+x)) absolutely_integrable_on {-pi..pi}"
     using absolutely_integrable_periodic_offset [OF f, of t] periodic by simp
   then have int: "(\<lambda>x. f(t+x) - l) absolutely_integrable_on {-pi..pi}"
     by auto
   have "(\<lambda>n. LINT x|lebesgue_on {0..pi}. Dirichlet_kernel n x * (f(t+x) + f(t-x) - 2*l)) \<longlonglongrightarrow> 0
     \<longleftrightarrow> (\<lambda>n. LINT x|lebesgue_on {0..d}. Dirichlet_kernel n x * (f(t+x) + f(t-x) - 2*l)) \<longlonglongrightarrow> 0"
     by (rule Lim_transform_eq) (use Riemann_localization_integral_range_half [OF int d] in auto)
   then show ?thesis
     by (simp add: Fourier_sum_limit_Dirichlet_kernel_half assms)
 qed
 
 subsection\<open>Make a harmless simplifying tweak to the Dirichlet kernel\<close>
 
 lemma inte_Dirichlet_kernel_mul_expand:
   assumes f: "f \<in> borel_measurable (lebesgue_on S)" and S: "S \<in> sets lebesgue"
   shows "(LINT x|lebesgue_on S. Dirichlet_kernel n x * f x
         = LINT x|lebesgue_on S. sin((n+1/2) * x) * f x / (2 * sin(x/2)))
        \<and> (integrable (lebesgue_on S) (\<lambda>x. Dirichlet_kernel n x * f x)
       \<longleftrightarrow> integrable (lebesgue_on S) (\<lambda>x. sin((n+1/2) * x) * f x / (2 * sin(x/2))))"
 proof (cases "0 \<in> S")
   case True
   have *: "{x. x = 0 \<and> x \<in> S} \<in> sets (lebesgue_on S)"
     using True  by (simp add: S sets_restrict_space_iff cong: conj_cong)
   have bm1: "(\<lambda>x. Dirichlet_kernel n x * f x) \<in> borel_measurable (lebesgue_on S)"
     unfolding Dirichlet_kernel_def
     by (force intro: * assms measurable continuous_imp_measurable_on_sets_lebesgue continuous_intros)
   have bm2: "(\<lambda>x. sin ((n + 1/2) * x) * f x / (2 * sin (x/2))) \<in> borel_measurable (lebesgue_on S)"
     by (intro assms measurable continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
   have 0: "{0} \<in> null_sets (lebesgue_on S)"
     using True by (simp add: S null_sets_restrict_space)
   show ?thesis
     apply (intro conjI integral_cong_AE integrable_cong_AE bm1 bm2 AE_I' [OF 0])
     unfolding Dirichlet_kernel_def  by auto
 next
   case False
   then show ?thesis
     unfolding Dirichlet_kernel_def by (auto intro!: Bochner_Integration.integral_cong Bochner_Integration.integrable_cong)
 qed
 
 lemma
   assumes f: "f \<in> borel_measurable (lebesgue_on S)" and S: "S \<in> sets lebesgue"
   shows integral_Dirichlet_kernel_mul_expand:
         "(LINT x|lebesgue_on S. Dirichlet_kernel n x * f x)
        = (LINT x|lebesgue_on S. sin((n+1/2) * x) * f x / (2 * sin(x/2)))" (is "?th1")
   and integrable_Dirichlet_kernel_mul_expand:
        "integrable (lebesgue_on S) (\<lambda>x. Dirichlet_kernel n x * f x)
     \<longleftrightarrow> integrable (lebesgue_on S) (\<lambda>x. sin((n+1/2) * x) * f x / (2 * sin(x/2)))" (is "?th2")
   using inte_Dirichlet_kernel_mul_expand [OF assms] by auto
 
 
 proposition Fourier_sum_limit_sine_part:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
     and d: "0 < d" "d \<le> pi"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> l
      \<longleftrightarrow> (\<lambda>n. LINT x|lebesgue_on {0..d}. sin((n + 1/2) * x) * ((f(t+x) + f(t-x) - 2*l) / x)) \<longlonglongrightarrow> 0"
     (is "?lhs \<longleftrightarrow> ?\<Psi> \<longlonglongrightarrow> 0")
 proof -
   have ftx: "(\<lambda>x. f(t+x)) absolutely_integrable_on {-pi..pi}"
     using absolutely_integrable_periodic_offset assms by auto
   then have ftmx: "(\<lambda>x. f(t-x)) absolutely_integrable_on {-pi..pi}"
     by (simp flip: absolutely_integrable_reflect_real [where f= "(\<lambda>x. f(t+x))"])
   have fbm: "(\<lambda>x. f(t+x) + f(t-x) - 2*l) absolutely_integrable_on {-pi..pi}"
     by (force intro: ftmx ftx)
   let ?\<Phi> = "\<lambda>n. LINT x|lebesgue_on {0..d}. Dirichlet_kernel n x * ((f(t+x) + f(t-x)) - 2*l)"
   have "?lhs \<longleftrightarrow> ?\<Phi> \<longlonglongrightarrow> 0"
     by (intro Fourier_sum_limit_Dirichlet_kernel_part assms)
   moreover have "?\<Phi> \<longlonglongrightarrow> 0 \<longleftrightarrow> ?\<Psi> \<longlonglongrightarrow> 0"
   proof (rule Lim_transform_eq [OF Lim_transform_eventually])
     let ?f = "\<lambda>n. LINT x|lebesgue_on {0..d}. sin((real n + 1/2) * x) * (1 / (2 * sin(x/2)) - 1/x) * (f(t+x) + f(t-x) - 2*l)"
     have "?f n = (LINT x|lebesgue_on {-pi..pi}.
             sin ((n + 1/2) * x) * ((if x \<in> {0..d} then 1 / (2 * sin (x/2)) - 1/x else 0) * (f(t+x) + f(t-x) - 2*l)))" for n
       using d by (simp add: integral_restrict if_distrib [of "\<lambda>u. _ * (u * _)"] mult.assoc flip: atLeastAtMost_iff cong: if_cong)
     moreover have "\<dots> \<longlonglongrightarrow> 0"
     proof (intro Riemann_lebesgue_sin_half absolutely_integrable_bounded_measurable_product_real)
       have "(\<lambda>x. 1 / (2 * sin(x/2)) - 1/x) \<in> borel_measurable (lebesgue_on {0..d})"
         by (intro measurable continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
       then show "(\<lambda>x. if x \<in> {0..d} then 1 / (2 * sin(x/2)) - 1/x else 0) \<in> borel_measurable (lebesgue_on {-pi..pi})"
         using d by (simp add: borel_measurable_if_lebesgue_on flip: atLeastAtMost_iff)
 
       let ?g = "\<lambda>x::real. 1 / (2 * sin(x/2)) - 1/x"
       have limg: "(?g \<longlongrightarrow> ?g a) (at a within {0..d})"   \<comment>\<open>thanks to Manuel Eberl\<close>
         if a: "0 \<le> a" "a \<le> d" for a
       proof -
         have "(?g \<longlongrightarrow> 0) (at_right 0)" and "(?g \<longlongrightarrow> ?g d) (at_left d)"
           using d sin_gt_zero[of "d/2"] by (real_asymp simp: field_simps)+
         moreover have "(?g \<longlongrightarrow> ?g a) (at a)" if "a > 0"
           using a that d sin_gt_zero[of "a/2"] that by (real_asymp simp: field_simps)
         ultimately show ?thesis using that d
           by (cases "a = 0 \<or> a = d") (auto simp: at_within_Icc_at at_within_Icc_at_right at_within_Icc_at_left)
       qed
       have "((\<lambda>x. if x \<in> {0..d} then 1 / (2 * sin(x/2)) - 1/x else 0) ` {-pi..pi}) = ((\<lambda>x. 1 / (2 * sin(x/2)) - 1/x) ` {0..d})"
         using d  by (auto intro: image_eqI [where x=0])
       moreover have "bounded \<dots>"
         by (intro compact_imp_bounded compact_continuous_image) (auto simp: continuous_on limg)
       ultimately show "bounded ((\<lambda>x. if x \<in> {0..d} then 1 / (2 * sin(x/2)) - 1/x else 0) ` {-pi..pi})"
         by simp
     qed (auto simp: fbm)
     ultimately show "?f \<longlonglongrightarrow> (0::real)"
       by simp
     show "\<forall>\<^sub>F n in sequentially. ?f n = ?\<Phi> n - ?\<Psi> n"
     proof (rule eventually_sequentiallyI [where c = "Suc 0"])
       fix n
       assume "n \<ge> Suc 0"
       have "integrable (lebesgue_on {0..d}) (\<lambda>x. sin ((real n + 1/2) * x) * (f(t+x) + f(t-x) - 2*l) / (2 * sin(x/2)))"
         using d
         apply (subst integrable_Dirichlet_kernel_mul_expand [symmetric])
           apply (intro assms absolutely_integrable_imp_borel_measurable absolutely_integrable_on_subinterval [OF fbm]
                        absolutely_integrable_imp_integrable absolutely_integrable_mult_Dirichlet_kernel_reflected_part2 | force)+
         done
       moreover have "integrable (lebesgue_on {0..d}) (\<lambda>x. sin ((real n + 1/2) * x) * (f(t+x) + f(t-x) - 2*l) / x)"
       proof (rule integrable_cong_AE_imp)
         let ?g = "\<lambda>x. Dirichlet_kernel n x * (2 * sin(x/2) / x * (f(t+x) + f(t-x) - 2*l))"
         have *: "\<bar>2 * sin (x/2) / x\<bar> \<le> 1" for x::real
           using abs_sin_x_le_abs_x [of "x/2"]
           by (simp add: divide_simps mult.commute abs_mult)
         have "bounded ((\<lambda>x. 1 + (x/2)\<^sup>2) ` {-pi..pi})"
           by (intro compact_imp_bounded compact_continuous_image continuous_intros) auto
         then have bo: "bounded ((\<lambda>x. 2 * sin (x/2) / x) ` {-pi..pi})"
           using * unfolding bounded_real by blast
         show "integrable (lebesgue_on {0..d}) ?g"
           using d
           apply (intro absolutely_integrable_imp_integrable
               absolutely_integrable_on_subinterval [OF absolutely_integrable_mult_Dirichlet_kernel]
               absolutely_integrable_bounded_measurable_product_real bo fbm
               measurable continuous_imp_measurable_on_sets_lebesgue continuous_intros, auto)
           done
         show "(\<lambda>x. sin ((n + 1/2) * x) * (f(t+x) + f(t-x) - 2*l) / x) \<in> borel_measurable (lebesgue_on {0..d})"
           using d
           apply (intro measurable absolutely_integrable_imp_borel_measurable
                        absolutely_integrable_on_subinterval [OF ftx] absolutely_integrable_on_subinterval [OF ftmx]
                        absolutely_integrable_continuous_real continuous_intros, auto)
           done
         have "Dirichlet_kernel n x * (2 * sin(x/2)) / x = sin ((real n + 1/2) * x) / x"
           if "0 < x" "x \<le> d" for x
           using that d by (simp add: Dirichlet_kernel_def divide_simps sin_zero_pi_iff)
         then show "AE x in lebesgue_on {0..d}. ?g x = sin ((real n + 1/2) * x) * (f(t+x) + f(t-x) - 2*l) / x"
           using d by (force intro: AE_I' [where N="{0}"])
       qed
       ultimately have "?f n = (LINT x|lebesgue_on {0..d}. sin ((n + 1/2) * x) * (f(t+x) + f(t-x) - 2*l) / (2 * sin(x/2)))
                  - (LINT x|lebesgue_on {0..d}. sin ((n + 1/2) * x) * (f(t+x) + f(t-x) - 2*l) / x)"
         by (simp add: right_diff_distrib [of _ _ "1/_"] left_diff_distrib)
       also have "\<dots> = ?\<Phi> n - ?\<Psi> n"
         using d
         by (simp add: measurable_restrict_mono [OF absolutely_integrable_imp_borel_measurable [OF fbm]]
                       integral_Dirichlet_kernel_mul_expand)
       finally show "?f n = ?\<Phi> n - ?\<Psi> n" .
     qed
   qed
   ultimately show ?thesis
     by simp
 qed
 
 
 subsection\<open>Dini's test for the convergence of a Fourier series\<close>
 
 proposition Fourier_Dini_test:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
     and int0d: "integrable (lebesgue_on {0..d}) (\<lambda>x. \<bar>f(t+x) + f(t-x) - 2*l\<bar> / x)"
     and "0 < d"
   shows "(\<lambda>n. (\<Sum>k\<le>n. Fourier_coefficient f k * trigonometric_set k t)) \<longlonglongrightarrow> l"
 proof -
   define \<phi> where "\<phi> \<equiv> \<lambda>n x. sin((n + 1/2) * x) * ((f(t+x) + f(t-x) - 2*l) / x)"
   have "(\<lambda>n. LINT x|lebesgue_on {0..pi}. \<phi> n x) \<longlonglongrightarrow> 0"
     unfolding lim_sequentially dist_real_def
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     define \<theta> where "\<theta> \<equiv> \<lambda>x. LINT x|lebesgue_on {0..x}. \<bar>f(t+x) + f(t-x) - 2*l\<bar> / x"
     have [simp]: "\<theta> 0 = 0"
       by (simp add: \<theta>_def integral_eq_zero_null_sets)
     have cont: "continuous_on {0..d} \<theta>"
       unfolding \<theta>_def using indefinite_integral_continuous_real int0d by blast
     with \<open>d > 0\<close>
     have "\<forall>e>0. \<exists>da>0. \<forall>x'\<in>{0..d}. \<bar>x' - 0\<bar> < da \<longrightarrow> \<bar>\<theta> x' - \<theta> 0\<bar> < e"
       by (force simp: continuous_on_real_range dest: bspec [where x=0])
     with \<open>e > 0\<close>
     obtain k where "k > 0" and k: "\<And>x'. \<lbrakk>0 \<le> x'; x' < k; x' \<le> d\<rbrakk> \<Longrightarrow> \<bar>\<theta> x'\<bar> < e/2"
       by (drule_tac x="e/2" in spec) auto
     define \<delta> where "\<delta> \<equiv> min d (min (k/2) pi)"
     have e2: "\<bar>\<theta> \<delta>\<bar> < e/2" and "\<delta> > 0" "\<delta> \<le> pi"
       unfolding \<delta>_def using k \<open>k > 0\<close> \<open>d > 0\<close> by auto
     have ftx: "(\<lambda>x. f(t+x)) absolutely_integrable_on {-pi..pi}"
       using absolutely_integrable_periodic_offset assms by auto
     then have ftmx: "(\<lambda>x. f(t-x)) absolutely_integrable_on {-pi..pi}"
       by (simp flip: absolutely_integrable_reflect_real [where f= "(\<lambda>x. f(t+x))"])
     have 1: "\<phi> n absolutely_integrable_on {0..\<delta>}" for n::nat
       unfolding \<phi>_def
     proof (rule absolutely_integrable_bounded_measurable_product_real)
       show "(\<lambda>x. sin ((real n + 1/2) * x)) \<in> borel_measurable (lebesgue_on {0..\<delta>})"
         by (intro continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
       show "bounded ((\<lambda>x. sin ((real n + 1/2) * x)) ` {0..\<delta>})"
         by (simp add: bounded_iff) (use abs_sin_le_one in blast)
       have "(\<lambda>x. (f(t+x) + f(t-x) - 2*l) / x) \<in> borel_measurable (lebesgue_on {0..\<delta>})"
         using \<open>d > 0\<close> unfolding \<delta>_def
         by (intro measurable absolutely_integrable_imp_borel_measurable
             absolutely_integrable_on_subinterval [OF ftx] absolutely_integrable_on_subinterval [OF ftmx]
             absolutely_integrable_continuous_real continuous_intros, auto)
       moreover have "integrable (lebesgue_on {0..\<delta>}) (norm \<circ> (\<lambda>x. (f(t+x) + f(t-x) - 2*l) / x))"
       proof (rule integrable_subinterval [of 0 d])
         show "integrable (lebesgue_on {0..d}) (norm \<circ> (\<lambda>x. (f(t+x) + f(t-x) - 2*l) / x))"
           using int0d by (subst integrable_cong) (auto simp: o_def)
         show "{0..\<delta>} \<subseteq> {0..d}"
           using \<open>d > 0\<close> by (auto simp: \<delta>_def)
       qed
       ultimately show "(\<lambda>x. (f(t+x) + f(t-x) - 2*l) / x) absolutely_integrable_on {0..\<delta>}"
         by (auto simp: absolutely_integrable_measurable)
     qed auto
     have 2: "\<phi> n absolutely_integrable_on {\<delta>..pi}" for n::nat
       unfolding \<phi>_def
     proof (rule absolutely_integrable_bounded_measurable_product_real)
       show "(\<lambda>x. sin ((n + 1/2) * x)) \<in> borel_measurable (lebesgue_on {\<delta>..pi})"
         by (intro continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
       show "bounded ((\<lambda>x. sin ((n + 1/2) * x)) ` {\<delta>..pi})"
         by (simp add: bounded_iff) (use abs_sin_le_one in blast)
     have "(\<lambda>x. inverse x * (f(t+x) + f(t-x) - 2*l)) absolutely_integrable_on {\<delta>..pi}"
     proof (rule absolutely_integrable_bounded_measurable_product_real)
       have "(\<lambda>x. 1/x) \<in> borel_measurable (lebesgue_on {\<delta>..pi})"
         by (auto simp: measurable_completion measurable_restrict_space1)
       then show "inverse \<in> borel_measurable (lebesgue_on {\<delta>..pi})"
         by (metis (no_types, lifting) inverse_eq_divide measurable_lebesgue_cong)
       have "\<forall>x\<in>{\<delta>..pi}. inverse \<bar>x\<bar> \<le> inverse \<delta>"
         using \<open>0 < \<delta>\<close> by auto
       then show "bounded (inverse ` {\<delta>..pi})"
         by (auto simp: bounded_iff)
       show "(\<lambda>x. f(t+x) + f(t-x) - 2*l) absolutely_integrable_on {\<delta>..pi}"
       proof (rule absolutely_integrable_on_subinterval)
         show "(\<lambda>x. (f(t+x) + f(t-x) - 2*l)) absolutely_integrable_on {-pi..pi}"
           by (fast intro: ftx ftmx absolutely_integrable_on_const)
         show "{\<delta>..pi} \<subseteq> {-pi..pi}"
           using \<open>0 < \<delta>\<close> by auto
       qed
     qed auto
     then show "(\<lambda>x. (f(t+x) + f(t-x) - 2*l) / x) absolutely_integrable_on {\<delta>..pi}"
       by (metis (no_types, lifting) divide_inverse mult.commute set_integrable_cong)
   qed auto
   have "(\<lambda>x. f(t+x) - l) absolutely_integrable_on {-pi..pi}"
     using ftx by auto
   moreover have "bounded ((\<lambda>x. 0) ` {x. \<bar>x\<bar> < \<delta>})"
     using bounded_def by blast
   moreover have "bounded (inverse ` {x. \<not> \<bar>x\<bar> < \<delta>})"
     using \<open>\<delta> > 0\<close> by (auto simp: divide_simps intro: boundedI [where B = "1/\<delta>"])
   ultimately have "(\<lambda>x. (if \<bar>x\<bar> < \<delta> then 0 else inverse x) * (if x \<in> {-pi..pi} then f(t+x) - l else 0)) absolutely_integrable_on UNIV"
     apply (intro absolutely_integrable_bounded_measurable_product_real measurable set_integral_diff)
           apply (auto simp: lebesgue_on_UNIV_eq measurable_completion simp flip: absolutely_integrable_restrict_UNIV [where S = "{-pi..pi}"])
     done
   moreover have "(if x \<in> {-pi..pi} then if \<bar>x\<bar> < \<delta> then 0 else (f(t+x) - l) / x else 0)
                = (if \<bar>x\<bar> < \<delta> then 0 else inverse x) * (if x \<in> {-pi..pi} then f(t+x) - l else 0)"  for x
     by (auto simp: divide_simps)
   ultimately have *: "(\<lambda>x. if \<bar>x\<bar> < \<delta> then 0 else (f(t+x) - l) / x) absolutely_integrable_on {-pi..pi}"
     by (simp add: flip: absolutely_integrable_restrict_UNIV [where S = "{-pi..pi}"])
   have "(\<lambda>n. LINT x|lebesgue_on {0..pi}. sin ((n + 1/2) * x) * (if \<bar>x\<bar> < \<delta> then 0 else (f(t+x) - l) / x)
                                        + sin ((n + 1/2) * -x) * (if \<bar>x\<bar> < \<delta> then 0 else (f(t-x) - l) / -x))
         \<longlonglongrightarrow> 0"
     using Riemann_lebesgue_sin_half [OF *] *
     by (simp add: integral_reflect_and_add absolutely_integrable_imp_integrable absolutely_integrable_sin_product cong: if_cong)
   moreover have "sin ((n + 1/2) * x) * (if \<bar>x\<bar> < \<delta> then 0 else (f(t+x) - l) / x)
                + sin ((n + 1/2) * -x) * (if \<bar>x\<bar> < \<delta> then 0 else (f(t-x) - l) / -x)
            = (if \<not> \<bar>x\<bar> < \<delta> then \<phi> n x else 0)" for x n
     by simp (auto simp: divide_simps algebra_simps \<phi>_def)
   ultimately have "(\<lambda>n. LINT x|lebesgue_on {0..pi}. (if \<not> \<bar>x\<bar> < \<delta> then \<phi> n x else 0)) \<longlonglongrightarrow> 0"
     by simp
   moreover have "(if 0 \<le> x \<and> x \<le> pi then if \<not> \<bar>x\<bar> < \<delta> then \<phi> n x else 0 else 0)
                = (if \<delta> \<le> x \<and> x \<le> pi then \<phi> n x else 0)" for x n
     using \<open>\<delta> > 0\<close> by auto
   ultimately have \<dagger>: "(\<lambda>n. LINT x|lebesgue_on {\<delta>..pi}. \<phi> n x) \<longlonglongrightarrow> 0"
     by (simp flip: Lebesgue_Measure.integral_restrict_UNIV)
   then obtain N::nat where N: "\<And>n. n\<ge>N \<Longrightarrow> \<bar>LINT x|lebesgue_on {\<delta>..pi}. \<phi> n x\<bar> < e/2"
     unfolding lim_sequentially dist_real_def
     by (metis (full_types) \<open>0 < e\<close> diff_zero half_gt_zero_iff)
   have "\<bar>integral\<^sup>L (lebesgue_on {0..pi}) (\<phi> n)\<bar> < e" if "n \<ge> N" for n::nat
   proof -
     have int: "integrable (lebesgue_on {0..pi}) (\<phi> (real n))"
       by (intro integrable_combine [of concl: 0 pi] absolutely_integrable_imp_integrable) (use  \<open>\<delta> > 0\<close>  \<open>\<delta> \<le> pi\<close> 1 2 in auto)
     then have "integral\<^sup>L (lebesgue_on {0..pi}) (\<phi> n) = integral\<^sup>L (lebesgue_on {0..\<delta>}) (\<phi> n) + integral\<^sup>L (lebesgue_on {\<delta>..pi}) (\<phi> n)"
       by (rule integral_combine) (use \<open>0 < \<delta>\<close> \<open>\<delta> \<le> pi\<close> in auto)
     moreover have "\<bar>integral\<^sup>L (lebesgue_on {0..\<delta>}) (\<phi> n)\<bar> \<le> LINT x|lebesgue_on {0..\<delta>}. \<bar>f(t + x) + f(t - x) - 2 * l\<bar> / x"
     proof (rule integral_abs_bound_integral)
       show "integrable (lebesgue_on {0..\<delta>}) (\<phi> (real n))"
         by (meson integrable_subinterval \<open>\<delta> \<le> pi\<close> int atLeastatMost_subset_iff order_refl)
       have "{0..\<delta>} \<subseteq> {0..d}"
         by (auto simp: \<delta>_def)
       then show "integrable (lebesgue_on {0..\<delta>}) (\<lambda>x. \<bar>f(t + x) + f(t - x) - 2 * l\<bar> / x)"
         by (rule integrable_subinterval [OF int0d])
       show "\<bar>\<phi> (real n) x\<bar> \<le> \<bar>f(t + x) + f(t - x) - 2 * l\<bar> / x"
         if "x \<in> space (lebesgue_on {0..\<delta>})" for x
         using that
         apply (auto simp: \<phi>_def divide_simps abs_mult)
         by (simp add: mult.commute mult_left_le)
     qed
     ultimately have "\<bar>integral\<^sup>L (lebesgue_on {0..pi}) (\<phi> n)\<bar> < e/2 + e/2"
       using N [OF that] e2 unfolding \<theta>_def by linarith
     then show ?thesis
       by simp
   qed
   then show "\<exists>N. \<forall>n\<ge>N. \<bar>integral\<^sup>L (lebesgue_on {0..pi}) (\<phi> (real n)) - 0\<bar> < e"
     by force
 qed
   then show ?thesis
     unfolding \<phi>_def using Fourier_sum_limit_sine_part assms pi_gt_zero by blast
 qed
 
 
 subsection\<open>Cesaro summability of Fourier series using Fejér kernel\<close>
 
 definition Fejer_kernel :: "nat \<Rightarrow> real \<Rightarrow> real"
   where
   "Fejer_kernel \<equiv> \<lambda>n x. if n = 0 then 0 else (\<Sum>r<n. Dirichlet_kernel r x) / n"
 
 lemma Fejer_kernel:
      "Fejer_kernel n x =
         (if n = 0 then 0
          else if x = 0 then n/2
          else sin(n / 2 * x) ^ 2 / (2 * n * sin(x/2) ^ 2))"
 proof (cases "x=0 \<or> sin(x/2) = 0")
   case True
   have "(\<Sum>r<n. (1 + real r * 2)) = real n * real n"
     by (induction n) (auto simp: algebra_simps)
   with True show ?thesis
     by (auto simp: Fejer_kernel_def Dirichlet_kernel_def field_simps simp flip: sum_divide_distrib)
 next
   case False
   have "sin (x/2) * (\<Sum>r<n. sin ((real r * 2 + 1) * x / 2)) =
         sin (real n * x / 2) * sin (real n * x / 2)"
   proof (induction n)
   next
     case (Suc n)
     then show ?case
       apply (simp add: field_simps sin_times_sin)
       apply (simp add: add_divide_distrib)
       done
   qed auto
   then show ?thesis
     using False
     unfolding Fejer_kernel_def Dirichlet_kernel_def
     by (simp add: divide_simps power2_eq_square mult.commute flip: sum_divide_distrib)
 qed
 
 lemma Fejer_kernel_0 [simp]: "Fejer_kernel 0 x = 0"  "Fejer_kernel n 0 = n/2"
   by (auto simp: Fejer_kernel)
 
 lemma Fejer_kernel_continuous_strong:
   "continuous_on {-(2 * pi)<..<2 * pi} (Fejer_kernel n)"
 proof (cases "n=0")
   case False
   then show ?thesis
   by (simp add: Fejer_kernel_def continuous_intros Dirichlet_kernel_continuous_strong)
 qed (simp add: Fejer_kernel_def)
 
 lemma Fejer_kernel_continuous:
   "continuous_on {-pi..pi} (Fejer_kernel n)"
   apply (rule continuous_on_subset [OF Fejer_kernel_continuous_strong])
   apply (simp add: subset_iff)
   using pi_gt_zero apply linarith
   done
 
 
 lemma absolutely_integrable_mult_Fejer_kernel:
   assumes "f absolutely_integrable_on {-pi..pi}"
   shows "(\<lambda>x. Fejer_kernel n x * f x) absolutely_integrable_on {-pi..pi}"
 proof (rule absolutely_integrable_bounded_measurable_product_real)
   show "Fejer_kernel n \<in> borel_measurable (lebesgue_on {-pi..pi})"
     by (simp add: Fejer_kernel_continuous continuous_imp_measurable_on_sets_lebesgue)
   show "bounded (Fejer_kernel n ` {-pi..pi})"
     using Fejer_kernel_continuous compact_continuous_image compact_imp_bounded by blast
 qed (use assms in auto)
 
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected1:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>x. Fejer_kernel n x * f(t + x)) absolutely_integrable_on {-pi..pi}"
   using assms
   by (force intro: absolutely_integrable_mult_Fejer_kernel absolutely_integrable_periodic_offset)
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected2:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>x. Fejer_kernel n x * f(t - x)) absolutely_integrable_on {-pi..pi}"
 proof -
   have "(\<lambda>x. f(t - x)) absolutely_integrable_on {-pi..pi}"
     using assms
     apply (subst absolutely_integrable_reflect_real [symmetric])
     apply (simp add: absolutely_integrable_periodic_offset)
     done
   then show ?thesis
     by (rule absolutely_integrable_mult_Fejer_kernel)
 qed
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected3:
   shows "(\<lambda>x. Fejer_kernel n x * c) absolutely_integrable_on {-pi..pi}"
   using absolutely_integrable_on_const absolutely_integrable_mult_Fejer_kernel by blast
 
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected_part1:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "d \<le> pi"
   shows "(\<lambda>x. Fejer_kernel n x * f(t + x)) absolutely_integrable_on {0..d}"
   by (rule absolutely_integrable_on_subinterval [OF absolutely_integrable_mult_Fejer_kernel_reflected1]) (auto simp: assms)
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected_part2:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "d \<le> pi"
   shows "(\<lambda>x. Fejer_kernel n x * f(t - x)) absolutely_integrable_on {0..d}"
   by (rule absolutely_integrable_on_subinterval [OF absolutely_integrable_mult_Fejer_kernel_reflected2]) (auto simp: assms)
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected_part3:
   assumes "d \<le> pi"
   shows "(\<lambda>x. Fejer_kernel n x * c) absolutely_integrable_on {0..d}"
   by (rule absolutely_integrable_on_subinterval [OF absolutely_integrable_mult_Fejer_kernel_reflected2]) (auto simp: assms)
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected_part4:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "d \<le> pi"
   shows "(\<lambda>x. Fejer_kernel n x * (f(t + x) + f(t - x))) absolutely_integrable_on {0..d}"
   unfolding distrib_left
   by (intro set_integral_add absolutely_integrable_mult_Fejer_kernel_reflected_part1 absolutely_integrable_mult_Fejer_kernel_reflected_part2 assms)
 
 lemma absolutely_integrable_mult_Fejer_kernel_reflected_part5:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "d \<le> pi"
   shows "(\<lambda>x. Fejer_kernel n x * ((f(t + x) + f(t - x)) - c)) absolutely_integrable_on {0..d}"
   unfolding distrib_left right_diff_distrib
   by (intro set_integral_add set_integral_diff absolutely_integrable_on_const
       absolutely_integrable_mult_Fejer_kernel_reflected_part1 absolutely_integrable_mult_Fejer_kernel_reflected_part2 assms, auto)
 
 
 lemma Fourier_sum_offset_Fejer_kernel_half:
   fixes n::nat
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x" and "n > 0"
   shows "(\<Sum>r<n. \<Sum>k\<le>2*r. Fourier_coefficient f k * trigonometric_set k t) / n - l
        = (LINT x|lebesgue_on {0..pi}. Fejer_kernel n x * (f(t + x) + f(t - x) - 2 * l)) / pi"
 proof -
   have "(\<Sum>r<n. \<Sum>k\<le>2 * r. Fourier_coefficient f k * trigonometric_set k t) - real n * l
        = (\<Sum>r<n. (\<Sum>k\<le>2 * r. Fourier_coefficient f k * trigonometric_set k t) - l)"
     by (simp add: sum_subtractf)
   also have "\<dots> = (\<Sum>r<n.
                       (LINT x|lebesgue_on {0..pi}. Dirichlet_kernel r x * (f(t + x) + f(t - x) - 2 * l)) / pi)"
     by (simp add: Fourier_sum_offset_Dirichlet_kernel_half assms)
   also have "\<dots> = real n * ((LINT x|lebesgue_on {0..pi}. Fejer_kernel n x * (f(t + x) + f(t - x) - 2 * l)) / pi)"
   proof -
     have "integrable (lebesgue_on {0..pi}) (\<lambda>x. Dirichlet_kernel i x * (f(t + x) + f(t - x) - 2 * l))" for i
       using absolutely_integrable_mult_Dirichlet_kernel_reflected_part2(2) f periodic
       by (force simp: intro!: absolutely_integrable_imp_integrable)
     then show ?thesis
       using \<open>n > 0\<close>
       apply (simp add: Fejer_kernel_def flip: sum_divide_distrib)
       apply (simp add: sum_distrib_right flip: Bochner_Integration.integral_sum [symmetric])
       done
   qed
   finally have "(\<Sum>r<n. \<Sum>k\<le>2 * r. Fourier_coefficient f k * trigonometric_set k t) - real n * l = real n * ((LINT x|lebesgue_on {0..pi}. Fejer_kernel n x * (f(t + x) + f(t - x) - 2 * l)) / pi)" .
   with \<open>n > 0\<close> show ?thesis
     by (auto simp: mult.commute divide_simps)
 qed
 
 
 lemma Fourier_sum_limit_Fejer_kernel_half:
   fixes n::nat
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. ((\<Sum>r<n. \<Sum>k\<le>2*r. Fourier_coefficient f k * trigonometric_set k t)) / n) \<longlonglongrightarrow> l
          \<longleftrightarrow>
          ((\<lambda>n. integral\<^sup>L (lebesgue_on {0..pi}) (\<lambda>x. Fejer_kernel n x * ((f(t + x) + f(t - x)) - 2*l)))  \<longlonglongrightarrow> 0)"
         (is "?lhs = ?rhs")
 proof -
   have "?lhs \<longleftrightarrow>
         (\<lambda>n. ((\<Sum>r<n. \<Sum>k\<le>2*r.  Fourier_coefficient f k * trigonometric_set k t)) / n - l) \<longlonglongrightarrow> 0"
     by (simp add: LIM_zero_iff)
   also have "\<dots> \<longleftrightarrow>
         (\<lambda>n. ((((\<Sum>r<n. \<Sum>k\<le>2*r.  Fourier_coefficient f k * trigonometric_set k t)) / n) - l) * pi) \<longlonglongrightarrow> 0"
     using tendsto_mult_right_iff [OF pi_neq_zero] by simp
   also have "\<dots> \<longleftrightarrow> ?rhs"
     apply (intro Lim_transform_eq [OF Lim_transform_eventually [of "\<lambda>n. 0"]] eventually_sequentiallyI [of 1])
     apply (simp_all add: Fourier_sum_offset_Fejer_kernel_half assms)
     done
   finally show ?thesis .
 qed
 
 
 lemma has_integral_Fejer_kernel:
   "has_bochner_integral (lebesgue_on {-pi..pi}) (Fejer_kernel n) (if n = 0 then 0 else pi)"
 proof -
   have "has_bochner_integral (lebesgue_on {-pi..pi}) (\<lambda>x. (\<Sum>r<n. Dirichlet_kernel r x) / real n) ((\<Sum>r<n. pi) / n)"
     by (simp add: has_bochner_integral_iff integrable_Dirichlet_kernel has_bochner_integral_divide has_bochner_integral_sum)
   then show ?thesis
     by (auto simp: Fejer_kernel_def)
 qed
 
 lemma has_integral_Fejer_kernel_half:
   "has_bochner_integral (lebesgue_on {0..pi}) (Fejer_kernel n) (if n = 0 then 0 else pi/2)"
 proof -
   have "has_bochner_integral (lebesgue_on {0..pi}) (\<lambda>x. (\<Sum>r<n. Dirichlet_kernel r x) / real n) ((\<Sum>r<n. pi/2) / n)"
     apply (intro has_bochner_integral_sum has_bochner_integral_divide)
     using not_integrable_integral_eq by (force simp: has_bochner_integral_iff)
   then show ?thesis
     by (auto simp: Fejer_kernel_def)
 qed
 
 lemma Fejer_kernel_pos_le [simp]: "Fejer_kernel n x \<ge> 0"
   by (simp add: Fejer_kernel)
 
 
 theorem Fourier_Fejer_Cesaro_summable:
   assumes f: "f absolutely_integrable_on {-pi..pi}"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
     and fl: "(f \<longlongrightarrow> l) (at t within atMost t)"
     and fr: "(f \<longlongrightarrow> r) (at t within atLeast t)"
   shows "(\<lambda>n. (\<Sum>m<n. \<Sum>k\<le>2*m. Fourier_coefficient f k * trigonometric_set k t) / n) \<longlonglongrightarrow> (l+r) / 2"
 proof -
   define h where "h \<equiv> \<lambda>u. (f(t+u) + f(t-u)) - (l+r)"
   have "(\<lambda>n. LINT u|lebesgue_on {0..pi}. Fejer_kernel n u * h u) \<longlonglongrightarrow> 0"
   proof -
     have h0: "(h \<longlongrightarrow> 0) (at 0 within atLeast 0)"
     proof -
       have l0: "((\<lambda>u. f(t-u) - l) \<longlongrightarrow> 0) (at 0 within {0..})"
         using fl
         unfolding Lim_within
         apply (elim all_forward imp_forward ex_forward conj_forward asm_rl, clarify)
         apply (drule_tac x="t-x" in bspec)
          apply (auto simp: dist_norm)
         done
       have r0: "((\<lambda>u. f(t + u) - r) \<longlongrightarrow> 0) (at 0 within {0..})"
         using fr
         unfolding Lim_within
         apply (elim all_forward imp_forward ex_forward conj_forward asm_rl, clarify)
         apply (drule_tac x="t+x" in bspec)
          apply (auto simp: dist_norm)
         done
       show ?thesis
         using tendsto_add [OF l0 r0] by (simp add: h_def algebra_simps)
     qed
     show ?thesis
       unfolding lim_sequentially dist_real_def diff_0_right
     proof clarify
       fix e::real
       assume "e > 0"
       then obtain x' where "0 < x'" "\<And>x. \<lbrakk>0 < x; x < x'\<rbrakk> \<Longrightarrow> \<bar>h x\<bar> < e / (2 * pi)"
         using h0 unfolding Lim_within dist_real_def
         by (auto simp: dest: spec [where x="e/2/pi"])
       then obtain \<xi> where "0 < \<xi>" "\<xi> < pi" and \<xi>: "\<And>x. 0 < x \<and> x \<le> \<xi> \<Longrightarrow> \<bar>h x\<bar> < e/2/pi"
         apply (intro that [where \<xi>="min x' pi/2"], auto)
         using m2pi_less_pi by linarith
       have ftx: "(\<lambda>x. f(t+x)) absolutely_integrable_on {-pi..pi}"
         using absolutely_integrable_periodic_offset assms by auto
       then have ftmx: "(\<lambda>x. f(t-x)) absolutely_integrable_on {-pi..pi}"
         by (simp flip: absolutely_integrable_reflect_real [where f= "(\<lambda>x. f(t+x))"])
       have h_aint: "h absolutely_integrable_on {-pi..pi}"
         unfolding h_def
         by (intro absolutely_integrable_on_const set_integral_diff set_integral_add, auto simp: ftx ftmx)
       have "(\<lambda>n. LINT x|lebesgue_on {\<xi>..pi}. Fejer_kernel n x * h x) \<longlonglongrightarrow> 0"
       proof (rule Lim_null_comparison)
         define \<phi> where "\<phi> \<equiv> \<lambda>n. (LINT x|lebesgue_on {\<xi>..pi}. \<bar>h x\<bar> / (2 * sin(x/2) ^ 2)) / n"
         show "\<forall>\<^sub>F n in sequentially. norm (LINT x|lebesgue_on {\<xi>..pi}. Fejer_kernel n x * h x) \<le> \<phi> n"
         proof (rule eventually_sequentiallyI)
           fix n::nat assume "n \<ge> 1"
           have hint: "(\<lambda>x. h x / (2 * sin(x/2) ^ 2)) absolutely_integrable_on {\<xi>..pi}"
             unfolding divide_inverse mult.commute [of "h _"]
           proof (rule absolutely_integrable_bounded_measurable_product_real)
             have cont: "continuous_on {\<xi>..pi} (\<lambda>x. inverse (2 * (sin (x * inverse 2))\<^sup>2))"
               using \<open>0 < \<xi>\<close> by (intro continuous_intros) (auto simp: sin_zero_pi_iff)
             show "(\<lambda>x. inverse (2 * (sin (x * inverse 2))\<^sup>2)) \<in> borel_measurable (lebesgue_on {\<xi>..pi})"
               using \<open>0 < \<xi>\<close>
               by (intro cont continuous_imp_measurable_on_sets_lebesgue) auto
             show "bounded ((\<lambda>x. inverse (2 * (sin (x * inverse 2))\<^sup>2)) ` {\<xi>..pi})"
               using cont by (simp add: compact_continuous_image compact_imp_bounded)
             show "h absolutely_integrable_on {\<xi>..pi}"
               using \<open>0 < \<xi>\<close> \<open>\<xi> < pi\<close> by (auto intro: absolutely_integrable_on_subinterval [OF h_aint])
           qed auto
           then have *: "integrable (lebesgue_on {\<xi>..pi}) (\<lambda>x. \<bar>h x\<bar> / (2 * (sin (x/2))\<^sup>2))"
             by (simp add: absolutely_integrable_measurable o_def)
           define \<psi> where
               "\<psi> \<equiv> \<lambda>x. (if n = 0 then 0 else if x = 0 then n/2
                          else (sin (real n / 2 * x))\<^sup>2 / (2 * real n * (sin (x/2))\<^sup>2)) * h x"
           have "\<bar>LINT x|lebesgue_on {\<xi>..pi}. \<psi> x\<bar>
               \<le> (LINT x|lebesgue_on {\<xi>..pi}. \<bar>h x\<bar> / (2 * (sin (x/2))\<^sup>2) / n)"
           proof (rule integral_abs_bound_integral)
             show **: "integrable (lebesgue_on {\<xi>..pi}) (\<lambda>x. \<bar>h x\<bar> / (2 * (sin (x/2))\<^sup>2) / n)"
               using Bochner_Integration.integrable_mult_left [OF *, of "1/n"]
               by (simp add: field_simps)
             show \<dagger>: "\<bar>\<psi> x\<bar> \<le> \<bar>h x\<bar> / (2 * (sin (x/2))\<^sup>2) / real n"
               if "x \<in> space (lebesgue_on {\<xi>..pi})" for x
               using that \<open>0 < \<xi>\<close>
               apply (simp add: \<psi>_def divide_simps mult_less_0_iff abs_mult)
               apply (auto simp: square_le_1 mult_left_le_one_le)
               done
             show "integrable (lebesgue_on {\<xi>..pi}) \<psi>"
             proof (rule measurable_bounded_by_integrable_imp_lebesgue_integrable [OF _ **])
               let ?g = "\<lambda>x. \<bar>h x\<bar> / (2 * sin(x/2) ^ 2) / n"
               have ***: "integrable (lebesgue_on {\<xi>..pi}) (\<lambda>x. (sin (n/2 * x))\<^sup>2 * (inverse (2 * (sin (x/2))\<^sup>2) * h x))"
               proof (rule absolutely_integrable_imp_integrable [OF absolutely_integrable_bounded_measurable_product_real])
                 show "(\<lambda>x. (sin (real n / 2 * x))\<^sup>2) \<in> borel_measurable (lebesgue_on {\<xi>..pi})"
                   by (intro continuous_imp_measurable_on_sets_lebesgue continuous_intros) auto
                 show "bounded ((\<lambda>x. (sin (real n / 2 * x))\<^sup>2) ` {\<xi>..pi})"
                   by (force simp: square_le_1 intro: boundedI [where B=1])
                 show "(\<lambda>x. inverse (2 * (sin (x/2))\<^sup>2) * h x) absolutely_integrable_on {\<xi>..pi}"
                   using hint by (simp add: divide_simps)
               qed auto
               show "\<psi> \<in> borel_measurable (lebesgue_on {\<xi>..pi})"
                 apply (rule borel_measurable_integrable)
                 apply (rule integrable_cong [where f = "\<lambda>x. sin(n / 2 * x) ^ 2 / (2 * n * sin(x/2) ^ 2) * h x", OF refl, THEN iffD1])
                 using \<open>0 < \<xi>\<close> **
                  apply (force simp: \<psi>_def divide_simps algebra_simps mult_less_0_iff abs_mult)
                 using Bochner_Integration.integrable_mult_left [OF ***, of "1/n"]
                 by (simp add: field_simps)
               show "norm (\<psi> x) \<le> ?g x" if "x \<in> {\<xi>..pi}" for x
                 using that \<dagger> by (simp add: \<psi>_def)
             qed auto
           qed
           then show "norm (LINT x|lebesgue_on {\<xi>..pi}. Fejer_kernel n x * h x) \<le> \<phi> n"
             by (simp add: Fejer_kernel \<phi>_def \<psi>_def flip: Bochner_Integration.integral_divide [OF *])
         qed
         show "\<phi> \<longlonglongrightarrow> 0"
           unfolding \<phi>_def divide_inverse
           by (simp add: tendsto_mult_right_zero lim_inverse_n)
       qed
       then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> \<bar>LINT x|lebesgue_on {\<xi>..pi}. Fejer_kernel n x * h x\<bar> < e/2"
         unfolding lim_sequentially by (metis half_gt_zero_iff norm_conv_dist real_norm_def \<open>e > 0\<close>)
       show "\<exists>N. \<forall>n\<ge>N. \<bar>(LINT u|lebesgue_on {0..pi}. Fejer_kernel n u * h u)\<bar> < e"
       proof (intro exI allI impI)
         fix n :: nat
         assume n: "n \<ge> max 1 N"
         with N have 1: "\<bar>LINT x|lebesgue_on {\<xi>..pi}. Fejer_kernel n x * h x\<bar> < e/2"
           by simp
         have "integral\<^sup>L (lebesgue_on {0..\<xi>}) (Fejer_kernel n) \<le> integral\<^sup>L (lebesgue_on {0..pi}) (Fejer_kernel n)"
          using \<open>\<xi> < pi\<close> has_bochner_integral_iff has_integral_Fejer_kernel_half
          by (force intro!: integral_mono_lebesgue_on_AE)
         also have "\<dots> \<le> pi"
           using has_integral_Fejer_kernel_half by (simp add: has_bochner_integral_iff)
         finally have int_le_pi: "integral\<^sup>L (lebesgue_on {0..\<xi>}) (Fejer_kernel n) \<le> pi" .
         have 2: "\<bar>LINT x|lebesgue_on {0..\<xi>}. Fejer_kernel n x * h x\<bar> \<le> (LINT x|lebesgue_on {0..\<xi>}. Fejer_kernel n x * e/2/pi)"
         proof -
           have eq: "integral\<^sup>L (lebesgue_on {0..\<xi>}) (\<lambda>x. Fejer_kernel n x * h x)
                   = integral\<^sup>L (lebesgue_on {0..\<xi>}) (\<lambda>x. Fejer_kernel n x * (if x = 0 then 0 else h x))"
           proof (rule integral_cong_AE)
             have \<dagger>: "{u. u \<noteq> 0 \<longrightarrow> P u} \<inter> {0..\<xi>} = {0} \<union> Collect P \<inter> {0..\<xi>}"
               "{u. u \<noteq> 0 \<and> P u} \<inter> {0..\<xi>} = (Collect P \<inter> {0..\<xi>}) - {0}" for P
               using \<open>0 < \<xi>\<close> by auto
             have *: "- {0} \<inter> A \<inter> {0..\<xi>} = A \<inter> {0..\<xi>} - {0}" for A
               by auto
             show "(\<lambda>x. Fejer_kernel n x * h x) \<in> borel_measurable (lebesgue_on {0..\<xi>})"
               using \<open>\<xi> < pi\<close>
               by (intro absolutely_integrable_imp_borel_measurable h_aint
                   absolutely_integrable_on_subinterval [OF absolutely_integrable_mult_Fejer_kernel], auto)
             then show "(\<lambda>x. Fejer_kernel n x * (if x = 0 then 0 else h x)) \<in> borel_measurable (lebesgue_on {0..\<xi>})"
               apply (simp add: in_borel_measurable Ball_def vimage_def Collect_conj_eq Collect_imp_eq * flip: Collect_neg_eq)
               apply (elim all_forward imp_forward asm_rl)
               using \<open>0 < \<xi>\<close>
               apply (auto simp: \<dagger> sets.insert_in_sets sets_restrict_space_iff cong: conj_cong)
               done
             have 0: "{0} \<in> null_sets (lebesgue_on {0..\<xi>})"
               using \<open>0 < \<xi>\<close> by (simp add: null_sets_restrict_space)
             then show "AE x in lebesgue_on {0..\<xi>}. Fejer_kernel n x * h x = Fejer_kernel n x * (if x = 0 then 0 else h x)"
               by (auto intro: AE_I' [OF 0])
           qed
           show ?thesis
             unfolding eq
           proof (rule integral_abs_bound_integral)
             have "(\<lambda>x. if x = 0 then 0 else h x) absolutely_integrable_on {- pi..pi}"
             proof (rule absolutely_integrable_spike [OF h_aint])
               show "negligible {0}"
                 by auto
             qed auto
             with \<open>0 < \<xi>\<close> \<open>\<xi> < pi\<close> show "integrable (lebesgue_on {0..\<xi>}) (\<lambda>x. Fejer_kernel n x * (if x = 0 then 0 else h x))"
               by (intro absolutely_integrable_imp_integrable h_aint absolutely_integrable_on_subinterval [OF absolutely_integrable_mult_Fejer_kernel]) auto
             show "integrable (lebesgue_on {0..\<xi>}) (\<lambda>x. Fejer_kernel n x * e / 2 / pi)"
               by (simp add: absolutely_integrable_imp_integrable \<open>\<xi> < pi\<close> absolutely_integrable_mult_Fejer_kernel_reflected_part3 less_eq_real_def)
             show "\<bar>Fejer_kernel n x * (if x = 0 then 0 else h x)\<bar> \<le> Fejer_kernel n x * e / 2 / pi"
               if "x \<in> space (lebesgue_on {0..\<xi>})" for x
               using that \<xi> [of x] \<open>e > 0\<close>
               by (auto simp: abs_mult eq simp flip: times_divide_eq_right intro: mult_left_mono)
           qed
         qed
         have 3: "\<dots> \<le> e/2"
           using int_le_pi \<open>0 < e\<close>
           by (simp add: divide_simps mult.commute [of e])
 
         have "integrable (lebesgue_on {0..pi}) (\<lambda>x. Fejer_kernel n x * h x)"
           unfolding h_def
           by (simp add: absolutely_integrable_imp_integrable absolutely_integrable_mult_Fejer_kernel_reflected_part5 assms)
         then have "LINT x|lebesgue_on {0..pi}. Fejer_kernel n x * h x
                  = (LINT x|lebesgue_on {0..\<xi>}. Fejer_kernel n x * h x) + (LINT x|lebesgue_on {\<xi>..pi}. Fejer_kernel n x * h x)"
           by (rule integral_combine) (use  \<open>0 < \<xi>\<close> \<open>\<xi> < pi\<close> in auto)
         then show "\<bar>LINT u|lebesgue_on {0..pi}. Fejer_kernel n u * h u\<bar> < e"
           using 1 2 3 by linarith
       qed
     qed
   qed
   then show ?thesis
     unfolding h_def by (simp add: Fourier_sum_limit_Fejer_kernel_half assms add_divide_distrib)
 qed
 
 corollary Fourier_Fejer_Cesaro_summable_simple:
   assumes f: "continuous_on UNIV f"
     and periodic: "\<And>x. f(x + 2*pi) = f x"
   shows "(\<lambda>n. (\<Sum>m<n. \<Sum>k\<le>2*m. Fourier_coefficient f k * trigonometric_set k x) / n) \<longlonglongrightarrow> f x"
 proof -
   have "(\<lambda>n. (\<Sum>m<n. \<Sum>k\<le>2*m. Fourier_coefficient f k * trigonometric_set k x) / n) \<longlonglongrightarrow> (f x + f x) / 2"
   proof (rule Fourier_Fejer_Cesaro_summable)
     show "f absolutely_integrable_on {- pi..pi}"
       using absolutely_integrable_continuous_real continuous_on_subset f by blast
     show "(f \<longlongrightarrow> f x) (at x within {..x})"  "(f \<longlongrightarrow> f x) (at x within {x..})"
       using Lim_at_imp_Lim_at_within continuous_on_def f by blast+
   qed (auto simp: periodic Lim_at_imp_Lim_at_within continuous_on_def f)
   then show ?thesis
     by simp
 qed
 
 end
 
 
diff --git a/thys/Gauss_Sums/Polya_Vinogradov.thy b/thys/Gauss_Sums/Polya_Vinogradov.thy
--- a/thys/Gauss_Sums/Polya_Vinogradov.thy
+++ b/thys/Gauss_Sums/Polya_Vinogradov.thy
@@ -1,873 +1,873 @@
 (*
   File:     Polya_Vinogradov.thy
   Authors:  Rodrigo Raya, EPFL; Manuel Eberl, TUM
 
   The Pólya–Vinogradov inequality, both the general case and the stronger variant for
   primitive characters.
 *)
 section \<open>The Pólya--Vinogradov Inequality\<close>
 theory Polya_Vinogradov
 imports
   Gauss_Sums
   "Dirichlet_Series.Divisor_Count"
 begin
 
 unbundle no_vec_lambda_notation
 
 subsection \<open>The case of primitive characters\<close>
 
 text \<open>
   We first prove a stronger variant of the Pólya--Vinogradov inequality for primitive characters.
   The fully general variant will then simply be a corollary of this. First, we need some bounds on
   logarithms, exponentials, and the harmonic numbers:
 \<close>
 
 (* TODO: Move? *)
 lemma ln_add_one_self_less_self:
   fixes x :: real
   assumes "x > 0" 
   shows "ln (1 + x) < x"
 proof -
   have "0 \<le> x" "0 < x" "exp x > 0" "1+x > 0" using assms by simp+
   have "1 + x < 1 + x + x\<^sup>2 / 2"
     using \<open>0 < x\<close> by auto
   also have "\<dots> \<le> exp x"
     using exp_lower_Taylor_quadratic[OF \<open>0 \<le> x\<close>] by blast
   finally have "1 + x < exp (x)" by blast
   then have "ln (1 + x) < ln (exp (x))" 
     using ln_less_cancel_iff[OF \<open>1+x > 0\<close> \<open>exp(x) > 0\<close>] by auto
   also have "\<dots> = x" using ln_exp by blast
   finally show ?thesis by auto
 qed
 
 lemma exp_1_bounds:
   assumes "x > (0::real)"
   shows   "exp 1 > (1 + 1 / x) powr x" and "exp 1 < (1 + 1 / x) powr (x+1)"
 proof -
   have "ln (1 + 1 / x) < 1 / x"
     using ln_add_one_self_less_self assms by simp
   thus "exp 1 > (1 + 1 / x) powr x" using assms
     by (simp add: field_simps powr_def)
 next
   have "1 < (x + 1) * ln ((x + 1) / x)" (is "_ < ?f x")
   proof (rule DERIV_neg_imp_decreasing_at_top[where ?f = ?f])
     fix t assume t: "x \<le> t"
     have "(?f has_field_derivative (ln (1 + 1 / t) - 1 / t)) (at t)"
       using t assms by (auto intro!: derivative_eq_intros simp:divide_simps)
     moreover have "ln (1 + 1 / t) - 1 / t < 0"
       using ln_add_one_self_less_self[of "1 / t"] t assms by auto
     ultimately show "\<exists>y. ((\<lambda>t. (t + 1) * ln ((t + 1) / t)) has_real_derivative y) (at t) \<and> y < 0"
       by blast
   qed real_asymp
   thus "exp 1 < (1 + 1 / x) powr (x + 1)"
     using assms by (simp add: powr_def field_simps)
 qed
 
 lemma harm_aux_ineq_1:
   fixes k :: real
   assumes "k > 1"
   shows "1 / k < ln (1 + 1 / (k - 1))" 
 proof -   
   have "k-1 > 0" \<open>k > 0\<close> using assms by simp+
   from exp_1_bounds(2)[OF \<open>k-1 > 0\<close>]
   have "exp 1 < (1 + 1 / (k - 1)) powr k" by simp
   then have n_z: "(1 + 1 / (k - 1)) powr k > 0" 
       using assms not_exp_less_zero by auto
   
   have "(1::real) = ln (exp(1))" using ln_exp by auto
   also have "\<dots> < ln ((1 + 1 / (k - 1)) powr k)"
     using ln_less_cancel_iff[of "exp(1)",simplified,OF \<open>(1 + 1 / (k - 1)) powr k > 0\<close>]
           exp_1_bounds[OF \<open>k - 1 > 0\<close>] by simp
   also have "\<dots> = k * ln (1 + 1 / (k - 1))" 
     using ln_powr n_z by simp
   finally have "1 < k * ln (1 + 1 / (k - 1))" 
     by blast
   then show ?thesis using assms by (simp add: field_simps)
 qed
 
 lemma harm_aux_ineq_2_lemma:
   assumes "x \<ge> (0::real)"
   shows   "1 < (x + 1) * ln (1 + 2 / (2 * x + 1))"
 proof -
   have "0 < ln (1+2/(2*x+1)) - 1 / (x + 1)" (is "_ < ?f x")
   proof (rule DERIV_neg_imp_decreasing_at_top[where ?f = ?f])
     fix t assume t: "x \<le> t"
     from assms t have "3 + 8 * t + 4 * t^2 > 0"
       by (intro add_pos_nonneg) auto
     hence *: "3 + 8 * t + 4 * t^2 \<noteq> 0"
       by auto
     have "(?f has_field_derivative (-1 / ((1 + t)^2 * (3 + 8 * t + 4 * t ^ 2)))) (at t)"
       apply (insert assms t *, (rule derivative_eq_intros refl | simp add: add_pos_pos)+)
       apply (auto simp: divide_simps)
       apply (auto simp: algebra_simps power2_eq_square)
       done
     moreover have "-1 / ((1 + t)^2 * (3 + 8 * t + 4 * t^2)) < 0"
       using t assms by (intro divide_neg_pos mult_pos_pos add_pos_nonneg) auto
     ultimately show "\<exists>y. (?f has_real_derivative y) (at t) \<and> y < 0"
       by blast
   qed real_asymp
   thus "1 < (x + 1) * ln (1+2/(2*x+1))"
     using assms by (simp add: field_simps)
 qed
 
 lemma harm_aux_ineq_2:
   fixes k :: real
   assumes "k \<ge> 1"
   shows   "1 / (k + 1) < ln (1 + 2 / (2 * k + 1))" 
 proof -
   have "k > 0" using assms by auto
   have "1 < (k + 1) * ln (1 + 2 / (2 * k + 1))"
     using harm_aux_ineq_2_lemma assms by simp
   then show ?thesis 
     by (simp add: \<open>0 < k\<close> add_pos_pos mult.commute mult_imp_div_pos_less)
 qed
 
 lemma nat_0_1_induct [case_names 0 1 step]:
   assumes "P 0" "P 1" "\<And>n. n \<ge> 1 \<Longrightarrow> P n \<Longrightarrow> P (Suc n)"
   shows   "P n"
 proof (induction n rule: less_induct)
   case (less n)
   show ?case 
     using assms(3)[OF _ less.IH[of "n - 1"]]
     by (cases "n \<le> 1")
       (insert assms(1-2),auto simp: eval_nat_numeral le_Suc_eq)
 qed
 
 lemma harm_less_ln:
   fixes m :: nat
   assumes "m > 0"
   shows   "harm m < ln (2 * m + 1)" 
   using assms
 proof (induct m rule: nat_0_1_induct)
   case 0
   then show ?case by blast
 next
   case 1
   have "harm 1 = (1::real)" unfolding harm_def by simp
   have "harm 1 < ln (3::real)" 
     by (subst \<open>harm 1 = 1\<close>,subst ln3_gt_1,simp)
   then show ?case by simp
 next
   case (step n)
   have "harm (n+1) = harm n + 1/(n+1)"
     by ((subst Suc_eq_plus1[symmetric])+,subst harm_Suc,subst inverse_eq_divide,blast)
   also have "\<dots> < ln (real (2 * n + 1)) + 1/(n+1)"
     using step(1-2) by auto
   also have "\<dots> < ln (real (2 * n + 1)) + ln (1+2/(2*n+1))"
   proof -
     from step(1) have "real n \<ge> 1" by simp
     have "1 / real (n + 1) < ln (1 + 2 / real (2 * n + 1))"
       using harm_aux_ineq_2[OF \<open>1 \<le> (real n)\<close>]  by (simp add: add.commute)
     then show ?thesis by auto
   qed
   also have "\<dots> = ln ((2 * n + 1) * (1+2/(2*n+1)))"
     by (rule ln_mult[symmetric],simp,simp add: field_simps)
   also have "\<dots> = ln (2*(n+1)+1)"
   proof -
     have "(2 * n + 1) * (1+2/(2*n+1)) = 2*(n+1)+1"
       by (simp add: field_simps)
     then show ?thesis by presburger
   qed
   finally show ?case by simp
 qed
 (* END TODO *)
   
 
 text\<open>Theorem 8.21\<close>
 theorem (in primitive_dchar) polya_vinogradov_inequality_primitive:
   fixes x :: nat
   shows "norm (\<Sum>m=1..x. \<chi> m) < sqrt n * ln n"
 proof -
   define \<tau> :: complex where "\<tau> = gauss_sum 1 div sqrt n"
   have \<tau>_mod: "norm \<tau> = 1" using fourier_primitive(2)
     by (simp add: \<tau>_def)
   {
     fix m
     have "\<chi> m = (\<tau> div sqrt n) * (\<Sum>k = 1..n. (cnj (\<chi> k)) * unity_root n (-m*k))"
     using fourier_primitive(1)[of m] \<tau>_def by blast}
     note chi_expr = this
     have "(\<Sum>m = 1..x. \<chi>(m)) = (\<Sum>m = 1..x. (\<tau> div sqrt n) * (\<Sum>k = 1..n. (cnj (\<chi> k)) * unity_root n (-m*k)))"
       by(rule sum.cong[OF refl]) (use chi_expr in blast)
     also have "\<dots> = (\<Sum>m = 1..x. (\<Sum>k = 1..n. (\<tau> div sqrt n) * ((cnj (\<chi> k)) * unity_root n (-m*k))))"
       by (rule sum.cong,simp,simp add: sum_distrib_left)
     also have "\<dots> = (\<Sum>k = 1..n. (\<Sum>m = 1..x. (\<tau> div sqrt n) * ((cnj (\<chi> k)) * unity_root n (-m*k))))"
       by (rule sum.swap)
     also have "\<dots> = (\<Sum>k = 1..n. (\<tau> div sqrt n) *  (cnj (\<chi> k) * (\<Sum>m = 1..x. unity_root n (-m*k))))"
       by (rule sum.cong,simp,simp add: sum_distrib_left)
     also have "\<dots> = (\<Sum>k = 1..<n. (\<tau> div sqrt n) * (cnj (\<chi> k) * (\<Sum>m = 1..x. unity_root n (-m*k))))"
       using n by (intro sum.mono_neutral_right) (auto intro: eq_zero)
     also have "\<dots> = (\<tau> div sqrt n) * (\<Sum>k = 1..<n. (cnj (\<chi> k) * (\<Sum>m = 1..x. unity_root n (-m*k))))"
       by (simp add: sum_distrib_left)
     finally have "(\<Sum>m = 1..x. \<chi>(m)) = (\<tau> div sqrt n) * (\<Sum>k = 1..<n. (cnj (\<chi> k) * (\<Sum>m = 1..x. unity_root n (-m*k))))"
       by blast
     hence eq: "sqrt n * (\<Sum>m=1..x. \<chi>(m)) = \<tau> * (\<Sum>k=1..<n. (cnj (\<chi> k) * (\<Sum>m=1..x. unity_root n (-m*k))))"
       by auto
     define f where "f = (\<lambda>k. (\<Sum>m = 1..x. unity_root n (-m*k)))"
     
     hence "(sqrt n) * norm(\<Sum>m = 1..x. \<chi>(m)) = norm(\<tau> * (\<Sum>k=1..<n. (cnj (\<chi> k) * (\<Sum>m = 1..x. unity_root n (-m*k)))))"
     proof -
       have "norm(sqrt n * (\<Sum>m=1..x. \<chi>(m))) = norm (sqrt n) * norm((\<Sum>m = 1..x. \<chi>(m)))"
         by (simp add: norm_mult)
       also have "\<dots> = (sqrt n) * norm((\<Sum>m = 1..x. \<chi>(m)))"
         by simp
       finally have 1: "norm((sqrt n) * (\<Sum>m = 1..x. \<chi>(m))) = (sqrt n) * norm((\<Sum>m = 1..x. \<chi>(m)))"
         by blast
       then show ?thesis using eq by algebra
     qed
     also have "\<dots> = norm (\<Sum>k = 1..<n. (cnj (\<chi> k) * (\<Sum>m = 1..x. unity_root n (-m*k))))"
       by (simp add: norm_mult \<tau>_mod)
     also have "\<dots> \<le> (\<Sum>k = 1..<n. norm (cnj (\<chi> k) * (\<Sum> m = 1..x. unity_root n (-m*k))))"
       using norm_sum by blast
     also have "\<dots> = (\<Sum>k = 1..<n. norm (cnj (\<chi> k)) * norm((\<Sum> m = 1..x. unity_root n (-m*k))))"
       by (rule sum.cong,simp, simp add: norm_mult)
     also have "\<dots> \<le> (\<Sum>k = 1..<n. norm((\<Sum>m = 1..x. unity_root n (-m*k))))"
     proof -
       show ?thesis
       proof (rule sum_mono)
         fix k
         assume "k \<in> {1..<n}" 
         define sum_aux :: real where "sum_aux = norm (\<Sum>m=1..x. unity_root n (- int m * int k))"
         have "sum_aux \<ge> 0" unfolding sum_aux_def by auto
         have "norm (cnj (\<chi> k)) \<le> 1" using norm_le_1[of k] by simp
         then have "norm (cnj (\<chi> k)) * sum_aux \<le> 1 * sum_aux"
           using \<open>sum_aux \<ge> 0\<close> by (simp add: mult_left_le_one_le)
         then show " norm (cnj (\<chi> k)) *
            norm (\<Sum>m = 1..x. unity_root n (- int m * int k))
            \<le> norm (\<Sum>m = 1..x. unity_root n (- int m * int k))"
           unfolding sum_aux_def by argo
       qed
     qed
     also have "\<dots> = (\<Sum>k = 1..<n. norm(f k))"
       using f_def by blast
     finally have 24: "(sqrt n) * norm(\<Sum>m = 1..x. \<chi>(m)) \<le> (\<Sum>k = 1..<n. norm(f k))"
       by blast
     
     {
       fix k :: int
       have "f(n-k) = cnj(f(k))"
       proof -
         have "f(n-k) = (\<Sum>m = 1..x. unity_root n (-m*(n-k)))"
           unfolding f_def by blast
         also have "\<dots> = (\<Sum>m = 1..x. unity_root n (m*k))"
         proof (rule sum.cong,simp)
           fix xa
           assume "xa \<in> {1..x}" 
           have "(k * int xa - int n * int xa) mod int n = (k * int xa - 0) mod int n"
             by (intro mod_diff_cong) auto
           thus "unity_root n (-int xa * (int n - k)) = unity_root n (int xa * k)"
             unfolding ring_distribs by (intro unity_root_cong) (auto simp: cong_def algebra_simps)
         qed
         also have "\<dots> = cnj(f(k))"
         proof -
           have "cnj(f(k)) = cnj (\<Sum>m = 1..x. unity_root n (- int m * k))"
             unfolding f_def by blast
           also have "cnj (\<Sum>m = 1..x. unity_root n (- int m * k)) = 
                 (\<Sum>m = 1..x. cnj(unity_root n (- int m * k)))"
             by (rule cnj_sum)
           also have "\<dots> = (\<Sum>m = 1..x. unity_root n (int m * k))"
             by (intro sum.cong) (auto simp: unity_root_uminus)
           finally show ?thesis by auto
         qed
         finally show "f(n-k) = cnj(f(k))" by blast      
       qed
       hence "norm(f(n-k)) = norm(cnj(f(k)))" by simp
       hence "norm(f(n-k)) = norm(f(k))" by auto
     }
     note eq = this
     have 25: 
       "odd n \<Longrightarrow> (\<Sum>k = 1..n - 1. norm (f (int k))) \<le>
                     2 * (\<Sum>k = 1..(n-1) div 2. norm (f (int k)))" 
       "even n \<Longrightarrow> (\<Sum>k = 1..n - 1. norm (f (int k))) \<le>
                     2 * (\<Sum>k = 1..(n-2) div 2. norm (f (int k))) + norm(f(n div 2))"
     proof -
       assume "odd n" 
       define g where "g = (\<lambda>k. norm (f k))"
       have "(n-1) div 2  = n div 2" using \<open>odd n\<close> n 
         using div_mult_self1_is_m[OF pos2,of "n-1"] 
               odd_two_times_div_two_nat[OF \<open>odd n\<close>] by linarith      
       have "(\<Sum>i=1..n-1. g i) = (\<Sum>i\<in>{1..n div 2}\<union>{n div 2<..n-1}. g i)"
         using n by (intro sum.cong,auto) 
       also have "\<dots> = (\<Sum>i\<in>{1..n div 2}. g i) + (\<Sum>i\<in>{n div 2<..n-1}. g i)"
         by (subst sum.union_disjoint,auto)
       also have "(\<Sum>i\<in>{n div 2<..n-1}. g i) = (\<Sum>i\<in>{1..n - (n div 2 + 1)}. g (n - i))"
         by (rule sum.reindex_bij_witness[of _ "\<lambda>i. n - i" "\<lambda>i. n - i"],auto) 
       also have "\<dots> \<le> (\<Sum>i\<in>{1..n div 2}. g (n - i))"
         by (intro sum_mono2,simp,auto simp add: g_def)
       finally have 1: "(\<Sum>i=1..n-1. g i) \<le> (\<Sum>i=1..n div 2. g i + g (n - i))"
         by (simp add: sum.distrib)
       have "(\<Sum>i=1..n div 2. g i + g (n - i)) = (\<Sum>i=1..n div 2. 2 * g i)"
         unfolding g_def
         apply(rule sum.cong,simp)
         using eq int_ops(6) by force
       also have "\<dots> = 2 * (\<Sum>i=1..n div 2. g i)"
         by (rule sum_distrib_left[symmetric])
       finally have 2: "(\<Sum>i=1..n div 2. g i + g (n - i)) = 2 * (\<Sum>i=1..n div 2. g i)"
         by blast
       from 1 2 have "(\<Sum>i=1..n-1. g i) \<le> 2 * (\<Sum>i=1..n div 2. g i)" by algebra
       then show "(\<Sum>n = 1..n - 1. norm (f (int n))) \<le> 2 * (\<Sum>n = 1..(n-1) div 2. norm (f (int n)))" 
         unfolding g_def \<open>(n-1) div 2 = n div 2\<close> by blast
     next
       assume "even n" 
       define g where "g = (\<lambda>n. norm (f (n)))"
       have "(n-2) div 2 = n div 2 - 1" using \<open>even n\<close> n by simp
       have "(\<Sum>i=1..n-1. g i) = (\<Sum>i\<in>{1..<n div 2}\<union> {n div 2} \<union> {n div 2<..n-1}. g i)"
         using n by (intro sum.cong,auto) 
       also have "\<dots> = (\<Sum>i\<in>{1..<n div 2}. g i) + (\<Sum>i\<in>{n div 2<..n-1}. g i) + g(n div 2)"
         by (subst sum.union_disjoint,auto)
       also have "(\<Sum>i\<in>{n div 2<..n-1}. g i) = (\<Sum>i\<in>{1..n - (n div 2+1)}. g (n - i))"
         by (rule sum.reindex_bij_witness[of _ "\<lambda>i. n - i" "\<lambda>i. n - i"],auto) 
       also have "\<dots> \<le> (\<Sum>i\<in>{1..<n div 2}. g (n - i))"
       proof (intro sum_mono2,simp)
         have "n - n div 2 = n div 2" using \<open>even n\<close> n by auto
         then have "n - (n div 2 + 1) < n div 2" 
           using n by (simp add: divide_simps)
         then show "{1..n - (n div 2 + 1)} \<subseteq> {1..<n div 2}" by fastforce
       qed auto
       finally have 1: "(\<Sum>i=1..n-1. g i) \<le> (\<Sum>i=1..<n div 2. g i + g (n - i)) + g(n div 2)"
         by (simp add: sum.distrib)
       have "(\<Sum>i=1..<n div 2. g i + g (n - i)) = (\<Sum>i=1..<n div 2. 2 * g i)"
         unfolding g_def
         apply(rule sum.cong,simp)
         using eq int_ops(6) by force
       also have "\<dots> = 2 * (\<Sum>i=1..<n div 2. g i)"
         by (rule sum_distrib_left[symmetric])
       finally have 2: "(\<Sum>i=1..<n div 2. g i + g (n - i)) = 2 * (\<Sum>i=1..<n div 2. g i)"
         by blast
       from 1 2 have 3: "(\<Sum>i=1..n-1. g i) \<le> 2 * (\<Sum>i=1..<n div 2. g i) + g(n div 2)" by algebra
       then have "(\<Sum>i=1..n-1. g i) \<le> 2 * (\<Sum>i=1..(n-2) div 2. g i) + g(n div 2)" 
       proof -
         have "{1..<n div 2} = {1..(n-2) div 2}" by auto
         then have "(\<Sum>i=1..<n div 2. g i) = (\<Sum>i=1..(n-2) div 2. g i)" 
           by (rule sum.cong,simp)
         then show ?thesis using 3 by presburger
       qed
       then show "(\<Sum>k = 1..n - 1. norm (f (int k))) \<le> 2 * (\<Sum>n = 1..(n-2) div 2. norm (f (int n))) + g(n div 2)" 
         unfolding g_def by blast
     qed
     
     (* expression for each f(n) *)
     {fix k :: int
     assume "1 \<le> k" "k \<le> n div 2" 
     have "k \<le> n - 1"
       using \<open>k \<le> n div 2\<close> n by linarith
     define y where "y = unity_root n (-k)"
     define z where "z = exp (-(pi*k/n)* \<i>)"
     have "z^2 = exp (2*(-(pi*k/n)* \<i>))"
       unfolding z_def using exp_double[symmetric] by blast
     also have "\<dots> = y"
       unfolding y_def unity_root_conv_exp by (simp add: algebra_simps)
     finally have z_eq: "y = z^2" by blast
     have z_not_0: "z \<noteq> 0" 
       using z_eq by (simp add: z_def)
     
     then have "y \<noteq> 1" 
       using unity_root_eq_1_iff_int \<open>1 \<le> k\<close> \<open>k \<le> n - 1\<close> not_less
             unity_root_eq_1_iff_int y_def zdvd_not_zless by auto
     
     have "f(k) = (\<Sum>m = 1..x . y^m)" 
       unfolding f_def y_def 
       by (subst unity_root_pow,rule sum.cong,simp,simp add: algebra_simps)
     also have sum: "\<dots> = (\<Sum>m = 1..<x+1 . y^m)"
       by (rule sum.cong,fastforce,simp)
     also have "\<dots> = (\<Sum>m = 0..<x+1 . y^m) - 1"
       by (subst (2) sum.atLeast_Suc_lessThan) auto
     also have "\<dots> = (y^(x+1) - 1) div (y - 1) - 1"
       using geometric_sum[OF \<open>y \<noteq> 1\<close>, of "x+1"] by (simp add: atLeast0LessThan)   
     also have "\<dots> = (y^(x+1) - 1 - (y-1)) div (y - 1)"
     proof -
       have "y - 1 \<noteq> 0" using \<open>y \<noteq> 1\<close> by simp
       show ?thesis
         using divide_diff_eq_iff[OF \<open>y - 1 \<noteq> 0\<close>, of "(y^(x+1) - 1)" 1] by auto
     qed
     also have "\<dots> = (y^(x+1) - y) div (y - 1)"
       by (simp add: algebra_simps)
     also have "\<dots> = y * (y^x - 1) div (y - 1)"
       by (simp add: algebra_simps)
     also have "\<dots> = z^2 * ((z^2)^x - 1) div (z^2 - 1)"
       unfolding z_eq by blast
     also have "\<dots> = z^2 * (z^(2*x) - 1) div (z^2 - 1)"
       by (subst power_mult[symmetric, of z 2 x],blast) 
     also have "\<dots> = z^(x+1)*((z ^x -inverse(z^x))) / (z - inverse(z))"
     proof -
       have "z^x \<noteq> 0" using z_not_0 by auto
       have 1: "z ^ (2 * x) - 1 = z^x*(z ^x -inverse(z^x))"
         by (simp add: semiring_normalization_rules(36) right_inverse[OF \<open>z^x \<noteq> 0\<close>]  right_diff_distrib')
       have 2: "z\<^sup>2 - 1 = z*(z - inverse(z))" 
         by (simp add: right_diff_distrib' semiring_normalization_rules(29) right_inverse[OF \<open>z \<noteq> 0\<close>])
     
       have 3: "z\<^sup>2 * (z^x / z) = z^(x+1)"
       proof -
         have "z\<^sup>2 * (z^x / z) = z\<^sup>2 * (z^x * inverse z)"
           by (simp add: inverse_eq_divide)
         also have "\<dots> = z^(x+1)"
           by (simp add: algebra_simps power2_eq_square right_inverse[OF \<open>z \<noteq> 0\<close>])
         finally show ?thesis by blast
       qed
       have "z\<^sup>2 * (z ^ (2 * x) - 1) / (z\<^sup>2 - 1) =
             z\<^sup>2 * (z^x*(z ^x -inverse(z^x))) / (z*(z - inverse(z)))"
         by (subst 1, subst 2,blast) 
       also have "\<dots> =  (z\<^sup>2 * (z^x / z)) * ((z ^x -inverse(z^x))) / (z - inverse(z))"
         by simp
       also have "\<dots> = z^(x+1) *((z ^x -inverse(z^x))) / (z - inverse(z))"
         by (subst 3,simp) 
       finally show ?thesis by simp
     qed
     finally have "f(k) = z^(x+1) *((z ^x -inverse(z^x))) / (z - inverse(z))" by blast
     
     (* inequality for each f(k) *)
     then have "norm(f(k)) = norm(z^(x+1) * (((z ^x -inverse(z^x))) / (z - inverse(z))))" by auto
     also have "\<dots> = norm(z^(x+1)) * norm(((z ^x -inverse(z^x))) / (z - inverse(z)))"
       using norm_mult by blast
     also have "\<dots> = norm(((z ^x -inverse(z^x))) / (z - inverse(z)))"
     proof -
       have "norm(z) = 1" 
         unfolding z_def by auto
       have "norm(z^(x+1)) = 1"
         by (subst norm_power,simp add: \<open>norm(z) = 1\<close>)
       then show ?thesis by simp
     qed
     also have "\<dots> = norm((exp (-(x*pi*k/n)* \<i>) - exp ((x*pi*k/n)* \<i>)) div 
                      (exp (-(pi*k/n)* \<i>) - exp ((pi*k/n)* \<i>)))"
     proof -
       have 1: "z ^ x = exp (-(x*pi*k/n)* \<i>)"
         unfolding z_def
         by (subst exp_of_nat_mult[symmetric],simp add: algebra_simps)
       have "inverse (z ^ x) = inverse (exp (-(x*pi*k/n)* \<i>))"
         using \<open>z ^ x = exp (-(x*pi*k/n)* \<i>)\<close> by auto
       also have "\<dots> = (exp ((x*pi*k/n)* \<i>))"
         by (simp add: exp_minus)
       finally have 2: "inverse(z^x) = exp ((x*pi*k/n)* \<i>)" by simp
       have 3: "inverse z = exp ((pi*k/n)* \<i>)"
         by (simp add: exp_minus z_def)
       show ?thesis using 1 2 3 z_def by simp
     qed
     also have "\<dots> = norm((sin (x*pi*k/n)) div (sin (pi*k/n)))"
     proof -
       have num: "(exp (-(x*pi*k/n)* \<i>) - exp ((x*pi*k/n)* \<i>)) = (-2*\<i>* sin((x*pi*k/n)))" 
       proof -
         have 1: "exp (-(x*pi*k/n)* \<i>) = cos(-(x*pi*k/n)) + \<i> * sin(-(x*pi*k/n))"
                 "exp ((x*pi*k/n)* \<i>) = cos((x*pi*k/n)) + \<i> * sin((x*pi*k/n))"
           using Euler Im_complex_of_real Im_divide_of_nat Im_i_times Re_complex_of_real
                 complex_Re_of_int complex_i_mult_minus exp_zero mult.assoc mult.commute by force+
         have "(exp (-(x*pi*k/n)* \<i>) - exp ((x*pi*k/n)* \<i>)) =
               (cos(-(x*pi*k/n)) + \<i> * sin(-(x*pi*k/n))) -
               (cos((x*pi*k/n)) + \<i> * sin((x*pi*k/n)))"
           using 1 by argo
         also have "\<dots> = -2*\<i>* sin((x*pi*k/n))" by simp
         finally show ?thesis by blast  
       qed
     
       have den: "(exp (-(pi*k/n)* \<i>) - exp ((pi*k/n)* \<i>)) = -2*\<i>* sin((pi*k/n))"
       proof -
         have 1: "exp (-(pi*k/n)* \<i>) = cos(-(pi*k/n)) + \<i> * sin(-(pi*k/n))"
                 "exp ((pi*k/n)* \<i>) = cos((pi*k/n)) + \<i> * sin((pi*k/n))"
           using Euler Im_complex_of_real Im_divide_of_nat Im_i_times Re_complex_of_real 
                 complex_Re_of_int complex_i_mult_minus exp_zero mult.assoc mult.commute by force+
         have "(exp (-(pi*k/n)* \<i>) - exp ((pi*k/n)* \<i>)) =
               (cos(-(pi*k/n)) + \<i> * sin(-(pi*k/n))) -
               (cos((pi*k/n)) + \<i> * sin((pi*k/n)))"
           using 1 by argo
         also have "\<dots> = -2*\<i>* sin((pi*k/n))" by simp
         finally show ?thesis by blast  
       qed 
     
       have "norm((exp (-(x*pi*k/n)* \<i>) - exp ((x*pi*k/n)* \<i>)) div 
                      (exp (-(pi*k/n)* \<i>) - exp ((pi*k/n)* \<i>))) =
             norm((-2*\<i>* sin((x*pi*k/n))) div (-2*\<i>* sin((pi*k/n))))"
         using num den by presburger
       also have "\<dots> = norm(sin((x*pi*k/n)) div sin((pi*k/n)))"
         by (simp add: norm_divide)
       finally show ?thesis by blast
     qed
     also have "\<dots> = norm((sin (x*pi*k/n))) div norm((sin (pi*k/n)))"
       by (simp add: norm_divide)
     also have "\<dots> \<le> 1 div norm((sin (pi*k/n)))"
     proof -
       have "norm((sin (pi*k/n))) \<ge> 0" by simp
       have "norm (sin (x*pi*k/n)) \<le> 1" by simp
       then show ?thesis   
         using divide_right_mono[OF \<open>norm (sin (x*pi*k/n)) \<le> 1\<close> \<open>norm((sin (pi*k/n))) \<ge> 0\<close>]
         by blast
     qed
     finally have 26: "norm(f(k)) \<le> 1 div norm((sin (pi*k/n)))"
       by blast
     
     (* inequality with sin *)
     {
       fix t
       assume "t \<ge> 0" "t \<le> pi div 2"
       then have "t \<in> {0..pi div 2}" by auto 
       have "convex_on {0..pi/2} (\<lambda>x. -sin x)"
        by (rule convex_on_realI[where f' = "\<lambda>x. - cos x"])
           (auto intro!: derivative_eq_intros simp: cos_monotone_0_pi_le)
       from convex_onD_Icc'[OF this \<open>t \<in> {0..pi div 2}\<close>] have "sin(t) \<ge> (2 div pi)*t" by simp
     }
     note sin_ineq = this
     
     have sin_ineq_inst: "sin ((pi*k) / n) \<ge> (2 * k) / n"
     proof -
       have "pi / n \<ge> 0" by simp
       have 1: "(pi*k) / n \<ge> 0" using \<open>1 \<le> k\<close> by auto
       have "(pi*k)/n = (pi / n) * k" by simp
       also have "\<dots> \<le> (pi / n) * (n / 2)" 
         using mult_left_mono[of "k" "n / 2" "pi / n"] 
               \<open>k \<le> n div 2\<close> \<open>0 \<le> pi / real n\<close> by linarith
       also have "\<dots> \<le> pi / 2" 
         by (simp add: divide_simps)     
       finally have 2: "(pi*k)/n \<le> pi / 2" by auto
       
       have "(2 / pi) * (pi * k / n) \<le> sin((pi * k) / n)"
         using sin_ineq[OF 1 2] by blast
       then show "sin((pi * k) / n) \<ge> (2*k) / n" 
         by auto
     qed
     
     from 26 have "norm(f(k)) \<le> 1 div abs((sin (pi*k/n)))" by simp
     also have "\<dots> \<le> 1 / abs((2*k) / n)" 
     proof -
       have "sin (pi*k/n) \<ge> (2*k) / n" using sin_ineq_inst by simp
       moreover have "(2*k) / n > 0" using n \<open>1 \<le> k\<close> by auto
       ultimately have "abs((sin (pi*k/n))) \<ge> abs((2*k)/n)" by auto
       have "abs((2*k)/n) > 0" using \<open>(2*k)/n > 0\<close> by linarith
       then show "1 div abs((sin (pi*k/n))) \<le> 1 / abs(((2*k)/n))"
         using \<open>abs((2*k)/n) > 0\<close> \<open>abs((sin (pi*k/n))) \<ge> abs(((2*k)/n))\<close>
         by (intro frac_le) auto
     qed
     also have "\<dots> = n / (2*k)" using \<open>k \<ge> 1\<close> by simp
     finally have "norm(f(k)) \<le> n / (2*k)" by blast
   }
   note ineq = this
 
   (* inequality for the odd and even case*)
   have "sqrt n * norm (sum \<chi> {1..x}) < n * ln n"
   proof (cases "even n")
     case True
     have "norm (f(n div 2)) \<le> 1" 
     proof -
       have "int (n div 2) \<ge> 1" using n \<open>even n\<close> by auto
       show ?thesis
         using ineq[OF \<open>int (n div 2) \<ge> 1\<close>] True n by force
     qed
     from 24 have "sqrt n * norm (sum \<chi> {1..x}) 
                \<le> (\<Sum>k = 1..<n. norm (f (int k)))" by blast
     also have "\<dots> = (\<Sum>k = 1..n-1. norm (f (int k)))"
       by (intro sum.cong) auto
     also have "\<dots> \<le> 2 * (\<Sum>k = 1..(n - 2) div 2. norm (f (int k))) + norm(f(n div 2))"
       using 25(2)[OF True] by blast
     also have "\<dots> \<le>  real n * (\<Sum>k = 1..(n - 2) div 2. 1 / k) + norm(f(n div 2))"
     proof -
       have "(\<Sum>k = 1..(n - 2) div 2. norm (f (int k))) \<le> (\<Sum>k = 1..(n - 2) div 2. real n div (2*k))"
       proof (rule sum_mono)
         fix k
         assume "k \<in> {1..(n - 2) div 2}"
         then have "1 \<le> int k" "int k \<le> n div 2" by auto
         show "norm (f (int k)) \<le> real n / (2*k)" 
           using ineq[OF \<open>1 \<le> int k\<close> \<open>int k \<le> n div 2\<close>] by auto
       qed
       also have "\<dots> = (\<Sum>k = 1..(n - 2) div 2. (real n div 2) * (1 / k))"
         by (rule sum.cong,auto)
       also have "\<dots> = (real n div 2) * (\<Sum>k = 1..(n - 2) div 2. 1 / k)"
         using sum_distrib_left[symmetric] by fast
       finally have "(\<Sum>k = 1..(n - 2) div 2. norm (f (int k))) \<le> 
                   (real n div 2) * (\<Sum>k = 1..(n - 2) div 2. 1 / k)"
         by blast
       then show ?thesis by argo
     qed
     also have "\<dots> = real n * harm ((n - 2) div 2) + norm(f(n div 2))"
       unfolding harm_def inverse_eq_divide by simp
     also have "\<dots> < n * ln n"
     proof (cases "n = 2")   
       case True 
       have "real n * harm ((n - 2) div 2) + norm (f (int (n div 2))) \<le> 1" 
         using \<open>n = 2\<close> \<open>norm (f (int (n div 2))) \<le> 1\<close>
         unfolding harm_def by simp
       moreover have "real n * ln (real n) \<ge> 4 / 3" 
         using \<open>n = 2\<close> ln2_ge_two_thirds by auto
       ultimately show ?thesis by argo                
     next
       case False
       have "n > 3" using n \<open>n \<noteq> 2\<close> \<open>even n\<close> by auto
       then have "(n-2) div 2 > 0" by simp
       then have "harm ((n - 2) div 2) < ln (real (2 * ((n - 2) div 2) + 1))"
         using harm_less_ln by blast
       also have "\<dots> = ln (real (n - 1))" 
         using \<open>even n\<close> \<open>n > 3\<close> by simp      
       finally have 1: "harm ((n - 2) div 2) < ln (real (n - 1))"
         by blast
       then have "real n * harm ((n - 2) div 2) < real n * ln (real (n - 1))"
         using n by simp
       then have "real n * harm ((n - 2) div 2) + norm (f (int (n div 2)))
             < real n * ln (real (n - 1)) + 1"
         using \<open>norm (f (int (n div 2))) \<le> 1\<close> by argo
       also have "\<dots> = real n * ln (real (n - 1)) + real n * 1 / real n"
         using n by auto
       also have "\<dots> < real n * ln (real (n - 1)) + real n * ln (1 + 1 / (real n - 1))"
       proof -
         have "real n > 1" "real n > 0" using n by simp+
         then have "real n * (1 / real n) < real n * ln (1 + 1 / (real n - 1))"
           by (intro mult_strict_left_mono harm_aux_ineq_1) auto
         then show ?thesis by auto         
       qed
       also have "\<dots> = real n * ( ln (real (n - 1)) + ln (1 + 1 / (real n - 1)))"
         by argo
       also have "\<dots> = real n * ( ln (real (n - 1) * (1 + 1 / (real n - 1))))"
       proof -
         have "real (n - 1) > 0" "1 + 1 / (real n - 1) > 0"  
           using n by (auto simp add: add_pos_nonneg)
         show ?thesis 
           by (subst ln_mult [OF \<open>real (n - 1) > 0\<close> \<open>1 + 1 / (real n - 1) > 0\<close>,symmetric],blast)          
       qed
       also have "\<dots> = real n * ln n"
         using n by (auto simp add: divide_simps)
       finally show ?thesis by blast
     qed
     finally show ?thesis by blast
   next
     case False
     from 24 have "sqrt n * norm (sum \<chi> {1..x}) \<le> (\<Sum>k= 1..<n. norm (f (int k)))"
       by blast
     also have "\<dots> = (\<Sum>k= 1..n-1. norm (f (int k)))"
       by (intro sum.cong) auto
     also have "\<dots> \<le> 2 * (\<Sum>k = 1..(n - 1) div 2. norm (f (int k)))"
       using 25(1)[OF False] by blast
     also have "\<dots> \<le> real n * (\<Sum>k = 1..(n - 1) div 2. 1 / k)"
     proof -
       have "(\<Sum>k = 1..(n - 1) div 2. norm (f (int k))) \<le> (\<Sum>k = 1..(n - 1) div 2. real n div (2*k))"
       proof (rule sum_mono)
         fix k
         assume "k \<in> {1..(n - 1) div 2}"
         then have "1 \<le> int k" "int k \<le> n div 2" by auto
         show "norm (f (int k)) \<le> real n / (2*k)" 
           using ineq[OF \<open>1 \<le> int k\<close> \<open>int k \<le> n div 2\<close>] by auto
       qed
       also have "\<dots> = (\<Sum>k = 1..(n - 1) div 2. (n / 2) * (1 / k))"
         by (rule sum.cong,auto)
       also have "\<dots> = (n / 2) * (\<Sum>k = 1..(n - 1) div 2. 1 / k)"
         using sum_distrib_left[symmetric] by fast
       finally have "(\<Sum>k = 1..(n - 1) div 2. norm (f (int k))) \<le> 
                   (real n div 2) * (\<Sum>k = 1..(n - 1) div 2. 1 / k)"
         by blast
       then show ?thesis by argo
     qed
     also have "\<dots> = real n * harm ((n - 1) div 2)"
       unfolding harm_def inverse_eq_divide by simp
     also have "\<dots> < n * ln n"
     proof -
       have "n > 2" using n \<open>odd n\<close> by presburger
       then have "(n-1) div 2 > 0" by auto
       then have "harm ((n - 1) div 2) < ln (real (2 * ((n - 1) div 2) + 1))"
         using harm_less_ln by blast
       also have "\<dots> = ln (real n)" using \<open>odd n\<close> by simp
       finally show ?thesis using n by simp 
     qed
     finally show ?thesis by blast
   qed
   
   then have 1: "sqrt n * norm (sum \<chi> {1..x}) < n * ln n"
     by blast
   show  "norm (sum \<chi> {1..x}) < sqrt n * ln n"
   proof -
     have 2: "norm (sum \<chi> {1..x}) * sqrt n < n * ln n"
       using 1 by argo
     have "sqrt n > 0" using n by simp
     have 3: "(n * ln n) / sqrt n = sqrt n * ln n"
       using n by (simp add: field_simps)
     show "norm (sum \<chi> {1..x}) < sqrt n * ln n"
       using mult_imp_less_div_pos[OF \<open>sqrt n > 0\<close> 2] 3 by argo
   qed
 qed
 
 
 subsection \<open>General case\<close>
 
 text \<open>
   We now first prove the inequality for the general case in terms of the divisor function:
 \<close>
 theorem (in dcharacter) polya_vinogradov_inequality_explicit:
   assumes nonprincipal: "\<chi> \<noteq> principal_dchar n"
   shows   "norm (sum \<chi> {1..x}) < sqrt conductor * ln conductor * divisor_count (n div conductor)"
 proof -
   write primitive_extension ("\<Phi>")
   write conductor ("c")
   interpret \<Phi>: primitive_dchar c "residue_mult_group c" primitive_extension
     using primitive_primitive_extension nonprincipal by metis
 
   have *: "k \<le> x div b \<longleftrightarrow> b * k \<le> x" if "b > 0" for b k
     by (metis that antisym_conv div_le_mono div_mult_self1_is_m
               less_imp_le not_less times_div_less_eq_dividend)
   have **: "a > 0" if "a dvd n" for a
     using n that by (auto intro!: Nat.gr0I)
 
   from nonprincipal have "(\<Sum>m=1..x. \<chi> m) = (\<Sum>m | m \<in> {1..x} \<and> coprime m n. \<Phi> m)"
     by (intro sum.mono_neutral_cong_right) (auto simp: eq_zero_iff principal_decomposition)
   also have "\<dots> = (\<Sum>m=1..x. \<Phi> m * (\<Sum>d | d dvd gcd m n. moebius_mu d))"
     by (subst sum_moebius_mu_divisors', intro sum.mono_neutral_cong_left)
        (auto simp: coprime_iff_gcd_eq_1 simp del: coprime_imp_gcd_eq_1)
   also have "\<dots> = (\<Sum>m=1..x. \<Sum>d | d dvd gcd m n. \<Phi> m * moebius_mu d)"
     by (simp add: sum_distrib_left)
   also have "\<dots> = (\<Sum>m=1..x. \<Sum>d | d dvd m \<and> d dvd n. \<Phi> m * moebius_mu d)"
     by (intro sum.cong) auto
   also have "\<dots> = (\<Sum>(m, d)\<in>(SIGMA m:{1..x}. {d. d dvd m \<and> d dvd n}). \<Phi> m * moebius_mu d)"
     using n by (subst sum.Sigma) auto
   also have "\<dots> = (\<Sum>(d, q)\<in>(SIGMA d:{d. d dvd n}. {1..x div d}). moebius_mu d * \<Phi> (d * q))"
     by (intro sum.reindex_bij_witness[of _ "\<lambda>(d,q). (d * q, d)" "\<lambda>(m,d). (d, m div d)"])
        (auto simp: * ** Suc_le_eq)
   also have "\<dots> = (\<Sum>d | d dvd n. moebius_mu d * \<Phi> d * (\<Sum>q=1..x div d. \<Phi> q))"
     using n by (subst sum.Sigma [symmetric]) (auto simp: sum_distrib_left mult.assoc)
   finally have eq: "(\<Sum>m=1..x. \<chi> m) = \<dots>" .
 
   have "norm (\<Sum>m=1..x. \<chi> m) \<le>
           (\<Sum>d | d dvd n. norm (moebius_mu d * \<Phi> d) * norm (\<Sum>q=1..x div d. \<Phi> q))"
     unfolding eq by (intro sum_norm_le) (simp add: norm_mult)
   also have "\<dots> < (\<Sum>d | d dvd n. norm (moebius_mu d * \<Phi> d) * (sqrt c * ln c))"
     (is "sum ?lhs _ < sum ?rhs _")
   proof (rule sum_strict_mono_ex1)
     show "\<forall>d\<in>{d. d dvd n}. ?lhs d \<le> ?rhs d"
       by (intro ballI mult_left_mono less_imp_le[OF \<Phi>.polya_vinogradov_inequality_primitive]) auto
     show "\<exists>d\<in>{d. d dvd n}. ?lhs d < ?rhs d"
       by (intro bexI[of _ 1] mult_strict_left_mono \<Phi>.polya_vinogradov_inequality_primitive) auto
   qed (use n in auto)
   also have "\<dots> = sqrt c * ln c * (\<Sum>d | d dvd n. norm (moebius_mu d * \<Phi> d))"
     by (simp add: sum_distrib_left sum_distrib_right mult_ac)
   also have "(\<Sum>d | d dvd n. norm (moebius_mu d * \<Phi> d)) =
                (\<Sum>d | d dvd n \<and> squarefree d \<and> coprime d c. 1)"
     using n by (intro sum.mono_neutral_cong_right)
                (auto simp: moebius_mu_def \<Phi>.eq_zero_iff norm_mult norm_power \<Phi>.norm)
   also have "\<dots> = card {d. d dvd n \<and> squarefree d \<and> coprime d c}"
     by simp
   also have "card {d. d dvd n \<and> squarefree d \<and> coprime d c} \<le> card {d. d dvd (n div c)}"
   proof (intro card_mono; safe?)
     show "finite {d. d dvd (n div c)}"
       using dvd_div_eq_0_iff[of c n] n conductor_dvd by (intro finite_divisors_nat) auto
   next
     fix d assume d: "d dvd n" "squarefree d" "coprime d c"
     hence "d > 0" by (intro Nat.gr0I) auto
     show "d dvd (n div c)"
     proof (rule multiplicity_le_imp_dvd)
       fix p :: nat assume p: "prime p"
       show "multiplicity p d \<le> multiplicity p (n div c)"
       proof (cases "p dvd d")
         assume "p dvd d"
         with d \<open>d > 0\<close> p have "multiplicity p d = 1"
           by (auto simp: squarefree_factorial_semiring' in_prime_factors_iff)
         moreover have "p dvd (n div c)"
         proof -
           have "p dvd c * (n div c)"
             using \<open>p dvd d\<close> \<open>d dvd n\<close> conductor_dvd by auto
           moreover have "\<not>(p dvd c)"
             using d p \<open>p dvd d\<close> coprime_common_divisor not_prime_unit by blast
           ultimately show "p dvd (n div c)"
             using p prime_dvd_mult_iff by blast
         qed
         hence "multiplicity p (n div c) \<ge> 1"
           using n p conductor_dvd dvd_div_eq_0_iff[of c n]
           by (intro multiplicity_geI) (auto intro: Nat.gr0I)
         ultimately show ?thesis by simp
       qed (auto simp: not_dvd_imp_multiplicity_0)
     qed (use \<open>d > 0\<close> in simp_all)
   qed
   also have "card {d. d dvd (n div c)} = divisor_count (n div c)"
     by (simp add: divisor_count_def)
   finally show "norm (sum \<chi> {1..x}) < sqrt c * ln c * divisor_count (n div c)"
     using conductor_gr_0 by (simp add: mult_left_mono)
 qed
 
 (* TODO: Move? *)
 text \<open>
   Next, we obtain a suitable upper bound on the number of divisors of \<open>n\<close>:
 \<close>
 lemma divisor_count_upper_bound_aux:
   fixes n :: nat
   shows "divisor_count n \<le> 2 * card {d. d dvd n \<and> d \<le> sqrt n}"
 proof (cases "n = 0")
   case False
   hence n: "n > 0" by simp
   have *: "x > 0" if "x dvd n" for x
     using that n by (auto intro!: Nat.gr0I)
   have **: "real n = sqrt (real n) * sqrt (real n)"
     by simp
   have ***: "n < x * sqrt n \<longleftrightarrow> sqrt n < x" "x * sqrt n < n \<longleftrightarrow> x < sqrt n" for x
-    by (metis ** n of_nat_0_less_iff real_mult_less_iff1 real_sqrt_gt_0_iff)+
+    by (metis ** n of_nat_0_less_iff mult_less_iff1 real_sqrt_gt_0_iff)+
 
   have "divisor_count n = card {d. d dvd n}"
     by (simp add: divisor_count_def)
   also have "{d. d dvd n} = {d. d dvd n \<and> d \<le> sqrt n} \<union> {d. d dvd n \<and> d > sqrt n}"
     by auto
   also have "card \<dots> = card {d. d dvd n \<and> d \<le> sqrt n} + card {d. d dvd n \<and> d > sqrt n}"
     using n by (subst card_Un_disjoint) auto
   also have "bij_betw (\<lambda>d. n div d) {d. d dvd n \<and> d > sqrt n} {d. d dvd n \<and> d < sqrt n}"
     using n by (intro bij_betwI[of _ _ _ "\<lambda>d. n div d"])
                (auto simp: Real.real_of_nat_div real_sqrt_divide field_simps * ***)
   hence "card {d. d dvd n \<and> d > sqrt n} = card {d. d dvd n \<and> d < sqrt n}"
     by (rule bij_betw_same_card)
   also have "\<dots> \<le> card {d. d dvd n \<and> d \<le> sqrt n}"
     using n by (intro card_mono) auto
   finally show "divisor_count n \<le> 2 * \<dots>" by simp
 qed auto
 
 lemma divisor_count_upper_bound:
   fixes n :: nat
   shows "divisor_count n \<le> 2 * nat \<lfloor>sqrt n\<rfloor>"
 proof (cases "n = 0")
   case False
   have "divisor_count n \<le> 2 * card {d. d dvd n \<and> d \<le> sqrt n}"
     by (rule divisor_count_upper_bound_aux)
   also have "card {d. d dvd n \<and> d \<le> sqrt n} \<le> card {1..nat \<lfloor>sqrt n\<rfloor>}"
     using False by (intro card_mono) (auto simp: le_nat_iff le_floor_iff Suc_le_eq intro!: Nat.gr0I)
   also have "\<dots> = nat \<lfloor>sqrt n\<rfloor>" by simp
   finally show ?thesis by simp
 qed auto
 
 lemma divisor_count_upper_bound':
   fixes n :: nat
   shows "real (divisor_count n) \<le> 2 * sqrt n"
 proof -
   have "real (divisor_count n) \<le> 2 * real (nat \<lfloor>sqrt n\<rfloor>)"
     using divisor_count_upper_bound[of n] by linarith
   also have "\<dots> \<le> 2 * sqrt n"
     by simp
   finally show ?thesis .
 qed
 (* END TODO *)
 
 
 text \<open>
   We are now ready to prove the `regular' Pólya--Vinogradov inequality.
 
   Apostol formulates it in the following way (Theorem 13.15, notation adapted):
   `If \<open>\<chi>\<close> is any nonprincipal character mod \<open>n\<close>, then for all \<open>x \<ge> 2\<close> we have
   $\sum_{m\leq x} \chi(m) = O(\sqrt{n}\log n)$.'
 
   The precondition \<open>x \<ge> 2\<close> here is completely unnecessary. The `Big-O' notation is somewhat
   problematic since it does not make explicit in what way the variables are quantified
   (in particular the \<open>x\<close> and the \<open>\<chi>\<close>). The statement of the theorem in this way (for a fixed
   character \<open>\<chi>\<close>) seems to suggest that \<open>n\<close> is fixed here, which would make the use of `Big-O'
   completely vacuous, since it is an asymptotic statement about \<open>n\<close>.
 
   We therefore decided to formulate the inequality in the following more explicit way,
   even giving an explicit constant factor:
 \<close>
 theorem (in dcharacter) polya_vinogradov_inequality:
   assumes nonprincipal: "\<chi> \<noteq> principal_dchar n"
   shows   "norm (\<Sum>m=1..x. \<chi> m) < 2 * sqrt n * ln n"
 proof -
   have "n div conductor > 0"
     using n conductor_dvd dvd_div_eq_0_iff[of conductor n] by auto
   have "norm (\<Sum>m=1..x. \<chi> m) < sqrt conductor * ln conductor * divisor_count (n div conductor)"
     using nonprincipal by (rule polya_vinogradov_inequality_explicit)
   also have "\<dots> \<le> sqrt conductor * ln conductor * (2 * sqrt (n div conductor))"
     using conductor_gr_0 \<open>n div conductor > 0\<close>
     by (intro mult_left_mono divisor_count_upper_bound') (auto simp: Suc_le_eq)
   also have "sqrt (n div conductor) = sqrt n / sqrt conductor"
     using conductor_dvd by (simp add: Real.real_of_nat_div real_sqrt_divide)
   also have "sqrt conductor * ln conductor * (2 * (sqrt n / sqrt conductor)) =
                2 * sqrt n * ln conductor"
     using conductor_gr_0 n by (simp add: algebra_simps)
   also have "\<dots> \<le> 2 * sqrt n * ln n"
     using conductor_le_modulus conductor_gr_0 by (intro mult_left_mono) auto
   finally show ?thesis .
 qed
 
 unbundle vec_lambda_notation
 
 end
\ No newline at end of file
diff --git a/thys/GenClock/GenClock.thy b/thys/GenClock/GenClock.thy
--- a/thys/GenClock/GenClock.thy
+++ b/thys/GenClock/GenClock.thy
@@ -1,1357 +1,1357 @@
 (*  Title:       Formalization of Schneider's generalized clock synchronization protocol.
     Author:      Alwen Tiu, LORIA, June 11, 2005
     Maintainer:  Alwen Tiu <Alwen.Tiu at loria.fr>
 *)
 
 theory GenClock imports Complex_Main begin
 
 subsection\<open>Types and constants definitions\<close>
 
 text\<open>Process is represented by natural numbers. The type 'event' corresponds
 to synchronization rounds.\<close>
 
 type_synonym process = nat
 type_synonym event = nat      (* synchronization rounds *)
 type_synonym time = real
 type_synonym Clocktime = real
 
 axiomatization
   \<delta> :: real and
   \<mu> :: real and
   \<rho> :: real and
   rmin :: real and
   rmax :: real and
   \<beta> :: real and
   \<Lambda> :: real and
   (* Number of processes *)
   np :: process and
   maxfaults :: process and
   (* Physical clocks *)
   PC :: "[process, time] \<Rightarrow> Clocktime" and
   (* Virtual / Logical clocks *)
   VC :: "[process, time] \<Rightarrow> Clocktime" and
   (* Starting (real) time of synchronization rounds *)
   te :: "[process, event] \<Rightarrow> time" and
   (* Clock readings at each round *)
   \<theta> :: "[process, event] \<Rightarrow> (process \<Rightarrow> Clocktime)" and
   (* Logical clock in-effect at a time interval *)
   IC :: "[process, event, time] \<Rightarrow> Clocktime" and
   (* Correct clocks *)
   correct :: "[process, time] \<Rightarrow> bool" and
   (* The averaging function to calculate clock adjustment *)
   cfn :: "[process, (process \<Rightarrow> Clocktime)] \<Rightarrow> Clocktime" and
 
   \<pi> :: "[Clocktime, Clocktime] \<Rightarrow> Clocktime" and
 
   \<alpha> :: "Clocktime \<Rightarrow> Clocktime"
 
 definition
   count :: "[process \<Rightarrow> bool, process] \<Rightarrow> nat" where
   "count f n = card {p. p < n \<and> f p}"
 
 definition
   (* Adjustment to a clock *)
   Adj :: "[process, event] \<Rightarrow> Clocktime" where
   "Adj = (\<lambda> p i. if 0 < i then cfn p (\<theta> p i) - PC p (te p i)
-                 else 0)" 
+                 else 0)"
 
 definition
   (* Auxilary predicates used in the definition of precision enhancement *)
   okRead1 :: "[process \<Rightarrow> Clocktime, Clocktime, process \<Rightarrow> bool] \<Rightarrow> bool" where
   "okRead1 f x ppred \<longleftrightarrow> (\<forall> l m. ppred l \<and> ppred m \<longrightarrow> \<bar>f l - f m\<bar> \<le> x)"
 
 definition
-  okRead2 :: "[process \<Rightarrow> Clocktime, process \<Rightarrow> Clocktime, Clocktime, 
+  okRead2 :: "[process \<Rightarrow> Clocktime, process \<Rightarrow> Clocktime, Clocktime,
                process \<Rightarrow> bool] \<Rightarrow> bool" where
   "okRead2 f g x ppred \<longleftrightarrow> (\<forall> p. ppred p \<longrightarrow> \<bar>f p - g p\<bar> \<le> x)"
 
 definition
   rho_bound1 :: "[[process, time] \<Rightarrow> Clocktime] \<Rightarrow> bool" where
   "rho_bound1 C \<longleftrightarrow> (\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> C p t - C p s \<le> (t - s)*(1 + \<rho>))"
 definition
   rho_bound2 :: "[[process, time] \<Rightarrow> Clocktime] \<Rightarrow> bool" where
   "rho_bound2 C \<longleftrightarrow> (\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> (t - s)*(1 - \<rho>) \<le> C p t - C p s)"
 
 subsection\<open>Clock conditions\<close>
 
 text\<open>Some general assumptions\<close>
 axiomatization where
-  constants_ax: "0 < \<beta> \<and> 0 < \<mu> \<and> 0 < rmin 
+  constants_ax: "0 < \<beta> \<and> 0 < \<mu> \<and> 0 < rmin
   \<and> rmin \<le> rmax \<and> 0 < \<rho> \<and> 0 < np \<and> maxfaults \<le> np"
 
 axiomatization where
   PC_monotone: "\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> PC p s \<le> PC p t"
 
 axiomatization where
   VClock: "\<forall> p t i. correct p t \<and> te p i \<le> t \<and> t < te p (i + 1) \<longrightarrow> VC p t = IC p i t"
 
 axiomatization where
   IClock: "\<forall> p t i. correct p t \<longrightarrow> IC p i t = PC p t + Adj p i"
 
 text\<open>Condition 1: initial skew\<close>
 axiomatization where
   init: "\<forall> p. correct p 0 \<longrightarrow> 0 \<le> PC p 0 \<and> PC p 0 \<le> \<mu>"
 
 text\<open>Condition 2: bounded drift\<close>
 axiomatization where
   rate_1: "\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> PC p t - PC p s \<le> (t - s)*(1 + \<rho>)" and
   rate_2: "\<forall> p s t. correct p t \<and> s \<le> t \<longrightarrow> (t - s)*(1 - \<rho>) \<le> PC p t - PC p s"
 
 text\<open>Condition 3: bounded interval\<close>
 axiomatization where
   rts0: "\<forall> p t i. correct p t \<and> t \<le> te p (i+1) \<longrightarrow> t - te p i \<le> rmax" and
   rts1: "\<forall> p t i. correct p t \<and> te p (i+1) \<le> t \<longrightarrow> rmin \<le> t - te p i"
 
 text\<open>Condition 4 : bounded delay\<close>
 axiomatization where
   rts2a: "\<forall> p q t i. correct p t \<and> correct q t \<and> te q i + \<beta> \<le> t \<longrightarrow> te p i \<le> t"  and
   rts2b: "\<forall> p q i. correct p (te p i) \<and> correct q (te q i) \<longrightarrow> abs(te p i - te q i) \<le> \<beta>"
 
 text\<open>Condition 5: initial synchronization\<close>
 axiomatization where
   synch0: "\<forall> p. te p 0 = 0"
 
 text\<open>Condition 6: nonoverlap\<close>
 axiomatization where
   nonoverlap: "\<beta> \<le> rmin"
 
 text\<open>Condition 7: reading errors\<close>
 axiomatization where
-  readerror: "\<forall> p q i. correct p (te p (i+1)) \<and> correct q (te p (i+1)) \<longrightarrow> 
+  readerror: "\<forall> p q i. correct p (te p (i+1)) \<and> correct q (te p (i+1)) \<longrightarrow>
               abs(\<theta> p (i+1) q - IC q i (te p (i+1))) \<le> \<Lambda>"
 
 text\<open>Condition 8: bounded faults\<close>
 axiomatization where
   correct_closed: "\<forall> p s t. s \<le> t \<and> correct p t \<longrightarrow> correct p s" and
   correct_count:  "\<forall> t. np - maxfaults \<le> count (\<lambda> p. correct p t) np"
 
 text\<open>Condition 9: Translation invariance\<close>
 axiomatization where
   trans_inv: "\<forall> p f x. 0 \<le> x \<longrightarrow> cfn p (\<lambda> y. f y + x) = cfn p f + x"
 
 text\<open>Condition 10: precision enhancement\<close>
 axiomatization where
-  prec_enh: 
-  "\<forall> ppred p q f g x y. 
-          np - maxfaults \<le> count ppred np \<and> 
-          okRead1 f y ppred \<and> okRead1 g y ppred \<and> 
-          okRead2 f g x ppred \<and> ppred p \<and> ppred q 
+  prec_enh:
+  "\<forall> ppred p q f g x y.
+          np - maxfaults \<le> count ppred np \<and>
+          okRead1 f y ppred \<and> okRead1 g y ppred \<and>
+          okRead2 f g x ppred \<and> ppred p \<and> ppred q
       \<longrightarrow> abs(cfn p f - cfn q g) \<le> \<pi> x y"
 
 text\<open>Condition 11: accuracy preservation\<close>
 axiomatization where
   acc_prsv:
   "\<forall> ppred p q f x. okRead1 f x ppred \<and> np - maxfaults \<le> count ppred np
           \<and> ppred p \<and> ppred q \<longrightarrow> abs(cfn p f - f q) \<le> \<alpha> x"
 
 
 subsubsection\<open>Some derived properties of clocks\<close>
 
-lemma rts0d: 
+lemma rts0d:
 assumes cp: "correct p (te p (i+1))"
 shows "te p (i+1) - te p i \<le> rmax"
 using cp rts0 by simp
 
 lemma rts1d:
 assumes cp: "correct p (te p (i+1))"
 shows "rmin \<le> te p (i+1) - te p i"
 using cp rts1 by simp
 
-lemma rte: 
+lemma rte:
 assumes cp: "correct p (te p (i+1))"
 shows "te p i \<le> te p (i+1)"
 proof-
   from cp rts1d have "rmin \<le> te p (i+1) - te p i"
     by simp
   from this constants_ax show ?thesis by arith
 qed
 
 lemma beta_bound1:
 assumes corr_p: "correct p (te p (i+1))"
 and corr_q: "correct q (te p (i+1))"
 shows "0 \<le> te p (i+1) - te q i"
 proof-
   from corr_p rte have "te p i \<le> te p (i+1)"
     by simp
   from this corr_p correct_closed have corr_pi: "correct p (te p i)"
     by blast
   from corr_p rts1d nonoverlap have "rmin \<le> te p (i+1) - te p i"
     by simp
   from this nonoverlap have "\<beta> \<le> te p (i+1) - te p i" by simp
   hence "te p i + \<beta> \<le> te p (i+1)" by simp
 
-  from this corr_p corr_q rts2a 
+  from this corr_p corr_q rts2a
   have "te q i \<le> te p (i+1)"
     by blast
   thus ?thesis by simp
 qed
 
 lemma beta_bound2:
 assumes corr_p: "correct p (te p (i+1))"
 and corr_q: "correct q (te q i)"
 shows "te p (i+1) - te q i \<le> rmax + \<beta>"
 proof-
   from corr_p rte have "te p i \<le> te p (i+1)"
     by simp
   from this corr_p correct_closed have corr_pi: "correct p (te p i)"
     by blast
 
   have split: "te p (i+1) - te q i =
     (te p (i+1) - te p i) + (te p i - te q i)"
     by (simp)
 
   from corr_q corr_pi rts2b have Eq1: "abs(te p i - te q i) \<le> \<beta>"
     by simp
   have Eq2: "te p i - te q i \<le> \<beta>"
   proof cases
     assume "te q i \<le> te p i"
     from this Eq1 show ?thesis
       by (simp add: abs_if)
   next
     assume "\<not> (te q i \<le> te p i)"
     from this Eq1 show ?thesis
       by (simp add: abs_if)
   qed
 
   from corr_p rts0d have "te p (i+1) - te p i \<le> rmax"
     by simp
   from this split Eq2 show ?thesis by simp
 qed
 
 subsubsection\<open>Bounded-drift for logical clocks (IC)\<close>
 
-lemma bd: 
+lemma bd:
   assumes ie: "s \<le> t"
   and rb1: "rho_bound1 C"
   and rb2: "rho_bound2 D"
   and PC_ie: "D q t - D q s \<le> C p t - C p s"
   and corr_p: "correct p t"
   and corr_q: "correct q t"
   shows "\<bar> C p t - D q t \<bar>  \<le> \<bar> C p s - D q s \<bar> + 2*\<rho>*(t - s)"
 proof-
   let ?Dt = "C p t - D q t"
   let ?Ds = "C p s - D q s"
   let ?Bp = "C p t - C p s"
   let ?Bq = "D q t - D q s"
   let ?I = "t - s"
 
   have "\<bar> ?Bp - ?Bq \<bar> \<le> 2*\<rho>*(t - s)"
   proof-
     from PC_ie have Eq1: "\<bar> ?Bp - ?Bq \<bar> = ?Bp - ?Bq" by (simp add: abs_if)
     from corr_p ie rb1 have Eq2: "?Bp - ?Bq \<le> ?I*(1+\<rho>) - ?Bq" (is "?E1 \<le> ?E2")
       by(simp add: rho_bound1_def)
     from corr_q ie rb2 have "?I*(1 - \<rho>) \<le> ?Bq"
       by(simp add: rho_bound2_def)
     from this have Eq3: "?E2 \<le> ?I*(1+\<rho>) - ?I*(1 - \<rho>)"
       by(simp)
     have Eq4: "?I*(1+\<rho>) - ?I*(1 - \<rho>) = 2*\<rho>*?I"
       by(simp add: algebra_simps)
     from Eq1 Eq2 Eq3 Eq4 show ?thesis by simp
   qed
   moreover
   have "\<bar>?Dt\<bar>  \<le> \<bar>?Bp - ?Bq\<bar>  + \<bar>?Ds\<bar>"
     by(simp add: abs_if)
   ultimately show ?thesis by simp
 qed
 
-lemma bounded_drift: 
+lemma bounded_drift:
   assumes ie: "s \<le> t"
   and rb1: "rho_bound1 C"
   and rb2: "rho_bound2 C"
   and rb3: "rho_bound1 D"
   and rb4: "rho_bound2 D"
   and corr_p: "correct p t"
   and corr_q: "correct q t"
   shows "\<bar>C p t - D q t\<bar> \<le> \<bar>C p s - D q s\<bar>  + 2*\<rho>*(t - s)"
 proof-
   let ?Bp = "C p t - C p s"
   let ?Bq = "D q t - D q s"
 
   show ?thesis
   proof cases
     assume "?Bq \<le> ?Bp"
     from this ie rb1 rb4 corr_p corr_q bd show ?thesis by simp
   next
     assume "\<not> (?Bq \<le> ?Bp)"
     hence "?Bp \<le> ?Bq" by simp
-    from this ie rb2 rb3 corr_p corr_q bd 
+    from this ie rb2 rb3 corr_p corr_q bd
     have "\<bar>D q t - C p t\<bar>  \<le> \<bar>D q s - C p s\<bar> + 2*\<rho>*(t - s)"
       by simp
     from this show ?thesis by (simp add: abs_minus_commute)
   qed
 qed
 
 text\<open>Drift rate of logical clocks\<close>
 
 lemma IC_rate1:
 "rho_bound1 (\<lambda> p t. IC p i t)"
 proof-
   {
     fix p::process
     fix s::time
     fix t::time
     assume cp: "correct p t"
     assume ie: "s \<le> t"
     from cp ie correct_closed have cps: "correct p s"
       by blast
     have "IC p i t - IC p i s \<le> (t - s)*(1+\<rho>)"
     proof-
       from cp IClock have "IC p i t = PC p t + Adj p i"
         by simp
       moreover
       from cps IClock have "IC p i s = PC p s + Adj p i"
         by simp
       moreover
       from cp ie rate_1 have "PC p t - PC p s \<le> (t - s)*(1+\<rho>)"
         by simp
       ultimately show ?thesis by simp
     qed
   }
   thus ?thesis by (simp add: rho_bound1_def)
 qed
 
 lemma IC_rate2:
 "rho_bound2 (\<lambda> p t. IC p i t)"
 proof-
   {
     fix p::process
     fix s::time
     fix t::time
     assume cp: "correct p t"
     assume ie: "s \<le> t"
     from cp ie correct_closed have cps: "correct p s"
       by blast
     have "(t - s)*(1 - \<rho>) \<le> IC p i t - IC p i s"
     proof-
       from cp IClock have "IC p i t = PC p t + Adj p i"
         by simp
       moreover
       from cps IClock have "IC p i s = PC p s + Adj p i"
         by simp
       moreover
       from cp ie rate_2 have "(t - s)*(1-\<rho>) \<le> PC p t - PC p s"
         by simp
       ultimately show ?thesis by simp
     qed
   }
   thus ?thesis by (simp add: rho_bound2_def)
 qed
 
 text\<open>Auxilary function \<open>ICf\<close>: we introduce this to avoid some
 unification problem in some tactic of isabelle.\<close>
 
 definition
   ICf :: "nat \<Rightarrow> (process \<Rightarrow> time \<Rightarrow> Clocktime)" where
   "ICf i = (\<lambda> p t. IC p i t)"
 
-lemma IC_bd: 
+lemma IC_bd:
   assumes ie: "s \<le> t"
   and corr_p: "correct p t"
   and corr_q: "correct q t"
-  shows "\<bar>IC p i t - IC q j t\<bar> \<le> \<bar>IC p i s - IC q j s\<bar> + 2*\<rho>*(t - s)" 
+  shows "\<bar>IC p i t - IC q j t\<bar> \<le> \<bar>IC p i s - IC q j s\<bar> + 2*\<rho>*(t - s)"
 proof-
   let ?C = "ICf i"
   let ?D = "ICf j"
   let ?G = "\<bar>?C p t - ?D q t\<bar> \<le> \<bar>?C p s - ?D q s\<bar> + 2*\<rho>*(t - s)"
 
-  from IC_rate1 have rb1: "rho_bound1 (ICf i) \<and> rho_bound1 (ICf j)" 
+  from IC_rate1 have rb1: "rho_bound1 (ICf i) \<and> rho_bound1 (ICf j)"
     by (simp add: ICf_def)
 
-  from IC_rate2 have rb2: "rho_bound2 (ICf i) \<and> rho_bound2 (ICf j)" 
+  from IC_rate2 have rb2: "rho_bound2 (ICf i) \<and> rho_bound2 (ICf j)"
     by (simp add: ICf_def)
 
   from ie rb1 rb2 corr_p corr_q bounded_drift
   have ?G by simp
 
   from this show ?thesis by (simp add: ICf_def)
 qed
 
-lemma event_bound: 
+lemma event_bound:
 assumes ie1: "0 \<le> (t::real)"
 and corr_p: "correct p t"
 and corr_q: "correct q t"
 shows "\<exists> i. t < max (te p i) (te q i)"
 proof (rule ccontr)
   assume A: "\<not> (\<exists> i. t < max (te p i) (te q i))"
-  show False 
+  show False
   proof-
     have F1: "\<forall> i. te p i \<le> t"
-    proof 
+    proof
       fix i :: nat
       from A have "\<not> (t < max (te p i) (te q i))"
         by simp
       hence Eq1: "max (te p i) (te q i) \<le> t" by arith
       have Eq2: "te p i \<le> max (te p i) (te q i)"
         by (simp add: max_def)
       from Eq1 Eq2 show "te p i \<le> t" by simp
     qed
-    
+
     have F2: "\<forall> (i :: nat). correct p (te p i)"
     proof
       fix i :: nat
       from F1 have "te p i \<le> t" by simp
-      from this corr_p correct_closed 
+      from this corr_p correct_closed
       show "correct p (te p i)" by blast
     qed
-     
+
     have F3: "\<forall> (i :: nat). real i * rmin \<le> te p i"
     proof
       fix i :: nat
       show "real i * rmin \<le> te p i"
       proof (induct i)
         from synch0 show "real (0::nat) * rmin \<le> te p 0" by simp
       next
         fix i :: nat assume ind_hyp: "real i * rmin \<le> te p i"
-        
+
         show "real (Suc i) * rmin \<le> te p (Suc i)"
         proof-
 
-          have Eq1: "real i * rmin + rmin = (real i + 1)*rmin" 
-            by (simp add: distrib_right) 
+          have Eq1: "real i * rmin + rmin = (real i + 1)*rmin"
+            by (simp add: distrib_right)
           have Eq2: "real i + 1 = real (i+1)" by simp
-          from Eq1 Eq2 
+          from Eq1 Eq2
           have Eq3: "real i * rmin + rmin = real (i+1) * rmin"
             by presburger
 
           from F2 have cp1: "correct p (te p (i+1))"
             by simp
           from F2 have cp2: "correct p (te p i)"
             by simp
           from cp1 rts1d have "rmin \<le> te p (i+1) - te p i"
             by simp
           hence Eq4: "te p i + rmin \<le> te p (i+1)" by simp
           from ind_hyp have "real i * rmin + rmin \<le> te p i + rmin"
             by (simp)
           from this Eq4 have "real i * rmin + rmin \<le> te p (i+1)"
             by simp
           from this Eq3 show ?thesis by simp
         qed
       qed
     qed
-    
+
     have F4: "\<forall> (i::nat). real i * rmin \<le> t"
     proof
       fix i::nat
       from F1 have "te p i \<le> t" by simp
       moreover
       from F3 have "real i * rmin \<le> te p i" by simp
       ultimately show "real i * rmin \<le> t" by simp
     qed
 
     from constants_ax have "0 < rmin" by simp
 
-    from this reals_Archimedean3 
+    from this reals_Archimedean3
     have Archi: "\<exists> (k::nat). t < real k * rmin"
       by blast
-    
+
     from Archi obtain k::nat where C: "t < real k * rmin" ..
-    
-    from F4 have "real k * rmin \<le> t" by simp 
+
+    from F4 have "real k * rmin \<le> t" by simp
     hence notC: "\<not> (t < real k * rmin)" by simp
-    
+
     from C notC show False by simp
   qed
 qed
 
 subsection\<open>Agreement property\<close>
 
 definition "\<gamma>1 x = \<pi> (2*\<rho>*\<beta> + 2*\<Lambda>) (2*\<Lambda> + x + 2*\<rho>*(rmax + \<beta>))"
 definition "\<gamma>2 x = x + 2*\<rho>*rmax"
 definition "\<gamma>3 x = \<alpha> (2*\<Lambda> + x + 2*\<rho>*(rmax + \<beta>)) + \<Lambda> + 2*\<rho>*\<beta>"
 
 definition
   okmaxsync :: "[nat, Clocktime] \<Rightarrow> bool" where
   "okmaxsync i x \<longleftrightarrow> (\<forall> p q. correct p (max (te p i) (te q i))
-     \<and> correct q (max (te p i) (te q i)) \<longrightarrow> 
+     \<and> correct q (max (te p i) (te q i)) \<longrightarrow>
        \<bar>IC p i (max (te p i) (te q i)) - IC q i (max (te p i) (te q i))\<bar> \<le> x)"
 
 definition
   okClocks :: "[process, process, nat] \<Rightarrow> bool" where
   "okClocks p q i \<longleftrightarrow> (\<forall> t. 0 \<le> t \<and> t < max (te p i) (te q i)
-        \<and> correct p t \<and> correct q t 
+        \<and> correct p t \<and> correct q t
      \<longrightarrow> \<bar>VC p t - VC q t\<bar> \<le> \<delta>)"
 
 lemma okClocks_sym:
 assumes ok_pq: "okClocks p q i"
 shows "okClocks q p i"
 proof-
   {
     fix t :: time
     assume ie1: "0 \<le> t"
     assume ie2: "t < max (te q i) (te p i)"
     assume corr_q: "correct q t"
     assume corr_p: "correct p t"
 
     have "max (te q i) (te p i) = max (te p i) (te q i)"
       by (simp add: max_def)
-    from this ok_pq ie1 ie2 corr_p corr_q 
+    from this ok_pq ie1 ie2 corr_p corr_q
     have "\<bar>VC q t - VC p t\<bar> \<le> \<delta>"
       by(simp add: abs_minus_commute okClocks_def)
   }
   thus ?thesis by (simp add: okClocks_def)
 qed
 
-lemma ICp_Suc: 
+lemma ICp_Suc:
 assumes corr_p: "correct p (te p (i+1))"
 shows "IC p (i+1) (te p (i+1)) = cfn p (\<theta> p (i+1)) "
 using corr_p IClock by(simp add: Adj_def)
 
 lemma IC_trans_inv:
-assumes ie1: "te q (i+1) \<le> te p (i+1)" 
+assumes ie1: "te q (i+1) \<le> te p (i+1)"
 and corr_p: "correct p (te p (i+1))"
 and corr_q: "correct q (te p (i+1))"
-shows 
-"IC q (i+1) (te p (i+1)) =  
+shows
+"IC q (i+1) (te p (i+1)) =
   cfn q (\<lambda> n. \<theta> q (i+1) n + (PC q (te p (i+1)) - PC q (te q (i+1))))"
 (is "?T1 = ?T2")
 proof-
   let ?X = "PC q (te p (i+1)) - PC q (te q (i+1))"
 
 
   from corr_q ie1 PC_monotone have posX: "0 \<le> ?X"
     by (simp add: le_diff_eq)
   from IClock corr_q have "?T1 = cfn q (\<theta> q (i+1)) + ?X"
     by(simp add: Adj_def)
 
   from this posX trans_inv show ?thesis by simp
 qed
 
-lemma beta_rho: 
+lemma beta_rho:
 assumes ie: "te q (i+1) \<le> te p (i+1)"
 and corr_p: "correct p (te p (i+1))"
 and corr_q: "correct q (te p (i+1))"
 and corr_l: "correct l (te p (i+1))"
 shows "\<bar>(PC l (te p (i+1)) - PC l (te q (i+1))) - (te p (i+1) - te q (i+1))\<bar> \<le> \<beta>*\<rho>"
 proof-
   let ?X = "(PC l (te p (i+1)) - PC l (te q (i+1)))"
-  let ?D = "te p (i+1) - te q (i+1)" 
+  let ?D = "te p (i+1) - te q (i+1)"
 
   from ie have posD: "0 \<le> ?D" by simp
 
-  from ie PC_monotone corr_l have posX: "0 \<le> ?X" 
+  from ie PC_monotone corr_l have posX: "0 \<le> ?X"
     by (simp add: le_diff_eq)
   from ie corr_l rate_1 have bound1: "?X \<le> ?D * (1 + \<rho>)" by simp
   from ie corr_l correct_closed have corr_l_tq: "correct l (te q (i+1))"
     by(blast)
   from ie corr_q correct_closed have corr_q_tq: "correct q (te q (i+1))"
     by blast
   from corr_q_tq corr_p rts2b have "\<bar>?D\<bar> \<le> \<beta>"
     by(simp)
   from this constants_ax posD have D_beta: "?D*\<rho> \<le> \<beta>*\<rho>"
     by(simp add: abs_if)
 
-  show ?thesis 
+  show ?thesis
   proof cases
     assume A: "?D \<le> ?X"
     from posX posD A have absEq: "\<bar>?X - ?D\<bar> = ?X - ?D"
       by(simp add: abs_if)
-    from bound1 have bound2: "?X - ?D \<le> ?D*\<rho>" 
+    from bound1 have bound2: "?X - ?D \<le> ?D*\<rho>"
       by(simp add: mult.commute distrib_right)
     from D_beta absEq bound2 show ?thesis by simp
   next
     assume notA: "\<not> (?D \<le> ?X)"
     from this have absEq2: "\<bar>?X - ?D\<bar> = ?D - ?X"
       by(simp add: abs_if)
     from ie corr_l rate_2 have bound3: "?D*(1 - \<rho>) \<le> ?X" by simp
     from this have "?D - ?X \<le> ?D*\<rho>" by (simp add: algebra_simps)
     from this absEq2 D_beta show ?thesis by simp
   qed
 qed
 
-text\<open>This lemma (and the next one pe-cond2) proves an assumption used 
+text\<open>This lemma (and the next one pe-cond2) proves an assumption used
 in the precision enhancement.\<close>
 
-lemma pe_cond1: 
-assumes ie: "te q (i+1) \<le> te p (i+1)" 
+lemma pe_cond1:
+assumes ie: "te q (i+1) \<le> te p (i+1)"
 and corr_p: "correct p (te p (i+1))"
 and corr_q: "correct q (te p (i + 1))"
 and corr_l: "correct l (te p (i+1))"
-shows "\<bar>\<theta> q (i+1) l + (PC q (te p (i+1)) - PC q (te q (i+1))) - 
+shows "\<bar>\<theta> q (i+1) l + (PC q (te p (i+1)) - PC q (te q (i+1))) -
            \<theta> p (i+1) l\<bar> \<le> 2* \<rho> * \<beta> + 2*\<Lambda>"
 (is "?M \<le> ?N")
 proof-
   let ?Xl = "(PC l (te p (i+1)) - PC l (te q (i+1)))"
   let ?Xq = "(PC q (te p (i+1)) - PC q (te q (i+1)))"
-  let ?D = "te p (i+1) - te q (i+1)" 
+  let ?D = "te p (i+1) - te q (i+1)"
   let ?T = "\<theta> p (i+1) l - \<theta> q (i+1) l"
   let ?RE1 = "\<theta> p (i+1) l - IC l i (te p (i+1))"
   let ?RE2 = "\<theta> q (i+1) l - IC l i (te q (i+1))"
   let ?ICT = "IC l i (te p (i+1)) - IC l i (te q (i+1))"
 
   have "?M = \<bar>(?Xq - ?D) - (?T - ?D)\<bar>"
   by(simp add: abs_if)
 
   hence Split: "?M \<le> \<bar>?Xq - ?D\<bar> + \<bar>?T - ?D\<bar>"
     by(simp add: abs_if)
 
   from ie corr_q correct_closed have corr_q_tq: "correct q (te q (i+1))"
     by(blast)
   from ie corr_l correct_closed have corr_l_tq: "correct l (te q (i+1))"
     by blast
 
-  from corr_p corr_q corr_l ie beta_rho 
+  from corr_p corr_q corr_l ie beta_rho
   have XlD: "\<bar>?Xl - ?D\<bar> \<le> \<beta>*\<rho>"
     by simp
-  
-  from corr_p corr_q ie beta_rho 
+
+  from corr_p corr_q ie beta_rho
   have XqD: "\<bar>?Xq - ?D\<bar> \<le> \<beta>*\<rho>" by simp
 
-  have TD: "\<bar>?T - ?D\<bar> \<le> 2*\<Lambda> + \<beta>*\<rho>" 
+  have TD: "\<bar>?T - ?D\<bar> \<le> 2*\<Lambda> + \<beta>*\<rho>"
   proof-
     have Eq1: "\<bar>?T - ?D\<bar> = \<bar>(?T - ?ICT) + (?ICT - ?D)\<bar>" (is "?E1 = ?E2")
       by (simp add: abs_if)
-  
-    have Eq2: "?E2 \<le> \<bar>?T - ?ICT\<bar> + \<bar>?ICT - ?D\<bar>" 
+
+    have Eq2: "?E2 \<le> \<bar>?T - ?ICT\<bar> + \<bar>?ICT - ?D\<bar>"
       by(simp add: abs_if)
 
     have Eq3: "\<bar>?T - ?ICT\<bar> \<le>  \<bar>?RE1\<bar> + \<bar>?RE2\<bar>"
       by(simp add: abs_if)
 
-    from readerror corr_p corr_l 
+    from readerror corr_p corr_l
     have Eq4: "\<bar>?RE1\<bar> \<le> \<Lambda>" by simp
-     
 
-    from corr_l_tq corr_q_tq this readerror 
+
+    from corr_l_tq corr_q_tq this readerror
     have Eq5: "\<bar>?RE2\<bar> \<le> \<Lambda>" by simp
-    
+
     from Eq3 Eq4 Eq5 have Eq6: "\<bar>?T - ?ICT\<bar> \<le> 2*\<Lambda>"
       by simp
 
     have Eq7: "?ICT - ?D = ?Xl - ?D"
     proof-
       from corr_p rte have "te p i \<le> te p (i+1)"
         by(simp)
       from this corr_l correct_closed have corr_l_tpi: "correct l (te p i)"
         by blast
       from corr_q_tq rte have "te q i \<le> te q (i+1)"
         by simp
       from this corr_l_tq correct_closed have corr_l_tqi: "correct l (te q i)"
         by blast
 
       from IClock corr_l
       have F1: "IC l i (te p (i+1)) = PC l (te p (i+1)) + Adj l i"
         by(simp)
-      from IClock corr_l_tq 
+      from IClock corr_l_tq
       have F2: "IC l i (te q (i+1)) = PC l (te q (i+1)) + Adj l i"
         by simp
       from F1 F2 show ?thesis by(simp)
     qed
 
     from this XlD have Eq8: "\<bar>?ICT - ?D\<bar> \<le> \<beta>*\<rho>"
       by arith
-    from Eq1 Eq2 Eq6 Eq8 show ?thesis 
+    from Eq1 Eq2 Eq6 Eq8 show ?thesis
       by(simp)
   qed
 
   from Split XqD TD have F1: "?M \<le> 2* \<beta> * \<rho> + 2*\<Lambda>"
     by(simp)
-  have F2: "2 * \<rho> * \<beta> + 2*\<Lambda> = 2* \<beta> * \<rho> + 2*\<Lambda>" 
+  have F2: "2 * \<rho> * \<beta> + 2*\<Lambda> = 2* \<beta> * \<rho> + 2*\<Lambda>"
     by simp
   from F1 show ?thesis by (simp only: F2)
 
 qed
 
-lemma pe_cond2: 
+lemma pe_cond2:
 assumes ie: "te m i \<le> te l i"
 and corr_k: "correct k (te k (i+1))"
 and corr_l_tk: "correct l (te k (i+1))"
 and corr_m_tk: "correct m (te k (i+1))"
 and ind_hyp: "\<bar>IC l i (te l i) - IC m i (te l i)\<bar> \<le> \<delta>S"
 shows "\<bar>\<theta> k (i+1) l - \<theta> k (i+1) m\<bar> \<le> 2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
 proof-
   let ?X = "\<theta> k (i+1) l - \<theta> k (i+1) m"
   let ?N = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
   let ?D1 = "\<theta> k (i+1) l - IC l i (te k (i+1))"
   let ?D2 = "\<theta> k (i+1) m - IC m i (te k (i+1))"
   let ?ICS = "IC l i (te k (i+1)) - IC m i (te k (i+1))"
   let ?tlm = "te l i"
   let ?IC = "IC l i ?tlm - IC m i ?tlm"
 
-  have Eq1: "\<bar>?X\<bar> = \<bar>(?D1 - ?D2) + ?ICS\<bar>" (is "?E1 = ?E2") 
+  have Eq1: "\<bar>?X\<bar> = \<bar>(?D1 - ?D2) + ?ICS\<bar>" (is "?E1 = ?E2")
     by (simp add: abs_if)
 
   have Eq2: "?E2 \<le> \<bar>?D1 - ?D2\<bar> + \<bar>?ICS\<bar>" by (simp add: abs_if)
 
-  from corr_l_tk corr_k beta_bound1 have ie_lk: "te l i \<le> te k (i+1)" 
+  from corr_l_tk corr_k beta_bound1 have ie_lk: "te l i \<le> te k (i+1)"
     by (simp add: le_diff_eq)
-  
+
   from this corr_l_tk correct_closed have corr_l: "correct l (te l i)"
     by blast
 
   from ie_lk corr_l_tk corr_m_tk IC_bd
   have Eq3: "\<bar>?ICS\<bar> \<le> \<bar>?IC\<bar> + 2*\<rho>*(te k (i+1) - ?tlm)"
     by simp
   from this ind_hyp have Eq4: "\<bar>?ICS\<bar> \<le> \<delta>S + 2*\<rho>*(te k (i+1) - ?tlm)"
     by simp
 
   from corr_l corr_k beta_bound2 have "te k (i+1) - ?tlm \<le> rmax + \<beta>"
     by simp
   from this constants_ax have "2*\<rho>*(te k (i+1) - ?tlm) \<le> 2*\<rho>*(rmax + \<beta>)"
-    by (simp add: real_mult_le_cancel_iff2)
+    by simp
   from this Eq4 have Eq4a: "\<bar>?ICS\<bar> \<le> \<delta>S + 2*\<rho>*(rmax + \<beta>)"
-    by (simp)
+    by simp
 
-  from corr_k corr_l_tk readerror 
+  from corr_k corr_l_tk readerror
   have Eq5: "\<bar>?D1\<bar> \<le> \<Lambda>" by simp
-  from corr_k corr_m_tk readerror 
+  from corr_k corr_m_tk readerror
   have Eq6: "\<bar>?D2\<bar> \<le> \<Lambda>" by simp
   have "\<bar>?D1 - ?D2\<bar> \<le> \<bar>?D1\<bar> + \<bar>?D2\<bar>" by (simp add: abs_if)
   from this Eq5 Eq6 have Eq7: "\<bar>?D1 - ?D2\<bar> \<le> 2*\<Lambda>"
     by (simp)
 
   from Eq1 Eq2 Eq4a Eq7 split show ?thesis by (simp)
 qed
 
 lemma theta_bound:
 assumes corr_l: "correct l (te p (i+1))"
 and corr_m: "correct m (te p (i+1))"
 and corr_p: "correct p (te p (i+1))"
-and IC_bound: 
+and IC_bound:
     "\<bar>IC l i (max (te l i) (te m i)) - IC m i (max (te l i) (te m i))\<bar>
       \<le> \<delta>S"
 shows "\<bar>\<theta> p (i+1) l - \<theta> p (i+1) m\<bar>
        \<le>  2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
 proof-
   from corr_p corr_l beta_bound1 have tli_le_tp: "te l i \<le> te p (i+1)"
     by (simp add: le_diff_eq)
   from corr_p corr_m beta_bound1 have tmi_le_tp: "te m i \<le> te p (i+1)"
     by (simp add: le_diff_eq)
-  
+
   let ?tml = "max (te l i) (te m i)"
   from tli_le_tp tmi_le_tp have tml_le_tp: "?tml \<le> te p (i+1)"
     by simp
 
   from tml_le_tp corr_l correct_closed have corr_l_tml: "correct l ?tml"
     by blast
   from tml_le_tp corr_m correct_closed have corr_m_tml: "correct m ?tml"
     by blast
 
   let ?Y = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
   show "\<bar>\<theta> p (i+1) l - \<theta> p (i+1) m\<bar> \<le> ?Y"
   proof cases
     assume A: "te m i < te l i"
 
-    from this IC_bound 
+    from this IC_bound
     have "\<bar>IC l i (te l i) - IC m i (te l i)\<bar> \<le> \<delta>S"
       by(simp add: max_def)
-    from this A corr_p corr_l corr_m pe_cond2 
-    show ?thesis by(simp) 
+    from this A corr_p corr_l corr_m pe_cond2
+    show ?thesis by(simp)
   next
     assume "\<not> (te m i < te l i)"
     hence Eq1: "te l i \<le> te m i" by simp
-    from this IC_bound 
+    from this IC_bound
     have Eq2: "\<bar>IC l i (te m i) - IC m i (te m i)\<bar> \<le> \<delta>S"
       by(simp add: max_def)
 
     hence "\<bar>IC m i (te m i) - IC l i (te m i)\<bar> \<le> \<delta>S"
       by (simp add: abs_minus_commute)
-    from this Eq1 corr_p corr_l corr_m pe_cond2 
+    from this Eq1 corr_p corr_l corr_m pe_cond2
     have "\<bar>\<theta> p (i+1) m - \<theta> p (i+1) l\<bar> \<le> ?Y"
       by(simp)
     thus ?thesis by (simp add: abs_minus_commute)
   qed
 qed
 
-lemma four_one_ind_half: 
+lemma four_one_ind_half:
   assumes ie1: "\<beta> \<le> rmin"
   and ie2: "\<mu> \<le> \<delta>S"
   and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
   and ind_hyp: "okmaxsync i \<delta>S"
   and ie4: "te q (i+1) \<le> te p (i+1)"
   and corr_p: "correct p (te p (i+1))"
   and corr_q: "correct q (te p (i+1))"
 shows "\<bar>IC p (i+1) (te p (i+1)) - IC q (i+1) (te p (i+1))\<bar> \<le> \<delta>S"
 proof-
   let ?tpq = "te p (i+1)"
 
   let ?f = "\<lambda> n. \<theta> q (i+1) n + (PC q (te p (i+1)) - PC q (te q (i+1)))"
   let ?g = "\<theta> p (i+1)"
 
   from ie4 corr_q correct_closed have corr_q_tq: "correct q (te q (i+1))"
     by blast
-  
-  have Eq_IC_cfn: "\<bar>IC p (i+1) ?tpq - IC q (i+1) ?tpq\<bar> = 
+
+  have Eq_IC_cfn: "\<bar>IC p (i+1) ?tpq - IC q (i+1) ?tpq\<bar> =
     \<bar>cfn q ?f - cfn p ?g\<bar>"
   proof-
-    from corr_p ICp_Suc have Eq1: "IC p (i+1) ?tpq = cfn p ?g" by simp 
-    
-    from ie4 corr_p corr_q IC_trans_inv 
+    from corr_p ICp_Suc have Eq1: "IC p (i+1) ?tpq = cfn p ?g" by simp
+
+    from ie4 corr_p corr_q IC_trans_inv
     have Eq2: "IC q (i+1) ?tpq = cfn q ?f" by simp
-      
+
     from Eq1 Eq2 show ?thesis by(simp add: abs_if)
   qed
 
   let ?ppred = "\<lambda> l. correct l (te p (i+1))"
-    
+
   let ?X = "2*\<rho>*\<beta> + 2*\<Lambda>"
   have "\<forall> l. ?ppred l \<longrightarrow> \<bar>?f l - ?g l\<bar> \<le> ?X"
   proof -
     {
       fix l
       assume "?ppred l"
       from ie4 corr_p corr_q this pe_cond1
       have "\<bar>?f l - ?g l\<bar> \<le> (2*\<rho>*\<beta> + 2*\<Lambda>)"
         by(auto)
     }
     thus ?thesis by blast
   qed
-  hence cond1: "okRead2 ?f ?g ?X ?ppred" 
+  hence cond1: "okRead2 ?f ?g ?X ?ppred"
     by(simp add: okRead2_def)
-    
+
   let ?Y = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
 
   have "\<forall> l m. ?ppred l \<and> ?ppred m \<longrightarrow> \<bar>?f l - ?f m\<bar> \<le> ?Y"
   proof-
     {
       fix l m
       assume corr_l: "?ppred l"
       assume corr_m: "?ppred m"
 
       from corr_p corr_l beta_bound1 have tli_le_tp: "te l i \<le> te p (i+1)"
         by (simp add: le_diff_eq)
       from corr_p corr_m beta_bound1 have tmi_le_tp: "te m i \<le> te p (i+1)"
         by (simp add: le_diff_eq)
 
       let ?tlm = "max (te l i) (te m i)"
 
       from tli_le_tp tmi_le_tp have tlm_le_tp: "?tlm \<le> te p (i+1)"
         by simp
 
       from ie4 corr_l correct_closed have corr_l_tq: "correct l (te q (i+1))"
         by blast
       from ie4 corr_m correct_closed have corr_m_tq: "correct m (te q (i+1))"
         by blast
       from tlm_le_tp corr_l correct_closed have corr_l_tlm: "correct l ?tlm"
         by blast
       from tlm_le_tp corr_m correct_closed have corr_m_tlm: "correct m ?tlm"
         by blast
 
-      from ind_hyp corr_l_tlm corr_m_tlm 
+      from ind_hyp corr_l_tlm corr_m_tlm
       have EqAbs1: "\<bar>IC l i ?tlm - IC m i ?tlm\<bar> \<le> \<delta>S"
         by(auto simp add: okmaxsync_def)
 
       have EqAbs3: "\<bar>?f l - ?f m\<bar> = \<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar>"
         by (simp add: abs_if)
 
       from EqAbs1 corr_q_tq corr_l_tq corr_m_tq theta_bound
       have "\<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar> \<le> ?Y"
         by simp
       from this EqAbs3  have "\<bar>?f l - ?f m\<bar> \<le> ?Y"
         by simp
     }
     thus ?thesis by simp
   qed
-  hence cond2a: "okRead1 ?f ?Y ?ppred" by (simp add: okRead1_def) 
+  hence cond2a: "okRead1 ?f ?Y ?ppred" by (simp add: okRead1_def)
 
   have "\<forall> l m. ?ppred l \<and> ?ppred m \<longrightarrow> \<bar>?g l - ?g m\<bar> \<le> ?Y"
   proof-
     {
       fix l m
       assume corr_l: "?ppred l"
       assume corr_m: "?ppred m"
 
       from corr_p corr_l beta_bound1 have tli_le_tp: "te l i \<le> te p (i+1)"
         by (simp add: le_diff_eq)
       from corr_p corr_m beta_bound1 have tmi_le_tp: "te m i \<le> te p (i+1)"
         by (simp add: le_diff_eq)
 
       let ?tlm = "max (te l i) (te m i)"
       from tli_le_tp tmi_le_tp have tlm_le_tp: "?tlm \<le> te p (i+1)"
         by simp
 
       from tlm_le_tp corr_l correct_closed have corr_l_tlm: "correct l ?tlm"
         by blast
       from tlm_le_tp corr_m correct_closed have corr_m_tlm: "correct m ?tlm"
         by blast
 
-      from ind_hyp corr_l_tlm corr_m_tlm 
+      from ind_hyp corr_l_tlm corr_m_tlm
       have EqAbs1: "\<bar>IC l i ?tlm - IC m i ?tlm\<bar> \<le> \<delta>S"
         by(auto simp add: okmaxsync_def)
 
       from EqAbs1 corr_p corr_l corr_m theta_bound
       have "\<bar>?g l - ?g m\<bar> \<le> ?Y" by simp
     }
     thus ?thesis by simp
   qed
-  hence cond2b: "okRead1 ?g ?Y ?ppred" by (simp add: okRead1_def) 
+  hence cond2b: "okRead1 ?g ?Y ?ppred" by (simp add: okRead1_def)
 
   from correct_count have "np - maxfaults \<le> count ?ppred np"
     by simp
-  from this corr_p corr_q cond1 cond2a cond2b prec_enh 
-  have "\<bar>cfn q ?f - cfn p ?g\<bar> \<le> \<pi> ?X ?Y" 
+  from this corr_p corr_q cond1 cond2a cond2b prec_enh
+  have "\<bar>cfn q ?f - cfn p ?g\<bar> \<le> \<pi> ?X ?Y"
     by blast
 
   from ie3 this have "\<bar>cfn q ?f - cfn p ?g\<bar> \<le> \<delta>S"
     by (simp add: \<gamma>1_def)
 
   from this Eq_IC_cfn show ?thesis by (simp)
 qed
 
 text\<open>Theorem 4.1 in Shankar's paper.\<close>
 
-theorem four_one: 
+theorem four_one:
   assumes ie1: "\<beta> \<le> rmin"
   and ie2: "\<mu> \<le> \<delta>S"
   and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
 shows "okmaxsync i \<delta>S"
 proof(induct i)
   show "okmaxsync 0 \<delta>S"
   proof-
     {
-      fix p q 
+      fix p q
       assume corr_p: "correct p (max (te p 0) (te q 0))"
       assume corr_q: "correct q (max (te p 0) (te q 0))"
 
       from corr_p synch0 have cp0: "correct p 0" by simp
       from corr_q synch0 have cq0: "correct q 0" by simp
 
-      from synch0 cp0 cq0 IClock 
-      have IC_eq_PC: 
+      from synch0 cp0 cq0 IClock
+      have IC_eq_PC:
         "\<bar>IC p 0 (max (te p 0) (te q 0)) - IC q 0 (max (te p 0) (te q 0))\<bar>
          = \<bar>PC p 0 - PC q 0\<bar>" (is "?T1 = ?T2")
         by(simp add: Adj_def)
 
-      from ie2 init synch0 cp0 have range1: "0 \<le> PC p 0 \<and> PC p 0 \<le> \<delta>S"  
+      from ie2 init synch0 cp0 have range1: "0 \<le> PC p 0 \<and> PC p 0 \<le> \<delta>S"
         by auto
       from ie2 init synch0 cq0 have range2: "0 \<le> PC q 0 \<and> PC q 0 \<le> \<delta>S"
         by auto
       have "?T2 \<le> \<delta>S"
       proof cases
         assume A:"PC p 0 < PC q 0"
-        from A range1 range2 show ?thesis 
+        from A range1 range2 show ?thesis
           by(auto simp add: abs_if)
       next
         assume notA: "\<not> (PC p 0 < PC q 0)"
         from notA range1 range2 show ?thesis
           by(auto simp add: abs_if)
       qed
       from this IC_eq_PC have "?T1 \<le> \<delta>S" by simp
     }
     thus ?thesis by (simp add: okmaxsync_def)
   qed
 next
   fix i assume ind_hyp: "okmaxsync i \<delta>S"
   show "okmaxsync (Suc i) \<delta>S"
   proof-
     {
       fix p q
       assume corr_p: "correct p (max (te p (i + 1)) (te q (i + 1)))"
       assume corr_q: "correct q (max (te p (i + 1)) (te q (i + 1)))"
       let ?tp = "te p (i + 1)"
       let ?tq = "te q (i + 1)"
       let ?tpq = "max ?tp ?tq"
 
       have "\<bar>IC p (i+1) ?tpq - IC q (i+1) ?tpq\<bar> \<le> \<delta>S" (is "?E1 \<le> \<delta>S")
       proof cases
         assume A: "?tq < ?tp"
-        from A corr_p have cp1: "correct p (te p (i+1))" 
+        from A corr_p have cp1: "correct p (te p (i+1))"
           by (simp add: max_def)
-        from A corr_q have cq1: "correct q (te p (i+1))" 
+        from A corr_q have cq1: "correct q (te p (i+1))"
           by (simp add: max_def)
-        from A 
-        have Eq1: "?E1 = \<bar>IC p (i+1) (te p (i+1)) - IC q (i+1) (te p (i+1))\<bar>" 
+        from A
+        have Eq1: "?E1 = \<bar>IC p (i+1) (te p (i+1)) - IC q (i+1) (te p (i+1))\<bar>"
                   (is "?E1 = ?E2")
           by (simp add: max_def)
-        from A cp1 cq1 corr_p corr_q ind_hyp ie1 ie2 ie3 
-          four_one_ind_half 
+        from A cp1 cq1 corr_p corr_q ind_hyp ie1 ie2 ie3
+          four_one_ind_half
         have "?E2 \<le> \<delta>S" by (simp)
         from this Eq1 show ?thesis by simp
       next
         assume notA: "\<not> (?tq < ?tp)"
-        from this corr_p have cp2: "correct p (te q (i+1))" 
+        from this corr_p have cp2: "correct p (te q (i+1))"
           by (simp add: max_def)
         from notA corr_q have cq2: "correct q (te q (i+1))"
           by (simp add: max_def)
-        from notA 
-        have Eq2: "?E1 = \<bar>IC q (i+1) (te q (i+1)) - IC p (i+1) (te q (i+1))\<bar>" 
+        from notA
+        have Eq2: "?E1 = \<bar>IC q (i+1) (te q (i+1)) - IC p (i+1) (te q (i+1))\<bar>"
                   (is "?E1  = ?E3")
           by (simp add: max_def abs_minus_commute)
         from notA have "?tp \<le> ?tq" by simp
         from this cp2 cq2 ind_hyp ie1 ie2 ie3 four_one_ind_half
         have "?E3 \<le> \<delta>S"
           by simp
         from this Eq2 show ?thesis by (simp)
       qed
     }
     thus ?thesis by (simp add: okmaxsync_def)
   qed
 qed
 
-lemma VC_cfn: 
+lemma VC_cfn:
   assumes corr_p: "correct p (te p (i+1))"
   and ie: "te p (i+1) < te p (i+2)"
 shows "VC p (te p (i+1)) = cfn p (\<theta> p (i+1))"
 proof-
   from ie corr_p VClock have "VC p (te p (i+1)) = IC p (i+1) (te p (i+1))"
     by simp
   moreover
-  from corr_p IClock 
+  from corr_p IClock
   have "IC p (i+1) (te p (i+1)) = PC p (te p (i+1)) + Adj p (i+1)"
     by blast
   moreover
   have "PC p (te p (i+1)) + Adj p (i+1) = cfn p (\<theta> p (i+1))"
     by(simp add: Adj_def)
   ultimately show ?thesis by simp
 qed
 
 text\<open>Lemma for the inductive case in Theorem 4.2\<close>
 
 lemma four_two_ind:
   assumes ie1: "\<beta> \<le> rmin"
   and ie2: "\<mu> \<le> \<delta>S"
   and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
   and ie4: "\<gamma>2 \<delta>S \<le> \<delta>"
   and ie5: "\<gamma>3 \<delta>S \<le> \<delta>"
   and ie6: "te q (i+1) \<le> te p (i+1)"
   and ind_hyp: "okClocks p q i"
   and t_bound1: "0 \<le> t"
   and t_bound2: "t < max (te p (i+1)) (te q (i+1))"
   and t_bound3: "max (te p i) (te q i) \<le> t"
   and tpq_bound: "max (te p i) (te q i) < max (te p (i+1)) (te q (i+1))"
   and corr_p: "correct p t"
   and corr_q: "correct q t"
 shows "\<bar>VC p t - VC q t\<bar> \<le> \<delta>"
 proof cases
   assume A: "t < te q (i+1)"
-  
+
   let ?tpq = "max (te p i) (te q i)"
-  
-  have Eq1: "te p i \<le> t \<and> te q i \<le> t" 
+
+  have Eq1: "te p i \<le> t \<and> te q i \<le> t"
   proof cases
     assume "te p i \<le> te q i"
     from this  t_bound3 show ?thesis by (simp add: max_def)
   next
     assume "\<not> (te p i \<le> te q i)"
     from this t_bound3 show ?thesis by (simp add: max_def)
   qed
-  
+
   from ie6 have tp_max: "max (te p (i+1)) (te q (i+1)) = te p (i+1)"
     by(simp add: max_def)
   from this t_bound2 have Eq2: "t < te p (i+1)" by simp
 
   from VClock Eq1 Eq2 corr_p have Eq3: "VC p t = IC p i t" by simp
-    
+
   from VClock Eq1 A corr_q have Eq4: "VC q t = IC q i t" by simp
   from Eq3 Eq4 have Eq5: "\<bar>VC p t - VC q t\<bar> = \<bar>IC p i t - IC q i t\<bar>"
     by simp
 
   from t_bound3 corr_p corr_q correct_closed
   have corr_tpq: "correct p ?tpq \<and> correct q ?tpq"
     by(blast)
 
   from t_bound3 IC_bd corr_p corr_q
   have Eq6: "\<bar>IC p i t - IC q i t\<bar>  \<le> \<bar>IC p i ?tpq - IC q i ?tpq\<bar>
     + 2*\<rho>*(t - ?tpq)" (is "?E1 \<le> ?E2")
     by(blast)
-  
+
   from ie1 ie2 ie3 four_one have "okmaxsync i \<delta>S" by simp
 
   from this corr_tpq have "\<bar>IC p i ?tpq - IC q i ?tpq\<bar> \<le> \<delta>S"
     by(simp add: okmaxsync_def)
-  
+
   from Eq6 this  have Eq7: "?E1 \<le> \<delta>S + 2*\<rho>*(t - ?tpq)" by simp
 
   from corr_p Eq2 rts0 have "t - te p i \<le> rmax" by simp
   from this have "t - ?tpq \<le> rmax" by (simp add: max_def)
-  from this constants_ax have "2*\<rho>*(t - ?tpq) \<le> 2*\<rho>*rmax" 
-    by (simp add: real_mult_le_cancel_iff1) 
+  from this constants_ax have "2*\<rho>*(t - ?tpq) \<le> 2*\<rho>*rmax"
+    by simp
   hence "\<delta>S + 2*\<rho>*(t - ?tpq) \<le> \<delta>S + 2*\<rho>*rmax"
     by simp
   from this Eq7 have "?E1 \<le> \<delta>S + 2*\<rho>*rmax" by simp
   from this Eq5 ie4 show ?thesis by(simp add: \<gamma>2_def)
 next
   assume "\<not> (t < te q (i+1))"
   hence  B: "te q (i+1) \<le> t" by simp
 
-  from ie6 t_bound2 
+  from ie6 t_bound2
   have tp_max: "max (te p (i+1)) (te q (i+1)) = te p (i+1)"
     by(simp add: max_def)
 
   have "te p i \<le> max (te p i) (te q i)"
     by(simp add: max_def)
 
   from this t_bound3 have tp_bound1: "te p i \<le> t" by simp
 
   from tp_max t_bound2 have tp_bound2: "t < te p (i+1)" by simp
 
   have tq_bound1: "t < te q (i+2)"
   proof (rule ccontr)
     assume "\<not> (t < te q (i+2))"
     hence C: "te q (i+2) \<le> t" by simp
 
-    from C corr_q correct_closed 
+    from C corr_q correct_closed
     have corr_q_t2: "correct q (te q (i+2))" by blast
 
     have "te q (i+1) + \<beta> \<le> t"
     proof-
       from corr_q_t2 rts1d have "rmin \<le> te q (i+2) - te q (i+1)"
         by simp
       from this ie1 have "\<beta> \<le> te q (i+2) - te q (i+1)"
         by simp
       hence "te q (i+1) + \<beta> \<le> te q (i+2)" by simp
       from this C show ?thesis by simp
     qed
     from this corr_p corr_q rts2a have "te p (i+1) \<le> t"
       by blast
     hence "\<not> (t < te p (i+1))" by simp
     from this tp_bound2 show False by simp
   qed
 
   from tq_bound1 B have tq_bound2: "te q (i+1) < te q (i+2)" by simp
   from B tp_bound2 have tq_bound3: "te q (i+1) < te p (i+1)"
     by simp
-  from B corr_p correct_closed 
+  from B corr_p correct_closed
   have corr_p_tq1: "correct p (te q (i+1))" by blast
 
-  from B correct_closed corr_q 
+  from B correct_closed corr_q
   have corr_q_tq1: "correct q (te q (i+1))" by blast
 
-  from corr_p_tq1 corr_q_tq1 beta_bound1 
-  have tq_bound4: "te p i \<le> te q (i+1)" 
+  from corr_p_tq1 corr_q_tq1 beta_bound1
+  have tq_bound4: "te p i \<le> te q (i+1)"
     by(simp add: le_diff_eq)
 
-  from tq_bound1 VClock B corr_q 
+  from tq_bound1 VClock B corr_q
   have Eq1: "VC q t = IC q (i+1) t" by simp
-  
+
   from VClock tp_bound1 tp_bound2 corr_p
   have Eq2: "VC p t = IC p i t" by simp
-  
+
   from Eq1 Eq2 have Eq3: "\<bar>VC p t - VC q t\<bar> = \<bar>IC p i t - IC q (i+1) t\<bar>"
     by simp
-  
-  from B corr_p corr_q IC_bd 
-  have "\<bar>IC p i t - IC q (i+1) t\<bar> \<le> 
-     \<bar>IC p i (te q (i+1)) - IC q (i+1) (te q (i+1))\<bar> + 2*\<rho>*(t - te q (i+1))" 
+
+  from B corr_p corr_q IC_bd
+  have "\<bar>IC p i t - IC q (i+1) t\<bar> \<le>
+     \<bar>IC p i (te q (i+1)) - IC q (i+1) (te q (i+1))\<bar> + 2*\<rho>*(t - te q (i+1))"
     by simp
 
-  from this Eq3 
-  have VC_split: "\<bar>VC p t - VC q t\<bar> \<le> 
-    \<bar>IC p i (te q (i+1)) - IC q (i+1) (te q (i+1))\<bar> + 2*\<rho>*(t - te q (i+1))" 
+  from this Eq3
+  have VC_split: "\<bar>VC p t - VC q t\<bar> \<le>
+    \<bar>IC p i (te q (i+1)) - IC q (i+1) (te q (i+1))\<bar> + 2*\<rho>*(t - te q (i+1))"
     by simp
 
   from tq_bound2 VClock corr_q_tq1
   have Eq4: "VC q (te q (i+1)) = IC q (i+1) (te q (i+1))" by simp
 
-  from this tq_bound2 VC_cfn corr_q_tq1 
+  from this tq_bound2 VC_cfn corr_q_tq1
   have Eq5: "IC q (i+1) (te q (i+1)) = cfn q (\<theta> q (i+1))" by simp
-    
-  hence IC_eq_cfn: "IC p i (te q (i+1)) - IC q (i+1) (te q (i+1)) = 
+
+  hence IC_eq_cfn: "IC p i (te q (i+1)) - IC q (i+1) (te q (i+1)) =
     IC p i (te q (i+1)) - cfn q (\<theta> q (i+1))"
-    (is "?E1 = ?E2") 
+    (is "?E1 = ?E2")
     by simp
 
   let ?f = "\<theta> q (i+1)"
   let ?ppred = "\<lambda> l. correct l (te q (i+1))"
   let ?X = "2*\<Lambda> + \<delta>S + 2*\<rho>*(rmax + \<beta>)"
 
   have "\<forall> l m. ?ppred l \<and> ?ppred m \<longrightarrow> \<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar> \<le> ?X"
   proof-
     {
       fix l :: process
       fix m :: process
       assume corr_l: "?ppred l"
       assume corr_m: "?ppred m"
-      
+
       let ?tlm = "max (te l i) (te m i)"
       have tlm_bound: "?tlm \<le> te q (i+1)"
       proof-
         from corr_l corr_q_tq1 beta_bound1 have "te l i \<le> te q (i+1)"
           by (simp add: le_diff_eq)
         moreover
         from corr_m corr_q_tq1 beta_bound1 have "te m i \<le> te q (i+1)"
           by (simp add: le_diff_eq)
         ultimately show ?thesis by simp
       qed
-        
-      from tlm_bound corr_l corr_m correct_closed 
+
+      from tlm_bound corr_l corr_m correct_closed
       have corr_tlm: "correct l ?tlm \<and> correct m ?tlm"
         by blast
 
       have "\<bar>IC l i ?tlm - IC m i ?tlm\<bar> \<le> \<delta>S"
       proof-
         from ie1 ie2 ie3 four_one  have "okmaxsync i \<delta>S"
           by simp
         from this corr_tlm show ?thesis by(simp add: okmaxsync_def)
       qed
 
       from this corr_l corr_m corr_q_tq1 theta_bound
       have "\<bar>\<theta> q (i+1) l - \<theta> q (i+1) m\<bar> \<le> ?X" by simp
     }
     thus ?thesis by blast
   qed
   hence readOK: "okRead1 (\<theta> q (i+1)) ?X ?ppred"
     by(simp add: okRead1_def)
 
   let ?E3 = "cfn q (\<theta> q (i+1)) - \<theta> q (i+1) p"
   let ?E4 = "\<theta> q (i+1) p - IC p i (te q (i+1))"
 
   have "\<bar>?E2\<bar> = \<bar>?E3 + ?E4\<bar>" by (simp add: abs_if)
   hence Eq8: "\<bar>?E2\<bar> \<le> \<bar>?E3\<bar> + \<bar>?E4\<bar>" by (simp add: abs_if)
- 
+
   from correct_count have ppredOK: "np - maxfaults \<le> count ?ppred np"
     by simp
   from readOK ppredOK corr_p_tq1 corr_q_tq1 acc_prsv
   have "\<bar>?E3\<bar> \<le> \<alpha> ?X"
     by blast
   from this Eq8 have Eq9: "\<bar>?E2\<bar> \<le> \<alpha> ?X + \<bar>?E4\<bar>" by simp
 
   from corr_p_tq1 corr_q_tq1 readerror
   have "\<bar>?E4\<bar> \<le> \<Lambda>" by simp
-    
+
   from this Eq9 have Eq10: "\<bar>?E2\<bar> \<le> \<alpha> ?X + \<Lambda>" by simp
-  
-  from this VC_split IC_eq_cfn 
-  have almost_right: 
-    "\<bar>VC p t - VC q t\<bar> \<le> 
-     \<alpha> ?X + \<Lambda> + 2*\<rho>*(t - te q (i+1))" 
+
+  from this VC_split IC_eq_cfn
+  have almost_right:
+    "\<bar>VC p t - VC q t\<bar> \<le>
+     \<alpha> ?X + \<Lambda> + 2*\<rho>*(t - te q (i+1))"
     by simp
 
   have "t - te q (i+1) \<le> \<beta>"
   proof (rule ccontr)
     assume "\<not> (t - te q (i+1) \<le> \<beta>)"
     hence "te q (i+1) + \<beta> \<le> t" by simp
     from this corr_p corr_q rts2a have "te p (i+1) \<le> t"
       by auto
     hence "\<not> (t < te p (i+1))" by simp
     from this tp_bound2 show False
       by simp
   qed
 
-  from this constants_ax 
-  have "\<alpha> ?X + \<Lambda> + 2*\<rho>*(t - te q (i+1)) 
+  from this constants_ax
+  have "\<alpha> ?X + \<Lambda> + 2*\<rho>*(t - te q (i+1))
         \<le> \<alpha> ?X + \<Lambda> + 2*\<rho>*\<beta>"
     by (simp)
 
-  from this almost_right 
-  have "\<bar>VC p t - VC q t\<bar> \<le> \<alpha> ?X + \<Lambda> + 2*\<rho>*\<beta>" 
+  from this almost_right
+  have "\<bar>VC p t - VC q t\<bar> \<le> \<alpha> ?X + \<Lambda> + 2*\<rho>*\<beta>"
     by arith
 
   from this ie5 show ?thesis by (simp add: \<gamma>3_def)
 qed
 
 text\<open>Theorem 4.2 in Shankar's paper.\<close>
 
-theorem four_two: 
+theorem four_two:
   assumes ie1: "\<beta> \<le> rmin"
   and ie2: "\<mu> \<le> \<delta>S"
   and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
   and ie4: "\<gamma>2 \<delta>S \<le> \<delta>"
   and ie5: "\<gamma>3 \<delta>S \<le> \<delta>"
 shows "okClocks p q i"
 proof (induct i)
   show "okClocks p q 0"
   proof-
     {
       fix t :: time
       assume t_bound1: "0 \<le> t"
       assume t_bound2: "t < max (te p 0) (te q 0)"
       assume corr_p: "correct p t"
       assume corr_q: "correct q t"
       from t_bound2 synch0 have "t < 0"
         by(simp add: max_def)
       from this t_bound1 have False by simp
       hence "\<bar>VC p t - VC q t\<bar> \<le> \<delta>" by simp
     }
     thus ?thesis by (simp add: okClocks_def)
   qed
 next
   fix i::nat assume ind_hyp: "okClocks p q i"
   show "okClocks p q (Suc i)"
   proof -
     {
       fix t :: time
       assume t_bound1: "0 \<le> t"
       assume t_bound2: "t < max (te p (i+1)) (te q (i+1))"
       assume corr_p: "correct p t"
       assume corr_q: "correct q t"
-      
+
       let ?tpq1 = "max (te p i) (te q i)"
       let ?tpq2 = "max (te p (i+1)) (te q (i+1))"
 
       have "\<bar>VC p t - VC q t\<bar> \<le> \<delta>"
       proof cases
         assume tpq_bound: "?tpq1 < ?tpq2"
-        show ?thesis 
+        show ?thesis
         proof cases
           assume "t < ?tpq1"
           from t_bound1 this  corr_p corr_q ind_hyp
           show ?thesis by(simp add: okClocks_def)
         next
           assume "\<not> (t < ?tpq1)"
           hence tpq_le_t: "?tpq1 \<le> t" by arith
 
-          show ?thesis 
+          show ?thesis
           proof cases
             assume A: "te q (i+1) \<le> te p (i+1)"
 
-            from this tpq_le_t tpq_bound ie1 ie2 ie3 ie4 ie5 
-              ind_hyp t_bound1 t_bound2 
+            from this tpq_le_t tpq_bound ie1 ie2 ie3 ie4 ie5
+              ind_hyp t_bound1 t_bound2
               corr_p corr_q tpq_bound four_two_ind
             show ?thesis by(simp)
           next
             assume "\<not> (te q (i+1) \<le> te p (i+1))"
             hence B: "te p (i+1) \<le> te q (i+1)" by simp
-            
-            from ind_hyp okClocks_sym have ind_hyp1: "okClocks q p i" 
+
+            from ind_hyp okClocks_sym have ind_hyp1: "okClocks q p i"
               by blast
 
             have maxsym1: "max (te p (i+1)) (te q (i+1)) = max (te q (i+1)) (te p (i+1))"
               by (simp add: max_def)
-            have maxsym2: "max (te p i) (te q i) = max (te q i) (te p i)" 
+            have maxsym2: "max (te p i) (te q i) = max (te q i) (te p i)"
               by (simp add: max_def)
 
-            from maxsym1 t_bound2 
+            from maxsym1 t_bound2
             have t_bound21: "t < max (te q (i+1)) (te p (i+1))"
               by simp
-            
-            from maxsym1 maxsym2 tpq_bound 
+
+            from maxsym1 maxsym2 tpq_bound
             have tpq_bound1: "max (te q i) (te p i) < max (te q (i+1)) (te p (i+1))"
               by simp
-            from maxsym2 tpq_le_t 
+            from maxsym2 tpq_le_t
             have tpq_le_t1: "max (te q i) (te p i) \<le> t" by simp
 
-            from B tpq_le_t1 tpq_bound1 ie1 ie2 ie3 ie4 ie5 
-              ind_hyp1 t_bound1 t_bound21 
+            from B tpq_le_t1 tpq_bound1 ie1 ie2 ie3 ie4 ie5
+              ind_hyp1 t_bound1 t_bound21
               corr_p corr_q tpq_bound four_two_ind
             have "\<bar>VC q t - VC p t\<bar> \<le> \<delta>" by(simp)
             thus ?thesis by (simp add: abs_minus_commute)
           qed
 
         qed
       next
         assume "\<not> (?tpq1 < ?tpq2)"
         hence "?tpq2 \<le> ?tpq1" by arith
         from t_bound2 this have "t < ?tpq1" by arith
         from t_bound1 this corr_p corr_q ind_hyp
         show ?thesis by(simp add: okClocks_def)
       qed
     }
     thus ?thesis by (simp add: okClocks_def)
   qed
 qed
-    
+
 text\<open>The main theorem: all correct clocks are synchronized within the
 bound delta.\<close>
 
-theorem agreement: 
+theorem agreement:
   assumes ie1: "\<beta> \<le> rmin"
   and ie2: "\<mu> \<le> \<delta>S"
   and ie3: "\<gamma>1 \<delta>S \<le> \<delta>S"
   and ie4: "\<gamma>2 \<delta>S \<le> \<delta>"
   and ie5: "\<gamma>3 \<delta>S \<le> \<delta>"
   and ie6: "0 \<le> t"
   and cpq: "correct p t \<and> correct q t"
 shows "\<bar>VC p t - VC q t\<bar> \<le> \<delta>"
 proof-
   from ie6 cpq event_bound have "\<exists> i :: nat. t < max (te p i) (te q i)"
     by simp
   from this obtain i  :: nat where t_bound: "t < max (te p i) (te q i)" ..
-  
+
   from t_bound ie1 ie2 ie3 ie4 ie5 four_two have "okClocks p q i"
     by simp
 
-  from ie6 this t_bound cpq show ?thesis 
+  from ie6 this t_bound cpq show ?thesis
     by (simp add: okClocks_def)
 qed
 
 end
diff --git a/thys/Girth_Chromatic/Girth_Chromatic.thy b/thys/Girth_Chromatic/Girth_Chromatic.thy
--- a/thys/Girth_Chromatic/Girth_Chromatic.thy
+++ b/thys/Girth_Chromatic/Girth_Chromatic.thy
@@ -1,737 +1,737 @@
 theory Girth_Chromatic
 imports
   Ugraphs
   Girth_Chromatic_Misc
   "HOL-Probability.Probability"
   "HOL-Decision_Procs.Approximation"
 begin
 
 section \<open>Probability Space on Sets of Edges\<close>
 
 definition cylinder :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> 'a set set" where
   "cylinder S A B = {T \<in> Pow S. A \<subseteq> T \<and> B \<inter> T = {}}"
 
 lemma full_sum:
   fixes p :: real
   assumes "finite S"
   shows "(\<Sum>A\<in>Pow S. p^card A * (1 - p)^card (S - A)) = 1"
 using assms
 proof induct
   case (insert s S)
   have "inj_on (insert s) (Pow S)"
       and "\<And>x. S - insert s x = S - x"
       and "Pow S \<inter> insert s ` Pow S = {}"
       and "\<And>x. x \<in> Pow S \<Longrightarrow> card (insert s S - x) = Suc (card (S - x))"
     using insert(1-2) by (auto simp: insert_Diff_if intro!: inj_onI)
   moreover have "\<And>x. x \<subseteq> S \<Longrightarrow> card (insert s x) = Suc (card x)"
     using insert(1-2) by (subst card.insert) (auto dest: finite_subset)
   ultimately show ?case
     by (simp add: sum.reindex sum_distrib_left[symmetric] ac_simps
                   insert.hyps sum.union_disjoint Pow_insert)
 qed simp
 
 text \<open>Definition of the probability space on edges:\<close>
 locale edge_space =
   fixes n :: nat and p :: real
   assumes p_prob: "0 \<le> p" "p \<le> 1"
 begin
 
 definition S_verts :: "nat set" where
   "S_verts \<equiv> {1..n}"
 
 definition S_edges :: "uedge set" where
   "S_edges = all_edges S_verts"
 
 definition edge_ugraph :: "uedge set \<Rightarrow> ugraph" where
   "edge_ugraph es \<equiv> (S_verts, es \<inter> S_edges)"
 
 definition "P = point_measure (Pow S_edges) (\<lambda>s. p^card s * (1 - p)^card (S_edges - s))"
 
 lemma finite_verts[intro!]: "finite S_verts"
   by (auto simp: S_verts_def)
 
 lemma finite_edges[intro!]: "finite S_edges"
   by (auto simp: S_edges_def all_edges_def finite_verts)
 
 lemma finite_graph[intro!]: "finite (uverts (edge_ugraph es))"
   unfolding edge_ugraph_def by auto
 
 lemma uverts_edge_ugraph[simp]: "uverts (edge_ugraph es) = S_verts"
   by (simp add: edge_ugraph_def)
 
 lemma uedges_edge_ugraph[simp]: "uedges (edge_ugraph es) = es \<inter> S_edges"
   unfolding edge_ugraph_def by simp
 
 lemma space_eq: "space P = Pow S_edges" by (simp add: P_def space_point_measure)
 
 lemma sets_eq: "sets P = Pow (Pow S_edges)" by (simp add: P_def sets_point_measure)
 
 lemma emeasure_eq:
   "emeasure P A = (if A \<subseteq> Pow S_edges then (\<Sum>edges\<in>A. p^card edges * (1 - p)^card (S_edges - edges)) else 0)"
   using finite_edges p_prob
   by (simp add: P_def space_point_measure emeasure_point_measure_finite
     sets_point_measure emeasure_notin_sets)
 
 lemma integrable_P[intro, simp]: "integrable P (f::_ \<Rightarrow> real)"
   using finite_edges by (simp add: integrable_point_measure_finite P_def)
 
 lemma borel_measurable_P[measurable]: "f \<in> borel_measurable P"
   unfolding P_def by simp
 
 lemma prob_space_P: "prob_space P"
 proof
   show "emeasure P (space P) = 1" \<comment> \<open>Sum of probabilities equals 1\<close>
     using finite_edges by (simp add: emeasure_eq full_sum one_ereal_def space_eq)
 qed
 
 end
 
 sublocale edge_space \<subseteq> prob_space P
   by (rule prob_space_P)
 
 context edge_space
 begin
 
 lemma prob_eq:
   "prob A = (if A \<subseteq> Pow S_edges then (\<Sum>edges\<in>A. p^card edges * (1 - p)^card (S_edges - edges)) else 0)"
   using emeasure_eq[of A] p_prob unfolding emeasure_eq_measure by (simp add: sum_nonneg)
 
 lemma integral_finite_singleton: "integral\<^sup>L P f = (\<Sum>x\<in>Pow S_edges. f x * measure P {x})"
   using p_prob prob_eq unfolding P_def
   by (subst lebesgue_integral_point_measure_finite) (auto intro!: sum.cong)
 
 text \<open>Probability of cylinder sets:\<close>
 lemma cylinder_prob:
   assumes "A \<subseteq> S_edges" "B \<subseteq> S_edges" "A \<inter> B = {}"
   shows "prob (cylinder S_edges A B) = p ^ (card A) * (1 - p) ^ (card B)" (is "_ = ?pp A B")
 proof -
   have "Pow S_edges \<inter> cylinder S_edges A B = cylinder S_edges A B"
        "\<And>x. x \<in> cylinder S_edges A B \<Longrightarrow> A \<union> x = x"
        "\<And>x. x \<in> cylinder S_edges A B \<Longrightarrow> finite x"
        "\<And>x. x \<in> cylinder S_edges A B \<Longrightarrow> B \<inter> (S_edges - B - x) = {}"
        "\<And>x. x \<in> cylinder S_edges A B \<Longrightarrow> B \<union> (S_edges - B - x) = S_edges - x"
        "finite A" "finite B"
     using assms by (auto simp add: cylinder_def intro: finite_subset)
   then have "(\<Sum>T\<in>cylinder S_edges A B. ?pp T (S_edges - T))
       = (\<Sum>T \<in> cylinder S_edges A B. p^(card A + card (T - A)) * (1 - p)^(card B + card ((S_edges - B) - T)))"
     using finite_edges by (simp add: card_Un_Int)
   also have "\<dots> = ?pp A B * (\<Sum>T\<in>cylinder S_edges A B. ?pp (T - A) (S_edges - B - T))"
     by (simp add: power_add sum_distrib_left ac_simps)
   also have "\<dots> = ?pp A B"
   proof -
     have "\<And>T. T \<in> cylinder S_edges A B \<Longrightarrow> S_edges - B - T = (S_edges - A) - B - (T - A)"
          "Pow (S_edges - A - B) = (\<lambda>x. x - A) ` cylinder S_edges A B"
          "inj_on (\<lambda>x. x - A) (cylinder S_edges A B)"
          "finite (S_edges - A - B)"
       using assms by (auto simp: cylinder_def intro!: inj_onI)
     with full_sum[of "S_edges - A - B"] show ?thesis by (simp add: sum.reindex)
   qed
   finally show ?thesis by (auto simp add: prob_eq cylinder_def)
 qed
 
 lemma Markov_inequality:
   fixes a :: real and X :: "uedge set \<Rightarrow> real"
   assumes "0 < c" "\<And>x. 0 \<le> f x"
   shows "prob {x \<in> space P. c \<le> f x} \<le> (\<integral>x. f x \<partial> P) / c"
 proof -
   from assms have "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>P) = (\<integral>x. f x \<partial>P)"
     by (intro nn_integral_eq_integral) auto
   with assms show ?thesis
     using nn_integral_Markov_inequality[of f P "space P" "1 / c"]
     by (simp cong: nn_integral_cong add: emeasure_eq_measure ennreal_mult[symmetric])
 qed
 
 end
 
 subsection \<open>Graph Probabilities outside of @{term Edge_Space} locale\<close>
 
 text \<open>
  These abbreviations allow a compact expression of probabilities about random
  graphs outside of the @{term Edge_Space} locale. We also transfer a few of the lemmas
  we need from the locale into the toplevel theory.
 \<close>
 
 abbreviation MGn :: "(nat \<Rightarrow> real) \<Rightarrow> nat \<Rightarrow> (uedge set) measure" where
   "MGn p n \<equiv> (edge_space.P n (p n))"
 abbreviation probGn :: "(nat \<Rightarrow> real) \<Rightarrow> nat \<Rightarrow> (uedge set \<Rightarrow> bool) \<Rightarrow> real" where
   "probGn p n P \<equiv> measure (MGn p n) {es \<in> space (MGn p n). P es}"
 
 lemma probGn_le:
   assumes p_prob: "0 < p n" "p n < 1"
   assumes sub: "\<And>n es. es \<in> space (MGn p n) \<Longrightarrow> P n es \<Longrightarrow> Q n es"
   shows "probGn p n (P n) \<le> probGn p n (Q n)"
 proof -
   from p_prob interpret E: edge_space n "p n" by unfold_locales auto
   show ?thesis
     by (auto intro!: E.finite_measure_mono sub simp: E.space_eq E.sets_eq)
 qed
 
 section \<open>Short cycles\<close>
 
 definition short_cycles :: "ugraph \<Rightarrow> nat \<Rightarrow> uwalk set" where
   "short_cycles G k \<equiv> {p \<in> ucycles G. uwalk_length p \<le> k}"
 
 text \<open>obtains a vertex in a short cycle:\<close>
 definition choose_v :: "ugraph \<Rightarrow> nat \<Rightarrow> uvert" where
   "choose_v G k \<equiv> SOME u. \<exists>p. p \<in> short_cycles G k \<and> u \<in> set p"
 
 partial_function (tailrec) kill_short :: "ugraph \<Rightarrow> nat \<Rightarrow> ugraph" where
   "kill_short G k = (if short_cycles G k = {} then G else (kill_short (G -- (choose_v G k)) k))"
 
 lemma ksc_simps[simp]:
   "short_cycles G k = {} \<Longrightarrow> kill_short G k = G"
   "short_cycles G k \<noteq> {}  \<Longrightarrow> kill_short G k = kill_short (G -- (choose_v G k)) k"
   by (auto simp: kill_short.simps)
 
 lemma
   assumes "short_cycles G k \<noteq> {}"
   shows choose_v__in_uverts: "choose_v G k \<in> uverts G" (is ?t1)
     and choose_v__in_short: "\<exists>p. p \<in> short_cycles G k \<and> choose_v G k \<in> set p" (is ?t2)
 proof -
   from assms obtain p where "p \<in> ucycles G" "uwalk_length p \<le> k"
     unfolding short_cycles_def by auto
   moreover
   then obtain u where "u \<in> set p" unfolding ucycles_def
     by (cases p) (auto simp: uwalk_length_conv)
   ultimately have "\<exists>u p. p \<in> short_cycles G k \<and> u \<in> set p"
     by (auto simp: short_cycles_def)
   then show ?t2 by (auto simp: choose_v_def intro!: someI_ex)
   then show ?t1 by (auto simp: short_cycles_def ucycles_def uwalks_def)
 qed
 
 lemma kill_step_smaller:
   assumes "short_cycles G k \<noteq> {}"
   shows "short_cycles (G -- (choose_v G k)) k \<subset> short_cycles G k"
 proof -
   let ?cv = "choose_v G k"
   from assms obtain p where "p \<in> short_cycles G k" "?cv \<in> set p"
     by atomize_elim (rule choose_v__in_short)
 
   have "short_cycles (G -- ?cv) k \<subseteq> short_cycles G k"
   proof
     fix p assume "p \<in> short_cycles (G -- ?cv) k"
     then show "p \<in> short_cycles G k"
       unfolding short_cycles_def ucycles_def uwalks_def
       using edges_Gu[of G ?cv] by (auto simp: verts_Gu)
   qed
   moreover have "p \<notin> short_cycles (G -- ?cv) k"
     using \<open>?cv \<in> set p\<close> by (auto simp: short_cycles_def ucycles_def uwalks_def verts_Gu)
   ultimately show ?thesis using \<open>p \<in> short_cycles G k\<close> by auto
 qed
 
 text \<open>Induction rule for @{term kill_short}:\<close>
 lemma kill_short_induct[consumes 1, case_names empty kill_vert]:
   assumes fin: "finite (uverts G)"
   assumes a_empty: "\<And>G. short_cycles G k = {} \<Longrightarrow> P G k"
   assumes a_kill: "\<And>G. finite (short_cycles G k) \<Longrightarrow> short_cycles G k \<noteq> {}
     \<Longrightarrow> P (G -- (choose_v G k)) k \<Longrightarrow> P G k"
   shows "P G k"
 proof -
   have "finite (short_cycles G k)"
     using finite_ucycles[OF fin] by (auto simp: short_cycles_def)
   then show ?thesis
     by (induct "short_cycles G k" arbitrary: G rule: finite_psubset_induct)
       (metis kill_step_smaller a_kill a_empty)
 qed
 
 text \<open>Large Girth (after @{term kill_short}):\<close>
 lemma kill_short_large_girth:
   assumes "finite (uverts G)"
   shows "k < girth (kill_short G k)"
 using assms
 proof (induct G k rule: kill_short_induct)
   case (empty G)
   then have "\<And>p. p \<in> ucycles G \<Longrightarrow> k < enat (uwalk_length p)"
     by (auto simp: short_cycles_def)
   with empty show ?case by (auto simp: girth_def intro: enat_less_INF_I)
 qed simp
 
 text \<open>Order of graph (after @{term kill_short}):\<close>
 lemma kill_short_order_of_graph:
   assumes "finite (uverts G)"
   shows "card (uverts G) - card (short_cycles G k) \<le> card (uverts (kill_short G k))"
 using assms assms
 proof (induct G k rule: kill_short_induct)
   case (kill_vert G)
   let ?oG = "G -- (choose_v G k)"
 
   have "finite (uverts ?oG)"
     using kill_vert by (auto simp: remove_vertex_def)
   moreover
   have "uverts (kill_short G k) = uverts (kill_short ?oG k)"
     using kill_vert by simp
   moreover
   have "card (uverts G) = Suc (card (uverts ?oG))"
     using choose_v__in_uverts kill_vert
     by (simp add: remove_vertex_def card_Suc_Diff1 del: card_Diff_insert)
   moreover
   have "card (short_cycles ?oG k) < card (short_cycles G k)"
     by (intro psubset_card_mono kill_vert.hyps kill_step_smaller)
   ultimately show ?case using kill_vert.hyps by presburger
 qed simp
 
 text \<open>Independence number (after @{term kill_short}):\<close>
 lemma kill_short_\<alpha>:
   assumes "finite (uverts G)"
   shows "\<alpha> (kill_short G k) \<le> \<alpha> G"
 using assms
 proof (induct G k rule: kill_short_induct)
   case (kill_vert G)
   note kill_vert(3)
   also have "\<alpha> (G -- (choose_v G k)) \<le> \<alpha> G" by (rule \<alpha>_remove_le)
   finally show ?case using kill_vert by simp
 qed simp
 
 text \<open>Wellformedness (after @{term kill_short}):\<close>
 lemma kill_short_uwellformed:
   assumes "finite (uverts G)" "uwellformed G"
   shows "uwellformed (kill_short G k)"
 using assms
 proof (induct G k rule: kill_short_induct)
   case (kill_vert G)
   from kill_vert.prems have "uwellformed (G -- (choose_v G k))"
     by (auto simp: uwellformed_def remove_vertex_def)
   with kill_vert.hyps show ?case by simp
 qed simp
 
 
 section \<open>The Chromatic-Girth Theorem\<close>
 
 text \<open>Probability of Independent Edges:\<close>
 lemma (in edge_space) random_prob_independent:
   assumes "n \<ge> k" "k \<ge> 2"
   shows "prob {es \<in> space P. k \<le> \<alpha> (edge_ugraph es)}
     \<le> (n choose k)*(1-p)^(k choose 2)"
 proof -
   let "?k_sets" = "{vs. vs \<subseteq> S_verts \<and> card vs = k}"
 
   { fix vs assume A: "vs \<in> ?k_sets"
     then have B: "all_edges vs \<subseteq> S_edges"
       unfolding all_edges_def S_edges_def by blast
 
     have "{es \<in> space P. vs \<in> independent_sets (edge_ugraph es)}
         = cylinder S_edges {} (all_edges vs)" (is "?L = _")
       using A by (auto simp: independent_sets_def edge_ugraph_def space_eq cylinder_def)
     then have "prob ?L = (1-p)^(k choose 2)"
       using A B finite by (auto simp: cylinder_prob card_all_edges dest: finite_subset)
   }
   note prob_k_indep = this
     \<comment> \<open>probability that a fixed set of k vertices is independent in a random graph\<close>
 
   have "{es \<in> space P. k \<in> card ` independent_sets (edge_ugraph es)}
     = (\<Union>vs \<in> ?k_sets. {es \<in> space P. vs \<in> independent_sets (edge_ugraph es)})" (is "?L = ?R")
     unfolding image_def space_eq independent_sets_def by auto
   then have "prob ?L \<le> (\<Sum>vs \<in> ?k_sets. prob {es \<in> space P. vs \<in> independent_sets (edge_ugraph es)})"
     by (auto intro!: finite_measure_subadditive_finite simp: space_eq sets_eq)
   also have "\<dots> = (n choose k)*((1 - p) ^ (k choose 2))"
     by (simp add: prob_k_indep S_verts_def n_subsets)
   finally show ?thesis using \<open>k \<ge> 2\<close> by (simp add: le_\<alpha>_iff)
 qed
 
 text \<open>Almost never many independent edges:\<close>
 lemma almost_never_le_\<alpha>:
   fixes k :: nat
     and p :: "nat \<Rightarrow> real"
   assumes p_prob: "\<forall>\<^sup>\<infinity> n. 0 < p n \<and> p n < 1"
   assumes [arith]: "k > 0"
   assumes N_prop: "\<forall>\<^sup>\<infinity> n. (6 * k * ln n)/n \<le> p n"
   shows "(\<lambda>n. probGn p n (\<lambda>es. 1/2*n/k \<le> \<alpha> (edge_space.edge_ugraph n es))) \<longlonglongrightarrow> 0"
     (is "(\<lambda>n. ?prob_fun n) \<longlonglongrightarrow> 0")
 proof -
   let "?prob_fun_raw n" = "probGn p n (\<lambda>es. nat(ceiling (1/2*n/k)) \<le> \<alpha> (edge_space.edge_ugraph n es))"
 
   define r where "r n = 1 / 2 * n / k" for n :: nat
   let ?nr = "\<lambda>n. nat(ceiling (r n))"
 
   have r_pos: "\<And>n. 0 < n \<Longrightarrow> 0 < r n " by (auto simp: r_def field_simps)
 
   have nr_bounds: "\<forall>\<^sup>\<infinity> n. 2 \<le> ?nr n \<and> ?nr n \<le> n"
     by (intro eventually_sequentiallyI[of "4 * k"])
        (simp add: r_def nat_ceiling_le_eq le_natceiling_iff field_simps)
 
   from nr_bounds p_prob have ev_prob_fun_raw_le:
     "\<forall>\<^sup>\<infinity> n. probGn p n (\<lambda>es. ?nr n\<le> \<alpha> (edge_space.edge_ugraph n es))
       \<le> (n * exp (- p n * (real (?nr n) - 1) / 2)) powr ?nr n"
     (is "\<forall>\<^sup>\<infinity> n. ?prob_fun_raw_le n")
   proof (rule eventually_elim2)
     fix n :: nat assume A: "2 \<le> ?nr n \<and> ?nr n \<le> n" "0 < p n \<and>p n < 1"
     then interpret pG: edge_space n "p n" by unfold_locales auto
 
     have r: "real (?nr n - Suc 0) = real (?nr n) - Suc 0" using A by auto
 
     have [simp]: "n>0" using A by linarith
     have "probGn p n (\<lambda>es. ?nr n \<le> \<alpha> (edge_space.edge_ugraph n es))
         \<le> (n choose ?nr n) * (1 - p n)^(?nr n choose 2)"
       using A by (auto intro: pG.random_prob_independent)
     also have "\<dots> \<le> n powr ?nr n * (1 - p n) powr (?nr n choose 2)"
       using A  by (simp add: powr_realpow of_nat_power [symmetric] binomial_le_pow  del: of_nat_power)
     also have "\<dots> = n powr ?nr n * (1 - p n) powr (?nr n * (?nr n - 1) / 2)"
       by (cases "even (?nr n - 1)")
         (auto simp add: n_choose_2_nat real_of_nat_div)
     also have "\<dots> = n powr ?nr n * ((1 - p n) powr ((?nr n - 1) / 2)) powr ?nr n"
       by (auto simp add: powr_powr r ac_simps)
     also have "\<dots> \<le> (n * exp (- p n * (?nr n - 1) / 2)) powr ?nr n"
     proof -
       have "(1 - p n) powr ((?nr n - 1) / 2) \<le> exp (- p n) powr ((?nr n - 1) / 2)"
         using A by (auto simp: powr_mono2 diff_conv_add_uminus simp del: add_uminus_conv_diff)
       also have "\<dots> = exp (- p n * (?nr n - 1) / 2)" by (auto simp: powr_def)
       finally show ?thesis
         using A by (auto simp: powr_mono2 powr_mult)
     qed
     finally show "probGn p n (\<lambda>es. ?nr n \<le> \<alpha> (edge_space.edge_ugraph n es))
       \<le> (n * exp (- p n * (real (?nr n) - 1) / 2)) powr ?nr n"
       using A r by simp
   qed
 
   from p_prob N_prop
   have ev_expr_bound: "\<forall>\<^sup>\<infinity> n. n * exp (-p n * (real (?nr n) - 1) / 2) \<le> (exp 1 / n) powr (1 / 2)"
   proof (elim eventually_rev_mp, intro eventually_sequentiallyI conjI impI)
     fix n assume n_bound[arith]: "2 \<le> n"
       and p_bound: "0 < p n \<and> p n < 1" "(6 * k * ln n) / n \<le> p n"
     have r_bound: "r n \<le> ?nr n" by (rule real_nat_ceiling_ge)
 
     have "n * exp (-p n * (real (?nr n)- 1) / 2) \<le> n * exp (- 3 / 2 * ln n + p n / 2)"
     proof -
       have "0 < ln n" using "n_bound" by auto
       then have "(3 / 2) * ln n \<le> ((6 * k * ln n) / n) * (?nr n / 2)"
         using r_bound le_of_int_ceiling[of "n/2*k"]
         by (simp add: r_def field_simps del: le_of_int_ceiling)
       also have "\<dots> \<le> p n * (?nr n / 2)"
         using n_bound p_bound r_bound r_pos[of n] by (auto simp: field_simps)
       finally show ?thesis using r_bound by (auto simp: field_simps)
     qed
     also have "\<dots> \<le> n * n powr (- 3 / 2) * exp 1 powr (1 / 2)"
       using p_bound by (simp add: powr_def exp_add [symmetric])
     also have "\<dots> \<le> n powr (-1 / 2) * exp 1 powr (1 / 2)" by (simp add: powr_mult_base)
     also have "\<dots> = (exp 1 / n) powr (1/2)"
       by (simp add: powr_divide powr_minus_divide)
     finally show "n * exp (- p n * (real (?nr n) - 1) / 2) \<le> (exp 1 / n) powr (1 / 2)" .
   qed
 
   have ceil_bound: "\<And>G n. 1/2*n/k \<le> \<alpha> G \<longleftrightarrow> nat(ceiling (1/2*n/k)) \<le> \<alpha> G"
     by (case_tac "\<alpha> G") (auto simp: nat_ceiling_le_eq)
 
   show ?thesis
   proof (unfold ceil_bound, rule real_tendsto_sandwich)
     show "(\<lambda>n. 0) \<longlonglongrightarrow> 0"
         "(\<lambda>n. (exp 1 / n) powr (1 / 2)) \<longlonglongrightarrow> 0"
         "\<forall>\<^sup>\<infinity> n. 0 \<le> ?prob_fun_raw n"
       using p_prob by (auto intro: measure_nonneg LIMSEQ_inv_powr elim: eventually_mono)
   next
     from nr_bounds ev_expr_bound ev_prob_fun_raw_le
     show "\<forall>\<^sup>\<infinity> n. ?prob_fun_raw n \<le> (exp 1 / n) powr (1 / 2)"
     proof (elim eventually_rev_mp, intro eventually_sequentiallyI impI conjI)
       fix n assume A: "3 \<le> n"
         and nr_bounds: "2 \<le> ?nr n \<and> ?nr n \<le> n"
         and prob_fun_raw_le: "?prob_fun_raw_le n"
         and expr_bound: "n * exp (- p n * (real (nat(ceiling (r n))) - 1) / 2) \<le> (exp 1 / n) powr (1 / 2)"
 
       have "exp 1 < (3 :: real)" by (approximation 6)
       then have "(exp 1 / n) powr (1 / 2) \<le> 1 powr (1 / 2)"
         using A by (intro powr_mono2) (auto simp: field_simps)
       then have ep_bound: "(exp 1 / n) powr (1 / 2) \<le> 1" by simp
 
       have "?prob_fun_raw n \<le> (n * exp (- p n * (real (?nr n) - 1) / 2)) powr (?nr n)"
         using prob_fun_raw_le by (simp add: r_def)
       also have "\<dots> \<le> ((exp 1 / n) powr (1 / 2)) powr ?nr n"
         using expr_bound A by (auto simp: powr_mono2)
       also have "\<dots> \<le> ((exp 1 / n) powr (1 / 2))"
         using nr_bounds ep_bound A by (auto simp: powr_le_one_le)
       finally show "?prob_fun_raw n \<le> (exp 1 / n) powr (1 / 2)" .
     qed
   qed
 qed
 
 text \<open>Mean number of k-cycles in a graph. (Or rather of paths describing a circle of length @{term k}):\<close>
 lemma (in edge_space) mean_k_cycles:
   assumes "3 \<le> k" "k < n"
   shows "(\<integral>es. card {c \<in> ucycles (edge_ugraph es). uwalk_length c = k} \<partial> P)
     = of_nat (fact n div fact (n - k)) * p ^ k"
 proof -
   let ?k_cycle = "\<lambda>es c k. c \<in> ucycles (edge_ugraph es) \<and> uwalk_length c = k"
   define C where "C k = {c. ?k_cycle S_edges c k}" for k
     \<comment> \<open>@{term "C k"} is the set of all possible cycles of size @{term k} in @{term "edge_ugraph S_edges"}\<close>
   define XG  where "XG es = {c. ?k_cycle es c k}" for es
     \<comment> \<open>@{term "XG es"} is the set of cycles contained in a @{term "edge_ugraph es"}\<close>
   define XC where "XC c = {es \<in> space P. ?k_cycle es c k}" for c
     \<comment> \<open>"@{term "XC c"} is the set of graphs (edge sets) containing a cycle c"\<close>
   then have XC_in_sets: "\<And>c. XC c \<in> sets P"
       and XC_cyl: "\<And>c. c \<in> C k \<Longrightarrow> XC c = cylinder S_edges (set (uwalk_edges c)) {}"
     by (auto simp: ucycles_def space_eq uwalks_def C_def cylinder_def sets_eq)
 
   have "(\<integral>es. card {c \<in> ucycles (edge_ugraph es). uwalk_length c = k} \<partial> P)
       =  (\<Sum>x\<in>space P. card (XG x) * prob {x})"
     by (simp add: XG_def integral_finite_singleton space_eq)
   also have "\<dots> = (\<Sum>c\<in>C k. prob (cylinder S_edges (set (uwalk_edges c)) {}))"
   proof -
     have XG_Int_C: "\<And>s. s \<in> space P \<Longrightarrow> C k \<inter> XG s = XG s"
       unfolding XG_def C_def ucycles_def uwalks_def edge_ugraph_def by auto
     have fin_XC: "\<And>k. finite (XC k)" and fin_C: "finite (C k)"
       unfolding C_def XC_def by (auto simp: finite_edges space_eq intro!: finite_ucycles)
 
     have "(\<Sum>x\<in>space P. card (XG x) * prob {x}) = (\<Sum>x\<in>space P. (\<Sum>c \<in> XG x. prob {x}))"
       by simp
     also have "\<dots> = (\<Sum>x\<in>space P. (\<Sum>c \<in> C k. if c \<in> XG x then prob {x} else 0))"
       using fin_C by (simp add: sum.If_cases) (simp add: XG_Int_C)
     also have "\<dots> = (\<Sum>c \<in> C k. (\<Sum> x \<in> space P \<inter> XC c. prob {x}))"
       using finite_edges by (subst sum.swap) (simp add: sum.inter_restrict XG_def XC_def space_eq)
     also have "\<dots> = (\<Sum>c \<in> C k. prob (XC c))"
       using fin_XC XC_in_sets
       by (auto simp add: prob_eq sets_eq space_eq intro!: sum.cong)
     finally show ?thesis by (simp add: XC_cyl)
   qed
   also have "\<dots> = (\<Sum>c\<in>C k. p ^ k)"
   proof -
     have "\<And>x. x \<in> C k \<Longrightarrow> card (set (uwalk_edges x)) = uwalk_length x"
       by (auto simp: uwalk_length_def C_def ucycles_distinct_edges intro: distinct_card)
     then show ?thesis by (auto simp: C_def ucycles_def uwalks_def cylinder_prob)
   qed
   also have "\<dots> = of_nat (fact n div fact (n - k)) * p ^ k"
   proof -
     have inj_last_Cons: "\<And>A. inj_on (\<lambda>es. last es # es) A" by (rule inj_onI) simp
     { fix xs A assume "3 \<le> length xs - Suc 0" "hd xs = last xs"
       then have "xs \<in> (\<lambda>xs. last xs # xs) ` A \<longleftrightarrow> tl xs \<in> A"
         by (cases xs) (auto simp: inj_image_mem_iff[OF inj_last_Cons] split: if_split_asm) }
     note image_mem_iff_inst = this
 
     { fix xs have "xs \<in> uwalks (edge_ugraph S_edges) \<Longrightarrow> set (tl xs) \<subseteq> S_verts"
         unfolding uwalks_def by (induct xs) auto }
     moreover
     { fix xs assume "set xs \<subseteq> S_verts" "2 \<le> length xs" "distinct xs"
       then have "(last xs # xs) \<in> uwalks (edge_ugraph S_edges)"
       proof (induct xs rule: uwalk_edges.induct)
         case (3 x y ys)
         have S_edges_memI: "\<And>x y. x \<in> S_verts \<Longrightarrow> y \<in> S_verts \<Longrightarrow> x \<noteq> y \<Longrightarrow> {x, y} \<in> S_edges"
           unfolding S_edges_def all_edges_def image_def by auto
 
         have "ys \<noteq> [] \<Longrightarrow> set ys \<subseteq> S_verts \<Longrightarrow> last ys \<in> S_verts"  by auto
         with 3 show ?case
           by (auto simp add: uwalks_def Suc_le_eq intro: S_edges_memI)
       qed simp_all}
     moreover note \<open>3 \<le> k\<close>
     ultimately
     have "C k = (\<lambda>xs. last xs # xs) ` {xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> S_verts}"
       by (auto simp: C_def ucycles_def uwalk_length_conv image_mem_iff_inst)
     moreover have "card S_verts = n" by (simp add: S_verts_def)
     ultimately have "card (C k) = fact n div fact (n - k)"
       using \<open>k < n\<close>
       by (simp add: card_image[OF inj_last_Cons] card_lists_distinct_length_eq' fact_div_fact)
     then show ?thesis by simp
   qed
   finally show ?thesis by simp
 qed
 
 text \<open>Girth-Chromatic number theorem:\<close>
 theorem girth_chromatic:
   fixes l :: nat
   shows "\<exists>G. uwellformed G \<and> l < girth G \<and> l < chromatic_number G"
 proof -
   define k where "k = max 3 l"
   define \<epsilon> where "\<epsilon> = 1 / (2 * k)"
   define p where "p n = real n powr (\<epsilon> - 1)" for n :: nat
 
   let ?ug = edge_space.edge_ugraph
 
   define short_count where "short_count g = card (short_cycles g k)" for g
     \<comment> \<open>This random variable differs from the one used in the proof of theorem 11.2.2,
           as we count the number of paths describing a circle, not the circles themselves\<close>
 
   from k_def have "3 \<le> k" "l \<le> k" by auto
   from \<open>3 \<le> k\<close> have \<epsilon>_props: "0 < \<epsilon>" "\<epsilon> < 1 / k" "\<epsilon> < 1" by (auto simp: \<epsilon>_def field_simps)
 
   have ev_p: "\<forall>\<^sup>\<infinity> n. 0 < p n \<and> p n < 1"
   proof (rule eventually_sequentiallyI)
     fix n :: nat assume "2 \<le> n"
     with \<open>\<epsilon> < 1\<close> have "n powr (\<epsilon> - 1) < 1" by (auto intro!: powr_less_one)
     then show "0 < p n \<and> p n < 1" using \<open>2 \<le> n\<close>
       by (auto simp: p_def)
   qed
   then
   have prob_short_count_le: "\<forall>\<^sup>\<infinity> n. probGn p n (\<lambda>es. (real n/2) \<le> short_count (?ug n es))
       \<le> 2 * (k - 2) * n powr (\<epsilon> * k - 1)"  (is "\<forall>\<^sup>\<infinity> n. ?P n")
   proof (elim eventually_rev_mp, intro eventually_sequentiallyI impI)
     fix n :: nat assume A: "Suc k \<le> n" "0 < p n \<and> p n < 1"
     then interpret pG: edge_space n "p n" by unfold_locales auto
     have "1 \<le> n" using A by auto
 
     define mean_short_count where "mean_short_count = (\<integral>es. short_count (?ug n es) \<partial> pG.P)"
 
     have mean_short_count_le: "mean_short_count \<le> (k - 2) * n powr (\<epsilon> * k)"
     proof -
       have small_empty: "\<And>es k. k \<le> 2 \<Longrightarrow> short_cycles (edge_space.edge_ugraph n es) k = {}"
           by (auto simp add: short_cycles_def ucycles_def)
       have short_count_conv: "\<And>es. short_count (?ug n es) = (\<Sum>i=3..k. real (card {c \<in> ucycles (?ug n es). uwalk_length c = i}))"
       proof (unfold short_count_def, induct k)
         case 0 with small_empty show ?case by auto
       next
         case (Suc k)
         show ?case proof (cases "Suc k \<le> 2")
           case True with small_empty show ?thesis by auto
         next
           case False
           have "{c \<in> ucycles (?ug n es). uwalk_length c \<le> Suc k}
               = {c \<in> ucycles (?ug n es). uwalk_length c \<le> k} \<union> {c \<in> ucycles (?ug n es). uwalk_length c = Suc k}"
             by auto
           moreover
           have "finite (uverts (edge_space.edge_ugraph n es))" by auto
           ultimately
           have "card {c \<in> ucycles (?ug n es). uwalk_length c \<le> Suc k}
             = card {c \<in> ucycles (?ug n es). uwalk_length c \<le> k} + card {c \<in> ucycles (?ug n es). uwalk_length c = Suc k}"
             using finite_ucycles by (subst card_Un_disjoint[symmetric]) auto
           then show ?thesis
             using Suc False unfolding short_cycles_def by (auto simp: not_le)
         qed
       qed
 
       have "mean_short_count = (\<Sum>i=3..k. \<integral>es. card {c \<in> ucycles (?ug n es). uwalk_length c = i} \<partial> pG.P)"
         unfolding mean_short_count_def short_count_conv
         by (subst Bochner_Integration.integral_sum) (auto intro: pG.integral_finite_singleton)
       also have "\<dots> = (\<Sum>i\<in>{3..k}. of_nat (fact n div fact (n - i)) * p n ^ i)"
         using A by (simp add: pG.mean_k_cycles)
       also have "\<dots> \<le> (\<Sum> i\<in>{3..k}. n ^ i * p n ^ i)"
         apply (rule sum_mono)
-        by (meson A fact_div_fact_le_pow  Suc_leD atLeastAtMost_iff of_nat_le_iff order_trans real_mult_le_cancel_iff1 zero_less_power)
+        by (meson A fact_div_fact_le_pow  Suc_leD atLeastAtMost_iff of_nat_le_iff order_trans mult_le_cancel_iff1 zero_less_power)
       also have "... \<le> (\<Sum> i\<in>{3..k}. n powr (\<epsilon> * k))"
         using \<open>1 \<le> n\<close> \<open>0 < \<epsilon>\<close> A
         by (intro sum_mono) (auto simp: p_def field_simps powr_mult_base powr_powr
           powr_realpow[symmetric] powr_mult[symmetric] powr_add[symmetric])
       finally show ?thesis by simp
     qed
 
     have "pG.prob {es \<in> space pG.P. n/2 \<le> short_count (?ug n es)} \<le> mean_short_count / (n/2)"
       unfolding mean_short_count_def using \<open>1 \<le> n\<close>
       by (intro pG.Markov_inequality) (auto simp: short_count_def)
     also have "\<dots> \<le> 2 * (k - 2) * n powr (\<epsilon> * k - 1)"
     proof -
       have "mean_short_count / (n / 2) \<le> 2 * (k - 2) * (1 / n powr 1) * n powr (\<epsilon> * k)"
         using mean_short_count_le \<open>1 \<le> n\<close> by (simp add: field_simps)
       then show ?thesis by (simp add: powr_diff algebra_simps)
     qed
     finally show "?P n" .
   qed
 
   define pf_short_count pf_\<alpha>
     where "pf_short_count n = probGn p n (\<lambda>es. n/2 \<le> short_count (?ug n es))"
       and "pf_\<alpha> n = probGn p n (\<lambda>es. 1/2 * n/k \<le> \<alpha> (edge_space.edge_ugraph n es))"
     for n
 
   have ev_short_count_le: "\<forall>\<^sup>\<infinity> n. pf_short_count n < 1 / 2"
   proof -
     have "\<epsilon> * k - 1 < 0"
       using \<epsilon>_props \<open>3 \<le> k\<close> by (auto simp: field_simps)
     then have "(\<lambda>n. 2 * (k - 2) * n powr (\<epsilon> * k - 1)) \<longlonglongrightarrow> 0" (is "?bound \<longlonglongrightarrow> 0")
       by (intro tendsto_mult_right_zero LIMSEQ_neg_powr)
     then have "\<forall>\<^sup>\<infinity> n. dist (?bound n) 0  < 1 / 2"
       by (rule tendstoD) simp
     with prob_short_count_le show ?thesis
       by (rule eventually_elim2) (auto simp: dist_real_def pf_short_count_def)
   qed
 
   have lim_\<alpha>: "pf_\<alpha> \<longlonglongrightarrow> 0"
   proof -
     have "0 < k" using \<open>3 \<le> k\<close> by simp
 
     have "\<forall>\<^sup>\<infinity> n. (6*k) * ln n / n \<le> p n \<longleftrightarrow> (6*k) * ln n * n powr - \<epsilon> \<le> 1"
     proof (rule eventually_sequentiallyI)
      fix n :: nat assume "1 \<le> n"
       then have "(6 * k) * ln n / n \<le> p n \<longleftrightarrow> (6*k) * ln n * (n powr - 1) \<le> n powr (\<epsilon> - 1)"
         by  (subst powr_minus) (simp add: divide_inverse p_def)
       also have "\<dots> \<longleftrightarrow> (6*k) * ln n * ((n powr - 1) / (n powr (\<epsilon> - 1))) \<le> n powr (\<epsilon> - 1) / (n powr (\<epsilon> - 1))"
         using \<open>1 \<le> n\<close> by (auto simp: field_simps)
       also have "\<dots> \<longleftrightarrow> (6*k) * ln n * n powr - \<epsilon> \<le> 1"
         by (simp add: powr_diff [symmetric] )
       finally show "(6*k) * ln n / n \<le> p n \<longleftrightarrow> (6*k) * ln n * n powr - \<epsilon> \<le> 1" .
     qed
     then have "(\<forall>\<^sup>\<infinity> n. (6 * k) * ln n / real n \<le> p n)
         \<longleftrightarrow> (\<forall>\<^sup>\<infinity> n. (6*k) * ln n * n powr - \<epsilon> \<le> 1)"
       by (rule eventually_subst)
     also have "\<forall>\<^sup>\<infinity> n. (6*k) * ln n * n powr - \<epsilon> \<le> 1"
     proof -
       { fix n :: nat assume "0 < n"
         have "ln (real n) \<le> n powr (\<epsilon>/2) / (\<epsilon>/2)"
           using \<open>0 < n\<close> \<open>0 < \<epsilon>\<close> by (intro ln_powr_bound) auto
         also have "\<dots> \<le> 2/\<epsilon> * n powr (\<epsilon>/2)" by (auto simp: field_simps)
         finally have "(6*k) * ln n * (n powr - \<epsilon>)  \<le> (6*k) * (2/\<epsilon> * n powr (\<epsilon>/2)) * (n powr - \<epsilon>)"
           using \<open>0 < n\<close> \<open>0 < k\<close> by (intro mult_right_mono mult_left_mono) auto
         also have "\<dots> = 12*k/\<epsilon> * n powr (-\<epsilon>/2)"
           unfolding divide_inverse
           by (auto simp: field_simps powr_minus[symmetric] powr_add[symmetric])
         finally have "(6*k) * ln n * (n powr - \<epsilon>) \<le> 12*k/\<epsilon> * n powr (-\<epsilon>/2)" .
       }
       then have "\<forall>\<^sup>\<infinity> n. (6*k) * ln n * (n powr - \<epsilon>) \<le> 12*k/\<epsilon> * n powr (-\<epsilon>/2)"
         by (intro eventually_sequentiallyI[of 1]) auto
       also have "\<forall>\<^sup>\<infinity> n. 12*k/\<epsilon> * n powr (-\<epsilon>/2) \<le> 1"
       proof -
         have "(\<lambda>n. 12*k/\<epsilon> * n powr (-\<epsilon>/2)) \<longlonglongrightarrow> 0"
           using \<open>0 < \<epsilon>\<close> by (intro tendsto_mult_right_zero LIMSEQ_neg_powr) auto
         then show ?thesis
           using \<open>0 < \<epsilon>\<close> by - (drule tendstoD[where e=1], auto elim: eventually_mono)
       qed
       finally (eventually_le_le) show ?thesis .
     qed
     finally have "\<forall>\<^sup>\<infinity> n. real (6 * k) * ln (real n) / real n \<le> p n" .
     with ev_p \<open>0 < k\<close> show ?thesis unfolding pf_\<alpha>_def by (rule almost_never_le_\<alpha>)
   qed
 
   from ev_short_count_le lim_\<alpha>[THEN tendstoD, of "1/2"] ev_p
   have "\<forall>\<^sup>\<infinity> n. 0 < p n \<and> p n < 1 \<and> pf_short_count n < 1/2 \<and> pf_\<alpha> n < 1/2"
     by simp (elim eventually_rev_mp, auto simp: eventually_sequentially dist_real_def)
   then obtain n where "0 < p n" "p n < 1" and [arith]: "0 < n"
       and probs: "pf_short_count n < 1/2" "pf_\<alpha> n < 1/2"
     by (auto simp: eventually_sequentially)
   then interpret ES: edge_space n "(p n)" by unfold_locales auto
 
   have rest_compl: "\<And>A P. A - {x\<in>A. P x} = {x\<in>A. \<not>P x}" by blast
 
   from probs have "ES.prob ({es \<in> space ES.P. n/2 \<le> short_count (?ug n es)}
       \<union> {es \<in> space ES.P. 1/2 * n/k \<le> \<alpha> (?ug n es)}) \<le> pf_short_count n + pf_\<alpha> n"
     unfolding pf_short_count_def pf_\<alpha>_def  by (subst ES.finite_measure_subadditive) auto
   also have "\<dots> < 1" using probs by auto
   finally have "0 < ES.prob (space ES.P - ({es \<in> space ES.P. n/2 \<le> short_count (?ug n es)}
       \<union> {es \<in> space ES.P. 1/2 * n/k \<le> \<alpha> (?ug n es)}))" (is "0 < ES.prob ?S")
     by (subst ES.prob_compl) auto
   also have "?S = {es \<in> space ES.P. short_count (?ug n es) < n/2 \<and> \<alpha> (?ug n es) < 1/2* n/k}" (is "\<dots> = ?C")
     by (auto simp: not_less rest_compl)
   finally have "?C \<noteq> {}" by (intro notI) (simp only:, auto)
   then obtain es where es_props: "es \<in> space ES.P"
       "short_count (?ug n es) < n/2" "\<alpha> (?ug n es) < 1/2 * n/k"
     by auto
     \<comment> \<open>now we obtained a high colored graph (few independent nodes) with almost no short cycles\<close>
 
   define G where "G = ?ug n es"
   define H where "H = kill_short G k"
 
   have G_props: "uverts G = {1..n}" "finite (uverts G)" "short_count G < n/2" "\<alpha> G < 1/2 * n/k"
     unfolding G_def using es_props by (auto simp: ES.S_verts_def)
 
   have "uwellformed G" by (auto simp: G_def uwellformed_def all_edges_def ES.S_edges_def)
   with G_props have T1: "uwellformed H" unfolding H_def by (intro kill_short_uwellformed)
 
   have "enat l \<le> enat k" using \<open>l \<le> k\<close> by simp
   also have "\<dots> < girth H" using G_props by (auto simp: kill_short_large_girth H_def)
   finally have T2: "l < girth H" .
 
   have card_H: "n/2 \<le> card (uverts H)"
     using G_props es_props kill_short_order_of_graph[of G k] by (simp add: short_count_def H_def)
 
   then have uverts_H: "uverts H \<noteq> {}" "0 < card (uverts H)" by auto
   then have "0 < \<alpha> H" using zero_less_\<alpha> uverts_H by auto
 
   have \<alpha>_HG: "\<alpha> H \<le> \<alpha> G"
     unfolding H_def G_def by (auto intro: kill_short_\<alpha>)
 
   have "enat l \<le> ereal k" using \<open>l \<le> k\<close> by auto
   also have "\<dots> < (n/2) / \<alpha> G" using G_props \<open>3 \<le> k\<close>
     by (cases "\<alpha> G") (auto simp: field_simps)
   also have "\<dots> \<le> (n/2) / \<alpha> H" using \<alpha>_HG \<open>0 < \<alpha> H\<close>
     by (auto simp: ereal_of_enat_pushout intro!: ereal_divide_left_mono)
   also have "\<dots> \<le> card (uverts H) / \<alpha> H" using card_H \<open>0 < \<alpha> H\<close>
     by (auto intro!: ereal_divide_right_mono)
   also have "\<dots> \<le> chromatic_number H" using uverts_H T1 by (intro chromatic_lb) auto
   finally have T3: "l < chromatic_number H"
     by (simp del: ereal_of_enat_simps)
 
   from T1 T2 T3 show ?thesis by fast
 qed
 
 end
diff --git a/thys/Green/CircExample.thy b/thys/Green/CircExample.thy
--- a/thys/Green/CircExample.thy
+++ b/thys/Green/CircExample.thy
@@ -1,794 +1,794 @@
 section \<open>The Circle Example\<close>
 
 theory CircExample
   imports Green SymmetricR2Shapes
 
 begin
 
 locale circle = R2 +
   fixes d::real
   assumes d_gt_0: "0 < d"
 begin
 
 definition circle_y where
   "circle_y t = sqrt (1/4 - t * t)"
 
 definition circle_cube where
   "circle_cube = (\<lambda>(x,y). ((x - 1/2) * d, (2 * y - 1) * d * sqrt (1/4 - (x -1/2)*(x -1/2))))"
 
 lemma circle_cube_nice:
   shows "circle_cube = (\<lambda>(x,y). (d * x_coord x, (2 * y - 1) * d * circle_y (x_coord x)))"
   by (auto simp add: circle_cube_def circle_y_def x_coord_def)
 
 definition rot_circle_cube where
   "rot_circle_cube = prod.swap \<circ> (circle_cube) \<circ> prod.swap"
 
 abbreviation "rot_y t1 t2 \<equiv> ((t1-1/2)/(2* circle_y (x_coord (rot_x t1 t2))) +1/2::real)"
 
 definition "x_coord_inv (x::real) = (1/2) + x"
 
 lemma x_coord_inv_1: "x_coord_inv (x_coord (x::real)) = x" 
   by (auto simp add: x_coord_inv_def x_coord_def)
 
 lemma x_coord_inv_2: "x_coord (x_coord_inv (x::real)) = x" 
   by (auto simp add: x_coord_inv_def x_coord_def)
 
 definition "circle_y_inv = circle_y"
 
 abbreviation "rot_x'' (x::real) (y::real) \<equiv> (x_coord_inv ((2 * y - 1) * circle_y (x_coord x)))"
 
 lemma circle_y_bounds:
   assumes "-1/2 \<le> (x::real) \<and> x \<le> 1/2"
   shows "0 \<le> circle_y x" "circle_y x \<le> 1/2"
   unfolding circle_y_def real_sqrt_ge_0_iff
 proof -
   show "0 \<le> 1/4 - x * x"
     using assms by (sos "(((A<0 * R<1) + ((A<=0 * (A<=1 * R<1)) * (R<1 * [1]^2))))")
   show "sqrt (1/4 - x * x) \<le> 1/2"
     apply (rule real_le_lsqrt)
     using assms apply(auto simp add: divide_simps algebra_simps)
     by (sos "(((A<0 * R<1) + ((A<=0 * (A<=1 * R<1)) * (R<1 * [1]^2))))")
 qed
 
 lemma circle_y_x_coord_bounds:
   assumes "0 \<le> (x::real)" "x \<le> 1"
   shows "0 \<le> circle_y (x_coord x) \<and> circle_y (x_coord x) \<le> 1/2"
   using circle_y_bounds[OF x_coord_bounds[OF assms]] by auto
 
 lemma rot_x_ivl:
   assumes "(0::real) \<le> x" "x \<le> 1"  "0 \<le> y" "y \<le> 1" 
   shows "0 \<le> rot_x'' x y \<and> rot_x'' x y \<le> 1"
 proof
   have "\<And>a::real. 0 \<le> a \<and> a \<le> 1/2 \<Longrightarrow> 0 \<le> 1/2 + (2 * y - 1) * a" using assms
     by (sos "(((A<0 * R<1) + (((A<=4 * R<1) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=5 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=4 * R<1)) * (R<1 * [1]^2))))))")
   then show "0 \<le> rot_x'' x y"
     using assms circle_y_x_coord_bounds by(auto simp add: x_coord_inv_def)
   have "\<And>a::real. 0 \<le> a \<and> a \<le> 1/2 \<Longrightarrow> 1/2 + (2 * y - 1) * a \<le> 1" using assms
     by (sos "(((A<0 * R<1) + (((A<=5 * R<1) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=4 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=5 * R<1)) * (R<1 * [1]^2))))))")
   then show "rot_x'' x y \<le> 1"
     using assms circle_y_x_coord_bounds by (auto simp add: x_coord_inv_def)
 qed
 
 abbreviation "rot_y'' (x::real) (y::real) \<equiv> (x_coord x)/(2* (circle_y (x_coord (rot_x'' x y))))  + 1/2" 
 
 lemma rot_y_ivl:
   assumes "(0::real) \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1" 
   shows "0 \<le> rot_y'' x y \<and> rot_y'' x y \<le> 1"
 proof
   show "0 \<le> rot_y'' x y"
   proof(cases "(x_coord x) < 0")
     case True
     have i: "\<And>a b::real. a < 0 \<Longrightarrow> 0 \<le> a + b \<Longrightarrow> (0 \<le> a/(2*(b)) + 1/2)"
       by(auto simp add: algebra_simps divide_simps) 
     have *: "(1/2 - x) \<le> sqrt (x * x + (1/4 + (x * (y * 4) + x * (x * (y * (y * 4))))) - (x + (x * (x * (y * 4)) + x * (y * (y * 4)))))"
       apply (rule real_le_rsqrt)
       using assms apply (simp add: algebra_simps power2_eq_square mult_left_le_one_le)
       by (sos "(((A<0 * R<1) + ((A<=0 * (A<=1 * (A<=2 * (A<=3 * R<1)))) * (R<4 * [1]^2))))")
     have rw: "\<bar>x - x * x\<bar> = x - x * x" using assms
       by (sos "(() & (((((A<0 * A<1) * R<1) + ((A<=0 * (A<=1 * (A<1 * R<1))) * (R<1 * [1]^2)))) & ((((A<0 * A<1) * R<1) + ((A<=0 * (A<=1 * (A<1 * R<1))) * (R<1 * [1]^2))))))")
     have "0 \<le> x_coord x + (circle_y (x_coord (rot_x'' x y)))"
       using * apply (auto simp add: x_coord_inv_2)
       by (auto simp add: circle_y_def algebra_simps rw x_coord_def)
     then show ?thesis
       using True i by blast
   next
     case False
     have i: "\<And>a b::real. 0 \<le> a \<Longrightarrow> 0 \<le> b  \<Longrightarrow> (0 \<le> a/(2*b) + 1/2)"
       by(auto simp add: algebra_simps divide_simps)
     have "0 \<le> circle_y (x_coord (x_coord_inv ((2 * y - 1) * circle_y (x_coord x))))"
     proof -
       have rw: "\<bar>x - x * x\<bar> = x - x * x" using assms
         by (sos "(() & (((((A<0 * A<1) * R<1) + ((A<=0 * (A<=1 * (A<1 * R<1))) * (R<1 * [1]^2)))) & ((((A<0 * A<1) * R<1) + ((A<=0 * (A<=1 * (A<1 * R<1))) * (R<1 * [1]^2))))))")
       have "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> -1/2\<le> (2 * y - 1) * x" using assms
         by (sos "(((A<0 * R<1) + (((A<=4 * R<1) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=5 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=4 * R<1)) * (R<1 * [1]^2))))))")
       then have "- 1/2 \<le> (2 * y - 1) * circle_y (x_coord x)"
         using circle_y_x_coord_bounds assms(1-2) by auto
       moreover
       have "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> (2 * y - 1) * x \<le> 1/2 " using assms
         by (sos "(((A<0 * R<1) + (((A<=5 * R<1) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=4 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=5 * R<1)) * (R<1 * [1]^2))))))")
       then have "(2 * y - 1) * circle_y (x_coord x) \<le> 1/2"
         using circle_y_x_coord_bounds assms(1-2) by auto
       ultimately show "0 \<le> circle_y (x_coord (x_coord_inv ((2 * y - 1) * circle_y (x_coord x))))"
         by (simp add: circle_y_bounds(1) x_coord_inv_2)
     qed
     then show ?thesis
       using False by auto
   qed
   have i: "\<And>a b::real. a < 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> (a/(2*(b)) + 1/2) \<le> 1"
     by(auto simp add: algebra_simps divide_simps) 
   show "rot_y'' x y \<le> 1"
   proof(cases "(x_coord x) < 0")
     case True
     have i: "\<And>a b::real. a < 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> (a/(2*(b)) + 1/2) \<le> 1"
       by(auto simp add: algebra_simps divide_simps) 
     have "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> -1/2\<le> (2 * y - 1) * x" using assms
       by (sos "(((A<0 * R<1) + (((A<=4 * R<1) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=5 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=4 * R<1)) * (R<1 * [1]^2))))))")
     then have "- 1/2 \<le> (2 * y - 1) * circle_y (x_coord x)"
       using circle_y_x_coord_bounds assms(1-2) by auto
     moreover have "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> (2 * y - 1) * x \<le> 1/2 " using assms
       by (sos "(((A<0 * R<1) + (((A<=5 * R<1) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=4 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=5 * R<1)) * (R<1 * [1]^2))))))")
     then have "(2 * y - 1) * circle_y (x_coord x) \<le> 1/2"
       using circle_y_x_coord_bounds assms(1-2) by auto
     ultimately have "0 \<le> circle_y (x_coord (x_coord_inv ((2 * y - 1) * circle_y (x_coord x))))"
       by (simp add: circle_y_bounds(1) x_coord_inv_2)
     then show ?thesis
       by (simp add: True i)
   next
     case False
     have i: "\<And>a b::real. 0 \<le> a \<Longrightarrow> a \<le> b  \<Longrightarrow> (a/(2*b) + 1/2) \<le> 1"
       by(auto simp add: algebra_simps divide_simps)
     have "(x - 1/2) * (x - 1/2) \<le> (x * x + (1/4 + (x * (y * 4) + x * (x * (y * (y * 4))))) - (x + (x * (x * (y * 4)) + x * (y * (y * 4)))))"
       using assms False 
       apply(auto simp add: x_coord_def)
       by (sos "(((A<0 * R<1) + (((A<=0 * (A<=1 * (A<=2 * R<1))) * (R<2 * [1]^2)) + ((A<=0 * (A<=1 * (A<=2 * (A<=3 * R<1)))) * (R<2 * [1]^2)))))")
     then have "sqrt ((x - 1/2) * (x - 1/2)) \<le> sqrt (x * x + (1/4 + (x * (y * 4) + x * (x * (y * (y * 4))))) - (x + (x * (x * (y * 4)) + x * (y * (y * 4)))))"
       using real_sqrt_le_mono by blast
     then have *: "(x - 1/2) \<le> sqrt (x * x + (1/4 + (x * (y * 4) + x * (x * (y * (y * 4))))) - (x + (x * (x * (y * 4)) + x * (y * (y * 4)))))"
       using assms False by(auto simp add: x_coord_def)
     have rw: "\<bar>x - x * x\<bar> = x - x * x" using assms
       by (sos "(() & (((((A<0 * A<1) * R<1) + ((A<=0 * (A<=1 * (A<1 * R<1))) * (R<1 * [1]^2)))) & ((((A<0 * A<1) * R<1) + ((A<=0 * (A<=1 * (A<1 * R<1))) * (R<1 * [1]^2))))))")
     have "x_coord x \<le> circle_y (x_coord (x_coord_inv ((2 * y - 1) * circle_y (x_coord x))))"
       using * unfolding x_coord_inv_2
       by (auto simp add: circle_y_def algebra_simps rw x_coord_def)
     then show ?thesis
       using False i by auto
   qed
 qed
 
 lemma circle_eq_rot_circle:
   assumes "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1" 
   shows "(circle_cube (x, y)) = (rot_circle_cube (rot_y'' x y, rot_x'' x y))"
 proof
   have rw:  "\<bar>1/4 - x_coord x * x_coord x\<bar> = 1/4 - x_coord x * x_coord x"
     apply(rule abs_of_nonneg)
     using assms mult_left_le by (auto simp add: x_coord_def divide_simps algebra_simps)
   show "fst (circle_cube (x, y)) = fst (rot_circle_cube (rot_y'' x y, rot_x'' x y))"
     using assms d_gt_0
     apply(simp add: circle_cube_nice rot_circle_cube_def x_coord_inv_2 circle_y_def algebra_simps rw)
     apply(auto simp add: x_coord_def algebra_simps)
     by (sos "(((((A<0 * A<1) * ((A<0 * A<1) * R<1)) + (([~4*d^2] * A=0) + (((A<=1 * (A<=2 * (A<=3 * R<1))) * (R<8 * [d]^2)) + ((A<=1 * (A<=2 * (A<=3 * (A<1 * R<1)))) * (R<8 * [d]^2)))))) & ((((A<0 * A<1) * ((A<0 * A<1) * R<1)) + (([~4*d^2] * A=0) + (((A<=0 * (A<=2 * (A<=3 * R<1))) * (R<8 * [d]^2)) + ((A<=0 * (A<=2 * (A<=3 * (A<1 * R<1)))) * (R<8 * [d]^2)))))))") (*Be patient: it takes a bit of time, still better than creeping its proof manually.*)
   show "snd (circle_cube (x, y)) = snd (rot_circle_cube (rot_y'' x y, rot_x'' x y))"
     using assms
     by(auto simp add: circle_cube_def rot_circle_cube_def x_coord_inv_def circle_y_def x_coord_def)
 qed
 
 lemma rot_circle_eq_circle:
   assumes "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1" 
   shows "(rot_circle_cube (x, y)) = (circle_cube (rot_x'' y x, rot_y'' y x))"
 proof
   show "fst (rot_circle_cube (x, y)) = fst (circle_cube (rot_x'' y x, rot_y'' y x))"
     using assms
     by(auto simp add: circle_cube_def rot_circle_cube_def x_coord_inv_def circle_y_def x_coord_def)
   have rw:  "\<bar>1/4 - x_coord y * x_coord y\<bar> =  1/4 - x_coord y * x_coord y"
     apply(rule abs_of_nonneg)
     using assms mult_left_le by (auto simp add: x_coord_def divide_simps algebra_simps)
   show "snd (rot_circle_cube (x, y)) = snd (circle_cube (rot_x'' y x, rot_y'' y x))"
     using assms d_gt_0
     apply(simp add: circle_cube_nice rot_circle_cube_def x_coord_inv_2 circle_y_def algebra_simps rw)
     apply(auto simp add: x_coord_def algebra_simps)
     by (sos "(((((A<0 * A<1) * ((A<0 * A<1) * R<1)) + (([~4*d^2] * A=0) + (((A<=0 * (A<=1 * (A<=3 * R<1))) * (R<8 * [d]^2)) + ((A<=0 * (A<=1 * (A<=3 * (A<1 * R<1)))) * (R<8 * [d]^2)))))) & ((((A<0 * A<1) * ((A<0 * A<1) * R<1)) + (([~4*d^2] * A=0) + (((A<=0 * (A<=1 * (A<=2 * R<1))) * (R<8 * [d]^2)) + ((A<=0 * (A<=1 * (A<=2 * (A<1 * R<1)))) * (R<8 * [d]^2)))))))") (*Be patient: it takes a bit of time, still better than creeping its proof manually.*)
 qed
 
 lemma rot_img_eq:
   assumes "0 < d"
   shows "(cubeImage (circle_cube )) = (cubeImage (rot_circle_cube))"
   apply(auto simp add: cubeImage_def image_def cbox_def real_pair_basis)
   by (meson rot_y_ivl rot_x_ivl assms circle_eq_rot_circle rot_circle_eq_circle)+ 
 
 lemma rot_circle_div_circle:
   assumes "0 < (d::real)"
   shows "gen_division (cubeImage circle_cube) (cubeImage ` {rot_circle_cube})"
   using rot_img_eq[OF assms] by(auto simp add: gen_division_def)
 
 lemma circle_cube_boundary_valid:
   assumes "(k,\<gamma>)\<in>boundary circle_cube"
   shows "valid_path \<gamma>"
 proof -
   have f01: "finite{0,1}"
     by simp
   show ?thesis
     using assms
     unfolding boundary_def horizontal_boundary_def vertical_boundary_def circle_cube_def valid_path_def piecewise_C1_differentiable_on_def
     by safe (rule derivative_intros continuous_intros f01 exI ballI conjI refl | force simp add: field_simps)+
 qed
 
 lemma rot_circle_cube_boundary_valid:
   assumes "(k,\<gamma>)\<in>boundary rot_circle_cube"
   shows "valid_path \<gamma>"
   using assms swap_valid_boundaries circle_cube_boundary_valid
   by (fastforce simp add: rot_circle_cube_def)
 
 lemma diff_divide_cancel: 
   fixes z::real shows  "z \<noteq> 0  \<Longrightarrow> (a * z - a * (b * z)) / z = (a - a * b)" 
   by (auto simp: field_simps)
 
 lemma circle_cube_is_type_I:
   assumes "0 < d"
   shows "typeI_twoCube circle_cube"
   unfolding typeI_twoCube_def
 proof (intro exI conjI ballI)
   have f01: "finite{-d/2,d/2}"
     by simp
   show "-d/2 < d/2"
     using assms by simp
   show "(\<lambda>x. d * sqrt (1/4 - (x/d) * (x/d))) piecewise_C1_differentiable_on {- d/2..d/2}"
     using assms unfolding piecewise_C1_differentiable_on_def   
     apply (intro exI conjI)
       apply (rule ballI refl f01 derivative_intros continuous_intros | simp)+
     apply (auto simp: field_simps)
     by sos
    show "(\<lambda>x. -d * sqrt (1/4 - (x/d) * (x/d))) piecewise_C1_differentiable_on {- d/2..d/2}"
     using assms unfolding piecewise_C1_differentiable_on_def   
     apply (intro exI conjI)
        apply (rule ballI refl f01 derivative_intros continuous_intros | simp)+
     apply (auto simp: field_simps)
     by sos
   show "- d * sqrt (1/4 - x / d * (x / d)) \<le> d * sqrt (1/4 - x / d * (x / d))"
     if "x \<in> {- d/2..d/2}" for x
   proof -
     have *: "x^2 \<le> (d/2)^2"
       using real_sqrt_le_iff that by fastforce
     show ?thesis
       apply (rule mult_right_mono)
       using assms * apply (simp_all add: divide_simps power2_eq_square)
       done
   qed
 qed (auto simp add: circle_cube_def divide_simps algebra_simps diff_divide_cancel)
 
 lemma rot_circle_cube_is_type_II:
   shows "typeII_twoCube rot_circle_cube"
   using d_gt_0 swap_typeI_is_typeII circle_cube_is_type_I
   by (auto simp add: rot_circle_cube_def)
 
 definition circle_bot_edge where
   "circle_bot_edge = (1::int, \<lambda>t. (x_coord t * d, - d * circle_y (x_coord t)))"
 
 definition circle_top_edge where
   "circle_top_edge = (- 1::int, \<lambda>t. (x_coord t * d, d * circle_y (x_coord t)))"
 
 definition circle_right_edge where
   "circle_right_edge = (1::int, \<lambda>y. (d/2, 0))"
 
 definition circle_left_edge where
   "circle_left_edge = (- 1::int, \<lambda>y. (- (d/2), 0))"
 
 lemma circle_cube_boundary_explicit:
     "boundary circle_cube = {circle_left_edge,circle_right_edge,circle_bot_edge,circle_top_edge}"
   by (auto simp add: valid_two_cube_def boundary_def horizontal_boundary_def vertical_boundary_def circle_cube_def 
       circle_top_edge_def circle_bot_edge_def circle_cube_nice x_coord_def circle_y_def
       circle_left_edge_def circle_right_edge_def)
 
 definition rot_circle_right_edge where
   "rot_circle_right_edge = (1::int, \<lambda>t. (d * circle_y (x_coord t), x_coord t * d))"
 
 definition rot_circle_left_edge where
   "rot_circle_left_edge = (- 1::int, \<lambda>t. (- d * circle_y (x_coord t), x_coord t * d))"
 
 definition rot_circle_top_edge where
   "rot_circle_top_edge = (- 1::int, \<lambda>y. (0, d/2))"
 
 definition rot_circle_bot_edge where
   "rot_circle_bot_edge = (1::int, \<lambda>y. (0, - (d/2)))"
 
 lemma rot_circle_cube_boundary_explicit:
     "boundary (rot_circle_cube) =
            {rot_circle_top_edge,rot_circle_bot_edge,rot_circle_right_edge,rot_circle_left_edge}"
   by (auto simp add: rot_circle_cube_def valid_two_cube_def boundary_def horizontal_boundary_def vertical_boundary_def circle_cube_def
       rot_circle_right_edge_def rot_circle_left_edge_def x_coord_def circle_y_def rot_circle_top_edge_def rot_circle_bot_edge_def)
 
 lemma rot_circle_cube_vertical_boundary_explicit:
     "vertical_boundary rot_circle_cube = {rot_circle_right_edge,rot_circle_left_edge}"
   by (auto simp add: rot_circle_cube_def valid_two_cube_def vertical_boundary_def circle_cube_def
       rot_circle_right_edge_def rot_circle_left_edge_def x_coord_def circle_y_def)
 
 lemma circ_left_edge_neq_top:
    "(- 1::int, \<lambda>y::real. (- (d/2), 0)) \<noteq> (- 1, \<lambda>x. ((x - 1/2) * d, d * sqrt (1/4 - (x - 1/2) * (x - 1/2))))"
   by (metis (no_types, lifting) add_diff_cancel_right' d_gt_0 mult.commute mult_cancel_left order_less_irrefl prod.inject)
 
 lemma circle_cube_valid_two_cube: "valid_two_cube (circle_cube)"
 proof (auto simp add: valid_two_cube_def boundary_def horizontal_boundary_def vertical_boundary_def circle_cube_def)
   have iv: "(- 1::int, \<lambda>y::real. (- (d/2), 0)) \<noteq> (- 1, \<lambda>x. ((x - 1/2) * d, d * sqrt (1/4 - (x - 1/2) * (x - 1/2))))"
     using d_gt_0  apply (auto simp add: algebra_simps)
     by (metis (no_types, hide_lams) add_diff_cancel_right' add_uminus_conv_diff cancel_comm_monoid_add_class.diff_cancel less_eq_real_def linorder_not_le mult.left_neutral prod.simps(1))
   have v: "(1::int, \<lambda>y. (d/2, 0)) \<noteq> (1, \<lambda>x. ((x - 1/2) * d, - (d * sqrt (1/4 - (x - 1/2) * (x - 1/2)))))"
     using d_gt_0  apply (auto simp add: algebra_simps)
     by (metis (no_types, hide_lams) diff_0 equal_neg_zero mult_zero_left nonzero_mult_div_cancel_left order_less_irrefl prod.sel(1) times_divide_eq_right zero_neq_numeral)
   show " card {(- 1::int, \<lambda>y. (- (d/2), 0)), (1, \<lambda>y. (d/2, 0)), (1, \<lambda>x. ((x - 1/2) * d, - (d * sqrt (1/4 - (x - 1/2) * (x - 1/2))))),
                    (- 1, \<lambda>x. ((x - 1/2) * d, d * sqrt (1/4 - (x - 1/2) * (x - 1/2))))} = 4"
     using iv v by auto
 qed
 
 lemma rot_circle_cube_valid_two_cube:
   shows "valid_two_cube rot_circle_cube"
   using valid_cube_valid_swap circle_cube_valid_two_cube d_gt_0 rot_circle_cube_def
   by force
 
 definition circle_arc_0 where "circle_arc_0 = (1, \<lambda>t::real. (0,0))"
 
 lemma circle_top_bot_edges_neq' [simp]: 
   shows "circle_top_edge \<noteq> circle_bot_edge"
   by (simp add: circle_top_edge_def circle_bot_edge_def)
 
 lemma rot_circle_top_left_edges_neq [simp]: "rot_circle_top_edge \<noteq> rot_circle_left_edge"
   apply (simp add: rot_circle_left_edge_def rot_circle_top_edge_def x_coord_def)
   by (metis (mono_tags, hide_lams) cancel_comm_monoid_add_class.diff_cancel d_gt_0 divide_eq_0_iff mult_zero_left order_less_irrefl prod.sel(2) zero_neq_numeral)
 
 lemma rot_circle_bot_left_edges_neq [simp]: "rot_circle_bot_edge \<noteq> rot_circle_left_edge"
   by (simp add: rot_circle_left_edge_def rot_circle_bot_edge_def x_coord_def)
 
 lemma rot_circle_top_right_edges_neq [simp]: "rot_circle_top_edge \<noteq> rot_circle_right_edge"
   by (simp add: rot_circle_right_edge_def rot_circle_top_edge_def x_coord_def)
 
 lemma rot_circle_bot_right_edges_neq [simp]: "rot_circle_bot_edge \<noteq> rot_circle_right_edge"
   apply (simp add: rot_circle_right_edge_def rot_circle_bot_edge_def x_coord_def)
   by (metis (mono_tags, hide_lams) cancel_comm_monoid_add_class.diff_cancel d_gt_0 divide_eq_0_iff mult_zero_left neg_0_equal_iff_equal order_less_irrefl prod.sel(2) zero_neq_numeral)
 
 lemma rot_circle_right_top_edges_neq' [simp]: "rot_circle_right_edge \<noteq> rot_circle_left_edge"
   by (simp add: rot_circle_left_edge_def rot_circle_right_edge_def)
 
 lemma rot_circle_left_bot_edges_neq [simp]: "rot_circle_left_edge \<noteq> rot_circle_top_edge"
   apply (simp add: rot_circle_top_edge_def rot_circle_left_edge_def)
   by (metis (no_types, hide_lams) cancel_comm_monoid_add_class.diff_cancel d_gt_0 mult.commute mult_zero_right nonzero_mult_div_cancel_left order_less_irrefl prod.sel(2) times_divide_eq_right x_coord_def zero_neq_numeral)
 
 lemma circle_right_top_edges_neq [simp]: "circle_right_edge \<noteq> circle_top_edge"
 proof -
   have "circle_right_edge = (1, (\<lambda>r::real. (d / 2, 0::real)))"
     using circle.circle_right_edge_def circle_axioms by blast
   then show ?thesis
     using circle.circle_top_edge_def circle_axioms by auto
 qed
 
 lemma circle_left_bot_edges_neq [simp]: "circle_left_edge \<noteq> circle_bot_edge"
 proof -
   have "circle_bot_edge = (1, \<lambda>r. (x_coord r * d, - d * circle_y (x_coord r)))"
     using circle.circle_bot_edge_def circle_axioms by blast
   then show ?thesis
     by (simp add: circle_left_edge_def)
 qed
 
 lemma circle_left_top_edges_neq [simp]: "circle_left_edge \<noteq> circle_top_edge"
 proof -
   have "\<exists>r. ((r - 1 / 2) * d, d * sqrt (1 / 4 - (r - 1 / 2) * (r - 1 / 2))) \<noteq> (- (d / 2), 0)"
     by (metis circ_left_edge_neq_top)
   then have "(\<exists>r. d * r \<noteq> - (d / 2)) \<or> (\<exists>r ra. (x_coord (x_coord_inv r) * d, d * circle_y (x_coord (x_coord_inv r))) = (x_coord ra * d, d * circle_y (x_coord ra)) \<and> d * circle_y r \<noteq> 0)"
     by (metis mult.commute)
   then have "(\<lambda>r. (x_coord r * d, d * circle_y (x_coord r))) \<noteq> (\<lambda>r. (- (d / 2), 0))"
     by (metis mult.commute prod.simps(1) x_coord_inv_2)
   then show ?thesis
     by (simp add: circle_left_edge_def circle_top_edge_def)
 qed
 
 lemma circle_right_bot_edges_neq [simp]: "circle_right_edge \<noteq> circle_bot_edge"
-  by (smt Pair_inject circle_bot_edge_def d_gt_0 circle.circle_right_edge_def circle_axioms real_mult_le_cancel_iff1 x_coord_def)
+  by (smt Pair_inject circle_bot_edge_def d_gt_0 circle.circle_right_edge_def circle_axioms mult_le_cancel_iff1 x_coord_def)
 
 definition circle_polar where
   "circle_polar t = ((d/2)  * cos (2 * pi * t), (d/2) * sin (2 * pi * t))"
 
 lemma circle_polar_smooth: "(circle_polar) C1_differentiable_on {0..1}"
 proof -
   have "inj ((*) (2 * pi))"
     by (auto simp: inj_on_def)
   then have *: "\<And>x. finite ({0..1} \<inter> (*) (2 * pi) -` {x})"
     by (simp add: finite_vimageI)
   have "(\<lambda>t. ((d/2)  * cos (2 * pi * t), (d/2) * sin (2 * pi * t))) C1_differentiable_on {0..1}"
     by (rule * derivative_intros)+
   then show ?thesis
     apply (rule eq_smooth_gen)
     by(simp add: circle_polar_def)
 qed
 
 abbreviation "custom_arccos \<equiv> (\<lambda>x. (if -1 \<le> x \<and> x \<le> 1 then arccos x else (if x < -1 then -x + pi else 1 -x )))"
 
 lemma cont_custom_arccos: 
   assumes "S \<subseteq> {-1..1}"
   shows "continuous_on S custom_arccos"
 proof -
   have "continuous_on ({-1..1} \<union> {}) custom_arccos"
     by (auto intro!: continuous_on_cases continuous_intros)
   with assms show ?thesis
     using continuous_on_subset by auto 
 qed
 
 lemma custom_arccos_has_deriv: 
   assumes "- 1 < x" "x < 1"
   shows "DERIV custom_arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
 proof -
   have x1: "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2"
     by (simp add: abs_less_iff abs_square_less_1 assms)
   show ?thesis
     apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
          apply (rule x1 derivative_eq_intros | simp add: sin_arccos)+
     using assms x1 cont_custom_arccos [of "{-1<..<1}"] 
          apply (auto simp: continuous_on_eq_continuous_at greaterThanLessThan_subseteq_atLeastAtMost_iff)
     done
 qed
 
 declare 
   custom_arccos_has_deriv[THEN DERIV_chain2, derivative_intros]
   custom_arccos_has_deriv[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemma circle_boundary_reparams:
   shows rot_circ_left_edge_reparam_polar_circ_split:
     "reparam (rec_join [(rot_circle_left_edge)]) (rec_join [(subcube (1/4) (1/2) (1, circle_polar)), (subcube (1/2) (3/4) (1, circle_polar))])"
     (is ?P1)
     and circ_top_edge_reparam_polar_circ_split:
     "reparam (rec_join [(circle_top_edge)]) (rec_join [(subcube 0 (1/4) (1, circle_polar)), (subcube (1/4) (1/2) (1, circle_polar))])"
     (is ?P2)
     and circ_bot_edge_reparam_polar_circ_split:
     "reparam (rec_join [(circle_bot_edge)]) (rec_join [(subcube (1/2) (3/4) (1, circle_polar)), (subcube (3/4) 1 (1, circle_polar))])"
     (is ?P3)
     and rot_circ_right_edge_reparam_polar_circ_split:
     "reparam (rec_join [(rot_circle_right_edge)]) (rec_join [(subcube (3/4) 1 (1, circle_polar)), (subcube 0 (1/4) (1, circle_polar))])"
     (is ?P4)
 proof -
   let ?\<phi> = "((*) (1/pi) \<circ> custom_arccos \<circ> (\<lambda>t. 2 * x_coord (1 - t)))" 
   let ?LHS1 = "(\<lambda>x. (- (d * sqrt (1/4 - x_coord (1 - x) * x_coord (1 - x))), x_coord (1 - x) * d))"
   let ?RHS1 = "((\<lambda>x. if x * 2 \<le> 1 then (d * cos (2 * pi * (2 * x/4 + 1/4))/2, d * sin (2 * pi * (2 * x/4 + 1/4))/2)
                         else (d * cos (2 * pi * ((2 * x - 1)/4 + 1/2))/2, d * sin (2 * pi * ((2 * x - 1)/4 + 1/2))/2)) \<circ> ?\<phi>)"
   let ?LHS2 = "\<lambda>x. ((x_coord (1 - x) * d, d * sqrt (1/4 - x_coord (1 - x) * x_coord (1 - x))))"
   let ?RHS2 = "((\<lambda>x. if x * 2 \<le> 1 then (d * cos (2 * x * pi/2)/2, d * sin (2 * x * pi/2)/2) else (d * cos (2 * pi * ((2 * x - 1)/4 + 1/4))/2, d * sin (2 * pi * ((2 * x - 1)/4 + 1/4))/2)) \<circ> ?\<phi>)"
   let ?LHS3 = "\<lambda>x. (x_coord x * d, - (d * sqrt (1/4 - x_coord x * x_coord x)))"
   let ?RHS3 = "(\<lambda>x. if x * 2 \<le> 1 then (d * cos (2 * pi * (2 * x/4 + 1/2))/2, d * sin (2 * pi * (2 * x/4 + 1/2))/2) 
                   else (d * cos (2 * pi * ((2 * x - 1)/4 + 3/4))/2, d * sin (2 * pi * ((2 * x - 1)/4 + 3/4))/2))"
   let ?LHS4 = "\<lambda>x. (d * sqrt (1/4 - x_coord x * x_coord x), x_coord x * d)"
   let ?RHS4 = "(\<lambda>x. if x * 2 \<le> 1 then (d * cos (2 * pi * (2 * x/4 + 3/4))/2, d * sin (2 * pi * (2 * x/4 + 3/4))/2) 
                  else (d * cos ((2 * x - 1) * pi/2)/2, d * sin ((2 * x - 1) * pi/2)/2))"
   have phi_diff: "?\<phi> piecewise_C1_differentiable_on {0..1}"
     unfolding piecewise_C1_differentiable_on_def
   proof
     show "continuous_on {0..1} ?\<phi>"
       unfolding x_coord_def
       by (intro continuous_on_compose cont_custom_arccos continuous_intros) auto
     have "?\<phi> C1_differentiable_on {0..1} - {0,1}"
       unfolding x_coord_def piecewise_C1_differentiable_on_def C1_differentiable_on_def valid_path_def
       by (simp | rule has_vector_derivative_pair_within DERIV_image_chain derivative_eq_intros continuous_intros exI ballI conjI 
           | force simp add: field_simps | sos)+
     then show "\<exists>s. finite s \<and> ?\<phi> C1_differentiable_on {0..1} - s"
       by force
   qed
   have inj: "inj ?\<phi>"
     apply (intro comp_inj_on inj_on_cases inj_on_arccos)
           apply (auto simp add: inj_on_def x_coord_def)
     using pi_ge_zero apply auto[1]
      apply (smt arccos)
     by (smt arccos_lbound)
   then have fin: "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> finite (?\<phi> -` {x})" 
     by (simp add: finite_vimageI)
   have "?\<phi> ` {0..1} = {0..1}"
   proof
     show "?\<phi> ` {0..1} \<subseteq> {0..1}"
       by (auto simp add: x_coord_def divide_simps arccos_lbound arccos_bounded)
     have "arccos (1 - 2 * ((1 - cos (x * pi))/2)) = x * pi" if "0 \<le> x" "x \<le> 1" for x
       using that by (simp add: field_simps arccos_cos)
     then show "{0..1} \<subseteq> ?\<phi> ` {0..1}"
       apply (auto simp: x_coord_def o_def image_def)
       by (rule_tac x="(1 - cos (x * pi))/2" in bexI) auto
   qed
   then have bij_phi: "bij_betw ?\<phi> {0..1} {0..1}"
     unfolding bij_betw_def using inj inj_on_subset by blast 
   have phi01: "?\<phi> -` {0..1} \<subseteq> {0..1}"
     by (auto simp add: subset_iff x_coord_def divide_simps)
   {
     fix x::real assume x: "0 \<le> x" "x \<le> 1"
     then have i: "- 1 \<le> (2 * x - 1)" "(2 * x - 1) \<le> 1"  by auto
     have ii: "cos (pi / 2 + arccos (1 - x * 2)) = -sin (arccos (1 - x * 2))"
       using minus_sin_cos_eq[symmetric, where ?x = "arccos (1 - x * 2)"]
       by (auto simp add: add.commute)
     have "2 * sqrt (x - x * x) = sqrt (4*x - 4*x * x)"
       by (metis mult.assoc real_sqrt_four real_sqrt_mult right_diff_distrib)
     also have "... = sqrt (1  - (2 * x - 1) * (2 * x - 1))"
       by (simp add: algebra_simps)
     finally have iii: "2 * sqrt (x - x * x) = cos (arcsin (2 * x - 1)) \<and> 2 * sqrt (x - x * x) =  sin (arccos (1 - 2 * x))"
       using arccos_minus[OF i]  unfolding minus_diff_eq sin_pi_minus
       by (simp add: cos_arcsin i power2_eq_square sin_arccos)
     then have 1: "?LHS1 x = ?RHS1 x"
       using d_gt_0 i x apply (simp add: x_coord_def field_simps)
       apply (auto simp add: diff_divide_distrib add_divide_distrib right_diff_distrib mult.commute ii)
       using cos_sin_eq[where ?x = "- arccos (1 - x * 2)"]
       by (simp add: cos_sin_eq[where ?x = "- arccos (1 - x * 2)"] right_diff_distrib)
     have 2: "?LHS2 x = ?RHS2 x"
       using x d_gt_0 iii by (auto simp add: x_coord_def diff_divide_distrib algebra_simps)
     have a: "cos (pi / 2 - arccos (x * 2 - 1)) = cos (pi / 2 - arccos (1 - x * 2))"
       by (smt arccos_minus arccos_cos2 arccos_lbound cos_arccos cos_ge_minus_one cos_le_one i(1) i(2) pi_def pi_half)
     have b: "cos (arccos (1 - x * 2) + pi * 3 / 2) = cos ((pi / 2 - arccos (x * 2 - 1)) + 2 * pi)"
       using arccos_minus[OF i]  by(auto simp add: mult.commute add.commute)
     then have c: "... = cos (pi / 2 - arccos (x * 2 - 1))" using cos_periodic by blast
     have "cos (- pi - arccos (1 - x * 2)) = cos (- (pi + arccos (1 - x * 2)))"
       by (auto simp add: minus_add[where b = "pi" and a = "arccos (1 - x * 2)", symmetric])
     moreover have "... = cos ((pi + arccos (1 - x * 2)))"
       using cos_minus by blast
     moreover have "... = cos (2*pi - arccos (x * 2 - 1))"
       using arccos_minus[OF i]  by (auto simp add: mult.commute add.commute)
     moreover have "... = cos (arccos (x * 2 - 1))"
       using cos_2pi_minus by auto
     ultimately have d: "cos (- pi - arccos (1 - x * 2)) = (x * 2 - 1)"
       using cos_arccos[OF i] mult.commute by metis
     have cosm: "\<And>x. cos (x - pi*2) = cos x"
       by (metis cos_periodic eq_diff_eq' mult.commute) 
     have 34: "?LHS3 x = (?RHS3  \<circ> ?\<phi>) x"  "?LHS4 x = (?RHS4 \<circ> ?\<phi>) x"
       using d_gt_0 x a b c iii cos_periodic [of "pi / 2 - arccos (x * 2 - 1)"] 
        apply (auto simp add: x_coord_def algebra_simps diff_divide_distrib power2_eq_square)
        apply (auto simp add: sin_cos_eq cosm)
       using d apply (auto simp add: right_diff_distrib)
       by (smt cos_minus)
     note 1 2 34
   } note * = this
   show ?P1 ?P2 ?P3 ?P4
        apply (auto simp add: subcube_def circle_bot_edge_def circle_top_edge_def circle_polar_def reversepath_def 
                subpath_def joinpaths_def circle_y_def rot_circle_left_edge_def rot_circle_right_edge_def)
     unfolding reparam_def
     by (rule ballI exI conjI impI phi_diff bij_phi phi01 fin * | force simp add: x_coord_def)+
 qed
 
 
 definition circle_cube_boundary_to_polarcircle where
   "circle_cube_boundary_to_polarcircle \<gamma> \<equiv>
      if (\<gamma> = (circle_top_edge)) then
            {subcube 0 (1/4) (1, circle_polar), subcube (1/4) (1/2) (1, circle_polar)}
      else if (\<gamma> = (circle_bot_edge)) then
            {subcube (1/2) (3/4) (1, circle_polar), subcube (3/4) 1 (1, circle_polar)}
      else {}"
 
 definition rot_circle_cube_boundary_to_polarcircle where
   "rot_circle_cube_boundary_to_polarcircle \<gamma> \<equiv>
      if (\<gamma> = (rot_circle_left_edge )) then
            {subcube (1/4)  (1/2) (1, circle_polar), subcube (1/2) (3/4) (1, circle_polar)}
      else if (\<gamma> = (rot_circle_right_edge)) then
            {subcube (3/4) 1 (1, circle_polar), subcube 0 (1/4) (1, circle_polar)}
      else {}"
 
 lemma circle_arcs_neq:
   assumes "0 \<le> k" "k \<le> 1" "0 \<le> n" "n \<le> 1" "n < k" "k + n < 1"
   shows "subcube k m (1, circle_polar) \<noteq> subcube n q (1, circle_polar)"
 proof (simp add: subcube_def subpath_def circle_polar_def)
   have "cos (2 * pi * k) \<noteq> cos(2 * pi * n)"
     unfolding cos_eq
   proof safe
     show False if "2 * pi * k = 2 * pi * n + 2 * m * pi" "m \<in> \<int>" for m
     proof -
       have "2 * pi * (k - n ) = 2 * m * pi"
         using distrib_left that by (simp add: left_diff_distrib mult.commute)
       then have a: "m = (k - n)" by auto
       have "\<lfloor>k - n\<rfloor> = 0 "
         using assms by (simp add: floor_eq_iff)
       then have "k - n \<notin> \<int>"
         using assms by (auto simp only: frac_eq_0_iff[symmetric] frac_def)
       then show False using that a by auto
     qed
     show False if "2 * pi * k = - (2 * pi * n) + 2 * m * pi" "m \<in> \<int>" for m
     proof -
       have "2 * pi * (k + n ) = 2 * m * pi"
         using that by (auto simp add: distrib_left)
       then have a: "m = (k + n)" by auto
       have "\<lfloor>k + n\<rfloor> = 0 "
         using assms by (simp add: floor_eq_iff)
       then have "k + n \<notin> \<int>"
         using Ints_def assms by force
       then show False using that a by auto
     qed
   qed
   then have "(\<lambda>x. (d * cos (2 * pi * ((m - k) * x + k))/2, d * sin (2 * pi * ((m - k) * x + k))/2)) 0  \<noteq> (\<lambda>x. (d * cos (2 * pi * ((q - n) * x + n))/2, d * sin (2 * pi * ((q - n) * x + n))/2)) 0"
     using d_gt_0 by auto
   then show "(\<lambda>x. (d * cos (2 * pi * ((m - k) * x + k))/2, d * sin (2 * pi * ((m - k) * x + k))/2)) \<noteq> (\<lambda>x. (d * cos (2 * pi * ((q - n) * x + n))/2, d * sin (2 * pi * ((q - n) * x + n))/2))" 
     by metis
 qed
 
 lemma circle_arcs_neq_2:
   assumes "0 \<le> k" "k \<le> 1" "0 \<le> n" "n \<le> 1" "n < k" "0 < n" and kn12: "1/2 < k + n" and "k + n < 3/2"
   shows "subcube k m (1, circle_polar) \<noteq> subcube n q (1, circle_polar)"
 proof (simp add: subcube_def subpath_def circle_polar_def)
   have "sin (2 * pi * k) \<noteq> sin(2 * pi * n)"
     unfolding sin_eq
   proof safe
     show False if "m \<in> \<int>" "2 * pi * k = 2 * pi * n + 2 * m * pi" for m
     proof -
       have "2 * pi * (k - n) = 2 * m * pi"
         using that by (simp add: left_diff_distrib mult.commute)                      
       then have a: "m = (k - n)" by auto
       have "\<lfloor>k - n\<rfloor> = 0 "
         using assms by (simp add: floor_eq_iff)
       then have "k - n \<notin>  \<int>"
         using assms by (auto simp only: frac_eq_0_iff[symmetric] frac_def )
       then show False using that a by auto
     qed
     show False if "2 * pi * k = - (2 * pi * n) + (2 * m + 1) * pi" "m \<in> \<int>" for m
     proof -
       have i: "\<And>pi. 0 < pi \<Longrightarrow> 2 * pi * (k + n ) = 2 * m * pi + pi \<Longrightarrow> m = (k + n) - 1/2"
         by (sos "(((((A<0 * A<1) * R<1) + ([1/2] * A=0))) & ((((A<0 * A<1) * R<1) + ([~1/2] * A=0))))")
       have "2 * pi * (k + n) = 2 * m * pi + pi"
         using that by (simp add: algebra_simps)
       then have a: "m = (k + n) - 1/2" using i[OF pi_gt_zero] by fastforce
       have "\<lfloor>k + n - 1/2\<rfloor> = 0 "
         using assms by (auto simp add: floor_eq_iff)
       then have "k + n - 1/2 \<notin> \<int>"
         by (metis Ints_cases add.commute add.left_neutral add_diff_cancel_left' add_diff_eq kn12 floor_of_int of_int_0 order_less_irrefl)
       then show False using that a by auto
     qed
   qed
   then have "(\<lambda>x. (d * cos (2 * pi * ((m - k) * x + k))/2, d * sin (2 * pi * ((m - k) * x + k))/2)) 0  \<noteq> (\<lambda>x. (d * cos (2 * pi * ((q - n) * x + n))/2, d * sin (2 * pi * ((q - n) * x + n))/2)) 0"
     using d_gt_0 by auto
   then show "(\<lambda>x. (d * cos (2 * pi * ((m - k) * x + k))/2, d * sin (2 * pi * ((m - k) * x + k))/2)) \<noteq> (\<lambda>x. (d * cos (2 * pi * ((q - n) * x + n))/2, d * sin (2 * pi * ((q - n) * x + n))/2))" 
     by metis
 qed
 
 lemma circle_cube_is_only_horizontal_div_of_rot:
   shows "only_horizontal_division (boundary (circle_cube)) {rot_circle_cube}"
   unfolding only_horizontal_division_def
 proof (rule exI [of _ "{}"], simp, intro conjI ballI)
   show "finite (boundary circle_cube)"
     using circle.circle_cube_boundary_explicit circle_axioms by auto
   show "boundary_chain (boundary circle_cube)"
     by (simp add: two_cube_boundary_is_boundary)
   show "\<And>x. x \<in> boundary circle_cube \<Longrightarrow> case x of (k, x) \<Rightarrow> valid_path x"
     using circle_cube_boundary_valid by blast
   let ?\<V> = "(boundary (circle_cube))"
   let ?pi = "{circle_left_edge, circle_right_edge}"
   let ?pj = "{rot_circle_top_edge, rot_circle_bot_edge}"
   let ?f = "circle_cube_boundary_to_polarcircle"
   let ?one_chaini = "boundary (circle_cube) - ?pi"
   have c: "common_reparam_exists ?\<V> (two_chain_vertical_boundary {rot_circle_cube})"
     unfolding common_reparam_exists_def
   proof (intro exI conjI)
     let ?subdiv = "{(subcube 0 (1/4) (1, circle_polar)),
                     (subcube (1/4) (1/2) (1, circle_polar)),
                     (subcube (1/2) (3/4) (1, circle_polar)),
                     (subcube (3/4) 1 (1, circle_polar))}"
     show "(\<forall>(k, \<gamma>)\<in>?subdiv. \<gamma> C1_differentiable_on {0..1})"
       using subpath_smooth[OF circle_polar_smooth] by (auto simp add: subcube_def)
     have 1: "finite ?subdiv" by auto
     show "boundary_chain ?subdiv"
       by (simp add: boundary_chain_def subcube_def)
     show "chain_reparam_chain' (boundary (circle_cube) - ?pi) ?subdiv"
       unfolding chain_reparam_chain'_def
     proof (intro exI conjI impI)
       show "\<Union> (?f ` ?one_chaini) = ?subdiv"
         apply (simp add: circle_cube_boundary_to_polarcircle_def circle_cube_boundary_explicit)
         using circle_top_bot_edges_neq' by metis
         let ?l = "[subcube 0 (1/4) (1, circle_polar), subcube (1/4) (1/2) (1, circle_polar)]"
       have "chain_reparam_weak_path (coeff_cube_to_path (circle_top_edge)) {subcube 0 (1/4) (1, circle_polar), subcube (1/4) (1/2) (1, circle_polar)}"
         unfolding chain_reparam_weak_path_def
       proof (intro exI conjI)
         show "valid_chain_list ?l"
           by (auto simp add: subcube_def circle_top_edge_def  x_coord_def circle_y_def pathfinish_def pathstart_def
               reversepath_def subpath_def joinpaths_def)
         show "reparam (coeff_cube_to_path circle_top_edge) (rec_join ?l)"
           using circ_top_edge_reparam_polar_circ_split by auto
         show "distinct ?l"
             apply simp
             apply (subst neq_commute)
             apply (simp add: circle_arcs_neq)
             done
       qed auto                                                     
       moreover have "chain_reparam_weak_path (coeff_cube_to_path (circle_bot_edge)) {subcube (1/2) (3/4) (1, circle_polar), subcube (3/4) 1 (1, circle_polar)}"
         unfolding chain_reparam_weak_path_def
       proof
         let ?l = "[subcube (1/2) (3/4) (1, circle_polar), subcube (3/4) 1 (1, circle_polar)]"
         have a: "valid_chain_list ?l"
           by (auto simp add: subcube_def circle_top_edge_def  x_coord_def circle_y_def pathfinish_def pathstart_def
               reversepath_def subpath_def joinpaths_def)
         have b: "reparam (rec_join [circle_bot_edge]) (rec_join ?l)"
           using circ_bot_edge_reparam_polar_circ_split by auto
         have c: "subcube (3/4) 1 (1, circle_polar) \<noteq> subcube (1/2) (3/4) (1, circle_polar)"
           apply(rule circle_arcs_neq_2) using d_gt_0(1) by auto
         show "set ?l = {subcube (1/2) (3/4) (1, circle_polar), subcube (3/4) 1 (1, circle_polar)} \<and>
                             distinct ?l \<and> reparam (coeff_cube_to_path (circle_bot_edge)) (rec_join ?l) \<and> valid_chain_list ?l \<and> ?l \<noteq> []" using a b c by auto
       qed
       ultimately
       show "(\<forall>cube\<in>?one_chaini. chain_reparam_weak_path (rec_join [cube]) (?f cube))"
         by (auto simp add:  circle_cube_boundary_to_polarcircle_def UNION_eq circle_cube_boundary_explicit)
       show "(\<forall>p\<in>?one_chaini. \<forall>p'\<in>?one_chaini. p \<noteq> p' \<longrightarrow> ?f p \<inter> ?f p' = {})"
         using circle_arcs_neq circle_arcs_neq_2 
         apply (auto simp add: circle_cube_boundary_to_polarcircle_def UNION_eq circle_cube_boundary_explicit neq_commute d_gt_0)
         using circle_top_bot_edges_neq' d_gt_0 apply auto[1]
           apply (smt atLeastAtMost_iff divide_less_eq_1_pos zero_less_divide_1_iff)
          apply (smt atLeastAtMost_iff divide_less_eq_1_pos zero_less_divide_iff)
         apply (smt atLeastAtMost_iff divide_cancel_left divide_less_eq_1_pos field_sum_of_halves zero_less_divide_1_iff)
         done
       show "(\<forall>x\<in>?one_chaini. finite (?f x))"
         by (auto simp add: circle_cube_boundary_to_polarcircle_def circle_cube_boundary_explicit)
     qed
     show "(\<forall>(k, \<gamma>)\<in>?pi. point_path \<gamma>)"
       using d_gt_0 by (auto simp add: point_path_def circle_left_edge_def circle_right_edge_def)
     let ?f = "rot_circle_cube_boundary_to_polarcircle"
     let ?one_chain2.0 = "two_chain_vertical_boundary {rot_circle_cube} - ?pj"
     show "chain_reparam_chain' (two_chain_vertical_boundary {rot_circle_cube} - ?pj) ?subdiv"
       unfolding chain_reparam_chain'_def
     proof (intro exI conjI)
       have rw: "?one_chain2.0 = {rot_circle_left_edge, rot_circle_right_edge}"
         by(auto simp add: rot_circle_cube_vertical_boundary_explicit two_chain_vertical_boundary_def)
       show "\<Union> (?f ` ?one_chain2.0) = ?subdiv"
         using rot_circle_right_top_edges_neq'
         by (auto simp add: rot_circle_cube_boundary_to_polarcircle_def rw)
       show "(\<forall>cube\<in>?one_chain2.0. chain_reparam_weak_path (rec_join [cube]) (?f cube))"
       proof (clarsimp simp add: rot_circle_cube_boundary_to_polarcircle_def rw, intro conjI)
         let ?l = "[subcube (1/4) (1/2) (1, circle_polar), subcube (1/2) (3/4) (1, circle_polar)]"
         show "chain_reparam_weak_path (coeff_cube_to_path (rot_circle_left_edge)) {subcube (1/4) (1/2) (1, circle_polar), subcube (1/2) (3/4) (1, circle_polar)}"
           unfolding chain_reparam_weak_path_def
         proof (intro exI conjI)
           show "valid_chain_list ?l"
             by (auto simp add: subcube_def pathfinish_def pathstart_def reversepath_def subpath_def joinpaths_def)
           show "reparam (coeff_cube_to_path rot_circle_left_edge) (rec_join ?l)"
             using rot_circ_left_edge_reparam_polar_circ_split by auto
           show "distinct ?l"
             apply simp
             apply (subst neq_commute)
             apply (simp add: circle_arcs_neq)
             done
         qed auto
         show "chain_reparam_weak_path (coeff_cube_to_path (rot_circle_right_edge)) {subcube (3/4) 1 (1, circle_polar), subcube 0 (1/4) (1, circle_polar)}"
           unfolding chain_reparam_weak_path_def
         proof (intro exI conjI)
           let ?l = "[subcube (3/4) 1 (1, circle_polar), subcube 0 (1/4) (1, circle_polar)]"
           show "valid_chain_list ?l"
             by  (auto simp add: circle_polar_def subcube_def pathfinish_def pathstart_def
                 reversepath_def subpath_def joinpaths_def)
           show "reparam (coeff_cube_to_path rot_circle_right_edge) (rec_join ?l)"
             using rot_circ_right_edge_reparam_polar_circ_split by auto
           show "distinct ?l" 
             by (simp add: circle_arcs_neq)
         qed auto
       qed
       show "(\<forall>p\<in>?one_chain2.0. \<forall>p'\<in>?one_chain2.0. p \<noteq> p' \<longrightarrow> ?f p \<inter> ?f p' = {})"
         using circle_arcs_neq circle_arcs_neq_2 
         apply (auto simp add: rot_circle_cube_boundary_to_polarcircle_def neq_commute)
          apply (metis add.right_neutral divide_less_eq_1_pos dual_order.order_iff_strict num.distinct(1) one_less_numeral_iff prod.sel(1) prod.sel(2) semiring_norm(68) subcube_def zero_less_divide_1_iff zero_less_numeral)
         apply (smt field_sum_of_halves)
         done
       show "(\<forall>x\<in>?one_chain2.0. finite (?f x))"
         by (auto simp add: rot_circle_cube_boundary_to_polarcircle_def UNION_eq rw)
     qed
     show "(\<forall>(k, \<gamma>)\<in>?pj. point_path \<gamma>)"
       using d_gt_0 by (auto simp add: point_path_def rot_circle_top_edge_def rot_circle_bot_edge_def)
   qed 
   then show "common_sudiv_exists (two_chain_vertical_boundary {rot_circle_cube}) (boundary circle_cube) \<or>
              common_reparam_exists (boundary circle_cube) (two_chain_vertical_boundary {rot_circle_cube})"
     by blast
 qed
 
 lemma GreenThm_cirlce:
   assumes "\<forall>twoC\<in>{circle_cube}. analytically_valid (cubeImage twoC) (\<lambda>x. F x \<bullet> i) j"
     "\<forall>twoC\<in>{rot_circle_cube}. analytically_valid (cubeImage twoC) (\<lambda>x. F x \<bullet> j) i"
   shows "integral (cubeImage (circle_cube)) (\<lambda>x. partial_vector_derivative (\<lambda>x. F x \<bullet> j) i x - partial_vector_derivative (\<lambda>x. F x \<bullet> i) j x) =
                      one_chain_line_integral F {i, j} (boundary (circle_cube))"
 proof(rule green_typeI_typeII_chain.GreenThm_typeI_typeII_divisible_region_finite_holes[of "(cubeImage (circle_cube))" i j F "{circle_cube}" "{rot_circle_cube}",
                             OF _ _ _ circle_cube_is_only_horizontal_div_of_rot _], auto)
   show "\<And> a b. (a, b) \<in> boundary circle_cube \<Longrightarrow> valid_path b" using circle_cube_boundary_valid by auto
   show "green_typeI_typeII_chain (cubeImage circle_cube) i j F {circle_cube} {rot_circle_cube}"
     using assms
     proof(auto simp add: green_typeI_typeII_chain_def green_typeI_chain_def green_typeII_chain_def green_typeI_chain_axioms_def green_typeII_chain_axioms_def
                intro!: circle_cube_is_type_I rot_circle_cube_is_type_II d_gt_0 R2_axioms)
       show "gen_division (cubeImage circle_cube) {cubeImage circle_cube}" by (simp add: gen_division_def)
       show "gen_division (cubeImage (circle_cube)) ({cubeImage rot_circle_cube})"
         using rot_circle_div_circle d_gt_0 by auto 
       show "valid_two_chain {rot_circle_cube}" "valid_two_chain {circle_cube}"
         apply (auto simp add: valid_two_chain_def)
         using rot_circle_cube_valid_two_cube circle_cube_valid_two_cube assms(1) by auto
     qed
   show "only_vertical_division (boundary (circle_cube)) {circle_cube}"
     using twoChainVertDiv_of_itself[of "{circle_cube}"]
     apply(simp add: two_chain_boundary_def)
     using circle_cube_boundary_valid
     by auto
 qed
 end
 end
diff --git a/thys/Gromov_Hyperbolicity/Metric_Completion.thy b/thys/Gromov_Hyperbolicity/Metric_Completion.thy
--- a/thys/Gromov_Hyperbolicity/Metric_Completion.thy
+++ b/thys/Gromov_Hyperbolicity/Metric_Completion.thy
@@ -1,482 +1,482 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     License: BSD
 *)
 
 section \<open>The metric completion of a metric space\<close>
 
 theory Metric_Completion
   imports Isometries
 begin
 
 text \<open>Any metric space can be completed, by adding the missing limits of Cauchy sequences.
 Formally, there exists an isometric embedding of the space in a complete space, with dense image.
 In this paragraph, we construct this metric completion. This is exactly the same construction
 as the way in which real numbers are constructed from rational numbers.\<close>
 
 subsection \<open>Definition of the metric completion\<close>
 
 quotient_type (overloaded) 'a metric_completion =
   "nat \<Rightarrow> ('a::metric_space)" / partial: "\<lambda>u v. (Cauchy u) \<and> (Cauchy v) \<and> (\<lambda>n. dist (u n) (v n)) \<longlonglongrightarrow> 0"
 unfolding part_equivp_def proof(auto intro!: ext)
   show "\<exists>x. Cauchy x"
     by (rule exI[of _ "\<lambda>_. undefined"]) (simp add: convergent_Cauchy convergent_const)
   fix x y z::"nat \<Rightarrow> 'a" assume H: "(\<lambda>n. dist (x n) (y n)) \<longlonglongrightarrow> 0"
                                    "(\<lambda>n. dist (x n) (z n)) \<longlonglongrightarrow> 0"
   have *: "(\<lambda>n. dist (x n) (y n) + dist (x n) (z n)) \<longlonglongrightarrow> 0 + 0"
     by (rule tendsto_add) (auto simp add: H)
   show "(\<lambda>n. dist (y n) (z n)) \<longlonglongrightarrow> 0"
     apply (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. dist (x n) (y n) + dist (x n) (z n)"])
     using * by (auto simp add: dist_triangle3)
 next
   fix x y z::"nat \<Rightarrow> 'a" assume H: "(\<lambda>n. dist (x n) (y n)) \<longlonglongrightarrow> 0"
                                    "(\<lambda>n. dist (y n) (z n)) \<longlonglongrightarrow> 0"
   have *: "(\<lambda>n. dist (x n) (y n) + dist (y n) (z n)) \<longlonglongrightarrow> 0 + 0"
     by (rule tendsto_add) (auto simp add: H)
   show "(\<lambda>n. dist (x n) (z n)) \<longlonglongrightarrow> 0"
     apply (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. dist (x n) (y n) + dist (y n) (z n)"])
     using * by (auto simp add: dist_triangle)
 next
   fix x y::"nat \<Rightarrow> 'a" assume H: "Cauchy x"
     "(\<lambda>v. Cauchy v \<and> (\<lambda>n. dist (x n) (v n)) \<longlonglongrightarrow> 0) = (\<lambda>v. Cauchy v \<and> (\<lambda>n. dist (y n) (v n)) \<longlonglongrightarrow> 0)"
   have "Cauchy x \<and> (\<lambda>n. dist (x n) (x n)) \<longlonglongrightarrow> 0" using H by auto
   then have "(\<lambda>n. dist (y n) (x n))\<longlonglongrightarrow> 0" using H by meson
   moreover have "dist (x n) (y n) = dist (y n) (x n)" for n using dist_commute by auto
   ultimately show "(\<lambda>n. dist (x n) (y n)) \<longlonglongrightarrow> 0" by auto
 qed
 
 text \<open>We have to show that the metric completion is indeed a metric space, that
 the original space embeds isometrically into it, and that it is complete. Before we prove these
 statements, we start with two simple lemmas that will be needed later on.\<close>
 
 lemma convergent_Cauchy_dist:
   fixes u v::"nat \<Rightarrow> ('a::metric_space)"
   assumes "Cauchy u" "Cauchy v"
   shows "convergent (\<lambda>n. dist (u n) (v n))"
 proof (rule real_Cauchy_convergent, intro CauchyI)
   fix e::real assume "e > 0"
   obtain Nu where Nu: "\<forall>n \<ge> Nu. \<forall>m \<ge> Nu. dist (u n) (u m) < e/2" using assms(1)
     by (metis \<open>0 < e\<close> less_divide_eq_numeral1(1) metric_CauchyD mult_zero_left)
   obtain Nv where Nv: "\<forall>n \<ge> Nv. \<forall>m \<ge> Nv. dist (v n) (v m) < e/2" using assms(2)
     by (metis \<open>0 < e\<close> less_divide_eq_numeral1(1) metric_CauchyD mult_zero_left)
   define M where "M = max Nu Nv"
   {
     fix n m assume H: "n \<ge> M" "m \<ge> M"
     have *: "dist (u n) (u m) < e/2" "dist (v n) (v m) < e/2"
       using Nu Nv H unfolding M_def by auto
     have "dist (u m) (v m) - dist (u n) (v n) \<le> dist (u m) (u n) + dist (v n) (v m)"
       by (simp add: algebra_simps) (metis add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
     also have "... < e/2 + e/2"
       using * by (simp add: dist_commute)
     finally have A: "dist (u m) (v m) - dist (u n) (v n) < e" by simp
 
     have "dist (u n) (v n) - dist (u m) (v m) \<le> dist (u m) (u n) + dist (v n) (v m)"
       by (simp add: algebra_simps) (metis add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
     also have "... < e/2 + e/2"
       using * by (simp add: dist_commute)
     finally have "dist (u n) (v n) - dist (u m) (v m) < e" by simp
     then have "norm(dist (u m) (v m) - dist (u n) (v n)) < e" using A by auto
   }
   then show "\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. norm (dist (u m) (v m) - dist (u n) (v n)) < e"
     by auto
 qed
 
 lemma convergent_add_null:
   fixes u v::"nat \<Rightarrow> ('a::real_normed_vector)"
   assumes "convergent u"
           "(\<lambda>n. v n - u n) \<longlonglongrightarrow> 0"
   shows "convergent v" "lim v = lim u"
 proof -
   have "(\<lambda>n. u n + (v n - u n)) \<longlonglongrightarrow> lim u + 0"
     apply (rule tendsto_add) using assms convergent_LIMSEQ_iff by auto
   then have *: "v \<longlonglongrightarrow> lim u" by auto
   show "convergent v" using * by (simp add: Lim_def convergentI)
   show "lim v = lim u" using * by (simp add: limI)
 qed
 
 text \<open>Let us now prove that the metric completion is a metric space: the distance between two
 Cauchy sequences is the limit of the distances of points in the sequence. The convergence follows
 from Lemma~\verb+convergent_Cauchy_dist+ above.\<close>
 
 instantiation metric_completion :: (metric_space) metric_space
 begin
 
 lift_definition dist_metric_completion::"('a::metric_space) metric_completion \<Rightarrow> 'a metric_completion \<Rightarrow> real"
   is "\<lambda>x y. lim (\<lambda>n. dist (x n) (y n))"
 proof -
   fix x y z t::"nat \<Rightarrow> 'a" assume H: "Cauchy x \<and> Cauchy y \<and> (\<lambda>n. dist (x n) (y n)) \<longlonglongrightarrow> 0"
                                      "Cauchy z \<and> Cauchy t \<and> (\<lambda>n. dist (z n) (t n)) \<longlonglongrightarrow> 0"
   show "lim (\<lambda>n. dist (x n) (z n)) = lim (\<lambda>n. dist (y n) (t n))"
   proof (rule convergent_add_null(2))
     show "convergent (\<lambda>n. dist (y n) (t n))"
       apply (rule convergent_Cauchy_dist) using H by auto
 
     have a: "(\<lambda>n. - dist (t n) (z n) - dist (x n) (y n)) \<longlonglongrightarrow> -0 -0"
       apply (intro tendsto_intros) using H by (auto simp add: dist_commute)
     have b:"(\<lambda>n. dist (t n) (z n) + dist (x n) (y n)) \<longlonglongrightarrow> 0 + 0"
       apply (rule tendsto_add) using H by (auto simp add: dist_commute)
     have I: "dist (x n) (z n) \<le> dist (t n) (y n) + (dist (t n) (z n) + dist (x n) (y n))" for n
       using dist_triangle[of "x n" "z n" "y n"] dist_triangle[of "y n" "z n" "t n"]
       by (auto simp add: dist_commute add.commute)
     show "(\<lambda>n. dist (x n) (z n) - dist (y n) (t n)) \<longlonglongrightarrow> 0"
       apply (rule tendsto_sandwich[of "\<lambda>n. -(dist (x n) (y n) + dist (z n) (t n))" _ _ "\<lambda>n. dist (x n) (y n) + dist (z n) (t n)"])
       apply (auto intro!: always_eventually simp add: algebra_simps dist_commute I)
       apply (meson add_left_mono dist_triangle3 dist_triangle_le)
       using a b by auto
   qed
 qed
 
 lemma dist_metric_completion_limit:
   fixes x y::"'a metric_completion"
   shows "(\<lambda>n. dist (rep_metric_completion x n) (rep_metric_completion y n)) \<longlonglongrightarrow> dist x y"
 proof -
   have C: "Cauchy (rep_metric_completion x)" "Cauchy (rep_metric_completion y)"
     using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
   show ?thesis
     unfolding dist_metric_completion_def using C apply auto
     using convergent_Cauchy_dist[OF C] convergent_LIMSEQ_iff by force
 qed
 
 lemma dist_metric_completion_limit':
   fixes x y::"nat \<Rightarrow> 'a"
   assumes "Cauchy x" "Cauchy y"
   shows "(\<lambda>n. dist (x n) (y n)) \<longlonglongrightarrow> dist (abs_metric_completion x) (abs_metric_completion y)"
 apply (subst dist_metric_completion.abs_eq)
 using assms convergent_Cauchy_dist[OF assms] by (auto simp add: convergent_LIMSEQ_iff)
 
 text \<open>To define a metric space in the current library of Isabelle/HOL, one should also introduce
 a uniformity structure and a topology, as follows (they are prescribed by the distance):\<close>
 
 definition uniformity_metric_completion::"(('a metric_completion) \<times> ('a metric_completion)) filter"
   where "uniformity_metric_completion = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_metric_completion :: "'a metric_completion set \<Rightarrow> bool"
   where "open_metric_completion U = (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance proof
   fix x y::"'a metric_completion"
   have C: "Cauchy (rep_metric_completion x)" "Cauchy (rep_metric_completion y)"
     using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
   show "(dist x y = 0) = (x = y)"
     apply (subst Quotient3_rel_rep[OF Quotient3_metric_completion, symmetric])
     unfolding dist_metric_completion_def using C apply auto
     using convergent_Cauchy_dist[OF C] convergent_LIMSEQ_iff apply force
     by (simp add: limI)
 next
   fix x y z::"'a metric_completion"
   have a: "(\<lambda>n. dist (rep_metric_completion x n) (rep_metric_completion y n)) \<longlonglongrightarrow> dist x y"
     using dist_metric_completion_limit by auto
   have b: "(\<lambda>n. dist (rep_metric_completion x n) (rep_metric_completion z n) + dist (rep_metric_completion y n) (rep_metric_completion z n))
       \<longlonglongrightarrow> dist x z + dist y z"
     apply (rule tendsto_add) using dist_metric_completion_limit by auto
   show "dist x y \<le> dist x z + dist y z"
     by (rule LIMSEQ_le[OF a b], rule exI[of _ 0], auto simp add: dist_triangle2)
 qed (auto simp add: uniformity_metric_completion_def open_metric_completion_def)
 end
 
 text \<open>Let us now show that the distance thus defined on the metric completion is indeed complete.
 This is essentially by design.\<close>
 
 instance metric_completion :: (metric_space) complete_space
 proof
   fix X::"nat \<Rightarrow> 'a metric_completion" assume "Cauchy X"
   have *: "\<exists>N. \<forall>n \<ge> N. dist (rep_metric_completion (X k) N) (rep_metric_completion (X k) n) < (1/Suc k)" for k
   proof -
     have "Cauchy (rep_metric_completion (X k))"
       using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
     then have "\<exists>N. \<forall>m \<ge> N. \<forall>n \<ge> N. dist (rep_metric_completion (X k) m) (rep_metric_completion (X k) n) < (1/Suc k)"
       unfolding Cauchy_def by auto
     then show ?thesis by auto
   qed
   have "\<exists>N. \<forall>k. \<forall>n \<ge> N k. dist (rep_metric_completion (X k) (N k)) (rep_metric_completion (X k) n) < (1/Suc k)"
     apply (rule choice) using * by auto
   then obtain N::"nat \<Rightarrow> nat" where
     N: "dist (rep_metric_completion (X k) (N k)) (rep_metric_completion (X k) n) < (1/Suc k)" if "n \<ge> N k" for n k
     by auto
   define u where "u = (\<lambda>k. rep_metric_completion (X k) (N k))"
 
   have "Cauchy u"
   proof (rule metric_CauchyI)
     fix e::real assume "e > 0"
     obtain K::nat where "K > 4/e" using reals_Archimedean2 by blast
     obtain L::nat where L: "\<forall>m \<ge> L. \<forall>n \<ge> L. dist (X m) (X n) < e/2"
       using metric_CauchyD[OF \<open>Cauchy X\<close>, of "e/2"] \<open>e > 0\<close> by auto
     {
       fix m n assume "m \<ge> max K L" "n \<ge> max K L"
       then have "dist (X m) (X n) < e/2" using L by auto
       then have "eventually (\<lambda>p. dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) < e/2) sequentially"
         using dist_metric_completion_limit[of "X m" "X n"] by (metis order_tendsto_iff)
       then obtain p where p: "p \<ge> max (N m) (N n)" "dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) < e/2"
         using eventually_False_sequentially eventually_elim2 eventually_ge_at_top by blast
       have "dist (u m) (rep_metric_completion (X m) p) < 1 / real (Suc m)"
         unfolding u_def using N[of m p] p(1) by auto
       also have "... < e/4"
         using \<open>m \<ge> max K L\<close> \<open>K > 4/e\<close> \<open>e > 0\<close> apply (auto simp add: divide_simps algebra_simps)
-        by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff real_mult_le_cancel_iff2)
+        by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
       finally have Im: "dist (u m) (rep_metric_completion (X m) p) < e/4" by simp
       have "dist (u n) (rep_metric_completion (X n) p) < 1 / real (Suc n)"
         unfolding u_def using N[of n p] p(1) by auto
       also have "... < e/4"
         using \<open>n \<ge> max K L\<close> \<open>K > 4/e\<close> \<open>e > 0\<close> apply (auto simp add: divide_simps algebra_simps)
-        by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff real_mult_le_cancel_iff2)
+        by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
       finally have In: "dist (u n) (rep_metric_completion (X n) p) < e/4" by simp
 
       have "dist (u m) (u n) \<le> dist (u m) (rep_metric_completion (X m) p)
           + dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) + dist (rep_metric_completion (X n) p) (u n)"
         by (metis add.commute add_left_mono dist_commute dist_triangle_le dist_triangle)
       also have "... < e/4 + e/2 + e/4"
         using In Im p(2) by (simp add: dist_commute)
       also have "... = e" by auto
       finally have "dist (u m) (u n) < e" by auto
     }
     then show "\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. dist (u m) (u n) < e" by meson
   qed
   have *: "(\<lambda>n. dist (abs_metric_completion u) (X n)) \<longlonglongrightarrow> 0"
   proof (rule order_tendstoI, auto simp add: less_le_trans eventually_sequentially)
     fix e::real assume "e > 0"
     obtain K::nat where "K > 4/e" using reals_Archimedean2 by blast
     obtain L::nat where L: "\<forall>m \<ge> L. \<forall>n \<ge> L. dist (u m) (u n) < e/4"
       using metric_CauchyD[OF \<open>Cauchy u\<close>, of "e/4"] \<open>e > 0\<close> by auto
     {
       fix n assume n: "n \<ge> max K L"
       {
         fix p assume p: "p \<ge> max (N n) L"
         have "dist (u n) (rep_metric_completion (X n) p) < 1/(Suc n)"
           unfolding u_def using N p by simp
         also have "... < e/4"
           using \<open>n \<ge> max K L\<close> \<open>K > 4/e\<close> \<open>e > 0\<close> apply (auto simp add: divide_simps algebra_simps)
-          by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff real_mult_le_cancel_iff2)
+          by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
         finally have *: "dist (u n) (rep_metric_completion (X n) p) < e/4"
           by fastforce
 
         have "dist (u p) (rep_metric_completion (X n) p) \<le> dist (u p) (u n) + dist (u n) (rep_metric_completion (X n) p)"
           using dist_triangle by auto
         also have "... < e/4 + e/4" using * L n p by force
         finally have "dist (u p) (rep_metric_completion (X n) p) \<le> e/2" by auto
       }
       then have A: "eventually (\<lambda>p. dist (u p) (rep_metric_completion (X n) p) \<le> e/2) sequentially"
         using eventually_at_top_linorder by blast
       have B: "(\<lambda>p. dist (u p) (rep_metric_completion (X n) p)) \<longlonglongrightarrow> dist (abs_metric_completion u) (X n)"
         using dist_metric_completion_limit'[OF \<open>Cauchy u\<close>, of "rep_metric_completion (X n)"]
         unfolding Quotient3_abs_rep[OF Quotient3_metric_completion, of "X n"]
         using Quotient3_rep_reflp[OF Quotient3_metric_completion] by auto
       have "dist (abs_metric_completion u) (X n) \<le> e/2"
         apply (rule LIMSEQ_le_const2[OF B]) using A unfolding eventually_sequentially by auto
       then have "dist (abs_metric_completion u) (X n) < e" using \<open>e > 0\<close> by auto
     }
     then show "\<exists>N. \<forall>n \<ge> N. dist (abs_metric_completion u) (X n) < e"
       by blast
   qed
   have "X \<longlonglongrightarrow> abs_metric_completion u"
     apply (rule tendstoI) using * by (auto simp add: order_tendsto_iff dist_commute)
   then show "convergent X" unfolding convergent_def by auto
 qed
 
 subsection \<open>Isometric embedding of a space in its metric completion\<close>
 
 text \<open>The canonical embedding of a space into its metric completion is obtained by taking
 the Cauchy sequence which is constant, equal to the given point. This is indeed an isometric
 embedding with dense image, as we prove in the lemmas below.\<close>
 
 definition to_metric_completion::"('a::metric_space) \<Rightarrow> 'a metric_completion"
   where "to_metric_completion x = abs_metric_completion (\<lambda>n. x)"
 
 lemma to_metric_completion_isometry:
   "isometry_on UNIV to_metric_completion"
 proof (rule isometry_onI)
   fix x y::'a
   have "(\<lambda>n. dist (x) (y)) \<longlonglongrightarrow> dist (to_metric_completion x) (to_metric_completion y)"
     unfolding to_metric_completion_def apply (rule dist_metric_completion_limit')
     unfolding Cauchy_def by auto
   then show "dist (to_metric_completion x) (to_metric_completion y) = dist x y"
     by (simp add: LIMSEQ_const_iff)
 qed
 
 lemma to_metric_completion_dense:
   assumes "open U" "U \<noteq> {}"
   shows "\<exists>x. to_metric_completion x \<in> U"
 proof -
   obtain y where "y \<in> U" using \<open>U \<noteq> {}\<close> by auto
   obtain e::real where e: "e > 0" "\<And>z. dist z y < e \<Longrightarrow> z \<in> U"
     using \<open>y \<in> U\<close> \<open>open U\<close> by (metis open_dist)
   have *: "Cauchy (rep_metric_completion y)"
     using Quotient3_metric_completion Quotient3_rep_reflp by fastforce
   then obtain N where N: "\<forall>n \<ge> N. \<forall>m \<ge> N. dist (rep_metric_completion y n) (rep_metric_completion y m) < e/2"
     using \<open>e > 0\<close> unfolding Cauchy_def by (meson divide_pos_pos zero_less_numeral)
   define x where "x = rep_metric_completion y N"
   have "(\<lambda>n. dist x (rep_metric_completion y n)) \<longlonglongrightarrow> dist (to_metric_completion x) (abs_metric_completion (rep_metric_completion y))"
     unfolding to_metric_completion_def apply (rule dist_metric_completion_limit')
     using * unfolding Cauchy_def by auto
   then have "(\<lambda>n. dist x (rep_metric_completion y n)) \<longlonglongrightarrow> dist (to_metric_completion x) y"
     unfolding Quotient3_abs_rep[OF Quotient3_metric_completion] by simp
   moreover have "eventually (\<lambda>n. dist x (rep_metric_completion y n) \<le> e/2) sequentially"
     unfolding eventually_sequentially x_def apply (rule exI[of _ N]) using N less_imp_le by auto
   ultimately have "dist (to_metric_completion x) y \<le> e/2"
     using LIMSEQ_le_const2 unfolding eventually_sequentially by metis
   then have "to_metric_completion x \<in> U"
     using e by auto
   then show ?thesis by auto
 qed
 
 lemma to_metric_completion_dense':
   "closure (range to_metric_completion) = UNIV"
 apply (auto simp add: closure_iff_nhds_not_empty) using to_metric_completion_dense by fastforce
 
 text \<open>The main feature of the completion is that a uniformly continuous function on the original space can be extended
 to a uniformly continuous function on the completion, i.e., it can be written as the composition of
 a new function and of the inclusion \verb+to_metric_completion+.\<close>
 
 lemma lift_to_metric_completion:
   fixes f::"('a::metric_space) \<Rightarrow> ('b::complete_space)"
   assumes "uniformly_continuous_on UNIV f"
   shows "\<exists>g. (uniformly_continuous_on UNIV g)
             \<and> (f = g o to_metric_completion)
             \<and> (\<forall>x \<in> range to_metric_completion. g x = f (inv to_metric_completion x))"
 proof -
   define I::"'a metric_completion \<Rightarrow> 'a" where "I = inv to_metric_completion"
   have "uniformly_continuous_on (range to_metric_completion) I"
     using isometry_on_uniformly_continuous[OF isometry_on_inverse(1)[OF to_metric_completion_isometry]] I_def
     by auto
   then have UC: "uniformly_continuous_on (range to_metric_completion) (\<lambda>x. f (I x))"
     using assms uniformly_continuous_on_compose
     by (metis I_def bij_betw_imp_surj_on bij_betw_inv_into isometry_on_inverse(4) to_metric_completion_isometry)
   obtain g where g: "uniformly_continuous_on (closure(range to_metric_completion)) g"
                     "\<And>x. x \<in> range to_metric_completion \<Longrightarrow> f (I x) = g x"
     using uniformly_continuous_on_extension_on_closure[OF UC] by metis
   have "uniformly_continuous_on UNIV g"
     using to_metric_completion_dense' g(1) by metis
   moreover have "f x = g (to_metric_completion x)" for x
     using g(2) by (metis I_def UNIV_I isometry_on_inverse(2) range_eqI to_metric_completion_isometry)
   moreover have "g x = f (inv to_metric_completion x)" if "x \<in> range to_metric_completion" for x
     using I_def g(2) that by auto
   ultimately show ?thesis unfolding comp_def by auto
 qed
 
 text \<open>When the function is an isometry, the lifted function is also an isometry (and its range is
 the closure of the range of the original function).
 This shows that the metric completion is unique, up to isometry:\<close>
 
 lemma lift_to_metric_completion_isometry:
   fixes f::"('a::metric_space) \<Rightarrow> ('b::complete_space)"
   assumes "isometry_on UNIV f"
   shows "\<exists>g. isometry_on UNIV g
           \<and> range g = closure(range f)
           \<and> f = g o to_metric_completion
           \<and> (\<forall>x \<in> range to_metric_completion. g x = f (inv to_metric_completion x))"
 proof -
   have *: "uniformly_continuous_on UNIV f" using assms isometry_on_uniformly_continuous by force
   obtain g where g: "uniformly_continuous_on UNIV g"
                     "f = g o to_metric_completion"
                     "\<And>x. x \<in> range to_metric_completion \<Longrightarrow> g x = f (inv to_metric_completion x)"
     using lift_to_metric_completion[OF *] by blast
   have *: "isometry_on (range to_metric_completion) g"
     apply (rule isometry_on_cong[OF _ g(3)], rule isometry_on_compose[of _ _ f])
     using assms isometry_on_inverse[OF to_metric_completion_isometry] isometry_on_subset by (auto) (fastforce)
   then have "isometry_on UNIV g"
     unfolding to_metric_completion_dense'[symmetric] apply (rule isometry_on_closure)
     using continuous_on_subset[OF uniformly_continuous_imp_continuous[OF g(1)]] by auto
 
   have "g`(range to_metric_completion) \<subseteq> range f"
     using g unfolding comp_def by auto
   moreover have "g`(closure (range to_metric_completion)) \<subseteq> closure (g`(range to_metric_completion))"
     using uniformly_continuous_imp_continuous[OF g(1)]
     by (meson closed_closure closure_subset continuous_on_subset image_closure_subset top_greatest)
   ultimately have "range g \<subseteq> closure (range f)"
     unfolding to_metric_completion_dense' by (simp add: g(2) image_comp)
 
   have "range f \<subseteq> range g"
     using g(2) by auto
   moreover have "closed (range g)"
     using isometry_on_complete_image[OF \<open>isometry_on UNIV g\<close>] by (simp add: complete_eq_closed)
   ultimately have "closure (range f) \<subseteq> range g"
     by (simp add: closure_minimal)
   then have "range g = closure (range f)"
     using \<open>range g \<subseteq> closure (range f)\<close> by auto
   then show ?thesis using \<open>isometry_on UNIV g\<close> g by metis
 qed
 
 subsection \<open>The metric completion of a second countable space is second countable\<close>
 
 text \<open>We want to show that the metric completion of a second countable space is still
 second countable. This is most easily expressed using the fact that a metric
 space is second countable if and only if there exists a dense countable subset. We prove
 the equivalence in the next lemma, and use it then to prove that the metric completion is
 still second countable.\<close>
 
 lemma second_countable_iff_dense_countable_subset:
   "(\<exists>B::'a::metric_space set set. countable B \<and> topological_basis B)
     \<longleftrightarrow> (\<exists>A::'a set. countable A \<and> closure A = UNIV)"
 proof
   assume "\<exists>B::'a set set. countable B \<and> topological_basis B"
   then obtain B::"'a set set" where "countable B" "topological_basis B" by auto
   define A where "A = (\<lambda>U. SOME x. x \<in> U)`B"
   have "countable A" unfolding A_def using \<open>countable B\<close> by auto
   moreover have "closure A = UNIV"
   proof (auto simp add: closure_approachable)
     fix x::'a and e::real assume "e > 0"
     obtain U where "U \<in> B" "x \<in> U" "U \<subseteq> ball x e"
       by (rule topological_basisE[OF \<open>topological_basis B\<close>, of "ball x e" x], auto simp add: \<open>e > 0\<close>)
     define y where "y = (\<lambda>U. SOME x. x \<in> U) U"
     have "y \<in> U" unfolding y_def using \<open>x \<in> U\<close> some_in_eq by fastforce
     then have "dist y x < e"
       using \<open>U \<subseteq> ball x e\<close> by (metis dist_commute mem_ball subset_iff)
     moreover have "y \<in> A" unfolding A_def y_def using \<open>U \<in> B\<close> by auto
     ultimately show "\<exists>y\<in>A. dist y x < e" by auto
   qed
   ultimately show "\<exists>A::'a set. countable A \<and> closure A = UNIV" by auto
 next
   assume "\<exists>A::'a set. countable A \<and> closure A = UNIV"
   then obtain A::"'a set" where "countable A" "closure A = UNIV" by auto
   define B where "B = (\<lambda>(x, (n::nat)). ball x (1/n))`(A \<times> UNIV)"
   have "countable B" unfolding B_def using \<open>countable A\<close> by auto
   moreover have "topological_basis B"
   proof (rule topological_basisI)
     fix x::'a and U assume "x \<in> U" "open U"
     then obtain e where "e > 0" "ball x e \<subseteq> U"
       using openE by blast
     obtain n::nat where "n > 2/e" using reals_Archimedean2 by auto
     then have "n > 0" using \<open>e > 0\<close> not_less by fastforce
     then have "1/n > 0" using zero_less_divide_iff by fastforce
     then obtain y where y: "y \<in> A" "dist x y < 1/n"
       by (metis \<open>closure A = UNIV\<close> UNIV_I closure_approachable dist_commute)
     then have "ball y (1/n) \<in> B" unfolding B_def by auto
     moreover have "x \<in> ball y (1/n)" using y(2) by (auto simp add: dist_commute)
     moreover have "ball y (1/n) \<subseteq> U"
     proof (auto)
       fix z assume z: "dist y z < 1/n"
       have "dist z x \<le> dist z y + dist y x" using dist_triangle by auto
       also have "... < 1/n + 1/n" using z y(2) by (auto simp add: dist_commute)
       also have "... < e"
         using \<open>n > 2/e\<close> \<open>e > 0\<close> \<open>n > 0\<close> by (auto simp add: divide_simps mult.commute)
       finally have "z \<in> ball x e" by (auto simp add: dist_commute)
       then show "z \<in> U" using \<open>ball x e \<subseteq> U\<close> by auto
     qed
     ultimately show "\<exists>V\<in>B. x \<in> V \<and> V \<subseteq> U" by metis
   qed (auto simp add: B_def)
   ultimately show "\<exists>B::'a set set. countable B \<and> topological_basis B" by auto
 qed
 
 lemma second_countable_metric_dense_subset:
   "\<exists>A::'a::{metric_space, second_countable_topology} set. countable A \<and> closure A = UNIV"
 using ex_countable_basis by (auto simp add: second_countable_iff_dense_countable_subset[symmetric])
 
 instance metric_completion::("{metric_space, second_countable_topology}") second_countable_topology
 proof
   obtain A::"'a set" where "countable A" "closure A = UNIV"
     using second_countable_metric_dense_subset by auto
   define Ab where "Ab = to_metric_completion`A"
   have "range to_metric_completion \<subseteq> closure Ab"
     unfolding Ab_def
     by (metis \<open>closure A = UNIV\<close> isometry_on_continuous[OF to_metric_completion_isometry] closed_closure closure_subset image_closure_subset)
   then have "closure Ab = UNIV"
     by (metis (no_types) to_metric_completion_dense'[symmetric] \<open>range to_metric_completion \<subseteq> closure Ab\<close> closure_closure closure_mono top.extremum_uniqueI)
   moreover have "countable Ab" unfolding Ab_def using \<open>countable A\<close> by auto
   ultimately have "\<exists>Ab::'a metric_completion set. countable Ab \<and> closure Ab = UNIV"
     by auto
   then show "\<exists>B::'a metric_completion set set. countable B \<and> open = generate_topology B"
     using second_countable_iff_dense_countable_subset topological_basis_imp_subbasis by auto
 qed
 
 instance metric_completion::("{metric_space, second_countable_topology}") polish_space
 by standard
 
 end (*of theory Metric_Completion*)
diff --git a/thys/Interval_Arithmetic_Word32/Interval_Word32.thy b/thys/Interval_Arithmetic_Word32/Interval_Word32.thy
--- a/thys/Interval_Arithmetic_Word32/Interval_Word32.thy
+++ b/thys/Interval_Arithmetic_Word32/Interval_Word32.thy
@@ -1,4143 +1,4143 @@
 (* Author:     Brandon Bohrer *)
 theory Interval_Word32
 imports
   Complex_Main
   Word_Lib.Word_Lib_Sumo
 begin
 
 abbreviation signed_real_of_word :: \<open>'a::len word \<Rightarrow> real\<close>
   where \<open>signed_real_of_word \<equiv> signed\<close>
 
 lemma (in linordered_idom) signed_less_numeral_iff:
   \<open>signed w < numeral n \<longleftrightarrow> sint w < numeral n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> of_int (sint w) < of_int (numeral n)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by (transfer fixing: less less_eq n) simp
   finally show ?thesis ..
 qed
 
 lemma (in linordered_idom) signed_less_neg_numeral_iff:
   \<open>signed w < - numeral n \<longleftrightarrow> sint w < - numeral n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> of_int (sint w) < of_int (- numeral n)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by (transfer fixing: less less_eq uminus n) simp
   finally show ?thesis ..
 qed
 
 lemma (in linordered_idom) numeral_less_signed_iff:
   \<open>numeral n < signed w \<longleftrightarrow> numeral n < sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> of_int (numeral n) < of_int (sint w)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by (transfer fixing: less less_eq n) simp
   finally show ?thesis ..
 qed
 
 lemma (in linordered_idom) neg_numeral_less_signed_iff:
   \<open>- numeral n < signed w \<longleftrightarrow> - numeral n < sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> of_int (- numeral n) < of_int (sint w)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by (transfer fixing: less less_eq uminus n) simp
   finally show ?thesis ..
 qed
 
 lemma (in linordered_idom) signed_nonnegative_iff:
   \<open>0 \<le> signed w \<longleftrightarrow> 0 \<le> sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> of_int 0 \<le> of_int (sint w)\<close>
     by (simp only: of_int_le_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by (transfer fixing: less_eq) simp
   finally show ?thesis ..
 qed
 
 lemma signed_real_of_word_plus_numeral_eq_signed_real_of_word_iff:
   \<open>signed_real_of_word v + numeral n = signed_real_of_word w
     \<longleftrightarrow> sint v + numeral n = sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (sint v + numeral n) = real_of_int (sint w)\<close>
     by (simp only: of_int_eq_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma signed_real_of_word_sum_less_eq_numeral_iff:
   \<open>signed_real_of_word v + signed_real_of_word w \<le> numeral n
     \<longleftrightarrow> sint v + sint w \<le> numeral n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (sint v + sint w) \<le> real_of_int (numeral n)\<close>
     by (simp only: of_int_le_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma signed_real_of_word_sum_less_eq_neg_numeral_iff:
   \<open>signed_real_of_word v + signed_real_of_word w \<le> - numeral n
     \<longleftrightarrow> sint v + sint w \<le> - numeral n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (sint v + sint w) \<le> real_of_int (- numeral n)\<close>
     by (simp only: of_int_le_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma signed_real_of_word_sum_less_numeral_iff:
   \<open>signed_real_of_word v + signed_real_of_word w < numeral n
     \<longleftrightarrow> sint v + sint w < numeral n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (sint v + sint w) < real_of_int (numeral n)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma signed_real_of_word_sum_less_neg_numeral_iff:
   \<open>signed_real_of_word v + signed_real_of_word w < - numeral n
     \<longleftrightarrow> sint v + sint w < - numeral n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (sint v + sint w) < real_of_int (- numeral n)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma numeral_less_eq_signed_real_of_word_sum:
   \<open>numeral n \<le> signed_real_of_word v + signed_real_of_word w
     \<longleftrightarrow> numeral n \<le> sint v + sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (numeral n) \<le> real_of_int (sint v + sint w)\<close>
     by (simp only: of_int_le_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma neg_numeral_less_eq_signed_real_of_word_sum:
   \<open>- numeral n \<le> signed_real_of_word v + signed_real_of_word w
     \<longleftrightarrow> - numeral n \<le> sint v + sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (- numeral n) \<le> real_of_int (sint v + sint w)\<close>
     by (simp only: of_int_le_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma numeral_less_signed_real_of_word_sum:
   \<open>numeral n < signed_real_of_word v + signed_real_of_word w
     \<longleftrightarrow> numeral n < sint v + sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (numeral n) < real_of_int (sint v + sint w)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemma neg_numeral_less_signed_real_of_word_sum:
   \<open>- numeral n < signed_real_of_word v + signed_real_of_word w
     \<longleftrightarrow> - numeral n < sint v + sint w\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof -
   have \<open>?Q \<longleftrightarrow> real_of_int (- numeral n) < real_of_int (sint v + sint w)\<close>
     by (simp only: of_int_less_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?P\<close>
     by simp
   finally show ?thesis ..
 qed
 
 lemmas real_of_word_simps [simp] = signed_less_numeral_iff [where ?'a = real]
   numeral_less_signed_iff [where ?'a = real]
   signed_less_neg_numeral_iff [where ?'a = real]
   neg_numeral_less_signed_iff [where ?'a = real]
   signed_nonnegative_iff [where ?'a = real]
 
 lemmas more_real_of_word_simps =
   signed_real_of_word_plus_numeral_eq_signed_real_of_word_iff
   signed_real_of_word_sum_less_eq_numeral_iff
   signed_real_of_word_sum_less_eq_neg_numeral_iff
   signed_real_of_word_sum_less_numeral_iff
   signed_real_of_word_sum_less_neg_numeral_iff
   numeral_less_eq_signed_real_of_word_sum
   neg_numeral_less_eq_signed_real_of_word_sum
   numeral_less_signed_real_of_word_sum
   neg_numeral_less_signed_real_of_word_sum
 
 declare more_real_of_word_simps [simp]
 
 text\<open>Interval-Word32.thy implements conservative interval arithmetic operators on 32-bit word 
    values, with explicit infinities for values outside the representable bounds. It is suitable 
    for use in interpreters for languages which  must have a well-understood low-level behavior
    (see Interpreter.thy). This work was originally part of the paper by Bohrer \emph{et al.}~\cite{BohrerTMMP18}.
 
    It is worth noting that this is not the first formalization of interval arithmetic in 
    Isabelle/HOL. This article is presented regardless because it has unique goals in mind
    which have led to unique design decisions. Our goal is generate code which can be used to 
    perform conservative arithmetic in implementations extracted from a proof.
 
    The Isabelle standard library now features interval arithmetic, for example in Approximation.thy.
    Ours differs in two ways:
    1) We use intervals with explicit positive and negative infinities, and with overflow checking.
       Such checking is often relevant in implementation-level code with unknown inputs.
       To promote memory-efficient implementations, we moreover use sentinel values for infinities,
       rather than datatype constructors. This is especially important in real-time settings where
       the garbarge collection required for datatypes can be a concern.
    2) Our goal is not to use interval arithmetic to discharge Isabelle goals, but to generate useful
       proven-correct implementation code, see Interpreter.thy. On the other hand,  we are not 
       concerned with producing interval-based automation for arithmetic goals in HOL.
 
    In practice, much of the work in this theory comes down to sheer case-analysis.
    Bounds-checking requires many edge cases in arithmetic functions, which come with many cases in
    proofs. Where possible, we attempt to offload interesting facts about word representations of 
    numbers into reusable lemmas, but even then main results require many subcases, each with 
    a certain amount of arithmetic grunt work.
 \<close>
 
 section \<open>Interval arithmetic definitions\<close>
 subsection \<open>Syntax\<close>
 text\<open>Words are 32-bit\<close>
 type_synonym word = "32 Word.word"
 
 text\<open>Sentinel values for infinities. Note that we leave the maximum value ($2^31$) 
   completed unused, so that negation of $(2^{31})-1$ is not an edge case\<close>
 definition NEG_INF::"word"
 where NEG_INF_def[simp]:"NEG_INF = -((2 ^ 31) -1)"
 
 definition NegInf::"real"
 where NegInf[simp]:"NegInf = real_of_int (sint NEG_INF)"
 
 definition POS_INF::"word"
 where POS_INF_def[simp]:"POS_INF = (2^31) - 1"
 
 definition PosInf::"real"
 where PosInf[simp]:"PosInf = real_of_int (sint POS_INF)"
 
 text\<open>Subtype of words who represent a finite value. \<close>
 typedef bword = "{n::word. sint n \<ge> sint NEG_INF \<and> sint n \<le> sint POS_INF}"
   apply(rule exI[where x=NEG_INF])
   by (auto)
 
 text\<open>Numeric literals\<close>
 type_synonym lit = bword
       
 setup_lifting type_definition_bword
 
 lift_definition bword_zero::"bword" is "0::32 Word.word"
   by auto
 
 lift_definition bword_one::"bword" is "1::32 Word.word"
   by(auto simp add: sint_uint)
 
 lift_definition bword_neg_one::"bword" is "-1::32 Word.word"
   by(auto)
 
 
 definition word::"word \<Rightarrow> bool"
 where word_def[simp]:"word w \<equiv> w \<in> {NEG_INF..POS_INF}"
 
 
 named_theorems rep_simps "Simplifications for representation functions"
 
 text\<open>Definitions of interval containment and word representation
 repe w r iff word w encodes real number r\<close>
 inductive repe ::"word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>E" 10)
 where 
   repPOS_INF:"r \<ge> real_of_int (sint POS_INF) \<Longrightarrow> repe POS_INF r" 
 | repNEG_INF:"r \<le> real_of_int (sint NEG_INF) \<Longrightarrow> repe NEG_INF r"
 | repINT:"(sint w) < real_of_int(sint POS_INF) \<Longrightarrow> (sint w) > real_of_int(sint NEG_INF) 
     \<Longrightarrow> repe w (sint w)"
 
 inductive_simps 
     repePos_simps[rep_simps]:"repe POS_INF r"
 and repeNeg_simps[rep_simps]:"repe NEG_INF r"
 and repeInt_simps[rep_simps]:"repe w (sint w)"
 
 text\<open>repU w r if w represents an upper bound of r\<close>
 definition repU ::"word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>U" 10)
 where "repU w r \<equiv> \<exists> r'. r' \<ge> r \<and> repe w r'"
 
 lemma repU_leq:"repU w r \<Longrightarrow> r' \<le> r \<Longrightarrow> repU w r'"
   unfolding repU_def
   using order_trans by auto
 
 text\<open>repU w r if w represents a lower bound of r\<close>
 definition repL ::"word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>L" 10)
 where "repL w r \<equiv> \<exists> r'. r' \<le> r \<and> repe w r'"
 
 lemma repL_geq:"repL w r \<Longrightarrow> r' \<ge> r \<Longrightarrow> repL w r'"
   unfolding repL_def
   using order_trans by auto
 
 text\<open>repP (l,u) r  iff l and u encode lower and upper bounds of r\<close>
 definition repP ::"word * word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>P" 10)
 where "repP w r \<equiv> let (w1, w2) = w in repL w1 r \<and> repU w2 r" 
 
 
 lemma int_not_posinf:
   assumes b1:"real_of_int (sint ra) <  real_of_int (sint POS_INF)"
   assumes b2:"real_of_int (sint NEG_INF) <  real_of_int (sint ra)"
   shows "ra \<noteq> POS_INF"
   using b1 b2 by auto
         
 lemma int_not_neginf:
   assumes b1:" real_of_int (sint ra) <  real_of_int (sint POS_INF)"
   assumes b2:" real_of_int (sint NEG_INF) <  real_of_int (sint ra)"
   shows "ra \<noteq> NEG_INF"
   using b1 b2 by auto
 
 lemma int_not_undef:
   assumes b1:"real_of_int (sint ra) <  real_of_int (sint POS_INF)"
   assumes b2:"real_of_int (sint NEG_INF) < real_of_int (sint ra)"
   shows "ra \<noteq> NEG_INF-1"
   using b1 b2 by auto
 
 lemma sint_range:
   assumes b1:"real_of_int (sint ra) < real_of_int (sint POS_INF)"
   assumes b2:"real_of_int (sint NEG_INF) < real_of_int (sint ra)"
   shows "sint ra  \<in> {i. i > -((2^31)-1)  \<and> i < (2^31)-1}"
   using b1 b2 by auto
 
 lemma word_size_neg:
   fixes w :: "32 Word.word"
   shows "size (-w) = size w"
   using Word.word_size[of w] Word.word_size[of "-w"] by auto
 
 lemma uint_distinct:
   fixes w1 w2
   shows "w1 \<noteq> w2 \<Longrightarrow> uint w1 \<noteq> uint w2"
   by auto
 
 section \<open>Preliminary lemmas\<close>
 subsection \<open>Case analysis lemmas\<close>
 text\<open>Case analysis principle for pairs of intervals, used in proofs of arithmetic operations\<close>
 lemma ivl_zero_case:
   fixes l1 u1 l2 u2 :: real
   assumes ivl1:"l1 \<le> u1"
   assumes ivl2:"l2 \<le> u2"
   shows 
 "(l1 \<le> 0 \<and> 0 \<le> u1 \<and> l2 \<le> 0 \<and> 0 \<le> u2)
 \<or>(l1 \<le> 0 \<and> 0 \<le> u1 \<and> 0 \<le> l2)
 \<or>(l1 \<le> 0 \<and> 0 \<le> u1 \<and> u2 \<le> 0)
 \<or>(0 \<le> l1 \<and> l2 \<le> 0 \<and> 0 \<le> u2)
 \<or>(u1 \<le> 0 \<and> l2 \<le> 0 \<and> 0 \<le> u2)
 \<or>(u1 \<le> 0 \<and> u2 \<le> 0)
 \<or>(u1 \<le> 0 \<and> 0 \<le> l2)
 \<or>(0 \<le> l1 \<and> u2 \<le> 0)
 \<or>(0 \<le> l1 \<and> 0 \<le> l2)"
 using ivl1 ivl2 
 by (metis le_cases)
 
 lemma case_ivl_zero
 [consumes 2, case_names ZeroZero ZeroPos ZeroNeg PosZero NegZero NegNeg NegPos PosNeg PosPos]:
   fixes l1 u1 l2 u2 :: real
   shows
   "l1 \<le> u1 \<Longrightarrow>
    l2 \<le> u2 \<Longrightarrow> 
 ((l1 \<le> 0 \<and> 0 \<le> u1 \<and> l2 \<le> 0 \<and> 0 \<le> u2) \<Longrightarrow> P) \<Longrightarrow>
 ((l1 \<le> 0 \<and> 0 \<le> u1 \<and> 0 \<le> l2) \<Longrightarrow> P) \<Longrightarrow>
 ((l1 \<le> 0 \<and> 0 \<le> u1 \<and> u2 \<le> 0) \<Longrightarrow> P) \<Longrightarrow>
  ((0 \<le> l1 \<and> l2 \<le> 0 \<and> 0 \<le> u2) \<Longrightarrow> P) \<Longrightarrow>
 ((u1 \<le> 0 \<and> l2 \<le> 0 \<and> 0 \<le> u2) \<Longrightarrow> P) \<Longrightarrow>
 ((u1 \<le> 0 \<and> u2 \<le> 0) \<Longrightarrow> P) \<Longrightarrow>
 ((u1 \<le> 0 \<and> 0 \<le> l2) \<Longrightarrow> P) \<Longrightarrow>
 ((0 \<le> l1 \<and> u2 \<le> 0) \<Longrightarrow> P) \<Longrightarrow>
 ((0 \<le> l1 \<and> 0 \<le> l2) \<Longrightarrow> P) \<Longrightarrow> P"
   using ivl_zero_case[of l1 u1 l2 u2]
   by auto
 
 lemma case_inf2[case_names PosPos PosNeg PosNum NegPos NegNeg NegNum NumPos NumNeg NumNum]:
   shows 
   "\<And>w1 w2 P.
       (w1 = POS_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> P w1 w2"
   by(auto)
 
 lemma case_pu_inf[case_names PosAny AnyPos NegNeg NegNum NumNeg NumNum]:
   shows 
   "\<And>w1 w2 P.
       (w1 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> P w1 w2"
   by(auto)
 
 lemma case_pl_inf[case_names NegAny AnyNeg PosPos PosNum NumPos NumNum]:
   shows 
   "\<And>w1 w2 P.
       (w1 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> P w1 w2"
   by(auto)
 
 lemma word_trichotomy[case_names Less Equal Greater]:
   fixes w1 w2 :: word
   shows 
   "(w1 <s w2 \<Longrightarrow> P w1 w2) \<Longrightarrow>
    (w1 = w2  \<Longrightarrow> P w1 w2) \<Longrightarrow>
    (w2 <s w1 \<Longrightarrow> P w1 w2) \<Longrightarrow> P w1 w2"
   using signed.linorder_cases by auto
 
 lemma case_times_inf
  [case_names 
   PosPos NegPos PosNeg NegNeg 
   PosLo PosHi PosZero NegLo NegHi NegZero
   LoPos HiPos ZeroPos LoNeg HiNeg ZeroNeg
   AllFinite]:
   fixes w1 w2 P
   assumes pp:"(w1 = POS_INF \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and np:"(w1 = NEG_INF \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and pn:"(w1 = POS_INF \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and nn:"(w1 = NEG_INF \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and pl:"(w1 = POS_INF \<and> w2 \<noteq> NEG_INF \<and> w2 <s 0 \<Longrightarrow> P w1 w2)"
   and ph:"(w1 = POS_INF \<and> w2 \<noteq> POS_INF \<and> 0 <s w2   \<Longrightarrow> P w1 w2)"
   and pz:"(w1 = POS_INF \<and> w2 = 0 \<Longrightarrow> P w1 w2)"
   and nl:"(w1 = NEG_INF \<and> w2 \<noteq> NEG_INF \<and> w2 <s 0 \<Longrightarrow> P w1 w2)"
   and nh:"(w1 = NEG_INF \<and> w2 \<noteq> POS_INF \<and> 0 <s w2 \<Longrightarrow> P w1 w2)"
   and nz:"(w1 = NEG_INF \<and> 0 = w2 \<Longrightarrow> P w1 w2)"
   and lp:"(w1 \<noteq> NEG_INF \<and> w1 <s 0 \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and hp:"(w1 \<noteq> POS_INF \<and> 0 <s w1 \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and zp:"(0 = w1 \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and ln:"(w1 \<noteq> NEG_INF \<and> w1 <s 0 \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and hn:"(w1 \<noteq> POS_INF \<and> 0 <s w1 \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and zn:"(0 = w1 \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and allFinite:"w1 \<noteq> NEG_INF \<and> w1 \<noteq> POS_INF \<and> w2 \<noteq> NEG_INF \<and> w2 \<noteq> POS_INF \<Longrightarrow> P w1 w2"
   shows " P w1 w2"
   proof (cases rule: word_trichotomy[of w1 0])
     case Less then have w1l:"w1 <s 0" by auto
     then show ?thesis
     proof (cases rule: word_trichotomy[of w2 0])
       case Less
       then show ?thesis 
         using nn nl ln nz zn allFinite w1l lp pl by blast
     next
       case Equal 
       then show ?thesis
         using nn nl ln nz zn  w1l allFinite lp pz
         by (auto)
     next
       case Greater
       then show ?thesis
         using  nh np zp lp w1l allFinite ln ph
         by (auto)
     qed
   next
     case Equal then have w1z:"w1 = 0" by auto
     then show ?thesis
     proof (cases rule: word_trichotomy[of w2 0])
       case Less
       then show ?thesis
         using zn allFinite w1z nl pl zp by auto
     next
       case Equal
       then show ?thesis
         using w1z allFinite
         by (auto)
     next
       case Greater
       then show ?thesis
         using allFinite zp w1z nh ph zn by auto
     qed
   next
     case Greater then have w1h:"0 <s w1" by auto
     then show ?thesis
     proof (cases rule: word_trichotomy[of w2 0])
       case Less
       then show ?thesis
         using pn pl hn  w1h allFinite hp nl by blast
     next
       case Equal
       then show ?thesis
         using pz pz allFinite w1h hn hp nz by blast
     next
       case Greater
       then show ?thesis
         using pp ph hp w1h allFinite hn nh by blast
     qed
   qed
 
 
 subsection \<open>Trivial arithmetic lemmas\<close>
 
 lemma max_diff_pos:"0 \<le> 9223372034707292161 + ((-(2 ^ 31))::real)" by auto
 
 lemma max_less:"2 ^ 31 < (9223372039002259455::int)" by auto
 
 lemma sints64:"sints 64 = {i. - (2 ^ 63) \<le> i \<and> i < 2 ^ 63}"
   using sints_def[of 64] range_sbintrunc[of 63] by auto 
 
 lemma sints32:"sints 32 = {i. - (2 ^ 31) \<le> i \<and> i < 2 ^ 31}"
   using sints_def[of 32] range_sbintrunc[of 31] by auto 
 
 lemma upcast_max:"sint((scast(0x80000001::word))::64 Word.word)=sint((0x80000001::32 Word.word))"
   by auto
 
 lemma upcast_min:"(0xFFFFFFFF80000001::64 Word.word) = ((scast (-0x7FFFFFFF::word))::64 Word.word)"
   by auto
 
 lemma min_extend_neg:"sint ((0xFFFFFFFF80000001)::64 Word.word) < 0"
   by auto
 
 lemma min_extend_val':"sint ((-0x7FFFFFFF)::64 Word.word) = (-0x7FFFFFFF)" by auto
 
 lemma min_extend_val:"(-0x7FFFFFFF::64 Word.word) = 0xFFFFFFFF80000001" by auto
 
 lemma range2s:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
   by auto
 
 
 section \<open>Arithmetic operations\<close>
 text\<open>This section defines operations which conservatively compute upper and lower bounds of 
  arithmetic functions given upper and lower bounds on their arguments. Each function comes with a 
  proof that it rounds in the advertised direction.
 \<close>
 subsection \<open>Addition upper bound\<close>
 text\<open>Upper bound of w1 + w2\<close>
 fun pu :: "word \<Rightarrow> word \<Rightarrow> word"
 where "pu w1 w2 = 
 (if w1 = POS_INF then POS_INF
  else if w2 = POS_INF then POS_INF
  else if w1 = NEG_INF then 
   (if w2 = NEG_INF then NEG_INF 
    else
      (let sum::64 Word.word = ((scast w2)::64 Word.word) + ((scast NEG_INF)::64 Word.word) in
      if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
      else scast sum))
  else if w2 = NEG_INF then 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast NEG_INF)::64 Word.word) in
    if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
    else scast sum)
  else 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word) in
    if ((scast POS_INF)::64 Word.word) <=s (sum::64 Word.word) then POS_INF
    else if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
    else scast sum))"
 
 lemma scast_down_range:
   fixes w::"'a::len Word.word"
   assumes "sint w \<in> sints (len_of (TYPE('b::len)))"
   shows "sint w = sint ((scast w)::'b Word.word)"
   using word_sint.Abs_inverse [OF assms] by simp
 
 lemma pu_lemma:
   fixes w1 w2
   fixes r1 r2 :: real
   assumes up1:"w1 \<equiv>\<^sub>U (r1::real)"
   assumes up2:"w2 \<equiv>\<^sub>U (r2::real)"
   shows   "pu w1 w2 \<equiv>\<^sub>U (r1 + r2)"
 proof -
   have scast_eq1:"sint((scast w1)::64 Word.word) = sint w1" 
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have scast_eq2:"sint((scast (0x80000001::word))::64 Word.word) 
   = sint ((0x80000001::32 Word.word))"
      by auto
   have scast_eq3:"sint((scast w2)::64 Word.word) = sint w2"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have w2Geq:"sint ((scast w2)::64 Word.word) \<ge> - (2 ^ 31) " 
     using word_sint.Rep[of "(w2)::32 Word.word"] sints32 Word.word_size 
       scast_eq1 upcast_max scast_eq3 len32 mem_Collect_eq 
     by auto
   have "sint ((scast w2)::64 Word.word) \<le> 2 ^ 31"
     apply (auto simp add: word_sint.Rep[of "(w2)::32 Word.word"] sints32 
         scast_eq3 len32)
     using word_sint.Rep[of "(w2)::32 Word.word"] len32[of "TYPE(32)"] sints32 by auto
   then have w2Less:"sint ((scast w2)::64 Word.word) < 9223372039002259455" by auto
   have w2Range:
     "-(2 ^ (size ((scast w2)::64 Word.word) - 1)) 
      \<le> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
    \<and> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
      \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
     apply(auto simp add: Word.word_size scast_eq1 upcast_max sints64 max_less)
     using max_diff_pos max_less w2Less w2Geq by auto
   have w2case1a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
             =  sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
     by(rule signed_arith_sint(1)[OF w2Range])
   have w1Lower:"sint ((scast w1)::64 Word.word) \<ge> - (2 ^ 31) " 
     using word_sint.Rep[of "(w1)::32 Word.word"] sints32 Word.word_size scast_eq1 scast_eq2 
       scast_eq3 len32 mem_Collect_eq 
     by auto
   have w1Leq:"sint ((scast w1)::64 Word.word) \<le> 2 ^ 31"
     apply (auto simp add: word_sint.Rep[of "(w1)::32 Word.word"] sints32 scast_eq1 len32)
     using word_sint.Rep[of "(w1)::32 Word.word"] len32[of "TYPE(32)"] sints32 by auto
   then have w1Less:"sint ((scast w1)::64 Word.word) < 9223372039002259455"
     using max_less by auto
   have w1MinusBound:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
     \<le> sint ((scast w1)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
   \<and> sint ((scast w1)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
     \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
     apply(auto simp add:
     Word.word_size[of "(scast w1)::64 Word.word"] 
     Word.word_size[of "(scast (-0x7FFFFFFF))::64 Word.word"]
     scast_eq3 scast_eq2 
     word_sint.Rep[of "(w1)::32 Word.word"]
     word_sint.Rep[of "0x80000001::32 Word.word"]
     word_sint.Rep[of "(scast w1)::64 Word.word"]
     word_sint.Rep[of "-0x7FFFFFFF::64 Word.word"]
     sints64 sints32)
     using w1Lower w1Less by auto
   have w1case1a:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
              = sint ((scast w1)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
     by (rule signed_arith_sint(1)[of "(scast w1)::64 Word.word" "(- 0x7FFFFFFF)", OF w1MinusBound])
   have w1case1a':"sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) 
         = sint ((scast w1)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word)"
     using min_extend_val w1case1a by auto
   have w1Leq':"sint w1 \<le> 2^31 - 1"
     using word_sint.Rep[of "(w1)::32 Word.word"] 
     by (auto simp add:  sints32 len32[of "TYPE(32)"])
   have neg64:"(((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) 
             = ((scast w2)::64 Word.word) + (-0x7FFFFFFF)" by auto
   have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
     by auto
   obtain r'\<^sub>1 and r'\<^sub>2 where   
             geq1:"r'\<^sub>1\<ge>r1" and equiv1:"w1 \<equiv>\<^sub>E r'\<^sub>1"
         and geq2:"r'\<^sub>2\<ge>r2" and equiv2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
           using up1 up2 unfolding repU_def by auto
   show ?thesis
 proof (cases rule: case_pu_inf[where ?w1.0=w1, where ?w2.0=w2])
   case PosAny then show ?thesis
     apply (auto simp add: repU_def repe.simps)
     using linear by blast 
 next
   case AnyPos
   then show ?thesis
   apply (auto simp add: repU_def repe.simps)
   using linear by blast
 next
   case NegNeg
   then show ?thesis 
   using up1 up2 
   by (auto simp add: repU_def repe.simps)
 next
   case NegNum
   assume neq1:"w2 \<noteq> POS_INF"
   assume eq2:"w1 = NEG_INF"
   assume neq3:"w2 \<noteq> NEG_INF"
   let ?sum = "(scast w2 + scast NEG_INF)::64 Word.word"
   have leq1:"r'\<^sub>1 \<le>  (real_of_int (sint NEG_INF))" 
     using equiv1 neq1 eq2 neq3 by (auto simp add: repe.simps)
   have leq2:"r'\<^sub>2 =  (real_of_int (sint w2))"
     using equiv2 neq1 eq2 neq3 by (auto simp add: repe.simps)
   have case1:"?sum <=s ((scast NEG_INF)::64 Word.word) \<Longrightarrow> NEG_INF \<equiv>\<^sub>U r1 + r2"
     using up1 up2
     apply (simp add: repU_def repe.simps word_sle_eq)
     apply (rule exI [where x= "r1 + r2"])
     apply auto
     using w2case1a
     apply (auto simp add: eq2 scast_eq3)
     subgoal for r'
     proof -
       assume \<open>r1 \<le> r'\<close> \<open>r' \<le> - 2147483647\<close> \<open>r2 \<le> signed w2\<close> \<open>sint w2 \<le> 0\<close>
       from \<open>sint w2 \<le> 0\<close> have \<open>real_of_int (sint w2) \<le> real_of_int 0\<close>
         by (simp only: of_int_le_iff)
       then have \<open>signed w2 \<le> (0::real)\<close>
         by simp
       from \<open>r1 \<le> r'\<close> \<open>r' \<le> - 2147483647\<close> have \<open>r1 \<le> - 2147483647\<close>
         by (rule order_trans)
       moreover from \<open>r2 \<le> signed w2\<close> \<open>signed w2 \<le> (0::real)\<close> have \<open>r2 \<le> 0\<close>
         by (rule order_trans)
       ultimately show \<open>r1 + r2 \<le> - 2147483647\<close>
         by simp
     qed
     done   
   have case2:"\<not>(?sum <=s scast NEG_INF) \<Longrightarrow> scast ?sum \<equiv>\<^sub>U r1 + r2"
     apply(simp add: repU_def repe.simps word_sle_def up1 up2)
     apply(rule exI[where x= "r'\<^sub>2 - 0x7FFFFFFF"])
     apply(rule conjI)
     subgoal 
       proof -
         assume " \<not> sint (scast w2 + 0xFFFFFFFF80000001) \<le> - 2147483647"
         have bound1:"r1 \<le> - 2147483647"
           using leq1 geq1 by (auto)
         have bound2:"r2 \<le> r'\<^sub>2"
           using leq2 geq2 by auto        
         show "r1 + r2 \<le> r'\<^sub>2 - 2147483647"
           using bound1 bound2
           by(linarith)
       qed
     apply(rule disjI2)
     apply(rule disjI2)
     apply(auto simp add: not_le)
     subgoal
       proof -
         assume a:"sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647"
         then have sintw2_bound:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
           unfolding min_extend_val by auto 
         have case1a:" sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
                  =  sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
           by(rule signed_arith_sint(1)[OF w2Range])
         have "- 0x7FFFFFFF < sint w2 + (- 0x7FFFFFFF)"
           using sintw2_bound case1a min_extend_val' scast_eq3 by linarith
         then have w2bound:"0 < sint w2" 
           using less_add_same_cancel2 by blast
         have rightSize:"sint (((scast w2)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
           using case1a scast_eq3 min_extend_val' word_sint.Rep[of "(w2)::32 Word.word"] w2bound
           by (auto simp add: sints32 len32[of "TYPE(32)"])
         have downcast:"sint ((scast (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                    = sint (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word)) "
           using scast_down_range[OF rightSize]
           by auto
         then have b:"sint ((scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001))::word)
                  = sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001)" 
           using min_extend_val by auto
         have c:"sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) 
             = sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word)"
           using min_extend_val case1a by auto
         show \<open>r'\<^sub>2 - 2147483647 = signed (SCAST(64 \<rightarrow> 32) (SCAST(32 \<rightarrow> 64) w2 + 0xFFFFFFFF80000001))\<close>
           using a b min_extend_val' scast_eq3 leq2 case1a [symmetric]
           apply (simp add: algebra_simps)
           apply transfer
           apply simp
           done
       qed
     subgoal  
     proof -
       have range2a:" - (2 ^ (size ((scast w2)::64 Word.word) - 1)) 
         \<le> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
       \<and> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
         \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
         apply(auto simp add: Word.word_size scast_eq1 upcast_max sints64 sints32 max_less)
         using max_diff_pos max_less w2Geq w2Less by auto
       have case2a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
                 =  sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF range2a])
       have neg64:"(((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) 
                 = ((scast w2)::64 Word.word) + (-0x7FFFFFFF)" by auto
       assume "sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647"
       then have sintw2_bound:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 by auto 
       have a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((-0x7FFFFFFF)::64 Word.word)" 
         using case2a by auto
       have b:"sint ((scast w2)::64 Word.word) = sint w2" 
         apply(rule Word.sint_up_scast)
         unfolding Word.is_up by auto
       have d:"sint w2 \<le> 2^31 - 1"
         using word_sint.Rep[of "(w2)::32 Word.word"] 
         by (auto simp add:  sints32 len32[of "TYPE(32)"])
       have "- 0x7FFFFFFF < sint w2 + (- 0x7FFFFFFF)"
         using sintw2_bound case2a min_extend_val' scast_eq3 by linarith
       then have w2bound:"0 < sint w2" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w2)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case2a b min_extend_val'
         using word_sint.Rep[of "(w2)::32 Word.word"] w2bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                   = sint (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       have "sint (scast (((scast w2)::64 Word.word) + (-0x7FFFFFFF))::word) < 2147483647"
         unfolding downcast a b min_extend_val'
         using range2s[of "sint w2", OF d]
         by auto
       then show "sint (scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001)::word) < 2147483647"
         by auto
     qed
     subgoal proof -
       assume notLeq:"sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647"
       then have gr:"sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647" 
         by auto
       have case2a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
                  = sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF w2Range])
       from neg64
       have sintw2_bound:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 using notLeq by auto 
       have a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((-0x7FFFFFFF)::64 Word.word)" 
         using case2a by auto
       have c:"sint((-0x7FFFFFFF)::64 Word.word) = -0x7FFFFFFF" 
         by auto
       have d:"sint w2 \<le> 2^31 - 1"
         using word_sint.Rep[of "(w2)::32 Word.word"] 
         by (auto simp add:  sints32 len32[of "TYPE(32)"])
       have "- 0x7FFFFFFF < sint w2 + (- 0x7FFFFFFF)"
         using sintw2_bound case2a c scast_eq3 by linarith
       then have w2bound:"0 < sint w2" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w2)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case2a scast_eq3
         using word_sint.Rep[of "(w2)::32 Word.word"] w2bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                    = sint (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       have sintEq:" sint ((scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001))::word) 
           = sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) "
           using downcast by auto
       show "- 2147483647 < sint (SCAST(64 \<rightarrow> 32) (SCAST(32 \<rightarrow> 64) w2 + 0xFFFFFFFF80000001))"
         unfolding sintEq  
         using gr of_int_less_iff of_int_minus of_int_numeral by linarith
       qed
     done
   have castEquiv:"\<not>(?sum <=s scast NEG_INF) \<Longrightarrow> (scast ?sum) \<equiv>\<^sub>U r1 + r2"
     using up1 up2 case1 case2  by fastforce
   have letRep:"(let sum = ?sum in if sum <=s scast NEG_INF then NEG_INF else scast sum) \<equiv>\<^sub>U r1 + r2"
     using case1 case2
     by(cases "?sum <=s scast NEG_INF"; auto) 
   show "pu w1 w2 \<equiv>\<^sub>U r1 + r2"
     using letRep eq2 neq1 
     by(auto)
 next
   case NumNeg
   assume neq3:"w1 \<noteq> NEG_INF"
   assume neq1:"w1 \<noteq> POS_INF"
   assume eq2:"w2 = NEG_INF"
   let ?sum = "(scast w1 + scast NEG_INF)::64 Word.word"
   have case1:"?sum <=s ((scast NEG_INF)::64 Word.word) \<Longrightarrow> NEG_INF \<equiv>\<^sub>U r1 + r2"
     using up1 up2 apply (simp add: repU_def repe.simps word_sle_def)
     apply(rule exI[where x= "r1 + r2"])
     apply(auto)
         using w1case1a min_extend_neg 
         apply (auto simp add: neq1 eq2 neq3 repINT repU_def repe.simps repeInt_simps 
         up2 word_sless_alt) 
     using repINT repU_def repe.simps repeInt_simps up2 word_sless_alt
     proof -
       fix r'
       assume a1:"sint ((scast w1)::64 Word.word) \<le> 0"
       then have "sint w1 \<le> 0" using scast_eq1 by auto 
       then have h3: \<open>signed w1 \<le> (0::real)\<close>
         by transfer simp
       assume a2:"r2 \<le> r'"
       assume a3:"r1 \<le> signed w1"
       assume a4:"r' \<le>  (- 2147483647)"
       from a2 a4 have h1:"r2 \<le> - 2147483647" by auto
       from a1 a3 h3 have h2:"r1 \<le> 0" 
       using dual_order.trans of_int_le_0_iff by blast
       show "r1 + r2 \<le>  (- 2147483647)"
         using h1 h2 add.right_neutral add_mono by fastforce
     qed
   have leq1:"r'\<^sub>2 \<le>  (real_of_int (sint NEG_INF))" and leq2:"r'\<^sub>1 =  (real_of_int (sint w1))" 
     using equiv1 equiv2 neq1 eq2 neq3 unfolding repe.simps by auto
   have case1a:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
              = sint ((scast w1)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
     by(rule signed_arith_sint(1)[OF w1MinusBound])
   have case2:"\<not>(?sum <=s scast NEG_INF) \<Longrightarrow> scast ?sum \<equiv>\<^sub>U r1 + r2"
     apply (simp add: repU_def repe.simps word_sle_def up1 up2)
     apply(rule exI[where x= "r'\<^sub>1 - 0x7FFFFFFF"]) (*r1 + r2*)
     apply(rule conjI)
     subgoal using leq1 leq2 geq1 geq2 by auto
     apply(rule disjI2)
     apply(rule disjI2)
     apply(auto)
     subgoal
       proof -
       have f:"r'\<^sub>1 =  (real_of_int (sint w1))"
         by (simp add: leq1 leq2 )
        assume a:"\<not> sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
        then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
          unfolding min_extend_val by auto 
        have "- 0x7FFFFFFF < sint w1 + (- 0x7FFFFFFF)"
          using sintw2_bound case1a min_extend_val' scast_eq1 by linarith
        then have w2bound:"0 < sint w1" 
          using less_add_same_cancel2 by blast
        have rightSize:"sint (((scast w1)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
          unfolding w1case1a 
          using w2bound word_sint.Rep[of "(w1)::32 Word.word"]
          by (auto simp add: sints32 len32[of "TYPE(32)"] scast_eq1)
       have downcast:"sint ((scast (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF))))::word)
                    = sint (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       then have "sint ((scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001))::word) 
                  = sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001)" 
         using min_extend_val by auto
       then have \<open>signed (SCAST(64 \<rightarrow> 32) (SCAST(32 \<rightarrow> 64) w1 + 0xFFFFFFFF80000001)) =
         (signed (SCAST(32 \<rightarrow> 64) w1 + 0xFFFFFFFF80000001) :: real)\<close>
         by transfer simp
       moreover have "r'\<^sub>1 - (real_of_int 2147483647) =
           (real_of_int (sint ((scast w1)::64 Word.word ) - 2147483647))"
         by (simp add: scast_eq1 leq2)
       moreover from w1case1a'
       have \<open>signed (SCAST(32 \<rightarrow> 64) w1 + 0xFFFFFFFF80000001) =
         signed (SCAST(32 \<rightarrow> 64) w1) + (signed (- 0x7FFFFFFF :: 64 Word.word) :: real)\<close>
         by transfer simp
       ultimately show "r'\<^sub>1 -  2147483647 
         = (signed ((scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001))::word))"
         by simp
     qed
     subgoal  
     proof -
       assume "\<not> sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
       then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 by auto 
       have "- 0x7FFFFFFF < sint w1 + (- 0x7FFFFFFF)"
         using sintw2_bound case1a min_extend_val' scast_eq1 by linarith
       then have w2bound:"0 < sint w1" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w1)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case1a scast_eq1 w1case1a'
         using word_sint.Rep[of "(w1)::32 Word.word"] w2bound
         by(auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                    = sint (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word)) "
         using scast_down_range[OF rightSize]
         by auto
       show "sint (scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001)::word) < 2147483647"
         using downcast min_extend_val' w1case1a' scast_eq1 arith[of "sint w1", OF w1Leq']
         by auto
     qed
     subgoal proof -
       assume notLeq:"\<not> sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
       then have gr:"sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647" 
         by auto
       then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 using notLeq by auto 
       have "- 0x7FFFFFFF < sint w1 + (- 0x7FFFFFFF)"
         using sintw2_bound case1a min_extend_val' scast_eq1 by linarith
       then have w2bound:"0 < sint w1" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w1)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case1a scast_eq1 w1case1a'
         using word_sint.Rep[of "(w1)::32 Word.word"] w2bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       show "- 2147483647 
         < sint ((scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001))::word)"
         using scast_down_range[OF rightSize] gr of_int_less_iff of_int_minus of_int_numeral by simp
       qed
       done
     have letUp:"(let sum=?sum in if sum <=s scast NEG_INF then NEG_INF else scast sum) \<equiv>\<^sub>U r1+r2"
       using case1 case2
       by (auto simp add: Let_def)
     have puSimp:"pu w1 w2=(let sum = ?sum in if sum <=s scast NEG_INF then NEG_INF else scast sum)"
       using neq3 neq1 eq2 equiv1 leq2 repeInt_simps by force
     then show "pu w1 w2 \<equiv>\<^sub>U r1 + r2"      
       using letUp puSimp by auto
 next
   case NumNum
   assume notinf1:"w1 \<noteq> POS_INF"
   assume notinf2:"w2 \<noteq> POS_INF"
   assume notneginf1:"w1 \<noteq> NEG_INF"
   assume notneginf2:"w2 \<noteq> NEG_INF"
   let ?sum = "((scast w1)::64 Word.word) + ((scast w2):: 64 Word.word)"
   have inf_case:"scast POS_INF <=s ?sum \<Longrightarrow> POS_INF \<equiv>\<^sub>U r1 + r2"
     using repU_def repePos_simps 
     by (meson dual_order.strict_trans not_less order_refl)
   have truth:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
      \<le> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
    \<and> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
      \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
     using Word.word_size[of "(scast w2)::64 Word.word"]
       Word.word_size[of "(scast w1)::64 Word.word"]
     scast_eq1 scast_eq3
     word_sint.Rep[of "(w1)::32 Word.word"]
     word_sint.Rep[of "(w2)::32 Word.word"]
     word_sint.Rep[of "(scast w1)::64 Word.word"]
     word_sint.Rep[of "(scast w2)::64 Word.word"]
     sints64 sints32 by auto 
   have sint_eq:"sint((scast w1 + scast w2)::64 Word.word) = sint w1 + sint w2"
     using signed_arith_sint(1)[of "(scast w1)::64 Word.word" "(scast w2)::64 Word.word", OF truth]
       scast_eq1 scast_eq3
     by auto
   have bigOne:"scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word) 
     \<Longrightarrow> \<exists>r'\<ge>r1 + r2. r' \<le>  (- 0x7FFFFFFF)"
    proof -
      assume "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)"
      then have "sint w1 + sint w2 \<le> - 0x7FFFFFFF"
        using sint_eq unfolding word_sle_eq by auto
      then have sum_leq: \<open>real_of_int (sint w1 + sint w2) \<le> real_of_int (- 0x7FFFFFFF)\<close>
        by (simp only: of_int_le_iff)
      obtain r'\<^sub>1 r'\<^sub>2 ::real where 
        bound1:"r'\<^sub>1 \<ge> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
        bound2:"r'\<^sub>2 \<ge> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
        using up1 up2 unfolding repU_def by auto
      have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2  \<le>  sint w2" 
        using \<open>scast w1 + scast w2 <=s - 0x7FFFFFFF\<close>  word_sle_def notinf1 notinf2 
          bound1 bound2 unfolding repe.simps by auto
      have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
        using somethingA somethingB add_mono by fastforce  
      show "\<exists>r'\<ge>r1 + r2. r' \<le> (- 0x7FFFFFFF)"
        apply(rule exI[where x = "r'\<^sub>1 + r'\<^sub>2"])
        using bound1 bound2 add_mono something sum_leq 
        apply (auto intro: order_trans [of _ \<open>signed_real_of_word w1 +
          signed_real_of_word w2\<close>])
        done
    qed
    have anImp:"\<And>r'.  (r'\<ge>r1 + r2 \<and> r' \<le>  (- 2147483647)) \<Longrightarrow> 
     (\<exists>r. - (2 ^ 31 - 1) = - (2 ^ 31 - 1) 
      \<and> r' = r \<and> r \<le> (real_of_int (sint ((- (2 ^ 31 - 1))::32 Word.word))))"
       by auto
    have anEq:"((scast ((- (2 ^ 31 - 1))::32 Word.word))::64 Word.word) =  (- 0x7FFFFFFF)"
      by auto
    have bigTwo:
    "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) \<Longrightarrow> 
     \<not>(?sum <=s ((scast NEG_INF)::64 Word.word)) \<Longrightarrow> 
     \<exists>r'\<ge>r1 + r2. r' = 
       (real_of_int (sint (scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word))::word)))
     \<and> (r' <  0x7FFFFFFF \<and>  (-0x7FFFFFFF) < r')"
    proof -
      assume "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum)"
        and "\<not>(?sum <=s ((scast NEG_INF)::64 Word.word))"
      then have interval_int: "sint w1 + sint w2 < 0x7FFFFFFF"
        "(- 0x7FFFFFFF) < sint w1 + sint w2"
        unfolding word_sle_eq POS_INF_def NEG_INF_def using sint_eq by auto
      then have interval: \<open>real_of_int (sint w1 + sint w2) < real_of_int (0x7FFFFFFF)\<close>
        \<open>real_of_int (- 0x7FFFFFFF) < real_of_int (sint w1 + sint w2)\<close>
        by (simp_all only: of_int_less_iff)
      obtain r'\<^sub>1 r'\<^sub>2 ::real where 
        bound1:"r'\<^sub>1 \<ge> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
        bound2:"r'\<^sub>2 \<ge> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
        using up1 up2 unfolding repU_def by auto
      have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2  \<le>  sint w2" 
        using word_sle_def notinf1 notinf2 bound1 bound2 unfolding repe.simps by auto
      have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
        using somethingA somethingB add_mono by fastforce  
      have "(w1 \<equiv>\<^sub>E r'\<^sub>1)" using bound1 by auto
      then have
            r1w1:"r'\<^sub>1 =  (real_of_int (sint w1))"
        and w1U:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
        and w1L:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
        unfolding repe.simps
        using notinf1 notinf2 notneginf1 notneginf2 by (auto)
      have "(w2 \<equiv>\<^sub>E r'\<^sub>2)" using bound2 by auto
      then have
            r2w1:"r'\<^sub>2 =  (real_of_int (sint w2))"
        and w2U:" (real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
        and w2L:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
        unfolding repe.simps
        using notinf1 notinf2 notneginf1 notneginf2 by (auto)
      have "sint (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)) 
          = sint ((scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)))::word)"
        apply(rule scast_down_range)
        unfolding sint_eq using sints32 interval_int by auto
      then have cast_eq:"(sint ((scast (((scast w1)::64 Word.word) 
                       + ((scast w2)::64 Word.word)))::word)) 
                     = sint w1 + sint w2"
        using scast_down_range sints32 interval_int sint_eq by auto
      from something and cast_eq 
      have r12_sint_scast:"r'\<^sub>1 + r'\<^sub>2 
        = (sint ((scast (((scast w1)::64 Word.word) 
          + ((scast w2)::64 Word.word)))::word))"
        using r1w1 w1U w1L r2w1 w2U w2L by (simp)
      show ?thesis 
        using bound1 bound2 add_mono r12_sint_scast cast_eq interval 
        \<open>r'\<^sub>1 + r'\<^sub>2 =  (real_of_int (sint (scast (scast w1 + scast w2))))\<close>
        by simp
    qed
    have neg_inf_case:"?sum <=s ((scast ((NEG_INF)::word))::64 Word.word) \<Longrightarrow> NEG_INF \<equiv>\<^sub>U r1 + r2"
    proof (unfold repU_def NEG_INF_def repe.simps)
      assume "scast w1 + scast w2 <=s ((scast ((- (2 ^ 31 - 1))::word))::64 Word.word)"
      then have "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)" 
        by (metis anEq)
      then obtain r' where geq:"(r' \<ge> r1 + r2)" and leq:"(r' \<le>  (- 0x7FFFFFFF))"
       using bigOne by auto
      show "(\<exists>r'\<ge>plus r1 r2.
        (\<exists>r. uminus (minus(2 ^ 31) 1) = POS_INF \<and> r' = r \<and>  (real_of_int (sint POS_INF)) \<le> r) 
      \<or> (\<exists>r. uminus (minus(2 ^ 31) 1) = uminus (minus(2 ^ 31)  1) 
         \<and> r' = r \<and> r \<le> real_of_int (sint ((uminus (minus(2 ^ 31) 1))::word)))
      \<or> (\<exists>w. uminus (minus(2 ^ 31) 1) = w 
         \<and> r' = real_of_int (sint w)
         \<and> (real_of_int (sint w)) <  (real_of_int (sint POS_INF)) 
         \<and> less (real_of_int (sint (uminus (minus(2 ^ 31) 1))))  (real_of_int (sint w))))"
        using leq anImp geq by meson
    qed
    have int_case:"\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) 
               \<Longrightarrow> \<not> (?sum <=s ((scast NEG_INF)::64 Word.word)) 
               \<Longrightarrow> ((scast ?sum)::word) \<equiv>\<^sub>U r1 + r2"
    proof -
      assume bound1:"\<not> ((scast POS_INF)::64 Word.word) <=s scast w1 + scast w2"
      assume bound2:"\<not> scast w1 + scast w2 <=s ((scast NEG_INF)::64 Word.word)"
      obtain r'::real  
        where rDef:"r' = (real_of_int (sint ((scast (((scast w1)::64 Word.word) 
                         + ((scast w2)::64 Word.word)))::word)))"
        and r12:"r'\<ge>r1 + r2" 
        and boundU:"r' <  0x7FFFFFFF" 
        and boundL:"(-0x7FFFFFFF) < r'"
        using bigTwo[OF bound1 bound2] by auto
      obtain w::word 
      where wdef:"w = (scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word))::word)"
        by auto
      then have wr:"r' = (real_of_int (sint w))"
        using r12 bound1 bound2 rDef by blast
      show ?thesis
        unfolding repU_def repe.simps 
        using r12 wdef rDef boundU boundL wr  
        by auto 
    qed
    have almost:"(let sum::64 Word.word = scast w1 + scast w2 in 
      if scast POS_INF <=s sum then POS_INF 
      else if sum <=s scast NEG_INF then NEG_INF 
     else scast sum) \<equiv>\<^sub>U r1 + r2"
    apply(cases "((scast POS_INF)::64 Word.word) <=s ((?sum)::64 Word.word)")
    subgoal using inf_case Let_def int_case neg_inf_case by auto
    apply(cases "?sum <=s scast NEG_INF")
    subgoal 
      using inf_case Let_def int_case neg_inf_case 
      proof -
        assume "\<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2"
        then have "\<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF 
                 \<and> \<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2 
                 \<and> \<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF 
              \<or> ((let w = scast w1 + scast w2 in 
                 if scast POS_INF <=s (w::64 Word.word)  then POS_INF 
                 else if w <=s scast NEG_INF then NEG_INF 
                 else scast w) \<equiv>\<^sub>U r1 + r2)"
          using neg_inf_case by presburger
        then show ?thesis
          using int_case by force
      qed
    subgoal using inf_case Let_def int_case neg_inf_case 
    proof -
      assume a1: "\<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2"
      assume "\<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF"
      have "\<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF 
          \<and> \<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2 
       \<or> ((let w = scast w1 + scast w2 in 
          if scast POS_INF <=s (w::64 Word.word) then POS_INF 
          else if w <=s scast NEG_INF then NEG_INF 
          else scast w) \<equiv>\<^sub>U r1 + r2)"
        using a1 neg_inf_case by presburger
      then show ?thesis
        using int_case by force
    qed
    done
   then show ?thesis 
     using notinf1 notinf2 notneginf1 notneginf2 by auto
 qed
 qed
 
 text\<open>Lower bound of w1 + w2\<close>
 fun pl :: "word \<Rightarrow> word \<Rightarrow> word"
 where "pl w1 w2 = 
 (if w1 = NEG_INF then NEG_INF
  else if w2 = NEG_INF then NEG_INF
  else if w1 = POS_INF then 
   (if w2 = POS_INF then POS_INF 
    else
      (let sum::64 Word.word = ((scast w2)::64 Word.word) + ((scast POS_INF)::64 Word.word) in
      if ((scast POS_INF)::64 Word.word) <=s(sum::64 Word.word) then POS_INF
      else scast sum))
  else if w2 = POS_INF then 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast POS_INF)::64 Word.word) in
    if ((scast POS_INF)::64 Word.word) <=s(sum::64 Word.word)  then POS_INF
    else scast sum)
  else 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word) in
    if ((scast POS_INF)::64 Word.word) <=s (sum::64 Word.word) then POS_INF
    else if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
    else scast sum))"
 
 
 subsection \<open>Addition lower bound\<close>
 
 text\<open>Correctness of lower bound of w1 + w2\<close>
 lemma pl_lemma:
 assumes lo1:"w1 \<equiv>\<^sub>L (r1::real)"
 assumes lo2:"w2 \<equiv>\<^sub>L (r2::real)"
 shows "pl w1 w2 \<equiv>\<^sub>L (r1 + r2)"
 proof -
   have scast_eq1:"sint((scast w1)::64 Word.word) = sint w1" 
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have scast_eq2:"sint((scast (0x80000001::word))::64 Word.word)=sint((0x80000001::32 Word.word))"
     by auto
   have scast_eq3:"sint((scast w2)::64 Word.word) = sint w2"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have sints64:"sints 64 = {i. - (2 ^ 63) \<le> i \<and> i < 2 ^ 63}"
     using sints_def[of 64] range_sbintrunc[of 63] by auto 
   have sints32:"sints 32 = {i. - (2 ^ 31) \<le> i \<and> i < 2 ^ 31}"
     using sints_def[of 32] range_sbintrunc[of 31] by auto 
   have thing1:"0 \<le> 9223372034707292161 + ((-(2 ^ 31))::real)" by auto
   have "sint (( w2)) \<ge> (-(2 ^ 31))"
     using word_sint.Rep[of "(w2)::32 Word.word"] sints32 mem_Collect_eq
     Word.word_size[of "(scast w2)::64 Word.word"] scast_eq1 scast_eq2 scast_eq3 len32 
     by auto
   then have thing4:"sint ((scast w2)::64 Word.word) \<ge> (-(2 ^ 31))" 
     using scast_down_range sint_ge sints_num
     using scast_eq3 by linarith
   have aLeq2:"(-(2 ^ 31)::int) \<ge> -9223372039002259455" by auto 
   then have thing2:" (0::int) \<le> 9223372039002259455 + sint ((scast w2)::64 Word.word)"
     using thing4 aLeq2 
     by (metis ab_group_add_class.ab_left_minus add.commute add_mono neg_le_iff_le)
   have aLeq:"2 ^ 31 \<le> (9223372039002259455::int)" by auto
   have bLeq:"sint ((scast w2)::64 Word.word) \<le> 2 ^ 31"
     apply ( auto simp add: word_sint.Rep[of "(w2)::32 Word.word"] sints32 
         scast_eq3 len32)
     using word_sint.Rep[of "(w2)::32 Word.word"] len32[of "TYPE(32)"] sints32 by auto
   have thing3:" sint ((scast w2)::64 Word.word) \<le> 9223372034707292160 "
     using aLeq bLeq by auto
   have truth:" - (2 ^ (size ((scast w2)::64 Word.word) - 1)) 
       \<le> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
     \<and> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
       \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
     by(auto simp add:
     Word.word_size[of "(scast w2)::64 Word.word"] 
     Word.word_size[of "(scast (0x7FFFFFFF))::64 Word.word"]
     scast_eq1 scast_eq2 
     sints64 sints32 thing2 thing1 thing3)
   have case1a:" sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
              =  sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
     by(rule signed_arith_sint(1)[OF truth])
   have case1b:"sint ((0xFFFFFFFF80000001)::64 Word.word) < 0"
     by auto
   have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
     by auto
   have neg64:"(((scast w2)::64 Word.word) + 0x7FFFFFFF) 
             = ((scast w2)::64 Word.word) + (0x7FFFFFFF)"
     by auto
   obtain r'\<^sub>1 and r'\<^sub>2 where   
             geq1:"r'\<^sub>1\<le>r1" and equiv1:"w1 \<equiv>\<^sub>E r'\<^sub>1"
         and geq2:"r'\<^sub>2\<le>r2" and equiv2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
           using lo1 lo2 unfolding repL_def by auto
   show ?thesis
 proof (cases rule: case_pl_inf[where ?w1.0=w1, where ?w2.0=w2])
   case NegAny
   then show ?thesis
   apply (auto simp add: repL_def repe.simps)
   using lo1 lo2 linear by auto
 next
   case AnyNeg
   then show ?thesis 
   apply (auto simp add: repL_def repe.simps)
   using linear by auto
 next
   case PosPos
   then show ?thesis 
   using lo1 lo2 
   by (auto simp add: repL_def repe.simps)
 next
   case PosNum
   assume neq1:"w2 \<noteq> POS_INF"
   assume eq2:"w1 = POS_INF"
   assume neq3:"w2 \<noteq> NEG_INF"
   let ?sum = "(scast w2 + scast POS_INF)::64 Word.word"
   have case1:"(((scast POS_INF)::64 Word.word) <=s ?sum) \<Longrightarrow> POS_INF \<equiv>\<^sub>L r1 + r2"
     using lo1 lo2 apply (simp add: repL_def repe.simps word_sle_def)
     apply(rule exI[where x= "r1 + r2"])
     using case1a case1b 
     apply (auto simp add: neq1 eq2 neq3 repINT repL_def repe.simps 
       repeInt_simps lo2 word_sless_alt)
    proof -
       fix r'
       assume a1:"0 \<le> sint (((scast w2)::64 Word.word))"
       from a1 have h3:"2147483647 \<le> sint w2 + 0x7FFFFFFF " using scast_eq3
         by auto
       assume a2:"r' \<le> r1"
       assume a3:"signed w2 \<le> r2"
       assume a4:"(2147483647) \<le> r'"
       from a2 a4 have h1:"2147483647 \<le> r1" by auto
       from a1 a3 h3 have h2:"0 \<le> r2" 
         using of_int_le_0_iff le_add_same_cancel2
         apply simp
         apply transfer
         apply simp
         apply (metis (full_types) of_int_0 of_int_le_iff order_trans signed_take_bit_nonnegative_iff)
         done
       show "(2147483647) \<le> r1 + r2 "
         using h1 h2 h3 add.right_neutral add_mono  
         by fastforce
       qed
   have leq1:"r'\<^sub>1 \<ge>  (real_of_int (sint POS_INF))" 
     using equiv1 neq1 eq2 neq3 
     unfolding repe.simps by auto
   have leq2:"r'\<^sub>2 = (real_of_int (sint w2))"
     using equiv2 neq1 eq2 neq3
     unfolding repe.simps by auto      
   have case2:"\<not>(scast POS_INF <=s ?sum) \<Longrightarrow> scast ?sum \<equiv>\<^sub>L r1 + r2"
     apply (simp add: repL_def repe.simps word_sle_def lo1 lo2)
     apply(rule exI[where x= "r'\<^sub>2 + 0x7FFFFFFF"]) (*r1 + r2*)
     apply(rule conjI)
     subgoal 
       proof -
         assume "\<not> 2147483647 \<le> sint (scast w2 + 0x7FFFFFFF)"
         have bound1:"2147483647 \<le> r1"
           using leq1 geq1 by (auto)
         have bound2:"r'\<^sub>2 \<le> r2 "
           using leq2 geq2 by auto        
         show "r'\<^sub>2 + 2147483647 \<le> r1 + r2"
           using bound1 bound2
           by linarith
       qed
     apply(rule disjI2)
     apply(rule disjI2)
     apply(auto)
     subgoal
       proof -
        assume a:"\<not> 2147483647 \<le> sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)"
        then have sintw2_bound:"2147483647 > sint (((scast w2)::64 Word.word) + (0x7FFFFFFF))"
          by auto 
        have case1a:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                  =  sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
          by(rule signed_arith_sint(1)[OF truth])
        have a1:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) 
               = sint((scast w2)::64 Word.word) + sint((0x7FFFFFFF)::64 Word.word)" 
          using case1a by auto
        have c1:"sint((0x7FFFFFFF)::64 Word.word) = 0x7FFFFFFF" 
          by auto
        have "sint w2 + ( 0x7FFFFFFF) <  0x7FFFFFFF"
          using sintw2_bound case1a c1 scast_eq3 by linarith
        then have w2bound:"sint w2 < 0" 
          using add_less_same_cancel2 by blast
        have rightSize:"sint (((scast w2)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
          unfolding case1a scast_eq3 c1 
          using word_sint.Rep[of "(w2)::32 Word.word"] w2bound 
          by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + (( 0x7FFFFFFF))))::word)
         = sint (((scast w2)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       then have b:"sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word)
                  = sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)" 
         by auto
       have c:"sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)
             = sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word)"
         using case1a by auto
       have d:"sint ((0x7FFFFFFF)::64 Word.word) = (0x7FFFFFFF)" by auto 
       have f:"r'\<^sub>2 =  (real_of_int (sint w2))"
         by (simp add: leq2)
       show "r'\<^sub>2 +  2147483647 
         = (signed ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word))"
         using a b c d scast_eq3 f leq2 of_int_numeral 
         by auto
       qed
     subgoal  
     proof -
       have truth2a:"-(2^(size ((scast w2)::64 Word.word)-1)) 
           \<le> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
         \<and> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
           \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
         apply(auto simp add:
             Word.word_size[of "(scast w2)::64 Word.word"]
             Word.word_size[of "(scast (0x7FFFFFFF))::64 Word.word"]
             scast_eq1 scast_eq2 sints64 sints32 thing2)
         using thing1 thing2 thing3 by auto
       have case2a:" sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                   = sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF truth2a])
       have min_cast:"(0x7FFFFFFF::64 Word.word) =((scast (0x7FFFFFFF::word))::64 Word.word)"
         by auto
       assume "\<not> 2147483647 \<le> sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)"
       then have sintw2_bound:"2147483647 > sint (((scast w2)::64 Word.word) + (0x7FFFFFFF))"
         using neg64 by auto
       have a:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((0x7FFFFFFF)::64 Word.word)" 
         using case2a by auto
       have c:"sint((0x7FFFFFFF)::64 Word.word) = 0x7FFFFFFF" 
         by auto
       have " 0x7FFFFFFF > sint w2 + ( 0x7FFFFFFF)"
         using sintw2_bound case2a c scast_eq3 by linarith
       then have w2bound:" sint w2 < 0" 
         by simp
       have rightSize:"sint (((scast w2)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case2a scast_eq3 c
         apply (auto simp add: sints32 len32[of "TYPE(32)"])
         using word_sint.Rep[of "(w2)::32 Word.word"] sints32 len32[of "TYPE(32)"] w2bound 
         by auto
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + (( 0x7FFFFFFF))))::word) 
         = sint (((scast w2)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       then show "sint (scast (((scast w2)::64 Word.word) + 0x7FFFFFFF)::word) < 2147483647"
         unfolding downcast a scast_eq3 c
         using w2bound by auto
     qed
     subgoal proof -
       assume notLeq:"\<not> 2147483647 \<le> sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)"
       then have gr:"sint (((scast w2)::64 Word.word) + 0x7FFFFFFF) <  2147483647" 
         by auto
       have case2a:" sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                   = sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF truth])
       have min_cast:"(0x7FFFFFFF::64 Word.word) =((scast (0x7FFFFFFF::word))::64 Word.word)"
         by auto
       have neg64:"(((scast w2)::64 Word.word) + 0x7FFFFFFF) 
                 = ((scast w2)::64 Word.word) + (0x7FFFFFFF)"
         by auto
       then have sintw2_bound:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) < 2147483647"
         using neg64 using notLeq by auto 
       have a:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((0x7FFFFFFF)::64 Word.word)"
         using case2a by auto
       have c:"sint((0x7FFFFFFF)::64 Word.word) = 0x7FFFFFFF" 
         by auto
       have "- 2147483647 \<noteq> w2" using neq3 unfolding NEG_INF_def by auto
       then have "sint((- 2147483647)::word) \<noteq> sint w2"
         using word_sint.Rep_inject by blast
       then have n1:"- 2147483647 \<noteq> sint w2"
         by auto
       have "- 2147483648 \<noteq> w2"
         apply(rule repe.cases[OF equiv2])
         by auto
       then have "sint(- 2147483648::word) \<noteq> sint w2"
       using word_sint.Rep_inject by blast
       then have n2:"- 2147483648 \<noteq> sint w2" 
         by auto
       then have d:"sint w2 > - 2147483647"
         using word_sint.Rep[of "(w2)::32 Word.word"] sints32 len32[of "TYPE(32)"] neq3 n1 n2
         by auto
       have w2bound:"- 2147483647 < sint w2 + 0x7FFFFFFF"
         using sintw2_bound case2a c scast_eq3 d by linarith
       have rightSize:"sint (((scast w2)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         using sints32 len32[of "TYPE(32)"] w2bound word_sint.Rep[of "(w2)::32 Word.word"] 
           c case2a scast_eq3 sintw2_bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + (( 0x7FFFFFFF))))::word)
                    = sint (((scast w2)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       have sintEq:" sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word) =
           sint (((scast w2)::64 Word.word) + 0x7FFFFFFF) "
           using downcast by auto
       show "- 2147483647
           < sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word)"
         unfolding sintEq  
         using gr of_int_less_iff of_int_minus of_int_numeral c case2a scast_eq3 w2bound
         by simp
       qed
       done
   have "(let sum = ?sum in if scast POS_INF <=s sum then POS_INF else scast sum) \<equiv>\<^sub>L r1 + r2"
     using case1 case2
     by (auto simp add: Let_def)
   then show ?thesis 
     using lo1 lo2 neq1 eq2 neq3 
     by (auto)
 next
   case NumPos
     assume neq3:"w1 \<noteq> NEG_INF"
     assume neq1:"w1 \<noteq> POS_INF"
     assume eq2:"w2 = POS_INF"
     let ?sum = "(scast w1 + scast POS_INF)::64 Word.word"
     have thing1:"0 \<le> 9223372034707292161 + ((-(2 ^ 31))::real)" by auto
     have "sint (( w1)) \<ge> (-(2 ^ 31))"
       using word_sint.Rep[of "(w1)::32 Word.word"] scast_eq1 scast_eq2 scast_eq3
         Word.word_size[of "(scast w1)::64 Word.word"] sints32 len32 mem_Collect_eq
       by auto
     then have thing4:"sint ((scast w1)::64 Word.word) \<ge> (-(2 ^ 31))" 
       using scast_down_range sint_ge sints_num scast_eq3 scast_eq1 by linarith
     have aLeq2:"(-(2 ^ 31)::int) \<ge> -9223372039002259455" by auto 
     then have thing2:" (0::int) \<le> 9223372039002259455 + sint ((scast w1)::64 Word.word)"
       using thing4 aLeq2 
       by (metis ab_group_add_class.ab_left_minus add.commute add_mono neg_le_iff_le)
     have aLeq:"2 ^ 31 \<le> (9223372039002259455::int)" by auto
     have bLeq:"sint ((scast w1)::64 Word.word) \<le> 2 ^ 31"
       apply (auto simp add: word_sint.Rep[of "(w1)::32 Word.word"] sints32 
           scast_eq1 len32)
       using word_sint.Rep[of "(w1)::32 Word.word"] len32[of "TYPE(32)"] sints32
       by clarsimp
     have thing3:" sint ((scast w1)::64 Word.word) \<le> 9223372034707292160 "
       using aLeq bLeq by auto
     have truth:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
                    \<le> sint ((scast w1)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word)
                  \<and> sint ((scast w1)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
                    \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
       by(auto simp add:
       Word.word_size[of "(scast w1)::64 Word.word"]
       Word.word_size[of "(scast (0x7FFFFFFF))::64 Word.word"]
       scast_eq3 scast_eq2 sints64 sints32 thing2 thing1 thing3)
     have case1a:"sint (((scast w1)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                = sint ((scast w1)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
       by(rule signed_arith_sint(1)[OF truth])
     have case1b:"sint ((0xFFFFFFFF80000001)::64 Word.word) < 0"
       by auto
     have g:"(0x7FFFFFFF::64 Word.word) = 0x7FFFFFFF" by auto
     have c:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) 
           = sint ((scast w1)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word)"
       using g case1a 
       by blast
     have d:"sint ((0x7FFFFFFF)::64 Word.word) = (0x7FFFFFFF)" by auto 
     have e:"sint ((scast w1)::64 Word.word) = sint w1" 
       using scast_eq1 by blast
     have d2:"sint w1 \<le> 2^31 - 1"
       using word_sint.Rep[of "(w1)::32 Word.word"] 
       by (auto simp add: sints32 len32[of "TYPE(32)"])
     have case1:"scast POS_INF <=s ?sum \<Longrightarrow> POS_INF \<equiv>\<^sub>L r1 + r2"
       using lo1 lo2 apply (simp add: repL_def repe.simps word_sle_def)
       apply(rule exI[where x= "r1 + r2"])
       apply(auto)
           using case1a case1b 
           apply (auto simp add: neq1 eq2 neq3 repINT repL_def 
             repe.simps repeInt_simps lo2 word_sless_alt) (* close 4 goals *)
      proof -
         fix r'
         have h3:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) 
           = sint (((scast w1)::64 Word.word)) + sint(0x7FFFFFFF::64 Word.word)" 
           using case1a by auto 
         have h4:"sint(0x7FFFFFFF::64 Word.word) = 2147483647" by auto
         assume a1:"0 \<le> sint ((scast w1)::64 Word.word)"
         then have h3:"sint w1 \<ge> 0" using scast_eq1 h3 h4 by auto 
         assume a2:"r' \<le> r2"
         assume a3:"signed w1 \<le> r1"
         assume a4:"(2147483647) \<le> r'"
         from a2 a4 have h1:"r2 \<ge>  2147483647" by auto
         from a3 h3 have h2:"r1 \<ge> 0"
           by (auto intro: order_trans [of _ \<open>signed_real_of_word w1\<close>])
         show " 2147483647 \<le> r1 + r2"
           using h1 h2 add.right_neutral add_mono by fastforce
         qed
     have leq1:"r'\<^sub>2 \<ge>  (real_of_int (sint POS_INF))" and leq2:"r'\<^sub>1 =  (real_of_int (sint w1))" 
       using equiv1 equiv2 neq1 eq2 neq3 unfolding repe.simps by auto
     have neg64:"(((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) 
               = ((scast w1)::64 Word.word) + (-0x7FFFFFFF)" 
       by auto
     have case2:"\<not>(scast POS_INF <=s ?sum) \<Longrightarrow> scast ?sum \<equiv>\<^sub>L r1 + r2"
       apply (simp add: repL_def repe.simps word_sle_def lo1 lo2)
       apply(rule exI[where x= "r'\<^sub>1 + 0x7FFFFFFF"]) 
       apply(rule conjI)
       subgoal 
         proof -
           assume "\<not> 2147483647 \<le> sint (scast w1 + 0x7FFFFFFF)"
           have bound1:"r2 \<ge>  2147483647"
             using leq1 geq2 by (auto)
           have bound2:"r1 \<ge> r'\<^sub>1"
             using leq2 geq1 by auto        
           show "r'\<^sub>1 + 2147483647 \<le> r1 + r2"
             using bound1 bound2
             by linarith
           qed
       apply(rule disjI2)
       apply(rule disjI2)
       apply(auto)
       subgoal
         proof -
         have f:"r'\<^sub>1 =  (real_of_int (sint w1))"
           by (simp add: leq1 leq2 )
          assume a:"\<not> 2147483647 \<le> sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)"
          then have sintw2_bound:"2147483647 > sint (((scast w1)::64 Word.word) + (0x7FFFFFFF))"
            by auto 
          have "0x7FFFFFFF > sint w1 + (0x7FFFFFFF)"
            using sintw2_bound case1a d scast_eq1 by linarith
          then have w2bound:"0 > sint w1" 
            using add_less_same_cancel2 by blast
          have rightSize:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
            unfolding case1a e 
            using w2bound word_sint.Rep[of "(w1)::32 Word.word"]
            by (auto simp add: sints32 len32[of "TYPE(32)"] )
         have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
           by auto
         have downcast:"sint ((scast (((scast w1)::64 Word.word) + (( 0x7FFFFFFF))))::word) 
                      = sint (((scast w1)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
           using scast_down_range[OF rightSize]
           by auto
         then have b:"sint((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word)
                    = sint(((scast w1)::64 Word.word) + 0x7FFFFFFF)" 
           using g by auto
         show "r'\<^sub>1 + 2147483647
           = ((signed_real_of_word ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word)))"
           using a b c d e f 
           proof -
             have "(real_of_int (sint ((scast w1)::64 Word.word ) + 2147483647)) 
                 = r'\<^sub>1 +  (real_of_int 2147483647)"
               using e leq2 by auto
             from this [symmetric] show ?thesis
               using b c d of_int_numeral
               by simp
           qed
         qed
       subgoal  
       proof -
         assume "\<not> 2147483647 \<le> sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)"
         then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (0x7FFFFFFF)) < 2147483647"
           unfolding neg64 by auto 
         have "0x7FFFFFFF > sint w1 + (0x7FFFFFFF)"
           using sintw2_bound case1a d scast_eq1 by linarith
         then have w2bound:"0 > sint w1" 
           using add_less_same_cancel2 by blast
         have rightSize:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
           unfolding case1a e c 
           using word_sint.Rep[of "(w1)::32 Word.word"] w2bound
           by (auto simp add: sints32 len32[of "TYPE(32)"])
         have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
           by auto
         have downcast:"sint ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word) 
           = sint (((scast w1)::64 Word.word) + ((0x7FFFFFFF)::64 Word.word))"
           using scast_down_range[OF rightSize]
           by auto
         show "sint (scast (((scast w1)::64 Word.word) + 0x7FFFFFFF)::word) < 2147483647"
           using downcast d e c arith[of "sint w1", OF d2] sintw2_bound by linarith
       qed
       subgoal proof -
         assume notLeq:"\<not> 2147483647 \<le> sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)"
         then have gr:"2147483647 > sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)" 
           by auto
         then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (0x7FFFFFFF)) < 2147483647"
           unfolding neg64 using notLeq by auto 
         have "0x7FFFFFFF > sint w1 + ( 0x7FFFFFFF)"
           using sintw2_bound case1a d scast_eq1 by linarith
         then have useful:"0 > sint w1"
           using add_less_same_cancel2 by blast
         have rightSize:"sint (((scast w1)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
           unfolding case1a e
           using word_sint.Rep[of "(w1)::32 Word.word"]
             sints32 len32[of "TYPE(32)"] useful
           by auto
         have "- 2147483647 \<noteq> w1" using neq3 unfolding NEG_INF_def by auto
         then have "sint((- 2147483647)::word) \<noteq> sint w1"
           using word_sint.Rep_inject by blast
         then have n1:"- 2147483647 \<noteq> sint w1"
           by auto
         have "- 2147483648 \<noteq> w1"
           apply(rule repe.cases[OF equiv1]) using int_not_undef[of w1] by auto
         then have "sint(- 2147483648::word) \<noteq> sint w1"
           using word_sint.Rep_inject by blast
         then have n2:"- 2147483648 \<noteq> sint w1" 
           by auto
         then have d:"sint w1 > - 2147483647"
           using word_sint.Rep[of "(w1)::32 Word.word"] 
             sints32 len32[of "TYPE(32)"] n1 n2 neq3 
           by (simp)
         have d2:"sint (0x7FFFFFFF::64 Word.word) > 0"
           by auto
         from d d2 have d3:"- 2147483647 < sint w1 + sint (0x7FFFFFFF::64 Word.word)"
           by auto
         have d4:"sint ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word) 
           = sint w1 + sint (0x7FFFFFFF::64 Word.word)"
           using case1a rightSize scast_down_range scast_eq1 by fastforce  
         then show "- 2147483647 < sint (SCAST(64 \<rightarrow> 32) (SCAST(32 \<rightarrow> 64) w1 + 0x7FFFFFFF))"
           using d3 d4 by auto
         qed done
       have "(let sum = ?sum in if scast POS_INF <=s sum then POS_INF else scast sum) \<equiv>\<^sub>L r1 + r2"
         using case1 case2
         by (auto simp add: Let_def)
       then show ?thesis 
         using neq1 eq2 neq3 by (auto)
 next
   case NumNum
   assume notinf1:"w1 \<noteq> POS_INF"
   assume notinf2:"w2 \<noteq> POS_INF"
   assume notneginf1:"w1 \<noteq> NEG_INF"
   assume notneginf2:"w2 \<noteq> NEG_INF"
   let ?sum = "((scast w1)::64 Word.word) + ((scast w2):: 64 Word.word)"
   have truth:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
       \<le> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
     \<and> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
       \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
     using Word.word_size[of "(scast w2)::64 Word.word"] 
       Word.word_size[of "(scast w1)::64 Word.word"]
       scast_eq1 scast_eq3 sints64 sints32
       word_sint.Rep[of "(w1)::32 Word.word"]
       word_sint.Rep[of "(w2)::32 Word.word"]
     by auto 
   have sint_eq:"sint((scast w1 + scast w2)::64 Word.word) = sint w1 + sint w2"
     using signed_arith_sint(1)[of "(scast w1)::64 Word.word" "(scast w2)::64 Word.word", OF truth]
       scast_eq1 scast_eq3
     by auto
   have bigOne:"scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word) 
     \<Longrightarrow> \<exists>r'\<le>r1 + r2. r' \<le>  -0x7FFFFFFF"
   proof -
     assume "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)"
     then have sum_leq:"sint w1 + sint w2 \<le> - 0x7FFFFFFF"
           and sum_leq':" (sint w1 + sint w2) \<le>  (- 2147483647)"
       using sint_eq unfolding word_sle_eq by auto 
     obtain r'\<^sub>1 r'\<^sub>2 ::real where 
       bound1:"r'\<^sub>1 \<le> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
       bound2:"r'\<^sub>2 \<le> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
       using lo1 lo2 unfolding repL_def by auto
     have somethingA:"r'\<^sub>1 \<le> sint w1" and somethingB:"r'\<^sub>2 \<le> sint w2" 
       using bound1 bound2 \<open>scast w1 + scast w2 <=s -0x7FFFFFFF\<close> word_sle_def notinf1 notinf2 
       unfolding repe.simps by auto
     have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
       using somethingA somethingB add_mono 
       by fastforce  
     show "\<exists>r'\<le>r1 + r2. r' \<le> (-0x7FFFFFFF)"
       apply (rule exI[where x = "r'\<^sub>1 + r'\<^sub>2"])
       using bound1 bound2 add_mono something sum_leq'
       apply (auto intro: order_trans [of _ \<open>signed_real_of_word w1 + signed_real_of_word w2\<close>])
       done      
   qed
   have anImp:"\<And>r'.  (r'\<ge>r1 + r2 \<and> r' \<le>  (- 2147483647)) \<Longrightarrow>
    (\<exists>r. - (2 ^ 31 - 1) = - (2 ^ 31 - 1) \<and> r' = r \<and> r 
         \<le> (real_of_int (sint ((- (2 ^ 31 - 1))::32 Word.word))))"
     by auto
   have anEq:"((scast ((- (2 ^ 31 - 1))::32 Word.word))::64 Word.word) = (- 0x7FFFFFFF)"
     by auto
   have bigTwo:
    "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) \<Longrightarrow>
     \<not>(?sum <=s ((scast NEG_INF)::64 Word.word)) \<Longrightarrow>
     \<exists>r'\<le>r1 + r2. r' = (real_of_int (sint (scast (((scast w1)::64 Word.word)
                       + ((scast w2)::64 Word.word))::word)))
                \<and> (r' <  0x7FFFFFFF \<and>  (-0x7FFFFFFF) < r')"
   proof -
     assume "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum)"
     then have sum_leq:"sint w1 + sint w2 < 0x7FFFFFFF"
       unfolding word_sle_eq using sint_eq by auto
     then have sum_leq':" (sint w1 + sint w2) < (2147483647)"
       by auto
     assume "\<not>(?sum <=s ((scast NEG_INF)::64 Word.word))"
     then have sum_geq:"(- 0x7FFFFFFF) < sint w1 + sint w2"
       unfolding word_sle_eq using sint_eq by auto
     then have sum_geq':" (- 2147483647) <  (sint w1 + sint w2)"
       by auto
     obtain r'\<^sub>1 r'\<^sub>2 ::real where 
       bound1:"r'\<^sub>1 \<le> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
       bound2:"r'\<^sub>2 \<le> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
        using lo1 lo2 unfolding repL_def by auto
     have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2 \<le> sint w2" 
       using word_sle_def notinf1 notinf2 bound1 bound2 unfolding repe.simps by auto
     have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
       using somethingA somethingB add_mono 
       by fastforce  
     have "(w1 \<equiv>\<^sub>E r'\<^sub>1)" using bound1 by auto
     then have
           r1w1:"r'\<^sub>1 = (real_of_int (sint w1))"
       and w1U:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
       and w1L:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
       unfolding repe.simps
       using notinf1 notinf2 notneginf1 notneginf2 by (auto)
     have "(w2 \<equiv>\<^sub>E r'\<^sub>2)" using bound2 by auto
     then have
           r2w1:"r'\<^sub>2 =  (real_of_int (sint w2))"
       and w2U:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
       and w2L:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
       unfolding repe.simps
       using notinf1 notinf2 notneginf1 notneginf2 by (auto)
     have "sint (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)) 
         = sint ((scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)))::word)"
       apply(rule scast_down_range)
       unfolding sint_eq using sints32 sum_geq sum_leq by auto
     then have cast_eq:"(sint ((scast (((scast w1)::64 Word.word) 
         + ((scast w2)::64 Word.word)))::word)) 
       = sint w1 + sint w2"
       using scast_down_range sints32 sum_geq sum_leq sint_eq by auto
     from something and cast_eq 
     have r12_sint_scast:"r'\<^sub>1 + r'\<^sub>2 
       = (sint ((scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)))::word))"
       using r1w1 w1U w1L r2w1 w2U w2L 
       by (simp)
     have leq_ref:"\<And>x y ::real. x = y ==> x \<le> y" by auto
     show ?thesis
       apply(rule exI[where x="r'\<^sub>1 + r'\<^sub>2"])
       apply(rule conjI)
       subgoal 
         using r12_sint_scast cast_eq leq_ref r2w1 r1w1 add_mono[of r'\<^sub>1 r1 r'\<^sub>2 r2] bound1 bound2
         by auto
       using bound1 bound2 add_mono r12_sint_scast cast_eq sum_leq sum_leq' sum_geq' sum_geq
       \<open>r'\<^sub>1 + r'\<^sub>2 =  (real_of_int (sint (scast (scast w1 + scast w2))))\<close> 
       by auto
     qed
   have neg_inf_case:"?sum <=s ((scast ((NEG_INF)::word))::64 Word.word)  \<Longrightarrow> NEG_INF \<equiv>\<^sub>L r1 + r2"
   proof (unfold repL_def NEG_INF_def repe.simps)
     assume "scast w1 + scast w2 <=s ((scast ((- (2 ^ 31 - 1))::word))::64 Word.word)"
     then have "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)" 
       by (metis anEq)
     then obtain r' where geq:"(r' \<le> r1 + r2)" and leq:"(r' \<le> (-0x7FFFFFFF))"
       using bigOne by auto
     show "(\<exists>r'\<le>plus r1  r2.
       (\<exists>r. uminus (minus(2 ^ 31) 1) = POS_INF \<and> r' = r \<and>  (real_of_int (sint POS_INF)) \<le> r)
     \<or> (\<exists>r. uminus (minus(2 ^ 31) 1) = uminus (minus(2 ^ 31)  1) 
         \<and> r' = r \<and> r \<le>  (real_of_int (sint ((uminus (minus(2 ^ 31) 1))::word))))
     \<or> (\<exists>w. uminus (minus(2 ^ 31) 1) = w \<and>
            r' =  (real_of_int (sint w)) \<and>
             (real_of_int (sint w)) <  (real_of_int (sint POS_INF)) 
         \<and> less ( (real_of_int (sint (uminus (minus(2 ^ 31) 1))))) ((real_of_int (sint w)))))"
     using leq geq
     by (meson dual_order.strict_trans linorder_not_le order_less_irrefl) 
   qed
   have bigThree:"0x7FFFFFFF <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word) 
     \<Longrightarrow> \<exists>r'\<le>r1 + r2. 2147483647 \<le> r'"
   proof -
     assume "0x7FFFFFFF <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
     then have sum_leq:"0x7FFFFFFF \<le> sint w1 + sint w2 "
           and sum_leq':" 2147483647 \<le>  (sint w1 + sint w2)"
       using sint_eq unfolding word_sle_eq by auto 
     obtain r'\<^sub>1 r'\<^sub>2 ::real where 
       bound1:"r'\<^sub>1 \<le> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
       bound2:"r'\<^sub>2 \<le> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
       using lo1 lo2 unfolding repL_def by auto
     have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2  \<le>  sint w2" 
       using \<open> 0x7FFFFFFF <=s scast w1 + scast w2 \<close> word_sle_def notinf1 notinf2
         bound1 bound2 repe.simps
       by auto
     have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
       using somethingA somethingB add_mono of_int_add  
       by fastforce  
     show "\<exists>r'\<le> r1 + r2.  (2147483647) \<le> r'"
       apply(rule exI[where x = "r'\<^sub>1 + r'\<^sub>2"])
       using bound1 bound2 add_mono something sum_leq' order.trans
     proof -
       have f1: " (real_of_int (sint w2)) = r'\<^sub>2"
         by (metis bound2 notinf2 notneginf2 repe.cases)
       have " (real_of_int (sint w1)) = r'\<^sub>1"
         by (metis bound1 notinf1 notneginf1 repe.cases)
       then have f2: " (real_of_int 2147483647) \<le> r'\<^sub>2 + r'\<^sub>1"
         using f1 sum_leq' by auto
       have "r'\<^sub>2 + r'\<^sub>1 \<le> r2 + r1"
         by (meson add_left_mono add_right_mono bound1 bound2 order.trans)
       then show "r'\<^sub>1 + r'\<^sub>2 \<le> r1 + r2 \<and>  2147483647 \<le> r'\<^sub>1 + r'\<^sub>2"
         using f2 by (simp add: add.commute)
     qed
   qed
   have inf_case:"((scast POS_INF)::64 Word.word) <=s ?sum \<Longrightarrow> POS_INF \<equiv>\<^sub>L r1 + r2"
     proof -
       assume "((scast POS_INF)::64 Word.word) 
           <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
       then have "((scast ((2 ^ 31 - 1)::word))::64 Word.word) 
              <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
         unfolding  repL_def repe.simps by auto
       then have "(0x7FFFFFFF::64 Word.word) 
              <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
         by auto
       then obtain r' where geq:"(r' \<le> r1 + r2)" and leq:"(0x7FFFFFFF \<le> r')"
         using bigThree by auto
       show "?thesis"
         unfolding repL_def repe.simps using leq geq by auto
     qed
   have int_case:"\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) 
     \<Longrightarrow> \<not> (?sum <=s ((scast NEG_INF)::64 Word.word)) 
     \<Longrightarrow> ((scast ?sum)::word) \<equiv>\<^sub>L r1 + r2"
   proof -
     assume bound1:"\<not> ((scast POS_INF)::64 Word.word) <=s scast w1 + scast w2"
     assume bound2:"\<not> scast w1 + scast w2 <=s ((scast NEG_INF)::64 Word.word)"
     obtain r'::real  
       where rDef:"r' = (real_of_int (sint ((scast (((scast w1)::64 Word.word) 
                      + ((scast w2)::64 Word.word)))::word)))"
       and r12:"r'\<le>r1 + r2" 
       and boundU:"r' <  0x7FFFFFFF" 
       and boundL:" (-0x7FFFFFFF) < r'"
       using bigTwo[OF bound1 bound2] by auto
     obtain w::word 
     where wdef:"w = (scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word))::word)"
       by auto
     then have wr:"r' =  (real_of_int (sint w))"
       using r12 bound1 bound2 rDef by blast
     show ?thesis
       unfolding repL_def repe.simps 
       using r12 wdef rDef boundU boundL wr  
       by auto 
   qed
   have "(let sum = ?sum in
     if scast POS_INF <=s sum then POS_INF 
     else if sum <=s scast NEG_INF then NEG_INF 
     else scast sum) \<equiv>\<^sub>L r1 + r2"
     apply(cases "((scast POS_INF)::64 Word.word) <=s ?sum")
      apply(cases "?sum <=s scast NEG_INF")
       using inf_case neg_inf_case int_case by (auto simp add: Let_def)
   then show ?thesis 
     using notinf1 notinf2 notneginf1 notneginf2
     by(auto)
 qed
 qed
 
 subsection \<open>Max function\<close>
 
 text\<open>Maximum of w1 + w2 in 2s-complement\<close>
 fun wmax :: "word \<Rightarrow> word \<Rightarrow> word"
 where "wmax w1 w2 = (if w1 <s w2 then w2 else w1)"
 
 text\<open>Correctness of wmax\<close>
 lemma wmax_lemma:
   assumes eq1:"w1 \<equiv>\<^sub>E (r1::real)"
   assumes eq2:"w2 \<equiv>\<^sub>E (r2::real)"
   shows "wmax w1 w2 \<equiv>\<^sub>E (max r1 r2)"
 proof(cases rule: case_inf2[where ?w1.0=w1, where ?w2.0=w2])
   case PosPos
   from PosPos eq1 eq2
   have bound1:"(real_of_int (sint POS_INF)) \<le> r1"
   and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     by (auto simp add: repe.simps)
   have eqInf:"wmax w1 w2 = POS_INF"
     using PosPos unfolding wmax.simps by auto
   have pos_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2
     by linarith
   show ?thesis
     using pos_eq eqInf by auto
 next
   case PosNeg
   from PosNeg 
   have bound1:"(real_of_int (sint POS_INF)) \<le> r1"
    and bound2:"r2 \<le> (real_of_int (sint NEG_INF))"
     using eq1 eq2 by (auto simp add: repe.simps)
   have eqNeg:"wmax w1 w2 = POS_INF"
     unfolding eq1 eq2 wmax.simps PosNeg word_sless_def word_sle_def
     by(auto) 
   have neg_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2 eq1 eq2 by auto
   show "?thesis"
     using eqNeg neg_eq by auto
 next
   case PosNum
   from PosNum eq1 eq2
   have bound1:" (real_of_int (sint POS_INF)) \<le> r1"
   and bound2a:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
   and bound2b:" (real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
     by (auto simp add: repe.simps)
   have eqNeg:"wmax w1 w2 = POS_INF"
     using PosNum bound2b 
     unfolding wmax.simps word_sless_def word_sle_def
     by auto 
   have neg_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply (rule repPOS_INF)
     using bound1 bound2a bound2b word_sless_alt le_max_iff_disj 
     unfolding eq1 eq2 by blast
   show "?thesis"
     using eqNeg neg_eq by auto
 next
   case NegPos
   from NegPos eq1 eq2
   have bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
    and bound2:" (real_of_int (sint POS_INF)) \<le> r2"
     by (auto simp add: repe.simps)
   have eqNeg:"wmax w1 w2 = POS_INF"
     unfolding NegPos word_sless_def word_sle_def
     by(auto)
   have neg_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2 by auto
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using eqNeg neg_eq by auto
 next
   case NegNeg
   from NegNeg eq1 eq2
   have bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
    and bound2:"r2 \<le>  (real_of_int (sint NEG_INF))"
     by (auto simp add: repe.simps)
   have eqNeg:"NEG_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repNEG_INF)
     using eq1 eq2 bound1 bound2
     by(auto)
   have neg_eq:"wmax w1 w2 = NEG_INF"
     using NegNeg by auto 
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using eqNeg neg_eq by auto
 next
   case NegNum
   from NegNum eq1 eq2
   have eq3:"r2 = (real_of_int (sint w2))"
    and bound2a:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
    and bound2b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
    and bound1:"r1 \<le> (real_of_int (sint NEG_INF))"
     by (auto simp add: repe.simps)
   have eqNeg:"max r1 r2 = (real_of_int (sint w2))"
     using NegNum assms(2) bound2a eq3 repeInt_simps bound1 bound2a bound2b
     by (metis less_irrefl max.bounded_iff max_def not_less)
   then have extra_eq:"(wmax w1 w2) = w2"
     using assms(2) bound2a eq3 NegNum repeInt_simps 
     by (simp add: word_sless_alt)
   have neg_eq:"wmax w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmax w1 w2)))"
     apply(rule repINT)
     using extra_eq eq3 bound2a bound2b by(auto)
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using eqNeg neg_eq extra_eq by auto
 next
   case NumPos
   from NumPos eq1 eq2
   have p2:"w2 = POS_INF"
    and eq1:"r1 = (real_of_int (sint w1))"
    and eq2:"r2 = r2"
    and bound1a:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
    and bound1b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
    and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     by (auto simp add: repe.simps)    
   have res1:"wmax w1 w2 = POS_INF"
     using NumPos p2 eq1 eq2 assms(1) bound1b p2 repeInt_simps 
     by (simp add: word_sless_alt)
   have res3:"POS_INF \<equiv>\<^sub>E max r1 r2"
     using repPOS_INF NumPos bound2 le_max_iff_disj by blast
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2" 
     using res1 res3 by auto
 next
   case NumNeg
   from NumNeg eq1 eq2
   have n2:"w2 = NEG_INF"
    and rw1:"r1 = (real_of_int (sint w1))"
    and bound1a:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
    and bound1b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
    and bound2:"r2 \<le> (real_of_int (sint NEG_INF))"
     by (auto simp add: repe.simps)    
   have res1:"max r1 r2 = (real_of_int (sint (wmax w1 w2)))"
     using bound1b bound2 NumNeg less_trans wmax.simps of_int_less_iff 
       word_sless_alt rw1 antisym_conv2 less_imp_le max_def
     by metis
   have res2:"wmax w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmax w1 w2)))"
     apply(rule repINT)
     using bound1a bound1b bound2 NumNeg leD leI less_trans n2 wmax.simps 
     by (auto simp add: word_sless_alt)
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using res1 res2 by auto
 next
   case NumNum
   from NumNum eq1 eq2
   have eq1:"r1 = (real_of_int (sint w1))"
    and eq2:"r2 = (real_of_int (sint w2))"
    and bound1a:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
    and bound1b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
    and bound2a:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
    and bound2b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
     by (auto simp add: repe.simps)    
   have res1:"max r1 r2 = (real_of_int (sint (wmax w1 w2)))"
     using eq1 eq2 bound1a bound1b bound2a bound2b
     apply (auto simp add: max_def word_sless_alt not_less; transfer)
      apply simp_all
     done
   have res2:"wmax w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmax w1 w2)))"
     apply (rule repINT)
     using bound1a bound1b bound2a bound2b
     by (simp add: \<open>max r1 r2 =  (real_of_int (sint (wmax w1 w2)))\<close> eq2 min_less_iff_disj)+
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using res1 res2 by auto
 qed
 
 lemma max_repU1:
   assumes "w1 \<equiv>\<^sub>U x"
   assumes "w2 \<equiv>\<^sub>U y"
   shows "wmax w1 w2 \<equiv>\<^sub>U x "
   using wmax_lemma assms repU_def
   by (meson le_max_iff_disj)
   
 lemma max_repU2:
   assumes "w1 \<equiv>\<^sub>U y"
   assumes "w2 \<equiv>\<^sub>U x"
   shows "wmax w1 w2 \<equiv>\<^sub>U x"
   using wmax_lemma assms repU_def
   by (meson le_max_iff_disj)
 
 text\<open>Product of w1 * w2 with bounds checking\<close>
 fun wtimes :: "word \<Rightarrow> word \<Rightarrow> word"
 where "wtimes w1 w2 =
  (if w1 = POS_INF \<and> w2 = POS_INF then POS_INF
   else if w1 = NEG_INF \<and> w2 = POS_INF then NEG_INF
   else if w1 = POS_INF \<and> w2 = NEG_INF then NEG_INF
   else if w1 = NEG_INF \<and> w2 = NEG_INF then POS_INF
   
   else if w1 = POS_INF \<and> w2 <s 0 then NEG_INF 
   else if w1 = POS_INF \<and> 0 <s w2 then POS_INF 
   else if w1 = POS_INF \<and> 0 = w2 then 0 
   else if w1 = NEG_INF \<and> w2 <s 0 then POS_INF 
   else if w1 = NEG_INF \<and> 0 <s w2 then NEG_INF 
   else if w1 = NEG_INF \<and> 0 = w2 then 0 
   
   else if w1 <s 0 \<and> w2 = POS_INF then NEG_INF 
   else if 0 <s w1 \<and> w2 = POS_INF then POS_INF 
   else if 0 = w1 \<and> w2 = POS_INF then 0
   else if w1 <s 0 \<and> w2 = NEG_INF then POS_INF 
   else if 0 <s w1 \<and> w2 = NEG_INF then NEG_INF 
   else if 0 = w1 \<and> w2 = NEG_INF then 0 
   
   else 
   (let prod::64 Word.word = (scast w1) * (scast w2) in
    if prod <=s (scast NEG_INF) then NEG_INF
    else if (scast POS_INF) <=s prod then POS_INF
    else (scast prod)))"
 
 
 subsection \<open>Multiplication upper bound\<close>
 text\<open>Product of 32-bit numbers fits in 64 bits\<close>
 lemma times_upcast_lower:
   fixes x y::int
   assumes a1:"x \<ge> -2147483648"
   assumes a2:"y \<ge> -2147483648"
   assumes a3:"x \<le> 2147483648"
   assumes a4:"y \<le> 2147483648"
   shows "- 4611686018427387904 \<le>  x * y"
 proof -
   let ?thesis = "- 4611686018427387904 \<le> x * y"
   have is_neg:"- 4611686018427387904 < (0::int)" by auto
   have case1:"x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<ge> 0"
       have h1:"x * y \<ge> 0"
         using a5 a6 by (simp add: zero_le_mult_iff)
       then show ?thesis using is_neg by auto
     qed
   have case2:"x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis" 
     proof -
       assume a5:"x \<le> 0" and a6:"y \<ge> 0"
       have h1:"-2147483648 * (2147483648) \<le> x * 2147483648"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"-2147483648 \<le> y" using a6 by auto
       have h3:"x * 2147483648 \<le> x * y" 
         using a1 a2 a3 a4 a5 a6 h2 
         using mult_left_mono_neg by blast
       show ?thesis using h1 h2 h3 by auto
     qed
   have case3:"x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<le> 0"
       have h1:"2147483648 * (-2147483648) \<le> 2147483648 * y"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"-2147483648 \<le> x" using a5 by auto
       have h3:"2147483648 * y \<le> x * y" 
         using a1 a2 a3 a4 a5 a6 h2 
         using mult_left_mono_neg mult_right_mono_neg by blast
       show ?thesis using h1 h2 h3 by auto
     qed
   have case4:"x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
   proof -
       assume a5:"x \<le> 0" and a6:"y \<le> 0"
       have h1:"x * y \<ge> 0"
         using a5 a6 by (simp add: zero_le_mult_iff)
       then show ?thesis using is_neg by auto
     qed
   show ?thesis
     using case1 case2 case3 case4 by linarith
 qed
 
 text\<open>Product of 32-bit numbers fits in 64 bits\<close>
 lemma times_upcast_upper:
   fixes x y ::int
   assumes a1:"x \<ge> -2147483648"
   assumes a2:"y \<ge> -2147483648"
   assumes a3:"x \<le> 2147483648"
   assumes a4:"y \<le> 2147483648"
   shows "x * y \<le> 4611686018427387904" 
 proof -
   let ?thesis = "x * y \<le> 4611686018427387904"
   have case1:"x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<ge> 0"
       have h1:"2147483648 * 2147483648 \<ge> x * 2147483648"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"x * 2147483648 \<ge> x * y" 
         using a1 a2 a3 a4 a5 a6 by (simp add: mult_mono)
       show ?thesis using h1 h2 by auto
     qed
   have case2:"x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<le> 0" and a6:"y \<ge> 0"
       have h1:"2147483648 * 2147483648 \<ge> (0::int)" by auto
       have h2:"0 \<ge> x * y"
         using a5 a6 mult_nonneg_nonpos2 by blast
       show ?thesis using h1 h2 by auto
     qed
   have case3:"x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<le> 0"
       have h1:"2147483648 * 2147483648 \<ge> (0::int)" by auto
       have h2:"0 \<ge> x * y"
         using a5 a6 mult_nonneg_nonpos by blast
       show ?thesis using h1 h2 by auto
     qed
   have case4:"x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<le> 0" and a6:"y \<le> 0"
       have h1:"-2147483648 * -2147483648 \<ge> x * -2147483648"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"x * -2147483648 \<ge> x * y" 
         using a1 a2 a3 a4 a5 a6 mult_left_mono_neg by blast
       show ?thesis using h1 h2 by auto
     qed
 show "x * y \<le> 4611686018427387904"
   using case1 case2 case3 case4
   by linarith
 qed
    
 text\<open>Correctness of 32x32 bit multiplication\<close>
 
 subsection \<open>Exact multiplication\<close>
 lemma wtimes_exact:
 assumes eq1:"w1 \<equiv>\<^sub>E r1"
 assumes eq2:"w2 \<equiv>\<^sub>E r2"
 shows "wtimes w1 w2 \<equiv>\<^sub>E r1 * r2"
 proof -
   have POS_cast:"sint ((scast POS_INF)::64 Word.word) = sint POS_INF"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have POS_sint:"sint POS_INF = (2^31)-1"  by auto
   have w1_cast:"sint ((scast w1)::64 Word.word) = sint w1"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have w2_cast:"sint ((scast w2)::64 Word.word) = sint w2"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have NEG_cast:"sint ((scast NEG_INF)::64 Word.word) = sint NEG_INF"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have rangew1:"sint ((scast w1)::64 Word.word) \<in> {- (2 ^ 31).. (2^31)} " 
     using word_sint.Rep[of "(w1)::32 Word.word"] sints32 len32 mem_Collect_eq POS_cast w1_cast 
     by auto
   have rangew2:"sint ((scast w2)::64 Word.word) \<in> {- (2 ^ 31).. (2^31)} " 
     using word_sint.Rep[of "(w2)::32 Word.word"] sints32 len32 mem_Collect_eq POS_cast w2_cast 
     by auto
   show ?thesis
 proof (cases rule: case_times_inf[of w1 w2])
   case PosPos then
   have a1: "PosInf \<le> r1"
   and  a2: "PosInf \<le> r2" 
     using "PosPos" eq1 eq2 repe.simps by (auto)
   have f3: "\<And>n e::real.  1 \<le> max ( (numeral n)) e"
     by (simp add: le_max_iff_disj)
   have "\<And>n e::real. 0 \<le> max ( (numeral n)) e"
     by (simp add: le_max_iff_disj)
   then have "r1 \<le> r1 * r2"
     using f3 "PosPos" eq1 eq2 repe.simps
     using eq1 eq2 by (auto simp add: repe.simps)
   then have "PosInf \<le> r1 * r2"
     using a1 by linarith
   then show ?thesis
     using "PosPos"  by(auto simp add: repe.simps)
 next
   case NegPos
   from "NegPos" have notPos:"w1 \<noteq> POS_INF" unfolding POS_INF_def NEG_INF_def by auto
   have a1: "NegInf \<ge> r1"
     using eq1 "NegPos" by (auto simp add: repe.simps)
   have a2: "PosInf \<le> r2"
     using eq2 "NegPos" by (auto simp add: repe.simps)
   have f1: "real_of_int Numeral1 = 1"
     by simp
   have f3: "(real_of_int 3) \<le> - r1"
     using a1 by (auto)
   have f4:"0 \<le> r2"
     using f1 a2 by(auto)
   have f5: "r1 \<le>  - 1"
     using f3 by auto
   have fact:"r1 * r2 \<le> - r2"
     using f5 f4 mult_right_mono by fastforce
   show ?thesis
     using a1 a2 fact by (auto simp add: repe.simps "NegPos")
 next
   case PosNeg
   have a1: "PosInf \<le> r1"
     using eq1 "PosNeg" by (auto simp add: repe.simps)
   then have h1:"r1 \<ge> 1"
     by (auto)
   have a2: " NegInf \<ge> r2"
     using eq2 "PosNeg" by (auto simp add: repe.simps)
   have f1: "\<not>  NegInf *  (- 1) \<le> 1"
     by (auto)
   have f2: "\<forall>e ea::real. (e *  (- 1) \<le> ea) = (ea *  (- 1) \<le> e)" by force
   then have f3: "\<not> 1 *  (- 1::real) \<le>  NegInf"
     using f1 by blast
   have f4: "r1 *  (- 1) \<le>  NegInf"
     using f2 a1 
     by(auto)
   have f5: "\<forall>e ea eb. (if (ea::real) \<le> eb then e \<le> eb else e \<le> ea) = (e \<le> ea \<or> e \<le> eb)"
     by force
   have " 0 *  (- 1::real) \<le> 1"
     by simp
   then have "r1 *  (- 1) \<le>  0"
     using f5 f4 f3 f2 by meson
   then have f6: "0 \<le> r1" by fastforce
   have "1 *  (- 1) \<le>  (- 1::real)"
     using f2 by force
   then have fact:"r2 \<le>  (- 1)"
     using f3 a2 by fastforce
   have rule:"\<And>c. c > 0 \<Longrightarrow> r1 \<ge> c \<and> r2 \<le> -1 \<Longrightarrow> r1 * r2 \<le> -c"
     apply auto
     by (metis (no_types, hide_lams) f5 mult_less_cancel_left_pos 
         mult_minus1_right neg_le_iff_le not_less)
   have "r1 * r2 \<le> NegInf"
     using "PosNeg" f6 fact rule[of PosInf] a1
     by(auto)
   then show ?thesis
     using "PosNeg" by (auto simp add: repe.simps)
 next
   case NegNeg
   have a1: "(-2147483647) \<ge> r1"
     using eq1 "NegNeg" by (auto simp add: repe.simps)
   then have h1:"r1 \<le> -1"
     using max.bounded_iff max_def one_le_numeral
     by auto
   have a2: " (-2147483647) \<ge> r2"
     using eq2 "NegNeg" by (auto simp add: repe.simps)
   have f1: "\<forall>e ea eb. \<not> (e::real) \<le> ea \<or> \<not> 0 \<le> eb \<or> eb * e \<le> eb * ea"
     using mult_left_mono by metis
   have f2: "-  1 =  (- 1::real)"
     by force
   have f3: " 0 \<le>  (1::real)"
     by simp
   have f4: "\<forall>e ea eb. (ea::real) \<le> e \<or> \<not> ea \<le> eb \<or> \<not> eb \<le> e"
     by (meson less_le_trans not_le)
   have f5: " 0 \<le>  (2147483647::real)"
     by simp
   have f6: "-  (- 2147483647) =  (2147483647::real)"
     by force
   then have f7: "- ( (- 2147483647) * r1) =  (2147483647 * r1)"
     by (metis mult_minus_left)
   have f8: "- ( (- 2147483647) *  (- 1)) =  2147483647 *  (- 1::real)"
     by simp
   have " 2147483647 = -  1 *  (- 2147483647::real)"
     by simp
   then have f9: "r1 \<le>  (- 1) \<longrightarrow>  2147483647 \<le> r1 *  (- 2147483647)"
     using f8 f7 f5 f2 f1 by linarith
   have f10: "-  2147483647 =  (- 2147483647::real)"
     by fastforce
   have f11: "- (r2 *  1 * (r1 *  (- 1))) = r1 * r2"
     by (simp add: mult.commute)
   have f12: "r1 *  (- 1) = - (r1 *  1)"
     by simp
   have "r1 *  1 * ( (- 2147483647) *  1) =  (- 2147483647) * r1"
     by (simp add: mult.commute)
   then have f13: "r1 *  (- 1) * ( (- 2147483647) *  1) =  2147483647 * r1"
     using f12 f6 by (metis (no_types) mult_minus_left)
   have " 1 * r1 \<le>  1 *  (- 2147483647)"
     using a1 
     by (auto simp add: a1)
   then have " 2147483647 \<le> r1 *  (- 1)" by fastforce
   then have "0 \<le> r1 *  (- 1)"
     using f5 f4 by (metis)
   then have "r1 \<le>  (- 1) \<and> - (r1 *  2147483647) \<le> - (r2 *  1 * (r1 *  (- 1)))"
     by (metis a2 f11 h1 mult_left_mono_neg minus_mult_right mult_minus1_right neg_0_le_iff_le)
   then have "r1 \<le>  (- 1) \<and> r1 *  (- 2147483647) \<le> r2 * r1"
     using f11 f10 by (metis mult_minus_left mult.commute)
   then have fact:" 2147483647 \<le> r2 * r1"
     using f9 f4 by blast
   show ?thesis
     using a1 a2 h1 fact
     by (auto simp add: repe.simps "NegNeg" mult.commute)
 next
   case PosLo
   from "PosLo"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" by (auto)
   from eq1 "PosLo" 
   have upper:" (real_of_int (sint POS_INF)) \<le> r1 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w2 < 0" using "PosLo" 
     apply (auto simp add: word_sless_def word_sle_def)   
     by (simp add: dual_order.order_iff_strict)
   then have lower2:"sint w2 \<le> -1" by auto
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "PosLo"  
     by (auto simp add: repe.simps)
   have f4: "r1 *  (- 1) \<le>  (- 2147483647)"
     using upper by (auto)
   have f5: "r2 \<le>  (- 1)"
     using lower2 rw2 by transfer simp
   have "0 < r1"
     using upper by (auto) 
   have "\<forall>r. r < - 2147483647 \<or> \<not> r < r1 * - 1"
     using f4 less_le_trans by blast
   then have "r1 *  (real_of_int (sint w2)) \<le>  (- 2147483647)"
     using f5 f4 upper lower2 rw2 mult_left_mono
     by (metis \<open>0 < r1\<close> dual_order.order_iff_strict f5 mult_left_mono rw2)
   then have "r1 * r2 \<le> real_of_int (sint NEG_INF)" 
     using upper lower2  rw2 
     by (auto)
   then show ?thesis
     using "PosLo" by (auto simp add: repe.simps)
 next
   case PosHi
   from "PosHi"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" 
     by (auto)
   from eq1 "PosHi" 
   have upper:"(real_of_int (sint POS_INF)) \<le> r1 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w2 > 0" using "PosHi" 
     apply (auto simp add: word_sless_def word_sle_def)   
     by (simp add: dual_order.order_iff_strict)
   then have lower2:"sint w2 \<ge> 1" by auto
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "PosHi"
     by (auto) 
   have "0 \<le> r1" using upper by (auto)
   then have "r1 \<le> r1 * r2"
     using rw2 lower2 by (metis (no_types)  mult_left_mono mult.right_neutral of_int_1_le_iff)
   have "PosInf \<le> r1 * r2"
       using upper lower2 rw2 
       apply (auto)
       using \<open>0 \<le> r1\<close> mult_numeral_1_right numeral_One of_int_1_le_iff zero_le_one
       apply simp
       using mult_mono [of 2147483647 r1 1 \<open>signed_real_of_word (w2::32 Word.word)\<close>]
       apply simp
       apply transfer
       apply simp
       done
   then show ?thesis
   using "PosHi" by (auto simp add: repe.simps)
 next
   case PosZero
   from "PosZero"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF"
     by (auto)
   from eq1 "PosZero"
   have upper:" (real_of_int (sint POS_INF)) \<le> r1 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w2 = 0" using "PosZero" 
     by (auto simp add: word_sless_def word_sle_def)   
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "PosZero" 
     by auto 
   have "0 = r1 * r2"
     using "PosZero" rw2 by auto
   then show ?thesis
     using "PosZero" by (auto simp add: repe.simps)
 next
   case NegHi
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" 
     using "NegHi" by (auto)
   from eq1 "NegHi" 
   have upper:"(real_of_int (sint NEG_INF)) \<ge> r1 " 
     by (auto simp add: repe.simps)
   have low:"sint w2 > 0" using "NegHi"
     apply (auto simp add: word_sless_def word_sle_def)
     by (simp add: dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w2)) > 0"
     by transfer simp
   then have lower2:"(real_of_int (sint w2)) \<ge> 1"  
     using low by transfer simp
 
   from eq1 have rw1:"r1 \<le> (real_of_int (sint w1))" 
     using repe.simps "NegHi" 
     by (simp add: upper)
   from eq2 have rw2:"r2 = (real_of_int (sint w2))" 
     using repe.simps "NegHi"
     by (auto)
   have mylem:"\<And>x y z::real. x \<le> -1 \<Longrightarrow> y \<ge> 1 \<Longrightarrow> z \<le> -1 \<Longrightarrow> x \<le> z \<Longrightarrow>  x * y \<le> z"
     proof -
     fix x y z::real
     assume a1:"x \<le> -1"
     assume a2:"y \<ge> 1"
     then have h1:"-1 \<ge> -y" by auto
     assume a3:"z \<le> -1"
     then have a4:"z < 0"  by auto
     from a4 have h2:"-z > 0"  using leD leI by auto
     from a3 have h5:"-z \<ge> 1"  by (simp add: leD leI)
     assume a5:"x \<le> z"
     then have h6:"-x \<ge> -z" by auto
     have h3:"-x * -z = x * z" by auto
     show "x * y \<le> z"
       using a1 a2 a3 a5 a4 h1 h2 h3 h6 h5 a5 dual_order.trans leD mult.right_neutral
       by (metis dual_order.order_iff_strict mult_less_cancel_left2)
     qed
   have prereqs:"r1 \<le> - 1" "1 
       \<le> (real_of_int (sint w2))" " (- 2147483647::real) \<le> - 1 " "r1 \<le> (-2147483647)"
     using rw1 rw2 "NegHi" lower2 by (auto simp add: word_sless_def word_sle_def)
   have "r1 * r2 \<le> real_of_int (sint NEG_INF)"
     using upper lower1 lower2 rw1 rw2 
     apply (auto simp add: word_sless_def word_sle_def)
     using mylem[of  "r1" " (real_of_int (sint w2))" " (- 2147483647)"] prereqs
     by auto
   then show ?thesis
     using "NegHi" by (auto simp add: repe.simps)
 next
   case NegLo
   from "NegLo"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" 
     by (auto)
   from eq1 "NegLo" 
   have upper:"(real_of_int (sint NEG_INF)) \<ge> r1" 
   by (auto simp add: repe.simps)
   have low:"sint w2 < 0" using "NegLo"
     by (auto simp add: word_sless_def word_sle_def dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w2)) < 0"
     by transfer simp
   from eq1 have rw1:"r1 \<le>  (real_of_int (sint w1))" 
     using repe.simps "NegLo"
     by (simp add: upper)
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "NegLo"
     by (auto)
   have hom:"(- 2147483647) = -(2147483647::real)" by auto
   have mylem:"\<And>x y z::real. y < 0 \<Longrightarrow>   x \<le> y \<Longrightarrow> z \<le> -1 \<Longrightarrow> -y \<le> x * z"
     proof -
     fix x y z::real
     assume a1:"y < 0"
     assume a2:"x \<le> y"
     then have h1:"-x \<ge> -y" by auto
     assume a3:"z \<le> -1"
     then have a4:"z < 0" 
       by auto
     from a4 have h2:"-z > 0" using leD leI by auto
     from a3 have h5:"-z \<ge> 1" by (simp add: leD leI)
     have h4:"-x * -z \<ge> -y"
       using  a1 a2 a3 a4 h1 h2 h5 dual_order.trans mult.right_neutral
-      by (metis mult.commute neg_0_less_iff_less real_mult_le_cancel_iff1)
+      by (metis mult.commute neg_0_less_iff_less mult_le_cancel_iff1)
     have h3:"-x * -z = x * z" by auto
     show "- y \<le> x * z "
       using a1 a2 a3 a4 h1 h2 h3 h4 h5 
       by simp
     qed
   have prereqs:"- 2147483647 < (0::real)" " r1 \<le> - 2147483647"
     using rw1 rw2 "NegLo" by (auto simp add: word_sless_def word_sle_def)
   moreover have \<open>sint w2 \<le> - 1\<close>
     using low by simp
   then have \<open>real_of_int (sint w2) \<le> real_of_int (- 1)\<close>
     by (simp only: of_int_le_iff)
   then have \<open>signed_real_of_word w2 \<le> - 1\<close>
     by simp
   ultimately have "2147483647 \<le> r1 * r2" 
     using upper lower1 rw1 rw2
       mylem[of "-2147483647" "r1" "(real_of_int (sint w2))"] 
     by (auto simp add: word_sless_def word_sle_def)
   then show ?thesis
     using "NegLo" by (auto simp add: repe.simps)
 next
   case NegZero
   from "NegZero"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" by (auto)
   from eq2 "NegZero" 
   have "r2 = 0" 
     using repe.simps "NegZero"
     by (auto)
   then show ?thesis
     using "NegZero" by (auto simp add: repe.simps)
 next
   case LoPos
   from "LoPos"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF" 
     by (auto)
   from eq2 "LoPos" 
   have upper:"(real_of_int (sint POS_INF)) \<le> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 < 0" using "LoPos"
     apply (auto simp add: word_sless_def word_sle_def)   
     by (simp add: dual_order.order_iff_strict)
   then have lower2:"sint w1 \<le> -1" by auto
   from eq1 have rw1:"r1 = (real_of_int (sint w1))" 
     using repe.simps "LoPos" by (auto simp add: repe.simps)
   have f4: "r2 * (- 1) \<le> (- 2147483647)"
     using upper by(auto)
   have f5: "r1 \<le> (- 1)"
     using lower2 rw1 by transfer simp
   have "0 < r2"
     using upper by(auto)
   then have "r2 * r1 \<le> r2 * (- 1)"
     by (metis dual_order.order_iff_strict mult_right_mono f5  mult.commute)
   then have "r2 * r1 \<le> (- 2147483647)"
     by (meson f4 less_le_trans not_le)
   then have "(real_of_int (sint w1)) * r2 \<le> (- 2147483647)"
     using f5 f4 rw1 less_le_trans not_le mult.commute rw1 
     by (auto simp add: mult.commute)
   then have "r1 * r2 \<le> NegInf"
     using rw1
     by (auto)
   then show ?thesis
     using "LoPos" by (auto simp: repe.simps)
 next
   case HiPos
   from "HiPos"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF" 
     by (auto)
   from eq2 "HiPos"
   have upper:"(real_of_int (sint POS_INF)) \<le> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 > 0" using "HiPos"
     by (auto simp add: word_sless_def word_sle_def dual_order.order_iff_strict)
   then have lower2:"sint w1 \<ge> 1" by auto
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using "HiPos" 
     by (auto simp add: repe.simps)
   have "0 \<le> r2"
     using upper by(auto)
   then have "r2 \<le> r2 * r1"
     using lower2 rw2 by (metis (no_types) mult_left_mono mult.right_neutral of_int_1_le_iff)
   have "2147483647 \<le> r1 * r2"
     using upper lower2 rw2 
     apply (simp add: word_sless_def word_sle_def)
     using mult_mono [of 1 \<open>signed_real_of_word w1\<close> 2147483647 r2]
     apply simp
     apply transfer
     apply simp
     done
   then show ?thesis
     using "HiPos" by (auto simp add: repe.simps)
 next
   case ZeroPos
   from "ZeroPos"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF"
     by (auto)
   from eq2 "ZeroPos" 
   have upper:" (real_of_int (sint POS_INF)) \<le> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 = 0" using "ZeroPos" 
     by (auto simp add: word_sless_def word_sle_def)   
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using repe.simps "ZeroPos" 
     by (auto)
   have "r1 = 0" using lower1 rw2 by auto
   then show ?thesis
     using "ZeroPos" by (auto simp add: repe.simps)
 next 
   case ZeroNeg
   from "ZeroNeg" 
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF" 
     by (auto)
   from eq2 "ZeroNeg" 
   have upper:"(real_of_int (sint NEG_INF)) \<ge> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 = 0" using "ZeroNeg" 
     by (auto simp add: word_sless_def word_sle_def)   
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using repe.simps "ZeroNeg" 
     by (auto)
   have "r1 = 0" using lower1 rw2 by auto
   then show ?thesis
     using "ZeroNeg" by (auto simp add: repe.simps)
 next
   case LoNeg
   from "LoNeg"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF"
     by (auto)
   from eq2 "LoNeg" 
   have upper:" (real_of_int (sint NEG_INF)) \<ge> r2 " 
     by (auto simp add: repe.simps)
   have low:"sint w1 < 0" using "LoNeg" 
     apply (auto simp add: word_sless_def word_sle_def)
     by (simp add: dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w1)) < 0" by transfer simp
   from low have \<open>sint w1 \<le> - 1\<close>
     by simp
   then have lower2:"(real_of_int (sint w1)) \<le> -1"
     by transfer simp
   from eq1 have rw1:"r2 \<le>  (real_of_int (sint w2))" 
     using "LoNeg" upper by auto
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using "LoNeg" by (auto simp add: upper repe.simps)
   have hom:"(- 2147483647::real) = -(2147483647)" by auto
   have mylem:"\<And>x y z::real. y < 0 \<Longrightarrow>   x \<le> y \<Longrightarrow> z \<le> -1 \<Longrightarrow> -y \<le> x * z"
     proof -
     fix x y z::real
     assume a1:"y < 0"
     assume a2:"x \<le> y"
     then have h1:"-x \<ge> -y" by auto
     assume a3:"z \<le> -1"
     then have a4:"z < 0" by auto
     from a4 have h2:"-z > 0" 
       using leD leI by auto
     from a3 have h5:"-z \<ge> 1" 
       by (simp add:  leD leI)
     have h4:"-x * -z \<ge> -y"
       using  a1 a2 a3 a4 h1 h2 h5 dual_order.trans mult_left_mono mult.right_neutral mult.commute
       by (metis dual_order.order_iff_strict mult_minus_right mult_zero_right neg_le_iff_le)
     have h3:"-x * -z = x * z" by auto
     show "- y \<le> x * z "
       using a1 a2 a3 a4 h1 h2 h3 h4 h5 
       by simp
     qed
   have prereqs:"- 2147483647 < (0::real)" " r2 \<le> - 2147483647" " (real_of_int (sint w1)) \<le> - 1"
     using rw1 rw2 "LoNeg" lower2 by (auto simp add: word_sless_def word_sle_def lower2)
   have "2147483647 \<le> r1 * r2"
     using upper lower1 lower2 rw1 rw2 mylem[of "-2147483647" "r2" 
         "(real_of_int (sint w1))"] prereqs
     by (auto simp add:word_sless_def word_sle_def mult.commute)
   then show ?thesis
     using "LoNeg" by (auto simp add: repe.simps)
 next
   case HiNeg
   from HiNeg
   have w1NotPinf:"w1 \<noteq> POS_INF" and w1NotNinf:"w1 \<noteq> NEG_INF"
     by (auto)
   have upper:" (real_of_int (sint NEG_INF)) \<ge> r2 " 
     using HiNeg eq2
     by (auto simp add: repe.simps )
   have low:"sint w1 > 0" using HiNeg 
     apply (auto simp add: word_sless_def word_sle_def)
     by (simp add: dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w1)) > 0" by transfer simp
   from low have \<open>sint w1 \<ge> 1\<close>
     by simp
   then have lower2:"(real_of_int (sint w1)) \<ge> 1"  
     by transfer simp
   from eq2 have rw1:"r2 \<le>  (real_of_int (sint w2))" 
     using repe.simps HiNeg by (simp add: upper)
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using repe.simps HiNeg  
     by (auto)
   have mylem:"\<And>x y z::real. x \<le> -1 \<Longrightarrow> y \<ge> 1 \<Longrightarrow> z \<le> -1 \<Longrightarrow> x \<le> z \<Longrightarrow>  x * y \<le> z"
     proof -
       fix x y z::real
       assume a1:"x \<le> -1"
       assume a2:"y \<ge> 1"
       then have h1:"-1 \<ge> -y" by auto
       assume a3:"z \<le> -1"
       then have a4:"z < 0" by auto
       from a4 have h2:"-z > 0" 
         using  leD leI by auto
       from a3 have h5:"-z \<ge> 1" 
         by (simp add:  leD leI)
       assume a5:"x \<le> z"
       then have h6:"-x \<ge> -z" by auto
       have h3:"-x * -z = x * z" by auto
       show "x * y \<le> z"
         using a1 a2 a3 a4 h1 h2 h3 h6 h5 a5 dual_order.trans less_eq_real_def
         by (metis mult_less_cancel_left1 not_le)
     qed
   have prereqs:"r2 \<le> - 1" "1 \<le> (real_of_int (sint w1))" 
                " (- 2147483647) \<le> - (1::real )" "r2 \<le>  (- 2147483647)"
     using rw1 rw2 HiNeg lower2 by (auto simp add: word_sless_def word_sle_def)
   have "r1 * r2 \<le> - 2147483647"
     using upper lower1 lower2 rw1 rw2 
     apply (auto simp add: word_sless_def word_sle_def)
     using mylem[of "r2" "(real_of_int (sint w1))" " (- 2147483647)"] prereqs
     by (auto simp add: mult.commute)
   then show ?thesis
     using HiNeg by(auto simp add: repe.simps)
 next
   case AllFinite
   let ?prod = "(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))"
   consider 
       (ProdNeg) "?prod <=s ((scast NEG_INF)::64 Word.word)" 
     | (ProdPos) "(((scast POS_INF)::64 Word.word) <=s ?prod)"
     | (ProdFin) "\<not>(?prod <=s ((scast NEG_INF)::64 Word.word)) 
               \<and>  \<not>((scast POS_INF)::64 Word.word) <=s ?prod"
     by (auto)
   then show ?thesis
   proof (cases)
     case ProdNeg
     have bigLeq:"(4611686018427387904::real) \<le> 9223372036854775807" by auto
     have set_cast:"\<And>x::int. (x \<in> {-(2^31)..2^31}) = ( (real_of_int x) \<in> {-(2^31)..2^31})"
       by auto
     have eq3:"sint(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)) = 
      sint ((scast w1)::64 Word.word) * sint ((scast w2)::64 Word.word)"
      apply(rule Word_Lemmas.signed_arith_sint(4))
      using rangew1 rangew2 w1_cast w2_cast 
      using Word.word_size[of "((scast w1)::64 Word.word)"] 
      using Word.word_size[of "((scast w2)::64 Word.word)"]
      using times_upcast_upper[of "sint w1" "sint w2"]
      using times_upcast_lower[of "sint w1" "sint w2"] 
      by auto
     assume "?prod <=s ((scast NEG_INF)::64 Word.word)"
     then have sint_leq:"sint ?prod \<le> sint ((scast NEG_INF)::64 Word.word)"
       using word_sle_def by blast
     have neqs:"w1 \<noteq> POS_INF" " w1 \<noteq> NEG_INF" "w2 \<noteq> POS_INF" "w2 \<noteq> NEG_INF"
       using AllFinite word_sless_def signed.not_less_iff_gr_or_eq by force+
     from eq1 have rw1:"r1 = (real_of_int (sint w1))" using neqs by (auto simp add: repe.simps)
     from eq2 have rw2:"r2 = (real_of_int (sint w2))" using neqs by (auto simp add: repe.simps)
     show ?thesis
       using AllFinite ProdNeg  w1_cast w2_cast rw1 rw2 sint_leq  
       apply (auto simp add: repe.simps eq3)
       apply (subst (asm) of_int_le_iff [symmetric, where ?'a = real])
       apply simp
       done
   next
     case ProdPos
     have bigLeq:"(4611686018427387904::real) \<le> 9223372036854775807" by auto
     have set_cast:"\<And>x::int. (x \<in> {-(2^31)..2^31}) = ( (real_of_int x) \<in> {-(2^31)..2^31})"
       by auto
     have eq3:"sint(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)) = 
       sint ((scast w1)::64 Word.word) * sint ((scast w2)::64 Word.word)"
       apply(rule Word_Lemmas.signed_arith_sint(4))
       using rangew1 rangew2 POS_cast POS_sint w1_cast w2_cast
       using Word.word_size[of "((scast w1)::64 Word.word)"] 
       using Word.word_size[of "((scast w2)::64 Word.word)"]
       using times_upcast_upper[of "sint w1" "sint w2"]
       using times_upcast_lower[of "sint w1" "sint w2"] 
       by auto
     assume cast:"((scast POS_INF)::64 Word.word) <=s ?prod"
     then have sint_leq:"sint ((scast POS_INF)::64 Word.word) \<le> sint ?prod"
       using word_sle_def by blast
     have neqs:"w1 \<noteq> POS_INF" " w1 \<noteq> NEG_INF" "w2 \<noteq> POS_INF" "w2 \<noteq> NEG_INF"
       using AllFinite word_sless_def signed.not_less_iff_gr_or_eq by force+
     from eq1 have rw1:"r1 =  (real_of_int (sint w1))" 
       using repe.simps AllFinite neqs by auto
     from eq2 have rw2:"r2 = (real_of_int (sint w2))" 
       using repe.simps AllFinite neqs by auto
     have prodHi:"r1 * r2 \<ge> PosInf"
       using w1_cast w2_cast rw1 rw2 sint_leq apply (auto simp add: eq3)
       apply (subst (asm) of_int_le_iff [symmetric, where ?'a = real])
       apply simp
       done
     have infs:"SCAST(32 \<rightarrow> 64) NEG_INF <s SCAST(32 \<rightarrow> 64) POS_INF"
       by (auto)
     have casted:"SCAST(32 \<rightarrow> 64) POS_INF <=s SCAST(32 \<rightarrow> 64) w1 * SCAST(32 \<rightarrow> 64) w2"
       using cast by auto
     have almostContra:"SCAST(32 \<rightarrow> 64) NEG_INF <s SCAST(32 \<rightarrow> 64) w1 * SCAST(32 \<rightarrow> 64) w2"
       using infs cast  signed.order.strict_trans2 by blast
     have contra:"\<not>(SCAST(32 \<rightarrow> 64) w1 * SCAST(32 \<rightarrow> 64) w2 <=s SCAST(32 \<rightarrow> 64) NEG_INF)"
       using eq3 almostContra by auto
     have wtimesCase:"wtimes w1 w2 = POS_INF"
       using neqs ProdPos almostContra wtimes.simps AllFinite ProdPos
       by (auto simp add: repe.simps Let_def)
     show ?thesis
       using prodHi
       apply(simp only: repe.simps)      
       apply(rule disjI1)
       apply(rule exI[where x= "r1*r2"])
       apply(rule conjI)
        apply(rule wtimesCase)
       using prodHi by auto
   next
     case ProdFin
     have bigLeq:"(4611686018427387904::real) \<le> 9223372036854775807" by auto
     have set_cast:"\<And>x::int. (x \<in> {-(2^31)..2^31}) = ( (real_of_int x) \<in> {-(2^31)..2^31})"
       by auto
     have eq3:"sint(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)) = 
       sint ((scast w1)::64 Word.word) * sint ((scast w2)::64 Word.word)"
       apply(rule Word_Lemmas.signed_arith_sint(4))
       using rangew1 rangew2 POS_cast POS_sint w1_cast w2_cast 
       using Word.word_size[of "((scast w1)::64 Word.word)"] 
       using Word.word_size[of "((scast w2)::64 Word.word)"]
       using times_upcast_upper[of "sint w1" "sint w2"]
       using times_upcast_lower[of "sint w1" "sint w2"] 
       by auto
     from ProdFin have a1:"\<not>(?prod <=s ((scast NEG_INF)::64 Word.word))"
       by auto
     then have sintGe:"sint (?prod) > sint (((scast NEG_INF)::64 Word.word))"
       using word_sle_def dual_order.order_iff_strict signed.linear 
       by fastforce
     from ProdFin have a2:"\<not>((scast POS_INF)::64 Word.word) <=s ?prod"
       by auto
     then have sintLe:"sint (((scast POS_INF)::64 Word.word)) > sint (?prod)"
       using word_sle_def dual_order.order_iff_strict signed.linear 
       by fastforce
     have neqs:"w1 \<noteq> POS_INF" " w1 \<noteq> NEG_INF" "w2 \<noteq> POS_INF" "w2 \<noteq> NEG_INF"
       using AllFinite word_sless_def signed.not_less_iff_gr_or_eq by force+
     from eq1 have rw1:"r1 =  (real_of_int (sint w1))" using neqs by(auto simp add: repe.simps)
     from eq2 have rw2:"r2 =  (real_of_int (sint w2))" using neqs by(auto simp add: repe.simps)
     from rw1 rw2 have "r1 * r2 =  (real_of_int ((sint w1) * (sint w2)))"
       by simp
     have rightSize:"sint (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))
       \<in> sints (len_of TYPE(32))"
       using sintLe sintGe sints32 by (simp) 
     have downcast:"sint ((scast (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)))::word)
                  = sint (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))"
       using scast_down_range[OF rightSize]
       by auto
     then have res_eq:"r1 * r2 
       = real_of_int(sint((scast (((scast w1)::64 Word.word)*((scast w2)::64 Word.word)))::word))"
       using rw1 rw2 eq3 POS_cast POS_sint w1_cast w2_cast downcast 
         \<open>r1 * r2 =  (real_of_int (sint w1 * sint w2))\<close> 
       by (auto)
     have res_up:"sint (scast (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))::word) 
                < sint POS_INF"
       using rw1 rw2 eq3 POS_cast POS_sint w1_cast w2_cast downcast
         \<open>r1 * r2 = (real_of_int (sint w1 * sint w2))\<close> 
         \<open>sint (scast w1 * scast w2) < sint (scast POS_INF)\<close> 
           of_int_eq_iff res_eq 
       by presburger
     have res_lo:"sint NEG_INF 
                < sint (scast (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))::word)"
       using rw1 rw2 eq3 POS_cast POS_sint w1_cast w2_cast NEG_cast downcast
         \<open>r1 * r2 =  (real_of_int (sint w1 * sint w2))\<close> 
         \<open>sint (scast NEG_INF) < sint (scast w1 * scast w2)\<close> 
         of_int_eq_iff res_eq 
       by presburger
     have "scast ?prod \<equiv>\<^sub>E (r1 * r2)"
       using res_eq res_up res_lo 
       apply (auto simp add: rep_simps)
       using repeInt_simps by auto
     then show ?thesis 
       using AllFinite ProdFin by(auto)
   qed
 qed
 qed
 
 subsection \<open>Multiplication upper bound\<close>
 text\<open>Upper bound of multiplication from upper and lower bounds\<close>
 fun tu :: "word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word"
 where "tu w1l w1u w2l w2u = 
  wmax (wmax (wtimes w1l w2l) (wtimes w1u w2l))
       (wmax (wtimes w1l w2u) (wtimes w1u w2u))"
 
 lemma tu_lemma:
   assumes u1:"u\<^sub>1 \<equiv>\<^sub>U (r1::real)"
   assumes u2:"u\<^sub>2 \<equiv>\<^sub>U (r2::real)"
   assumes l1:"l\<^sub>1 \<equiv>\<^sub>L (r1::real)"
   assumes l2:"l\<^sub>2 \<equiv>\<^sub>L (r2::real)"
   shows "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U (r1 * r2)"
 proof -
   obtain rl1 rl2 ru1 ru2 :: real 
   where gru1:"ru1 \<ge> r1" and gru2:"ru2 \<ge> r2" and grl1:"rl1 \<le> r1" and grl2:"rl2 \<le> r2" 
   and eru1:"u\<^sub>1 \<equiv>\<^sub>E ru1" and eru2:"u\<^sub>2 \<equiv>\<^sub>E ru2" and erl1:"l\<^sub>1 \<equiv>\<^sub>E rl1" and erl2:"l\<^sub>2 \<equiv>\<^sub>E rl2"
   using u1 u2 l1 l2 unfolding repU_def repL_def by auto
   have timesuu:"wtimes u\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E ru1 * ru2"
     using wtimes_exact[OF eru1 eru2] by auto
   have timesul:"wtimes u\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E ru1 * rl2"
     using wtimes_exact[OF eru1 erl2] by auto
   have timeslu:"wtimes l\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E rl1 * ru2"
     using wtimes_exact[OF erl1 eru2] by auto
   have timesll:"wtimes l\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E rl1 * rl2"
     using wtimes_exact[OF erl1 erl2] by auto
   have maxt12:"wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>E max (rl1 * rl2) (ru1 * rl2)"
     by (rule  wmax_lemma[OF timesll timesul])
   have maxt34:"wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>E max (rl1 * ru2) (ru1 * ru2)"
     by (rule  wmax_lemma[OF timeslu timesuu])
   have bigMax:"wmax (wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>E max (max (rl1 * rl2) (ru1 * rl2)) (max (rl1 * ru2) (ru1 * ru2))"
     by (rule wmax_lemma[OF maxt12 maxt34])
   obtain maxt12val :: real 
     where maxU12:"wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>U max (rl1 * rl2) (ru1 * rl2)"
   using maxt12 unfolding repU_def by blast
   obtain maxt34val :: real 
     where maxU34:"wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>U max (rl1 * ru2) (ru1 * ru2)"
   using maxt34 unfolding repU_def by blast
   obtain bigMaxU:"wmax (wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>U max (max (rl1 * rl2) (ru1 * rl2)) (max (rl1 * ru2) (ru1 * ru2))"
   using bigMax unfolding repU_def by blast
   have ivl1:"rl1 \<le> ru1" using grl1 gru1 by auto
   have ivl2:"rl2 \<le> ru2" using grl2 gru2 by auto
   let ?thesis = "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2"
   show ?thesis
   using ivl1 ivl2
   proof(cases rule: case_ivl_zero)
     case ZeroZero
     assume "rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     then have geq1:"ru1 \<ge> 0" and geq2:"ru2 \<ge> 0" by auto
     consider "r1 \<ge> 0 \<and> r2 \<ge> 0" | "r1 \<ge> 0 \<and> r2 \<le> 0" | "r1 \<le> 0 \<and> r2 \<ge> 0" | "r1 \<le> 0 \<and> r2 \<le> 0"
     using le_cases by auto
     then show "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2" 
     proof (cases)
       case 1
       have g1:"ru1 * ru2 \<ge> ru1 * r2" 
         using "1" geq1 geq2 grl2 gru2
         by (simp add: mult_left_mono)
       have g2:"ru1 * r2 \<ge> r1 * r2"
         using "1" geq1 geq2 grl1 grl2 gru1 gru2
         by (simp add: mult_right_mono)
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up eru1 eru2 erl1 erl2 repU_def timesuu tu.simps
           max_repU2[OF maxU12] max_repU2[OF maxU34] max_repU2[OF bigMaxU]
         by (metis wmax.elims)
     next
       case 2
       have g1:"ru1 * ru2 \<ge> 0" 
         using "2" geq1 geq2 grl2 gru2 by (simp)
       have g2:"0 \<ge> r1 * r2"
         using "2" by (simp add: mult_le_0_iff)
         from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2" by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12]
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis  repU_def  tu.simps)
     next
       case 3
       have g1:"ru1 * ru2 \<ge> 0" 
         using "3" geq1 geq2  by simp
       have g2:"0 \<ge> r1 * r2"
         using "3" by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2" by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] repU_def tu.simps timesuu
         by (metis max.coboundedI1 max.commute maxt34)
     next
       case 4
       have g1:"rl1 * rl2 \<ge> rl1 * r2" 
         using "4" geq1 geq2 grl1 grl2 gru1 gru2
         using  \<open>rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2\<close> less_eq_real_def
           by (metis mult_left_mono_neg)
       have g2:"rl1 * r2 \<ge> r1 * r2"
         using "4" geq1 geq2 grl1 grl2 gru1 gru2 \<open>rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2\<close>  
           by (metis mult_left_mono_neg mult.commute)
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU1 repU_def timesll tu.simps)
       qed
   next
     case ZeroPos
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> 0 \<le> rl2"
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     consider "r1 \<ge> 0" | "r1 \<le> 0" using le_cases by (auto)
     then show ?thesis
     proof (cases)
       case 1
       assume r1:"r1 \<ge> 0"
       have g1:"ru1 * ru2 \<ge> ru1 * r2" 
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_left_mono by blast
       have g2:"ru1 * r2 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_right_mono by blast
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis repU_def tu.simps) 
     next
       case 2
       assume r1:"r1 \<le> 0"
       have g1:"ru1 * ru2 \<ge> 0" 
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_left_mono 
         by (simp add: mult_less_0_iff less_le_trans not_less)
       have g2:"0 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_right_mono 
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis repU_def tu.simps) 
       qed 
   next
     case ZeroNeg
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> ru2 \<le> 0"
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have case1:"r1 \<ge> 0 \<Longrightarrow> ?thesis" 
     proof -
       assume r1:"r1 \<ge> 0"
       have g1:"rl1 * rl2 \<ge> 0" 
         using r1 r2 bounds grl1 grl2 gru1 gru2 mult_less_0_iff less_le_trans not_less
         by metis
       have g2:"0 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_right_mono 
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis 
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU2 max_repU1 repU_def timesll tu.simps)
     qed
     have case2:"r1 \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume r1:"r1 \<le> 0"
       have g1:"rl1 * rl2 \<ge> rl1 * r2" 
         using r1 r2 bounds  grl1 grl2 gru1 gru2
         by (metis mult_left_mono_neg)
       have g2:"rl1 * r2 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2 mult.commute
         by (metis mult_left_mono_neg)
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34 
         by (metis max_repU1 repU_def timesll tu.simps) 
     qed
     show "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2"
       using case1 case2 le_cases by blast
   next
     case PosZero
     assume bounds:"0 \<le> rl1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"ru1 * ru2 \<ge> ru1 * r2" 
         using "1" bounds grl1 grl2 gru1 gru2
         using mult_left_mono 
         using leD leI less_le_trans by metis
       have g2:"ru1 * r2 \<ge> r1 * r2"
         using "1" bounds grl1 grl2 gru1 gru2
         using mult_right_mono by blast
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis repU_def tu.simps) 
     next
       case 2
         have g1:"ru1 * ru2 \<ge> 0" 
           using r1 bounds grl2 gru2 gru1 leD leI less_le_trans by auto
         have g2:"0 \<ge> r1 * r2"
           using r1 "2" 
           by (simp add: mult_le_0_iff)
         from g1 and g2
         have up:"ru1 * ru2 \<ge> r1 * r2"
           by auto
         show ?thesis
           using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
             max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
           by (metis repU_def tu.simps)
       qed
   next
     case NegZero
     assume bounds:"ru1 \<le> 0 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<le> 0"  using bounds dual_order.trans gru1 by blast
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"ru1 * rl2 \<ge> 0" 
         using r1 "1" bounds grl1 grl2 gru1 gru2 mult_less_0_iff not_less
         by metis
       have g2:"0 \<ge> r1 * r2"
         using r1 "1" bounds grl1 grl2 gru1 gru2
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"ru1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU1 repU_def timesul tu.simps) 
     next
       case 2
       have lower:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
       have g1:"rl1 * rl2 \<ge> rl1 * r2" 
         using r1 "2" bounds grl1 grl2 gru1 gru2 less_eq(1) less_le_trans not_less 
           mult_le_cancel_left
         by metis
       have g2:"rl1 * r2 \<ge> r1 * r2"
         using r1 "2" bounds grl1 grl2 gru1 gru2 mult.commute not_le lower mult_le_cancel_left
         by metis
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU1 repU_def timesll tu.simps)
     qed
   next
     case NegNeg
     assume bounds:"ru1 \<le> 0 \<and> ru2 \<le> 0"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<le> 0" using bounds dual_order.trans grl2 r2 by blast
     have g1:"rl1 * rl2 \<ge> rl1 * r2" 
       using r1 r2 bounds  grl1 grl2 gru1 gru2 less_eq(1)  mult_le_cancel_left less_le_trans not_less
       by metis
     have g2:"rl1 * r2 \<ge> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult.commute not_le lower1 lower2 mult_le_cancel_left
       by metis
     from g1 and g2
     have up:"rl1 * rl2 \<ge> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
         max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34 
       by (metis max_repU1 repU_def timesll tu.simps)
   next
     case NegPos
     assume bounds:"ru1 \<le> 0 \<and> 0 \<le> rl2"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<le> 0" using bounds by auto 
     have upper2:"ru2 \<ge> 0" using bounds dual_order.trans gru2 r2 by blast
     have g1:"ru1 * rl2 \<ge> ru1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 not_less upper1 lower2 mult_le_cancel_left
       by metis
     have g2:"ru1 * r2 \<ge> r1 * r2"
       using r1 upper1 r2 mult_right_mono gru1 by metis
     from g1 and g2
     have up:"ru1 * rl2 \<ge> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU wmax.elims maxt34
         max_repU2[OF maxU12] max_repU2[OF maxU34] max_repU2[OF bigMaxU]
       by (metis max_repU1 repU_def timesul tu.simps)
   next
     case PosNeg
     assume bounds:"0 \<le> rl1 \<and> ru2 \<le> 0"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<le> 0" using dual_order.trans grl2 r2 by blast
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<le> 0" using bounds by auto
     have g1:"rl1 * ru2 \<ge> rl1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 not_less upper2 lower1 mult_le_cancel_left 
       by metis
     have g2:"rl1 * r2 \<ge> r1 * r2"
       using r1 lower1 r2 not_less gru2 gru1 grl1 grl2
       by (metis mult_le_cancel_left mult.commute)
     from g1 and g2
     have up:"rl1 * ru2 \<ge> r1 * r2"
       by auto
     show "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2"
       using up maxU12 maxU34 bigMaxU wmax.elims max.coboundedI1 max.commute maxt34
         max_repU2[OF maxU12] max_repU2[OF maxU34] max_repU2[OF bigMaxU] 
       by (metis repU_def tu.simps)
   next
     case PosPos
     assume bounds:"0 \<le> rl1 \<and> 0 \<le> rl2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<ge> 0" using dual_order.trans gru2 u2 r2 bounds by blast
     have g1:"ru1 * ru2 \<ge> ru1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_left_mono leD leI less_le_trans by metis
     have g2:"ru1 * r2 \<ge> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_right_mono by metis
     from g1 and g2
     have up:"ru1 * ru2 \<ge> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU wmax.elims max.coboundedI1 max.commute maxt34
         max_repU2[OF bigMaxU] max_repU2[OF maxU12] max_repU2[OF maxU34]
       by (metis repU_def tu.simps)
   qed
 qed
 
 subsection \<open>Minimum function\<close>
 text\<open>Minimum of 2s-complement words\<close>
 fun wmin :: "word \<Rightarrow> word \<Rightarrow> word"
 where "wmin w1 w2 = 
   (if w1 <s w2 then w1 else w2)"
                                             
 text\<open>Correctness of wmin\<close>
 lemma wmin_lemma:
   assumes eq1:"w1 \<equiv>\<^sub>E (r1::real)"
   assumes eq2:"w2 \<equiv>\<^sub>E (r2::real)"
   shows "wmin w1 w2 \<equiv>\<^sub>E (min r1 r2)"
 proof(cases rule: case_inf2[where ?w1.0=w1, where ?w2.0=w2])
   case PosPos
   assume p1:"w1 = POS_INF"   
      and p2:"w2 = POS_INF"
   then have bound1:"(real_of_int (sint POS_INF)) \<le> r1"
         and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     using eq1 eq2 by (auto simp add: rep_simps repe.simps)
   have eqInf:"wmin w1 w2 = POS_INF"
     using p1 p2 unfolding wmin.simps by auto
   have pos_eq:"POS_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2 unfolding eq1 eq2 by auto
   show ?thesis
     using pos_eq eqInf by auto
 next
   case PosNeg
   assume p1:"w1 = POS_INF"
   assume n2:"w2 = NEG_INF"
   obtain r ra :: real 
   where bound1:" (real_of_int (sint POS_INF)) \<le> r"
     and bound2:"ra \<le>  (real_of_int (sint NEG_INF))"
     and eq1:"r1 = r"
     and eq2:"r2 = ra"
     using p1 n2 eq1 eq2 by(auto simp add: rep_simps repe.simps)
   have eqNeg:"wmin w1 w2 = NEG_INF"
     unfolding eq1 eq2 wmin.simps p1 n2 word_sless_def word_sle_def
     by(auto) 
   have neg_eq:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using bound1 bound2 eq1 eq2 by auto
   show "?thesis"
     using eqNeg neg_eq by auto
 next
   case PosNum
   assume p1:"w1 = POS_INF"
   assume np2:"w2 \<noteq> POS_INF"
   assume nn2:"w2 \<noteq> NEG_INF"
   have eq2:"r2 = (real_of_int (sint w2))"
     and bound1:"(real_of_int (sint POS_INF)) \<le> r1"
     and bound2a:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
     and bound2b:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
     using p1 np2 nn2 eq1 eq2 by(auto simp add: rep_simps repe.simps)
   have eqNeg:"min r1 r2 = sint w2"
     using p1
     by (metis bound1 bound2b dual_order.trans eq2 min_def not_less) 
   have neg_eq:"wmin w1 w2 \<equiv>\<^sub>E  (real_of_int (sint (wmin w1 w2)))"
     apply (rule repINT)
     using bound1 bound2a bound2b bound2b p1 unfolding eq1 eq2
     by (auto simp add: word_sless_alt)
   show "?thesis"
     using eqNeg neg_eq
     by (metis bound2b less_eq_real_def not_less of_int_less_iff p1 wmin.simps word_sless_alt)
 next
   case NegPos
   assume n1:"w1 = NEG_INF"   
   assume p2:"w2 = POS_INF"
   have  bound1:"r1 \<le> (real_of_int (sint NEG_INF))"
     and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     using n1 p2 eq1 eq2 by(auto simp add: rep_simps repe.simps)    
   have eqNeg:"wmin w1 w2 = NEG_INF"
     unfolding eq1 eq2 wmin.simps n1 p2 word_sless_def word_sle_def
     by(auto)
   have neg_eq:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using bound1 bound2 unfolding eq1 eq2 by auto
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using eqNeg neg_eq by auto                      
 next
   case NegNeg
   assume n1:"w1 = NEG_INF"                 
   assume n2:"w2 = NEG_INF" 
   have bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
    and bound2:"r2 \<le>  (real_of_int (sint NEG_INF))"
     using n1 n2 eq1 eq2 by(auto simp add: rep_simps repe.simps)    
   have eqNeg:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using eq1 eq2 bound1 bound2 unfolding NEG_INF_def
     by (auto)
   have neg_eq:"wmin w1 w2 = NEG_INF"
     using n1 n2 unfolding NEG_INF_def wmin.simps by auto 
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using eqNeg neg_eq by auto
 next
   case NegNum
   assume n1:"w1 = NEG_INF" 
     and  nn2:"w2 \<noteq> NEG_INF"
     and  np2:"w2 \<noteq> POS_INF"
   have eq2:"r2 =  (real_of_int (sint w2))"
     and bound2a:"(real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
     and bound2b:"(real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
     and bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
     using n1 nn2 np2 eq2 eq1 eq2 by (auto simp add: rep_simps repe.simps)  
   have eqNeg:"wmin w1 w2 = NEG_INF"
     using n1 assms(2) bound2a eq2 n1 repeInt_simps  
     by (auto simp add: word_sless_alt)
   have neg_eq:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using bound1 bound2a bound2b eq1 min_le_iff_disj by blast
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using eqNeg neg_eq by auto
 next
   case NumPos
   assume p2:"w2 = POS_INF"
    and  nn1:"w1 \<noteq> NEG_INF"
    and  np1:"w1 \<noteq> POS_INF"
   have eq1:"r1 =  (real_of_int (sint w1))"
     and bound1a:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
     and bound1b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
     and bound2:" (real_of_int (sint POS_INF)) \<le> r2"
     using nn1 np1 p2 eq2 eq1 eq2 by (auto simp add: rep_simps repe.simps)  
   have res1:"wmin w1 w2 = w1"
     using p2 eq1 eq2  assms(1) bound1b p2 repeInt_simps  
     by (auto simp add: word_sless_alt)
   have res2:"min r1 r2 =  (real_of_int (sint w1))"
     using eq1 eq2 bound1a bound1b bound2 
     by transfer (auto simp add: less_imp_le less_le_trans min_def)
   have res3:"wmin w1 w2 \<equiv>\<^sub>E  (real_of_int (sint (wmin w1 w2)))"
     apply(rule repINT)
     using p2 bound1a res1 bound1a bound1b bound2 
     by auto
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2" 
     using res1 res2 res3 by auto
 next
   case NumNeg
   assume nn1:"w1 \<noteq> NEG_INF"
   assume np1:"w1 \<noteq> POS_INF"
   assume n2:"w2 = NEG_INF"
   have eq1:"r1 =  (real_of_int (sint w1))"
     and bound1a:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
     and bound1b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
     and bound2:"r2 \<le>  (real_of_int (sint NEG_INF))"
     using nn1 np1 n2 eq2 eq1 eq2 by (auto simp add: rep_simps repe.simps)
   have res1:"wmin w1 w2 = NEG_INF"
     using n2 bound1b
     by (metis min.absorb_iff2 min_def n2 not_less of_int_less_iff wmin.simps word_sless_alt)
   have res2:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using eq1 eq2 bound1a bound1b bound2 min_le_iff_disj by blast
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using res1 res2 by auto
 next
   case NumNum
   assume np1:"w1 \<noteq> POS_INF"
   assume nn1:"w1 \<noteq> NEG_INF"
   assume np2:"w2 \<noteq> POS_INF"
   assume nn2:"w2 \<noteq> NEG_INF"
   have eq1:"r1 =  (real_of_int (sint w1))"
   and  eq2:"r2 =  (real_of_int (sint w2))"
   and  bound1a:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
   and  bound1b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
   and  bound2a:" (real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
   and  bound2b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
     using nn1 np1 nn2 np2 eq2 eq1 eq2 
     by (auto simp add: rep_simps repe.simps)
   have res1:"min r1 r2 =  (real_of_int (sint (wmin w1 w2)))"
     using eq1 eq2 bound1a bound1b bound2a bound2b 
     apply (simp add: min_def word_sless_alt not_less)
     apply transfer
     apply simp
     done
   have res2:"wmin w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmin w1 w2)))"
     apply (rule repINT)
     using bound1a bound1b bound2a bound2b
     by (simp add: \<open>min r1 r2 = (real_of_int (sint (wmin w1 w2)))\<close> eq2 min_less_iff_disj)+
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using res1 res2 by auto
 qed    
     
 lemma min_repU1:
   assumes "w1 \<equiv>\<^sub>L x"
   assumes "w2 \<equiv>\<^sub>L y"
   shows "wmin w1 w2 \<equiv>\<^sub>L x "
   using wmin_lemma assms repL_def
   by (meson min_le_iff_disj)
 
 lemma min_repU2:
   assumes "w1 \<equiv>\<^sub>L y"
   assumes "w2 \<equiv>\<^sub>L x"
   shows "wmin w1 w2 \<equiv>\<^sub>L x"
   using wmin_lemma assms repL_def
 by (meson min_le_iff_disj)
 
 
 subsection \<open>Multiplication lower bound\<close>
 text\<open>Multiplication lower bound\<close>
 fun tl :: "word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word"
 where "tl w1l w1u w2l w2u =
   wmin (wmin (wtimes w1l w2l) (wtimes w1u w2l))
        (wmin (wtimes w1l w2u) (wtimes w1u w2u))"
 
 text\<open>Correctness of multiplication lower bound\<close>
 lemma tl_lemma:
   assumes u1:"u\<^sub>1 \<equiv>\<^sub>U (r1::real)"
   assumes u2:"u\<^sub>2 \<equiv>\<^sub>U (r2::real)"
   assumes l1:"l\<^sub>1 \<equiv>\<^sub>L (r1::real)"
   assumes l2:"l\<^sub>2 \<equiv>\<^sub>L (r2::real)"
   shows "tl l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>L (r1 * r2)"
 proof -
   obtain rl1 rl2 ru1 ru2 :: real 
   where gru1:"ru1 \<ge> r1" and gru2:"ru2 \<ge> r2" and grl1:"rl1 \<le> r1" and grl2:"rl2 \<le> r2" 
   and eru1:"u\<^sub>1 \<equiv>\<^sub>E ru1" and eru2:"u\<^sub>2 \<equiv>\<^sub>E ru2" and erl1:"l\<^sub>1 \<equiv>\<^sub>E rl1" and erl2:"l\<^sub>2 \<equiv>\<^sub>E rl2"
   using u1 u2 l1 l2 unfolding repU_def repL_def by auto
   have timesuu:"wtimes u\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E ru1 * ru2"
     using wtimes_exact[OF eru1 eru2] by auto
   have timesul:"wtimes u\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E ru1 * rl2"
     using wtimes_exact[OF eru1 erl2] by auto
   have timeslu:"wtimes l\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E rl1 * ru2"
     using wtimes_exact[OF erl1 eru2] by auto
   have timesll:"wtimes l\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E rl1 * rl2"
     using wtimes_exact[OF erl1 erl2] by auto
   have maxt12:"wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>E min (rl1 * rl2) (ru1 * rl2)"
     by (rule  wmin_lemma[OF timesll timesul])
   have maxt34:"wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>E min (rl1 * ru2) (ru1 * ru2)"
     by (rule  wmin_lemma[OF timeslu timesuu])
   have bigMax:"wmin (wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>E min (min(rl1 * rl2) (ru1 * rl2)) (min (rl1 * ru2) (ru1 * ru2))"
     by (rule wmin_lemma[OF maxt12 maxt34])
   obtain maxt12val :: real 
     where maxU12:"wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>L min (rl1 * rl2) (ru1 * rl2)"
   using maxt12 unfolding repL_def by blast
   obtain maxt34val :: real 
     where maxU34:"wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>L min (rl1 * ru2) (ru1 * ru2)"
   using maxt34 unfolding repL_def by blast
   obtain bigMaxU:"wmin (wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>L min (min (rl1 * rl2) (ru1 * rl2)) (min (rl1 * ru2) (ru1 * ru2))"
   using bigMax unfolding repL_def by blast
   have ivl1:"rl1 \<le> ru1" using grl1 gru1 by auto
   have ivl2:"rl2 \<le> ru2" using grl2 gru2 by auto
   let ?thesis = "tl l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>L r1 * r2"
   show ?thesis
   using ivl1 ivl2
   proof(cases rule: case_ivl_zero)
     case ZeroZero        
     assume "rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     then have geq1:"ru1 \<ge> 0" and geq2:"ru2 \<ge> 0" 
     and geq3:"rl1 \<le> 0" and geq4:"rl2 \<le> 0" by auto
     consider "r1 \<ge> 0 \<and> r2 \<ge> 0" | "r1 \<le> 0 \<and> r2 \<ge> 0" | "r1 \<ge> 0 \<and> r2 \<le> 0" | "r1 \<le> 0 \<and> r2 \<le> 0"
       using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"rl1 * ru2 \<le> 0" 
         using "1" geq1 geq2 geq3 geq4 grl2 gru2 mult_le_0_iff by blast
       have g2:"0 \<le>  r1 * r2"
         using "1"  geq1 geq2 grl1 grl2 gru1 gru2
         by (simp)
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up eru1 eru2 erl1 erl2 min_repU1 min_repU2 
           repL_def repU_def timeslu tl.simps wmin.elims
         by (metis bigMax min_le_iff_disj)
     next
       case 2
       have g1:"rl1 * ru2 \<le> rl1 * r2" 
         using "2" geq1 geq2 grl2 gru2
         by (metis mult_le_cancel_left  geq3 leD)
       have g2:"rl1 * r2 \<le> r1 * r2"
         using "2" geq1 geq2 grl2 gru2
         by (simp add: mult_right_mono grl1)
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
         by (metis up maxU12 min_repU2 repL_def tl.simps min.coboundedI1 maxt34)
     next
       case 3
       have g1:"ru1 * rl2 \<le> ru1 * r2" 
         using "3" geq1 geq2 grl2 gru2
         by (simp add: mult_left_mono)
       have g2:"ru1 * r2 \<le> r1 * r2"
         using "3" geq1 geq2 grl1 grl2 gru1 gru2 mult_minus_right mult_right_mono
         by (simp add: mult_right_mono_neg)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2" by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 maxt34 timesul
         by (metis repL_def tl.simps)
     next
       case 4
       have g1:"ru1 * rl2 \<le> 0" 
         using "4" geq1 geq2 grl1 grl2 gru1 gru2 \<open>rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2\<close> 
           mult_less_0_iff  less_eq_real_def not_less
         by auto
       have g2:"0 \<le> r1 * r2"
         using "4" geq1 geq2 grl1 grl2 gru1 gru2
         by (metis mult_less_0_iff  not_less)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
       by (metis up maxU12 maxU34 wmin.elims min_repU1 min_repU2 repL_def timesul tl.simps) 
     qed
   next
     case ZeroPos
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> 0 \<le> rl2"
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     consider "r1 \<ge> 0" | "r1 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"rl1 * rl2 \<le> 0" 
         using "1" r2 bounds grl1 grl2 gru1 gru2
         by (simp add: mult_le_0_iff)
       have g2:"0 \<le> r1 * r2"
         using "1" r2 bounds grl1 grl2 gru1 gru2
         by (simp)
       from g1 and g2
       have up:"rl1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
         by (metis repL_def timesll tl.simps up maxU12 maxU34 wmin.elims min_repU2 min_repU1) 
     next
       case 2
       have bound:"ru2 \<ge> 0"
         using "2" r2 bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
       then have g1:"rl1 * ru2 \<le> rl1 * r2" 
         using "2" r2 bounds grl1 grl2 gru1 gru2 mult_le_cancel_left
         by fastforce
       have g2:"rl1 * r2 \<le> r1 * r2"
         using "2" r2 bounds grl1 grl2 gru1 gru2 mult_le_0_iff mult_le_cancel_right by fastforce
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2" by auto
       show ?thesis
         by (metis up maxU12 wmin.elims min_repU2 min.coboundedI1 maxt34 repL_def tl.simps) 
       qed
   next
     case ZeroNeg
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> ru2 \<le> 0"
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     consider (Pos) "r1 \<ge> 0" | (Neg) "r1 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case Pos
       have bound:"rl2 \<le> 0"
         using Pos r2 bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
       then have g1:"ru1 * rl2 \<le> ru1 * r2" 
         using Pos bounds grl1 grl2 gru1 gru2 mult_le_cancel_left
         by fastforce
       have p1:"\<And>a::real. (0 \<le> - a) = (a \<le> 0)"
         by(auto)
       have p2:"\<And>a b::real.  (- a \<le> - b) = (b \<le> a)" by auto
       have g2:"ru1 * r2 \<le> r1 * r2"
         using Pos r2 bounds grl1 grl2 gru1 gru2 p1 p2
         by (simp add: mult_right_mono_neg)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis 
         by (metis up maxU12 maxU34 wmin.elims min_repU2 min_repU1 repL_def timesul tl.simps)
     next
       case Neg
       have g1:"ru1 * ru2 \<le> 0" 
         using Neg r2 bounds  grl1 grl2 gru1 gru2 mult_le_0_iff by blast
       have g2:"0 \<le> r1 * r2"
         using Neg r2 zero_le_mult_iff by blast  
       from g1 and g2
       have up:"ru1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 
         min.coboundedI1 min.commute maxt34 
         by (metis repL_def tl.simps) 
       qed
   next
     case PosZero
     assume bounds:"0 \<le> rl1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have bound:"0 \<le> ru1" using r1 bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"rl1 * rl2 \<le> 0" 
         using r1 "1" bounds grl1 grl2 gru1 gru2 mult_le_0_iff by blast
       have g2:"0 \<le> r1 * r2"
         using r1 "1" bounds grl1 grl2 gru1 gru2 zero_le_mult_iff by blast
       from g1 and g2
       have up:"rl1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims min_repU2 min_repU1 
         min.coboundedI1 min.commute maxt12 maxt34 repL_def timesll tl.simps
         by metis          
     next
       case 2
       have g1:"ru1 * rl2 \<le> ru1 * r2" 
         using r1 "2" bounds bound grl1 grl2 gru1 gru2
         using mult_left_mono by blast
       have g2:"ru1 * r2 \<le> r1 * r2"
         using r1 "2" bounds bound grl2 gru2
         by (metis mult_left_mono_neg gru1 mult.commute)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 maxt34
         by (metis repL_def timesul tl.simps)
       qed
   next
     case NegZero
     assume bounds:"ru1 \<le> 0 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<le> 0"  using bounds dual_order.trans gru1 by blast
     have bound:"rl1 \<le> 0" using r1  bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       assume r2:"r2 \<ge> 0"
       have g1:"rl1 * ru2 \<le> rl1 * r2" 
         using r1 r2 bounds bound grl1 grl2 gru1 gru2
         by (metis mult_le_cancel_left leD)  
       have g2:"rl1 * r2 \<le> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2 mult_right_mono 
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
       using up maxU12 maxU34 bigMaxU min_repU2 min_repU1 min.coboundedI1 maxt34
       by (metis min_repU2 repL_def tl.simps) 
     next
       case 2
       assume r2:"r2 \<le> 0"
       have lower:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
       have g1:"ru1 * ru2 \<le> 0" 
         using r1 r2 bounds  grl1 grl2 gru1 gru2 mult_le_0_iff by blast
       have g2:"0 \<le> r1 * r2"
         using r1 r2 
         by (simp add: zero_le_mult_iff)
       from g1 and g2
       have up:"ru1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
       using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 
         min.coboundedI1 min.commute maxt34
       by (metis repL_def tl.simps)
       qed
   next
     case NegNeg
     assume bounds:"ru1 \<le> 0 \<and> ru2 \<le> 0"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<le> 0" using bounds dual_order.trans grl2 r2 by blast
     have g1:"ru1 * ru2 \<le> ru1 * r2" 
       using r1 r2 bounds  grl1 grl2 gru1 gru2
       using    not_less mult_le_cancel_left
       by metis
     have g2:"ru1 * r2 \<le> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_le_cancel_left mult.commute not_le lower1 lower2
       by metis
     from g1 and g2
     have up:"ru1 * ru2 \<le> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU 
       wmin.elims min_repU2 min_repU1 
       min.coboundedI1 min.commute maxt34 
       by (metis repL_def tl.simps)
   next
     case NegPos
     assume bounds:"ru1 \<le> 0 \<and> 0 \<le> rl2"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<le> 0" using bounds by auto 
     have upper2:"ru2 \<ge> 0" using bounds dual_order.trans gru2 r2 by blast
     have g1:"rl1 * ru2 \<le> rl1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 less_le_trans upper1 lower2 
       by (metis mult_le_cancel_left not_less)
     have g2:"rl1 * r2 \<le> r1 * r2"
       using r1 upper1 r2 mult_right_mono mult_le_0_iff grl1 by blast
     from g1 and g2
     have up:"rl1 * ru2 \<le> r1 * r2"
       by auto
     show ?thesis
     using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 maxt12 maxt34 
     by (metis repL_def timeslu tl.simps)
   next
     case PosNeg
     assume bounds:"0 \<le> rl1 \<and> ru2 \<le> 0"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<le> 0" using dual_order.trans grl2 r2 by blast
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<le> 0" using bounds by auto
     have g1:"ru1 * rl2 \<le> ru1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_left_mono less_le_trans not_less
       by metis
     have g2:"ru1 * r2 \<le> r1 * r2"
       using r1 lower1 r2 not_less gru2 gru1 grl1 grl2
       by (metis mult_le_cancel_left  mult.commute)
     from g1 and g2
     have up:"ru1 * rl2 \<le> r1 * r2"
       by auto
     show "tl l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>L r1 * r2"
       using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1
       by (metis repL_def timesul tl.simps)
   next
     case PosPos
     assume bounds:"0 \<le> rl1 \<and> 0 \<le> rl2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<ge> 0" using dual_order.trans gru2 u2 r2 bounds by blast
     have g1:"rl1 * rl2 \<le> rl1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2
       using mult_left_mono 
       using leD leI less_le_trans by auto
     have g2:"rl1 * r2 \<le> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2
       using mult_right_mono by blast
     from g1 and g2
     have up:"rl1 * rl2 \<le> r1 * r2"
       by auto
     show ?thesis
     using up maxU12 maxU34 bigMaxU min_repU2 min_repU1 min.coboundedI1 maxt12 maxt34
       by (metis repL_def tl.simps)
   qed
 qed
 
 text\<open>Most significant bit only changes under successor when all other bits are 1\<close>
 lemma msb_succ:
   fixes w :: "32 Word.word"
   assumes neq1:"uint w \<noteq> 0xFFFFFFFF"
   assumes neq2:"uint w \<noteq> 0x7FFFFFFF"
   shows "msb (w + 1) = msb w"
   proof -
     have "w \<noteq> 0xFFFFFFFF"
       using neq1 by auto
     then have neqneg1:"w \<noteq> -1" by auto
     have "w \<noteq> 0x7FFFFFFF"
       using neq2 by auto
     then have neqneg2:"w \<noteq> (2^31)-1" by auto
     show ?thesis using neq1 neq2  unfolding msb_big
     using Word_Lemmas.word_le_make_less[of "w + 1" "0x80000000"] 
           Word_Lemmas.word_le_make_less[of "w " "0x80000000"]
           neqneg1 neqneg2
       by auto
   qed
 
 text\<open>Negation commutes with msb except at edge cases\<close>
 lemma msb_non_min:
   fixes w :: "32 Word.word"
   assumes neq1:"uint w \<noteq> 0"
   assumes neq2:"uint w \<noteq> ((2^(len_of (TYPE(31)))))"
   shows "msb (uminus w) = HOL.Not(msb(w))"
   proof -
     have fact1:"uminus w = word_succ (~~ w)"
       by (rule twos_complement)
     have fact2:"msb (~~w) = HOL.Not(msb w)"
       using word_ops_msb[of w] 
       by auto
     have neqneg1:"w \<noteq> 0" using neq1 by auto
     have not_undef:"w \<noteq> 0x80000000"
       using neq2 by auto
     then have neqneg2:"w \<noteq> (2^31)" by auto
     from \<open>w \<noteq> 0\<close> have \<open>~~ w \<noteq> ~~ 0\<close>
       by (simp only: bit.compl_eq_compl_iff) simp
     then have "(~~ w) \<noteq> 0xFFFFFFFF"
       by auto
     then have uintNeq1:"uint (~~ w) \<noteq> 0xFFFFFFFF"
       using uint_distinct[of "~~w" "0xFFFFFFFF"] 
       by auto
     from \<open>w \<noteq> 2 ^ 31\<close> have \<open>~~ w \<noteq> ~~ 2 ^ 31\<close>
       by (simp only: bit.compl_eq_compl_iff) simp
     then have "(~~ w) \<noteq> 0x7FFFFFFF"
       by auto
     then have uintNeq2:" uint (~~ w) \<noteq> 0x7FFFFFFF"
       using uint_distinct[of "~~w" "0x7FFFFFFF"]
       by auto
     have fact3:"msb ((~~w) + 1) = msb (~~w)"
       apply(rule msb_succ[of "~~w"])
       using neq1 neq2 uintNeq1 uintNeq2 by auto 
     show "msb (uminus w) = HOL.Not(msb(w))"
       using fact1 fact2 fact3 by (simp add: word_succ_p1)
     qed
 
 text\<open>Only 0x80000000 preserves msb=1 under negation\<close>
 lemma msb_min_neg:
   fixes w::"word"
   assumes msb1:"msb (- w)"
   assumes msb2:"msb w"
   shows "uint w = ((2^(len_of (TYPE(31)))))"
 proof (rule ccontr)
   from \<open>msb w\<close> have \<open>w \<noteq> 0\<close>
     using word_msb_0 by auto
   then have \<open>uint w \<noteq> 0\<close>
     by transfer simp
   moreover assume \<open>uint w \<noteq> 2 ^ LENGTH(31)\<close>
   ultimately have \<open>msb (- w) \<longleftrightarrow> \<not> msb w\<close>
     by (rule msb_non_min)
   with assms show False
     by simp
 qed
 
 text\<open>Only 0x00000000 preserves msb=0 under negation\<close>
 lemma msb_zero:
   fixes w::"word"
   assumes msb1:"\<not> msb (- w)"
   assumes msb2:"\<not> msb w"
   shows "uint w = 0"
   proof -
     have neq:"w \<noteq> ((2 ^ len_of TYPE(31))::word)" using msb1 msb2 by auto
     have eq:"uint ((2 ^ len_of TYPE(31))::word) = 2 ^ len_of TYPE(31)" 
       by auto
     then have neq:"uint w \<noteq> uint ((2 ^ len_of TYPE(31))::word)" 
       using uint_distinct[of w "2^len_of TYPE(31)"] neq eq by auto
     show ?thesis
       using msb1 msb2 minus_zero msb_non_min[of w] neq by force
   qed
     
 text\<open>Finite numbers alternate msb under negation\<close>
 lemma msb_pos:
   fixes w::"word"
   assumes msb1:"msb (- w)"
   assumes msb2:"\<not> msb w"
   shows "uint w \<in> {1 .. (2^((len_of TYPE(32)) - 1))-1}" 
   proof -
     have main: "w \<in> {1 .. (2^((len_of TYPE(32)) - 1))-1}"
       using msb1 msb2 apply(clarsimp) 
       unfolding word_msb_sint
       apply(rule conjI)
       apply (metis neg_equal_0_iff_equal not_le word_less_1)
       proof -
         have imp:"w \<ge> 0x80000000 \<Longrightarrow> False"
           proof -
             assume geq:"w \<ge> 0x80000000"
             then have "msb w"
               using Word_Lemmas.msb_big[of w] by auto
             then show False using msb2 by auto
           qed
         have mylem:"\<And>w1 w2::word. uint w1 \<ge> uint w2 \<Longrightarrow> w1 \<ge> w2" 
           subgoal for w1 w2 
             by (simp add: word_le_def)
           done
         have mylem2:"\<And>w1 w2::word.  w1 >  w2 \<Longrightarrow> uint w1 > uint w2" 
           subgoal for w1 w2 
             by (simp add: word_less_def)
           done
         have gr_to_geq:"w > 0x7FFFFFFF \<Longrightarrow> w \<ge> 0x80000000"
           apply(rule mylem)
           using mylem2[of "0x7FFFFFFF" "w"] by auto
         have taut:"w \<le> 0x7FFFFFFF \<or> w > 0x7FFFFFFF" by auto        
         then show "w \<le> 0x7FFFFFFF"
         using imp taut gr_to_geq by auto
       qed
     have set_eq:"(uint ` (({1..(minus(2 ^ (minus(len_of TYPE(32))  1)) 1)})::word set)) 
                = ({1..minus(2 ^ (minus (len_of TYPE(32)) 1)) 1}::int set)"
       apply(auto simp add: word_le_def)
       subgoal for xa 
       proof -
         assume lower:"1 \<le> xa" and upper:"xa \<le> 2147483647"
         then have in_range:"xa \<in> {0 .. 2^32-1}" by auto
         then have "xa \<in> range (uint::word \<Rightarrow> int)" 
           unfolding word_uint.Rep_range uints_num by auto
         then obtain w::word  where xaw:"xa = uint w" by auto
         then have "w \<in> {1..0x7FFFFFFF} " 
         using lower upper apply(clarsimp, auto)
         by (auto simp add: word_le_def)
         then show ?thesis
           using uint_distinct uint_distinct main image_eqI word_le_def xaw by blast
       qed
       done
     then show  "uint w \<in> {1..2 ^ (len_of TYPE(32) - 1) - 1}" 
       using uint_distinct uint_distinct main image_eqI
       by blast
     qed
     
 lemma msb_neg:
   fixes w::"word"
   assumes msb1:"\<not> msb (- w)"
   assumes msb2:"msb w"
   shows "uint w \<in> {2^((len_of TYPE(32) - 1))+1 .. 2^((len_of TYPE(32)))-1}" 
   proof -
     have mylem:"\<And>w1 w2::word. uint w1 \<ge> uint w2 \<Longrightarrow> w1 \<ge> w2" 
       by (simp add: word_le_def)
     have mylem2:"\<And>w1 w2::word.  w1 >  w2 \<Longrightarrow> uint w1 > uint w2" 
       by (simp add: word_less_def)
     have gr_to_geq:"w > 0x80000000 \<Longrightarrow> w \<ge> 0x80000001"
       apply(rule mylem)
       using mylem2[of "0x80000000" "w"] by auto
     have taut:"w \<le> 0x80000000 \<or> 0x80000000 < w" by auto
     have imp:"w \<le> 0x80000000 \<Longrightarrow> False"
       proof -
         assume geq:"w \<le> 0x80000000"
         then have "(msb (-w))"
           using Word_Lemmas.msb_big[of "-w"] Word_Lemmas.msb_big[of "w"] 
           by (simp add: msb2) 
         then show False using msb1 by auto
       qed
     have main: "w \<in> {2^((len_of TYPE(32)) - 1)+1 .. 2^((len_of TYPE(32)))-1}"  
       using msb1 msb2 apply(clarsimp)
       unfolding word_msb_sint
       proof -
         show "0x80000001 \<le> w"
         using imp taut gr_to_geq by auto
       qed
     have set_eq:"(uint ` (({2^((len_of TYPE(32) - 1))+1 .. 2^((len_of TYPE(32)))-1})::word set)) 
                        = {2^((len_of TYPE(32) - 1))+1 .. 2^((len_of TYPE(32)))-1}"
       apply(auto)
       subgoal for xa by (simp add: word_le_def)
       subgoal for w using uint_lt [of w] by simp
       subgoal for xa
       proof -
         assume lower:"2147483649 \<le> xa" and upper:"xa \<le> 4294967295"
         then have in_range:"xa \<in> {0x80000000 .. 0xFFFFFFFF}" by auto
         then have "xa \<in> range (uint::word \<Rightarrow> int)" 
           unfolding word_uint.Rep_range uints_num by auto
         then obtain w::word  where xaw:"xa = uint w" by auto
         then have the_in:"w \<in> {0x80000001 .. 0xFFFFFFFF} " 
           using lower upper
           by (auto simp add: word_le_def)
         have the_eq:"(0xFFFFFFFF::word) = -1" by auto
         from the_in the_eq have "w \<in> {0x80000001 .. -1}" by auto
         then show ?thesis
       using uint_distinct uint_distinct main image_eqI word_le_def xaw by blast
       qed
       done
     then show  "uint w \<in> {2^((len_of TYPE(32)) - 1)+1 .. 2^((len_of TYPE(32)))-1}" 
       using uint_distinct uint_distinct main image_eqI
       by blast
     qed
 
 text\<open>2s-complement commutes with negation except edge cases\<close>
 lemma sint_neg_hom:
   fixes w :: "32 Word.word"
   shows "uint w \<noteq> ((2^(len_of (TYPE(31))))) \<Longrightarrow> (sint(-w) = -(sint w))"
   unfolding word_sint_msb_eq apply auto
     subgoal using msb_min_neg by auto 
    prefer 3 subgoal using msb_zero[of w] by (simp add: msb_zero)
   proof -
     assume msb1:"msb (- w)"
     assume msb2:"\<not> msb w"
     have "uint w \<in> {1 .. (2^((len_of TYPE(32)) - 1))-1}" using msb_pos[OF msb1 msb2] by auto
     then have bound:"uint w \<in> {1 .. 0x7FFFFFFF}" by auto
     have size:"size (w::32 Word.word) = 32" using Word.word_size[of w] by auto 
     have lem:"\<And>x::int. \<And>n::nat.   x \<in> {1..(2^n)-1} \<Longrightarrow> ((- x) mod (2^n)) - (2^n) = - x"
       subgoal for x n
         apply(cases "x mod 2^n = 0")
         by(auto simp add: Divides.zmod_zminus1_eq_if[of x  "2^n"])
       done
     have lem_rule:"uint w \<in> {1..2 ^ 32 - 1} 
       \<Longrightarrow> (- uint w mod  4294967296) - 4294967296 = - uint w"
       using lem[of "uint w" 32] by auto
     have almost:"- uint w mod 4294967296 - 4294967296 = - uint w"
       apply(rule lem_rule)  
       using bound by auto
     show "uint (- w) - 2 ^ size (- w) = - uint w"
     using bound
     unfolding Word.uint_word_ariths word_size_neg by (auto simp add: size almost)
 next
   assume neq:"uint w \<noteq> 0x80000000"
   assume msb1:"\<not> msb (- w)"
   assume msb2:"msb w"
   have bound:"uint w \<in> {0x80000001.. 0xFFFFFFFF}" using msb1 msb2 msb_neg by auto
   have size:"size (w::32 Word.word) = 32" using Word.word_size[of w] by auto
   have lem:"\<And>x::int. \<And>n::nat.   x \<in> {1..(2^n)-1} \<Longrightarrow> (-x mod (2^n)) = (2^n) - x"
       subgoal for x n
         apply(auto)
         apply(cases "x mod 2^n = 0")
         by (simp add: Divides.zmod_zminus1_eq_if[of x  "2^n"])+
       done
   from bound 
   have  wLeq: "uint w \<le> 4294967295"
     and wGeq: "2147483649 \<le> uint w"
     by auto
   from wLeq have wLeq':"uint w \<le> 4294967296" by fastforce
   have f3: "(0 \<le> 4294967296 + - 1 * uint w + - 1 * ((4294967296 + - 1 * uint w) mod 4294967296))
             = (uint w + (4294967296 + - 1 * uint w) mod 4294967296 \<le> 4294967296)"
     by auto
   have f4: "(0 \<le> 4294967296 + - 1 * uint w) = (uint w \<le> 4294967296)"
     by auto
   have f5: "\<forall>i ia. \<not> (0::int) \<le> i \<or> 0 \<le> i + - 1 * (i mod ia)"
     by (simp add: zmod_le_nonneg_dividend)
   then have f6: "uint w + (4294967296 + - 1 * uint w) mod 4294967296 \<le> 4294967296"
     using f4 f3 wLeq' by blast
   have f7: "4294967296 + - 1 * uint w + - 4294967296 = - 1 * uint w"
     by auto
   have f8: "- (1::int) * 4294967296 = - 4294967296"
     by auto
   have f9: "(0 \<le> - 1 * uint w) = (uint w \<le> 0)"
     by auto
   have f10: "(4294967296 + -1 * uint w + -1 * ((4294967296 + -1 * uint w) mod 4294967296) \<le> 0) 
            = (4294967296 \<le> uint w + (4294967296 + - 1 * uint w) mod 4294967296)"
     by auto
   have f11: "\<not> 4294967296 \<le> (0::int)"
     by auto
   have f12: "\<forall>x0. ((0::int) < x0) = (\<not> x0 \<le> 0)"
     by auto
   have f13: "\<forall>x0 x1. ((x1::int) < x0) = (\<not> 0 \<le> x1 + - 1 * x0)"
     by auto
   have f14: "\<forall>x0 x1. ((x1::int) \<le> x1 mod x0) = (x1 + - 1 * (x1 mod x0) \<le> 0)"
     by auto
   have "\<not> uint w \<le> 0"
     using wGeq by fastforce
   then have "4294967296 \<le> uint w + (4294967296 + - 1 * uint w) mod 4294967296"
     using f14 f13 f12 f11 f10 f9 f8 f7 by (metis (no_types) int_mod_ge)
   then 
   show "uint (- w) = 2 ^ size w - uint w"
     using f6
     unfolding Word.uint_word_ariths  
     by (auto simp add: size f4)
   qed
 
 text\<open>2s-complement encoding is injective\<close>
 lemma sint_dist:
   fixes x y ::word
   assumes "x \<noteq> y"
   shows "sint x \<noteq> sint y"
   by (simp add: assms)
 
 subsection\<open>Negation\<close>
 fun wneg :: "word \<Rightarrow> word"
 where "wneg w = 
   (if w = NEG_INF then POS_INF else if w = POS_INF then NEG_INF else -w)"
 
 text\<open>word negation is correct\<close>
 lemma wneg_lemma:
   assumes eq:"w \<equiv>\<^sub>E (r::real)"
   shows "wneg w \<equiv>\<^sub>E -r"
   apply(rule repe.cases[OF eq])
     apply(auto intro!: repNEG_INF repPOS_INF simp add: repe.simps)[2]
   subgoal for ra
   proof -
     assume eq:"w = ra"
     assume i:"r =  (real_of_int (sint ra))"
     assume bounda:" (real_of_int (sint ra)) <  (real_of_int (sint POS_INF))"
     assume boundb:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint ra))"
     have raNeq:"ra \<noteq> 2147483647"
       using sint_range[OF bounda boundb]
       by (auto)
     have raNeqUndef:"ra \<noteq> 2147483648"
       using int_not_undef[OF bounda boundb]
       by (auto)
     have "uint ra \<noteq> uint ((2 ^ len_of TYPE(31))::word)"
       apply (rule uint_distinct)
       using raNeqUndef by auto
     then have raNeqUndefUint:"uint ra \<noteq> ((2 ^ len_of TYPE(31)))"
       by auto
     have res1:"wneg w \<equiv>\<^sub>E  (real_of_int (sint (wneg w)))"
       apply (rule repINT)
       using sint_range[OF bounda boundb] sint_neg_hom[of ra, OF raNeqUndefUint]
       raNeq raNeqUndefUint raNeqUndef eq 
       by(auto)
     have res2:"- r =  (real_of_int (sint (wneg w)))"
       using eq bounda boundb i sint_neg_hom[of ra, OF raNeqUndefUint] raNeq raNeqUndef eq
       apply auto
       apply transfer
       apply simp
       done
     show ?thesis
       using res1 res2 by auto
     qed
   done
 
 subsection\<open>Comparison\<close>
 fun wgreater :: "word \<Rightarrow> word \<Rightarrow> bool"
 where "wgreater w1 w2 = (sint w1 > sint w2)"
 
 lemma neg_less_contra:"\<And>x. Suc x < - (Suc x) \<Longrightarrow> False"
   by auto
 
 text\<open>Comparison < is correct\<close>
 lemma wgreater_lemma:"w1 \<equiv>\<^sub>L (r1::real) \<Longrightarrow> w2 \<equiv>\<^sub>U r2 \<Longrightarrow> wgreater w1 w2 \<Longrightarrow> r1 > r2"
   proof (auto simp add: repU_def repL_def)
     fix r'\<^sub>1 r'\<^sub>2
     assume sint_le:"sint w1 > sint w2"
     then have sless:"(w2 <s w1)" using word_sless_alt by auto
     assume r1_leq:"r'\<^sub>1 \<le> r1"
     assume r2_leq:"r2 \<le> r'\<^sub>2"
     assume wr1:"w1 \<equiv>\<^sub>E r'\<^sub>1"
     assume wr2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
     have greater:"r'\<^sub>1 > r'\<^sub>2" 
       using wr1 wr2 apply(auto simp add: repe.simps)
              prefer 4 using sless sint_le
              apply (auto simp add: less_le_trans not_le)
         apply transfer apply simp
        apply transfer apply simp
       apply transfer apply simp
       done
     show "r1 > r2"
       using r1_leq r2_leq greater by auto
   qed
 
 text\<open>Comparison $\geq$ of words\<close>
 fun wgeq :: "word \<Rightarrow> word \<Rightarrow> bool"
 where "wgeq w1 w2 =
 ((\<not> ((w2 = NEG_INF \<and> w1 = NEG_INF)
   \<or>(w2 = POS_INF \<and> w1 = POS_INF))) \<and>
 (sint w2 \<le> sint w1))"
 
 text\<open>Comparison $\geq$ of words is correct\<close>
 lemma wgeq_lemma:"w1 \<equiv>\<^sub>L r1 \<Longrightarrow> w2 \<equiv>\<^sub>U (r2::real) \<Longrightarrow> wgeq w1 w2 \<Longrightarrow> r1 \<ge> r2"
   proof (unfold wgeq.simps)
     assume assms:"\<not> (w2 = NEG_INF \<and> w1 = NEG_INF \<or> w2 = POS_INF \<and> w1 = POS_INF) \<and> sint w2 \<le> sint w1"
     assume a1:"w1 \<equiv>\<^sub>L r1" and a2:"w2 \<equiv>\<^sub>U (r2::real)"
     from assms have sint_le:"sint w2 \<le> sint w1" by auto
     then have sless:"(w2 <=s w1)" using word_sless_alt word_sle_def by auto
     obtain r'\<^sub>1 r'\<^sub>2 where  r1_leq:"r'\<^sub>1 \<le> r1" and r2_leq:"r2 \<le> r'\<^sub>2"
     and wr1:"w1 \<equiv>\<^sub>E r'\<^sub>1" and wr2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
     using a1 a2 unfolding repU_def repL_def by auto
     from assms have check1:"\<not> (w1 = NEG_INF \<and> w2 = NEG_INF)" by auto
     from assms have check2:"\<not> (w1 = POS_INF \<and> w2 = POS_INF)" by auto
     have less:"r'\<^sub>2 \<le> r'\<^sub>1" 
       using sless sint_le check1 check2 repe.simps wr2 wr1
       apply (auto simp add: repe.simps)
              apply transfer
              apply simp
             apply transfer
             apply simp
            apply transfer
            apply simp
           apply transfer
           apply simp
          apply transfer
          apply simp
         apply transfer
         apply simp
        apply transfer
        apply simp
       apply transfer
       apply simp
       done
     show "r1 \<ge> r2"
       using r1_leq r2_leq less by auto
   qed
 
 subsection\<open>Absolute value\<close>
 
 text\<open>Absolute value of word\<close>
 fun wabs :: "word \<Rightarrow> word"
   where "wabs l1 = (wmax l1 (wneg l1))"
 
 text\<open>Correctness of wmax\<close>
 lemma wabs_lemma:
   assumes eq:"w \<equiv>\<^sub>E (r::real)"
   shows "wabs w \<equiv>\<^sub>E (abs r)"
 proof -
   have w:"wmax w (wneg w) \<equiv>\<^sub>E max r (-r)" by (rule wmax_lemma[OF eq wneg_lemma[OF eq]])
   have r:"max r (-r) = abs r" by auto
   from w r show ?thesis by auto
 qed
 
 declare more_real_of_word_simps [simp del]
 
 end
diff --git a/thys/Irrational_Series_Erdos_Straus/Irrational_Series_Erdos_Straus.thy b/thys/Irrational_Series_Erdos_Straus/Irrational_Series_Erdos_Straus.thy
--- a/thys/Irrational_Series_Erdos_Straus/Irrational_Series_Erdos_Straus.thy
+++ b/thys/Irrational_Series_Erdos_Straus/Irrational_Series_Erdos_Straus.thy
@@ -1,2017 +1,2017 @@
 (* Title:      Irrational_Series_Erdos_Straus.thy
    Author:     Angeliki Koutsoukou-Argyraki and Wenda Li, University of Cambridge, UK.
 
 We formalise certain irrationality criteria for infinite series by P. Erdos and E.G. Straus.
 In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1 in [1]. The latter is an 
 application of Theorem 2.1 involving the prime numbers.
 
 References:
 [1]  P. Erdos and E.G. Straus, On the irrationality of certain series, Pacific Journal of 
 Mathematics, Vol. 55, No 1, 1974  https://projecteuclid.org/euclid.pjm/1102911140
 *)
 
 theory "Irrational_Series_Erdos_Straus" imports
   Prime_Number_Theorem.Prime_Number_Theorem
   Prime_Distribution_Elementary.PNT_Consequences
 begin
 
 section \<open>Miscellaneous\<close>
 
 lemma suminf_comparison:
   assumes "summable f" and gf: "\<And>n. norm (g n) \<le> f n"
   shows "suminf g \<le> suminf f"
 proof (rule suminf_le)
   show "g n \<le> f n" for n
     using gf[of n] by auto
   show "summable g"
     using assms summable_comparison_test' by blast 
   show "summable f" using assms(1) .
 qed
 
 lemma tendsto_of_int_diff_0:
   assumes "(\<lambda>n. f n - of_int(g n)) \<longlonglongrightarrow> (0::real)" "\<forall>\<^sub>F n in sequentially. f n > 0"
   shows "\<forall>\<^sub>F n in sequentially. 0 \<le> g n"
 proof -
   have "\<forall>\<^sub>F n in sequentially. \<bar>f n - of_int(g n)\<bar> < 1 / 2" 
     using assms(1)[unfolded tendsto_iff,rule_format,of "1/2"] by auto
   then show ?thesis using assms(2)
     apply eventually_elim
     by linarith
 qed
 
 lemma eventually_mono_sequentially:
   assumes "eventually P sequentially"
   assumes "\<And>x. P (x+k) \<Longrightarrow> Q (x+k)"
   shows "eventually Q sequentially"
   using sequentially_offset[OF assms(1),of k]
   apply (subst eventually_sequentially_seg[symmetric,of _ k])
   apply (elim eventually_mono)
   by fact
 
 lemma frequently_eventually_at_top:
   fixes P Q::"'a::linorder \<Rightarrow> bool"
   assumes "frequently P at_top" "eventually Q at_top"
   shows "frequently (\<lambda>x. P x \<and> (\<forall>y\<ge>x. Q y) ) at_top"
   using assms
   unfolding frequently_def eventually_at_top_linorder 
   by (metis (mono_tags, hide_lams) le_cases order_trans)
 
 lemma eventually_at_top_mono:
   fixes P Q::"'a::linorder \<Rightarrow> bool"
   assumes event_P:"eventually P at_top"
   assumes PQ_imp:"\<And>x. x\<ge>z \<Longrightarrow> \<forall>y\<ge>x. P y \<Longrightarrow> Q x"
   shows "eventually Q at_top"
 proof -
   obtain N where N_P:"\<forall>n\<ge>N. P n"
     using event_P[unfolded eventually_at_top_linorder] by auto
   define N' where "N' = max N z"
   have "Q x" when "x\<ge>N'" for x 
     apply (rule PQ_imp)
     using N_P that unfolding N'_def by auto
   then show ?thesis unfolding eventually_at_top_linorder
     by auto
 qed
 
 lemma frequently_at_top_elim:
   fixes P Q::"'a::linorder \<Rightarrow> bool"
   assumes "\<exists>\<^sub>Fx in at_top. P x"
   assumes "\<And>i. P i \<Longrightarrow> \<exists>j>i. Q j"
   shows "\<exists>\<^sub>Fx in at_top. Q x"
   using assms unfolding frequently_def eventually_at_top_linorder 
   by (meson leD le_cases less_le_trans)
 
 lemma less_Liminf_iff:
   fixes X :: "_ \<Rightarrow> _ :: complete_linorder"
   shows "Liminf F X < C \<longleftrightarrow> (\<exists>y<C. frequently (\<lambda>x. y \<ge> X x) F)"
   apply (subst Not_eq_iff[symmetric])
   apply (simp add:not_less not_frequently not_le le_Liminf_iff)
   by force
 
 lemma sequentially_even_odd_imp:
   assumes "\<forall>\<^sub>F N in sequentially. P (2*N)" "\<forall>\<^sub>F N in sequentially. P (2*N+1)"
   shows "\<forall>\<^sub>F n in sequentially. P n"
 proof -
   obtain N where N_P:"\<forall>x\<ge>N.  P (2 * x) \<and> P (2 * x + 1)"
     using eventually_conj[OF assms] 
     unfolding eventually_at_top_linorder by auto
   define N' where "N'=2*N "
   have "P n" when "n\<ge>2*N" for n
   proof -
     define n' where "n'= n div 2"
     then have "n'\<ge>N" using that by auto
     then have "P (2 * n') \<and> P (2 * n' + 1)"
       using N_P by auto
     then show ?thesis unfolding n'_def
       apply (cases "even n")
       by auto
   qed
   then show ?thesis unfolding eventually_at_top_linorder by auto
 qed
 
 
 section \<open>Theorem 2.1 and Corollary 2.10\<close>
 
 context
   fixes a b ::"nat\<Rightarrow>int "
   assumes a_pos:"\<forall> n. a n >0 " and a_large:"\<forall>\<^sub>F n in sequentially. a n > 1" 
     and ab_tendsto: "(\<lambda>n. \<bar>b n\<bar> / (a (n-1)*a n)) \<longlonglongrightarrow> 0"
 begin
 
 private lemma aux_series_summable: "summable (\<lambda>n. b n / (\<Prod>k\<le>n. a k))" 
 proof -
   have "\<forall>e>0. \<forall>\<^sub>F x in sequentially. \<bar>b x\<bar> / (a (x-1) * a x) < e"
     using ab_tendsto[unfolded tendsto_iff] 
     apply (simp add:of_int_abs[symmetric] abs_mult del:of_int_abs)
     by (subst (asm) (2) abs_of_pos,use \<open>\<forall> n. a n > 0\<close> in auto)+                 
   from this[rule_format,of 1]
   have "\<forall>\<^sub>F x in sequentially. \<bar>real_of_int(b x)\<bar> < (a (x-1) * a x)"
     using \<open>\<forall> n. a n >0\<close> by auto
   moreover have "\<forall>n. (\<Prod>k\<le>n. real_of_int (a k)) > 0" 
     using a_pos by (auto intro!:linordered_semidom_class.prod_pos)
   ultimately have "\<forall>\<^sub>F n in sequentially. \<bar>b n\<bar> / (\<Prod>k\<le>n. a k) 
                         < (a (n-1) * a n) / (\<Prod>k\<le>n. a k)"
     apply (elim eventually_mono)
     by (auto simp add:field_simps)
   moreover have "\<bar>b n\<bar> / (\<Prod>k\<le>n. a k) = norm (b n / (\<Prod>k\<le>n. a k))" for n 
     using \<open>\<forall>n. (\<Prod>k\<le>n. real_of_int (a k)) > 0\<close>[rule_format,of n] by auto
   ultimately have "\<forall>\<^sub>F n in sequentially. norm (b n / (\<Prod>k\<le>n. a k)) 
                         < (a (n-1) * a n) / (\<Prod>k\<le>n. a k)"
     by algebra
   moreover have "summable (\<lambda>n. (a (n-1) * a n) / (\<Prod>k\<le>n. a k))" 
   proof -
     obtain s where a_gt_1:"\<forall> n\<ge>s. a n >1"
       using a_large[unfolded eventually_at_top_linorder] by auto
     define cc where "cc= (\<Prod>k<s. a k)"
     have "cc>0" 
       unfolding cc_def
       apply (rule linordered_semidom_class.prod_pos)
       using a_pos by auto
     have "(\<Prod>k\<le>n+s. a k) \<ge> cc * 2^n" for n
     proof -
       have "prod a {s..<Suc (s + n)} \<ge> 2^n"
       proof (induct n)
         case 0
         then show ?case using a_gt_1 by auto
       next
         case (Suc n)
         moreover have "a (s + Suc n) \<ge> 2" 
           using a_gt_1 by (smt le_add1)
         ultimately show ?case 
           apply (subst prod.atLeastLessThan_Suc,simp)
           using mult_mono'[of 2 "a (Suc (s + n))" " 2 ^ n" "prod a {s..<Suc (s + n)}",simplified] 
           by (simp add: mult.commute)
       qed
       moreover have "prod a {0..(n + s)} =
             prod a {..<s} * prod a {s..<Suc (s + n)} "
         using prod.atLeastLessThan_concat[of 0 s "s+n+1" a,simplified]
         apply (simp add: atLeastLessThanSuc_atLeastAtMost algebra_simps
             atLeast0LessThan)
         by (smt a_gt_1 le_add2 lessThan_atLeast0 mult.left_commute prod.last_plus zero_le)
       ultimately show ?thesis
         using \<open>cc>0\<close> unfolding cc_def by (simp add: atLeast0AtMost)
     qed
     then have "1/(\<Prod>k\<le>n+s. a k) \<le> 1/(cc * 2^n)" for n
     proof -
       assume asm:"\<And>n. cc * 2 ^ n \<le> prod a {..n + s}"
       then have "real_of_int (cc * 2 ^ n) \<le> prod a {..n + s}" using of_int_le_iff by blast
       moreover have "prod a {..n + s} >0" using \<open>cc>0\<close> by (simp add: a_pos prod_pos)
       ultimately show ?thesis using \<open>cc>0\<close> 
         by (auto simp:field_simps simp del:of_int_prod)
     qed
     moreover have "summable (\<lambda>n. 1/(cc * 2^n))"
     proof -
       have "summable (\<lambda>n. 1/(2::int)^n)"
         using summable_geometric[of "1/(2::int)"] by (simp add:power_one_over)
       from summable_mult[OF this,of "1/cc"] show ?thesis by auto
     qed
     ultimately have "summable (\<lambda>n. 1 / (\<Prod>k\<le>n+s. a k))"
       apply (elim summable_comparison_test'[where N=0])
       apply (unfold real_norm_def, subst abs_of_pos)
       by (auto simp add: \<open>\<forall>n. 0 < (\<Prod>k\<le>n. real_of_int (a k))\<close>)
     then have "summable (\<lambda>n. 1 / (\<Prod>k\<le>n. a k))"
       apply (subst summable_iff_shift[where k=s,symmetric])
       by simp
     then have "summable (\<lambda>n. (a (n+1) * a (n+2)) / (\<Prod>k\<le>n+2. a k))"
     proof -
       assume asm:"summable (\<lambda>n. 1 / real_of_int (prod a {..n}))"
       have "1 / real_of_int (prod a {..n}) = (a (n+1) * a (n+2)) / (\<Prod>k\<le>n+2. a k)" for n 
       proof -
         have "a (Suc (Suc n)) \<noteq> 0" "a (Suc n) \<noteq>0" 
           using a_pos by (metis less_irrefl)+
         then show ?thesis 
           by (simp add: atLeast0_atMost_Suc atMost_atLeast0)
       qed
       then show ?thesis using asm by auto
     qed
     then show "summable (\<lambda>n. (a (n-1) * a n) / (\<Prod>k\<le>n. a k))"
       apply (subst summable_iff_shift[symmetric,of _ 2])
       by auto
   qed
   ultimately show ?thesis 
     apply (elim summable_comparison_test_ev[rotated])
     by (simp add: eventually_mono)
 qed
 
 private fun get_c::"(nat \<Rightarrow> int) \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> int \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> int)" where
   "get_c a' b' B N 0 = round (B * b' N / a' N)"|
   "get_c a' b' B N (Suc n) = get_c a' b' B N n * a' (n+N) - B * b' (n+N)"
 
 lemma ab_rationality_imp:
   assumes ab_rational:"(\<Sum>n. (b n / (\<Prod>i \<le> n. a i))) \<in> \<rat>"
   shows "\<exists> (B::int)>0. \<exists> c::nat\<Rightarrow> int.
             (\<forall>\<^sub>F n in sequentially. B*b n = c n * a n - c(n+1) \<and> \<bar>c(n+1)\<bar><a n/2)
             \<and> (\<lambda>n. c (Suc n) / a n) \<longlonglongrightarrow> 0"
 proof -
   have [simp]:"a n \<noteq> 0" for n using a_pos by (metis less_numeral_extra(3))
   obtain A::int and B::int where 
     AB_eq:"(\<Sum>n. real_of_int (b n) / real_of_int (prod a {..n})) = A / B" and "B>0"
   proof -
     obtain q::rat where "(\<Sum>n. real_of_int (b n) / real_of_int (prod a {..n})) = real_of_rat q"
       using ab_rational by (rule Rats_cases) simp
     moreover obtain A::int and B::int where "q = Rat.Fract A B" "B > 0" "coprime A B"
       by (rule Rat_cases) auto
     ultimately show ?thesis by (auto intro!: that[of A B] simp:of_rat_rat)
   qed  
   define f where "f = (\<lambda>n.  b n / real_of_int (prod a {..n}))"
   define R where "R = (\<lambda>N. (\<Sum>n. B*b (n+N+1) / prod a {N..n+N+1}))"
   have all_e_ubound:"\<forall>e>0. \<forall>\<^sub>F M in sequentially. \<forall>n. \<bar>B*b (n+M+1) / prod a {M..n+M+1}\<bar> < e/4 * 1/2^n"
   proof safe
     fix e::real assume "e>0"
     obtain N where N_a2: "\<forall>n \<ge> N. a n \<ge> 2" 
       and N_ba: "\<forall>n \<ge> N. \<bar>b n\<bar> / (a (n-1) * a n)  < e/(4*B)"
     proof -
       have "\<forall>\<^sub>F n in sequentially. \<bar>b n\<bar> / (a (n - 1) * a n) < e/(4*B)" 
         using order_topology_class.order_tendstoD[OF ab_tendsto,of "e/(4*B)"] \<open>B>0\<close> \<open>e>0\<close>
         by auto
       moreover have "\<forall>\<^sub>F n in sequentially. a n \<ge> 2"
         using a_large by (auto elim: eventually_mono)
       ultimately have "\<forall>\<^sub>F n in sequentially. \<bar>b n\<bar> / (a (n - 1) * a n) < e/(4*B) \<and> a n \<ge> 2" 
         by eventually_elim auto
       then show ?thesis unfolding eventually_at_top_linorder using that
         by auto
     qed
     have geq_N_bound:"\<bar>B*b (n+M+1) / prod a {M..n+M+1}\<bar> < e/4 * 1/2^n" when "M\<ge>N" for n M   
     proof -
       define D where "D = B*b (n+M+1)/ (a (n+M) * a (n+M+1))"
       have "\<bar>B*b (n+M+1) / prod a {M..n+M+1}\<bar> = \<bar>D / prod a {M..<n+M}\<bar>"
       proof -
         have "{M..n+M+1} = {M..<n+M} \<union> {n+M,n+M+1}" by auto
         then have "prod a {M..n+M+1} = a (n+M) * a (n+M+1)* prod a {M..<n+M}" by simp
         then show ?thesis unfolding D_def by (simp add:algebra_simps)
       qed
       also have "... <  \<bar>e/4 * (1/prod a {M..<n+M})\<bar>"
       proof -
         have "\<bar>D\<bar> < e/ 4" 
           unfolding D_def using N_ba[rule_format, of "n+M+1"] \<open>B>0\<close> \<open>M \<ge> N\<close> \<open>e>0\<close> a_pos
           by (auto simp:field_simps abs_mult abs_of_pos)
         from mult_strict_right_mono[OF this,of "1/prod a {M..<n+M}"] a_pos \<open>e>0\<close>
         show ?thesis 
           apply (auto simp:abs_prod abs_mult prod_pos)
           by (subst (2) abs_of_pos,auto)+
       qed
       also have "... \<le> e/4 * 1/2^n"
       proof -
         have "prod a {M..<n+M} \<ge> 2^n"
         proof (induct n)
           case 0
           then show ?case by simp
         next
           case (Suc n)
           then show ?case 
             using \<open>M\<ge>N\<close> by (simp add: N_a2 mult.commute mult_mono' prod.atLeastLessThan_Suc)
         qed
         then have "real_of_int (prod a {M..<n+M}) \<ge> 2^n" 
           using numeral_power_le_of_int_cancel_iff by blast
         then show ?thesis using \<open>e>0\<close> by (auto simp add:divide_simps)
       qed
       finally show ?thesis .
     qed
     show "\<forall>\<^sub>F M in sequentially. \<forall>n. \<bar>real_of_int (B * b (n + M + 1)) 
                 / real_of_int (prod a {M..n + M + 1})\<bar> < e / 4 * 1 / 2 ^ n"
       apply (rule eventually_sequentiallyI[of N])
       using geq_N_bound by blast
   qed
   have R_tendsto_0:"R \<longlonglongrightarrow> 0"
   proof (rule tendstoI)
     fix e::real assume "e>0"
     show "\<forall>\<^sub>F x in sequentially. dist (R x) 0 < e" using all_e_ubound[rule_format,OF \<open>e>0\<close>]
     proof eventually_elim
       case (elim M)
       define g where "g = (\<lambda>n. B*b (n+M+1) / prod a {M..n+M+1})"
       have g_lt:"\<bar>g n\<bar> < e/4 * 1/2^n" for n
         using elim unfolding g_def by auto
       have g_abs_summable:"summable (\<lambda>n. \<bar>g n\<bar>)"
       proof -
         have "summable (\<lambda>n. e/4 * 1/2^n)" 
           using summable_geometric[of "1/2",THEN summable_mult,of "e/4",simplified]
           by (auto simp add:algebra_simps power_divide)
         then show ?thesis 
           apply (elim summable_comparison_test')
           using g_lt less_eq_real_def by auto
       qed
       have "\<bar>\<Sum>n. g n\<bar> \<le> (\<Sum>n. \<bar>g n\<bar>)" by (rule summable_rabs[OF g_abs_summable])
       also have "... \<le>(\<Sum>n. e/4 * 1/2^n)"
       proof (rule suminf_comparison)
         show "summable (\<lambda>n. e/4 * 1/2^n)" 
           using summable_geometric[of "1/2",THEN summable_mult,of "e/4",simplified]
           by (auto simp add:algebra_simps power_divide)
         show "\<And>n. norm \<bar>g n\<bar> \<le> e / 4 * 1 / 2 ^ n" using g_lt less_eq_real_def by auto
       qed
       also have "... = (e/4) * (\<Sum>n. (1/2)^n)"
         apply (subst suminf_mult[symmetric])
         subgoal 
           apply (rule complete_algebra_summable_geometric)
           by simp
         subgoal by (auto simp:algebra_simps power_divide)
         done
       also have "... = e/2" by (simp add:suminf_geometric[of "1/2"])
       finally have "\<bar>\<Sum>n. g n\<bar> \<le> e / 2" .
       then show "dist (R M) 0 < e" unfolding R_def g_def using \<open>e>0\<close> by auto
     qed
   qed
 
   obtain N where R_N_bound:"\<forall>M \<ge> N. \<bar>R M\<bar> \<le>  1 / 4"
     and N_geometric:"\<forall>M\<ge>N. \<forall>n. \<bar>real_of_int (B * b (n + M + 1)) / (prod a {M..n + M + 1})\<bar> < 1 / 2 ^ n"
   proof -
     obtain N1 where N1:"\<forall>M \<ge> N1. \<bar>R M\<bar> \<le>  1 / 4"
       using metric_LIMSEQ_D[OF R_tendsto_0,of "1/4"] all_e_ubound[rule_format,of 4,unfolded eventually_sequentially]
       by (auto simp:less_eq_real_def)
     obtain N2 where N2:"\<forall>M\<ge>N2. \<forall>n. \<bar>real_of_int (B * b (n + M + 1)) 
                           / (prod a {M..n + M + 1})\<bar> < 1 / 2 ^ n"
       using all_e_ubound[rule_format,of 4,unfolded eventually_sequentially]
       by (auto simp:less_eq_real_def)
     define N where "N=max N1 N2"
     show ?thesis using that[of N] N1 N2 unfolding N_def by simp
   qed
 
   define C where "C = B * prod a {..<N} * (\<Sum>n<N. f n)"
   have "summable f"
     unfolding f_def using aux_series_summable .
   have "A * prod a {..<N} = C + B * b N / a N  + R N" 
   proof -
     have "A * prod a {..<N} = B * prod a {..<N} * (\<Sum>n. f n)"
       unfolding AB_eq f_def using \<open>B>0\<close> by auto
     also have "... = B * prod a {..<N} * ((\<Sum>n<N+1. f n) + (\<Sum>n. f (n+N+1)))"
       using suminf_split_initial_segment[OF \<open>summable f\<close>, of "N+1"] by auto
     also have "... = B * prod a {..<N} * ((\<Sum>n<N. f n) + f N + (\<Sum>n. f (n+N+1)))"
       using sum.atLeast0_lessThan_Suc by simp
     also have "... = C + B * b N / a N + (\<Sum>n. B*b (n+N+1) / prod a {N..n+N+1})"
     proof -
       have "B * prod a {..<N} * f N = B * b N / a N" 
       proof -
         have "{..N} =  {..<N} \<union> {N}" using ivl_disj_un_singleton(2) by blast
         then show ?thesis unfolding f_def by auto
       qed
       moreover have "B * prod a {..<N} * (\<Sum>n. f (n+N+1)) = (\<Sum>n. B*b (n+N+1) / prod a {N..n+N+1})"
       proof -
         have "summable (\<lambda>n. f (n + N + 1))" 
           using \<open>summable f\<close> summable_iff_shift[of f "N+1"] by auto
         moreover have "prod a {..<N} * f (n + N + 1) = b (n + N + 1) / prod a {N..n + N + 1}" for n
         proof -
           have "{..n + N + 1} = {..<N} \<union> {N..n + N + 1}" by auto
           then show ?thesis 
             unfolding f_def
             apply simp
             apply (subst prod.union_disjoint)
             by auto
         qed
         ultimately show ?thesis 
           apply (subst suminf_mult[symmetric])
           by (auto simp add: mult.commute mult.left_commute)
       qed
       ultimately show ?thesis unfolding C_def by (auto simp:algebra_simps)
     qed
     also have "... = C +B * b N / a N  + R N"
       unfolding R_def by simp
     finally show ?thesis .
   qed
   have R_bound:"\<bar>R M\<bar> \<le> 1 / 4" and R_Suc:"R (Suc M) = a M * R M - B * b (Suc M) / a (Suc M)" 
     when "M \<ge> N" for M
   proof -
     define g where "g = (\<lambda>n. B*b (n+M+1) / prod a {M..n+M+1})"
     have g_abs_summable:"summable (\<lambda>n. \<bar>g n\<bar>)"
     proof -
       have "summable (\<lambda>n.(1::real)/2^n)" 
         using summable_geometric[of "(1::real)/2",simplified] 
         by (auto elim!: back_subst[of "summable"] simp:field_simps)
       moreover have "\<bar>g n\<bar> < 1/2^n" for n
         using N_geometric[rule_format,OF that] unfolding g_def by simp
       ultimately show ?thesis 
         apply (elim summable_comparison_test')
         using less_eq_real_def by auto
     qed
     show "\<bar>R M\<bar> \<le> 1 / 4" using R_N_bound[rule_format,OF that] .
     have "R M = (\<Sum>n. g n)" unfolding R_def g_def by simp
     also have "... = g 0 + (\<Sum>n. g (Suc n))"
       apply (subst suminf_split_head)
       using summable_rabs_cancel[OF g_abs_summable] by auto
     also have "... = g 0 + 1/a M * (\<Sum>n. a M * g (Suc n))"
       apply (subst suminf_mult)
       by (auto simp add: g_abs_summable summable_Suc_iff summable_rabs_cancel)
     also have "... = g 0 + 1/a M * R (Suc M)"
     proof -
       have "a M * g (Suc n) = B * b (n + M + 2) / prod a {Suc M..n + M + 2}" for n
       proof -
         have "{M..Suc (Suc (M + n))} = {M} \<union> {Suc M..Suc (Suc (M + n))}" by auto
         then show ?thesis 
           unfolding g_def using \<open>B>0\<close> by (auto simp add:algebra_simps)
       qed
       then have "(\<Sum>n. a M * g (Suc n)) = R (Suc M)"
         unfolding R_def by auto
       then show ?thesis by auto
     qed
     finally have "R M = g 0 + 1 / a M * R (Suc M)" .
     then have "R (Suc M) = a M * R M - g 0 * a M" 
       by (auto simp add:algebra_simps)
     moreover have "{M..Suc M} = {M,Suc M}" by auto
     ultimately show "R (Suc M) = a M * R M - B * b (Suc M) / a (Suc M)" 
       unfolding g_def by auto
   qed
 
   define c where "c = (\<lambda>n. if n\<ge>N then get_c a b B N (n-N) else undefined)"
   have c_rec:"c (n+1) = c n * a n -  B * b n" when "n \<ge> N" for n
     unfolding c_def using that by (auto simp:Suc_diff_le)
   have c_R:"c (Suc n) / a n = R n" when "n \<ge> N" for n
     using that
   proof (induct rule:nat_induct_at_least)
     case base
     have "\<bar> c (N+1) / a N \<bar> \<le> 1/2" 
     proof -
       have "c N = round (B * b N / a N)" unfolding c_def by simp
       moreover have "c (N+1) / a N = c N - B * b N / a N"
         using a_pos[rule_format,of N]
         by (auto simp add:c_rec[of N,simplified] divide_simps)
       ultimately show ?thesis using of_int_round_abs_le by auto
     qed        
     moreover have "\<bar>R N\<bar> \<le> 1 / 4" using R_bound[of N] by simp
     ultimately have "\<bar>c (N+1) / a N - R N \<bar> < 1" by linarith
     moreover have "c (N+1) / a N - R N \<in> \<int>"
     proof -
       have "c (N+1) / a N = c N - B * b N / a N"
         using a_pos[rule_format,of N]
         by (auto simp add:c_rec[of N,simplified] divide_simps)
       moreover have " B * b N / a N + R N \<in> \<int>" 
       proof -
         have "C = B * (\<Sum>n<N. prod a {..<N} * (b n / prod a {..n}))"
           unfolding C_def f_def by (simp add:sum_distrib_left algebra_simps)
         also have "... = B * (\<Sum>n<N. prod a {n<..<N} * b n)"
         proof -
           have "{..<N} = {n<..<N} \<union> {..n}" if "n<N" for n 
             by (simp add: ivl_disj_un_one(1) sup_commute that)
           then show ?thesis
             using \<open>B>0\<close> 
             apply simp
             apply (subst prod.union_disjoint)
             by auto
         qed
         finally have "C = real_of_int (B * (\<Sum>n<N. prod a {n<..<N} * b n))" .
         then have "C \<in> \<int>" using Ints_of_int by blast
         moreover note \<open>A * prod a {..<N} = C + B * b N / a N  + R N\<close>
         ultimately show ?thesis 
           by (metis Ints_diff Ints_of_int add.assoc add_diff_cancel_left')
       qed
       ultimately show ?thesis by (simp add: diff_diff_add)
     qed
     ultimately have "c (N+1) / a N - R N = 0"
       by (metis Ints_cases less_irrefl of_int_0 of_int_lessD)
     then show ?case by simp
   next
     case (Suc n)
     have "c (Suc (Suc n)) / a (Suc n) = c (Suc n) - B * b (Suc n) / a (Suc n)"
       apply (subst c_rec[of "Suc n",simplified])
       using \<open>N \<le> n\<close> by (auto simp add: divide_simps)
     also have "... = a n * R n - B * b (Suc n) / a (Suc n)"  
       using Suc by (auto simp: divide_simps)
     also have "... = R (Suc n)"
       using R_Suc[OF \<open>N \<le> n\<close>] by simp
     finally  show ?case .
   qed
   have ca_tendsto_zero:"(\<lambda>n. c (Suc n) / a n) \<longlonglongrightarrow> 0"
     using R_tendsto_0 
     apply (elim filterlim_mono_eventually)
     using c_R by (auto intro!:eventually_sequentiallyI[of N])
   have ca_bound:"\<bar>c (n + 1)\<bar> < a n / 2" when "n \<ge> N" for n
   proof -
     have "\<bar>c (Suc n)\<bar> / a n  = \<bar>c (Suc n) / a n\<bar>" using a_pos[rule_format,of n] by auto
     also have "... = \<bar>R n\<bar>" using c_R[OF that] by auto
     also have "... < 1/2" using R_bound[OF that] by auto
     finally have "\<bar>c (Suc n)\<bar> / a n < 1/2" .
     then show ?thesis using a_pos[rule_format,of n] by auto
   qed
 
 (* (* the following part corresponds to (2.7) (2.8) in the original paper, but turns out to be
         not necessary. *)
   have c_round:"c n = round (B * b n / a n)" when "n \<ge> N" for n
   proof (cases "n=N")
     case True
     then show ?thesis unfolding c_def by simp
   next
     case False
     with \<open>n\<ge>N\<close> obtain n' where n_Suc:"n=Suc n'" and "n' \<ge> N" 
       by (metis le_eq_less_or_eq lessE less_imp_le_nat)
     have "B * b n / a n = c n - R n"
     proof -
       have "R n = c n - B * b n / a n"
         using c_R[OF \<open>n'\<ge>N\<close>,symmetric,folded n_Suc] R_Suc[OF \<open>n'\<ge>N\<close>,folded n_Suc]
         by (auto simp:field_simps)
       then show ?thesis by (auto simp:field_simps)
     qed
     then have "\<bar>B * b n / a n - c n\<bar> = \<bar>R n\<bar>" by auto
     then have "\<bar>B * b n / a n - c n\<bar> < 1/2" using R_bound[OF \<open>n \<ge> N\<close>] by auto
     from round_unique'[OF this] show ?thesis by auto
   qed
   *)
   show "\<exists>B>0. \<exists>c. (\<forall>\<^sub>F n in sequentially. B * b n = c n * a n - c (n + 1) 
             \<and> real_of_int \<bar>c (n + 1)\<bar> < a n / 2) \<and> (\<lambda>n. c (Suc n) / a n) \<longlonglongrightarrow> 0"
     unfolding eventually_at_top_linorder
     apply (rule exI[of _ B],use \<open>B>0\<close> in simp)
     apply (intro exI[of _c] exI[of _ N])
     using c_rec ca_bound ca_tendsto_zero 
     by fastforce
 qed
 
 private lemma imp_ab_rational:
   assumes "\<exists> (B::int)>0. \<exists> c::nat\<Rightarrow> int.
               (\<forall>\<^sub>F n in sequentially. B*b n = c n * a n - c(n+1) \<and> \<bar>c(n+1)\<bar><a n/2)"
   shows "(\<Sum>n. (b n / (\<Prod>i \<le> n. a i))) \<in> \<rat>"
 proof -
   obtain B::int and c::"nat\<Rightarrow>int" and N::nat where "B>0" and  
     large_n:"\<forall>n\<ge>N. B * b n = c n * a n - c (n + 1) \<and> real_of_int \<bar>c (n + 1)\<bar> < a n / 2
                       \<and> a n\<ge>2"
   proof -
     obtain B c where "B>0" and event1:"\<forall>\<^sub>F n in sequentially. B * b n = c n * a n - c (n + 1) 
               \<and> real_of_int \<bar>c (n + 1)\<bar> < real_of_int (a n) / 2"
       using assms by auto
     from eventually_conj[OF event1 a_large,unfolded eventually_at_top_linorder]
     obtain N where "\<forall>n\<ge>N. (B * b n = c n * a n - c (n + 1) 
                         \<and> real_of_int \<bar>c (n + 1)\<bar> < real_of_int (a n) / 2) \<and> 2 \<le> a n"
       by fastforce
     then show ?thesis using that[of B N c] \<open>B>0\<close> by auto
   qed
   define f where "f=(\<lambda>n. real_of_int (b n) / real_of_int (prod a {..n}))"
   define S where "S = (\<Sum>n. f n)"
   have "summable f"
     unfolding f_def by (rule aux_series_summable)
   define C where "C=B*prod a {..<N} * (\<Sum>n<N. f n)"
   have "B*prod a {..<N} * S = C + real_of_int (c N)" 
   proof -
     define h1 where "h1= (\<lambda>n. (c (n+N) * a (n+N)) / prod a {N..n+N})"
     define h2 where "h2 = (\<lambda>n. c (n+N+1) / prod a {N..n+N})"
     have f_h12:"B*prod a {..<N}*f (n+N) = h1 n - h2 n" for n 
     proof -
       define g1 where "g1 = (\<lambda>n. B * b (n+N))"
       define g2 where "g2 = (\<lambda>n. prod a {..<N} / prod a {..n + N})"
       have "B*prod a {..<N}*f (n+N) = (g1 n * g2 n)"
         unfolding f_def g1_def g2_def by (auto simp:algebra_simps)
       moreover have "g1 n = c (n+N) * a (n+N) - c (n+N+1)" 
         using large_n[rule_format,of "n+N"] unfolding g1_def by auto
       moreover have "g2 n = (1/prod a {N..n+N})" 
       proof -
         have "prod a ({..<N} \<union> {N..n + N}) = prod a {..<N} * prod a {N..n + N}"
           apply (rule prod.union_disjoint[of "{..<N}" "{N..n+N}" a])
           by auto
         moreover have "prod a ({..<N} \<union> {N..n + N}) = prod a {..n+N}"
           by (simp add: ivl_disj_un_one(4))
         ultimately show ?thesis 
           unfolding g2_def
           apply simp
           using a_pos by (metis less_irrefl)
       qed
       ultimately have "B*prod a {..<N}*f (n+N) = (c (n+N) * a (n+N) - c (n+N+1)) / prod a {N..n+N}"
         by auto
       also have "... = h1 n - h2 n"
         unfolding h1_def h2_def by (auto simp:algebra_simps diff_divide_distrib)
       finally show ?thesis by simp
     qed
     have "B*prod a {..<N} * S = B*prod a {..<N} * ((\<Sum>n<N. f n) + (\<Sum>n. f (n+N)))"
       using suminf_split_initial_segment[OF \<open>summable f\<close>,of N] 
       unfolding S_def by (auto simp:algebra_simps)
     also have "... = C + B*prod a {..<N}*(\<Sum>n. f (n+N))"
       unfolding C_def by (auto simp:algebra_simps)
     also have "... = C + (\<Sum>n. h1 n - h2 n)"
       apply (subst suminf_mult[symmetric])
       subgoal using \<open>summable f\<close> by (simp add: summable_iff_shift)
       subgoal using f_h12 by auto
       done
     also have "... = C + h1 0"
     proof -
       have "(\<lambda>n. \<Sum>i\<le>n. h1 i - h2 i) \<longlonglongrightarrow> (\<Sum>i. h1 i - h2 i)"
       proof (rule summable_LIMSEQ')
         have "(\<lambda>i. h1 i - h2 i) = (\<lambda>i.  real_of_int (B * prod a {..<N}) * f (i + N))"
           using f_h12 by auto
         then show "summable (\<lambda>i. h1 i - h2 i)"
           using \<open>summable f\<close> by (simp add: summable_iff_shift summable_mult)
       qed
       moreover have "(\<Sum>i\<le>n. h1 i - h2 i)  = h1 0 - h2 n" for n
       proof (induct n)
         case 0
         then show ?case by simp
       next
         case (Suc n)
         have "(\<Sum>i\<le>Suc n. h1 i - h2 i) = (\<Sum>i\<le>n. h1 i - h2 i) + h1 (n+1) - h2 (n+1)"
           by auto
         also have "... =  h1 0 - h2 n + h1 (n+1) - h2 (n+1)" using Suc by auto
         also have "... = h1 0 - h2 (n+1)"
         proof -
           have "h2 n = h1 (n+1)"
             unfolding h2_def h1_def 
             apply (auto simp:prod.nat_ivl_Suc')
             using a_pos by (metis less_numeral_extra(3))
           then show ?thesis by auto
         qed
         finally show ?case by simp
       qed
       ultimately have "(\<lambda>n. h1 0 - h2 n) \<longlonglongrightarrow> (\<Sum>i. h1 i - h2 i)" by simp
       then have "h2 \<longlonglongrightarrow> (h1 0 -  (\<Sum>i. h1 i - h2 i))"
         apply (elim metric_tendsto_imp_tendsto)
         by (auto intro!:eventuallyI simp add:dist_real_def)
       moreover have "h2 \<longlonglongrightarrow> 0"
       proof -
         have h2_n:"\<bar>h2 n\<bar> < (1 / 2)^(n+1)" for n 
         proof -
           have "\<bar>h2 n\<bar> = \<bar>c (n + N + 1)\<bar> / prod a {N..n + N}"
             unfolding h2_def abs_divide
             using a_pos by (simp add: abs_of_pos prod_pos)
           also have "... < (a (N+n) / 2) / prod a {N..n + N}"
             unfolding h2_def
             apply (rule divide_strict_right_mono)
             subgoal using large_n[rule_format,of "N+n"] by (auto simp add:algebra_simps)
             subgoal using a_pos by (simp add: prod_pos)
             done
           also have "... = 1 / (2*prod a {N..<n + N})"
             apply (subst ivl_disj_un(6)[of N "n+N",symmetric])
             using a_pos[rule_format,of "N+n"] by (auto simp add:algebra_simps)
           also have "... \<le> (1/2)^(n+1)"
           proof (induct n)
             case 0
             then show ?case by auto
           next
             case (Suc n)
             define P where "P=1 / real_of_int (2 * prod a {N..<n + N})"
             have "1 / real_of_int (2 * prod a {N..<Suc n + N}) = P / a (n+N)"
               unfolding P_def by (auto simp add: prod.atLeastLessThan_Suc)
             also have "... \<le>  ( (1 / 2) ^ (n + 1) ) / a (n+N) "
               apply (rule divide_right_mono)
               subgoal unfolding P_def using Suc by auto
               subgoal by (simp add: a_pos less_imp_le)
               done
             also have "... \<le> ( (1 / 2) ^ (n + 1) ) / 2 "
               apply (rule divide_left_mono)
               using large_n[rule_format,of "n+N",simplified] by auto
             also have "... = (1 / 2) ^ (n + 2)" by auto
             finally show ?case by simp
           qed
           finally show ?thesis .
         qed
         have "(\<lambda>n. (1 / 2)^(n+1)) \<longlonglongrightarrow> (0::real)" 
           using tendsto_mult_right_zero[OF LIMSEQ_abs_realpow_zero2[of "1/2",simplified],of "1/2"]
           by auto
         then show ?thesis 
           apply (elim Lim_null_comparison[rotated])
           using h2_n less_eq_real_def by (auto intro!:eventuallyI)
       qed
       ultimately have "(\<Sum>i. h1 i - h2 i) = h1 0"
         using LIMSEQ_unique by fastforce
       then show ?thesis by simp
     qed
     also have "... = C + c N"
       unfolding h1_def using a_pos 
       by auto (metis less_irrefl)
     finally show ?thesis . 
   qed
   then have "S = (C + real_of_int (c N)) / (B*prod a {..<N})" 
     by (metis \<open>0 < B\<close> a_pos less_irrefl mult.commute mult_pos_pos 
         nonzero_mult_div_cancel_right of_int_eq_0_iff prod_pos)
   moreover have "... \<in> \<rat>"
     unfolding C_def f_def by (intro Rats_divide Rats_add Rats_mult Rats_of_int Rats_sum)
   ultimately show "S \<in> \<rat>" by auto
 qed
 
 theorem theorem_2_1_Erdos_Straus :
   "(\<Sum>n. (b n / (\<Prod>i \<le> n. a i))) \<in> \<rat> \<longleftrightarrow> (\<exists> (B::int)>0. \<exists> c::nat\<Rightarrow> int.
             (\<forall>\<^sub>F n in sequentially. B*b n = c n * a n - c(n+1) \<and> \<bar>c(n+1)\<bar><a n/2))"
   using ab_rationality_imp imp_ab_rational by auto
 
 text\<open>The following is a Corollary to Theorem 2.1.  \<close>
 
 corollary corollary_2_10_Erdos_Straus:
   assumes ab_event:"\<forall>\<^sub>F n in sequentially. b n > 0 \<and> a (n+1) \<ge> a n" 
     and ba_lim_leq:"lim (\<lambda>n. (b(n+1) - b n )/a n) \<le> 0" 
     and ba_lim_exist:"convergent (\<lambda>n. (b(n+1) - b n )/a n)"
     and "liminf (\<lambda>n. a n / b n) = 0 "
   shows "(\<Sum>n. (b n / (\<Prod>i \<le> n. a i))) \<notin> \<rat>"
 proof 
   assume "(\<Sum>n. (b n / (\<Prod>i \<le> n. a i))) \<in> \<rat>"
   then obtain B c where "B>0" and abc_event:"\<forall>\<^sub>F n in sequentially. B * b n = c n * a n - c (n + 1) 
           \<and> \<bar>c (n + 1)\<bar> < a n / 2" and ca_vanish: "(\<lambda>n. c (Suc n) / a n) \<longlonglongrightarrow> 0"
     using ab_rationality_imp by auto
 
   have bac_close:"(\<lambda>n. B * b n / a n - c n) \<longlonglongrightarrow> 0"
   proof -
     have "\<forall>\<^sub>F n in sequentially. B * b n - c n * a n + c (n + 1) = 0"
       using abc_event by (auto elim!:eventually_mono)
     then have "\<forall>\<^sub>F n in sequentially. (B * b n - c n * a n + c (n+1)) / a n = 0 "
       apply eventually_elim
       by auto
     then have "\<forall>\<^sub>F n in sequentially. B * b n / a n - c n  + c (n + 1) / a n = 0"
       apply eventually_elim
       using a_pos by (auto simp:divide_simps) (metis less_irrefl)
     then have "(\<lambda>n. B * b n / a n - c n  + c (n + 1) / a n) \<longlonglongrightarrow> 0"
       by (simp add: eventually_mono tendsto_iff)
     from tendsto_diff[OF this ca_vanish]  
     show ?thesis by auto
   qed
 
   have c_pos:"\<forall>\<^sub>F n in sequentially. c n > 0" 
   proof -
     from bac_close have *:"\<forall>\<^sub>F n in sequentially. c n \<ge> 0"
       apply (elim tendsto_of_int_diff_0)
       using ab_event a_large apply (eventually_elim) 
       using \<open>B>0\<close> by auto 
     show ?thesis
     proof (rule ccontr)
       assume "\<not> (\<forall>\<^sub>F n in sequentially. c n > 0)"
       moreover have "\<forall>\<^sub>F n in sequentially. c (Suc n) \<ge> 0 \<and> c n\<ge>0"
         using * eventually_sequentially_Suc[of "\<lambda>n. c n\<ge>0"] 
         by (metis (mono_tags, lifting) eventually_at_top_linorder le_Suc_eq)
       ultimately have "\<exists>\<^sub>F n in sequentially. c n = 0 \<and> c (Suc n) \<ge> 0"
         using eventually_elim2 frequently_def by fastforce
       moreover have "\<forall>\<^sub>F n in sequentially. b n > 0 \<and> B * b n = c n * a n - c (n + 1)"
         using ab_event abc_event by eventually_elim auto
       ultimately have "\<exists>\<^sub>F n in sequentially. c n = 0 \<and> c (Suc n) \<ge> 0 \<and> b n > 0 
                           \<and> B * b n = c n * a n - c (n + 1)"
         using frequently_eventually_frequently by fastforce
       from frequently_ex[OF this] 
       obtain n where "c n = 0" "c (Suc n) \<ge> 0" "b n > 0" 
         "B * b n = c n * a n - c (n + 1)"
         by auto
       then have "B * b n \<le> 0" by auto
       then show False using \<open>b n>0\<close> \<open>B > 0\<close> using mult_pos_pos not_le by blast
     qed
   qed
 
   have bc_epsilon:"\<forall>\<^sub>F n in sequentially. b (n+1) / b n >  (c (n+1) - \<epsilon>) / c n" when "\<epsilon>>0" "\<epsilon><1" for \<epsilon>::real
   proof -
     have "\<forall>\<^sub>F x in sequentially. \<bar>c (Suc x) / a x\<bar> < \<epsilon> / 2"
       using ca_vanish[unfolded tendsto_iff,rule_format, of "\<epsilon>/2"] \<open>\<epsilon>>0\<close> by auto
     moreover then have "\<forall>\<^sub>F x in sequentially. \<bar>c (x+2) / a (x+1)\<bar> < \<epsilon> / 2"
       apply (subst (asm) eventually_sequentially_Suc[symmetric])
       by simp
     moreover have "\<forall>\<^sub>F n in sequentially. B * b (n+1) = c (n+1) * a (n+1) - c (n + 2)"
       using abc_event
       apply (subst (asm) eventually_sequentially_Suc[symmetric])
       by (auto elim:eventually_mono)
     moreover have "\<forall>\<^sub>F n in sequentially. c n > 0 \<and> c (n+1) > 0 \<and> c (n+2) > 0"
     proof -
       have "\<forall>\<^sub>F n in sequentially. 0 < c (Suc n)"
         using c_pos by (subst eventually_sequentially_Suc) simp
       moreover then have "\<forall>\<^sub>F n in sequentially. 0 < c (Suc (Suc n))"
         using c_pos by (subst eventually_sequentially_Suc) simp
       ultimately show ?thesis using c_pos by eventually_elim auto
     qed
     ultimately show ?thesis using ab_event abc_event 
     proof eventually_elim
       case (elim n)
       define \<epsilon>\<^sub>0 \<epsilon>\<^sub>1 where "\<epsilon>\<^sub>0 = c (n+1) / a n" and "\<epsilon>\<^sub>1 = c (n+2) / a (n+1)"
       have "\<epsilon>\<^sub>0 > 0" "\<epsilon>\<^sub>1 > 0" "\<epsilon>\<^sub>0 < \<epsilon>/2" "\<epsilon>\<^sub>1 < \<epsilon>/2" using a_pos elim by (auto simp add: \<epsilon>\<^sub>0_def \<epsilon>\<^sub>1_def)
       have "(\<epsilon> - \<epsilon>\<^sub>1) * c n > 0"
         apply (rule mult_pos_pos)
         using \<open>\<epsilon>\<^sub>1 > 0\<close> \<open>\<epsilon>\<^sub>1 < \<epsilon>/2\<close> \<open>\<epsilon>>0\<close> elim by auto
       moreover have "\<epsilon>\<^sub>0 * (c (n+1) - \<epsilon>) > 0"
         apply (rule mult_pos_pos[OF \<open>\<epsilon>\<^sub>0 > 0\<close>])
         using elim(4) that(2) by linarith
       ultimately have "(\<epsilon> - \<epsilon>\<^sub>1) * c n + \<epsilon>\<^sub>0 * (c (n+1) - \<epsilon>) > 0" by auto
       moreover have "c n - \<epsilon>\<^sub>0 > 0" using \<open>\<epsilon>\<^sub>0 < \<epsilon> / 2\<close> elim(4) that(2) by linarith
       moreover have "c n > 0" by (simp add: elim(4))
       ultimately have "(c (n+1) - \<epsilon>) / c n < (c (n+1) - \<epsilon>\<^sub>1) / (c n -  \<epsilon>\<^sub>0)"
         by (auto simp add: field_simps)
       also have "... \<le> (c (n+1) - \<epsilon>\<^sub>1) / (c n -  \<epsilon>\<^sub>0) * (a (n+1) / a n)"
       proof -
         have "(c (n+1) - \<epsilon>\<^sub>1) / (c n -  \<epsilon>\<^sub>0) > 0" 
           by (smt \<open>0 < (\<epsilon> - \<epsilon>\<^sub>1) * real_of_int (c n)\<close> \<open>0 < real_of_int (c n) - \<epsilon>\<^sub>0\<close> 
               divide_pos_pos elim(4) mult_le_0_iff of_int_less_1_iff that(2))
         moreover have "(a (n+1) / a n) \<ge> 1" 
           using a_pos elim(5) by auto
-        ultimately show ?thesis by (metis mult_cancel_left1 real_mult_le_cancel_iff2)
+        ultimately show ?thesis by (metis mult_cancel_left1 mult_le_cancel_iff2)
       qed
       also have "... = (B * b (n+1)) / (B * b n)"
       proof -
         have "B * b n = c n * a n - c (n + 1)"
           using elim by auto
         also have "... = a n * (c n - \<epsilon>\<^sub>0)"
           using a_pos[rule_format,of n] unfolding \<epsilon>\<^sub>0_def by (auto simp:field_simps)
         finally have "B * b n = a n * (c n - \<epsilon>\<^sub>0)" .
         moreover have "B * b (n+1) = a (n+1) * (c (n+1) - \<epsilon>\<^sub>1)" 
           unfolding \<epsilon>\<^sub>1_def 
           using a_pos[rule_format,of "n+1"] 
           apply (subst \<open>B * b (n + 1) = c (n + 1) * a (n + 1) - c (n + 2)\<close>)
           by (auto simp:field_simps)
         ultimately show ?thesis by (simp add: mult.commute)
       qed
       also have "... = b (n+1) / b n" 
         using \<open>B>0\<close> by auto
       finally show ?case .
     qed
   qed
 
   have eq_2_11:"\<exists>\<^sub>F n in sequentially. b (n+1) > b n + (1 - \<epsilon>)^2 * a n / B" 
     when "\<epsilon>>0" "\<epsilon><1" "\<not> (\<forall>\<^sub>F n in sequentially. c (n+1) \<le> c n)"  for \<epsilon>::real
   proof -
     have "\<exists>\<^sub>F x in sequentially. c x < c (Suc x) " using that(3) 
       by (simp add:not_eventually frequently_elim1)
     moreover have "\<forall>\<^sub>F x in sequentially. \<bar>c (Suc x) / a x\<bar> < \<epsilon>"
       using ca_vanish[unfolded tendsto_iff,rule_format, of \<epsilon>] \<open>\<epsilon>>0\<close> by auto
     moreover have "\<forall>\<^sub>F n in sequentially. c n > 0 \<and> c (n+1) > 0"
     proof -
       have "\<forall>\<^sub>F n in sequentially. 0 < c (Suc n)"
         using c_pos by (subst eventually_sequentially_Suc) simp
       then show ?thesis using c_pos by eventually_elim auto
     qed
     ultimately show ?thesis  using ab_event abc_event bc_epsilon[OF \<open>\<epsilon>>0\<close> \<open>\<epsilon><1\<close>] 
     proof (elim frequently_rev_mp,eventually_elim)
       case (elim n)
       then have "c (n+1) / a n < \<epsilon>" 
         using a_pos[rule_format,of n] by auto
       also have "... \<le> \<epsilon> * c n" using elim(7) that(1) by auto
       finally have "c (n+1) / a n < \<epsilon> * c n" .
       then have "c (n+1) / c n < \<epsilon> * a n" 
         using a_pos[rule_format,of n] elim by (auto simp:field_simps)
       then have "(1 - \<epsilon>) * a n < a n - c (n+1) / c n"
         by (auto simp:algebra_simps)
       then have "(1 - \<epsilon>)^2 * a n / B < (1 - \<epsilon>) * (a n - c (n+1) / c n) / B"
-        apply (subst (asm) real_mult_less_iff1[symmetric, of "(1-\<epsilon>)/B"])
-        using \<open>\<epsilon><1\<close> \<open>B>0\<close> by (auto simp:divide_simps power2_eq_square)
+        apply (subst (asm) mult_less_iff1[symmetric, of "(1-\<epsilon>)/B"])
+        using \<open>\<epsilon><1\<close> \<open>B>0\<close> by (auto simp: divide_simps power2_eq_square mult_less_iff1)
       then have "b n + (1 - \<epsilon>)^2 * a n / B < b n + (1 - \<epsilon>) * (a n - c (n+1) / c n) / B"
         using \<open>B>0\<close> by auto
       also have "... = b n + (1 - \<epsilon>) * ((c n *a n - c (n+1)) / c n) / B"
         using elim by (auto simp:field_simps)
       also have "... = b n + (1 - \<epsilon>) * (b n / c n)"
       proof -
         have "B * b n = c n * a n - c (n + 1)" using elim by auto
         from this[symmetric] show ?thesis
           using \<open>B>0\<close> by simp
       qed
       also have "... = (1+(1-\<epsilon>)/c n) * b n"
         by (auto simp:algebra_simps)
       also have "... = ((c n+1-\<epsilon>)/c n) * b n"
         using elim by (auto simp:divide_simps)
       also have "... \<le> ((c (n+1) -\<epsilon>)/c n) * b n"
       proof -
         define cp where "cp = c n+1"
         have "c (n+1) \<ge> cp" unfolding cp_def using \<open>c n < c (Suc n)\<close> by auto
         moreover have "c n>0" "b n>0" using elim by auto
         ultimately show ?thesis 
           apply (fold cp_def)
           by (auto simp:divide_simps)
       qed
       also have "... < b (n+1)"
         using elim by (auto simp:divide_simps)
       finally show ?case .
     qed
   qed
 
   have "\<forall>\<^sub>F n in sequentially. c (n+1) \<le> c n"
   proof (rule ccontr)
     assume "\<not> (\<forall>\<^sub>F n in sequentially. c (n + 1) \<le> c n)"
     from eq_2_11[OF _ _ this,of "1/2"]
     have "\<exists>\<^sub>F n in sequentially. b (n+1) > b n + 1/4 * a n / B" 
       by (auto simp:algebra_simps power2_eq_square)
     then have *:"\<exists>\<^sub>F n in sequentially. (b (n+1) - b n) / a n > 1 / (B * 4)" 
       apply (elim frequently_elim1)
       subgoal for n
         using a_pos[rule_format,of n] by (auto simp:field_simps)
       done
     define f where "f = (\<lambda>n. (b (n+1) - b n) / a n)"
     have "f \<longlonglongrightarrow> lim f"
       using convergent_LIMSEQ_iff ba_lim_exist unfolding f_def by auto
     from this[unfolded tendsto_iff,rule_format, of "1 / (B*4)"] 
     have "\<forall>\<^sub>F x in sequentially. \<bar>f x - lim f\<bar> < 1 / (B * 4)"
       using \<open>B>0\<close> by (auto simp:dist_real_def)
     moreover have "\<exists>\<^sub>F n in sequentially. f n > 1 / (B * 4)" 
       using * unfolding f_def by auto
     ultimately have "\<exists>\<^sub>F n in sequentially. f n > 1 / (B * 4) \<and> \<bar>f n - lim f\<bar> < 1 / (B * 4)"
       by (auto elim:frequently_eventually_frequently[rotated])
     from frequently_ex[OF this] 
     obtain n where "f n > 1 / (B * 4)" "\<bar>f n - lim f\<bar> < 1 / (B * 4)"
       by auto
     moreover have "lim f \<le> 0" using ba_lim_leq unfolding f_def by auto
     ultimately show False by linarith
   qed
   then obtain N where N_dec:"\<forall>n\<ge>N. c (n+1) \<le> c n" by (meson eventually_at_top_linorder)
   define max_c where "max_c = (MAX n \<in> {..N}. c n)"
   have max_c:"c n \<le> max_c" for n
   proof (cases "n\<le>N")
     case True
     then show ?thesis unfolding max_c_def by simp
   next
     case False
     then have "n\<ge>N" by auto
     then have "c n\<le>c N" 
     proof (induct rule:nat_induct_at_least)
       case base
       then show ?case by simp
     next
       case (Suc n)
       then have "c (n+1) \<le> c n" using N_dec by auto
       then show ?case using \<open>c n \<le> c N\<close> by auto
     qed
     moreover have "c N \<le> max_c" unfolding max_c_def by auto
     ultimately show ?thesis by auto
   qed
   have "max_c > 0 " 
   proof -
     obtain N where "\<forall>n\<ge>N. 0 < c n" 
       using c_pos[unfolded eventually_at_top_linorder] by auto
     then have "c N > 0" by auto
     then show ?thesis using max_c[of N] by simp
   qed
   have ba_limsup_bound:"1/(B*(B+1)) \<le> limsup (\<lambda>n. b n/a n)" 
     "limsup (\<lambda>n. b n/a n) \<le> max_c / B + 1 / (B+1)"
   proof -
     define f where "f = (\<lambda>n. b n/a n)"
     from tendsto_mult_right_zero[OF bac_close,of "1/B"] 
     have "(\<lambda>n. f n - c n / B) \<longlonglongrightarrow> 0"
       unfolding f_def using  \<open>B>0\<close> by (auto simp:algebra_simps)
     from this[unfolded tendsto_iff,rule_format,of "1/(B+1)"]
     have "\<forall>\<^sub>F x in sequentially. \<bar>f x - c x / B\<bar> < 1 / (B+1)"
       using \<open>B>0\<close> by auto
     then have *:"\<forall>\<^sub>F n in sequentially. 1/(B*(B+1)) \<le> ereal (f n) \<and> ereal (f n) \<le> max_c / B + 1 / (B+1)" 
       using c_pos
     proof eventually_elim
       case (elim n)
       then have "f n - c n / B < 1 / (B+1)" by auto
       then have "f n < c n / B + 1 / (B+1)" by simp
       also have "... \<le> max_c / B + 1 / (B+1)"
         using max_c[of n] using \<open>B>0\<close> by (auto simp:divide_simps)
       finally have *:"f n < max_c / B + 1 / (B+1)" .
 
       have "1/(B*(B+1)) = 1/B - 1 / (B+1)" 
         using \<open>B>0\<close> by (auto simp:divide_simps)
       also have "... \<le> c n/B - 1 / (B+1)" 
         using \<open>0 < c n\<close> \<open>B>0\<close> by (auto,auto simp:divide_simps)
       also have "... < f n" using elim by auto
       finally have "1/(B*(B+1)) < f n" .
       with * show ?case by simp
     qed
     show "limsup f \<le> max_c / B + 1 / (B+1)"
       apply (rule Limsup_bounded)
       using * by (auto elim:eventually_mono)
     have "1/(B*(B+1)) \<le> liminf f"
       apply (rule Liminf_bounded)
       using * by (auto elim:eventually_mono)
     also have "liminf f \<le> limsup f" by (simp add: Liminf_le_Limsup)
     finally show "1/(B*(B+1)) \<le> limsup f" .
   qed
 
   have "0 < inverse (ereal (max_c / B + 1 / (B+1)))"
     using \<open>max_c > 0\<close> \<open>B>0\<close> 
     by (simp add: pos_add_strict)
   also have "... \<le> inverse (limsup (\<lambda>n. b n/a n))"
   proof (rule ereal_inverse_antimono[OF _ ba_limsup_bound(2)])
     have "0<1/(B*(B+1))" using \<open>B>0\<close> by auto
     also have "... \<le> limsup (\<lambda>n. b n/a n)" using ba_limsup_bound(1) .
     finally show "0\<le>limsup (\<lambda>n. b n/a n)" using zero_ereal_def by auto
   qed 
   also have "... = liminf (\<lambda>n. inverse (ereal ( b n/a n)))"
     apply (subst Liminf_inverse_ereal[symmetric])
     using a_pos ab_event by (auto elim!:eventually_mono simp:divide_simps)
   also have "... = liminf (\<lambda>n. ( a n/b n))"
     apply (rule Liminf_eq)
     using a_pos ab_event 
     apply (auto elim!:eventually_mono) 
     by (metis less_int_code(1))
   finally have "liminf (\<lambda>n. ( a n/b n)) > 0" .
   then show False using \<open>liminf (\<lambda>n. a n / b n) = 0\<close> by simp
 qed
 
 end
 
 section\<open>Some auxiliary results on the prime numbers. \<close>
 
 lemma nth_prime_nonzero[simp]:"nth_prime n \<noteq> 0"
   by (simp add: prime_gt_0_nat prime_nth_prime)
 
 lemma nth_prime_gt_zero[simp]:"nth_prime n >0"
   by (simp add: prime_gt_0_nat prime_nth_prime)
 
 lemma ratio_of_consecutive_primes:
   "(\<lambda>n. nth_prime (n+1)/nth_prime n) \<longlonglongrightarrow>1"
 proof -
   define f where "f=(\<lambda>x. real (nth_prime (Suc x)) /real (nth_prime x))"
   define g where "g=(\<lambda>x. (real x * ln (real x)) 
                               / (real (Suc x) * ln (real (Suc x))))"
   have p_n:"(\<lambda>x. real (nth_prime x) / (real x * ln (real x))) \<longlonglongrightarrow> 1"
     using nth_prime_asymptotics[unfolded asymp_equiv_def,simplified] .
   moreover have p_sn:"(\<lambda>n. real (nth_prime (Suc n)) 
                         / (real (Suc n) * ln (real (Suc n)))) \<longlonglongrightarrow> 1"
     using nth_prime_asymptotics[unfolded asymp_equiv_def,simplified
         ,THEN LIMSEQ_Suc] .
   ultimately have "(\<lambda>x. f x * g x) \<longlonglongrightarrow> 1"
     using tendsto_divide[OF p_sn p_n] 
     unfolding f_def g_def by (auto simp:algebra_simps)
   moreover have "g \<longlonglongrightarrow> 1" unfolding g_def
     by real_asymp
   ultimately have "(\<lambda>x. if g x = 0 then 0 else f x) \<longlonglongrightarrow> 1"
     apply (drule_tac tendsto_divide[OF _ \<open>g \<longlonglongrightarrow> 1\<close>])
     by auto
   then have "f \<longlonglongrightarrow> 1"
   proof (elim filterlim_mono_eventually)
     have "\<forall>\<^sub>F x in sequentially. (if g (x+3) = 0 then 0 
                 else f (x+3)) = f (x+3)" 
       unfolding g_def by auto
     then show "\<forall>\<^sub>F x in sequentially. (if g x = 0 then 0 else f x) = f x"
       apply (subst (asm) eventually_sequentially_seg)
       by simp
   qed auto
   then show ?thesis unfolding f_def by auto
 qed
 
 lemma nth_prime_double_sqrt_less:
   assumes "\<epsilon> > 0"
   shows "\<forall>\<^sub>F n in sequentially. (nth_prime (2*n) - nth_prime n) 
             / sqrt (nth_prime n) < n powr (1/2+\<epsilon>)"
 proof -
   define pp ll where 
     "pp=(\<lambda>n. (nth_prime (2*n) - nth_prime n) / sqrt (nth_prime n))" and
     "ll=(\<lambda>x::nat. x * ln x)"
   have pp_pos:"pp (n+1) > 0" for n
     unfolding pp_def by simp
 
   have "(\<lambda>x. nth_prime (2 * x)) \<sim>[sequentially] (\<lambda>x. (2 * x) * ln (2 * x))"
     using nth_prime_asymptotics[THEN asymp_equiv_compose
         ,of "(*) 2" sequentially,unfolded comp_def]
     using mult_nat_left_at_top pos2 by blast
   also have "... \<sim>[sequentially] (\<lambda>x. 2 *x * ln x)"
     by real_asymp
   finally have "(\<lambda>x. nth_prime (2 * x)) \<sim>[sequentially] (\<lambda>x. 2 *x * ln x)" .
   from this[unfolded asymp_equiv_def, THEN tendsto_mult_left,of 2]
   have "(\<lambda>x. nth_prime (2 * x) / (x * ln x)) \<longlonglongrightarrow> 2"
     unfolding asymp_equiv_def by auto
   moreover have *:"(\<lambda>x. nth_prime x / (x * ln x)) \<longlonglongrightarrow> 1"
     using nth_prime_asymptotics unfolding asymp_equiv_def by auto
   ultimately    
   have "(\<lambda>x. (nth_prime (2 * x) - nth_prime x) / ll x) \<longlonglongrightarrow> 1"
     unfolding ll_def
     apply -
     apply (drule (1) tendsto_diff)
     apply (subst of_nat_diff,simp)
     by (subst diff_divide_distrib,simp)
   moreover have "(\<lambda>x. sqrt (nth_prime x) / sqrt (ll x)) \<longlonglongrightarrow> 1"
     unfolding ll_def
     using tendsto_real_sqrt[OF *] 
     by (auto simp: real_sqrt_divide)
   ultimately have "(\<lambda>x. pp x * (sqrt (ll x) / (ll x))) \<longlonglongrightarrow> 1"
     apply -
     apply (drule (1) tendsto_divide,simp)
     by (auto simp:field_simps of_nat_diff pp_def)
   moreover have "\<forall>\<^sub>F x in sequentially. sqrt (ll x) / ll x = 1/sqrt (ll x)"
     apply (subst eventually_sequentially_Suc[symmetric])
     by (auto intro!:eventuallyI simp:ll_def divide_simps)
   ultimately have "(\<lambda>x. pp x / sqrt (ll x)) \<longlonglongrightarrow> 1"
     apply (elim filterlim_mono_eventually)
     by (auto elim!:eventually_mono) (metis mult.right_neutral times_divide_eq_right)
   moreover have "(\<lambda>x. sqrt (ll x) / x powr (1/2+\<epsilon>)) \<longlonglongrightarrow> 0"
     unfolding ll_def using \<open>\<epsilon>>0\<close> by real_asymp
   ultimately have "(\<lambda>x. pp x / x powr (1/2+\<epsilon>) * 
                       (sqrt (ll x) / sqrt (ll x))) \<longlonglongrightarrow> 0"
     apply -
     apply (drule (1) tendsto_mult)
     by (auto elim:filterlim_mono_eventually)
   moreover have "\<forall>\<^sub>F x in sequentially. sqrt (ll x) / sqrt (ll x) = 1"
     apply (subst eventually_sequentially_Suc[symmetric])
     by (auto intro!:eventuallyI simp:ll_def )
   ultimately have "(\<lambda>x. pp x / x powr (1/2+\<epsilon>)) \<longlonglongrightarrow> 0"
     apply (elim filterlim_mono_eventually)
     by (auto elim:eventually_mono)
   from tendstoD[OF this, of 1,simplified]
   show "\<forall>\<^sub>F x in sequentially. pp x < x powr (1 / 2 + \<epsilon>)"
     apply (elim eventually_mono_sequentially[of _ 1])
     using pp_pos by auto
 qed
 
 
 section \<open>Theorem 3.1\<close>
 
 text\<open>Theorem 3.1 is an application of Theorem 2.1 with the sequences considered involving 
 the prime numbers.\<close>
 
 theorem theorem_3_10_Erdos_Straus:
   fixes a::"nat \<Rightarrow> int"
   assumes a_pos:"\<forall> n. a n >0" and "mono a"
     and nth_1:"(\<lambda>n. nth_prime n / (a n)^2) \<longlonglongrightarrow> 0"
     and nth_2:"liminf (\<lambda>n. a n / nth_prime n) = 0"
   shows "(\<Sum>n. (nth_prime n / (\<Prod>i \<le> n. a i))) \<notin> \<rat>"
 proof
   assume asm:"(\<Sum>n. (nth_prime n / (\<Prod>i \<le> n. a i))) \<in> \<rat>"
 
   have a2_omega:"(\<lambda>n. (a n)^2) \<in> \<omega>(\<lambda>x. x * ln x)"
   proof -
     have "(\<lambda>n. real (nth_prime n)) \<in> o(\<lambda>n. real_of_int ((a n)\<^sup>2))"
       apply (rule smalloI_tendsto[OF nth_1])
       using a_pos by (metis (mono_tags, lifting) less_int_code(1) 
           not_eventuallyD of_int_0_eq_iff zero_eq_power2)
     moreover have "(\<lambda>x. real (nth_prime x)) \<in> \<Omega>(\<lambda>x. real x * ln (real x))"
       using nth_prime_bigtheta
       by blast
     ultimately show ?thesis 
       using landau_omega.small_big_trans smallo_imp_smallomega by blast
   qed
 
   have a_gt_1:"\<forall>\<^sub>F n in sequentially. 1 < a n" 
   proof -
     have "\<forall>\<^sub>F x in sequentially. \<bar>x * ln x\<bar> \<le> (a x)\<^sup>2"
       using a2_omega[unfolded smallomega_def,simplified,rule_format,of 1]
       by auto
     then have "\<forall>\<^sub>F x in sequentially. \<bar>(x+3) * ln (x+3)\<bar> \<le> (a (x+3))\<^sup>2" 
       apply (subst (asm) eventually_sequentially_seg[symmetric, of _ 3])
       by simp
     then have "\<forall>\<^sub>F n in sequentially. 1 < a ( n+3)" 
     proof (elim eventually_mono)
       fix x
       assume "\<bar>real (x + 3) * ln (real (x + 3))\<bar> \<le> real_of_int ((a (x + 3))\<^sup>2)"
       moreover have "\<bar>real (x + 3) * ln (real (x + 3))\<bar> > 3"
       proof -
         have "ln (real (x + 3)) > 1"
           apply simp using ln3_gt_1 ln_gt_1 by force
         moreover have "real(x+3) \<ge> 3" by simp
         ultimately have "(x+3)*ln (real (x + 3)) > 3*1 "
           apply (rule_tac mult_le_less_imp_less)
           by auto
         then show ?thesis by auto
       qed
       ultimately have "real_of_int ((a (x + 3))\<^sup>2) > 3"
         by auto
       then show "1 < a (x + 3)" 
         by (smt Suc3_eq_add_3 a_pos add.commute of_int_1 one_power2)
     qed
     then show ?thesis 
       apply (subst eventually_sequentially_seg[symmetric, of _ 3])
       by auto
   qed
 
   obtain B::int and c where 
     "B>0" and Bc_large:"\<forall>\<^sub>F n in sequentially. B * nth_prime n 
                 = c n * a n - c (n + 1) \<and> \<bar>c (n + 1)\<bar> <  a n / 2"
     and ca_vanish: "(\<lambda>n. c (Suc n) / real_of_int (a n)) \<longlonglongrightarrow> 0"
   proof -
     note a_gt_1
     moreover have "(\<lambda>n. real_of_int \<bar>int (nth_prime n)\<bar> 
                     / real_of_int (a (n - 1) * a n)) \<longlonglongrightarrow> 0" 
     proof -
       define f where "f=(\<lambda>n. nth_prime (n+1) / (a n * a (n+1)))"
       define g where "g=(\<lambda>n. 2*nth_prime n / (a n)^2)"
       have "\<forall>\<^sub>F x in sequentially. norm (f x) \<le> g x"
       proof -
         have "\<forall>\<^sub>F n in sequentially. nth_prime (n+1) < 2*nth_prime n" 
           using ratio_of_consecutive_primes[unfolded tendsto_iff
               ,rule_format,of 1,simplified]
           apply (elim eventually_mono)
           by (auto simp :divide_simps dist_norm)
         moreover have "\<forall>\<^sub>F n in sequentially. real_of_int (a n * a (n+1))
                            \<ge> (a n)^2"
           apply (rule eventuallyI)
           using \<open>mono a\<close> by (auto simp:power2_eq_square a_pos incseq_SucD)
         ultimately show ?thesis unfolding f_def g_def
           apply eventually_elim
           apply (subst norm_divide)
           apply (rule_tac linordered_field_class.frac_le)
           using a_pos[rule_format, THEN order.strict_implies_not_eq ]
           by auto
       qed
       moreover have "g \<longlonglongrightarrow> 0 " 
         using nth_1[THEN tendsto_mult_right_zero,of 2] unfolding g_def 
         by auto
       ultimately have "f \<longlonglongrightarrow> 0" 
         using Lim_null_comparison[of f g sequentially]
         by auto
       then show ?thesis
         unfolding f_def
         by (rule_tac LIMSEQ_imp_Suc) auto
     qed
     moreover have "(\<Sum>n. real_of_int (int (nth_prime n)) 
                     / real_of_int (prod a {..n})) \<in> \<rat>" 
       using asm by simp
     ultimately have "\<exists>B>0. \<exists>c. (\<forall>\<^sub>F n in sequentially.
               B * int (nth_prime n) = c n * a n - c (n + 1) \<and>
               real_of_int \<bar>c (n + 1)\<bar> < real_of_int (a n) / 2) \<and>
           (\<lambda>n. real_of_int (c (Suc n)) / real_of_int (a n)) \<longlonglongrightarrow> 0"
       using ab_rationality_imp[OF a_pos,of nth_prime] by fast
     then show thesis 
       apply clarify
       apply (rule_tac c=c and B=B in that)
       by auto
   qed
 
   have bac_close:"(\<lambda>n. B * nth_prime n / a n - c n) \<longlonglongrightarrow> 0"
   proof -
     have "\<forall>\<^sub>F n in sequentially. B * nth_prime n - c n * a n + c (n + 1) = 0"
       using Bc_large by (auto elim!:eventually_mono)
     then have "\<forall>\<^sub>F n in sequentially. (B * nth_prime n - c n * a n + c (n+1)) / a n = 0 "
       apply eventually_elim
       by auto
     then have "\<forall>\<^sub>F n in sequentially. B * nth_prime n / a n - c n  + c (n + 1) / a n = 0"
       apply eventually_elim
       using a_pos by (auto simp:divide_simps) (metis less_irrefl)
     then have "(\<lambda>n. B * nth_prime n / a n - c n  + c (n + 1) / a n) \<longlonglongrightarrow> 0"
       by (simp add: eventually_mono tendsto_iff)
     from tendsto_diff[OF this ca_vanish]  
     show ?thesis by auto
   qed
 
   have c_pos:"\<forall>\<^sub>F n in sequentially. c n > 0" 
   proof -
     from bac_close have *:"\<forall>\<^sub>F n in sequentially. c n \<ge> 0"
       apply (elim tendsto_of_int_diff_0)
       using a_gt_1 apply (eventually_elim) 
       using \<open>B>0\<close> by auto 
     show ?thesis
     proof (rule ccontr)
       assume "\<not> (\<forall>\<^sub>F n in sequentially. c n > 0)"
       moreover have "\<forall>\<^sub>F n in sequentially. c (Suc n) \<ge> 0 \<and> c n\<ge>0"
         using * eventually_sequentially_Suc[of "\<lambda>n. c n\<ge>0"] 
         by (metis (mono_tags, lifting) eventually_at_top_linorder le_Suc_eq)
       ultimately have "\<exists>\<^sub>F n in sequentially. c n = 0 \<and> c (Suc n) \<ge> 0"
         using eventually_elim2 frequently_def by fastforce
       moreover have "\<forall>\<^sub>F n in sequentially. nth_prime n > 0 
                         \<and> B * nth_prime n = c n * a n - c (n + 1)"
         using Bc_large by eventually_elim auto
       ultimately have "\<exists>\<^sub>F n in sequentially. c n = 0 \<and> c (Suc n) \<ge> 0 
           \<and> B * nth_prime n = c n * a n - c (n + 1)"
         using frequently_eventually_frequently by fastforce
       from frequently_ex[OF this] 
       obtain n where "c n = 0" "c (Suc n) \<ge> 0"
         "B * nth_prime n = c n * a n - c (n + 1)"
         by auto
       then have "B * nth_prime n \<le> 0" by auto
       then show False using \<open>B > 0\<close> 
         by (simp add: mult_le_0_iff)
     qed
   qed
 
   have B_nth_prime:"\<forall>\<^sub>F n in sequentially. nth_prime n > B" 
   proof -
     have "\<forall>\<^sub>F x in sequentially. B+1 \<le> nth_prime x"
       using nth_prime_at_top[unfolded filterlim_at_top_ge[where c="nat B+1"]
           ,rule_format,of "nat B + 1",simplified] 
 
       apply (elim eventually_mono)
       using \<open>B>0\<close> by auto
     then show ?thesis 
       apply (elim eventually_mono)
       by auto
   qed
 
   have bc_epsilon:"\<forall>\<^sub>F n in sequentially. nth_prime (n+1) 
             / nth_prime n >  (c (n+1) - \<epsilon>) / c n" when "\<epsilon>>0" "\<epsilon><1" for \<epsilon>::real
   proof -
     have "\<forall>\<^sub>F x in sequentially. \<bar>c (Suc x) / a x\<bar> < \<epsilon> / 2"
       using ca_vanish[unfolded tendsto_iff,rule_format, of "\<epsilon>/2"] \<open>\<epsilon>>0\<close> by auto
     moreover then have "\<forall>\<^sub>F x in sequentially. \<bar>c (x+2) / a (x+1)\<bar> < \<epsilon> / 2"
       apply (subst (asm) eventually_sequentially_Suc[symmetric])
       by simp
     moreover have "\<forall>\<^sub>F n in sequentially. B * nth_prime (n+1) = c (n+1) * a (n+1) - c (n + 2)"
       using Bc_large
       apply (subst (asm) eventually_sequentially_Suc[symmetric])
       by (auto elim:eventually_mono)
     moreover have "\<forall>\<^sub>F n in sequentially. c n > 0 \<and> c (n+1) > 0 \<and> c (n+2) > 0"
     proof -
       have "\<forall>\<^sub>F n in sequentially. 0 < c (Suc n)"
         using c_pos by (subst eventually_sequentially_Suc) simp
       moreover then have "\<forall>\<^sub>F n in sequentially. 0 < c (Suc (Suc n))"
         using c_pos by (subst eventually_sequentially_Suc) simp
       ultimately show ?thesis using c_pos by eventually_elim auto
     qed
     ultimately show ?thesis using Bc_large
     proof eventually_elim
       case (elim n)
       define \<epsilon>\<^sub>0 \<epsilon>\<^sub>1 where "\<epsilon>\<^sub>0 = c (n+1) / a n" and "\<epsilon>\<^sub>1 = c (n+2) / a (n+1)"
       have "\<epsilon>\<^sub>0 > 0" "\<epsilon>\<^sub>1 > 0" "\<epsilon>\<^sub>0 < \<epsilon>/2" "\<epsilon>\<^sub>1 < \<epsilon>/2" 
         using a_pos elim \<open>mono a\<close>
         by (auto simp add: \<epsilon>\<^sub>0_def \<epsilon>\<^sub>1_def abs_of_pos)
       have "(\<epsilon> - \<epsilon>\<^sub>1) * c n > 0"
         apply (rule mult_pos_pos)
         using \<open>\<epsilon>\<^sub>1 > 0\<close> \<open>\<epsilon>\<^sub>1 < \<epsilon>/2\<close> \<open>\<epsilon>>0\<close> elim by auto
       moreover have "\<epsilon>\<^sub>0 * (c (n+1) - \<epsilon>) > 0"
         apply (rule mult_pos_pos[OF \<open>\<epsilon>\<^sub>0 > 0\<close>])
         using elim(4) that(2) by linarith
       ultimately have "(\<epsilon> - \<epsilon>\<^sub>1) * c n + \<epsilon>\<^sub>0 * (c (n+1) - \<epsilon>) > 0" by auto
       moreover have "c n - \<epsilon>\<^sub>0 > 0" using \<open>\<epsilon>\<^sub>0 < \<epsilon> / 2\<close> elim(4) that(2) by linarith
       moreover have "c n > 0" by (simp add: elim(4))
       ultimately have "(c (n+1) - \<epsilon>) / c n < (c (n+1) - \<epsilon>\<^sub>1) / (c n -  \<epsilon>\<^sub>0)"
         by (auto simp add:field_simps)
       also have "... \<le> (c (n+1) - \<epsilon>\<^sub>1) / (c n -  \<epsilon>\<^sub>0) * (a (n+1) / a n)"
       proof -
         have "(c (n+1) - \<epsilon>\<^sub>1) / (c n -  \<epsilon>\<^sub>0) > 0" 
           by (smt \<open>0 < (\<epsilon> - \<epsilon>\<^sub>1) * real_of_int (c n)\<close> \<open>0 < real_of_int (c n) - \<epsilon>\<^sub>0\<close> 
               divide_pos_pos elim(4) mult_le_0_iff of_int_less_1_iff that(2))
         moreover have "(a (n+1) / a n) \<ge> 1" 
           using a_pos \<open>mono a\<close> by (simp add: mono_def)
-        ultimately show ?thesis by (metis mult_cancel_left1 real_mult_le_cancel_iff2)
+        ultimately show ?thesis by (metis mult_cancel_left1 mult_le_cancel_iff2)
       qed
       also have "... = (B * nth_prime (n+1)) / (B * nth_prime n)"
       proof -
         have "B * nth_prime n = c n * a n - c (n + 1)"
           using elim by auto
         also have "... = a n * (c n - \<epsilon>\<^sub>0)"
           using a_pos[rule_format,of n] unfolding \<epsilon>\<^sub>0_def by (auto simp:field_simps)
         finally have "B * nth_prime n = a n * (c n - \<epsilon>\<^sub>0)" .
         moreover have "B * nth_prime (n+1) = a (n+1) * (c (n+1) - \<epsilon>\<^sub>1)" 
           unfolding \<epsilon>\<^sub>1_def 
           using a_pos[rule_format,of "n+1"] 
           apply (subst \<open>B * nth_prime (n + 1) = c (n + 1) * a (n + 1) - c (n + 2)\<close>)
           by (auto simp:field_simps)
         ultimately show ?thesis by (simp add: mult.commute)
       qed
       also have "... = nth_prime (n+1) / nth_prime n" 
         using \<open>B>0\<close> by auto
       finally show ?case .
     qed
   qed
 
 
   have c_ubound:"\<forall>x. \<exists>n. c n > x"
   proof (rule ccontr)
     assume " \<not> (\<forall>x. \<exists>n. x < c n)"
     then obtain ub where "\<forall>n. c n \<le> ub" "ub > 0"
       by (meson dual_order.trans int_one_le_iff_zero_less le_cases not_le)
     define pa where "pa = (\<lambda>n. nth_prime n / a n)"
     have pa_pos:"\<And>n. pa n > 0" unfolding pa_def by (simp add: a_pos)
     have "liminf (\<lambda>n. 1 / pa n) = 0"
       using nth_2 unfolding pa_def by auto
     then have "(\<exists>y<ereal (real_of_int B / real_of_int (ub + 1)). 
       \<exists>\<^sub>F x in sequentially. ereal (1 / pa x) \<le> y)"
       apply (subst less_Liminf_iff[symmetric])
       using \<open>0 < B\<close> \<open>0 < ub\<close> by auto
     then have "\<exists>\<^sub>F x in sequentially. 1 / pa x < B/(ub+1)"
       by (meson frequently_mono le_less_trans less_ereal.simps(1))
     then have "\<exists>\<^sub>F x in sequentially. B*pa x > (ub+1)"
       apply (elim frequently_elim1)
       by (metis \<open>0 < ub\<close> mult.left_neutral of_int_0_less_iff pa_pos pos_divide_less_eq 
           pos_less_divide_eq times_divide_eq_left zless_add1_eq)
     moreover have "\<forall>\<^sub>F x in sequentially. c x \<le> ub"
       using \<open>\<forall>n. c n \<le> ub\<close> by simp
     ultimately have "\<exists>\<^sub>F x in sequentially. B*pa x - c x > 1"
       apply (elim frequently_rev_mp eventually_mono)
       by linarith
     moreover have "(\<lambda>n. B * pa n - c n) \<longlonglongrightarrow>0" 
       unfolding pa_def using bac_close by auto
     from tendstoD[OF this,of 1] 
     have "\<forall>\<^sub>F n in sequentially.  \<bar>B * pa n - c n\<bar> < 1"
       by auto
     ultimately have "\<exists>\<^sub>F x in sequentially. B*pa x - c x > 1 \<and> \<bar>B * pa x - c x\<bar> < 1"
       using frequently_eventually_frequently by blast
     then show False 
       by (simp add: frequently_def)
   qed
 
   have eq_2_11:"\<forall>\<^sub>F n in sequentially. c (n+1)>c n \<longrightarrow> 
                   nth_prime (n+1) > nth_prime n + (1 - \<epsilon>)^2 * a n / B" 
     when "\<epsilon>>0" "\<epsilon><1" for \<epsilon>::real
   proof -
     have "\<forall>\<^sub>F x in sequentially. \<bar>c (Suc x) / a x\<bar> < \<epsilon>"
       using ca_vanish[unfolded tendsto_iff,rule_format, of \<epsilon>] \<open>\<epsilon>>0\<close> by auto
     moreover have "\<forall>\<^sub>F n in sequentially. c n > 0 \<and> c (n+1) > 0"
     proof -
       have "\<forall>\<^sub>F n in sequentially. 0 < c (Suc n)"
         using c_pos by (subst eventually_sequentially_Suc) simp
       then show ?thesis using c_pos by eventually_elim auto
     qed
     ultimately show ?thesis  using Bc_large bc_epsilon[OF \<open>\<epsilon>>0\<close> \<open>\<epsilon><1\<close>] 
     proof (eventually_elim, rule_tac impI)
       case (elim n)
       assume "c n < c (n + 1)"
       have "c (n+1) / a n < \<epsilon>" 
         using a_pos[rule_format,of n] using elim(1,2) by auto
       also have "... \<le> \<epsilon> * c n" using elim(2) that(1) by auto
       finally have "c (n+1) / a n < \<epsilon> * c n" .
       then have "c (n+1) / c n < \<epsilon> * a n" 
         using a_pos[rule_format,of n] elim by (auto simp:field_simps)
       then have "(1 - \<epsilon>) * a n < a n - c (n+1) / c n"
         by (auto simp:algebra_simps)
       then have "(1 - \<epsilon>)^2 * a n / B < (1 - \<epsilon>) * (a n - c (n+1) / c n) / B"
-        apply (subst (asm) real_mult_less_iff1[symmetric, of "(1-\<epsilon>)/B"])
-        using \<open>\<epsilon><1\<close> \<open>B>0\<close> by (auto simp:divide_simps power2_eq_square)
+        apply (subst (asm) mult_less_iff1[symmetric, of "(1-\<epsilon>)/B"])
+        using \<open>\<epsilon><1\<close> \<open>B>0\<close> by (auto simp: divide_simps power2_eq_square mult_less_iff1)
       then have "nth_prime n + (1 - \<epsilon>)^2 * a n / B < nth_prime n + (1 - \<epsilon>) * (a n - c (n+1) / c n) / B"
         using \<open>B>0\<close> by auto
       also have "... = nth_prime n + (1 - \<epsilon>) * ((c n *a n - c (n+1)) / c n) / B"
         using elim by (auto simp:field_simps)
       also have "... = nth_prime n + (1 - \<epsilon>) * (nth_prime n / c n)"
       proof -
         have "B * nth_prime n = c n * a n - c (n + 1)" using elim by auto
         from this[symmetric] show ?thesis
           using \<open>B>0\<close> by simp
       qed
       also have "... = (1+(1-\<epsilon>)/c n) * nth_prime n"
         by (auto simp:algebra_simps)
       also have "... = ((c n+1-\<epsilon>)/c n) * nth_prime n"
         using elim by (auto simp:divide_simps)
       also have "... \<le> ((c (n+1) -\<epsilon>)/c n) * nth_prime n"
       proof -
         define cp where "cp = c n+1"
         have "c (n+1) \<ge> cp" unfolding cp_def using \<open>c n < c (n + 1)\<close> by auto
         moreover have "c n>0" "nth_prime n>0" using elim by auto
         ultimately show ?thesis 
           apply (fold cp_def)
           by (auto simp:divide_simps)
       qed
       also have "... < nth_prime (n+1)"
         using elim by (auto simp:divide_simps)
       finally show "real (nth_prime n) + (1 - \<epsilon>)\<^sup>2 * real_of_int (a n) 
           / real_of_int B < real (nth_prime (n + 1))" .
     qed
   qed
 
   have c_neq_large:"\<forall>\<^sub>F n in sequentially. c (n+1) \<noteq> c n"
   proof (rule ccontr)
     assume "\<not> (\<forall>\<^sub>F n in sequentially. c (n + 1) \<noteq> c n)"
     then have that:"\<exists>\<^sub>F n in sequentially. c (n + 1) = c n"
       unfolding frequently_def .
     have "\<forall>\<^sub>F x in sequentially. (B * int (nth_prime x) = c x * a x - c (x + 1) 
         \<and> \<bar>real_of_int (c (x + 1))\<bar> < real_of_int (a x) / 2) \<and> 0 < c x \<and> B < int (nth_prime x)
         \<and> (c (x+1)>c x \<longrightarrow> nth_prime (x+1) > nth_prime x +  a x / (2* B))"
       using Bc_large c_pos B_nth_prime eq_2_11[of "1-1/ sqrt 2",simplified]
       by eventually_elim (auto simp:divide_simps)
     then have "\<exists>\<^sub>F m in sequentially. nth_prime (m+1) > (1+1/(2*B))*nth_prime m"
     proof (elim frequently_eventually_at_top[OF that, THEN frequently_at_top_elim])
       fix n
       assume "c (n + 1) = c n \<and>
            (\<forall>y\<ge>n. (B * int (nth_prime y) = c y * a y - c (y + 1) \<and>
                     \<bar>real_of_int (c (y + 1))\<bar> < real_of_int (a y) / 2) \<and>
                    0 < c y \<and> B < int (nth_prime y) \<and> (c y < c (y + 1) \<longrightarrow>
                    real (nth_prime y) + real_of_int (a y) / real_of_int (2 * B)
                    < real (nth_prime (y + 1))))"
       then have "c (n + 1) = c n" 
         and Bc_eq:"\<forall>y\<ge>n. B * int (nth_prime y) = c y * a y - c (y + 1) \<and> 0 < c y 
                             \<and> \<bar>real_of_int (c (y + 1))\<bar> < real_of_int (a y) / 2 
                             \<and> B < int (nth_prime y)
                             \<and> (c y < c (y + 1) \<longrightarrow>
                    real (nth_prime y) + real_of_int (a y) / real_of_int (2 * B)
                    < real (nth_prime (y + 1)))"
         by auto
       obtain m where "n<m" "c m \<le> c n" "c n<c (m+1)" 
       proof -
         have "\<exists>N. N > n \<and> c N > c n"
           using c_ubound[rule_format, of "MAX x\<in>{..n}. c x"] 
           by (metis Max_ge atMost_iff dual_order.trans finite_atMost finite_imageI image_eqI 
               linorder_not_le order_refl)
         then obtain N where "N>n" "c N>c n" by auto
         define A m where "A={m. n<m \<and> (m+1)\<le>N \<and> c (m+1) > c n}" and "m = Min A"
         have "finite A" unfolding A_def
           by (metis (no_types, lifting) A_def add_leE finite_nat_set_iff_bounded_le mem_Collect_eq)
         moreover have "N-1\<in>A" unfolding A_def 
           using \<open>c n < c N\<close> \<open>n < N\<close> \<open>c (n + 1) = c n\<close>
           by (smt Suc_diff_Suc Suc_eq_plus1 Suc_leI Suc_pred  add.commute 
               add_diff_inverse_nat add_leD1 diff_is_0_eq' mem_Collect_eq nat_add_left_cancel_less
               zero_less_one)
         ultimately have "m\<in>A"
           using Min_in unfolding m_def by auto
         then have "n<m"  "c n<c (m+1)" "m>0"
           unfolding m_def A_def by auto
         moreover have "c m \<le> c n"
         proof (rule ccontr)
           assume " \<not> c m \<le> c n"
           then have "m-1\<in>A" using \<open>m\<in>A\<close> \<open>c (n + 1) = c n\<close>
             unfolding A_def 
             by auto (smt One_nat_def Suc_eq_plus1 Suc_lessI less_diff_conv)
           from  Min_le[OF \<open>finite A\<close> this,folded m_def] \<open>m>0\<close> show False by auto
         qed
         ultimately show ?thesis using that[of m] by auto
       qed
       have "(1 + 1 / (2 * B)) * nth_prime m < nth_prime m + a m / (2*B)"
       proof -
         have "nth_prime m < a m"
         proof -
           have "B * int (nth_prime m) < c m * (a m - 1)"
             using Bc_eq[rule_format,of m] \<open>c m \<le> c n\<close> \<open>c n < c (m + 1)\<close> \<open>n < m\<close> 
             by (auto simp:algebra_simps)
           also have "... \<le> c n * (a m - 1)"
             by (simp add: \<open>c m \<le> c n\<close> a_pos mult_right_mono)
           finally have "B * int (nth_prime m) < c n * (a m - 1)" .
           moreover have "c n\<le>B" 
           proof -
             have " B * int (nth_prime n) = c n * (a n - 1)" "B < int (nth_prime n)"
               and c_a:"\<bar>real_of_int (c (n + 1))\<bar> < real_of_int (a n) / 2"
               using Bc_eq[rule_format,of n] \<open>c (n + 1) = c n\<close> by (auto simp:algebra_simps)
             from this(1) have " c n dvd (B * int (nth_prime n))"
               by simp
             moreover have "coprime (c n) (int (nth_prime n))"
             proof -
               have "c n < int (nth_prime n)" 
               proof (rule ccontr)
                 assume "\<not> c n < int (nth_prime n)"
                 then have asm:"c n \<ge> int (nth_prime n)" by auto
                 then have "a n > 2 * nth_prime n"
                   using c_a \<open>c (n + 1) = c n\<close> by auto
                 then have "a n -1 \<ge> 2 * nth_prime n"
                   by simp
                 then have "a n - 1 > 2 * B"
                   using \<open>B < int (nth_prime n)\<close> by auto
                 from mult_le_less_imp_less[OF asm this] \<open>B>0\<close>
                 have "int (nth_prime n) * (2 * B) < c n * (a n - 1)"
                   by auto
                 then show False using \<open>B * int (nth_prime n) = c n * (a n - 1)\<close>
                   by (smt \<open>0 < B\<close> \<open>B < int (nth_prime n)\<close> combine_common_factor 
                       mult.commute mult_pos_pos)
               qed
               then have "\<not> nth_prime n dvd c n" 
                 by (simp add: Bc_eq zdvd_not_zless)
               then have "coprime (int (nth_prime n)) (c n)" 
                 by (auto intro!:prime_imp_coprime_int)
               then show ?thesis using coprime_commute by blast
             qed
             ultimately have "c n dvd B"
               using coprime_dvd_mult_left_iff by auto
             then show ?thesis using \<open>0 < B\<close> zdvd_imp_le by blast
           qed
           moreover have "c n > 0 " using Bc_eq by blast
           ultimately show ?thesis
             using \<open>B>0\<close> by (smt a_pos mult_mono)
         qed
         then show ?thesis using \<open>B>0\<close> by (auto simp:field_simps)
       qed
       also have "... < nth_prime (m+1)"
         using Bc_eq[rule_format, of m] \<open>n<m\<close> \<open>c m \<le> c n\<close> \<open>c n < c (m+1)\<close>
         by linarith
       finally show "\<exists>j>n. (1 + 1 / real_of_int (2 * B)) * real (nth_prime j)
                        < real (nth_prime (j + 1))" using \<open>m>n\<close> by auto
     qed
     then have "\<exists>\<^sub>F m in sequentially. nth_prime (m+1)/nth_prime m > (1+1/(2*B))"
       by (auto elim:frequently_elim1 simp:field_simps)
     moreover have "\<forall>\<^sub>F m in sequentially. nth_prime (m+1)/nth_prime m < (1+1/(2*B))"
       using ratio_of_consecutive_primes[unfolded tendsto_iff,rule_format,of "1/(2*B)"]
         \<open>B>0\<close>
       unfolding dist_real_def
       by (auto elim!:eventually_mono simp:algebra_simps)
     ultimately show False by (simp add: eventually_mono frequently_def)
   qed
 
   have c_gt_half:"\<forall>\<^sub>F N in sequentially. card {n\<in>{N..<2*N}.  c n > c (n+1)} > N / 2"
   proof -
     define h where "h=(\<lambda>n. (nth_prime (2*n) - nth_prime n) 
                               /  sqrt (nth_prime n))"
     have "\<forall>\<^sub>F n in sequentially. h n < n / 2"
     proof -
       have "\<forall>\<^sub>F n in sequentially. h n < n powr (5/6)"
         using nth_prime_double_sqrt_less[of "1/3"]
         unfolding h_def by auto
       moreover have "\<forall>\<^sub>F n in sequentially. n powr (5/6) < (n /2)"
         by real_asymp
       ultimately show ?thesis 
         by eventually_elim auto 
     qed
     moreover have "\<forall>\<^sub>F n in sequentially. sqrt (nth_prime n) / a n < 1 / (2*B)"
       using nth_1[THEN tendsto_real_sqrt,unfolded tendsto_iff
           ,rule_format,of "1/(2*B)"] \<open>B>0\<close> a_pos
       by (auto simp:real_sqrt_divide abs_of_pos)
     ultimately have "\<forall>\<^sub>F x in sequentially. c (x+1) \<noteq> c x
         \<and> sqrt (nth_prime x) / a x < 1 / (2*B)
         \<and>  h x < x / 2
         \<and> (c (x+1)>c x \<longrightarrow> nth_prime (x+1) > nth_prime x +  a x / (2* B))"
       using c_neq_large B_nth_prime eq_2_11[of "1-1/ sqrt 2",simplified]
       by eventually_elim (auto simp:divide_simps)
     then show ?thesis
     proof (elim eventually_at_top_mono)
       fix N assume "N\<ge>1" and N_asm:"\<forall>y\<ge>N. c (y + 1) \<noteq> c y \<and>
                sqrt (real (nth_prime y)) / real_of_int (a y)
                < 1 / real_of_int (2 * B) \<and>  h y < y / 2 \<and>
                (c y < c (y + 1) \<longrightarrow>
                 real (nth_prime y) + real_of_int (a y) / real_of_int (2 * B)
                 < real (nth_prime (y + 1)))"
 
       define S where "S={n \<in> {N..<2 * N}. c n < c (n + 1)}"
       define g where "g=(\<lambda>n. (nth_prime (n+1) - nth_prime n) 
                               /  sqrt (nth_prime n))"
       define f where "f=(\<lambda>n. nth_prime (n+1) - nth_prime n)"
       have g_gt_1:"g n>1" when "n\<ge>N" "c n < c (n + 1)" for n
       proof -
         have "nth_prime n + sqrt (nth_prime n) < nth_prime (n+1)"
         proof -
           have "nth_prime n + sqrt (nth_prime n) < nth_prime n + a n / (2*B)"
             using N_asm[rule_format,OF \<open>n\<ge>N\<close>] a_pos
             by (auto simp:field_simps)
           also have "... < nth_prime (n+1)"
             using N_asm[rule_format,OF \<open>n\<ge>N\<close>] \<open>c n < c (n + 1)\<close> by auto
           finally show ?thesis .
         qed
         then show ?thesis unfolding g_def 
           using \<open>c n < c (n + 1)\<close> by auto
       qed
       have g_geq_0:"g n \<ge> 0" for n 
         unfolding g_def  by auto
 
       have "finite S" "\<forall>x\<in>S. x\<ge>N \<and> c x<c (x+1)"
         unfolding S_def by auto
       then have "card S \<le> sum g S" 
       proof (induct S)
         case empty
         then show ?case by auto
       next
         case (insert x F)
         moreover have "g x>1" 
         proof -
           have "c x < c (x+1)" "x\<ge>N" using insert(4) by auto
           then show ?thesis using g_gt_1 by auto
         qed
         ultimately show ?case by simp
       qed
       also have "... \<le> sum g {N..<2*N}"
         apply (rule sum_mono2)
         unfolding S_def using g_geq_0 by auto
       also have "... \<le> sum (\<lambda>n. f n/sqrt (nth_prime N)) {N..<2*N}"
         apply (rule sum_mono)
         unfolding f_def g_def by (auto intro!:divide_left_mono)
       also have "... = sum f {N..<2*N} / sqrt (nth_prime N)"
         unfolding sum_divide_distrib[symmetric] by auto
       also have "... = (nth_prime (2*N) - nth_prime N) / sqrt (nth_prime N)"
       proof -
         have "sum f {N..<2 * N} = nth_prime (2 * N) - nth_prime N"   
         proof (induct N)
           case 0
           then show ?case by simp
         next
           case (Suc N)
           have ?case if "N=0"
           proof -
             have "sum f {Suc N..<2 * Suc N} = sum f {1}"
               using that by (simp add: numeral_2_eq_2)
             also have "... = nth_prime 2 - nth_prime 1"
               unfolding f_def by (simp add:numeral_2_eq_2)
             also have "... = nth_prime (2 * Suc N) - nth_prime (Suc N)"
               using that by auto
             finally show ?thesis .
           qed
           moreover have ?case if "N\<noteq>0"
           proof -
             have "sum f {Suc N..<2 * Suc N} = sum f {N..<2 * Suc N} - f N"
               apply (subst (2) sum.atLeast_Suc_lessThan)
               using that by auto
             also have "... = sum f {N..<2 * N}+ f (2*N) + f(2*N+1) - f N"
               by auto
             also have "... = nth_prime (2 * Suc N) - nth_prime (Suc N)"
               using Suc unfolding f_def by auto
             finally show ?thesis .
           qed
           ultimately show ?case by blast
         qed
         then show ?thesis by auto
       qed
       also have "... = h N"
         unfolding h_def by auto
       also have "... < N/2"
         using N_asm by auto
       finally have "card S < N/2" .
 
       define T where "T={n \<in> {N..<2 * N}. c n > c (n + 1)}"
       have "T \<union> S = {N..<2 * N}" "T \<inter> S = {}" "finite T"
         unfolding T_def S_def using N_asm by fastforce+
 
       then have "card T + card S = card {N..<2 * N}"
         using card_Un_disjoint \<open>finite S\<close> by metis
       also have "... = N"
         by simp
       finally have "card T + card S = N" .
       with \<open>card S < N/2\<close> 
       show "card T > N/2" by linarith
     qed
   qed
 
   text\<open>Inequality (3.5) in the original paper required a slight modification: \<close>
 
   have a_gt_plus:"\<forall>\<^sub>F n in sequentially. c n > c (n+1) \<longrightarrow>a (n+1) > a n + (a n - c(n+1) - 1) / c (n+1)"
   proof -
     note a_gt_1[THEN eventually_all_ge_at_top] c_pos[THEN eventually_all_ge_at_top]
     moreover have "\<forall>\<^sub>F n in sequentially. 
               B * int (nth_prime (n+1)) = c (n+1) * a (n+1) - c (n + 2)"
       using Bc_large 
       apply (subst (asm) eventually_sequentially_Suc[symmetric])
       by (auto elim:eventually_mono)
     moreover have "\<forall>\<^sub>F n in sequentially. 
                         B * int (nth_prime n) = c n * a n - c (n + 1) \<and> \<bar>c (n + 1)\<bar> <  a n / 2"
       using Bc_large by (auto elim:eventually_mono)
     ultimately show ?thesis 
       apply (eventually_elim)
     proof (rule impI)
       fix n 
       assume "\<forall>y\<ge>n. 1 < a y" "\<forall>y\<ge>n. 0 < c y"
         and
         Suc_n_eq:"B * int (nth_prime (n + 1)) = c (n + 1) * a (n + 1) - c (n + 2)" and
         "B * int (nth_prime n) = c n * a n - c (n + 1) \<and>
                 real_of_int \<bar>c (n + 1)\<bar> < real_of_int (a n) / 2" 
         and "c (n + 1) < c n"
       then have n_eq:"B * int (nth_prime n) = c n * a n - c (n + 1)" and 
         c_less_a: "real_of_int \<bar>c (n + 1)\<bar> < real_of_int (a n) / 2" 
         by auto
       from \<open>\<forall>y\<ge>n. 1 < a y\<close> \<open>\<forall>y\<ge>n. 0 < c y\<close> 
       have *:"a n>1" "a (n+1) > 1" "c n > 0" 
         "c (n+1) > 0"  "c (n+2) > 0"
         by auto
       then have "(1+1/c (n+1))* (a n - 1)/a (n+1) = (c (n+1)+1) * ((a n - 1) / (c (n+1) * a (n+1)))"
         by (auto simp:field_simps)
       also have "... \<le> c n * ((a n - 1) / (c (n+1) * a (n+1)))"
         apply (rule mult_right_mono)
         subgoal using \<open>c (n + 1) < c n\<close> by auto
         subgoal by (smt \<open>0 < c (n + 1)\<close> a_pos divide_nonneg_pos mult_pos_pos of_int_0_le_iff 
               of_int_0_less_iff)
         done
       also have "... = (c n * (a n - 1)) / (c (n+1) * a (n+1))" by auto
       also have "... < (c n * (a n - 1)) / (c (n+1) * a (n+1)  - c (n+2))"
         apply (rule divide_strict_left_mono)
         subgoal using \<open>c (n+2) > 0\<close> by auto
         unfolding Suc_n_eq[symmetric] using * \<open>B>0\<close> by auto
       also have "... < (c n * a n - c (n+1)) / (c (n+1) * a (n+1)  - c (n+2))"
         apply (rule frac_less)
         unfolding Suc_n_eq[symmetric] using * \<open>B>0\<close> \<open>c (n + 1) < c n\<close> 
         by (auto simp:algebra_simps)
       also have "... = nth_prime n / nth_prime (n+1)"
         unfolding Suc_n_eq[symmetric] n_eq[symmetric] using \<open>B>0\<close> by auto
       also have "... < 1" by auto
       finally have "(1 + 1 / real_of_int (c (n + 1))) * real_of_int (a n - 1) 
         / real_of_int (a (n + 1)) < 1 " .
       then show "a n + (a n - c (n + 1) - 1) /  (c (n + 1)) < (a (n + 1))"
         using * by (auto simp:field_simps)
     qed
   qed
   have a_gt_1:"\<forall>\<^sub>F n in sequentially. c n > c (n+1) \<longrightarrow> a (n+1) > a n + 1"
     using Bc_large a_gt_plus c_pos[THEN eventually_all_ge_at_top]
     apply eventually_elim
   proof (rule impI)
     fix n assume  
       "c (n + 1) < c n \<longrightarrow> a n +  (a n - c (n + 1) - 1) / c (n + 1) <  a (n + 1)" 
       "c (n + 1) < c n" and B_eq:"B * int (nth_prime n) = c n * a n - c (n + 1) \<and>
          \<bar>real_of_int (c (n + 1))\<bar> < real_of_int (a n) / 2" and c_pos:"\<forall>y\<ge>n. 0 < c y"
     from this(1,2) 
     have "a n +  (a n - c (n + 1) - 1) / c (n + 1) <  a (n + 1)" by auto
     moreover have "a n - 2 * c (n+1) > 0"
       using B_eq c_pos[rule_format,of "n+1"] by auto
     then have "a n - 2 * c (n+1) \<ge> 1" by simp
     then have "(a n - c (n + 1) - 1) / c (n + 1) \<ge> 1"
       using c_pos[rule_format,of "n+1"] by (auto simp:field_simps)
     ultimately show "a n + 1 < a (n + 1)" by auto
   qed
 
   text\<open>The following corresponds to inequality (3.6) in the paper, which had to be
         slightly corrected:  \<close>
 
   have a_gt_sqrt:"\<forall>\<^sub>F n in sequentially. c n > c (n+1) \<longrightarrow> a (n+1) > a n + (sqrt n - 2)"
   proof -
     have a_2N:"\<forall>\<^sub>F N in sequentially. a (2*N) \<ge> N /2 +1" 
       using c_gt_half a_gt_1[THEN eventually_all_ge_at_top] 
     proof eventually_elim
       case (elim N)
       define S where "S={n \<in> {N..<2 * N}. c (n + 1) < c n}"
       define f where "f = (\<lambda>n. a (Suc n) - a n)"
 
       have f_1:"\<forall>x\<in>S. f x\<ge>1" and f_0:"\<forall>x. f x\<ge>0"
         subgoal using elim unfolding S_def f_def by auto
         subgoal using \<open>mono a\<close>[THEN incseq_SucD] unfolding f_def by auto
         done
       have "N / 2 < card S" 
         using elim unfolding S_def by auto
       also have "... \<le> sum f S" 
         unfolding of_int_sum
         apply (rule sum_bounded_below[of _ 1,simplified])
         using f_1 by auto
       also have "... \<le> sum f {N..<2 * N}" 
         unfolding of_int_sum
         apply (rule sum_mono2)
         unfolding S_def using f_0 by auto
       also have "... = a (2*N) - a N" 
         unfolding of_int_sum f_def of_int_diff
         apply (rule sum_Suc_diff')
         by auto
       finally have "N / 2 < a (2*N) - a N" .
       then show ?case using a_pos[rule_format,of N] by linarith
     qed
 
     have a_n4:"\<forall>\<^sub>F n in sequentially. a n > n/4" 
     proof -
       obtain N where a_N:"\<forall>n\<ge>N. a (2*n) \<ge> n /2+1"
         using a_2N unfolding eventually_at_top_linorder by auto
       have "a n>n/4" when "n\<ge>2*N" for n 
       proof -
         define n' where "n'=n div 2"
         have "n'\<ge>N" unfolding n'_def using that by auto
         have "n/4 < n' /2+1"
           unfolding n'_def by auto
         also have "... \<le> a (2*n')"
           using a_N \<open>n'\<ge>N\<close> by auto
         also have "... \<le>a n" unfolding n'_def
           apply (cases "even n")
           subgoal by simp
           subgoal by (simp add: assms(2) incseqD)
           done
         finally show ?thesis .
       qed
       then show ?thesis
         unfolding eventually_at_top_linorder by auto
     qed
 
     have c_sqrt:"\<forall>\<^sub>F n in sequentially. c n < sqrt n / 4"
     proof -
       have "\<forall>\<^sub>F x in sequentially. x>1" by simp
       moreover have "\<forall>\<^sub>F x in sequentially. real (nth_prime x) / (real x * ln (real x)) < 2"
         using nth_prime_asymptotics[unfolded asymp_equiv_def,THEN order_tendstoD(2),of 2]
         by simp
       ultimately have "\<forall>\<^sub>F n in sequentially. c n < B*8 *ln n + 1" using a_n4 Bc_large
       proof eventually_elim
         case (elim n)
         from this(4) have "c n=(B*nth_prime n+c (n+1))/a n"
           using a_pos[rule_format,of n] 
           by (auto simp:divide_simps)
         also have "... = (B*nth_prime n)/a n+c (n+1)/a n"
           by (auto simp:divide_simps)
         also have "... < (B*nth_prime n)/a n + 1"
         proof -
           have "c (n+1)/a n < 1" using elim(4) by auto
           then show ?thesis by auto
         qed
         also have "... < B*8 * ln n + 1"
         proof -
           have "B*nth_prime n < 2*B*n*ln n"
             using \<open>real (nth_prime n) / (real n * ln (real n)) < 2\<close> \<open>B>0\<close> \<open> 1 < n\<close> 
             by (auto simp:divide_simps)
           moreover have "real n / 4 < real_of_int (a n)" by fact
           ultimately have "(B*nth_prime n) / a n < (2*B*n*ln n) / (n/4)"
             apply (rule_tac frac_less)
             using \<open>B>0\<close> \<open> 1 < n\<close>  by auto
           also have "... = B*8 * ln n"
             using \<open> 1 < n\<close> by auto
           finally show ?thesis by auto
         qed
         finally show ?case .
       qed
       moreover have "\<forall>\<^sub>F n in sequentially. B*8 *ln n + 1 < sqrt n / 4"
         by real_asymp
       ultimately show ?thesis 
         by eventually_elim auto
     qed
 
     have 
       "\<forall>\<^sub>F n in sequentially. 0 < c (n+1)"
       "\<forall>\<^sub>F n in sequentially. c (n+1) < sqrt (n+1) / 4"
       "\<forall>\<^sub>F n in sequentially. n > 4"
       "\<forall>\<^sub>F n in sequentially. (n - 4) / sqrt (n + 1) + 1 > sqrt n"
       subgoal using c_pos[THEN eventually_all_ge_at_top]    
         by eventually_elim auto
       subgoal using  c_sqrt[THEN eventually_all_ge_at_top] 
         by eventually_elim (use le_add1 in blast)
       subgoal by simp
       subgoal 
         by real_asymp
       done
     then show ?thesis using a_gt_plus a_n4
       apply eventually_elim
     proof (rule impI)
       fix n assume asm:"0 < c (n + 1)" "c (n + 1) < sqrt (real (n + 1)) / 4" and
         a_ineq:"c (n + 1) < c n \<longrightarrow> a n +  (a n - c (n + 1) - 1) /  c (n + 1) < a (n + 1)" 
         "c (n + 1) < c n"  and "n / 4 < a n" "n > 4" 
         and n_neq:" sqrt (real n) < real (n - 4) / sqrt (real (n + 1)) + 1"
 
       have "(n-4) / sqrt(n+1) = (n/4 - 1)/ (sqrt (real (n + 1)) / 4)"
         using \<open>n>4\<close> by (auto simp:divide_simps)
       also have "... < (a n - 1) /  c (n + 1)" 
         apply (rule frac_less)
         using \<open>n > 4\<close> \<open>n / 4 < a n\<close> \<open>0 < c (n + 1)\<close> \<open>c (n + 1) < sqrt (real (n + 1)) / 4\<close>
         by auto
       also have "... - 1 = (a n - c (n + 1) - 1) /  c (n + 1)"
         using \<open>0 < c (n + 1)\<close> by (auto simp:field_simps)
       also have "a n + ... < a (n+1)"
         using a_ineq by auto
       finally have "a n + ((n - 4) / sqrt (n + 1) - 1) < a (n + 1)" by simp
       moreover have "(n - 4) / sqrt (n + 1) - 1 > sqrt n - 2"
         using n_neq[THEN diff_strict_right_mono,of 2] \<open>n>4\<close> 
         by (auto simp:algebra_simps of_nat_diff) 
       ultimately show "real_of_int (a n) + (sqrt (real n) - 2) < real_of_int (a (n + 1))"
         by argo
     qed
   qed
 
   text\<open>The following corresponds to inequality $ a_{2N} > N^{3/2}/2$ in the paper,
  which had to be slightly corrected: \<close>
 
   have a_2N_sqrt:"\<forall>\<^sub>F N in sequentially. a (2*N) >  real N * (sqrt (real N)/2 - 1)"
     using c_gt_half a_gt_sqrt[THEN eventually_all_ge_at_top] eventually_gt_at_top[of 4]
   proof eventually_elim
     case (elim N)
     define S where "S={n \<in> {N..<2 * N}. c (n + 1) < c n}"
     define f where "f = (\<lambda>n. a (Suc n) - a n)"
 
     have f_N:"\<forall>x\<in>S. f x\<ge>sqrt N - 2"
     proof 
       fix x assume "x\<in>S"
       then have "sqrt (real x) - 2 < f x" "x\<ge>N"
         using elim unfolding S_def f_def by auto
       moreover have "sqrt x - 2 \<ge> sqrt N - 2"
         using \<open>x\<ge>N\<close> by simp
       ultimately show  "sqrt (real N) - 2 \<le> real_of_int (f x)" by argo
     qed
     have f_0:"\<forall>x. f x\<ge>0"
       using \<open>mono a\<close>[THEN incseq_SucD] unfolding f_def by auto
 
     have "(N / 2)  * (sqrt N - 2) < card S * (sqrt N - 2)" 
       apply (rule mult_strict_right_mono)
       subgoal using elim unfolding S_def by auto
       subgoal using \<open>N>4\<close> 
         by (metis diff_gt_0_iff_gt numeral_less_real_of_nat_iff real_sqrt_four real_sqrt_less_iff)
       done
     also have "...  \<le> sum f S" 
       unfolding of_int_sum
       apply (rule sum_bounded_below)
       using f_N by auto
     also have "... \<le> sum f {N..<2 * N}" 
       unfolding of_int_sum
       apply (rule sum_mono2)
       unfolding S_def using f_0 by auto
     also have "... = a (2*N) - a N" 
       unfolding of_int_sum f_def of_int_diff
       apply (rule sum_Suc_diff')
       by auto
     finally have "real N / 2 * (sqrt (real N) - 2) < real_of_int (a (2 * N) - a N)" 
       .              
     then have "real N / 2 * (sqrt (real N) - 2) < a (2 * N)"
       using a_pos[rule_format,of N] by linarith
     then show ?case by (auto simp:field_simps)
   qed
 
   text\<open>The following part is required to derive the final contradiction of the proof.\<close>
 
   have a_n_sqrt:"\<forall>\<^sub>F n in sequentially. a n > (((n-1)/2) powr (3/2) - (n-1)) /2"
   proof (rule sequentially_even_odd_imp)
     define f where "f=(\<lambda>N. ((real (2 * N - 1) / 2) powr (3 / 2) - real (2 * N - 1)) / 2)"
     define g where "g=(\<lambda>N. real N * (sqrt (real N) / 2 - 1))"
     have "\<forall>\<^sub>F N in sequentially. g N > f N"
       unfolding f_def g_def
       by real_asymp
     moreover have "\<forall>\<^sub>F N in sequentially. a (2 * N) > g N"
       unfolding g_def using a_2N_sqrt .
     ultimately show "\<forall>\<^sub>F N in sequentially. f N < a (2 * N)"
       by eventually_elim auto
   next
     define f where "f=(\<lambda>N. ((real (2 * N + 1 - 1) / 2) powr (3 / 2) 
                                   - real (2 * N + 1 - 1)) / 2)"
     define g where "g=(\<lambda>N. real N * (sqrt (real N) / 2 - 1))"
     have "\<forall>\<^sub>F N in sequentially. g N = f N"
       using eventually_gt_at_top[of 0]
       apply eventually_elim
       unfolding f_def g_def
       by (auto simp:algebra_simps powr_half_sqrt[symmetric] powr_mult_base)
     moreover have "\<forall>\<^sub>F N in sequentially. a (2 * N) > g N"
       unfolding g_def using a_2N_sqrt .
     moreover have "\<forall>\<^sub>F N in sequentially. a (2 * N + 1) \<ge> a (2*N)"
       apply (rule eventuallyI)
       using \<open>mono a\<close> by (simp add: incseqD)
     ultimately show "\<forall>\<^sub>F N in sequentially. f N < (a (2 * N + 1))"
       apply eventually_elim
       by auto
   qed
 
   have a_nth_prime_gt:"\<forall>\<^sub>F n in sequentially. a n / nth_prime n > 1"
   proof -
     define f where "f=(\<lambda>n::nat. (((n-1)/2) powr (3/2) - (n-1)) /2)"
     have "\<forall>\<^sub>F x in sequentially. real (nth_prime x) / (real x * ln (real x)) < 2"
       using nth_prime_asymptotics[unfolded asymp_equiv_def,THEN order_tendstoD(2),of 2]
       by simp
     from this[] eventually_gt_at_top[of 1]
     have "\<forall>\<^sub>F n in sequentially. real (nth_prime n)   < 2*(real n * ln n)"
       apply eventually_elim
       by (auto simp:field_simps)
     moreover have *:"\<forall>\<^sub>F N in sequentially. f N >0 "
       unfolding f_def
       by real_asymp
     moreover have " \<forall>\<^sub>F n in sequentially. f n < a n"
       using a_n_sqrt unfolding f_def .
     ultimately have "\<forall>\<^sub>F n in sequentially. a n / nth_prime n 
                     > f n / (2*(real n * ln n))"
       apply eventually_elim
       apply (rule frac_less2)
       by auto
     moreover have "\<forall>\<^sub>F n in sequentially.
         (f n)/ (2*(real n * ln n)) > 1"
       unfolding f_def 
       by real_asymp
     ultimately show ?thesis 
       by eventually_elim argo
   qed
 
   have a_nth_prime_lt:"\<exists>\<^sub>F n in sequentially. a n / nth_prime n < 1"
   proof -
     have "liminf (\<lambda>x. a x / nth_prime x) < 1"
       using nth_2 by auto
     from this[unfolded less_Liminf_iff]
     show ?thesis
       apply (auto elim!:frequently_elim1)
       by (meson divide_less_eq_1 ereal_less_eq(7) leD leI 
           nth_prime_nonzero of_nat_eq_0_iff of_nat_less_0_iff order.trans)
   qed
 
   from a_nth_prime_gt a_nth_prime_lt show False 
     by (simp add: eventually_mono frequently_def) 
 qed
 
 section\<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.\<close>
 
 end
\ No newline at end of file
diff --git a/thys/LLL_Basis_Reduction/LLL.thy b/thys/LLL_Basis_Reduction/LLL.thy
--- a/thys/LLL_Basis_Reduction/LLL.thy
+++ b/thys/LLL_Basis_Reduction/LLL.thy
@@ -1,1745 +1,1745 @@
 (*
     Authors:    Jose Divasón
                 Maximilian Haslbeck
                 Sebastiaan Joosten
                 René Thiemann
                 Akihisa Yamada
     License:    BSD
 *)
 
 section \<open>The LLL Algorithm\<close>
 
 text \<open>Soundness of the LLL algorithm is proven in four steps. 
   In the basic version, we do recompute the Gram-Schmidt ortogonal (GSO) basis 
   in every step. This basic version will have a full functional soundness proof, 
   i.e., termination and the property that the returned basis is reduced.
   Then in LLL-Number-Bounds we will strengthen the invariant and prove that
   all intermediate numbers stay polynomial in size.
   Moreover, in LLL-Impl we will refine the basic version, so that
   the GSO does not need to be recomputed in every step. 
   Finally, in LLL-Complexity, we develop an cost-annotated version
   of the refined algorithm and prove a polynomial upper bound on the 
   number of arithmetic operations.\<close> 
 
 
 text \<open>This theory provides a basic implementation and a soundness proof of the LLL algorithm
       to compute a "short" vector in a lattice.\<close> 
 
 theory LLL
   imports 
     Gram_Schmidt_2 
     Missing_Lemmas 
     Jordan_Normal_Form.Determinant 
     "Abstract-Rewriting.SN_Order_Carrier"
 begin
 
 subsection \<open>Core Definitions, Invariants, and Theorems for Basic Version\<close>
 
 (* Note/TODO by Max Haslbeck:
   Up to here I refactored the code in Gram_Schmidt_2 and Gram_Schmidt_Int which now makes heavy
   use of locales. In the future I would also like to do this here (instead of using LLL_invariant
   everywhere). *)
 
 locale LLL =
   fixes n :: nat (* n-dimensional vectors, *)
     and m :: nat (* number of vectors *)
     and fs_init :: "int vec list" (* initial basis *)
     and \<alpha> :: rat (* approximation factor *)
 
 begin
 
 sublocale vec_module "TYPE(int)" n.
 
 
 
 
 abbreviation RAT where "RAT \<equiv> map (map_vec rat_of_int)" 
 abbreviation SRAT where "SRAT xs \<equiv> set (RAT xs)" 
 abbreviation Rn where "Rn \<equiv> carrier_vec n :: rat vec set" 
 
 sublocale gs: gram_schmidt_fs n "RAT fs_init" .
 
 abbreviation lin_indep where "lin_indep fs \<equiv> gs.lin_indpt_list (RAT fs)" 
 abbreviation gso where "gso fs \<equiv> gram_schmidt_fs.gso n (RAT fs)"
 abbreviation \<mu> where "\<mu> fs \<equiv> gram_schmidt_fs.\<mu> n (RAT fs)"
 
 abbreviation reduced where "reduced fs \<equiv> gram_schmidt_fs.reduced n (RAT fs) \<alpha>" 
 abbreviation weakly_reduced where "weakly_reduced fs \<equiv> gram_schmidt_fs.weakly_reduced n (RAT fs) \<alpha>" 
   
 text \<open>lattice of initial basis\<close>
 definition "L = lattice_of fs_init" 
 
 text \<open>maximum squared norm of initial basis\<close>
 definition "N = max_list (map (nat \<circ> sq_norm) fs_init)" 
 
 text \<open>maximum absolute value in initial basis\<close>
 definition "M = Max ({abs (fs_init ! i $ j) | i j. i < m \<and> j < n} \<union> {0})" 
 
 text \<open>This is the core invariant which enables to prove functional correctness.\<close>
 
 definition "\<mu>_small fs i = (\<forall> j < i. abs (\<mu> fs i j) \<le> 1/2)" 
 
 definition LLL_invariant_weak :: "int vec list \<Rightarrow> bool" where
   "LLL_invariant_weak fs = (
     gs.lin_indpt_list (RAT fs) \<and> 
     lattice_of fs = L \<and>
     length fs = m)"
 
 lemma LLL_inv_wD: assumes "LLL_invariant_weak fs"
   shows 
   "lin_indep fs" 
   "length (RAT fs) = m" 
   "set fs \<subseteq> carrier_vec n"
   "\<And> i. i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" 
   "\<And> i. i < m \<Longrightarrow> gso fs i \<in> carrier_vec n" 
   "length fs = m"
   "lattice_of fs = L" 
 proof (atomize (full), goal_cases)
   case 1
   interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs"
     by (standard) (use assms LLL_invariant_weak_def gs.lin_indpt_list_def in auto)
   show ?case
     using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier
     by (auto simp add: LLL_invariant_weak_def gram_schmidt_fs.reduced_def)
 qed
 
 lemma LLL_inv_wI: assumes  
   "set fs \<subseteq> carrier_vec n"
   "length fs = m"
   "lattice_of fs = L" 
   "lin_indep fs" 
 shows "LLL_invariant_weak fs" 
   unfolding LLL_invariant_weak_def Let_def using assms by auto
 
 definition LLL_invariant :: "bool \<Rightarrow> nat \<Rightarrow> int vec list \<Rightarrow> bool" where 
   "LLL_invariant upw i fs = ( 
     gs.lin_indpt_list (RAT fs) \<and> 
     lattice_of fs = L \<and>
     reduced fs i \<and>
     i \<le> m \<and> 
     length fs = m \<and>
     (upw \<or> \<mu>_small fs i)    
   )" 
 
 lemma LLL_inv_imp_w: "LLL_invariant upw i fs \<Longrightarrow> LLL_invariant_weak fs" 
   unfolding LLL_invariant_def LLL_invariant_weak_def by blast 
 
 lemma LLL_invD: assumes "LLL_invariant upw i fs"
   shows 
   "lin_indep fs" 
   "length (RAT fs) = m" 
   "set fs \<subseteq> carrier_vec n"
   "\<And> i. i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" 
   "\<And> i. i < m \<Longrightarrow> gso fs i \<in> carrier_vec n" 
   "length fs = m"
   "lattice_of fs = L" 
   "weakly_reduced fs i"
   "i \<le> m"
   "reduced fs i" 
   "upw \<or> \<mu>_small fs i"
 proof (atomize (full), goal_cases)
   case 1
   interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs"
     by (standard) (use assms LLL_invariant_def gs.lin_indpt_list_def in auto)
   show ?case
     using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier
     by (auto simp add: LLL_invariant_def gram_schmidt_fs.reduced_def)
 qed
 
 lemma LLL_invI: assumes  
   "set fs \<subseteq> carrier_vec n"
   "length fs = m"
   "lattice_of fs = L" 
   "i \<le> m"
   "lin_indep fs" 
   "reduced fs i" 
   "upw \<or> \<mu>_small fs i" 
 shows "LLL_invariant upw i fs" 
   unfolding LLL_invariant_def Let_def split using assms by auto
 
 
 
 end
 
 locale fs_int' =
   fixes n m fs_init fs 
   assumes LLL_inv: "LLL.LLL_invariant_weak n m fs_init fs"
 
 sublocale fs_int' \<subseteq> fs_int_indpt
    using LLL_inv unfolding LLL.LLL_invariant_weak_def by (unfold_locales) blast
 
 context LLL
 begin
 
 lemma gso_cong: assumes "\<And> i. i \<le> x \<Longrightarrow> f1 ! i = f2 ! i"
    "x < length f1" "x < length f2" 
   shows "gso f1 x = gso f2 x"
   by (rule gs.gso_cong, insert assms, auto)
   
 lemma \<mu>_cong: assumes "\<And> k. j < i \<Longrightarrow> k \<le> j \<Longrightarrow> f1 ! k = f2 ! k"
   and i: "i < length f1" "i < length f2" 
   and "j < i \<Longrightarrow> f1 ! i = f2 ! i" 
   shows "\<mu> f1 i j = \<mu> f2 i j"
   by (rule gs.\<mu>_cong, insert assms, auto)
     
 definition reduction where "reduction = (4+\<alpha>)/(4*\<alpha>)"
 
 
 definition d :: "int vec list \<Rightarrow> nat \<Rightarrow> int" where "d fs k = gs.Gramian_determinant fs k"
 definition D :: "int vec list \<Rightarrow> nat" where "D fs = nat (\<Prod> i < m. d fs i)" 
 
 definition "d\<mu> gs i j = int_of_rat (of_int (d gs (Suc j)) * \<mu> gs i j)" 
 
 definition logD :: "int vec list \<Rightarrow> nat"
   where "logD fs = (if \<alpha> = 4/3 then (D fs) else nat (floor (log (1 / of_rat reduction) (D fs))))" 
 
 definition LLL_measure :: "nat \<Rightarrow> int vec list \<Rightarrow> nat" where 
   "LLL_measure i fs = (2 * logD fs + m - i)" 
 
 context
   fixes fs
   assumes Linv: "LLL_invariant_weak fs"
 begin
 
 interpretation fs: fs_int' n m fs_init fs
   by (standard) (use Linv in auto)
 
 lemma Gramian_determinant:
   assumes k: "k \<le> m" 
 shows "of_int (gs.Gramian_determinant fs k) = (\<Prod> j<k. sq_norm (gso fs j))" (is ?g1)
   "gs.Gramian_determinant fs k > 0" (is ?g2)
   using assms fs.Gramian_determinant LLL_inv_wD[OF Linv]  by auto
    
 lemma LLL_d_pos [intro]: assumes k: "k \<le> m" 
 shows "d fs k > 0"
   unfolding d_def using fs.Gramian_determinant k LLL_inv_wD[OF Linv] by auto
 
 lemma LLL_d_Suc: assumes k: "k < m" 
 shows "of_int (d fs (Suc k)) = sq_norm (gso fs k) * of_int (d fs k)" 
   using assms fs.fs_int_d_Suc  LLL_inv_wD[OF Linv] unfolding fs.d_def d_def by auto
 
 lemma LLL_D_pos:
   shows "D fs > 0"
   using fs.fs_int_D_pos LLL_inv_wD[OF Linv] unfolding D_def fs.D_def fs.d_def d_def by auto
 end
 
 text \<open>Condition when we can increase the value of $i$\<close>
 
 lemma increase_i:
   assumes Linv: "LLL_invariant upw i fs"
   assumes i: "i < m" 
   and upw: "upw \<Longrightarrow> i = 0" 
   and red_i: "i \<noteq> 0 \<Longrightarrow> sq_norm (gso fs (i - 1)) \<le> \<alpha> * sq_norm (gso fs i)"
 shows "LLL_invariant True (Suc i) fs" "LLL_measure i fs > LLL_measure (Suc i) fs" 
 proof -
   note inv = LLL_invD[OF Linv]
   from inv(8,10) have red: "weakly_reduced fs i" 
     and sred: "reduced fs i" by (auto)
   from red red_i i have red: "weakly_reduced fs (Suc i)" 
     unfolding gram_schmidt_fs.weakly_reduced_def
     by (intro allI impI, rename_tac ii, case_tac "Suc ii = i", auto)
   from inv(11) upw have sred_i: "\<And> j. j < i \<Longrightarrow> \<bar>\<mu> fs i j\<bar> \<le> 1 / 2" 
     unfolding \<mu>_small_def by auto
   from sred sred_i have sred: "reduced fs (Suc i)"
     unfolding gram_schmidt_fs.reduced_def
     by (intro conjI[OF red] allI impI, rename_tac ii j, case_tac "ii = i", auto)
   show "LLL_invariant True (Suc i) fs" 
     by (intro LLL_invI, insert inv red sred i, auto)
   show "LLL_measure i fs > LLL_measure (Suc i) fs" unfolding LLL_measure_def using i by auto
 qed
 
 text \<open>Standard addition step which makes $\mu_{i,j}$ small\<close>
 
 definition "\<mu>_small_row i fs j = (\<forall> j'. j \<le> j' \<longrightarrow> j' < i \<longrightarrow> abs (\<mu> fs i j') \<le> inverse 2)"
 
 lemma basis_reduction_add_row_main: assumes Linv: "LLL_invariant_weak fs"
   and i: "i < m"  and j: "j < i" 
   and fs': "fs' = fs[ i := fs ! i - c \<cdot>\<^sub>v fs ! j]" 
 shows "LLL_invariant_weak fs'" 
   "LLL_invariant True i fs \<Longrightarrow> LLL_invariant True i fs'"
   "c = round (\<mu> fs i j) \<Longrightarrow> \<mu>_small_row i fs (Suc j) \<Longrightarrow> \<mu>_small_row i fs' j" (* mu-value at position i j gets small *)
   "c = round (\<mu> fs i j) \<Longrightarrow> abs (\<mu> fs' i j) \<le> 1/2" (* mu-value at position i j gets small *)
   "LLL_measure i fs' = LLL_measure i fs" 
   (* new values of gso: no change *)
   "\<And> i. i < m \<Longrightarrow> gso fs' i = gso fs i" 
   (* new values of mu *)
   "\<And> i' j'. i' < m \<Longrightarrow> j' < m \<Longrightarrow>       
      \<mu> fs' i' j' = (if i' = i \<and> j' \<le> j then \<mu> fs i j' - of_int c * \<mu> fs j j' else \<mu> fs i' j')"
   (* new values of d *)
   "\<And> ii. ii \<le> m \<Longrightarrow> d fs' ii = d fs ii" 
 proof -
   define bnd :: rat where bnd: "bnd = 4 ^ (m - 1 - Suc j) * of_nat (N ^ (m - 1) * m)" 
   define M where "M = map (\<lambda>i. map (\<mu> fs i) [0..<m]) [0..<m]"
   note inv = LLL_inv_wD[OF Linv]
   note Gr = inv(1)
   have ji: "j \<le> i" "j < m" and jstrict: "j < i" 
     and add: "set fs \<subseteq> carrier_vec n" "i < length fs" "j < length fs" "i \<noteq> j" 
     and len: "length fs = m" 
     and indep: "lin_indep fs" 
     using inv j i by auto 
   let ?R = rat_of_int
   let ?RV = "map_vec ?R"   
   from inv i j
   have Fij: "fs ! i \<in> carrier_vec n" "fs ! j \<in> carrier_vec n" by auto
   let ?x = "fs ! i - c \<cdot>\<^sub>v fs ! j"  
   let ?g = "gso fs"
   let ?g' = "gso fs'"
   let ?mu = "\<mu> fs"
   let ?mu' = "\<mu> fs'"
   from inv j i 
   have Fi:"\<And> i. i < length (RAT fs) \<Longrightarrow> (RAT fs) ! i \<in> carrier_vec n"
     and gs_carr: "?g j \<in> carrier_vec n"
                 "?g i \<in> carrier_vec n"
                 "\<And> i. i < j \<Longrightarrow> ?g i \<in> carrier_vec n"
                 "\<And> j. j < i \<Longrightarrow> ?g j \<in> carrier_vec n" 
     and len': "length (RAT fs) = m"
     and add':"set (map ?RV fs) \<subseteq> carrier_vec n"
     by auto 
   have RAT_F1: "RAT fs' = (RAT fs)[i := (RAT fs) ! i - ?R c \<cdot>\<^sub>v (RAT fs) ! j]" 
     unfolding fs'
   proof (rule nth_equalityI[rule_format], goal_cases)
     case (2 k)
     show ?case 
     proof (cases "k = i")
       case False
       thus ?thesis using 2 by auto
     next
       case True
       hence "?thesis = (?RV (fs ! i - c \<cdot>\<^sub>v fs ! j) =
           ?RV (fs ! i) - ?R c \<cdot>\<^sub>v ?RV (fs ! j))" 
         using 2 add by auto
       also have "\<dots>" by (rule eq_vecI, insert Fij, auto)
       finally show ?thesis by simp
     qed
   qed auto
   hence RAT_F1_i:"RAT fs' ! i = (RAT fs) ! i - ?R c \<cdot>\<^sub>v (RAT fs) ! j" (is "_ = _ - ?mui")
     using i len by auto
   have uminus: "fs ! i - c \<cdot>\<^sub>v fs ! j = fs ! i + -c \<cdot>\<^sub>v fs ! j" 
     by (subst minus_add_uminus_vec, insert Fij, auto)
   have "lattice_of fs' = lattice_of fs" unfolding fs' uminus
     by (rule lattice_of_add[OF add, of _ "- c"], auto)
   with inv have lattice: "lattice_of fs' = L" by auto
   from add len
   have "k < length fs \<Longrightarrow> \<not> k \<noteq> i \<Longrightarrow> fs' ! k \<in> carrier_vec n" for k
     unfolding fs'
     by (metis (no_types, lifting) nth_list_update nth_mem subset_eq carrier_dim_vec index_minus_vec(2) 
         index_smult_vec(2))
   hence "k < length fs \<Longrightarrow> fs' ! k \<in> carrier_vec n" for k
     unfolding fs' using add len by (cases "k \<noteq> i",auto)
   with len have F1: "set fs' \<subseteq> carrier_vec n" "length fs' = m" unfolding fs' by (auto simp: set_conv_nth)
   hence F1': "length (RAT fs') = m" "SRAT fs' \<subseteq> Rn" by auto
   from indep have dist: "distinct (RAT fs)" by (auto simp: gs.lin_indpt_list_def)
   have Fij': "(RAT fs) ! i \<in> Rn" "(RAT fs) ! j \<in> Rn" using add'[unfolded set_conv_nth] i \<open>j < m\<close> len by auto
   have uminus': "(RAT fs) ! i - ?R c \<cdot>\<^sub>v (RAT fs) ! j = (RAT fs) ! i + - ?R c \<cdot>\<^sub>v (RAT fs) ! j" 
     by (subst minus_add_uminus_vec[where n = n], insert Fij', auto) 
   have span_F_F1: "gs.span (SRAT fs) = gs.span (SRAT fs')" unfolding RAT_F1 uminus' 
     by (rule gs.add_vec_span, insert len add, auto)
   have **: "?RV (fs ! i) + - ?R c \<cdot>\<^sub>v (RAT fs) ! j =  ?RV (fs ! i - c \<cdot>\<^sub>v fs ! j)"
     by (rule eq_vecI, insert Fij len i j, auto)
   from i j len have "j < length (RAT fs)" "i < length (RAT fs)" "i \<noteq> j" by auto
   from gs.lin_indpt_list_add_vec[OF this indep, of "- of_int c"]
   have "gs.lin_indpt_list ((RAT fs) [i := (RAT fs) ! i + - ?R c \<cdot>\<^sub>v (RAT fs) ! j])" (is "gs.lin_indpt_list ?F1") .
   also have "?F1 = RAT fs'" unfolding fs' using i len Fij' **
     by (auto simp: map_update)
   finally have indep_F1: "lin_indep fs'" .
   have conn1: "set (RAT fs) \<subseteq> carrier_vec n"  "length (RAT fs) = m" "distinct (RAT fs)"
     "gs.lin_indpt (set (RAT fs))"
     using inv unfolding gs.lin_indpt_list_def by auto
   have conn2: "set (RAT fs') \<subseteq> carrier_vec n"  "length (RAT fs') = m" "distinct (RAT fs')"
     "gs.lin_indpt (set (RAT fs'))"
     using indep_F1 F1' unfolding gs.lin_indpt_list_def by auto
   interpret gs1: gram_schmidt_fs_lin_indpt n "RAT fs"
     by (standard) (use inv gs.lin_indpt_list_def in auto)
   interpret gs2: gram_schmidt_fs_lin_indpt n "RAT fs'"
     by (standard) (use indep_F1 F1' gs.lin_indpt_list_def in auto)
   let ?G = "map ?g [0 ..< m]" 
   let ?G' = "map ?g' [0 ..< m]" 
   from gs1.span_gso gs2.span_gso gs1.gso_carrier gs2.gso_carrier conn1 conn2 span_F_F1 len 
   have span_G_G1: "gs.span (set ?G) = gs.span (set ?G')"
    and lenG: "length ?G = m" 
    and Gi: "i < length ?G \<Longrightarrow> ?G ! i \<in> Rn"
    and G1i: "i < length ?G' \<Longrightarrow> ?G' ! i \<in> Rn" for i
     by auto
   have eq: "x \<noteq> i \<Longrightarrow> RAT fs' ! x = (RAT fs) ! x" for x unfolding RAT_F1 by auto
   hence eq_part: "x < i \<Longrightarrow> ?g' x = ?g x" for x
     by (intro gs.gso_cong, insert len, auto)
   have G: "i < m \<Longrightarrow> (RAT fs) ! i \<in> Rn"
        "i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" for i by(insert add len', auto)
   note carr1[intro] = this[OF i] this[OF ji(2)]
   have "x < m \<Longrightarrow> ?g x \<in> Rn" 
        "x < m \<Longrightarrow> ?g' x \<in> Rn"
        "x < m \<Longrightarrow> dim_vec (gso fs x) = n"
        "x < m \<Longrightarrow> dim_vec (gso fs' x) = n"
        for x using inv G1i by (auto simp:o_def Gi G1i)
   hence carr2[intro!]:"?g i \<in> Rn" "?g' i \<in> Rn"
                  "?g ` {0..<i} \<subseteq> Rn"
                  "?g ` {0..<Suc i} \<subseteq> Rn" using i by auto
   have F1_RV: "?RV (fs' ! i) = RAT fs' ! i" using i F1 by auto
   have F_RV: "?RV (fs ! i) = (RAT fs) ! i" using i len by auto
   from eq_part 
   have span_G1_G: "gs.span (?g' ` {0..<i}) = gs.span (?g ` {0..<i})" (is "?ls = ?rs")
     apply(intro cong[OF refl[of "gs.span"]],rule image_cong[OF refl]) using eq by auto
   have "(RAT fs') ! i - ?g' i = ((RAT fs) ! i - ?g' i) - ?mui"
     unfolding RAT_F1_i using carr1 carr2
     by (intro eq_vecI, auto)
   hence in1:"((RAT fs) ! i - ?g' i) - ?mui \<in> ?rs"
     using gs2.oc_projection_exist[of i] conn2 i unfolding span_G1_G by auto
   from \<open>j < i\<close> have Gj_mem: "(RAT fs) ! j \<in> (\<lambda> x. ((RAT fs) ! x)) ` {0 ..< i}" by auto  
   have id1: "set (take i (RAT fs)) = (\<lambda>x. ?RV (fs ! x)) ` {0..<i}"
     using \<open>i < m\<close> len
     by (subst nth_image[symmetric], force+)
   have "(RAT fs) ! j \<in> ?rs \<longleftrightarrow> (RAT fs) ! j \<in> gs.span ((\<lambda>x. ?RV (fs ! x)) ` {0..<i})"
     using gs1.partial_span  \<open>i < m\<close> id1 inv by auto
   also have "(\<lambda>x. ?RV (fs ! x)) ` {0..<i} = (\<lambda>x. ((RAT fs) ! x)) ` {0..<i}" using \<open>i < m\<close> len by force
   also have "(RAT fs) ! j \<in> gs.span \<dots>"
     by (rule gs.span_mem[OF _ Gj_mem], insert \<open>i < m\<close> G, auto)
   finally have "(RAT fs) ! j \<in> ?rs" .
   hence in2:"?mui \<in> ?rs"
     apply(intro gs.prod_in_span) by force+
   have ineq:"((RAT fs) ! i - ?g' i) + ?mui - ?mui = ((RAT fs) ! i - ?g' i)"
     using carr1 carr2 by (intro eq_vecI, auto)
   have cong': "A = B \<Longrightarrow> A \<in> C \<Longrightarrow> B \<in> C" for A B :: "'a vec" and C by auto
   have *: "?g ` {0..<i} \<subseteq> Rn" by auto
   have in_span: "(RAT fs) ! i - ?g' i \<in> ?rs"
     by (rule cong'[OF eq_vecI gs.span_add1[OF * in1 in2,unfolded ineq]], insert carr1 carr2, auto)
   { 
     fix x assume x:"x < i" hence "x < m" "i \<noteq> x" using i by auto
     from gs2.orthogonal this inv assms
     have "?g' i \<bullet> ?g' x = 0" by auto
   }
   hence G1_G: "?g' i = ?g i"
     by (intro gs1.oc_projection_unique) (use inv i eq_part in_span in auto)
   show eq_fs:"x < m \<Longrightarrow> ?g' x = ?g x"
     for x proof(induct x rule:nat_less_induct[rule_format])
     case (1 x)
     hence ind: "m < x \<Longrightarrow> ?g' m = ?g m"
        for m by auto
     { assume "x > i"
       hence ?case unfolding gs2.gso.simps[of x] gs1.gso.simps[of x] unfolding gs1.\<mu>.simps gs2.\<mu>.simps
         using ind eq by (auto intro: cong[OF _ cong[OF refl[of "gs.sumlist"]]])
     } note eq_rest = this
     show ?case by (rule linorder_class.linorder_cases[of x i],insert G1_G eq_part eq_rest,auto)
   qed
   hence Hs:"?G' = ?G" by (auto simp:o_def)
   have red: "weakly_reduced fs i \<Longrightarrow> weakly_reduced fs' i" using eq_fs \<open>i < m\<close>
     unfolding gram_schmidt_fs.weakly_reduced_def by simp
   let ?Mi = "M ! i ! j"  
   have Gjn: "dim_vec (fs ! j) = n" using Fij(2) carrier_vecD by blast
   define E where "E = addrow_mat m (- ?R c) i j"
   define M' where "M' = gs1.M m"
   define N' where "N' = gs2.M m"
   have E: "E \<in> carrier_mat m m" unfolding E_def by simp
   have M: "M' \<in> carrier_mat m m" unfolding gs1.M_def M'_def by auto
   have N: "N' \<in> carrier_mat m m" unfolding gs2.M_def N'_def by auto
   let ?mat = "mat_of_rows n" 
   let ?GsM = "?mat ?G" 
   have Gs: "?GsM \<in> carrier_mat m n" by auto
   hence GsT: "?GsM\<^sup>T \<in> carrier_mat n m" by auto
   have Gnn: "?mat (RAT fs) \<in> carrier_mat m n" unfolding mat_of_rows_def using len by auto
   have "?mat (RAT fs') = addrow (- ?R c) i j (?mat (RAT fs))" 
     unfolding RAT_F1 by (rule eq_matI, insert Gjn ji(2), auto simp: len mat_of_rows_def)
   also have "\<dots> = E * ?mat (RAT fs)" unfolding E_def
     by (rule addrow_mat, insert j i, auto simp: mat_of_rows_def len)
   finally have HEG: "?mat (RAT fs') = E * ?mat (RAT fs)" . (* lemma 16.12(i), part 1 *)
   have "(E * M') * ?mat ?G = E * (M' * ?mat ?G)" 
     by (rule assoc_mult_mat[OF E M Gs])
   also have "M' * ?GsM = ?mat (RAT fs)" using gs1.matrix_equality conn1 M'_def by simp
   also have "E * \<dots> = ?mat (RAT fs')" unfolding HEG ..
   also have "\<dots> = N' * ?mat ?G'" using gs2.matrix_equality conn2 unfolding N'_def by simp
   also have "?mat ?G' = ?GsM" unfolding Hs ..
   finally have "(E * M') * ?GsM = N' * ?GsM" .
   from arg_cong[OF this, of "\<lambda> x. x * ?GsM\<^sup>T"] E M N 
   have EMN: "(E * M') * (?GsM * ?GsM\<^sup>T) = N' * (?GsM * ?GsM\<^sup>T)" 
     by (subst (1 2) assoc_mult_mat[OF _ Gs GsT, of _ m, symmetric], auto)
   have "det (?GsM * ?GsM\<^sup>T) = gs.Gramian_determinant ?G m" 
     unfolding gs.Gramian_determinant_def
     by (subst gs.Gramian_matrix_alt_def, auto simp: Let_def)
   also have "\<dots> > 0" 
   proof -
     have 1: "gs.lin_indpt_list ?G"
       using conn1 gs1.orthogonal_gso gs1.gso_carrier by (intro gs.orthogonal_imp_lin_indpt_list) (auto)
     interpret G: gram_schmidt_fs_lin_indpt n ?G
       by  (standard) (use 1 gs.lin_indpt_list_def in auto)
     show ?thesis
       by (intro G.Gramian_determinant) auto
   qed
   finally have "det (?GsM * ?GsM\<^sup>T) \<noteq> 0" by simp
   from vec_space.det_nonzero_congruence[OF EMN this _ _ N] Gs E M
   have EMN: "E * M' = N'" by auto (* lemma 16.12(i), part 2 *) 
   {
     fix i' j'
     assume ij: "i' < m" "j' < m" and choice: "i' \<noteq> i \<or> j < j'" 
     have "?mu' i' j' 
       = N' $$ (i',j')" using ij F1 unfolding N'_def gs2.M_def by auto
     also have "\<dots> = addrow (- ?R c) i j M' $$ (i',j')" unfolding EMN[symmetric] E_def
       by (subst addrow_mat[OF M], insert ji, auto)
     also have "\<dots> = (if i = i' then - ?R c * M' $$ (j, j') + M' $$ (i', j') else M' $$ (i', j'))" 
       by (rule index_mat_addrow, insert ij M, auto)
     also have "\<dots> = M' $$ (i', j')"
     proof (cases "i = i'")
       case True
       with choice have jj: "j < j'" by auto
       have "M' $$ (j, j') = ?mu j j'" 
         using ij ji len unfolding M'_def gs1.M_def by auto
       also have "\<dots> = 0" unfolding gs1.\<mu>.simps using jj by auto
       finally show ?thesis using True by auto
     qed auto
     also have "\<dots> = ?mu i' j'"
       using ij len unfolding M'_def gs1.M_def by auto
     also note calculation
   } note mu_no_change = this
   {
     fix j'
     assume jj': "j' \<le> j" with j i have j': "j' < m" by auto
     have "?mu' i j' 
       = N' $$ (i,j')" using jj' j i F1 unfolding N'_def gs2.M_def by auto
     also have "\<dots> = addrow (- ?R c) i j M' $$ (i,j')" unfolding EMN[symmetric] E_def
       by (subst addrow_mat[OF M], insert ji, auto)
     also have "\<dots> = - ?R c * M' $$ (j, j') + M' $$ (i, j')" 
       by (rule index_mat_addrow, insert j' i M, auto)
     also have "\<dots> = M' $$ (i, j') - ?R c * M' $$ (j, j')" by simp
     also have "M' $$ (i, j') = ?mu i j'"
       using i j' len unfolding M'_def gs1.M_def by auto
     also have "M' $$ (j, j') = ?mu j j'" 
       using i j j' len unfolding M'_def gs1.M_def by auto
     finally have "?mu' i j' = ?mu i j' - ?R c * ?mu j j'" by auto
   } note mu_change = this  
   show mu_update: "i' < m \<Longrightarrow> j' < m \<Longrightarrow> 
     ?mu' i' j' = (if i' = i \<and> j' \<le> j then ?mu i j' - ?R c * ?mu j j' else ?mu i' j')" 
     for i' j' using mu_change[of j'] mu_no_change[of i' j']
     by auto
   {
     assume "LLL_invariant True i fs"
     from LLL_invD[OF this] have "weakly_reduced fs i" and sred: "reduced fs i" by auto
     from red[OF this(1)] have red: "weakly_reduced fs' i" .
     have sred: "reduced fs' i"
       unfolding gram_schmidt_fs.reduced_def 
     proof (intro conjI[OF red] impI allI, goal_cases)
       case (1 i' j)
       with mu_no_change[of i' j] sred[unfolded gram_schmidt_fs.reduced_def, THEN conjunct2, rule_format, of i' j] i 
       show ?case by auto
     qed
     show "LLL_invariant True i fs'" 
       by (intro LLL_invI[OF F1 lattice \<open>i \<le> m\<close> indep_F1 sred], auto)
   } 
   show Linv': "LLL_invariant_weak fs'" 
     by (intro LLL_inv_wI[OF F1 lattice indep_F1])
 
   have mudiff:"?mu i j - of_int c = ?mu' i j"
     by (subst mu_change, auto simp: gs1.\<mu>.simps)
   have lin_indpt_list_fs: "gs.lin_indpt_list (RAT fs')"
     unfolding gs.lin_indpt_list_def using conn2 by auto
   { 
     assume c: "c = round (\<mu> fs i j)" 
     have small: "abs (?mu i j - of_int c) \<le> inverse 2" unfolding j c
       using of_int_round_abs_le by (auto simp add: abs_minus_commute)
     from this[unfolded mudiff] 
     show mu'_2: "abs (?mu' i j) \<le> 1 / 2" by simp
     assume mu_small: "\<mu>_small_row i fs (Suc j)" 
 
     show "\<mu>_small_row i fs' j" 
       unfolding \<mu>_small_row_def 
     proof (intro allI, goal_cases)
       case (1 j')
       show ?case using mu'_2 mu_small[unfolded \<mu>_small_row_def, rule_format, of j'] 
         by (cases "j' > j", insert mu_update[of i j'] i, auto)
     qed
   }
 
   {
     fix i
     assume i: "i \<le> m"
     have "rat_of_int (d fs' i) = of_int (d fs i)" 
       unfolding d_def Gramian_determinant(1)[OF Linv i] Gramian_determinant(1)[OF Linv' i]
       by (rule prod.cong[OF refl], subst eq_fs, insert i, auto)
     thus "d fs' i = d fs i" by simp
   } note d = this 
   have D: "D fs' = D fs" 
     unfolding D_def
     by (rule arg_cong[of _ _ nat], rule prod.cong[OF refl], auto simp: d)
   show "LLL_measure i fs' = LLL_measure i fs" 
     unfolding LLL_measure_def logD_def D ..
 qed
 
 text \<open>Addition step which can be skipped since $\mu$-value is already small\<close>
 
 lemma basis_reduction_add_row_main_0: assumes Linv: "LLL_invariant_weak fs"
   and i: "i < m"  and j: "j < i" 
   and 0: "round (\<mu> fs i j) = 0" 
   and mu_small: "\<mu>_small_row i fs (Suc j)"
 shows "\<mu>_small_row i fs j" (is ?g1)
 proof -
   note inv = LLL_inv_wD[OF Linv]
   from inv(5)[OF i] inv(5)[of j] i j
   have id: "fs[i := fs ! i - 0 \<cdot>\<^sub>v fs ! j] = fs" 
     by (intro nth_equalityI, insert inv i, auto)
   show ?g1
     using basis_reduction_add_row_main[OF Linv i j _, of fs] 0 id mu_small by auto
 qed
 
 lemma \<mu>_small_row_refl: "\<mu>_small_row i fs i" 
   unfolding \<mu>_small_row_def by auto
 
 lemma basis_reduction_add_row_done: assumes Linv: "LLL_invariant True i fs"
   and i: "i < m" 
   and mu_small: "\<mu>_small_row i fs 0" 
 shows "LLL_invariant False i fs"
 proof -
   note inv = LLL_invD[OF Linv]
   from mu_small 
   have mu_small: "\<mu>_small fs i" unfolding \<mu>_small_row_def \<mu>_small_def by auto
   show ?thesis
     using i mu_small by (intro LLL_invI[OF inv(3,6,7,9,1,10)], auto)
 qed     
 
 (* lemma 16.16 (ii), one case *)
 lemma d_swap_unchanged: assumes len: "length F1 = m" 
   and i0: "i \<noteq> 0" and i: "i < m" and ki: "k \<noteq> i" and km: "k \<le> m"   
   and swap: "F2 = F1[i := F1 ! (i - 1), i - 1 := F1 ! i]"
 shows "d F1 k = d F2 k"
 proof -
   let ?F1_M = "mat k n (\<lambda>(i, y). F1 ! i $ y)" 
   let ?F2_M = "mat k n (\<lambda>(i, y). F2 ! i $ y)" 
   have "\<exists> P. P \<in> carrier_mat k k \<and> det P \<in> {-1, 1} \<and> ?F2_M = P * ?F1_M" 
   proof cases
     assume ki: "k < i" 
     hence H: "?F2_M = ?F1_M" unfolding swap
       by (intro eq_matI, auto)
     let ?P = "1\<^sub>m k" 
     have "?P \<in> carrier_mat k k" "det ?P \<in> {-1, 1}" "?F2_M = ?P * ?F1_M" unfolding H by auto
     thus ?thesis by blast
   next
     assume "\<not> k < i" 
     with ki have ki: "k > i" by auto
     let ?P = "swaprows_mat k i (i - 1)" 
     from i0 ki have neq: "i \<noteq> i - 1" and kmi: "i - 1 < k" by auto
     have *: "?P \<in> carrier_mat k k" "det ?P \<in> {-1, 1}" using det_swaprows_mat[OF ki kmi neq] ki by auto
     from i len have iH: "i < length F1" "i - 1 < length F1" by auto 
     have "?P * ?F1_M = swaprows i (i - 1) ?F1_M" 
       by (subst swaprows_mat[OF _ ki kmi], auto)
     also have "\<dots> = ?F2_M" unfolding swap
       by (intro eq_matI, rename_tac ii jj, 
           case_tac "ii = i", (insert iH, simp add: nth_list_update)[1],
           case_tac "ii = i - 1", insert iH neq ki, auto simp: nth_list_update)
     finally show ?thesis using * by metis
   qed
   then obtain P where P: "P \<in> carrier_mat k k" and detP: "det P \<in> {-1, 1}" and H': "?F2_M = P * ?F1_M" by auto
   have "d F2 k = det (gs.Gramian_matrix F2 k)" 
     unfolding d_def gs.Gramian_determinant_def by simp
   also have "\<dots> = det (?F2_M * ?F2_M\<^sup>T)" unfolding gs.Gramian_matrix_def Let_def by simp
   also have "?F2_M * ?F2_M\<^sup>T = ?F2_M * (?F1_M\<^sup>T * P\<^sup>T)" unfolding H'
     by (subst transpose_mult[OF P], auto)
   also have "\<dots> = P * (?F1_M * (?F1_M\<^sup>T * P\<^sup>T))" unfolding H' 
     by (subst assoc_mult_mat[OF P], auto)
   also have "det \<dots> = det P * det (?F1_M * (?F1_M\<^sup>T * P\<^sup>T))" 
     by (rule det_mult[OF P], insert P, auto)
   also have "?F1_M * (?F1_M\<^sup>T * P\<^sup>T) = (?F1_M * ?F1_M\<^sup>T) * P\<^sup>T" 
     by (subst assoc_mult_mat, insert P, auto)
   also have "det \<dots> = det (?F1_M * ?F1_M\<^sup>T) * det P" 
     by (subst det_mult, insert P, auto simp: det_transpose)
   also have "det (?F1_M * ?F1_M\<^sup>T) = det (gs.Gramian_matrix F1 k)" unfolding gs.Gramian_matrix_def Let_def by simp
   also have "\<dots> = d F1 k" 
     unfolding d_def gs.Gramian_determinant_def by simp
   finally have "d F2 k = (det P * det P) * d F1 k" by simp
   also have "det P * det P = 1" using detP by auto
   finally show "d F1 k = d F2 k" by simp
 qed
 
 definition base where "base = real_of_rat ((4 * \<alpha>) / (4 + \<alpha>))" 
 
 definition g_bound :: "int vec list \<Rightarrow> bool" where 
   "g_bound fs = (\<forall> i < m. sq_norm (gso fs i) \<le> of_nat N)" 
 
 end
 
 locale LLL_with_assms = LLL + 
   assumes \<alpha>: "\<alpha> \<ge> 4/3"
     and lin_dep: "lin_indep fs_init" 
     and len: "length fs_init = m" 
 begin
 lemma \<alpha>0: "\<alpha> > 0" "\<alpha> \<noteq> 0" 
   using \<alpha> by auto
 
 lemma fs_init: "set fs_init \<subseteq> carrier_vec n" 
   using lin_dep[unfolded gs.lin_indpt_list_def] by auto
 
 
 lemma reduction: "0 < reduction" "reduction \<le> 1" 
   "\<alpha> > 4/3 \<Longrightarrow> reduction < 1" 
   "\<alpha> = 4/3 \<Longrightarrow> reduction = 1" 
   using \<alpha> unfolding reduction_def by auto
 
 lemma base: "\<alpha> > 4/3 \<Longrightarrow> base > 1" using reduction(1,3) unfolding reduction_def base_def by auto
 
 lemma basis_reduction_swap_main: assumes Linvw: "LLL_invariant_weak fs"
   and small: "LLL_invariant False i fs \<or> abs (\<mu> fs i (i - 1)) \<le> 1/2" 
   and i: "i < m"
   and i0: "i \<noteq> 0" 
   and norm_ineq: "sq_norm (gso fs (i - 1)) > \<alpha> * sq_norm (gso fs i)" 
   and fs'_def: "fs' = fs[i := fs ! (i - 1), i - 1 := fs ! i]" 
 shows "LLL_invariant_weak fs'" 
   and "LLL_invariant False i fs \<Longrightarrow> LLL_invariant False (i - 1) fs'" 
   and "LLL_measure i fs > LLL_measure (i - 1) fs'" 
   (* new values of gso *)
   and "\<And> k. k < m \<Longrightarrow> gso fs' k = (if k = i - 1 then
          gso fs i + \<mu> fs i (i - 1) \<cdot>\<^sub>v gso fs (i - 1) 
       else if k = i then
          gso fs (i - 1) - (RAT fs ! (i - 1) \<bullet> gso fs' (i - 1) / sq_norm (gso fs' (i - 1))) \<cdot>\<^sub>v gso fs' (i - 1)
       else gso fs k)" (is "\<And> k. _ \<Longrightarrow> _ = ?newg k")
   (* new values of norms of gso *)
   and "\<And> k. k < m \<Longrightarrow> sq_norm (gso fs' k) = (if k = i - 1 then
           sq_norm (gso fs i) + (\<mu> fs i (i - 1) * \<mu> fs i (i - 1)) * sq_norm (gso fs (i - 1))
       else if k = i then
          sq_norm (gso fs i) * sq_norm (gso fs (i - 1)) / sq_norm (gso fs' (i - 1))
       else sq_norm (gso fs k))" (is "\<And> k. _ \<Longrightarrow> _ = ?new_norm k")
   (* new values of \<mu>-values *)
   and "\<And> ii j. ii < m \<Longrightarrow> j < ii \<Longrightarrow> \<mu> fs' ii j = (
         if ii = i - 1 then 
            \<mu> fs i j
         else if ii = i then 
           if j = i - 1 then 
              \<mu> fs i (i - 1) * sq_norm (gso fs (i - 1)) / sq_norm (gso fs' (i - 1))
           else 
              \<mu> fs (i - 1) j
         else if ii > i \<and> j = i then
            \<mu> fs ii (i - 1) - \<mu> fs i (i - 1) * \<mu> fs ii i
         else if ii > i \<and> j = i - 1 then 
            \<mu> fs ii (i - 1) * \<mu> fs' i (i - 1) + \<mu> fs ii i * sq_norm (gso fs i) / sq_norm (gso fs' (i - 1))
         else \<mu> fs ii j)" (is "\<And> ii j. _ \<Longrightarrow> _ \<Longrightarrow> _ = ?new_mu ii j")
   (* new d-values *)
   and "\<And> ii. ii \<le> m \<Longrightarrow> of_int (d fs' ii) = (if ii = i then 
        sq_norm (gso fs' (i - 1)) / sq_norm (gso fs (i - 1)) * of_int (d fs i)
        else of_int (d fs ii))" 
 proof -
   note inv = LLL_inv_wD[OF Linvw]
   interpret fs: fs_int' n m fs_init fs
     by (standard) (use Linvw in auto)
   let ?mu1 = "\<mu> fs" 
   let ?mu2 = "\<mu> fs'" 
   let ?g1 = "gso fs" 
   let ?g2 = "gso fs'" 
   have m12: "\<bar>?mu1 i (i - 1)\<bar> \<le> inverse 2" using small
   proof 
     assume "LLL_invariant False i fs" 
     from LLL_invD(11)[OF this] i0 show ?thesis unfolding \<mu>_small_def by auto
   qed auto
   note d = d_def  
   note Gd = Gramian_determinant(1)
   note Gd12 = Gd[OF Linvw]
   let ?x = "?g1 (i - 1)" let ?y = "?g1 i" 
   let ?cond = "\<alpha> * sq_norm ?y < sq_norm ?x" 
   from inv have len: "length fs = m" and HC: "set fs \<subseteq> carrier_vec n" 
     and L: "lattice_of fs = L" 
     using i by auto 
   from i0 inv i have swap: "set fs \<subseteq> carrier_vec n" "i < length fs" "i - 1 < length fs" "i \<noteq> i - 1" 
     unfolding Let_def by auto
   have RAT_fs': "RAT fs' = (RAT fs)[i := (RAT fs) ! (i - 1), i - 1 := (RAT fs) ! i]" 
     unfolding fs'_def using swap by (intro nth_equalityI, auto simp: nth_list_update)
   have span': "gs.span (SRAT fs) = gs.span (SRAT fs')" unfolding fs'_def
     by (rule arg_cong[of _ _ gs.span], insert swap, auto)
   have lfs': "lattice_of fs' = lattice_of fs" unfolding fs'_def
     by (rule lattice_of_swap[OF swap refl])
   with inv have lattice: "lattice_of fs' = L" by auto
   have len': "length fs' = m" using inv unfolding fs'_def by auto
   have fs': "set fs' \<subseteq> carrier_vec n" using swap unfolding fs'_def set_conv_nth
     by (auto, rename_tac k, case_tac "k = i", force, case_tac "k = i - 1", auto)
   let ?rv = "map_vec rat_of_int" 
   from inv(1) have indepH: "lin_indep fs" .
   from i i0 len have "i < length (RAT fs)" "i - 1 < length (RAT fs)" by auto
   with distinct_swap[OF this] len have "distinct (RAT fs') = distinct (RAT fs)" unfolding RAT_fs'
     by (auto simp: map_update)
   with len' fs' span' indepH have indepH': "lin_indep fs'" unfolding fs'_def using i i0
     by (auto simp: gs.lin_indpt_list_def)
   have lenR': "length (RAT fs') = m" using len' by auto
   have conn1: "set (RAT fs) \<subseteq> carrier_vec n"  "length (RAT fs) = m" "distinct (RAT fs)"
     "gs.lin_indpt (set (RAT fs))"
     using inv unfolding gs.lin_indpt_list_def by auto
   have conn2: "set (RAT fs') \<subseteq> carrier_vec n"  "length (RAT fs') = m" "distinct (RAT fs')"
     "gs.lin_indpt (set (RAT fs'))"
     using indepH' lenR'  unfolding gs.lin_indpt_list_def by auto
   interpret gs2: gram_schmidt_fs_lin_indpt n "RAT fs'"
     by (standard) (use indepH' lenR' gs.lin_indpt_list_def in auto)
   have fs'_fs: "k < i - 1 \<Longrightarrow> fs' ! k = fs ! k" for k unfolding fs'_def by auto
   { 
     fix k
     assume ki: "k < i - 1" 
     with i have kn: "k < m" by simp
     have "?g2 k = ?g1 k" 
       by (rule gs.gso_cong, insert ki kn len, auto simp: fs'_def)
   } note G2_G = this
   have take_eq: "take (Suc i - 1 - 1) fs' = take (Suc i - 1 - 1) fs" 
     by (intro nth_equalityI, insert len len' i swap(2-), auto intro!: fs'_fs) 
   have i1n: "i - 1 < m" using i by auto
   let ?R = rat_of_int
   let ?RV = "map_vec ?R"  
   let ?f1 = "\<lambda> i. RAT fs ! i"
   let ?f2 = "\<lambda> i. RAT fs' ! i" 
   let ?n1 = "\<lambda> i. sq_norm (?g1 i)" 
   let ?n2 = "\<lambda> i. sq_norm (?g2 i)" 
   have heq:"fs ! (i - 1) = fs' ! i" "take (i-1) fs = take (i-1) fs'"
            "?f2 (i - 1) = ?f1 i" "?f2 i = ?f1 (i - 1)"
     unfolding fs'_def using i len i0 by auto
   have norm_pos2: "j < m \<Longrightarrow> ?n2 j > 0" for j 
     using gs2.sq_norm_pos len' by simp
   have norm_pos1: "j < m \<Longrightarrow> ?n1 j > 0" for j 
     using fs.gs.sq_norm_pos inv by simp
   have norm_zero2: "j < m \<Longrightarrow> ?n2 j \<noteq> 0" for j using norm_pos2[of j] by linarith
   have norm_zero1: "j < m \<Longrightarrow> ?n1 j \<noteq> 0" for j using norm_pos1[of j] by linarith
   have gs: "\<And> j. j < m \<Longrightarrow> ?g1 j \<in> Rn" using inv by blast
   have gs2: "\<And> j. j < m \<Longrightarrow> ?g2 j \<in> Rn" using fs.gs.gso_carrier conn2 by auto
   have g: "\<And> j. j < m \<Longrightarrow> ?f1 j \<in> Rn" using inv by auto
   have g2: "\<And> j. j < m \<Longrightarrow> ?f2 j \<in> Rn" using gs2.f_carrier conn2 by blast
   let ?fs1 = "?f1 ` {0..< (i - 1)}" 
   have G: "?fs1 \<subseteq> Rn" using g i by auto
   let ?gs1 = "?g1 ` {0..< (i - 1)}" 
   have G': "?gs1 \<subseteq> Rn" using gs i by auto
   let ?S = "gs.span ?fs1" 
   let ?S' = "gs.span ?gs1" 
   have S'S: "?S' = ?S" 
     by (rule fs.gs.partial_span', insert conn1 i, auto)
   have "gs.is_oc_projection (?g2 (i - 1)) (gs.span (?g2 ` {0..< (i - 1)})) (?f2 (i - 1))" 
     using i len' by (intro  gs2.gso_oc_projection_span(2)) auto
   also have "?f2 (i - 1) = ?f1 i" unfolding fs'_def using len i by auto
   also have "gs.span (?g2 ` {0 ..< (i - 1)}) = gs.span (?f2 ` {0 ..< (i - 1)})" 
     using i len' by (intro gs2.partial_span') auto
   also have "?f2 ` {0 ..< (i - 1)} = ?fs1" 
     by (rule image_cong[OF refl], insert len i, auto simp: fs'_def)
   finally have claim1: "gs.is_oc_projection (?g2 (i - 1)) ?S (?f1 i)" .
   have list_id: "[0..<Suc (i - 1)] = [0..< i - 1] @ [i - 1]" 
     "[0..< Suc i] = [0..< i] @ [i]" "map f [x] = [f x]" for f x using i by auto
   (* f1i_sum is claim 2 *)
   have f1i_sum: "?f1 i = gs.sumlist (map (\<lambda>j. ?mu1 i j \<cdot>\<^sub>v ?g1 j) [0 ..< i]) + ?g1 i" (is "_ = ?sum + _") 
     apply(subst fs.gs.fi_is_sum_of_mu_gso, insert len i, force)
     unfolding map_append list_id
     by (subst gs.M.sumlist_snoc, insert i gs conn1, auto simp: fs.gs.\<mu>.simps)
   have f1im1_sum: "?f1 (i - 1) = gs.sumlist (map (\<lambda>j. ?mu1 (i - 1) j \<cdot>\<^sub>v ?g1 j) [0..<i - 1]) + ?g1 (i - 1)" (is "_ = ?sum1 + _")
     apply(subst fs.gs.fi_is_sum_of_mu_gso, insert len i, force)
     unfolding map_append list_id
     by (subst gs.M.sumlist_snoc, insert i gs, auto simp: fs.gs.\<mu>.simps)
 
   have sum: "?sum \<in> Rn" by (rule gs.sumlist_carrier, insert gs i, auto)
   have sum1: "?sum1 \<in> Rn" by (rule gs.sumlist_carrier, insert gs i, auto)
   from gs.span_closed[OF G] have S: "?S \<subseteq> Rn" by auto
   from gs i have gs': "\<And> j. j < i - 1 \<Longrightarrow> ?g1 j \<in> Rn" and gsi: "?g1 (i - 1) \<in> Rn" by auto
   have "[0 ..< i] = [0 ..< Suc (i - 1)]" using i0 by simp
   also have "\<dots> = [0 ..< i - 1] @ [i - 1]" by simp
   finally have list: "[0 ..< i] = [0 ..< i - 1] @ [i - 1]" .
 
   { (* d does not change for k \<noteq> i *)
     fix k
     assume kn: "k \<le> m" and ki: "k \<noteq> i" 
     from d_swap_unchanged[OF len i0 i ki kn fs'_def]  
     have "d fs k = d fs' k" by simp
   } note d = this
 
   (* new value of g (i-1) *)
   have g2_im1: "?g2 (i - 1) = ?g1 i + ?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1)" (is "_ = _ + ?mu_f1")
   proof (rule gs.is_oc_projection_eq[OF  claim1 _ S g[OF i]])
     show "gs.is_oc_projection (?g1 i + ?mu_f1) ?S (?f1 i)" unfolding gs.is_oc_projection_def
     proof (intro conjI allI impI)
       let ?sum' = "gs.sumlist (map (\<lambda>j. ?mu1 i j \<cdot>\<^sub>v ?g1 j) [0 ..< i - 1])" 
       have sum': "?sum' \<in> Rn" by (rule gs.sumlist_carrier, insert gs i, auto)
       show inRn: "(?g1 i + ?mu_f1) \<in> Rn" using gs[OF i] gsi i by auto
       have carr: "?sum \<in> Rn" "?g1 i \<in> Rn" "?mu_f1 \<in> Rn" "?sum' \<in> Rn" using sum' sum gs[OF i] gsi i by auto
       have "?f1 i - (?g1 i + ?mu_f1) = (?sum + ?g1 i) - (?g1 i + ?mu_f1)"
         unfolding f1i_sum by simp
       also have "\<dots> = ?sum - ?mu_f1" using carr by auto
       also have "?sum = gs.sumlist (map (\<lambda>j. ?mu1 i j \<cdot>\<^sub>v ?g1 j) [0 ..< i - 1] @ [?mu_f1])" 
         unfolding list by simp 
       also have "\<dots> = ?sum' + ?mu_f1" 
         by (subst gs.sumlist_append, insert gs' gsi, auto)
       also have "\<dots> - ?mu_f1 = ?sum'" using sum' gsi by auto
       finally have id: "?f1 i - (?g1 i + ?mu_f1) = ?sum'" .
       show "?f1 i - (?g1 i + ?mu_f1) \<in> gs.span ?S" unfolding id gs.span_span[OF G]
       proof (rule gs.sumlist_in_span[OF G])
         fix v
         assume "v \<in> set (map (\<lambda>j. ?mu1 i j \<cdot>\<^sub>v ?g1 j) [0 ..< i - 1])" 
         then obtain j where j: "j < i - 1" and v: "v = ?mu1 i j \<cdot>\<^sub>v ?g1 j" by auto
         show "v \<in> ?S" unfolding v
           by (rule gs.smult_in_span[OF G], unfold S'S[symmetric], rule gs.span_mem, insert gs i j, auto)
       qed
       fix x
       assume "x \<in> ?S"
       hence x: "x \<in> ?S'" using S'S by simp
       show "(?g1 i + ?mu_f1) \<bullet> x = 0"
       proof (rule gs.orthocompl_span[OF _ G' inRn x])
         fix x
         assume "x \<in> ?gs1"
         then obtain j where j: "j < i - 1" and x_id: "x = ?g1 j" by auto
         from j i x_id gs[of j] have x: "x \<in> Rn" by auto
         {
           fix k
           assume k: "k > j" "k < m" 
           have "?g1 k \<bullet> x = 0" unfolding x_id 
             by (rule fs.gs.orthogonal, insert conn1 k, auto)
         }
         from this[of i] this[of "i - 1"] j i 
         have main: "?g1 i \<bullet> x = 0" "?g1 (i - 1) \<bullet> x = 0" by auto
         have "(?g1 i + ?mu_f1) \<bullet> x = ?g1 i \<bullet> x + ?mu_f1 \<bullet> x" 
           by (rule add_scalar_prod_distrib[OF gs[OF i] _ x], insert gsi, auto)
         also have "\<dots> = 0" using main
           by (subst smult_scalar_prod_distrib[OF gsi x], auto)
         finally show "(?g1 i + ?mu_f1) \<bullet> x = 0" .
       qed
     qed
   qed
   { (* 16.13 (i): for g, only g_i and g_{i-1} can change *)
     fix k
     assume kn: "k < m" 
       and ki: "k \<noteq> i" "k \<noteq> i - 1"
     have "?g2 k = gs.oc_projection (gs.span (?g2 ` {0..<k})) (?f2 k)" 
       by (rule gs2.gso_oc_projection_span, insert kn conn2, auto)
     also have "gs.span (?g2 ` {0..<k}) = gs.span (?f2 ` {0..<k})" 
       by (rule gs2.partial_span', insert conn2 kn, auto)
     also have "?f2 ` {0..<k} = ?f1 ` {0..<k}"
     proof(cases "k\<le>i")
       case True hence "k < i - 1" using ki by auto
       then show ?thesis apply(intro image_cong) unfolding fs'_def using len i by auto
     next
       case False 
       have "?f2 ` {0..<k} = Fun.swap i (i - 1) ?f1 ` {0..<k}"
         unfolding Fun.swap_def fs'_def o_def using len i 
         by (intro image_cong, insert len kn, force+)
       also have "\<dots> = ?f1 ` {0..<k}"
         apply(rule swap_image_eq) using False by auto
       finally show ?thesis.
     qed
     also have "gs.span \<dots> = gs.span (?g1 ` {0..<k})" 
       by (rule sym, rule fs.gs.partial_span', insert conn1 kn, auto)
     also have "?f2 k = ?f1 k" using ki kn len unfolding fs'_def by auto
     also have "gs.oc_projection (gs.span (?g1 ` {0..<k})) \<dots> = ?g1 k" 
       by (subst fs.gs.gso_oc_projection_span, insert kn conn1, auto)
     finally have "?g2 k = ?g1 k" . 
   } note g2_g1_identical = this
 
   (* calculation of new mu-values *)
   { (* no change of mu for lines before line i - 1 *)
     fix jj ii
     assume ii: "ii < i - 1"  
     have "?mu2 ii jj = ?mu1 ii jj" using ii i len
       by (subst gs.\<mu>_cong[of _ _ "RAT fs" "RAT fs'"], auto simp: fs'_def)
   } note mu'_mu_small_i = this
   { (* swap of mu-values in lines i - 1 and i for j < i - 1 *)
     fix jj
     assume jj: "jj < i - 1"  
     hence id1: "jj < i - 1 \<longleftrightarrow> True" "jj < i \<longleftrightarrow> True" by auto
     have id2: "?g2 jj = ?g1 jj" by (subst g2_g1_identical, insert jj i, auto)       
     have "?mu2 i jj = ?mu1 (i - 1) jj" "?mu2 (i - 1) jj = ?mu1 i jj" 
       unfolding gs2.\<mu>.simps fs.gs.\<mu>.simps id1 id2 if_True using len i i0 by (auto simp: fs'_def)
   } note mu'_mu_i_im1_j = this
 
   have im1: "i - 1 < m" using i by auto
 
   (* calculation of new value of g_i *)
   let ?g2_im1 = "?g2 (i - 1)" 
   have g2_im1_Rn: "?g2_im1 \<in> Rn" using i conn2 by (auto intro!: fs.gs.gso_carrier)
   {
     let ?mu2_f2 = "\<lambda> j. - ?mu2 i j \<cdot>\<^sub>v ?g2 j" 
     let ?sum = "gs.sumlist (map (\<lambda>j. - ?mu1 (i - 1) j \<cdot>\<^sub>v ?g1 j) [0 ..< i - 1])" 
     have mhs: "?mu2_f2 (i - 1) \<in> Rn" using i conn2 by (auto intro!: fs.gs.gso_carrier)
     have sum': "?sum \<in> Rn" by (rule gs.sumlist_carrier, insert gs i, auto)
     have gim1: "?f1 (i - 1) \<in> Rn" using g i by auto
     have "?g2 i = ?f2 i + gs.sumlist (map ?mu2_f2 [0 ..< i-1] @ [?mu2_f2 (i-1)])" 
       unfolding gs2.gso.simps[of i] list by simp
     also have "?f2 i = ?f1 (i - 1)" unfolding fs'_def using len i i0 by auto
     also have "map ?mu2_f2 [0 ..< i-1] = map (\<lambda>j. - ?mu1 (i - 1) j \<cdot>\<^sub>v ?g1 j) [0 ..< i - 1]"
       by (rule map_cong[OF refl], subst g2_g1_identical, insert i, auto simp: mu'_mu_i_im1_j)
     also have "gs.sumlist (\<dots> @ [?mu2_f2 (i - 1)]) = ?sum + ?mu2_f2 (i - 1)" 
       by (subst gs.sumlist_append, insert gs i mhs, auto)
     also have "?f1 (i - 1) + \<dots> = (?f1 (i - 1) + ?sum) + ?mu2_f2 (i - 1)"
       using gim1 sum' mhs by auto
     also have "?f1 (i - 1) + ?sum = ?g1 (i - 1)" unfolding fs.gs.gso.simps[of "i - 1"] by simp
     also have "?mu2_f2 (i - 1) = - (?f2 i \<bullet> ?g2_im1 / sq_norm ?g2_im1) \<cdot>\<^sub>v ?g2_im1" unfolding gs2.\<mu>.simps using i0 by simp
     also have "\<dots> = - ((?f2 i \<bullet> ?g2_im1 / sq_norm ?g2_im1) \<cdot>\<^sub>v ?g2_im1)" by auto
     also have "?g1 (i - 1) + \<dots> = ?g1 (i - 1) - ((?f2 i \<bullet> ?g2_im1 / sq_norm ?g2_im1) \<cdot>\<^sub>v ?g2_im1)"
       by (rule sym, rule minus_add_uminus_vec[of _ n], insert gsi g2_im1_Rn, auto)
     also have "?f2 i = ?f1 (i - 1)" by fact
     finally have "?g2 i = ?g1 (i - 1) - (?f1 (i - 1) \<bullet> ?g2 (i - 1) / sq_norm (?g2 (i - 1))) \<cdot>\<^sub>v ?g2 (i - 1)" .
   } note g2_i = this
 
   let ?n1 = "\<lambda> i. sq_norm (?g1 i)" 
   let ?n2 = "\<lambda> i. sq_norm (?g2 i)" 
 
   (* calculation of new norms *)
   { (* norm of g (i - 1) *)
     have "?n2 (i - 1) = sq_norm (?g1 i + ?mu_f1)" unfolding g2_im1 by simp
     also have "\<dots> = (?g1 i + ?mu_f1) \<bullet> (?g1 i + ?mu_f1)" 
       by (simp add: sq_norm_vec_as_cscalar_prod)
     also have "\<dots> = (?g1 i + ?mu_f1) \<bullet> ?g1 i + (?g1 i + ?mu_f1) \<bullet> ?mu_f1" 
       by (rule scalar_prod_add_distrib, insert gs i, auto)
     also have "(?g1 i + ?mu_f1) \<bullet> ?g1 i = ?g1 i \<bullet> ?g1 i + ?mu_f1 \<bullet> ?g1 i" 
       by (rule add_scalar_prod_distrib, insert gs i, auto)
     also have "(?g1 i + ?mu_f1) \<bullet> ?mu_f1 = ?g1 i \<bullet> ?mu_f1 + ?mu_f1 \<bullet> ?mu_f1" 
       by (rule add_scalar_prod_distrib, insert gs i, auto)
     also have "?mu_f1 \<bullet> ?g1 i = ?g1 i \<bullet> ?mu_f1"
       by (rule comm_scalar_prod, insert gs i, auto)
     also have "?g1 i \<bullet> ?g1 i = sq_norm (?g1 i)" 
       by (simp add: sq_norm_vec_as_cscalar_prod)
     also have "?g1 i \<bullet> ?mu_f1 = ?mu1 i (i - 1) * (?g1 i \<bullet> ?g1 (i - 1))" 
       by (rule scalar_prod_smult_right, insert gs[OF i] gs[OF \<open>i - 1 < m\<close>], auto)
     also have "?g1 i \<bullet> ?g1 (i - 1) = 0" 
       using orthogonalD[OF fs.gs.orthogonal_gso, of i "i - 1"] i len i0  
       by (auto simp: o_def)
     also have "?mu_f1 \<bullet> ?mu_f1 = ?mu1 i (i - 1) * (?mu_f1 \<bullet> ?g1 (i - 1))" 
       by (rule scalar_prod_smult_right, insert gs[OF i] gs[OF \<open>i - 1 < m\<close>], auto)
     also have "?mu_f1 \<bullet> ?g1 (i - 1) = ?mu1 i (i - 1) * (?g1 (i - 1) \<bullet> ?g1 (i - 1))" 
       by (rule scalar_prod_smult_left, insert gs[OF i] gs[OF \<open>i - 1 < m\<close>], auto)
     also have "?g1 (i - 1) \<bullet> ?g1 (i - 1) = sq_norm (?g1 (i - 1))" 
       by (simp add: sq_norm_vec_as_cscalar_prod)
     finally have "?n2 (i - 1) = ?n1 i + (?mu1 i (i - 1) * ?mu1 i (i - 1)) * ?n1 (i - 1)" 
       by (simp add: ac_simps o_def)
   } note sq_norm_g2_im1 = this
 
   from norm_pos1[OF i] norm_pos1[OF im1] norm_pos2[OF i] norm_pos2[OF im1]
   have norm0: "?n1 i \<noteq> 0" "?n1 (i - 1) \<noteq> 0" "?n2 i \<noteq> 0" "?n2 (i - 1) \<noteq> 0" by auto
   hence norm0': "?n2 (i - 1) \<noteq> 0" using i by auto
 
   { (* new norm of g i *)
     have si: "Suc i \<le> m" and im1: "i - 1 \<le> m" using i by auto
     have det1: "gs.Gramian_determinant (RAT fs) (Suc i) = (\<Prod>j<Suc i. \<parallel>fs.gs.gso j\<parallel>\<^sup>2)"
       using fs.gs.Gramian_determinant si len by auto
     have det2: "gs.Gramian_determinant (RAT fs') (Suc i) = (\<Prod>j<Suc i. \<parallel>gs2.gso j\<parallel>\<^sup>2)"
       using gs2.Gramian_determinant si len' by auto
     from norm_zero1[OF less_le_trans[OF _ im1]] have 0: "(\<Prod>j < i-1. ?n1 j) \<noteq> 0" 
       by (subst prod_zero_iff, auto)
     have "rat_of_int (d fs' (Suc i)) = rat_of_int (d fs (Suc i))" 
       using d_swap_unchanged[OF len i0 i _ si fs'_def] by auto
     also have "rat_of_int (d fs' (Suc i)) = gs.Gramian_determinant (RAT fs') (Suc i)" unfolding d_def 
       by (subst fs.of_int_Gramian_determinant[symmetric], insert conn2 i g fs', auto simp: set_conv_nth)
     also have "\<dots> = (\<Prod>j<Suc i. ?n2 j)" unfolding det2 by (rule prod.cong, insert i, auto)
     also have "rat_of_int (d fs (Suc i)) = gs.Gramian_determinant (RAT fs) (Suc i)" unfolding d_def 
       by (subst fs.of_int_Gramian_determinant[symmetric], insert conn1 i g, auto)
     also have "\<dots> = (\<Prod>j<Suc i. ?n1 j)" unfolding det1 by (rule prod.cong, insert i, auto)
     also have "{..<Suc i} = insert i (insert (i-1) {..<i-1})" (is "_ = ?set") by auto
     also have "(\<Prod>j\<in> ?set. ?n2 j) = ?n2 i * ?n2 (i - 1) * (\<Prod>j < i-1. ?n2 j)" using i0
       by (subst prod.insert; (subst prod.insert)?; auto)
     also have "(\<Prod>j\<in> ?set. ?n1 j) = ?n1 i * ?n1 (i - 1) * (\<Prod>j < i-1. ?n1 j)" using i0
       by (subst prod.insert; (subst prod.insert)?; auto)
     also have "(\<Prod>j < i-1. ?n2 j) = (\<Prod>j < i-1. ?n1 j)" 
       by (rule prod.cong, insert G2_G, auto)
     finally have "?n2 i = ?n1 i * ?n1 (i - 1) / ?n2 (i - 1)" 
       using 0 norm0' by (auto simp: field_simps)
   } note sq_norm_g2_i = this
 
   (* mu values in rows > i do not change with j \<notin> {i, i - 1} *)
   {
     fix ii j
     assume ii: "ii > i" "ii < m" 
      and ji: "j \<noteq> i" "j \<noteq> i - 1" 
     {
       assume j: "j < ii" 
       have "?mu2 ii j = (?f2 ii \<bullet> ?g2 j) / sq_norm (?g2 j)" 
         unfolding gs2.\<mu>.simps using j by auto
       also have "?f2 ii = ?f1 ii" using ii len unfolding fs'_def by auto
       also have "?g2 j = ?g1 j" using g2_g1_identical[of j] j ii ji by auto
       finally have "?mu2 ii j = ?mu1 ii j" 
         unfolding fs.gs.\<mu>.simps using j by auto
     }
     hence "?mu2 ii j = ?mu1 ii j" by (cases "j < ii", auto simp: gs2.\<mu>.simps fs.gs.\<mu>.simps)
   } note mu_no_change_large_row = this
 
   { (* the new value of mu i (i - 1) *)
     have "?mu2 i (i - 1) = (?f2 i \<bullet> ?g2 (i - 1)) / ?n2 (i - 1)" 
       unfolding gs2.\<mu>.simps using i0 by auto
     also have "?f2 i \<bullet> ?g2 (i - 1) = ?f1 (i - 1) \<bullet> ?g2 (i - 1)" 
       using len i i0 unfolding fs'_def by auto
     also have "\<dots> = ?f1 (i - 1) \<bullet> (?g1 i + ?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1))" 
       unfolding g2_im1 by simp
     also have "\<dots> = ?f1 (i - 1) \<bullet> ?g1 i + ?f1 (i - 1) \<bullet> (?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1))" 
       by (rule scalar_prod_add_distrib[of _ n], insert i gs g, auto)
     also have "?f1 (i - 1) \<bullet> ?g1 i = 0" 
       by (subst fs.gs.fi_scalar_prod_gso, insert conn1 im1 i i0, auto simp: fs.gs.\<mu>.simps fs.gs.\<mu>.simps)
     also have "?f1 (i - 1) \<bullet> (?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1)) = 
        ?mu1 i (i - 1) * (?f1 (i - 1) \<bullet> ?g1 (i - 1))"  
       by (rule scalar_prod_smult_distrib, insert gs g i, auto)
     also have "?f1 (i - 1) \<bullet> ?g1 (i - 1) = ?n1 (i - 1)" 
       by (subst fs.gs.fi_scalar_prod_gso, insert conn1 im1, auto simp: fs.gs.\<mu>.simps)
     finally 
     have "?mu2 i (i - 1) = ?mu1 i (i - 1) * ?n1 (i - 1) / ?n2 (i - 1)" 
       by (simp add: sq_norm_vec_as_cscalar_prod)
   } note mu'_mu_i_im1 = this
 
   { (* the new values of mu ii (i - 1) for ii > i *)
     fix ii assume iii: "ii > i" and ii: "ii < m" 
     hence iii1: "i - 1 < ii" by auto
     have "?mu2 ii (i - 1) = (?f2 ii \<bullet> ?g2 (i - 1)) / ?n2 (i - 1)" 
       unfolding gs2.\<mu>.simps using i0 iii1 by auto
     also have "?f2 ii \<bullet> ?g2 (i-1) = ?f1 ii \<bullet> ?g2 (i - 1)" 
       using len i i0 iii ii unfolding fs'_def by auto
     also have "\<dots> = ?f1 ii \<bullet> (?g1 i + ?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1))" 
       unfolding g2_im1 by simp
     also have "\<dots> = ?f1 ii \<bullet> ?g1 i + ?f1 ii \<bullet> (?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1))" 
       by (rule scalar_prod_add_distrib[of _ n], insert i ii gs g, auto)
     also have "?f1 ii \<bullet> ?g1 i = ?mu1 ii i * ?n1 i" 
       by (rule fs.gs.fi_scalar_prod_gso, insert conn1 ii i, auto)
     also have "?f1 ii \<bullet> (?mu1 i (i - 1) \<cdot>\<^sub>v ?g1 (i - 1)) = 
        ?mu1 i (i - 1) * (?f1 ii \<bullet> ?g1 (i - 1))"  
       by (rule scalar_prod_smult_distrib, insert gs g i ii, auto)
     also have "?f1 ii \<bullet> ?g1 (i - 1) = ?mu1 ii (i - 1) * ?n1 (i - 1)" 
       by (rule fs.gs.fi_scalar_prod_gso, insert conn1 ii im1, auto)
     finally have "?mu2 ii (i - 1) = ?mu1 ii (i - 1) * ?mu2 i (i - 1) + ?mu1 ii i * ?n1 i / ?n2 (i - 1)" 
       unfolding mu'_mu_i_im1 using norm0 by (auto simp: field_simps)
   } note mu'_mu_large_row_im1 = this    
 
   { (* the new values of mu ii i for ii > i *)
     fix ii assume iii: "ii > i" and ii: "ii < m" 
     have "?mu2 ii i = (?f2 ii \<bullet> ?g2 i) / ?n2 i" 
       unfolding gs2.\<mu>.simps using i0 iii by auto
     also have "?f2 ii \<bullet> ?g2 i = ?f1 ii \<bullet> ?g2 i" 
       using len i i0 iii ii unfolding fs'_def by auto
     also have "\<dots> = ?f1 ii \<bullet> (?g1 (i - 1) - (?f1 (i - 1) \<bullet> ?g2 (i - 1) / ?n2 (i - 1)) \<cdot>\<^sub>v ?g2 (i - 1))" 
       unfolding g2_i by simp
     also have "?f1 (i - 1) = ?f2 i" using i i0 len unfolding fs'_def by auto
     also have "?f2 i \<bullet> ?g2 (i - 1) / ?n2 (i - 1) = ?mu2 i (i - 1)" 
       unfolding gs2.\<mu>.simps using i i0 by auto
     also have "?f1 ii \<bullet> (?g1 (i - 1) - ?mu2 i (i - 1) \<cdot>\<^sub>v ?g2 (i - 1))
        = ?f1 ii \<bullet> ?g1 (i - 1) - ?f1 ii \<bullet> (?mu2 i (i - 1) \<cdot>\<^sub>v ?g2 (i - 1))" 
       by (rule scalar_prod_minus_distrib[OF g gs], insert gs2 ii i, auto)
     also have "?f1 ii \<bullet> ?g1 (i - 1) = ?mu1 ii (i - 1) * ?n1 (i - 1)" 
       by (rule fs.gs.fi_scalar_prod_gso, insert conn1 ii im1, auto)
     also have "?f1 ii \<bullet> (?mu2 i (i - 1) \<cdot>\<^sub>v ?g2 (i - 1)) = 
        ?mu2 i (i - 1) * (?f1 ii \<bullet> ?g2 (i - 1))" 
       by (rule scalar_prod_smult_distrib, insert gs gs2 g i ii, auto)
     also have "?f1 ii \<bullet> ?g2 (i - 1) = (?f1 ii \<bullet> ?g2 (i - 1) / ?n2 (i - 1)) * ?n2 (i - 1)" 
       using norm0 by (auto simp: field_simps)
     also have "?f1 ii \<bullet> ?g2 (i - 1) = ?f2 ii \<bullet> ?g2 (i - 1)" 
       using len ii iii unfolding fs'_def by auto
     also have "\<dots> / ?n2 (i - 1) = ?mu2 ii (i - 1)" unfolding gs2.\<mu>.simps using iii by auto
     finally 
     have "?mu2 ii i = 
        (?mu1 ii (i - 1) * ?n1 (i - 1) - ?mu2 i (i - 1) * ?mu2 ii (i - 1) * ?n2 (i - 1)) / ?n2 i" by simp
     also have "\<dots> = (?mu1 ii (i - 1) - ?mu1 i (i - 1) * ?mu2 ii (i - 1)) * ?n2 (i - 1) / ?n1 i" 
       unfolding sq_norm_g2_i mu'_mu_i_im1 using norm0 by (auto simp: field_simps)
     also have "\<dots> = (?mu1 ii (i - 1) * ?n2 (i - 1) - 
       ?mu1 i (i - 1) * ((?mu1 ii i * ?n1 i + ?mu1 i (i - 1) * ?mu1 ii (i - 1) * ?n1 (i - 1)))) / ?n1 i" 
       unfolding mu'_mu_large_row_im1[OF iii ii] mu'_mu_i_im1 using norm0 by (auto simp: field_simps)
     also have "\<dots> = ?mu1 ii (i - 1) - ?mu1 i (i - 1) * ?mu1 ii i" 
       unfolding sq_norm_g2_im1 using norm0 by (auto simp: field_simps)
     finally have "?mu2 ii i = ?mu1 ii (i - 1) - ?mu1 i (i - 1) * ?mu1 ii i" .
   } note mu'_mu_large_row_i = this
 
 
   {
     fix k assume k: "k < m" 
     show "?g2 k = ?newg k" 
       unfolding g2_i[symmetric] 
       unfolding g2_im1[symmetric]
       using g2_g1_identical[OF k] by auto
     show "?n2 k = ?new_norm k" 
       unfolding sq_norm_g2_i[symmetric]
       unfolding sq_norm_g2_im1[symmetric]
       using g2_g1_identical[OF k] by auto
     fix j assume jk: "j < k" hence j: "j < m" using k by auto
     have "k < i - 1 \<or> k = i - 1 \<or> k = i \<or> k > i" by linarith
     thus "?mu2 k j = ?new_mu k j" 
       unfolding mu'_mu_i_im1[symmetric]
       using
         mu'_mu_large_row_i[OF _ k]
         mu'_mu_large_row_im1 [OF _ k]
         mu_no_change_large_row[OF _ k, of j]
         mu'_mu_small_i
         mu'_mu_i_im1_j jk j k
       by auto
   } note new_g = this
 
   { (* 16.13 (ii) : norm of g (i - 1) decreases by reduction factor *)
     note sq_norm_g2_im1
     also have "?n1 i + (?mu1 i (i - 1) * ?mu1 i (i - 1)) * ?n1 (i - 1)
       < 1/\<alpha> * (?n1 (i - 1)) + (1/2 * 1/2) * (?n1 (i - 1))"
     proof (rule add_less_le_mono[OF _ mult_mono])
       from norm_ineq[unfolded mult.commute[of \<alpha>],
           THEN linordered_field_class.mult_imp_less_div_pos[OF \<alpha>0(1)]]
       show "?n1 i < 1/\<alpha> * ?n1 (i - 1)" using len i by auto
       from m12 have abs: "abs (?mu1 i (i - 1)) \<le> 1/2" by auto
       have "?mu1 i (i - 1) * ?mu1 i (i - 1) \<le> abs (?mu1 i (i - 1)) * abs (?mu1 i (i - 1))" by auto
       also have "\<dots> \<le> 1/2 * 1/2" using mult_mono[OF abs abs] by auto
       finally show "?mu1 i (i - 1) * ?mu1 i (i - 1) \<le> 1/2 * 1/2" by auto
     qed auto
     also have "\<dots> = reduction * sq_norm (?g1 (i - 1))" unfolding reduction_def  
       using \<alpha>0 by (simp add: ring_distribs add_divide_distrib)
     finally have "?n2 (i - 1) < reduction * ?n1 (i - 1)" .
   } note g_reduction = this (* Lemma 16.13 (ii) *)
 
   have lin_indpt_list_fs': "gs.lin_indpt_list (RAT fs')"
     unfolding gs.lin_indpt_list_def using conn2 by auto
 
   {
   (* stay reduced *)
     assume "LLL_invariant False i fs" 
     note inv = LLL_invD[OF this] 
     from inv have "weakly_reduced fs i" by auto
     hence "weakly_reduced fs (i - 1)" unfolding gram_schmidt_fs.weakly_reduced_def by auto
     hence red: "weakly_reduced fs' (i - 1)"
       unfolding gram_schmidt_fs.weakly_reduced_def using i G2_G by simp
     from inv have sred: "reduced fs i" by auto
     have sred: "reduced fs' (i - 1)"
       unfolding gram_schmidt_fs.reduced_def
     proof (intro conjI[OF red] allI impI, goal_cases)
       case (1 i' j)
       with sred have "\<bar>?mu1 i' j\<bar> \<le> 1 / 2" unfolding gram_schmidt_fs.reduced_def by auto
       thus ?case using mu'_mu_small_i[OF 1(1)] by simp
     qed
     have mu_small: "\<mu>_small fs' (i - 1)" 
       unfolding \<mu>_small_def
     proof (intro allI impI, goal_cases)
       case (1 j)
       thus ?case using inv(11) unfolding mu'_mu_i_im1_j[OF 1] \<mu>_small_def by auto
     qed      
     show "LLL_invariant False (i - 1) fs'"
       by (rule LLL_invI, insert lin_indpt_list_fs' conn2 mu_small span' lattice fs' sred i, auto)
   } 
 
       
   (* invariant is established *)
   show newInvw: "LLL_invariant_weak fs'"
     by (rule LLL_inv_wI, insert lin_indpt_list_fs' conn2 span' lattice fs', auto)
 
   (* show decrease in measure *)
   { (* 16.16 (ii), the decreasing case *)
     have ile: "i \<le> m" using i by auto
     from Gd[OF newInvw, folded d_def, OF ile] 
     have "?R (d fs' i) = (\<Prod>j<i. ?n2 j )" by auto
     also have "\<dots> = prod ?n2 ({0 ..< i-1} \<union> {i - 1})" 
       by (rule sym, rule prod.cong, (insert i0, auto)[1], insert i, auto)
     also have "\<dots> = ?n2 (i - 1) * prod ?n2 ({0 ..< i-1})" 
       by simp
     also have "prod ?n2 ({0 ..< i-1}) = prod ?n1 ({0 ..< i-1})" 
       by (rule prod.cong[OF refl], subst g2_g1_identical, insert i, auto)
     also have "\<dots> = (prod ?n1 ({0 ..< i-1} \<union> {i - 1})) / ?n1 (i - 1)" 
       by (subst prod.union_disjoint, insert norm_pos1[OF im1], auto)
     also have "prod ?n1 ({0 ..< i-1} \<union> {i - 1}) = prod ?n1 {0..<i}"
       by (rule arg_cong[of _ _ "prod ?n1"], insert i0, auto)
     also have "\<dots> = (\<Prod>j<i. ?n1 j)"
       by (rule prod.cong, insert i0, auto)
     also have "\<dots> = ?R (d fs i)" unfolding d_def Gd[OF Linvw ile]
       by (rule prod.cong[OF refl], insert i, auto)
     finally have new_di: "?R (d fs' i) = ?n2 (i - 1) / ?n1 (i - 1) * ?R (d fs i)" by simp
     also have "\<dots> < (reduction * ?n1 (i - 1)) / ?n1 (i - 1) * ?R (d fs i)"
       by (rule mult_strict_right_mono[OF divide_strict_right_mono[OF g_reduction norm_pos1[OF im1]]],
         insert LLL_d_pos[OF Linvw] i, auto)  
     also have "\<dots> = reduction * ?R (d fs i)" using norm_pos1[OF im1] by auto
     finally have "d fs' i < real_of_rat reduction * d fs i" 
       using of_rat_less of_rat_mult of_rat_of_int_eq by metis
     note this new_di
   } note d_i = this
   show "ii \<le> m \<Longrightarrow> ?R (d fs' ii) = (if ii = i then ?n2 (i - 1) / ?n1 (i - 1) * ?R (d fs i) else ?R (d fs ii))" 
     for ii using d_i d by auto
   have pos: "k < m \<Longrightarrow> 0 < d fs' k" "k < m \<Longrightarrow> 0 \<le> d fs' k" for k 
     using LLL_d_pos[OF newInvw, of k] by auto
   have prodpos:"0< (\<Prod>i<m. d fs' i)" apply (rule prod_pos)
     using LLL_d_pos[OF newInvw] by auto
   have prod_pos':"0 < (\<Prod>x\<in>{0..<m} - {i}. real_of_int (d fs' x))" apply (rule prod_pos)
     using LLL_d_pos[OF newInvw] pos by auto
   have prod_nonneg:"0 \<le> (\<Prod>x\<in>{0..<m} - {i}. real_of_int (d fs' x))" apply (rule prod_nonneg)
     using LLL_d_pos[OF newInvw] pos by auto
   have prodpos2:"0<(\<Prod>ia<m. d fs ia)" apply (rule prod_pos)
     using LLL_d_pos[OF Linvw] by auto
   have "D fs' = real_of_int (\<Prod>i<m. d fs' i)" unfolding D_def using prodpos by simp
   also have "(\<Prod>i<m. d fs' i) = (\<Prod> j \<in> {0 ..< m} - {i} \<union> {i}. d fs' j)"
     by (rule prod.cong, insert i, auto)
   also have "real_of_int \<dots> = real_of_int (\<Prod> j \<in> {0 ..< m} - {i}. d fs' j) * real_of_int (d fs' i)" 
     by (subst prod.union_disjoint, auto)
   also have "\<dots> < (\<Prod> j \<in> {0 ..< m} - {i}. d fs' j) * (of_rat reduction * d fs i)"
     by(rule mult_strict_left_mono[OF d_i(1)],insert prod_pos',auto)
   also have "(\<Prod> j \<in> {0 ..< m} - {i}. d fs' j) = (\<Prod> j \<in> {0 ..< m} - {i}. d fs j)"
     by (rule prod.cong, insert d, auto)
   also have "\<dots> * (of_rat reduction * d fs i) 
     = of_rat reduction * (\<Prod> j \<in> {0 ..< m} - {i} \<union> {i}. d fs j)" 
     by (subst prod.union_disjoint, auto)
   also have "(\<Prod> j \<in> {0 ..< m} - {i} \<union> {i}. d fs j) = (\<Prod> j<m. d fs j)" 
     by (subst prod.cong, insert i, auto)
   finally have D: "D fs' < real_of_rat reduction * D fs"
     unfolding D_def using prodpos2 by auto
   have logD: "logD fs' < logD fs" 
   proof (cases "\<alpha> = 4/3")
     case True
     show ?thesis using D unfolding reduction(4)[OF True] logD_def unfolding True by simp
   next
     case False
     hence False': "\<alpha> = 4/3 \<longleftrightarrow> False" by simp
     from False \<alpha> have "\<alpha> > 4/3" by simp
     with reduction have reduction1: "reduction < 1" by simp
     let ?new = "real (D fs')" 
     let ?old = "real (D fs)" 
     let ?log = "log (1/of_rat reduction)" 
     note pos = LLL_D_pos[OF newInvw] LLL_D_pos[OF Linvw]
     from reduction have "real_of_rat reduction > 0" by auto
     hence gediv:"1/real_of_rat reduction > 0" by auto
     have "(1/of_rat reduction) * ?new \<le> ((1/of_rat reduction) * of_rat reduction) * ?old"
-      unfolding mult.assoc real_mult_le_cancel_iff2[OF gediv] using D by simp
+      unfolding mult.assoc mult_le_cancel_iff2[OF gediv] using D by simp
     also have "(1/of_rat reduction) * of_rat reduction = 1" using reduction by auto
     finally have "(1/of_rat reduction) * ?new \<le> ?old" by auto
     hence "?log ((1/of_rat reduction) * ?new) \<le> ?log ?old"
       by (subst log_le_cancel_iff, auto simp: pos reduction1 reduction)
     hence "floor (?log ((1/of_rat reduction) * ?new)) \<le> floor (?log ?old)" 
       by (rule floor_mono)
     hence "nat (floor (?log ((1/of_rat reduction) * ?new))) \<le> nat (floor (?log ?old))" by simp
     also have "\<dots> = logD fs" unfolding logD_def False' by simp
     also have "?log ((1/of_rat reduction) * ?new) = 1 + ?log ?new" 
       by (subst log_mult, insert reduction reduction1, auto simp: pos )
     also have "floor (1 + ?log ?new) = 1 + floor (?log ?new)" by simp
     also have "nat (1 + floor (?log ?new)) = 1 + nat (floor (?log ?new))" 
       by (subst nat_add_distrib, insert pos reduction reduction1, auto)
     also have "nat (floor (?log ?new)) = logD fs'" unfolding logD_def False' by simp
     finally show "logD fs' < logD fs" by simp
   qed
   show "LLL_measure i fs > LLL_measure (i - 1) fs'" unfolding LLL_measure_def 
     using i logD by simp
 qed
 
 lemma LLL_inv_initial_state: "LLL_invariant True 0 fs_init" 
 proof - 
   from lin_dep[unfolded gs.lin_indpt_list_def]
   have "set (RAT fs_init) \<subseteq> Rn" by auto
   hence fs_init: "set fs_init \<subseteq> carrier_vec n" by auto
   show ?thesis 
     by (rule LLL_invI[OF fs_init len _ _ lin_dep], auto simp: L_def gs.reduced_def gs.weakly_reduced_def)
 qed
 
 lemma LLL_inv_m_imp_reduced: assumes "LLL_invariant True m fs" 
   shows "reduced fs m" 
   using LLL_invD[OF assms] by blast
 
 lemma basis_reduction_short_vector: assumes LLL_inv: "LLL_invariant True m fs" 
   and v: "v = hd fs" 
   and m0: "m \<noteq> 0"
 shows "v \<in> carrier_vec n"
   "v \<in> L - {0\<^sub>v n}"  
   "h \<in> L - {0\<^sub>v n} \<Longrightarrow> rat_of_int (sq_norm v) \<le> \<alpha> ^ (m - 1) * rat_of_int (sq_norm h)" 
   "v \<noteq> 0\<^sub>v j" 
 proof -
   let ?L = "lattice_of fs_init" 
   have a1: "\<alpha> \<ge> 1" using \<alpha> by auto 
   from LLL_invD[OF LLL_inv] have
     L: "lattice_of fs = L" 
     and red: "gram_schmidt_fs.weakly_reduced n (RAT fs) \<alpha> (length (RAT fs))" 
     and basis: "lin_indep fs" 
     and lenH: "length fs = m" 
     and H: "set fs \<subseteq> carrier_vec n" 
     by (auto simp: gs.lin_indpt_list_def gs.reduced_def)
   from lin_dep have G: "set fs_init \<subseteq> carrier_vec n" unfolding gs.lin_indpt_list_def by auto
   with m0 len have "dim_vec (hd fs_init) = n" by (cases fs_init, auto)
   from v m0 lenH v have v: "v = fs ! 0" by (cases fs, auto)
   interpret gs1: gram_schmidt_fs_lin_indpt n "RAT fs"
     by (standard) (use assms LLL_invariant_def gs.lin_indpt_list_def in auto)
   let ?r = "rat_of_int" 
   let ?rv = "map_vec ?r" 
   let ?F = "RAT fs" 
   let ?h = "?rv h" 
   { assume h:"h \<in> L - {0\<^sub>v n}" (is ?h_req)
     from h[folded L] have h: "h \<in> lattice_of fs" "h \<noteq> 0\<^sub>v n" by auto
     {
       assume f: "?h = 0\<^sub>v n" 
       have "?h = ?rv (0\<^sub>v n)" unfolding f by (intro eq_vecI, auto)
       hence "h = 0\<^sub>v n"
         using of_int_hom.vec_hom_zero_iff[of h] of_int_hom.vec_hom_inj by auto
       with h have False by simp
     } hence h0: "?h \<noteq> 0\<^sub>v n" by auto
     with lattice_of_of_int[OF H h(1)]
     have "?h \<in> gs.lattice_of ?F - {0\<^sub>v n}" by auto
   } 
   from gs1.weakly_reduced_imp_short_vector[OF red this a1] lenH
   show "h \<in> L - {0\<^sub>v n} \<Longrightarrow> ?r (sq_norm v) \<le> \<alpha> ^ (m - 1) * ?r (sq_norm h)"
     using basis unfolding L v gs.lin_indpt_list_def  by (auto simp: sq_norm_of_int)
   from m0 H lenH show vn: "v \<in> carrier_vec n" unfolding v by (cases fs, auto)
   have vL: "v \<in> L" unfolding L[symmetric] v using m0 H lenH
     by (intro basis_in_latticeI, cases fs, auto)
   {
     assume "v = 0\<^sub>v n" 
     hence "hd ?F = 0\<^sub>v n" unfolding v using m0 lenH by (cases fs, auto)
     with gs.lin_indpt_list_nonzero[OF basis] have False using m0 lenH by (cases fs, auto)
   }
   with vL show v: "v \<in> L - {0\<^sub>v n}" by auto
   have jn:"0\<^sub>v j \<in> carrier_vec n \<Longrightarrow> j = n" unfolding zero_vec_def carrier_vec_def by auto
   with v vn show "v \<noteq> 0\<^sub>v j" by auto
 qed
 
 
 lemma LLL_mu_d_Z: assumes inv: "LLL_invariant_weak fs" 
   and j: "j \<le> ii" and ii: "ii < m" 
 shows "of_int (d fs (Suc j)) * \<mu> fs ii j \<in> \<int>"
 proof -
   interpret fs: fs_int' n m fs_init fs
     by standard (use inv in auto)
   show ?thesis
     using assms fs.fs_int_mu_d_Z LLL_inv_wD[OF inv] unfolding d_def fs.d_def by auto
 qed
 
 context fixes fs
   assumes Linv: "LLL_invariant_weak fs" and gbnd: "g_bound fs" 
 begin
 
 interpretation gs1: gram_schmidt_fs_lin_indpt n "RAT fs"
   by (standard) (use Linv LLL_invariant_weak_def gs.lin_indpt_list_def in auto)
 
 lemma LLL_inv_N_pos: assumes m: "m \<noteq> 0" 
 shows "N > 0" 
 proof -
   let ?r = rat_of_int
   note inv = LLL_inv_wD[OF Linv]
   from inv have F: "RAT fs ! 0 \<in> Rn" "fs ! 0 \<in> carrier_vec n" using m by auto
   from m have upt: "[0..< m] = 0 # [1 ..< m]" using upt_add_eq_append[of 0 1 "m - 1"] by auto
   from inv(6) m have "map_vec ?r (fs ! 0) \<noteq> 0\<^sub>v n" using gs.lin_indpt_list_nonzero[OF inv(1)]
     unfolding set_conv_nth by force
   hence F0: "fs ! 0 \<noteq> 0\<^sub>v n" by auto
   hence "sq_norm (fs ! 0) \<noteq> 0" using F by simp
   hence 1: "sq_norm (fs ! 0) \<ge> 1" using sq_norm_vec_ge_0[of "fs ! 0"] by auto
   from gbnd m have "sq_norm (gso fs 0) \<le> of_nat N" unfolding g_bound_def by auto
   also have "gso fs 0 = RAT fs ! 0" unfolding upt using F by (simp add: gs1.gso.simps[of 0])
   also have "RAT fs ! 0 = map_vec ?r (fs ! 0)" using inv(6) m by auto
   also have "sq_norm \<dots> = ?r (sq_norm (fs ! 0))" by (simp add: sq_norm_of_int)
   finally show ?thesis using 1 by (cases N, auto)
 qed
 
 
 (* equation (3) in front of Lemma 16.18 *)
 lemma d_approx_main: assumes i: "ii \<le> m" "m \<noteq> 0" 
 shows "rat_of_int (d fs ii) \<le> rat_of_nat (N^ii)" 
 proof -
   note inv = LLL_inv_wD[OF Linv]
   from LLL_inv_N_pos i have A: "0 < N" by auto
   note main = inv(2)[unfolded gram_schmidt_int_def gram_schmidt_wit_def]
   have "rat_of_int (d fs ii) = (\<Prod>j<ii. \<parallel>gso fs j\<parallel>\<^sup>2)" unfolding d_def using i
     by (auto simp: Gramian_determinant [OF Linv])
   also have "\<dots> \<le> (\<Prod>j<ii. of_nat N)" using i
     by (intro prod_mono ballI conjI prod_nonneg, insert gbnd[unfolded g_bound_def], auto)
   also have "\<dots> = (of_nat N)^ii" unfolding prod_constant by simp
   also have "\<dots> = of_nat (N^ii)" by simp
   finally show ?thesis by simp
 qed
 
 lemma d_approx: assumes i: "ii < m"  
   shows "rat_of_int (d fs ii) \<le> rat_of_nat (N^ii)" 
   using d_approx_main[of ii] assms by auto
 
 
 lemma d_bound: assumes i: "ii < m" 
   shows "d fs ii \<le> N^ii" 
   using d_approx[OF assms] unfolding d_def by linarith
 
 
 lemma D_approx: "D fs \<le> N ^ (m * m)" 
 proof - 
   note inv = LLL_inv_wD[OF Linv]
   from LLL_inv_N_pos have N: "m \<noteq> 0 \<Longrightarrow> 0 < N" by auto
   note main = inv(2)[unfolded gram_schmidt_int_def gram_schmidt_wit_def]
   have "rat_of_int (\<Prod>i<m. d fs i) = (\<Prod>i<m. rat_of_int (d fs i))" by simp
   also have "\<dots> \<le> (\<Prod>i<m. (of_nat N) ^ i)" 
     by (rule prod_mono, insert d_approx LLL_d_pos[OF Linv], auto simp: less_le)
   also have "\<dots> \<le> (\<Prod>i<m. (of_nat N ^ m))" 
     by (rule prod_mono, insert N, auto intro: pow_mono_exp)
   also have "\<dots> = (of_nat N)^(m * m)" unfolding prod_constant power_mult by simp
   also have "\<dots> = of_nat (N ^ (m * m))" by simp
   finally have "(\<Prod>i<m. d fs i) \<le> N ^ (m * m)" by linarith
   also have "(\<Prod>i<m. d fs i) = D fs" unfolding D_def 
     by (subst nat_0_le, rule prod_nonneg, insert LLL_d_pos[OF Linv], auto simp: le_less)  
   finally show "D fs \<le> N ^ (m * m)" by linarith 
 qed
 
 
 lemma LLL_measure_approx: assumes "\<alpha> > 4/3" "m \<noteq> 0" 
 shows "LLL_measure i fs \<le> m + 2 * m * m * log base N"
 proof -   
   have b1: "base > 1" using base assms by auto
   have id: "base = 1 / real_of_rat reduction" unfolding base_def reduction_def using \<alpha>0 by
     (auto simp: field_simps of_rat_divide)
   from LLL_D_pos[OF Linv] have D1: "real (D fs) \<ge> 1" by auto
   note invD = LLL_inv_wD[OF Linv]  
   from invD
   have F: "set fs \<subseteq> carrier_vec n" and len: "length fs = m" by auto
   have N0: "N > 0" using LLL_inv_N_pos[OF assms(2)] .
   from D_approx 
   have D: "D fs \<le> N ^ (m * m)" .
   hence "real (D fs) \<le> real (N ^ (m * m))" by linarith
   also have "\<dots> = real N ^ (m * m)" by simp
   finally have log: "log base (real (D fs)) \<le> log base (real N ^ (m * m))"   
     by (subst log_le_cancel_iff[OF b1], insert D1 N0, auto)
 
   have "real (logD fs) = real (nat \<lfloor>log base (real (D fs))\<rfloor>)" 
     unfolding logD_def id using assms by auto
   also have "\<dots> \<le> log base (real (D fs))" using b1 D1 by auto
   also have "\<dots> \<le> log base (real N ^ (m * m))" by fact
   also have "\<dots> = (m * m) * log base (real N)" 
     by (rule log_nat_power, insert N0, auto)
   finally have main: "logD fs \<le> m * m * log base N" by simp
 
   have "real (LLL_measure i fs) = real (2 * logD fs + m - i)"
     unfolding LLL_measure_def split invD(1) by simp
   also have "\<dots> \<le> 2 * real (logD fs) + m" using invD by simp
   also have "\<dots> \<le> 2 * (m * m * log base N) + m" using main by auto
   finally show ?thesis by simp
 qed
 end
 
 lemma g_bound_fs_init: "g_bound fs_init" 
 proof -
   {
     fix i
     assume i: "i < m" 
     let ?N = "map (nat o sq_norm) fs_init"
     let ?r = rat_of_int
     from i have mem: "nat (sq_norm (fs_init ! i)) \<in> set ?N" using fs_init len unfolding set_conv_nth by force
     interpret gs: gram_schmidt_fs_lin_indpt n "RAT fs_init"
       by (standard) (use len lin_dep LLL_invariant_def gs.lin_indpt_list_def in auto)
     from mem_set_imp_le_max_list[OF _ mem]
     have FN: "nat (sq_norm (fs_init ! i)) \<le> N" unfolding N_def by force
     hence "\<parallel>fs_init ! i\<parallel>\<^sup>2 \<le> int N" using i by auto
     also have "\<dots> \<le> int (N * m)" using i by fastforce
     finally have f_bnd:  "\<parallel>fs_init ! i\<parallel>\<^sup>2 \<le> int (N * m)" .
     from FN have "rat_of_nat (nat (sq_norm (fs_init ! i))) \<le> rat_of_nat N" by simp
     also have "rat_of_nat (nat (sq_norm (fs_init ! i))) = ?r (sq_norm (fs_init ! i))" 
       using sq_norm_vec_ge_0[of "fs_init ! i"] by auto
     also have "\<dots> = sq_norm (RAT fs_init ! i)" unfolding sq_norm_of_int[symmetric] using fs_init len i by auto
     finally have "sq_norm (RAT fs_init ! i) \<le> rat_of_nat N" .
     with gs.sq_norm_gso_le_f i len lin_dep
     have g_bnd: "\<parallel>gs.gso i\<parallel>\<^sup>2 \<le> rat_of_nat N"
       unfolding gs.lin_indpt_list_def by fastforce
     note f_bnd g_bnd
   }
   thus "g_bound fs_init" unfolding g_bound_def by auto
 qed
 
 lemma LLL_measure_approx_fs_init: 
   "LLL_invariant upw i fs_init \<Longrightarrow> 4 / 3 < \<alpha> \<Longrightarrow> m \<noteq> 0 \<Longrightarrow> 
   real (LLL_measure i fs_init) \<le> real m + real (2 * m * m) * log base (real N)" 
   using LLL_measure_approx[OF LLL_inv_imp_w g_bound_fs_init] .
 
 lemma N_le_MMn: assumes m0: "m \<noteq> 0" 
   shows "N \<le> nat M * nat M * n" 
   unfolding N_def
 proof (rule max_list_le, unfold set_map o_def)
   fix ni
   assume "ni \<in> (\<lambda>x. nat \<parallel>x\<parallel>\<^sup>2) ` set fs_init" 
   then obtain fi where ni: "ni = nat (\<parallel>fi\<parallel>\<^sup>2)" and fi: "fi \<in> set fs_init" by auto
   from fi len obtain i where fii: "fi = fs_init ! i" and i: "i < m" unfolding set_conv_nth by auto
   from fi fs_init have fi: "fi \<in> carrier_vec n" by auto
   let ?set = "{\<bar>fs_init ! i $ j\<bar> |i j. i < m \<and> j < n} \<union> {0}" 
   have id: "?set = (\<lambda> (i,j). abs (fs_init ! i $ j)) ` ({0..<m} \<times> {0..<n}) \<union> {0}" 
     by force
   have fin: "finite ?set" unfolding id by auto
   { 
     fix j assume "j < n" 
     hence "M \<ge> \<bar>fs_init ! i $ j\<bar>" unfolding M_def using i
       by (intro Max_ge[of _ "abs (fs_init ! i $ j)"], intro fin, auto)
   } note M = this
   from Max_ge[OF fin, of 0] have M0: "M \<ge> 0" unfolding M_def by auto
   have "ni = nat (\<parallel>fi\<parallel>\<^sup>2)" unfolding ni by auto
   also have "\<dots> \<le> nat (int n * \<parallel>fi\<parallel>\<^sub>\<infinity>\<^sup>2)" using sq_norm_vec_le_linf_norm[OF fi]
     by (intro nat_mono, auto)
   also have "\<dots> = n * nat (\<parallel>fi\<parallel>\<^sub>\<infinity>\<^sup>2)"
     by (simp add: nat_mult_distrib)
   also have "\<dots> \<le> n * nat (M^2)" 
   proof (rule mult_left_mono[OF nat_mono])
     have fi: "\<parallel>fi\<parallel>\<^sub>\<infinity> \<le> M" unfolding linf_norm_vec_def    
     proof (rule max_list_le, unfold set_append set_map, rule ccontr)
       fix x
       assume "x \<in> abs ` set (list_of_vec fi) \<union> set [0]" and xM: "\<not> x \<le> M"  
       with M0 obtain fij where fij: "fij \<in> set (list_of_vec fi)" and x: "x = abs fij" by auto
       from fij fi obtain j where j: "j < n" and fij: "fij = fi $ j" 
         unfolding set_list_of_vec vec_set_def by auto
       from M[OF j] xM[unfolded x fij fii] show False by auto
     qed auto                
     show "\<parallel>fi\<parallel>\<^sub>\<infinity>\<^sup>2 \<le> M^2" unfolding abs_le_square_iff[symmetric] using fi 
       using linf_norm_vec_ge_0[of fi] by auto
   qed auto
   finally show "ni \<le> nat M * nat M * n" using M0 
     by (subst nat_mult_distrib[symmetric], auto simp: power2_eq_square ac_simps)
 qed (insert m0 len, auto)
 
 
 
 subsection \<open>Basic LLL implementation based on previous results\<close>
 
 text \<open>We now assemble a basic implementation of the LLL algorithm,
   where only the lattice basis is updated, and where the GSO and the $\mu$-values
   are always computed from scratch. This enables a simple soundness proof 
   and permits to separate an efficient implementation from the soundness reasoning.\<close>
 
 fun basis_reduction_add_rows_loop where
   "basis_reduction_add_rows_loop i fs 0 = fs" 
 | "basis_reduction_add_rows_loop i fs (Suc j) = (
      let c = round (\<mu> fs i j);
          fs' = (if c = 0 then fs else fs[ i := fs ! i - c \<cdot>\<^sub>v fs ! j])
       in basis_reduction_add_rows_loop i fs' j)" 
 
 definition basis_reduction_add_rows where
   "basis_reduction_add_rows upw i fs = 
      (if upw then basis_reduction_add_rows_loop i fs i else fs)" 
 
 definition basis_reduction_swap where
   "basis_reduction_swap i fs = (False, i - 1, fs[i := fs ! (i - 1), i - 1 := fs ! i])" 
 
 definition basis_reduction_step where
   "basis_reduction_step upw i fs = (if i = 0 then (True, Suc i, fs)
      else let 
        fs' = basis_reduction_add_rows upw i fs
      in if sq_norm (gso fs' (i - 1)) \<le> \<alpha> * sq_norm (gso fs' i) then
           (True, Suc i, fs') 
         else basis_reduction_swap i fs')" 
 
 function basis_reduction_main where
   "basis_reduction_main (upw,i,fs) = (if i < m \<and> LLL_invariant upw i fs
      then basis_reduction_main (basis_reduction_step upw i fs) else
      fs)"
   by pat_completeness auto
 
 definition "reduce_basis = basis_reduction_main (True, 0, fs_init)" 
 
 definition "short_vector = hd reduce_basis" 
 
 text \<open>Soundness of this implementation is easily proven\<close>
 
 lemma basis_reduction_add_rows_loop: assumes 
   inv: "LLL_invariant True i fs" 
   and mu_small: "\<mu>_small_row i fs j"
   and res: "basis_reduction_add_rows_loop i fs j = fs'" 
   and i: "i < m" 
   and j: "j \<le> i" 
 shows "LLL_invariant False i fs'" "LLL_measure i fs' = LLL_measure i fs" 
 proof (atomize(full), insert assms, induct j arbitrary: fs)
   case (0 fs)
   thus ?case using basis_reduction_add_row_done[of i fs] by auto
 next
   case (Suc j fs)
   hence j: "j < i" by auto
   let ?c = "round (\<mu> fs i j)" 
   show ?case
   proof (cases "?c = 0")
     case True
     thus ?thesis using Suc(1)[OF Suc(2) basis_reduction_add_row_main_0[OF LLL_inv_imp_w[OF Suc(2)] i j True Suc(3)]]
       Suc(2-) by auto
   next
     case False
     note step = basis_reduction_add_row_main(2-)[OF LLL_inv_imp_w[OF Suc(2)] i j refl]
     note step = step(1)[OF Suc(2)] step(2-)
     show ?thesis using Suc(1)[OF step(1-2)] False Suc(2-) step(4) by simp
   qed
 qed
 
 lemma basis_reduction_add_rows: assumes 
   inv: "LLL_invariant upw i fs" 
   and res: "basis_reduction_add_rows upw i fs = fs'" 
   and i: "i < m" 
 shows "LLL_invariant False i fs'" "LLL_measure i fs' = LLL_measure i fs" 
 proof (atomize(full), goal_cases)
   case 1
   note def = basis_reduction_add_rows_def
   show ?case
   proof (cases upw)
     case False
     with res inv show ?thesis by (simp add: def)
   next
     case True
     with inv have "LLL_invariant True i fs" by auto
     note start = this \<mu>_small_row_refl[of i fs]
     from res[unfolded def] True have "basis_reduction_add_rows_loop i fs i = fs'" by auto
     from basis_reduction_add_rows_loop[OF start this i]
     show ?thesis by auto
   qed
 qed
 
 lemma basis_reduction_swap: assumes 
   inv: "LLL_invariant False i fs" 
   and res: "basis_reduction_swap i fs = (upw',i',fs')" 
   and cond: "sq_norm (gso fs (i - 1)) > \<alpha> * sq_norm (gso fs i)" 
   and i: "i < m" "i \<noteq> 0" 
 shows "LLL_invariant upw' i' fs'" (is ?g1)
   "LLL_measure i' fs' < LLL_measure i fs" (is ?g2)
 proof -
   note invw = LLL_inv_imp_w[OF inv]
   note def = basis_reduction_swap_def
   from res[unfolded basis_reduction_swap_def]
   have id: "upw' = False" "i' = i - 1" "fs' = fs[i := fs ! (i - 1), i - 1 := fs ! i]" by auto
   from basis_reduction_swap_main(2-3)[OF invw _ i cond id(3)] inv show ?g1 ?g2 unfolding id by auto
 qed
 
 lemma basis_reduction_step: assumes 
   inv: "LLL_invariant upw i fs" 
   and res: "basis_reduction_step upw i fs = (upw',i',fs')" 
   and i: "i < m" 
 shows "LLL_invariant upw' i' fs'" "LLL_measure i' fs' < LLL_measure i fs" 
 proof (atomize(full), goal_cases)
   case 1
   note def = basis_reduction_step_def
   note invw = LLL_inv_imp_w[OF inv]
   obtain fs'' where fs'': "basis_reduction_add_rows upw i fs = fs''" by auto
   show ?case
   proof (cases "i = 0")
     case True
     from increase_i[OF inv i] True
       res show ?thesis by (auto simp: def)
   next
     case False
     hence id: "(i = 0) = False" by auto
     note res = res[unfolded def id if_False fs'' Let_def]
     let ?x = "sq_norm (gso fs'' (i - 1))" 
     let ?y = "\<alpha> * sq_norm (gso fs'' i)" 
     from basis_reduction_add_rows[OF inv fs'' i]
     have inv: "LLL_invariant False i fs''"
       and meas: "LLL_measure i fs'' = LLL_measure i fs" by auto
     note invw = LLL_inv_imp_w[OF inv]
     show ?thesis
     proof (cases "?x \<le> ?y")
       case True
       from increase_i[OF inv i] id True res meas
       show ?thesis by simp
     next
       case gt: False
       hence "?x > ?y" by auto
       from basis_reduction_swap[OF inv _ this i False] gt res meas
       show ?thesis by auto
     qed
   qed
 qed
 
 termination by (relation "measure (\<lambda> (upw,i,fs). LLL_measure i fs)", insert basis_reduction_step, auto split: prod.splits)
 
 declare basis_reduction_main.simps[simp del]
 
 lemma basis_reduction_main: assumes "LLL_invariant upw i fs" 
   and res: "basis_reduction_main (upw,i,fs) = fs'" 
 shows "LLL_invariant True m fs'" 
   using assms
 proof (induct "LLL_measure i fs" arbitrary: i fs upw rule: less_induct)
   case (less i fs upw)
   have id: "LLL_invariant upw i fs = True" using less by auto
   note res = less(3)[unfolded basis_reduction_main.simps[of upw i fs] id]
   note inv = less(2)
   note IH = less(1)
   show ?case
   proof (cases "i < m")
     case i: True
     obtain i' fs' upw' where step: "basis_reduction_step upw i fs = (upw',i',fs')" 
       (is "?step = _") by (cases ?step, auto)
     from IH[OF basis_reduction_step(2,1)[OF inv step i]] res[unfolded step] i
     show ?thesis by auto
   next
     case False
     with LLL_invD[OF inv] have i: "i = m" by auto
     with False res inv have "LLL_invariant upw m fs'" by auto
     thus "LLL_invariant True m fs'" unfolding LLL_invariant_def by auto
   qed
 qed
 
 lemma reduce_basis_inv: assumes res: "reduce_basis = fs" 
   shows "LLL_invariant True m fs" 
   using basis_reduction_main[OF LLL_inv_initial_state res[unfolded reduce_basis_def]] .
 
 lemma reduce_basis: assumes res: "reduce_basis = fs"
   shows "lattice_of fs = L" 
   "reduced fs m" 
   "lin_indep fs" 
   "length fs = m" 
   using LLL_invD[OF reduce_basis_inv[OF res]] by blast+
   
 lemma short_vector: assumes res: "short_vector = v" 
   and m0: "m \<noteq> 0"
 shows "v \<in> carrier_vec n"
   "v \<in> L - {0\<^sub>v n}"  
   "h \<in> L - {0\<^sub>v n} \<Longrightarrow> rat_of_int (sq_norm v) \<le> \<alpha> ^ (m - 1) * rat_of_int (sq_norm h)" 
   "v \<noteq> 0\<^sub>v j" 
   using basis_reduction_short_vector[OF reduce_basis_inv[OF refl] res[symmetric, unfolded short_vector_def] m0] 
   by blast+
 end
 
 end
diff --git a/thys/Matrices_for_ODEs/MTX_Examples.thy b/thys/Matrices_for_ODEs/MTX_Examples.thy
--- a/thys/Matrices_for_ODEs/MTX_Examples.thy
+++ b/thys/Matrices_for_ODEs/MTX_Examples.thy
@@ -1,237 +1,237 @@
 (*  Title:       Verification Examples
     Author:      Jonathan Julián Huerta y Munive, 2020
     Maintainer:  Jonathan Julián Huerta y Munive <jjhuertaymunive1@sheffield.ac.uk>
 *)
 
 section \<open> Verification examples \<close>
 
 
 theory MTX_Examples
   imports MTX_Flows "Hybrid_Systems_VCs.HS_VC_Spartan"
 
 begin
 
 
 subsection \<open> Examples \<close>
 
 abbreviation hoareT :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a set) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" 
   ("PRE_ HP _ POST _" [85,85]85) where "PRE P HP X POST Q \<equiv> (P \<le> |X]Q)"
 
 
 subsubsection \<open> Verification by uniqueness. \<close>
 
 abbreviation mtx_circ :: "2 sq_mtx" ("A")
   where "A \<equiv> mtx  
    ([0,  1] # 
     [-1, 0] # [])"
 
 abbreviation mtx_circ_flow :: "real \<Rightarrow> real^2 \<Rightarrow> real^2" ("\<phi>")
   where "\<phi> t s \<equiv> (\<chi> i. if i = 1 then s$1 * cos t + s$2 * sin t else - s$1 * sin t + s$2 * cos t)"
 
 lemma mtx_circ_flow_eq: "exp (t *\<^sub>R A) *\<^sub>V s = \<phi> t s"
   apply(rule local_flow.eq_solution[OF local_flow_sq_mtx_linear, symmetric])
     apply(rule ivp_solsI, simp_all add: sq_mtx_vec_mult_eq vec_eq_iff)
   unfolding UNIV_2 using exhaust_2
   by (force intro!: poly_derivatives simp: matrix_vector_mult_def)+
 
 lemma mtx_circ: 
   "PRE(\<lambda>s. r\<^sup>2 = (s $ 1)\<^sup>2 + (s $ 2)\<^sup>2) 
   HP x\<acute>=(*\<^sub>V) A & G 
   POST (\<lambda>s. r\<^sup>2 = (s $ 1)\<^sup>2 + (s $ 2)\<^sup>2)"
   apply(subst local_flow.fbox_g_ode[OF local_flow_sq_mtx_linear])
   unfolding mtx_circ_flow_eq by auto
 
 no_notation mtx_circ ("A")
         and mtx_circ_flow ("\<phi>")
 
 
 subsubsection \<open> Flow of diagonalisable matrix. \<close>
 
 abbreviation mtx_hOsc :: "real \<Rightarrow> real \<Rightarrow> 2 sq_mtx" ("A")
   where "A a b \<equiv> mtx  
    ([0, 1] # 
     [a, b] # [])"
 
 abbreviation mtx_chB_hOsc :: "real \<Rightarrow> real \<Rightarrow> 2 sq_mtx" ("P")
   where "P a b \<equiv> mtx
    ([a, b] # 
     [1, 1] # [])"
 
 lemma inv_mtx_chB_hOsc: 
   "a \<noteq> b \<Longrightarrow> (P a b)\<^sup>-\<^sup>1 = (1/(a - b)) *\<^sub>R mtx 
    ([ 1, -b] # 
     [-1,  a] # [])"
   apply(rule sq_mtx_inv_unique, unfold scaleR_mtx2 times_mtx2)
   by (simp add: diff_divide_distrib[symmetric] one_mtx2)+
 
 lemma invertible_mtx_chB_hOsc: "a \<noteq> b \<Longrightarrow> mtx_invertible (P a b)"
   apply(rule mtx_invertibleI[of _ "(P a b)\<^sup>-\<^sup>1"])
    apply(unfold inv_mtx_chB_hOsc scaleR_mtx2 times_mtx2 one_mtx2)
   by (subst sq_mtx_eq_iff, simp add: vector_def frac_diff_eq1)+
 
 lemma mtx_hOsc_diagonalizable:
   fixes a b :: real
   defines "\<iota>\<^sub>1 \<equiv> (b - sqrt (b^2+4*a))/2" and "\<iota>\<^sub>2 \<equiv> (b + sqrt (b^2+4*a))/2"
   assumes "b\<^sup>2 + a * 4 > 0" and "a \<noteq> 0"
   shows "A a b = P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a) * (\<d>\<i>\<a>\<g> i. if i = 1 then \<iota>\<^sub>1 else \<iota>\<^sub>2) * (P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a))\<^sup>-\<^sup>1"
   unfolding assms apply(subst inv_mtx_chB_hOsc)
   using assms(3,4) apply(simp_all add: diag2_eq[symmetric])
   unfolding sq_mtx_times_eq sq_mtx_scaleR_eq UNIV_2 apply(subst sq_mtx_eq_iff)
   using exhaust_2 assms by (auto simp: field_simps, auto simp: field_power_simps)
 
 lemma mtx_hOsc_solution_eq:
   fixes a b :: real
   defines "\<iota>\<^sub>1 \<equiv> (b - sqrt (b\<^sup>2+4*a))/2" and "\<iota>\<^sub>2 \<equiv> (b + sqrt (b\<^sup>2+4*a))/2"
   defines "\<Phi> t \<equiv> mtx (
    [\<iota>\<^sub>2*exp(t*\<iota>\<^sub>1) - \<iota>\<^sub>1*exp(t*\<iota>\<^sub>2),     exp(t*\<iota>\<^sub>2)-exp(t*\<iota>\<^sub>1)]#
    [a*exp(t*\<iota>\<^sub>2) - a*exp(t*\<iota>\<^sub>1), \<iota>\<^sub>2*exp(t*\<iota>\<^sub>2)-\<iota>\<^sub>1*exp(t*\<iota>\<^sub>1)]#[])"
   assumes "b\<^sup>2 + a * 4 > 0" and "a \<noteq> 0"
   shows "P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a) * (\<d>\<i>\<a>\<g> i. exp (t * (if i=1 then \<iota>\<^sub>1 else \<iota>\<^sub>2))) * (P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a))\<^sup>-\<^sup>1 
   = (1/sqrt (b\<^sup>2 + a * 4)) *\<^sub>R (\<Phi> t)"
   unfolding assms apply(subst inv_mtx_chB_hOsc)
   using assms apply(simp_all add: mtx_times_scaleR_commute, subst sq_mtx_eq_iff)
   unfolding UNIV_2 sq_mtx_times_eq sq_mtx_scaleR_eq sq_mtx_uminus_eq apply(simp_all add: axis_def)
   by (auto simp: field_simps, auto simp: field_power_simps)+
  
 lemma local_flow_mtx_hOsc:
   fixes a b
   defines "\<iota>\<^sub>1 \<equiv> (b - sqrt (b^2+4*a))/2" and "\<iota>\<^sub>2 \<equiv> (b + sqrt (b^2+4*a))/2"
   defines "\<Phi> t \<equiv> mtx (
    [\<iota>\<^sub>2*exp(t*\<iota>\<^sub>1) - \<iota>\<^sub>1*exp(t*\<iota>\<^sub>2),     exp(t*\<iota>\<^sub>2)-exp(t*\<iota>\<^sub>1)]#
    [a*exp(t*\<iota>\<^sub>2) - a*exp(t*\<iota>\<^sub>1), \<iota>\<^sub>2*exp(t*\<iota>\<^sub>2)-\<iota>\<^sub>1*exp(t*\<iota>\<^sub>1)]#[])"
   assumes "b\<^sup>2 + a * 4 > 0" and "a \<noteq> 0"
   shows "local_flow ((*\<^sub>V) (A a b)) UNIV UNIV (\<lambda>t. (*\<^sub>V) ((1/sqrt (b\<^sup>2 + a * 4)) *\<^sub>R \<Phi> t))"
   unfolding assms using local_flow_sq_mtx_linear[of "A a b"] assms
   apply(subst (asm) exp_scaleR_diagonal2[OF invertible_mtx_chB_hOsc mtx_hOsc_diagonalizable])
      apply(simp, simp, simp)
   by (subst (asm) mtx_hOsc_solution_eq) simp_all
 
 lemma overdamped_door_arith:
   assumes "b\<^sup>2 + a * 4 > 0" and "a < 0" and "b \<le> 0" and "t \<ge> 0" and "s1 > 0"
   shows "0 \<le> ((b + sqrt (b\<^sup>2 + 4 * a)) * exp (t * (b - sqrt (b\<^sup>2 + 4 * a)) / 2) / 2 - 
 (b - sqrt (b\<^sup>2 + 4 * a)) * exp (t * (b + sqrt (b\<^sup>2 + 4 * a)) / 2) / 2) * s1 / sqrt (b\<^sup>2 + a * 4)"
 proof(subst diff_divide_distrib[symmetric], simp)
   have f0: "s1 / (2 * sqrt (b\<^sup>2 + a * 4)) > 0"  (is "s1/?c3 > 0")
     using assms(1,5) by simp
   have f1: "(b - sqrt (b\<^sup>2 + 4 * a)) < (b + sqrt (b\<^sup>2 + 4 * a))" (is "?c2 < ?c1") 
     and f2: "(b + sqrt (b\<^sup>2 + 4 * a)) < 0"
     using sqrt_ge_absD[of b "b\<^sup>2 + 4 * a"] assms by (force, linarith)
   hence f3: "exp (t * ?c2 / 2) \<le> exp (t * ?c1 / 2)" (is "exp ?t1 \<le> exp ?t2")
     unfolding exp_le_cancel_iff 
     using assms(4) by (case_tac "t=0", simp_all)
   hence "?c2 * exp ?t2 \<le> ?c2 * exp ?t1"
-    using f1 f2 real_mult_le_cancel_iff2[of "-?c2" "exp ?t1" "exp ?t2"] by linarith 
+    using f1 f2 mult_le_cancel_iff2[of "-?c2" "exp ?t1" "exp ?t2"] by linarith 
   also have "... < ?c1 * exp ?t1"
     using f1 by auto
   also have"... \<le> ?c1 * exp ?t1"
     using f1 f2 by auto
   ultimately show "0 \<le> (?c1 * exp ?t1 - ?c2 * exp ?t2) * s1 / ?c3"
     using f0 f1 assms(5) by auto
 qed
 
 lemma overdamped_door:
   assumes "b\<^sup>2 + a * 4 > 0" and "a < 0" and "b \<le> 0" and "0 \<le> t"
   shows "PRE (\<lambda>s. s$1 = 0)
   HP (LOOP 
       (\<lambda>s. {s. s$1 > 0 \<and> s$2 = 0});
       (x\<acute>=(*\<^sub>V) (A a b) & G on {0..t} UNIV @ 0) 
      INV (\<lambda>s. 0 \<le> s$1))
   POST (\<lambda>s. 0 \<le> s $ 1)"
   apply(rule fbox_loopI, simp_all add: le_fun_def)
   apply(subst local_flow.fbox_g_ode_ivl[OF local_flow_mtx_hOsc[OF assms(1)]])
   using assms apply(simp_all add: le_fun_def fbox_def)
   unfolding sq_mtx_scaleR_eq UNIV_2 sq_mtx_vec_mult_eq
   by (clarsimp simp: overdamped_door_arith)
 
 
 no_notation mtx_hOsc ("A")
         and mtx_chB_hOsc ("P")
 
 
 subsubsection \<open> Flow of non-diagonalisable matrix. \<close>
 
 abbreviation mtx_cnst_acc :: "3 sq_mtx" ("K")
   where "K \<equiv> mtx (
   [0,1,0] #
   [0,0,1] # 
   [0,0,0] # [])"
 
 lemma pow2_scaleR_mtx_cnst_acc: "(t *\<^sub>R K)\<^sup>2 = mtx (
   [0,0,t\<^sup>2] #
   [0,0,0] # 
   [0,0,0] # [])"
   unfolding power2_eq_square apply(subst sq_mtx_eq_iff)
   unfolding sq_mtx_times_eq UNIV_3 by auto
 
 lemma powN_scaleR_mtx_cnst_acc: "n > 2 \<Longrightarrow> (t *\<^sub>R K)^n = 0"
   apply(induct n, simp, case_tac "n \<le> 2")
    apply(subgoal_tac "n = 2", erule ssubst)
   unfolding power_Suc2 pow2_scaleR_mtx_cnst_acc sq_mtx_times_eq UNIV_3
   by (auto simp: sq_mtx_eq_iff)
 
 lemma exp_mtx_cnst_acc: "exp (t *\<^sub>R K) = ((t *\<^sub>R K)\<^sup>2/\<^sub>R 2) + (t *\<^sub>R K) + 1"
   unfolding exp_def apply(subst suminf_eq_sum[of 2])
   using powN_scaleR_mtx_cnst_acc by (simp_all add: numeral_2_eq_2)
  
 lemma exp_mtx_cnst_acc_simps:
   "exp (t *\<^sub>R K) $$ 1 $ 1 = 1" "exp (t *\<^sub>R K) $$ 1 $ 2 = t" "exp (t *\<^sub>R K) $$ 1 $ 3 = t^2/2"
   "exp (t *\<^sub>R K) $$ 2 $ 1 = 0" "exp (t *\<^sub>R K) $$ 2 $ 2 = 1" "exp (t *\<^sub>R K) $$ 2 $ 3 = t"
   "exp (t *\<^sub>R K) $$ 3 $ 1 = 0" "exp (t *\<^sub>R K) $$ 3 $ 2 = 0" "exp (t *\<^sub>R K) $$ 3 $ 3 = 1"
   unfolding exp_mtx_cnst_acc one_mtx3 pow2_scaleR_mtx_cnst_acc by simp_all
 
 lemma exp_mtx_cnst_acc_vec_mult_eq: "exp (t *\<^sub>R K) *\<^sub>V s = 
   vector [s$3 * t^2/2 + s$2 * t + s$1, s$3 * t + s$2, s$3]"
   apply(simp add: sq_mtx_vec_mult_eq vector_def)
   unfolding UNIV_3 apply (simp add: exp_mtx_cnst_acc_simps fun_eq_iff)
   using exhaust_3 exp_mtx_cnst_acc_simps(7,8,9) by fastforce
 
 lemma local_flow_mtx_cnst_acc:
   "local_flow ((*\<^sub>V) K) UNIV UNIV (\<lambda>t s. ((t *\<^sub>R K)\<^sup>2/\<^sub>R 2 + (t *\<^sub>R K) + 1) *\<^sub>V s)"
   using local_flow_sq_mtx_linear[of K] unfolding exp_mtx_cnst_acc .  
 
 lemma docking_station_arith:
   assumes "(d::real) > x" and "v > 0"
   shows "(v = v\<^sup>2 * t / (2 * d - 2 * x)) \<longleftrightarrow> (v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = d)"
 proof
   assume "v = v\<^sup>2 * t / (2 * d - 2 * x)"
   hence "v * t = 2 * (d - x)"
     using assms by (simp add: eq_divide_eq power2_eq_square) 
   hence "v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = 2 * (d - x) - 4 * (d - x)\<^sup>2 / (4 * (d - x)) + x"
     apply(subst power_mult_distrib[symmetric])
     by (erule ssubst, subst power_mult_distrib, simp)
   also have "... = d"
     apply(simp only: mult_divide_mult_cancel_left_if)
     using assms by (auto simp: power2_eq_square)
   finally show "v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = d" .
 next
   assume "v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = d"
   hence "0 = v\<^sup>2 * t\<^sup>2 / (4 * (d - x)) + (d - x) - v * t"
     by auto
   hence "0 = (4 * (d - x)) * (v\<^sup>2 * t\<^sup>2 / (4 * (d - x)) + (d - x) - v * t)"
     by auto
   also have "... = v\<^sup>2 * t\<^sup>2 + 4 * (d - x)\<^sup>2  - (4 * (d - x)) * (v * t)"
     using assms apply(simp add: distrib_left right_diff_distrib)
     apply(subst right_diff_distrib[symmetric])+
     by (simp add: power2_eq_square)
   also have "... = (v * t - 2 * (d - x))\<^sup>2"
     by (simp only: power2_diff, auto simp: field_simps power2_diff)
   finally have "0 = (v * t - 2 * (d - x))\<^sup>2" .
   hence "v * t = 2 * (d - x)"
     by auto
   thus "v = v\<^sup>2 * t / (2 * d - 2 * x)"
     apply(subst power2_eq_square, subst mult.assoc)
     apply(erule ssubst, subst right_diff_distrib[symmetric])
     using assms by auto
 qed
 
 lemma docking_station:
   assumes "d > x\<^sub>0" and "v\<^sub>0 > 0"
   shows "PRE (\<lambda>s. s$1 = x\<^sub>0 \<and> s$2 = v\<^sub>0)
   HP ((3 ::= (\<lambda>s. -(v\<^sub>0^2/(2*(d-x\<^sub>0))))); x\<acute>=(*\<^sub>V) K & G)
   POST (\<lambda>s. s$2 = 0 \<longleftrightarrow> s$1 = d)"
   apply(clarsimp simp: le_fun_def local_flow.fbox_g_ode[OF local_flow_sq_mtx_linear[of K]])
   unfolding exp_mtx_cnst_acc_vec_mult_eq using assms by (simp add: docking_station_arith)
 
 no_notation mtx_cnst_acc ("K")
 
 end
\ No newline at end of file
diff --git a/thys/Neumann_Morgenstern_Utility/Expected_Utility.thy b/thys/Neumann_Morgenstern_Utility/Expected_Utility.thy
--- a/thys/Neumann_Morgenstern_Utility/Expected_Utility.thy
+++ b/thys/Neumann_Morgenstern_Utility/Expected_Utility.thy
@@ -1,274 +1,274 @@
 (* License: LGPL *)
 
 theory Expected_Utility
 imports
   Neumann_Morgenstern_Utility_Theorem
 begin
 
 section \<open> Definition of vNM-utility function \<close>
 
 text \<open> We define a version of the vNM Utility function using the locale mechanism. 
        Currently this definition and system U have no proven relation yet. \<close>
 
 text \<open> Important: u is actually not the von Neuman Utility Function, 
        but a Bernoulli Utility Function. The Expected value p 
        given u is the von Neumann Utility Function. \<close>
 
 locale vNM_utility =
   fixes outcomes :: "'a set"
   fixes relation :: "'a pmf relation"
   fixes u :: "'a \<Rightarrow> real"
   assumes "relation \<subseteq> (lotteries_on outcomes \<times> lotteries_on outcomes)"
   assumes "\<And>p q.  p \<in> lotteries_on outcomes \<Longrightarrow> 
                   q \<in> lotteries_on outcomes \<Longrightarrow> 
         p \<succeq>[relation] q \<longleftrightarrow> measure_pmf.expectation p u \<ge> measure_pmf.expectation q u"
 begin
 
 lemma vNM_utilityD:
   shows "relation \<subseteq> (lotteries_on outcomes \<times> lotteries_on outcomes)"
     and "p \<in> lotteries_on outcomes \<Longrightarrow> q \<in> lotteries_on outcomes \<Longrightarrow> 
     p \<succeq>[relation] q \<longleftrightarrow> measure_pmf.expectation p u \<ge> measure_pmf.expectation q u"
   using vNM_utility_axioms vNM_utility_def by (blast+)
 
 lemma not_outside:
   assumes "p \<succeq>[relation] q"
   shows "p \<in> lotteries_on outcomes"
     and "q \<in> lotteries_on outcomes"
 proof (goal_cases)
   case 1
   then show ?case
     by (meson assms contra_subsetD mem_Sigma_iff vNM_utility_axioms vNM_utility_def)
 next
   case 2
   then show ?case
     by (metis assms mem_Sigma_iff subsetCE vNM_utility_axioms vNM_utility_def)
 qed
 
 lemma utility_ge:
   assumes "p \<succeq>[relation] q"
   shows "measure_pmf.expectation p u \<ge> measure_pmf.expectation q u"
   using assms vNM_utility_axioms vNM_utility_def
   by (metis (no_types, lifting) not_outside(1) not_outside(2))
 
 end (* vNM_Utility *)
 
 sublocale vNM_utility \<subseteq> ordinal_utility "(lotteries_on outcomes)" relation "(\<lambda>p. measure_pmf.expectation p u)"
 proof (standard, goal_cases)
   case (2 x y)
   then show ?case
     using not_outside(1) by blast
 next
   case (3 x y)
   then show ?case 
     by (auto simp add: not_outside(2))
 qed (metis (mono_tags, lifting) vNM_utility_axioms vNM_utility_def)
 
 context vNM_utility
 begin
 
 lemma strict_preference_iff_strict_utility:
  assumes "p \<in> lotteries_on outcomes" 
  assumes "q \<in> lotteries_on outcomes"
  shows "p \<succ>[relation] q \<longleftrightarrow> measure_pmf.expectation p u > measure_pmf.expectation q u"
   by (meson assms(1) assms(2) less_eq_real_def not_le util_def)
 
 lemma pos_distrib_left:
   assumes "c > 0"
   shows "(\<Sum>z\<in>outcomes. pmf q z * (c * u z)) = c * (\<Sum>z\<in>outcomes. pmf q z * (u z))"
 proof -
   have "(\<Sum>z\<in>outcomes. pmf q z * (c * u z)) = (\<Sum>z\<in>outcomes. pmf q z * c * u z)"
     by (simp add: ab_semigroup_mult_class.mult_ac(1))
   also have "... = (\<Sum>z\<in>outcomes. c * pmf q z *  u z)"
     by (simp add: mult.commute)
   also have "... = c * (\<Sum>z\<in>outcomes. pmf q z *  u z)"
     by (simp add: ab_semigroup_mult_class.mult_ac(1) sum_distrib_left)
   finally show ?thesis .
 qed
 
 lemma sum_pmf_util_commute:
   "(\<Sum>a\<in>outcomes. pmf p a * u a) = (\<Sum>a\<in>outcomes. u a * pmf p a)"
   by (simp add: mult.commute)
 
 
 
 section \<open> Finite outcomes \<close>
 context
   assumes fnt: "finite outcomes"
 begin
 
 lemma sum_equals_pmf_expectation:
   assumes "p \<in> lotteries_on outcomes"
   shows"(\<Sum>z\<in>outcomes. (pmf p z) * (u z)) = measure_pmf.expectation p u"
 proof -
   have fnt: "finite outcomes"
     by (simp add: vNM_utilityD(1) fnt)
   have "measure_pmf.expectation p u = (\<Sum>a\<in>outcomes. pmf p a * u a)"
     using support_in_outcomes assms fnt integral_measure_pmf_real
       sum_pmf_util_commute by fastforce
   then show ?thesis
     using real_scaleR_def by presburger
 qed
 
 lemma expected_utility_weak_preference:
   assumes "p \<in> lotteries_on outcomes" 
     and "q \<in> lotteries_on outcomes"
   shows   "p \<succeq>[relation] q \<longleftrightarrow> (\<Sum>z\<in>outcomes. (pmf p z) * (u z)) \<ge> (\<Sum>z\<in>outcomes. (pmf q z) * (u z))"
   using sum_equals_pmf_expectation[of p, OF assms(1)] 
         sum_equals_pmf_expectation[of q, OF assms(2)]
    vNM_utility_def assms(1) assms(2) util_def_conf by presburger
 
 lemma diff_leq_zero_weak_preference:
   assumes "p \<in> lotteries_on outcomes"
     and "q \<in> lotteries_on outcomes"
   shows "p \<succeq> q \<longleftrightarrow> ((\<Sum>a\<in>outcomes. pmf q a * u a) - (\<Sum>a\<in>outcomes. pmf p a * u a) \<le> 0)"
   using assms(1) assms(2) diff_le_0_iff_le
   by (metis (mono_tags, lifting) expected_utility_weak_preference)
 
 lemma expected_utility_strict_preference:
   assumes "p \<in> lotteries_on outcomes" 
     and "q \<in> lotteries_on outcomes"
   shows   "p \<succ>[relation] q \<longleftrightarrow> measure_pmf.expectation p u > measure_pmf.expectation q u"
   using assms expected_utility_weak_preference less_eq_real_def not_le
   by (metis (no_types, lifting) util_def_conf)
 
 lemma scale_pos_left: 
   assumes "c > 0" 
   shows "vNM_utility outcomes relation (\<lambda>x. c * u x)"
 proof(standard, goal_cases)
   case 1
   then show ?case
     using vNM_utility_axioms vNM_utility_def by blast
 next
   case (2 p q)
   have "q \<in> lotteries_on outcomes" and "p \<in> lotteries_on outcomes"
     using "2"(2) by (simp add: fnt "2"(1))+
   then have *: "p \<succeq> q = (measure_pmf.expectation q u \<le> measure_pmf.expectation p u)"
     using expected_utility_weak_preference[of p q] assms by blast
   have dist_c: "(\<Sum>z\<in>outcomes. (pmf q z) * (c * u z)) = c * (\<Sum>z\<in>outcomes. (pmf q z) * (u z))"
     using pos_distrib_left[of c q] assms by blast
   have dist_c': "(\<Sum>z\<in>outcomes. (pmf p z) * (c * u z)) = c * (\<Sum>z\<in>outcomes. (pmf p z) * (u z))"
     using pos_distrib_left[of c p] assms by blast
   have "p \<succeq> q \<longleftrightarrow> ((\<Sum>z\<in>outcomes. (pmf q z) * (c * u z)) \<le> (\<Sum>z\<in>outcomes. (pmf p z) * (c * u z)))"
   proof (rule iffI)
     assume "p \<succeq> q"
     then have "(\<Sum>z\<in>outcomes. pmf q z * (u z)) \<le> (\<Sum>z\<in>outcomes. pmf p z * (u z))" 
       using utility_ge
       using "2"(1) "2"(2) sum_equals_pmf_expectation by presburger
     then show "(\<Sum>z\<in>outcomes. pmf q z * (c * u z)) \<le> (\<Sum>z\<in>outcomes. pmf p z * (c * u z))" 
       using dist_c dist_c'
       by (simp add: assms)
   next
     assume "(\<Sum>z\<in>outcomes. pmf q z * (c * u z)) \<le> (\<Sum>z\<in>outcomes. pmf p z * (c * u z))"
     then have "(\<Sum>z\<in>outcomes. pmf q z * (u z)) \<le> (\<Sum>z\<in>outcomes. pmf p z * (u z))"
-      using "2"(1) real_mult_le_cancel_iff2 assms by (simp add: dist_c dist_c')
+      using "2"(1) mult_le_cancel_iff2 assms by (simp add: dist_c dist_c')
     then show "p \<succeq> q"
       using "2"(2) assms "2"(1) by (simp add: * sum_equals_pmf_expectation)
   qed
   then show ?case
     by (simp add: "*" assms)
 qed
 
 lemma strict_alt_def:
   assumes "p \<in> lotteries_on outcomes" 
     and "q \<in> lotteries_on outcomes"
   shows "p \<succ>[relation] q \<longleftrightarrow> 
             (\<Sum>z\<in>outcomes. (pmf p z) * (u z)) > (\<Sum>z\<in>outcomes. (pmf q z) * (u z))"
   using sum_equals_pmf_expectation[of p, OF assms(1)] assms(1) assms(2)
     sum_equals_pmf_expectation[of q, OF assms(2)] strict_prefernce_iff_strict_utility
   by presburger
 
 lemma strict_alt_def_utility_g:
   assumes "p \<succ>[relation] q"
   shows "(\<Sum>z\<in>outcomes. (pmf p z) * (u z)) > (\<Sum>z\<in>outcomes. (pmf q z) * (u z))"
   using assms not_outside(1) not_outside(2) strict_alt_def
   by meson
 
 end (* finite outcomes *)
 
 end (* Definition of vNM Utility Function as locale *)
 
 lemma vnm_utility_is_ordinal_utility:
   assumes "vNM_utility outcomes relation u"
   shows "ordinal_utility (lotteries_on outcomes) relation (\<lambda>p. measure_pmf.expectation p u)"
 proof (standard, goal_cases)
   case (1 x y)
   then show ?case
     using assms vNM_utility_def by blast
 next
   case (2 x y)
   then show ?case 
     using assms vNM_utility.not_outside(1) by blast
 next
   case (3 x y)
   then show ?case 
     using assms vNM_utility.not_outside(2) by blast
 qed
 
 lemma vnm_utility_imp_reational_prefs:
   assumes "vNM_utility outcomes relation u"
   shows "rational_preference (lotteries_on outcomes) relation"
 proof (standard,goal_cases)
   case (1 x y)
   then show ?case
     using assms vNM_utility.not_outside(1) by blast
 next
   case (2 x y)
   then show ?case
     using assms vNM_utility.not_outside(2) by blast
 next
   case 3
   have t: "trans relation"
     using assms ordinal_utility.util_imp_trans vnm_utility_is_ordinal_utility by blast
   have "refl_on (lotteries_on outcomes) relation"
     by (meson assms order_refl refl_on_def vNM_utility_def)
   then show ?case
     using preorder_on_def t by blast
 next
   case 4
   have "total_on (lotteries_on outcomes) relation"
     using ordinal_utility.util_imp_total[of "lotteries_on outcomes" 
         relation "(\<lambda>p. (\<Sum>z\<in>outcomes. (pmf p z) * (u z)))"]
       assms vnm_utility_is_ordinal_utility
     using ordinal_utility.util_imp_total by blast
   then show ?case
     by simp
 qed
 
 theorem expected_utilty_theorem_form_vnm_utility:
   assumes fnt: "finite outcomes" and "outcomes \<noteq> {}"
   shows "rational_preference (lotteries_on outcomes) \<R> \<and> 
          independent_vnm (lotteries_on outcomes) \<R> \<and> 
          continuous_vnm (lotteries_on outcomes) \<R> \<longleftrightarrow> 
          (\<exists>u. vNM_utility outcomes \<R> u)"
 proof
   assume "rational_preference (\<P> outcomes) \<R> \<and> independent_vnm (\<P> outcomes) \<R> \<and> continuous_vnm (\<P> outcomes) \<R>"
   with Von_Neumann_Morgenstern_Utility_Theorem[of outcomes \<R>, OF assms] have
   "(\<exists>u. ordinal_utility (\<P> outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u))" using assms by blast
   then obtain u where
     u: "ordinal_utility (\<P> outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u)"
     by auto
   have "vNM_utility outcomes \<R> u"
   proof (standard, goal_cases)
     case 1
     then show ?case
       using u ordinal_utility.relation_subset_crossp by blast
   next
     case (2 p q)
     then show ?case
       using assms(2) expected_value_is_utility_function fnt u by blast
   qed
   then show "\<exists>u. vNM_utility outcomes \<R> u" 
     by blast
 next
   assume a: "\<exists>u. vNM_utility outcomes \<R> u"
   then have "rational_preference (\<P> outcomes) \<R>"
     using vnm_utility_imp_reational_prefs by auto
   moreover have "independent_vnm (\<P> outcomes) \<R>"
     using a by (meson assms(2) fnt vNM_utility_implies_independence vnm_utility_is_ordinal_utility)
   moreover have "continuous_vnm (\<P> outcomes) \<R>"
     using a by (meson assms(2) fnt vNM_utilty_implies_continuity vnm_utility_is_ordinal_utility)
   ultimately show "rational_preference (\<P> outcomes) \<R> \<and> independent_vnm (\<P> outcomes) \<R> \<and> continuous_vnm (\<P> outcomes) \<R>"
     by auto
 qed
 
 end
diff --git a/thys/Ordinary_Differential_Equations/Ex/Examples_One_Step_Method.thy b/thys/Ordinary_Differential_Equations/Ex/Examples_One_Step_Method.thy
--- a/thys/Ordinary_Differential_Equations/Ex/Examples_One_Step_Method.thy
+++ b/thys/Ordinary_Differential_Equations/Ex/Examples_One_Step_Method.thy
@@ -1,481 +1,481 @@
 theory Examples_One_Step_Method
 imports
   "HOL-ODE-Numerics.ODE_Numerics"
 begin
 
 subsection \<open>Example 1\<close>
 experiment begin
 
 schematic_goal e1_fas:
   "[1, (X!1)\<^sup>2 - X!0] = interpret_floatariths ?fas X"
   unfolding power2_eq_square\<comment> \<open>TODO: proper affine implementation of power\<close>
   by (reify_floatariths)
 
 concrete_definition e1_fas uses e1_fas
 
 interpretation e1: ode_interpretation true_form UNIV e1_fas "\<lambda>(x, y). (1, y\<^sup>2 - x)::real*real"
   "d::2" for d
   by unfold_locales (auto simp: e1_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
       mk_ode_ops_def eucl_of_list_prod power2_eq_square intro!: isFDERIV_I)
 
 lemma e1_0: "t \<in> {4 .. 4} \<longrightarrow> (x, y) \<in> {(0, 0) .. (0, 0.71875)} \<longrightarrow>
    t \<in> e1.existence_ivl0 (x, y) \<and> e1.flow0 (x, y) t \<in> {(3.999, -1.96)..(4, -1.9)}"
   by (tactic \<open>ode_bnds_tac @{thms e1_fas_def} 30 20 7 12 [(0, 1, "0x000000")] (* "out_e1_0.out" *) "" @{context} 1\<close>)
 
 lemma e1_1: "t \<in> {4 .. 4} \<longrightarrow> (x, y) \<in> {(0, 0.71875) .. (0, 0.71875)} \<longrightarrow>
    t \<in> e1.existence_ivl0 (x, y) \<and> e1.flow0 (x, y) t \<in> {(3.999, -1.921)..(4, -1.919)}"
   by (tactic \<open>ode_bnds_tac @{thms e1_fas_def} 30 20 7 12 [(0, 1, "0xff0000")] (* "out_e1_1.out" *) "" @{context} 1\<close>)
 
 end
 
 
 subsection \<open>Example Exponential\<close>
 experiment begin
 
 schematic_goal exp_fas:
   "[1, (X!1)] = interpret_floatariths ?fas X"
   by (reify_floatariths)
 concrete_definition exp_fas uses exp_fas
 
 interpretation exp_ivp: ode_interpretation true_form UNIV exp_fas
   "\<lambda>(t::real, x). (1, x::real)" "one::2"
   by standard
     (auto simp: exp_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
       mk_ode_ops_def eucl_of_list_prod power2_eq_square intro!: isFDERIV_I)
 
 subsubsection \<open>connection to exponential function\<close>
 
 lemma exp_ivp_existence_ivl0:
   "exp_ivp.existence_ivl0 p = UNIV"
   by (rule exp_ivp.existence_ivl_eq_domain)
      (auto intro!: exI[where x=1] order_trans[OF norm_Pair_le] order_trans[OF _ norm_snd_le])
 
 lemma exp_eq_exp_ivp_aux:
   "exp_ivp.flow0 (0, 1) x = (x, exp x)"
   apply (rule exp_ivp.flow_unique[where phi="\<lambda>x. (x, exp x)"])
   unfolding exp_ivp_existence_ivl0
   by (auto simp: has_vector_derivative_def intro!: derivative_eq_intros)
 
 lemma ex_eq_exp_ivp: "exp x = snd (exp_ivp.flow0 (0, 1) x)"
   unfolding exp_eq_exp_ivp_aux by simp
 
 text \<open>concrete example\<close>
 
 lemma exp_ode_result:
   "t \<in> {1 .. 1} \<longrightarrow> (s, x) \<in> {(0, 1) .. (0, 1)} \<longrightarrow>
   t \<in> exp_ivp.existence_ivl0 (s, x) \<and>
   exp_ivp.flow0 (s, x) t \<in> {(0.99, 2.718281) .. (1, 2.718284)}"
   by (tactic \<open>ode_bnds_tac @{thms exp_fas_def} 30 20 7 20 [(0, 1, "0x000000")] (* "out_exp.out" *) "" @{context} 1\<close>)
 
 lemma exp1: "exp 1 \<in> {2.718281 .. 2.718284::real}"
   using exp_ode_result[of 1 0 1]
   by (auto simp: exp_eq_exp_ivp_aux)
 
 end
 
 
 subsection \<open>Van der Pol\<close>
 experiment begin
 
 schematic_goal vdp_fas:
   "[X!1, X!1 * (1 - (X!0)\<^sup>2) - X!0] = interpret_floatariths ?fas X"
   unfolding power2_eq_square\<comment> \<open>TODO: proper affine implementation of power\<close>
   by (reify_floatariths)
 
 concrete_definition vdp_fas uses vdp_fas
 
 interpretation vdp: ode_interpretation true_form UNIV vdp_fas "\<lambda>(x, y). (y, y * (1 - x\<^sup>2) - x)::real*real"
   "n::2" for n
   by standard
     (auto simp: vdp_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
       mk_ode_ops_def eucl_of_list_prod power2_eq_square intro!: isFDERIV_I)
 
 lemma vdp_c0: "t \<in> point_ivl 7 \<longrightarrow> (x, y) \<in> point_ivl (1.4, 2.4) \<longrightarrow>
    t \<in> vdp.existence_ivl0 (x, y) \<and> vdp.flow0 (x, y) t \<in> {(1.870, 0.9887) .. (1.875, 1.001)}"
   by (tactic \<open>ode_bnds_tac @{thms vdp_fas_def} 30 35 9 14 [(0, 1, "0x000000")] (* "out_vdp_c0.out" *) "" @{context} 1\<close>)
 
 lemma vdp_c1: "t \<in> point_ivl 7 \<longrightarrow> (x, y) \<in> point_ivl (1.4, 2.4) \<longrightarrow>
    t \<in> vdp.existence_ivl0 (x, y) \<and>
    vdp.flow0 (x, y) t \<in> {(1.870, 0.9887) .. (1.875, 1.001)} \<and>
     vdp.Dflow (x, y) t o\<^sub>L blinfun_of_list [1,0, 0,1] \<in>
       vdp.blinfuns_of_lvivl ([-0.197,-0.399, 0.835, 1.71],
                              [-0.189, -0.387, 0.858, 1.75])"
   by (tactic \<open>ode'_bnds_tac @{thms vdp_fas_def} 30 80 40 14
     [(0, 1, "0x000000", [0,1])] ["0x7f0000", "0x00007f"] (* "out_vdp_c1.out" *) "" @{context} 1\<close>)
 end
 
 subsection \<open>Example Classical Lorenz Equations\<close>
 experiment begin
 
 schematic_goal
   lorenz_fas:
   "[10 * (X!1 - X!0),
     X!0 * (28 - X!2) - X!1,
     X!0 * X!1 - 8 /3 * X!2] =
   interpret_floatariths ?fas X"
   by (reify_floatariths)
 concrete_definition lorenz_fas uses lorenz_fas
 
 interpretation lorenz: ode_interpretation true_form UNIV lorenz_fas
   "\<lambda>(x, y, z). (10 * (y - x), x * (28 - z) - y, x * y - 8 / 3 * z)
     ::real*real*real"
   "three::3"
   by standard
     (auto simp: lorenz_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
       mk_ode_ops_def eucl_of_list_prod power2_eq_square intro!: isFDERIV_I)
 
 text \<open>Taken from "A database of rigorous and high-precision periodic orbits of the Lorenz model" (2015)
   by Barrio, Dena, Tucker\<close>
 lemma lorenz_c0: "t \<in> point_ivl 1.558652210 \<longrightarrow> (x, y, z) \<in> point_ivl ( -2.147367631, 2.078048211, 27) \<longrightarrow>
    t \<in> lorenz.existence_ivl0 (x, y, z) \<and> lorenz.flow0 (x, y, z) t \<in> {(-2.1515, 2.0738, 26.992) .. (-2.1434, 2.0824, 27.009)}"
   by (tactic \<open>ode_bnds_tac @{thms lorenz_fas_def} 30 35 9 16
     [(0, 1, "0x7f0000"), (0, 2, "0x00007f")] (* "out_lorenz_c0.out" *) "" @{context} 1\<close>)
 
 lemma lorenz_c1: "t \<in> point_ivl (FloatR 52299689 (- 25) \<comment> \<open>for C1-info, the target time needs to be a float\<close>) \<longrightarrow>
   (x, y, z) \<in> point_ivl ( -2.147367631, 2.078048211, 27) \<longrightarrow>
    t \<in> lorenz.existence_ivl0 (x, y, z) \<and>
    lorenz.flow0 (x, y, z) t \<in> {(-2.158, 2.064, 26.98) .. (-2.137, 2.092, 27.02)} \<and>
     lorenz.Dflow (x, y, z) t o\<^sub>L blinfun_of_list [1,0,0, 0,1,0, 0,0,1] \<in>
       lorenz.blinfuns_of_lvivl ([-0.535,-1.15,-0.794, 1.49,4.01,0.651, 2.71,6.85,2.11],
                                 [-0.479,-1.03,-0.751, 1.58,4.14,0.703, 2.82,7.00,2.19])"
   by (tactic \<open>ode'_bnds_tac @{thms lorenz_fas_def} 30 80 40 16
     [(0, 1, "0x000000", [0,1,2]), (0, 2, "0x7f7f7f", [0,1,2])] ["0x7f0000", "0x007f00", "0x00007f"]
       (* "out_lorenz_c1.out" *) "" @{context} 1\<close>)
 end
 
 
 subsection \<open>Bessel Function inspired example\<close>
 text \<open>\label{sec:bessel}\<close>
 experiment begin
 
 unbundle floatarith_notation
 
 text \<open>encoding a constant parameter and higher derivatives in the ode...\<close>
 
 schematic_goal bessel_fas:
   "[0, -1, -(X!3), (((X!1)\<^sup>2 - (X!0)\<^sup>2) * X!2 + (X!1) * (X!3)) / (X!1)\<^sup>2] = interpret_floatariths ?fas X"
   unfolding power2_eq_square\<comment> \<open>TODO: proper affine implementation of power\<close>
   by (reify_floatariths)
 concrete_definition bessel_fas uses bessel_fas
 
 interpretation bessel: ode_interpretation "Less (Var 1) (Num 0)" "{(mu, s, _, _). s < 0}"
   bessel_fas
   "\<lambda>(mu::real, s::real, x::real, x'::real).
   (0::real,
   -1::real,
   -x'::real,
   (((s\<^sup>2 - mu\<^sup>2) * x + s * x') / s\<^sup>2))"
   "four::4"
   by standard
     (auto simp: bessel_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def inverse_eq_divide
       mk_ode_ops_def eucl_of_list_prod power2_eq_square intro!: isFDERIV_I)
 
 definition "J0 = 0.765197686557966551449717526103"
 definition "J0' = 0.440050585744933515959682203719"
 
 lemma bessel_result:
   "t \<in> {10 .. 10} \<longrightarrow>
    (x, y, j0, j0') \<in> {(0, -1, 0.765197686557966551449717526103, 0.440050585744933515959682203719) ..
       (0, -1, 0.765197686557966551449717526103, 0.440050585744933515959682203719)} \<longrightarrow>
    t \<in> bessel.existence_ivl0 (x, y, j0, j0') \<and>
                 bessel.flow0 (x, y, j0, j0') t \<in> {(0, -11.01, -0.18, -0.185) .. (0, -11, -0.165, -0.169)}"
   by (tactic \<open>ode_bnds_tac @{thms bessel_fas_def} 30 20 7 12
     [(1, 2, "0x007f00"), (1, 3, "0x00007f")] (* "out_bessel.out" *) "" @{context} 1\<close>)
 end
 
 subsection \<open> Oil reservoir in Affine arithmetic \<close>
 text \<open>\label{sec:exampleoil}\<close>
 experiment begin
 
 schematic_goal oil_fas:
   "[X!1, (X!1)\<^sup>2 - 3 / (0.001 + (X!0)\<^sup>2)] = interpret_floatariths ?fas X"
   unfolding power2_eq_square\<comment> \<open>TODO: proper affine implementation of power\<close>
   by (reify_floatariths)
 
 concrete_definition oil_fas uses oil_fas
 
 lemma oil_deriv_ok: fixes y::real
 shows "1 / 1000 + y*y = 0 \<longleftrightarrow> False"
 proof -
   have "1 / 1000 + y*y > 0"
     by (auto intro!: add_pos_nonneg)
   thus ?thesis by auto
 qed
 
 interpretation oil: ode_interpretation true_form UNIV oil_fas
   "\<lambda>(y, z). (z, z\<^sup>2 - 3 / (0.001 + y\<^sup>2))::real*real" "two::2"
   by standard
     (auto simp: oil_fas_def oil_deriv_ok less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def inverse_eq_divide
       mk_ode_ops_def eucl_of_list_prod isDERIV_Power_iff power2_eq_square intro!: isFDERIV_I)
 
 theorem oil_20:
   "t \<in> {50 .. 50} \<longrightarrow> (x, y) \<in> {(10, 0) .. (10, 0)} \<longrightarrow>
    t \<in> oil.existence_ivl0 (x, y) \<and> oil.flow0 (x, y) t \<in> {(-8.310, -0.2252) .. (-8.257, -0.2236)}"
   by (tactic \<open>ode_bnds_tac @{thms oil_fas_def} 30 20 7 20 [(0, 1, "0x000000")] (* "out_oil_20.out" *) "" @{context} 1\<close>)
 
 theorem oil_30:
   "t \<in> {50 .. 50} \<longrightarrow> (x, y) \<in> {(10, 0) .. (10, 0)} \<longrightarrow>
    t \<in> oil.existence_ivl0 (x, y) \<and> oil.flow0 (x, y) t \<in> {(-8.279, -0.2246) .. (-8.276, -0.2245)}"
   by (tactic \<open>ode_bnds_tac @{thms oil_fas_def} 30 20 7 30 [(0, 1, "0xff0000")] (* "out_oil_30.out" *) "" @{context} 1\<close>)
 end
 
 subsection \<open>Example V in Walter's textbook~\cite{walter}\<close>
 experiment begin
 
 schematic_goal e3_fas:
   "[1, (X!1)\<^sup>2 + (X!0)\<^sup>2] = interpret_floatariths ?fas X"
   unfolding power2_eq_square\<comment> \<open>TODO: proper affine implementation of power\<close>
   by (reify_floatariths)
 concrete_definition e3_fas uses e3_fas
 
 interpretation e3: ode_interpretation true_form UNIV e3_fas "\<lambda>(t, x). (1, x\<^sup>2 + t\<^sup>2)::real*real"
   "d::2" for d
   by standard
     (auto simp: e3_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
       mk_ode_ops_def eucl_of_list_prod power2_eq_square intro!: isFDERIV_I)
 
 lemma e3_flow_mem:
   "t \<in> {0.125 .. 0.125} \<longrightarrow> (s, x) \<in> {(0, 1) .. (0, 1)} \<longrightarrow>
   t \<in> e3.existence_ivl0 (s, x) \<and> (e3.flow0 (s, x) t \<in> {(0.124, 1.14347) .. (0.126, 1.14376)})"
   by (tactic \<open>ode_bnds_tac @{thms e3_fas_def} 30 20 7 11 [(0, 1, "0x000000")] (* "out_e2.out" *) "" @{context} 1\<close>)
 
 subsubsection \<open>Walter's analytical obtained by in section 9, Example V.\<close>
 
 lemma cos_neq_zeroI:
   assumes "-pi / 2 < x" "x < pi / 2"
   shows "cos x \<noteq> 0"
   using assms div2_less_self
   by (fastforce simp: cos_zero_iff)
 
 lemma quadratic_real_max_eq:
   fixes a b c x::real
   defines "xm \<equiv> -b / (2 * a)"
   shows "a < 0 \<Longrightarrow> a * x\<^sup>2 + b * x + c \<le> a * xm\<^sup>2 + b * xm + c"
   unfolding xm_def
   by (sos "(((((A<0 * (A<1 * A<2)) * R<1) + ((A<2 * R<1) * (R<1 * [a^2]^2)))) &
     ((((A<0 * (A<1 * A<2)) * R<1) + ((R<1 * (R<1/2 * [2*a^4*x + a^3*b]^2)) +
     ((A<0 * (A<1 * R<1)) * (R<1/2 * [2*a^2*x + a*b]^2))))))")
 
 definition "f = (\<lambda>t x. t\<^sup>2 + x\<^sup>2::real)"
 
 lemma ll: "local_lipschitz UNIV UNIV f"
   by (rule c1_implies_local_lipschitz[where f'="\<lambda>(t, x). blinfun_scaleR_left (blinfun_scaleR_left id_blinfun 2) x"])
     (auto intro!: continuous_intros derivative_eq_intros ext simp: f_def split_beta' blinfun.bilinear_simps)
 
 lemma cont: "continuous_on UNIV (\<lambda>t. f t x)"
   by (auto intro!: continuous_intros simp: f_def)
 
 interpretation ll_on_open_real UNIV f UNIV by unfold_locales (auto intro!: ll cont)
 
 definition f1::"real \<Rightarrow> real \<Rightarrow> real" where "f1 t x \<equiv> x\<^sup>2"
 definition v::"real \<Rightarrow> real" where "v t = 1 / (1 - t)"
 
 lemma v: "(v solves_ode f1) {0..<1} UNIV" and "v 0 = 1"
   by (auto intro!: solves_odeI derivative_eq_intros ext
     simp: v_def has_vderiv_on_def f1_def has_vector_derivative_def divide_simps power2_eq_square)
 
 lemma
   lower_bound:
   assumes y: "(y solves_ode f) {0 ..< t1} UNIV"
     and iv: "y 0 = 1"
     and t: "t1 < 1" "t \<in> {0 ..< t1}"
   shows "v t \<le> y t"
   using y[THEN solves_ode_on_subset] solves_odeD(1)[OF v, THEN has_vderiv_on_subset]
   apply (rule lower_solution[where ?t0.0 = 0])
   using t
   by (auto simp: f1_def f_def v_def iv)
 
 definition f2::"real \<Rightarrow> real \<Rightarrow> real" where "f2 t x \<equiv> 1 + x\<^sup>2"
 definition w::"real \<Rightarrow> real" where "w t = tan (t + pi / 4)"
 
 lemma w: "(w solves_ode f2) {0..<pi/4} UNIV" and "w 0 = 1"
   by (auto intro!: solves_odeI derivative_eq_intros ext
     simp: w_def has_vderiv_on_def f2_def has_vector_derivative_def cos_neq_zeroI
       tan_45 tan_sec divide_simps)
 
 lemma upper_bound:
   assumes y: "(y solves_ode f) {0 ..< t1} UNIV"
     and iv: "y 0 = 1"
     and t: "t1 < pi / 4" "t \<in> {0 ..< t1}"
   shows "y t \<le> w t"
   using y[THEN solves_ode_on_subset] solves_odeD(1)[OF w,THEN has_vderiv_on_subset]
   apply (rule upper_solution[where ?t0.0 = 0])
   using t pi_less_4
   by (auto simp: f2_def f_def w_def iv abs_square_less_1 tan_45)
 
 context
   fixes a::real
   assumes a: "a > 1"
   assumes cond: "1 < 16 * a\<^sup>2 * (a - 1)"
 begin
 
 definition w1::"real \<Rightarrow> real" where "w1 t = 1 / (1 - a * t)"
 definition w1'::"real \<Rightarrow> real" where "w1' t = a / ((1 - a * t)\<^sup>2)"
 
 lemma w1_lower:
   assumes s: "s < 1 / a" "0 < s"
   shows "f s (w1 s) < w1' s"
 proof -
   define smax where "smax \<equiv> 1 / (2 * a)"
   have "a - 1 > (1 - a * s)\<^sup>2 * s\<^sup>2"
   proof -
     have "sqrt ((1 - a * s)\<^sup>2 * s\<^sup>2) = (1 - a * s) * s"
       using a s
       by (auto simp: power_mult_distrib[symmetric] algebra_simps divide_simps
         split: if_split_asm)
     also have "\<dots> = (- a) * s\<^sup>2 + 1 * s + 0" by (simp add: algebra_simps power2_eq_square)
     also have "\<dots> \<le> (1 - a * smax) * smax"
       apply (rule order_trans[OF quadratic_real_max_eq])
       using a s
       by (auto simp: smax_def divide_simps algebra_simps power2_eq_square)
     finally have "((1 - a * s)\<^sup>2 * s\<^sup>2) \<le> (1 - a * smax)\<^sup>2 * smax\<^sup>2"
       unfolding power_mult_distrib[symmetric]
       by (simp add: sqrt_le_D)
     also have "\<dots> < a - 1"
       using a s cond
       by (auto simp add: smax_def power2_eq_square algebra_simps  divide_simps split: if_splits)
     finally show ?thesis .
   qed
   then have "s\<^sup>2 < (a - 1) / (1 - a * s)\<^sup>2"
     using a s
     by (auto simp: divide_simps algebra_simps)
   then have "s\<^sup>2 + (1 / (1 - a * s))\<^sup>2 < a / (1 - a * s)\<^sup>2"
     by (simp add: diff_divide_distrib algebra_simps power_one_over)
   then show ?thesis by (simp add: w1_def w1'_def f_def)
 qed
 
 lemma w1: "(w1 has_vderiv_on w1') {0..<1/a}"
   by (auto intro!: derivative_eq_intros split: if_splits
     simp: w1_def w1'_def has_vderiv_on_def has_vector_derivative_def
       algebra_simps divide_simps power2_eq_square)
 
 lemma upper_bound1:
   assumes y: "(y solves_ode f) {0 ..< t1} UNIV"
     and iv: "y 0 = 1"
     and t: "t1 < 1 / a" "t \<in> {0 ..< t1}"
   shows "y t \<le> w1 t"
 proof -
   have less_one: "s * a < 1" if a1: "s < t1" and a2: "t1 * a < 1" for s
   proof -
     have "0 < a"
       using a by linarith
     then have "a * s \<le> t1 * a"
-      using a1 by (metis (no_types) less_eq_real_def mult.commute real_mult_le_cancel_iff2)
+      using a1 by (metis (no_types) less_eq_real_def mult.commute mult_le_cancel_iff2)
     then have "a * s < 1"
       using a2 by linarith
     then show ?thesis
       by (metis mult.commute)
   qed
   show ?thesis
     using y[THEN solves_ode_on_subset] w1[THEN has_vderiv_on_subset] w1_lower
     apply (rule upper_solution[where ?t0.0 = 0 and S = "{0 ..< t1}"])
     using t a
     by (auto simp: less_one w1_def f_def w1'_def iv divide_simps)
 qed
 
 end
 
 definition w16::"real \<Rightarrow> real" where "w16 t = 16 / (16 - 17 * t)"
 
 lemma upper_bound16:
   assumes y: "(y solves_ode f) {0 ..< t1} UNIV"
     and iv: "y 0 = 1"
     and t: "t1 < 16 / 17" "t \<in> {0 ..< t1}"
   shows "y t \<le> w16 t"
   using upper_bound1[of "17/16" y t1 t] assms
   by (simp add: divide_simps w1_def w16_def)
 
 lemma approx_lower_bound:
   "1.142857139 \<le> v 0.125"
   unfolding v_def
   by (approximation 40)
 
 lemma approx_upper_bound:
   "w 0.125 \<le> 1.287426955"
   unfolding w_def
   by (approximation 40)
 
 lemma approx_upper_bound16:
   "w16 0.125 \<le> 1.153153155"
   unfolding w16_def
   by (approximation 40)
 
 end
 
 subsection \<open>Building\<close>
 experiment begin
 
 text \<open>Benchmark from the ARCH friendly competition: group AFF. This example is out of the scope of
 the current ODE solver: dimension is very high, and without matrix exponential, the ODE solver is
 too unstable.\<close>
 
 definition "x1'  x == x ! 25"
 definition "x2'  x == x ! 26"
 definition "x3'  x == x ! 27"
 definition "x4'  x == x ! 28"
 definition "x5'  x == x ! 29"
 definition "x6'  x == x ! 30"
 definition "x7'  x == x ! 31"
 definition "x8'  x == x ! 32"
 definition "x9'  x == x ! 33"
 definition "x10' x == x ! 34"
 definition "x11' x == x ! 35"
 definition "x12' x == x ! 36"
 definition "x13' x == x ! 37"
 definition "x14' x == x ! 38"
 definition "x15' x == x ! 39"
 definition "x16' x == x ! 40"
 definition "x17' x == x ! 41"
 definition "x18' x == x ! 42"
 definition "x19' x == x ! 43"
 definition "x20' x == x ! 44"
 definition "x21' x == x ! 45"
 definition "x22' x == x ! 46"
 definition "x23' x == x ! 47"
 definition "x24' x == x ! 48"
 definition "x25' x == 0.013697*(x!49) - 606.16*x!1 + 34.67*x!2 - 5.0432*x!3 - 734.04*x!4 + 124.55*x!5 - 302.91*x!6 - 98.21*x!7 - 2.204*x!8 - 10.668*x!9 - 41.864*x!10 + 8.1784*x!11 + 51.36*x!12 - 10.956*x!13 - 2.3086*x!14 - 11.998*x!15 - 42.003*x!16 + 4.9418*x!17 - 1.5216*x!18 - 10.35*x!19 + 8.6969*x!20 + 14.96*x!21 + 37.885*x!22 - 24.546*x!23 - 19.3*x!24 - 1.1333*x!25 + 0.036523*x!26 - 0.0053128*x!27 - 0.77328*x!28 + 0.13121*x!29 - 0.3191*x!30 - 0.10346*x!31 - 0.0023218*x!32 - 0.011238*x!33 - 0.044102*x!34 + 0.0086155*x!35 + 0.054106*x!36 - 0.011541*x!37 - 0.002432*x!38 - 0.012639*x!39 - 0.044248*x!40 + 0.0052059*x!41 - 0.0016029*x!42 - 0.010904*x!43 + 0.0091618*x!44 + 0.01576*x!45 + 0.03991*x!46 - 0.025858*x!47 - 0.020331*x!48"
 definition "x26' x == 33.51*x!1 - 664.52*x!2 + 79.773*x!3 + 207.45*x!4 + 829.03*x!5 + 94.055*x!6 - 4.3133*x!7 - 136.48*x!8 + 16.276*x!9 + 28.243*x!10 - 76.936*x!11 - 0.55452*x!12 + 30.931*x!13 + 51.904*x!14 + 11.87*x!15 + 9.6948*x!16 - 15.613*x!17 + 15.14*x!18 + 7.6133*x!19 - 5.7122*x!20 + 3.7841*x!21 - 21.172*x!22 - 29.014*x!23 + 10.245*x!24 + 0.035301*x!25 - 1.1948*x!26 + 0.084037*x!27 + 0.21854*x!28 + 0.87334*x!29 + 0.099082*x!30 - 0.0045438*x!31 - 0.14378*x!32 + 0.017146*x!33 + 0.029753*x!34 - 0.081048*x!35 - 0.00058416*x!36 + 0.032585*x!37 + 0.054679*x!38 + 0.012505*x!39 + 0.010213*x!40 - 0.016447*x!41 + 0.01595*x!42 + 0.0080202*x!43 - 0.0060176*x!44 + 0.0039864*x!45 - 0.022303*x!46 - 0.030565*x!47 + 0.010792*x!48"
 definition "x27' x == 76.572*x!2 - 3.4577*x!1 - 799.41*x!3 - 347.78*x!4 - 142.59*x!5 + 867.7*x!6 - 165.08*x!7 + 36.992*x!8 + 91.256*x!9 - 66.266*x!10 + 26.434*x!11 + 39.519*x!12 + 67.373*x!13 - 32.177*x!14 + 17.164*x!15 + 133.45*x!16 + 34.378*x!17 + 6.5652*x!18 + 27.869*x!19 - 51.473*x!20 + 41.979*x!21 - 44.928*x!22 + 34.417*x!23 + 30.824*x!24 - 0.0036425*x!25 + 0.080665*x!26 - 1.3369*x!27 - 0.36637*x!28 - 0.15021*x!29 + 0.91408*x!30 - 0.17391*x!31 + 0.038969*x!32 + 0.096134*x!33 - 0.069808*x!34 + 0.027847*x!35 + 0.041632*x!36 + 0.070975*x!37 - 0.033897*x!38 + 0.018082*x!39 + 0.14058*x!40 + 0.036215*x!41 + 0.0069161*x!42 + 0.029358*x!43 - 0.054224*x!44 + 0.044223*x!45 - 0.04733*x!46 + 0.036257*x!47 + 0.032471*x!48"
 definition "x28' x == 206.8*x!2 - 734.86*x!1 - 348.32*x!3 - 1910.4*x!4 - 135.41*x!5 - 218.05*x!6 - 1130.0*x!7 + 263.61*x!8 - 178.6*x!9 - 285.02*x!10 + 65.125*x!11 + 125.09*x!12 - 78.164*x!13 - 2.0288*x!14 + 11.414*x!15 - 54.481*x!16 - 17.625*x!17 - 14.273*x!18 - 13.334*x!19 + 11.514*x!20 + 88.076*x!21 + 56.304*x!22 - 12.53*x!23 + 19.497*x!24 - 0.77414*x!25 + 0.21785*x!26 - 0.36694*x!27 - 2.5072*x!28 - 0.14264*x!29 - 0.2297*x!30 - 1.1904*x!31 + 0.2777*x!32 - 0.18815*x!33 - 0.30026*x!34 + 0.068606*x!35 + 0.13177*x!36 - 0.082342*x!37 - 0.0021372*x!38 + 0.012024*x!39 - 0.057393*x!40 - 0.018567*x!41 - 0.015036*x!42 - 0.014047*x!43 + 0.012129*x!44 + 0.092784*x!45 + 0.059314*x!46 - 0.013199*x!47 + 0.020539*x!48"
 definition "x29' x == 126.41*x!1 + 830.41*x!2 - 142.11*x!3 - 134.84*x!4 - 1968.7*x!5 + 54.561*x!6 + 141.8*x!7 + 1183.9*x!8 + 118.23*x!9 - 32.897*x!10 + 295.19*x!11 - 13.727*x!12 - 6.9809*x!13 - 150.49*x!14 - 16.631*x!15 + 76.503*x!16 + 25.453*x!17 + 26.848*x!18 + 8.696*x!19 - 20.18*x!20 - 16.511*x!21 + 8.533*x!22 + 112.09*x!23 + 9.1024*x!24 + 0.13317*x!25 + 0.8748*x!26 - 0.14971*x!27 - 0.14205*x!28 - 2.5687*x!29 + 0.057478*x!30 + 0.14938*x!31 + 1.2472*x!32 + 0.12455*x!33 - 0.034656*x!34 + 0.31097*x!35 - 0.014461*x!36 - 0.0073541*x!37 - 0.15853*x!38 - 0.01752*x!39 + 0.080592*x!40 + 0.026813*x!41 + 0.028283*x!42 + 0.0091609*x!43 - 0.021259*x!44 - 0.017394*x!45 + 0.0089891*x!46 + 0.11808*x!47 + 0.009589*x!48"
 definition "x30' x == 89.14*x!2 - 308.62*x!1 + 845.85*x!3 - 220.15*x!4 + 49.494*x!5 - 2326.8*x!6 + 132.76*x!7 + 67.169*x!8 - 1400.6*x!9 + 24.168*x!10 + 24.278*x!11 - 85.266*x!12 - 294.4*x!13 + 127.92*x!14 - 24.456*x!15 - 379.06*x!16 - 100.16*x!17 - 46.537*x!18 - 67.411*x!19 + 169.3*x!20 - 100.19*x!21 + 200.07*x!22 - 126.91*x!23 - 44.045*x!24 - 0.32511*x!25 + 0.093904*x!26 + 0.89106*x!27 - 0.23192*x!28 + 0.052139*x!29 - 2.9459*x!30 + 0.13986*x!31 + 0.07076*x!32 - 1.4755*x!33 + 0.02546*x!34 + 0.025576*x!35 - 0.089824*x!36 - 0.31014*x!37 + 0.13476*x!38 - 0.025763*x!39 - 0.39932*x!40 - 0.10551*x!41 - 0.049024*x!42 - 0.071015*x!43 + 0.17835*x!44 - 0.10555*x!45 + 0.21077*x!46 - 0.13369*x!47 - 0.046399*x!48"
 definition "x31' x == 140.17*x!5 - 3.2644*x!2 - 166.03*x!3 - 1130.1*x!4 - 97.135*x!1 + 149.9*x!6 - 2042.2*x!7 + 77.153*x!8 + 122.7*x!9 - 1223.6*x!10 - 66.505*x!11 + 249.18*x!12 - 16.632*x!13 + 2.6274*x!14 + 56.399*x!15 - 46.871*x!16 - 118.4*x!17 - 62.011*x!18 - 2.1658*x!19 - 30.269*x!20 + 130.25*x!21 + 5.2191*x!22 - 24.931*x!23 + 6.3303*x!24 - 0.10233*x!25 - 0.0034389*x!26 - 0.17491*x!27 - 1.1905*x!28 + 0.14767*x!29 + 0.15792*x!30 - 2.6461*x!31 + 0.081277*x!32 + 0.12926*x!33 - 1.289*x!34 - 0.07006*x!35 + 0.2625*x!36 - 0.01752*x!37 + 0.0027678*x!38 + 0.059414*x!39 - 0.049377*x!40 - 0.12472*x!41 - 0.065326*x!42 - 0.0022816*x!43 - 0.031887*x!44 + 0.13721*x!45 + 0.005498*x!46 - 0.026264*x!47 + 0.0066687*x!48"
 definition "x32' x == 34.596*x!3 - 138.29*x!2 - 2.5435*x!1 + 264.02*x!4 + 1185.0*x!5 + 58.931*x!6 + 77.078*x!7 - 2124.4*x!8 - 54.178*x!9 + 240.2*x!10 - 1279.6*x!11 + 14.033*x!12 + 37.313*x!13 + 238.99*x!14 + 1.7648*x!15 - 96.468*x!16 + 33.324*x!17 - 103.99*x!18 - 129.69*x!19 + 35.961*x!20 + 34.916*x!21 - 10.09*x!22 - 99.84*x!23 - 13.713*x!24 - 0.0026795*x!25 - 0.14568*x!26 + 0.036445*x!27 + 0.27814*x!28 + 1.2484*x!29 + 0.062081*x!30 + 0.081198*x!31 - 2.7327*x!32 - 0.057074*x!33 + 0.25304*x!34 - 1.348*x!35 + 0.014783*x!36 + 0.039308*x!37 + 0.25177*x!38 + 0.0018592*x!39 - 0.10162*x!40 + 0.035106*x!41 - 0.10955*x!42 - 0.13662*x!43 + 0.037884*x!44 + 0.036783*x!45 - 0.010629*x!46 - 0.10518*x!47 - 0.014446*x!48"
 definition "x33' x == 54.576*x!3 - 4.3846*x!2 - 11.068*x!1 - 167.43*x!4 + 119.06*x!5 - 1413.1*x!6 + 116.3*x!7 - 50.978*x!8 - 2668.8*x!9 + 58.12*x!10 + 61.221*x!11 - 299.51*x!12 - 1455.4*x!13 + 600.59*x!14 - 14.962*x!15 - 609.81*x!16 - 179.98*x!17 - 140.89*x!18 - 67.425*x!19 + 261.44*x!20 - 215.8*x!21 + 374.46*x!22 - 267.83*x!23 - 167.39*x!24 - 0.01166*x!25 - 0.004619*x!26 + 0.057493*x!27 - 0.17638*x!28 + 0.12543*x!29 - 1.4886*x!30 + 0.12251*x!31 - 0.053703*x!32 - 3.3062*x!33 + 0.061226*x!34 + 0.064493*x!35 - 0.31552*x!36 - 1.5332*x!37 + 0.63269*x!38 - 0.015762*x!39 - 0.6424*x!40 - 0.1896*x!41 - 0.14842*x!42 - 0.071029*x!43 + 0.27541*x!44 - 0.22734*x!45 + 0.39448*x!46 - 0.28215*x!47 - 0.17634*x!48"
 definition "x34' x == 29.028*x!2 - 42.219*x!1 - 59.833*x!3 - 284.78*x!4 - 31.96*x!5 + 16.189*x!6 - 1220.6*x!7 + 238.17*x!8 + 45.965*x!9 - 2290.9*x!10 + 219.74*x!11 + 1329.3*x!12 - 104.55*x!13 - 231.45*x!14 + 196.73*x!15 - 91.293*x!16 - 418.1*x!17 - 203.17*x!18 + 77.147*x!19 - 64.407*x!20 + 127.6*x!21 - 66.422*x!22 + 17.647*x!23 + 14.772*x!24 - 0.044476*x!25 + 0.03058*x!26 - 0.063031*x!27 - 0.3*x!28 - 0.033668*x!29 + 0.017054*x!30 - 1.2858*x!31 + 0.2509*x!32 + 0.048422*x!33 - 2.9081*x!34 + 0.23149*x!35 + 1.4003*x!36 - 0.11014*x!37 - 0.24382*x!38 + 0.20725*x!39 - 0.096173*x!40 - 0.44045*x!41 - 0.21403*x!42 + 0.08127*x!43 - 0.06785*x!44 + 0.13442*x!45 - 0.069972*x!46 + 0.01859*x!47 + 0.015562*x!48"
 definition "x35' x == 5.3147*x!1 - 77.32*x!2 + 33.098*x!3 + 62.873*x!4 + 295.95*x!5 + 11.239*x!6 - 66.808*x!7 - 1279.2*x!8 + 57.198*x!9 + 221.07*x!10 - 2387.6*x!11 + 120.01*x!12 + 572.58*x!13 + 1229.1*x!14 + 124.63*x!15 - 56.089*x!16 + 180.3*x!17 - 312.48*x!18 - 445.95*x!19 - 24.274*x!20 + 86.343*x!21 - 2.8317*x!22 - 45.574*x!23 - 33.346*x!24 + 0.0055988*x!25 - 0.081453*x!26 + 0.034867*x!27 + 0.066234*x!28 + 0.31177*x!29 + 0.011839*x!30 - 0.070379*x!31 - 1.3476*x!32 + 0.060255*x!33 + 0.23288*x!34 - 3.0099*x!35 + 0.12643*x!36 + 0.60318*x!37 + 1.2948*x!38 + 0.13129*x!39 - 0.059087*x!40 + 0.18994*x!41 - 0.32918*x!42 - 0.46979*x!43 - 0.025571*x!44 + 0.090958*x!45 - 0.002983*x!46 - 0.04801*x!47 - 0.035129*x!48"
 definition "x36' x == 48.409*x!1 - 3.7335*x!2 + 32.385*x!3 + 123.4*x!4 - 10.509*x!5 - 100.46*x!6 + 251.0*x!7 + 15.115*x!8 - 306.96*x!9 + 1327.9*x!10 + 119.59*x!11 - 2059.6*x!12 - 316.77*x!13 + 309.66*x!14 - 870.95*x!15 - 176.05*x!16 + 612.8*x!17 + 311.81*x!18 - 23.027*x!19 + 201.61*x!20 - 171.24*x!21 + 169.57*x!22 - 91.873*x!23 - 44.001*x!24 + 0.050997*x!25 - 0.0039331*x!26 + 0.034116*x!27 + 0.13*x!28 - 0.011071*x!29 - 0.10583*x!30 + 0.26442*x!31 + 0.015922*x!32 - 0.32337*x!33 + 1.3989*x!34 + 0.12598*x!35 - 2.6645*x!36 - 0.3337*x!37 + 0.32621*x!38 - 0.9175*x!39 - 0.18546*x!40 + 0.64555*x!41 + 0.32848*x!42 - 0.024258*x!43 + 0.21239*x!44 - 0.18039*x!45 + 0.17864*x!46 - 0.096784*x!47 - 0.046353*x!48"
 definition "x37' x == 16.772*x!2 - 18.711*x!1 + 31.337*x!3 - 86.799*x!4 - 1.8261*x!5 - 326.22*x!6 - 26.875*x!7 + 48.423*x!8 - 1444.1*x!9 - 111.75*x!10 + 580.84*x!11 - 316.97*x!12 - 2618.4*x!13 + 213.69*x!14 - 227.06*x!15 - 1560.3*x!16 - 475.12*x!17 + 287.08*x!18 + 62.345*x!19 + 349.71*x!20 - 307.69*x!21 + 551.86*x!22 - 413.54*x!23 - 278.79*x!24 - 0.019712*x!25 + 0.017669*x!26 + 0.033012*x!27 - 0.091439*x!28 - 0.0019237*x!29 - 0.34366*x!30 - 0.028311*x!31 + 0.051011*x!32 - 1.5212*x!33 - 0.11773*x!34 + 0.61189*x!35 - 0.33391*x!36 - 3.2531*x!37 + 0.22511*x!38 - 0.23919*x!39 - 1.6437*x!40 - 0.50052*x!41 + 0.30242*x!42 + 0.065677*x!43 + 0.36841*x!44 - 0.32414*x!45 + 0.58136*x!46 - 0.43564*x!47 - 0.29369*x!48"
 definition "x38' x == 2.1605*x!1 + 59.152*x!2 - 19.397*x!3 + 2.4357*x!4 - 153.32*x!5 + 143.74*x!6 + 5.1672*x!7 + 235.26*x!8 + 606.81*x!9 - 229.22*x!10 + 1225.8*x!11 + 308.88*x!12 + 220.47*x!13 - 2060.7*x!14 - 41.024*x!15 + 847.46*x!16 - 549.36*x!17 + 704.76*x!18 + 575.93*x!19 - 182.76*x!20 + 62.77*x!21 - 246.62*x!22 + 238.45*x!23 + 159.35*x!24 + 0.002276*x!25 + 0.062314*x!26 - 0.020434*x!27 + 0.0025659*x!28 - 0.16151*x!29 + 0.15142*x!30 + 0.0054434*x!31 + 0.24784*x!32 + 0.63924*x!33 - 0.24147*x!34 + 1.2913*x!35 + 0.32539*x!36 + 0.23225*x!37 - 2.6656*x!38 - 0.043217*x!39 + 0.89276*x!40 - 0.57872*x!41 + 0.74243*x!42 + 0.60672*x!43 - 0.19253*x!44 + 0.066125*x!45 - 0.2598*x!46 + 0.25119*x!47 + 0.16786*x!48"
 definition "x39' x == 11.65*x!2 - 11.108*x!1 + 6.8996*x!3 + 10.745*x!4 - 14.165*x!5 - 24.224*x!6 + 58.6*x!7 + 1.0473*x!8 - 23.411*x!9 + 194.71*x!10 + 124.74*x!11 - 874.49*x!12 - 232.17*x!13 - 36.538*x!14 - 982.44*x!15 - 164.62*x!16 + 658.46*x!17 + 612.29*x!18 + 81.858*x!19 + 340.63*x!20 - 202.91*x!21 + 81.196*x!22 - 56.024*x!23 - 15.279*x!24 - 0.011702*x!25 + 0.012273*x!26 + 0.0072684*x!27 + 0.01132*x!28 - 0.014922*x!29 - 0.025519*x!30 + 0.061732*x!31 + 0.0011033*x!32 - 0.024662*x!33 + 0.20512*x!34 + 0.1314*x!35 - 0.92123*x!36 - 0.24458*x!37 - 0.038491*x!38 - 1.5297*x!39 - 0.17342*x!40 + 0.69366*x!41 + 0.64502*x!42 + 0.086233*x!43 + 0.35883*x!44 - 0.21375*x!45 + 0.085536*x!46 - 0.059019*x!47 - 0.016096*x!48"
 definition "x40' x == 0.34677*x!2 - 45.16*x!1 + 87.266*x!3 - 58.989*x!4 + 81.86*x!5 - 393.99*x!6 - 43.617*x!7 - 87.105*x!8 - 585.65*x!9 - 95.775*x!10 - 55.621*x!11 - 175.4*x!12 - 1550.2*x!13 + 849.01*x!14 - 150.24*x!15 - 2831.0*x!16 - 714.73*x!17 - 306.41*x!18 - 276.74*x!19 + 1235.6*x!20 - 213.26*x!21 + 900.37*x!22 - 708.02*x!23 - 408.51*x!24 - 0.047574*x!25 + 0.00036531*x!26 + 0.09193*x!27 - 0.062142*x!28 + 0.086236*x!29 - 0.41505*x!30 - 0.045948*x!31 - 0.091761*x!32 - 0.61696*x!33 - 0.10089*x!34 - 0.058594*x!35 - 0.18478*x!36 - 1.633*x!37 + 0.89439*x!38 - 0.15827*x!39 - 3.477*x!40 - 0.75293*x!41 - 0.32279*x!42 - 0.29153*x!43 + 1.3016*x!44 - 0.22465*x!45 + 0.94849*x!46 - 0.74586*x!47 - 0.43035*x!48"
 definition "x41' x == 3.5059*x!1 - 19.002*x!2 + 24.585*x!3 - 17.341*x!4 + 25.7*x!5 - 100.44*x!6 - 121.83*x!7 + 37.286*x!8 - 153.78*x!9 - 417.65*x!10 + 181.1*x!11 + 615.65*x!12 - 480.91*x!13 - 550.2*x!14 + 663.43*x!15 - 703.07*x!16 - 2922.4*x!17 - 629.58*x!18 + 982.78*x!19 - 72.585*x!20 + 517.72*x!21 + 573.36*x!22 - 34.103*x!23 - 92.294*x!24 + 0.0036933*x!25 - 0.020017*x!26 + 0.025899*x!27 - 0.018268*x!28 + 0.027073*x!29 - 0.1058*x!30 - 0.12834*x!31 + 0.039279*x!32 - 0.162*x!33 - 0.43998*x!34 + 0.19078*x!35 + 0.64856*x!36 - 0.50662*x!37 - 0.57961*x!38 + 0.69889*x!39 - 0.74065*x!40 - 3.5734*x!41 - 0.66323*x!42 + 1.0353*x!43 - 0.076465*x!44 + 0.54539*x!45 + 0.60401*x!46 - 0.035926*x!47 - 0.097227*x!48"
 definition "x42' x == 11.689*x!2 - 6.541*x!1 + 14.446*x!3 - 16.841*x!4 + 27.253*x!5 - 50.506*x!6 - 63.95*x!7 - 102.32*x!8 - 140.13*x!9 - 204.16*x!10 - 309.41*x!11 + 316.39*x!12 + 287.25*x!13 + 700.16*x!14 + 615.11*x!15 - 292.97*x!16 - 628.33*x!17 - 1965.7*x!18 - 1181.8*x!19 - 160.14*x!20 + 504.08*x!21 + 10.684*x!22 - 328.24*x!23 - 67.729*x!24 - 0.0068906*x!25 + 0.012313*x!26 + 0.015219*x!27 - 0.017741*x!28 + 0.028709*x!29 - 0.053205*x!30 - 0.067368*x!31 - 0.10779*x!32 - 0.14762*x!33 - 0.21507*x!34 - 0.32595*x!35 + 0.33331*x!36 + 0.3026*x!37 + 0.73758*x!38 + 0.64799*x!39 - 0.30863*x!40 - 0.66191*x!41 - 2.5655*x!42 - 1.245*x!43 - 0.16869*x!44 + 0.53103*x!45 + 0.011255*x!46 - 0.34578*x!47 - 0.071349*x!48"
 definition "x43' x == 5.9383*x!2 - 11.411*x!1 + 26.834*x!3 - 15.359*x!4 + 6.1346*x!5 - 51.136*x!6 - 1.6072*x!7 - 127.63*x!8 - 64.662*x!9 + 76.069*x!10 - 444.22*x!11 - 20.062*x!12 + 77.799*x!13 + 570.73*x!14 + 84.558*x!15 - 263.82*x!16 + 983.07*x!17 - 1184.4*x!18 - 2653.4*x!19 + 240.05*x!20 + 17.029*x!21 - 433.29*x!22 - 721.56*x!23 - 85.171*x!24 - 0.012021*x!25 + 0.0062557*x!26 + 0.028268*x!27 - 0.01618*x!28 + 0.0064625*x!29 - 0.05387*x!30 - 0.0016931*x!31 - 0.13445*x!32 - 0.068118*x!33 + 0.080135*x!34 - 0.46796*x!35 - 0.021135*x!36 + 0.081958*x!37 + 0.60124*x!38 + 0.089078*x!39 - 0.27792*x!40 + 1.0356*x!41 - 1.2477*x!42 - 3.2899*x!43 + 0.25288*x!44 + 0.017939*x!45 - 0.45645*x!46 - 0.76013*x!47 - 0.089724*x!48"
 definition "x44' x == 10.661*x!1 + 0.75629*x!2 - 31.37*x!3 + 18.757*x!4 - 29.414*x!5 + 193.91*x!6 - 34.395*x!7 + 32.908*x!8 + 271.89*x!9 - 54.429*x!10 - 33.158*x!11 + 199.94*x!12 + 354.88*x!13 - 181.87*x!14 + 333.88*x!15 + 1248.3*x!16 - 59.084*x!17 - 157.94*x!18 + 239.26*x!19 - 1528.9*x!20 + 772.83*x!21 - 858.92*x!22 + 734.27*x!23 + 372.63*x!24 + 0.011231*x!25 + 0.00079672*x!26 - 0.033047*x!27 + 0.01976*x!28 - 0.030986*x!29 + 0.20427*x!30 - 0.036234*x!31 + 0.034667*x!32 + 0.28643*x!33 - 0.057338*x!34 - 0.03493*x!35 + 0.21063*x!36 + 0.37385*x!37 - 0.19159*x!38 + 0.35173*x!39 + 1.315*x!40 - 0.062242*x!41 - 0.16638*x!42 + 0.25204*x!43 - 2.1053*x!44 + 0.81414*x!45 - 0.90483*x!46 + 0.77352*x!47 + 0.39255*x!48"
 definition "x45' x == 21.145*x!1 - 0.67362*x!2 + 25.339*x!3 + 82.664*x!4 - 18.143*x!5 - 108.58*x!6 + 131.04*x!7 + 40.675*x!8 - 205.5*x!9 + 125.37*x!10 + 92.038*x!11 - 169.72*x!12 - 294.36*x!13 + 57.772*x!14 - 200.48*x!15 - 211.37*x!16 + 512.5*x!17 + 500.79*x!18 + 15.006*x!19 + 785.7*x!20 - 3685.6*x!21 + 248.17*x!22 - 125.37*x!23 - 428.07*x!24 + 0.022275*x!25 - 0.00070963*x!26 + 0.026694*x!27 + 0.087083*x!28 - 0.019113*x!29 - 0.11438*x!30 + 0.13805*x!31 + 0.04285*x!32 - 0.21648*x!33 + 0.13207*x!34 + 0.096957*x!35 - 0.17879*x!36 - 0.31009*x!37 + 0.06086*x!38 - 0.2112*x!39 - 0.22266*x!40 + 0.5399*x!41 + 0.52756*x!42 + 0.015808*x!43 + 0.8277*x!44 - 4.3773*x!45 + 0.26143*x!46 - 0.13208*x!47 - 0.45095*x!48"
 definition "x46' x == 30.438*x!1 - 10.312*x!2 - 14.559*x!3 + 71.32*x!4 + 9.4074*x!5 + 217.12*x!6 + 3.4082*x!7 - 22.61*x!8 + 366.85*x!9 - 62.437*x!10 - 17.337*x!11 + 170.53*x!12 + 551.59*x!13 - 246.57*x!14 + 70.631*x!15 + 918.77*x!16 + 591.41*x!17 + 17.745*x!18 - 424.27*x!19 - 874.95*x!20 + 255.27*x!21 - 4294.4*x!22 + 510.73*x!23 + 1033.1*x!24 + 0.032064*x!25 - 0.010863*x!26 - 0.015337*x!27 + 0.075133*x!28 + 0.0099102*x!29 + 0.22872*x!30 + 0.0035904*x!31 - 0.023818*x!32 + 0.38646*x!33 - 0.065775*x!34 - 0.018263*x!35 + 0.17964*x!36 + 0.58107*x!37 - 0.25975*x!38 + 0.074406*x!39 + 0.96788*x!40 + 0.62302*x!41 + 0.018694*x!42 - 0.44695*x!43 - 0.92172*x!44 + 0.26891*x!45 - 5.0186*x!46 + 0.53803*x!47 + 1.0883*x!48"
 definition "x47' x == 11.835*x!3 - 37.47*x!2 - 18.027*x!1 - 25.981*x!4 + 110.26*x!5 - 133.09*x!6 - 21.113*x!7 - 89.428*x!8 - 265.96*x!9 + 11.486*x!10 - 31.545*x!11 - 88.775*x!12 - 389.13*x!13 + 228.95*x!14 - 47.085*x!15 - 703.45*x!16 - 45.639*x!17 - 333.53*x!18 - 724.09*x!19 + 748.64*x!20 - 119.88*x!21 + 488.53*x!22 - 3962.5*x!23 - 875.81*x!24 - 0.01899*x!25 - 0.039473*x!26 + 0.012468*x!27 - 0.027369*x!28 + 0.11615*x!29 - 0.1402*x!30 - 0.022242*x!31 - 0.094208*x!32 - 0.28018*x!33 + 0.0121*x!34 - 0.033231*x!35 - 0.093521*x!36 - 0.40993*x!37 + 0.24119*x!38 - 0.049602*x!39 - 0.74105*x!40 - 0.048079*x!41 - 0.35136*x!42 - 0.7628*x!43 + 0.78865*x!44 - 0.12629*x!45 + 0.51464*x!46 - 4.669*x!47 - 0.92262*x!48"
 definition "x48' x == 12.708*x!1 + 4.8669*x!2 - 6.4356*x!3 + 9.4963*x!4 + 3.5537*x!5 - 74.352*x!6 + 13.537*x!7 - 16.221*x!8 - 158.43*x!9 + 2.6078*x!10 - 31.934*x!11 - 48.095*x!12 - 252.14*x!13 + 158.72*x!14 - 25.236*x!15 - 416.39*x!16 - 103.09*x!17 - 75.108*x!18 - 90.118*x!19 + 375.82*x!20 - 425.25*x!21 + 1006.8*x!22 - 878.11*x!23 - 4455.6*x!24 + 0.013388*x!25 + 0.0051271*x!26 - 0.0067796*x!27 + 0.010004*x!28 + 0.0037436*x!29 - 0.078327*x!30 + 0.01426*x!31 - 0.017088*x!32 - 0.1669*x!33 + 0.0027471*x!34 - 0.033641*x!35 - 0.050665*x!36 - 0.26562*x!37 + 0.16721*x!38 - 0.026585*x!39 - 0.43865*x!40 - 0.1086*x!41 - 0.079123*x!42 - 0.094935*x!43 + 0.39591*x!44 - 0.44798*x!45 + 1.0606*x!46 - 0.92505*x!47 - 5.1884*x!48"
 definition "t'   x == 1"
 definition "u1   x == x ! 49"
 
 schematic_goal building_fas:
   "[t' X,  x1' X,  x2' X,  x3' X,  x4' X,  x5' X,  x6' X,  x7' X,  x8' X,  x9' X,
   x10' X, x11' X, x12' X, x13' X, x14' X, x15' X, x16' X, x17' X, x18' X, x19' X,
   x20' X, x21' X, x22' X, x23' X, x24' X, x25' X, x26' X, x27' X, x28' X, x29' X,
   x30' X, x31' X, x32' X, x33' X, x34' X, x35' X, x36' X, x37' X, x38' X, x39' X,
   x40' X, x41' X, x42' X, x43' X, x44' X, x45' X, x46' X, x47' X, x48' X, u1 X] =
   interpret_floatariths ?fas X"
   unfolding t'_def x1'_def  x2'_def  x3'_def  x4'_def  x5'_def  x6'_def  x7'_def  x8'_def  x9'_def
     x10'_def x11'_def x12'_def x13'_def x14'_def x15'_def x16'_def x17'_def x18'_def x19'_def
     x20'_def x21'_def x22'_def x23'_def x24'_def x25'_def x26'_def x27'_def x28'_def x29'_def
     x30'_def x31'_def x32'_def x33'_def x34'_def x35'_def x36'_def x37'_def x38'_def x39'_def
     x40'_def x41'_def x42'_def x43'_def x44'_def x45'_def x46'_def x47'_def x48'_def u1_def
   by (reify_floatariths)
 
 concrete_definition building_fas uses building_fas
 
 end
 
 end
diff --git a/thys/Perron_Frobenius/Perron_Frobenius.thy b/thys/Perron_Frobenius/Perron_Frobenius.thy
--- a/thys/Perron_Frobenius/Perron_Frobenius.thy
+++ b/thys/Perron_Frobenius/Perron_Frobenius.thy
@@ -1,272 +1,272 @@
 (* Author: R. Thiemann *)
 
 subsection \<open>Perron-Frobenius theorem via Brouwer's fixpoint theorem.\<close>
 
 theory Perron_Frobenius
 imports
   "HOL-Analysis.Brouwer_Fixpoint"
   Perron_Frobenius_Aux
 begin
 
 text \<open>We follow the textbook proof of Serre \cite[Theorem 5.2.1]{SerreMatrices}.\<close>
 
 context
   fixes A :: "complex ^ 'n ^ 'n :: finite"
   assumes rnnA: "real_non_neg_mat A"
 begin
 
 private abbreviation(input) sr where "sr \<equiv> spectral_radius A"
 
 private definition max_v_ev :: "(complex^'n) \<times> complex" where
   "max_v_ev = (SOME v_ev. eigen_vector A (fst v_ev) (snd v_ev)
   \<and> norm (snd v_ev) = sr)"
 
 private definition "max_v = (1 / norm1 (fst max_v_ev)) *\<^sub>R fst max_v_ev"
 private definition "max_ev = snd max_v_ev"
 
 private lemma max_v_ev:
   "eigen_vector A max_v max_ev"
   "norm max_ev = sr"
   "norm1 max_v = 1"
 proof -
   obtain v ev where id: "max_v_ev = (v,ev)" by force
   from spectral_radius_ev[of A] someI_ex[of "\<lambda> v_ev. eigen_vector A (fst v_ev) (snd v_ev)
   \<and> norm (snd v_ev) = sr", folded max_v_ev_def, unfolded id]
   have v: "eigen_vector A v ev" and ev: "norm ev = sr" by auto
   from normalize_eigen_vector[OF v] ev
   show "eigen_vector A max_v max_ev" "norm max_ev = sr" "norm1 max_v = 1"
     unfolding max_v_def max_ev_def id by auto
 qed
 
 text \<open>In the definition of S, we use the linear norm instead of the
   default euclidean norm which is defined via the type-class.
   The reason is that S is not convex if one uses the euclidean norm.\<close>
 
 private definition B :: "real ^ 'n ^ 'n" where "B \<equiv> \<chi> i j. Re (A $ i $ j)"
 private definition S where "S = {v :: real ^ 'n . norm1 v = 1 \<and> (\<forall> i. v $ i \<ge> 0) \<and>
   (\<forall> i. (B *v v) $ i \<ge> sr * (v $ i))}"
 private definition f :: "real ^ 'n \<Rightarrow> real ^ 'n" where
   "f v = (1 / norm1 (B *v v)) *\<^sub>R (B *v v)"
 
 private lemma closedS: "closed S"
   unfolding S_def matrix_vector_mult_def[abs_def]
 proof (intro closed_Collect_conj closed_Collect_all closed_Collect_le closed_Collect_eq)
   show "continuous_on UNIV norm1"
     by (simp add: continuous_at_imp_continuous_on)
 qed (auto intro!: continuous_intros continuous_on_component)
 
 private lemma boundedS: "bounded S"
 proof -
   {
     fix v :: "real ^ 'n"
     from norm1_ge_norm[of v] have "norm1 v = 1 \<Longrightarrow> norm v \<le> 1" by auto
   }
   thus ?thesis
   unfolding S_def bounded_iff
   by (auto intro!: exI[of _ 1])
 qed
 
 private lemma compactS: "compact S"
   using boundedS closedS
   by (simp add: compact_eq_bounded_closed)
 
 private lemmas rnn = real_non_neg_matD[OF rnnA]
 
 lemma B_norm: "B $ i $ j = norm (A $ i $ j)"
   using rnn[of i j]
   by (cases "A $ i $ j", auto simp: B_def)
 
 lemma mult_B_mono: assumes "\<And> i. v $ i \<ge> w $ i"
   shows "(B *v v) $ i \<ge> (B *v w) $ i" unfolding matrix_vector_mult_def vec_lambda_beta
   by (rule sum_mono, rule mult_left_mono[OF assms], unfold B_norm, auto)
 
 
 private lemma non_emptyS: "S \<noteq> {}"
 proof -
   let ?v = "(\<chi> i. norm (max_v $ i)) :: real ^ 'n"
   have "norm1 max_v = 1" by (rule max_v_ev(3))
   hence nv: "norm1 ?v = 1" unfolding norm1_def by auto
   {
     fix i
     have "sr * (?v $ i) = sr * norm (max_v $ i)" by auto
     also have "\<dots> = (norm max_ev) * norm (max_v $ i)" using max_v_ev by auto
     also have "\<dots> = norm ((max_ev *s max_v) $ i)" by (auto simp: norm_mult)
     also have "max_ev *s max_v = A *v max_v" using max_v_ev(1)[unfolded eigen_vector_def] by auto
     also have "norm ((A *v max_v) $ i) \<le> (B *v ?v) $ i"
       unfolding matrix_vector_mult_def vec_lambda_beta
       by (rule sum_norm_le, auto simp: norm_mult B_norm)
     finally have "sr * (?v $ i) \<le> (B *v ?v) $ i" .
   } note le = this
   have "?v \<in> S" unfolding S_def using nv le by auto
   thus ?thesis by blast
 qed
 
 private lemma convexS: "convex S"
 proof (rule convexI)
   fix v w a b
   assume *: "v \<in> S" "w \<in> S" "0 \<le> a" "0 \<le> b" "a + b = (1 :: real)"
   let ?lin = "a *\<^sub>R v + b *\<^sub>R w"
   from * have 1: "norm1 v = 1" "norm1 w = 1" unfolding S_def by auto
   have "norm1 ?lin = a * norm1 v + b * norm1 w"
     unfolding norm1_def sum_distrib_left sum.distrib[symmetric]
   proof (rule sum.cong)
     fix i :: 'n
     from * have "v $ i \<ge> 0" "w $ i \<ge> 0" unfolding S_def by auto
     thus "norm (?lin $ i) = a * norm (v $ i) + b * norm (w $ i)"
       using *(3-4) by auto
   qed simp
   also have "\<dots> = 1" using *(5) 1 by auto
   finally have norm1: "norm1 ?lin = 1" .
   {
     fix i
     from * have "0 \<le> v $ i" "sr * v $ i \<le> (B *v v) $ i" unfolding S_def by auto
     with \<open>a \<ge> 0\<close> have a: "a * (sr * v $ i) \<le> a * (B *v v) $ i" by (intro mult_left_mono)
     from * have "0 \<le> w $ i" "sr * w $ i \<le> (B *v w) $ i" unfolding S_def by auto
     with \<open>b \<ge> 0\<close> have b: "b * (sr * w $ i) \<le> b * (B *v w) $ i" by (intro mult_left_mono)
     from a b have "a * (sr * v $ i) + b * (sr * w $ i) \<le> a * (B *v v) $ i + b * (B *v w) $ i" by auto
   } note le = this
   have switch[simp]: "\<And> x y. x * a * y = a * x * y"  "\<And> x y. x * b * y = b * x * y" by auto
   have [simp]: "x \<in> {v,w} \<Longrightarrow> a * (r * x $h i) = r * (a * x $h i)" for a r i x by auto
   show "a *\<^sub>R v + b *\<^sub>R w \<in> S" using * norm1 le unfolding S_def
     by (auto simp: matrix_vect_scaleR matrix_vector_right_distrib ring_distribs)
 qed
 
 private abbreviation (input) r :: "real \<Rightarrow> complex" where
   "r \<equiv> of_real"
 
 private abbreviation rv :: "real ^'n \<Rightarrow> complex ^'n" where
   "rv v \<equiv> \<chi> i. r (v $ i)"
 
 private lemma rv_0: "(rv v = 0) = (v = 0)"
   by (simp add: of_real_hom.map_vector_0 map_vector_def vec_eq_iff)
 
 private lemma rv_mult: "A *v rv v = rv (B *v v)"
 proof -
   have "map_matrix r B = A"
     using rnnA unfolding map_matrix_def B_def real_non_neg_mat_def map_vector_def elements_mat_h_def
     by vector
   thus ?thesis
     using of_real_hom.matrix_vector_mult_hom[of B, where 'a = complex]
     unfolding map_vector_def by auto
 qed
 
 context
   assumes zero_no_ev: "\<And> v. v \<in> S \<Longrightarrow> A *v rv v \<noteq> 0"
 begin
 private lemma normB_S: assumes v: "v \<in> S"
   shows "norm1 (B *v v) \<noteq> 0"
 proof -
   from zero_no_ev[OF v, unfolded rv_mult rv_0]
   show ?thesis by auto
 qed
 
 private lemma image_f: "f ` S \<subseteq> S"
 proof -
   {
     fix v
     assume v: "v \<in> S"
     hence norm: "norm1 v = 1" and ge: "\<And> i. v $ i \<ge> 0" "\<And> i. sr * v $ i \<le> (B *v v) $ i" unfolding S_def by auto
     from normB_S[OF v] have normB: "norm1 (B *v v) > 0" using norm1_nonzero by auto
     have fv: "f v = (1 / norm1 (B *v v)) *\<^sub>R (B *v v)" unfolding f_def by auto
     from normB have Bv0: "B *v v \<noteq> 0" unfolding norm1_0_iff[symmetric] by linarith
     have norm: "norm1 (f v) = 1" unfolding fv using normB Bv0 by simp
     define c where "c = (1 / norm1 (B *v v))"
     have c: "c > 0" unfolding c_def using normB by auto
     {
       fix i
       have 1: "f v $ i \<ge> 0" unfolding fv c_def[symmetric] using c ge
         by (auto simp: matrix_vector_mult_def sum_distrib_left B_norm intro!: sum_nonneg)
       have id1: "\<And> i. (B *v f v) $ i = c * ((B *v (B *v v)) $ i)"
         unfolding f_def c_def matrix_vect_scaleR by simp
       have id3: "\<And> i. sr * f v $ i = c * ((B *v (sr *\<^sub>R v)) $ i)"
         unfolding f_def c_def[symmetric] matrix_vect_scaleR by auto
       have 2: "sr * f v $ i \<le> (B *v f v) $ i" unfolding id1 id3
-        unfolding real_mult_le_cancel_iff2[OF \<open>c > 0\<close>]
+        unfolding mult_le_cancel_iff2[OF \<open>c > 0\<close>]
         by (rule mult_B_mono, insert ge(2), auto)
       note 1 2
     }
     with norm have "f v \<in> S" unfolding S_def by auto
   }
   thus ?thesis by blast
 qed
 
 private lemma cont_f: "continuous_on S f"
   unfolding f_def[abs_def] continuous_on using normB_S
   unfolding norm1_def
   by (auto intro!: tendsto_eq_intros)
 
 qualified lemma perron_frobenius_positive_ev:
   "\<exists> v. eigen_vector A v (r sr) \<and> real_non_neg_vec v"
 proof -
   from brouwer[OF compactS convexS non_emptyS cont_f image_f]
     obtain v where v: "v \<in> S" and fv: "f v = v" by auto
   define ev where "ev = norm1 (B *v v)"
   from normB_S[OF v] have "ev \<noteq> 0" unfolding ev_def by auto
   with norm1_ge_0[of "B *v v", folded ev_def] have norm: "ev > 0" by auto
   from arg_cong[OF fv[unfolded f_def], of "\<lambda> (w :: real ^ 'n). ev *\<^sub>R w"] norm
   have ev: "B *v v = ev *s v" unfolding ev_def[symmetric] scalar_mult_eq_scaleR by simp
   with v[unfolded S_def] have ge: "\<And> i. sr * v $ i \<le> ev * v $ i" by auto
   have "A *v rv v = rv (B *v v)" unfolding rv_mult ..
   also have "\<dots> = ev *s rv v" unfolding ev vec_eq_iff
     by (simp add: scaleR_conv_of_real scaleR_vec_def)
   finally have ev: "A *v rv v = ev *s rv v" .
   from v have v0: "v \<noteq> 0" unfolding S_def by auto
   hence "rv v \<noteq> 0" unfolding rv_0 .
   with ev have ev: "eigen_vector A (rv v) ev" unfolding eigen_vector_def by auto
   hence "eigen_value A ev" unfolding eigen_value_def by auto
   from spectral_radius_max[OF this] have le: "norm (r ev) \<le> sr" .
   from v0 obtain i where "v $ i \<noteq> 0" unfolding vec_eq_iff by auto
   from v have "v $ i \<ge> 0" unfolding S_def by auto
   with \<open>v $ i \<noteq> 0\<close> have "v $ i > 0" by auto
   with ge[of i] have ge: "sr \<le> ev" by auto
   with le have sr: "r sr = ev" by auto
   from v have *: "real_non_neg_vec (rv v)" unfolding S_def real_non_neg_vec_def vec_elements_h_def by auto
   show ?thesis unfolding sr
     by (rule exI[of _ "rv v"], insert * ev norm, auto)
 qed
 end
 
 qualified lemma perron_frobenius_both:
   "\<exists> v. eigen_vector A v (r sr) \<and> real_non_neg_vec v"
 proof (cases "\<forall> v \<in> S. A *v rv v \<noteq> 0")
   case True
   show ?thesis
     by (rule Perron_Frobenius.perron_frobenius_positive_ev[OF rnnA], insert True, auto)
 next
   case False
   then obtain v where v: "v \<in> S" and A0: "A *v rv v = 0" by auto
   hence id: "A *v rv v = 0 *s rv v" and v0: "v \<noteq> 0" unfolding S_def by auto
   from v0 have "rv v \<noteq> 0" unfolding rv_0 .
   with id have ev: "eigen_vector A (rv v) 0" unfolding eigen_vector_def by auto
   hence "eigen_value A 0" unfolding eigen_value_def ..
   from spectral_radius_max[OF this] have 0: "0 \<le> sr" by auto
   from v[unfolded S_def] have ge: "\<And> i. sr * v $ i \<le> (B *v v) $ i" by auto
   from v[unfolded S_def] have rnn: "real_non_neg_vec (rv v)"
     unfolding real_non_neg_vec_def vec_elements_h_def by auto
   from v0 obtain i where "v $ i \<noteq> 0" unfolding vec_eq_iff by auto
   from v have "v $ i \<ge> 0" unfolding S_def by auto
   with \<open>v $ i \<noteq> 0\<close> have vi: "v $ i > 0" by auto
   from rv_mult[of v, unfolded A0] have "rv (B *v v) = 0" by simp
   hence "B *v v = 0" unfolding rv_0 .
   from ge[of i, unfolded this] vi have ge: "sr \<le> 0" by (simp add: mult_le_0_iff)
   with \<open>0 \<le> sr\<close> have "sr = 0" by auto
   show ?thesis unfolding \<open>sr = 0\<close> using rnn ev by auto
 qed
 end
 
 text \<open>Perron Frobenius: The largest complex eigenvalue of a real-valued non-negative matrix
   is a real one, and it has a real-valued non-negative eigenvector.\<close>
 
 lemma perron_frobenius:
   assumes "real_non_neg_mat A"
   shows "\<exists>v. eigen_vector A v (of_real (spectral_radius A)) \<and> real_non_neg_vec v"
   by (rule Perron_Frobenius.perron_frobenius_both[OF assms])
 
 text \<open>And a version which ignores the eigenvector.\<close>
 
 lemma perron_frobenius_eigen_value:
   assumes "real_non_neg_mat A"
   shows "eigen_value A (of_real (spectral_radius A))"
   using perron_frobenius[OF assms] unfolding eigen_value_def by blast
 
 end
diff --git a/thys/Poincare_Bendixson/Invariance.thy b/thys/Poincare_Bendixson/Invariance.thy
--- a/thys/Poincare_Bendixson/Invariance.thy
+++ b/thys/Poincare_Bendixson/Invariance.thy
@@ -1,299 +1,299 @@
 section \<open>Invariance\<close>
 theory Invariance
   imports ODE_Misc
 begin
 
 context auto_ll_on_open begin
 
 definition "invariant M \<longleftrightarrow> (\<forall>x\<in>M. trapped x M)"
 
 definition "positively_invariant M \<longleftrightarrow> (\<forall>x\<in>M. trapped_forward x M)"
 
 definition "negatively_invariant M \<longleftrightarrow> (\<forall>x\<in>M. trapped_backward x M)"
 
 lemma positively_invariant_iff:
   "positively_invariant M \<longleftrightarrow>
   (\<Union>x\<in>M. flow0 x ` (existence_ivl0 x \<inter> {0..})) \<subseteq> M"
   unfolding positively_invariant_def trapped_forward_def
   by auto
 
 lemma negatively_invariant_iff:
   "negatively_invariant M \<longleftrightarrow>
   (\<Union>x\<in>M. flow0 x ` (existence_ivl0 x \<inter> {..0})) \<subseteq> M"
   unfolding negatively_invariant_def trapped_backward_def
   by auto
 
 lemma invariant_iff_pos_and_neg_invariant:
   "invariant M \<longleftrightarrow> positively_invariant M \<and> negatively_invariant M"
   unfolding invariant_def trapped_def positively_invariant_def negatively_invariant_def
   by blast
 
 lemma invariant_iff:
   "invariant M \<longleftrightarrow> (\<Union>x\<in>M. flow0 x ` (existence_ivl0 x)) \<subseteq>  M"
   unfolding invariant_iff_pos_and_neg_invariant positively_invariant_iff negatively_invariant_iff
   by (metis (mono_tags) SUP_le_iff invariant_def invariant_iff_pos_and_neg_invariant negatively_invariant_iff positively_invariant_iff trapped_iff_on_existence_ivl0)
 
 lemma positively_invariant_restrict_dom: "positively_invariant M = positively_invariant (M \<inter> X)"
   unfolding positively_invariant_def trapped_forward_def
   by (auto intro!: flow_in_domain dest: mem_existence_ivl_iv_defined)
 
 lemma negatively_invariant_restrict_dom: "negatively_invariant M = negatively_invariant (M \<inter> X)"
   unfolding negatively_invariant_def trapped_backward_def
   by (auto intro!: flow_in_domain dest: mem_existence_ivl_iv_defined)
 
 lemma invariant_restrict_dom: "invariant M = invariant (M \<inter> X)"
   using invariant_iff_pos_and_neg_invariant
     negatively_invariant_restrict_dom
     positively_invariant_restrict_dom by auto
     (*
 lemma positively_invariant_imp_subset:
   "M \<subseteq> X" if "positively_invariant M"
   using positively_invariant_iff that by blast
 
 lemma negatively_invariant_imp_subset:
   "M \<subseteq> X" if "negatively_invariant M"
   using negatively_invariant_iff that by blast
 
 lemma invariant_imp_subset:
   "M \<subseteq> X" if "invariant M"
   using invariant_iff that by blast
 *)
 
 end context auto_ll_on_open begin
 
 lemma positively_invariant_eq_rev: "positively_invariant M = rev.negatively_invariant M"
   unfolding positively_invariant_def rev.negatively_invariant_def
   by (simp add: rev.trapped_backward_iff_rev_trapped_forward)
 
 lemma negatively_invariant_eq_rev: "negatively_invariant M = rev.positively_invariant M"
   unfolding negatively_invariant_def rev.positively_invariant_def
   by (simp add: trapped_backward_iff_rev_trapped_forward)
 
 lemma invariant_eq_rev: "invariant M = rev.invariant M"
   unfolding invariant_iff_pos_and_neg_invariant rev.invariant_iff_pos_and_neg_invariant
     positively_invariant_eq_rev negatively_invariant_eq_rev by auto
 
 lemma negatively_invariant_complI: "negatively_invariant (X-M)" if "positively_invariant M"
   unfolding negatively_invariant_def trapped_backward_def
 proof clarsimp
   fix x t
   assume x: "x \<in> X" "x \<notin> M" "t \<in> existence_ivl0 x" "t \<le> 0"
   have a1:"flow0 x t \<in> X" using x
     using flow_in_domain by blast
   have a2:"flow0 x t \<notin> M"
   proof (rule ccontr)
     assume "\<not> flow0 x t \<notin> M"
     then have "trapped_forward (flow0 x t) M"
       using positively_invariant_def that by auto
     moreover have "flow0 (flow0 x t) (-t) = x"
       using \<open>t \<in> existence_ivl0 x\<close> flows_reverse by auto
     moreover have "-t \<in> existence_ivl0 (flow0 x t) \<inter> {0..}"
       using existence_ivl_reverse x(3) x(4) by auto
     ultimately have "x \<in> M" unfolding trapped_forward_def
       by (metis image_subset_iff)
     thus False using x(2) by auto
   qed
   show "flow0 x t \<in> X \<and> flow0 x t \<notin> M" using a1 a2 by auto
 qed
 
 end context auto_ll_on_open begin
 
 lemma negatively_invariant_complD: "positively_invariant M" if "negatively_invariant (X-M)"
 proof -
   have "rev.positively_invariant (X-M)" using that
     by (simp add: negatively_invariant_eq_rev)
   then have "rev.negatively_invariant (X-(X-M))"
     by (simp add: rev.negatively_invariant_complI)
   then have "positively_invariant (X-(X-M))"
     using rev.negatively_invariant_eq_rev by auto
   thus ?thesis using Diff_Diff_Int
     by (metis inf_commute positively_invariant_restrict_dom) 
 qed
 
 lemma pos_invariant_iff_compl_neg_invariant: "positively_invariant M \<longleftrightarrow> negatively_invariant (X - M)"
   by (safe intro!: negatively_invariant_complI dest!: negatively_invariant_complD)
 
 lemma neg_invariant_iff_compl_pos_invariant:
   shows "negatively_invariant M \<longleftrightarrow> positively_invariant (X - M)"
   by (simp add: auto_ll_on_open.pos_invariant_iff_compl_neg_invariant negatively_invariant_eq_rev positively_invariant_eq_rev rev.auto_ll_on_open_axioms)
 
 lemma invariant_iff_compl_invariant:
   shows "invariant M \<longleftrightarrow> invariant (X - M)"
   using invariant_iff_pos_and_neg_invariant neg_invariant_iff_compl_pos_invariant pos_invariant_iff_compl_neg_invariant by blast
 
 lemma invariant_iff_pos_invariant_and_compl_pos_invariant:
   shows "invariant M \<longleftrightarrow> positively_invariant M \<and> positively_invariant (X-M)"
   by (simp add: invariant_iff_pos_and_neg_invariant neg_invariant_iff_compl_pos_invariant)
 
 end
 
 subsection \<open>Tools for proving invariance\<close>
 
 context auto_ll_on_open begin
 
 lemma positively_invariant_left_inter:
   assumes "positively_invariant C"
   assumes "\<forall>x \<in> C \<inter> D. trapped_forward x D"
   shows "positively_invariant (C \<inter> D)"
   using assms positively_invariant_def trapped_forward_def by auto
 
 lemma trapped_forward_le:
   fixes V :: "'a \<Rightarrow> real"
   assumes "V x \<le> 0"
   assumes contg: "continuous_on (flow0 x ` (existence_ivl0 x \<inter> {0..})) g"
   assumes "\<And>x. (V has_derivative V' x) (at x)"
   assumes "\<And>s. s \<in> existence_ivl0 x \<inter> {0..} \<Longrightarrow> V' (flow0 x s) (f (flow0 x s)) \<le> g (flow0 x s) * V (flow0 x s)"
   shows "trapped_forward x {x. V x \<le> 0}"
   unfolding trapped_forward_def
 proof clarsimp
   fix t
   assume t: "t \<in> existence_ivl0 x" "0 \<le> t"
   then have ex:"{0..t} \<subseteq> existence_ivl0 x"
     by (simp add: local.ivl_subset_existence_ivl)
   have contV: "continuous_on UNIV V"
     using assms(3) has_derivative_continuous_on by blast
   have 1: "continuous_on {0..t} (g \<circ> flow0 x)"
     apply (rule continuous_on_compose)
     using continuous_on_subset ex local.flow_continuous_on apply blast
     by (meson Int_subset_iff atLeastAtMost_iff atLeast_iff contg continuous_on_subset ex image_mono subsetI)
   have 2: "(\<And>s. s \<in> {0..t} \<Longrightarrow>
          (V \<circ> flow0 x has_real_derivative (V' (flow0 x s) \<circ> f \<circ> flow0 x) s) (at s))"
     apply (auto simp add:o_def has_field_derivative_def)
   proof -                              
     fix s
     assume "0 \<le> s" "s \<le> t"
     then have "s \<in> existence_ivl0 x" using ex by auto
     from flow_has_derivative[OF this] have
       "(flow0 x has_derivative (\<lambda>i. i *\<^sub>R f (flow0 x s))) (at s)" .
     from has_derivative_compose[OF this assms(3)]
     have "((\<lambda>t. V (flow0 x t)) has_derivative (\<lambda>t. V' (flow0 x s)  (t *\<^sub>R f (flow0 x s)))) (at s)" .
     moreover have "linear (V' (flow0 x s))"  using assms(3) has_derivative_linear by blast
     ultimately 
     have "((\<lambda>t. V (flow0 x t)) has_derivative (\<lambda>t. t *\<^sub>R V' (flow0 x s) (f (flow0 x s)))) (at s)" 
       unfolding linear_cmul[OF \<open>linear (V' (flow0 x s))\<close>] by blast
     thus "((\<lambda>t. V (flow0 x t)) has_derivative (*) (V' (flow0 x s) (f (flow0 x s)))) (at s)"
       by (auto intro!: derivative_eq_intros simp add: mult_commute_abs)
   qed
   have 3: "(\<And>s. s \<in> {0..t} \<Longrightarrow>
          (V' (flow0 x s)  \<circ> f \<circ> flow0 x) s \<le> (g \<circ> flow0 x) s *\<^sub>R (V \<circ> flow0 x) s)"
     using ex by (auto intro!:assms(4))
   from comparison_principle_le_linear[OF 1 2 _ 3] assms(1)
   have "\<forall>s \<in> {0..t}. (V \<circ> flow0 x) s \<le> 0"
     using local.mem_existence_ivl_iv_defined(2) t(1) by auto
   thus " V (flow0 x t) \<le> 0"
     by (simp add: t(2))
 qed
 
 lemma positively_invariant_le_domain:
   fixes V :: "'a \<Rightarrow> real"
   assumes "positively_invariant D"
   assumes contg: "continuous_on D g"
   assumes "\<And>x. (V has_derivative V' x) (at x)" (* TODO: domain can be added here too ? *)
   assumes "\<And>s. s \<in> D \<Longrightarrow> V' s (f s) \<le> g s * V s"
   shows "positively_invariant (D \<inter> {x. V x \<le> 0})"
   apply (auto intro!:positively_invariant_left_inter[OF assms(1)])
 proof -
   fix x
   assume "x \<in> D" "V x \<le> 0"
   have "continuous_on (flow0 x ` (existence_ivl0 x \<inter> {0..})) g"
     by (meson \<open>x \<in> D\<close> assms(1) contg continuous_on_subset positively_invariant_def trapped_forward_def)
   from trapped_forward_le[OF \<open>V x \<le> 0\<close> this assms(3)]
   show "trapped_forward x {x. V x \<le> 0}" using assms(4)
     using \<open>x \<in> D\<close> assms(1) positively_invariant_def trapped_forward_def by auto
 qed
 
 lemma positively_invariant_barrier_domain:
   fixes V :: "'a \<Rightarrow> real"
   assumes "positively_invariant D"
   assumes "\<And>x. (V has_derivative V' x) (at x)"
   assumes "continuous_on D (\<lambda>x. V' x (f x))"
   assumes "\<And>s. s \<in> D \<Longrightarrow> V s = 0 \<Longrightarrow> V' s (f s) < 0"
   shows "positively_invariant (D \<inter> {x. V x \<le> 0})"
   apply (auto intro!:positively_invariant_left_inter[OF assms(1)])
 proof -
   fix x
   assume "x \<in> D" "V x \<le> 0"
   have contV: "continuous_on UNIV V" using assms(2) has_derivative_continuous_on by blast
   then have *: "continuous_on (flow0 x ` (existence_ivl0 x \<inter> {0..})) V"
     using continuous_on_subset by blast
   have sub: "flow0 x ` (existence_ivl0 x \<inter> {0..}) \<subseteq> D"
     using \<open>x \<in> D\<close> assms(1) positively_invariant_def trapped_forward_def by auto
   then have contV': "continuous_on (flow0 x ` (existence_ivl0 x \<inter> {0..})) (\<lambda>x. V' x (f x))"
     by (metis assms(3) continuous_on_subset)
   have nz: "\<And>i t. t \<in> existence_ivl0 x \<Longrightarrow>
        0 \<le> t \<Longrightarrow>  max (-V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2) > 0"
   proof -
     fix i t
     assume "t \<in> existence_ivl0 x" "0 \<le> t"
     then have "flow0 x t \<in> D"
       using \<open>x \<in> D\<close> assms(1) positively_invariant_def trapped_forward_def by auto
     then have "V (flow0 x t) = 0 \<Longrightarrow> - V' (flow0 x t) (f (flow0 x t)) > 0" using assms(4) by simp
     then have "(V (flow0 x t))^2 > 0 \<or> - V' (flow0 x t) (f (flow0 x t)) > 0" by simp
     thus "max (-V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2) > 0" unfolding less_max_iff_disj
       by auto
   qed
   have *: "continuous_on (flow0 x ` (existence_ivl0 x \<inter> {0..})) (\<lambda>x. V' x (f x) * V x / max (- V' x (f x)) ((V x)^2))"
     apply (auto intro!:continuous_intros continuous_on_max simp add: * contV')
     using nz by fastforce
   have "(\<And>t. t \<in> existence_ivl0 x \<inter> {0..} \<Longrightarrow>
         V' (flow0 x t) (f (flow0 x t)) \<le>
         (V' (flow0 x t) (f (flow0 x t)) * V (flow0 x t)
         / max (- V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2)) * V (flow0 x t))"
   proof clarsimp
     fix t
     assume "t \<in> existence_ivl0 x" "0 \<le> t"
     then have p: "max (-V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2) > 0" using nz by auto
     have " V' (flow0 x t) (f (flow0 x t)) * max (- V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2)
       \<le>  V' (flow0 x t) (f (flow0 x t)) * (V (flow0 x t))\<^sup>2"
-      by (smt mult_minus_left mult_minus_right power2_eq_square real_mult_le_cancel_iff2)
+      by (smt mult_minus_left mult_minus_right power2_eq_square mult_le_cancel_iff2)
     then have "V' (flow0 x t) (f (flow0 x t))
       \<le>  V' (flow0 x t) (f (flow0 x t)) * (V (flow0 x t))\<^sup>2
       / max (- V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2)"
       using p pos_le_divide_eq by blast
     thus " V' (flow0 x t) (f (flow0 x t))
          \<le> V' (flow0 x t) (f (flow0 x t)) * (V (flow0 x t)) * V (flow0 x t) /
            max (- V' (flow0 x t) (f (flow0 x t))) ((V (flow0 x t))\<^sup>2)"
       by (simp add: power2_eq_square)
   qed
   from trapped_forward_le[OF \<open>V x \<le> 0\<close> * assms(2) this]
   show "trapped_forward x {x. V x \<le> 0}" by auto
 qed
 
 lemma positively_invariant_UNIV:
   shows "positively_invariant UNIV"
   using positively_invariant_iff by blast
 
 lemma positively_invariant_conj:
   assumes "positively_invariant C"
   assumes "positively_invariant D"
   shows "positively_invariant (C \<inter> D)"
   using assms positively_invariant_def
   using positively_invariant_left_inter by auto
 
 lemma positively_invariant_le:
   fixes V :: "'a \<Rightarrow> real"
   assumes contg: "continuous_on UNIV g"
   assumes "\<And>x. (V has_derivative V' x) (at x)"
   assumes "\<And>s. V' s (f s) \<le> g s * V s"
   shows "positively_invariant {x. V x \<le> 0}"
 proof -
   from positively_invariant_le_domain[OF positively_invariant_UNIV assms]  
   have "positively_invariant (UNIV \<inter> {x. V x \<le> 0})" .
   thus ?thesis by auto
 qed
 
 lemma positively_invariant_barrier:
   fixes V :: "'a \<Rightarrow> real"
   assumes "\<And>x. (V has_derivative V' x) (at x)"
   assumes "continuous_on UNIV (\<lambda>x. V' x (f x))"
   assumes "\<And>s. V s = 0 \<Longrightarrow> V' s (f s) < 0"
   shows "positively_invariant {x. V x \<le> 0}"
 proof -
   from positively_invariant_barrier_domain[OF positively_invariant_UNIV assms]  
   have "positively_invariant (UNIV \<inter> {x. V x \<le> 0})" .
   thus ?thesis by auto
 qed
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/QHLProver/Quantum_Program.thy b/thys/QHLProver/Quantum_Program.thy
--- a/thys/QHLProver/Quantum_Program.thy
+++ b/thys/QHLProver/Quantum_Program.thy
@@ -1,1110 +1,1109 @@
 section \<open>Quantum programs\<close>
 
 theory Quantum_Program
   imports Matrix_Limit
 begin
 
 subsection \<open>Syntax\<close>
 
 text \<open>Datatype for quantum programs\<close>
 datatype com = 
   SKIP
 | Utrans "complex mat"
 | Seq com com  ("_;;/ _" [60, 61] 60)
 | Measure nat "nat \<Rightarrow> complex mat" "com list" 
 | While "nat \<Rightarrow> complex mat" com 
 
 text \<open>A state corresponds to the density operator\<close>
 type_synonym state = "complex mat"
 
 text \<open>List of dimensions of quantum states\<close>
 locale state_sig =
   fixes dims :: "nat list"
 begin
 
 definition d :: nat where
   "d = prod_list dims"
 
 text \<open>Wellformedness of commands\<close>
 
 fun well_com :: "com \<Rightarrow> bool" where
   "well_com SKIP = True"
 | "well_com (Utrans U) = (U \<in> carrier_mat d d \<and> unitary U)"
 | "well_com (Seq S1 S2) = (well_com S1 \<and> well_com S2)"
 | "well_com (Measure n M S) = 
     (measurement d n M \<and> length S = n \<and> list_all well_com S)"
 | "well_com (While M S) =
     (measurement d 2 M \<and> well_com S)"
 
 subsection \<open>Denotational semantics\<close>
 
 text \<open>Denotation of going through the while loop n times\<close>
 fun denote_while_n_iter :: "complex mat \<Rightarrow> complex mat \<Rightarrow> (state \<Rightarrow> state) \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> state" where
   "denote_while_n_iter M0 M1 DS 0 \<rho> = \<rho>"
 | "denote_while_n_iter M0 M1 DS (Suc n) \<rho> = denote_while_n_iter M0 M1 DS n (DS (M1 * \<rho> * adjoint M1))"
 
 fun denote_while_n :: "complex mat \<Rightarrow> complex mat \<Rightarrow> (state \<Rightarrow> state) \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> state" where
   "denote_while_n M0 M1 DS n \<rho> = M0 * denote_while_n_iter M0 M1 DS n \<rho> * adjoint M0"
 
 fun denote_while_n_comp :: "complex mat \<Rightarrow> complex mat \<Rightarrow> (state \<Rightarrow> state) \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> state" where
   "denote_while_n_comp M0 M1 DS n \<rho> = M1 * denote_while_n_iter M0 M1 DS n \<rho> * adjoint M1"
 
 lemma denote_while_n_iter_assoc:
   "denote_while_n_iter M0 M1 DS (Suc n) \<rho> = DS (M1 * (denote_while_n_iter M0 M1 DS n \<rho>) * adjoint M1)"
 proof (induct n arbitrary: \<rho>)
   case 0
   show ?case by auto
 next
   case (Suc n)
   show ?case
     apply (subst denote_while_n_iter.simps)
     apply (subst Suc, auto)
     done
 qed
 
 lemma denote_while_n_iter_dim:
   "\<rho> \<in> carrier_mat m m \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> M1 \<in> carrier_mat m m \<Longrightarrow> adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m m
   \<Longrightarrow> (\<And>\<rho>. \<rho> \<in> carrier_mat m m \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> DS \<rho> \<in> carrier_mat m m \<and> partial_density_operator (DS \<rho>))
   \<Longrightarrow> denote_while_n_iter M0 M1 DS n \<rho> \<in> carrier_mat m m \<and> partial_density_operator (denote_while_n_iter M0 M1 DS n \<rho>)"
 proof (induct n arbitrary: \<rho>)
   case 0
   then show ?case unfolding denote_while_n_iter.simps by auto
 next
   case (Suc n)
   then have dr: "\<rho> \<in> carrier_mat m m" and dM1: "M1 \<in> carrier_mat m m" by auto
   have dMr: "M1 * \<rho> * adjoint M1 \<in> carrier_mat m m" using dr dM1 by fastforce
   have pdoMr: "partial_density_operator (M1 * \<rho> * adjoint M1)" using pdo_close_under_measurement Suc by auto
   from Suc dMr pdoMr have d: "DS (M1 * \<rho> * adjoint M1) \<in> carrier_mat m m" and "partial_density_operator (DS (M1 * \<rho> * adjoint M1))" by auto
   then show ?case unfolding denote_while_n_iter.simps
     using Suc by auto
 qed
 
 lemma pdo_denote_while_n_iter:
   "\<rho> \<in> carrier_mat m m \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> M1 \<in> carrier_mat m m \<Longrightarrow> adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m m
   \<Longrightarrow> (\<And>\<rho>. \<rho> \<in> carrier_mat m m \<and> partial_density_operator \<rho> \<Longrightarrow> partial_density_operator (DS \<rho>))
   \<Longrightarrow> (\<And>\<rho>. \<rho> \<in> carrier_mat m m \<and> partial_density_operator \<rho> \<Longrightarrow> DS \<rho> \<in> carrier_mat m m)
   \<Longrightarrow> partial_density_operator (denote_while_n_iter M0 M1 DS n \<rho>)"
 proof (induct n arbitrary: \<rho>)
   case 0
   then show ?case unfolding denote_while_n_iter.simps by auto
 next
   case (Suc n)
   have "partial_density_operator (M1 * \<rho> * adjoint M1)" using Suc pdo_close_under_measurement by auto
   moreover have "M1 * \<rho> * adjoint M1 \<in> carrier_mat m m" using Suc by auto
   ultimately have p: "partial_density_operator (DS (M1 * \<rho> * adjoint M1))" and d: "DS (M1 * \<rho> * adjoint M1) \<in> carrier_mat m m "using Suc by auto
   show ?case unfolding denote_while_n_iter.simps using Suc(1)[OF d p Suc(4) Suc(5)] Suc by auto
 qed
 
 
 text \<open>Denotation of while is simply the infinite sum of denote\_while\_n\<close>
 definition denote_while :: "complex mat \<Rightarrow> complex mat \<Rightarrow> (state \<Rightarrow> state) \<Rightarrow> state \<Rightarrow> state" where
   "denote_while M0 M1 DS \<rho> = matrix_inf_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)"
 
 lemma denote_while_n_dim:
   assumes "\<rho> \<in> carrier_mat d d"
     "M0 \<in> carrier_mat d d"
     "M1 \<in> carrier_mat d d"
     "partial_density_operator \<rho>"
     "\<And>\<rho>'. \<rho>' \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho>'  \<Longrightarrow> positive (DS \<rho>') \<and> trace (DS \<rho>') \<le> trace \<rho>' \<and> DS \<rho>' \<in> carrier_mat d d"
    shows "denote_while_n M0 M1 DS n \<rho>  \<in> carrier_mat d d"
 proof (induction n arbitrary: \<rho>)
   case 0
   then show ?case 
   proof -
     have "M0 * \<rho> * adjoint M0 \<in> carrier_mat d d"
       using assms assoc_mult_mat by auto
     then show ?thesis by auto
   qed
 next
   case (Suc n)
   then show ?case 
   proof -
     have "denote_while_n M0 M1 DS n (DS (M1 * \<rho> * adjoint M1)) \<in> carrier_mat d d"
       using Suc assms by auto
     then show ?thesis by auto
   qed
 qed
  
 lemma denote_while_n_sum_dim:
   assumes "\<rho> \<in> carrier_mat d d"
     "M0 \<in> carrier_mat d d"
     "M1 \<in> carrier_mat d d"
     "partial_density_operator \<rho>"
     "\<And>\<rho>'. \<rho>' \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho>'  \<Longrightarrow> positive (DS \<rho>') \<and> trace (DS \<rho>') \<le> trace \<rho>' \<and> DS \<rho>' \<in> carrier_mat d d"
   shows "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<in> carrier_mat d d"
 proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   then show ?case
   proof -
     have " denote_while_n M0 M1 DS n \<rho> \<in> carrier_mat d d"
       using denote_while_n_dim assms by auto
     then have "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n) \<in> carrier_mat d d"
       using Suc by auto
     then show ?thesis by auto
   qed
 qed
 
 lemma trace_decrease_mul_adj:
   assumes pdo: "partial_density_operator \<rho>" and dimr: "\<rho> \<in> carrier_mat d d" 
     and dimx: "x \<in> carrier_mat d d" and un: "adjoint x * x \<le>\<^sub>L   1\<^sub>m d "
   shows "trace (x * \<rho> * adjoint x) \<le> trace \<rho>"
 proof -
   have ad: "adjoint x * x \<in> carrier_mat d d" using adjoint_dim index_mult_mat dimx by auto
   have "trace (x * \<rho> * adjoint x) = trace ((adjoint x * x) * \<rho>)" using dimx dimr by (mat_assoc d)
   also have "\<dots> \<le> trace (1\<^sub>m d * \<rho>)" using lowner_le_trace un ad dimr pdo by auto
   also have "\<dots> = trace \<rho>" using dimr by auto
   ultimately show ?thesis by auto
 qed
 
 lemma denote_while_n_positive: 
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and un: "adjoint M1 * M1 \<le>\<^sub>L   1\<^sub>m d"
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
   shows "partial_density_operator \<rho> \<and> \<rho> \<in> carrier_mat d d \<Longrightarrow> positive (denote_while_n M0 M1 DS n \<rho>)"
 proof (induction n arbitrary: \<rho>)
   case 0
   then show ?case using positive_close_under_left_right_mult_adjoint dim0 unfolding partial_density_operator_def by auto
 next
   case (Suc n)
   then show ?case 
   proof -
     have pdoM: "partial_density_operator (M1 * \<rho> * adjoint M1)" using pdo_close_under_measurement Suc dim1 un by auto
     moreover have cM: "M1 * \<rho> * adjoint M1 \<in> carrier_mat d d" using Suc dim1 adjoint_dim index_mult_mat by auto
     ultimately have DSM1: "positive (DS (M1 * \<rho> * adjoint M1)) \<and> trace (DS (M1 * \<rho> * adjoint M1)) \<le> trace (M1 * \<rho> * adjoint M1) \<and> DS (M1 * \<rho> * adjoint M1) \<in> carrier_mat d d"
       using DS by auto
     moreover have "trace (M1 * \<rho> * adjoint M1) \<le> trace \<rho>" using trace_decrease_mul_adj Suc dim1 un by auto
     ultimately have "partial_density_operator (DS (M1 * \<rho> * adjoint M1))" using Suc unfolding partial_density_operator_def by auto
     then have "positive (M0 * denote_while_n_iter M0 M1 DS n (DS (M1 * \<rho> * adjoint M1)) * adjoint M0)" using Suc DSM1 by auto
     then have "positive (denote_while_n M0 M1 DS (Suc n) \<rho>)" by auto
     then show ?thesis by auto      
   qed
 qed
 
 lemma denote_while_n_sum_positive:
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and un: "adjoint M1 * M1 \<le>\<^sub>L   1\<^sub>m d" 
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
       and pdo: "partial_density_operator \<rho>" and r: " \<rho> \<in> carrier_mat d d" 
     shows "positive (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n)"
 proof -
   have "\<And>k. k < n \<Longrightarrow> positive (denote_while_n M0 M1 DS k \<rho>)"  using assms denote_while_n_positive by auto
   moreover have "\<And>k. k < n \<Longrightarrow> denote_while_n M0 M1 DS k \<rho> \<in> carrier_mat d d" using denote_while_n_dim assms by auto
   ultimately show ?thesis using matrix_sum_positive by auto
 qed
 
 lemma trace_measure2_id:
   assumes dM0: "M0 \<in> carrier_mat n n" and dM1: "M1 \<in> carrier_mat n n" 
     and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m n"
     and dA: "A \<in> carrier_mat n n"
   shows "trace (M0 * A * adjoint M0) + trace (M1 * A * adjoint M1) = trace A"
 proof -
   have "trace (M0 * A * adjoint M0) + trace (M1 * A * adjoint M1) = trace ((adjoint M0 * M0 + adjoint M1 * M1) * A)"
     using assms 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.
 qed
 
 lemma measurement_lowner_le_one1:
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d"
   shows "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d"
 proof -
   have paM0: "positive (adjoint M0 * M0)"
     apply (subgoal_tac "adjoint M0 * adjoint (adjoint M0) = adjoint M0 * M0")
     subgoal using positive_if_decomp[of "adjoint M0 * M0"] dim0 adjoint_dim[OF dim0] by fastforce
     using adjoint_adjoint[of M0] by auto
   have le1: "adjoint M0 * M0 + adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" using id lowner_le_refl[of "1\<^sub>m d"] by fastforce
   show "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" 
     using add_positive_le_reduce2[OF _ _ _ paM0 le1] dim0 dim1 by fastforce
 qed
 
 lemma denote_while_n_sum_trace:
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" 
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
       and r: " \<rho> \<in> carrier_mat d d"
       and pdor: "partial_density_operator \<rho>"
     shows "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n) \<le> trace \<rho>"
 proof -
   have un: "adjoint M1 * M1 \<le>\<^sub>L 1\<^sub>m d" using measurement_lowner_le_one1 using dim0 dim1 id by auto
   have DS': "(DS \<rho> \<in> carrier_mat d d) \<and> partial_density_operator (DS \<rho>)" if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
   proof -
     have res: "positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d" using DS that by auto
     moreover have "trace \<rho> \<le> 1" using that partial_density_operator_def by auto
     ultimately have "trace (DS \<rho>) \<le> 1" by auto
     with res show ?thesis unfolding partial_density_operator_def by auto
   qed
   have dWk: "denote_while_n_iter M0 M1 DS k \<rho> \<in> carrier_mat d d" for k 
     using denote_while_n_iter_dim[OF r pdor dim1 un] DS' dim0 dim1 by auto
   have pdoWk: "partial_density_operator (denote_while_n_iter M0 M1 DS k \<rho>)" for k 
     using pdo_denote_while_n_iter[OF r pdor dim1 un] DS' dim0 dim1 by auto
   have dW0k: "denote_while_n M0 M1 DS k \<rho> \<in> carrier_mat d d" for k using denote_while_n_dim r dim0 dim1 pdor by auto
   then have dsW0k: "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) k \<in> carrier_mat d d" for k
     using matrix_sum_dim[of k "\<lambda>k. denote_while_n M0 M1 DS k \<rho>"] by auto
 
   have "(denote_while_n_comp M0 M1 DS n \<rho>) \<in> carrier_mat d d" for n unfolding denote_while_n_comp.simps using dim1 dWk by auto
   moreover have 
     pdoW1k: "partial_density_operator (denote_while_n_comp M0 M1 DS n \<rho>)" for n unfolding denote_while_n_comp.simps
     using pdo_close_under_measurement[OF dim1 dWk pdoWk un] by auto
   ultimately have "trace (DS (denote_while_n_comp M0 M1 DS n \<rho>)) \<le> trace (denote_while_n_comp M0 M1 DS n \<rho>)" for n
     using DS by auto
   moreover have "trace (denote_while_n_iter M0 M1 DS (Suc n) \<rho>) = trace (DS (denote_while_n_comp M0 M1 DS n \<rho>))" for n
     using denote_while_n_iter_assoc[folded denote_while_n_comp.simps] by auto
   ultimately have leq3: "trace (denote_while_n_iter M0 M1 DS (Suc n) \<rho>) \<le> trace (denote_while_n_comp M0 M1 DS n \<rho>)" for n by auto
 
   have mainleq: "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)) + trace (denote_while_n_comp M0 M1 DS n \<rho>) \<le> trace \<rho>" for n
   proof (induct n)
     case 0
     then show ?case unfolding matrix_sum.simps denote_while_n.simps denote_while_n_comp.simps denote_while_n_iter.simps 
       apply (subgoal_tac "M0 * \<rho> * adjoint M0 + 0\<^sub>m d d = M0 * \<rho> * adjoint M0")
       using trace_measure2_id[OF dim0 dim1 id r] dim0 apply simp
       using dim0 by auto
   next
     case (Suc n)
 
     have eq1: "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc (Suc n))) 
       = trace (denote_while_n M0 M1 DS (Suc n) \<rho>) + trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n))"
       unfolding matrix_sum.simps
       using trace_add_linear dW0k[of "Suc n"] dsW0k[of "Suc n"] by auto
 
     have eq2: "trace (denote_while_n M0 M1 DS (Suc n) \<rho>) + trace (denote_while_n_comp M0 M1 DS (Suc n) \<rho>) 
       = trace (denote_while_n_iter M0 M1 DS (Suc n) \<rho>)"
       unfolding denote_while_n.simps denote_while_n_comp.simps using trace_measure2_id[OF dim0 dim1 id dWk[of "Suc n"]] by auto
 
     have "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc (Suc n))) + trace (denote_while_n_comp M0 M1 DS (Suc n) \<rho>)
     = trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)) + trace (denote_while_n M0 M1 DS (Suc n) \<rho>) + trace (denote_while_n_comp M0 M1 DS (Suc n) \<rho>)"
       using eq1 by auto
     also have "\<dots> = trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)) + trace (denote_while_n_iter M0 M1 DS (Suc n) \<rho>)"
       using eq2 by auto
     also have "\<dots> \<le> trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)) + trace (denote_while_n_comp M0 M1 DS n \<rho>)"
       using leq3 by auto
     also have "\<dots> \<le> trace \<rho>" using Suc by auto
     finally show ?case.
   qed
 
   have reduce_le_complex: "(b::complex) \<ge> 0 \<Longrightarrow> a + b \<le> c \<Longrightarrow> a \<le> c" for a b c by simp
   have "positive (denote_while_n_comp M0 M1 DS n \<rho>)" for n using pdoW1k unfolding partial_density_operator_def by auto
   then have "trace (denote_while_n_comp M0 M1 DS n \<rho>) \<ge> 0" for n using positive_trace
     using \<open>\<And>n. denote_while_n_comp M0 M1 DS n \<rho> \<in> carrier_mat d d\<close> by blast
   then have "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)) \<le> trace \<rho>" for n 
     using mainleq reduce_le_complex[of "trace (denote_while_n_comp M0 M1 DS n \<rho>)"] by auto
   moreover have "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) 0) \<le> trace \<rho>"
     unfolding matrix_sum.simps
     using trace_zero positive_trace pdor unfolding partial_density_operator_def
     using r by auto
   ultimately show "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n) \<le> trace \<rho>" for n 
     apply (induct n) by auto
 qed
  
 lemma denote_while_n_sum_partial_density:
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d"
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
       and pdo: "partial_density_operator \<rho>" and r: " \<rho> \<in> carrier_mat d d" 
   shows "(partial_density_operator (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n))"
 proof -
   have "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n) \<le> trace \<rho>" 
     using denote_while_n_sum_trace assms by auto
   then have "trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n) \<le> 1" 
     using pdo unfolding partial_density_operator_def  by auto
   moreover have "positive (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n)" 
     using assms DS denote_while_n_sum_positive measurement_lowner_le_one1[OF dim0 dim1 id] by auto
   ultimately show ?thesis unfolding partial_density_operator_def by auto
 qed
 
 lemma denote_while_n_sum_lowner_le:
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d"
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
       and pdo: "partial_density_operator \<rho>" and dimr: " \<rho> \<in> carrier_mat d d" 
   shows "(matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<le>\<^sub>L matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n))"
 proof auto
   have whilenc: "denote_while_n M0 M1 DS n \<rho> \<in> carrier_mat d d" using denote_while_n_dim assms by auto
   have sumc: "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<in> carrier_mat d d"
     using denote_while_n_sum_dim assms by auto
   have "denote_while_n M0 M1 DS n \<rho> + matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n - matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n
          = denote_while_n M0 M1 DS n \<rho>  + matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n + (- matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n)" 
     using  minus_add_uminus_mat[of "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n" d d "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n"] by auto
   also have "\<dots> = denote_while_n M0 M1 DS n \<rho>  + 0\<^sub>m d d" 
     by (smt assoc_add_mat minus_add_uminus_mat minus_r_inv_mat sumc uminus_carrier_mat whilenc)
   also have "\<dots> = denote_while_n M0 M1 DS n \<rho>" using whilenc by auto
   finally have simp: "denote_while_n M0 M1 DS n \<rho> + matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n -  matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n =
                 denote_while_n M0 M1 DS n \<rho> " by auto
   have "positive (denote_while_n M0 M1 DS n \<rho>)" using denote_while_n_positive assms measurement_lowner_le_one1[OF dim0 dim1 id] by auto
   then have "matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<le>\<^sub>L (denote_while_n M0 M1 DS n \<rho> + matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n)"
     unfolding lowner_le_def using simp by auto
   then show "matrix_sum d (\<lambda>n. M0 * denote_while_n_iter M0 M1 DS n \<rho> * adjoint M0) n \<le>\<^sub>L
              (M0 * denote_while_n_iter M0 M1 DS n \<rho> * adjoint M0 + matrix_sum d (\<lambda>n. M0 * denote_while_n_iter M0 M1 DS n \<rho> * adjoint M0) n)" by auto
 qed
 
 lemma lowner_is_lub_matrix_sum: 
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d"
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
       and pdo: "partial_density_operator \<rho>" and dimr: " \<rho> \<in> carrier_mat d d" 
   shows  "matrix_seq.lowner_is_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)) (matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)))"
 proof-
   have sumdd: "\<forall>n. matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<in> carrier_mat d d"
     using  denote_while_n_sum_dim assms by auto
   have sumtr: "\<forall>n. trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n) \<le> trace \<rho>"
     using denote_while_n_sum_trace assms by auto
   have sumpar: "\<forall>n. partial_density_operator (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n)"
     using denote_while_n_sum_partial_density assms by auto
   have sumle:"\<forall>n. matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<le>\<^sub>L matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)"
     using denote_while_n_sum_lowner_le assms by auto
   have seqd: "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>))"
     using matrix_seq_def sumdd sumpar sumle by auto
   then show ?thesis  using matrix_seq.lowner_lub_prop[of d "(matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>))"] by auto
 qed
   
 lemma denote_while_dim_positive:
   assumes dim0: "M0 \<in> carrier_mat d d" and dim1: "M1 \<in> carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d"
       and DS: "\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (DS \<rho>) \<and> trace (DS \<rho>) \<le> trace \<rho> \<and> DS \<rho> \<in> carrier_mat d d"
       and pdo: "partial_density_operator \<rho>" and dimr: " \<rho> \<in> carrier_mat d d" 
   shows
     "denote_while M0 M1 DS \<rho> \<in> carrier_mat d d \<and> positive (denote_while M0 M1 DS \<rho>) \<and> trace (denote_while M0 M1 DS \<rho>) \<le> trace \<rho>"
 proof -
   have sumdd: "\<forall>n. matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<in> carrier_mat d d"
     using denote_while_n_sum_dim assms by auto
   have sumtr: "\<forall>n. trace (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n) \<le> trace \<rho>"
     using denote_while_n_sum_trace assms by auto
   have sumpar: "\<forall>n. partial_density_operator (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n)"
     using denote_while_n_sum_partial_density assms by auto
   have sumle:"\<forall>n. matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) n \<le>\<^sub>L matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>) (Suc n)"
     using denote_while_n_sum_lowner_le assms by auto
   have seqd: "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>))"
     using matrix_seq_def sumdd sumpar sumle by auto
   have "matrix_seq.lowner_is_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)) (matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)))"
     using lowner_is_lub_matrix_sum assms by auto
   then have "matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)) \<in> carrier_mat d d
             \<and> positive (matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>)))
             \<and> trace (matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n M0 M1 DS n \<rho>))) \<le> trace \<rho>"
     using matrix_seq.lowner_is_lub_dim seqd matrix_seq.lowner_lub_is_positive matrix_seq.lowner_lub_trace sumtr by auto
   then show ?thesis unfolding denote_while_def matrix_inf_sum_def by auto 
 qed 
 
 definition denote_measure :: "nat \<Rightarrow> (nat \<Rightarrow> complex mat) \<Rightarrow> ((state \<Rightarrow> state) list) \<Rightarrow> state \<Rightarrow> state" where
   "denote_measure n M DS \<rho> = matrix_sum d (\<lambda>k. (DS!k) ((M k) * \<rho> * adjoint (M k))) n"
 
 lemma denote_measure_dim:
   assumes "\<rho> \<in> carrier_mat d d"
     "measurement d n M"
     "\<And>\<rho>' k. \<rho>' \<in> carrier_mat d d \<Longrightarrow> k < n \<Longrightarrow> (DS!k) \<rho>' \<in> carrier_mat d d"
   shows
     "denote_measure n M DS \<rho> \<in> carrier_mat d d"
 proof -
   have dMk: "k < n \<Longrightarrow> M k \<in> carrier_mat d d" for k using assms measurement_def by auto
   have d: "k < n \<Longrightarrow> (M k) * \<rho> * adjoint (M k) \<in> carrier_mat d d" for k 
     using mult_carrier_mat[OF mult_carrier_mat[OF dMk assms(1)] adjoint_dim[OF dMk]] by auto
   then have "k < n \<Longrightarrow> (DS!k) ((M k) * \<rho> * adjoint (M k)) \<in> carrier_mat d d" for k using assms(3) by auto
   then show ?thesis unfolding denote_measure_def using matrix_sum_dim[of n "\<lambda>k. (DS!k) ((M k) * \<rho> * adjoint (M k))"] by auto
 qed
 
 lemma measure_well_com:
   assumes "well_com (Measure n M S)"
   shows "\<And>k. k < n \<Longrightarrow> well_com (S ! k)"
   using assms unfolding well_com.simps using list_all_length by auto
 
 
 text \<open>Semantics of commands\<close>
 fun denote :: "com \<Rightarrow> state \<Rightarrow> state" where
   "denote SKIP \<rho> = \<rho>"
 | "denote (Utrans U) \<rho> = U * \<rho> * adjoint U"
 | "denote (Seq S1 S2) \<rho> = denote S2 (denote S1 \<rho>)"
 | "denote (Measure n M S) \<rho> = denote_measure n M (map denote S) \<rho>"
 | "denote (While M S) \<rho> = denote_while (M 0) (M 1) (denote S) \<rho>"
 
 
 lemma denote_measure_expand:
   assumes m: "m \<le> n" and wc: "well_com (Measure n M S)"  
   shows "denote (Measure m M S) \<rho> = matrix_sum d (\<lambda>k. denote (S!k) ((M k) * \<rho> * adjoint (M k))) m"
   unfolding denote.simps denote_measure_def
 proof -
   have "k < m \<Longrightarrow> map denote S ! k = denote (S!k)" for k using wc m by auto
   then have "k < m \<Longrightarrow> (map denote S ! k) (M k * \<rho> * adjoint (M k)) = denote (S!k) ((M k) * \<rho> * adjoint (M k))" for k by auto
   then show "matrix_sum d (\<lambda>k. (map denote S ! k) (M k * \<rho> * adjoint (M k))) m
     = matrix_sum d (\<lambda>k. denote (S ! k) (M k * \<rho> * adjoint (M k))) m" 
     using matrix_sum_cong[of m "\<lambda>k. (map denote S ! k) (M k * \<rho> * adjoint (M k))" "\<lambda>k. denote (S ! k) (M k * \<rho> * adjoint (M k))"] by auto
 qed
 
 lemma matrix_sum_trace_le:
   fixes f :: "nat \<Rightarrow> complex mat" and g :: "nat \<Rightarrow> complex mat"
   assumes "(\<And>k. k < n \<Longrightarrow> f k \<in> carrier_mat d d)" 
     "(\<And>k. k < n \<Longrightarrow> g k \<in> carrier_mat d d)"
     "(\<And>k. k < n \<Longrightarrow> trace (f k) \<le> trace (g k))"
   shows "trace (matrix_sum d f n) \<le> trace (matrix_sum d g n)"
 proof -
   have "sum (\<lambda>k. trace (f k)) {0..<n} \<le>  sum (\<lambda>k. trace (g k)) {0..<n}"
     using assms by (meson atLeastLessThan_iff sum_mono)
   then show ?thesis using trace_matrix_sum_linear assms by auto
 qed
 
 lemma map_denote_positive_trace_dim:
   assumes "well_com (Measure x1 x2a x3a)"
     "x4 \<in> carrier_mat d d"
     "partial_density_operator x4"
     "\<And>x3aa \<rho>. x3aa \<in> set x3a \<Longrightarrow> well_com x3aa \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
       \<Longrightarrow> positive (denote x3aa \<rho>) \<and> trace (denote x3aa \<rho>) \<le> trace \<rho> \<and> denote x3aa \<rho> \<in> carrier_mat d d"
   shows "\<forall>k < x1. positive ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) 
                \<and> ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<in> carrier_mat d d
                \<and> trace ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<le> trace (x2a k * x4 * adjoint (x2a k))"
 proof -
   have x2ak: "\<forall> k < x1. x2a k \<in> carrier_mat d d" using assms(1) measurement_dim by auto
   then have x2aa:"\<forall> k < x1. (x2a k * x4 * adjoint (x2a k)) \<in> carrier_mat d d" using assms(2) by fastforce
   have posct: "positive ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) 
                \<and> ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<in> carrier_mat d d
                \<and> trace ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<le> trace (x2a k * x4 * adjoint (x2a k))"
     if k: "k < x1" for k
   proof -
     have lea: "adjoint (x2a k) * x2a k \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat assms(1) k by auto
     have "(x2a k * x4 * adjoint (x2a k)) \<in> carrier_mat d d" using k x2aa assms(2) by fastforce
     moreover have "(x3a ! k) \<in> set x3a" using k assms(1) by simp
     moreover have "well_com (x3a ! k)"  using k assms(1) using measure_well_com by blast
     moreover have "partial_density_operator (x2a k * x4 * adjoint (x2a k))" 
       using pdo_close_under_measurement x2ak assms(2,3) lea  k by blast 
     ultimately have "positive (denote (x3a ! k) (x2a k * x4 * adjoint (x2a k)))
          \<and> (denote (x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<in> carrier_mat d d
          \<and> trace (denote (x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<le> trace (x2a k * x4 * adjoint (x2a k))" 
       using assms(4) by auto
     then show ?thesis using assms(1) k by auto          
   qed
   then show ?thesis by auto
 qed
 
 lemma denote_measure_positive_trace_dim:
   assumes "well_com (Measure x1 x2a x3a)"
     "x4 \<in> carrier_mat d d"
     "partial_density_operator x4"
     "\<And>x3aa \<rho>. x3aa \<in> set x3a \<Longrightarrow> well_com x3aa \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
       \<Longrightarrow> positive (denote x3aa \<rho>) \<and> trace (denote x3aa \<rho>) \<le> trace \<rho> \<and> denote x3aa \<rho> \<in> carrier_mat d d"
   shows "positive (denote (Measure x1 x2a x3a) x4) \<and> trace (denote (Measure x1 x2a x3a) x4) \<le> trace x4
         \<and> (denote (Measure x1 x2a x3a) x4) \<in> carrier_mat d d"
 proof -
   have x2ak: "\<forall> k < x1. x2a k \<in> carrier_mat d d" using assms(1) measurement_dim by auto
   then have x2aa:"\<forall> k < x1. (x2a k * x4 * adjoint (x2a k)) \<in> carrier_mat d d" using assms(2) by fastforce
   have posct:"\<forall> k < x1. positive ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) 
                \<and> ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<in> carrier_mat d d
                \<and> trace ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \<le> trace (x2a k * x4 * adjoint (x2a k))"
     using map_denote_positive_trace_dim assms by auto
   
   have "trace (matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) x1)
        \<le> trace (matrix_sum d (\<lambda>k. (x2a k * x4 * adjoint (x2a k))) x1)"
     using posct matrix_sum_trace_le[of x1 "(\<lambda>k. (map denote x3a ! k) (x2a k * x4 * adjoint (x2a k)))" "(\<lambda>k. x2a k * x4 * adjoint (x2a k)) "]
          x2aa by auto
   also have "\<dots> = trace x4"  using trace_measurement[of d "x1" "x2a" x4] assms(1,2) by auto
   finally have " trace (matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) x1) \<le> trace x4" by auto
   then have "trace (denote_measure x1 x2a (map denote x3a) x4) \<le> trace x4"
     unfolding denote_measure_def by auto
   then have "trace (denote (Measure x1 x2a x3a) x4) \<le> trace x4" by auto
   moreover from posct have "positive (denote (Measure x1 x2a x3a) x4)"
     apply auto
     unfolding denote_measure_def using matrix_sum_positive by auto
   moreover have "(denote (Measure x1 x2a x3a) x4) \<in> carrier_mat d d" 
     apply auto  
     unfolding denote_measure_def using matrix_sum_dim posct 
     by (simp add: matrix_sum_dim)
   ultimately show ?thesis by auto
 qed
   
 lemma denote_positive_trace_dim:
   "well_com S \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
    \<Longrightarrow> (positive (denote S \<rho>) \<and> trace (denote S \<rho>) \<le> trace \<rho> \<and> denote S \<rho> \<in> carrier_mat d d)"
 proof (induction arbitrary: \<rho>)
   case SKIP
 then show ?case unfolding partial_density_operator_def by auto
 next
 case (Utrans x)
   then show ?case  
   proof -
     assume wc: "well_com (Utrans x)" and r: "\<rho> \<in> carrier_mat d d" and pdo: "partial_density_operator \<rho>"
     show "positive (denote (Utrans x) \<rho>) \<and> trace (denote (Utrans x) \<rho>) \<le> trace \<rho> \<and> denote (Utrans x) \<rho> \<in> carrier_mat d d"
     proof -
      have "trace (x * \<rho> * adjoint x) = trace ((adjoint x * x) * \<rho>)"
        using r apply (mat_assoc d) using wc by auto
      also have "\<dots> = trace (1\<^sub>m d * \<rho>)" using wc inverts_mat_def inverts_mat_symm adjoint_dim by auto
      also have "\<dots> = trace \<rho>"  using r by auto
      finally have fst: "trace (x * \<rho> * adjoint x) = trace \<rho>" by auto
      moreover have "positive (x * \<rho> * adjoint x)" using positive_close_under_left_right_mult_adjoint r pdo wc unfolding partial_density_operator_def by auto
      moreover have "x * \<rho> * adjoint x \<in> carrier_mat d d" using r wc adjoint_dim index_mult_mat by auto
      ultimately show ?thesis by auto
     qed
   qed
 next
   case (Seq x1 x2a)
   then show ?case
   proof -
     assume dx1: "(\<And>\<rho>. well_com x1 \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (denote x1 \<rho>) \<and> trace (denote x1 \<rho>) \<le> trace \<rho> \<and> denote x1 \<rho> \<in> carrier_mat d d)"
        and dx2a: "(\<And>\<rho>. well_com x2a \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive (denote x2a \<rho>) \<and> trace (denote x2a \<rho>) \<le> trace \<rho> \<and> denote x2a \<rho> \<in> carrier_mat d d)"
        and wc: "well_com (Seq x1 x2a)" and r: "\<rho> \<in> carrier_mat d d" and pdo: "partial_density_operator \<rho>"
     show "positive (denote (Seq x1 x2a) \<rho>) \<and> trace (denote (Seq x1 x2a) \<rho>) \<le> trace \<rho> \<and> denote (Seq x1 x2a) \<rho> \<in> carrier_mat d d"
     proof -
       have ptc: "positive (denote x1 \<rho>) \<and> trace (denote x1 \<rho>) \<le> trace \<rho> \<and> denote x1 \<rho> \<in> carrier_mat d d"
         using wc r pdo dx1 by auto
       then have "partial_density_operator (denote x1 \<rho>)" using pdo unfolding partial_density_operator_def by auto
       then show ?thesis using ptc dx2a wc  dual_order.trans by auto
     qed
   qed
 next
   case (Measure x1 x2a x3a)
   then show ?case using denote_measure_positive_trace_dim by auto
 next
   case (While x1 x2a)
   then show ?case
   proof -
     have "adjoint (x1 0) * (x1 0) + adjoint (x1 1) * (x1 1) = 1\<^sub>m d"
       using measurement_id2 While by auto
     moreover have "(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> 
       positive (denote x2a \<rho>) \<and> trace (denote x2a \<rho>) \<le> trace \<rho> \<and> denote x2a \<rho> \<in> carrier_mat d d)"
       using While by fastforce
     moreover have "x1 0 \<in> carrier_mat d d \<and> x1 1 \<in> carrier_mat d d"
       using measurement_dim While by fastforce
     ultimately have "denote_while (x1 0) (x1 1) (denote x2a) \<rho> \<in> carrier_mat d d \<and> 
                positive (denote_while (x1 0) (x1 1) (denote x2a) \<rho>) \<and> 
                trace (denote_while (x1 0) (x1 1) (denote x2a) \<rho>) \<le> trace \<rho>"
       using denote_while_dim_positive[of "x1 0" "x1 1" "denote x2a" "\<rho>"] While by fastforce
     then show ?thesis by auto
   qed 
 qed
 
 lemma denote_dim_pdo:
   "well_com S \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
    \<Longrightarrow> (denote S \<rho> \<in> carrier_mat d d) \<and> (partial_density_operator (denote S \<rho>))"
   using denote_positive_trace_dim unfolding partial_density_operator_def by fastforce
 
 lemma denote_dim:
   "well_com S \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
    \<Longrightarrow> (denote S \<rho> \<in> carrier_mat d d)"
   using denote_positive_trace_dim by auto
 
 lemma denote_trace:
   "well_com S \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
    \<Longrightarrow> trace (denote S \<rho>) \<le> trace \<rho>"
   using denote_positive_trace_dim by auto
 
 lemma denote_partial_density_operator:
   assumes "well_com S" "partial_density_operator \<rho>" "\<rho> \<in> carrier_mat d d"
   shows "partial_density_operator (denote S \<rho>)"
   using assms denote_positive_trace_dim unfolding partial_density_operator_def
   using dual_order.trans by blast
 
 
 lemma denote_while_n_sum_mat_seq:
   assumes "\<rho> \<in> carrier_mat d d" and
     "x1 0 \<in> carrier_mat d d" and
     "x1 1 \<in> carrier_mat d d" and
     "partial_density_operator \<rho>" and
     wc: "well_com x2" and mea: "measurement d 2 x1"  
   shows "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>))"   
 proof -
   let ?A = "x1 0" and ?B = "x1 1"
   have dx2:"\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow>
             positive ((denote x2) \<rho>) \<and> trace ((denote x2) \<rho>) \<le> trace \<rho> \<and> (denote x2) \<rho> \<in> carrier_mat d d"
     using denote_positive_trace_dim wc by auto
   have lo1: "adjoint ?A * ?A + adjoint ?B * ?B = 1\<^sub>m d" using measurement_id2 assms by auto
   have "\<forall>n. matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n \<in> carrier_mat d d"
     using assms dx2 
     by (metis denote_while_n_dim matrix_sum_dim)
   moreover have "(\<forall>n. partial_density_operator (matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n))"
     using assms dx2 lo1
     by (metis denote_while_n_sum_partial_density)
   moreover have "(\<forall>n. matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n \<le>\<^sub>L matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) (Suc n))"
     using assms dx2 lo1
     by (metis denote_while_n_sum_lowner_le)
   ultimately show ?thesis
     unfolding matrix_seq_def by auto
 qed 
 
 lemma denote_while_n_add:
   assumes M0: "x1 0 \<in> carrier_mat d d" and
     M1: "x1 1 \<in> carrier_mat d d" and
     wc: "well_com x2" and mea: "measurement d 2 x1" and
     DS: "(\<And>\<rho>\<^sub>1 \<rho>\<^sub>2. \<rho>\<^sub>1 \<in> carrier_mat d d \<Longrightarrow> \<rho>\<^sub>2 \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho>\<^sub>1 \<Longrightarrow> 
       partial_density_operator \<rho>\<^sub>2 \<Longrightarrow> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2) \<le> 1 \<Longrightarrow> denote x2 (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote x2 \<rho>\<^sub>1 + denote x2 \<rho>\<^sub>2)"
   shows "\<rho>\<^sub>1 \<in> carrier_mat d d \<Longrightarrow> \<rho>\<^sub>2 \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho>\<^sub>1 \<Longrightarrow> partial_density_operator \<rho>\<^sub>2 \<Longrightarrow> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2) \<le> 1 \<Longrightarrow> 
     denote_while_n (x1 0) (x1 1) (denote x2) k (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote_while_n (x1 0) (x1 1) (denote x2) k \<rho>\<^sub>1 + denote_while_n (x1 0) (x1 1) (denote x2) k \<rho>\<^sub>2"
 proof (auto, induct k arbitrary: \<rho>\<^sub>1 \<rho>\<^sub>2)
   case 0
   then show ?case
     apply auto using M0 by (mat_assoc d)
 next
   case (Suc k)
   then show ?case 
   proof -
     let ?A = "x1 0" and ?B = "x1 1"
     have dx2:"(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive ((denote x2) \<rho>) \<and> trace ((denote x2) \<rho>) \<le> trace \<rho> \<and> (denote x2) \<rho> \<in> carrier_mat d d) "
       using denote_positive_trace_dim wc by auto
     have lo1: "adjoint ?B * ?B \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat assms by auto
     have dim1: "x1 1 * \<rho>\<^sub>1 * adjoint (x1 1) \<in> carrier_mat d d" using assms Suc 
       by (metis adjoint_dim mult_carrier_mat)
     moreover have pdo1: "partial_density_operator (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1))"
       using pdo_close_under_measurement assms(2) Suc(2,4) lo1 by auto
     ultimately have dimr1: "denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) \<in> carrier_mat d d"
       using dx2 by auto
     have dim2: "x1 1 * \<rho>\<^sub>2 * adjoint (x1 1) \<in> carrier_mat d d" using assms Suc 
       by (metis adjoint_dim mult_carrier_mat)
     moreover have pdo2: "partial_density_operator (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))"
       using pdo_close_under_measurement assms(2) Suc lo1 by auto
     ultimately have dimr2: "denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1)) \<in> carrier_mat d d"
       using dx2 by auto
     have pdor1: "partial_density_operator (denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)))"
       using denote_partial_density_operator assms dim1 pdo1 by auto
     have pdor2: "partial_density_operator (denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1)))"
       using denote_partial_density_operator assms dim2 pdo2 by auto
     have "trace (denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1))) \<le> trace (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1))"
       using dx2 dim1 pdo1 by auto
     also have tr1: "\<dots> \<le> trace \<rho>\<^sub>1" using trace_decrease_mul_adj assms Suc lo1 by auto
     finally have trr1:" trace (denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1))) \<le> trace \<rho>\<^sub>1" by auto
     have "trace (denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))) \<le> trace (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))"
       using dx2 dim2 pdo2 by auto
     also have tr2: "\<dots> \<le> trace \<rho>\<^sub>2" using trace_decrease_mul_adj assms Suc lo1 by auto
     finally have trr2:" trace (denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))) \<le> trace \<rho>\<^sub>2" by auto
     from tr1 tr2 Suc have "trace ( (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) +  (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))) \<le> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2)"
       using trace_add_linear trace_add_linear[of "(x1 1 * \<rho>\<^sub>1 * adjoint (x1 1))" d "(x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))"]
             trace_add_linear[of \<rho>\<^sub>1 d \<rho>\<^sub>2]
       using dim1 dim2 by auto
     then have trless1: "trace ( (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) +  (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))) \<le> 1" using Suc by auto
     from trr1 trr2 Suc have "trace (denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) + denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))) \<le> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2)"
       using trace_add_linear[of "denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1))" d "denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))"]
             trace_add_linear[of \<rho>\<^sub>1 d \<rho>\<^sub>2]
       using dimr1 dimr2 by auto
     then have trless2: "trace (denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) + denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))) \<le> 1"
       using Suc by auto
     have "x1 1 * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x1 1) = (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) + (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))"
       using M1 Suc by (mat_assoc d)
     then have deadd: "denote x2 (x1 1 * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x1 1)) =
         denote x2 (x1 1 * \<rho>\<^sub>1 * adjoint (x1 1)) + denote x2 (x1 1 * \<rho>\<^sub>2 * adjoint (x1 1))"
       using assms(5) dim1 dim2 pdo1 pdo2 trless1 by auto
     from dimr1 dimr2 pdor1 pdor2 trless2 Suc(1) deadd show ?thesis by auto
   qed
 qed
 
 lemma denote_while_add:
   assumes r1: "\<rho>\<^sub>1 \<in> carrier_mat d d" and
     r2: "\<rho>\<^sub>2 \<in> carrier_mat d d" and
     M0: "x1 0 \<in> carrier_mat d d" and
     M1: "x1 1 \<in> carrier_mat d d" and
     pdo1: "partial_density_operator \<rho>\<^sub>1" and
     pdo2: "partial_density_operator \<rho>\<^sub>2" and tr12: "trace (\<rho>\<^sub>1 + \<rho>\<^sub>2) \<le> 1" and
     wc: "well_com x2" and mea: "measurement d 2 x1" and
     DS: "(\<And>\<rho>\<^sub>1 \<rho>\<^sub>2. \<rho>\<^sub>1 \<in> carrier_mat d d \<Longrightarrow> \<rho>\<^sub>2 \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho>\<^sub>1 \<Longrightarrow> 
       partial_density_operator \<rho>\<^sub>2 \<Longrightarrow> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2) \<le> 1 \<Longrightarrow> denote x2 (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote x2 \<rho>\<^sub>1 + denote x2 \<rho>\<^sub>2)"
     shows
     "denote_while (x1 0) (x1 1) (denote x2) (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote_while (x1 0) (x1 1) (denote x2) \<rho>\<^sub>1 + denote_while (x1 0) (x1 1) (denote x2) \<rho>\<^sub>2"
 proof -
   let ?A = "x1 0" and ?B = "x1 1"
   have dx2:"(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive ((denote x2) \<rho>) \<and> trace ((denote x2) \<rho>) \<le> trace \<rho> \<and> (denote x2) \<rho> \<in> carrier_mat d d) "
     using denote_positive_trace_dim wc by auto
   have lo1: "adjoint ?A * ?A + adjoint ?B * ?B = 1\<^sub>m d" using measurement_id2 assms by auto
   have pdo12: "partial_density_operator (\<rho>\<^sub>1 + \<rho>\<^sub>2)" using pdo1 pdo2 unfolding partial_density_operator_def using tr12 positive_add assms by auto
   have ms1: "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1))"   
     using denote_while_n_sum_mat_seq assms by auto
   have ms2: "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2))"   
     using denote_while_n_sum_mat_seq assms by auto
   have dim1: "(\<forall>n. matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>\<^sub>1) n \<in> carrier_mat d d)"   
     using assms dx2 
     by (metis denote_while_n_dim matrix_sum_dim)
   have dim2: "(\<forall>n. matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>\<^sub>2) n \<in> carrier_mat d d)"   
     using assms dx2 
     by (metis denote_while_n_dim matrix_sum_dim)
   have "trace (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1) n +
                matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2) n) \<le> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2)"
     for n
   proof -
     have "trace (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1) n) \<le> trace \<rho>\<^sub>1"
       using denote_while_n_sum_trace dx2 lo1 assms by auto
     moreover have "trace (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2) n) \<le> trace \<rho>\<^sub>2"
       using denote_while_n_sum_trace dx2 lo1 assms by auto
     ultimately show ?thesis
       using trace_add_linear dim1 dim2
       by (metis add_mono_thms_linordered_semiring(1) r1 r2)
   qed
   then have "\<forall>n. trace (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1) n + matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2) n) \<le> 1"
     using assms(7) dual_order.trans by blast
   then have lladd: "matrix_seq.lowner_lub  (\<lambda>n. (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1)) n + (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2)) n) = matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1))
     + matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2))"
     using lowner_lub_add ms1 ms2 by auto
  
   have "matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n (\<rho>\<^sub>1 + \<rho>\<^sub>2)) m =
     matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1) m + matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2) m"
     for m
   proof -
     have "(\<And>k. k < m \<Longrightarrow> denote_while_n (x1 0) (x1 1) (denote x2) k (\<rho>\<^sub>1 + \<rho>\<^sub>2) \<in> carrier_mat d d)"
       using denote_while_n_dim dx2 pdo12 assms measurement_dim by auto
     moreover have "(\<And>k. k < m \<Longrightarrow> denote_while_n (x1 0) (x1 1) (denote x2) k \<rho>\<^sub>1 \<in> carrier_mat d d)" 
       using denote_while_n_dim dx2  assms measurement_dim by auto
     moreover have "(\<And>k. k < m \<Longrightarrow> denote_while_n (x1 0) (x1 1) (denote x2) k \<rho>\<^sub>2 \<in> carrier_mat d d)"
       using denote_while_n_dim dx2  assms measurement_dim by auto
     moreover have "(\<forall>  k < m.
       denote_while_n (x1 0) (x1 1) (denote x2) k (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote_while_n (x1 0) (x1 1) (denote x2) k \<rho>\<^sub>1 + denote_while_n (x1 0) (x1 1) (denote x2) k \<rho>\<^sub>2)"
       using denote_while_n_add assms by auto
     ultimately show ?thesis
       using matrix_sum_add[of m "(\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n (\<rho>\<^sub>1 + \<rho>\<^sub>2))" d "(\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>\<^sub>1)"
         "(\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>\<^sub>2)"] by auto
   qed
   then have "matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n (\<rho>\<^sub>1 + \<rho>\<^sub>2))) = 
     matrix_seq.lowner_lub (\<lambda>n. (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>1)) n + (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>\<^sub>2)) n)"
     using lladd by presburger
   then show ?thesis unfolding denote_while_def matrix_inf_sum_def using lladd by auto
 qed
 
 lemma denote_add:
   "well_com S \<Longrightarrow> \<rho>\<^sub>1 \<in> carrier_mat d d \<Longrightarrow> \<rho>\<^sub>2 \<in> carrier_mat d d \<Longrightarrow>
    partial_density_operator \<rho>\<^sub>1 \<Longrightarrow> partial_density_operator \<rho>\<^sub>2 \<Longrightarrow> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2) \<le> 1 \<Longrightarrow>
    denote S (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote S \<rho>\<^sub>1 + denote S \<rho>\<^sub>2"
 proof (induction arbitrary: \<rho>\<^sub>1 \<rho>\<^sub>2)
   case SKIP
   then show ?case by auto
 next
   case (Utrans U)
   then show ?case by (clarsimp, mat_assoc d)
 next
   case (Seq x1 x2a)
   then show ?case
   proof -
     have dim1: "denote x1 \<rho>\<^sub>1 \<in> carrier_mat d d" using denote_positive_trace_dim Seq by auto
     have dim2: "denote x1 \<rho>\<^sub>2 \<in> carrier_mat d d" using denote_positive_trace_dim Seq by auto
     have "trace (denote x1  \<rho>\<^sub>1) \<le> trace \<rho>\<^sub>1" using denote_positive_trace_dim Seq by auto
     moreover have "trace (denote x1 \<rho>\<^sub>2) \<le> trace \<rho>\<^sub>2" using denote_positive_trace_dim Seq by auto
     ultimately have tr: "trace (denote x1 \<rho>\<^sub>1 + denote x1 \<rho>\<^sub>2) \<le> 1" using Seq(4,5,8) trace_add_linear dim1 dim2
       by (smt add_mono order_trans)
 
     have "denote (Seq x1 x2a) (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote x2a (denote x1 (\<rho>\<^sub>1 + \<rho>\<^sub>2))" by auto
     moreover have "denote x1 (\<rho>\<^sub>1 + \<rho>\<^sub>2) = denote x1 \<rho>\<^sub>1 + denote x1 \<rho>\<^sub>2" using Seq by auto
     moreover have "partial_density_operator (denote x1 \<rho>\<^sub>1)" using denote_partial_density_operator Seq by auto
     moreover have "partial_density_operator (denote x1 \<rho>\<^sub>2)" using denote_partial_density_operator Seq by auto
     ultimately show ?thesis using Seq dim1 dim2 tr by auto
   qed
 next
   case (Measure x1 x2a x3a)
   then show ?case
   proof -
     have ptc: "\<And>x3aa \<rho>. x3aa \<in> set x3a \<Longrightarrow> well_com x3aa \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
       \<Longrightarrow> positive (denote x3aa \<rho>) \<and> trace (denote x3aa \<rho>) \<le> trace \<rho> \<and> denote x3aa \<rho> \<in> carrier_mat d d"
       using denote_positive_trace_dim Measure by auto
     then have map:"\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> \<forall> k < x1. positive ((map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k))) 
                \<and> ((map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k))) \<in> carrier_mat d d
                \<and> trace ((map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k))) \<le> trace (x2a k * \<rho> * adjoint (x2a k))"
       using Measure map_denote_positive_trace_dim by auto
 
     from map have mapd1: "\<And>k. k < x1 \<Longrightarrow> (map denote x3a ! k) (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) \<in> carrier_mat d d"
       using Measure by auto
     from map have mapd2: "\<And>k. k < x1 \<Longrightarrow> (map denote x3a ! k) (x2a k * \<rho>\<^sub>2 * adjoint (x2a k)) \<in> carrier_mat d d"
       using Measure by auto
     have dim1:"\<And>k. k < x1 \<Longrightarrow> x2a k * \<rho>\<^sub>1 * adjoint (x2a k) \<in> carrier_mat d d" 
       using well_com.simps(5) measurement_dim Measure by fastforce
     have dim2: "\<And>k. k < x1 \<Longrightarrow> x2a k * \<rho>\<^sub>2 * adjoint (x2a k) \<in> carrier_mat d d"
       using well_com.simps(5) measurement_dim Measure by fastforce
     have "\<And>k. k < x1 \<Longrightarrow> (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) \<in> carrier_mat d d"
       using well_com.simps(5) measurement_dim Measure by fastforce
     have lea: "\<And>k. k < x1 \<Longrightarrow> adjoint (x2a k) * x2a k \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat Measure by auto
     moreover have dimx: "\<And>k. k < x1 \<Longrightarrow> x2a k \<in> carrier_mat d d" using Measure measurement_dim by auto
     ultimately have pdo12:"\<And>k. k < x1 \<Longrightarrow> partial_density_operator (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) \<and> partial_density_operator (x2a k * \<rho>\<^sub>2 * adjoint (x2a k))"
       using pdo_close_under_measurement Measure measurement_dim by blast
 
     have trless: "trace (x2a k * \<rho>\<^sub>1 * adjoint (x2a k) + x2a k * \<rho>\<^sub>2 * adjoint (x2a k)) \<le> 1"
       if k: "k < x1" for k
     proof -
       have "trace (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) \<le> trace \<rho>\<^sub>1" using trace_decrease_mul_adj dimx Measure lea k by auto
       moreover have "trace (x2a k * \<rho>\<^sub>2 * adjoint (x2a k)) \<le> trace \<rho>\<^sub>2" using trace_decrease_mul_adj dimx Measure lea k by auto
       ultimately have "trace (x2a k * \<rho>\<^sub>1 * adjoint (x2a k) + x2a k * \<rho>\<^sub>2 * adjoint (x2a k)) \<le> trace (\<rho>\<^sub>1 + \<rho>\<^sub>2)"
         using trace_add_linear dim1 dim2 Measure k 
         by (metis add_mono_thms_linordered_semiring(1))
       then show ?thesis using Measure(7) by auto
     qed
  
     have dist: "(x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) = (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) + (x2a k * \<rho>\<^sub>2 * adjoint (x2a k))"
       if k: "k < x1" for k
     proof -
       have "(x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) = ((x2a k * \<rho>\<^sub>1 + x2a k * \<rho>\<^sub>2) * adjoint (x2a k))"
         using mult_add_distrib_mat Measure well_com.simps(4) measurement_dim by (metis k)
       also have "\<dots> = (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) + (x2a k * \<rho>\<^sub>2 * adjoint (x2a k))"
         apply (mat_assoc d) using Measure k well_com.simps(4) measurement_dim by auto
       finally show ?thesis by auto
     qed
 
     have mapadd: "(map denote x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) =
         (map denote x3a ! k) (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) + (map denote x3a ! k) (x2a k * \<rho>\<^sub>2 * adjoint (x2a k))"
       if k: "k < x1" for k
     proof -
       have "(map denote x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) = denote (x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k))"
         using Measure.prems(1) k by auto
       then have mapx: "(map denote x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) =  denote (x3a ! k) ((x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) + (x2a k * \<rho>\<^sub>2 * adjoint (x2a k)))"
         using dist k by auto
       have "denote (x3a ! k) ((x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) + (x2a k * \<rho>\<^sub>2 * adjoint (x2a k))) 
            = denote (x3a ! k) (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)) + denote (x3a ! k) (x2a k * \<rho>\<^sub>2  * adjoint (x2a k))"
         using Measure(1,2) dim1 dim2 pdo12 trless k
         by (simp add: list_all_length)
       then show ?thesis  
         using Measure.prems(1) mapx k by auto
     qed
     then have mapd12:"(\<And>k. k < x1 \<Longrightarrow> (map denote x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)) \<in> carrier_mat d d)"
       using mapd1 mapd2 by auto
 
     have "matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k))) x1 =
           matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * \<rho>\<^sub>1 * adjoint (x2a k))) x1 + 
           matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * \<rho>\<^sub>2 * adjoint (x2a k))) x1"
       using matrix_sum_add[of x1 "(\<lambda>k. (map denote x3a ! k) (x2a k * (\<rho>\<^sub>1 + \<rho>\<^sub>2) * adjoint (x2a k)))" d "(\<lambda>k. (map denote x3a ! k) (x2a k * \<rho>\<^sub>1 * adjoint (x2a k)))" "(\<lambda>k. (map denote x3a ! k) (x2a k * \<rho>\<^sub>2 * adjoint (x2a k)))"]
       using mapd12 mapd1 mapd2 mapadd by auto
     then show ?thesis  using denote.simps(4) unfolding denote_measure_def by auto
   qed
 next
   case (While x1 x2)
   then show ?case
     apply auto using denote_while_add measurement_dim by auto     
 qed 
 
 
 lemma mulfact:
   fixes c:: real and a:: complex and b:: complex
   assumes "c\<ge>0" "a \<le> b"
   shows "c * a \<le> c * b"
-  using assms Im_complex_of_real Re_complex_of_real less_eq_complex_def mult_eq_0_iff real_mult_le_cancel_iff2 times_complex.simps
-  using eq_iff by fastforce 
+  using assms mult_le_cancel_iff2 by force
 
 lemma denote_while_n_scale:
   fixes c:: real
   assumes "c\<ge>0"
     "measurement d 2 x1" "well_com x2"
     "(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (c \<cdot>\<^sub>m \<rho>) \<le> 1 \<Longrightarrow> 
       denote x2 (c \<cdot>\<^sub>m \<rho>) =  c \<cdot>\<^sub>m denote x2 \<rho>)"
   shows "\<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (c \<cdot>\<^sub>m \<rho>) \<le> 1 \<Longrightarrow> 
     denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \<cdot>\<^sub>m \<rho>) = c \<cdot>\<^sub>m (denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>)"
 proof (auto, induct n arbitrary: \<rho>)
   case 0
   then show ?case 
     apply auto apply (mat_assoc d) using assms measurement_dim by auto
 next
   case (Suc n)
   then show ?case
   proof -
     let ?A = "x1 0" and ?B = "x1 1"
     have dx2:"(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive ((denote x2) \<rho>) \<and> trace ((denote x2) \<rho>) \<le> trace \<rho> \<and> (denote x2) \<rho> \<in> carrier_mat d d) "
       using denote_positive_trace_dim assms by auto
     have lo1: "adjoint ?B * ?B \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat assms by auto
     have dim1: "x1 1 * \<rho> * adjoint (x1 1) \<in> carrier_mat d d" using assms(2) Suc(2) measurement_dim 
       by (meson adjoint_dim mult_carrier_mat one_less_numeral_iff semiring_norm(76))
     moreover have pdo1: "partial_density_operator (x1 1 * \<rho> * adjoint (x1 1))"
       using pdo_close_under_measurement assms  Suc lo1 measurement_dim 
       by (metis One_nat_def lessI numeral_2_eq_2)
     ultimately have dimr: "denote x2 (x1 1 * \<rho> * adjoint (x1 1)) \<in> carrier_mat d d"
       using dx2 by auto
     have pdor: "partial_density_operator (denote x2 (x1 1 * \<rho> * adjoint (x1 1)))"
       using denote_partial_density_operator assms dim1 pdo1 by auto
     have "trace (denote x2 (x1 1 * \<rho> * adjoint (x1 1))) \<le> trace (x1 1 * \<rho> * adjoint (x1 1))"
       using dx2 dim1 pdo1 by auto
     also have trr1: "\<dots> \<le> trace \<rho>" using trace_decrease_mul_adj assms Suc lo1 measurement_dim by auto
     finally have trr: "trace (denote x2 (x1 1 * \<rho> * adjoint (x1 1))) \<le> trace \<rho>" by auto
     moreover have "trace (c \<cdot>\<^sub>m denote x2 (x1 1 * \<rho> * adjoint (x1 1))) = c * trace (denote x2 (x1 1 * \<rho> * adjoint (x1 1)))"
       using trace_smult dimr by auto
     moreover have trcr: "trace (c \<cdot>\<^sub>m \<rho>) = c * trace \<rho>" using trace_smult Suc by auto
     ultimately have "trace (c \<cdot>\<^sub>m denote x2 (x1 1 * \<rho> * adjoint (x1 1))) \<le> trace (c \<cdot>\<^sub>m \<rho>)"
       using assms(1) state_sig.mulfact by auto
     then have trrc: "trace (c \<cdot>\<^sub>m denote x2 (x1 1 * \<rho> * adjoint (x1 1))) \<le>  1" using Suc by auto
     have "trace (c \<cdot>\<^sub>m (x1 1 * \<rho> * adjoint (x1 1))) = c * trace (x1 1 * \<rho> * adjoint (x1 1))"
       using trace_smult dim1 by auto
     then have "trace (c \<cdot>\<^sub>m (x1 1 * \<rho> * adjoint (x1 1))) \<le> trace (c \<cdot>\<^sub>m \<rho>)"  using trcr trr1 assms(1) 
       using state_sig.mulfact by auto
     then have trrle: "trace (c \<cdot>\<^sub>m (x1 1 * \<rho> * adjoint (x1 1))) \<le> 1" using Suc by auto
     have "x1 1 * (complex_of_real c \<cdot>\<^sub>m \<rho>) * adjoint (x1 1) = complex_of_real c \<cdot>\<^sub>m (x1 1 * \<rho> * adjoint (x1 1))"
       apply (mat_assoc d) using Suc.prems(1) assms measurement_dim by auto
     then have "denote x2 (x1 1 * (complex_of_real c \<cdot>\<^sub>m \<rho>) * adjoint (x1 1)) =  (denote x2 (c \<cdot>\<^sub>m (x1 1 * (\<rho>) * adjoint (x1 1))))"
       by auto
     moreover have "denote x2 (c \<cdot>\<^sub>m (x1 1 * \<rho> * adjoint (x1 1))) = c \<cdot>\<^sub>m denote x2 (x1 1 * \<rho> * adjoint (x1 1))"
       using assms(4) dim1 pdo1 trrle by auto
     ultimately have "denote x2 (x1 1 * (complex_of_real c \<cdot>\<^sub>m \<rho>) * adjoint (x1 1)) = c \<cdot>\<^sub>m denote x2 (x1 1 * \<rho> * adjoint (x1 1))"
       using assms by auto
     then show ?thesis using Suc dimr pdor trrc by auto
   qed
 qed
   
 lemma denote_while_scale:
   fixes c:: real
   assumes "\<rho> \<in> carrier_mat d d"
     "partial_density_operator \<rho>"
     "trace (c \<cdot>\<^sub>m \<rho>) \<le> 1" "c \<ge> 0"
     "measurement d 2 x1" "well_com x2"
     "(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (c \<cdot>\<^sub>m \<rho>) \<le> 1 \<Longrightarrow> 
       denote x2 (c \<cdot>\<^sub>m \<rho>) =  c \<cdot>\<^sub>m denote x2 \<rho>)"
   shows "denote_while (x1 0) (x1 1) (denote x2) (c \<cdot>\<^sub>m \<rho>) = c \<cdot>\<^sub>m denote_while (x1 0) (x1 1) (denote x2) \<rho>"
 proof -
   let ?A = "x1 0" and ?B = "x1 1"
   have dx2:"(\<And>\<rho>. \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> positive ((denote x2) \<rho>) \<and> trace ((denote x2) \<rho>) \<le> trace \<rho> \<and> (denote x2) \<rho> \<in> carrier_mat d d) "
     using denote_positive_trace_dim assms by auto
   have lo1: "adjoint ?A * ?A + adjoint ?B * ?B = 1\<^sub>m d" using measurement_id2 assms by auto
   have ms: "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>))"   
     using denote_while_n_sum_mat_seq assms measurement_dim by auto
 
   have trcless: "trace (c \<cdot>\<^sub>m matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n) \<le> 1" for n
   proof -
     have dimr: "matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n \<in> carrier_mat d d"   
       using assms dx2 denote_while_n_dim matrix_sum_dim 
       using matrix_seq.dim ms by auto 
     have "trace (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>) n) \<le> trace \<rho>"
       using denote_while_n_sum_trace dx2 lo1 assms measurement_dim by auto
     moreover have "trace (c \<cdot>\<^sub>m matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n) = c * trace (matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n)"
       using trace_smult dimr by auto
     moreover have "trace (c \<cdot>\<^sub>m \<rho>) =  c * trace \<rho>"  using trace_smult assms by auto        
     ultimately have "trace (c \<cdot>\<^sub>m matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>) n) \<le> trace (c \<cdot>\<^sub>m \<rho>)"
       using  assms(4) by (simp add: ordered_comm_semiring_class.comm_mult_left_mono)
     then show ?thesis
       using assms by auto
   qed
 
   have llscale: "matrix_seq.lowner_lub  (\<lambda>n. c \<cdot>\<^sub>m (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>)) n) 
     = c \<cdot>\<^sub>m matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>))"
     using lowner_lub_scale[of d "(matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>))" c] ms trcless assms(4) by auto
   have "matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \<cdot>\<^sub>m \<rho>)) m 
     = c \<cdot>\<^sub>m (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>)) m"
     for m
   proof -
     have  dim:"(\<And>k. k < m \<Longrightarrow> denote_while_n (x1 0) (x1 1) (denote x2) k \<rho> \<in> carrier_mat d d)" 
       using denote_while_n_dim dx2  assms measurement_dim by auto
     then have dimr: "(\<And>k. k < m \<Longrightarrow> c \<cdot>\<^sub>m denote_while_n (x1 0) (x1 1) (denote x2) k \<rho> \<in> carrier_mat d d)"
       using smult_carrier_mat by auto
     have "\<forall> n<m. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \<cdot>\<^sub>m \<rho>) = c \<cdot>\<^sub>m (denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>)"
       using denote_while_n_scale assms by auto
     then have "(matrix_sum d (\<lambda>n. c \<cdot>\<^sub>m denote_while_n ?A ?B (denote x2) n \<rho>)) m = 
       matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \<cdot>\<^sub>m \<rho>)) m "
       using matrix_sum_cong[of m "\<lambda>n. complex_of_real c \<cdot>\<^sub>m denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>"] dimr 
       by fastforce
     moreover have "(matrix_sum d (\<lambda>n. c \<cdot>\<^sub>m denote_while_n ?A ?B (denote x2) n \<rho>)) m = c \<cdot>\<^sub>m (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>)) m"
       using matrix_sum_smult[of m "(\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n \<rho>)" d c] dim by auto
     ultimately show ?thesis by auto
   qed
   then have "matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \<cdot>\<^sub>m \<rho>))) =
     matrix_seq.lowner_lub (\<lambda>n. c \<cdot>\<^sub>m (matrix_sum d (\<lambda>n. denote_while_n ?A ?B (denote x2) n \<rho>)) n)"
     by meson
   then show ?thesis
     unfolding denote_while_def matrix_inf_sum_def using llscale by auto
 qed
  
 lemma denote_scale:
   fixes c :: real
   assumes "c\<ge>0"
   shows "well_com S \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow>
          trace (c  \<cdot>\<^sub>m \<rho>) \<le> 1 \<Longrightarrow> denote S (c  \<cdot>\<^sub>m \<rho>) = c  \<cdot>\<^sub>m denote S \<rho>"
 proof (induction arbitrary: \<rho>)
   case SKIP
   then show ?case by auto
 next
   case (Utrans x)
   then show ?case
     unfolding denote.simps apply (mat_assoc d) using Utrans by auto
 next
   case (Seq x1 x2a)
   then show ?case
   proof -
     have cd: "denote x1 (c \<cdot>\<^sub>m \<rho>) = c \<cdot>\<^sub>m denote x1 \<rho>" using Seq by auto
     have x1: "denote x1 \<rho> \<in> carrier_mat d d \<and> partial_density_operator (denote x1 \<rho>) \<and> trace (denote x1 \<rho>) \<le> trace \<rho>" 
       using denote_positive_trace_dim Seq denote_partial_density_operator by auto
     have "trace (c \<cdot>\<^sub>m denote x1 \<rho>) = c * trace (denote x1 \<rho>)" using trace_smult x1 by auto
     also have "\<dots> \<le> c * trace \<rho>" using x1 assms 
       by (metis Seq.prems cd denote_positive_trace_dim partial_density_operator_def positive_scale smult_carrier_mat trace_smult well_com.simps(3))
     also have "\<dots> \<le> 1" using Seq(6) trace_smult Seq(4) 
       by (simp add: trace_smult)
     finally have "trace (c \<cdot>\<^sub>m denote x1 \<rho>) \<le>1" by auto
     then have "denote x2a (c \<cdot>\<^sub>m denote x1 \<rho>) = c \<cdot>\<^sub>m denote x2a ( denote x1 \<rho>)" using x1 Seq by auto
     then show ?thesis using denote.simps(4) cd by auto
   qed
 next
   case (Measure x1 x2a x3a)
   then show ?case
   proof -
     have ptc: "\<And>x3aa \<rho>. x3aa \<in> set x3a \<Longrightarrow> well_com x3aa \<Longrightarrow> \<rho> \<in> carrier_mat d d \<Longrightarrow> partial_density_operator \<rho> 
       \<Longrightarrow> positive (denote x3aa \<rho>) \<and> trace (denote x3aa \<rho>) \<le> trace \<rho> \<and> denote x3aa \<rho> \<in> carrier_mat d d"
       using denote_positive_trace_dim Measure by auto
     have cad: "x2a k * (c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k) = c \<cdot>\<^sub>m (x2a k * \<rho> * adjoint (x2a k))"
       if k: "k < x1" for k
       apply (mat_assoc d) using well_com.simps Measure measurement_dim k by auto
     have "\<forall>k<x1. x2a k * \<rho> * adjoint (x2a k) \<in> carrier_mat d d"
       using Measure(2) measurement_dim Measure(3) by fastforce
     have lea: "\<forall>k<x1. adjoint (x2a k) * x2a k \<le>\<^sub>L 1\<^sub>m d" using measurement_le_one_mat Measure(2) by auto
     then have pdox: "\<forall> k<x1. partial_density_operator (x2a k * \<rho> * adjoint (x2a k))"
       using pdo_close_under_measurement Measure(2,3,4) measurement_dim  
       by (meson state_sig.well_com.simps(4))
     have x2aa:"\<forall> k < x1. (x2a k * \<rho> * adjoint (x2a k)) \<in> carrier_mat d d" using Measure(2,3) measurement_dim by fastforce
     have dimm: "(\<And>k. k < x1 \<Longrightarrow> (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k)) \<in> carrier_mat d d)"
       using map_denote_positive_trace_dim Measure(2,3,4) ptc by auto
     then have dimcm: "(\<And>k. k < x1 \<Longrightarrow> c \<cdot>\<^sub>m (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k)) \<in> carrier_mat d d)"
       using smult_carrier_mat by auto
     
     have tra: "\<forall> k < x1. trace ((x2a k * \<rho> * adjoint (x2a k))) \<le> trace \<rho>"
       using trace_decrease_mul_adj Measure lea measurement_dim by auto
 
     have tra1: "trace (c \<cdot>\<^sub>m (x2a k * \<rho> * adjoint (x2a k))) \<le> 1" if k: "k < x1" for k
     proof -
       have trle: "trace (x2a k * \<rho> * adjoint (x2a k)) \<le> trace \<rho>" using tra k by auto
       have "trace (c \<cdot>\<^sub>m (x2a k * \<rho> * adjoint (x2a k))) = c * trace ((x2a k * \<rho> * adjoint (x2a k)))"
         using trace_smult x2aa k by auto
       also have "\<dots> \<le> c * trace \<rho>" 
         using trle assms mulfact  by auto
       also have "\<dots> \<le> 1" using Measure(3,5) trace_smult  by metis
       finally show ?thesis by auto
     qed
 
     have "(map denote x3a ! k) (x2a k * (c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k)) 
         = c \<cdot>\<^sub>m (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k))" if k: "k < x1" for k
     proof -
       have "denote (x3a ! k) (x2a k * (c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k)) = denote (x3a ! k) (c \<cdot>\<^sub>m (x2a k * \<rho> * adjoint (x2a k)))"
         using cad k by auto
       also have "\<dots> = c \<cdot>\<^sub>m denote (x3a ! k) ( (x2a k * \<rho> * adjoint (x2a k)))"
         using Measure(1,2) pdox x2aa tra1 k using measure_well_com by auto
       finally have "denote (x3a ! k) (x2a k * (complex_of_real c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k)) = complex_of_real c \<cdot>\<^sub>m denote (x3a ! k) (x2a k * \<rho> * adjoint (x2a k))"
         by auto
       then show ?thesis using Measure.prems(1) k by auto
     qed
 
     then have "matrix_sum d (\<lambda>k. c \<cdot>\<^sub>m (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k))) x1 =
       matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * (c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k))) x1"
       using matrix_sum_cong[of x1 "(\<lambda>k. complex_of_real c \<cdot>\<^sub>m (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k)))" 
         "(\<lambda>k. (map denote x3a ! k) (x2a k * (complex_of_real c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k)))"] dimcm by auto
     then have "matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * (c \<cdot>\<^sub>m \<rho>) * adjoint (x2a k))) x1 =
        c \<cdot>\<^sub>m matrix_sum d (\<lambda>k. (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k))) x1"
       using matrix_sum_smult[of x1 "(\<lambda>k. (map denote x3a ! k) (x2a k * \<rho> * adjoint (x2a k)))" d c] dimm by auto
     then have "denote (Measure x1 x2a x3a) (c \<cdot>\<^sub>m \<rho>) = c \<cdot>\<^sub>m denote (Measure x1 x2a x3a) \<rho>"
     using denote.simps(4)[of x1 x2a x3a "c \<cdot>\<^sub>m \<rho>"] 
     using denote.simps(4)[of x1 x2a x3a "\<rho>"] unfolding denote_measure_def by auto
   then show ?thesis by auto
 qed     
 next
   case (While x1 x2a)
   then show ?case
     apply auto
     using denote_while_scale assms by auto
 qed
 
 lemma limit_mat_denote_while_n:
   assumes wc: "well_com (While M S)" and dr: "\<rho> \<in> carrier_mat d d" and pdor: "partial_density_operator \<rho>"
   shows "limit_mat (matrix_sum d (\<lambda>k. denote_while_n (M 0) (M 1) (denote S) k \<rho>)) (denote (While M S) \<rho>) d"
 proof -
   have m: "measurement d 2 M" using wc by auto
   then have dM0: "M 0 \<in> carrier_mat d d" and dM1: "M 1 \<in> carrier_mat d d" and id: "adjoint (M 0) * (M 0) + adjoint (M 1) * (M 1) = 1\<^sub>m d" 
     using measurement_id2 m measurement_def by auto
   have wcs: "well_com S" using wc by auto
   have DS: "positive (denote S \<rho>) \<and> trace (denote S \<rho>) \<le> trace \<rho> \<and> denote S \<rho> \<in> carrier_mat d d" 
     if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
     using wcs that denote_positive_trace_dim by auto
 
   have sumdd: "(\<forall>n. matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>) n \<in> carrier_mat d d)" 
     if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
     using denote_while_n_sum_dim dM0 dM1 DS that by auto
   have sumtr: "\<forall> n. trace (matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>) n) \<le> trace \<rho>"
     if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
     using denote_while_n_sum_trace[OF dM0 dM1 id DS] that by auto
   have sumpar: "(\<forall>n. partial_density_operator (matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>) n))"
     if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
     using denote_while_n_sum_partial_density[OF dM0 dM1 id DS] that by auto
   have sumle:"(\<forall>n. matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>) n \<le>\<^sub>L matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>) (Suc n))"
     if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
     using denote_while_n_sum_lowner_le[OF dM0 dM1 id DS] that by auto
   have seqd: "matrix_seq d (matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>))"
     if "\<rho> \<in> carrier_mat d d" and "partial_density_operator \<rho>" for \<rho>
     using matrix_seq_def sumdd sumpar sumle that by auto
 
   have "matrix_seq.lowner_is_lub (matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>))
     (matrix_seq.lowner_lub (matrix_sum d (\<lambda>n. denote_while_n (M 0) (M 1) (denote S) n \<rho>)))"
     using DS lowner_is_lub_matrix_sum dM0 dM1 id pdor dr by auto
   then show "limit_mat (matrix_sum d (\<lambda>k. denote_while_n (M 0) (M 1) (denote S) k \<rho>)) (denote (While M S) \<rho>) d"
     unfolding denote.simps denote_while_def matrix_inf_sum_def using matrix_seq.lowner_lub_is_limit[OF seqd[OF dr pdor]]  by auto
 qed
 
 end
 
 end
diff --git a/thys/Root_Balanced_Tree/Root_Balanced_Tree_Tab.thy b/thys/Root_Balanced_Tree/Root_Balanced_Tree_Tab.thy
--- a/thys/Root_Balanced_Tree/Root_Balanced_Tree_Tab.thy
+++ b/thys/Root_Balanced_Tree/Root_Balanced_Tree_Tab.thy
@@ -1,109 +1,109 @@
 section "Tabulating the Balanced Predicate"
 
 theory Root_Balanced_Tree_Tab
 imports
   Root_Balanced_Tree
   "HOL-Decision_Procs.Approximation"
   "HOL-Library.IArray"
 begin
 
 locale Min_tab =
 fixes p :: "nat \<Rightarrow> nat \<Rightarrow> bool"
 fixes tab :: "nat list"
 assumes mono_p: "n \<le> n' \<Longrightarrow> p n h \<Longrightarrow> p n' h"
 assumes p: "\<exists>n. p n h"
 assumes tab_LEAST: "h < length tab \<Longrightarrow> tab!h = (LEAST n. p n h)"
 begin
 
 lemma tab_correct: "h < length tab \<Longrightarrow> p n h = (n \<ge> tab ! h)"
   apply auto
   using not_le_imp_less not_less_Least tab_LEAST apply auto[1]
   by (metis LeastI mono_p p tab_LEAST)
 
 end
 
 definition bal_tab :: "nat list" where
 "bal_tab = [0, 1, 1, 2, 4, 6, 10, 16, 25, 40, 64, 101, 161, 256, 406, 645, 1024,
   1625, 2580, 4096, 6501, 10321, 16384, 26007, 41285, 65536, 104031, 165140,
   262144, 416127, 660561, 1048576, 1664510, 2642245, 4194304, 6658042, 10568983,
   16777216, 26632170, 42275935, 67108864, 106528681, 169103740, 268435456,
   426114725, 676414963, 1073741824, 1704458900, 2705659852, 4294967296\<^cancel>\<open>,
   6817835603\<close>]"
 (*ML\<open>floor (Math.pow(2.0,5.0/1.5))\<close>*)
 
 axiomatization where c_def: "c = 3/2"
 
 fun is_floor :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
 "is_floor n h = (let m = floor((2::real) powr ((real(h)-1)/c)) in n \<le> m \<and> m \<le> n)"
 text\<open>Note that @{prop"n \<le> m \<and> m \<le> n"} avoids the technical restriction of the
 \<open>approximation\<close> method which does not support \<open>=\<close>, even on integers.\<close>
 
 
 lemma bal_tab_correct:
   "\<forall>i < length bal_tab. is_floor (bal_tab!i) i"
 apply(simp add: bal_tab_def c_def All_less_Suc)
 apply (approximation 50)
 done
 
 (* FIXME mv *)
 lemma ceiling_least_real: "ceiling(r::real) = (LEAST i. r \<le> i)"
 by (metis Least_equality ceiling_le le_of_int_ceiling)
 
 lemma floor_greatest_real: "floor(r::real) = (GREATEST i. i \<le> r)"
 by (metis Greatest_equality le_floor_iff of_int_floor_le)
 
 lemma LEAST_eq_floor:
   "(LEAST n. int h \<le> \<lceil>c * log 2 (real n + 1)\<rceil>) = floor((2::real) powr ((real(h)-1)/c))"
 proof -
   have "int h \<le> \<lceil>c * log 2 (real n + 1)\<rceil>
       \<longleftrightarrow> 2 powr ((real(h)-1)/c) < real(n)+1" (is "?L = ?R") for n
   proof -
     have "?L \<longleftrightarrow> h < c * log 2 (real n + 1) + 1" by linarith
     also have "\<dots> \<longleftrightarrow> (real h-1)/c < log 2 (real n + 1)"
       using c1 by(simp add: field_simps)
     also have "\<dots> \<longleftrightarrow> 2 powr ((real h-1)/c) < 2 powr (log 2 (real n + 1))"
       by(simp del: powr_log_cancel)
     also have "\<dots> \<longleftrightarrow> ?R"
       by(simp)
     finally show ?thesis .
   qed
   moreover have "((LEAST n::nat. r < n+1) = nat(floor r))" for r :: real
     by(rule Least_equality) linarith+
   ultimately show ?thesis by simp
 qed
 
 interpretation Min_tab
 where p = bal_i and tab = bal_tab
 proof(unfold bal_i_def, standard, goal_cases)
   case (1 n n' h)
   have "int h \<le> ceiling(c * log 2 (real n + 1))" by(rule 1[unfolded bal_i_def])
   also have "\<dots> \<le> ceiling(c * log 2 (real n' + 1))"
     using c1 "1"(1) by (simp add: ceiling_mono)
   finally show ?case .
 next
   case (2 h)
   show ?case
   proof
     show "int h \<le> \<lceil>c * log 2 (real (2 ^ h - 1) + 1)\<rceil>"
       apply(simp add: of_nat_diff log_nat_power) using c1
-      by (metis ceiling_mono ceiling_of_nat order.order_iff_strict mult.left_neutral mult_eq_0_iff of_nat_0_le_iff real_mult_le_cancel_iff1)
+      by (metis ceiling_mono ceiling_of_nat order.order_iff_strict mult.left_neutral mult_eq_0_iff of_nat_0_le_iff mult_le_cancel_iff1)
   qed
 next
   case 3
   thus ?case using bal_tab_correct LEAST_eq_floor
      by (simp add: eq_iff[symmetric]) (metis nat_int)
 qed
 
 text\<open>Now we replace the list by an immutable array:\<close>
 
 definition bal_array :: "nat iarray" where
 "bal_array = IArray bal_tab"
 
 text\<open>A trick for code generation: how to get rid of the precondition:\<close>
 
 lemma bal_i_code:
   "bal_i n h =
   (if h < IArray.length bal_array then IArray.sub bal_array h \<le> n else bal_i n h)"
 by (simp add: bal_array_def tab_correct)
 
 end
diff --git a/thys/Safe_Distance/Safe_Distance.thy b/thys/Safe_Distance/Safe_Distance.thy
--- a/thys/Safe_Distance/Safe_Distance.thy
+++ b/thys/Safe_Distance/Safe_Distance.thy
@@ -1,1472 +1,1472 @@
 \<^marker>\<open>creator "Albert Rizaldi" "Fabian Immler\<close>
 
 section \<open>Safe Distance\<close>
 
 theory Safe_Distance
 imports
   "HOL-Analysis.Multivariate_Analysis"
   "HOL-Decision_Procs.Approximation"
   Sturm_Sequences.Sturm
 begin
 
 text \<open>
 This theory is about formalising the safe distance rule. The safe distance rule is obtained
 from Vienna Convention which basically states the following thing.
 
   ``The car at all times must maintain a safe distance towards the vehicle in front of it,
     such that whenever the vehicle in front and the ego vehicle apply maximum deceleration,
     there will not be a collision.''
 
 To formalise this safe distance rule we have to define first what is a safe distance.
 To define this safe distance, we have to model the physics of the movement of the vehicle.
 The following model is sufficient.
 
   \<open>s = s\<^sub>0 + v\<^sub>0 * t + 1 / 2 * a\<^sub>0 * t\<^sup>2\<close>
 
 Assumptions in this model are :
   \<^item> Both vehicles are assumed to be point mass. The exact location of the ego vehicle
     is the front-most occupancy of the ego vehicle. Similarly for the other vehicle,
     its exact location is the rearmost occupancy of the other vehicle.
 
   \<^item> Both cars can never drive backward.
 \<close>
 
 lemmas [simp del] = div_mult_self1 div_mult_self2 div_mult_self3 div_mult_self4
 
 subsection \<open>Quadratic Equations\<close>
 
 lemma discriminant: "a * x\<^sup>2 + b * x + c = (0::real) \<Longrightarrow> 0 \<le> b\<^sup>2 - 4 * a * c" 
   by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [2*a*x + b]^2))))")
 
 lemma quadratic_eq_factoring:
   assumes D : "D = b\<^sup>2 - 4 * a * c"
   assumes nn: "0 \<le> D"
   assumes x1: "x\<^sub>1 = (-b + sqrt D) / (2 * a)"
   assumes x2: "x\<^sub>2 = (-b - sqrt D) / (2 * a)"
   assumes a : "a \<noteq> 0"
   shows "a * x\<^sup>2 + b * x + c = a * (x - x\<^sub>1) * (x - x\<^sub>2)"
   using nn
   by (simp add: D x1 x2)
      (simp add: assms power2_eq_square power3_eq_cube field_split_simps)
 
 lemma quadratic_eq_zeroes_iff:
   assumes D : "D = b\<^sup>2 - 4 * a * c"
   assumes x1: "x\<^sub>1 = (-b + sqrt D) / (2 * a)"
   assumes x2: "x\<^sub>2 = (-b - sqrt D) / (2 * a)"
   assumes a : "a \<noteq> 0"
   shows "a * x\<^sup>2 + b * x + c = 0 \<longleftrightarrow> (D \<ge> 0 \<and> (x = x\<^sub>1 \<or> x = x\<^sub>2))" (is "?z \<longleftrightarrow> _")
   using quadratic_eq_factoring[OF D _ x1 x2 a, of x] discriminant[of a x b c] a
   by (auto simp: D)
 
 subsection \<open>Convexity Condition\<close>
 
 lemma p_convex:
   fixes a b c x y z :: real
   assumes p_def: "p = (\<lambda>x. a * x\<^sup>2 + b * x + c)"
   assumes less : "x < y" "y < z" 
       and ge   : "p x > p y" "p y \<le> p z"
   shows "a > 0"
   using less ge unfolding p_def
   by (sos "((((A<0 * (A<1 * A<2)) * R<1) + (((A<2 * R<1) * (R<1/4 * [y + ~1*z]^2)) +
     (((A<=1 * R<1) * (R<1 * [x + ~1*y]^2)) + (((A<=1 * (A<0 * (A<1 * R<1))) * (R<1/4 * [1]^2)) +
     (((A<=0 * R<1) * (R<1/4 * [~1*y^2 + x*y + ~1*x*z + y*z]^2)) +
     ((A<=0 * (A<0 * (A<1 * R<1))) * (R<1 * [x + ~1/2*y + ~1/2*z]^2))))))))")
   
 definition root_in :: "real \<Rightarrow> real \<Rightarrow> (real \<Rightarrow> real) \<Rightarrow> bool" where
   "root_in m M f = (\<exists>x\<in>{m .. M}. f x = 0)"
 
 definition quadroot_in :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "quadroot_in m M a b c = root_in m M (\<lambda>x. a * x^2 + b * x + c)"
 
 lemma card_iff_exists: "0 < card X \<longleftrightarrow> finite X \<and> (\<exists>x. x \<in> X)"
   by (auto simp: card_gt_0_iff)
   
 lemma quadroot_in_sturm[code]:
   "quadroot_in m M a b c \<longleftrightarrow> (a = 0 \<and> b = 0 \<and> c = 0 \<and> m \<le> M) \<or>
     (m \<le> M \<and> poly [:c, b, a:] m = 0) \<or>
     count_roots_between [:c, b, a:] m M > 0"
   apply (cases "a = 0 \<and> b = 0 \<and> c = 0 \<and> m \<le> M")
    apply (force simp: quadroot_in_def root_in_def)
   apply (cases "m \<le> M \<and> poly [:c, b, a:] m = 0")
    apply (force simp: quadroot_in_def root_in_def algebra_simps power2_eq_square count_roots_between_correct card_iff_exists)
 proof -
   assume H: "\<not> (a = 0 \<and> b = 0 \<and> c = 0 \<and> m \<le> M)" "\<not> (m \<le> M \<and> poly [:c, b, a:] m = 0)"
   hence "poly [:c, b, a:] m \<noteq> 0 \<or> m > M"
     by auto
   then have "quadroot_in m M a b c \<longleftrightarrow> 0 < count_roots_between [:c, b, a:] m M"
   proof (rule disjE)
     assume pnz: "poly [:c, b, a:] m \<noteq> 0"
     then have nz: "[:c, b, a:] \<noteq> 0" by auto
     show ?thesis
       unfolding count_roots_between_correct card_iff_exists
       apply safe
         apply (rule finite_subset[where B="{x. poly [:c, b, a:] x = 0}"])
          apply force
         apply (rule poly_roots_finite)
         apply (rule nz)
       using pnz
        apply (auto simp add: count_roots_between_correct quadroot_in_def root_in_def card_iff_exists
           algebra_simps power2_eq_square)
       apply (case_tac "x = m")
        apply (force simp: algebra_simps)
       apply force
       done
   qed (auto simp: quadroot_in_def count_roots_between_correct root_in_def card_eq_0_iff)
   then show "quadroot_in m M a b c = (a = 0 \<and> b = 0 \<and> c = 0 \<and> m \<le> M \<or>
      m \<le> M \<and> poly [:c, b, a:] m = 0 \<or>
      0 < count_roots_between [:c, b, a:] m M)"
     using H by metis
 qed
 
 lemma check_quadroot_linear:
   fixes a b c :: real
   assumes "a = 0"
   shows "\<not> quadroot_in m M a b c \<longleftrightarrow>
     ((b = 0 \<and> c = 0 \<and> M < m) \<or> (b = 0 \<and> c \<noteq> 0) \<or>
      (b \<noteq> 0 \<and> (let x = - c / b in m > x \<or> x > M)))"
 proof -
   have "quadroot_in m M a b c \<longleftrightarrow> (b = 0 \<longrightarrow> quadroot_in m M a b c) \<and> (b \<noteq> 0 \<longrightarrow> quadroot_in m M a b c)"
     by auto
   also have "(b = 0 \<longrightarrow> quadroot_in m M a b c) \<longleftrightarrow>
     ((b = 0 \<longrightarrow> c = 0 \<longrightarrow> m \<le> M) \<and> (b \<noteq> 0 \<or> c = 0))"
     by (auto simp: quadroot_in_def Let_def root_in_def assms field_split_simps
       intro!: bexI[where x="-c / b"])
   also have "(b \<noteq> 0 \<longrightarrow> quadroot_in m M a b c) \<longleftrightarrow> (b = 0 \<or> (let x = -c / b in m \<le> x \<and> x \<le> M))"
     apply (auto simp: quadroot_in_def Let_def root_in_def assms field_split_simps
         intro!: bexI[where x="-c / b"])
-    by (metis mult.commute mult_le_cancel_left_neg add_eq_0_iff real_mult_le_cancel_iff2)+
+    by (metis mult.commute mult_le_cancel_left_neg add_eq_0_iff mult_le_cancel_iff2)+
   finally show ?thesis
     by (simp add: Let_def not_less not_le)
 qed 
 
 lemma check_quadroot_nonlinear:
   assumes "a \<noteq> 0"
   shows "quadroot_in m M a b c =
     (let D = b^2 - 4 * a * c in D \<ge> 0 \<and>
       ((let x = (-b + sqrt D)/(2*a) in m \<le> x \<and> x \<le> M) \<or>
       (let x = (-b - sqrt D)/(2*a) in m \<le> x \<and> x \<le> M)))"
   by (auto simp: quadroot_in_def Let_def root_in_def quadratic_eq_zeroes_iff[OF refl refl refl assms])
 
 lemma ncheck_quadroot:
   shows "\<not>quadroot_in m M a b c \<longleftrightarrow>
     (a = 0 \<longrightarrow>\<not>quadroot_in m M a b c) \<and>
     (a = 0 \<or> \<not>quadroot_in m M a b c)"
   by auto
 
 subsection \<open>Movement\<close>
 
 locale movement = 
   fixes a v s0 :: real
 begin
 
 text \<open>
   Function to compute the distance using the equation
 
     \<open>s(t) = s\<^sub>0 + v\<^sub>0 * t + 1 / 2 * a\<^sub>0 * t\<^sup>2\<close>
   
   Input parameters: 
    \<^item> \<open>s\<^sub>0\<close>: initial distance
    \<^item> \<open>v\<^sub>0\<close>: initial velocity (positive means forward direction and the converse is true)
    \<^item> \<open>a\<close>: acceleration (positive for increasing and negative for decreasing)
    \<^item> \<open>t\<close>: time 
 
   For the time \<open>t < 0\<close>, we assume the output of the function is \<open>s\<^sub>0\<close>. Otherwise, the output
   is calculated according to the equation above.
 \<close>
 
 subsubsection \<open>Continuous Dynamics\<close>
 
 definition p :: "real \<Rightarrow> real" where
   "p t = s0 + v * t + 1/2 * a * t\<^sup>2"
 
 lemma p_all_zeroes:
   assumes D: "D = v\<^sup>2 - 2 * a * s0"
   shows "p t = 0 \<longleftrightarrow> ((a \<noteq> 0 \<and> 0 \<le> D \<and> ((t = (- v + sqrt D) / a) \<or> t = (- v - sqrt D) / a)) \<or>
     (a = 0 \<and> v = 0 \<and> s0 = 0) \<or> (a = 0 \<and> v \<noteq> 0 \<and> t = (- s0 / v)))"
   using quadratic_eq_zeroes_iff[OF refl refl refl, of "a / 2" t v s0]
   by (auto simp: movement.p_def D power2_eq_square field_split_simps)
 
 lemma p_zero[simp]: "p 0 = s0"
   by (simp add: p_def)
 
 lemma p_continuous[continuous_intros]: "continuous_on T p"
   unfolding p_def by (auto intro!: continuous_intros)
 
 lemma isCont_p[continuous_intros]: "isCont p x"
   using p_continuous[of UNIV]
   by (auto simp: continuous_on_eq_continuous_at)
 
 definition p' :: "real \<Rightarrow> real" where
   "p' t = v + a * t"
 
 lemma p'_zero: "p' 0 = v"
   by (simp add: p'_def)
 
 lemma p_has_vector_derivative[derivative_intros]: "(p has_vector_derivative p' t) (at t within s)"
   by (auto simp: p_def[abs_def] p'_def has_vector_derivative_def algebra_simps
     intro!: derivative_eq_intros)
 
 lemma p_has_real_derivative[derivative_intros]: "(p has_real_derivative p' t) (at t within s)"
   using p_has_vector_derivative
   by (simp add: has_field_derivative_iff_has_vector_derivative)
 
 definition p'' :: "real \<Rightarrow> real" where 
   "p'' t = a"
 
 lemma p'_has_vector_derivative[derivative_intros]: "(p' has_vector_derivative p'' t) (at t within s)"
   by (auto simp: p'_def[abs_def] p''_def has_vector_derivative_def algebra_simps
     intro!: derivative_eq_intros)
 
 lemma p'_has_real_derivative[derivative_intros]: "(p' has_real_derivative p'' t) (at t within s)"
   using p'_has_vector_derivative
   by (simp add: has_field_derivative_iff_has_vector_derivative)
 
 definition t_stop :: real where 
   "t_stop = - v / a"
 
 lemma p'_stop_zero: "p' t_stop = (if a = 0 then v else 0)" by (auto simp: p'_def t_stop_def)
 
 lemma p'_pos_iff: "p' x > 0 \<longleftrightarrow> (if a > 0 then x > -v / a else if a < 0 then x < -v / a else v > 0)"
   by (auto simp: p'_def field_split_simps)
 
 lemma le_t_stop_iff: "a \<noteq> 0 \<Longrightarrow> x \<le> t_stop \<longleftrightarrow> (if a < 0 then p' x \<ge> 0 else p' x \<le> 0)"
   by (auto simp: p'_def field_split_simps t_stop_def)
 
 lemma p'_continuous[continuous_intros]: "continuous_on T p'"
   unfolding p'_def by (auto intro: continuous_intros)
 
 lemma isCont_p'[continuous_intros]: "isCont p' x"
   using p'_continuous[of UNIV] by (auto simp: continuous_on_eq_continuous_at)
 
 definition p_max :: real where 
   "p_max = p t_stop"
 
 lemmas p_t_stop = p_max_def[symmetric]
 
 lemma p_max_eq: "p_max = s0 - v\<^sup>2 / a / 2"
   by (auto simp: p_max_def p_def t_stop_def field_split_simps power2_eq_square)
 
 subsubsection \<open>Hybrid Dynamics\<close>
 
 definition s :: "real \<Rightarrow> real" where
   "s t = (     if t \<le> 0      then s0
           else if t \<le> t_stop then p t
           else                p_max)"
 
 definition q :: "real \<Rightarrow> real" where
   "q t = s0 + v * t"
 
 definition q' :: "real \<Rightarrow> real" where
   "q' t = v"
 
 lemma init_q: "q 0 = s0" unfolding q_def by auto
 
 lemma q_continuous[continuous_intros]: "continuous_on T q"
   unfolding q_def by (auto intro: continuous_intros)
 
 lemma isCont_q[continuous_intros]: "isCont q x"
   using q_continuous[of UNIV]
   by (auto simp:continuous_on_eq_continuous_at)
 
 lemma q_has_vector_derivative[derivative_intros]: "(q has_vector_derivative q' t) (at t within u)"
   by (auto simp: q_def[abs_def] q'_def has_vector_derivative_def algebra_simps
           intro!: derivative_eq_intros)
 
 lemma q_has_real_derivative[derivative_intros]: "(q has_real_derivative q' t) (at t within u)"
   using q_has_vector_derivative
   by (simp add:has_field_derivative_iff_has_vector_derivative)
 
 lemma s_cond_def:
   "t \<le> 0 \<Longrightarrow> s t = s0"
   "0 \<le> t \<Longrightarrow> t \<le> t_stop \<Longrightarrow> s t = p t"
   by (simp_all add: s_def)
   
 end
 
 locale braking_movement = movement +
   assumes decel: "a < 0"
   assumes nonneg_vel: "v \<ge> 0"
 begin
 
 lemma t_stop_nonneg: "0 \<le> t_stop"
   using decel nonneg_vel
   by (auto simp: t_stop_def divide_simps)
 
 lemma t_stop_pos:
   assumes "v \<noteq> 0"
   shows "0 < t_stop"
   using decel nonneg_vel assms
   by (auto simp: t_stop_def divide_simps)
 
 lemma t_stop_zero:
   assumes "t_stop = 0"
   shows "v = 0"
   using assms decel
   by (auto simp: t_stop_def)
 
 lemma t_stop_zero_not_moving: "t_stop = 0 \<Longrightarrow> q t = s0" 
   unfolding q_def using t_stop_zero by auto
 
 abbreviation "s_stop \<equiv> s t_stop"
 
 lemma s_t_stop: "s_stop = p_max"
   using t_stop_nonneg
   by (auto simp: s_def t_stop_def p_max_def p_def)
 
 lemma s0_le_s_stop: "s0 \<le> s_stop" 
 proof (rule subst[where t="s_stop" and s="p_max"])
   show "p_max = s_stop" by (rule sym[OF s_t_stop])
 next
   show "s0 \<le> p_max" 
   proof (rule subst[where t="p_max" and s="s0 - v\<^sup>2 / a / 2"]) 
     show " s0 - v\<^sup>2 / a / 2 = p_max" using p_max_eq by auto
   next
     have "0 \<le> - v\<^sup>2 / a / 2" using decel zero_le_square[of v]
     proof -
       have f1: "a \<le> 0"
         using \<open>a < 0\<close> by linarith
       have "(- 1 * v\<^sup>2 \<le> 0) = (0 \<le> v\<^sup>2)"
         by auto
       then have "0 \<le> - 1 * v\<^sup>2 / a"
         using f1 by (meson zero_le_divide_iff zero_le_power2)
       then show ?thesis
         by force
     qed
     thus "s0 \<le> s0 - v\<^sup>2 / a / 2" by auto
   qed
 qed
 
 lemma p_mono: "x \<le> y \<Longrightarrow> y \<le> t_stop \<Longrightarrow> p x \<le> p y"
   using decel
 proof -
   assume "x \<le> y" and "y \<le> t_stop" and "a < 0"
   hence "x + y \<le> - 2 * v / a"
     unfolding t_stop_def by auto
   hence "-1 / 2 * a * (x + y) \<le> v" (is "?lhs0 \<le> ?rhs0")
     using `a < 0` by (auto simp add: field_simps)
   hence "?lhs0 * (x- y) \<ge> ?rhs0 * (x - y)"
     using `x \<le> y` by sos
   hence "v * x + 1 / 2 * a * x\<^sup>2 \<le> v * y + 1 / 2 * a * y\<^sup>2"
     by (auto simp add: field_simps power_def)
   thus " p x \<le> p y"
     unfolding p_max_def p_def t_stop_def by auto
 qed
 
 lemma p_antimono: "x \<le> y \<Longrightarrow> t_stop \<le> x \<Longrightarrow> p y \<le> p x"
   using decel
 proof -
   assume "x \<le> y" and "t_stop \<le> x" and "a < 0"
   hence "- 2 * v / a \<le> x + y"
     unfolding t_stop_def by auto
   hence "v \<le> - 1/ 2 * a * (x + y)"
     using `a < 0` by (auto simp add: field_simps)
   hence "v * (x - y) \<ge> -1/2 * a * (x\<^sup>2 - y\<^sup>2) "
     using `x \<le> y` by sos
   hence "v * y + 1/2 * a * y\<^sup>2 \<le> v * x + 1/2 * a * x\<^sup>2"
     by (auto simp add: field_simps)
   thus "p y \<le> p x"
     unfolding p_max_def p_def t_stop_def by auto
 qed
 
 lemma p_strict_mono: "x < y \<Longrightarrow> y \<le> t_stop \<Longrightarrow> p x < p y"
   using decel
 proof -
   assume "x < y" and "y \<le> t_stop" and "a < 0"
   hence "x + y < - 2 * v / a"
     unfolding t_stop_def by auto
   hence "-1 / 2 * a * (x + y) < v" (is "?lhs0 < ?rhs0")
     using `a < 0` by (auto simp add: field_simps)
   hence "?lhs0 * (x- y) > ?rhs0 * (x - y)"
     using `x < y` by sos
   hence "v * x + 1 / 2 * a * x\<^sup>2 < v * y + 1 / 2 * a * y\<^sup>2"
     by (auto simp add: field_simps power_def)
   thus " p x < p y"
     unfolding p_max_def p_def t_stop_def by auto
 qed
 
 lemma p_strict_antimono: "x < y \<Longrightarrow> t_stop \<le> x\<Longrightarrow> p y < p x"
   using decel
 proof -
   assume "x < y" and "t_stop \<le> x" and "a < 0"
   hence "- 2 * v / a < x + y"
     unfolding t_stop_def by auto
   hence "v < - 1/ 2 * a * (x + y)"
     using `a < 0` by (auto simp add: field_simps)
   hence "v * (x - y) > -1/2 * a * (x\<^sup>2 - y\<^sup>2) "
     using `x < y` by sos
   hence "v * y + 1/2 * a * y\<^sup>2 < v * x + 1/2 * a * x\<^sup>2"
     by (auto simp add: field_simps)
   thus "p y < p x"
     unfolding p_max_def p_def t_stop_def by auto
 qed
 
 lemma p_max: "p x \<le> p_max"
   unfolding p_max_def
   by (cases "x \<le> t_stop") (auto intro: p_mono p_antimono)
 
 lemma continuous_on_s[continuous_intros]: "continuous_on T s"
   unfolding s_def[abs_def]
   using t_stop_nonneg
   by (intro continuous_on_subset[where t=T and s = "{.. 0}\<union>({0 .. t_stop} \<union> {t_stop ..})"] continuous_on_If)
      (auto simp: p_continuous p_max_def antisym_conv[where x=0])
 
 lemma isCont_s[continuous_intros]: "isCont s x"
   using continuous_on_s[of UNIV]
   by (auto simp: continuous_on_eq_continuous_at)
 
 definition s' :: "real \<Rightarrow> real" where
   "s' t = (if t \<le> t_stop then p' t else 0)"
 
 lemma s_has_real_derivative:
   assumes "t \<ge> 0" "v / a \<le> 0" "a \<noteq> 0"
   shows "(s has_real_derivative s' t) (at t within {0..})"
 proof -
   from assms have *: "t \<le> t_stop \<longleftrightarrow> t \<in> {0 .. t_stop}" by simp
   from assms have "0 \<le> t_stop" by (auto simp: t_stop_def)
   have "((\<lambda>t. if t \<in> {0 .. t_stop} then p t else p_max) has_real_derivative
     (if t \<in> {0..t_stop} then p' t else 0)) (at t within {0..})"
     unfolding s_def[abs_def] s'_def 
       has_field_derivative_iff_has_vector_derivative
     apply (rule has_vector_derivative_If_within_closures[where T = "{t_stop ..}"])
     using \<open>0 \<le> t_stop\<close> \<open>a \<noteq> 0\<close>
     by (auto simp: assms p'_stop_zero p_t_stop max_def insert_absorb
       intro!: p_has_vector_derivative)
   from _ _ this show ?thesis
     unfolding has_vector_derivative_def has_field_derivative_iff_has_vector_derivative
       s'_def s_def[abs_def] *
     by (rule has_derivative_transform)
       (auto simp: assms s_def p_max_def t_stop_def)
 qed
 
 lemma s_has_vector_derivative[derivative_intros]:
   assumes "t \<ge> 0" "v / a \<le> 0" "a \<noteq> 0"
   shows  "(s has_vector_derivative s' t) (at t within {0..})"
   using s_has_real_derivative[OF assms]
   by (simp add: has_field_derivative_iff_has_vector_derivative)
    
 lemma s_has_field_derivative[derivative_intros]:
   assumes "t \<ge> 0" "v / a \<le> 0" "a \<noteq> 0"
   shows "(s has_field_derivative s' t) (at t within {0..})"
   using s_has_vector_derivative[OF assms]
   by(simp add: has_field_derivative_iff_has_vector_derivative)
   
 lemma s_has_real_derivative_at:
   assumes "0 < x" "0 \<le> v" "a < 0"
   shows "(s has_real_derivative s' x) (at x)"
 proof -
   from assms have "(s has_real_derivative s' x) (at x within {0 ..})"
     by (intro s_has_real_derivative) (auto intro!: divide_nonneg_nonpos)
   then have "(s has_real_derivative s' x) (at x within {0<..})"
     by (rule DERIV_subset) auto
   then show "(s has_real_derivative s' x) (at x)" using assms
     by (subst (asm) at_within_open) auto
 qed
                    
 lemma s_delayed_has_field_derivative[derivative_intros]:
   assumes "\<delta> < t" "0 \<le> v" "a < 0"
   shows "((\<lambda>x. s (x - \<delta>)) has_field_derivative s' (t - \<delta>)) (at t within {\<delta><..})"
 proof -
   from assms have "((\<lambda>x. s (x + - \<delta>)) has_real_derivative s' (t - \<delta>)) (at t)"
   using DERIV_shift[of "s" "(s' (t - \<delta>))" t "-\<delta>"] s_has_real_derivative_at 
   by auto  
   
   thus "((\<lambda>x. s (x - \<delta>)) has_field_derivative s' (t - \<delta>)) (at t within {\<delta><..})"
   using has_field_derivative_at_within by auto
 qed  
 
 lemma s_delayed_has_vector_derivative[derivative_intros]:
   assumes "\<delta> < t" "0 \<le> v" "a < 0"
   shows  "((\<lambda>x. s (x - \<delta>)) has_vector_derivative s' (t - \<delta>)) (at t within {\<delta><..})"
   using s_delayed_has_field_derivative[OF assms]  
   by(simp add:has_field_derivative_iff_has_vector_derivative)
 
 lemma s'_nonneg: "0 \<le> v \<Longrightarrow> a \<le> 0 \<Longrightarrow> 0 \<le> s' x"
   by (auto simp: s'_def p'_def t_stop_def field_split_simps) 
 
 lemma s'_pos: "0 \<le> x \<Longrightarrow> x < t_stop \<Longrightarrow> 0 \<le> v \<Longrightarrow> a \<le> 0 \<Longrightarrow> 0 < s' x"
   by (intro le_neq_trans s'_nonneg)
     (auto simp: s'_def p'_def t_stop_def field_split_simps)
 
 subsubsection \<open>Monotonicity of Movement\<close>
 
 lemma s_mono:
   assumes "t \<ge> u" "u \<ge> 0"
   shows "s t \<ge> s u"
   using p_mono[of u t] assms p_max[of u] by (auto simp: s_def)
 
 lemma s_strict_mono:
   assumes "u < t" "t \<le> t_stop" "u \<ge> 0"
   shows "s u < s t"
   using p_strict_mono[of u t] assms p_max[of u] by (auto simp: s_def)
 
 lemma s_antimono:
   assumes "x \<le> y"
   assumes "t_stop \<le> x"
   shows "s y \<le> s x"
 proof -
   from assms have "t_stop \<le> y" by auto  
   hence "s y \<le> p_max" unfolding s_def p_max_eq
     using p_max_def p_max_eq s0_le_s_stop s_t_stop by auto
   also have "... \<le> s x" 
     using \<open>t_stop \<le> x\<close> s_mono s_t_stop t_stop_nonneg by fastforce
   ultimately show "s y \<le> s x" by auto
 qed
 
 lemma init_s : "t \<le> 0 \<Longrightarrow> s t = s0"
   using decel nonneg_vel by (simp add: divide_simps s_def)
 
 lemma q_min: "0 \<le> t \<Longrightarrow> s0 \<le> q t"
   unfolding q_def using nonneg_vel by auto
 
 lemma q_mono: "x \<le> y \<Longrightarrow> q x \<le> q y"
   unfolding q_def using nonneg_vel by (auto simp: mult_left_mono)
 
 subsubsection \<open>Maximum at Stopping Time\<close>
 
 lemma s_max: "s x \<le> s_stop"
   using p_max[of x] p_max[of 0] unfolding s_t_stop by (auto simp: s_def)
 
 lemma s_eq_s_stop: "NO_MATCH t_stop x \<Longrightarrow> x \<ge> t_stop \<Longrightarrow> s x = s_stop"
   using t_stop_nonneg by (auto simp: s_def p_max_def)
 
 end
 
 subsection \<open>Safe Distance\<close>
 
 locale safe_distance =
   fixes a\<^sub>e v\<^sub>e s\<^sub>e :: real
   fixes a\<^sub>o v\<^sub>o s\<^sub>o :: real
   assumes nonneg_vel_ego   : "0 \<le> v\<^sub>e"
   assumes nonneg_vel_other : "0 \<le> v\<^sub>o"
   assumes decelerate_ego   : "a\<^sub>e < 0"
   assumes decelerate_other : "a\<^sub>o < 0"
   assumes in_front         : "s\<^sub>e < s\<^sub>o"
 begin
 
 lemmas hyps =
   nonneg_vel_ego   
   nonneg_vel_other 
   decelerate_ego   
   decelerate_other 
   in_front
 
 sublocale ego: braking_movement a\<^sub>e v\<^sub>e s\<^sub>e by (unfold_locales; rule hyps)
 sublocale other: braking_movement a\<^sub>o v\<^sub>o s\<^sub>o by (unfold_locales; rule hyps)
 sublocale ego_other: movement "a\<^sub>o - a\<^sub>e" "v\<^sub>o - v\<^sub>e" "s\<^sub>o - s\<^sub>e" by unfold_locales
 
 subsubsection \<open>Collision\<close>
 
 definition collision :: "real set \<Rightarrow> bool" where
   "collision time_set \<equiv> (\<exists>t \<in> time_set. ego.s t = other.s t )"
 
 abbreviation no_collision :: "real set \<Rightarrow> bool" where
   "no_collision time_set \<equiv> \<not> collision time_set"
 
 lemma no_collision_initially : "no_collision {.. 0}"
   using decelerate_ego nonneg_vel_ego
   using decelerate_other nonneg_vel_other in_front
   by (auto simp: divide_simps collision_def ego.s_def other.s_def)
 
 lemma no_collisionI:
   "(\<And>t. t \<in> S \<Longrightarrow> ego.s t \<noteq> other.s t) \<Longrightarrow> no_collision S"
   unfolding collision_def by blast
 
 theorem cond_1: "ego.s_stop < s\<^sub>o \<Longrightarrow> no_collision {0..}"
 proof (rule no_collisionI, simp)
   fix t::real
   assume "t \<ge> 0"
   have "ego.s t \<le> ego.s_stop"
     by (rule ego.s_max)
   also assume "\<dots> < s\<^sub>o"
   also have "\<dots> = other.s 0"
     by (simp add: other.init_s)
   also have "\<dots> \<le> other.s t"
     using \<open>0 \<le> t\<close> hyps
     by (intro other.s_mono) auto
   finally show "ego.s t \<noteq> other.s t"
     by simp
 qed
 
 lemma ego_other_strict_ivt:
   assumes "ego.s t > other.s t"
   shows "collision {0 ..< t}"
 proof cases
   have [simp]: "s\<^sub>e < s\<^sub>o \<Longrightarrow> ego.s 0 \<le> other.s 0" 
     by (simp add: movement.s_def)
   assume "0 \<le> t"
   with assms in_front
   have "\<exists>x\<ge>0. x \<le> t \<and> other.s x - ego.s x = 0"
     by (intro IVT2, auto simp: continuous_diff other.isCont_s ego.isCont_s)
   then show ?thesis
     using assms
     by (auto simp add: algebra_simps collision_def Bex_def order.order_iff_strict)
 qed (insert assms hyps, auto simp: collision_def ego.init_s other.init_s intro!: bexI[where x=0])
 
 lemma collision_subset: "collision s \<Longrightarrow> s \<subseteq> t \<Longrightarrow> collision t"
   by (auto simp: collision_def)
 
 lemma ego_other_ivt:
   assumes "ego.s t \<ge> other.s t"
   shows "collision {0 .. t}"
 proof cases
   assume "ego.s t > other.s t"
   from ego_other_strict_ivt[OF this]
   show ?thesis
     by (rule collision_subset) auto
 qed (insert hyps assms; cases "t \<ge> 0"; force simp: collision_def ego.init_s other.init_s)
 
 theorem cond_2:
   assumes "ego.s_stop \<ge> other.s_stop"
   shows "collision {0 ..}"
   using assms
   apply (intro collision_subset[where t="{0 ..}" and s = "{0 .. max ego.t_stop other.t_stop}"])
    apply (intro ego_other_ivt[where t = "max ego.t_stop other.t_stop"])
    apply (auto simp: ego.s_eq_s_stop other.s_eq_s_stop)
   done
 
 abbreviation D2 :: "real" where
   "D2 \<equiv> (v\<^sub>o - v\<^sub>e)^2 - 2 * (a\<^sub>o - a\<^sub>e) * (s\<^sub>o - s\<^sub>e)"
 
 abbreviation t\<^sub>D' :: "real" where
   "t\<^sub>D' \<equiv> sqrt (2 * (ego.s_stop - other.s_stop) / a\<^sub>o)"
 
 lemma pos_via_half_dist:
   "dist a b < b / 2 \<Longrightarrow> b > 0 \<Longrightarrow> a > 0"
   by (auto simp: dist_real_def abs_real_def split: if_splits)
 
 lemma collision_within_p:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "collision {0..} \<longleftrightarrow> (\<exists>t\<ge>0. ego.p t = other.p t \<and> t < ego.t_stop \<and> t < other.t_stop)"
 proof (auto simp: collision_def, goal_cases)
   case (2 t)
   then show ?case
     by (intro bexI[where x = t]) (auto simp: ego.s_def other.s_def)
 next
   case (1 t)
   then show ?case using assms hyps ego.t_stop_nonneg other.t_stop_nonneg
     apply (auto simp: ego.s_def other.s_def ego.s_t_stop other.s_t_stop ego.p_t_stop other.p_t_stop not_le
         split: if_splits)
     defer
   proof goal_cases
     case 1
     from 1 have le: "ego.t_stop \<le> other.t_stop" by auto
     from 1 have "ego.t_stop < t" by simp
     from other.s_strict_mono[OF this] 1
     have "other.s ego.t_stop < other.s t"
       by auto
     also have "\<dots> = ego.s ego.t_stop"
       using ego.s_t_stop ego.t_stop_nonneg 1 other.s_def by auto
     finally have "other.s ego.t_stop < ego.s ego.t_stop" .
     from ego_other_strict_ivt[OF this] le in_front
     show ?case
       by (auto simp add: collision_def) (auto simp: movement.s_def split: if_splits)
   next
     case 2
     from 2 have "other.p_max = ego.p t" by simp
     also have "\<dots> \<le> ego.p ego.t_stop"
       using 2
       by (intro ego.p_mono) auto
     also have "\<dots> = ego.p_max"
       by (simp add: ego.p_t_stop)
     also note \<open>\<dots> < other.p_max\<close>
     finally show ?case by arith
   next
     case 3
     thus "\<exists>t\<ge>0. ego.p t = other.p t \<and> t < ego.t_stop \<and> t < other.t_stop" 
       apply (cases "t = other.t_stop")
        apply (simp add: other.p_t_stop )
        apply (metis (no_types) ego.p_max not_le)
       apply (cases "t = ego.t_stop")
        apply (simp add: ego.p_t_stop)
        defer
        apply force
     proof goal_cases
       case (1)
       let ?d = "\<lambda>t. other.p' t - ego.p' t"
       define d' where "d' = ?d ego.t_stop / 2"
       have d_cont: "isCont ?d ego.t_stop"
         unfolding ego.t_stop_def other.p'_def ego.p'_def by simp
       have "?d ego.t_stop > 0"
         using 1
         by (simp add: ego.p'_stop_zero other.p'_pos_iff) (simp add: ego.t_stop_def other.t_stop_def)
       then have "d' > 0" by (auto simp: d'_def)
       from d_cont[unfolded continuous_at_eps_delta, THEN spec, rule_format, OF \<open>d' > 0\<close>]
       obtain e where e: "e > 0" "\<And>x. dist x ego.t_stop < e \<Longrightarrow> ?d x > 0"
         unfolding d'_def
         using \<open>?d ego.t_stop > 0\<close> pos_via_half_dist
         by force
       define t' where "t' = ego.t_stop - min (ego.t_stop / 2) (e / 2)"
       have "0 < ego.t_stop" using 1 by auto
       have "other.p t' - ego.p t' < other.p ego.t_stop - ego.p ego.t_stop"
         apply (rule DERIV_pos_imp_increasing[of t'])
          apply (force simp: t'_def e min_def \<open>0 < ego.t_stop\<close>)
         apply (auto intro!: exI[where x = "?d x" for x] intro!: derivative_intros e)
         using \<open>e > 0\<close>
         apply (auto simp: t'_def dist_real_def algebra_simps)
         done
       also have "\<dots> = 0" using 1 by (simp add: ego.p_t_stop)
       finally have less: "other.p t' < ego.p t'" by simp
       have "t' > 0"
         using 1 by (auto simp: t'_def algebra_simps min_def)
       have "t' < ego.t_stop" by (auto simp: t'_def \<open>e > 0\<close> \<open>ego.t_stop > 0\<close>)
       from less_le_trans[OF \<open>t' < ego.t_stop\<close> \<open>ego.t_stop \<le> other.t_stop\<close>]
       have "t' < other.t_stop" .
       from ego_other_strict_ivt[of t'] less
       have "collision {0..<t'}"
         using \<open>t' > 0\<close> \<open>t' < ego.t_stop\<close> \<open>t' < other.t_stop\<close>
         by (auto simp: other.s_def ego.s_def split: if_splits)
       thus ?case
         using \<open>t' > 0\<close> \<open>t' < ego.t_stop\<close> \<open>t' < other.t_stop\<close>
         apply (auto simp: collision_def ego.s_def other.s_def movement.p_def
             split: if_splits)
         apply (rule_tac x = t in exI) 
         apply (auto simp: movement.p_def)[]
         done
     qed
   qed
 qed
 
 lemma collision_within_eq:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "collision {0..} \<longleftrightarrow> collision {0 ..< min ego.t_stop other.t_stop}"
   unfolding collision_within_p[OF assms]
   unfolding collision_def
   by (safe; force
     simp: ego.s_def other.s_def movement.p_def ego.t_stop_def other.t_stop_def
     split: if_splits)
 
 lemma collision_excluded: "(\<And>t. t \<in> T \<Longrightarrow> ego.s t \<noteq> other.s t) \<Longrightarrow> collision S \<longleftrightarrow> collision (S - T)"
   by (auto simp: collision_def)
 
 lemma collision_within_less:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "collision {0..} \<longleftrightarrow> collision {0 <..< min ego.t_stop other.t_stop}"
 proof -
   note collision_within_eq[OF assms]
   also have "collision {0 ..< min ego.t_stop other.t_stop} \<longleftrightarrow>
     collision ({0 ..< min ego.t_stop other.t_stop} - {0})"
     using hyps assms
     by (intro collision_excluded) (auto simp: ego.s_def other.s_def)
   also have "{0 ..< min ego.t_stop other.t_stop} - {0} = {0 <..< min ego.t_stop other.t_stop}"
     by auto
   finally show ?thesis 
     unfolding collision_def
     by (safe;
       force
         simp: ego.s_def other.s_def movement.p_def ego.t_stop_def other.t_stop_def
         split: if_splits)
 qed
 
 theorem cond_3:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "collision {0..} \<longleftrightarrow> (a\<^sub>o > a\<^sub>e \<and> v\<^sub>o < v\<^sub>e \<and> 0 \<le> D2 \<and> sqrt D2 > v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o)"
 proof -
   have "v\<^sub>o \<noteq> 0"
     using assms(1) assms(2) movement.s_def movement.t_stop_def by auto
   with hyps have "v\<^sub>o > 0" by auto
   note hyps = hyps this
   define t1 where "t1 = (- (v\<^sub>o - v\<^sub>e) + sqrt D2) / (a\<^sub>o - a\<^sub>e)"
   define t2 where "t2 = (- (v\<^sub>o - v\<^sub>e) - sqrt D2) / (a\<^sub>o - a\<^sub>e)"
   define bounded where "bounded \<equiv> \<lambda>t. (0 \<le> t \<and> t \<le> ego.t_stop \<and> t \<le> other.t_stop)"
   have ego_other_conv:
     "\<And>t. bounded t \<Longrightarrow> ego.p t = other.p t \<longleftrightarrow> ego_other.p t = 0"
     by (auto simp: movement.p_def field_split_simps)
   let ?r = "{0 <..< min ego.t_stop other.t_stop}"
   have D2: "D2 = (v\<^sub>o - v\<^sub>e)\<^sup>2 - 4 * ((a\<^sub>o - a\<^sub>e) / 2) * (s\<^sub>o - s\<^sub>e)" by simp
   define D where "D = D2"
   note D = D_def[symmetric]
   define x1 where "x1 \<equiv> (- (v\<^sub>o - v\<^sub>e) + sqrt D2) / (2 * ((a\<^sub>o - a\<^sub>e) / 2))"
   define x2 where "x2 \<equiv> (- (v\<^sub>o - v\<^sub>e) - sqrt D2) / (2 * ((a\<^sub>o - a\<^sub>e) / 2))"
   have x2: "x2 =(- (v\<^sub>o - v\<^sub>e) - sqrt D2) / (a\<^sub>o - a\<^sub>e)"
     by (simp add: x2_def field_split_simps)
   have x1: "x1 =(- (v\<^sub>o - v\<^sub>e) + sqrt D2) / (a\<^sub>o - a\<^sub>e)"
     by (simp add: x1_def field_split_simps)
   from collision_within_less[OF assms]
   have coll_eq: "collision {0..} = collision ?r"
     by (auto simp add: bounded_def)
   also have "\<dots> \<longleftrightarrow> (a\<^sub>o > a\<^sub>e \<and> v\<^sub>o < v\<^sub>e \<and> 0 \<le> D2 \<and> sqrt D2 > v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o)"
   proof safe
     assume H: "a\<^sub>e < a\<^sub>o" "v\<^sub>o < v\<^sub>e" "0 \<le> D2"
     assume sqrt: "sqrt D2 > v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o"
     have nz: "(a\<^sub>o - a\<^sub>e) / 2 \<noteq> 0" using \<open>a\<^sub>e < a\<^sub>o\<close> by simp
     note sol = quadratic_eq_zeroes_iff[OF D2 x1_def[THEN meta_eq_to_obj_eq] x2_def[THEN meta_eq_to_obj_eq] nz]
     from sol[of x2] \<open>0 \<le> D2\<close>
     have "other.p x2 = ego.p x2"
       by (auto simp: ego.p_def other.p_def field_split_simps)
     moreover
     have "x2 > 0"
     proof (rule ccontr)
       assume "\<not> 0 < x2"
       then have "ego_other.p x2 \<ge> ego_other.p 0"
         using H hyps
         by (intro DERIV_nonpos_imp_nonincreasing[of x2]) 
           (auto intro!: exI[where x="ego_other.p' x" for x] derivative_eq_intros
             simp: ego_other.p'_def add_nonpos_nonpos mult_nonneg_nonpos)
       also have "ego_other.p 0 > 0" using hyps by (simp add: ego_other.p_def)
       finally (xtrans) show False using \<open>other.p x2 = ego.p x2\<close>
         by (simp add: movement.p_def field_split_simps power2_eq_square)
     qed
     moreover
     have "x2 < other.t_stop"
       using sqrt H hyps
       by (auto simp: x2 other.t_stop_def field_split_simps power2_eq_square)
 
     ultimately
     show "collision {0<..<min ego.t_stop other.t_stop}"
     proof (cases "x2 < ego.t_stop", goal_cases)
       case 2
       then have "other.s x2 = other.p x2"
         by (auto simp: other.s_def)
       also from 2 have "\<dots> \<le> ego.p ego.t_stop"
         by (auto intro!: ego.p_antimono)
       also have "\<dots> = ego.s x2"
         using 2 by (auto simp: ego.s_def ego.p_t_stop)
       finally have "other.s x2 \<le> ego.s x2" .
       from ego_other_ivt[OF this]
       show ?thesis
         unfolding coll_eq[symmetric]
         by (rule collision_subset) auto
     qed (auto simp: collision_def ego.s_def other.s_def not_le intro!: bexI[where x=x2])
   next
     let ?max = "max ego.t_stop other.t_stop"
     let ?min = "min ego.t_stop other.t_stop"
     assume "collision ?r"
     then obtain t where t: "ego.p t = other.p t" "0 < t" "t < ?min"
       by (auto simp: collision_def ego.s_def other.s_def)
     then have "t < - (v\<^sub>e / a\<^sub>e)" "t < - (v\<^sub>o / a\<^sub>o)" "t < other.t_stop"
       by (simp_all add: ego.t_stop_def other.t_stop_def)
     from t have "ego_other.p t = 0"
       by (auto simp: movement.p_def field_split_simps)
     from t have "t < ?max" by auto
     from hyps assms have "0 < ego_other.p 0"
       by simp
     from ego_other.p_def[abs_def, THEN meta_eq_to_obj_eq]
     have eop_eq: "ego_other.p = (\<lambda>t. 1 / 2 * (a\<^sub>o - a\<^sub>e) * t\<^sup>2 + (v\<^sub>o - v\<^sub>e) * t + (s\<^sub>o - s\<^sub>e))"
       by (simp add: algebra_simps)
     show "a\<^sub>o > a\<^sub>e"
     proof -
       have "ego.p other.t_stop \<le> ego.p_max"
         by (rule ego.p_max)
       also have "... \<le> other.p other.t_stop" using hyps assms
         by (auto simp:other.s_def ego.s_def ego.p_t_stop split:if_splits)
       finally have "0 \<le> ego_other.p other.t_stop"
         by (auto simp add:movement.p_def field_simps)
       from p_convex[OF eop_eq, of 0 t other.t_stop, simplified \<open>ego_other.p t = 0\<close>,
         OF \<open>0 < t\<close> \<open>t < other.t_stop\<close> \<open>0 < ego_other.p 0\<close> \<open>0 \<le> ego_other.p other.t_stop\<close>]
       show "a\<^sub>o > a\<^sub>e" by (simp add: algebra_simps)
     qed
     have rewr: "4 * ((a\<^sub>o - a\<^sub>e) / 2) = 2 * (a\<^sub>o - a\<^sub>e)" by simp
     from \<open>a\<^sub>o > a\<^sub>e\<close> \<open>ego_other.p t = 0\<close> ego_other.p_all_zeroes[OF D2[symmetric], of t]
     have "0 \<le> D2" and disj: "(t = (- (v\<^sub>o - v\<^sub>e) + sqrt D2) / (a\<^sub>o - a\<^sub>e) \<or> t = (- (v\<^sub>o - v\<^sub>e) - sqrt D2) / (a\<^sub>o - a\<^sub>e))"
       using hyps assms
       unfolding rewr by simp_all
     show "0 \<le> D2" by fact
     from add_strict_mono[OF \<open>t < - (v\<^sub>e / a\<^sub>e)\<close> \<open>t < - (v\<^sub>o / a\<^sub>o)\<close>] `0 < t` \<open>a\<^sub>o > a\<^sub>e\<close>
     have "0 < - (v\<^sub>e / a\<^sub>e) + - (v\<^sub>o / a\<^sub>o)" by (simp add: divide_simps)
     then have "0 > v\<^sub>e * a\<^sub>o + a\<^sub>e * v\<^sub>o" using hyps
       by (simp add: field_split_simps split: if_splits)
     show "v\<^sub>o < v\<^sub>e"
       using `a\<^sub>e < a\<^sub>o` `movement.p (a\<^sub>o - a\<^sub>e) (v\<^sub>o - v\<^sub>e) (s\<^sub>o - s\<^sub>e) t = 0` in_front  t(2)
       apply (auto simp: movement.p_def divide_less_0_iff algebra_simps power2_eq_square)
       by (smt divide_less_0_iff mult_le_cancel_right mult_mono mult_nonneg_nonneg nonneg_vel_ego)
     from disj have "x2 < ?min"
     proof rule
       assume "t = (- (v\<^sub>o - v\<^sub>e) - sqrt D2) / (a\<^sub>o - a\<^sub>e)"
       then show ?thesis
         using \<open>t < ?min\<close>
         by (simp add: x2)
     next
       assume "t = (- (v\<^sub>o - v\<^sub>e) + sqrt D2) / (a\<^sub>o - a\<^sub>e)"
       also have "\<dots> \<ge> x2"
         unfolding x2
         apply (rule divide_right_mono)
          apply (subst (2) diff_conv_add_uminus)
          apply (rule add_left_mono)
         using \<open>a\<^sub>o > a\<^sub>e\<close> \<open>D2 \<ge> 0\<close>
         by auto
       also (xtrans) note \<open>t < ?min\<close>
       finally show ?thesis .
     qed
     then show "sqrt D2 > v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o"
       using hyps \<open>a\<^sub>o > a\<^sub>e\<close>
       by (auto simp: x2 field_split_simps other.t_stop_def)
   qed
   finally show ?thesis .
 qed
 
 subsubsection \<open>Formalising Safe Distance\<close>
 
 text \<open>First definition for Safe Distance based on \<open>cond_1\<close>.\<close>
 definition absolute_safe_distance :: real where
   "absolute_safe_distance = - v\<^sub>e\<^sup>2 / (2 * a\<^sub>e)"
 
 lemma absolute_safe_distance:
   assumes "s\<^sub>o - s\<^sub>e > absolute_safe_distance"
   shows "no_collision {0..}"
   proof -
   from assms hyps absolute_safe_distance_def have "ego.s_stop < s\<^sub>o" 
     by (auto simp add:ego.s_def ego.p_def ego.t_stop_def power_def)
   thus ?thesis by (rule cond_1)
   qed
 
 text \<open>First Fallback for Safe Distance.\<close>
 definition fst_safe_distance :: real where
   "fst_safe_distance = v\<^sub>o\<^sup>2 / (2 * a\<^sub>o) - v\<^sub>e\<^sup>2 / (2 * a\<^sub>e)"
 
 definition distance_leq_d2 :: real where
   "distance_leq_d2 = (a\<^sub>e + a\<^sub>o) / (2 * a\<^sub>o\<^sup>2) * v\<^sub>o\<^sup>2 - v\<^sub>o * v\<^sub>e / a\<^sub>o"
 
 lemma snd_leq_fst_exp: "distance_leq_d2 \<le> fst_safe_distance"
 proof -
   have "0 \<le> (other.t_stop - ego.t_stop)\<^sup>2" by auto
   hence "- ego.t_stop\<^sup>2 \<le> other.t_stop\<^sup>2 - 2 * other.t_stop * ego.t_stop" by (simp add:power_def algebra_simps) 
   with hyps(3) have "- ego.t_stop\<^sup>2 * (a\<^sub>e / 2) \<ge> (other.t_stop\<^sup>2 - 2 * other.t_stop * ego.t_stop) * (a\<^sub>e / 2)"
     by (smt half_gt_zero_iff mult_le_cancel_right)
   with ego.t_stop_def other.t_stop_def hyps 
   have "- v\<^sub>e\<^sup>2 / (2 * a\<^sub>e) \<ge> a\<^sub>e * v\<^sub>o\<^sup>2 / (2 * a\<^sub>o\<^sup>2) - v\<^sub>o * v\<^sub>e / a\<^sub>o" by (simp add:power_def algebra_simps)
   with fst_safe_distance_def distance_leq_d2_def
   have 1: "fst_safe_distance \<ge>  a\<^sub>e * v\<^sub>o\<^sup>2 / (2 * a\<^sub>o\<^sup>2) - v\<^sub>o * v\<^sub>e / a\<^sub>o + v\<^sub>o\<^sup>2 / (2 * a\<^sub>o)" by (auto simp add:algebra_simps)
   have "a\<^sub>e * v\<^sub>o\<^sup>2 / (2 * a\<^sub>o\<^sup>2) - v\<^sub>o * v\<^sub>e / a\<^sub>o + v\<^sub>o\<^sup>2 / (2 * a\<^sub>o) = distance_leq_d2" (is "?LHS = _")
   proof -
     have "?LHS = a\<^sub>e * v\<^sub>o\<^sup>2 / (2 * a\<^sub>o\<^sup>2) - v\<^sub>o * v\<^sub>e / a\<^sub>o + a\<^sub>o * v\<^sub>o\<^sup>2 / (2 * a\<^sub>o\<^sup>2)"  
       by (auto simp add: algebra_simps power_def)
     also have "...  = distance_leq_d2" 
       by (auto simp add: power_def field_split_simps distance_leq_d2_def)
     finally show ?thesis by auto    
   qed
   with 1 show ?thesis by auto
 qed  
 
 lemma sqrt_D2_leq_stop_time_diff:
   assumes "a\<^sub>e < a\<^sub>o"
   assumes "0 \<le> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o "
   assumes "s\<^sub>o - s\<^sub>e \<ge> distance_leq_d2"
   shows "sqrt D2 \<le> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o"
 proof -
   from assms have "- 2 * (a\<^sub>o - a\<^sub>e) * (s\<^sub>o - s\<^sub>e) \<le> - 2 * (a\<^sub>o - a\<^sub>e) * distance_leq_d2" (is "?L \<le> ?R") 
   by simp
   hence "D2 \<le> (v\<^sub>o - v\<^sub>e)\<^sup>2 - 2 * (a\<^sub>o - a\<^sub>e) * distance_leq_d2" by (simp add: algebra_simps)
   also have "... = (v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o)\<^sup>2"
   proof -
     from distance_leq_d2_def
     have 1: "(v\<^sub>o - v\<^sub>e)\<^sup>2 - 2 * (a\<^sub>o - a\<^sub>e) * distance_leq_d2 = 
              (v\<^sub>o - v\<^sub>e)\<^sup>2 - (a\<^sub>o - a\<^sub>e) * (a\<^sub>e + a\<^sub>o) / a\<^sub>o\<^sup>2 * v\<^sub>o\<^sup>2 + 2 * (a\<^sub>o - a\<^sub>e) * v\<^sub>o * v\<^sub>e / a\<^sub>o"
       by (auto simp add: field_split_simps)
     with hyps(4) have "... = (v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o)\<^sup>2"
       by (auto simp add: power_def field_split_simps)
     with 1 show ?thesis by auto
   qed
   finally show ?thesis  by (smt assms(2) real_le_lsqrt real_sqrt_le_0_iff)
 qed
 
 lemma cond2_imp_pos_vo:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "v\<^sub>o \<noteq> 0"
 proof (rule ccontr)
   assume "\<not> v\<^sub>o \<noteq> 0"
   with other.s_def other.t_stop_def have "other.s_stop = s\<^sub>o" by auto
   with assms(2) have "ego.s_stop < s\<^sub>o" by auto
   with assms(1) show "False" by auto
 qed
 
 lemma cond2_imp_gt_fst_sd:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "fst_safe_distance < s\<^sub>o - s\<^sub>e"
 proof (cases "v\<^sub>e \<noteq> 0")
   case True
   from fst_safe_distance_def assms ego.s_def ego.t_stop_pos[OF \<open>v\<^sub>e \<noteq> 0\<close>] ego.p_def ego.t_stop_def
        other.s_def other.t_stop_pos[OF cond2_imp_pos_vo[OF assms]] other.p_def other.t_stop_def hyps
   show ?thesis by (simp add: power_def algebra_simps)
 next
   case False
   with fst_safe_distance_def  have "fst_safe_distance = v\<^sub>o\<^sup>2 / (2 * a\<^sub>o)" by auto
   also have "... \<le> 0"  by (simp add: divide_nonneg_neg hyps)
   also have "... < s\<^sub>o - s\<^sub>e" by (simp add: algebra_simps hyps)
   finally show ?thesis by auto
 qed
 
 text \<open>Second Fallback for Safe Distance.\<close>
 definition snd_safe_distance :: real where
   "snd_safe_distance = (v\<^sub>o - v\<^sub>e)\<^sup>2 / (2 * (a\<^sub>o - a\<^sub>e))"
 
 lemma fst_leq_snd_safe_distance:
   assumes "a\<^sub>e < a\<^sub>o"
   shows"fst_safe_distance \<le> snd_safe_distance"
 proof -
   have "0 \<le> (v\<^sub>o / a\<^sub>o - v\<^sub>e / a\<^sub>e)\<^sup>2" by auto
   hence 1: "0 \<le> (v\<^sub>o / a\<^sub>o)\<^sup>2 - 2 * v\<^sub>o * v\<^sub>e / (a\<^sub>o * a\<^sub>e) + (v\<^sub>e / a\<^sub>e)\<^sup>2" by (auto simp add: power_def algebra_simps)
   from hyps have "0 \<le> a\<^sub>o * a\<^sub>e"  by (simp add: mult_nonpos_nonpos)  
   from mult_right_mono[OF 1 this] hyps
   have "0 \<le> v\<^sub>o\<^sup>2 * a\<^sub>e / a\<^sub>o - 2 * v\<^sub>o * v\<^sub>e  + v\<^sub>e\<^sup>2 * a\<^sub>o / a\<^sub>e" by (auto simp add: power_def algebra_simps)
   with hyps have 2: "(v\<^sub>o\<^sup>2 / (2 * a\<^sub>o) - v\<^sub>e\<^sup>2 / (2 * a\<^sub>e)) * (2 * (a\<^sub>o - a\<^sub>e)) \<le> (v\<^sub>o - v\<^sub>e)\<^sup>2"
     by (auto simp add: power_def field_split_simps)
   from assms have "0 \<le> 2 * (a\<^sub>o - a\<^sub>e)" by auto
   from divide_right_mono[OF 2 this] assms fst_safe_distance_def snd_safe_distance_def
   show ?thesis by auto
 qed
 
 lemma snd_safe_distance_iff_nonneg_D2: 
   assumes "a\<^sub>e < a\<^sub>o"
   shows "s\<^sub>o - s\<^sub>e \<le> snd_safe_distance \<longleftrightarrow> 0 \<le> D2"
 proof -
   from snd_safe_distance_def assms pos_le_divide_eq[of "2 * (a\<^sub>o - a\<^sub>e)"]
   have "s\<^sub>o - s\<^sub>e \<le> snd_safe_distance \<longleftrightarrow> (s\<^sub>o - s\<^sub>e) * (2 * (a\<^sub>o - a\<^sub>e)) \<le> (v\<^sub>o - v\<^sub>e)\<^sup>2" by auto
   also have "... \<longleftrightarrow> 0 \<le> D2" by (auto simp add: algebra_simps)
   finally show ?thesis by auto
 qed
 
 lemma t_stop_diff_neg_means_leq_D2:
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop" "a\<^sub>e < a\<^sub>o" "0 \<le> D2"
   shows "v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0 \<longleftrightarrow> sqrt D2 > v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o"
 proof
   assume only_if: "v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0"
   from assms have "... \<le> sqrt D2" by auto
   with only_if show "v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < sqrt D2" by linarith
 next
   assume if_part: "v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < sqrt D2"
   from cond2_imp_gt_fst_sd[OF assms(1) assms(2)] snd_leq_fst_exp have "distance_leq_d2 \<le> s\<^sub>o - s\<^sub>e" by auto
   from if_part and sqrt_D2_leq_stop_time_diff [OF \<open>a\<^sub>e < a\<^sub>o\<close> _ \<open>distance_leq_d2 \<le> s\<^sub>o - s\<^sub>e\<close>]
   show " v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0"  by linarith
 qed
 
 theorem cond_3':
   assumes "s\<^sub>o \<le> ego.s_stop" "ego.s_stop < other.s_stop"
   shows "collision {0..} \<longleftrightarrow> (a\<^sub>o > a\<^sub>e \<and> v\<^sub>o < v\<^sub>e \<and> s\<^sub>o - s\<^sub>e \<le> snd_safe_distance \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0)"
 proof (cases "a\<^sub>o \<le> a\<^sub>e \<or> v\<^sub>o \<ge> v\<^sub>e")
   case True
   with cond_3[OF assms] show ?thesis by auto
 next
   case False
   from \<open>\<not> (a\<^sub>o \<le> a\<^sub>e \<or> v\<^sub>e \<le> v\<^sub>o)\<close> have "a\<^sub>o > a\<^sub>e" by auto
   from \<open>\<not> (a\<^sub>o \<le> a\<^sub>e \<or> v\<^sub>e \<le> v\<^sub>o)\<close> have "v\<^sub>o < v\<^sub>e" by auto
   show ?thesis 
   proof -
     from snd_safe_distance_iff_nonneg_D2 [OF \<open>a\<^sub>o > a\<^sub>e\<close>]
     have 1: "(a\<^sub>e < a\<^sub>o \<and> v\<^sub>o < v\<^sub>e \<and> s\<^sub>o - s\<^sub>e \<le> snd_safe_distance \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0) \<longleftrightarrow>
           (a\<^sub>e < a\<^sub>o \<and> v\<^sub>o < v\<^sub>e \<and> 0 \<le> D2 \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0)" by auto
 
     from t_stop_diff_neg_means_leq_D2[OF assms \<open>a\<^sub>e < a\<^sub>o\<close>]
     have "... = (a\<^sub>e < a\<^sub>o \<and> v\<^sub>o < v\<^sub>e \<and> 0 \<le> D2 \<and> sqrt D2 > v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o)" by auto
 
     with 1 cond_3[OF assms] show ?thesis by blast
   qed
 qed
 
 definition d :: "real \<Rightarrow> real" where
   "d t = (
     if t \<le> 0 then s\<^sub>o - s\<^sub>e
     else if t \<le> ego.t_stop \<and> t \<le> other.t_stop then ego_other.p t
     else if ego.t_stop \<le> t \<and> t \<le> other.t_stop then other.p t - ego.s_stop
     else if other.t_stop \<le> t \<and> t \<le> ego.t_stop then other.s_stop - ego.p t
     else other.s_stop - ego.s_stop
   )"
 
 lemma d_diff: "d t = other.s t - ego.s t"
   by (auto simp: d_def ego.s_eq_s_stop other.s_eq_s_stop ego.s_cond_def other.s_cond_def
     movement.p_def field_split_simps)
 
 lemma collision_d: "collision S \<longleftrightarrow> (\<exists>t\<in>S. d t = 0)"
   by (force simp: d_diff collision_def )
 
 lemma collision_restrict: "collision {0..} \<longleftrightarrow> collision {0..max ego.t_stop other.t_stop}"  
   by (auto simp: max.coboundedI1 ego.t_stop_nonneg min_def
     ego.s_eq_s_stop other.s_eq_s_stop collision_def
     intro!: bexI[where x = "min t (max (movement.t_stop a\<^sub>e v\<^sub>e) (movement.t_stop a\<^sub>o v\<^sub>o))" for t])
 
 lemma collision_union: "collision (A \<union> B) \<longleftrightarrow> collision A \<or> collision B"
   by (auto simp: collision_def)
 
 lemma symbolic_checker:
   "collision {0..} \<longleftrightarrow>
     (quadroot_in 0 (min ego.t_stop other.t_stop) (1/2 * (a\<^sub>o - a\<^sub>e)) (v\<^sub>o - v\<^sub>e) (s\<^sub>o - s\<^sub>e)) \<or>
     (quadroot_in ego.t_stop other.t_stop (1/2 * a\<^sub>o) v\<^sub>o (s\<^sub>o - ego.s_stop)) \<or>
     (quadroot_in other.t_stop ego.t_stop (1/2 * a\<^sub>e) v\<^sub>e (s\<^sub>e - other.s_stop))"
  (is "_ \<longleftrightarrow> ?q1 \<or> ?q2 \<or> ?q3")
 proof -
   have *: "{0..max ego.t_stop other.t_stop} =
     {0 .. min ego.t_stop other.t_stop} \<union> {ego.t_stop .. other.t_stop} \<union> {other.t_stop .. ego.t_stop}"
     using ego.t_stop_nonneg other.t_stop_nonneg
     by auto
   have "collision {0..min (movement.t_stop a\<^sub>e v\<^sub>e) (movement.t_stop a\<^sub>o v\<^sub>o)} = ?q1"
     by (force simp: collision_def quadroot_in_def root_in_def d_def
       power2_eq_square field_split_simps movement.p_def movement.s_cond_def)
   moreover
   have "collision {ego.t_stop .. other.t_stop} = ?q2"
     using ego.t_stop_nonneg
     by (force simp: collision_def quadroot_in_def root_in_def d_def
       ego.s_eq_s_stop movement.s_cond_def movement.p_def)
   moreover
   have "collision {other.t_stop .. ego.t_stop} = ?q3"
     using other.t_stop_nonneg
     by (force simp: collision_def quadroot_in_def root_in_def d_def
       other.s_eq_s_stop movement.s_cond_def movement.p_def)
   ultimately
   show ?thesis
     unfolding collision_restrict * collision_union
     by auto
 qed
 
 end
 
 subsection \<open>Checker Design\<close>
 
 definition rel_dist_to_stop :: "real \<Rightarrow> real \<Rightarrow> real" where
   "rel_dist_to_stop v a \<equiv> - v\<^sup>2 / (2 * a)"
 
 context includes floatarith_notation begin
 definition rel_dist_to_stop_expr :: "nat \<Rightarrow> nat \<Rightarrow> floatarith" where
   "rel_dist_to_stop_expr v a = Mult (Minus (Power (Var v) 2)) (Inverse (Mult (Num 2) (Var a)))"
 
 definition rel_dist_to_stop' :: "nat \<Rightarrow> float interval option \<Rightarrow> float interval option \<Rightarrow> float interval option" where
   "rel_dist_to_stop' p v a = approx p (rel_dist_to_stop_expr 0 1) [v, a]"
 
 lemma rel_dist_to_stop': "interpret_floatarith (rel_dist_to_stop_expr 0 1) [v, a] = rel_dist_to_stop v a"
   by (simp add: rel_dist_to_stop_def rel_dist_to_stop_expr_def inverse_eq_divide)
 
 definition first_safe_dist :: "real \<Rightarrow> real \<Rightarrow> real" where
   "first_safe_dist v\<^sub>e a\<^sub>e \<equiv> rel_dist_to_stop v\<^sub>e a\<^sub>e"
 
 definition second_safe_dist :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
   "second_safe_dist v\<^sub>e a\<^sub>e v\<^sub>o a\<^sub>o \<equiv> rel_dist_to_stop v\<^sub>e a\<^sub>e - rel_dist_to_stop v\<^sub>o a\<^sub>o"
 
 definition second_safe_dist_expr :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> floatarith" where
   "second_safe_dist_expr ve ae vo ao = Add (rel_dist_to_stop_expr ve ae) (Minus (rel_dist_to_stop_expr vo ao))"
 
 definition second_safe_dist' :: "nat \<Rightarrow> float interval option \<Rightarrow> float interval option
     \<Rightarrow> float interval option \<Rightarrow> float interval option \<Rightarrow> float interval option" where
   "second_safe_dist' p v\<^sub>e a\<^sub>e v\<^sub>o a\<^sub>o = approx p (second_safe_dist_expr 0 1 2 3) [v\<^sub>e, a\<^sub>e, v\<^sub>o, a\<^sub>o]"
 
 lemma second_safe_dist':
   "interpret_floatarith (second_safe_dist_expr 0 1 2 3) [v, a, v', a'] = second_safe_dist v a v' a'"
   by (simp add: second_safe_dist_def second_safe_dist_expr_def rel_dist_to_stop_def rel_dist_to_stop_expr_def inverse_eq_divide)
 
 definition t_stop :: "real \<Rightarrow> real \<Rightarrow> real" where
   "t_stop v a \<equiv> - v / a"
 
 definition t_stop_expr :: "nat \<Rightarrow> nat \<Rightarrow> floatarith" where
   "t_stop_expr v a = Minus (Mult (Var v) (Inverse (Var a)))"
 end
 
 definition s_stop :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
   "s_stop s v a \<equiv> s + rel_dist_to_stop v a"
 
 definition discriminant :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
   "discriminant s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<equiv> (v\<^sub>o - v\<^sub>e)\<^sup>2 - 2 * (a\<^sub>o - a\<^sub>e) * (s\<^sub>o - s\<^sub>e)"
 
 definition suff_cond_safe_dist2 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "suff_cond_safe_dist2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<equiv> 
     let D2 = discriminant s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o 
     in \<not> (a\<^sub>e < a\<^sub>o \<and> v\<^sub>o < v\<^sub>e \<and> 0 \<le> D2 \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < sqrt D2
   )"
 
 lemma less_sqrt_iff: "y \<ge> 0 \<Longrightarrow> x < sqrt y \<longleftrightarrow> (x \<ge> 0 \<longrightarrow> x\<^sup>2 < y)"
   by (smt real_le_lsqrt real_less_rsqrt real_sqrt_ge_zero)
 
 lemma suff_cond_safe_dist2_code[code]:
   "suff_cond_safe_dist2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o =
     (let D2 = discriminant s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o in
       (a\<^sub>e < a\<^sub>o \<longrightarrow> v\<^sub>o < v\<^sub>e \<longrightarrow> 0 \<le> D2 \<longrightarrow> (v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o \<ge> 0 \<and> (v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o)\<^sup>2 \<ge> D2)))"
   using real_sqrt_ge_zero real_less_rsqrt less_sqrt_iff
   by (auto simp: suff_cond_safe_dist2_def Let_def)
   
 text \<open>
   There are two expressions for safe distance. The first safe distance \<open>first_safe_dist\<close> is always valid.
   Whenever the distance is bigger than \<open>first_safe_dist\<close>, it is guarantee to be collision free.
   The second one is \<open>second_safe_dist\<close>. If the sufficient condition \<open>suff_cond_safe_dist2\<close> is satisfied and
   the distance is bigger than \<open>second_safe_dist\<close>, it is guaranteed to be collision free.
 \<close>
 
 definition check_precond :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where 
   "check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<longleftrightarrow> s\<^sub>o > s\<^sub>e \<and> 0 \<le> v\<^sub>e \<and> 0 \<le> v\<^sub>o \<and> a\<^sub>e < 0 \<and> a\<^sub>o < 0 "
 
 lemma check_precond_safe_distance: 
   "check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o = safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o"
 proof
   assume "safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o"
   then interpret safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o .
   show "check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
     by (auto simp: check_precond_def in_front nonneg_vel_ego other.nonneg_vel ego.decel other.decel)
 qed (unfold_locales; auto simp: check_precond_def)
 
 subsubsection \<open>Prescriptive Checker\<close>
   
 definition checker :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<equiv>
     let distance   = s\<^sub>o - s\<^sub>e;
         precond    = check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o;
         safe_dist1 = first_safe_dist v\<^sub>e a\<^sub>e; 
         safe_dist2 = second_safe_dist v\<^sub>e a\<^sub>e v\<^sub>o a\<^sub>o;
         cond2      = suff_cond_safe_dist2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o 
     in precond \<and> (safe_dist1 < distance \<or> (safe_dist2 < distance \<and> distance \<le> safe_dist1 \<and> cond2))"
 
 lemma aux_logic:
   assumes "a \<Longrightarrow> b"
   assumes "b \<Longrightarrow> a \<longleftrightarrow> c"
   shows "a \<longleftrightarrow> b \<and> c"
   using assms by blast
 
 theorem soundness_correctness:
   "checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<longleftrightarrow> check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<and> safe_distance.no_collision a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o {0..}"
 proof (rule aux_logic, simp add: checker_def Let_def)
   assume cp: "check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
   then have in_front': "s\<^sub>o > s\<^sub>e"
     and nonneg_vel_ego: "0 \<le> v\<^sub>e"
     and nonneg_vel_other: "0 \<le> v\<^sub>o"
     and decelerate_ego: "a\<^sub>e < 0"
     and decelerate_other: "a\<^sub>o < 0"
     by (auto simp: check_precond_def)
 
   from in_front' have in_front: "0 < s\<^sub>o - s\<^sub>e" by arith
 
   interpret safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o by (unfold_locales; fact)
   interpret ego: braking_movement a\<^sub>e v\<^sub>e s\<^sub>e by (unfold_locales; fact)
   interpret other: braking_movement a\<^sub>o v\<^sub>o s\<^sub>o by (unfold_locales; fact)
 
   have "ego.p_max < s\<^sub>o \<or> other.p_max \<le> ego.p_max \<or> s\<^sub>o \<le> ego.p_max \<and> ego.p_max < other.p_max"
     by arith
   then show "checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o = safe_distance.no_collision a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o {0..}"
   proof (elim disjE)
     assume "ego.p_max < s\<^sub>o"
     then have "checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
       using \<open>a\<^sub>e < 0\<close> cp
       by (simp add: checker_def Let_def first_safe_dist_def rel_dist_to_stop_def ego.p_max_def
         ego.p_def ego.t_stop_def algebra_simps power2_eq_square)
     moreover
     have "no_collision {0..}"
       using \<open>ego.p_max < s\<^sub>o\<close>
       by (intro cond_1) (auto simp: ego.s_t_stop)
     ultimately show ?thesis by auto
   next
     assume "other.p_max \<le> ego.p_max"
     then have "\<not> checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
       using \<open>a\<^sub>e < 0\<close> \<open>a\<^sub>o < 0\<close> other.nonneg_vel
       by (auto simp add: checker_def Let_def first_safe_dist_def second_safe_dist_def
         rel_dist_to_stop_def movement.p_max_def
         movement.p_def movement.t_stop_def algebra_simps power2_eq_square)
          (smt divide_nonneg_neg mult_nonneg_nonneg)
     moreover have "collision {0..}"
       using \<open>other.p_max \<le> ego.p_max\<close>
       by (intro cond_2) (auto simp: other.s_t_stop ego.s_t_stop)
     ultimately show ?thesis by auto
   next
     assume H: "s\<^sub>o \<le> ego.p_max \<and> ego.p_max < other.p_max"
     then have "checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o = (\<not> (a\<^sub>e < a\<^sub>o \<and> v\<^sub>o < v\<^sub>e \<and> 0 \<le> D2 \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < sqrt D2))"
       using \<open>a\<^sub>e < 0\<close> \<open>a\<^sub>o < 0\<close> cp
       by (simp add: checker_def Let_def first_safe_dist_def rel_dist_to_stop_def ego.p_max_def
         ego.p_def ego.t_stop_def algebra_simps power2_eq_square second_safe_dist_def
         suff_cond_safe_dist2_def discriminant_def not_less other.p_max_def other.p_def other.t_stop_def)
     also have "\<dots> = no_collision {0..}"
       using H
       unfolding Not_eq_iff
       by (intro cond_3[symmetric]) (auto simp: ego.s_t_stop other.s_t_stop)
     finally show ?thesis by auto
   qed
 qed
 
 definition checker2 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "checker2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<equiv> 
     let distance   = s\<^sub>o - s\<^sub>e;
         precond    = check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o;
         safe_dist1 = first_safe_dist v\<^sub>e a\<^sub>e; 
         safe_dist2 = second_safe_dist v\<^sub>e a\<^sub>e v\<^sub>o a\<^sub>o;
         safe_dist3 = - rel_dist_to_stop (v\<^sub>o - v\<^sub>e) (a\<^sub>o - a\<^sub>e) 
     in
       if \<not> precond then False 
       else if distance > safe_dist1 then True 
       else if a\<^sub>o > a\<^sub>e \<and> v\<^sub>o < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0 then distance > safe_dist3
       else distance > safe_dist2"
 
 theorem checker_eq_checker2: "checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<longleftrightarrow> checker2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
 proof (cases "check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o")
   case False
   with checker_def checker2_def
   show ?thesis by auto
 next
   case True
   with check_precond_def safe_distance_def 
   have "safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o"  by (simp add: check_precond_safe_distance)
   
   from this interpret safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o by auto
   interpret ego: braking_movement a\<^sub>e v\<^sub>e s\<^sub>e by (unfold_locales; fact)
   interpret other: braking_movement a\<^sub>o v\<^sub>o s\<^sub>o by (unfold_locales; fact)
 
   from \<open>check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o\<close>  cond_3 cond_3'[symmetric] fst_leq_snd_safe_distance
   ego.s_t_stop ego.p_max_def ego.p_def ego.t_stop_def hyps other.s_t_stop other.p_max_def other.p_def 
   other.t_stop_def checker2_def checker_def suff_cond_safe_dist2_def fst_safe_distance_def 
   first_safe_dist_def snd_safe_distance_def second_safe_dist_def rel_dist_to_stop_def discriminant_def 
   show ?thesis
     by (auto simp add:power_def Let_def split: if_splits)
 qed
 
 definition checker3 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "checker3 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<equiv> 
     let distance = s\<^sub>o - s\<^sub>e;
         precond  = check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o;
         s_stop_e = s\<^sub>e + rel_dist_to_stop v\<^sub>e a\<^sub>e;
         s_stop_o = s\<^sub>o + rel_dist_to_stop v\<^sub>o a\<^sub>o 
     in precond \<and> (s_stop_e < s\<^sub>o 
                \<or> (s\<^sub>o \<le> s_stop_e \<and> s_stop_e < s_stop_o \<and>
                  (\<not>(a\<^sub>o > a\<^sub>e \<and> v\<^sub>o < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o < 0 \<and> distance * (a\<^sub>o - a\<^sub>e) \<le> (v\<^sub>o - v\<^sub>e)\<^sup>2 / 2))))"
 
 theorem checker2_eq_checker3:
   "checker2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<longleftrightarrow> checker3 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
   apply (auto simp: checker2_def checker3_def Let_def first_safe_dist_def not_less
     suff_cond_safe_dist2_def second_safe_dist_def rel_dist_to_stop_def check_precond_def)
 proof goal_cases
   case 1
   then interpret safe_distance
     by unfold_locales auto
   from fst_leq_snd_safe_distance 1
   show ?case
     by (auto simp: fst_safe_distance_def snd_safe_distance_def)
 next
   case 2
   then interpret safe_distance
     by unfold_locales auto
   from fst_leq_snd_safe_distance 2
   show ?case
     by (auto simp: fst_safe_distance_def snd_safe_distance_def field_split_simps)
 next
   case 3
   then interpret safe_distance
     by unfold_locales auto
   from fst_leq_snd_safe_distance 3
   show ?case
     by (auto simp: fst_safe_distance_def snd_safe_distance_def field_split_simps)
 qed
 
 subsubsection \<open>Approximate Checker\<close>
 
 lemma checker2_def': "checker2 a b c d e f = (
   let distance   = d - a;
       precond    = check_precond a b c d e f;
       safe_dist1 = first_safe_dist b c;
       safe_dist2 = second_safe_dist b c e f;
       C          = c < f \<and> e < b \<and> b * f > c * e;
       P1         = (e - b)\<^sup>2 < 2 * distance * (f - c);
       P2         = - b\<^sup>2 / c + e\<^sup>2 / f < 2 * distance
   in precond \<and> (safe_dist1 < distance \<or>
                 safe_dist1 \<ge> distance \<and> (C \<and> P1 \<or> \<not>C \<and> P2)))"
   unfolding checker2_def
   by (auto simp: Let_def field_split_simps check_precond_def second_safe_dist_def
     rel_dist_to_stop_def)
 
 lemma power2_less_sqrt_iff: "(x::real)\<^sup>2 < y \<longleftrightarrow> (y \<ge> 0 \<and> abs x < sqrt y)"
   apply (auto simp: real_less_rsqrt abs_real_def less_sqrt_iff)
    apply (meson le_less le_less_trans not_less power2_less_0)+
   done
 
 schematic_goal checker_form: "interpret_form ?x ?y \<Longrightarrow> checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
   unfolding checker_eq_checker2 checker2_eq_checker3 checker3_def check_precond_def first_safe_dist_def second_safe_dist_def
     suff_cond_safe_dist2_def Let_def t_stop_def s_stop_def
     rel_dist_to_stop_def
     discriminant_def
     not_le not_less
     de_Morgan_conj
     de_Morgan_disj
     power2_less_sqrt_iff
   apply (tactic \<open>(Reification.tac @{context} @{thms interpret_form.simps interpret_floatarith.simps interpret_floatarith_divide interpret_floatarith_diff}) NONE 1\<close>)
   apply assumption
   done
 
 context includes floatarith_notation begin                                            
 definition "checker' p s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o = approx_form p
            (Conj (Conj (Less (Var (Suc (Suc 0))) (Var (Suc (Suc (Suc 0)))))
                    (Conj (LessEqual (Var (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))) (Var (Suc (Suc (Suc (Suc (Suc 0)))))))
                      (Conj (LessEqual (Var (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))) (Var (Suc (Suc (Suc (Suc (Suc (Suc 0))))))))
                        (Conj (Less (Var 0) (Var (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))))
                          (Less (Var (Suc 0)) (Var (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))))))))
              (Disj (Less (Add (Var (Suc (Suc 0)))
                            (Mult (Minus (Power (Var (Suc (Suc (Suc (Suc (Suc 0)))))) 2)) (Inverse (Mult (Var (Suc (Suc (Suc (Suc 0))))) (Var 0)))))
                      (Var (Suc (Suc (Suc 0)))))
                (Conj (LessEqual (Var (Suc (Suc (Suc 0))))
                        (Add (Var (Suc (Suc 0)))
                          (Mult (Minus (Power (Var (Suc (Suc (Suc (Suc (Suc 0)))))) 2)) (Inverse (Mult (Var (Suc (Suc (Suc (Suc 0))))) (Var 0))))))
                  (Conj (Less (Add (Var (Suc (Suc 0)))
                                (Mult (Minus (Power (Var (Suc (Suc (Suc (Suc (Suc 0)))))) 2)) (Inverse (Mult (Var (Suc (Suc (Suc (Suc 0))))) (Var 0)))))
                          (Add (Var (Suc (Suc (Suc 0))))
                            (Mult (Minus (Power (Var (Suc (Suc (Suc (Suc (Suc (Suc 0))))))) 2))
                              (Inverse (Mult (Var (Suc (Suc (Suc (Suc 0))))) (Var (Suc 0)))))))
                    (Disj (LessEqual (Var (Suc 0)) (Var 0))
                      (Disj (LessEqual (Var (Suc (Suc (Suc (Suc (Suc 0)))))) (Var (Suc (Suc (Suc (Suc (Suc (Suc 0))))))))
                        (Disj (LessEqual (Var (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0))))))))
                                (Add (Var (Suc (Suc (Suc (Suc (Suc 0))))))
                                  (Minus (Mult (Mult (Var 0) (Inverse (Var (Suc 0)))) (Var (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))))))
                          (Less (Mult (Power (Add (Var (Suc (Suc (Suc (Suc (Suc (Suc 0))))))) (Minus (Var (Suc (Suc (Suc (Suc (Suc 0)))))))) 2)
                                  (Inverse (Var (Suc (Suc (Suc (Suc 0)))))))
                            (Mult (Add (Var (Suc (Suc (Suc 0)))) (Minus (Var (Suc (Suc 0))))) (Add (Var (Suc 0)) (Minus (Var 0))))))))))))
   ([a\<^sub>e, a\<^sub>o, s\<^sub>e, s\<^sub>o, Interval' (Float 2 0) (Float 2 0), v\<^sub>e, v\<^sub>o, Interval' (Float 0 1) (Float 0 1)]) (replicate 8 0)"
 
 lemma less_Suc_iff_disj: "i < Suc x \<longleftrightarrow> i = x \<or> i < x"
   by auto
 
 lemma checker'_soundness_correctness:
   assumes "a \<in> {real_of_float al .. real_of_float au}"
   assumes "b \<in> {real_of_float bl .. real_of_float bu}"
   assumes "c \<in> {real_of_float cl .. real_of_float cu}"
   assumes "d \<in> {real_of_float dl .. real_of_float du}"
   assumes "e \<in> {real_of_float el .. real_of_float eu}"
   assumes "f \<in> {real_of_float fl .. real_of_float fu}"
   assumes chk: "checker' p (Interval' al au) (Interval' bl bu) (Interval' cl cu) (Interval' dl du) (Interval' el eu) (Interval' fl fu)"
   shows "checker a b c d e f"
   apply (rule checker_form)
   apply (rule approx_form_aux)
    apply (rule chk[unfolded checker'_def])
   using assms(1-6)
   unfolding bounded_by_def
 proof (auto split: option.splits)
   fix i x2
   assume *: "[Interval' cl cu, Interval' fl fu, Interval' al au, Interval' dl du, 
            Interval' (Float 2 0) (Float 2 0), Interval' bl bu, Interval' el eu, Interval' 0 0] ! i = Some x2"
   assume " i < Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))"
   then consider "i = 0" | "i = 1" | "i = 2" | "i = 3" | "i = 4" | "i = 5" | "i = 6" | "i = 7"
     by linarith
   thus " [c, f, a, d, 2, b, e, 0] ! i \<in>\<^sub>r x2"
     apply cases using assms(1-6) *
     by (auto intro!: in_real_intervalI dest!: Interval'_eq_Some)
 qed
     
 lemma approximate_soundness_correctness:
   assumes "a \<in> {real_of_float al .. real_of_float au}"
   assumes "b \<in> {real_of_float bl .. real_of_float bu}"
   assumes "c \<in> {real_of_float cl .. real_of_float cu}"
   assumes "d \<in> {real_of_float dl .. real_of_float du}"
   assumes "e \<in> {real_of_float el .. real_of_float eu}"
   assumes "f \<in> {real_of_float fl .. real_of_float fu}"
   assumes chk: "checker' p (Interval' al au) (Interval' bl bu) (Interval' cl cu) (Interval' dl du) (Interval' el eu) (Interval' fl fu)"
   shows checker'_precond: "check_precond a b c d e f"
     and checker'_no_collision: "safe_distance.no_collision c b a f e d  {0..}"
   unfolding atomize_conj
   apply (subst soundness_correctness[symmetric])
   using checker'_soundness_correctness[OF assms]
   by (auto simp: checker_def Let_def)
 
 subsubsection \<open>Symbolic Checker\<close>
 
 definition symbolic_checker :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "symbolic_checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<equiv>
     let e_stop = - v\<^sub>e / a\<^sub>e;
         o_stop = - v\<^sub>o / a\<^sub>o
     in check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<and>
        (\<not>quadroot_in 0 (min e_stop o_stop) (1/2 * (a\<^sub>o - a\<^sub>e)) (v\<^sub>o - v\<^sub>e) (s\<^sub>o - s\<^sub>e) \<and>
        \<not>quadroot_in e_stop o_stop (1/2 * a\<^sub>o) v\<^sub>o (s\<^sub>o - movement.p a\<^sub>e v\<^sub>e s\<^sub>e e_stop) \<and>
        \<not>quadroot_in o_stop e_stop (1/2 * a\<^sub>e) v\<^sub>e (s\<^sub>e - movement.p a\<^sub>o v\<^sub>o s\<^sub>o o_stop))"
 
 theorem symbolic_soundness_correctness:
   "symbolic_checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<longleftrightarrow> check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<and> safe_distance.no_collision a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o {0..}"
 proof -
   {
     assume c: "check_precond s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o"
     then interpret safe_distance a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o
       by (simp add: check_precond_safe_distance)
     have "symbolic_checker s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o = no_collision {0..}"
       using c
       unfolding symbolic_checker symbolic_checker_def ego.s_t_stop other.s_t_stop ego.p_max_def other.p_max_def
       by (auto simp: Let_def movement.t_stop_def)
   }
   then show ?thesis
     by (auto simp: symbolic_checker_def Let_def)
 qed
 end
 
 end
\ No newline at end of file
diff --git a/thys/Safe_Distance/Safe_Distance_Reaction.thy b/thys/Safe_Distance/Safe_Distance_Reaction.thy
--- a/thys/Safe_Distance/Safe_Distance_Reaction.thy
+++ b/thys/Safe_Distance/Safe_Distance_Reaction.thy
@@ -1,1757 +1,1757 @@
 \<^marker>\<open>creator "Albert Rizaldi" "Fabian Immler\<close>
 
 section \<open>Safe Distance with Reaction Time\<close>
 
 theory Safe_Distance_Reaction
 imports
   Safe_Distance
 begin
 
 subsection \<open>Normal Safe Distance\<close>
                                     
 locale safe_distance_normal = safe_distance +
   fixes \<delta> :: real
   assumes pos_react: "0 < \<delta>"
 begin
 
 sublocale ego2: braking_movement a\<^sub>e v\<^sub>e "(ego.q \<delta>)" ..
 
 lemma ego2_s_init: "ego2.s 0 = ego.q \<delta>" unfolding ego2.s_def by auto
 
 definition \<tau> :: "real \<Rightarrow> real" where
   "\<tau> t = t - \<delta>"
 
 definition \<tau>' :: "real \<Rightarrow> real" where
   "\<tau>' t = 1"
 
 lemma \<tau>_continuous[continuous_intros]: "continuous_on T \<tau>"
   unfolding \<tau>_def by (auto intro: continuous_intros)
 
 lemma isCont_\<tau>[continuous_intros]: "isCont \<tau> x"
   using \<tau>_continuous[of UNIV] by (auto simp: continuous_on_eq_continuous_at)
 
 lemma del_has_vector_derivative[derivative_intros]: "(\<tau> has_vector_derivative \<tau>' t) (at t within u)"
   by (auto simp: \<tau>_def[abs_def] \<tau>'_def has_vector_derivative_def algebra_simps
            intro!: derivative_eq_intros)
                                                              
 lemma del_has_real_derivative[derivative_intros]: "(\<tau> has_real_derivative \<tau>' t) (at t within u)"
   using del_has_vector_derivative
   by (simp add:has_field_derivative_iff_has_vector_derivative)
 
 lemma delay_image: "\<tau> ` {\<delta>..} = {0..}"
 proof (rule subset_antisym, unfold image_def, unfold \<tau>_def)
   show "{y. \<exists>x\<in>{\<delta>..}. y = x - \<delta>} \<subseteq> {0..}" by auto
 next
   show "{0..} \<subseteq> {y. \<exists>x\<in>{\<delta>..}. y = x - \<delta>}"
   proof (rule subsetI)
     fix a
     assume "(a::real) \<in> {0..}"
     hence "0 \<le> a" by simp
     hence "\<exists>x\<in>{\<delta>..}. a = x - \<delta>" using bexI[where x = "a + \<delta>"] by auto
     thus "a \<in> {y. \<exists>x\<in>{\<delta>..}. y = x - \<delta>}" by auto
   qed
 qed
 
 lemma s_delayed_has_real_derivative[derivative_intros]:
   assumes "\<delta> \<le> t"
   shows "((ego2.s \<circ> \<tau>) has_field_derivative ego2.s' (t - \<delta>) * \<tau>' t) (at t within {\<delta>..})"
 proof (rule DERIV_image_chain)
   from assms have 0: "0 \<le> t - \<delta>" by simp
   from ego2.t_stop_nonneg have 1: "v\<^sub>e / a\<^sub>e \<le> 0" unfolding ego2.t_stop_def by simp
   from ego2.decel have 2: "a\<^sub>e \<noteq> 0" by simp
   show "(ego2.s has_real_derivative ego2.s' (t - \<delta>)) (at (\<tau> t) within \<tau> ` {\<delta>..})"
   using ego2.s_has_real_derivative[OF 0 1 2] sym[OF delay_image]
   unfolding \<tau>_def by simp
 next
   from del_has_real_derivative show "(\<tau> has_real_derivative \<tau>' t) (at t within {\<delta>..})" 
   by auto
 qed
 
 lemma s_delayed_has_real_derivative' [derivative_intros]:
   assumes "\<delta> \<le> t"
   shows "((ego2.s \<circ> \<tau>) has_field_derivative (ego2.s' \<circ> \<tau>) t) (at t within {\<delta>..})"
 proof -
   from s_delayed_has_real_derivative[OF assms] have
   "((ego2.s \<circ> \<tau>) has_field_derivative ego2.s' (t - \<delta>) * \<tau>' t) (at t within {\<delta>..})"
   by auto
   hence "((ego2.s \<circ> \<tau>) has_field_derivative ego2.s' (t - \<delta>) * 1) (at t within {\<delta>..})"
   using \<tau>'_def[of t] by metis
   hence "((ego2.s \<circ> \<tau>) has_field_derivative ego2.s' (t - \<delta>)) (at t within {\<delta>..})"
   by (simp add:algebra_simps)  
   thus ?thesis unfolding comp_def \<tau>_def by auto
 qed
 
 lemma s_delayed_has_vector_derivative' [derivative_intros]:
   assumes "\<delta> \<le> t"
   shows "((ego2.s \<circ> \<tau>) has_vector_derivative (ego2.s' \<circ> \<tau>) t) (at t within {\<delta>..})"
   using s_delayed_has_real_derivative'[OF assms]
   by (simp add:has_field_derivative_iff_has_vector_derivative)
   
 definition u :: "real \<Rightarrow> real" where
   "u t = (     if t \<le> 0 then s\<^sub>e
           else if t \<le> \<delta> then ego.q t 
           else          (ego2.s \<circ> \<tau>) t)"
 
 lemma init_u: "t \<le> 0 \<Longrightarrow> u t = s\<^sub>e" unfolding u_def by auto
 
 lemma u_delta: "u \<delta> = ego2.s 0"
 proof -  
   have "u \<delta> = ego.q \<delta>" using pos_react unfolding u_def by auto
   also have "... = ego2.s 0" unfolding ego2.s_def by auto
   finally show "u \<delta> = ego2.s 0" .
 qed
 
 lemma q_delta: "ego.q \<delta> = ego2.s 0" using u_delta pos_react unfolding u_def by auto
 
 definition u' :: "real \<Rightarrow> real" where
   "u' t = (if t \<le> \<delta> then ego.q' t else ego2.s' (t - \<delta>))"
 
 lemma u'_delta: "u' \<delta> = ego2.s' 0"
 proof -
   have "u' \<delta> = ego.q' \<delta>" unfolding u'_def by auto
   also have "... = v\<^sub>e" unfolding ego2.q'_def by simp
   also have "... = ego2.p' 0" unfolding ego2.p'_def by simp
   also have "... = ego2.s' 0" using ego2.t_stop_nonneg unfolding ego2.s'_def by auto 
   finally show "u' \<delta> = ego.s' 0" .
 qed
 
 lemma q'_delta: "ego.q' \<delta> = ego2.s' 0" using u'_delta unfolding u'_def by auto
 
 lemma u_has_real_derivative[derivative_intros]:
   assumes nonneg_t: "t \<ge> 0"
   shows "(u has_real_derivative u' t) (at t within {0..})"
 proof -
   from pos_react have "0 \<le> \<delta>" by simp
 
   have temp: "((\<lambda>t. if t \<in> {0 .. \<delta>} then ego.q t else (ego2.s \<circ> \<tau>) t) has_real_derivative
     (if t \<in> {0..\<delta>} then ego.q' t else (ego2.s' \<circ> \<tau>) t)) (at t within {0..})" (is "(?f1 has_real_derivative ?f2) (?net)")
     unfolding u_def[abs_def] u'_def 
       has_field_derivative_iff_has_vector_derivative
     apply (rule has_vector_derivative_If_within_closures[where T = "{\<delta>..}"])
     using \<open>0 \<le> \<delta>\<close> q_delta q'_delta ego.s_has_vector_derivative[OF assms] ego.decel ego.t_stop_nonneg 
     s_delayed_has_vector_derivative'[of "t"] \<tau>_def
     unfolding comp_def
     by (auto simp: assms  max_def insert_absorb   
       intro!: ego.q_has_vector_derivative)
   show ?thesis
     unfolding has_vector_derivative_def has_field_derivative_iff_has_vector_derivative
       u'_def u_def[abs_def] 
     proof (rule has_derivative_transform[where f="(\<lambda>t. if t \<in> {0..\<delta>} then ego.q t else (ego2.s \<circ> \<tau>) t)"])
       from nonneg_t show " t \<in> {0..}" by auto
     next
       fix x
       assume "(x::real) \<in> {0..}"
       hence  "x \<le> \<delta> \<longleftrightarrow> x \<in> {0 .. \<delta>}" by simp
       thus  " (if x \<le> 0 then s\<^sub>e else if x \<le> \<delta> then ego.q x else (ego2.s \<circ> \<tau>) x) =
          (if x \<in> {0..\<delta>} then ego.q x else (ego2.s \<circ> \<tau>) x)" using pos_react unfolding ego.q_def by auto
     next
       from temp have "(?f1 has_vector_derivative ?f2) ?net"
       using has_field_derivative_iff_has_vector_derivative by auto      
       moreover with assms have "t \<in> {0 .. \<delta>} \<longleftrightarrow> t \<le> \<delta>" by auto
       ultimately show " ((\<lambda>t. if t \<in> {0..\<delta>} then ego.q t else (ego2.s \<circ> \<tau>) t) has_derivative
               (\<lambda>x. x *\<^sub>R (if t \<le> \<delta> then ego2.q' t else ego2.s' (t - \<delta>)))) (at t within {0..})" 
       unfolding comp_def \<tau>_def has_vector_derivative_def by auto
     qed 
 qed
 
 definition t_stop :: real where 
   "t_stop = ego2.t_stop + \<delta>"
 
 lemma t_stop_nonneg: "0 \<le> t_stop"
   unfolding t_stop_def
   using ego2.t_stop_nonneg pos_react
   by auto
 
 lemma t_stop_pos: "0 < t_stop"
   unfolding t_stop_def
   using ego2.t_stop_nonneg pos_react
   by auto
 
 lemma t_stop_zero:
   assumes "t_stop \<le> x"
   assumes "x \<le> \<delta>"
   shows "v\<^sub>e = 0"
   using assms unfolding t_stop_def using ego2.t_stop_nonneg pos_react ego2.t_stop_zero by auto
 
 lemma u'_stop_zero: "u' t_stop = 0" 
   unfolding u'_def t_stop_def ego2.q'_def ego2.s'_def
   using ego2.t_stop_nonneg ego2.p'_stop_zero decelerate_ego ego2.t_stop_zero by auto
 
 definition u_max :: real where 
   "u_max = u (ego2.t_stop + \<delta>)"
 
 lemma u_max_eq: "u_max = ego.q \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2"
 proof (cases "ego2.t_stop = 0")
   assume "ego2.t_stop = 0"
   hence "v\<^sub>e = 0" using ego2.t_stop_zero by simp
   with \<open>ego2.t_stop = 0\<close> show "u_max = ego.q \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2"  unfolding u_max_def u_def using pos_react by auto
 next
   assume "ego2.t_stop \<noteq> 0"
   hence "u_max = (ego2.s \<circ> \<tau>) (ego2.t_stop + \<delta>)" 
     unfolding u_max_def u_def  using ego2.t_stop_nonneg pos_react by auto 
   moreover have "... = ego2.s ego2.t_stop" unfolding comp_def \<tau>_def by auto
   moreover have "... = ego2.p_max" 
     unfolding ego2.s_def ego2.p_max_def using \<open>ego2.t_stop \<noteq> 0\<close> ego2.t_stop_nonneg by auto
   moreover have "... = ego.q \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2" using ego2.p_max_eq .
   ultimately show ?thesis by auto
 qed
 
 lemma u_mono: 
   assumes "x \<le> y" "y \<le> t_stop" 
   shows "u x \<le> u y"
 proof -
   have "y \<le> 0 \<or> (0 < y \<and> y \<le> \<delta>) \<or> \<delta> < y" by auto
 
   moreover
   { assume "y \<le> 0"
     with assms have "x \<le> 0" by auto
     with \<open>y \<le> 0\<close> have "u x \<le> u y" unfolding u_def by auto }
 
   moreover
   { assume "0 < y \<and> y \<le> \<delta>"
     with assms have "x \<le> \<delta>" by auto
     hence "u x \<le> u y" 
     proof (cases "x \<le> 0")
       assume "x \<le> 0"
       with \<open>x \<le> \<delta>\<close> and \<open>0 < y \<and> y \<le> \<delta>\<close> show "u x \<le> u y"  unfolding u_def using ego.q_min by auto
     next
       assume "\<not> x \<le> 0"
       with \<open>0 < y \<and> y \<le> \<delta>\<close> and assms show "u x \<le> u y" 
         unfolding u_def  using ego.q_mono by auto
     qed }
   
   moreover
   { assume "\<delta> < y"
     have "u x \<le> u y"
     proof (cases "\<delta> < x")
       assume "\<delta> < x" 
       with pos_react have "\<not> x \<le> 0" by auto
       moreover from \<open>\<delta> < y\<close> and pos_react have "\<not> y \<le> 0" by auto
       ultimately show "u x \<le> u y"  unfolding u_def comp_def 
         using assms ego2.s_mono[of "x - \<delta>" "y - \<delta>"] \<open>\<delta> < y\<close> \<open>\<delta> < x\<close> by (auto simp:\<tau>_def)
     next
       assume "\<not> \<delta> < x"
       hence "x \<le> \<delta>" by simp
       hence "u x \<le> ego.q \<delta>" unfolding u_def using pos_react nonneg_vel_ego
         by (auto simp add:ego.q_def mult_left_mono)
       also have "... = ego2.s (\<tau> \<delta>)" unfolding ego2.s_def unfolding \<tau>_def by auto
       also have "... \<le> ego2.s (\<tau> y)" unfolding \<tau>_def using \<open>\<delta> < y\<close> by (auto simp add:ego2.s_mono)
       also have "... = u y" unfolding u_def using \<open>\<delta> < y\<close> pos_react by auto     
       ultimately show "u x \<le> u y" by auto
     qed }
   
   ultimately show "u x \<le> u y" by auto
 qed
 
 lemma u_antimono: "x \<le> y \<Longrightarrow> t_stop \<le> x \<Longrightarrow> u y \<le> u x"
 proof -
   assume 1: "x \<le> y"
   assume 2: "t_stop \<le> x"
   hence "\<delta> \<le> x" unfolding \<tau>_def t_stop_def using pos_react ego2.t_stop_nonneg by auto
   with 1 have "\<delta> \<le> y" by auto
   from 1 and 2 have 3: "t_stop \<le> y" by auto
   show "u y \<le> u x"
   proof (cases "x \<noteq> \<delta> \<and> y \<noteq> \<delta>")
     assume "x \<noteq> \<delta> \<and> y \<noteq> \<delta>"
     hence "x \<noteq> \<delta>" and "y \<noteq> \<delta>" by auto
     have "u y \<le> (ego2.s \<circ> \<tau>) y" unfolding u_def using \<open>\<delta> \<le> y\<close> \<open>y \<noteq> \<delta>\<close> pos_react by auto
     also have "... \<le> (ego2.s \<circ> \<tau>) x" unfolding comp_def
     proof (intro ego2.s_antimono)
       show "\<tau> x \<le> \<tau> y" unfolding \<tau>_def using \<open>x \<le> y\<close> by auto
     next
       show "ego2.t_stop \<le> \<tau> x" unfolding \<tau>_def using \<open>t_stop \<le> x\<close> by (auto simp: t_stop_def)
     qed
     also have "... \<le> u x" unfolding u_def using \<open>\<delta> \<le> x\<close>\<open>x \<noteq> \<delta>\<close> pos_react by auto
     ultimately show "u y \<le> u x" by auto
   next
     assume "\<not> (x \<noteq> \<delta> \<and> y \<noteq> \<delta>)"
     have "x \<noteq> \<delta> \<longrightarrow> y \<noteq> \<delta>"
     proof (rule impI; erule contrapos_pp[where Q="\<not> x = \<delta>"])
       assume "\<not> y \<noteq> \<delta>"
       hence "y = \<delta>" by simp
       with \<open>t_stop \<le> y\<close> have "ego2.t_stop = 0" unfolding t_stop_def 
         using ego2.t_stop_nonneg by auto
       with \<open>t_stop \<le> x\<close> have "x = \<delta>" unfolding t_stop_def using \<open>x \<le> y\<close> \<open>y = \<delta>\<close> by auto
       thus "\<not> x \<noteq> \<delta>" by auto
     qed
     with \<open>\<not> (x \<noteq> \<delta> \<and> y \<noteq> \<delta>)\<close> have "(x = \<delta> \<and> y = \<delta>) \<or> (x = \<delta>)" by auto
     
     moreover
     { assume "x = \<delta> \<and> y = \<delta>"
       hence "x = \<delta>" and "y = \<delta>" by auto
       hence "u y \<le> ego.q \<delta>" unfolding u_def using pos_react by auto
       also have "... \<le> u x" unfolding u_def using \<open>x = \<delta>\<close> pos_react by auto
       ultimately have "u y \<le> u x" by auto }
 
     moreover
     { assume "x = \<delta>" 
       hence "ego2.t_stop = 0" using \<open>t_stop \<le> x\<close> ego2.t_stop_nonneg by (auto simp:t_stop_def)
       hence "v\<^sub>e = 0" by (rule ego2.t_stop_zero)
       hence "u y \<le> ego.q \<delta>"
         using pos_react \<open>x = \<delta>\<close> \<open>x \<le> y\<close> \<open>v\<^sub>e = 0\<close>
         unfolding u_def comp_def \<tau>_def ego2.s_def ego2.p_def ego2.p_max_def ego2.t_stop_def 
         by auto
       also have "... \<le> u x" using \<open>x = \<delta>\<close> pos_react unfolding u_def by auto       
       ultimately have "u y \<le> u x" by auto }
 
     ultimately show ?thesis by auto
   qed
 qed
 
 lemma u_max: "u x \<le> u_max" 
   unfolding u_max_def using t_stop_def        
   by (cases "x \<le> t_stop") (auto intro: u_mono u_antimono)
 
 lemma u_eq_u_stop: "NO_MATCH t_stop x \<Longrightarrow> x \<ge> t_stop \<Longrightarrow> u x = u_max"
 proof -
   assume "t_stop \<le> x"
   with t_stop_pos have "0 < x" by auto
   from \<open>t_stop \<le> x\<close> have "\<delta> \<le> x" unfolding t_stop_def using ego2.t_stop_nonneg by auto
   show  "u x = u_max"
   proof (cases "x \<le> \<delta>")
     assume "x \<le> \<delta>" 
     with \<open>t_stop \<le> x\<close> have "v\<^sub>e = 0" by (rule t_stop_zero)
     also have "x = \<delta>" using \<open>x \<le> \<delta>\<close> and \<open>\<delta> \<le> x\<close> by auto
     ultimately have "u x = ego.q \<delta>" unfolding u_def using pos_react by auto
     also have "... = u_max" unfolding u_max_eq using \<open>v\<^sub>e = 0\<close> by auto
     ultimately show "u x = u_max" by simp
   next
     assume "\<not> x \<le> \<delta>"
     hence "\<delta> < x" by auto
     hence "u x = (ego2.s \<circ> \<tau>) x" unfolding u_def using pos_react by auto
     also have "... = ego2.s ego2.t_stop" 
       proof (unfold comp_def; unfold \<tau>_def; intro order.antisym)
         have "x - \<delta> \<ge> ego2.t_stop" using \<open>t_stop \<le> x\<close> unfolding t_stop_def by auto
         thus "ego2.s (x - \<delta>) \<le> ego2.s ego2.t_stop" by (rule ego2.s_antimono) simp
       next
         have "x - \<delta> \<ge> ego2.t_stop" using \<open>t_stop \<le> x\<close> unfolding t_stop_def by auto
         thus "ego2.s ego2.t_stop \<le> ego2.s (x - \<delta>)" using ego2.t_stop_nonneg by (rule ego2.s_mono)
       qed
     also have "... = u_max" unfolding u_max_eq ego2.s_t_stop ego2.p_max_eq by auto
     ultimately show "u x = u_max" by auto
   qed
 qed
 
 lemma at_least_delta:
   assumes "x \<le> \<delta>"
   assumes "t_stop \<le> x"
   shows "ego.q x = ego2.s (x - \<delta>)"
   using assms ego2.t_stop_nonneg 
   unfolding t_stop_def ego2.s_def less_eq_real_def by auto
 
 lemma continuous_on_u[continuous_intros]: "continuous_on T u"
   unfolding u_def[abs_def]
   using t_stop_nonneg pos_react at_least_delta
   proof (intro continuous_on_subset[where t=T and s = "{..0} \<union> ({0..\<delta>} \<union> ({\<delta> .. t_stop} \<union> {t_stop ..}))"] continuous_on_If continuous_intros)
     fix x
     assume " \<not> x \<le> \<delta>"
     assume "x \<in> {0..\<delta>}"
     hence "0 \<le> x" and "x \<le> \<delta>" by auto
     thus "ego.q x = (ego2.s \<circ> \<tau>) x" 
       unfolding comp_def \<tau>_def ego2.s_def 
       using \<open>\<not> x \<le> \<delta>\<close> by auto
   next
     fix x
     assume "x \<in> {\<delta>..t_stop} \<union> {t_stop..}"
     hence "\<delta> \<le> x" unfolding t_stop_def using pos_react ego.t_stop_nonneg by auto
     also assume "x \<le> \<delta>"
     ultimately have "x = \<delta>" by auto
     thus "ego.q x = (ego2.s \<circ> \<tau>) x" unfolding comp_def \<tau>_def ego2.s_def by auto
   next
     fix t::real
     assume "t \<in> {.. 0}"
     hence "t \<le> 0" by auto
     also assume "\<not> t \<le> 0"
     ultimately have "t = 0" by auto
     hence "s\<^sub>e = ego.q t" unfolding ego.q_def by auto
     with pos_react \<open>t = 0\<close> show "s\<^sub>e = (if t \<le> \<delta> then ego.q t else (ego2.s \<circ> \<tau>) t)" by auto
   next
     fix t::real
     assume "t \<in> {0..\<delta>} \<union> ({\<delta>..t_stop} \<union> {t_stop..})"
     hence "0 \<le> t" using pos_react ego2.t_stop_nonneg by (auto simp: t_stop_def)
     also assume "t \<le> 0"
     ultimately have "t = 0" by auto
     hence " s\<^sub>e = (if t \<le> \<delta> then ego.q t else (ego2.s \<circ> \<tau>) t)" using pos_react ego.init_q by auto
     thus "s\<^sub>e = (if t \<le> \<delta> then ego.q t else (ego2.s \<circ> \<tau>) t)" by auto
   next
     show "T \<subseteq> {..0} \<union> ({0..\<delta>} \<union> ({\<delta>..t_stop} \<union> {t_stop..}))" by auto  
   qed
 
 lemma isCont_u[continuous_intros]: "isCont u x"
   using continuous_on_u[of UNIV]
   by (auto simp:continuous_on_eq_continuous_at)
 
 definition collision_react :: "real set \<Rightarrow> bool" where
   "collision_react time_set \<equiv> (\<exists>t\<in>time_set. u t = other.s t )"
 
 abbreviation no_collision_react :: "real set \<Rightarrow> bool" where
   "no_collision_react time_set \<equiv> \<not> collision_react time_set"
 
 lemma no_collision_reactI:
   assumes "\<And>t. t \<in> S \<Longrightarrow> u t \<noteq> other.s t"
   shows "no_collision_react S"
   using assms
   unfolding collision_react_def
   by blast
 
 lemma no_collision_union:
   assumes "no_collision_react S"
   assumes "no_collision_react T"
   shows "no_collision_react (S \<union> T)"
   using assms
   unfolding collision_react_def
   by auto
 
 lemma collision_trim_subset:
   assumes "collision_react S"
   assumes "no_collision_react T"
   assumes "T \<subseteq> S"
   shows "collision_react (S - T)"
   using assms
   unfolding collision_react_def by auto
 
 theorem cond_1r : "u_max < s\<^sub>o \<Longrightarrow> no_collision_react {0..}"
 proof (rule no_collision_reactI, simp)
   fix t :: real
   assume "0 \<le> t"
   have "u t \<le> u_max" by (rule u_max)
   also assume "... < s\<^sub>o"
   also have "... = other.s 0"
     by (simp add: other.init_s)
   also have "... \<le> other.s t"
     using \<open>0 \<le> t\<close> hyps
     by (intro other.s_mono) auto
   finally show "u t \<noteq> other.s t"
     by simp
 qed
 
 definition safe_distance_1r :: real where 
   "safe_distance_1r = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2"
 
 lemma sd_1r_eq: "(s\<^sub>o - s\<^sub>e > safe_distance_1r) = (u_max < s\<^sub>o)"
 proof -
   have "(s\<^sub>o - s\<^sub>e > safe_distance_1r) = (s\<^sub>o - s\<^sub>e > v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2)" unfolding safe_distance_1r_def by auto
   moreover have "... = (s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2 < s\<^sub>o)" by auto
   ultimately show ?thesis using u_max_eq ego.q_def by auto
 qed
 
 lemma sd_1r_correct:
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_1r"
   shows "no_collision_react {0..}"
 proof -
   from assms have "u_max < s\<^sub>o" using sd_1r_eq by auto
   thus ?thesis by (rule cond_1r)
 qed
 
 lemma u_other_strict_ivt:
   assumes "u t > other.s t"
   shows "collision_react {0..<t}"
 proof cases
   assume "0 \<le> t"
   with assms in_front
   have "\<exists>x\<ge>0. x \<le> t \<and> other.s x - u x = 0"
     by (intro IVT2) (auto simp: init_u other.init_s continuous_diff isCont_u other.isCont_s)
   then show ?thesis
     using assms
     by (auto simp add: algebra_simps collision_react_def Bex_def order.order_iff_strict)
 qed(insert assms hyps, auto simp: collision_react_def init_u other.init_s)
 
 lemma collision_react_subset: "collision_react s \<Longrightarrow> s \<subseteq> t \<Longrightarrow> collision_react t"
   by (auto simp:collision_react_def) 
 
 lemma u_other_ivt:
   assumes "u t \<ge> other.s t"
   shows "collision_react {0 .. t}"
 proof cases
   assume "u t > other.s t"
   from u_other_strict_ivt[OF this]
   show ?thesis
     by (rule collision_react_subset) auto
 qed (insert hyps assms; cases "t \<ge> 0"; force simp: collision_react_def init_u other.init_s)
 
 theorem cond_2r:
   assumes "u_max \<ge> other.s_stop"
   shows "collision_react {0 ..}"
   using assms
   apply(intro collision_react_subset[where t="{0..}" and s ="{0 .. max t_stop other.t_stop}"])
    apply(intro u_other_ivt[where t ="max t_stop other.t_stop"])
    apply(auto simp: u_eq_u_stop other.s_eq_s_stop)
   done
 
 definition ego_other2 :: "real \<Rightarrow> real" where
   "ego_other2 t = other.s t - u t"
 
 lemma continuous_on_ego_other2[continuous_intros]: "continuous_on T ego_other2"
   unfolding ego_other2_def[abs_def]
   by (intro continuous_intros)
 
 lemma isCont_ego_other2[continuous_intros]: "isCont ego_other2 x"
   using continuous_on_ego_other2[of UNIV]
   by (auto simp: continuous_on_eq_continuous_at)
 
 definition ego_other2' :: "real \<Rightarrow> real" where
   "ego_other2' t  = other.s' t - u' t"
 
 lemma ego_other2_has_real_derivative[derivative_intros]: 
   assumes "0 \<le> t"
   shows "(ego_other2 has_real_derivative ego_other2' t) (at t within {0..})"
   using assms other.t_stop_nonneg decelerate_other
   unfolding other.t_stop_def
   by (auto simp: ego_other2_def[abs_def] ego_other2'_def  algebra_simps
            intro!: derivative_eq_intros)
 
 theorem cond_3r_1:
   assumes "u \<delta> \<ge> other.s \<delta>"
   shows "collision_react {0 .. \<delta>}"
   proof (unfold collision_react_def) 
   have 1: "\<exists>t\<ge>0. t \<le> \<delta> \<and> ego_other2 t = 0"
     proof (intro IVT2)
       show "ego_other2 \<delta> \<le> 0" unfolding ego_other2_def using assms by auto
     next
       show "0 \<le> ego_other2 0" unfolding ego_other2_def 
         using other.init_s[of 0] init_u[of 0] in_front by auto
     next
       show "0 \<le> \<delta>" using pos_react by auto
     next
       show "\<forall>t. 0 \<le> t \<and> t \<le> \<delta> \<longrightarrow> isCont ego_other2 t" 
         using isCont_ego_other2 by auto
     qed
     then obtain t where "0 \<le> t \<and> t \<le> \<delta> \<and> ego_other2 t = 0" by auto
     hence "t \<in> {0 .. \<delta>}" and "u t = other.s t" unfolding ego_other2_def by auto
     thus "\<exists>t\<in>{0..\<delta>}. u t = other.s t" by (intro bexI)    
   qed
 
 definition distance0 :: real where 
   "distance0 =  v\<^sub>e * \<delta> - v\<^sub>o * \<delta> - a\<^sub>o * \<delta>\<^sup>2 / 2"
 
 definition distance0_2 :: real where 
   "distance0_2 = v\<^sub>e * \<delta> + 1 / 2 * v\<^sub>o\<^sup>2 / a\<^sub>o"
 
 theorem cond_3r_1':
   assumes "s\<^sub>o - s\<^sub>e \<le> distance0"
   assumes "\<delta> \<le> other.t_stop"
   shows "collision_react {0 .. \<delta>}"
 proof -
   from assms have "u \<delta> \<ge> other.s \<delta>" unfolding distance0_def other.s_def
     other.p_def u_def ego.q_def using pos_react by auto
   thus ?thesis using cond_3r_1 by auto
 qed
 
 theorem distance0_2_eq:
   assumes "\<delta> > other.t_stop"
   shows "(u \<delta> < other.s \<delta>) = (s\<^sub>o - s\<^sub>e > distance0_2)"
 proof -
   from assms have "(u \<delta> < other.s \<delta>) = (ego.q \<delta> < other.p_max)"
     using u_def other.s_def pos_react by auto
   also have "... = (s\<^sub>e + v\<^sub>e * \<delta> < s\<^sub>o + v\<^sub>o * (- v\<^sub>o / a\<^sub>o) + 1 / 2 * a\<^sub>o * (- v\<^sub>o / a\<^sub>o)\<^sup>2)"
     using ego.q_def other.p_max_def other.p_def other.t_stop_def by auto
   also have "... = (v\<^sub>e * \<delta> - v\<^sub>o * (- v\<^sub>o / a\<^sub>o) - 1 / 2 * a\<^sub>o * (- v\<^sub>o / a\<^sub>o)\<^sup>2 < s\<^sub>o - s\<^sub>e)" by linarith
   also have "... = (v\<^sub>e * \<delta> + v\<^sub>o\<^sup>2 / a\<^sub>o - 1 / 2 * v\<^sub>o\<^sup>2 / a\<^sub>o < s\<^sub>o - s\<^sub>e)"
     using other.p_def other.p_max_def other.p_max_eq other.t_stop_def by auto
   also have "... = (v\<^sub>e * \<delta> + 1 / 2 * v\<^sub>o\<^sup>2 / a\<^sub>o < s\<^sub>o - s\<^sub>e)" by linarith
   thus ?thesis using distance0_2_def by (simp add: calculation)
 qed
 
 theorem cond_3r_1'_2:
   assumes "s\<^sub>o - s\<^sub>e \<le> distance0_2"
   assumes "\<delta> > other.t_stop"
   shows "collision_react {0 .. \<delta>}"
 proof -
   from assms distance0_2_eq have "u \<delta> \<ge> other.s \<delta>" unfolding distance0_def other.s_def
     other.p_def u_def ego.q_def using pos_react by auto
   thus ?thesis using cond_3r_1 by auto
 qed
 
 definition safe_distance_3r :: real where
   "safe_distance_3r = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2"
 
 lemma distance0_at_most_sd3r:
   "distance0 \<le> safe_distance_3r"
   unfolding distance0_def safe_distance_3r_def using nonneg_vel_ego decelerate_ego
   by (auto simp add:field_simps)
 
 definition safe_distance_4r :: real where 
   "safe_distance_4r = (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 + v\<^sub>e * \<delta>"
 
 lemma distance0_at_most_sd4r:
   assumes "a\<^sub>o > a\<^sub>e"
   shows "distance0 \<le> safe_distance_4r"
 proof -
   from assms have "a\<^sub>o \<ge> a\<^sub>e" by auto
   have "0 \<le> (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / (2 * a\<^sub>o - 2 * a\<^sub>e)"
     by (rule divide_nonneg_nonneg) (auto simp add:assms `a\<^sub>e \<le> a\<^sub>o`)
   thus ?thesis unfolding distance0_def safe_distance_4r_def
     by auto
 qed
 
 definition safe_distance_2r :: real where 
   "safe_distance_2r = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o"
 
 lemma vo_start_geq_ve:
   assumes "\<delta> \<le> other.t_stop"
   assumes "other.s' \<delta> \<ge> v\<^sub>e"
   shows "u \<delta> < other.s \<delta>"
 proof -
     from assms have "v\<^sub>e \<le> v\<^sub>o + a\<^sub>o * \<delta>" unfolding other.s'_def other.p'_def by auto
     with  mult_right_mono[OF this, of "\<delta>"] have "v\<^sub>e * \<delta> \<le> v\<^sub>o * \<delta> + a\<^sub>o * \<delta>\<^sup>2" (is "?l0 \<le> ?r0")
       using pos_react by (auto simp add:field_simps power_def)
     hence "s\<^sub>e + ?l0 \<le> s\<^sub>e + ?r0" by auto
     also have "... < s\<^sub>o + ?r0" using in_front by auto
     also have "... < s\<^sub>o + v\<^sub>o * \<delta> + a\<^sub>o * \<delta>\<^sup>2 / 2" using decelerate_other pos_react by auto
     finally show ?thesis using pos_react assms(1)
       unfolding u_def ego.q_def other.s_def other.t_stop_def other.p_def by auto
 qed
 
 theorem so_star_stop_leq_se_stop:
   assumes "\<delta> \<le> other.t_stop"
   assumes "other.s' \<delta> < v\<^sub>e"
   assumes "\<not> (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
   shows "0 \<le> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2 + (v\<^sub>o + a\<^sub>o * \<delta>)\<^sup>2 / a\<^sub>o / 2"
 proof -
   consider "v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> \<ge> 0" | "\<not> (v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> \<ge> 0)" by auto
   thus ?thesis
   proof (cases)
     case 1
     hence "v\<^sub>e - a\<^sub>e / a\<^sub>o * (v\<^sub>o + a\<^sub>o * \<delta>) \<ge> 0" unfolding other.s'_def other.p'_def
       by (auto simp add:assms(1))
     hence "v\<^sub>e - a\<^sub>e / a\<^sub>o * v\<^sub>o - a\<^sub>e * \<delta> \<ge> 0" (is "?l0 \<ge> 0") using decelerate_other
       by (auto simp add:field_simps)
     hence "?l0 / a\<^sub>e \<le> 0" using divide_right_mono_neg[OF `?l0 \<ge> 0`] decelerate_ego by auto
     hence "0 \<ge> v\<^sub>e / a\<^sub>e - v\<^sub>o / a\<^sub>o - \<delta>" using decelerate_ego by (auto simp add:field_simps)
     hence *: "- v\<^sub>e / a\<^sub>e \<ge> - (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o" using decelerate_other by (auto simp add:field_simps)
     from assms have **: "v\<^sub>o + a\<^sub>o * \<delta> \<le> v\<^sub>e" unfolding other.s'_def other.p'_def by auto
     have vo_star_nneg: "v\<^sub>o + a\<^sub>o * \<delta> \<ge> 0"
     proof -
       from assms(1) have "- v\<^sub>o \<le> a\<^sub>o * \<delta>" unfolding other.t_stop_def using decelerate_other
         by (auto simp add:field_simps)
       thus ?thesis by auto
     qed
     from mult_mono[OF * ** _ `0 \<le> v\<^sub>o + a\<^sub>o * \<delta>`]
     have "- (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o * (v\<^sub>o + a\<^sub>o * \<delta>) \<le> - v\<^sub>e / a\<^sub>e * v\<^sub>e" using nonneg_vel_ego decelerate_ego
       by (auto simp add:field_simps)
     hence "- (v\<^sub>o + a\<^sub>o * \<delta>)\<^sup>2 / a\<^sub>o \<le> - v\<^sub>e\<^sup>2 / a\<^sub>e " by (auto simp add: field_simps power_def)
     thus ?thesis by (auto simp add:field_simps)
   next
     case 2
     with assms have "a\<^sub>o \<le> a\<^sub>e" by auto
     from assms(2) have "(v\<^sub>o + a\<^sub>o * \<delta>) \<le> v\<^sub>e" unfolding other.s'_def using assms unfolding other.p'_def
       by auto
     have vo_star_nneg: "v\<^sub>o + a\<^sub>o * \<delta> \<ge> 0"
     proof -
       from assms(1) have "- v\<^sub>o \<le> a\<^sub>o * \<delta>" unfolding other.t_stop_def using decelerate_other
         by (auto simp add:field_simps)
       thus ?thesis by auto
     qed
     with mult_mono[OF `v\<^sub>o + a\<^sub>o * \<delta> \<le> v\<^sub>e` `v\<^sub>o + a\<^sub>o * \<delta> \<le> v\<^sub>e`] have *: "(v\<^sub>o + a\<^sub>o * \<delta>)\<^sup>2 \<le> v\<^sub>e\<^sup>2"
       using nonneg_vel_ego by (auto simp add:power_def)
     from `a\<^sub>o \<le> a\<^sub>e` have "- 1 /a\<^sub>o \<le> - 1 / a\<^sub>e" using decelerate_ego decelerate_other
       by (auto simp add:field_simps)
     from mult_mono[OF * this] have "(v\<^sub>o + a\<^sub>o * \<delta>)\<^sup>2 * (- 1 / a\<^sub>o) \<le> v\<^sub>e\<^sup>2 * (- 1 / a\<^sub>e)"
       using nonneg_vel_ego decelerate_other by (auto simp add:field_simps)
     then show ?thesis by auto
   qed
 qed
 
 theorem distance0_at_most_distance2r:
   assumes "\<delta> \<le> other.t_stop"
   assumes "other.s' \<delta> < v\<^sub>e"
   assumes "\<not> (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
   shows "distance0 \<le> safe_distance_2r"
 proof -
   from so_star_stop_leq_se_stop[OF assms] have " 0 \<le> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2 + (v\<^sub>o + a\<^sub>o * \<delta>)\<^sup>2 / a\<^sub>o / 2 " (is "0 \<le> ?term")
     by auto
   have "safe_distance_2r = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o" unfolding safe_distance_2r_def by auto
   also have "... = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + (v\<^sub>o + a\<^sub>o * \<delta>)\<^sup>2 / 2 / a\<^sub>o - v\<^sub>o * \<delta> - a\<^sub>o * \<delta>\<^sup>2 / 2"
     using decelerate_other by (auto simp add:field_simps power_def)
   also have "... = v\<^sub>e * \<delta> - v\<^sub>o * \<delta> - a\<^sub>o * \<delta>\<^sup>2 / 2 + ?term" (is "_ = ?left + ?term")
     by (auto simp add:field_simps)
   finally have "safe_distance_2r = distance0 + ?term" unfolding distance0_def by auto
   with `0 \<le> ?term` show "distance0 \<le> safe_distance_2r" by auto
 qed
 
 theorem dist0_sd2r_1:
   assumes "\<delta> \<le> other.t_stop"
   assumes "\<not> (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_2r"
   shows "s\<^sub>o - s\<^sub>e > distance0"
 proof (cases "other.s' \<delta> \<ge> v\<^sub>e")
   assume "v\<^sub>e \<le> other.s' \<delta>"
   from vo_start_geq_ve[OF assms(1) this] have "u \<delta> < other.s \<delta>" by auto
   thus ?thesis unfolding distance0_def u_def using pos_react assms(1) unfolding ego.q_def
     other.s_def other.p_def by auto
 next
   assume "\<not> v\<^sub>e \<le> other.s' \<delta>"
   hence "v\<^sub>e > other.s' \<delta>" by auto
   from distance0_at_most_distance2r[OF assms(1) this assms(2)] have "distance0 \<le> safe_distance_2r"
     by auto
   with assms(3) show ?thesis by auto
 qed
 
 theorem sd2r_eq:
   assumes "\<delta> > other.t_stop"
   shows "(u_max < other.s \<delta>) = (s\<^sub>o - s\<^sub>e > safe_distance_2r)"
 proof -
   from assms have "(u_max < other.s \<delta>) = (ego2.s (- v\<^sub>e / a\<^sub>e) < other.p_max)"
     using u_max_def ego2.t_stop_def u_def other.s_def \<tau>_def pos_react ego2.p_max_eq ego2.s_t_stop u_max_eq by auto
   also have "... = (s\<^sub>e + v\<^sub>e * \<delta> + v\<^sub>e * (- v\<^sub>e / a\<^sub>e) + 1 / 2 * a\<^sub>e * (- v\<^sub>e / a\<^sub>e)\<^sup>2 < s\<^sub>o + v\<^sub>o * (- v\<^sub>o / a\<^sub>o) + 1 / 2 * a\<^sub>o * (- v\<^sub>o / a\<^sub>o)\<^sup>2)"
     using ego2.s_def ego2.p_def ego.q_def other.p_max_def other.p_def other.t_stop_def ego2.p_max_def ego2.s_t_stop ego2.t_stop_def by auto
   also have "... = (v\<^sub>e * \<delta> + v\<^sub>e * (- v\<^sub>e / a\<^sub>e) + 1 / 2 * a\<^sub>e * (- v\<^sub>e / a\<^sub>e)\<^sup>2 - v\<^sub>o * (- v\<^sub>o / a\<^sub>o) - 1 / 2 * a\<^sub>o * (- v\<^sub>o / a\<^sub>o)\<^sup>2 < s\<^sub>o  - s\<^sub>e)" by linarith
   also have "... = (v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e + 1 / 2 * v\<^sub>e\<^sup>2 / a\<^sub>e + v\<^sub>o\<^sup>2 / a\<^sub>o - 1 / 2 * v\<^sub>o\<^sup>2 / a\<^sub>o < s\<^sub>o  - s\<^sub>e)"
     using ego2.p_def ego2.p_max_def ego2.p_max_eq ego2.t_stop_def other.p_def other.p_max_def other.p_max_eq other.t_stop_def by auto
   also have "... = (v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o  < s\<^sub>o - s\<^sub>e)" by linarith
   thus ?thesis using distance0_2_def by (simp add: calculation safe_distance_2r_def)
 qed
 
 theorem dist0_sd2r_2:
   assumes "\<delta> > - v\<^sub>o / a\<^sub>o"
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_2r"
   shows "s\<^sub>o - s\<^sub>e > distance0_2"
 proof -
   have "- v\<^sub>e\<^sup>2 / 2 / a\<^sub>e \<ge> 0" using zero_le_power2 hyps(3) divide_nonneg_neg by (auto simp add:field_simps)
   hence "v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o \<ge> v\<^sub>e * \<delta> + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o" by simp
   hence "safe_distance_2r \<ge> distance0_2" using safe_distance_2r_def distance0_2_def by auto
   thus ?thesis using assms(2) by linarith
 qed
 end
 
 subsection \<open>Safe Distance Delta\<close>
 
 locale safe_distance_no_collsion_delta = safe_distance_normal +
   assumes no_collision_delta: "u \<delta> < other.s \<delta>"
 begin
 
 sublocale delayed_safe_distance: safe_distance a\<^sub>e v\<^sub>e "ego.q \<delta>" a\<^sub>o "other.s' \<delta>" "other.s \<delta>"
   proof (unfold_locales)
     from nonneg_vel_ego show "0 \<le> v\<^sub>e" by auto
   next
     from nonneg_vel_other show "0 \<le> other.s' \<delta>" unfolding other.s'_def other.p'_def other.t_stop_def
       using decelerate_other by (auto simp add: field_split_simps)
   next
     from decelerate_ego show "a\<^sub>e < 0" by auto
   next
     from decelerate_other show "a\<^sub>o < 0" by auto
   next
     from no_collision_delta show "ego.q \<delta> < other.s \<delta>" unfolding u_def using pos_react by auto
   qed
 
 lemma no_collision_react_initially_strict:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   shows "no_collision_react {0 <..< \<delta>}"
 proof (rule no_collision_reactI)
   fix t::real
   assume "t \<in> {0 <..< \<delta>}" 
   show "u t \<noteq> other.s t"
   proof (rule ccontr)
     assume "\<not> u t \<noteq> other.s t"
     hence "ego_other2 t = 0" unfolding ego_other2_def by auto
     from \<open>t \<in> {0 <..< \<delta>}\<close> have "ego_other2 t = other.s t - ego.q t" 
       unfolding ego_other2_def u_def using ego.init_q by auto
     have "\<delta> \<le> other.t_stop \<or> other.t_stop < \<delta>" by auto
     
     moreover
     { assume le_t_stop: "\<delta> \<le> other.t_stop"
       with \<open>ego_other2 t = other.s t - ego.q t\<close> have "ego_other2 t = other.p t - ego.q t"
         unfolding other.s_def using \<open>t \<in> {0 <..< \<delta>}\<close> by auto
       with \<open>ego_other2 t = 0\<close> have "other.p t - ego.q t = 0" by auto
       hence eq: "(s\<^sub>o- s\<^sub>e) + (v\<^sub>o - v\<^sub>e) * t + (1/2 * a\<^sub>o) * t\<^sup>2 = 0"
         unfolding other.p_def ego.q_def by (auto simp: algebra_simps)
       define p where "p \<equiv> \<lambda>x. (1/2 * a\<^sub>o) * x\<^sup>2 + (v\<^sub>o - v\<^sub>e) * x + (s\<^sub>o - s\<^sub>e)"
       have "0 < 1/2 * a\<^sub>o"
       proof (intro p_convex[where p=p and b="v\<^sub>o - v\<^sub>e" and c="s\<^sub>o - s\<^sub>e"])
           show "0 < t" using \<open>t \<in> {0 <..< \<delta>}\<close> by auto
         next
           show "t < \<delta>" using  \<open>t \<in> {0 <..< \<delta>}\<close> by auto
         next
           show "p t < p 0" unfolding p_def using eq in_front by (auto simp: algebra_simps)
         next
           from eq have "p t = 0" unfolding p_def by auto
           also have "... < p \<delta>"  using no_collision_delta pos_react le_t_stop             
             unfolding p_def u_def other.s_def ego.q_def other.p_def by (auto simp:algebra_simps)
           finally have "p t < p \<delta>" by simp
           thus "p t \<le> p \<delta>" by auto
         next
           show "p = (\<lambda>x. 1 / 2 * a\<^sub>o * x\<^sup>2 + (v\<^sub>o - v\<^sub>e) * x + (s\<^sub>o - s\<^sub>e))" unfolding p_def
           by (rule refl)
       qed
       hence "0 < a\<^sub>o" by auto
       with decelerate_other have False by simp }
 
     moreover
     { assume gt_t_stop: "\<delta> > other.t_stop"
       have t_lt_t_stop: "t < other.t_stop"
       proof (rule ccontr)
         assume "\<not> t < other.t_stop"
         hence "other.t_stop \<le> t" by simp
         from \<open>ego_other2 t = 0\<close> have "ego.q t = other.p_max"
           unfolding ego_other2_def u_def other.s_def comp_def \<tau>_def other.p_max_def
           using \<open>t \<in> {0 <..< \<delta>}\<close> \<open>other.t_stop \<le> t\<close> gt_t_stop by (auto split:if_splits)
         have "ego.q t = u t" unfolding u_def using \<open>t \<in> {0 <..< \<delta>}\<close> by auto
         also have "... \<le> u_max" using u_max by auto
         also have "... < other.p_max" using assms(2) other.s_t_stop by auto
         finally have "ego.q t < other.p_max" by auto
         with \<open>ego.q t = other.p_max\<close> show False by auto  
       qed
       
       with \<open>ego_other2 t = other.s t - ego.q t\<close> have "ego_other2 t = other.p t - ego.q t"
         unfolding other.s_def using \<open>t \<in> {0 <..< \<delta>}\<close> by auto
       with \<open>ego_other2 t = 0\<close> have "other.p t - ego.q t = 0" by auto
       hence eq: "(s\<^sub>o- s\<^sub>e) + (v\<^sub>o - v\<^sub>e) * t + (1/2 * a\<^sub>o) * t\<^sup>2 = 0"
         unfolding other.p_def ego.q_def by (auto simp: algebra_simps)
       define p where "p \<equiv> \<lambda>x. (1/2 * a\<^sub>o) * x\<^sup>2 + (v\<^sub>o - v\<^sub>e) * x + (s\<^sub>o - s\<^sub>e)"
       have "0 < 1/2 * a\<^sub>o"
       proof (intro p_convex[where p=p and b="v\<^sub>o - v\<^sub>e" and c="s\<^sub>o - s\<^sub>e"])
           show "0 < t" using \<open>t \<in> {0 <..< \<delta>}\<close> by auto
         next
           show "t < other.t_stop" using t_lt_t_stop by auto
         next
           show "p t < p 0" unfolding p_def using eq in_front by (auto simp: algebra_simps)
         next
           from eq have zero: "p t = 0" unfolding p_def by auto
           have eq: "p other.t_stop = ego_other2 other.t_stop" 
             unfolding ego_other2_def other.s_t_stop u_def ego.q_def 
                       other.s_def other.p_def p_def
             using \<open>\<delta> > other.t_stop\<close> other.t_stop_nonneg other.t_stop_def
             by (auto simp: diff_divide_distrib left_diff_distrib')
           have "u other.t_stop \<le> u_max" using u_max by auto
           also have "... < other.s_stop" using assms by auto
           finally have "0 \<le> other.s_stop - u other.t_stop" by auto
           hence "0 \<le> ego_other2 other.t_stop" unfolding ego_other2_def by auto
           hence "0 \<le> p other.t_stop" using eq by auto
           with zero show "p t \<le> p other.t_stop" by auto
         next
           show "p = (\<lambda>x. 1 / 2 * a\<^sub>o * x\<^sup>2 + (v\<^sub>o - v\<^sub>e) * x + (s\<^sub>o - s\<^sub>e))"
           unfolding p_def by (rule refl)
       qed 
       hence False using decelerate_other by auto }
 
      ultimately show False by auto
   qed
 qed
 
 lemma no_collision_react_initially:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   shows "no_collision_react {0 .. \<delta>}"
 proof -
   have "no_collision_react {0 <..< \<delta>}" by (rule no_collision_react_initially_strict[OF assms])
   have "u 0 \<noteq> other.s 0" using init_u other.init_s in_front by auto
   hence "no_collision_react {0}" unfolding collision_react_def by auto
   with \<open>no_collision_react {0 <..< \<delta>}\<close> have "no_collision_react ({0} \<union> {0 <..< \<delta>})"
     using no_collision_union[of "{0}" "{0 <..< \<delta>}"] by auto
   moreover have "{0} \<union> {0 <..< \<delta>} = {0 ..< \<delta>}" using pos_react by auto
   ultimately have "no_collision_react {0 ..< \<delta>}" by auto
 
   have "u \<delta> \<noteq> other.s \<delta>" using no_collision_delta by auto
   hence "no_collision_react {\<delta>}" unfolding collision_react_def by auto
   with \<open>no_collision_react {0 ..< \<delta>}\<close> have "no_collision_react ({\<delta>} \<union> {0 ..< \<delta>})"
     using no_collision_union[of "{\<delta>}" "{0 ..< \<delta>}"] by auto
   moreover have "{\<delta>} \<union> {0 ..< \<delta>} = {0 .. \<delta>}" using pos_react by auto
   ultimately show "no_collision_react {0 .. \<delta>}" by auto
 qed
 
 lemma collision_after_delta:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   shows "collision_react {0 ..} \<longleftrightarrow> collision_react {\<delta>..}" 
 proof
   assume "collision_react {0 ..}"
   have "no_collision_react {0 .. \<delta>}" by (rule no_collision_react_initially[OF assms])
   with \<open>collision_react {0..}\<close> have "collision_react ({0..} - {0 .. \<delta>})"
   using pos_react by (auto intro: collision_trim_subset)
   
   moreover have "{0..} - {0 .. \<delta>} = {\<delta> <..}" using pos_react by auto
   ultimately have "collision_react {\<delta> <..}" by auto
   thus "collision_react {\<delta> ..}" by (auto intro:collision_react_subset)
 next
   assume "collision_react {\<delta>..}"
   moreover have "{\<delta>..} \<subseteq> {0 ..}" using pos_react by auto
   ultimately show "collision_react {0 ..}" by (rule collision_react_subset)
 qed
 
 lemma collision_react_strict:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   shows "collision_react {\<delta> ..} \<longleftrightarrow> collision_react {\<delta> <..}"
 proof
   assume asm: "collision_react {\<delta> ..}"
   have "no_collision_react {\<delta>}" using no_collision_delta unfolding collision_react_def by auto
   moreover have "{\<delta> <..} \<subseteq> {\<delta> ..}" by auto
   ultimately have "collision_react ({\<delta> ..} - {\<delta>})" using asm collision_trim_subset by simp
   moreover have "{\<delta> <..} = {\<delta> ..} - {\<delta>}" by auto
   ultimately show "collision_react {\<delta> <..}" by auto
 next
   assume "collision_react {\<delta> <..}"
   thus "collision_react {\<delta> ..}" 
     using collision_react_subset[where t="{\<delta> ..}" and s="{\<delta> <..}"] by fastforce
 qed
 
 lemma delayed_other_s_stop_eq: "delayed_safe_distance.other.s_stop = other.s_stop"
 proof (unfold other.s_t_stop; unfold delayed_safe_distance.other.s_t_stop; unfold movement.p_max_eq)
   have "\<delta> \<le> other.t_stop \<or> other.t_stop < \<delta>" by auto
 
   moreover
   { assume "\<delta> \<le> other.t_stop"
     hence "other.s \<delta> - (other.s' \<delta>)\<^sup>2 / a\<^sub>o / 2 = s\<^sub>o - v\<^sub>o\<^sup>2 / a\<^sub>o / 2"
     unfolding other.s_def other.s'_def
     using  pos_react decelerate_other
     by (auto simp add: other.p_def other.p'_def power2_eq_square field_split_simps) }
 
   moreover
   { assume "other.t_stop < \<delta>"
     hence "other.s \<delta> - (other.s' \<delta>)\<^sup>2 / a\<^sub>o / 2 = s\<^sub>o - v\<^sub>o\<^sup>2 / a\<^sub>o / 2"
     unfolding other.s_def other.s'_def other.p_max_eq
     using pos_react decelerate_other 
     by (auto) }
 
   ultimately show "other.s \<delta> - (other.s' \<delta>)\<^sup>2 / a\<^sub>o / 2 = s\<^sub>o - v\<^sub>o\<^sup>2 / a\<^sub>o / 2" by auto
 qed
 
 lemma delayed_cond3':
   assumes "other.s \<delta> \<le> u_max" 
   assumes "u_max < other.s_stop"
   shows "delayed_safe_distance.collision {0 ..} \<longleftrightarrow>  
           (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> other.s \<delta> - ego.q \<delta> \<le> delayed_safe_distance.snd_safe_distance \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
   proof (rule delayed_safe_distance.cond_3')
     have "other.s \<delta> \<le> u_max" using \<open>other.s \<delta> \<le> u_max\<close> . 
     also have "... = ego2.s_stop" unfolding u_max_eq ego2.s_t_stop ego2.p_max_eq by (rule refl)
     finally show "other.s \<delta> \<le> ego2.s_stop" by auto
   next
     have "ego2.s_stop = u_max" unfolding ego2.s_t_stop ego2.p_max_eq u_max_eq by (rule refl)
     also have "... < other.s_stop" using assms by auto
     also have "... \<le> delayed_safe_distance.other.s_stop" using delayed_other_s_stop_eq by auto
     finally show "ego2.s_stop < delayed_safe_distance.other.s_stop" by auto
   qed
 
 lemma delayed_other_t_stop_eq:
   assumes "\<delta> \<le> other.t_stop"
   shows "delayed_safe_distance.other.t_stop + \<delta> = other.t_stop"
   using assms decelerate_other
   unfolding delayed_safe_distance.other.t_stop_def other.t_stop_def other.s'_def
             movement.t_stop_def other.p'_def
   by (auto simp add: field_split_simps)
 
 lemma delayed_other_s_eq:
   assumes "0 \<le> t"
   shows "delayed_safe_distance.other.s t = other.s (t + \<delta>)"
 proof (cases "\<delta> \<le> other.t_stop")
   assume 1: "\<delta> \<le> other.t_stop"
   have "t + \<delta> \<le> other.t_stop \<or> other.t_stop < t + \<delta>" by auto
   moreover
   { assume "t + \<delta> \<le> other.t_stop"
     hence "delayed_safe_distance.other.s t = delayed_safe_distance.other.p t"    
       using delayed_other_t_stop_eq [OF 1] assms
       unfolding delayed_safe_distance.other.s_def by auto 
     
     also have "... = other.p (t + \<delta>)" 
       unfolding movement.p_def other.s_def other.s'_def other.p'_def
       using pos_react 1 
       by (auto simp add: power2_eq_square field_split_simps)
       
     also have "... = other.s (t + \<delta>)"
       unfolding other.s_def 
       using assms pos_react \<open>t + \<delta> \<le> other.t_stop\<close> by auto
 
     finally have "delayed_safe_distance.other.s t = other.s (t + \<delta>)" by auto }
 
   moreover
   { assume "other.t_stop < t + \<delta>"
     hence "delayed_safe_distance.other.s t = delayed_safe_distance.other.p_max"
       using delayed_other_t_stop_eq [OF 1] assms delayed_safe_distance.other.t_stop_nonneg
       unfolding delayed_safe_distance.other.s_def by auto
     
     also have "... = other.p_max" 
       unfolding movement.p_max_eq other.s_def other.s'_def other.p_def other.p'_def
       using pos_react 1 decelerate_other 
       by (auto simp add: power2_eq_square field_split_simps)
 
     also have "... = other.s (t + \<delta>)"
       unfolding other.s_def
       using assms pos_react \<open>other.t_stop < t + \<delta>\<close> by auto
 
     finally have "delayed_safe_distance.other.s t = other.s (t + \<delta>)" by auto }
 
   ultimately show ?thesis by auto
 next
   assume "\<not> \<delta> \<le> other.t_stop"
   hence "other.t_stop < \<delta>" by auto
   hence "other.s' \<delta> = 0" and "other.s \<delta> = other.p_max" 
     unfolding other.s'_def other.s_def using pos_react by auto
   hence "delayed_safe_distance.other.s t = delayed_safe_distance.other.p_max"
     unfolding delayed_safe_distance.other.s_def using assms decelerate_other 
     by (auto simp add:movement.p_max_eq movement.p_def movement.t_stop_def)
   also have "... = other.p_max" 
     unfolding movement.p_max_eq using \<open>other.s' \<delta> = 0\<close> \<open>other.s \<delta> = other.p_max\<close>
     using other.p_max_eq by auto
   also have "... = other.s (t + \<delta>)" 
     unfolding other.s_def using pos_react assms \<open>other.t_stop < \<delta>\<close> by auto
   finally show "delayed_safe_distance.other.s t = other.s (t + \<delta>)" by auto
 qed
 
 lemma translate_collision_range:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   shows "delayed_safe_distance.collision {0 ..} \<longleftrightarrow> collision_react {\<delta> ..}"
 proof 
   assume "delayed_safe_distance.collision {0 ..}" 
   then obtain t where eq: "ego2.s t = delayed_safe_distance.other.s t" and "0 \<le> t"
     unfolding delayed_safe_distance.collision_def by auto
 
   have "ego2.s t = (ego2.s \<circ> \<tau>) (t + \<delta>)" unfolding comp_def \<tau>_def by auto
   also have "... = u (t + \<delta>)" unfolding u_def using \<open>0 \<le> t\<close> pos_react 
     by (auto simp: \<tau>_def ego2.init_s)
   finally have left:"ego2.s t = u (t + \<delta>)" by auto
 
   have right: "delayed_safe_distance.other.s t = other.s (t + \<delta>)"
     using delayed_other_s_eq pos_react \<open>0 \<le> t\<close> by auto
 
   with eq and left have "u (t + \<delta>) = other.s (t + \<delta>)" by auto
   moreover have "\<delta> \<le> t + \<delta>" using \<open>0 \<le> t\<close> by auto
   ultimately show "collision_react {\<delta> ..}" unfolding collision_react_def by auto
 next
   assume "collision_react {\<delta> ..}"
   hence "collision_react {\<delta> <..}" using collision_react_strict[OF assms] by simp
   then obtain t where eq: "u t = other.s t" and "\<delta> < t"
     unfolding collision_react_def by auto
   moreover hence "u t = (ego2.s \<circ> \<tau>) t" unfolding u_def using pos_react by auto
   moreover have "other.s t = delayed_safe_distance.other.s (t - \<delta>)"
     using delayed_other_s_eq \<open>\<delta> < t\<close> by auto
   ultimately have "ego2.s (t - \<delta>) = delayed_safe_distance.other.s (t - \<delta>)"
     unfolding comp_def \<tau>_def by auto
   with \<open>\<delta> < t\<close> show "delayed_safe_distance.collision {0 ..}" 
     unfolding delayed_safe_distance.collision_def by auto
 qed
 
 theorem cond_3r_2:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   assumes "other.s \<delta> \<le> u_max"
   shows "collision_react {0 ..} \<longleftrightarrow> 
          (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> other.s \<delta> -  ego.q \<delta> \<le> delayed_safe_distance.snd_safe_distance \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
 proof -
   have "collision_react {0 ..} \<longleftrightarrow> collision_react {\<delta> ..}" by (rule collision_after_delta[OF assms(1) assms(2)])
   also have "... \<longleftrightarrow> delayed_safe_distance.collision {0 ..}" by (simp add: translate_collision_range[OF assms(1) assms(2)])
   also have "... \<longleftrightarrow>  (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> other.s \<delta> -  ego.q \<delta> \<le> delayed_safe_distance.snd_safe_distance \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
     by (rule delayed_cond3'[OF assms(3) assms(2)])
   finally show "collision_react {0 ..} \<longleftrightarrow>  (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> other.s \<delta> -  ego.q \<delta> \<le> delayed_safe_distance.snd_safe_distance \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
     by auto
 qed
 
 lemma sd_2r_correct_for_3r_2:
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_2r"
   assumes "other.s \<delta> \<le> u_max"
   assumes "\<not> (a\<^sub>o > a\<^sub>e \<and> other.s' \<delta> < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * other.s' \<delta> < 0)"
   shows "no_collision_react {0..}"
 proof -
   from assms have "s\<^sub>o - s\<^sub>e > v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o" unfolding safe_distance_2r_def by auto
   hence "s\<^sub>o - v\<^sub>o\<^sup>2 / 2 / a\<^sub>o > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e" by auto
   hence "s\<^sub>o - v\<^sub>o\<^sup>2 / a\<^sub>o + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e" by auto
   hence "s\<^sub>o + v\<^sub>o * (- v\<^sub>o / a\<^sub>o) + 1/2 * a\<^sub>o * (-v\<^sub>o / a\<^sub>o)\<^sup>2 > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e"
     using other.p_def other.p_max_def other.p_max_eq other.t_stop_def by auto
   hence "other.s_stop > u_max" unfolding other.s_def using u_max_eq other.t_stop_def
     using ego.q_def other.p_def other.p_max_def other.s_def other.s_t_stop by auto
   thus ?thesis
     using assms(2) assms(3) collision_after_delta cond_1r delayed_cond3' translate_collision_range by linarith
 qed
 
 lemma sd2_at_most_sd4:
   assumes "a\<^sub>o > a\<^sub>e"
   shows "safe_distance_2r \<le> safe_distance_4r"
 proof -
   have "a\<^sub>o \<noteq> 0" and "a\<^sub>e \<noteq> 0" and "a\<^sub>o - a\<^sub>e \<noteq> 0" and "0 < 2 * (a\<^sub>o - a\<^sub>e)" using hyps assms(1) by auto
   have "0 \<le> (- v\<^sub>e * a\<^sub>o + v\<^sub>o * a\<^sub>e + a\<^sub>o * a\<^sub>e * \<delta>) * (- v\<^sub>e * a\<^sub>o + v\<^sub>o * a\<^sub>e + a\<^sub>o * a\<^sub>e * \<delta>)"
     (is "0 \<le> (?l1 + ?l2 + ?l3) * ?r") by auto
   also have "... = v\<^sub>e\<^sup>2 * a\<^sub>o\<^sup>2 + v\<^sub>o\<^sup>2 * a\<^sub>e\<^sup>2 + a\<^sub>o\<^sup>2 * a\<^sub>e\<^sup>2 * \<delta>\<^sup>2 - 2 * v\<^sub>e * a\<^sub>o * v\<^sub>o * a\<^sub>e - 2 * a\<^sub>o\<^sup>2 * a\<^sub>e * \<delta> * v\<^sub>e + 2 * a\<^sub>o * a\<^sub>e\<^sup>2 * \<delta> * v\<^sub>o"
     (is "?lhs = ?rhs")
     by (auto simp add:algebra_simps power_def)
   finally have "0 \<le> ?rhs" by auto
   hence "(- v\<^sub>e\<^sup>2 * a\<^sub>o / a\<^sub>e - v\<^sub>o\<^sup>2 * a\<^sub>e / a\<^sub>o) * (a\<^sub>o * a\<^sub>e) \<le> (a\<^sub>o * a\<^sub>e * \<delta>\<^sup>2 - 2 * v\<^sub>e * v\<^sub>o - 2 * a\<^sub>o * \<delta> * v\<^sub>e + 2 * a\<^sub>e * \<delta> * v\<^sub>o) * (a\<^sub>o * a\<^sub>e)"
     by (auto simp add: algebra_simps power_def)
   hence "2 * v\<^sub>e * \<delta> * (a\<^sub>o - a\<^sub>e) - v\<^sub>e\<^sup>2 * a\<^sub>o / a\<^sub>e + v\<^sub>e\<^sup>2 + v\<^sub>o\<^sup>2 - v\<^sub>o\<^sup>2 * a\<^sub>e / a\<^sub>o \<le> v\<^sub>o\<^sup>2 + a\<^sub>o\<^sup>2 * \<delta>\<^sup>2 + v\<^sub>e\<^sup>2 + 2 * v\<^sub>o * \<delta> * a\<^sub>o - 2 * v\<^sub>e * v\<^sub>o - 2 * a\<^sub>o * \<delta> * v\<^sub>e - 2 * v\<^sub>o * \<delta> * a\<^sub>o + 2 * a\<^sub>e * \<delta> * v\<^sub>o - a\<^sub>o\<^sup>2 * \<delta>\<^sup>2 + a\<^sub>o * a\<^sub>e * \<delta>\<^sup>2 + 2 * v\<^sub>e * \<delta> * (a\<^sub>o - a\<^sub>e)"
     by (auto simp add: ego2.decel other.decel)
   hence "2 * v\<^sub>e * \<delta> * (a\<^sub>o - a\<^sub>e) - v\<^sub>e\<^sup>2 * a\<^sub>o / a\<^sub>e + v\<^sub>e\<^sup>2 + v\<^sub>o\<^sup>2 - v\<^sub>o\<^sup>2 * a\<^sub>e / a\<^sub>o \<le> (v\<^sub>o + \<delta> * a\<^sub>o - v\<^sub>e)\<^sup>2 - 2 * v\<^sub>o * \<delta> * a\<^sub>o + 2 * a\<^sub>e * \<delta> * v\<^sub>o - a\<^sub>o\<^sup>2 * \<delta>\<^sup>2 + a\<^sub>o * a\<^sub>e * \<delta>\<^sup>2 + 2 * v\<^sub>e * \<delta> * (a\<^sub>o - a\<^sub>e)"
     by (auto simp add: algebra_simps power_def)
   hence "v\<^sub>e * \<delta> * 2 * (a\<^sub>o - a\<^sub>e) - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e * 2 * a\<^sub>o + v\<^sub>e\<^sup>2 / 2 / a\<^sub>e * 2 * a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o * 2 * a\<^sub>o - v\<^sub>o\<^sup>2 / 2 / a\<^sub>o * 2 * a\<^sub>e \<le> (v\<^sub>o + \<delta> * a\<^sub>o - v\<^sub>e)\<^sup>2 - v\<^sub>o * \<delta> * 2 * a\<^sub>o - v\<^sub>o * \<delta> * 2 * -a\<^sub>e - a\<^sub>o * \<delta>\<^sup>2 / 2 * 2 * a\<^sub>o - a\<^sub>o * \<delta>\<^sup>2 / 2 * 2 * -a\<^sub>e + v\<^sub>e * \<delta> * 2 * (a\<^sub>o - a\<^sub>e)"
     (is "?lhs1 \<le> ?rhs1")
     by (simp add: \<open>a\<^sub>o \<noteq> 0\<close> \<open>a\<^sub>e \<noteq> 0\<close> power2_eq_square algebra_simps)
   hence "v\<^sub>e * \<delta> * 2 * (a\<^sub>o - a\<^sub>e) - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e * 2 * (a\<^sub>o - a\<^sub>e) + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o * 2 * (a\<^sub>o - a\<^sub>e) \<le> (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) * 2 * (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> * 2 * (a\<^sub>o - a\<^sub>e) - a\<^sub>o * \<delta>\<^sup>2 / 2 * 2 * (a\<^sub>o - a\<^sub>e) + v\<^sub>e * \<delta> * 2 *(a\<^sub>o - a\<^sub>e)"
     (is "?lhs2 \<le> ?rhs2")
   proof -
     assume "?lhs1 \<le> ?rhs1"
     have "?lhs1 = ?lhs2" by (auto simp add:field_simps)
     moreover
     have "?rhs1 = ?rhs2" using `a\<^sub>o - a\<^sub>e \<noteq> 0` by (auto simp add:field_simps)
     ultimately show ?thesis using `?lhs1 \<le> ?rhs1` by auto
   qed
   hence "(v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o) * 2 * (a\<^sub>o - a\<^sub>e) \<le> ((v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 + v\<^sub>e * \<delta>) * 2 *(a\<^sub>o - a\<^sub>e)"
     by (simp add: algebra_simps)
   hence "v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o \<le> (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 + v\<^sub>e * \<delta>"
-    using \<open>a\<^sub>o > a\<^sub>e\<close> real_mult_le_cancel_iff1[OF `0 < 2 * (a\<^sub>o - a\<^sub>e)`, of "(v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o)"
+    using \<open>a\<^sub>o > a\<^sub>e\<close> mult_le_cancel_iff1[OF `0 < 2 * (a\<^sub>o - a\<^sub>e)`, of "(v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o)"
     "(v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 + v\<^sub>e * \<delta>"] semiring_normalization_rules(18)
     by (metis (no_types, lifting))
   thus ?thesis using safe_distance_2r_def safe_distance_4r_def by auto
 qed
 
 lemma sd_4r_correct:
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_4r"
   assumes "other.s \<delta> \<le> u_max"
   assumes "\<delta> \<le> other.t_stop"
   assumes "a\<^sub>o > a\<^sub>e"
   shows "no_collision_react {0..}"
 proof -
   from assms have "s\<^sub>o - s\<^sub>e > (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 + v\<^sub>e * \<delta>"
     unfolding safe_distance_4r_def by auto
   hence "s\<^sub>o + v\<^sub>o * \<delta> + 1/2 * a\<^sub>o * \<delta>\<^sup>2 - s\<^sub>e - v\<^sub>e * \<delta> > (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e)" by linarith
   hence "other.s \<delta> -  ego.q \<delta> > (other.s' \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e)"
     using assms(3) ego.q_def other.p_def other.s_def other.p'_def other.s'_def pos_react by auto
   hence "other.s \<delta> -  ego.q \<delta> > delayed_safe_distance.snd_safe_distance"
     by (simp add: delayed_safe_distance.snd_safe_distance_def)
   hence c: "\<not> (other.s \<delta> -  ego.q \<delta> \<le> delayed_safe_distance.snd_safe_distance)" by linarith
   have "u_max < other.s_stop"
     unfolding u_max_eq other.s_t_stop other.p_max_eq ego.q_def using assms(1) sd2_at_most_sd4[OF assms(4)]
     unfolding safe_distance_4r_def safe_distance_2r_def by auto
   consider "s\<^sub>o \<le> u_max" | "s\<^sub>o > u_max" by linarith
   thus ?thesis
   proof (cases)
     case 1
     from cond_3r_2[OF this `u_max < other.s_stop` assms(2)]  show ?thesis
       using c by auto
   next
     case 2
     then show ?thesis using cond_1r by auto
   qed
 qed
 
 text \<open>Irrelevant, this Safe Distance is unreachable in the checker.\<close>
 definition safe_distance_5r :: real where 
   "safe_distance_5r = v\<^sub>e\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o + v\<^sub>e * \<delta>"
 
 lemma sd_5r_correct:
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_5r"
   assumes "u_max < other.s_stop"
   assumes "other.s \<delta> \<le> u_max"
   assumes "\<delta> > other.t_stop"
   shows "no_collision_react {0..}"
 proof -
   from assms have "s\<^sub>o - s\<^sub>e > v\<^sub>e\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o + v\<^sub>e * \<delta>"
     unfolding safe_distance_5r_def by auto
   hence "s\<^sub>o + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o - s\<^sub>e - v\<^sub>e * \<delta> > (0 - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e)"
     using assms(2-4) unfolding other.s_def other.s_t_stop
     apply (auto simp: movement.p_t_stop split: if_splits)
     using cond_1r cond_2r other.s_t_stop by linarith+
   hence "other.s \<delta> -  ego.q \<delta> > (other.s' \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e)"
     using assms(2) assms(3) assms(4) other.s_def other.s_t_stop by auto
   hence "other.s \<delta> -  ego.q \<delta> > delayed_safe_distance.snd_safe_distance"
     by (simp add: delayed_safe_distance.snd_safe_distance_def)
   hence "\<not> (other.s \<delta> -  ego.q \<delta> \<le> delayed_safe_distance.snd_safe_distance)" by linarith
   thus ?thesis using assms(2) assms(3) cond_1r cond_3r_2 by linarith
 qed
 
 lemma translate_no_collision_range:
   "delayed_safe_distance.no_collision {0 ..} \<longleftrightarrow> no_collision_react {\<delta> ..}"  
 proof
   assume left: "delayed_safe_distance.no_collision {0 ..}" 
   show "no_collision_react {\<delta> ..}" 
   proof (unfold collision_react_def; simp; rule ballI)
     fix t::real  
     assume "t \<in> {\<delta> ..}"
     hence "\<delta> \<le> t" by simp
     with pos_react have "0 \<le> t - \<delta>" by simp
     with left have ineq: "ego2.s (t - \<delta>) \<noteq> delayed_safe_distance.other.s (t - \<delta>)"
       unfolding delayed_safe_distance.collision_def by auto
     have "ego2.s (t - \<delta>) = (ego2.s \<circ> \<tau>) t" unfolding comp_def \<tau>_def by auto
     also have "... = u t" unfolding u_def using \<open>\<delta> \<le> t\<close> pos_react 
       by (auto simp: \<tau>_def ego2.init_s)
     finally have "ego2.s (t - \<delta>) = u t" by auto
 
     moreover have "delayed_safe_distance.other.s (t - \<delta>) = other.s t"
       using delayed_other_s_eq pos_react \<open>\<delta> \<le> t\<close> by auto
   
     ultimately show "u t \<noteq> other.s t" using ineq by auto
   qed
 next
   assume right: "no_collision_react {\<delta> ..}"
   show "delayed_safe_distance.no_collision {0 ..}"
   proof (unfold delayed_safe_distance.collision_def; simp; rule ballI)
     fix t ::real
     assume "t \<in> {0 ..}"
     hence "0 \<le> t" by auto
     hence "\<delta> \<le> t + \<delta>" by auto
     with right have ineq: "u (t + \<delta>) \<noteq> other.s (t + \<delta>)" unfolding collision_react_def by auto
             
     have "u (t + \<delta>) = ego2.s t" unfolding u_def comp_def \<tau>_def 
       using \<open>0 \<le> t\<close> pos_react \<open>\<delta> \<le> t+ \<delta>\<close> by (auto simp add:ego2.init_s)
     moreover have "other.s (t + \<delta>) = delayed_safe_distance.other.s t"
       using delayed_other_s_eq[of t] using \<open>0 \<le> t\<close> by auto
     ultimately show "ego2.s t \<noteq> delayed_safe_distance.other.s t" using ineq by auto
   qed
 qed
 
 lemma delayed_cond1:
   assumes "other.s \<delta> > u_max"
   shows "delayed_safe_distance.no_collision {0 ..}"
 proof -
   have "ego2.s_stop = u_max"  unfolding ego2.s_t_stop ego2.p_max_eq u_max_eq by auto
   also have "... < other.s \<delta>" using assms by simp
   finally have "ego2.s_stop < other.s \<delta>" by auto
   thus "delayed_safe_distance.no_collision {0 ..}" by (simp add: delayed_safe_distance.cond_1)
 qed
 
 theorem cond_3r_3:
   assumes "s\<^sub>o \<le> u_max"
   assumes "u_max < other.s_stop"
   assumes "other.s \<delta> > u_max"
   shows "no_collision_react {0 ..}"
 proof -
   have eq: "{0 ..} = {0 .. \<delta>} \<union> {\<delta> ..}" using pos_react by auto
   show ?thesis unfolding eq 
   proof (intro no_collision_union)
     show "no_collision_react {0 .. \<delta>}" by (rule no_collision_react_initially[OF assms(1) assms(2)])  
   next
     have "delayed_safe_distance.no_collision {0 ..}" by (rule delayed_cond1[OF assms(3)])
     with translate_no_collision_range show "no_collision_react {\<delta> ..}" by auto
   qed
 qed
 
 lemma sd_2r_correct_for_3r_3:
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_2r"
   assumes "other.s \<delta> > u_max"
   shows "no_collision_react {0..}"
 proof -
   from assms have "s\<^sub>o - s\<^sub>e > v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o" unfolding safe_distance_2r_def by auto
   hence "s\<^sub>o - v\<^sub>o\<^sup>2 / 2 / a\<^sub>o > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e" by auto
   hence "s\<^sub>o - v\<^sub>o\<^sup>2 / a\<^sub>o + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e" by auto
   hence "s\<^sub>o + v\<^sub>o * (- v\<^sub>o / a\<^sub>o) + 1/2 * a\<^sub>o * (-v\<^sub>o / a\<^sub>o)\<^sup>2 > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e"
     using other.p_def other.p_max_def other.p_max_eq other.t_stop_def by auto
   hence "other.s_stop > u_max" unfolding other.s_def using u_max_eq other.t_stop_def
     using ego.q_def other.p_def other.p_max_def other.s_def other.s_t_stop by auto
   thus ?thesis
     using assms(2) cond_1r cond_3r_3 by linarith
 qed
 
 lemma sd_3r_correct:
   assumes "s\<^sub>o - s\<^sub>e > safe_distance_3r"
   assumes "\<delta> \<le> other.t_stop"
   shows "no_collision_react {0 ..}"
 proof -
   from assms have "s\<^sub>o - s\<^sub>e > v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e - v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2" unfolding safe_distance_3r_def by auto
   hence "s\<^sub>o + v\<^sub>o * \<delta> + 1/2 * a\<^sub>o * \<delta>\<^sup>2 > s\<^sub>e + v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e" by auto
   hence "other.s \<delta> > u_max" using other.s_def u_max_eq assms(2) ego.q_def other.p_def pos_react by auto
   thus ?thesis using cond_1r cond_3r_3 delayed_other_s_stop_eq delayed_safe_distance.other.s0_le_s_stop by linarith
 qed
 
 lemma sd_2_at_least_sd_3:
   assumes "\<delta> \<le> other.t_stop"
   shows "safe_distance_3r \<ge> safe_distance_2r"
 proof -
   from assms have "\<delta> = other.t_stop \<or> \<delta> < other.t_stop" by auto
   then have "safe_distance_3r = safe_distance_2r \<or> safe_distance_3r > safe_distance_2r"
   proof (rule Meson.disj_forward)
       assume "\<delta> = other.t_stop"
       hence "\<delta> = - v\<^sub>o / a\<^sub>o" unfolding other.t_stop_def by auto
       hence "- v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 = - v\<^sub>o  * other.t_stop - 1/2 * a\<^sub>o * other.t_stop\<^sup>2" by (simp add: movement.t_stop_def)
       thus "safe_distance_3r = safe_distance_2r"
         using other.p_def other.p_max_def other.p_max_eq safe_distance_2r_def safe_distance_3r_def by auto
     next
       assume "\<delta> < other.t_stop"
       hence "\<delta> < - v\<^sub>o / a\<^sub>o" unfolding other.t_stop_def by auto
       hence "0 < v\<^sub>o + a\<^sub>o * \<delta>"
         using other.decel other.p'_def other.p'_pos_iff by auto
       hence "0 < v\<^sub>o + 1/2 * a\<^sub>o * (\<delta> + other.t_stop)" by (auto simp add:field_simps other.t_stop_def)
       hence "0 > v\<^sub>o * (\<delta> - other.t_stop) + 1/2 * a\<^sub>o * (\<delta> + other.t_stop) * (\<delta> - other.t_stop)"
         using `\<delta> < other.t_stop`  mult_less_cancel_left_neg[where c="\<delta> - other.t_stop" and a ="v\<^sub>o + 1 / 2 * a\<^sub>o * (\<delta> + other.t_stop)" and b="0"]
         by (auto simp add: field_simps)
       hence " (\<delta> + other.t_stop) * (\<delta> - other.t_stop) = (\<delta>\<^sup>2 - other.t_stop\<^sup>2)"
         by (simp add: power2_eq_square square_diff_square_factored)
       hence "0 > v\<^sub>o * (\<delta> - other.t_stop) + 1/2 * a\<^sub>o * (\<delta>\<^sup>2 - other.t_stop\<^sup>2)"
         by (metis (no_types, hide_lams) \<open>v\<^sub>o * (\<delta> - other.t_stop) + 1 / 2 * a\<^sub>o * (\<delta> + other.t_stop) * (\<delta> - other.t_stop) < 0\<close> divide_divide_eq_left divide_divide_eq_right times_divide_eq_left)
       hence "0 > v\<^sub>o * \<delta> - v\<^sub>o * other.t_stop  + 1/2 * a\<^sub>o * \<delta>\<^sup>2 -  1/2 * a\<^sub>o * other.t_stop\<^sup>2 "
         by (simp add: right_diff_distrib)
       hence "- v\<^sub>o * \<delta> - 1/2 * a\<^sub>o * \<delta>\<^sup>2 > - v\<^sub>o  * (- v\<^sub>o / a\<^sub>o) - 1/2 * a\<^sub>o * (- v\<^sub>o / a\<^sub>o)\<^sup>2"
         unfolding movement.t_stop_def by argo
       thus "safe_distance_3r > safe_distance_2r"
         using other.p_def other.p_max_def other.p_max_eq other.t_stop_def safe_distance_2r_def safe_distance_3r_def by auto
   qed
   thus ?thesis by auto
 qed
 end
 
 subsection \<open>Checker Design\<close>
 
 text \<open>
   We define two checkers for different cases: 
   \<^item> one checker for the case that \<open>\<delta> \<le> other.t_stop (other.t_stop = - v\<^sub>o / a\<^sub>o)\<close>
   \<^item> a second checker for the case that \<open>\<delta> > other.t_stop\<close>
 \<close>
 
 definition check_precond_r1 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> s\<^sub>o > s\<^sub>e \<and> 0 \<le> v\<^sub>e \<and> 0 \<le> v\<^sub>o \<and> a\<^sub>e < 0 \<and> a\<^sub>o < 0 \<and> 0 < \<delta> \<and> \<delta> \<le> - v\<^sub>o / a\<^sub>o"
 
 definition safe_distance0 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where 
   "safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = v\<^sub>e * \<delta> - v\<^sub>o * \<delta> - a\<^sub>o * \<delta>\<^sup>2 / 2"
 
 definition safe_distance_1r :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where 
   "safe_distance_1r a\<^sub>e v\<^sub>e \<delta> = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / a\<^sub>e / 2"
 
 definition safe_distance_2r :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where 
   "safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e + v\<^sub>o\<^sup>2 / 2 / a\<^sub>o"
 
 definition safe_distance_4r :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where
   "safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = (v\<^sub>o + a\<^sub>o * \<delta> - v\<^sub>e)\<^sup>2 / 2 / (a\<^sub>o - a\<^sub>e) - v\<^sub>o * \<delta> - 1 / 2 * a\<^sub>o * \<delta>\<^sup>2 + v\<^sub>e * \<delta>"
 
 definition safe_distance_3r :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where 
   "safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = v\<^sub>e * \<delta> - v\<^sub>e\<^sup>2 / 2 / a\<^sub>e - v\<^sub>o * \<delta> - 1 / 2 * a\<^sub>o * \<delta>\<^sup>2"
 
 definition checker_r1 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<equiv> 
     let distance      = s\<^sub>o - s\<^sub>e;
 				precond       = check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>;
         vo_star       = v\<^sub>o + a\<^sub>o * \<delta>;
         t_stop_o_star = - vo_star / a\<^sub>o;
         t_stop_e      = - v\<^sub>e / a\<^sub>e;
         safe_dist0    = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>;
         safe_dist1    = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>;
         safe_dist2    = safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>;
         safe_dist3    = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>
     in
       if \<not> precond then False
       else if distance > safe_dist0 \<or> distance > safe_dist3 then True
       else if (a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star) then distance > safe_dist2
       else distance > safe_dist1"
 
 theorem checker_r1_correctness:
   "(checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> 
    safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})"
 proof
   assume asm: "checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
   have pre: "check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
   proof (rule ccontr)
     assume "\<not> check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
     with asm show "False" unfolding checker_r1_def Let_def by auto
   qed
   from pre have sdn': "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>"
     by (unfold_locales) (auto simp add: check_precond_r1_def)
   interpret sdn: safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
     rewrites "sdn.distance0 = safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
              "sdn.safe_distance_1r = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>" and
              "sdn.safe_distance_2r = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
              "sdn.safe_distance_4r = safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
              "sdn.safe_distance_3r = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   proof -
     from sdn' show "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>" by auto
   next
     show "safe_distance_normal.distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> "
       unfolding safe_distance_normal.distance0_def[OF sdn'] safe_distance0_def by auto
   next
     show "safe_distance_normal.safe_distance_1r a\<^sub>e v\<^sub>e \<delta> = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
       unfolding safe_distance_normal.safe_distance_1r_def[OF sdn'] safe_distance_1r_def by auto
   next
     show "safe_distance_normal.safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
       unfolding safe_distance_normal.safe_distance_2r_def[OF sdn'] safe_distance_2r_def by auto
   next
     show "safe_distance_normal.safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> "
       unfolding safe_distance_normal.safe_distance_4r_def[OF sdn'] safe_distance_4r_def by auto
   next
     show "safe_distance_normal.safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
       unfolding safe_distance_normal.safe_distance_3r_def[OF sdn'] safe_distance_3r_def by auto
   qed
   have "0 < \<delta>" and "\<delta> \<le> - v\<^sub>o / a\<^sub>o" using pre unfolding check_precond_r1_def by auto
   define so_delta where "so_delta = s\<^sub>o + v\<^sub>o * \<delta> + a\<^sub>o * \<delta>\<^sup>2 / 2"
   define q_e_delta where "q_e_delta \<equiv> s\<^sub>e + v\<^sub>e * \<delta>"
   define u_stop_e where "u_stop_e \<equiv> q_e_delta - v\<^sub>e\<^sup>2 / (2 * a\<^sub>e)"
   define vo_star where "vo_star = v\<^sub>o + a\<^sub>o * \<delta>"
   define t_stop_o_star where "t_stop_o_star \<equiv> - vo_star / a\<^sub>o"
   define t_stop_e where "t_stop_e = - v\<^sub>e / a\<^sub>e"
   define distance where "distance \<equiv> s\<^sub>o - s\<^sub>e"
   define distance0 where "distance0 = safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   define safe_dist0 where "safe_dist0 = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
   define safe_dist2 where "safe_dist2 \<equiv> safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   define safe_dist1 where "safe_dist1 \<equiv> safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   define safe_dist3 where "safe_dist3 = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   note abb = so_delta_def q_e_delta_def u_stop_e_def vo_star_def t_stop_o_star_def t_stop_e_def
              distance_def safe_dist2_def safe_dist1_def safe_dist0_def safe_dist3_def distance0_def
   consider "distance > safe_dist0" | "distance > safe_dist3" | "distance \<le> safe_dist0 \<and> distance \<le> safe_dist3"
     by linarith
   hence "sdn.no_collision_react {0..}"
   proof (cases)
     case 1
     then show ?thesis using sdn.sd_1r_correct unfolding  abb by auto
   next
     case 2
     hence pre2: "distance > distance0" using sdn.distance0_at_most_sd3r unfolding abb by auto
     hence "sdn.u \<delta> < sdn.other.s \<delta>" using pre unfolding sdn.u_def sdn.ego.q_def
       sdn.other.s_def sdn.other.t_stop_def sdn.other.p_def abb check_precond_r1_def sdn.distance0_def
       by auto
     from pre interpret sdr: safe_distance_no_collsion_delta a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
       by (unfold_locales) (auto simp add:check_precond_r1_def `sdn.u \<delta> < sdn.other.s \<delta>`)
     show ?thesis using sdr.sd_3r_correct 2 pre unfolding check_precond_r1_def abb sdn.other.t_stop_def
       by auto
   next
     case 3
     hence "distance \<le> safe_dist3" by auto
     hence "sdn.other.s \<delta> \<le> sdn.u_max" using pre unfolding check_precond_r1_def sdn.other.s_def sdn.other.t_stop_def
       sdn.other.p_def sdn.u_max_eq sdn.ego.q_def abb sdn.safe_distance_3r_def by auto
     have " (a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star) \<or> \<not>  (a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star) "
       by auto
     moreover
     { assume cond: "(a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star)"
       with 3 pre have "distance > safe_dist2" using asm unfolding checker_r1_def
           Let_def abb by auto
       with sdn.distance0_at_most_sd4r have "distance > distance0" unfolding abb using cond by auto
       hence "sdn.u \<delta> < sdn.other.s \<delta>" using pre unfolding sdn.u_def sdn.ego.q_def
           sdn.other.s_def sdn.other.t_stop_def sdn.other.p_def abb check_precond_r1_def sdn.distance0_def
         by auto
       from pre interpret sdr: safe_distance_no_collsion_delta a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
         by (unfold_locales) (auto simp add:check_precond_r1_def `sdn.u \<delta> < sdn.other.s \<delta>`)
       from sdr.sd_4r_correct[OF _ `sdn.other.s \<delta> \<le> sdn.u_max`] `distance > safe_dist2`
         have ?thesis using pre cond  unfolding check_precond_r1_def sdn.other.t_stop_def abb by auto }
     moreover
     { assume not_cond: "\<not>  (a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star)"
       with 3 pre have "distance > safe_dist1" using asm unfolding checker_r1_def
         Let_def abb by auto
       with sdn.dist0_sd2r_1 have "distance > distance0" using pre not_cond unfolding check_precond_r1_def
         sdn.other.t_stop_def sdn.other.s'_def sdn.other.p'_def abb by (auto simp add:field_simps)
       hence "sdn.u \<delta> < sdn.other.s \<delta>" using pre unfolding sdn.u_def sdn.ego.q_def
           sdn.other.s_def sdn.other.t_stop_def sdn.other.p_def abb check_precond_r1_def sdn.distance0_def
         by auto
       from pre interpret sdr: safe_distance_no_collsion_delta a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
         by (unfold_locales) (auto simp add:check_precond_r1_def `sdn.u \<delta> < sdn.other.s \<delta>`)
       from sdr.sd_2r_correct_for_3r_2[OF _ `sdn.other.s \<delta> \<le> sdn.u_max`] not_cond `distance > safe_dist1`
         have ?thesis using pre unfolding abb sdn.other.s'_def check_precond_r1_def sdn.other.t_stop_def sdn.other.p'_def
         by (auto simp add:field_simps) }
     ultimately show ?thesis by auto
   qed
   with pre show " check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> sdn.no_collision_react {0..}" by auto
 next
   assume "check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..}"
   hence pre: "check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>" and as2: "safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..}"
   by auto
   show "checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> "
   proof (rule ccontr)
     assume as1: "\<not> checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
     from pre have "0 < \<delta>" and "\<delta> \<le> - v\<^sub>o / a\<^sub>o" unfolding check_precond_r1_def by auto
     define so_delta where "so_delta = s\<^sub>o + v\<^sub>o * \<delta> + a\<^sub>o * \<delta>\<^sup>2 / 2"
     define q_e_delta where "q_e_delta \<equiv> s\<^sub>e + v\<^sub>e * \<delta>"
     define u_stop_e where "u_stop_e \<equiv> q_e_delta - v\<^sub>e\<^sup>2 / (2 * a\<^sub>e)"
     define vo_star where "vo_star \<equiv> v\<^sub>o + a\<^sub>o * \<delta>"
     define t_stop_o_star where "t_stop_o_star \<equiv> - vo_star / a\<^sub>o"
     define t_stop_e where "t_stop_e \<equiv> - v\<^sub>e / a\<^sub>e"
     define distance where "distance \<equiv> s\<^sub>o - s\<^sub>e"
     define distance0 where "distance0 \<equiv> safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     define safe_dist0 where "safe_dist0 \<equiv> safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
     define safe_dist2 where "safe_dist2 \<equiv> safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     define safe_dist1 where "safe_dist1 \<equiv> safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     define safe_dist3 where "safe_dist3 \<equiv> safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     note abb = so_delta_def q_e_delta_def u_stop_e_def vo_star_def t_stop_o_star_def t_stop_e_def
                distance_def safe_dist2_def safe_dist1_def safe_dist0_def safe_dist3_def distance0_def
     from pre have sdn': "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>"
       by (unfold_locales) (auto simp add: check_precond_r1_def)
     interpret sdn: safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
       rewrites "sdn.distance0 = safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
                "sdn.safe_distance_1r = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>" and
                "sdn.safe_distance_2r = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
                "sdn.safe_distance_4r = safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
                "sdn.safe_distance_3r = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     proof -
       from sdn' show "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>" by auto
     next
       show "safe_distance_normal.distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance0 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> "
         unfolding safe_distance_normal.distance0_def[OF sdn'] safe_distance0_def by auto
     next
       show "safe_distance_normal.safe_distance_1r a\<^sub>e v\<^sub>e \<delta> = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
         unfolding safe_distance_normal.safe_distance_1r_def[OF sdn'] safe_distance_1r_def by auto
     next
       show "safe_distance_normal.safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
         unfolding safe_distance_normal.safe_distance_2r_def[OF sdn'] safe_distance_2r_def by auto
     next
       show "safe_distance_normal.safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> "
         unfolding safe_distance_normal.safe_distance_4r_def[OF sdn'] safe_distance_4r_def by auto
     next
       show "safe_distance_normal.safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
         unfolding safe_distance_normal.safe_distance_3r_def[OF sdn'] safe_distance_3r_def by auto
     qed
     have "\<not> distance > distance0 \<or>  distance > distance0" by auto
     moreover
     { assume "\<not> distance > distance0"
       hence "distance \<le> distance0" by auto
       with sdn.cond_3r_1' have "sdn.collision_react {0..\<delta>}" using pre unfolding check_precond_r1_def abb
         sdn.other.t_stop_def by auto
       with sdn.collision_react_subset have "sdn.collision_react {0..}" by auto
       with as2 have "False" by auto }
     moreover
     { assume if2: "distance > distance0"
       have "\<not> (distance > safe_dist0 \<or> distance > safe_dist3)"
       proof (rule ccontr)
         assume "\<not> \<not> (safe_dist0 < distance \<or> safe_dist3 < distance)"
         hence "(safe_dist0 < distance \<or> safe_dist3 < distance)" by auto
         with as1 show "False" using pre if2 unfolding checker_r1_def Let_def abb
           by auto
       qed
       hence if31: "distance \<le> safe_dist0" and if32: "distance \<le> safe_dist3" by auto
       have "sdn.u \<delta> < sdn.other.s \<delta>" using if2 pre unfolding sdn.u_def sdn.ego.q_def
           sdn.other.s_def sdn.other.t_stop_def sdn.other.p_def abb check_precond_r1_def sdn.distance0_def
           by auto
       from pre interpret sdr: safe_distance_no_collsion_delta a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
         by (unfold_locales) (auto simp add:check_precond_r1_def `sdn.u \<delta> < sdn.other.s \<delta>`)
       have " s\<^sub>o \<le> sdn.u_max" using if31 unfolding sdn.u_max_eq sdn.ego.q_def abb
         sdn.safe_distance_1r_def by auto
       have "sdn.other.s \<delta> \<le> sdn.u_max" using if32 pre unfolding sdn.other.s_def check_precond_r1_def
         sdn.other.t_stop_def sdn.other.p_def sdn.u_max_eq sdn.ego.q_def abb sdn.safe_distance_3r_def
         by auto
       consider "(a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star)" |
                "\<not> (a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star)" by auto
       hence "False"
       proof (cases)
         case 1
         hence rest_conjunct:"(a\<^sub>e < a\<^sub>o \<and> sdn.other.s' \<delta> < v\<^sub>e \<and> v\<^sub>e - a\<^sub>e / a\<^sub>o * sdn.other.s' \<delta> < 0)"
           using pre unfolding check_precond_r1_def unfolding sdn.other.s'_def sdn.other.t_stop_def
           sdn.other.p'_def abb by (auto simp add:field_simps)
         from 1 have "distance \<le> safe_dist2" using as1 pre if2 if31 if32 unfolding checker_r1_def
           Let_def abb by auto
         hence cond_f: "sdn.other.s \<delta> - sdn.ego.q \<delta> \<le> sdr.delayed_safe_distance.snd_safe_distance"
           using pre unfolding check_precond_r1_def sdn.other.s_def sdn.other.t_stop_def sdn.other.p_def
           sdn.ego.q_def sdr.delayed_safe_distance.snd_safe_distance_def using sdn.other.s'_def[of "\<delta>"]
           unfolding sdn.other.t_stop_def sdn.other.p'_def abb sdn.safe_distance_4r_def
           by auto
         have "distance > safe_dist1 \<or> distance \<le> safe_dist1" by auto
         moreover
         { assume "distance > safe_dist1"
           hence "sdn.u_max < sdn.other.s_stop" unfolding sdn.u_max_eq sdn.ego.q_def sdn.other.s_t_stop
               sdn.other.p_max_eq abb sdn.safe_distance_2r_def by (auto simp add:field_simps)
           from sdr.cond_3r_2[OF `s\<^sub>o \<le> sdn.u_max` this `sdn.other.s \<delta> \<le> sdn.u_max`]
           have "sdn.collision_react {0..}" using cond_f rest_conjunct by auto
           with as2 have "False" by auto }
         moreover
         { assume "distance \<le> safe_dist1"
           hence "sdn.u_max \<ge> sdn.other.s_stop" unfolding sdn.u_max_eq sdn.ego.q_def sdn.other.s_t_stop
               sdn.other.p_max_eq abb sdn.safe_distance_2r_def by (auto simp add:field_simps)
           with sdn.cond_2r[OF this] have "sdn.collision_react {0..}" by auto
           with as2 have "False" by auto }
         ultimately show ?thesis by auto
       next
         case 2
         hence "distance \<le> safe_dist1" using as1 pre if2 if31 if32 unfolding checker_r1_def
           Let_def abb by auto
         hence "sdn.u_max \<ge> sdn.other.s_stop" unfolding sdn.u_max_eq sdn.ego.q_def sdn.other.s_t_stop
           sdn.other.p_max_eq abb sdn.safe_distance_2r_def by (auto simp add:field_simps)
         with sdn.cond_2r[OF this] have "sdn.collision_react {0..}" by auto
         with as2 show "False" by auto
       qed }
     ultimately show "False" by auto
   qed
 qed
 
 definition check_precond_r2 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where 
   "check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> s\<^sub>o > s\<^sub>e \<and> 0 \<le> v\<^sub>e \<and> 0 \<le> v\<^sub>o \<and> a\<^sub>e < 0 \<and> a\<^sub>o < 0 \<and> 0 < \<delta> \<and> \<delta> > - v\<^sub>o / a\<^sub>o"
 
 definition safe_distance0_2 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" where 
   "safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = v\<^sub>e * \<delta> + 1 / 2 * v\<^sub>o\<^sup>2 / a\<^sub>o"
 
 definition checker_r2 :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<equiv> 
     let distance   = s\<^sub>o - s\<^sub>e;
 				precond    = check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>;
         safe_dist0 = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>;
         safe_dist1 = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> 
     in
       if \<not> precond then False
       else if distance > safe_dist0 then True
       else distance > safe_dist1"
 
 theorem checker_r2_correctness:
   "(checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> 
     safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})"
 proof
   assume asm: "checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
   have pre: "check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
   proof (rule ccontr)
     assume "\<not> check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
       with asm show "False" unfolding checker_r2_def Let_def by auto
     qed
       from pre have sdn': "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>"
     by (unfold_locales) (auto simp add: check_precond_r2_def)
   interpret sdn: safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
     rewrites "sdn.distance0_2 = safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
              "sdn.safe_distance_1r = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>" and
              "sdn.safe_distance_2r = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   proof -
     from sdn' show "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>" by auto
   next
     show "safe_distance_normal.distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
       unfolding safe_distance_normal.distance0_2_def[OF sdn'] safe_distance0_2_def by auto
   next
     show "safe_distance_normal.safe_distance_1r a\<^sub>e v\<^sub>e \<delta> = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
       unfolding safe_distance_normal.safe_distance_1r_def[OF sdn'] safe_distance_1r_def by auto
   next
     show "safe_distance_normal.safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
       unfolding safe_distance_normal.safe_distance_2r_def[OF sdn'] safe_distance_2r_def by auto
   qed
   have "0 < \<delta>" and "\<delta> > - v\<^sub>o / a\<^sub>o" using pre unfolding check_precond_r2_def by auto
   define distance where "distance \<equiv> s\<^sub>o - s\<^sub>e"
   define distance0_2 where "distance0_2 = safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   define safe_dist0 where "safe_dist0 = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
   define safe_dist1 where "safe_dist1 \<equiv> safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
   note abb = distance_def safe_dist1_def safe_dist0_def distance0_2_def
   consider "distance > safe_dist0" | "distance \<le> safe_dist0"
     by linarith
   hence "sdn.no_collision_react {0..}"
   proof (cases)
     case 1
     then show ?thesis using sdn.sd_1r_correct unfolding abb by auto
   next
     case 2
     hence "(s\<^sub>o \<le> sdn.u_max)" using distance_def safe_dist0_def sdn.sd_1r_eq by linarith
     with 2 pre have "distance > safe_dist1" using asm unfolding checker_r2_def Let_def abb by auto
     with sdn.dist0_sd2r_2 have "distance > distance0_2" using abb \<open>- v\<^sub>o / a\<^sub>o < \<delta>\<close> by auto
     hence "sdn.u \<delta> < sdn.other.s \<delta>" using abb sdn.distance0_2_eq \<open>\<delta> > - v\<^sub>o / a\<^sub>o\<close> sdn.other.t_stop_def by auto
     have "sdn.u_max < sdn.other.s \<delta>" using abb sdn.sd2r_eq  \<open>\<delta> > - v\<^sub>o / a\<^sub>o\<close> sdn.other.t_stop_def `distance > safe_dist1` by auto
     from pre interpret sdr: safe_distance_no_collsion_delta a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
         by (unfold_locales) (auto simp add:check_precond_r2_def `sdn.u \<delta> < sdn.other.s \<delta>`)
     from sdr.sd_2r_correct_for_3r_3[OF] `distance > safe_dist1` `sdn.u \<delta> < sdn.other.s \<delta>` `sdn.u_max < sdn.other.s \<delta>`
        show ?thesis using pre unfolding abb sdn.other.s'_def check_precond_r2_def sdn.other.t_stop_def sdn.other.p'_def
             by (auto simp add:field_simps)
   qed
   with pre show " check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> sdn.no_collision_react {0..}" by auto
 next
   assume "check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..}"
   hence pre: "check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>" and as2: "safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..}"
     by auto
   show "checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
   proof (rule ccontr)
     assume as1: "\<not> checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
     from pre have "0 < \<delta>" and "\<delta> > - v\<^sub>o / a\<^sub>o" unfolding check_precond_r2_def by auto
     define distance where "distance \<equiv> s\<^sub>o - s\<^sub>e"
     define distance0_2 where "distance0_2 = safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     define safe_dist0 where "safe_dist0 = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
     define safe_dist1 where "safe_dist1 \<equiv> safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     note abb = distance_def safe_dist1_def safe_dist0_def distance0_2_def
     from pre have sdn': "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>"
       by (unfold_locales) (auto simp add: check_precond_r2_def)
    interpret sdn: safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
     rewrites "sdn.distance0_2 = safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>" and
              "sdn.safe_distance_1r = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>" and
              "sdn.safe_distance_2r = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
     proof -
       from sdn' show "safe_distance_normal a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>" by auto
     next
       show "safe_distance_normal.distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance0_2 v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
         unfolding safe_distance_normal.distance0_2_def[OF sdn'] safe_distance0_2_def by auto
     next
       show "safe_distance_normal.safe_distance_1r a\<^sub>e v\<^sub>e \<delta> = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>"
         unfolding safe_distance_normal.safe_distance_1r_def[OF sdn'] safe_distance_1r_def by auto
     next
       show "safe_distance_normal.safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>"
         unfolding safe_distance_normal.safe_distance_2r_def[OF sdn'] safe_distance_2r_def by auto
     qed
     have "\<not> distance > distance0_2 \<or>  distance > distance0_2" by auto
     moreover
     { assume "\<not> distance > distance0_2"
       hence "distance \<le> distance0_2" by auto
       with sdn.cond_3r_1'_2 have "sdn.collision_react {0..\<delta>}" using pre unfolding check_precond_r2_def abb sdn.other.t_stop_def by auto
       with sdn.collision_react_subset have "sdn.collision_react {0..}" by auto
       with as2 have "False" by auto }
     moreover
     { assume if2: "distance > distance0_2"
       have "\<not> (distance > safe_dist0)"
       proof (rule ccontr)
         assume "\<not> \<not> (safe_dist0 < distance)"
         hence "(safe_dist0 < distance)" by auto
         with as1 show "False" using pre if2 unfolding checker_r2_def Let_def abb by auto
       qed
       hence if3: "distance \<le> safe_dist0" by auto
       with pre have "distance \<le> safe_dist1" using as1 unfolding checker_r2_def Let_def abb by auto
 
       have "sdn.u \<delta> < sdn.other.s \<delta>" using abb if2 sdn.distance0_2_eq \<open>\<delta> > - v\<^sub>o / a\<^sub>o\<close> sdn.other.t_stop_def by auto
       from pre interpret sdr: safe_distance_no_collsion_delta a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta>
           by (unfold_locales) (auto simp add:check_precond_r2_def `sdn.u \<delta> < sdn.other.s \<delta>`)
       have "sdn.u_max \<ge> sdn.other.s \<delta>" using abb sdn.sd2r_eq  \<open>\<delta> > - v\<^sub>o / a\<^sub>o\<close> sdn.other.t_stop_def `distance \<le> safe_dist1` by auto
       with `\<delta> > - v\<^sub>o / a\<^sub>o` have "sdn.u_max \<ge> sdn.other.s_stop"
         using sdn.other.s_mono sdn.other.t_stop_nonneg sdn.other.p_t_stop sdn.other.p_zero sdn.other.t_stop_def
         apply (auto simp: sdn.other.s_def movement.t_stop_def split: if_splits)
         using sdn.other.p_zero by auto
       hence "sdn.collision_react {0..}" using sdn.cond_2r by auto
       with as2 have "False" by auto }
     ultimately show "False" by auto
   qed
 qed
 
 text \<open>Combine the two checkers into one.\<close>
 
 definition check_precond_r :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where 
   "check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> s\<^sub>o > s\<^sub>e \<and> 0 \<le> v\<^sub>e \<and> 0 \<le> v\<^sub>o \<and> a\<^sub>e < 0 \<and> a\<^sub>o < 0 \<and> 0 < \<delta>"
 
 definition checker_r :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> bool" where
   "checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<equiv> 
     let distance      = s\<^sub>o - s\<^sub>e;
 				precond       = check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>;
         vo_star       = v\<^sub>o + a\<^sub>o * \<delta>;
         t_stop_o_star = -vo_star / a\<^sub>o;
         t_stop_e      = -v\<^sub>e / a\<^sub>e;
         t_stop_o      = -v\<^sub>o / a\<^sub>o;
         safe_dist0    = safe_distance_1r a\<^sub>e v\<^sub>e \<delta>;
         safe_dist1    = safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>;
         safe_dist2    = safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>;
         safe_dist3    = safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta> 
     in
       if \<not> precond then False
       else if distance > safe_dist0 then True
       else if \<delta> \<le> t_stop_o \<and> distance > safe_dist3 then True
       else if \<delta> \<le> t_stop_o \<and> (a\<^sub>o > a\<^sub>e \<and> vo_star < v\<^sub>e \<and> t_stop_e < t_stop_o_star) then distance > safe_dist2
       else distance > safe_dist1"
 
 theorem checker_eq_1:
   "checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> \<delta> \<le> - v\<^sub>o / a\<^sub>o  \<longleftrightarrow> checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
 proof -
   have "checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> \<delta> \<le> - v\<^sub>o / a\<^sub>o \<longleftrightarrow> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>
     \<and> (s\<^sub>o - s\<^sub>e > safe_distance_1r a\<^sub>e v\<^sub>e \<delta>
         \<or> s\<^sub>o - s\<^sub>e > safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>
         \<or> (((a\<^sub>o > a\<^sub>e \<and> v\<^sub>o + a\<^sub>o * \<delta> < v\<^sub>e \<and> - v\<^sub>e / a\<^sub>e < - (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o) \<longrightarrow> s\<^sub>o - s\<^sub>e > safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>)
             \<and> (\<not> (a\<^sub>o > a\<^sub>e \<and> v\<^sub>o + a\<^sub>o * \<delta> < v\<^sub>e \<and> - v\<^sub>e / a\<^sub>e < - (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o) \<longrightarrow> s\<^sub>o - s\<^sub>e > safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>)))
     \<and> \<delta> \<le> - v\<^sub>o / a\<^sub>o" using checker_r_def by metis
   also have "... \<longleftrightarrow> check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>
     \<and> (s\<^sub>o - s\<^sub>e > safe_distance_1r a\<^sub>e v\<^sub>e \<delta>
         \<or> s\<^sub>o - s\<^sub>e > safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>
         \<or> (((a\<^sub>o > a\<^sub>e \<and> v\<^sub>o + a\<^sub>o * \<delta> < v\<^sub>e \<and> - v\<^sub>e / a\<^sub>e < - (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o) \<longrightarrow> s\<^sub>o - s\<^sub>e > safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>)
             \<and> (\<not> (a\<^sub>o > a\<^sub>e \<and> v\<^sub>o + a\<^sub>o * \<delta> < v\<^sub>e \<and> - v\<^sub>e / a\<^sub>e < - (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o) \<longrightarrow> s\<^sub>o - s\<^sub>e > safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>)))"
     by (auto simp add:check_precond_r_def check_precond_r1_def)
   also have "... \<longleftrightarrow> checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>" by (metis checker_r1_def)
   finally show ?thesis by auto
 qed
 
 theorem checker_eq_2:
   "checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> \<delta> > - v\<^sub>o / a\<^sub>o \<longleftrightarrow> checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>"
 proof -
   have "checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> \<delta> > - v\<^sub>o / a\<^sub>o \<longleftrightarrow> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> (\<not> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<or>
    s\<^sub>o - s\<^sub>e > safe_distance_1r a\<^sub>e v\<^sub>e \<delta> \<or>
    (\<delta> \<le> - v\<^sub>o / a\<^sub>o \<and> s\<^sub>o - s\<^sub>e > safe_distance_3r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>) \<or>
    (\<delta> \<le> - v\<^sub>o / a\<^sub>o \<and> a\<^sub>o > a\<^sub>e \<and> v\<^sub>o + a\<^sub>o * \<delta> < v\<^sub>e \<and> - v\<^sub>e / a\<^sub>e < - (v\<^sub>o + a\<^sub>o * \<delta>) / a\<^sub>o \<and> s\<^sub>o - s\<^sub>e > safe_distance_4r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>) \<or>
    s\<^sub>o - s\<^sub>e > safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>) \<and> \<delta> > - v\<^sub>o / a\<^sub>o" unfolding checker_r_def Let_def if_splits by auto
   also have
    "... \<longleftrightarrow> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>
    \<and> (s\<^sub>o - s\<^sub>e > safe_distance_1r a\<^sub>e v\<^sub>e \<delta> \<or> s\<^sub>o - s\<^sub>e > safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>)
    \<and> \<delta> > - v\<^sub>o / a\<^sub>o"  by (auto simp add:HOL.disjE)
   also have
     "... \<longleftrightarrow> check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>
    \<and> (s\<^sub>o - s\<^sub>e > safe_distance_1r a\<^sub>e v\<^sub>e \<delta> \<or> s\<^sub>o - s\<^sub>e > safe_distance_2r a\<^sub>e v\<^sub>e a\<^sub>o v\<^sub>o \<delta>)"
     by (auto simp add:check_precond_r_def check_precond_r2_def)
   also have "... \<longleftrightarrow> checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>" by (auto simp add:checker_r2_def Let_def if_splits)
   thus ?thesis using calculation by auto
 qed
 
 theorem checker_r_correctness:
   "(checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})"
 proof -
   have "checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<longleftrightarrow> (checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> \<delta> \<le> - v\<^sub>o / a\<^sub>o) \<or> (checker_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> \<delta> > - v\<^sub>o / a\<^sub>o)" by auto
   also have "... \<longleftrightarrow> checker_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<or> checker_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta>" using checker_eq_1 checker_eq_2 by auto
   also have "... \<longleftrightarrow> (check_precond_r1 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})
       \<or> (check_precond_r2 s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})"
     using checker_r1_correctness checker_r2_correctness by auto
   also have "... \<longleftrightarrow> (\<delta> \<le> - v\<^sub>o / a\<^sub>o \<and> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})
       \<or> (\<delta> > - v\<^sub>o / a\<^sub>o \<and> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..})"
     by (auto simp add:check_precond_r_def check_precond_r1_def check_precond_r2_def)
   also have "... \<longleftrightarrow> check_precond_r s\<^sub>e v\<^sub>e a\<^sub>e s\<^sub>o v\<^sub>o a\<^sub>o \<delta> \<and> safe_distance_normal.no_collision_react a\<^sub>e v\<^sub>e s\<^sub>e a\<^sub>o v\<^sub>o s\<^sub>o \<delta> {0..}"
     by auto
   finally show ?thesis by auto
 qed
 
 end
\ No newline at end of file