diff --git a/thys/Arith_Prog_Rel_Primes/Arith_Prog_Rel_Primes.thy b/thys/Arith_Prog_Rel_Primes/Arith_Prog_Rel_Primes.thy
--- a/thys/Arith_Prog_Rel_Primes/Arith_Prog_Rel_Primes.thy
+++ b/thys/Arith_Prog_Rel_Primes/Arith_Prog_Rel_Primes.thy
@@ -1,955 +1,955 @@
-(*
-  File:   Arith_Prog_Rel_Primes.thy
-  Author: Jose Manuel Rodriguez Caballero, University of Tartu
-*)
-section \<open>Problem ARITHMETIC PROGRESSIONS (Putnam exam problems 2002)\<close>
-theory Arith_Prog_Rel_Primes
-  imports
-    Complex_Main 
-    "HOL-Number_Theory.Number_Theory"
-begin
-
-text \<open>
- Statement of the problem (from ~\cite{putnam}): For which integers $n>1$ does the set of positive 
- integers less than and relatively prime to $n$ constitute an arithmetic progression?
- 
- The solution of the above problem is theorem @{text arith_prog_rel_primes_solution}.
-
- First, we will require some auxiliary material before we get started with the actual
- solution.
-\<close>
-
-subsection \<open>Auxiliary results\<close>
-
-lemma even_and_odd_parts:
-  fixes n::nat
-  assumes \<open>n \<noteq> 0\<close>
-  shows \<open>\<exists> k q::nat. n = (2::nat)^k*q \<and> odd q\<close>
-proof-
-  have \<open>prime (2::nat)\<close>
-    by simp    
-  thus ?thesis
-    using prime_power_canonical[where p = "2" and m = "n"]
-      assms semiring_normalization_rules(7) by auto    
-qed
-
-lemma only_one_odd_div_power2:
-  fixes n::nat
-  assumes \<open>n \<noteq> 0\<close> and  \<open>\<And> x. x dvd n \<Longrightarrow> odd x \<Longrightarrow> x = 1\<close>
-  shows \<open>\<exists> k. n = (2::nat)^k\<close>
-  by (metis even_and_odd_parts assms(1) assms(2) dvd_triv_left semiring_normalization_rules(11)
-      semiring_normalization_rules(7))
-
-lemma coprime_power2:
-  fixes n::nat
-  assumes \<open>n \<noteq> 0\<close> and \<open>\<And> x. x < n \<Longrightarrow> (coprime x n \<longleftrightarrow> odd x)\<close>
-  shows \<open>\<exists> k. n = (2::nat)^k\<close>
-proof-
-  have \<open>x dvd n \<Longrightarrow> odd x \<Longrightarrow> x = 1\<close>
-    for x
-    by (metis neq0_conv One_nat_def Suc_1 Suc_lessI assms(1) assms(2) coprime_left_2_iff_odd
-        dvd_refl linorder_neqE_nat nat_dvd_1_iff_1 nat_dvd_not_less not_coprimeI)
-  thus ?thesis
-    using assms(1) only_one_odd_div_power2 
-    by auto 
-qed
-
-subsection \<open>Main result\<close>
-
-text \<open>
-  The solution to the problem  ARITHMETIC PROGRESSIONS (Putnam exam problems 2002)
-\<close>
-
-theorem arith_prog_rel_primes_solution:
-  fixes n :: nat
-  assumes \<open>n > 1\<close>
-  shows \<open>(prime n \<or> (\<exists> k. n = 2^k) \<or> n = 6) \<longleftrightarrow>  
-(\<exists> a b m. m \<noteq> 0 \<and> {x | x. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m})\<close>
-proof-
-  have \<open> (prime n \<or> (\<exists> k. n = 2^k) \<or>  n = 6) \<longleftrightarrow>
- (\<exists> b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m})\<close>
-  proof
-    show "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-      if "prime n \<or> (\<exists>k. n = 2 ^ k) \<or> n = 6"
-    proof-
-      have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-        if "prime n"
-      proof-
-        have \<open>\<exists>m.   m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m}\<close>
-        proof-
-          have \<open>{x | x :: nat. x < n \<and> coprime x n} =  {x | x :: nat. x \<noteq> 0 \<and> x < n}\<close> 
-          proof
-            show "{x |x. x < n \<and> coprime x n} \<subseteq> {x |x. x \<noteq> 0 \<and> x < n}"
-              by (smt Collect_mono not_le ord_0_nat ord_eq_0 order_refl prime_gt_1_nat that zero_neq_one)
-            show "{x |x. x \<noteq> 0 \<and> x < n} \<subseteq> {x |x. x < n \<and> coprime x n}"
-              using coprime_commute prime_nat_iff'' that 
-              by fastforce              
-          qed
-          obtain m where \<open>m+1 = n\<close>
-            using add.commute assms less_imp_add_positive by blast
-          have \<open>{1+j| j::nat. j < (m::nat)} =  {x | x :: nat. x \<noteq> 0 \<and> x < m+1}\<close> 
-            by (metis Suc_eq_plus1   \<open>m + 1 = n\<close> gr0_implies_Suc le_simps(3)   less_nat_zero_code   linorder_not_less nat.simps(3) nat_neq_iff  plus_1_eq_Suc )
-          hence  \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < (m::nat)}\<close>
-            using \<open>{x | x :: nat. x < n \<and> coprime x n} =  {x | x :: nat. x \<noteq> 0 \<and> x < n}\<close>  \<open>m+1 = n\<close> 
-            by auto
-          from \<open>n > 1\<close> have \<open>m \<noteq> 0\<close> 
-            using \<open>m + 1 = n\<close> by linarith
-          have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m}\<close> 
-            using Suc_eq_plus1 \<open>1 < n\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j |j. j < m}\<close> 
-            by auto
-          hence \<open>(\<exists> m.  m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m})\<close>
-            using \<open>m \<noteq> 0\<close> 
-            by blast
-          thus ?thesis by blast
-        qed
-        hence \<open>\<exists>m.  m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*1| j::nat. j < m}\<close>
-          by auto
-        thus ?thesis
-          by blast 
-      qed
-      moreover have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-        if "\<exists>k. n = 2 ^ k"
-      proof-
-        obtain k where \<open>n = 2 ^ k\<close>
-          using \<open>\<exists>k. n = 2 ^ k\<close> by auto
-        have \<open>k \<noteq> 0\<close> 
-          by (metis \<open>1 < n\<close> \<open>n = 2 ^ k\<close> nat_less_le power.simps(1))
-        obtain t where \<open>Suc t = k\<close> 
-          by (metis \<open>k \<noteq> 0\<close> fib.cases)
-        have \<open>n = 2^(Suc t)\<close> 
-          by (simp add: \<open>Suc t = k\<close> \<open>n = 2 ^ k\<close>)
-        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < 2^t}\<close>
-        proof
-          show "{x |x. x < n \<and> coprime x n} \<subseteq> {1 + j * 2 |j. j < 2^t}"
-          proof
-            fix x
-            assume \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
-            hence \<open>x < n\<close>
-              by blast
-            have \<open>coprime x n\<close>
-              using \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
-              by blast
-            hence \<open>coprime x (2^(Suc k))\<close>
-              by (simp add: \<open>k \<noteq> 0\<close> \<open>n = 2 ^ k\<close>)              
-            have \<open>odd x\<close>
-              using \<open>coprime x n\<close> \<open>k \<noteq> 0\<close> \<open>n = 2 ^ k\<close> 
-              by auto 
-            then obtain j where \<open>x = 1+j*2\<close>
-              by (metis add.commute add.left_commute left_add_twice mult_2_right oddE)
-            have \<open>x < 2^k\<close>
-              using \<open>n = 2 ^ k\<close> \<open>x < n\<close> \<open>x = 1+j*2\<close> 
-              by linarith
-            hence \<open>1+j*2 < 2^k\<close>
-              using \<open>x = 1+j*2\<close>
-              by blast
-            hence \<open>j < 2^t\<close>
-              using \<open>Suc t = k\<close> by auto              
-            thus \<open>x \<in> {1 + j * 2 |j. j < 2^t}\<close>
-              using \<open>x = 1+j*2\<close>
-              by blast
-          qed
-          show "{1 + j * 2 |j. j < 2 ^ t} \<subseteq> {x |x. x < n \<and> coprime x n}"
-          proof
-            fix x::nat
-            assume \<open>x \<in> {1 + j * 2 |j. j < 2 ^ t}\<close>
-            then obtain j where \<open>x = 1 + j * 2\<close> and \<open>j < 2 ^ t\<close>
-              by blast
-            have \<open>x < 2*(2^t)\<close>
-              using  \<open>x = 1 + j * 2\<close>  \<open>j < 2 ^ t\<close>
-              by linarith              
-            hence \<open>x < n\<close>
-              by (simp add: \<open>n = 2 ^ Suc t\<close>)
-            moreover have \<open>coprime x n\<close>
-              by (metis (no_types) \<open>\<And>thesis. (\<And>j. \<lbrakk>x = 1 + j * 2; j < 2 ^ t\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> \<open>n = 2 ^ k\<close> coprime_Suc_left_nat coprime_mult_right_iff coprime_power_right_iff plus_1_eq_Suc)              
-            ultimately show \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
-              by blast
-          qed
-        qed
-        have \<open>(2::nat)^(t::nat) \<noteq> 0\<close> 
-          by simp
-        obtain m where \<open>m = (2::nat)^t\<close> by blast
-        have \<open>m \<noteq> 0\<close> 
-          using \<open>m = 2 ^ t\<close> 
-          by auto
-        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
-          using \<open>m = 2 ^ t\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < 2 ^ t}\<close> 
-          by auto
-        from  \<open>m \<noteq> 0\<close>  \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
-        show ?thesis by blast
-      qed
-      moreover have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-        if "n = 6"
-      proof-
-        have  \<open>{x | x. x < 6 \<and> coprime x 6} = {1+j*4| j::nat. j < 2}\<close>
-        proof-
-          have \<open>{x | x::nat. x < 6 \<and> coprime x 6} = {1, 5}\<close>
-          proof
-            show "{u. \<exists>x. u = (x::nat) \<and> x < 6 \<and> coprime x 6} \<subseteq> {1, 5}"
-            proof
-              fix u::nat
-              assume \<open>u \<in> {u. \<exists>x. u = x \<and> x < 6 \<and> coprime x 6}\<close>
-              hence \<open>coprime u 6\<close>
-                by blast
-              have \<open>u < 6\<close>
-                using \<open>u \<in> {u. \<exists>x. u = x \<and> x < 6 \<and> coprime x 6}\<close>
-                by blast
-              moreover have \<open>u \<noteq> 0\<close>
-                using \<open>coprime u 6\<close> ord_eq_0 
-                by fastforce
-              moreover have \<open>u \<noteq> 2\<close>
-                using \<open>coprime u 6\<close>
-                by auto
-              moreover have \<open>u \<noteq> 3\<close>
-              proof-
-                have \<open>gcd (3::nat) 6 = 3\<close>
-                  by auto
-                thus ?thesis 
-                  by (metis (no_types) \<open>coprime u 6\<close> \<open>gcd 3 6 = 3\<close> coprime_iff_gcd_eq_1 
-                      numeral_eq_one_iff semiring_norm(86))
-              qed
-              moreover have \<open>u \<noteq> 4\<close>
-              proof-
-                have \<open>gcd (4::nat) 6 = 2\<close>
-                  by (metis (no_types, lifting) add_numeral_left gcd_add1 gcd_add2 gcd_nat.idem
-                      numeral_Bit0 numeral_One one_plus_numeral semiring_norm(4) semiring_norm(5))
-                thus ?thesis
-                  using \<open>coprime u 6\<close> coprime_iff_gcd_eq_1 
-                  by auto 
-              qed
-              ultimately have \<open>u = 1 \<or> u = 5\<close>
-                by auto
-              thus \<open>u \<in> {1, 5}\<close>
-                by blast
-            qed
-            show "{1::nat, 5} \<subseteq> {x |x. x < 6 \<and> coprime x 6}"
-            proof-
-              have \<open>(1::nat) \<in> {x |x. x < 6 \<and> coprime x 6}\<close>
-                by simp                
-              moreover have \<open>(5::nat) \<in> {x |x. x < 6 \<and> coprime x 6}\<close>
-                by (metis Suc_numeral coprime_Suc_right_nat less_add_one mem_Collect_eq
-                    numeral_plus_one semiring_norm(5) semiring_norm(8))                
-              ultimately show ?thesis 
-                by blast
-            qed
-          qed
-          moreover have \<open>{1+j*4| j::nat. j < 2} = {1, 5}\<close>
-            by auto
-          ultimately show ?thesis by auto
-        qed
-        moreover have \<open>(2::nat) \<noteq> 0\<close>
-          by simp          
-        ultimately have \<open>\<exists> m.  m \<noteq> 0 \<and> {x | x :: nat. x < 6 \<and> coprime x 6} = {1+j*4| j::nat. j < m}\<close>
-          by blast
-        thus ?thesis
-          using that 
-          by auto 
-      qed
-      ultimately show ?thesis
-        using that 
-        by blast 
-    qed
-    show "prime n \<or> (\<exists>k. n = 2 ^ k) \<or> n = 6"
-      if "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-    proof-
-      obtain b m where \<open>m \<noteq> 0\<close> and \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
-        using \<open>\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-        by auto
-      show ?thesis
-      proof(cases \<open>n = 2\<close>)
-        case True
-        thus ?thesis
-          by auto 
-      next
-        case False
-        have \<open>b \<le> 4\<close>
-        proof(cases \<open>odd b\<close>)
-          case True
-          show ?thesis
-          proof(rule classical)
-            assume \<open>\<not>(b \<le> 4)\<close>
-            hence \<open>b > 4\<close> 
-              using le_less_linear 
-              by blast
-            obtain m where \<open>m \<noteq> 0\<close> 
-              and \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
-              using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            have \<open>b \<noteq> 0\<close> 
-              using \<open>4 < b\<close> 
-              by linarith
-            have \<open>n = 2 + (m-1)*b\<close> 
-            proof-
-              have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                using \<open>1 < n\<close> coprime_diff_one_left_nat 
-                by auto
-              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast
-              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
-                by blast
-              have \<open>i \<le> m-1\<close> 
-                using \<open>i < m\<close> 
-                by linarith
-              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>m \<noteq> 0\<close> 
-                by auto
-              hence \<open>1 + (m-1)*b \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
-                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast
-              hence \<open>1 + (m-1)*b < n\<close> 
-                by blast
-              hence \<open>1 + (m-1)*b \<le> n-1\<close> 
-                by linarith
-              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
-                using \<open>n - 1 = 1 + i * b\<close> 
-                by linarith
-              hence \<open>(m-1)*b \<le> i*b\<close> 
-                by linarith
-              hence \<open>m-1 \<le> i\<close> 
-                using \<open>b \<noteq> 0\<close> 
-                by auto
-              hence \<open>m-1 = i\<close> 
-                using \<open>i \<le> m - 1\<close> le_antisym 
-                by blast
-              thus ?thesis 
-                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close> 
-                by auto
-            qed
-            have \<open>m \<ge> 2\<close> 
-              using \<open>n = 2 + (m - 1)*b\<close> \<open>n \<noteq> 2\<close> 
-              by auto
-            hence \<open>1+b \<in> {1+j*b| j. j < m}\<close> 
-              by fastforce
-            hence  \<open>1+b \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
-              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            hence \<open>coprime (1+b) n\<close> 
-              by blast
-            have \<open>(2::nat) dvd (1+b)\<close> 
-              using \<open>odd b\<close> 
-              by simp
-            hence \<open>coprime (2::nat) n\<close> 
-              using \<open>coprime (1 + b) n\<close> coprime_common_divisor coprime_left_2_iff_odd odd_one 
-              by blast
-            have \<open>(2::nat) < n\<close> 
-              using \<open>1 < n\<close> \<open>n \<noteq> 2\<close> 
-              by linarith
-            have \<open>2 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-              using \<open>2 < n\<close> \<open>coprime 2 n\<close> 
-              by blast 
-            hence  \<open>2 \<in> {1+j*b| j::nat. j < m}\<close> 
-              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            then obtain j::nat where \<open>2 = 1+j*b\<close> 
-              by blast 
-            have  \<open>1 = j*b\<close> 
-              using \<open>2 = 1+j*b\<close>
-              by linarith
-            thus ?thesis 
-              by simp
-          qed
-        next
-          case False
-          hence \<open>even b\<close>
-            by simp
-          show ?thesis
-          proof(rule classical)
-            assume \<open>\<not>(b \<le> 4)\<close>
-            hence \<open>b > 4\<close> 
-              using le_less_linear 
-              by blast
-            obtain m where  \<open> m \<noteq> 0\<close>
-              and \<open>{x | x::nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
-              using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            have \<open>b \<noteq> 0\<close> 
-              using \<open>4 < b\<close> 
-              by linarith
-            have \<open>n = 2 + (m-1)*b\<close> 
-            proof-
-              have \<open>n-1 \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
-                using \<open>1 < n\<close> coprime_diff_one_left_nat 
-                by auto
-              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast
-              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
-                by blast
-              have \<open>i \<le> m-1\<close> 
-                using \<open>i < m\<close> 
-                by linarith
-              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>m \<noteq> 0\<close> 
-                by auto
-              hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast
-              hence \<open>1 + (m-1)*b < n\<close> 
-                by blast
-              hence \<open>1 + (m-1)*b \<le> n-1\<close> 
-                by linarith
-              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
-                using \<open>n - 1 = 1 + i * b\<close> 
-                by linarith
-              hence \<open>(m-1)*b \<le> i*b\<close> 
-                by linarith
-              hence \<open>m-1 \<le> i\<close> 
-                using \<open>b \<noteq> 0\<close> 
-                by auto
-              hence \<open>m-1 = i\<close> 
-                using \<open>i \<le> m - 1\<close> le_antisym 
-                by blast
-              thus ?thesis 
-                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close> 
-                by auto
-            qed
-            obtain k :: nat where \<open>b = 2*k\<close> 
-              using \<open>even b\<close>
-              by blast
-            have \<open>n = 2*(1 + (m-1)*k)\<close>
-              using  \<open>n = 2 + (m-1)*b\<close>  \<open>b = 2*k\<close> 
-              by simp
-            show ?thesis
-            proof (cases \<open>odd m\<close>)
-              case True
-              hence \<open>odd m\<close> by blast
-              then obtain t::nat where \<open>m-1 = 2*t\<close> 
-                by (metis odd_two_times_div_two_nat)
-              have  \<open>n = 2*(1 + b*t)\<close> 
-                using \<open>m - 1 = 2 * t\<close> \<open>n = 2 + (m - 1) * b\<close> 
-                by auto
-              have \<open>t < m\<close> 
-                using \<open>m - 1 = 2 * t\<close> \<open>m \<noteq> 0\<close> 
-                by linarith
-              have \<open>1 + b*t \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>t < m\<close> 
-                by auto 
-              hence \<open>1 + b*t \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
-                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast 
-              hence \<open>coprime (1 + b*t) n\<close> 
-                by auto
-              thus ?thesis 
-                by (metis (no_types, lifting) \<open>b = 2 * k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 * (1 + b * t)\<close> \<open>n = 2 + (m - 1) * b\<close> \<open>n \<noteq> 2\<close> add_cancel_right_right coprime_mult_right_iff coprime_self mult_cancel_left mult_is_0 nat_dvd_1_iff_1)
-            next
-              case False
-              thus ?thesis
-              proof(cases \<open>odd k\<close>)
-                case True
-                hence \<open>odd k\<close>
-                  by blast
-                have \<open>even (1 + (m - 1) * k)\<close> 
-                  by (simp add: False True \<open>m \<noteq> 0\<close>)
-                have \<open>coprime (2 + (m - 1) * k) (1 + (m - 1) * k)\<close> 
-                  by simp
-                have \<open>coprime (2 + (m - 1) * k) n\<close> 
-                  using \<open>coprime (2 + (m - 1) * k) (1 + (m - 1) * k)\<close> \<open>even (1 + (m - 1) * k)\<close> 
-                    \<open>n = 2 * (1 + (m - 1) * k)\<close> coprime_common_divisor coprime_mult_right_iff
-                    coprime_right_2_iff_odd odd_one 
-                  by blast
-                have \<open>2 + (m - 1) * k < n\<close> 
-                  by (metis (no_types, lifting) \<open>even (1 + (m - 1) * k)\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close>
-                      add_gr_0 add_mono_thms_linordered_semiring(1) dvd_add_left_iff dvd_add_triv_left_iff dvd_imp_le le_add2 le_neq_implies_less less_numeral_extra(1) mult_2 odd_one)
-                have \<open>2 + (m - 1) * k  \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                  using \<open>2 + (m - 1) * k < n\<close> \<open>coprime (2 + (m - 1) * k) n\<close> 
-                  by blast
-                hence \<open>2 + (m - 1) * k  \<in> {1 + j * b |j. j < m}\<close> 
-                  using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                  by blast
-                then obtain j::nat where  \<open>2 + (m - 1) * k  = 1 + j * b\<close> and \<open>j < m\<close>
-                  by blast
-                have  \<open>1 + (m - 1) * k  = j * b\<close>
-                  using \<open>2 + (m - 1) * k  = 1 + j * b\<close>
-                  by simp
-                hence  \<open>1 + (m - 1) * k  = j * (2*k)\<close> 
-                  using \<open>b = 2 * k\<close> by blast
-                thus ?thesis 
-                  by (metis \<open>b = 2 * k\<close> \<open>even b\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 + (m - 1) * b\<close> dvd_add_times_triv_right_iff dvd_antisym dvd_imp_le dvd_triv_right even_numeral mult_2 zero_less_numeral)
-              next
-                case False
-                hence \<open>even k\<close> by auto
-                have \<open>odd (1 + (m - 1) * k)\<close> 
-                  by (simp add: \<open>even k\<close> )
-                hence \<open>coprime (3 + (m - 1) * k) (1 + (m - 1) * k)\<close> 
-                  by (smt add_numeral_left coprime_common_divisor coprime_right_2_iff_odd dvd_add_left_iff not_coprimeE numeral_Bit1 numeral_One numeral_plus_one one_add_one)
-                hence \<open>coprime (3 + (m - 1) * k) n\<close> 
-                  by (metis \<open>even k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> coprime_mult_right_iff coprime_right_2_iff_odd even_add even_mult_iff odd_numeral)
-                have \<open>3 + (m - 1) * k < n\<close> 
-                  by (smt Groups.add_ac(2) \<open>even k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 + (m - 1) * b\<close> \<open>n \<noteq> 2\<close> add_Suc_right add_cancel_right_right add_mono_thms_linordered_semiring(1) dvd_imp_le even_add even_mult_iff le_add2 le_neq_implies_less left_add_twice mult_2 neq0_conv numeral_Bit1 numeral_One odd_numeral one_add_one plus_1_eq_Suc)
-                have \<open>3 + (m - 1) * k \<in> {x |x. x < n \<and> coprime x n}\<close> 
-                  using \<open>3 + (m - 1) * k < n\<close> \<open>coprime (3 + (m - 1) * k) n\<close> 
-                  by blast
-                hence \<open>3 + (m - 1) * k \<in> {1 + j * b |j. j < m}\<close> 
-                  using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                  by blast 
-                then obtain j::nat where \<open>3 + (m - 1) * k = 1 + j * b\<close> 
-                  by blast  
-                have \<open>2 + (m - 1) * k = j * b\<close> 
-                  using \<open>3 + (m - 1) * k = 1 + j * b\<close> 
-                  by simp
-                hence  \<open>2 + (m - 1) * k = j * 2*k\<close> 
-                  by (simp add: \<open>b = 2 * k\<close>)
-                thus ?thesis 
-                  by (metis \<open>4 < b\<close> \<open>b = 2 * k\<close> \<open>even k\<close> dvd_add_times_triv_right_iff dvd_antisym 
-                      dvd_triv_right mult_2 nat_neq_iff numeral_Bit0)
-              qed
-            qed
-          qed
-        qed
-        moreover have \<open>b \<noteq> 3\<close>
-        proof (rule classical)
-          assume \<open>\<not> (b \<noteq> 3)\<close>
-          hence \<open>b = 3\<close> 
-            by blast
-          obtain m where  \<open>m \<noteq> 0\<close> and 
-            \<open>{x | x::nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
-            using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-            by blast
-          have \<open>b \<noteq> 0\<close> 
-            by (simp add: \<open>b = 3\<close>)
-          have \<open>n = 2 + (m-1)*b\<close> 
-          proof-
-            have \<open>n-1 \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
-              using \<open>1 < n\<close> coprime_diff_one_left_nat 
-              by auto
-            have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
-              using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-                \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
-              by blast
-            have \<open>i \<le> m-1\<close> 
-              using \<open>i < m\<close> 
-              by linarith
-            have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
-              using \<open>m \<noteq> 0\<close> 
-              by auto
-            hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            hence \<open>1 + (m-1)*b < n\<close> 
-              by blast
-            hence \<open>1 + (m-1)*b \<le> n-1\<close> 
-              by linarith
-            hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
-              using \<open>n - 1 = 1 + i * b\<close> 
-              by linarith
-            hence \<open>(m-1)*b \<le> i*b\<close> 
-              by linarith
-            hence \<open>m-1 \<le> i\<close> 
-              using \<open>b \<noteq> 0\<close> 
-              by auto
-            hence \<open>m-1 = i\<close> 
-              using \<open>i \<le> m - 1\<close> le_antisym 
-              by blast
-            thus ?thesis 
-              using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close> 
-              by auto
-          qed
-          have \<open>n > 2\<close> 
-            using \<open>1 < n\<close> \<open>n \<noteq> 2\<close> 
-            by linarith
-          hence \<open> m \<ge> 2 \<close> using  \<open>n = 2 + (m-1)*b\<close> \<open>b = 3\<close> 
-            by simp
-          have \<open>4 \<in> {1+j*(b::nat)| j::nat. j < m}\<close> 
-            using \<open>2 \<le> m\<close> \<open>b = 3\<close> 
-            by force
-          hence \<open>(4::nat) \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close> 
-            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
-            by auto
-          hence \<open>coprime (4::nat) n\<close> 
-            by blast
-          have \<open>(2::nat) dvd 4\<close> 
-            by auto
-          hence \<open>coprime (2::nat) n\<close> 
-            using \<open>coprime (4::nat) n\<close> coprime_divisors dvd_refl 
-            by blast
-          have \<open>4 < n\<close> 
-            using \<open>4 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-            by blast
-          have \<open>2 < (4::nat)\<close> 
-            by auto
-          have  \<open>2 < n\<close> 
-            by (simp add: \<open>2 < n\<close>)
-          hence \<open>2 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-            using  \<open>coprime (2::nat) n\<close> 
-            by blast
-          hence  \<open>2 \<in> {1+j*(b::nat)| j::nat. j < m}\<close> 
-            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-            by blast
-          then obtain j::nat where \<open>2 = 1+j*3\<close> 
-            using \<open>b = 3\<close> 
-            by blast
-          from  \<open>2 = 1+j*3\<close>
-          have  \<open>1 = j*3\<close> 
-            by auto
-          hence \<open>3 dvd 1\<close> 
-            by auto
-          thus ?thesis
-            using nat_dvd_1_iff_1 numeral_eq_one_iff 
-            by blast
-        qed
-        ultimately have \<open>b = 0 \<or> b = 1 \<or> b = 2 \<or> b = 4\<close>
-          by auto
-        moreover have \<open>b = 0 \<Longrightarrow> \<exists>k. n = 2^k\<close>
-        proof-
-          assume \<open>b = 0\<close>
-          have \<open>{1 + j * b |j. j < m} = {1}\<close>
-            using \<open>b = 0\<close> \<open>m \<noteq> 0\<close> 
-            by auto
-          hence \<open>{x |x. x < n \<and> coprime x n} = {1}\<close>
-            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
-            by blast
-          hence \<open>n = 2\<close>
-          proof-
-            have \<open>n-1 \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close> 
-              using \<open>1 < n\<close> coprime_diff_one_left_nat 
-              by auto
-            have \<open>n-1 \<in> {1}\<close> 
-              using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} = {1}\<close> 
-              by blast
-            hence \<open>n-1 = 1\<close> 
-              by blast
-            hence \<open>n = 2\<close> 
-              by simp
-            thus ?thesis 
-              by blast
-          qed
-          hence \<open>n = 2^1\<close>
-            by auto
-          thus ?thesis
-            by blast 
-        qed
-        moreover have \<open>b = 1 \<Longrightarrow> prime n\<close>
-        proof-
-          assume \<open>b = 1\<close>
-          have \<open>x < n \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> coprime x n\<close>
-            for x
-          proof-
-            assume \<open>x < n\<close> and \<open>x \<noteq> 0\<close>
-            have \<open>{1+j| j::nat. j < m} = {x | x::nat. x < m+1 \<and> x \<noteq> 0}\<close> 
-              by (metis (full_types) Suc_eq_plus1  add_mono1 less_Suc_eq_0_disj  nat.simps(3) plus_1_eq_Suc )
-            hence \<open>{x | x :: nat. x < n \<and> coprime x n} = {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close>
-              using \<open>b = 1\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by auto
-            have \<open>coprime (n-1) n\<close> 
-              using \<open>1 < n\<close> coprime_diff_one_left_nat 
-              by auto
-            have \<open>n-1 < n\<close> 
-              using \<open>1 < n\<close> 
-              by auto
-            have \<open>n-1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-              using \<open>coprime (n - 1) n\<close> \<open>n - 1 < n\<close> 
-              by blast
-            have \<open>n-1 \<le> m\<close> 
-              by (metis (no_types, lifting) CollectD Suc_eq_plus1 Suc_less_eq2 \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close>   leD  le_less_linear not_less_eq_eq )
-            have \<open>m \<in>  {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close> 
-              using \<open>m \<noteq> 0\<close> 
-              by auto
-            have \<open>m \<in> {x |x. x < n \<and> coprime x n} \<close> 
-              using \<open>m \<in> {x |x. x < m + 1 \<and> x \<noteq> 0}\<close> 
-                \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close> 
-              by blast
-            have \<open>m < n\<close> 
-              using \<open>m \<in> {x |x. x < n \<and> coprime x n}\<close> 
-              by blast
-            have \<open>m+1 = n\<close> 
-              using \<open>m < n\<close> \<open>n - 1 \<le> m\<close> 
-              by linarith
-            have \<open>x \<in>  {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close> 
-              using \<open>m + 1 = n\<close> \<open>x < n\<close> \<open>x \<noteq> 0\<close> 
-              by blast
-            hence \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close> 
-              using \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close> 
-              by blast
-            thus ?thesis 
-              by blast
-          qed
-          thus ?thesis
-            using assms coprime_commute nat_neq_iff prime_nat_iff'' by auto 
-        qed
-        moreover have \<open>b = 2 \<Longrightarrow> \<exists> k. n = 2^k\<close>
-        proof-
-          assume \<open>b = 2\<close>
-          have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
-            using \<open>b = 2\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-            by auto
-          have \<open>x < n \<Longrightarrow> coprime x n \<longleftrightarrow> odd x\<close>
-            for x::nat
-          proof-
-            assume \<open>x < n\<close>
-            have \<open>coprime x n \<Longrightarrow> odd x\<close>
-            proof-
-              assume \<open>coprime x n\<close>
-              have \<open>x \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                by (simp add: \<open>coprime x n\<close> \<open>x < n\<close>)
-              hence \<open>x \<in> {1+j*2| j::nat. j < m}\<close> 
-                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < m}\<close> 
-                by blast
-              then obtain j where \<open>x = 1+j*2\<close> 
-                by blast
-              thus ?thesis
-                by simp
-            qed
-            moreover have \<open>odd x \<Longrightarrow> coprime x n\<close>
-            proof-
-              assume \<open>odd x\<close>
-              obtain j::nat where \<open>x = 1+j*2\<close> 
-                by (metis \<open>odd x\<close> add.commute mult_2_right odd_two_times_div_two_succ one_add_one semiring_normalization_rules(16)) 
-              have \<open>j < (n-1)/2\<close> 
-                using \<open>x < n\<close> \<open>x = 1 + j * 2\<close> 
-                by linarith
-              have \<open>n = 2*m\<close>
-              proof-
-                have  \<open>(2::nat) \<noteq> 0\<close> 
-                  by auto
-                have \<open>n = 2+(m-1)*2\<close> 
-                proof-
-                  have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                    using \<open>1 < n\<close> coprime_diff_one_left_nat 
-                    by auto
-                  have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
-                    using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-                      \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                    by blast
-                  then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
-                    by blast
-                  have \<open>i \<le> m-1\<close> 
-                    using \<open>i < m\<close> 
-                    by linarith
-                  have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
-                    using \<open>m \<noteq> 0\<close> by auto
-                  hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                    using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                    by blast
-                  hence \<open>1 + (m-1)*b < n\<close> 
-                    by blast
-                  hence \<open>1 + (m-1)*b \<le> n-1\<close> 
-                    by linarith
-                  hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
-                    using \<open>n - 1 = 1 + i * b\<close> 
-                    by linarith
-                  hence \<open>(m-1)*b \<le> i*b\<close> 
-                    by linarith
-                  hence \<open>m-1 \<le> i\<close> 
-                  proof-
-                    have \<open>b \<noteq> 0\<close>
-                      using \<open>b = 2\<close>
-                      by simp
-                    thus ?thesis
-                      using \<open>(m - 1) * b \<le> i * b\<close> mult_le_cancel2 
-                      by blast 
-                  qed
-                  hence \<open>m-1 = i\<close> 
-                    using \<open>i \<le> m - 1\<close> le_antisym 
-                    by blast
-                  thus ?thesis 
-                    using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
-                    by (simp add: \<open>b = 2\<close>)
-                qed
-                thus  ?thesis 
-                  by (simp add: \<open>m \<noteq> 0\<close> \<open>n = 2 + (m - 1) * 2\<close> mult.commute mult_eq_if)
-              qed
-              hence \<open>j < m\<close> 
-                using \<open>x < n\<close> \<open>x = 1 + j * 2\<close> 
-                by linarith
-              hence \<open>x \<in> {1+j*2| j::nat. j < m}\<close> 
-                using \<open>x = 1 + j * 2\<close> 
-                by blast
-              hence \<open>x \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < m}\<close> 
-                by blast
-              thus ?thesis 
-                by blast
-            qed
-            ultimately show ?thesis 
-              by blast
-          qed
-          thus ?thesis 
-            using coprime_power2 assms 
-            by auto
-        qed
-        moreover have \<open>b = 4 \<Longrightarrow> n = 6\<close>
-        proof-
-          assume \<open>b = 4\<close>
-          have \<open>n = 2 \<or> n = 6\<close>
-          proof(rule classical)
-            assume \<open>\<not> (n = 2 \<or> n = 6)\<close>
-            have  \<open>(4::nat) \<noteq> 0\<close> 
-              by auto
-            have \<open>n =  2+(m-1)*4\<close> 
-            proof-
-              have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                using \<open>1 < n\<close> coprime_diff_one_left_nat 
-                by auto
-              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
-                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast
-              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
-                by blast
-              have \<open>i \<le> m-1\<close> 
-                using \<open>i < m\<close> 
-                by linarith
-              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
-                using \<open>m \<noteq> 0\<close> 
-                by auto
-              hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-                by blast
-              hence \<open>1 + (m-1)*b < n\<close> 
-                by blast
-              hence \<open>1 + (m-1)*b \<le> n-1\<close> 
-                by linarith
-              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
-                using \<open>n - 1 = 1 + i * b\<close> 
-                by linarith
-              hence \<open>(m-1)*b \<le> i*b\<close> 
-                by linarith
-              hence \<open>m-1 \<le> i\<close> 
-              proof-
-                have \<open>b \<noteq> 0\<close>
-                  using \<open>b = 4\<close> by auto
-                thus ?thesis
-                  using \<open>(m - 1) * b \<le> i * b\<close> mult_le_cancel2 
-                  by blast 
-              qed
-              hence \<open>m-1 = i\<close> 
-                using \<open>i \<le> m - 1\<close> le_antisym 
-                by blast
-              thus ?thesis 
-                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
-                by (simp add: \<open>b = 4\<close>) 
-            qed
-            hence \<open>n = 4*m - 2\<close> 
-              by (simp add: \<open>m \<noteq> 0\<close> mult.commute mult_eq_if)
-            have \<open>m \<ge> 3\<close> 
-              using \<open>\<not> (n = 2 \<or> n = 6)\<close> \<open>n = 2 + (m - 1) * 4\<close> 
-              by auto
-            hence \<open> {1+j*4| j::nat. j < 3} \<subseteq> {1+j*4| j::nat. j < m}\<close>
-              by force
-            hence \<open>9 \<in> {1+j*4| j::nat. j < 3}\<close> 
-              by force
-            hence \<open>9 \<in> {1+j*4| j::nat. j < m}\<close> 
-              using  \<open> {1+j*4| j::nat. j < 3} \<subseteq> {1+j*4| j::nat. j < m}\<close> 
-              by blast
-            hence \<open>9 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
-              using \<open>b = 4\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by auto
-            hence \<open>coprime (9::nat) n\<close> 
-              by blast
-            have \<open>(3::nat) dvd 9\<close> 
-              by auto
-            have  \<open>coprime (3::nat) n\<close> using  \<open>coprime (9::nat) n\<close> \<open>(3::nat) dvd 9\<close>
-              by (metis coprime_commute coprime_mult_right_iff dvd_def)
-            have \<open>(3::nat) < n\<close> 
-              by (metis One_nat_def Suc_lessI \<open>1 < n\<close> \<open>\<not> (n = 2 \<or> n = 6)\<close> \<open>coprime 3 n\<close>
-                  coprime_self numeral_2_eq_2 numeral_3_eq_3 less_numeral_extra(1) nat_dvd_not_less)
-            have \<open>3 \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close> 
-              using \<open>3 < n\<close> \<open>coprime 3 n\<close> 
-              by blast
-            hence  \<open>(3::nat) \<in> {1+j*4| j::nat. j < m}\<close>
-              using \<open>b = 4\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
-              by blast
-            then obtain j::nat where \<open>(3::nat) = 1 + j*4\<close> 
-              by blast  
-            have \<open>2 = j*4\<close> 
-              using numeral_3_eq_3 \<open>(3::nat) = 1 + j*4\<close>
-              by linarith
-            hence \<open>1 = j*2\<close> 
-              by linarith
-            hence \<open>even 1\<close> 
-              by simp
-            thus ?thesis 
-              using odd_one 
-              by blast
-          qed
-          thus ?thesis
-            by (simp add: False)            
-        qed
-        ultimately show ?thesis 
-          by blast
-      qed
-    qed
-  qed
-  moreover have \<open>(\<exists> b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m})
-  \<longleftrightarrow> (\<exists> a b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m})\<close>
-  proof
-    show "\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}"
-      if "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-      using that
-      by blast 
-    show "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
-      if "\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}"
-    proof-
-      obtain a b m::nat where \<open>m \<noteq> 0\<close>
-        and \<open>{x | x :: nat. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m}\<close>
-        using \<open>\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> 
-        by auto        
-      have \<open>a = 1\<close> 
-      proof-
-        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {(a::nat)+j*(b::nat)| j::nat. j < m} \<Longrightarrow> a = 1\<close>
-        proof-
-          have \<open>Min {x | x :: nat. x < n \<and> coprime x n} = Min {a+j*b| j::nat. j < m}\<close>
-            using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> 
-            by auto            
-          have  \<open>Min {x | x :: nat. x < n \<and> coprime x n} = 1\<close>
-          proof-
-            have \<open>finite {x | x :: nat. x < n \<and> coprime x n}\<close>
-              by auto
-            have \<open>{x | x :: nat. x < n \<and> coprime x n} \<noteq> {}\<close> 
-              using \<open>1 < n\<close> by auto
-            have \<open>1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
-              using \<open>1 < n\<close> 
-              by auto
-            have \<open>\<forall> x. coprime x n \<longrightarrow> x \<ge> 1\<close> 
-              using \<open>1 < n\<close> le_less_linear 
-              by fastforce
-            hence \<open>\<forall> x.  x < n \<and> coprime x n \<longrightarrow> x \<ge> 1\<close> 
-              by blast
-            hence \<open>\<forall> x \<in> {x | x :: nat. x < n \<and> coprime x n}. x \<ge> 1\<close> 
-              by blast
-            hence \<open>Min {x | x :: nat. x < n \<and> coprime x n} \<ge> 1\<close> 
-              using \<open>finite {x | x :: nat. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} \<noteq> {}\<close>
-              by auto
-            thus ?thesis 
-              using Min_le \<open>1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>finite {x |x. x < n \<and> coprime x n}\<close>
-                antisym by blast
-          qed
-          have \<open>Min  {a+j*b| j::nat. j < m} = a\<close>
-          proof -
-            have f1: "\<exists>n. a = a + n * b \<and> n < m"
-              using \<open>m \<noteq> 0\<close> 
-              by auto
-            have f2: "\<exists>n. 1 = a + n * b \<and> n < m"
-              using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> assms coprime_1_left 
-              by blast
-            have f3: "\<exists>na. a = na \<and> na < n \<and> coprime na n"
-              using f1 \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> by blast
-            have "n \<noteq> 1"
-              by (metis (lifting) assms less_irrefl_nat)
-            then have "\<not> coprime 0 n"
-              by simp
-            then show ?thesis
-              using f3 f2 by (metis \<open>Min {x |x. x < n \<and> coprime x n} = 1\<close> \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> less_one linorder_neqE_nat not_add_less1)
-          qed
-          hence \<open>Min  {a+j*b| j::nat. j < m} = a\<close> by blast
-          thus ?thesis 
-            using \<open>Min {x | x :: nat. x < n \<and> coprime x n} = 1\<close> \<open>Min {x | x :: nat. x < n \<and> coprime x n} = Min {a+j*b| j::nat. j < m}\<close>
-            by linarith
-        qed
-        thus ?thesis
-          using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> 
-          by blast 
-      qed
-      thus ?thesis using  \<open>m \<noteq> 0\<close> \<open>{x | x. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m}\<close> 
-        by auto
-    qed
-  qed 
-  ultimately show ?thesis
-    by simp 
-qed
-
+(*
+  File:   Arith_Prog_Rel_Primes.thy
+  Author: Jose Manuel Rodriguez Caballero, University of Tartu
+*)
+section \<open>Problem ARITHMETIC PROGRESSIONS (Putnam exam problems 2002)\<close>
+theory Arith_Prog_Rel_Primes
+  imports
+    Complex_Main 
+    "HOL-Number_Theory.Number_Theory"
+begin
+
+text \<open>
+ Statement of the problem (from ~\cite{putnam}): For which integers $n>1$ does the set of positive 
+ integers less than and relatively prime to $n$ constitute an arithmetic progression?
+ 
+ The solution of the above problem is theorem @{text arith_prog_rel_primes_solution}.
+
+ First, we will require some auxiliary material before we get started with the actual
+ solution.
+\<close>
+
+subsection \<open>Auxiliary results\<close>
+
+lemma even_and_odd_parts:
+  fixes n::nat
+  assumes \<open>n \<noteq> 0\<close>
+  shows \<open>\<exists> k q::nat. n = (2::nat)^k*q \<and> odd q\<close>
+proof-
+  have \<open>prime (2::nat)\<close>
+    by simp    
+  thus ?thesis
+    using prime_power_canonical[where p = "2" and m = "n"]
+      assms semiring_normalization_rules(7) by auto    
+qed
+
+lemma only_one_odd_div_power2:
+  fixes n::nat
+  assumes \<open>n \<noteq> 0\<close> and  \<open>\<And> x. x dvd n \<Longrightarrow> odd x \<Longrightarrow> x = 1\<close>
+  shows \<open>\<exists> k. n = (2::nat)^k\<close>
+  by (metis even_and_odd_parts assms(1) assms(2) dvd_triv_left semiring_normalization_rules(11)
+      semiring_normalization_rules(7))
+
+lemma coprime_power2:
+  fixes n::nat
+  assumes \<open>n \<noteq> 0\<close> and \<open>\<And> x. x < n \<Longrightarrow> (coprime x n \<longleftrightarrow> odd x)\<close>
+  shows \<open>\<exists> k. n = (2::nat)^k\<close>
+proof-
+  have \<open>x dvd n \<Longrightarrow> odd x \<Longrightarrow> x = 1\<close>
+    for x
+    by (metis neq0_conv One_nat_def Suc_1 Suc_lessI assms(1) assms(2) coprime_left_2_iff_odd
+        dvd_refl linorder_neqE_nat nat_dvd_1_iff_1 nat_dvd_not_less not_coprimeI)
+  thus ?thesis
+    using assms(1) only_one_odd_div_power2 
+    by auto 
+qed
+
+subsection \<open>Main result\<close>
+
+text \<open>
+  The solution to the problem  ARITHMETIC PROGRESSIONS (Putnam exam problems 2002)
+\<close>
+
+theorem arith_prog_rel_primes_solution:
+  fixes n :: nat
+  assumes \<open>n > 1\<close>
+  shows \<open>(prime n \<or> (\<exists> k. n = 2^k) \<or> n = 6) \<longleftrightarrow>  
+(\<exists> a b m. m \<noteq> 0 \<and> {x | x. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m})\<close>
+proof-
+  have \<open> (prime n \<or> (\<exists> k. n = 2^k) \<or>  n = 6) \<longleftrightarrow>
+ (\<exists> b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m})\<close>
+  proof
+    show "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+      if "prime n \<or> (\<exists>k. n = 2 ^ k) \<or> n = 6"
+    proof-
+      have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+        if "prime n"
+      proof-
+        have \<open>\<exists>m.   m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m}\<close>
+        proof-
+          have \<open>{x | x :: nat. x < n \<and> coprime x n} =  {x | x :: nat. x \<noteq> 0 \<and> x < n}\<close> 
+          proof
+            show "{x |x. x < n \<and> coprime x n} \<subseteq> {x |x. x \<noteq> 0 \<and> x < n}"
+              by (smt Collect_mono not_le ord_0_nat ord_eq_0 order_refl prime_gt_1_nat that zero_neq_one)
+            show "{x |x. x \<noteq> 0 \<and> x < n} \<subseteq> {x |x. x < n \<and> coprime x n}"
+              using coprime_commute prime_nat_iff'' that 
+              by fastforce              
+          qed
+          obtain m where \<open>m+1 = n\<close>
+            using add.commute assms less_imp_add_positive by blast
+          have \<open>{1+j| j::nat. j < (m::nat)} =  {x | x :: nat. x \<noteq> 0 \<and> x < m+1}\<close> 
+            by (metis Suc_eq_plus1   \<open>m + 1 = n\<close> gr0_implies_Suc le_simps(3)   less_nat_zero_code   linorder_not_less nat.simps(3) nat_neq_iff  plus_1_eq_Suc )
+          hence  \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < (m::nat)}\<close>
+            using \<open>{x | x :: nat. x < n \<and> coprime x n} =  {x | x :: nat. x \<noteq> 0 \<and> x < n}\<close>  \<open>m+1 = n\<close> 
+            by auto
+          from \<open>n > 1\<close> have \<open>m \<noteq> 0\<close> 
+            using \<open>m + 1 = n\<close> by linarith
+          have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m}\<close> 
+            using Suc_eq_plus1 \<open>1 < n\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j |j. j < m}\<close> 
+            by auto
+          hence \<open>(\<exists> m.  m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m})\<close>
+            using \<open>m \<noteq> 0\<close> 
+            by blast
+          thus ?thesis by blast
+        qed
+        hence \<open>\<exists>m.  m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*1| j::nat. j < m}\<close>
+          by auto
+        thus ?thesis
+          by blast 
+      qed
+      moreover have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+        if "\<exists>k. n = 2 ^ k"
+      proof-
+        obtain k where \<open>n = 2 ^ k\<close>
+          using \<open>\<exists>k. n = 2 ^ k\<close> by auto
+        have \<open>k \<noteq> 0\<close> 
+          by (metis \<open>1 < n\<close> \<open>n = 2 ^ k\<close> nat_less_le power.simps(1))
+        obtain t where \<open>Suc t = k\<close> 
+          by (metis \<open>k \<noteq> 0\<close> fib.cases)
+        have \<open>n = 2^(Suc t)\<close> 
+          by (simp add: \<open>Suc t = k\<close> \<open>n = 2 ^ k\<close>)
+        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < 2^t}\<close>
+        proof
+          show "{x |x. x < n \<and> coprime x n} \<subseteq> {1 + j * 2 |j. j < 2^t}"
+          proof
+            fix x
+            assume \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
+            hence \<open>x < n\<close>
+              by blast
+            have \<open>coprime x n\<close>
+              using \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
+              by blast
+            hence \<open>coprime x (2^(Suc k))\<close>
+              by (simp add: \<open>k \<noteq> 0\<close> \<open>n = 2 ^ k\<close>)              
+            have \<open>odd x\<close>
+              using \<open>coprime x n\<close> \<open>k \<noteq> 0\<close> \<open>n = 2 ^ k\<close> 
+              by auto 
+            then obtain j where \<open>x = 1+j*2\<close>
+              by (metis add.commute add.left_commute left_add_twice mult_2_right oddE)
+            have \<open>x < 2^k\<close>
+              using \<open>n = 2 ^ k\<close> \<open>x < n\<close> \<open>x = 1+j*2\<close> 
+              by linarith
+            hence \<open>1+j*2 < 2^k\<close>
+              using \<open>x = 1+j*2\<close>
+              by blast
+            hence \<open>j < 2^t\<close>
+              using \<open>Suc t = k\<close> by auto              
+            thus \<open>x \<in> {1 + j * 2 |j. j < 2^t}\<close>
+              using \<open>x = 1+j*2\<close>
+              by blast
+          qed
+          show "{1 + j * 2 |j. j < 2 ^ t} \<subseteq> {x |x. x < n \<and> coprime x n}"
+          proof
+            fix x::nat
+            assume \<open>x \<in> {1 + j * 2 |j. j < 2 ^ t}\<close>
+            then obtain j where \<open>x = 1 + j * 2\<close> and \<open>j < 2 ^ t\<close>
+              by blast
+            have \<open>x < 2*(2^t)\<close>
+              using  \<open>x = 1 + j * 2\<close>  \<open>j < 2 ^ t\<close>
+              by linarith              
+            hence \<open>x < n\<close>
+              by (simp add: \<open>n = 2 ^ Suc t\<close>)
+            moreover have \<open>coprime x n\<close>
+              by (metis (no_types) \<open>\<And>thesis. (\<And>j. \<lbrakk>x = 1 + j * 2; j < 2 ^ t\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> \<open>n = 2 ^ k\<close> coprime_Suc_left_nat coprime_mult_right_iff coprime_power_right_iff plus_1_eq_Suc)              
+            ultimately show \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
+              by blast
+          qed
+        qed
+        have \<open>(2::nat)^(t::nat) \<noteq> 0\<close> 
+          by simp
+        obtain m where \<open>m = (2::nat)^t\<close> by blast
+        have \<open>m \<noteq> 0\<close> 
+          using \<open>m = 2 ^ t\<close> 
+          by auto
+        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
+          using \<open>m = 2 ^ t\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < 2 ^ t}\<close> 
+          by auto
+        from  \<open>m \<noteq> 0\<close>  \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
+        show ?thesis by blast
+      qed
+      moreover have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+        if "n = 6"
+      proof-
+        have  \<open>{x | x. x < 6 \<and> coprime x 6} = {1+j*4| j::nat. j < 2}\<close>
+        proof-
+          have \<open>{x | x::nat. x < 6 \<and> coprime x 6} = {1, 5}\<close>
+          proof
+            show "{u. \<exists>x. u = (x::nat) \<and> x < 6 \<and> coprime x 6} \<subseteq> {1, 5}"
+            proof
+              fix u::nat
+              assume \<open>u \<in> {u. \<exists>x. u = x \<and> x < 6 \<and> coprime x 6}\<close>
+              hence \<open>coprime u 6\<close>
+                by blast
+              have \<open>u < 6\<close>
+                using \<open>u \<in> {u. \<exists>x. u = x \<and> x < 6 \<and> coprime x 6}\<close>
+                by blast
+              moreover have \<open>u \<noteq> 0\<close>
+                using \<open>coprime u 6\<close> ord_eq_0 
+                by fastforce
+              moreover have \<open>u \<noteq> 2\<close>
+                using \<open>coprime u 6\<close>
+                by auto
+              moreover have \<open>u \<noteq> 3\<close>
+              proof-
+                have \<open>gcd (3::nat) 6 = 3\<close>
+                  by auto
+                thus ?thesis 
+                  by (metis (no_types) \<open>coprime u 6\<close> \<open>gcd 3 6 = 3\<close> coprime_iff_gcd_eq_1 
+                      numeral_eq_one_iff semiring_norm(86))
+              qed
+              moreover have \<open>u \<noteq> 4\<close>
+              proof-
+                have \<open>gcd (4::nat) 6 = 2\<close>
+                  by (metis (no_types, lifting) add_numeral_left gcd_add1 gcd_add2 gcd_nat.idem
+                      numeral_Bit0 numeral_One one_plus_numeral semiring_norm(4) semiring_norm(5))
+                thus ?thesis
+                  using \<open>coprime u 6\<close> coprime_iff_gcd_eq_1 
+                  by auto 
+              qed
+              ultimately have \<open>u = 1 \<or> u = 5\<close>
+                by auto
+              thus \<open>u \<in> {1, 5}\<close>
+                by blast
+            qed
+            show "{1::nat, 5} \<subseteq> {x |x. x < 6 \<and> coprime x 6}"
+            proof-
+              have \<open>(1::nat) \<in> {x |x. x < 6 \<and> coprime x 6}\<close>
+                by simp                
+              moreover have \<open>(5::nat) \<in> {x |x. x < 6 \<and> coprime x 6}\<close>
+                by (metis Suc_numeral coprime_Suc_right_nat less_add_one mem_Collect_eq
+                    numeral_plus_one semiring_norm(5) semiring_norm(8))                
+              ultimately show ?thesis 
+                by blast
+            qed
+          qed
+          moreover have \<open>{1+j*4| j::nat. j < 2} = {1, 5}\<close>
+            by auto
+          ultimately show ?thesis by auto
+        qed
+        moreover have \<open>(2::nat) \<noteq> 0\<close>
+          by simp          
+        ultimately have \<open>\<exists> m.  m \<noteq> 0 \<and> {x | x :: nat. x < 6 \<and> coprime x 6} = {1+j*4| j::nat. j < m}\<close>
+          by blast
+        thus ?thesis
+          using that 
+          by auto 
+      qed
+      ultimately show ?thesis
+        using that 
+        by blast 
+    qed
+    show "prime n \<or> (\<exists>k. n = 2 ^ k) \<or> n = 6"
+      if "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+    proof-
+      obtain b m where \<open>m \<noteq> 0\<close> and \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
+        using \<open>\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+        by auto
+      show ?thesis
+      proof(cases \<open>n = 2\<close>)
+        case True
+        thus ?thesis
+          by auto 
+      next
+        case False
+        have \<open>b \<le> 4\<close>
+        proof(cases \<open>odd b\<close>)
+          case True
+          show ?thesis
+          proof(rule classical)
+            assume \<open>\<not>(b \<le> 4)\<close>
+            hence \<open>b > 4\<close> 
+              using le_less_linear 
+              by blast
+            obtain m where \<open>m \<noteq> 0\<close> 
+              and \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
+              using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            have \<open>b \<noteq> 0\<close> 
+              using \<open>4 < b\<close> 
+              by linarith
+            have \<open>n = 2 + (m-1)*b\<close> 
+            proof-
+              have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                using \<open>1 < n\<close> coprime_diff_one_left_nat 
+                by auto
+              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast
+              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
+                by blast
+              have \<open>i \<le> m-1\<close> 
+                using \<open>i < m\<close> 
+                by linarith
+              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>m \<noteq> 0\<close> 
+                by auto
+              hence \<open>1 + (m-1)*b \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
+                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast
+              hence \<open>1 + (m-1)*b < n\<close> 
+                by blast
+              hence \<open>1 + (m-1)*b \<le> n-1\<close> 
+                by linarith
+              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
+                using \<open>n - 1 = 1 + i * b\<close> 
+                by linarith
+              hence \<open>(m-1)*b \<le> i*b\<close> 
+                by linarith
+              hence \<open>m-1 \<le> i\<close> 
+                using \<open>b \<noteq> 0\<close> 
+                by auto
+              hence \<open>m-1 = i\<close> 
+                using \<open>i \<le> m - 1\<close> le_antisym 
+                by blast
+              thus ?thesis 
+                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close> 
+                by auto
+            qed
+            have \<open>m \<ge> 2\<close> 
+              using \<open>n = 2 + (m - 1)*b\<close> \<open>n \<noteq> 2\<close> 
+              by auto
+            hence \<open>1+b \<in> {1+j*b| j. j < m}\<close> 
+              by fastforce
+            hence  \<open>1+b \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
+              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            hence \<open>coprime (1+b) n\<close> 
+              by blast
+            have \<open>(2::nat) dvd (1+b)\<close> 
+              using \<open>odd b\<close> 
+              by simp
+            hence \<open>coprime (2::nat) n\<close> 
+              using \<open>coprime (1 + b) n\<close> coprime_common_divisor coprime_left_2_iff_odd odd_one 
+              by blast
+            have \<open>(2::nat) < n\<close> 
+              using \<open>1 < n\<close> \<open>n \<noteq> 2\<close> 
+              by linarith
+            have \<open>2 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+              using \<open>2 < n\<close> \<open>coprime 2 n\<close> 
+              by blast 
+            hence  \<open>2 \<in> {1+j*b| j::nat. j < m}\<close> 
+              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            then obtain j::nat where \<open>2 = 1+j*b\<close> 
+              by blast 
+            have  \<open>1 = j*b\<close> 
+              using \<open>2 = 1+j*b\<close>
+              by linarith
+            thus ?thesis 
+              by simp
+          qed
+        next
+          case False
+          hence \<open>even b\<close>
+            by simp
+          show ?thesis
+          proof(rule classical)
+            assume \<open>\<not>(b \<le> 4)\<close>
+            hence \<open>b > 4\<close> 
+              using le_less_linear 
+              by blast
+            obtain m where  \<open> m \<noteq> 0\<close>
+              and \<open>{x | x::nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
+              using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            have \<open>b \<noteq> 0\<close> 
+              using \<open>4 < b\<close> 
+              by linarith
+            have \<open>n = 2 + (m-1)*b\<close> 
+            proof-
+              have \<open>n-1 \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
+                using \<open>1 < n\<close> coprime_diff_one_left_nat 
+                by auto
+              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast
+              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
+                by blast
+              have \<open>i \<le> m-1\<close> 
+                using \<open>i < m\<close> 
+                by linarith
+              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>m \<noteq> 0\<close> 
+                by auto
+              hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast
+              hence \<open>1 + (m-1)*b < n\<close> 
+                by blast
+              hence \<open>1 + (m-1)*b \<le> n-1\<close> 
+                by linarith
+              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
+                using \<open>n - 1 = 1 + i * b\<close> 
+                by linarith
+              hence \<open>(m-1)*b \<le> i*b\<close> 
+                by linarith
+              hence \<open>m-1 \<le> i\<close> 
+                using \<open>b \<noteq> 0\<close> 
+                by auto
+              hence \<open>m-1 = i\<close> 
+                using \<open>i \<le> m - 1\<close> le_antisym 
+                by blast
+              thus ?thesis 
+                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close> 
+                by auto
+            qed
+            obtain k :: nat where \<open>b = 2*k\<close> 
+              using \<open>even b\<close>
+              by blast
+            have \<open>n = 2*(1 + (m-1)*k)\<close>
+              using  \<open>n = 2 + (m-1)*b\<close>  \<open>b = 2*k\<close> 
+              by simp
+            show ?thesis
+            proof (cases \<open>odd m\<close>)
+              case True
+              hence \<open>odd m\<close> by blast
+              then obtain t::nat where \<open>m-1 = 2*t\<close> 
+                by (metis odd_two_times_div_two_nat)
+              have  \<open>n = 2*(1 + b*t)\<close> 
+                using \<open>m - 1 = 2 * t\<close> \<open>n = 2 + (m - 1) * b\<close> 
+                by auto
+              have \<open>t < m\<close> 
+                using \<open>m - 1 = 2 * t\<close> \<open>m \<noteq> 0\<close> 
+                by linarith
+              have \<open>1 + b*t \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>t < m\<close> 
+                by auto 
+              hence \<open>1 + b*t \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
+                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast 
+              hence \<open>coprime (1 + b*t) n\<close> 
+                by auto
+              thus ?thesis 
+                by (metis (no_types, lifting) \<open>b = 2 * k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 * (1 + b * t)\<close> \<open>n = 2 + (m - 1) * b\<close> \<open>n \<noteq> 2\<close> add_cancel_right_right coprime_mult_right_iff coprime_self mult_cancel_left mult_is_0 nat_dvd_1_iff_1)
+            next
+              case False
+              thus ?thesis
+              proof(cases \<open>odd k\<close>)
+                case True
+                hence \<open>odd k\<close>
+                  by blast
+                have \<open>even (1 + (m - 1) * k)\<close> 
+                  by (simp add: False True \<open>m \<noteq> 0\<close>)
+                have \<open>coprime (2 + (m - 1) * k) (1 + (m - 1) * k)\<close> 
+                  by simp
+                have \<open>coprime (2 + (m - 1) * k) n\<close> 
+                  using \<open>coprime (2 + (m - 1) * k) (1 + (m - 1) * k)\<close> \<open>even (1 + (m - 1) * k)\<close> 
+                    \<open>n = 2 * (1 + (m - 1) * k)\<close> coprime_common_divisor coprime_mult_right_iff
+                    coprime_right_2_iff_odd odd_one 
+                  by blast
+                have \<open>2 + (m - 1) * k < n\<close> 
+                  by (metis (no_types, lifting) \<open>even (1 + (m - 1) * k)\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close>
+                      add_gr_0 add_mono_thms_linordered_semiring(1) dvd_add_left_iff dvd_add_triv_left_iff dvd_imp_le le_add2 le_neq_implies_less less_numeral_extra(1) mult_2 odd_one)
+                have \<open>2 + (m - 1) * k  \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                  using \<open>2 + (m - 1) * k < n\<close> \<open>coprime (2 + (m - 1) * k) n\<close> 
+                  by blast
+                hence \<open>2 + (m - 1) * k  \<in> {1 + j * b |j. j < m}\<close> 
+                  using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                  by blast
+                then obtain j::nat where  \<open>2 + (m - 1) * k  = 1 + j * b\<close> and \<open>j < m\<close>
+                  by blast
+                have  \<open>1 + (m - 1) * k  = j * b\<close>
+                  using \<open>2 + (m - 1) * k  = 1 + j * b\<close>
+                  by simp
+                hence  \<open>1 + (m - 1) * k  = j * (2*k)\<close> 
+                  using \<open>b = 2 * k\<close> by blast
+                thus ?thesis 
+                  by (metis \<open>b = 2 * k\<close> \<open>even b\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 + (m - 1) * b\<close> dvd_add_times_triv_right_iff dvd_antisym dvd_imp_le dvd_triv_right even_numeral mult_2 zero_less_numeral)
+              next
+                case False
+                hence \<open>even k\<close> by auto
+                have \<open>odd (1 + (m - 1) * k)\<close> 
+                  by (simp add: \<open>even k\<close> )
+                hence \<open>coprime (3 + (m - 1) * k) (1 + (m - 1) * k)\<close> 
+                  by (smt add_numeral_left coprime_common_divisor coprime_right_2_iff_odd dvd_add_left_iff not_coprimeE numeral_Bit1 numeral_One numeral_plus_one one_add_one)
+                hence \<open>coprime (3 + (m - 1) * k) n\<close> 
+                  by (metis \<open>even k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> coprime_mult_right_iff coprime_right_2_iff_odd even_add even_mult_iff odd_numeral)
+                have \<open>3 + (m - 1) * k < n\<close> 
+                  by (smt Groups.add_ac(2) \<open>even k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 + (m - 1) * b\<close> \<open>n \<noteq> 2\<close> add_Suc_right add_cancel_right_right add_mono_thms_linordered_semiring(1) dvd_imp_le even_add even_mult_iff le_add2 le_neq_implies_less left_add_twice mult_2 neq0_conv numeral_Bit1 numeral_One odd_numeral one_add_one plus_1_eq_Suc)
+                have \<open>3 + (m - 1) * k \<in> {x |x. x < n \<and> coprime x n}\<close> 
+                  using \<open>3 + (m - 1) * k < n\<close> \<open>coprime (3 + (m - 1) * k) n\<close> 
+                  by blast
+                hence \<open>3 + (m - 1) * k \<in> {1 + j * b |j. j < m}\<close> 
+                  using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                  by blast 
+                then obtain j::nat where \<open>3 + (m - 1) * k = 1 + j * b\<close> 
+                  by blast  
+                have \<open>2 + (m - 1) * k = j * b\<close> 
+                  using \<open>3 + (m - 1) * k = 1 + j * b\<close> 
+                  by simp
+                hence  \<open>2 + (m - 1) * k = j * 2*k\<close> 
+                  by (simp add: \<open>b = 2 * k\<close>)
+                thus ?thesis 
+                  by (metis \<open>4 < b\<close> \<open>b = 2 * k\<close> \<open>even k\<close> dvd_add_times_triv_right_iff dvd_antisym 
+                      dvd_triv_right mult_2 nat_neq_iff numeral_Bit0)
+              qed
+            qed
+          qed
+        qed
+        moreover have \<open>b \<noteq> 3\<close>
+        proof (rule classical)
+          assume \<open>\<not> (b \<noteq> 3)\<close>
+          hence \<open>b = 3\<close> 
+            by blast
+          obtain m where  \<open>m \<noteq> 0\<close> and 
+            \<open>{x | x::nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
+            using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+            by blast
+          have \<open>b \<noteq> 0\<close> 
+            by (simp add: \<open>b = 3\<close>)
+          have \<open>n = 2 + (m-1)*b\<close> 
+          proof-
+            have \<open>n-1 \<in> {x | x::nat. x < n \<and> coprime x n}\<close> 
+              using \<open>1 < n\<close> coprime_diff_one_left_nat 
+              by auto
+            have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
+              using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+                \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
+              by blast
+            have \<open>i \<le> m-1\<close> 
+              using \<open>i < m\<close> 
+              by linarith
+            have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
+              using \<open>m \<noteq> 0\<close> 
+              by auto
+            hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            hence \<open>1 + (m-1)*b < n\<close> 
+              by blast
+            hence \<open>1 + (m-1)*b \<le> n-1\<close> 
+              by linarith
+            hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
+              using \<open>n - 1 = 1 + i * b\<close> 
+              by linarith
+            hence \<open>(m-1)*b \<le> i*b\<close> 
+              by linarith
+            hence \<open>m-1 \<le> i\<close> 
+              using \<open>b \<noteq> 0\<close> 
+              by auto
+            hence \<open>m-1 = i\<close> 
+              using \<open>i \<le> m - 1\<close> le_antisym 
+              by blast
+            thus ?thesis 
+              using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close> 
+              by auto
+          qed
+          have \<open>n > 2\<close> 
+            using \<open>1 < n\<close> \<open>n \<noteq> 2\<close> 
+            by linarith
+          hence \<open> m \<ge> 2 \<close> using  \<open>n = 2 + (m-1)*b\<close> \<open>b = 3\<close> 
+            by simp
+          have \<open>4 \<in> {1+j*(b::nat)| j::nat. j < m}\<close> 
+            using \<open>2 \<le> m\<close> \<open>b = 3\<close> 
+            by force
+          hence \<open>(4::nat) \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close> 
+            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
+            by auto
+          hence \<open>coprime (4::nat) n\<close> 
+            by blast
+          have \<open>(2::nat) dvd 4\<close> 
+            by auto
+          hence \<open>coprime (2::nat) n\<close> 
+            using \<open>coprime (4::nat) n\<close> coprime_divisors dvd_refl 
+            by blast
+          have \<open>4 < n\<close> 
+            using \<open>4 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+            by blast
+          have \<open>2 < (4::nat)\<close> 
+            by auto
+          have  \<open>2 < n\<close> 
+            by (simp add: \<open>2 < n\<close>)
+          hence \<open>2 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+            using  \<open>coprime (2::nat) n\<close> 
+            by blast
+          hence  \<open>2 \<in> {1+j*(b::nat)| j::nat. j < m}\<close> 
+            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+            by blast
+          then obtain j::nat where \<open>2 = 1+j*3\<close> 
+            using \<open>b = 3\<close> 
+            by blast
+          from  \<open>2 = 1+j*3\<close>
+          have  \<open>1 = j*3\<close> 
+            by auto
+          hence \<open>3 dvd 1\<close> 
+            by auto
+          thus ?thesis
+            using nat_dvd_1_iff_1 numeral_eq_one_iff 
+            by blast
+        qed
+        ultimately have \<open>b = 0 \<or> b = 1 \<or> b = 2 \<or> b = 4\<close>
+          by auto
+        moreover have \<open>b = 0 \<Longrightarrow> \<exists>k. n = 2^k\<close>
+        proof-
+          assume \<open>b = 0\<close>
+          have \<open>{1 + j * b |j. j < m} = {1}\<close>
+            using \<open>b = 0\<close> \<open>m \<noteq> 0\<close> 
+            by auto
+          hence \<open>{x |x. x < n \<and> coprime x n} = {1}\<close>
+            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
+            by blast
+          hence \<open>n = 2\<close>
+          proof-
+            have \<open>n-1 \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close> 
+              using \<open>1 < n\<close> coprime_diff_one_left_nat 
+              by auto
+            have \<open>n-1 \<in> {1}\<close> 
+              using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} = {1}\<close> 
+              by blast
+            hence \<open>n-1 = 1\<close> 
+              by blast
+            hence \<open>n = 2\<close> 
+              by simp
+            thus ?thesis 
+              by blast
+          qed
+          hence \<open>n = 2^1\<close>
+            by auto
+          thus ?thesis
+            by blast 
+        qed
+        moreover have \<open>b = 1 \<Longrightarrow> prime n\<close>
+        proof-
+          assume \<open>b = 1\<close>
+          have \<open>x < n \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> coprime x n\<close>
+            for x
+          proof-
+            assume \<open>x < n\<close> and \<open>x \<noteq> 0\<close>
+            have \<open>{1+j| j::nat. j < m} = {x | x::nat. x < m+1 \<and> x \<noteq> 0}\<close> 
+              by (metis (full_types) Suc_eq_plus1  add_mono1 less_Suc_eq_0_disj  nat.simps(3) plus_1_eq_Suc )
+            hence \<open>{x | x :: nat. x < n \<and> coprime x n} = {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close>
+              using \<open>b = 1\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by auto
+            have \<open>coprime (n-1) n\<close> 
+              using \<open>1 < n\<close> coprime_diff_one_left_nat 
+              by auto
+            have \<open>n-1 < n\<close> 
+              using \<open>1 < n\<close> 
+              by auto
+            have \<open>n-1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+              using \<open>coprime (n - 1) n\<close> \<open>n - 1 < n\<close> 
+              by blast
+            have \<open>n-1 \<le> m\<close> 
+              by (metis (no_types, lifting) CollectD Suc_eq_plus1 Suc_less_eq2 \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close>   leD  le_less_linear not_less_eq_eq )
+            have \<open>m \<in>  {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close> 
+              using \<open>m \<noteq> 0\<close> 
+              by auto
+            have \<open>m \<in> {x |x. x < n \<and> coprime x n} \<close> 
+              using \<open>m \<in> {x |x. x < m + 1 \<and> x \<noteq> 0}\<close> 
+                \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close> 
+              by blast
+            have \<open>m < n\<close> 
+              using \<open>m \<in> {x |x. x < n \<and> coprime x n}\<close> 
+              by blast
+            have \<open>m+1 = n\<close> 
+              using \<open>m < n\<close> \<open>n - 1 \<le> m\<close> 
+              by linarith
+            have \<open>x \<in>  {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close> 
+              using \<open>m + 1 = n\<close> \<open>x < n\<close> \<open>x \<noteq> 0\<close> 
+              by blast
+            hence \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close> 
+              using \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close> 
+              by blast
+            thus ?thesis 
+              by blast
+          qed
+          thus ?thesis
+            using assms coprime_commute nat_neq_iff prime_nat_iff'' by auto 
+        qed
+        moreover have \<open>b = 2 \<Longrightarrow> \<exists> k. n = 2^k\<close>
+        proof-
+          assume \<open>b = 2\<close>
+          have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
+            using \<open>b = 2\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+            by auto
+          have \<open>x < n \<Longrightarrow> coprime x n \<longleftrightarrow> odd x\<close>
+            for x::nat
+          proof-
+            assume \<open>x < n\<close>
+            have \<open>coprime x n \<Longrightarrow> odd x\<close>
+            proof-
+              assume \<open>coprime x n\<close>
+              have \<open>x \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                by (simp add: \<open>coprime x n\<close> \<open>x < n\<close>)
+              hence \<open>x \<in> {1+j*2| j::nat. j < m}\<close> 
+                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < m}\<close> 
+                by blast
+              then obtain j where \<open>x = 1+j*2\<close> 
+                by blast
+              thus ?thesis
+                by simp
+            qed
+            moreover have \<open>odd x \<Longrightarrow> coprime x n\<close>
+            proof-
+              assume \<open>odd x\<close>
+              obtain j::nat where \<open>x = 1+j*2\<close> 
+                by (metis \<open>odd x\<close> add.commute mult_2_right odd_two_times_div_two_succ one_add_one semiring_normalization_rules(16)) 
+              have \<open>j < (n-1)/2\<close> 
+                using \<open>x < n\<close> \<open>x = 1 + j * 2\<close> 
+                by linarith
+              have \<open>n = 2*m\<close>
+              proof-
+                have  \<open>(2::nat) \<noteq> 0\<close> 
+                  by auto
+                have \<open>n = 2+(m-1)*2\<close> 
+                proof-
+                  have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                    using \<open>1 < n\<close> coprime_diff_one_left_nat 
+                    by auto
+                  have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
+                    using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+                      \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                    by blast
+                  then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
+                    by blast
+                  have \<open>i \<le> m-1\<close> 
+                    using \<open>i < m\<close> 
+                    by linarith
+                  have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
+                    using \<open>m \<noteq> 0\<close> by auto
+                  hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                    using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                    by blast
+                  hence \<open>1 + (m-1)*b < n\<close> 
+                    by blast
+                  hence \<open>1 + (m-1)*b \<le> n-1\<close> 
+                    by linarith
+                  hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
+                    using \<open>n - 1 = 1 + i * b\<close> 
+                    by linarith
+                  hence \<open>(m-1)*b \<le> i*b\<close> 
+                    by linarith
+                  hence \<open>m-1 \<le> i\<close> 
+                  proof-
+                    have \<open>b \<noteq> 0\<close>
+                      using \<open>b = 2\<close>
+                      by simp
+                    thus ?thesis
+                      using \<open>(m - 1) * b \<le> i * b\<close> mult_le_cancel2 
+                      by blast 
+                  qed
+                  hence \<open>m-1 = i\<close> 
+                    using \<open>i \<le> m - 1\<close> le_antisym 
+                    by blast
+                  thus ?thesis 
+                    using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
+                    by (simp add: \<open>b = 2\<close>)
+                qed
+                thus  ?thesis 
+                  by (simp add: \<open>m \<noteq> 0\<close> \<open>n = 2 + (m - 1) * 2\<close> mult.commute mult_eq_if)
+              qed
+              hence \<open>j < m\<close> 
+                using \<open>x < n\<close> \<open>x = 1 + j * 2\<close> 
+                by linarith
+              hence \<open>x \<in> {1+j*2| j::nat. j < m}\<close> 
+                using \<open>x = 1 + j * 2\<close> 
+                by blast
+              hence \<open>x \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < m}\<close> 
+                by blast
+              thus ?thesis 
+                by blast
+            qed
+            ultimately show ?thesis 
+              by blast
+          qed
+          thus ?thesis 
+            using coprime_power2 assms 
+            by auto
+        qed
+        moreover have \<open>b = 4 \<Longrightarrow> n = 6\<close>
+        proof-
+          assume \<open>b = 4\<close>
+          have \<open>n = 2 \<or> n = 6\<close>
+          proof(rule classical)
+            assume \<open>\<not> (n = 2 \<or> n = 6)\<close>
+            have  \<open>(4::nat) \<noteq> 0\<close> 
+              by auto
+            have \<open>n =  2+(m-1)*4\<close> 
+            proof-
+              have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                using \<open>1 < n\<close> coprime_diff_one_left_nat 
+                by auto
+              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> 
+                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast
+              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close> 
+                by blast
+              have \<open>i \<le> m-1\<close> 
+                using \<open>i < m\<close> 
+                by linarith
+              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close> 
+                using \<open>m \<noteq> 0\<close> 
+                by auto
+              hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+                by blast
+              hence \<open>1 + (m-1)*b < n\<close> 
+                by blast
+              hence \<open>1 + (m-1)*b \<le> n-1\<close> 
+                by linarith
+              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close> 
+                using \<open>n - 1 = 1 + i * b\<close> 
+                by linarith
+              hence \<open>(m-1)*b \<le> i*b\<close> 
+                by linarith
+              hence \<open>m-1 \<le> i\<close> 
+              proof-
+                have \<open>b \<noteq> 0\<close>
+                  using \<open>b = 4\<close> by auto
+                thus ?thesis
+                  using \<open>(m - 1) * b \<le> i * b\<close> mult_le_cancel2 
+                  by blast 
+              qed
+              hence \<open>m-1 = i\<close> 
+                using \<open>i \<le> m - 1\<close> le_antisym 
+                by blast
+              thus ?thesis 
+                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
+                by (simp add: \<open>b = 4\<close>) 
+            qed
+            hence \<open>n = 4*m - 2\<close> 
+              by (simp add: \<open>m \<noteq> 0\<close> mult.commute mult_eq_if)
+            have \<open>m \<ge> 3\<close> 
+              using \<open>\<not> (n = 2 \<or> n = 6)\<close> \<open>n = 2 + (m - 1) * 4\<close> 
+              by auto
+            hence \<open> {1+j*4| j::nat. j < 3} \<subseteq> {1+j*4| j::nat. j < m}\<close>
+              by force
+            hence \<open>9 \<in> {1+j*4| j::nat. j < 3}\<close> 
+              by force
+            hence \<open>9 \<in> {1+j*4| j::nat. j < m}\<close> 
+              using  \<open> {1+j*4| j::nat. j < 3} \<subseteq> {1+j*4| j::nat. j < m}\<close> 
+              by blast
+            hence \<open>9 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
+              using \<open>b = 4\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by auto
+            hence \<open>coprime (9::nat) n\<close> 
+              by blast
+            have \<open>(3::nat) dvd 9\<close> 
+              by auto
+            have  \<open>coprime (3::nat) n\<close> using  \<open>coprime (9::nat) n\<close> \<open>(3::nat) dvd 9\<close>
+              by (metis coprime_commute coprime_mult_right_iff dvd_def)
+            have \<open>(3::nat) < n\<close> 
+              by (metis One_nat_def Suc_lessI \<open>1 < n\<close> \<open>\<not> (n = 2 \<or> n = 6)\<close> \<open>coprime 3 n\<close>
+                  coprime_self numeral_2_eq_2 numeral_3_eq_3 less_numeral_extra(1) nat_dvd_not_less)
+            have \<open>3 \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close> 
+              using \<open>3 < n\<close> \<open>coprime 3 n\<close> 
+              by blast
+            hence  \<open>(3::nat) \<in> {1+j*4| j::nat. j < m}\<close>
+              using \<open>b = 4\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close> 
+              by blast
+            then obtain j::nat where \<open>(3::nat) = 1 + j*4\<close> 
+              by blast  
+            have \<open>2 = j*4\<close> 
+              using numeral_3_eq_3 \<open>(3::nat) = 1 + j*4\<close>
+              by linarith
+            hence \<open>1 = j*2\<close> 
+              by linarith
+            hence \<open>even 1\<close> 
+              by simp
+            thus ?thesis 
+              using odd_one 
+              by blast
+          qed
+          thus ?thesis
+            by (simp add: False)            
+        qed
+        ultimately show ?thesis 
+          by blast
+      qed
+    qed
+  qed
+  moreover have \<open>(\<exists> b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m})
+  \<longleftrightarrow> (\<exists> a b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m})\<close>
+  proof
+    show "\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}"
+      if "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+      using that
+      by blast 
+    show "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
+      if "\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}"
+    proof-
+      obtain a b m::nat where \<open>m \<noteq> 0\<close>
+        and \<open>{x | x :: nat. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m}\<close>
+        using \<open>\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> 
+        by auto        
+      have \<open>a = 1\<close> 
+      proof-
+        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {(a::nat)+j*(b::nat)| j::nat. j < m} \<Longrightarrow> a = 1\<close>
+        proof-
+          have \<open>Min {x | x :: nat. x < n \<and> coprime x n} = Min {a+j*b| j::nat. j < m}\<close>
+            using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> 
+            by auto            
+          have  \<open>Min {x | x :: nat. x < n \<and> coprime x n} = 1\<close>
+          proof-
+            have \<open>finite {x | x :: nat. x < n \<and> coprime x n}\<close>
+              by auto
+            have \<open>{x | x :: nat. x < n \<and> coprime x n} \<noteq> {}\<close> 
+              using \<open>1 < n\<close> by auto
+            have \<open>1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close> 
+              using \<open>1 < n\<close> 
+              by auto
+            have \<open>\<forall> x. coprime x n \<longrightarrow> x \<ge> 1\<close> 
+              using \<open>1 < n\<close> le_less_linear 
+              by fastforce
+            hence \<open>\<forall> x.  x < n \<and> coprime x n \<longrightarrow> x \<ge> 1\<close> 
+              by blast
+            hence \<open>\<forall> x \<in> {x | x :: nat. x < n \<and> coprime x n}. x \<ge> 1\<close> 
+              by blast
+            hence \<open>Min {x | x :: nat. x < n \<and> coprime x n} \<ge> 1\<close> 
+              using \<open>finite {x | x :: nat. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} \<noteq> {}\<close>
+              by auto
+            thus ?thesis 
+              using Min_le \<open>1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>finite {x |x. x < n \<and> coprime x n}\<close>
+                antisym by blast
+          qed
+          have \<open>Min  {a+j*b| j::nat. j < m} = a\<close>
+          proof -
+            have f1: "\<exists>n. a = a + n * b \<and> n < m"
+              using \<open>m \<noteq> 0\<close> 
+              by auto
+            have f2: "\<exists>n. 1 = a + n * b \<and> n < m"
+              using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> assms coprime_1_left 
+              by blast
+            have f3: "\<exists>na. a = na \<and> na < n \<and> coprime na n"
+              using f1 \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> by blast
+            have "n \<noteq> 1"
+              by (metis (lifting) assms less_irrefl_nat)
+            then have "\<not> coprime 0 n"
+              by simp
+            then show ?thesis
+              using f3 f2 by (metis \<open>Min {x |x. x < n \<and> coprime x n} = 1\<close> \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> less_one linorder_neqE_nat not_add_less1)
+          qed
+          hence \<open>Min  {a+j*b| j::nat. j < m} = a\<close> by blast
+          thus ?thesis 
+            using \<open>Min {x | x :: nat. x < n \<and> coprime x n} = 1\<close> \<open>Min {x | x :: nat. x < n \<and> coprime x n} = Min {a+j*b| j::nat. j < m}\<close>
+            by linarith
+        qed
+        thus ?thesis
+          using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> 
+          by blast 
+      qed
+      thus ?thesis using  \<open>m \<noteq> 0\<close> \<open>{x | x. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m}\<close> 
+        by auto
+    qed
+  qed 
+  ultimately show ?thesis
+    by simp 
+qed
+
 end
\ No newline at end of file
diff --git a/thys/Arith_Prog_Rel_Primes/document/root.bib b/thys/Arith_Prog_Rel_Primes/document/root.bib
--- a/thys/Arith_Prog_Rel_Primes/document/root.bib
+++ b/thys/Arith_Prog_Rel_Primes/document/root.bib
@@ -1,5 +1,5 @@
-
-@misc{putnam,
-  title="Problem {``ARITHMETIC PROGRESSIONS"}, from {P}utnam exam problems 2002, https://www.ocf.berkeley.edu/~wwu/riddles/putnam.shtml"
-}
-
+
+@misc{putnam,
+  title="Problem {``ARITHMETIC PROGRESSIONS"}, from {P}utnam exam problems 2002, https://www.ocf.berkeley.edu/~wwu/riddles/putnam.shtml"
+}
+
diff --git a/thys/Arith_Prog_Rel_Primes/document/root.tex b/thys/Arith_Prog_Rel_Primes/document/root.tex
--- a/thys/Arith_Prog_Rel_Primes/document/root.tex
+++ b/thys/Arith_Prog_Rel_Primes/document/root.tex
@@ -1,31 +1,31 @@
-\documentclass[11pt,a4paper]{article}
-\usepackage{isabelle,isabellesym}
-
-
-%this should be the last package used
-\usepackage{pdfsetup}
-
-% urls in roman style, theory text in math-similar italics
-\urlstyle{rm}
-\isabellestyle{it}
-
-\begin{document}
-
-\title{Arithmetic progressions and relative primes}
-\author{Jos\'e Manuel Rodr\'iguez Caballero}
-\maketitle
-
-\begin{abstract}
-This article provides a formalization of the solution obtained by the author of the Problem ``ARITHMETIC PROGRESSIONS" from the 
-Putnam exam problems \cite{putnam} of $2002$. The statement of the problem is as follows: For which integers $n>1$ does the set of positive integers less than and relatively prime to $n$ constitute an arithmetic progression?
-\end{abstract}
-
-\tableofcontents
-
-\input{session}
-
-
-\bibliographystyle{abbrv}
-\bibliography{root}
-
-\end{document}
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+
+
+%this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+\begin{document}
+
+\title{Arithmetic progressions and relative primes}
+\author{Jos\'e Manuel Rodr\'iguez Caballero}
+\maketitle
+
+\begin{abstract}
+This article provides a formalization of the solution obtained by the author of the Problem ``ARITHMETIC PROGRESSIONS" from the 
+Putnam exam problems \cite{putnam} of $2002$. The statement of the problem is as follows: For which integers $n>1$ does the set of positive integers less than and relatively prime to $n$ constitute an arithmetic progression?
+\end{abstract}
+
+\tableofcontents
+
+\input{session}
+
+
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+\end{document}
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)
-  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
+(*
+  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)
+  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      
-    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
+(*
+  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      
+    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/Banach_Steinhaus/ROOT b/thys/Banach_Steinhaus/ROOT
--- a/thys/Banach_Steinhaus/ROOT
+++ b/thys/Banach_Steinhaus/ROOT
@@ -1,13 +1,13 @@
-chapter AFP
-
-session Banach_Steinhaus (AFP) = "HOL-Analysis" +
-  options [timeout = 300]
-  sessions
-    "HOL-Types_To_Sets"
-    "HOL-ex"
-  theories
-    Banach_Steinhaus
-    Banach_Steinhaus_Missing
-  document_files
-    "root.tex"
-    "root.bib"
+chapter AFP
+
+session Banach_Steinhaus (AFP) = "HOL-Analysis" +
+  options [timeout = 300]
+  sessions
+    "HOL-Types_To_Sets"
+    "HOL-ex"
+  theories
+    Banach_Steinhaus
+    Banach_Steinhaus_Missing
+  document_files
+    "root.tex"
+    "root.bib"
diff --git a/thys/Banach_Steinhaus/document/root.bib b/thys/Banach_Steinhaus/document/root.bib
--- a/thys/Banach_Steinhaus/document/root.bib
+++ b/thys/Banach_Steinhaus/document/root.bib
@@ -1,26 +1,26 @@
-@article{banach1927principe,
-  title={Sur le principe de la condensation de singularit{\'e}s},
-  author={Banach, Stefan and Steinhaus, Hugo},
-  journal={Fundamenta Mathematicae},
-  volume={1},
-  number={9},
-  pages={50--61},
-  year={1927}
-}
-
-@article{sokal2011really,
-  title={A really simple elementary proof of the uniform boundedness theorem},
-  author={Sokal, Alan D},
-  journal={The American Mathematical Monthly},
-  volume={118},
-  number={5},
-  pages={450--452},
-  year={2011},
-  publisher={Taylor \& Francis}
-}
-
-@article{Weisstein_UBP,
-  title={Uniform Boundedness Principle},
-  author={Moslehian, Mohammad Sal and Weisstein, Eric W.},
-  journal={From MathWorld--A Wolfram Web Resource. http://mathworld.wolfram.com/UniformBoundednessPrinciple.html}
-}
+@article{banach1927principe,
+  title={Sur le principe de la condensation de singularit{\'e}s},
+  author={Banach, Stefan and Steinhaus, Hugo},
+  journal={Fundamenta Mathematicae},
+  volume={1},
+  number={9},
+  pages={50--61},
+  year={1927}
+}
+
+@article{sokal2011really,
+  title={A really simple elementary proof of the uniform boundedness theorem},
+  author={Sokal, Alan D},
+  journal={The American Mathematical Monthly},
+  volume={118},
+  number={5},
+  pages={450--452},
+  year={2011},
+  publisher={Taylor \& Francis}
+}
+
+@article{Weisstein_UBP,
+  title={Uniform Boundedness Principle},
+  author={Moslehian, Mohammad Sal and Weisstein, Eric W.},
+  journal={From MathWorld--A Wolfram Web Resource. http://mathworld.wolfram.com/UniformBoundednessPrinciple.html}
+}
diff --git a/thys/Banach_Steinhaus/document/root.tex b/thys/Banach_Steinhaus/document/root.tex
--- a/thys/Banach_Steinhaus/document/root.tex
+++ b/thys/Banach_Steinhaus/document/root.tex
@@ -1,30 +1,30 @@
-\documentclass[11pt,a4paper]{article}
-\usepackage{isabelle,isabellesym}
-\usepackage{amsmath,amssymb}
-
-%this should be the last package used
-\usepackage{pdfsetup}
-
-% urls in roman style, theory text in math-similar italics
-\urlstyle{rm}
-\isabellestyle{it}
-
-\begin{document}
-
-\title{Banach-Steinhaus theorem}
-\author{Dominique Unruh \and Jos\'e Manuel Rodr\'iguez Caballero}
-\maketitle
-
-\begin{abstract}
-We formalize in Isabelle/HOL a result \cite{Weisstein_UBP} due to S. Banach and H. Steinhaus \cite{banach1927principe} known as Banach-Steinhaus theorem or Uniform boundedness principle: a pointwise-bounded family of continuous linear operators from a Banach space to a normed space is uniformly bounded. Our approach is an adaptation to Isabelle/HOL of a proof due to A. Sokal \cite{sokal2011really}.
-\end{abstract}
-
-\tableofcontents
-
-\input{session}
-
-
-\bibliographystyle{abbrv}
-\bibliography{root}
-
-\end{document}
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+\usepackage{amsmath,amssymb}
+
+%this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+\begin{document}
+
+\title{Banach-Steinhaus theorem}
+\author{Dominique Unruh \and Jos\'e Manuel Rodr\'iguez Caballero}
+\maketitle
+
+\begin{abstract}
+We formalize in Isabelle/HOL a result \cite{Weisstein_UBP} due to S. Banach and H. Steinhaus \cite{banach1927principe} known as Banach-Steinhaus theorem or Uniform boundedness principle: a pointwise-bounded family of continuous linear operators from a Banach space to a normed space is uniformly bounded. Our approach is an adaptation to Isabelle/HOL of a proof due to A. Sokal \cite{sokal2011really}.
+\end{abstract}
+
+\tableofcontents
+
+\input{session}
+
+
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+\end{document}
diff --git a/thys/FOL_Harrison/document/root.tex b/thys/FOL_Harrison/document/root.tex
--- a/thys/FOL_Harrison/document/root.tex
+++ b/thys/FOL_Harrison/document/root.tex
@@ -1,80 +1,80 @@
-\documentclass[a4paper]{article}
-
-\title{First-Order Logic According to Harrison}
-
-\author{Alexander Birch Jensen, Anders Schlichtkrull \&\\ J{\o}rgen Villadsen, DTU Compute, Denmark}
-
-\date{\isadate\today}
-
-\usepackage[left=15mm,right=15mm,top=20mm,bottom=27mm]{geometry}
-
-\usepackage{datetime,isabelle,isabellesym,parskip}
-
-\newdateformat{isadate}{\THEDAY\ \monthname[\THEMONTH] \THEYEAR}
-
-\usepackage{pdfsetup}
-
-\isabellestyle{tt}
-
-\urlstyle{rm}
-
-%\renewcommand{\isachardoublequote}{}
-%\renewcommand{\isachardoublequoteopen}{}
-%\renewcommand{\isachardoublequoteclose}{}
-
-\renewcommand{\isamarkupchapter}[1]{\clearpage\isamarkupsection{#1}\medskip}
-\renewcommand{\isamarkupsection}[1]{\medskip\section*{#1}\addcontentsline{toc}{section}{#1}\medskip}
-\renewcommand{\isamarkupsubsection}[1]{\medskip\subsection*{#1}\medskip}
-\renewcommand{\isamarkupsubsubsection}[1]{\medskip\subsubsection*{#1}\medskip}
-
-\renewcommand{\isabeginpar}{\par\ifisamarkup\relax\else\bigskip\fi}
-\renewcommand{\isaendpar}{\par\bigskip}
-
-\begin{document}
-
-\makeatletter
-\parbox[t]{\textwidth}{\centering\Huge\bfseries\@title}\par\kern5mm
-\parbox[t]{\textwidth}{\centering\Large\bfseries\@author}\par\kern3mm
-\parbox[t]{\textwidth}{\centering\bfseries\@date}\par\kern8mm
-\makeatother
-
-\begin{abstract}\normalsize\noindent
-We present a certified declarative first-order prover with equality based on John Harrison's
-Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009. ML code
-reflection is used such that the entire prover can be executed within Isabelle as a very simple
-interactive proof assistant. As examples we consider Pelletier's problems 1-46.
-\end{abstract}
-
-\tableofcontents
-
-\isamarkupsection{Preample}
-
-Preliminary formalizations are described here:
-\begin{trivlist}
-\item
-Alexander Birch Jensen:
-\emph{Development and Verification of a Proof Assistant.}
-Master's Thesis, Technical University of Denmark, 2016.
-\url{http://findit.dtu.dk/en/catalog/2345011633}
-\item
-Alexander Birch Jensen, Anders Schlichtkrull \&\ J{\o}rgen Villadsen:
-\emph{Verification of an LCF-Style First-Order Prover with Equality.}
-Isabelle Workshop 2016.
-\url{https://github.com/logic-tools/sml-handbook}
-\end{trivlist}
-
-\clearpage
-
-\input{session}
-
-\clearpage
-
-\isamarkupsection{Acknowledgements}
-
-The SML code is based on the OCaml code accompanying John Harrison's
-Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009
-
-Thanks to Jasmin Blanchette, Asta Halkj{\ae}r From, John Bruntse Larsen, Andrei Popescu and
-Tom Ridge for discussions.
-
-\end{document}
+\documentclass[a4paper]{article}
+
+\title{First-Order Logic According to Harrison}
+
+\author{Alexander Birch Jensen, Anders Schlichtkrull \&\\ J{\o}rgen Villadsen, DTU Compute, Denmark}
+
+\date{\isadate\today}
+
+\usepackage[left=15mm,right=15mm,top=20mm,bottom=27mm]{geometry}
+
+\usepackage{datetime,isabelle,isabellesym,parskip}
+
+\newdateformat{isadate}{\THEDAY\ \monthname[\THEMONTH] \THEYEAR}
+
+\usepackage{pdfsetup}
+
+\isabellestyle{tt}
+
+\urlstyle{rm}
+
+%\renewcommand{\isachardoublequote}{}
+%\renewcommand{\isachardoublequoteopen}{}
+%\renewcommand{\isachardoublequoteclose}{}
+
+\renewcommand{\isamarkupchapter}[1]{\clearpage\isamarkupsection{#1}\medskip}
+\renewcommand{\isamarkupsection}[1]{\medskip\section*{#1}\addcontentsline{toc}{section}{#1}\medskip}
+\renewcommand{\isamarkupsubsection}[1]{\medskip\subsection*{#1}\medskip}
+\renewcommand{\isamarkupsubsubsection}[1]{\medskip\subsubsection*{#1}\medskip}
+
+\renewcommand{\isabeginpar}{\par\ifisamarkup\relax\else\bigskip\fi}
+\renewcommand{\isaendpar}{\par\bigskip}
+
+\begin{document}
+
+\makeatletter
+\parbox[t]{\textwidth}{\centering\Huge\bfseries\@title}\par\kern5mm
+\parbox[t]{\textwidth}{\centering\Large\bfseries\@author}\par\kern3mm
+\parbox[t]{\textwidth}{\centering\bfseries\@date}\par\kern8mm
+\makeatother
+
+\begin{abstract}\normalsize\noindent
+We present a certified declarative first-order prover with equality based on John Harrison's
+Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009. ML code
+reflection is used such that the entire prover can be executed within Isabelle as a very simple
+interactive proof assistant. As examples we consider Pelletier's problems 1-46.
+\end{abstract}
+
+\tableofcontents
+
+\isamarkupsection{Preample}
+
+Preliminary formalizations are described here:
+\begin{trivlist}
+\item
+Alexander Birch Jensen:
+\emph{Development and Verification of a Proof Assistant.}
+Master's Thesis, Technical University of Denmark, 2016.
+\url{http://findit.dtu.dk/en/catalog/2345011633}
+\item
+Alexander Birch Jensen, Anders Schlichtkrull \&\ J{\o}rgen Villadsen:
+\emph{Verification of an LCF-Style First-Order Prover with Equality.}
+Isabelle Workshop 2016.
+\url{https://github.com/logic-tools/sml-handbook}
+\end{trivlist}
+
+\clearpage
+
+\input{session}
+
+\clearpage
+
+\isamarkupsection{Acknowledgements}
+
+The SML code is based on the OCaml code accompanying John Harrison's
+Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009
+
+Thanks to Jasmin Blanchette, Asta Halkj{\ae}r From, John Bruntse Larsen, Andrei Popescu and
+Tom Ridge for discussions.
+
+\end{document}
diff --git a/thys/IMP2_Binary_Heap/IMP2_Binary_Heap.thy b/thys/IMP2_Binary_Heap/IMP2_Binary_Heap.thy
--- a/thys/IMP2_Binary_Heap/IMP2_Binary_Heap.thy
+++ b/thys/IMP2_Binary_Heap/IMP2_Binary_Heap.thy
@@ -1,903 +1,903 @@
-theory IMP2_Binary_Heap
-  imports IMP2.IMP2 IMP2.IMP2_Aux_Lemmas
-begin
-section \<open>Introduction\<close>
-text \<open>In this submission imperative versions of the following array-based binary minimum heap
-      functions are implemented and verified: insert, get-min, delete-min, make-heap.
-      The latter three are then used to prove the correctness of an in-place heapsort, which sorts
-      an array in descending order. To do that in Isabelle/HOL, the proof framework IMP2
-      \cite{IMP2-AFP} is used. Here arrays are modeled by \<open>int \<Rightarrow> int\<close> functions. The imperative
-      implementations are iterative versions of the partly recursive algorithms described in
-      \cite{MS} and \cite{CLRS}.
-
-      This submission starts with the basic definitions and lemmas, which are needed for array-based 
-      binary heaps. These definitions and lemmas are parameterised with an arbitrary (transitive) 
-      comparison function (where such a function is needed), so they are not only applicable to 
-      minimum heaps. After some more general, useful lemmas on arrays, the imperative minimum heap 
-      functions and the heapsort are implemented and verified.\<close>
-
-section \<open>Heap Related Definitions and Theorems\<close>
-subsection \<open>Array Bounds\<close>
-text \<open>A small helper function is used to define valid array indices. Note that the lower index 
-      bound \<open>l\<close> is arbitrary and not fixed to 0 or 1. The upper index bound \<open>r\<close> is not a valid
-      index itself, so that the empty array can be denoted by having \<open>l = r\<close>.\<close>
-abbreviation bounded :: "int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "bounded l r x \<equiv> l \<le> x \<and> x < r"
-
-subsection \<open>Parent and Children\<close>
-
-subsubsection \<open>Definitions\<close>
-text \<open>For the notion of an array-based binary heap, the parent and child relations on the array 
-      indices need to be defined.\<close>
-definition parent :: "int \<Rightarrow> int \<Rightarrow> int" where
-  "parent l c = l + (c - l - 1) div 2"
-
-definition l_child :: "int \<Rightarrow> int \<Rightarrow> int" where
-  "l_child l p = 2 * p - l + 1"
-
-definition r_child :: "int \<Rightarrow> int \<Rightarrow> int" where
-  "r_child l p = 2 * p - l + 2"
-
-subsubsection \<open>Lemmas\<close>
-lemma parent_upper_bound: "parent l c < c \<longleftrightarrow> l \<le> c"
-  unfolding parent_def by auto
-
-lemma parent_upper_bound_alt: "l \<le> parent l c \<Longrightarrow> parent l c < c"
-  unfolding parent_def by simp
-
-lemma parent_lower_bound: "l \<le> parent l c \<longleftrightarrow> l < c"
-  unfolding parent_def by linarith
-
-lemma grand_parent_upper_bound: "parent l (parent l c) < c \<longleftrightarrow> l \<le> c"
-  unfolding parent_def by linarith
-
-corollary parent_bounds: "l < x \<Longrightarrow> x < r \<Longrightarrow> bounded l r (parent l x)"
-  using parent_lower_bound parent_upper_bound_alt by fastforce
-
-
-lemma l_child_lower_bound: " p < l_child l p \<longleftrightarrow> l \<le> p"
-  unfolding l_child_def by simp
-
-corollary l_child_lower_bound_alt: "l \<le> x \<Longrightarrow> x \<le> p \<Longrightarrow> x < l_child l p"
-  using l_child_lower_bound[of p l] by linarith
-
-lemma parent_l_child[simp]: "parent l (l_child l n) = n"
-  unfolding parent_def l_child_def by simp
-
-
-lemma r_child_lower_bound: "l \<le> p \<Longrightarrow> p < r_child l p"
-  unfolding r_child_def by simp
-
-corollary r_child_lower_bound_alt: "l \<le> x \<Longrightarrow> x \<le> p \<Longrightarrow> x < r_child l p"
-  using r_child_lower_bound[of l p] by linarith
-
-lemma parent_r_child[simp]: "parent l (r_child l n) = n"
-  unfolding parent_def r_child_def by simp
-
-
-lemma smaller_l_child: "l_child l x < r_child l x"
-  unfolding l_child_def r_child_def by simp
-
-lemma parent_two_children: 
-  "(c = l_child l p \<or> c = r_child l p) \<longleftrightarrow> parent l c = p"
-  unfolding parent_def l_child_def r_child_def by linarith
-
-subsection \<open>Heap Invariants\<close>
-subsubsection \<open>Definitions\<close>
-text \<open>The following heap invariants and the following lemmas are parameterised with an arbitrary 
-      (transitive) comparison function. For the concrete function implementations at the end of 
-      this submission \<open>\<le>\<close> on ints is used.\<close>
-
-text \<open>For the \<open>make_heap\<close> function, which transforms an unordered array into a valid heap,
-      the notion of a partial heap is needed. Here the heap invariant only holds for array indices
-      between a certain valid array index \<open>m\<close> and \<open>r\<close>. The standard heap invariant is then
-      simply the special case where \<open>m = l\<close>.\<close>
-definition is_partial_heap 
-  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "is_partial_heap cmp heap l m r = (\<forall> x. bounded m r x \<longrightarrow> 
-               bounded m r (parent l x) \<longrightarrow> cmp (heap (parent l x)) (heap x))"
-
-abbreviation is_heap 
-  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "is_heap cmp heap l r \<equiv> is_partial_heap cmp heap l l r"
-
-
-text \<open>During all of the modifying heap functions the heap invariant is temporarily violated at
-      a single index \<open>i\<close> and it is then gradually restored by either \<open>sift_down\<close> or 
-      \<open>sift_up\<close>. The following definitions formalize these weakened invariants.
-
-      The second part of the conjunction in the following definitions states, that the comparison 
-      between the parent of \<open>i\<close> and each of the children of \<open>i\<close> evaluates to \<open>True\<close> without 
-      explicitly using the child relations.\<close>
-definition is_partial_heap_except_down 
-  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "is_partial_heap_except_down cmp heap l m r i = (\<forall> x. bounded m r x \<longrightarrow>
-    ((parent l x \<noteq> i \<longrightarrow> bounded m r (parent l x) \<longrightarrow> cmp (heap (parent l x)) (heap x)) \<and> 
-     (parent l x = i \<longrightarrow> bounded m r (parent l (parent l x))  
-                     \<longrightarrow> cmp (heap (parent l (parent l x))) (heap x))))"
-
-abbreviation is_heap_except_down 
-  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "is_heap_except_down cmp heap l r i \<equiv> is_partial_heap_except_down cmp heap l l r i"
-
-
-text \<open>As mentioned the notion of a partial heap is only needed for \<open>make_heap\<close>, 
-      which only uses \<open>sift_down\<close> internally, so there doesn't need to be an additional 
-      definition for the partial heap version of the \<open>sift_up\<close> invariant.\<close>
-definition is_heap_except_up 
-  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "is_heap_except_up cmp heap l r i = (\<forall> x. bounded l r x \<longrightarrow> 
-    ((x \<noteq> i \<longrightarrow> bounded l r (parent l x) \<longrightarrow> cmp (heap (parent l x)) (heap x)) \<and> 
-     (parent l x = i \<longrightarrow> bounded l r (parent l (parent l x)) 
-                     \<longrightarrow> cmp (heap (parent l (parent l x))) (heap x))))"
-
-subsubsection \<open>Lemmas\<close>
-
-lemma empty_partial_heap[simp]: "is_partial_heap cmp heap l r r"
-  unfolding is_partial_heap_def by linarith
-
-lemma is_partial_heap_smaller_back: 
-  "is_partial_heap cmp heap l m r \<Longrightarrow> r' \<le> r \<Longrightarrow> is_partial_heap cmp heap l m r'"
-  unfolding is_partial_heap_def by simp
-
-lemma is_partial_heap_smaller_front: 
-  "is_partial_heap cmp heap l m r \<Longrightarrow> m \<le> m' \<Longrightarrow> is_partial_heap cmp heap l m' r"
-  unfolding is_partial_heap_def by simp
-
-text \<open>The second half of each array is a is a partial binary heap, since it contains only leafs,
-      which are all trivial binary heaps.\<close>
-lemma snd_half_is_partial_heap: 
-  "(l + r) div 2 \<le> m \<Longrightarrow> is_partial_heap cmp heap l m r" 
-  unfolding is_partial_heap_def parent_def by linarith
-
-lemma modify_outside_partial_heap: 
-  assumes 
-    "heap = heap' on {m..<r}" 
-    "is_partial_heap cmp heap l m r"
-  shows "is_partial_heap cmp heap' l m r"
-  using assms eq_onD unfolding is_partial_heap_def by fastforce
-
-text \<open>The next few lemmas formalize how the heap invariant is weakened, when the heap is modified
-      in a certain way.\<close>
-
-text \<open>This lemma is used by \<open>make_heap\<close>.\<close>
-lemma partial_heap_added_first_el: 
-  assumes 
-    "l \<le> m" "m \<le> r"
-    "is_partial_heap cmp heap l (m + 1) r"
-  shows "is_partial_heap_except_down cmp heap l m r m"
- unfolding is_partial_heap_except_down_def
-proof
-  fix x
-  let ?p_x = "parent l x"
-  let ?gp_x = "parent l ?p_x"
-  show "bounded m r x \<longrightarrow>
-        (?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> cmp (heap ?p_x) (heap x)) \<and>
-        (?p_x = m \<longrightarrow> bounded m r ?gp_x \<longrightarrow> cmp (heap ?gp_x) (heap x))"
-  proof
-    assume x_bound: "bounded m r x"
-    have p_x_lower: "?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> ?p_x \<ge> m + 1"
-      by simp
-    hence "?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> x \<ge> m + 1"
-      using parent_upper_bound[of l x] x_bound assms(1) by linarith
-    hence p_invariant: "(?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> cmp (heap ?p_x) (heap x))"
-      using assms(3) is_partial_heap_def p_x_lower x_bound by blast
-
-    have gp_up_bound: "(?p_x = m \<longrightarrow> ?gp_x < m)"
-      by (simp add: assms(1) parent_upper_bound)
-    show "(?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> cmp (heap ?p_x) (heap x)) \<and>
-          (?p_x = m \<longrightarrow> bounded m r ?gp_x \<longrightarrow> cmp (heap ?gp_x) (heap x))"
-      using gp_up_bound p_invariant by linarith
-  qed
-qed
-
-text \<open>This lemma is used by \<open>del_min\<close>.\<close>
-lemma heap_changed_first_el: 
-  assumes "is_heap cmp heap l r" "l \<le> r"
-  shows "is_heap_except_down cmp (heap(l := b)) l r l"
-proof -
-  have "is_partial_heap cmp heap l (l + 1) r"
-    using assms(1) is_partial_heap_smaller_front by fastforce
-  hence "is_partial_heap cmp (heap(l := b)) l (l + 1) r"
-    using modify_outside_partial_heap[of heap] by simp
-  thus ?thesis
-    by (simp add: assms(2) partial_heap_added_first_el)
-qed
-
-text \<open>This lemma is used by \<open>insert\<close>.\<close>
-lemma heap_appended_el: 
-  assumes 
-    "is_heap cmp heap l r" 
-    "heap = heap' on {l..<r}"
-  shows "is_heap_except_up cmp heap' l (r+1) r"
-proof -
-  have "is_heap cmp heap' l r" 
-    using assms(1,2) modify_outside_partial_heap by blast 
-  thus ?thesis unfolding is_partial_heap_def is_heap_except_up_def
-    by (metis not_less_iff_gr_or_eq parent_upper_bound zless_add1_eq)
-qed
-
-subsubsection \<open>First Heap Element\<close>
-text \<open>The next step is to show that the first element of the heap is always the ``smallest'' 
-      according to the given comparison function. For the proof a rule for strong induction on lower
-      bounded integers is needed. Its proof is based on the proof of strong induction on natural 
-      numbers found in \cite{Str_Ind}.\<close>
-lemma strong_int_gr_induct_helper: 
-  assumes "k < (i::int)" "(\<And>i. k < i \<Longrightarrow> (\<And>j. k < j \<Longrightarrow> j < i \<Longrightarrow> P j) \<Longrightarrow> P i)"
-  shows "\<And>j. k < j \<Longrightarrow> j < i \<Longrightarrow> P j"
-  using assms
-proof(induction i rule: int_gr_induct)
-  case base 
-  then show ?case by linarith 
-next
-  case (step i) 
-  then show ?case 
-  proof(cases "j = i")
-    case True
-    then show ?thesis using step.IH step.prems(1,3) by blast 
-  next
-    case False
-    hence "j < i" using step.prems(2) by simp
-    then show ?thesis using step.IH step.prems(1,3) by blast 
-  qed
-qed
-
-theorem strong_int_gr_induct:
-  assumes 
-    "k < (i::int)" 
-    "(\<And>i. k < i \<Longrightarrow> (\<And>j. k < j \<Longrightarrow> j < i \<Longrightarrow> P j) \<Longrightarrow> P i)" 
-  shows "P i"
-  using assms less_induct strong_int_gr_induct_helper by blast
-
-text \<open>Now the main theorem, that the first heap element is the ``smallest'' according to the
-      given comparison function, can be proven.\<close>
-theorem heap_first_el:
-  assumes 
-    "is_heap cmp heap l r"
-    "transp cmp"
-    "l < x" "x < r"
-  shows "cmp (heap l) (heap x)"
-  using assms unfolding is_partial_heap_def
-proof(induction x rule: strong_int_gr_induct[of l])
-  case 1
-  then show ?case using assms(3) by simp
-next
-  case (2 i)
-  have cmp_pi_i: "cmp (heap (parent l i)) (heap i)"
-    using "2.hyps" "2.prems"(1,4) parent_bounds by simp
-  then show ?case 
-  proof(cases)
-    assume "parent l i > l"
-    then have "cmp (heap l) (heap (parent l i))"
-      using "2.IH" "2.prems"(1,2,4) parent_upper_bound_alt by simp
-    then show ?thesis
-      using "2.prems"(2) cmp_pi_i transpE by metis
-  next
-    assume "\<not> parent l i > l"
-    then have "parent l i = l"
-      using "2.hyps" dual_order.order_iff_strict parent_lower_bound by metis
-    then show ?thesis
-      using cmp_pi_i by simp
-  qed
-qed
-
-
-
-section \<open>General Lemmas on Arrays\<close>
-text \<open>Some additional lemmas on @{const "mset_ran"}, @{const "swap"} and @{const "eq_on"} are needed
-      for the final proofs.\<close>
-
-subsection \<open>Lemmas on @{const "mset_ran"}\<close>
-abbreviation arr_mset :: "(int \<Rightarrow> 'a) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a multiset" where
-  "arr_mset arr l r \<equiv> mset_ran arr {l..<r}"
-
-lemma in_mset_imp_in_array: 
-  "x \<in># (arr_mset arr l r) \<longleftrightarrow> (\<exists>i. bounded l r i \<and> arr i = x)"
-  unfolding mset_ran_def by fastforce
-
-lemma arr_mset_remove_last: 
-  "l \<le> r \<Longrightarrow> arr_mset arr l r = arr_mset arr l (r + 1) - {#arr r#}"
-  by (simp add: intvs_upper_decr mset_ran_def)
-
-lemma arr_mset_append: 
-  "l \<le> r \<Longrightarrow> arr_mset arr l (r + 1) = arr_mset arr l r + {#arr r#}"
-  using arr_mset_remove_last[of l r arr] by simp
-
-corollary arr_mset_append_alt: 
-  "l \<le> r \<Longrightarrow> arr_mset (arr(r := b)) l (r + 1) = arr_mset arr l r + {#b#}"
-  by (simp add: arr_mset_append mset_ran_subst_outside)
-
-lemma arr_mset_remove_first: 
-  "i \<le> r \<Longrightarrow> arr_mset arr (i - 1) r = arr_mset arr i r + {#arr (i - 1)#}"
-  by(induction r rule: int_ge_induct) (auto simp add: arr_mset_append)
-
-lemma arr_mset_split: 
-  assumes "l \<le> m" "m \<le> r"
-  shows "arr_mset arr l r = arr_mset arr l m + arr_mset arr m r"
-  using assms
-proof(induction m rule: int_ge_induct[of l])
-  case (step i)
-  have add_last: "arr_mset arr l (i + 1) = arr_mset arr l i + {#arr i#}"
-    using step arr_mset_append by blast
-  have rem_first: "arr_mset arr (i+1) r = arr_mset arr i r - {#arr i#}"
-    by (metis step.prems arr_mset_remove_first add_diff_cancel_right') 
-  show ?case 
-    using step add_last rem_first by fastforce
-qed (simp)
-
-text \<open>That the first element in a heap is the ``smallest'', can now be expressed using multisets.\<close>
-corollary heap_first_el_alt:                                                   
-  assumes 
-    "transp cmp" 
-    "is_heap cmp heap l r" 
-    "x \<in># (arr_mset heap l r)" 
-    "heap l \<noteq> x"
-  shows "cmp (heap l) x"
-  by(metis assms heap_first_el in_mset_imp_in_array le_less)
-
-
-subsection \<open>Lemmas on @{term "swap"} and @{term "eq_on"}\<close>
-
-lemma eq_on_subset: 
-  "arr1 = arr2 on R \<Longrightarrow> S \<subseteq> R \<Longrightarrow> arr1 = arr2 on S"
-  by (simp add: eq_on_def set_mp)
-
-lemma swap_swaps: 
-  "arr' = swap arr x y \<Longrightarrow> arr' y = arr x \<and> arr' x = arr y"
-  unfolding swap_def by simp
-
-lemma swap_only_swaps: 
-  "arr' = swap arr x y \<Longrightarrow> z \<noteq> x \<Longrightarrow> z \<noteq> y \<Longrightarrow> arr' z = arr z"
-  unfolding swap_def by simp
-
-lemma swap_commute: "swap arr x y = swap arr y x"
-  unfolding swap_def by fastforce
-
-lemma swap_eq_on: 
-  "arr1 = arr2 on S \<Longrightarrow> x \<notin> S \<Longrightarrow> y \<notin> S \<Longrightarrow> arr1 = swap arr2 x y on S"
-  unfolding swap_def by simp
-
-corollary swap_parent_eq_on: 
-  assumes 
-    "arr1 = arr2 on - {l..<r}" 
-    "l < c" "c < r" 
-  shows "arr1 = swap arr2 (parent l c) c on - {l..<r} "
-  using parent_bounds swap_eq_on assms by fastforce
-
-corollary swap_child_eq_on: 
-  assumes 
-    "arr1 = arr2 on - {l..<r}" 
-    "c = l_child l p \<or> c = r_child l p" 
-    "l \<le> p" "c < r" 
-  shows "arr1 = swap arr2 p c on - {l..<r} "
-  by (metis assms parent_lower_bound parent_two_children swap_parent_eq_on)
-
-lemma swap_child_mset: 
-  assumes 
-    "arr_mset arr1 l r = arr_mset arr2 l r" 
-    "c = l_child l p \<or> c = r_child l p" 
-    "l \<le> p" "c < r" 
-  shows "arr_mset arr1 l r = arr_mset (swap arr2 p c) l r"
-proof -
-  have child_bounded: "l < c \<and> c < r"
-    by (metis assms(2-4) parent_lower_bound parent_two_children)
-  have parent_bounded: "bounded l r p"
-    by (metis assms(2-4) dual_order.strict_trans parent_two_children parent_upper_bound_alt)
-  thus ?thesis
-    using assms(1) child_bounded mset_ran_swap[of p "{l..<r}" c arr2] atLeastLessThan_iff
-    by simp
-qed
-
-text \<open>The following lemma shows, which propositions have to hold on the pre-swap array, so that
-      a comparison between two elements holds on the post-swap array. This is useful for the 
-      proofs of the loop invariants of \<open>sift_up\<close> and \<open>sift_down\<close>. The lemma is kept 
-      quite general (except for the argument order) and could probably be more closely
-      related to the parent relation for more concise proofs.\<close>
-lemma cmp_swapI: 
-  fixes arr::"'a::order \<Rightarrow> 'a::order"
-  assumes
-    "m < n \<and> x < y"
-    "m < n \<and> x < y \<Longrightarrow> x = m \<Longrightarrow> y = n \<Longrightarrow> P (arr n) (arr m)"
-    "m < n \<and> x < y \<Longrightarrow> x \<noteq> m \<Longrightarrow> x \<noteq> n \<Longrightarrow> y \<noteq> m \<Longrightarrow> y \<noteq> n \<Longrightarrow> P (arr m) (arr n)"
-    "m < n \<and> x < y \<Longrightarrow> x = m \<Longrightarrow> y \<noteq> m \<Longrightarrow> y \<noteq> n \<Longrightarrow>  P (arr y) (arr n)"
-    "m < n \<and> x < y \<Longrightarrow> x = n \<Longrightarrow> y \<noteq> m \<Longrightarrow> y \<noteq> n \<Longrightarrow>  P (arr m) (arr y)"
-    "m < n \<and> x < y \<Longrightarrow> x \<noteq> m \<Longrightarrow> x \<noteq> n \<Longrightarrow> y = n \<Longrightarrow> P (arr m) (arr x)"
-    "m < n \<and> x < y \<Longrightarrow> x \<noteq> m \<Longrightarrow> x \<noteq> n \<Longrightarrow> y = m \<Longrightarrow> P (arr x) (arr n)"
-  shows "P (swap arr x y m) (swap arr x y n)"
-  by (metis assms order.asym swap_only_swaps swap_swaps)
-
-section \<open>Imperative Heap Implementation\<close>
-text \<open>The following imperative heap functions are based on \cite{MS} and \cite{CLRS}. All functions,
-      that are recursive in these books, are iterative in the following implementations. The 
-      function definitions are done with IMP2 \cite{IMP2-AFP}. From now on the heaps only contain 
-      ints and only use \<open>\<le>\<close> as comparison function. The auxiliary lemmas used from now on are 
-      heavily modeled after the proof goals, that are generated by the vcg tool (also part of IMP2).\<close>
-
-subsection \<open>Simple Functions\<close>
-subsubsection \<open>Parent, Children and Swap\<close>
-text \<open>In this section the parent and children relations are expressed as IMP2 procedures. 
-      Additionally a simple procedure, that swaps two array elements, is defined.\<close>
-procedure_spec prnt (l, x) returns p
-  assumes True
-    ensures "p = parent l\<^sub>0 x\<^sub>0"
-  defines \<open>p = ((x - l - 1) / 2 + l)\<close>
-  by vcg (simp add: parent_def)
-
-procedure_spec left_child (l, x) returns lc
-  assumes True 
-    ensures "lc = l_child l\<^sub>0 x\<^sub>0"
-  defines \<open>lc = 2 * x - l + 1\<close>
-  by vcg (simp add: l_child_def)
-
-procedure_spec right_child (l, x) returns rc
-  assumes True
-    ensures "rc = r_child l\<^sub>0 x\<^sub>0"
-  defines \<open>rc = 2 * x - l + 2\<close>
-  by vcg (simp add: r_child_def)
-
-procedure_spec swp (heap, x, y) returns heap
-  assumes True
-    ensures "heap = swap heap\<^sub>0 x\<^sub>0 y\<^sub>0 "
-  defines \<open>tmp = heap[x]; heap[x] = heap[y]; heap[y] = tmp\<close>
-  by vcg (simp add: swap_def)
-
-subsubsection \<open>\<open>get_min\<close>\<close>
-text \<open>In this section \<open>get_min\<close> is defined, which simply returns the first element (the minimum) of 
-      the heap. For this definition an additional theorem is proven, which enables the use of
-      @{const "Min_mset"} in the postcondition.\<close>
-
-theorem heap_minimum: 
-  assumes 
-    "l < r" 
-    "is_heap (\<le>) heap l r"
-  shows "heap l = Min_mset (arr_mset heap l r)"
-proof -
-  have "(\<forall>x \<in># (arr_mset heap l r). (heap l) \<le> x)"
-    using assms(2) heap_first_el_alt transp_le by blast
-  thus ?thesis
-    by (simp add: assms(1) dual_order.antisym)
-qed
-
-procedure_spec get_min (heap, l, r) returns min
-  assumes "l < r \<and> is_heap (\<le>) heap l r"  
-    ensures "min = Min_mset (arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0)"
-  for heap[] l r
-  defines \<open>min = heap[l]\<close>
-  by vcg (simp add: heap_minimum)
-
-subsection \<open>Modifying Functions\<close>
-
-subsubsection \<open>\<open>sift_up\<close> and \<open>insert\<close>\<close>
-text \<open>The next heap function is \<open>insert\<close>, which internally uses \<open>sift_up\<close>. In the beginning of 
-      this section \<open>sift_up_step\<close> is proven, which states that each \<open>sift_up\<close> loop iteration 
-      correctly transforms the weakened heap invariant. For its proof two additional
-      auxiliary lemmas are used. After \<open>sift_up_step\<close> \<open>sift_up\<close> and then \<open>insert\<close> are verified.\<close>
-
-text \<open>\<open>sift_up_step\<close> can be proven directly by the smt-solver without auxiliary lemmas, but they
-      were introduced to show the proof details. The analogous proofs for \<open>sift_down\<close> were 
-      just solved with smt, since the proof structure should be very similar, even though the 
-      \<open>sift_down\<close> proof goals are slightly more complex.\<close>
-lemma sift_up_step_aux1:
-  fixes heap::"int \<Rightarrow> int"
-  assumes  
-    "is_heap_except_up (\<le>) heap l r x"
-    "parent l x \<ge> l" 
-    "(heap x) \<le> (heap (parent l x))" 
-    "bounded l r k" 
-    "k \<noteq> (parent l x)" 
-    "bounded l r (parent l k)"
-  shows "(swap heap (parent l x) x (parent l k)) \<le> (swap heap (parent l x) x k)"
-  apply(intro cmp_swapI[of "(parent l k)" k "(parent l x)" x "(\<le>)" heap])
-  subgoal using assms(2,6) parent_upper_bound_alt by blast
-  subgoal using assms(3) by blast
-  subgoal using assms(1,4,6) unfolding is_heap_except_up_def by blast
-  subgoal using assms(1,3,4,6) unfolding is_heap_except_up_def by fastforce
-  subgoal using assms(5) by blast
-  subgoal by blast 
-  subgoal using assms(1,2,4) unfolding is_heap_except_up_def by simp
-  done
-
-lemma sift_up_step_aux2: 
-  fixes heap::"int \<Rightarrow> int"
-  assumes
-    "is_heap_except_up (\<le>) heap l r x"
-    "parent l x \<ge> l"
-    "heap x \<le> (heap (parent l x))"
-    "bounded l r k"
-    "parent l k = parent l x"
-    "bounded l r (parent l (parent l k))"
-  shows 
-    "swap heap (parent l x) x (parent l (parent l k)) \<le> swap heap (parent l x) x k"
-  using assms unfolding is_heap_except_up_def
-proof-
-  let ?gp_k = "parent l (parent l k)"
-  let ?gp_x = "parent l (parent l x)"
-  have gp_k_eq_gp_x: "swap heap (parent l x) x ?gp_k = heap ?gp_x"
-    by (metis assms(2,5) grand_parent_upper_bound less_irrefl swap_only_swaps)
-  show ?thesis
-      using assms unfolding is_heap_except_up_def
-  proof(cases)
-    assume k_eq_x: "k = x"
-    have "swap heap (parent l x) x k = heap (parent l x)"
-      by (metis k_eq_x swap_swaps)
-    then show ?thesis
-      using assms(1,2,4,6) unfolding is_heap_except_up_def
-      by (metis gp_k_eq_gp_x k_eq_x parent_bounds parent_lower_bound)
-  next
-    assume k_neq_x: "k \<noteq> x"
-    have "swap heap (parent l x) x k = heap k"
-      by (metis assms(5) gp_k_eq_gp_x k_neq_x swap_only_swaps)
-    then show ?thesis using assms unfolding is_heap_except_up_def
-      by (metis gp_k_eq_gp_x k_neq_x order_trans parent_bounds parent_lower_bound)
-  qed
-qed
-
-lemma sift_up_step:
-  fixes heap::"int \<Rightarrow> int"
-  assumes  
-    "is_heap_except_up (\<le>) heap l r x"
-    "parent l x \<ge> l" 
-    "(heap x) \<le> (heap (parent l x))"
-  shows "is_heap_except_up (\<le>) (swap heap (parent l x) x) l r (parent l x)"
-  using assms sift_up_step_aux1 sift_up_step_aux2
-  unfolding is_heap_except_up_def by blast
-
-text \<open>\<open>sift_up\<close> restores the heap invariant, that is only violated at the current position, by 
-      iteratively swapping the current element with its parent until the beginning of the array is 
-      reached or the current element is bigger than its parent.\<close>
-procedure_spec sift_up (heap, l, r, x) returns heap
-  assumes "is_heap_except_up (\<le>) heap l r x \<and> bounded l r x"
-    ensures "is_heap (\<le>) heap l\<^sub>0 r\<^sub>0 \<and>
-             arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset heap l\<^sub>0 r\<^sub>0 \<and>
-             heap\<^sub>0 = heap on - {l\<^sub>0..<r\<^sub>0}"
-  for heap[] l x r
-  defines \<open>
-    p = prnt(l, x);
-    while (x > l \<and> heap[x] \<le> heap[p]) 
-      @variant \<open>x - l\<close>
-      @invariant \<open>is_heap_except_up (\<le>) heap l r x \<and> p = parent l x \<and> 
-                  bounded l r x \<and> arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset heap l r \<and>
-                  heap\<^sub>0 = heap  on - {l..<r}\<close> 
-    {
-        heap = swp(heap, p, x);
-        x = p;
-        p = prnt(l, x)
-    }\<close>
-  apply vcg_cs
-  apply(intro conjI)
-  subgoal using parent_lower_bound sift_up_step by blast
-  subgoal using parent_lower_bound by blast
-  subgoal using parent_bounds by blast
-  subgoal using parent_bounds by (simp add: mset_ran_swap)
-  subgoal using swap_parent_eq_on by blast
-  subgoal using parent_upper_bound by simp
-  subgoal unfolding is_heap_except_up_def is_partial_heap_def
-    by (metis le_less not_less parent_lower_bound)
-  done
-
-text \<open>\<open>insert\<close> inserts an element into a heap by appending it to the heap and restoring the heap 
-      invariant with @{const "sift_up"}.\<close>
-procedure_spec insert (heap, l, r, el) returns (heap, l, r)
-  assumes "is_heap (\<le>) heap l r \<and> l \<le> r"  
-    ensures "is_heap (\<le>) heap l r \<and>
-             arr_mset heap l r = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 + {#el\<^sub>0#} \<and>
-             l = l\<^sub>0 \<and> r = r\<^sub>0 + 1  \<and> heap\<^sub>0 = heap on - {l..<r}"
-  for heap l r el
-  defines \<open>
-    heap[r] = el;
-    x = r;
-    r = r + 1;
-    heap = sift_up(heap, l, r, x)
-  \<close>
-  apply vcg_cs 
-  subgoal by (simp add: heap_appended_el)
-  subgoal by (metis arr_mset_append_alt add_mset_add_single)
-  done
-
-subsubsection \<open>\<open>sift_down\<close>, \<open>del_min\<close> and \<open>make_heap\<close>\<close>
-text \<open>The next heap functions are \<open>del_min\<close> and \<open>make_heap\<close>, which both use \<open>sift_down\<close> to 
-      restore/establish the heap invariant. \<open>sift_down\<close> is proven first (this time without 
-      additional auxiliary lemmas) followed by \<open>del_min\<close> and \<open>make_heap\<close>.\<close>
-
-text \<open>\<open>sift_down\<close> restores the heap invariant, that is only violated at the current position, by 
-      iteratively swapping the current element with its smallest child until the end of 
-      the array is reached or the current element is smaller than its children.\<close>
-procedure_spec sift_down(heap, l, r, x) returns heap 
-  assumes "is_partial_heap_except_down (\<le>) heap l x r x \<and> l \<le> x \<and> x \<le> r"
-    ensures "is_partial_heap (\<le>) heap l\<^sub>0 x\<^sub>0 r\<^sub>0 \<and> 
-             arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset heap l\<^sub>0 r\<^sub>0 \<and> 
-             heap\<^sub>0 = heap on - {l\<^sub>0..<r\<^sub>0}"
-  defines \<open>
-   lc = left_child(l, x);
-   rc = right_child(l, x);
-    while (lc < r \<and> (heap[lc] < heap[x] \<or> (rc < r \<and> heap[rc] < heap[x]))) 
-      @variant \<open>r - x\<close>
-      @invariant \<open>is_partial_heap_except_down (\<le>) heap l x\<^sub>0 r x \<and>
-                  x\<^sub>0 \<le> x \<and> x \<le> r \<and> lc = l_child l x \<and> rc = r_child l x \<and>
-                  arr_mset heap\<^sub>0 l r = arr_mset heap l r \<and>
-                  heap\<^sub>0 = heap on - {l..<r}\<close>
-  { 
-    smallest = lc;
-    if (rc < r \<and> heap[rc] < heap[lc]) {
-      smallest = rc
-    };
-    heap = swp(heap, x, smallest);
-    x = smallest;
-    lc = left_child(l, x);
-    rc = right_child(l, x)
-  }\<close>
-  apply vcg_cs
-  subgoal
-    apply(intro conjI)
-    subgoal unfolding is_partial_heap_except_down_def
-      by (smt parent_two_children swap_swaps swap_only_swaps
-          swap_commute parent_upper_bound_alt)
-    subgoal using r_child_lower_bound_alt by fastforce
-    subgoal using swap_child_mset order_trans by blast
-    subgoal using swap_child_eq_on by fastforce
-    done
-  subgoal
-    by (meson less_le_trans not_le order.asym r_child_lower_bound) 
-  subgoal
-    apply(intro conjI)
-    subgoal unfolding is_partial_heap_except_down_def
-      by (smt parent_two_children swap_swaps swap_only_swaps
-          swap_commute parent_upper_bound_alt)
-    subgoal using l_child_lower_bound_alt by fastforce
-    subgoal using swap_child_mset order_trans by blast
-    subgoal using swap_child_eq_on by fastforce
-    done
-  subgoal 
-    by (meson less_le_trans not_le order.asym l_child_lower_bound)
-  subgoal unfolding is_partial_heap_except_down_def is_partial_heap_def
-    by (metis dual_order.strict_trans not_less parent_two_children smaller_l_child)
-  done
-
-
-text \<open>\<open>del_min\<close> needs an additional lemma which shows, that it actually removes (only) the minimum
-      from the heap.\<close>
-lemma del_min_mset: 
-  fixes heap::"int \<Rightarrow> int"
-  assumes 
-    "l < r"
-    "is_heap (\<le>) heap l r"
-    "mod_heap = heap(l := heap (r - 1))"
-    "arr_mset mod_heap l (r - 1) = arr_mset new_heap l (r - 1)"
-  shows 
-    "arr_mset new_heap l (r - 1) = arr_mset heap l r - {#Min_mset (arr_mset heap l r)#}"
-proof -
-  let ?heap_mset = "arr_mset heap l r"
-  have l_is_min: "heap l = Min_mset ?heap_mset"
-    using assms(1,2) heap_minimum by blast
-  have "(arr_mset mod_heap l r) = ?heap_mset + {#heap (r-1)#} - {#heap l#}"
-    by (simp add: assms(1,3) mset_ran_subst_inside)
-  hence "(arr_mset mod_heap l (r - 1)) = ?heap_mset - {#heap l#}"
-    by (simp add: assms(1,3) arr_mset_remove_last) 
-  thus ?thesis
-    using assms(4) l_is_min by simp
-qed
-
-text \<open>\<open>del_min\<close> removes the minimum element from the heap by replacing the first element with the 
-      last element, shrinking the array by one and subsequently restoring the heap invariant 
-      with @{const "sift_down"}.\<close>
-procedure_spec del_min (heap, l, r) returns (heap, l, r)
-  assumes "l < r \<and> is_heap (\<le>) heap l r"  
-    ensures "is_heap (\<le>) heap l r \<and> 
-             arr_mset heap l r = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 - {#Min_mset (arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0)#} \<and> 
-             l = l\<^sub>0 \<and> r = r\<^sub>0 - 1 \<and> 
-             heap\<^sub>0 = heap on - {l\<^sub>0..<r\<^sub>0}"
-  for heap l r
-  defines \<open>
-    r = r - 1;
-    heap[l] = heap[r];
-    heap = sift_down(heap, l, r, l)
-  \<close>
-  apply vcg_cs
-  subgoal by (simp add: heap_changed_first_el is_partial_heap_smaller_back)
-  subgoal
-    apply(rule conjI)
-    subgoal using del_min_mset by blast
-    subgoal by (simp add: eq_on_def intvs_incdec(3) intvs_lower_incr)
-    done
-  done
-
-
-text \<open>\<open>make_heap\<close> transforms an arbitrary array into a heap by iterating through all array 
-      positions from the middle of the array up to the beginning of the array and calling 
-      @{const "sift_down"} for each one.\<close>
-procedure_spec make_heap (heap, l, r) returns heap
-  assumes "l \<le> r"  
-    ensures "is_heap (\<le>) heap l\<^sub>0 r\<^sub>0 \<and> 
-             arr_mset heap l\<^sub>0 r\<^sub>0 = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 \<and> 
-             heap\<^sub>0 = heap on - {l\<^sub>0..< r\<^sub>0}"
-  for heap[] l r
-  defines \<open>
-    y = (r + l)/2 - 1;
-    while (y \<ge> l)
-          @variant \<open>y - l + 1\<close>
-          @invariant \<open>is_partial_heap (\<le>) heap l (y + 1) r \<and>
-                      arr_mset heap l r = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 \<and>
-                      l - 1 \<le> y \<and> y < r \<and> heap\<^sub>0 = heap on - {l..<r}\<close>
-    {
-      heap = sift_down(heap, l, r, y);
-      y = y - 1
-    }\<close> 
-  apply(vcg_cs)
-  subgoal 
-    apply(rule conjI)
-    subgoal by (simp add: snd_half_is_partial_heap add.commute)
-    subgoal by linarith 
-    done
-  subgoal using partial_heap_added_first_el le_less by blast 
-  subgoal using eq_on_trans by blast 
-  subgoal using dual_order.antisym by fastforce
-  done
-
-subsection \<open>Heapsort Implementation\<close>
-
-text \<open>The final part of this submission is the implementation of the in-place heapsort. Firstly it 
-      builds the \<open>\<le>\<close>-heap and then it iteratively removes the minimum of the heap, which is put at 
-      the now vacant end of the shrinking heap. This is done until the heap is empty, which leaves 
-      the array sorted in descending order.\<close>
-subsubsection \<open>Auxiliary Lemmas\<close>
-text \<open>Firstly the notion of a sorted array is needed. This is more or less the same as 
-      @{const "ran_sorted"} generalized for arbitrary comparison functions.\<close>
-definition array_is_sorted :: "(int \<Rightarrow> int \<Rightarrow> bool) \<Rightarrow>  (int \<Rightarrow> int) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
-  "array_is_sorted cmp a l r \<equiv> \<forall>i. \<forall>j. bounded l r i \<longrightarrow> bounded l r j \<longrightarrow> i < j \<longrightarrow> cmp (a i) (a j)"
-
-text \<open>This lemma states, that the heapsort doesn't change the elements contained in the array during
-      the loop iterations.\<close>
-lemma heap_sort_mset_step:
-  fixes arr::"int \<Rightarrow> int"
-  assumes 
-    "l < m" "m \<le> r"
-    "arr_mset arr' l (m - 1) = arr_mset arr l m - {#Min_mset (arr_mset arr l m)#}"
-    "arr = arr' on - {l..<m}"
-    "mod_arr = arr'(m - 1 := Min_mset (arr_mset arr l m))"
-  shows "arr_mset arr l r = arr_mset mod_arr l r"
-proof -
-  let ?min = "{#Min_mset (arr_mset arr l m)#}"
-  let ?new_arr_mset = "arr_mset mod_arr"
-  have middle: "?new_arr_mset (m - 1) m = ?min"
-    by (simp add: assms(5))
-  have first_half: "?new_arr_mset l (m - 1) = arr_mset arr l m - ?min"
-    by (simp add: assms(3,5) mset_ran_subst_outside)
-  hence "?new_arr_mset l m = ?new_arr_mset l (m - 1) + ?new_arr_mset (m - 1) m"
-    by (metis assms(1,3,5) diff_add_cancel middle arr_mset_append_alt zle_diff1_eq)
-  hence first_half_middle: "?new_arr_mset l m = arr_mset arr l m"
-    using middle first_half assms(1) by simp
-
-  hence "mod_arr = arr on - {l..<m}"
-    using assms(1,4,5) eq_on_sym eq_on_trans by auto
-  then have second_half: "arr_mset arr m r = arr_mset mod_arr m r"
-    by (simp add: eq_on_def mset_ran_cong)
-
-  then show ?thesis
-    by (metis arr_mset_split assms(1,2) first_half_middle le_less)
-qed
-
-text \<open>This lemma states, that each loop iteration leaves the growing second half of the array 
-      sorted in descending order.\<close>
-lemma heap_sort_second_half_sorted_step: 
-  fixes arr::"int \<Rightarrow> int"
-  assumes
-    "l\<^sub>0 < m" "m \<le> r\<^sub>0"
-    "arr = arr' on - {l\<^sub>0..<m}"
-    "\<forall>i. \<forall>j. bounded m r\<^sub>0 i \<longrightarrow> bounded m r\<^sub>0 j \<longrightarrow>  i < j \<longrightarrow> arr j \<le> arr i"
-    "\<forall>x\<in>#arr_mset arr l\<^sub>0 m. \<forall>y\<in>#arr_mset arr m r\<^sub>0. \<not> x < y"
-    "bounded (m - 1) r\<^sub>0 i" 
-    "bounded (m - 1) r\<^sub>0 j" 
-    "i < j"
-    "mod_arr = (arr'(m - 1 := Min_mset (arr_mset arr l\<^sub>0 m)))"
-  shows "mod_arr j \<le> mod_arr i"
-proof -
-  have second_half_eq: "mod_arr = arr on {m..< r\<^sub>0}" 
-    using assms(3, 9) unfolding eq_on_def by simp
-  have j_stricter_bound: "bounded m r\<^sub>0 j"
-    using assms(6-8) by simp
-  then have el_at_j: "mod_arr j \<in># arr_mset arr m r\<^sub>0"
-    using eq_onD second_half_eq by fastforce
-  then show ?thesis 
-  proof(cases)
-    assume "i = (m-1)"
-    then have "mod_arr i \<in># arr_mset arr l\<^sub>0 m"
-      by (simp add: assms(1, 9))
-    then show ?thesis
-      using assms(5) el_at_j not_less by blast 
-  next
-    assume "i \<noteq> (m-1)"  
-    then have "bounded m r\<^sub>0 i"
-      using assms(6) by simp
-    then show ?thesis 
-      using assms(4, 8) eq_on_def j_stricter_bound second_half_eq by force
-  qed
-qed
-
-
-text \<open>The following lemma shows that all elements in the first part of the array (the binary heap) 
-      are bigger than the elements in the second part (the sorted part) after every iteration. This 
-      lemma and the invariant of the \<open>heap_sort\<close> loop use \<open>\<not> x < y\<close> instead of \<open>x \<ge> y\<close> since 
-      \<open>vcg_cs\<close> doesn't terminate in the latter case.\<close>
-lemma heap_sort_fst_part_bigger_snd_part_step:
-  fixes arr::"int \<Rightarrow> int" 
-  assumes
-    "l\<^sub>0 < m"
-    "m \<le> r\<^sub>0"
-    "arr_mset arr' l\<^sub>0 (m - 1) = arr_mset arr l\<^sub>0 m - {#Min_mset (arr_mset arr l\<^sub>0 m)#}"
-    "arr = arr' on - {l\<^sub>0..<m}"
-    "\<forall>x\<in>#arr_mset arr l\<^sub>0 m. \<forall>y\<in>#arr_mset arr m r\<^sub>0. \<not> x < y"
-    "mod_arr = arr'(m - 1 := Min_mset (arr_mset arr l\<^sub>0 m))"
-    "x\<in>#arr_mset mod_arr l\<^sub>0 (m - 1)"
-    "y\<in>#arr_mset mod_arr (m - 1) r\<^sub>0"
-  shows "\<not> x < y"
-proof -
-  have "{m..<r\<^sub>0} \<subseteq> - {l\<^sub>0..<m}" 
-    by auto
-  hence "arr' = arr on {m..<r\<^sub>0}" 
-    using assms(4) eq_on_sym eq_on_subset by blast
-  hence arr_eq_on: "mod_arr = arr on {m..<r\<^sub>0}"
-    by (simp add: assms(6))
-  hence same_mset: "arr_mset mod_arr m r\<^sub>0 = arr_mset arr m r\<^sub>0"
-    using mset_ran_cong by blast
-  have "x \<in># arr_mset arr l\<^sub>0 m" using same_mset assms
-    by (metis assms(3,6,7) add_mset_remove_trivial_eq lran_upd_outside(2)
-        mset_lran cancel_ab_semigroup_add_class.diff_right_commute
-        diff_single_trivial multi_self_add_other_not_self order_refl)
-  then have x_bigger_min: "x \<ge> Min_mset (arr_mset arr l\<^sub>0 m)"
-    using Min_le by blast 
-  have y_smaller_min: "y \<le> Min_mset (arr_mset arr l\<^sub>0 m)" 
-  proof(cases "y = mod_arr (m - 1)")
-    case False
-    hence "y\<in>#arr_mset mod_arr (m - 1) r\<^sub>0 - {#mod_arr (m - 1)#}"
-      by (metis assms(8) diff_single_trivial insert_DiffM insert_noteq_member)
-    then have "y\<in>#arr_mset arr m r\<^sub>0"
-      by (simp add: assms(2) intvs_decr_l mset_ran_insert same_mset)
-    then show ?thesis
-      using assms(1) assms(5) by fastforce 
-  qed (simp add: assms(6))
-  then show ?thesis
-    using x_bigger_min by linarith 
-qed
-
-subsubsection \<open>Implementation\<close>
-text \<open>Now finally the correctness of the \<open>heap_sort\<close> is shown. As mentioned, it starts by 
-      transforming the array into a minimum heap using @{const "make_heap"}. Then in each 
-      iteration it removes the first element from the heap with @{const "del_min"} after its value 
-      was retrieved with @{const "get_min"}. This value is then put at the position freed by 
-      @{const "del_min"}.\<close>
-program_spec heap_sort
-  assumes "l \<le> r"  
-    ensures "array_is_sorted (\<ge>) arr l\<^sub>0 r\<^sub>0 \<and> 
-             arr_mset arr\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset arr l\<^sub>0 r\<^sub>0 \<and> 
-             arr\<^sub>0 = arr on - {l\<^sub>0 ..<r\<^sub>0 } \<and> l = l\<^sub>0 \<and> r = r\<^sub>0"
-  for l r arr[]
-  defines \<open>
-    arr = make_heap(arr, l, r);
-    m = r;
-    while (m > l)
-      @variant \<open>m - l + 1\<close> 
-      @invariant \<open>is_heap (\<le>) arr l m \<and>
-        array_is_sorted (\<ge>) arr m r\<^sub>0 \<and>
-        (\<forall>x \<in># arr_mset arr l\<^sub>0 m. \<forall>y \<in># arr_mset arr m r\<^sub>0. \<not> x < y) \<and>
-        arr_mset arr\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset arr l\<^sub>0 r\<^sub>0 \<and> 
-        l \<le> m \<and> m \<le> r\<^sub>0 \<and> l = l\<^sub>0 \<and> arr\<^sub>0 = arr on - {l\<^sub>0 ..<r\<^sub>0}\<close>
-    {
-      min = get_min(arr, l, m);
-      (arr, l, m) = del_min(arr, l, m);
-      arr[m] = min 
-    }
-  \<close>
-  apply vcg_cs
-  subgoal unfolding array_is_sorted_def by simp
-  subgoal
-    apply(intro conjI)
-    subgoal unfolding is_partial_heap_def by simp
-    subgoal unfolding array_is_sorted_def using heap_sort_second_half_sorted_step
-      by blast
-    subgoal using heap_sort_fst_part_bigger_snd_part_step by blast
-    subgoal using heap_sort_mset_step by blast
-    subgoal unfolding eq_on_def
-      by (metis ComplD ComplI atLeastLessThan_iff less_le_trans)
-    done
-  done
-end
+theory IMP2_Binary_Heap
+  imports IMP2.IMP2 IMP2.IMP2_Aux_Lemmas
+begin
+section \<open>Introduction\<close>
+text \<open>In this submission imperative versions of the following array-based binary minimum heap
+      functions are implemented and verified: insert, get-min, delete-min, make-heap.
+      The latter three are then used to prove the correctness of an in-place heapsort, which sorts
+      an array in descending order. To do that in Isabelle/HOL, the proof framework IMP2
+      \cite{IMP2-AFP} is used. Here arrays are modeled by \<open>int \<Rightarrow> int\<close> functions. The imperative
+      implementations are iterative versions of the partly recursive algorithms described in
+      \cite{MS} and \cite{CLRS}.
+
+      This submission starts with the basic definitions and lemmas, which are needed for array-based 
+      binary heaps. These definitions and lemmas are parameterised with an arbitrary (transitive) 
+      comparison function (where such a function is needed), so they are not only applicable to 
+      minimum heaps. After some more general, useful lemmas on arrays, the imperative minimum heap 
+      functions and the heapsort are implemented and verified.\<close>
+
+section \<open>Heap Related Definitions and Theorems\<close>
+subsection \<open>Array Bounds\<close>
+text \<open>A small helper function is used to define valid array indices. Note that the lower index 
+      bound \<open>l\<close> is arbitrary and not fixed to 0 or 1. The upper index bound \<open>r\<close> is not a valid
+      index itself, so that the empty array can be denoted by having \<open>l = r\<close>.\<close>
+abbreviation bounded :: "int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "bounded l r x \<equiv> l \<le> x \<and> x < r"
+
+subsection \<open>Parent and Children\<close>
+
+subsubsection \<open>Definitions\<close>
+text \<open>For the notion of an array-based binary heap, the parent and child relations on the array 
+      indices need to be defined.\<close>
+definition parent :: "int \<Rightarrow> int \<Rightarrow> int" where
+  "parent l c = l + (c - l - 1) div 2"
+
+definition l_child :: "int \<Rightarrow> int \<Rightarrow> int" where
+  "l_child l p = 2 * p - l + 1"
+
+definition r_child :: "int \<Rightarrow> int \<Rightarrow> int" where
+  "r_child l p = 2 * p - l + 2"
+
+subsubsection \<open>Lemmas\<close>
+lemma parent_upper_bound: "parent l c < c \<longleftrightarrow> l \<le> c"
+  unfolding parent_def by auto
+
+lemma parent_upper_bound_alt: "l \<le> parent l c \<Longrightarrow> parent l c < c"
+  unfolding parent_def by simp
+
+lemma parent_lower_bound: "l \<le> parent l c \<longleftrightarrow> l < c"
+  unfolding parent_def by linarith
+
+lemma grand_parent_upper_bound: "parent l (parent l c) < c \<longleftrightarrow> l \<le> c"
+  unfolding parent_def by linarith
+
+corollary parent_bounds: "l < x \<Longrightarrow> x < r \<Longrightarrow> bounded l r (parent l x)"
+  using parent_lower_bound parent_upper_bound_alt by fastforce
+
+
+lemma l_child_lower_bound: " p < l_child l p \<longleftrightarrow> l \<le> p"
+  unfolding l_child_def by simp
+
+corollary l_child_lower_bound_alt: "l \<le> x \<Longrightarrow> x \<le> p \<Longrightarrow> x < l_child l p"
+  using l_child_lower_bound[of p l] by linarith
+
+lemma parent_l_child[simp]: "parent l (l_child l n) = n"
+  unfolding parent_def l_child_def by simp
+
+
+lemma r_child_lower_bound: "l \<le> p \<Longrightarrow> p < r_child l p"
+  unfolding r_child_def by simp
+
+corollary r_child_lower_bound_alt: "l \<le> x \<Longrightarrow> x \<le> p \<Longrightarrow> x < r_child l p"
+  using r_child_lower_bound[of l p] by linarith
+
+lemma parent_r_child[simp]: "parent l (r_child l n) = n"
+  unfolding parent_def r_child_def by simp
+
+
+lemma smaller_l_child: "l_child l x < r_child l x"
+  unfolding l_child_def r_child_def by simp
+
+lemma parent_two_children: 
+  "(c = l_child l p \<or> c = r_child l p) \<longleftrightarrow> parent l c = p"
+  unfolding parent_def l_child_def r_child_def by linarith
+
+subsection \<open>Heap Invariants\<close>
+subsubsection \<open>Definitions\<close>
+text \<open>The following heap invariants and the following lemmas are parameterised with an arbitrary 
+      (transitive) comparison function. For the concrete function implementations at the end of 
+      this submission \<open>\<le>\<close> on ints is used.\<close>
+
+text \<open>For the \<open>make_heap\<close> function, which transforms an unordered array into a valid heap,
+      the notion of a partial heap is needed. Here the heap invariant only holds for array indices
+      between a certain valid array index \<open>m\<close> and \<open>r\<close>. The standard heap invariant is then
+      simply the special case where \<open>m = l\<close>.\<close>
+definition is_partial_heap 
+  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "is_partial_heap cmp heap l m r = (\<forall> x. bounded m r x \<longrightarrow> 
+               bounded m r (parent l x) \<longrightarrow> cmp (heap (parent l x)) (heap x))"
+
+abbreviation is_heap 
+  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "is_heap cmp heap l r \<equiv> is_partial_heap cmp heap l l r"
+
+
+text \<open>During all of the modifying heap functions the heap invariant is temporarily violated at
+      a single index \<open>i\<close> and it is then gradually restored by either \<open>sift_down\<close> or 
+      \<open>sift_up\<close>. The following definitions formalize these weakened invariants.
+
+      The second part of the conjunction in the following definitions states, that the comparison 
+      between the parent of \<open>i\<close> and each of the children of \<open>i\<close> evaluates to \<open>True\<close> without 
+      explicitly using the child relations.\<close>
+definition is_partial_heap_except_down 
+  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "is_partial_heap_except_down cmp heap l m r i = (\<forall> x. bounded m r x \<longrightarrow>
+    ((parent l x \<noteq> i \<longrightarrow> bounded m r (parent l x) \<longrightarrow> cmp (heap (parent l x)) (heap x)) \<and> 
+     (parent l x = i \<longrightarrow> bounded m r (parent l (parent l x))  
+                     \<longrightarrow> cmp (heap (parent l (parent l x))) (heap x))))"
+
+abbreviation is_heap_except_down 
+  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "is_heap_except_down cmp heap l r i \<equiv> is_partial_heap_except_down cmp heap l l r i"
+
+
+text \<open>As mentioned the notion of a partial heap is only needed for \<open>make_heap\<close>, 
+      which only uses \<open>sift_down\<close> internally, so there doesn't need to be an additional 
+      definition for the partial heap version of the \<open>sift_up\<close> invariant.\<close>
+definition is_heap_except_up 
+  :: "('a::order \<Rightarrow> 'a::order \<Rightarrow> bool) \<Rightarrow> (int \<Rightarrow> 'a::order) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "is_heap_except_up cmp heap l r i = (\<forall> x. bounded l r x \<longrightarrow> 
+    ((x \<noteq> i \<longrightarrow> bounded l r (parent l x) \<longrightarrow> cmp (heap (parent l x)) (heap x)) \<and> 
+     (parent l x = i \<longrightarrow> bounded l r (parent l (parent l x)) 
+                     \<longrightarrow> cmp (heap (parent l (parent l x))) (heap x))))"
+
+subsubsection \<open>Lemmas\<close>
+
+lemma empty_partial_heap[simp]: "is_partial_heap cmp heap l r r"
+  unfolding is_partial_heap_def by linarith
+
+lemma is_partial_heap_smaller_back: 
+  "is_partial_heap cmp heap l m r \<Longrightarrow> r' \<le> r \<Longrightarrow> is_partial_heap cmp heap l m r'"
+  unfolding is_partial_heap_def by simp
+
+lemma is_partial_heap_smaller_front: 
+  "is_partial_heap cmp heap l m r \<Longrightarrow> m \<le> m' \<Longrightarrow> is_partial_heap cmp heap l m' r"
+  unfolding is_partial_heap_def by simp
+
+text \<open>The second half of each array is a is a partial binary heap, since it contains only leafs,
+      which are all trivial binary heaps.\<close>
+lemma snd_half_is_partial_heap: 
+  "(l + r) div 2 \<le> m \<Longrightarrow> is_partial_heap cmp heap l m r" 
+  unfolding is_partial_heap_def parent_def by linarith
+
+lemma modify_outside_partial_heap: 
+  assumes 
+    "heap = heap' on {m..<r}" 
+    "is_partial_heap cmp heap l m r"
+  shows "is_partial_heap cmp heap' l m r"
+  using assms eq_onD unfolding is_partial_heap_def by fastforce
+
+text \<open>The next few lemmas formalize how the heap invariant is weakened, when the heap is modified
+      in a certain way.\<close>
+
+text \<open>This lemma is used by \<open>make_heap\<close>.\<close>
+lemma partial_heap_added_first_el: 
+  assumes 
+    "l \<le> m" "m \<le> r"
+    "is_partial_heap cmp heap l (m + 1) r"
+  shows "is_partial_heap_except_down cmp heap l m r m"
+ unfolding is_partial_heap_except_down_def
+proof
+  fix x
+  let ?p_x = "parent l x"
+  let ?gp_x = "parent l ?p_x"
+  show "bounded m r x \<longrightarrow>
+        (?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> cmp (heap ?p_x) (heap x)) \<and>
+        (?p_x = m \<longrightarrow> bounded m r ?gp_x \<longrightarrow> cmp (heap ?gp_x) (heap x))"
+  proof
+    assume x_bound: "bounded m r x"
+    have p_x_lower: "?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> ?p_x \<ge> m + 1"
+      by simp
+    hence "?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> x \<ge> m + 1"
+      using parent_upper_bound[of l x] x_bound assms(1) by linarith
+    hence p_invariant: "(?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> cmp (heap ?p_x) (heap x))"
+      using assms(3) is_partial_heap_def p_x_lower x_bound by blast
+
+    have gp_up_bound: "(?p_x = m \<longrightarrow> ?gp_x < m)"
+      by (simp add: assms(1) parent_upper_bound)
+    show "(?p_x \<noteq> m \<longrightarrow> bounded m r ?p_x \<longrightarrow> cmp (heap ?p_x) (heap x)) \<and>
+          (?p_x = m \<longrightarrow> bounded m r ?gp_x \<longrightarrow> cmp (heap ?gp_x) (heap x))"
+      using gp_up_bound p_invariant by linarith
+  qed
+qed
+
+text \<open>This lemma is used by \<open>del_min\<close>.\<close>
+lemma heap_changed_first_el: 
+  assumes "is_heap cmp heap l r" "l \<le> r"
+  shows "is_heap_except_down cmp (heap(l := b)) l r l"
+proof -
+  have "is_partial_heap cmp heap l (l + 1) r"
+    using assms(1) is_partial_heap_smaller_front by fastforce
+  hence "is_partial_heap cmp (heap(l := b)) l (l + 1) r"
+    using modify_outside_partial_heap[of heap] by simp
+  thus ?thesis
+    by (simp add: assms(2) partial_heap_added_first_el)
+qed
+
+text \<open>This lemma is used by \<open>insert\<close>.\<close>
+lemma heap_appended_el: 
+  assumes 
+    "is_heap cmp heap l r" 
+    "heap = heap' on {l..<r}"
+  shows "is_heap_except_up cmp heap' l (r+1) r"
+proof -
+  have "is_heap cmp heap' l r" 
+    using assms(1,2) modify_outside_partial_heap by blast 
+  thus ?thesis unfolding is_partial_heap_def is_heap_except_up_def
+    by (metis not_less_iff_gr_or_eq parent_upper_bound zless_add1_eq)
+qed
+
+subsubsection \<open>First Heap Element\<close>
+text \<open>The next step is to show that the first element of the heap is always the ``smallest'' 
+      according to the given comparison function. For the proof a rule for strong induction on lower
+      bounded integers is needed. Its proof is based on the proof of strong induction on natural 
+      numbers found in \cite{Str_Ind}.\<close>
+lemma strong_int_gr_induct_helper: 
+  assumes "k < (i::int)" "(\<And>i. k < i \<Longrightarrow> (\<And>j. k < j \<Longrightarrow> j < i \<Longrightarrow> P j) \<Longrightarrow> P i)"
+  shows "\<And>j. k < j \<Longrightarrow> j < i \<Longrightarrow> P j"
+  using assms
+proof(induction i rule: int_gr_induct)
+  case base 
+  then show ?case by linarith 
+next
+  case (step i) 
+  then show ?case 
+  proof(cases "j = i")
+    case True
+    then show ?thesis using step.IH step.prems(1,3) by blast 
+  next
+    case False
+    hence "j < i" using step.prems(2) by simp
+    then show ?thesis using step.IH step.prems(1,3) by blast 
+  qed
+qed
+
+theorem strong_int_gr_induct:
+  assumes 
+    "k < (i::int)" 
+    "(\<And>i. k < i \<Longrightarrow> (\<And>j. k < j \<Longrightarrow> j < i \<Longrightarrow> P j) \<Longrightarrow> P i)" 
+  shows "P i"
+  using assms less_induct strong_int_gr_induct_helper by blast
+
+text \<open>Now the main theorem, that the first heap element is the ``smallest'' according to the
+      given comparison function, can be proven.\<close>
+theorem heap_first_el:
+  assumes 
+    "is_heap cmp heap l r"
+    "transp cmp"
+    "l < x" "x < r"
+  shows "cmp (heap l) (heap x)"
+  using assms unfolding is_partial_heap_def
+proof(induction x rule: strong_int_gr_induct[of l])
+  case 1
+  then show ?case using assms(3) by simp
+next
+  case (2 i)
+  have cmp_pi_i: "cmp (heap (parent l i)) (heap i)"
+    using "2.hyps" "2.prems"(1,4) parent_bounds by simp
+  then show ?case 
+  proof(cases)
+    assume "parent l i > l"
+    then have "cmp (heap l) (heap (parent l i))"
+      using "2.IH" "2.prems"(1,2,4) parent_upper_bound_alt by simp
+    then show ?thesis
+      using "2.prems"(2) cmp_pi_i transpE by metis
+  next
+    assume "\<not> parent l i > l"
+    then have "parent l i = l"
+      using "2.hyps" dual_order.order_iff_strict parent_lower_bound by metis
+    then show ?thesis
+      using cmp_pi_i by simp
+  qed
+qed
+
+
+
+section \<open>General Lemmas on Arrays\<close>
+text \<open>Some additional lemmas on @{const "mset_ran"}, @{const "swap"} and @{const "eq_on"} are needed
+      for the final proofs.\<close>
+
+subsection \<open>Lemmas on @{const "mset_ran"}\<close>
+abbreviation arr_mset :: "(int \<Rightarrow> 'a) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a multiset" where
+  "arr_mset arr l r \<equiv> mset_ran arr {l..<r}"
+
+lemma in_mset_imp_in_array: 
+  "x \<in># (arr_mset arr l r) \<longleftrightarrow> (\<exists>i. bounded l r i \<and> arr i = x)"
+  unfolding mset_ran_def by fastforce
+
+lemma arr_mset_remove_last: 
+  "l \<le> r \<Longrightarrow> arr_mset arr l r = arr_mset arr l (r + 1) - {#arr r#}"
+  by (simp add: intvs_upper_decr mset_ran_def)
+
+lemma arr_mset_append: 
+  "l \<le> r \<Longrightarrow> arr_mset arr l (r + 1) = arr_mset arr l r + {#arr r#}"
+  using arr_mset_remove_last[of l r arr] by simp
+
+corollary arr_mset_append_alt: 
+  "l \<le> r \<Longrightarrow> arr_mset (arr(r := b)) l (r + 1) = arr_mset arr l r + {#b#}"
+  by (simp add: arr_mset_append mset_ran_subst_outside)
+
+lemma arr_mset_remove_first: 
+  "i \<le> r \<Longrightarrow> arr_mset arr (i - 1) r = arr_mset arr i r + {#arr (i - 1)#}"
+  by(induction r rule: int_ge_induct) (auto simp add: arr_mset_append)
+
+lemma arr_mset_split: 
+  assumes "l \<le> m" "m \<le> r"
+  shows "arr_mset arr l r = arr_mset arr l m + arr_mset arr m r"
+  using assms
+proof(induction m rule: int_ge_induct[of l])
+  case (step i)
+  have add_last: "arr_mset arr l (i + 1) = arr_mset arr l i + {#arr i#}"
+    using step arr_mset_append by blast
+  have rem_first: "arr_mset arr (i+1) r = arr_mset arr i r - {#arr i#}"
+    by (metis step.prems arr_mset_remove_first add_diff_cancel_right') 
+  show ?case 
+    using step add_last rem_first by fastforce
+qed (simp)
+
+text \<open>That the first element in a heap is the ``smallest'', can now be expressed using multisets.\<close>
+corollary heap_first_el_alt:                                                   
+  assumes 
+    "transp cmp" 
+    "is_heap cmp heap l r" 
+    "x \<in># (arr_mset heap l r)" 
+    "heap l \<noteq> x"
+  shows "cmp (heap l) x"
+  by(metis assms heap_first_el in_mset_imp_in_array le_less)
+
+
+subsection \<open>Lemmas on @{term "swap"} and @{term "eq_on"}\<close>
+
+lemma eq_on_subset: 
+  "arr1 = arr2 on R \<Longrightarrow> S \<subseteq> R \<Longrightarrow> arr1 = arr2 on S"
+  by (simp add: eq_on_def set_mp)
+
+lemma swap_swaps: 
+  "arr' = swap arr x y \<Longrightarrow> arr' y = arr x \<and> arr' x = arr y"
+  unfolding swap_def by simp
+
+lemma swap_only_swaps: 
+  "arr' = swap arr x y \<Longrightarrow> z \<noteq> x \<Longrightarrow> z \<noteq> y \<Longrightarrow> arr' z = arr z"
+  unfolding swap_def by simp
+
+lemma swap_commute: "swap arr x y = swap arr y x"
+  unfolding swap_def by fastforce
+
+lemma swap_eq_on: 
+  "arr1 = arr2 on S \<Longrightarrow> x \<notin> S \<Longrightarrow> y \<notin> S \<Longrightarrow> arr1 = swap arr2 x y on S"
+  unfolding swap_def by simp
+
+corollary swap_parent_eq_on: 
+  assumes 
+    "arr1 = arr2 on - {l..<r}" 
+    "l < c" "c < r" 
+  shows "arr1 = swap arr2 (parent l c) c on - {l..<r} "
+  using parent_bounds swap_eq_on assms by fastforce
+
+corollary swap_child_eq_on: 
+  assumes 
+    "arr1 = arr2 on - {l..<r}" 
+    "c = l_child l p \<or> c = r_child l p" 
+    "l \<le> p" "c < r" 
+  shows "arr1 = swap arr2 p c on - {l..<r} "
+  by (metis assms parent_lower_bound parent_two_children swap_parent_eq_on)
+
+lemma swap_child_mset: 
+  assumes 
+    "arr_mset arr1 l r = arr_mset arr2 l r" 
+    "c = l_child l p \<or> c = r_child l p" 
+    "l \<le> p" "c < r" 
+  shows "arr_mset arr1 l r = arr_mset (swap arr2 p c) l r"
+proof -
+  have child_bounded: "l < c \<and> c < r"
+    by (metis assms(2-4) parent_lower_bound parent_two_children)
+  have parent_bounded: "bounded l r p"
+    by (metis assms(2-4) dual_order.strict_trans parent_two_children parent_upper_bound_alt)
+  thus ?thesis
+    using assms(1) child_bounded mset_ran_swap[of p "{l..<r}" c arr2] atLeastLessThan_iff
+    by simp
+qed
+
+text \<open>The following lemma shows, which propositions have to hold on the pre-swap array, so that
+      a comparison between two elements holds on the post-swap array. This is useful for the 
+      proofs of the loop invariants of \<open>sift_up\<close> and \<open>sift_down\<close>. The lemma is kept 
+      quite general (except for the argument order) and could probably be more closely
+      related to the parent relation for more concise proofs.\<close>
+lemma cmp_swapI: 
+  fixes arr::"'a::order \<Rightarrow> 'a::order"
+  assumes
+    "m < n \<and> x < y"
+    "m < n \<and> x < y \<Longrightarrow> x = m \<Longrightarrow> y = n \<Longrightarrow> P (arr n) (arr m)"
+    "m < n \<and> x < y \<Longrightarrow> x \<noteq> m \<Longrightarrow> x \<noteq> n \<Longrightarrow> y \<noteq> m \<Longrightarrow> y \<noteq> n \<Longrightarrow> P (arr m) (arr n)"
+    "m < n \<and> x < y \<Longrightarrow> x = m \<Longrightarrow> y \<noteq> m \<Longrightarrow> y \<noteq> n \<Longrightarrow>  P (arr y) (arr n)"
+    "m < n \<and> x < y \<Longrightarrow> x = n \<Longrightarrow> y \<noteq> m \<Longrightarrow> y \<noteq> n \<Longrightarrow>  P (arr m) (arr y)"
+    "m < n \<and> x < y \<Longrightarrow> x \<noteq> m \<Longrightarrow> x \<noteq> n \<Longrightarrow> y = n \<Longrightarrow> P (arr m) (arr x)"
+    "m < n \<and> x < y \<Longrightarrow> x \<noteq> m \<Longrightarrow> x \<noteq> n \<Longrightarrow> y = m \<Longrightarrow> P (arr x) (arr n)"
+  shows "P (swap arr x y m) (swap arr x y n)"
+  by (metis assms order.asym swap_only_swaps swap_swaps)
+
+section \<open>Imperative Heap Implementation\<close>
+text \<open>The following imperative heap functions are based on \cite{MS} and \cite{CLRS}. All functions,
+      that are recursive in these books, are iterative in the following implementations. The 
+      function definitions are done with IMP2 \cite{IMP2-AFP}. From now on the heaps only contain 
+      ints and only use \<open>\<le>\<close> as comparison function. The auxiliary lemmas used from now on are 
+      heavily modeled after the proof goals, that are generated by the vcg tool (also part of IMP2).\<close>
+
+subsection \<open>Simple Functions\<close>
+subsubsection \<open>Parent, Children and Swap\<close>
+text \<open>In this section the parent and children relations are expressed as IMP2 procedures. 
+      Additionally a simple procedure, that swaps two array elements, is defined.\<close>
+procedure_spec prnt (l, x) returns p
+  assumes True
+    ensures "p = parent l\<^sub>0 x\<^sub>0"
+  defines \<open>p = ((x - l - 1) / 2 + l)\<close>
+  by vcg (simp add: parent_def)
+
+procedure_spec left_child (l, x) returns lc
+  assumes True 
+    ensures "lc = l_child l\<^sub>0 x\<^sub>0"
+  defines \<open>lc = 2 * x - l + 1\<close>
+  by vcg (simp add: l_child_def)
+
+procedure_spec right_child (l, x) returns rc
+  assumes True
+    ensures "rc = r_child l\<^sub>0 x\<^sub>0"
+  defines \<open>rc = 2 * x - l + 2\<close>
+  by vcg (simp add: r_child_def)
+
+procedure_spec swp (heap, x, y) returns heap
+  assumes True
+    ensures "heap = swap heap\<^sub>0 x\<^sub>0 y\<^sub>0 "
+  defines \<open>tmp = heap[x]; heap[x] = heap[y]; heap[y] = tmp\<close>
+  by vcg (simp add: swap_def)
+
+subsubsection \<open>\<open>get_min\<close>\<close>
+text \<open>In this section \<open>get_min\<close> is defined, which simply returns the first element (the minimum) of 
+      the heap. For this definition an additional theorem is proven, which enables the use of
+      @{const "Min_mset"} in the postcondition.\<close>
+
+theorem heap_minimum: 
+  assumes 
+    "l < r" 
+    "is_heap (\<le>) heap l r"
+  shows "heap l = Min_mset (arr_mset heap l r)"
+proof -
+  have "(\<forall>x \<in># (arr_mset heap l r). (heap l) \<le> x)"
+    using assms(2) heap_first_el_alt transp_le by blast
+  thus ?thesis
+    by (simp add: assms(1) dual_order.antisym)
+qed
+
+procedure_spec get_min (heap, l, r) returns min
+  assumes "l < r \<and> is_heap (\<le>) heap l r"  
+    ensures "min = Min_mset (arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0)"
+  for heap[] l r
+  defines \<open>min = heap[l]\<close>
+  by vcg (simp add: heap_minimum)
+
+subsection \<open>Modifying Functions\<close>
+
+subsubsection \<open>\<open>sift_up\<close> and \<open>insert\<close>\<close>
+text \<open>The next heap function is \<open>insert\<close>, which internally uses \<open>sift_up\<close>. In the beginning of 
+      this section \<open>sift_up_step\<close> is proven, which states that each \<open>sift_up\<close> loop iteration 
+      correctly transforms the weakened heap invariant. For its proof two additional
+      auxiliary lemmas are used. After \<open>sift_up_step\<close> \<open>sift_up\<close> and then \<open>insert\<close> are verified.\<close>
+
+text \<open>\<open>sift_up_step\<close> can be proven directly by the smt-solver without auxiliary lemmas, but they
+      were introduced to show the proof details. The analogous proofs for \<open>sift_down\<close> were 
+      just solved with smt, since the proof structure should be very similar, even though the 
+      \<open>sift_down\<close> proof goals are slightly more complex.\<close>
+lemma sift_up_step_aux1:
+  fixes heap::"int \<Rightarrow> int"
+  assumes  
+    "is_heap_except_up (\<le>) heap l r x"
+    "parent l x \<ge> l" 
+    "(heap x) \<le> (heap (parent l x))" 
+    "bounded l r k" 
+    "k \<noteq> (parent l x)" 
+    "bounded l r (parent l k)"
+  shows "(swap heap (parent l x) x (parent l k)) \<le> (swap heap (parent l x) x k)"
+  apply(intro cmp_swapI[of "(parent l k)" k "(parent l x)" x "(\<le>)" heap])
+  subgoal using assms(2,6) parent_upper_bound_alt by blast
+  subgoal using assms(3) by blast
+  subgoal using assms(1,4,6) unfolding is_heap_except_up_def by blast
+  subgoal using assms(1,3,4,6) unfolding is_heap_except_up_def by fastforce
+  subgoal using assms(5) by blast
+  subgoal by blast 
+  subgoal using assms(1,2,4) unfolding is_heap_except_up_def by simp
+  done
+
+lemma sift_up_step_aux2: 
+  fixes heap::"int \<Rightarrow> int"
+  assumes
+    "is_heap_except_up (\<le>) heap l r x"
+    "parent l x \<ge> l"
+    "heap x \<le> (heap (parent l x))"
+    "bounded l r k"
+    "parent l k = parent l x"
+    "bounded l r (parent l (parent l k))"
+  shows 
+    "swap heap (parent l x) x (parent l (parent l k)) \<le> swap heap (parent l x) x k"
+  using assms unfolding is_heap_except_up_def
+proof-
+  let ?gp_k = "parent l (parent l k)"
+  let ?gp_x = "parent l (parent l x)"
+  have gp_k_eq_gp_x: "swap heap (parent l x) x ?gp_k = heap ?gp_x"
+    by (metis assms(2,5) grand_parent_upper_bound less_irrefl swap_only_swaps)
+  show ?thesis
+      using assms unfolding is_heap_except_up_def
+  proof(cases)
+    assume k_eq_x: "k = x"
+    have "swap heap (parent l x) x k = heap (parent l x)"
+      by (metis k_eq_x swap_swaps)
+    then show ?thesis
+      using assms(1,2,4,6) unfolding is_heap_except_up_def
+      by (metis gp_k_eq_gp_x k_eq_x parent_bounds parent_lower_bound)
+  next
+    assume k_neq_x: "k \<noteq> x"
+    have "swap heap (parent l x) x k = heap k"
+      by (metis assms(5) gp_k_eq_gp_x k_neq_x swap_only_swaps)
+    then show ?thesis using assms unfolding is_heap_except_up_def
+      by (metis gp_k_eq_gp_x k_neq_x order_trans parent_bounds parent_lower_bound)
+  qed
+qed
+
+lemma sift_up_step:
+  fixes heap::"int \<Rightarrow> int"
+  assumes  
+    "is_heap_except_up (\<le>) heap l r x"
+    "parent l x \<ge> l" 
+    "(heap x) \<le> (heap (parent l x))"
+  shows "is_heap_except_up (\<le>) (swap heap (parent l x) x) l r (parent l x)"
+  using assms sift_up_step_aux1 sift_up_step_aux2
+  unfolding is_heap_except_up_def by blast
+
+text \<open>\<open>sift_up\<close> restores the heap invariant, that is only violated at the current position, by 
+      iteratively swapping the current element with its parent until the beginning of the array is 
+      reached or the current element is bigger than its parent.\<close>
+procedure_spec sift_up (heap, l, r, x) returns heap
+  assumes "is_heap_except_up (\<le>) heap l r x \<and> bounded l r x"
+    ensures "is_heap (\<le>) heap l\<^sub>0 r\<^sub>0 \<and>
+             arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset heap l\<^sub>0 r\<^sub>0 \<and>
+             heap\<^sub>0 = heap on - {l\<^sub>0..<r\<^sub>0}"
+  for heap[] l x r
+  defines \<open>
+    p = prnt(l, x);
+    while (x > l \<and> heap[x] \<le> heap[p]) 
+      @variant \<open>x - l\<close>
+      @invariant \<open>is_heap_except_up (\<le>) heap l r x \<and> p = parent l x \<and> 
+                  bounded l r x \<and> arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset heap l r \<and>
+                  heap\<^sub>0 = heap  on - {l..<r}\<close> 
+    {
+        heap = swp(heap, p, x);
+        x = p;
+        p = prnt(l, x)
+    }\<close>
+  apply vcg_cs
+  apply(intro conjI)
+  subgoal using parent_lower_bound sift_up_step by blast
+  subgoal using parent_lower_bound by blast
+  subgoal using parent_bounds by blast
+  subgoal using parent_bounds by (simp add: mset_ran_swap)
+  subgoal using swap_parent_eq_on by blast
+  subgoal using parent_upper_bound by simp
+  subgoal unfolding is_heap_except_up_def is_partial_heap_def
+    by (metis le_less not_less parent_lower_bound)
+  done
+
+text \<open>\<open>insert\<close> inserts an element into a heap by appending it to the heap and restoring the heap 
+      invariant with @{const "sift_up"}.\<close>
+procedure_spec insert (heap, l, r, el) returns (heap, l, r)
+  assumes "is_heap (\<le>) heap l r \<and> l \<le> r"  
+    ensures "is_heap (\<le>) heap l r \<and>
+             arr_mset heap l r = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 + {#el\<^sub>0#} \<and>
+             l = l\<^sub>0 \<and> r = r\<^sub>0 + 1  \<and> heap\<^sub>0 = heap on - {l..<r}"
+  for heap l r el
+  defines \<open>
+    heap[r] = el;
+    x = r;
+    r = r + 1;
+    heap = sift_up(heap, l, r, x)
+  \<close>
+  apply vcg_cs 
+  subgoal by (simp add: heap_appended_el)
+  subgoal by (metis arr_mset_append_alt add_mset_add_single)
+  done
+
+subsubsection \<open>\<open>sift_down\<close>, \<open>del_min\<close> and \<open>make_heap\<close>\<close>
+text \<open>The next heap functions are \<open>del_min\<close> and \<open>make_heap\<close>, which both use \<open>sift_down\<close> to 
+      restore/establish the heap invariant. \<open>sift_down\<close> is proven first (this time without 
+      additional auxiliary lemmas) followed by \<open>del_min\<close> and \<open>make_heap\<close>.\<close>
+
+text \<open>\<open>sift_down\<close> restores the heap invariant, that is only violated at the current position, by 
+      iteratively swapping the current element with its smallest child until the end of 
+      the array is reached or the current element is smaller than its children.\<close>
+procedure_spec sift_down(heap, l, r, x) returns heap 
+  assumes "is_partial_heap_except_down (\<le>) heap l x r x \<and> l \<le> x \<and> x \<le> r"
+    ensures "is_partial_heap (\<le>) heap l\<^sub>0 x\<^sub>0 r\<^sub>0 \<and> 
+             arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset heap l\<^sub>0 r\<^sub>0 \<and> 
+             heap\<^sub>0 = heap on - {l\<^sub>0..<r\<^sub>0}"
+  defines \<open>
+   lc = left_child(l, x);
+   rc = right_child(l, x);
+    while (lc < r \<and> (heap[lc] < heap[x] \<or> (rc < r \<and> heap[rc] < heap[x]))) 
+      @variant \<open>r - x\<close>
+      @invariant \<open>is_partial_heap_except_down (\<le>) heap l x\<^sub>0 r x \<and>
+                  x\<^sub>0 \<le> x \<and> x \<le> r \<and> lc = l_child l x \<and> rc = r_child l x \<and>
+                  arr_mset heap\<^sub>0 l r = arr_mset heap l r \<and>
+                  heap\<^sub>0 = heap on - {l..<r}\<close>
+  { 
+    smallest = lc;
+    if (rc < r \<and> heap[rc] < heap[lc]) {
+      smallest = rc
+    };
+    heap = swp(heap, x, smallest);
+    x = smallest;
+    lc = left_child(l, x);
+    rc = right_child(l, x)
+  }\<close>
+  apply vcg_cs
+  subgoal
+    apply(intro conjI)
+    subgoal unfolding is_partial_heap_except_down_def
+      by (smt parent_two_children swap_swaps swap_only_swaps
+          swap_commute parent_upper_bound_alt)
+    subgoal using r_child_lower_bound_alt by fastforce
+    subgoal using swap_child_mset order_trans by blast
+    subgoal using swap_child_eq_on by fastforce
+    done
+  subgoal
+    by (meson less_le_trans not_le order.asym r_child_lower_bound) 
+  subgoal
+    apply(intro conjI)
+    subgoal unfolding is_partial_heap_except_down_def
+      by (smt parent_two_children swap_swaps swap_only_swaps
+          swap_commute parent_upper_bound_alt)
+    subgoal using l_child_lower_bound_alt by fastforce
+    subgoal using swap_child_mset order_trans by blast
+    subgoal using swap_child_eq_on by fastforce
+    done
+  subgoal 
+    by (meson less_le_trans not_le order.asym l_child_lower_bound)
+  subgoal unfolding is_partial_heap_except_down_def is_partial_heap_def
+    by (metis dual_order.strict_trans not_less parent_two_children smaller_l_child)
+  done
+
+
+text \<open>\<open>del_min\<close> needs an additional lemma which shows, that it actually removes (only) the minimum
+      from the heap.\<close>
+lemma del_min_mset: 
+  fixes heap::"int \<Rightarrow> int"
+  assumes 
+    "l < r"
+    "is_heap (\<le>) heap l r"
+    "mod_heap = heap(l := heap (r - 1))"
+    "arr_mset mod_heap l (r - 1) = arr_mset new_heap l (r - 1)"
+  shows 
+    "arr_mset new_heap l (r - 1) = arr_mset heap l r - {#Min_mset (arr_mset heap l r)#}"
+proof -
+  let ?heap_mset = "arr_mset heap l r"
+  have l_is_min: "heap l = Min_mset ?heap_mset"
+    using assms(1,2) heap_minimum by blast
+  have "(arr_mset mod_heap l r) = ?heap_mset + {#heap (r-1)#} - {#heap l#}"
+    by (simp add: assms(1,3) mset_ran_subst_inside)
+  hence "(arr_mset mod_heap l (r - 1)) = ?heap_mset - {#heap l#}"
+    by (simp add: assms(1,3) arr_mset_remove_last) 
+  thus ?thesis
+    using assms(4) l_is_min by simp
+qed
+
+text \<open>\<open>del_min\<close> removes the minimum element from the heap by replacing the first element with the 
+      last element, shrinking the array by one and subsequently restoring the heap invariant 
+      with @{const "sift_down"}.\<close>
+procedure_spec del_min (heap, l, r) returns (heap, l, r)
+  assumes "l < r \<and> is_heap (\<le>) heap l r"  
+    ensures "is_heap (\<le>) heap l r \<and> 
+             arr_mset heap l r = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 - {#Min_mset (arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0)#} \<and> 
+             l = l\<^sub>0 \<and> r = r\<^sub>0 - 1 \<and> 
+             heap\<^sub>0 = heap on - {l\<^sub>0..<r\<^sub>0}"
+  for heap l r
+  defines \<open>
+    r = r - 1;
+    heap[l] = heap[r];
+    heap = sift_down(heap, l, r, l)
+  \<close>
+  apply vcg_cs
+  subgoal by (simp add: heap_changed_first_el is_partial_heap_smaller_back)
+  subgoal
+    apply(rule conjI)
+    subgoal using del_min_mset by blast
+    subgoal by (simp add: eq_on_def intvs_incdec(3) intvs_lower_incr)
+    done
+  done
+
+
+text \<open>\<open>make_heap\<close> transforms an arbitrary array into a heap by iterating through all array 
+      positions from the middle of the array up to the beginning of the array and calling 
+      @{const "sift_down"} for each one.\<close>
+procedure_spec make_heap (heap, l, r) returns heap
+  assumes "l \<le> r"  
+    ensures "is_heap (\<le>) heap l\<^sub>0 r\<^sub>0 \<and> 
+             arr_mset heap l\<^sub>0 r\<^sub>0 = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 \<and> 
+             heap\<^sub>0 = heap on - {l\<^sub>0..< r\<^sub>0}"
+  for heap[] l r
+  defines \<open>
+    y = (r + l)/2 - 1;
+    while (y \<ge> l)
+          @variant \<open>y - l + 1\<close>
+          @invariant \<open>is_partial_heap (\<le>) heap l (y + 1) r \<and>
+                      arr_mset heap l r = arr_mset heap\<^sub>0 l\<^sub>0 r\<^sub>0 \<and>
+                      l - 1 \<le> y \<and> y < r \<and> heap\<^sub>0 = heap on - {l..<r}\<close>
+    {
+      heap = sift_down(heap, l, r, y);
+      y = y - 1
+    }\<close> 
+  apply(vcg_cs)
+  subgoal 
+    apply(rule conjI)
+    subgoal by (simp add: snd_half_is_partial_heap add.commute)
+    subgoal by linarith 
+    done
+  subgoal using partial_heap_added_first_el le_less by blast 
+  subgoal using eq_on_trans by blast 
+  subgoal using dual_order.antisym by fastforce
+  done
+
+subsection \<open>Heapsort Implementation\<close>
+
+text \<open>The final part of this submission is the implementation of the in-place heapsort. Firstly it 
+      builds the \<open>\<le>\<close>-heap and then it iteratively removes the minimum of the heap, which is put at 
+      the now vacant end of the shrinking heap. This is done until the heap is empty, which leaves 
+      the array sorted in descending order.\<close>
+subsubsection \<open>Auxiliary Lemmas\<close>
+text \<open>Firstly the notion of a sorted array is needed. This is more or less the same as 
+      @{const "ran_sorted"} generalized for arbitrary comparison functions.\<close>
+definition array_is_sorted :: "(int \<Rightarrow> int \<Rightarrow> bool) \<Rightarrow>  (int \<Rightarrow> int) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
+  "array_is_sorted cmp a l r \<equiv> \<forall>i. \<forall>j. bounded l r i \<longrightarrow> bounded l r j \<longrightarrow> i < j \<longrightarrow> cmp (a i) (a j)"
+
+text \<open>This lemma states, that the heapsort doesn't change the elements contained in the array during
+      the loop iterations.\<close>
+lemma heap_sort_mset_step:
+  fixes arr::"int \<Rightarrow> int"
+  assumes 
+    "l < m" "m \<le> r"
+    "arr_mset arr' l (m - 1) = arr_mset arr l m - {#Min_mset (arr_mset arr l m)#}"
+    "arr = arr' on - {l..<m}"
+    "mod_arr = arr'(m - 1 := Min_mset (arr_mset arr l m))"
+  shows "arr_mset arr l r = arr_mset mod_arr l r"
+proof -
+  let ?min = "{#Min_mset (arr_mset arr l m)#}"
+  let ?new_arr_mset = "arr_mset mod_arr"
+  have middle: "?new_arr_mset (m - 1) m = ?min"
+    by (simp add: assms(5))
+  have first_half: "?new_arr_mset l (m - 1) = arr_mset arr l m - ?min"
+    by (simp add: assms(3,5) mset_ran_subst_outside)
+  hence "?new_arr_mset l m = ?new_arr_mset l (m - 1) + ?new_arr_mset (m - 1) m"
+    by (metis assms(1,3,5) diff_add_cancel middle arr_mset_append_alt zle_diff1_eq)
+  hence first_half_middle: "?new_arr_mset l m = arr_mset arr l m"
+    using middle first_half assms(1) by simp
+
+  hence "mod_arr = arr on - {l..<m}"
+    using assms(1,4,5) eq_on_sym eq_on_trans by auto
+  then have second_half: "arr_mset arr m r = arr_mset mod_arr m r"
+    by (simp add: eq_on_def mset_ran_cong)
+
+  then show ?thesis
+    by (metis arr_mset_split assms(1,2) first_half_middle le_less)
+qed
+
+text \<open>This lemma states, that each loop iteration leaves the growing second half of the array 
+      sorted in descending order.\<close>
+lemma heap_sort_second_half_sorted_step: 
+  fixes arr::"int \<Rightarrow> int"
+  assumes
+    "l\<^sub>0 < m" "m \<le> r\<^sub>0"
+    "arr = arr' on - {l\<^sub>0..<m}"
+    "\<forall>i. \<forall>j. bounded m r\<^sub>0 i \<longrightarrow> bounded m r\<^sub>0 j \<longrightarrow>  i < j \<longrightarrow> arr j \<le> arr i"
+    "\<forall>x\<in>#arr_mset arr l\<^sub>0 m. \<forall>y\<in>#arr_mset arr m r\<^sub>0. \<not> x < y"
+    "bounded (m - 1) r\<^sub>0 i" 
+    "bounded (m - 1) r\<^sub>0 j" 
+    "i < j"
+    "mod_arr = (arr'(m - 1 := Min_mset (arr_mset arr l\<^sub>0 m)))"
+  shows "mod_arr j \<le> mod_arr i"
+proof -
+  have second_half_eq: "mod_arr = arr on {m..< r\<^sub>0}" 
+    using assms(3, 9) unfolding eq_on_def by simp
+  have j_stricter_bound: "bounded m r\<^sub>0 j"
+    using assms(6-8) by simp
+  then have el_at_j: "mod_arr j \<in># arr_mset arr m r\<^sub>0"
+    using eq_onD second_half_eq by fastforce
+  then show ?thesis 
+  proof(cases)
+    assume "i = (m-1)"
+    then have "mod_arr i \<in># arr_mset arr l\<^sub>0 m"
+      by (simp add: assms(1, 9))
+    then show ?thesis
+      using assms(5) el_at_j not_less by blast 
+  next
+    assume "i \<noteq> (m-1)"  
+    then have "bounded m r\<^sub>0 i"
+      using assms(6) by simp
+    then show ?thesis 
+      using assms(4, 8) eq_on_def j_stricter_bound second_half_eq by force
+  qed
+qed
+
+
+text \<open>The following lemma shows that all elements in the first part of the array (the binary heap) 
+      are bigger than the elements in the second part (the sorted part) after every iteration. This 
+      lemma and the invariant of the \<open>heap_sort\<close> loop use \<open>\<not> x < y\<close> instead of \<open>x \<ge> y\<close> since 
+      \<open>vcg_cs\<close> doesn't terminate in the latter case.\<close>
+lemma heap_sort_fst_part_bigger_snd_part_step:
+  fixes arr::"int \<Rightarrow> int" 
+  assumes
+    "l\<^sub>0 < m"
+    "m \<le> r\<^sub>0"
+    "arr_mset arr' l\<^sub>0 (m - 1) = arr_mset arr l\<^sub>0 m - {#Min_mset (arr_mset arr l\<^sub>0 m)#}"
+    "arr = arr' on - {l\<^sub>0..<m}"
+    "\<forall>x\<in>#arr_mset arr l\<^sub>0 m. \<forall>y\<in>#arr_mset arr m r\<^sub>0. \<not> x < y"
+    "mod_arr = arr'(m - 1 := Min_mset (arr_mset arr l\<^sub>0 m))"
+    "x\<in>#arr_mset mod_arr l\<^sub>0 (m - 1)"
+    "y\<in>#arr_mset mod_arr (m - 1) r\<^sub>0"
+  shows "\<not> x < y"
+proof -
+  have "{m..<r\<^sub>0} \<subseteq> - {l\<^sub>0..<m}" 
+    by auto
+  hence "arr' = arr on {m..<r\<^sub>0}" 
+    using assms(4) eq_on_sym eq_on_subset by blast
+  hence arr_eq_on: "mod_arr = arr on {m..<r\<^sub>0}"
+    by (simp add: assms(6))
+  hence same_mset: "arr_mset mod_arr m r\<^sub>0 = arr_mset arr m r\<^sub>0"
+    using mset_ran_cong by blast
+  have "x \<in># arr_mset arr l\<^sub>0 m" using same_mset assms
+    by (metis assms(3,6,7) add_mset_remove_trivial_eq lran_upd_outside(2)
+        mset_lran cancel_ab_semigroup_add_class.diff_right_commute
+        diff_single_trivial multi_self_add_other_not_self order_refl)
+  then have x_bigger_min: "x \<ge> Min_mset (arr_mset arr l\<^sub>0 m)"
+    using Min_le by blast 
+  have y_smaller_min: "y \<le> Min_mset (arr_mset arr l\<^sub>0 m)" 
+  proof(cases "y = mod_arr (m - 1)")
+    case False
+    hence "y\<in>#arr_mset mod_arr (m - 1) r\<^sub>0 - {#mod_arr (m - 1)#}"
+      by (metis assms(8) diff_single_trivial insert_DiffM insert_noteq_member)
+    then have "y\<in>#arr_mset arr m r\<^sub>0"
+      by (simp add: assms(2) intvs_decr_l mset_ran_insert same_mset)
+    then show ?thesis
+      using assms(1) assms(5) by fastforce 
+  qed (simp add: assms(6))
+  then show ?thesis
+    using x_bigger_min by linarith 
+qed
+
+subsubsection \<open>Implementation\<close>
+text \<open>Now finally the correctness of the \<open>heap_sort\<close> is shown. As mentioned, it starts by 
+      transforming the array into a minimum heap using @{const "make_heap"}. Then in each 
+      iteration it removes the first element from the heap with @{const "del_min"} after its value 
+      was retrieved with @{const "get_min"}. This value is then put at the position freed by 
+      @{const "del_min"}.\<close>
+program_spec heap_sort
+  assumes "l \<le> r"  
+    ensures "array_is_sorted (\<ge>) arr l\<^sub>0 r\<^sub>0 \<and> 
+             arr_mset arr\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset arr l\<^sub>0 r\<^sub>0 \<and> 
+             arr\<^sub>0 = arr on - {l\<^sub>0 ..<r\<^sub>0 } \<and> l = l\<^sub>0 \<and> r = r\<^sub>0"
+  for l r arr[]
+  defines \<open>
+    arr = make_heap(arr, l, r);
+    m = r;
+    while (m > l)
+      @variant \<open>m - l + 1\<close> 
+      @invariant \<open>is_heap (\<le>) arr l m \<and>
+        array_is_sorted (\<ge>) arr m r\<^sub>0 \<and>
+        (\<forall>x \<in># arr_mset arr l\<^sub>0 m. \<forall>y \<in># arr_mset arr m r\<^sub>0. \<not> x < y) \<and>
+        arr_mset arr\<^sub>0 l\<^sub>0 r\<^sub>0 = arr_mset arr l\<^sub>0 r\<^sub>0 \<and> 
+        l \<le> m \<and> m \<le> r\<^sub>0 \<and> l = l\<^sub>0 \<and> arr\<^sub>0 = arr on - {l\<^sub>0 ..<r\<^sub>0}\<close>
+    {
+      min = get_min(arr, l, m);
+      (arr, l, m) = del_min(arr, l, m);
+      arr[m] = min 
+    }
+  \<close>
+  apply vcg_cs
+  subgoal unfolding array_is_sorted_def by simp
+  subgoal
+    apply(intro conjI)
+    subgoal unfolding is_partial_heap_def by simp
+    subgoal unfolding array_is_sorted_def using heap_sort_second_half_sorted_step
+      by blast
+    subgoal using heap_sort_fst_part_bigger_snd_part_step by blast
+    subgoal using heap_sort_mset_step by blast
+    subgoal unfolding eq_on_def
+      by (metis ComplD ComplI atLeastLessThan_iff less_le_trans)
+    done
+  done
+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)
-      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)
-      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)
-      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)
-      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>
-
+(* 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)
+      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)
+      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)
+      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)
+      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/Jordan_Normal_Form/document/root.tex b/thys/Jordan_Normal_Form/document/root.tex
--- a/thys/Jordan_Normal_Form/document/root.tex
+++ b/thys/Jordan_Normal_Form/document/root.tex
@@ -1,133 +1,133 @@
-\documentclass[11pt,a4paper]{article}
-\usepackage{isabelle,isabellesym}
-
-% this should be the last package used
-\usepackage{pdfsetup}
-
-% urls in roman style, theory text in math-similar italics
-\urlstyle{rm}
-\isabellestyle{it}
-
-\newcommand\isafor{\textsf{IsaFoR}}
-\newcommand\ceta{\textsf{Ce\kern-.18emT\kern-.18emA}}
-
-\begin{document}
-
-\title{Matrices, Jordan Normal Forms, and Spectral Radius Theory\footnote{Supported by FWF (Austrian Science Fund) project Y757.}}
-\author{Ren\'e Thiemann and Akihisa Yamada}
-\maketitle
-
-\begin{abstract}
-  Matrix interpretations are useful as measure functions in termination proving.
-  In order to use these interpretations also for complexity analysis, 
-  the growth rate of matrix powers has to examined. Here, we formalized
-  an important result of spectral radius theory, namely that the growth rate
-  is polynomially bounded if and only if the spectral radius of a matrix is at most one. 
-  
-  To formally prove this result we first studied the growth rates of matrices
-  in Jordan normal form, and prove the result that every 
-  complex matrix has a Jordan normal form by means of two algorithms:
-  we first convert matrices into similar ones via Schur decomposition, and
-  then apply a second algorithm which converts an upper-triangular matrix into
-  Jordan normal form. We further showed uniqueness of Jordan normal forms which 
-  then gives rise to a modular algorithm to compute individual blocks of a Jordan
-  normal form. 
-  
-  The whole development is based on a new abstract type for matrices, which is
-  also executable by a suitable setup of the code generator. It 
-  completely subsumes our former AFP-entry on executable matrices 
-  \cite{Matrix-AFP}, and its main advantage is its close connection to the
-  HMA-representation which allowed us to easily adapt existing proofs on 
-  determinants.
-  
- All the results have been applied to improve \ceta\ \cite{CeTA,CeTAcomplexity},
- our certifier to validate termination and complexity proof certificates.
-\end{abstract}
-
-\tableofcontents
-
-\section{Introduction}
-
-The spectral radius of a square, complex valued matrix $A$ is defined as the 
-largest norm of some eigenvalue $c$ with eigenvector $v$. 
-It is a central notion to estimate how
-the values in $A^n$ for increasing $n$. If the spectral radius is larger
-than $1$, clearly the values grow exponentially, since then 
-$A^n \cdot v = c^n \cdot v$ becomes exponentially large. 
-
-The other results, namely
-that the values in $A^n$ are bounded by a constant, 
-if the spectral radius is smaller
-than $1$, and that there is a polynomial bound if the spectral radius
-is exactly $1$ are only immediate for matrices which have an eigenbasis,
-a precondition which is not satisfied by every matrix.
-
-However, these results are derivable via Jordan normal forms (JNFs): 
-If $J$ is a JNF of $A$, then the growth rates of $A^n$ and $J^n$ are related
-by a constant as $A$ and $J$ are similar matrices. And for the values in $J^n$ 
-there is a closed formula which gives the desired complexity bounds.
-To be more precise, the values in $J^n$ are bounded by 
-${\cal O}(|c|^n \cdot n^{k-1})$ where $k$ is the size of the largest
-block of an eigenvalue $c$ which has maximal norm w.r.t.\ the set of all
-eigenvalues. And since every complex matrix has a JNF, we can derive the 
-polynomial (resp.\ constant bounds), if the spectral radius is 1 (resp.\ smaller
-than 1).
-
-These results are already applied in current complexity tools, and the motivation
-of this development was to extend our certifier \ceta\ to be able to validate
-corresponding complexity proofs. To this end, we formalized
-the  following main results:
-\begin{itemize}
-\item an algorithm to compute the characteristic polynomial, since
-  the eigenvalues are exactly the roots of this polynomial;
-\item the complexity bounds for JNFs; and
-\item an algorithm which computes JNFs for every matrix, provided that the
-  list of eigenvalues is given. With the help of the fundamental theorem
-  of algebra this shows that every complex matrix has a JNF.
-\end{itemize}
-
-Since \ceta\ is generated from Isabelle/HOL via code-generation, all the 
-algorithms and results need to be available at code-generation time. Especially
-there is no possibility to create types on the fly which are chosen to fit 
-the matrix dimensions of the input. To this end, we cannot use the 
-matrix-representation of HOL multivariate analysis (HMA).
-
-Instead, we provide a new matrix library which is based on HOL-algebra with
-its explicit carriers. In contrast to our earlier development \cite{Matrix-AFP}, 
-we do not immediately formalize everything as lists of lists, 
-but use a more mathematical
-notion as triples of the form (dimension, dimension, characteristic-function).
-This makes reasoning very similar to HMA, and a suitable implementation type
-can be chosen afterwards: we provide one via immutable arrays (we use IArray's from
-the HOL library),
-but one can also think of an implementation for sparse matrices, etc.
-Even the infinite carrier itself is executable where we rely upon Lochbihler's
-container framework \cite{Containers-AFP} to have different set representations 
-at the same time.
-
-As a consequence of not using HMA, we could not directly reuse existing 
-algorithms which
-have been formalized for this representation. For instance, we formalized our
-own version of Gauss-Jordan elimination which is not very different to the
-one of Divas\'on and Aransay in \cite{Gauss_Jordan-AFP}: both define row-echelon
-form and apply elementary row transformations. Whereas Gauss-Jordan elimination
-has been developed from scratch as a case-study to see how suitable our matrix
-representation is, in other cases we often just
-copied and adjusted existing proofs from HMA. For instance, most of the library for 
-determinants has been copied from the Isabelle distribution and adapted to our
-matrix representation.
-
-
-As a result of our formalization, \ceta\ is now able to check  
-polynomial bounds for matrix interpretations \cite{MatrixJAR}. 
-
-
-% include generated text of all theories
-\input{session}
-
-
-
-\bibliographystyle{abbrv}
-\bibliography{root}
-
-\end{document}
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+
+% this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+\newcommand\isafor{\textsf{IsaFoR}}
+\newcommand\ceta{\textsf{Ce\kern-.18emT\kern-.18emA}}
+
+\begin{document}
+
+\title{Matrices, Jordan Normal Forms, and Spectral Radius Theory\footnote{Supported by FWF (Austrian Science Fund) project Y757.}}
+\author{Ren\'e Thiemann and Akihisa Yamada}
+\maketitle
+
+\begin{abstract}
+  Matrix interpretations are useful as measure functions in termination proving.
+  In order to use these interpretations also for complexity analysis, 
+  the growth rate of matrix powers has to examined. Here, we formalized
+  an important result of spectral radius theory, namely that the growth rate
+  is polynomially bounded if and only if the spectral radius of a matrix is at most one. 
+  
+  To formally prove this result we first studied the growth rates of matrices
+  in Jordan normal form, and prove the result that every 
+  complex matrix has a Jordan normal form by means of two algorithms:
+  we first convert matrices into similar ones via Schur decomposition, and
+  then apply a second algorithm which converts an upper-triangular matrix into
+  Jordan normal form. We further showed uniqueness of Jordan normal forms which 
+  then gives rise to a modular algorithm to compute individual blocks of a Jordan
+  normal form. 
+  
+  The whole development is based on a new abstract type for matrices, which is
+  also executable by a suitable setup of the code generator. It 
+  completely subsumes our former AFP-entry on executable matrices 
+  \cite{Matrix-AFP}, and its main advantage is its close connection to the
+  HMA-representation which allowed us to easily adapt existing proofs on 
+  determinants.
+  
+ All the results have been applied to improve \ceta\ \cite{CeTA,CeTAcomplexity},
+ our certifier to validate termination and complexity proof certificates.
+\end{abstract}
+
+\tableofcontents
+
+\section{Introduction}
+
+The spectral radius of a square, complex valued matrix $A$ is defined as the 
+largest norm of some eigenvalue $c$ with eigenvector $v$. 
+It is a central notion to estimate how
+the values in $A^n$ for increasing $n$. If the spectral radius is larger
+than $1$, clearly the values grow exponentially, since then 
+$A^n \cdot v = c^n \cdot v$ becomes exponentially large. 
+
+The other results, namely
+that the values in $A^n$ are bounded by a constant, 
+if the spectral radius is smaller
+than $1$, and that there is a polynomial bound if the spectral radius
+is exactly $1$ are only immediate for matrices which have an eigenbasis,
+a precondition which is not satisfied by every matrix.
+
+However, these results are derivable via Jordan normal forms (JNFs): 
+If $J$ is a JNF of $A$, then the growth rates of $A^n$ and $J^n$ are related
+by a constant as $A$ and $J$ are similar matrices. And for the values in $J^n$ 
+there is a closed formula which gives the desired complexity bounds.
+To be more precise, the values in $J^n$ are bounded by 
+${\cal O}(|c|^n \cdot n^{k-1})$ where $k$ is the size of the largest
+block of an eigenvalue $c$ which has maximal norm w.r.t.\ the set of all
+eigenvalues. And since every complex matrix has a JNF, we can derive the 
+polynomial (resp.\ constant bounds), if the spectral radius is 1 (resp.\ smaller
+than 1).
+
+These results are already applied in current complexity tools, and the motivation
+of this development was to extend our certifier \ceta\ to be able to validate
+corresponding complexity proofs. To this end, we formalized
+the  following main results:
+\begin{itemize}
+\item an algorithm to compute the characteristic polynomial, since
+  the eigenvalues are exactly the roots of this polynomial;
+\item the complexity bounds for JNFs; and
+\item an algorithm which computes JNFs for every matrix, provided that the
+  list of eigenvalues is given. With the help of the fundamental theorem
+  of algebra this shows that every complex matrix has a JNF.
+\end{itemize}
+
+Since \ceta\ is generated from Isabelle/HOL via code-generation, all the 
+algorithms and results need to be available at code-generation time. Especially
+there is no possibility to create types on the fly which are chosen to fit 
+the matrix dimensions of the input. To this end, we cannot use the 
+matrix-representation of HOL multivariate analysis (HMA).
+
+Instead, we provide a new matrix library which is based on HOL-algebra with
+its explicit carriers. In contrast to our earlier development \cite{Matrix-AFP}, 
+we do not immediately formalize everything as lists of lists, 
+but use a more mathematical
+notion as triples of the form (dimension, dimension, characteristic-function).
+This makes reasoning very similar to HMA, and a suitable implementation type
+can be chosen afterwards: we provide one via immutable arrays (we use IArray's from
+the HOL library),
+but one can also think of an implementation for sparse matrices, etc.
+Even the infinite carrier itself is executable where we rely upon Lochbihler's
+container framework \cite{Containers-AFP} to have different set representations 
+at the same time.
+
+As a consequence of not using HMA, we could not directly reuse existing 
+algorithms which
+have been formalized for this representation. For instance, we formalized our
+own version of Gauss-Jordan elimination which is not very different to the
+one of Divas\'on and Aransay in \cite{Gauss_Jordan-AFP}: both define row-echelon
+form and apply elementary row transformations. Whereas Gauss-Jordan elimination
+has been developed from scratch as a case-study to see how suitable our matrix
+representation is, in other cases we often just
+copied and adjusted existing proofs from HMA. For instance, most of the library for 
+determinants has been copied from the Isabelle distribution and adapted to our
+matrix representation.
+
+
+As a result of our formalization, \ceta\ is now able to check  
+polynomial bounds for matrix interpretations \cite{MatrixJAR}. 
+
+
+% include generated text of all theories
+\input{session}
+
+
+
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+\end{document}
diff --git a/thys/Paraconsistency/document/root.tex b/thys/Paraconsistency/document/root.tex
--- a/thys/Paraconsistency/document/root.tex
+++ b/thys/Paraconsistency/document/root.tex
@@ -1,124 +1,124 @@
-\documentclass[11pt,a4paper]{article}
-
-\title{Paraconsistency}
-
-\author{Anders Schlichtkrull \&\ J{\o}rgen Villadsen, DTU Compute, Denmark}
-
-\date{\isadate\today}
-
-\usepackage{datetime,isabelle,isabellesym,parskip,underscore}
-
-\newdateformat{isadate}{\THEDAY\ \monthname[\THEMONTH] \THEYEAR}
-
-\usepackage[cm]{fullpage}
-
-\usepackage{pdfsetup}
-
-\isabellestyle{tt}
-
-\urlstyle{rm}
-
-\renewcommand{\isachardoublequote}{}
-\renewcommand{\isachardoublequoteopen}{}
-\renewcommand{\isachardoublequoteclose}{}
-
-\renewcommand{\isamarkupchapter}[1]{\clearpage\isamarkupsection{#1}}
-\renewcommand{\isamarkupsection}[1]{\section*{#1}\addcontentsline{toc}{section}{#1}}
-\renewcommand{\isamarkupsubsection}[1]{\medskip\subsection*{#1}}
-\renewcommand{\isamarkupsubsubsection}[1]{\medskip\subsubsection*{#1}}
-
-\renewcommand{\isabeginpar}{\par\ifisamarkup\relax\else\bigskip\fi}
-\renewcommand{\isaendpar}{\par\bigskip}
-
-\begin{document}
-
-\makeatletter
-\parbox[t]{\textwidth}{\centering\Huge\bfseries\@title}\par\kern5mm
-\parbox[t]{\textwidth}{\centering\Large\bfseries\@author}\par\kern3mm
-\parbox[t]{\textwidth}{\centering\bfseries\@date}\par\kern8mm
-\makeatother
-
-\begin{abstract}\normalsize\noindent
-Paraconsistency is about handling inconsistency in a coherent way. In classical and intuitionistic
-logic everything follows from an inconsistent theory. A paraconsistent logic avoids the explosion.
-Quite a few applications in computer science and engineering are discussed in the Intelligent
-Systems Reference Library Volume 110: Towards Paraconsistent Engineering (Springer 2016). We
-formalize a paraconsistent many-valued logic that we motivated and described in a special issue on
-logical approaches to paraconsistency (Journal of Applied Non-Classical Logics 2005). We limit
-ourselves to the propositional fragment of the higher-order logic. The logic is based on so-called
-key equalities and has a countably infinite number of truth values. We prove theorems in the logic
-using the definition of validity. We verify truth tables and also counterexamples for non-theorems.
-We prove meta-theorems about the logic and finally we investigate a case study.
-\end{abstract}
-
-\tableofcontents
-
-\isamarkupsection{Preface}
-
-The present formalization in Isabelle essentially follows our extended abstract \cite{Jensen+12}.
-The Stanford Encyclopedia of Philosophy has a comprehensive overview of logical approaches to
-paraconsistency \cite{Priest+15}. We have elsewhere explained the rationale for our paraconsistent
-many-valued logic and considered applications in multi-agent systems and natural language semantics
-\cite{Villadsen05-JANCL,Villadsen09,Villadsen10,Villadsen14}.
-
-It is a revised and extended version of our formalization \url{https://github.com/logic-tools/mvl}
-that accompany our chapter in a book on partiality published by Cambridge Scholars Press. The GitHub
-link provides more information. We are grateful to the editors --- Henning Christiansen, M. Dolores
-Jim\'{e}nez L\'{o}pez, Roussanka Loukanova and Larry Moss --- for the opportunity to contribute to
-the book.
-
-\input{session}
-
-\clearpage\addcontentsline{toc}{section}{References}
-
-\begin{thebibliography}{0}
-
-\bibitem{Jensen+12}
-A.~S. Jensen and J.~Villadsen.
-\newblock
-\emph{Paraconsistent Computational Logic}.
-\newblock
-In P.~Blackburn, K.~F.~J{\o}rgensen, N.~Jones, and E.~Palmgren, editors, 8th Scandinavian Logic
-Symposium: Abstracts, pages 59--61, Roskilde University, 2012.
-
-\bibitem{Priest+15}
-G.~Priest, K.~Tanaka and Z.~Weber.
-\newblock
-\emph{Paraconsistent Logic}.
-\newblock
-In E.~N. Zalta et~al., editors, Stanford Encyclopedia of Philosophy, Online Entry
-\url{http://plato.stanford.edu/entries/logic-paraconsistent/} Spring Edition, 2015.
-
-\bibitem{Villadsen05-JANCL}
-J.~Villadsen.
-\newblock
-\emph{Supra-logic: Using Transfinite Type Theory with Type Variables for Paraconsistency}.
-\newblock
-Logical Approaches to Paraconsistency, Journal of Applied Non-Classical Logics, 15(1):45--58, 2005.
-
-\bibitem{Villadsen09}
-J.~Villadsen.
-\newblock
-\emph{Infinite-Valued Propositional Type Theory for Semantics}.
-\newblock
-In J.-Y.~B\'{e}ziau and A.~Costa-Leite, editors, Dimensions of Logical Concepts, pages 277--297,
-Unicamp Cole\c{c}.~CLE 54, 2009.
-
-\bibitem{Villadsen10}
-J.~Villadsen.
-\newblock
-\emph{Nabla: A Linguistic System Based on Type Theory}.
-\newblock
-Foundations of Communication and Cognition (New Series), LIT Verlag, 2010.
-
-\bibitem{Villadsen14}
-J.~Villadsen.
-\newblock
-\emph{Multi-dimensional Type Theory: Rules, Categories and Combinators for Syntax and Semantics}.
-\newblock
-In P.~Blache, H.~Christiansen, V.~Dahl, D.~Duchier, and J.~Villadsen, editors, Constraints and
-Language, pages 167--189, Cambridge Scholars Press, 2014.
-
-\end{thebibliography}
-
-\end{document}
+\documentclass[11pt,a4paper]{article}
+
+\title{Paraconsistency}
+
+\author{Anders Schlichtkrull \&\ J{\o}rgen Villadsen, DTU Compute, Denmark}
+
+\date{\isadate\today}
+
+\usepackage{datetime,isabelle,isabellesym,parskip,underscore}
+
+\newdateformat{isadate}{\THEDAY\ \monthname[\THEMONTH] \THEYEAR}
+
+\usepackage[cm]{fullpage}
+
+\usepackage{pdfsetup}
+
+\isabellestyle{tt}
+
+\urlstyle{rm}
+
+\renewcommand{\isachardoublequote}{}
+\renewcommand{\isachardoublequoteopen}{}
+\renewcommand{\isachardoublequoteclose}{}
+
+\renewcommand{\isamarkupchapter}[1]{\clearpage\isamarkupsection{#1}}
+\renewcommand{\isamarkupsection}[1]{\section*{#1}\addcontentsline{toc}{section}{#1}}
+\renewcommand{\isamarkupsubsection}[1]{\medskip\subsection*{#1}}
+\renewcommand{\isamarkupsubsubsection}[1]{\medskip\subsubsection*{#1}}
+
+\renewcommand{\isabeginpar}{\par\ifisamarkup\relax\else\bigskip\fi}
+\renewcommand{\isaendpar}{\par\bigskip}
+
+\begin{document}
+
+\makeatletter
+\parbox[t]{\textwidth}{\centering\Huge\bfseries\@title}\par\kern5mm
+\parbox[t]{\textwidth}{\centering\Large\bfseries\@author}\par\kern3mm
+\parbox[t]{\textwidth}{\centering\bfseries\@date}\par\kern8mm
+\makeatother
+
+\begin{abstract}\normalsize\noindent
+Paraconsistency is about handling inconsistency in a coherent way. In classical and intuitionistic
+logic everything follows from an inconsistent theory. A paraconsistent logic avoids the explosion.
+Quite a few applications in computer science and engineering are discussed in the Intelligent
+Systems Reference Library Volume 110: Towards Paraconsistent Engineering (Springer 2016). We
+formalize a paraconsistent many-valued logic that we motivated and described in a special issue on
+logical approaches to paraconsistency (Journal of Applied Non-Classical Logics 2005). We limit
+ourselves to the propositional fragment of the higher-order logic. The logic is based on so-called
+key equalities and has a countably infinite number of truth values. We prove theorems in the logic
+using the definition of validity. We verify truth tables and also counterexamples for non-theorems.
+We prove meta-theorems about the logic and finally we investigate a case study.
+\end{abstract}
+
+\tableofcontents
+
+\isamarkupsection{Preface}
+
+The present formalization in Isabelle essentially follows our extended abstract \cite{Jensen+12}.
+The Stanford Encyclopedia of Philosophy has a comprehensive overview of logical approaches to
+paraconsistency \cite{Priest+15}. We have elsewhere explained the rationale for our paraconsistent
+many-valued logic and considered applications in multi-agent systems and natural language semantics
+\cite{Villadsen05-JANCL,Villadsen09,Villadsen10,Villadsen14}.
+
+It is a revised and extended version of our formalization \url{https://github.com/logic-tools/mvl}
+that accompany our chapter in a book on partiality published by Cambridge Scholars Press. The GitHub
+link provides more information. We are grateful to the editors --- Henning Christiansen, M. Dolores
+Jim\'{e}nez L\'{o}pez, Roussanka Loukanova and Larry Moss --- for the opportunity to contribute to
+the book.
+
+\input{session}
+
+\clearpage\addcontentsline{toc}{section}{References}
+
+\begin{thebibliography}{0}
+
+\bibitem{Jensen+12}
+A.~S. Jensen and J.~Villadsen.
+\newblock
+\emph{Paraconsistent Computational Logic}.
+\newblock
+In P.~Blackburn, K.~F.~J{\o}rgensen, N.~Jones, and E.~Palmgren, editors, 8th Scandinavian Logic
+Symposium: Abstracts, pages 59--61, Roskilde University, 2012.
+
+\bibitem{Priest+15}
+G.~Priest, K.~Tanaka and Z.~Weber.
+\newblock
+\emph{Paraconsistent Logic}.
+\newblock
+In E.~N. Zalta et~al., editors, Stanford Encyclopedia of Philosophy, Online Entry
+\url{http://plato.stanford.edu/entries/logic-paraconsistent/} Spring Edition, 2015.
+
+\bibitem{Villadsen05-JANCL}
+J.~Villadsen.
+\newblock
+\emph{Supra-logic: Using Transfinite Type Theory with Type Variables for Paraconsistency}.
+\newblock
+Logical Approaches to Paraconsistency, Journal of Applied Non-Classical Logics, 15(1):45--58, 2005.
+
+\bibitem{Villadsen09}
+J.~Villadsen.
+\newblock
+\emph{Infinite-Valued Propositional Type Theory for Semantics}.
+\newblock
+In J.-Y.~B\'{e}ziau and A.~Costa-Leite, editors, Dimensions of Logical Concepts, pages 277--297,
+Unicamp Cole\c{c}.~CLE 54, 2009.
+
+\bibitem{Villadsen10}
+J.~Villadsen.
+\newblock
+\emph{Nabla: A Linguistic System Based on Type Theory}.
+\newblock
+Foundations of Communication and Cognition (New Series), LIT Verlag, 2010.
+
+\bibitem{Villadsen14}
+J.~Villadsen.
+\newblock
+\emph{Multi-dimensional Type Theory: Rules, Categories and Combinators for Syntax and Semantics}.
+\newblock
+In P.~Blache, H.~Christiansen, V.~Dahl, D.~Duchier, and J.~Villadsen, editors, Constraints and
+Language, pages 167--189, Cambridge Scholars Press, 2014.
+
+\end{thebibliography}
+
+\end{document}
diff --git a/thys/Recursion-Addition/recursion.thy b/thys/Recursion-Addition/recursion.thy
--- a/thys/Recursion-Addition/recursion.thy
+++ b/thys/Recursion-Addition/recursion.thy
@@ -1,1525 +1,1525 @@
-(*  Title:       Recursion theorem
-    Author:      Georgy Dunaev <georgedunaev at gmail.com>, 2020
-    Maintainer:  Georgy Dunaev <georgedunaev at gmail.com>
-*)
-section "Recursion Submission"
-
-text \<open>Recursion Theorem is proved in the following document.
-It also contains the addition on natural numbers.
-The development is done in the context of Zermelo-Fraenkel set theory.\<close>
-
-theory recursion
-  imports ZF
-begin
-
-section \<open>Basic Set Theory\<close>
-text \<open>Useful lemmas about sets, functions and natural numbers\<close>
-lemma pisubsig : \<open>Pi(A,P)\<subseteq>Pow(Sigma(A,P))\<close>
-proof
-  fix x
-  assume \<open>x \<in> Pi(A,P)\<close>
-  hence \<open>x \<in> {f\<in>Pow(Sigma(A,P)). A\<subseteq>domain(f) & function(f)}\<close>
-    by (unfold Pi_def)
-  thus \<open>x \<in> Pow(Sigma(A, P))\<close>
-    by (rule CollectD1)
-qed
-
-lemma apparg:
-  fixes f A B
-  assumes T0:\<open>f:A\<rightarrow>B\<close>
-  assumes T1:\<open>f ` a = b\<close>
-  assumes T2:\<open>a \<in> A\<close>
-  shows \<open>\<langle>a, b\<rangle> \<in> f\<close>
-proof(rule iffD2[OF func.apply_iff], rule T0)
-  show T:\<open>a \<in> A \<and> f ` a = b\<close>
-    by (rule conjI[OF T2 T1])
-qed
-
-theorem nat_induct_bound :
-  assumes H0:\<open>P(0)\<close>
-  assumes H1:\<open>!!x. x\<in>nat \<Longrightarrow> P(x) \<Longrightarrow> P(succ(x))\<close>
-  shows \<open>\<forall>n\<in>nat. P(n)\<close>
-proof(rule ballI)
-  fix n
-  assume H2:\<open>n\<in>nat\<close>
-  show \<open>P(n)\<close>
-  proof(rule nat_induct[of n])
-    from H2 show \<open>n\<in>nat\<close> by assumption
-  next
-    show \<open>P(0)\<close> by (rule H0)
-  next
-    fix x
-    assume H3:\<open>x\<in>nat\<close>
-    assume H4:\<open>P(x)\<close>
-    show \<open>P(succ(x))\<close> by (rule H1[OF H3 H4])
-  qed
-qed
-
-theorem nat_Tr : \<open>\<forall>n\<in>nat. m\<in>n \<longrightarrow> m\<in>nat\<close>
-proof(rule nat_induct_bound)
-  show \<open>m \<in> 0 \<longrightarrow> m \<in> nat\<close> by auto
-next
-  fix x
-  assume H0:\<open>x \<in> nat\<close>
-  assume H1:\<open>m \<in> x \<longrightarrow> m \<in> nat\<close>
-  show \<open>m \<in> succ(x) \<longrightarrow> m \<in> nat\<close>
-  proof(rule impI)
-    assume H2:\<open>m\<in>succ(x)\<close>
-    show \<open>m \<in> nat\<close>
-    proof(rule succE[OF H2])
-      assume H3:\<open>m = x\<close>
-      from H0 and H3 show \<open>m \<in> nat\<close>
-        by auto
-    next
-      assume H4:\<open>m \<in> x\<close>
-      show \<open>m \<in> nat\<close>
-        by(rule mp[OF H1 H4])
-    qed
-  qed
-qed
-
-(* Natural numbers are linearly ordered. *)
-theorem zeroleq : \<open>\<forall>n\<in>nat. 0\<in>n \<or> 0=n\<close>
-proof(rule ballI)
-  fix n
-  assume H1:\<open>n\<in>nat\<close>
-  show \<open>0\<in>n\<or>0=n\<close>
-  proof(rule nat_induct[of n])
-    from H1 show \<open>n \<in> nat\<close> by assumption
-  next
-    show \<open>0 \<in> 0 \<or> 0 = 0\<close> by (rule disjI2, rule refl)
-  next
-    fix x
-    assume H2:\<open>x\<in>nat\<close>
-    assume H3:\<open> 0 \<in> x \<or> 0 = x\<close>
-    show \<open>0 \<in> succ(x) \<or> 0 = succ(x)\<close>
-    proof(rule disjE[OF H3])
-      assume H4:\<open>0\<in>x\<close>
-      show \<open>0 \<in> succ(x) \<or> 0 = succ(x)\<close>
-      proof(rule disjI1)
-        show \<open>0 \<in> succ(x)\<close>
-          by (rule succI2[OF H4])
-      qed
-    next
-      assume H4:\<open>0=x\<close>
-      show \<open>0 \<in> succ(x) \<or> 0 = succ(x)\<close>
-      proof(rule disjI1)
-        have q:\<open>x \<in> succ(x)\<close> by auto
-        from q and H4 show \<open>0 \<in> succ(x)\<close> by auto
-      qed
-    qed
-  qed
-qed
-
-theorem JH2_1ii : \<open>m\<in>succ(n) \<Longrightarrow> m\<in>n\<or>m=n\<close>
-  by auto
-
-theorem nat_transitive:\<open>\<forall>n\<in>nat. \<forall>k. \<forall>m.  k \<in> m \<and> m \<in> n \<longrightarrow> k \<in> n\<close>
-proof(rule nat_induct_bound)
-  show \<open>\<forall>k. \<forall>m. k \<in> m \<and> m \<in> 0 \<longrightarrow> k \<in> 0\<close>
-  proof(rule allI, rule allI, rule impI)
-    fix k m
-    assume H:\<open>k \<in> m \<and> m \<in> 0\<close>
-    then have H:\<open>m \<in> 0\<close> by auto
-    then show \<open>k \<in> 0\<close> by auto
-  qed
-next
-  fix n
-  assume H0:\<open>n \<in> nat\<close>
-  assume H1:\<open>\<forall>k.
-            \<forall>m.
-               k \<in> m \<and> m \<in> n \<longrightarrow>
-               k \<in> n\<close>
-  show \<open>\<forall>k. \<forall>m.
-               k \<in> m \<and>
-               m \<in> succ(n) \<longrightarrow>
-               k \<in> succ(n)\<close>
-  proof(rule allI, rule allI, rule impI)
-    fix k m
-    assume H4:\<open>k \<in> m \<and> m \<in> succ(n)\<close>
-    hence H4':\<open>m \<in> succ(n)\<close> by (rule conjunct2)
-    hence H4'':\<open>m\<in>n \<or> m=n\<close> by (rule succE, auto)
-    from H4 have Q:\<open>k \<in> m\<close> by (rule conjunct1)
-    have H1S:\<open>\<forall>m. k \<in> m \<and> m \<in> n \<longrightarrow> k \<in> n\<close>
-      by (rule spec[OF H1])
-    have H1S:\<open>k \<in> m \<and> m \<in> n \<longrightarrow> k \<in> n\<close>
-      by (rule spec[OF H1S])
-    show \<open>k \<in> succ(n)\<close>
-    proof(rule disjE[OF H4''])
-      assume L:\<open>m\<in>n\<close>
-      from Q and L have QL:\<open>k \<in> m \<and> m \<in> n\<close> by auto
-      have G:\<open>k \<in> n\<close> by (rule mp [OF H1S QL])
-      show \<open>k \<in> succ(n)\<close>
-        by (rule succI2[OF G])
-    next
-      assume L:\<open>m=n\<close>
-      from Q have F:\<open>k \<in> succ(m)\<close> by auto
-      from L and Q show \<open>k \<in> succ(n)\<close> by auto
-    qed
-  qed
-qed
-
-theorem nat_xninx : \<open>\<forall>n\<in>nat. \<not>(n\<in>n)\<close>
-proof(rule nat_induct_bound)
-  show \<open>0\<notin>0\<close>
-    by auto
-next
-  fix x
-  assume H0:\<open>x\<in>nat\<close>
-  assume H1:\<open>x\<notin>x\<close>
-  show \<open>succ(x) \<notin> succ(x)\<close>
-  proof(rule contrapos[OF H1])
-    assume Q:\<open>succ(x) \<in> succ(x)\<close>
-    have D:\<open>succ(x)\<in>x \<or> succ(x)=x\<close>
-      by (rule JH2_1ii[OF Q])
-    show \<open>x\<in>x\<close>
-    proof(rule disjE[OF D])
-      assume Y1:\<open>succ(x)\<in>x\<close>
-      have U:\<open>x\<in>succ(x)\<close> by (rule succI1)
-      have T:\<open>x \<in> succ(x) \<and> succ(x) \<in> x \<longrightarrow> x \<in> x\<close>
-        by (rule spec[OF spec[OF bspec[OF nat_transitive H0]]])
-      have R:\<open>x \<in> succ(x) \<and> succ(x) \<in> x\<close>
-        by (rule conjI[OF U Y1])
-      show \<open>x\<in>x\<close>
-        by (rule mp[OF T R])
-    next
-      assume Y1:\<open>succ(x)=x\<close>
-      show \<open>x\<in>x\<close>
-        by (rule subst[OF Y1], rule Q)
-    qed
-  qed
-qed
-
-theorem nat_asym : \<open>\<forall>n\<in>nat. \<forall>m. \<not>(n\<in>m \<and> m\<in>n)\<close>
-proof(rule ballI, rule allI)
-  fix n m
-  assume H0:\<open>n \<in> nat\<close>
-  have Q:\<open>\<not>(n\<in>n)\<close>
-    by(rule bspec[OF nat_xninx H0])
-  show \<open>\<not> (n \<in> m \<and> m \<in> n)\<close>
-  proof(rule contrapos[OF Q])
-    assume W:\<open>(n \<in> m \<and> m \<in> n)\<close>
-    show \<open>n\<in>n\<close>
-      by (rule mp[OF spec[OF spec[OF bspec[OF nat_transitive H0]]] W])
-  qed
-qed
-
-theorem zerolesucc :\<open>\<forall>n\<in>nat. 0 \<in> succ(n)\<close>
-proof(rule nat_induct_bound)
-  show \<open>0\<in>1\<close>
-    by auto
-next
-  fix x
-  assume H0:\<open>x\<in>nat\<close>
-  assume H1:\<open>0\<in>succ(x)\<close>
-  show \<open>0\<in>succ(succ(x))\<close>
-  proof
-    assume J:\<open>0 \<notin> succ(x)\<close>
-    show \<open>0 = succ(x)\<close>
-      by(rule notE[OF J H1])
-  qed
-qed
-
-theorem succ_le : \<open>\<forall>n\<in>nat. succ(m)\<in>succ(n) \<longrightarrow> m\<in>n\<close>
-proof(rule nat_induct_bound)
-  show \<open> succ(m) \<in> 1 \<longrightarrow> m \<in> 0\<close>
-    by blast
-next
-  fix x
-  assume H0:\<open>x \<in> nat\<close>
-  assume H1:\<open>succ(m) \<in> succ(x) \<longrightarrow> m \<in> x\<close>
-  show \<open> succ(m) \<in>
-             succ(succ(x)) \<longrightarrow>
-             m \<in> succ(x)\<close>
-  proof(rule impI)
-    assume J0:\<open>succ(m) \<in> succ(succ(x))\<close>
-    show \<open>m \<in> succ(x)\<close>
-    proof(rule succE[OF J0])
-      assume R:\<open>succ(m) = succ(x)\<close>
-      hence R:\<open>m=x\<close> by (rule upair.succ_inject)
-      from R and succI1 show \<open>m \<in> succ(x)\<close> by auto
-    next
-      assume R:\<open>succ(m) \<in> succ(x)\<close>
-      have R:\<open>m\<in>x\<close> by (rule mp[OF H1 R])
-      then show \<open>m \<in> succ(x)\<close> by auto
-    qed
-  qed
-qed
-
-theorem succ_le2 : \<open>\<forall>n\<in>nat. \<forall>m. succ(m)\<in>succ(n) \<longrightarrow> m\<in>n\<close>
-proof
-  fix n
-  assume H:\<open>n\<in>nat\<close>
-  show \<open>\<forall>m. succ(m) \<in> succ(n) \<longrightarrow> m \<in> n\<close>
-  proof
-    fix m
-    from succ_le and H show \<open>succ(m) \<in> succ(n) \<longrightarrow> m \<in> n\<close> by auto
-  qed
-qed
-
-theorem le_succ : \<open>\<forall>n\<in>nat. m\<in>n \<longrightarrow> succ(m)\<in>succ(n)\<close>
-proof(rule nat_induct_bound)
-  show \<open>m \<in> 0 \<longrightarrow> succ(m) \<in> 1\<close>
-    by auto
-next
-  fix x
-  assume H0:\<open>x\<in>nat\<close>
-  assume H1:\<open>m \<in> x \<longrightarrow> succ(m) \<in> succ(x)\<close>
-  show \<open>m \<in> succ(x) \<longrightarrow>
-            succ(m) \<in> succ(succ(x))\<close>
-  proof(rule impI)
-    assume HR1:\<open>m\<in>succ(x)\<close>
-    show \<open>succ(m) \<in> succ(succ(x))\<close>
-    proof(rule succE[OF HR1])
-      assume Q:\<open>m = x\<close>
-      from Q show \<open>succ(m) \<in> succ(succ(x))\<close>
-        by auto
-    next
-      assume Q:\<open>m \<in> x\<close>
-      have Q:\<open>succ(m) \<in> succ(x)\<close>
-        by (rule mp[OF H1 Q])
-      from Q show \<open>succ(m) \<in> succ(succ(x))\<close>
-        by (rule succI2)
-    qed
-  qed
-qed
-
-theorem nat_linord:\<open>\<forall>n\<in>nat. \<forall>m\<in>nat. m\<in>n\<or>m=n\<or>n\<in>m\<close>
-proof(rule ballI)
-  fix n
-  assume H1:\<open>n\<in>nat\<close>
-  show \<open>\<forall>m\<in>nat. m \<in> n \<or> m = n \<or> n \<in> m\<close>
-  proof(rule nat_induct[of n])
-    from H1 show \<open>n\<in>nat\<close> by assumption
-  next
-    show \<open>\<forall>m\<in>nat. m \<in> 0 \<or> m = 0 \<or> 0 \<in> m\<close>
-    proof
-      fix m
-      assume J:\<open>m\<in>nat\<close>
-      show \<open> m \<in> 0 \<or> m = 0 \<or> 0 \<in> m\<close>
-      proof(rule disjI2)
-        have Q:\<open>0\<in>m\<or>0=m\<close> by (rule bspec[OF zeroleq J])
-        show \<open>m = 0 \<or> 0 \<in> m\<close>
-          by (rule disjE[OF Q], auto)
-      qed
-    qed
-  next
-    fix x
-    assume K:\<open>x\<in>nat\<close>
-    assume M:\<open>\<forall>m\<in>nat. m \<in> x \<or> m = x \<or> x \<in> m\<close>
-    show \<open>\<forall>m\<in>nat.
-            m \<in> succ(x) \<or>
-            m = succ(x) \<or>
-            succ(x) \<in> m\<close>
-    proof(rule nat_induct_bound)
-      show \<open>0 \<in> succ(x) \<or>  0 = succ(x) \<or> succ(x) \<in> 0\<close>
-      proof(rule disjI1)
-        show \<open>0 \<in> succ(x)\<close>
-          by (rule bspec[OF zerolesucc K])
-      qed
-    next
-      fix y
-      assume H0:\<open>y \<in> nat\<close>
-      assume H1:\<open>y \<in> succ(x) \<or> y = succ(x) \<or> succ(x) \<in> y\<close>
-      show \<open>succ(y) \<in> succ(x) \<or>
-            succ(y) = succ(x) \<or>
-            succ(x) \<in> succ(y)\<close>
-      proof(rule disjE[OF H1])
-        assume W:\<open>y\<in>succ(x)\<close>
-        show \<open>succ(y) \<in> succ(x) \<or>
-              succ(y) = succ(x) \<or>
-              succ(x) \<in> succ(y)\<close>
-        proof(rule succE[OF W])
-          assume G:\<open>y=x\<close>
-          show \<open>succ(y) \<in> succ(x) \<or>
-    succ(y) = succ(x) \<or>
-    succ(x) \<in> succ(y)\<close>
-            by (rule disjI2, rule disjI1, rule subst[OF G], rule refl)
-        next
-          assume G:\<open>y \<in> x\<close>
-          have R:\<open>succ(y) \<in> succ(x)\<close>
-            by (rule mp[OF bspec[OF le_succ K] G])
-          show \<open>succ(y) \<in> succ(x) \<or>
-           succ(y) = succ(x) \<or>
-           succ(x) \<in> succ(y)\<close>
-            by(rule disjI1, rule R)
-        qed
-      next
-        assume W:\<open>y = succ(x) \<or> succ(x) \<in> y\<close>
-        show \<open>succ(y) \<in> succ(x) \<or>
-              succ(y) = succ(x) \<or>
-              succ(x) \<in> succ(y)\<close>
-        proof(rule disjE[OF W])
-          assume W:\<open>y=succ(x)\<close>
-          show \<open>succ(y) \<in> succ(x) \<or>
-              succ(y) = succ(x) \<or>
-              succ(x) \<in> succ(y)\<close>
-            by (rule disjI2, rule disjI2, rule subst[OF W], rule succI1)
-        next
-          assume W:\<open>succ(x)\<in>y\<close>
-          show \<open>succ(y) \<in> succ(x) \<or>
-              succ(y) = succ(x) \<or>
-              succ(x) \<in> succ(y)\<close>
-            by (rule disjI2, rule disjI2, rule succI2[OF W])
-        qed
-      qed
-    qed
-  qed
-qed
-
-lemma tgb:
-  assumes knat: \<open>k\<in>nat\<close>
-  assumes D: \<open>t \<in> k \<rightarrow> A\<close>
-  shows  \<open>t \<in> Pow(nat \<times> A)\<close>
-proof -
-  from D
-  have q:\<open>t\<in>{t\<in>Pow(Sigma(k,%_.A)). k\<subseteq>domain(t) & function(t)}\<close>
-    by(unfold Pi_def)
-  have J:\<open>t \<in> Pow(k \<times> A)\<close>
-    by (rule CollectD1[OF q])
-  have G:\<open>k \<times> A \<subseteq> nat \<times> A\<close>
-  proof(rule func.Sigma_mono)
-    from knat
-    show \<open>k\<subseteq>nat\<close>
-      by (rule QUniv.naturals_subset_nat)
-  next
-    show \<open>\<And>x. x \<in> k \<Longrightarrow> A \<subseteq> A\<close>
-      by auto
-  qed
-  show \<open>t \<in> Pow(nat \<times> A)\<close>
-    by (rule subsetD, rule func.Pow_mono[OF G], rule J)
-qed
-
-section \<open>Compatible set\<close>
-text \<open>Union of compatible set of functions is a function.\<close>
-
-definition compat :: \<open>[i,i]\<Rightarrow>o\<close>
-  where "compat(f1,f2) == \<forall>x.\<forall>y1.\<forall>y2.\<langle>x,y1\<rangle> \<in> f1 \<and> \<langle>x,y2\<rangle> \<in> f2 \<longrightarrow> y1=y2"
-
-lemma compatI [intro]:
-  assumes H:\<open>\<And>x y1 y2.\<lbrakk>\<langle>x,y1\<rangle> \<in> f1; \<langle>x,y2\<rangle> \<in> f2\<rbrakk>\<Longrightarrow>y1=y2\<close>
-  shows \<open>compat(f1,f2)\<close>
-proof(unfold compat_def)
-  show \<open>\<forall>x y1 y2. \<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2 \<longrightarrow> y1 = y2\<close>
-  proof(rule allI | rule impI)+
-    fix x y1 y2
-    assume K:\<open>\<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2\<close>
-    have K1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close> by (rule conjunct1[OF K])
-    have K2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close> by (rule conjunct2[OF K])
-    show \<open>y1 = y2\<close> by (rule H[OF K1 K2])
-  qed
-qed
-
-lemma compatD:
-  assumes H: \<open>compat(f1,f2)\<close>
-  shows \<open>\<And>x y1 y2.\<lbrakk>\<langle>x,y1\<rangle> \<in> f1; \<langle>x,y2\<rangle> \<in> f2\<rbrakk>\<Longrightarrow>y1=y2\<close>
-proof -
-  fix x y1 y2
-  assume Q1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
-  assume Q2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close>
-  from H have H:\<open>\<forall>x y1 y2. \<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2 \<longrightarrow> y1 = y2\<close>
-    by (unfold compat_def)
-  show \<open>y1=y2\<close>
-  proof(rule mp[OF spec[OF spec[OF spec[OF H]]]])
-    show \<open>\<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2\<close>
-      by(rule conjI[OF Q1 Q2])
-  qed
-qed
-
-lemma compatE:
-  assumes H: \<open>compat(f1,f2)\<close>
-  and W:\<open>(\<And>x y1 y2.\<lbrakk>\<langle>x,y1\<rangle> \<in> f1; \<langle>x,y2\<rangle> \<in> f2\<rbrakk>\<Longrightarrow>y1=y2) \<Longrightarrow> E\<close>
-shows \<open>E\<close>
-  by (rule W, rule compatD[OF H], assumption+)
-
-
-definition compatset :: \<open>i\<Rightarrow>o\<close>
-  where "compatset(S) == \<forall>f1\<in>S.\<forall>f2\<in>S. compat(f1,f2)"
-
-lemma compatsetI [intro] :
-  assumes 1:\<open>\<And>f1 f2. \<lbrakk>f1\<in>S;f2\<in>S\<rbrakk> \<Longrightarrow> compat(f1,f2)\<close>
-  shows \<open>compatset(S)\<close>
-  by (unfold compatset_def, rule ballI, rule ballI, rule 1, assumption+)
-
-lemma compatsetD:
-  assumes H: \<open>compatset(S)\<close>
-  shows \<open>\<And>f1 f2.\<lbrakk>f1\<in>S; f2\<in>S\<rbrakk>\<Longrightarrow>compat(f1,f2)\<close>
-proof -
-  fix f1 f2
-  assume H1:\<open>f1\<in>S\<close>
-  assume H2:\<open>f2\<in>S\<close>
-  from H have H:\<open>\<forall>f1\<in>S.\<forall>f2\<in>S. compat(f1,f2)\<close>
-    by (unfold compatset_def)
-  show \<open>compat(f1,f2)\<close>
-    by (rule bspec[OF bspec[OF H H1] H2])
-qed
-
-lemma compatsetE:
-  assumes H: \<open>compatset(S)\<close>
-  and W:\<open>(\<And>f1 f2.\<lbrakk>f1\<in>S; f2\<in>S\<rbrakk>\<Longrightarrow>compat(f1,f2)) \<Longrightarrow> E\<close>
-shows \<open>E\<close>
-  by (rule W, rule compatsetD[OF H], assumption+)
-
-theorem upairI1 : \<open>a \<in> {a, b}\<close>
-proof
-  assume \<open>a \<notin> {b}\<close>
-  show \<open>a = a\<close> by (rule refl)
-qed
-
-theorem upairI2 : \<open>b \<in> {a, b}\<close>
-proof
-  assume H:\<open>b \<notin> {b}\<close>
-  have Y:\<open>b \<in> {b}\<close> by (rule upair.singletonI)
-  show \<open>b = a\<close> by (rule notE[OF H Y])
-qed
-
-theorem sinup : \<open>{x} \<in> \<langle>x, xa\<rangle>\<close>
-proof (unfold Pair_def)
-  show \<open>{x} \<in> {{x, x}, {x, xa}}\<close>
-  proof (rule IFOL.subst)
-    show \<open>{x} \<in> {{x},{x,xa}}\<close>
-      by (rule upairI1)
-  next
-    show \<open>{{x}, {x, xa}} = {{x, x}, {x, xa}}\<close>
-      by blast
-  qed
-qed
-
-theorem compatsetunionfun :
-  fixes S
-  assumes H0:\<open>compatset(S)\<close>
-  shows \<open>function(\<Union>S)\<close>
-proof(unfold function_def)
-  show \<open> \<forall>x y1. \<langle>x, y1\<rangle> \<in> \<Union>S \<longrightarrow>
-          (\<forall>y2. \<langle>x, y2\<rangle> \<in> \<Union>S \<longrightarrow> y1 = y2)\<close>
-  proof(rule allI, rule allI, rule impI, rule allI, rule impI)
-    fix x y1 y2
-    assume F1:\<open>\<langle>x, y1\<rangle> \<in> \<Union>S\<close>
-    assume F2:\<open>\<langle>x, y2\<rangle> \<in> \<Union>S\<close>
-    show \<open>y1=y2\<close>
-    proof(rule UnionE[OF F1], rule UnionE[OF F2])
-      fix f1 f2
-      assume J1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
-      assume J2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close>
-      assume K1:\<open>f1 \<in> S\<close>
-      assume K2:\<open>f2 \<in> S\<close>
-      have R:\<open>compat(f1,f2)\<close>
-        by (rule compatsetD[OF H0 K1 K2])
-      show \<open>y1=y2\<close>
-        by(rule compatD[OF R J1 J2])
-    qed
-  qed
-qed
-
-theorem mkel :
-  assumes 1:\<open>A\<close>
-  assumes 2:\<open>A\<Longrightarrow>B\<close>
-  shows \<open>B\<close>
-  by (rule 2, rule 1)
-
-theorem valofunion :
-  fixes S
-  assumes H0:\<open>compatset(S)\<close>
-  assumes W:\<open>f\<in>S\<close>
-  assumes Q:\<open>f:A\<rightarrow>B\<close>
-  assumes T:\<open>a\<in>A\<close>
-  assumes P:\<open>f ` a = v\<close>
-  shows N:\<open>(\<Union>S)`a = v\<close>
-proof -
-  have K:\<open>\<langle>a, v\<rangle> \<in> f\<close>
-    by (rule apparg[OF Q P T])
-  show N:\<open>(\<Union>S)`a = v\<close>
-  proof(rule function_apply_equality)
-    show \<open>function(\<Union>S)\<close>
-      by(rule compatsetunionfun[OF H0])
-  next
-    show \<open>\<langle>a, v\<rangle> \<in> \<Union>S\<close>
-      by(rule UnionI[OF W K ])
-  qed
-qed
-
-section "Partial computation"
-
-definition satpc :: \<open>[i,i,i] \<Rightarrow> o \<close>
-  where \<open>satpc(t,\<alpha>,g) == \<forall>n \<in> \<alpha> . t`succ(n) = g ` <t`n, n>\<close>
-
-text \<open>$m$-step computation based on $a$ and $g$\<close>
-definition partcomp :: \<open>[i,i,i,i,i]\<Rightarrow>o\<close>
-  where \<open>partcomp(A,t,m,a,g) == (t:succ(m)\<rightarrow>A) \<and> (t`0=a) \<and> satpc(t,m,g)\<close>
-
-lemma partcompI [intro]:
-  assumes H1:\<open>(t:succ(m)\<rightarrow>A)\<close>
-  assumes H2:\<open>(t`0=a)\<close>
-  assumes H3:\<open>satpc(t,m,g)\<close>
-  shows \<open>partcomp(A,t,m,a,g)\<close>
-proof (unfold partcomp_def, auto)
-  show \<open>t \<in> succ(m) \<rightarrow> A\<close> by (rule H1)
-  show \<open>(t`0=a)\<close> by (rule H2)
-  show \<open>satpc(t,m,g)\<close> by (rule H3)
-qed
-
-lemma partcompD1: \<open>partcomp(A,t,m,a,g) \<Longrightarrow> t \<in> succ(m) \<rightarrow> A\<close>
-  by (unfold partcomp_def, auto)
-
-lemma partcompD2: \<open>partcomp(A,t,m,a,g) \<Longrightarrow> (t`0=a)\<close>
- by (unfold partcomp_def, auto)
-
-lemma partcompD3: \<open>partcomp(A,t,m,a,g) \<Longrightarrow> satpc(t,m,g)\<close>
-  by (unfold partcomp_def, auto)
-
-lemma partcompE [elim] :
-  assumes 1:\<open>partcomp(A,t,m,a,g)\<close>
-    and 2:\<open>\<lbrakk>(t:succ(m)\<rightarrow>A) ; (t`0=a) ; satpc(t,m,g)\<rbrakk> \<Longrightarrow> E\<close>
-  shows \<open>E\<close>
-  by (rule 2, rule partcompD1[OF 1], rule partcompD2[OF 1], rule partcompD3[OF 1])
-
-text \<open>If we add ordered pair in the middle of partial computation then
-it will not change.\<close>
-lemma addmiddle:
-(*  fixes  t m a g*)
-  assumes mnat:\<open>m\<in>nat\<close>
-  assumes F:\<open>partcomp(A,t,m,a,g)\<close>
-  assumes xinm:\<open>x\<in>m\<close>
-  shows \<open>cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t) = t\<close>
-proof(rule partcompE[OF F])
-  assume F1:\<open>t \<in> succ(m) \<rightarrow> A\<close>
-  assume F2:\<open>t ` 0 = a\<close>
-  assume F3:\<open>satpc(t, m, g)\<close>
-  from F3
-  have W:\<open>\<forall>n\<in>m. t ` succ(n) = g ` \<langle>t ` n, n\<rangle>\<close>
-    by (unfold satpc_def)
-  have U:\<open>t ` succ(x) = g ` \<langle>t ` x, x\<rangle>\<close>
-    by (rule bspec[OF W xinm])
-  have E:\<open>\<langle>succ(x), (g ` \<langle>t ` x, x\<rangle>)\<rangle> \<in> t\<close>
-  proof(rule apparg[OF F1 U])
-    show \<open>succ(x) \<in> succ(m)\<close>
-      by(rule mp[OF bspec[OF le_succ mnat] xinm])
-  qed
-  show ?thesis
-    by (rule equalities.cons_absorb[OF E])
-qed
-
-
-section \<open>Set of functions \<close>
-text \<open>It is denoted as $F$ on page 48 in "Introduction to Set Theory".\<close>
-definition pcs :: \<open>[i,i,i]\<Rightarrow>i\<close>
-  where \<open>pcs(A,a,g) == {t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close>
-
-lemma pcs_uniq :
-  assumes F1:\<open>m1\<in>nat\<close>
-  assumes F2:\<open>m2\<in>nat\<close>
-  assumes H1: \<open>partcomp(A,f1,m1,a,g)\<close>
-  assumes H2: \<open>partcomp(A,f2,m2,a,g)\<close>
-  shows \<open>\<forall>n\<in>nat. n\<in>succ(m1) \<and> n\<in>succ(m2) \<longrightarrow> f1`n = f2`n\<close>
-proof(rule partcompE[OF H1], rule partcompE[OF H2])
-  assume H11:\<open>f1 \<in> succ(m1) \<rightarrow> A\<close>
-  assume H12:\<open>f1 ` 0 = a \<close>
-  assume H13:\<open>satpc(f1, m1, g)\<close>
-  assume H21:\<open>f2 \<in> succ(m2) \<rightarrow> A\<close>
-  assume H22:\<open>f2 ` 0 = a\<close>
-  assume H23:\<open>satpc(f2, m2, g)\<close>
-  show \<open>\<forall>n\<in>nat. n\<in>succ(m1) \<and> n\<in>succ(m2) \<longrightarrow> f1`n = f2`n\<close>
-proof(rule nat_induct_bound)
-  from H12 and H22
-  show \<open>0\<in>succ(m1) \<and> 0\<in>succ(m2) \<longrightarrow> f1 ` 0 = f2 ` 0\<close>
-    by auto
-next
-  fix x
-  assume J0:\<open>x\<in>nat\<close>
-  assume J1:\<open>x \<in> succ(m1) \<and> x \<in> succ(m2) \<longrightarrow> f1 ` x = f2 ` x\<close>
-  from H13 have G1:\<open>\<forall>n \<in> m1 . f1`succ(n) = g ` <f1`n, n>\<close>
-    by (unfold satpc_def, auto)
-  from H23 have G2:\<open>\<forall>n \<in> m2 . f2`succ(n) = g ` <f2`n, n>\<close>
-    by (unfold satpc_def, auto)
-  show \<open>succ(x) \<in> succ(m1) \<and> succ(x) \<in> succ(m2) \<longrightarrow>
-        f1 ` succ(x) = f2 ` succ(x)\<close>
-  proof
-    assume K:\<open>succ(x) \<in> succ(m1) \<and> succ(x) \<in> succ(m2)\<close>
-    from K have K1:\<open>succ(x) \<in> succ(m1)\<close> by auto
-    from K have K2:\<open>succ(x) \<in> succ(m2)\<close> by auto
-    have K1':\<open>x \<in> m1\<close> by (rule mp[OF bspec[OF succ_le F1] K1])
-    have K2':\<open>x \<in> m2\<close> by (rule mp[OF bspec[OF succ_le F2] K2])
-    have U1:\<open>x\<in>succ(m1)\<close>
-      by (rule Nat.succ_in_naturalD[OF K1 Nat.nat_succI[OF F1]])
-    have U2:\<open>x\<in>succ(m2)\<close>
-      by (rule Nat.succ_in_naturalD[OF K2 Nat.nat_succI[OF F2]])
-    have Y1:\<open>f1`succ(x) = g ` <f1`x, x>\<close>
-      by (rule bspec[OF G1 K1'])
-    have Y2:\<open>f2`succ(x) = g ` <f2`x, x>\<close>
-      by (rule bspec[OF G2 K2'])
-    have \<open>f1 ` x = f2 ` x\<close>
-      by(rule mp[OF J1 conjI[OF U1 U2]])
-    then have Y:\<open>g ` <f1`x, x> = g ` <f2`x, x>\<close> by auto
-    from Y1 and Y2 and Y
-    show \<open>f1 ` succ(x) = f2 ` succ(x)\<close>
-      by auto
-  qed
-qed
-qed
-
-lemma domainsubsetfunc :
-  assumes Q:\<open>f1\<subseteq>f2\<close>
-  shows \<open>domain(f1)\<subseteq>domain(f2)\<close>
-proof
-  fix x
-  assume H:\<open>x \<in> domain(f1)\<close>
-  show \<open>x \<in> domain(f2)\<close>
-  proof(rule domainE[OF H])
-    fix y
-    assume W:\<open>\<langle>x, y\<rangle> \<in> f1\<close>
-    have \<open>\<langle>x, y\<rangle> \<in> f2\<close>
-      by(rule subsetD[OF Q W])
-    then show \<open>x \<in> domain(f2)\<close>
-      by(rule domainI)
-  qed
-qed
-
-lemma natdomfunc:
-  assumes 1:\<open>q\<in>A\<close>
-  assumes J0:\<open>f1 \<in> Pow(nat \<times> A)\<close>
-  assumes U:\<open>m1 \<in> domain(f1)\<close>
-  shows \<open>m1\<in>nat\<close>
-proof -
-  from J0 have J0 : \<open>f1 \<subseteq> nat \<times> A\<close>
-    by auto
-  have J0:\<open>domain(f1) \<subseteq> domain(nat \<times> A)\<close>
-    by(rule func.domain_mono[OF J0])
-  have F:\<open>m1 \<in> domain(nat \<times> A)\<close>
-    by(rule subsetD[OF J0 U])
-  have R:\<open>domain(nat \<times> A) = nat\<close>
-    by (rule equalities.domain_of_prod[OF 1])
-  show \<open>m1 \<in> nat\<close>
-    by(rule subst[OF R], rule F)
-qed
-
-lemma pcs_lem :
-  assumes 1:\<open>q\<in>A\<close>
-  shows \<open>compatset(pcs(A, a, g))\<close>
-proof (*(rule compatsetI)*)
-  fix f1 f2
-  assume H1:\<open>f1 \<in> pcs(A, a, g)\<close>
-  then have H1':\<open>f1 \<in> {t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close> by (unfold pcs_def)
-  hence H1'A:\<open>f1 \<in> Pow(nat*A)\<close> by auto
-  hence H1'A:\<open>f1 \<subseteq> (nat*A)\<close> by auto
-  assume H2:\<open>f2 \<in> pcs(A, a, g)\<close>
-  then have H2':\<open>f2 \<in> {t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close> by (unfold pcs_def)
-  show \<open>compat(f1, f2)\<close>
-  proof(rule compatI)
-    fix x y1 y2
-    assume P1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
-    assume P2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close>
-    show \<open>y1 = y2\<close>
-    proof(rule CollectE[OF H1'], rule CollectE[OF H2'])
-      assume J0:\<open>f1 \<in> Pow(nat \<times> A)\<close>
-      assume J1:\<open>f2 \<in> Pow(nat \<times> A)\<close>
-      assume J2:\<open>\<exists>m\<in>nat. partcomp(A, f1, m, a, g)\<close>
-      assume J3:\<open>\<exists>m\<in>nat. partcomp(A, f2, m, a, g)\<close>
-      show \<open>y1 = y2\<close>
-      proof(rule bexE[OF J2], rule bexE[OF J3])
-        fix m1 m2
-        assume K1:\<open>partcomp(A, f1, m1, a, g)\<close>
-        assume K2:\<open>partcomp(A, f2, m2, a, g)\<close>
-        hence K2':\<open>(f2:succ(m2)\<rightarrow>A) \<and> (f2`0=a) \<and> satpc(f2,m2,g)\<close>
-          by (unfold partcomp_def)
-        from K1 have K1'A:\<open>(f1:succ(m1)\<rightarrow>A)\<close> by (rule partcompD1)
-        from K2' have K2'A:\<open>(f2:succ(m2)\<rightarrow>A)\<close> by auto
-        from K1'A have K1'AD:\<open>domain(f1) = succ(m1)\<close>
-          by(rule domain_of_fun)
-        from K2'A have K2'AD:\<open>domain(f2) = succ(m2)\<close>
-          by(rule domain_of_fun)
-        have L1:\<open>f1`x=y1\<close>
-          by (rule func.apply_equality[OF P1], rule K1'A)
-        have L2:\<open>f2`x=y2\<close>
-          by(rule func.apply_equality[OF P2], rule K2'A)
-        have m1nat:\<open>m1\<in>nat\<close>
-        proof(rule natdomfunc[OF 1 J0])
-          show \<open>m1 \<in> domain(f1)\<close>
-            by (rule ssubst[OF K1'AD], auto)
-        qed
-        have m2nat:\<open>m2\<in>nat\<close>
-        proof(rule natdomfunc[OF 1 J1])
-          show \<open>m2 \<in> domain(f2)\<close>
-            by (rule ssubst[OF K2'AD], auto)
-        qed
-        have G1:\<open>\<langle>x, y1\<rangle> \<in> (nat*A)\<close>
-          by(rule subsetD[OF H1'A P1])
-        have KK:\<open>x\<in>nat\<close>
-          by(rule SigmaE[OF G1], auto)
-        (*x is in the domain of f1  i.e. succ(m1)
-so we can have both  x \<in> ?m1.2 \<and> x \<in> ?m2.2
-how to prove that m1 \<in> nat ? from J0 !  f1 is a subset of nat \<times> A*)
-        have W:\<open>f1`x=f2`x\<close>
-        proof(rule mp[OF bspec[OF pcs_uniq KK] ])
-          show \<open>m1 \<in> nat\<close>
-            by (rule m1nat)
-        next
-          show \<open>m2 \<in> nat\<close>
-            by (rule m2nat)
-        next
-          show \<open>partcomp(A, f1, m1, a, g)\<close>
-            by (rule K1)
-        next
-          show \<open>partcomp(A, f2, m2, a, g)\<close>
-            by (rule K2)
-        next
-            (*  P1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
-              K1'A:\<open>(f1:succ(m1)\<rightarrow>A)\<close>
-            *)
-          have U1:\<open>x \<in> succ(m1)\<close>
-            by (rule func.domain_type[OF P1 K1'A])
-          have U2:\<open>x \<in> succ(m2)\<close>
-            by (rule func.domain_type[OF P2 K2'A])
-          show \<open>x \<in> succ(m1) \<and> x \<in> succ(m2)\<close>
-            by (rule conjI[OF U1 U2])
-        qed
-        from L1 and W and L2
-        show \<open>y1 = y2\<close> by auto
-      qed
-    qed
-  qed
-qed
-
-theorem fuissu : \<open>f \<in> X -> Y \<Longrightarrow> f \<subseteq> X\<times>Y\<close>
-proof
-  fix w
-  assume H1 : \<open>f \<in> X -> Y\<close>
-  then have J1:\<open>f \<in> {q\<in>Pow(Sigma(X,\<lambda>_.Y)). X\<subseteq>domain(q) & function(q)}\<close>
-    by (unfold Pi_def)
-  then have J2:\<open>f \<in> Pow(Sigma(X,\<lambda>_.Y))\<close>
-    by auto
-  then have J3:\<open>f \<subseteq> Sigma(X,\<lambda>_.Y)\<close>
-    by auto
-  assume H2 : \<open>w \<in> f\<close>
-  from J3 and H2 have \<open>w\<in>Sigma(X,\<lambda>_.Y)\<close>
-    by auto
-  then have J4:\<open>w \<in> (\<Union>x\<in>X. (\<Union>y\<in>Y. {\<langle>x,y\<rangle>}))\<close>
-    by auto
-  show \<open>w \<in> X*Y\<close>
-  proof (rule UN_E[OF J4])
-    fix x
-    assume V1:\<open>x \<in> X\<close>
-    assume V2:\<open>w \<in> (\<Union>y\<in>Y. {\<langle>x, y\<rangle>})\<close>
-    show \<open>w \<in> X \<times> Y\<close>
-    proof (rule UN_E[OF V2])
-      fix y
-      assume V3:\<open>y \<in> Y\<close>
-      assume V4:\<open>w \<in> {\<langle>x, y\<rangle>}\<close>
-      then have V4:\<open>w = \<langle>x, y\<rangle>\<close>
-        by auto
-      have v5:\<open>\<langle>x, y\<rangle> \<in> Sigma(X,\<lambda>_.Y)\<close>
-      proof(rule SigmaI)
-        show \<open>x \<in> X\<close> by (rule V1)
-      next
-        show \<open>y \<in> Y\<close> by (rule V3)
-      qed
-      then have V5:\<open>\<langle>x, y\<rangle> \<in> X*Y\<close>
-        by auto
-      from V4 and V5 show \<open>w \<in> X \<times> Y\<close> by auto
-    qed
-  qed
-qed
-
-theorem recuniq :
-  fixes f
-  assumes H0:\<open>f \<in> nat -> A \<and> f ` 0 = a \<and> satpc(f, nat, g)\<close>
-  fixes t
-  assumes H1:\<open>t \<in> nat -> A \<and> t ` 0 = a \<and> satpc(t, nat, g)\<close>
-  fixes x
-  shows \<open>f=t\<close>
-proof -
-  from H0 have H02:\<open>\<forall>n \<in> nat. f`succ(n) = g ` <(f`n), n>\<close> by (unfold satpc_def, auto)
-  from H0 have H01:\<open>f ` 0 = a\<close> by auto
-  from H0 have H00:\<open>f \<in> nat -> A\<close> by auto
-  from H1 have H12:\<open>\<forall>n \<in> nat. t`succ(n) = g ` <(t`n), n>\<close> by (unfold satpc_def, auto)
-  from H1 have H11:\<open>t ` 0 = a\<close> by auto
-  from H1 have H10:\<open>t \<in> nat -> A\<close> by auto
-  show \<open>f=t\<close>
-  proof (rule fun_extension[OF H00 H10])
-    fix x
-    assume K: \<open>x \<in> nat\<close>
-    show \<open>(f ` x) = (t ` x)\<close>
-    proof(rule nat_induct[of x])
-      show \<open>x \<in> nat\<close> by (rule K)
-    next
-      from H01 and H11 show \<open>f ` 0 = t ` 0\<close>
-        by auto
-    next
-      fix x
-      assume A:\<open>x\<in>nat\<close>
-      assume B:\<open>f`x = t`x\<close>
-      show \<open>f ` succ(x) = t ` succ(x)\<close>
-      proof -
-        from H02 and A have H02':\<open>f`succ(x) = g ` <(f`x), x>\<close>
-          by (rule bspec)
-        from H12 and A have H12':\<open>t`succ(x) = g ` <(t`x), x>\<close>
-          by (rule bspec)
-        from B and H12' have H12'':\<open>t`succ(x) = g ` <(f`x), x>\<close> by auto
-        from H12'' and H02' show \<open>f ` succ(x) = t ` succ(x)\<close> by auto
-      qed
-    qed
-  qed
-qed
-
-section \<open>Lemmas for recursion theorem\<close>
-
-locale recthm =
-  fixes A :: "i"
-    and a :: "i"
-    and g :: "i"
-  assumes hyp1 : \<open>a \<in> A\<close>
-    and hyp2 : \<open>g : ((A*nat)\<rightarrow>A)\<close>
-begin
-
-lemma l3:\<open>function(\<Union>pcs(A, a, g))\<close>
-  by (rule compatsetunionfun, rule pcs_lem, rule hyp1)
-
-lemma l1 : \<open>\<Union>pcs(A, a, g) \<subseteq> nat \<times> A\<close>
-proof
-  fix x
-  assume H:\<open>x \<in> \<Union>pcs(A, a, g)\<close>
-  hence  H:\<open>x \<in> \<Union>{t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close>
-    by (unfold pcs_def)
-  show \<open>x \<in> nat \<times> A\<close>
-  proof(rule UnionE[OF H])
-    fix B
-    assume J1:\<open>x\<in>B\<close>
-    assume J2:\<open>B \<in> {t \<in> Pow(nat \<times> A) .
-            \<exists>m\<in>nat. partcomp(A, t, m, a, g)}\<close>
-    hence J2:\<open>B \<in> Pow(nat \<times> A)\<close> by auto
-    hence J2:\<open>B \<subseteq> nat \<times> A\<close> by auto
-    from J1 and J2 show \<open>x \<in> nat \<times> A\<close>
-      by auto
-  qed
-qed
-
-lemma le1:
-  assumes H:\<open>x\<in>1\<close>
-  shows \<open>x=0\<close>
-proof
-  show \<open>x \<subseteq> 0\<close>
-  proof
-    fix z
-    assume J:\<open>z\<in>x\<close>
-    show \<open>z\<in>0\<close>
-    proof(rule succE[OF H])
-      assume J:\<open>x\<in>0\<close>
-      show \<open>z\<in>0\<close>
-        by (rule notE[OF not_mem_empty J])
-    next
-      assume K:\<open>x=0\<close>
-      from J and K show \<open>z\<in>0\<close>
-        by auto
-    qed
-  qed
-next
-  show \<open>0 \<subseteq> x\<close> by auto
-qed
-
-lemma lsinglfun : \<open>function({\<langle>0, a\<rangle>})\<close>
-proof(unfold function_def)
-  show \<open> \<forall>x y. \<langle>x, y\<rangle> \<in> {\<langle>0, a\<rangle>} \<longrightarrow>
-          (\<forall>y'. \<langle>x, y'\<rangle> \<in> {\<langle>0, a\<rangle>} \<longrightarrow>
-                y = y')\<close>
-  proof(rule allI,rule allI,rule impI,rule allI,rule impI)
-    fix x y y'
-    assume H0:\<open>\<langle>x, y\<rangle> \<in> {\<langle>0, a\<rangle>}\<close>
-    assume H1:\<open>\<langle>x, y'\<rangle> \<in> {\<langle>0, a\<rangle>}\<close>
-    show \<open>y = y'\<close>
-    proof(rule upair.singletonE[OF H0],rule upair.singletonE[OF H1])
-      assume H0:\<open>\<langle>x, y\<rangle> = \<langle>0, a\<rangle>\<close>
-      assume H1:\<open>\<langle>x, y'\<rangle> = \<langle>0, a\<rangle>\<close>
-      from H0 and H1 have H:\<open>\<langle>x, y\<rangle> = \<langle>x, y'\<rangle>\<close> by auto
-      then show \<open>y = y'\<close> by auto
-    qed
-  qed
-qed
-
-lemma singlsatpc:\<open>satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
-proof(unfold satpc_def)
-  show \<open>\<forall>n\<in>0. {\<langle>0, a\<rangle>} ` succ(n) =
-           g ` \<langle>{\<langle>0, a\<rangle>} ` n, n\<rangle>\<close>
-    by auto
-qed
-
-lemma zerostep :
-  shows \<open>partcomp(A, {\<langle>0, a\<rangle>}, 0, a, g)\<close>
-proof(unfold partcomp_def)
-  show \<open>{\<langle>0, a\<rangle>} \<in> 1 -> A \<and> {\<langle>0, a\<rangle>} ` 0 = a \<and> satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
-  proof
-    show \<open>{\<langle>0, a\<rangle>} \<in> 1 -> A\<close>
-    proof (unfold Pi_def)
-      show \<open>{\<langle>0, a\<rangle>} \<in> {f \<in> Pow(1 \<times> A) . 1 \<subseteq> domain(f) \<and> function(f)}\<close>
-      proof
-        show \<open>{\<langle>0, a\<rangle>} \<in> Pow(1 \<times> A)\<close>
-        proof(rule PowI, rule equalities.singleton_subsetI)
-          show \<open>\<langle>0, a\<rangle> \<in> 1 \<times> A\<close>
-          proof
-            show \<open>0 \<in> 1\<close> by auto
-          next
-            show \<open>a \<in> A\<close> by (rule hyp1)
-          qed
-        qed
-      next
-        show \<open>1 \<subseteq> domain({\<langle>0, a\<rangle>}) \<and> function({\<langle>0, a\<rangle>})\<close>
-        proof
-          show \<open>1 \<subseteq> domain({\<langle>0, a\<rangle>})\<close>
-          proof
-            fix x
-            assume W:\<open>x\<in>1\<close>
-            from W have W:\<open>x=0\<close> by (rule le1)
-            have Y:\<open>0\<in>domain({\<langle>0, a\<rangle>})\<close>
-              by auto
-            from W and Y
-            show \<open>x\<in>domain({\<langle>0, a\<rangle>})\<close>
-              by auto
-          qed
-        next
-          show \<open>function({\<langle>0, a\<rangle>})\<close>
-            by (rule lsinglfun)
-        qed
-      qed
-    qed
-    show \<open>{\<langle>0, a\<rangle>} ` 0 = a \<and> satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
-    proof
-      show \<open>{\<langle>0, a\<rangle>} ` 0 = a\<close>
-        by (rule func.singleton_apply)
-    next
-      show \<open>satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
-        by (rule singlsatpc)
-    qed
-  qed
-qed
-
-lemma zainupcs : \<open>\<langle>0, a\<rangle> \<in> \<Union>pcs(A, a, g)\<close>
-proof
-  show \<open>\<langle>0, a\<rangle> \<in> {\<langle>0, a\<rangle>}\<close>
-    by auto
-next
-  (* {\<langle>0, a\<rangle>} is a 0-step computation *)
-  show \<open>{\<langle>0, a\<rangle>} \<in> pcs(A, a, g)\<close>
-  proof(unfold pcs_def)
-    show \<open>{\<langle>0, a\<rangle>} \<in> {t \<in> Pow(nat \<times> A) . \<exists>m\<in>nat. partcomp(A, t, m, a, g)}\<close>
-    proof
-      show \<open>{\<langle>0, a\<rangle>} \<in> Pow(nat \<times> A)\<close>
-      proof(rule PowI, rule equalities.singleton_subsetI)
-        show \<open>\<langle>0, a\<rangle> \<in> nat \<times> A\<close>
-        proof
-          show \<open>0 \<in> nat\<close> by auto
-        next
-          show \<open>a \<in> A\<close> by (rule hyp1)
-        qed
-      qed
-    next
-      show \<open>\<exists>m\<in>nat. partcomp(A, {\<langle>0, a\<rangle>}, m, a, g)\<close>
-      proof
-        show \<open>partcomp(A, {\<langle>0, a\<rangle>}, 0, a, g)\<close>
-          by (rule zerostep)
-      next
-        show \<open>0 \<in> nat\<close> by auto
-      qed
-    qed
-  qed
-qed
-
-lemma l2': \<open>0 \<in> domain(\<Union>pcs(A, a, g))\<close>
-proof
-  show \<open>\<langle>0, a\<rangle> \<in> \<Union>pcs(A, a, g)\<close>
-    by (rule zainupcs)
-qed
-
-text \<open>Push an ordered pair to the end of partial computation t
-and obtain another partial computation.\<close>
-lemma shortlem :
-  assumes mnat:\<open>m\<in>nat\<close>
-  assumes F:\<open>partcomp(A,t,m,a,g)\<close>
-  shows \<open>partcomp(A,cons(\<langle>succ(m), g ` <t`m, m>\<rangle>, t),succ(m),a,g)\<close>
-proof(rule partcompE[OF F])
-  assume F1:\<open>t \<in> succ(m) \<rightarrow> A\<close>
-  assume F2:\<open>t ` 0 = a\<close>
-  assume F3:\<open>satpc(t, m, g)\<close>
-  show ?thesis (*\<open>partcomp(A,cons(\<langle>succ(m), g ` <t`m, m>\<rangle>, t),succ(m),a,g)\<close> *)
-  proof
-    have ljk:\<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> (cons(succ(m),succ(m)) \<rightarrow> A)\<close>
-    proof(rule func.fun_extend3[OF F1])
-      show \<open>succ(m) \<notin> succ(m)\<close>
-        by (rule  upair.mem_not_refl)
-      have tmA:\<open>t ` m \<in> A\<close>
-        by (rule func.apply_funtype[OF F1], auto)
-      show \<open>g ` \<langle>t ` m, m\<rangle> \<in> A\<close>
-        by(rule func.apply_funtype[OF hyp2], auto, rule tmA, rule mnat)
-    qed
-    have \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> (cons(succ(m),succ(m)) \<rightarrow> A)\<close>
-      by (rule ljk)
-    then have \<open>cons(\<langle>cons(m, m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> cons(cons(m, m), cons(m, m)) \<rightarrow> A\<close>
-      by (unfold succ_def)
-    then show \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> succ(succ(m)) \<rightarrow> A\<close>
-      by (unfold succ_def, assumption)
-    show \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` 0 = a\<close>
-    proof(rule trans, rule func.fun_extend_apply[OF F1])
-      show \<open>succ(m) \<notin> succ(m)\<close> by (rule  upair.mem_not_refl)
-      show \<open>(if 0 = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` 0) = a\<close>
-        by(rule trans, rule upair.if_not_P, auto, rule F2)
-    qed
-    show \<open>satpc(cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t), succ(m), g)\<close>
-    proof(unfold satpc_def, rule ballI)
-      fix n
-      assume Q:\<open>n \<in> succ(m)\<close>
-      show \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` succ(n)
-= g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-      proof(rule trans, rule func.fun_extend_apply[OF F1], rule upair.mem_not_refl)
-        show \<open>(if succ(n) = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` succ(n)) =
-    g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-        proof(rule upair.succE[OF Q])
-          assume Y:\<open>n=m\<close>
-          show \<open>(if succ(n) = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` succ(n)) =
-    g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-          proof(rule trans, rule upair.if_P)
-            from Y show \<open>succ(n) = succ(m)\<close> by auto
-          next
-            have L1:\<open>t ` m = cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n\<close>
-            proof(rule sym, rule trans, rule func.fun_extend_apply[OF F1], rule upair.mem_not_refl)
-              show \<open> (if n = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` n) = t ` m\<close>
-              proof(rule trans, rule upair.if_not_P)
-                from Y show \<open>t ` n = t ` m\<close> by auto
-                show \<open>n \<noteq> succ(m)\<close>
-                proof(rule not_sym)
-                  show \<open>succ(m) \<noteq> n\<close>
-                    by(rule subst, rule sym, rule Y, rule upair.succ_neq_self)
-                qed
-              qed
-            qed
-            from Y
-            have L2:\<open>m = n\<close>
-              by auto
-            have L:\<open> \<langle>t ` m, m\<rangle> = \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-              by(rule subst_context2[OF L1 L2])
-            show \<open> g ` \<langle>t ` m, m\<rangle> = g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-              by(rule subst_context[OF L])
-          qed
-        next
-          assume Y:\<open>n \<in> m\<close>
-          show \<open>(if succ(n) = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` succ(n)) =
-                g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-          proof(rule trans, rule upair.if_not_P)
-            show \<open>succ(n) \<noteq> succ(m)\<close>
-              by(rule contrapos, rule upair.mem_imp_not_eq, rule Y, rule upair.succ_inject, assumption)
-          next
-            have X:\<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n = t ` n\<close>
-            proof(rule trans, rule func.fun_extend_apply[OF F1], rule upair.mem_not_refl)
-              show \<open>(if n = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` n) = t ` n\<close>
-              proof(rule upair.if_not_P)
-                show \<open>n \<noteq> succ(m)\<close>
-                proof(rule contrapos)
-                  assume q:"n=succ(m)"
-                  from q and Y have M:\<open>succ(m)\<in>m\<close>
-                    by auto
-                  show \<open>m\<in>m\<close>
-                    by(rule Nat.succ_in_naturalD[OF M mnat])
-                next
-                  show \<open>m \<notin> m\<close> by (rule  upair.mem_not_refl)
-                qed
-              qed
-            qed
-            from F3
-            have W:\<open>\<forall>n\<in>m. t ` succ(n) = g ` \<langle>t ` n, n\<rangle>\<close>
-              by (unfold satpc_def)
-            have U:\<open>t ` succ(n) = g ` \<langle>t ` n, n\<rangle>\<close>
-              by (rule bspec[OF W Y])
-            show \<open>t ` succ(n) = g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
-              by (rule trans, rule U, rule sym, rule subst_context[OF X])
-          qed
-        qed
-      qed
-    qed
-  qed
-qed
-
-lemma l2:\<open>nat \<subseteq> domain(\<Union>pcs(A, a, g))\<close>
-proof
-  fix x
-  assume G:\<open>x\<in>nat\<close>
-  show \<open>x \<in> domain(\<Union>pcs(A, a, g))\<close>
-  proof(rule nat_induct[of x])
-    show \<open>x\<in>nat\<close> by (rule G)
-  next
-    fix x
-    assume Q1:\<open>x\<in>nat\<close>
-    assume Q2:\<open>x\<in>domain(\<Union>pcs(A, a, g))\<close>
-    show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
-    proof(rule domainE[OF Q2])
-      fix y
-      assume W1:\<open>\<langle>x, y\<rangle> \<in> (\<Union>pcs(A, a, g))\<close>
-      show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
-      proof(rule UnionE[OF W1])
-        fix t
-        assume E1:\<open>\<langle>x, y\<rangle> \<in> t\<close>
-        assume E2:\<open>t \<in> pcs(A, a, g)\<close>
-        hence E2:\<open>t\<in>{t\<in>Pow(nat*A). \<exists>m \<in> nat. partcomp(A,t,m,a,g)}\<close>
-          by(unfold pcs_def)
-        have E21:\<open>t\<in>Pow(nat*A)\<close>
-          by(rule CollectD1[OF E2])
-        have E22m:\<open>\<exists>m\<in>nat. partcomp(A,t,m,a,g)\<close>
-          by(rule CollectD2[OF E2])
-        show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
-        proof(rule bexE[OF E22m])
-          fix m
-          assume mnat:\<open>m\<in>nat\<close>
-          assume E22P:\<open>partcomp(A,t,m,a,g)\<close>
-          hence E22:\<open>((t:succ(m)\<rightarrow>A) \<and> (t`0=a)) \<and> satpc(t,m,g)\<close>
-            by(unfold partcomp_def, auto)
-          hence E223:\<open>satpc(t,m,g)\<close> by auto
-          hence E223:\<open>\<forall>n \<in> m . t`succ(n) = g ` <t`n, n>\<close>
-            by(unfold satpc_def, auto)
-          from E22 have E221:\<open>(t:succ(m)\<rightarrow>A)\<close>
-            by auto
-          from E221 have domt:\<open>domain(t) = succ(m)\<close>
-            by (rule func.domain_of_fun)
-          from E1 have xind:\<open>x \<in> domain(t)\<close>
-            by (rule equalities.domainI)
-          from xind and domt have xinsm:\<open>x \<in> succ(m)\<close>
-            by auto
-          show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
-          proof
-        (*proof(rule exE[OF E22])*)
-            show \<open> \<langle>succ(x), g ` <t`x, x>\<rangle> \<in> (\<Union>pcs(A, a, g))\<close> (*?*)
-            proof
-             (*t\<union>{\<langle>succ(x), g ` <t`x, x>\<rangle>}*)
-              show \<open>cons(\<langle>succ(x), g ` <t`x, x>\<rangle>, t) \<in> pcs(A, a, g)\<close>
-              proof(unfold pcs_def, rule CollectI)
-                from E21
-                have L1:\<open>t \<subseteq> nat \<times> A\<close>
-                  by auto
-                from Q1 have J1:\<open>succ(x)\<in>nat\<close>
-                  by auto(*Nat.nat_succI*)
-                have txA: \<open>t ` x \<in> A\<close>
-                  by (rule func.apply_type[OF E221 xinsm])
-                from txA and Q1 have txx:\<open>\<langle>t ` x, x\<rangle> \<in> A \<times> nat\<close>
-                  by auto
-                have secp: \<open>g ` \<langle>t ` x, x\<rangle> \<in> A\<close>
-                  by(rule func.apply_type[OF hyp2 txx])
-                from J1 and secp
-                have L2:\<open>\<langle>succ(x),g ` \<langle>t ` x, x\<rangle>\<rangle> \<in> nat \<times> A\<close>
-                  by auto
-                show \<open> cons(\<langle>succ(x),g ` \<langle>t ` x, x\<rangle>\<rangle>,t) \<in> Pow(nat \<times> A)\<close>
-                proof(rule PowI)
-                  show \<open> cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t) \<subseteq> nat \<times> A\<close>
-                  proof
-                    show \<open>\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle> \<in> nat \<times> A \<and> t \<subseteq> nat \<times> A\<close>
-                      by (rule conjI[OF L2 L1])
-                  qed
-                qed
-              next
-                show \<open>\<exists>m \<in> nat. partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), m, a, g)\<close>
-                proof(rule succE[OF xinsm])
-                  assume xeqm:\<open>x=m\<close>
-                  show \<open>\<exists>m \<in> nat. partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), m, a, g)\<close>
-                  proof
-                    show \<open>partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), succ(x), a, g)\<close>
-                    proof(rule shortlem[OF Q1])
-                      show \<open>partcomp(A, t, x, a, g)\<close>
-                      proof(rule subst[of m x], rule sym, rule xeqm)
-                        show \<open>partcomp(A, t, m, a, g)\<close>
-                          by (rule E22P)
-                      qed
-                    qed
-                  next
-                    from Q1 show \<open>succ(x) \<in> nat\<close> by auto
-                  qed
-                next
-                  assume xinm:\<open>x\<in>m\<close>
-                  have lmm:\<open>cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t) = t\<close>
-                    by (rule addmiddle[OF mnat E22P xinm])
-                  show \<open>\<exists>m\<in>nat. partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), m, a, g)\<close>
-                    by(rule subst[of t], rule sym, rule lmm, rule E22m)
-                qed
-              qed
-            next
-              show \<open>\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle> \<in> cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t)\<close>
-                by auto
-            qed
-          qed
-        qed
-      qed
-    qed
-  next
-    show \<open>0 \<in> domain(\<Union>pcs(A, a, g))\<close>
-      by (rule l2')
-  qed
-qed
-
-lemma useful : \<open>\<forall>m\<in>nat. \<exists>t. partcomp(A,t,m,a,g)\<close>
-proof(rule nat_induct_bound)
-  show \<open>\<exists>t. partcomp(A, t, 0, a, g)\<close>
-  proof
-    show \<open>partcomp(A, {\<langle>0, a\<rangle>}, 0, a, g)\<close>
-      by (rule zerostep)
-  qed
-next
-  fix m
-  assume mnat:\<open>m\<in>nat\<close>
-  assume G:\<open>\<exists>t. partcomp(A,t,m,a,g)\<close>
-  show \<open>\<exists>t. partcomp(A,t,succ(m),a,g)\<close>
-  proof(rule exE[OF G])
-    fix t
-    assume G:\<open>partcomp(A,t,m,a,g)\<close>
-    show \<open>\<exists>t. partcomp(A,t,succ(m),a,g)\<close>
-    proof
-      show \<open>partcomp(A,cons(\<langle>succ(m), g ` <t`m, m>\<rangle>, t),succ(m),a,g)\<close>
-        by(rule shortlem[OF mnat G])
-    qed
-  qed
-qed
-
-lemma l4 : \<open>(\<Union>pcs(A,a,g)) \<in> nat -> A\<close>
-proof(unfold Pi_def)
-  show \<open> \<Union>pcs(A, a, g) \<in> {f \<in> Pow(nat \<times> A) . nat \<subseteq> domain(f) \<and> function(f)}\<close>
-  proof
-    show \<open>\<Union>pcs(A, a, g) \<in> Pow(nat \<times> A)\<close>
-    proof
-      show \<open>\<Union>pcs(A, a, g) \<subseteq> nat \<times> A\<close>
-        by (rule l1)
-    qed
-  next
-    show \<open>nat \<subseteq> domain(\<Union>pcs(A, a, g)) \<and> function(\<Union>pcs(A, a, g))\<close>
-    proof
-      show \<open>nat \<subseteq> domain(\<Union>pcs(A, a, g))\<close>
-        by (rule l2)
-    next
-      show \<open>function(\<Union>pcs(A, a, g))\<close>
-        by (rule l3)
-    qed
-  qed
-qed
-
-lemma l5: \<open>(\<Union>pcs(A, a, g)) ` 0 = a\<close>
-proof(rule func.function_apply_equality)
-  show \<open>function(\<Union>pcs(A, a, g))\<close>
-    by (rule l3)
-next
-  show \<open>\<langle>0, a\<rangle> \<in> \<Union>pcs(A, a, g)\<close>
-    by (rule zainupcs)
-qed
-
-lemma ballE2:
-  assumes \<open>\<forall>x\<in>AA. P(x)\<close>
-  assumes \<open>x\<in>AA\<close>
-  assumes \<open>P(x) ==> Q\<close>
-  shows Q
-  by (rule assms(3), rule bspec, rule assms(1), rule assms(2))
-
-text \<open> Recall that
-  \<open>satpc(t,\<alpha>,g) == \<forall>n \<in> \<alpha> . t`succ(n) = g ` <t`n, n>\<close>
-  \<open>partcomp(A,t,m,a,g) == (t:succ(m)\<rightarrow>A) \<and> (t`0=a) \<and> satpc(t,m,g)\<close>
-  \<open>pcs(A,a,g) == {t\<in>Pow(nat*A). \<exists>m. partcomp(A,t,m,a,g)}\<close>
-\<close>
-
-lemma l6new: \<open>satpc(\<Union>pcs(A, a, g), nat, g)\<close>
-proof (unfold satpc_def, rule ballI)
-  fix n
-  assume nnat:\<open>n\<in>nat\<close>
-  hence snnat:\<open>succ(n)\<in>nat\<close> by auto
-  (* l2:\<open>nat \<subseteq> domain(\<Union>pcs(A, a, g))\<close> *)
-  show \<open>(\<Union>pcs(A, a, g)) ` succ(n) = g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle>\<close>
-  proof(rule ballE2[OF useful snnat], erule exE)
-    fix t
-    assume Y:\<open>partcomp(A, t, succ(n), a, g)\<close>
-    show \<open>(\<Union>pcs(A, a, g)) ` succ(n) = g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle>\<close>
-    proof(rule partcompE[OF Y])
-      assume Y1:\<open>t \<in> succ(succ(n)) \<rightarrow> A\<close>
-      assume Y2:\<open>t ` 0 = a\<close>
-      assume Y3:\<open>satpc(t, succ(n), g)\<close>
-      hence Y3:\<open>\<forall>x \<in> succ(n) . t`succ(x) = g ` <t`x, x>\<close>
-        by (unfold satpc_def)
-      hence Y3:\<open>t`succ(n) = g ` <t`n, n>\<close>
-        by (rule bspec, auto)
-      have e1:\<open>(\<Union>pcs(A, a, g)) ` succ(n) = t ` succ(n)\<close>
-      proof(rule valofunion, rule pcs_lem, rule hyp1)
-        show \<open>t \<in> pcs(A, a, g)\<close>
-        proof(unfold pcs_def, rule CollectI)
-          show \<open>t \<in> Pow(nat \<times> A)\<close>
-            proof(rule tgb)
-            show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
-          next
-            from snnat
-            show \<open>succ(succ(n)) \<in> nat\<close> by auto
-          qed
-        next
-          show \<open>\<exists>m\<in>nat. partcomp(A, t, m, a, g)\<close>
-            by(rule bexI, rule Y, rule snnat)
-        qed
-      next
-        show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
-      next
-        show \<open>succ(n) \<in> succ(succ(n))\<close> by auto
-      next
-        show \<open>t ` succ(n) = t ` succ(n)\<close> by (rule refl)
-      qed
-      have e2:\<open>(\<Union>pcs(A, a, g)) ` n = t ` n\<close>
-      proof(rule valofunion, rule pcs_lem, rule hyp1)
-        show \<open>t \<in> pcs(A, a, g)\<close>
-        proof(unfold pcs_def, rule CollectI)
-          show \<open>t \<in> Pow(nat \<times> A)\<close>
-          proof(rule tgb)
-            show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
-          next
-            from snnat
-            show \<open>succ(succ(n)) \<in> nat\<close> by auto
-          qed
-        next
-          show \<open>\<exists>m\<in>nat. partcomp(A, t, m, a, g)\<close>
-            by(rule bexI, rule Y, rule snnat)
-        qed
-      next
-        show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
-      next
-        show \<open>n \<in> succ(succ(n))\<close> by auto
-      next
-        show \<open>t ` n = t ` n\<close> by (rule refl)
-      qed
-      have e3:\<open>g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle> = g ` \<langle>t ` n, n\<rangle>\<close>
-        by (rule subst[OF e2], rule refl)
-      show \<open>(\<Union>pcs(A, a, g)) ` succ(n) = g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle>\<close>
-        by (rule trans, rule e1,rule trans, rule Y3, rule sym, rule e3)
-    qed
-  qed
-qed
-
-section "Recursion theorem"
-
-theorem recursionthm:
-  shows \<open>\<exists>!f. ((f \<in> (nat\<rightarrow>A)) \<and> ((f`0) = a) \<and> satpc(f,nat,g))\<close>
-(* where \<open>satpc(t,\<alpha>,g) == \<forall>n \<in> \<alpha> . t`succ(n) = g ` <t`n, n>\<close> *)
-proof
-  show \<open>\<exists>f. f \<in> nat -> A \<and> f ` 0 = a \<and> satpc(f, nat, g)\<close>
-  proof
-    show \<open>(\<Union>pcs(A,a,g)) \<in> nat -> A \<and> (\<Union>pcs(A,a,g)) ` 0 = a \<and> satpc(\<Union>pcs(A,a,g), nat, g)\<close>
-    proof
-      show \<open>\<Union>pcs(A, a, g) \<in> nat -> A\<close>
-        by (rule l4)
-    next
-      show \<open>(\<Union>pcs(A, a, g)) ` 0 = a \<and> satpc(\<Union>pcs(A, a, g), nat, g)\<close>
-      proof
-        show \<open>(\<Union>pcs(A, a, g)) ` 0 = a\<close>
-          by (rule l5)
-      next
-        show \<open>satpc(\<Union>pcs(A, a, g), nat, g)\<close>
-          by (rule l6new)
-      qed
-    qed
-  qed
-next
-  show \<open>\<And>f y. f \<in> nat -> A \<and>
-           f ` 0 = a \<and>
-           satpc(f, nat, g) \<Longrightarrow>
-           y \<in> nat -> A \<and>
-           y ` 0 = a \<and>
-           satpc(y, nat, g) \<Longrightarrow>
-           f = y\<close>
-    by (rule recuniq)
-qed
-
-end
-
-section "Lemmas for addition"
-
-text \<open>
-Let's define function t(x) = (a+x).
-Firstly we need to define a function \<open>g:nat \<times> nat \<rightarrow> nat\<close>, such that
-\<open>g`\<langle>t`n, n\<rangle> = t`succ(n) = a + (n + 1) = (a + n) + 1 = (t`n) + 1\<close>
-So \<open>g`\<langle>a, b\<rangle> = a + 1\<close> and \<open>g(p) = succ(pr1(p))\<close>
-and \<open>satpc(t,\<alpha>,g) \<Longleftrightarrow> \<forall>n \<in> \<alpha> . t`succ(n) = succ(t`n)\<close>.
-\<close>
-
-definition addg :: \<open>i\<close>
-  where addg_def : \<open>addg == \<lambda>x\<in>(nat*nat). succ(fst(x))\<close>
-
-lemma addgfun: \<open>function(addg)\<close>
-  by (unfold addg_def, rule func.function_lam)
-
-lemma addgsubpow : \<open>addg \<in> Pow((nat \<times> nat) \<times> nat)\<close>
-proof (unfold addg_def, rule subsetD)
-  show \<open>(\<lambda>x\<in>nat \<times> nat. succ(fst(x))) \<in> nat \<times> nat \<rightarrow> nat\<close>
-  proof(rule func.lam_type)
-    fix x
-    assume \<open>x\<in>nat \<times> nat\<close>
-    hence \<open>fst(x)\<in>nat\<close> by auto
-    thus \<open>succ(fst(x)) \<in> nat\<close> by auto
-  qed
-next
-  show \<open>nat \<times> nat \<rightarrow> nat \<subseteq> Pow((nat \<times> nat) \<times> nat)\<close>
-    by (rule pisubsig)
-qed
-
-lemma addgdom : \<open>nat \<times> nat \<subseteq> domain(addg)\<close>
-proof(unfold addg_def)
-  have e:\<open>domain(\<lambda>x\<in>nat \<times> nat. succ(fst(x))) = nat \<times> nat\<close>
-    by (rule domain_lam)  (* "domain(Lambda(A,b)) = A" *)
-  show \<open>nat \<times> nat \<subseteq>
-    domain(\<lambda>x\<in>nat \<times> nat. succ(fst(x)))\<close>
-    by (rule subst, rule sym, rule e, auto)
-qed
-
-lemma plussucc:
-  assumes F:\<open>f \<in> (nat\<rightarrow>nat)\<close>
-  assumes H:\<open>satpc(f,nat,addg)\<close>
-  shows \<open>\<forall>n \<in> nat . f`succ(n) = succ(f`n)\<close>
-proof
-  fix n
-  assume J:\<open>n\<in>nat\<close>
-  from H
-  have H:\<open>\<forall>n \<in> nat . f`succ(n) = (\<lambda>x\<in>(nat*nat). succ(fst(x)))` <f`n, n>\<close>
-    by (unfold satpc_def, unfold addg_def)
-  have H:\<open>f`succ(n) = (\<lambda>x\<in>(nat*nat). succ(fst(x)))` <f`n, n>\<close>
-    by (rule bspec[OF H J])
-  have Q:\<open>(\<lambda>x\<in>(nat*nat). succ(fst(x)))` <f`n, n> = succ(fst(<f`n, n>))\<close>
-  proof(rule func.beta)
-    show \<open>\<langle>f ` n, n\<rangle> \<in> nat \<times> nat\<close>
-    proof
-      show \<open>f ` n \<in> nat\<close>
-        by (rule func.apply_funtype[OF F J])
-      show \<open>n \<in> nat\<close>
-        by (rule J)
-    qed
-  qed
-  have HQ:\<open>f`succ(n) = succ(fst(<f`n, n>))\<close>
-    by (rule trans[OF H Q])
-  have K:\<open>fst(<f`n, n>) = f`n\<close>
-    by auto
-  hence K:\<open>succ(fst(<f`n, n>)) = succ(f`n)\<close>
-    by (rule subst_context)
-  show \<open>f`succ(n) = succ(f`n)\<close>
-    by (rule trans[OF HQ K])
-qed
-
-section "Definition of addition"
-
-text \<open>Theorem that addition of natural numbers exists
-and unique in some sense. Due to theorem 'plussucc' the term
- \<open>satpc(f,nat,addg)\<close>
-  can be replaced here with
- \<open>\<forall>n \<in> nat . f`succ(n) = succ(f`n)\<close>.\<close>
-theorem addition:
-  assumes \<open>a\<in>nat\<close>
-  shows
- \<open>\<exists>!f. ((f \<in> (nat\<rightarrow>nat)) \<and> ((f`0) = a) \<and> satpc(f,nat,addg))\<close>
-proof(rule recthm.recursionthm, unfold recthm_def)
-  show \<open>a \<in> nat \<and> addg \<in> nat \<times> nat \<rightarrow> nat\<close>
-  proof
-    show \<open>a\<in>nat\<close> by (rule assms(1))
-  next
-    show \<open>addg \<in> nat \<times> nat \<rightarrow> nat\<close>
-    proof(unfold Pi_def, rule CollectI)
-      show \<open>addg \<in> Pow((nat \<times> nat) \<times> nat)\<close>
-        by (rule addgsubpow)
-    next
-      have A2: \<open>nat \<times> nat \<subseteq> domain(addg)\<close>
-        by(rule addgdom)
-      have A3: \<open>function(addg)\<close>
-        by (rule addgfun)
-      show \<open>nat \<times> nat \<subseteq> domain(addg) \<and> function(addg)\<close>
-        by(rule conjI[OF A2 A3])
-    qed
-  qed
-qed
-
-end
+(*  Title:       Recursion theorem
+    Author:      Georgy Dunaev <georgedunaev at gmail.com>, 2020
+    Maintainer:  Georgy Dunaev <georgedunaev at gmail.com>
+*)
+section "Recursion Submission"
+
+text \<open>Recursion Theorem is proved in the following document.
+It also contains the addition on natural numbers.
+The development is done in the context of Zermelo-Fraenkel set theory.\<close>
+
+theory recursion
+  imports ZF
+begin
+
+section \<open>Basic Set Theory\<close>
+text \<open>Useful lemmas about sets, functions and natural numbers\<close>
+lemma pisubsig : \<open>Pi(A,P)\<subseteq>Pow(Sigma(A,P))\<close>
+proof
+  fix x
+  assume \<open>x \<in> Pi(A,P)\<close>
+  hence \<open>x \<in> {f\<in>Pow(Sigma(A,P)). A\<subseteq>domain(f) & function(f)}\<close>
+    by (unfold Pi_def)
+  thus \<open>x \<in> Pow(Sigma(A, P))\<close>
+    by (rule CollectD1)
+qed
+
+lemma apparg:
+  fixes f A B
+  assumes T0:\<open>f:A\<rightarrow>B\<close>
+  assumes T1:\<open>f ` a = b\<close>
+  assumes T2:\<open>a \<in> A\<close>
+  shows \<open>\<langle>a, b\<rangle> \<in> f\<close>
+proof(rule iffD2[OF func.apply_iff], rule T0)
+  show T:\<open>a \<in> A \<and> f ` a = b\<close>
+    by (rule conjI[OF T2 T1])
+qed
+
+theorem nat_induct_bound :
+  assumes H0:\<open>P(0)\<close>
+  assumes H1:\<open>!!x. x\<in>nat \<Longrightarrow> P(x) \<Longrightarrow> P(succ(x))\<close>
+  shows \<open>\<forall>n\<in>nat. P(n)\<close>
+proof(rule ballI)
+  fix n
+  assume H2:\<open>n\<in>nat\<close>
+  show \<open>P(n)\<close>
+  proof(rule nat_induct[of n])
+    from H2 show \<open>n\<in>nat\<close> by assumption
+  next
+    show \<open>P(0)\<close> by (rule H0)
+  next
+    fix x
+    assume H3:\<open>x\<in>nat\<close>
+    assume H4:\<open>P(x)\<close>
+    show \<open>P(succ(x))\<close> by (rule H1[OF H3 H4])
+  qed
+qed
+
+theorem nat_Tr : \<open>\<forall>n\<in>nat. m\<in>n \<longrightarrow> m\<in>nat\<close>
+proof(rule nat_induct_bound)
+  show \<open>m \<in> 0 \<longrightarrow> m \<in> nat\<close> by auto
+next
+  fix x
+  assume H0:\<open>x \<in> nat\<close>
+  assume H1:\<open>m \<in> x \<longrightarrow> m \<in> nat\<close>
+  show \<open>m \<in> succ(x) \<longrightarrow> m \<in> nat\<close>
+  proof(rule impI)
+    assume H2:\<open>m\<in>succ(x)\<close>
+    show \<open>m \<in> nat\<close>
+    proof(rule succE[OF H2])
+      assume H3:\<open>m = x\<close>
+      from H0 and H3 show \<open>m \<in> nat\<close>
+        by auto
+    next
+      assume H4:\<open>m \<in> x\<close>
+      show \<open>m \<in> nat\<close>
+        by(rule mp[OF H1 H4])
+    qed
+  qed
+qed
+
+(* Natural numbers are linearly ordered. *)
+theorem zeroleq : \<open>\<forall>n\<in>nat. 0\<in>n \<or> 0=n\<close>
+proof(rule ballI)
+  fix n
+  assume H1:\<open>n\<in>nat\<close>
+  show \<open>0\<in>n\<or>0=n\<close>
+  proof(rule nat_induct[of n])
+    from H1 show \<open>n \<in> nat\<close> by assumption
+  next
+    show \<open>0 \<in> 0 \<or> 0 = 0\<close> by (rule disjI2, rule refl)
+  next
+    fix x
+    assume H2:\<open>x\<in>nat\<close>
+    assume H3:\<open> 0 \<in> x \<or> 0 = x\<close>
+    show \<open>0 \<in> succ(x) \<or> 0 = succ(x)\<close>
+    proof(rule disjE[OF H3])
+      assume H4:\<open>0\<in>x\<close>
+      show \<open>0 \<in> succ(x) \<or> 0 = succ(x)\<close>
+      proof(rule disjI1)
+        show \<open>0 \<in> succ(x)\<close>
+          by (rule succI2[OF H4])
+      qed
+    next
+      assume H4:\<open>0=x\<close>
+      show \<open>0 \<in> succ(x) \<or> 0 = succ(x)\<close>
+      proof(rule disjI1)
+        have q:\<open>x \<in> succ(x)\<close> by auto
+        from q and H4 show \<open>0 \<in> succ(x)\<close> by auto
+      qed
+    qed
+  qed
+qed
+
+theorem JH2_1ii : \<open>m\<in>succ(n) \<Longrightarrow> m\<in>n\<or>m=n\<close>
+  by auto
+
+theorem nat_transitive:\<open>\<forall>n\<in>nat. \<forall>k. \<forall>m.  k \<in> m \<and> m \<in> n \<longrightarrow> k \<in> n\<close>
+proof(rule nat_induct_bound)
+  show \<open>\<forall>k. \<forall>m. k \<in> m \<and> m \<in> 0 \<longrightarrow> k \<in> 0\<close>
+  proof(rule allI, rule allI, rule impI)
+    fix k m
+    assume H:\<open>k \<in> m \<and> m \<in> 0\<close>
+    then have H:\<open>m \<in> 0\<close> by auto
+    then show \<open>k \<in> 0\<close> by auto
+  qed
+next
+  fix n
+  assume H0:\<open>n \<in> nat\<close>
+  assume H1:\<open>\<forall>k.
+            \<forall>m.
+               k \<in> m \<and> m \<in> n \<longrightarrow>
+               k \<in> n\<close>
+  show \<open>\<forall>k. \<forall>m.
+               k \<in> m \<and>
+               m \<in> succ(n) \<longrightarrow>
+               k \<in> succ(n)\<close>
+  proof(rule allI, rule allI, rule impI)
+    fix k m
+    assume H4:\<open>k \<in> m \<and> m \<in> succ(n)\<close>
+    hence H4':\<open>m \<in> succ(n)\<close> by (rule conjunct2)
+    hence H4'':\<open>m\<in>n \<or> m=n\<close> by (rule succE, auto)
+    from H4 have Q:\<open>k \<in> m\<close> by (rule conjunct1)
+    have H1S:\<open>\<forall>m. k \<in> m \<and> m \<in> n \<longrightarrow> k \<in> n\<close>
+      by (rule spec[OF H1])
+    have H1S:\<open>k \<in> m \<and> m \<in> n \<longrightarrow> k \<in> n\<close>
+      by (rule spec[OF H1S])
+    show \<open>k \<in> succ(n)\<close>
+    proof(rule disjE[OF H4''])
+      assume L:\<open>m\<in>n\<close>
+      from Q and L have QL:\<open>k \<in> m \<and> m \<in> n\<close> by auto
+      have G:\<open>k \<in> n\<close> by (rule mp [OF H1S QL])
+      show \<open>k \<in> succ(n)\<close>
+        by (rule succI2[OF G])
+    next
+      assume L:\<open>m=n\<close>
+      from Q have F:\<open>k \<in> succ(m)\<close> by auto
+      from L and Q show \<open>k \<in> succ(n)\<close> by auto
+    qed
+  qed
+qed
+
+theorem nat_xninx : \<open>\<forall>n\<in>nat. \<not>(n\<in>n)\<close>
+proof(rule nat_induct_bound)
+  show \<open>0\<notin>0\<close>
+    by auto
+next
+  fix x
+  assume H0:\<open>x\<in>nat\<close>
+  assume H1:\<open>x\<notin>x\<close>
+  show \<open>succ(x) \<notin> succ(x)\<close>
+  proof(rule contrapos[OF H1])
+    assume Q:\<open>succ(x) \<in> succ(x)\<close>
+    have D:\<open>succ(x)\<in>x \<or> succ(x)=x\<close>
+      by (rule JH2_1ii[OF Q])
+    show \<open>x\<in>x\<close>
+    proof(rule disjE[OF D])
+      assume Y1:\<open>succ(x)\<in>x\<close>
+      have U:\<open>x\<in>succ(x)\<close> by (rule succI1)
+      have T:\<open>x \<in> succ(x) \<and> succ(x) \<in> x \<longrightarrow> x \<in> x\<close>
+        by (rule spec[OF spec[OF bspec[OF nat_transitive H0]]])
+      have R:\<open>x \<in> succ(x) \<and> succ(x) \<in> x\<close>
+        by (rule conjI[OF U Y1])
+      show \<open>x\<in>x\<close>
+        by (rule mp[OF T R])
+    next
+      assume Y1:\<open>succ(x)=x\<close>
+      show \<open>x\<in>x\<close>
+        by (rule subst[OF Y1], rule Q)
+    qed
+  qed
+qed
+
+theorem nat_asym : \<open>\<forall>n\<in>nat. \<forall>m. \<not>(n\<in>m \<and> m\<in>n)\<close>
+proof(rule ballI, rule allI)
+  fix n m
+  assume H0:\<open>n \<in> nat\<close>
+  have Q:\<open>\<not>(n\<in>n)\<close>
+    by(rule bspec[OF nat_xninx H0])
+  show \<open>\<not> (n \<in> m \<and> m \<in> n)\<close>
+  proof(rule contrapos[OF Q])
+    assume W:\<open>(n \<in> m \<and> m \<in> n)\<close>
+    show \<open>n\<in>n\<close>
+      by (rule mp[OF spec[OF spec[OF bspec[OF nat_transitive H0]]] W])
+  qed
+qed
+
+theorem zerolesucc :\<open>\<forall>n\<in>nat. 0 \<in> succ(n)\<close>
+proof(rule nat_induct_bound)
+  show \<open>0\<in>1\<close>
+    by auto
+next
+  fix x
+  assume H0:\<open>x\<in>nat\<close>
+  assume H1:\<open>0\<in>succ(x)\<close>
+  show \<open>0\<in>succ(succ(x))\<close>
+  proof
+    assume J:\<open>0 \<notin> succ(x)\<close>
+    show \<open>0 = succ(x)\<close>
+      by(rule notE[OF J H1])
+  qed
+qed
+
+theorem succ_le : \<open>\<forall>n\<in>nat. succ(m)\<in>succ(n) \<longrightarrow> m\<in>n\<close>
+proof(rule nat_induct_bound)
+  show \<open> succ(m) \<in> 1 \<longrightarrow> m \<in> 0\<close>
+    by blast
+next
+  fix x
+  assume H0:\<open>x \<in> nat\<close>
+  assume H1:\<open>succ(m) \<in> succ(x) \<longrightarrow> m \<in> x\<close>
+  show \<open> succ(m) \<in>
+             succ(succ(x)) \<longrightarrow>
+             m \<in> succ(x)\<close>
+  proof(rule impI)
+    assume J0:\<open>succ(m) \<in> succ(succ(x))\<close>
+    show \<open>m \<in> succ(x)\<close>
+    proof(rule succE[OF J0])
+      assume R:\<open>succ(m) = succ(x)\<close>
+      hence R:\<open>m=x\<close> by (rule upair.succ_inject)
+      from R and succI1 show \<open>m \<in> succ(x)\<close> by auto
+    next
+      assume R:\<open>succ(m) \<in> succ(x)\<close>
+      have R:\<open>m\<in>x\<close> by (rule mp[OF H1 R])
+      then show \<open>m \<in> succ(x)\<close> by auto
+    qed
+  qed
+qed
+
+theorem succ_le2 : \<open>\<forall>n\<in>nat. \<forall>m. succ(m)\<in>succ(n) \<longrightarrow> m\<in>n\<close>
+proof
+  fix n
+  assume H:\<open>n\<in>nat\<close>
+  show \<open>\<forall>m. succ(m) \<in> succ(n) \<longrightarrow> m \<in> n\<close>
+  proof
+    fix m
+    from succ_le and H show \<open>succ(m) \<in> succ(n) \<longrightarrow> m \<in> n\<close> by auto
+  qed
+qed
+
+theorem le_succ : \<open>\<forall>n\<in>nat. m\<in>n \<longrightarrow> succ(m)\<in>succ(n)\<close>
+proof(rule nat_induct_bound)
+  show \<open>m \<in> 0 \<longrightarrow> succ(m) \<in> 1\<close>
+    by auto
+next
+  fix x
+  assume H0:\<open>x\<in>nat\<close>
+  assume H1:\<open>m \<in> x \<longrightarrow> succ(m) \<in> succ(x)\<close>
+  show \<open>m \<in> succ(x) \<longrightarrow>
+            succ(m) \<in> succ(succ(x))\<close>
+  proof(rule impI)
+    assume HR1:\<open>m\<in>succ(x)\<close>
+    show \<open>succ(m) \<in> succ(succ(x))\<close>
+    proof(rule succE[OF HR1])
+      assume Q:\<open>m = x\<close>
+      from Q show \<open>succ(m) \<in> succ(succ(x))\<close>
+        by auto
+    next
+      assume Q:\<open>m \<in> x\<close>
+      have Q:\<open>succ(m) \<in> succ(x)\<close>
+        by (rule mp[OF H1 Q])
+      from Q show \<open>succ(m) \<in> succ(succ(x))\<close>
+        by (rule succI2)
+    qed
+  qed
+qed
+
+theorem nat_linord:\<open>\<forall>n\<in>nat. \<forall>m\<in>nat. m\<in>n\<or>m=n\<or>n\<in>m\<close>
+proof(rule ballI)
+  fix n
+  assume H1:\<open>n\<in>nat\<close>
+  show \<open>\<forall>m\<in>nat. m \<in> n \<or> m = n \<or> n \<in> m\<close>
+  proof(rule nat_induct[of n])
+    from H1 show \<open>n\<in>nat\<close> by assumption
+  next
+    show \<open>\<forall>m\<in>nat. m \<in> 0 \<or> m = 0 \<or> 0 \<in> m\<close>
+    proof
+      fix m
+      assume J:\<open>m\<in>nat\<close>
+      show \<open> m \<in> 0 \<or> m = 0 \<or> 0 \<in> m\<close>
+      proof(rule disjI2)
+        have Q:\<open>0\<in>m\<or>0=m\<close> by (rule bspec[OF zeroleq J])
+        show \<open>m = 0 \<or> 0 \<in> m\<close>
+          by (rule disjE[OF Q], auto)
+      qed
+    qed
+  next
+    fix x
+    assume K:\<open>x\<in>nat\<close>
+    assume M:\<open>\<forall>m\<in>nat. m \<in> x \<or> m = x \<or> x \<in> m\<close>
+    show \<open>\<forall>m\<in>nat.
+            m \<in> succ(x) \<or>
+            m = succ(x) \<or>
+            succ(x) \<in> m\<close>
+    proof(rule nat_induct_bound)
+      show \<open>0 \<in> succ(x) \<or>  0 = succ(x) \<or> succ(x) \<in> 0\<close>
+      proof(rule disjI1)
+        show \<open>0 \<in> succ(x)\<close>
+          by (rule bspec[OF zerolesucc K])
+      qed
+    next
+      fix y
+      assume H0:\<open>y \<in> nat\<close>
+      assume H1:\<open>y \<in> succ(x) \<or> y = succ(x) \<or> succ(x) \<in> y\<close>
+      show \<open>succ(y) \<in> succ(x) \<or>
+            succ(y) = succ(x) \<or>
+            succ(x) \<in> succ(y)\<close>
+      proof(rule disjE[OF H1])
+        assume W:\<open>y\<in>succ(x)\<close>
+        show \<open>succ(y) \<in> succ(x) \<or>
+              succ(y) = succ(x) \<or>
+              succ(x) \<in> succ(y)\<close>
+        proof(rule succE[OF W])
+          assume G:\<open>y=x\<close>
+          show \<open>succ(y) \<in> succ(x) \<or>
+    succ(y) = succ(x) \<or>
+    succ(x) \<in> succ(y)\<close>
+            by (rule disjI2, rule disjI1, rule subst[OF G], rule refl)
+        next
+          assume G:\<open>y \<in> x\<close>
+          have R:\<open>succ(y) \<in> succ(x)\<close>
+            by (rule mp[OF bspec[OF le_succ K] G])
+          show \<open>succ(y) \<in> succ(x) \<or>
+           succ(y) = succ(x) \<or>
+           succ(x) \<in> succ(y)\<close>
+            by(rule disjI1, rule R)
+        qed
+      next
+        assume W:\<open>y = succ(x) \<or> succ(x) \<in> y\<close>
+        show \<open>succ(y) \<in> succ(x) \<or>
+              succ(y) = succ(x) \<or>
+              succ(x) \<in> succ(y)\<close>
+        proof(rule disjE[OF W])
+          assume W:\<open>y=succ(x)\<close>
+          show \<open>succ(y) \<in> succ(x) \<or>
+              succ(y) = succ(x) \<or>
+              succ(x) \<in> succ(y)\<close>
+            by (rule disjI2, rule disjI2, rule subst[OF W], rule succI1)
+        next
+          assume W:\<open>succ(x)\<in>y\<close>
+          show \<open>succ(y) \<in> succ(x) \<or>
+              succ(y) = succ(x) \<or>
+              succ(x) \<in> succ(y)\<close>
+            by (rule disjI2, rule disjI2, rule succI2[OF W])
+        qed
+      qed
+    qed
+  qed
+qed
+
+lemma tgb:
+  assumes knat: \<open>k\<in>nat\<close>
+  assumes D: \<open>t \<in> k \<rightarrow> A\<close>
+  shows  \<open>t \<in> Pow(nat \<times> A)\<close>
+proof -
+  from D
+  have q:\<open>t\<in>{t\<in>Pow(Sigma(k,%_.A)). k\<subseteq>domain(t) & function(t)}\<close>
+    by(unfold Pi_def)
+  have J:\<open>t \<in> Pow(k \<times> A)\<close>
+    by (rule CollectD1[OF q])
+  have G:\<open>k \<times> A \<subseteq> nat \<times> A\<close>
+  proof(rule func.Sigma_mono)
+    from knat
+    show \<open>k\<subseteq>nat\<close>
+      by (rule QUniv.naturals_subset_nat)
+  next
+    show \<open>\<And>x. x \<in> k \<Longrightarrow> A \<subseteq> A\<close>
+      by auto
+  qed
+  show \<open>t \<in> Pow(nat \<times> A)\<close>
+    by (rule subsetD, rule func.Pow_mono[OF G], rule J)
+qed
+
+section \<open>Compatible set\<close>
+text \<open>Union of compatible set of functions is a function.\<close>
+
+definition compat :: \<open>[i,i]\<Rightarrow>o\<close>
+  where "compat(f1,f2) == \<forall>x.\<forall>y1.\<forall>y2.\<langle>x,y1\<rangle> \<in> f1 \<and> \<langle>x,y2\<rangle> \<in> f2 \<longrightarrow> y1=y2"
+
+lemma compatI [intro]:
+  assumes H:\<open>\<And>x y1 y2.\<lbrakk>\<langle>x,y1\<rangle> \<in> f1; \<langle>x,y2\<rangle> \<in> f2\<rbrakk>\<Longrightarrow>y1=y2\<close>
+  shows \<open>compat(f1,f2)\<close>
+proof(unfold compat_def)
+  show \<open>\<forall>x y1 y2. \<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2 \<longrightarrow> y1 = y2\<close>
+  proof(rule allI | rule impI)+
+    fix x y1 y2
+    assume K:\<open>\<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2\<close>
+    have K1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close> by (rule conjunct1[OF K])
+    have K2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close> by (rule conjunct2[OF K])
+    show \<open>y1 = y2\<close> by (rule H[OF K1 K2])
+  qed
+qed
+
+lemma compatD:
+  assumes H: \<open>compat(f1,f2)\<close>
+  shows \<open>\<And>x y1 y2.\<lbrakk>\<langle>x,y1\<rangle> \<in> f1; \<langle>x,y2\<rangle> \<in> f2\<rbrakk>\<Longrightarrow>y1=y2\<close>
+proof -
+  fix x y1 y2
+  assume Q1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
+  assume Q2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close>
+  from H have H:\<open>\<forall>x y1 y2. \<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2 \<longrightarrow> y1 = y2\<close>
+    by (unfold compat_def)
+  show \<open>y1=y2\<close>
+  proof(rule mp[OF spec[OF spec[OF spec[OF H]]]])
+    show \<open>\<langle>x, y1\<rangle> \<in> f1 \<and> \<langle>x, y2\<rangle> \<in> f2\<close>
+      by(rule conjI[OF Q1 Q2])
+  qed
+qed
+
+lemma compatE:
+  assumes H: \<open>compat(f1,f2)\<close>
+  and W:\<open>(\<And>x y1 y2.\<lbrakk>\<langle>x,y1\<rangle> \<in> f1; \<langle>x,y2\<rangle> \<in> f2\<rbrakk>\<Longrightarrow>y1=y2) \<Longrightarrow> E\<close>
+shows \<open>E\<close>
+  by (rule W, rule compatD[OF H], assumption+)
+
+
+definition compatset :: \<open>i\<Rightarrow>o\<close>
+  where "compatset(S) == \<forall>f1\<in>S.\<forall>f2\<in>S. compat(f1,f2)"
+
+lemma compatsetI [intro] :
+  assumes 1:\<open>\<And>f1 f2. \<lbrakk>f1\<in>S;f2\<in>S\<rbrakk> \<Longrightarrow> compat(f1,f2)\<close>
+  shows \<open>compatset(S)\<close>
+  by (unfold compatset_def, rule ballI, rule ballI, rule 1, assumption+)
+
+lemma compatsetD:
+  assumes H: \<open>compatset(S)\<close>
+  shows \<open>\<And>f1 f2.\<lbrakk>f1\<in>S; f2\<in>S\<rbrakk>\<Longrightarrow>compat(f1,f2)\<close>
+proof -
+  fix f1 f2
+  assume H1:\<open>f1\<in>S\<close>
+  assume H2:\<open>f2\<in>S\<close>
+  from H have H:\<open>\<forall>f1\<in>S.\<forall>f2\<in>S. compat(f1,f2)\<close>
+    by (unfold compatset_def)
+  show \<open>compat(f1,f2)\<close>
+    by (rule bspec[OF bspec[OF H H1] H2])
+qed
+
+lemma compatsetE:
+  assumes H: \<open>compatset(S)\<close>
+  and W:\<open>(\<And>f1 f2.\<lbrakk>f1\<in>S; f2\<in>S\<rbrakk>\<Longrightarrow>compat(f1,f2)) \<Longrightarrow> E\<close>
+shows \<open>E\<close>
+  by (rule W, rule compatsetD[OF H], assumption+)
+
+theorem upairI1 : \<open>a \<in> {a, b}\<close>
+proof
+  assume \<open>a \<notin> {b}\<close>
+  show \<open>a = a\<close> by (rule refl)
+qed
+
+theorem upairI2 : \<open>b \<in> {a, b}\<close>
+proof
+  assume H:\<open>b \<notin> {b}\<close>
+  have Y:\<open>b \<in> {b}\<close> by (rule upair.singletonI)
+  show \<open>b = a\<close> by (rule notE[OF H Y])
+qed
+
+theorem sinup : \<open>{x} \<in> \<langle>x, xa\<rangle>\<close>
+proof (unfold Pair_def)
+  show \<open>{x} \<in> {{x, x}, {x, xa}}\<close>
+  proof (rule IFOL.subst)
+    show \<open>{x} \<in> {{x},{x,xa}}\<close>
+      by (rule upairI1)
+  next
+    show \<open>{{x}, {x, xa}} = {{x, x}, {x, xa}}\<close>
+      by blast
+  qed
+qed
+
+theorem compatsetunionfun :
+  fixes S
+  assumes H0:\<open>compatset(S)\<close>
+  shows \<open>function(\<Union>S)\<close>
+proof(unfold function_def)
+  show \<open> \<forall>x y1. \<langle>x, y1\<rangle> \<in> \<Union>S \<longrightarrow>
+          (\<forall>y2. \<langle>x, y2\<rangle> \<in> \<Union>S \<longrightarrow> y1 = y2)\<close>
+  proof(rule allI, rule allI, rule impI, rule allI, rule impI)
+    fix x y1 y2
+    assume F1:\<open>\<langle>x, y1\<rangle> \<in> \<Union>S\<close>
+    assume F2:\<open>\<langle>x, y2\<rangle> \<in> \<Union>S\<close>
+    show \<open>y1=y2\<close>
+    proof(rule UnionE[OF F1], rule UnionE[OF F2])
+      fix f1 f2
+      assume J1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
+      assume J2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close>
+      assume K1:\<open>f1 \<in> S\<close>
+      assume K2:\<open>f2 \<in> S\<close>
+      have R:\<open>compat(f1,f2)\<close>
+        by (rule compatsetD[OF H0 K1 K2])
+      show \<open>y1=y2\<close>
+        by(rule compatD[OF R J1 J2])
+    qed
+  qed
+qed
+
+theorem mkel :
+  assumes 1:\<open>A\<close>
+  assumes 2:\<open>A\<Longrightarrow>B\<close>
+  shows \<open>B\<close>
+  by (rule 2, rule 1)
+
+theorem valofunion :
+  fixes S
+  assumes H0:\<open>compatset(S)\<close>
+  assumes W:\<open>f\<in>S\<close>
+  assumes Q:\<open>f:A\<rightarrow>B\<close>
+  assumes T:\<open>a\<in>A\<close>
+  assumes P:\<open>f ` a = v\<close>
+  shows N:\<open>(\<Union>S)`a = v\<close>
+proof -
+  have K:\<open>\<langle>a, v\<rangle> \<in> f\<close>
+    by (rule apparg[OF Q P T])
+  show N:\<open>(\<Union>S)`a = v\<close>
+  proof(rule function_apply_equality)
+    show \<open>function(\<Union>S)\<close>
+      by(rule compatsetunionfun[OF H0])
+  next
+    show \<open>\<langle>a, v\<rangle> \<in> \<Union>S\<close>
+      by(rule UnionI[OF W K ])
+  qed
+qed
+
+section "Partial computation"
+
+definition satpc :: \<open>[i,i,i] \<Rightarrow> o \<close>
+  where \<open>satpc(t,\<alpha>,g) == \<forall>n \<in> \<alpha> . t`succ(n) = g ` <t`n, n>\<close>
+
+text \<open>$m$-step computation based on $a$ and $g$\<close>
+definition partcomp :: \<open>[i,i,i,i,i]\<Rightarrow>o\<close>
+  where \<open>partcomp(A,t,m,a,g) == (t:succ(m)\<rightarrow>A) \<and> (t`0=a) \<and> satpc(t,m,g)\<close>
+
+lemma partcompI [intro]:
+  assumes H1:\<open>(t:succ(m)\<rightarrow>A)\<close>
+  assumes H2:\<open>(t`0=a)\<close>
+  assumes H3:\<open>satpc(t,m,g)\<close>
+  shows \<open>partcomp(A,t,m,a,g)\<close>
+proof (unfold partcomp_def, auto)
+  show \<open>t \<in> succ(m) \<rightarrow> A\<close> by (rule H1)
+  show \<open>(t`0=a)\<close> by (rule H2)
+  show \<open>satpc(t,m,g)\<close> by (rule H3)
+qed
+
+lemma partcompD1: \<open>partcomp(A,t,m,a,g) \<Longrightarrow> t \<in> succ(m) \<rightarrow> A\<close>
+  by (unfold partcomp_def, auto)
+
+lemma partcompD2: \<open>partcomp(A,t,m,a,g) \<Longrightarrow> (t`0=a)\<close>
+ by (unfold partcomp_def, auto)
+
+lemma partcompD3: \<open>partcomp(A,t,m,a,g) \<Longrightarrow> satpc(t,m,g)\<close>
+  by (unfold partcomp_def, auto)
+
+lemma partcompE [elim] :
+  assumes 1:\<open>partcomp(A,t,m,a,g)\<close>
+    and 2:\<open>\<lbrakk>(t:succ(m)\<rightarrow>A) ; (t`0=a) ; satpc(t,m,g)\<rbrakk> \<Longrightarrow> E\<close>
+  shows \<open>E\<close>
+  by (rule 2, rule partcompD1[OF 1], rule partcompD2[OF 1], rule partcompD3[OF 1])
+
+text \<open>If we add ordered pair in the middle of partial computation then
+it will not change.\<close>
+lemma addmiddle:
+(*  fixes  t m a g*)
+  assumes mnat:\<open>m\<in>nat\<close>
+  assumes F:\<open>partcomp(A,t,m,a,g)\<close>
+  assumes xinm:\<open>x\<in>m\<close>
+  shows \<open>cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t) = t\<close>
+proof(rule partcompE[OF F])
+  assume F1:\<open>t \<in> succ(m) \<rightarrow> A\<close>
+  assume F2:\<open>t ` 0 = a\<close>
+  assume F3:\<open>satpc(t, m, g)\<close>
+  from F3
+  have W:\<open>\<forall>n\<in>m. t ` succ(n) = g ` \<langle>t ` n, n\<rangle>\<close>
+    by (unfold satpc_def)
+  have U:\<open>t ` succ(x) = g ` \<langle>t ` x, x\<rangle>\<close>
+    by (rule bspec[OF W xinm])
+  have E:\<open>\<langle>succ(x), (g ` \<langle>t ` x, x\<rangle>)\<rangle> \<in> t\<close>
+  proof(rule apparg[OF F1 U])
+    show \<open>succ(x) \<in> succ(m)\<close>
+      by(rule mp[OF bspec[OF le_succ mnat] xinm])
+  qed
+  show ?thesis
+    by (rule equalities.cons_absorb[OF E])
+qed
+
+
+section \<open>Set of functions \<close>
+text \<open>It is denoted as $F$ on page 48 in "Introduction to Set Theory".\<close>
+definition pcs :: \<open>[i,i,i]\<Rightarrow>i\<close>
+  where \<open>pcs(A,a,g) == {t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close>
+
+lemma pcs_uniq :
+  assumes F1:\<open>m1\<in>nat\<close>
+  assumes F2:\<open>m2\<in>nat\<close>
+  assumes H1: \<open>partcomp(A,f1,m1,a,g)\<close>
+  assumes H2: \<open>partcomp(A,f2,m2,a,g)\<close>
+  shows \<open>\<forall>n\<in>nat. n\<in>succ(m1) \<and> n\<in>succ(m2) \<longrightarrow> f1`n = f2`n\<close>
+proof(rule partcompE[OF H1], rule partcompE[OF H2])
+  assume H11:\<open>f1 \<in> succ(m1) \<rightarrow> A\<close>
+  assume H12:\<open>f1 ` 0 = a \<close>
+  assume H13:\<open>satpc(f1, m1, g)\<close>
+  assume H21:\<open>f2 \<in> succ(m2) \<rightarrow> A\<close>
+  assume H22:\<open>f2 ` 0 = a\<close>
+  assume H23:\<open>satpc(f2, m2, g)\<close>
+  show \<open>\<forall>n\<in>nat. n\<in>succ(m1) \<and> n\<in>succ(m2) \<longrightarrow> f1`n = f2`n\<close>
+proof(rule nat_induct_bound)
+  from H12 and H22
+  show \<open>0\<in>succ(m1) \<and> 0\<in>succ(m2) \<longrightarrow> f1 ` 0 = f2 ` 0\<close>
+    by auto
+next
+  fix x
+  assume J0:\<open>x\<in>nat\<close>
+  assume J1:\<open>x \<in> succ(m1) \<and> x \<in> succ(m2) \<longrightarrow> f1 ` x = f2 ` x\<close>
+  from H13 have G1:\<open>\<forall>n \<in> m1 . f1`succ(n) = g ` <f1`n, n>\<close>
+    by (unfold satpc_def, auto)
+  from H23 have G2:\<open>\<forall>n \<in> m2 . f2`succ(n) = g ` <f2`n, n>\<close>
+    by (unfold satpc_def, auto)
+  show \<open>succ(x) \<in> succ(m1) \<and> succ(x) \<in> succ(m2) \<longrightarrow>
+        f1 ` succ(x) = f2 ` succ(x)\<close>
+  proof
+    assume K:\<open>succ(x) \<in> succ(m1) \<and> succ(x) \<in> succ(m2)\<close>
+    from K have K1:\<open>succ(x) \<in> succ(m1)\<close> by auto
+    from K have K2:\<open>succ(x) \<in> succ(m2)\<close> by auto
+    have K1':\<open>x \<in> m1\<close> by (rule mp[OF bspec[OF succ_le F1] K1])
+    have K2':\<open>x \<in> m2\<close> by (rule mp[OF bspec[OF succ_le F2] K2])
+    have U1:\<open>x\<in>succ(m1)\<close>
+      by (rule Nat.succ_in_naturalD[OF K1 Nat.nat_succI[OF F1]])
+    have U2:\<open>x\<in>succ(m2)\<close>
+      by (rule Nat.succ_in_naturalD[OF K2 Nat.nat_succI[OF F2]])
+    have Y1:\<open>f1`succ(x) = g ` <f1`x, x>\<close>
+      by (rule bspec[OF G1 K1'])
+    have Y2:\<open>f2`succ(x) = g ` <f2`x, x>\<close>
+      by (rule bspec[OF G2 K2'])
+    have \<open>f1 ` x = f2 ` x\<close>
+      by(rule mp[OF J1 conjI[OF U1 U2]])
+    then have Y:\<open>g ` <f1`x, x> = g ` <f2`x, x>\<close> by auto
+    from Y1 and Y2 and Y
+    show \<open>f1 ` succ(x) = f2 ` succ(x)\<close>
+      by auto
+  qed
+qed
+qed
+
+lemma domainsubsetfunc :
+  assumes Q:\<open>f1\<subseteq>f2\<close>
+  shows \<open>domain(f1)\<subseteq>domain(f2)\<close>
+proof
+  fix x
+  assume H:\<open>x \<in> domain(f1)\<close>
+  show \<open>x \<in> domain(f2)\<close>
+  proof(rule domainE[OF H])
+    fix y
+    assume W:\<open>\<langle>x, y\<rangle> \<in> f1\<close>
+    have \<open>\<langle>x, y\<rangle> \<in> f2\<close>
+      by(rule subsetD[OF Q W])
+    then show \<open>x \<in> domain(f2)\<close>
+      by(rule domainI)
+  qed
+qed
+
+lemma natdomfunc:
+  assumes 1:\<open>q\<in>A\<close>
+  assumes J0:\<open>f1 \<in> Pow(nat \<times> A)\<close>
+  assumes U:\<open>m1 \<in> domain(f1)\<close>
+  shows \<open>m1\<in>nat\<close>
+proof -
+  from J0 have J0 : \<open>f1 \<subseteq> nat \<times> A\<close>
+    by auto
+  have J0:\<open>domain(f1) \<subseteq> domain(nat \<times> A)\<close>
+    by(rule func.domain_mono[OF J0])
+  have F:\<open>m1 \<in> domain(nat \<times> A)\<close>
+    by(rule subsetD[OF J0 U])
+  have R:\<open>domain(nat \<times> A) = nat\<close>
+    by (rule equalities.domain_of_prod[OF 1])
+  show \<open>m1 \<in> nat\<close>
+    by(rule subst[OF R], rule F)
+qed
+
+lemma pcs_lem :
+  assumes 1:\<open>q\<in>A\<close>
+  shows \<open>compatset(pcs(A, a, g))\<close>
+proof (*(rule compatsetI)*)
+  fix f1 f2
+  assume H1:\<open>f1 \<in> pcs(A, a, g)\<close>
+  then have H1':\<open>f1 \<in> {t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close> by (unfold pcs_def)
+  hence H1'A:\<open>f1 \<in> Pow(nat*A)\<close> by auto
+  hence H1'A:\<open>f1 \<subseteq> (nat*A)\<close> by auto
+  assume H2:\<open>f2 \<in> pcs(A, a, g)\<close>
+  then have H2':\<open>f2 \<in> {t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close> by (unfold pcs_def)
+  show \<open>compat(f1, f2)\<close>
+  proof(rule compatI)
+    fix x y1 y2
+    assume P1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
+    assume P2:\<open>\<langle>x, y2\<rangle> \<in> f2\<close>
+    show \<open>y1 = y2\<close>
+    proof(rule CollectE[OF H1'], rule CollectE[OF H2'])
+      assume J0:\<open>f1 \<in> Pow(nat \<times> A)\<close>
+      assume J1:\<open>f2 \<in> Pow(nat \<times> A)\<close>
+      assume J2:\<open>\<exists>m\<in>nat. partcomp(A, f1, m, a, g)\<close>
+      assume J3:\<open>\<exists>m\<in>nat. partcomp(A, f2, m, a, g)\<close>
+      show \<open>y1 = y2\<close>
+      proof(rule bexE[OF J2], rule bexE[OF J3])
+        fix m1 m2
+        assume K1:\<open>partcomp(A, f1, m1, a, g)\<close>
+        assume K2:\<open>partcomp(A, f2, m2, a, g)\<close>
+        hence K2':\<open>(f2:succ(m2)\<rightarrow>A) \<and> (f2`0=a) \<and> satpc(f2,m2,g)\<close>
+          by (unfold partcomp_def)
+        from K1 have K1'A:\<open>(f1:succ(m1)\<rightarrow>A)\<close> by (rule partcompD1)
+        from K2' have K2'A:\<open>(f2:succ(m2)\<rightarrow>A)\<close> by auto
+        from K1'A have K1'AD:\<open>domain(f1) = succ(m1)\<close>
+          by(rule domain_of_fun)
+        from K2'A have K2'AD:\<open>domain(f2) = succ(m2)\<close>
+          by(rule domain_of_fun)
+        have L1:\<open>f1`x=y1\<close>
+          by (rule func.apply_equality[OF P1], rule K1'A)
+        have L2:\<open>f2`x=y2\<close>
+          by(rule func.apply_equality[OF P2], rule K2'A)
+        have m1nat:\<open>m1\<in>nat\<close>
+        proof(rule natdomfunc[OF 1 J0])
+          show \<open>m1 \<in> domain(f1)\<close>
+            by (rule ssubst[OF K1'AD], auto)
+        qed
+        have m2nat:\<open>m2\<in>nat\<close>
+        proof(rule natdomfunc[OF 1 J1])
+          show \<open>m2 \<in> domain(f2)\<close>
+            by (rule ssubst[OF K2'AD], auto)
+        qed
+        have G1:\<open>\<langle>x, y1\<rangle> \<in> (nat*A)\<close>
+          by(rule subsetD[OF H1'A P1])
+        have KK:\<open>x\<in>nat\<close>
+          by(rule SigmaE[OF G1], auto)
+        (*x is in the domain of f1  i.e. succ(m1)
+so we can have both  x \<in> ?m1.2 \<and> x \<in> ?m2.2
+how to prove that m1 \<in> nat ? from J0 !  f1 is a subset of nat \<times> A*)
+        have W:\<open>f1`x=f2`x\<close>
+        proof(rule mp[OF bspec[OF pcs_uniq KK] ])
+          show \<open>m1 \<in> nat\<close>
+            by (rule m1nat)
+        next
+          show \<open>m2 \<in> nat\<close>
+            by (rule m2nat)
+        next
+          show \<open>partcomp(A, f1, m1, a, g)\<close>
+            by (rule K1)
+        next
+          show \<open>partcomp(A, f2, m2, a, g)\<close>
+            by (rule K2)
+        next
+            (*  P1:\<open>\<langle>x, y1\<rangle> \<in> f1\<close>
+              K1'A:\<open>(f1:succ(m1)\<rightarrow>A)\<close>
+            *)
+          have U1:\<open>x \<in> succ(m1)\<close>
+            by (rule func.domain_type[OF P1 K1'A])
+          have U2:\<open>x \<in> succ(m2)\<close>
+            by (rule func.domain_type[OF P2 K2'A])
+          show \<open>x \<in> succ(m1) \<and> x \<in> succ(m2)\<close>
+            by (rule conjI[OF U1 U2])
+        qed
+        from L1 and W and L2
+        show \<open>y1 = y2\<close> by auto
+      qed
+    qed
+  qed
+qed
+
+theorem fuissu : \<open>f \<in> X -> Y \<Longrightarrow> f \<subseteq> X\<times>Y\<close>
+proof
+  fix w
+  assume H1 : \<open>f \<in> X -> Y\<close>
+  then have J1:\<open>f \<in> {q\<in>Pow(Sigma(X,\<lambda>_.Y)). X\<subseteq>domain(q) & function(q)}\<close>
+    by (unfold Pi_def)
+  then have J2:\<open>f \<in> Pow(Sigma(X,\<lambda>_.Y))\<close>
+    by auto
+  then have J3:\<open>f \<subseteq> Sigma(X,\<lambda>_.Y)\<close>
+    by auto
+  assume H2 : \<open>w \<in> f\<close>
+  from J3 and H2 have \<open>w\<in>Sigma(X,\<lambda>_.Y)\<close>
+    by auto
+  then have J4:\<open>w \<in> (\<Union>x\<in>X. (\<Union>y\<in>Y. {\<langle>x,y\<rangle>}))\<close>
+    by auto
+  show \<open>w \<in> X*Y\<close>
+  proof (rule UN_E[OF J4])
+    fix x
+    assume V1:\<open>x \<in> X\<close>
+    assume V2:\<open>w \<in> (\<Union>y\<in>Y. {\<langle>x, y\<rangle>})\<close>
+    show \<open>w \<in> X \<times> Y\<close>
+    proof (rule UN_E[OF V2])
+      fix y
+      assume V3:\<open>y \<in> Y\<close>
+      assume V4:\<open>w \<in> {\<langle>x, y\<rangle>}\<close>
+      then have V4:\<open>w = \<langle>x, y\<rangle>\<close>
+        by auto
+      have v5:\<open>\<langle>x, y\<rangle> \<in> Sigma(X,\<lambda>_.Y)\<close>
+      proof(rule SigmaI)
+        show \<open>x \<in> X\<close> by (rule V1)
+      next
+        show \<open>y \<in> Y\<close> by (rule V3)
+      qed
+      then have V5:\<open>\<langle>x, y\<rangle> \<in> X*Y\<close>
+        by auto
+      from V4 and V5 show \<open>w \<in> X \<times> Y\<close> by auto
+    qed
+  qed
+qed
+
+theorem recuniq :
+  fixes f
+  assumes H0:\<open>f \<in> nat -> A \<and> f ` 0 = a \<and> satpc(f, nat, g)\<close>
+  fixes t
+  assumes H1:\<open>t \<in> nat -> A \<and> t ` 0 = a \<and> satpc(t, nat, g)\<close>
+  fixes x
+  shows \<open>f=t\<close>
+proof -
+  from H0 have H02:\<open>\<forall>n \<in> nat. f`succ(n) = g ` <(f`n), n>\<close> by (unfold satpc_def, auto)
+  from H0 have H01:\<open>f ` 0 = a\<close> by auto
+  from H0 have H00:\<open>f \<in> nat -> A\<close> by auto
+  from H1 have H12:\<open>\<forall>n \<in> nat. t`succ(n) = g ` <(t`n), n>\<close> by (unfold satpc_def, auto)
+  from H1 have H11:\<open>t ` 0 = a\<close> by auto
+  from H1 have H10:\<open>t \<in> nat -> A\<close> by auto
+  show \<open>f=t\<close>
+  proof (rule fun_extension[OF H00 H10])
+    fix x
+    assume K: \<open>x \<in> nat\<close>
+    show \<open>(f ` x) = (t ` x)\<close>
+    proof(rule nat_induct[of x])
+      show \<open>x \<in> nat\<close> by (rule K)
+    next
+      from H01 and H11 show \<open>f ` 0 = t ` 0\<close>
+        by auto
+    next
+      fix x
+      assume A:\<open>x\<in>nat\<close>
+      assume B:\<open>f`x = t`x\<close>
+      show \<open>f ` succ(x) = t ` succ(x)\<close>
+      proof -
+        from H02 and A have H02':\<open>f`succ(x) = g ` <(f`x), x>\<close>
+          by (rule bspec)
+        from H12 and A have H12':\<open>t`succ(x) = g ` <(t`x), x>\<close>
+          by (rule bspec)
+        from B and H12' have H12'':\<open>t`succ(x) = g ` <(f`x), x>\<close> by auto
+        from H12'' and H02' show \<open>f ` succ(x) = t ` succ(x)\<close> by auto
+      qed
+    qed
+  qed
+qed
+
+section \<open>Lemmas for recursion theorem\<close>
+
+locale recthm =
+  fixes A :: "i"
+    and a :: "i"
+    and g :: "i"
+  assumes hyp1 : \<open>a \<in> A\<close>
+    and hyp2 : \<open>g : ((A*nat)\<rightarrow>A)\<close>
+begin
+
+lemma l3:\<open>function(\<Union>pcs(A, a, g))\<close>
+  by (rule compatsetunionfun, rule pcs_lem, rule hyp1)
+
+lemma l1 : \<open>\<Union>pcs(A, a, g) \<subseteq> nat \<times> A\<close>
+proof
+  fix x
+  assume H:\<open>x \<in> \<Union>pcs(A, a, g)\<close>
+  hence  H:\<open>x \<in> \<Union>{t\<in>Pow(nat*A). \<exists>m\<in>nat. partcomp(A,t,m,a,g)}\<close>
+    by (unfold pcs_def)
+  show \<open>x \<in> nat \<times> A\<close>
+  proof(rule UnionE[OF H])
+    fix B
+    assume J1:\<open>x\<in>B\<close>
+    assume J2:\<open>B \<in> {t \<in> Pow(nat \<times> A) .
+            \<exists>m\<in>nat. partcomp(A, t, m, a, g)}\<close>
+    hence J2:\<open>B \<in> Pow(nat \<times> A)\<close> by auto
+    hence J2:\<open>B \<subseteq> nat \<times> A\<close> by auto
+    from J1 and J2 show \<open>x \<in> nat \<times> A\<close>
+      by auto
+  qed
+qed
+
+lemma le1:
+  assumes H:\<open>x\<in>1\<close>
+  shows \<open>x=0\<close>
+proof
+  show \<open>x \<subseteq> 0\<close>
+  proof
+    fix z
+    assume J:\<open>z\<in>x\<close>
+    show \<open>z\<in>0\<close>
+    proof(rule succE[OF H])
+      assume J:\<open>x\<in>0\<close>
+      show \<open>z\<in>0\<close>
+        by (rule notE[OF not_mem_empty J])
+    next
+      assume K:\<open>x=0\<close>
+      from J and K show \<open>z\<in>0\<close>
+        by auto
+    qed
+  qed
+next
+  show \<open>0 \<subseteq> x\<close> by auto
+qed
+
+lemma lsinglfun : \<open>function({\<langle>0, a\<rangle>})\<close>
+proof(unfold function_def)
+  show \<open> \<forall>x y. \<langle>x, y\<rangle> \<in> {\<langle>0, a\<rangle>} \<longrightarrow>
+          (\<forall>y'. \<langle>x, y'\<rangle> \<in> {\<langle>0, a\<rangle>} \<longrightarrow>
+                y = y')\<close>
+  proof(rule allI,rule allI,rule impI,rule allI,rule impI)
+    fix x y y'
+    assume H0:\<open>\<langle>x, y\<rangle> \<in> {\<langle>0, a\<rangle>}\<close>
+    assume H1:\<open>\<langle>x, y'\<rangle> \<in> {\<langle>0, a\<rangle>}\<close>
+    show \<open>y = y'\<close>
+    proof(rule upair.singletonE[OF H0],rule upair.singletonE[OF H1])
+      assume H0:\<open>\<langle>x, y\<rangle> = \<langle>0, a\<rangle>\<close>
+      assume H1:\<open>\<langle>x, y'\<rangle> = \<langle>0, a\<rangle>\<close>
+      from H0 and H1 have H:\<open>\<langle>x, y\<rangle> = \<langle>x, y'\<rangle>\<close> by auto
+      then show \<open>y = y'\<close> by auto
+    qed
+  qed
+qed
+
+lemma singlsatpc:\<open>satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
+proof(unfold satpc_def)
+  show \<open>\<forall>n\<in>0. {\<langle>0, a\<rangle>} ` succ(n) =
+           g ` \<langle>{\<langle>0, a\<rangle>} ` n, n\<rangle>\<close>
+    by auto
+qed
+
+lemma zerostep :
+  shows \<open>partcomp(A, {\<langle>0, a\<rangle>}, 0, a, g)\<close>
+proof(unfold partcomp_def)
+  show \<open>{\<langle>0, a\<rangle>} \<in> 1 -> A \<and> {\<langle>0, a\<rangle>} ` 0 = a \<and> satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
+  proof
+    show \<open>{\<langle>0, a\<rangle>} \<in> 1 -> A\<close>
+    proof (unfold Pi_def)
+      show \<open>{\<langle>0, a\<rangle>} \<in> {f \<in> Pow(1 \<times> A) . 1 \<subseteq> domain(f) \<and> function(f)}\<close>
+      proof
+        show \<open>{\<langle>0, a\<rangle>} \<in> Pow(1 \<times> A)\<close>
+        proof(rule PowI, rule equalities.singleton_subsetI)
+          show \<open>\<langle>0, a\<rangle> \<in> 1 \<times> A\<close>
+          proof
+            show \<open>0 \<in> 1\<close> by auto
+          next
+            show \<open>a \<in> A\<close> by (rule hyp1)
+          qed
+        qed
+      next
+        show \<open>1 \<subseteq> domain({\<langle>0, a\<rangle>}) \<and> function({\<langle>0, a\<rangle>})\<close>
+        proof
+          show \<open>1 \<subseteq> domain({\<langle>0, a\<rangle>})\<close>
+          proof
+            fix x
+            assume W:\<open>x\<in>1\<close>
+            from W have W:\<open>x=0\<close> by (rule le1)
+            have Y:\<open>0\<in>domain({\<langle>0, a\<rangle>})\<close>
+              by auto
+            from W and Y
+            show \<open>x\<in>domain({\<langle>0, a\<rangle>})\<close>
+              by auto
+          qed
+        next
+          show \<open>function({\<langle>0, a\<rangle>})\<close>
+            by (rule lsinglfun)
+        qed
+      qed
+    qed
+    show \<open>{\<langle>0, a\<rangle>} ` 0 = a \<and> satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
+    proof
+      show \<open>{\<langle>0, a\<rangle>} ` 0 = a\<close>
+        by (rule func.singleton_apply)
+    next
+      show \<open>satpc({\<langle>0, a\<rangle>}, 0, g)\<close>
+        by (rule singlsatpc)
+    qed
+  qed
+qed
+
+lemma zainupcs : \<open>\<langle>0, a\<rangle> \<in> \<Union>pcs(A, a, g)\<close>
+proof
+  show \<open>\<langle>0, a\<rangle> \<in> {\<langle>0, a\<rangle>}\<close>
+    by auto
+next
+  (* {\<langle>0, a\<rangle>} is a 0-step computation *)
+  show \<open>{\<langle>0, a\<rangle>} \<in> pcs(A, a, g)\<close>
+  proof(unfold pcs_def)
+    show \<open>{\<langle>0, a\<rangle>} \<in> {t \<in> Pow(nat \<times> A) . \<exists>m\<in>nat. partcomp(A, t, m, a, g)}\<close>
+    proof
+      show \<open>{\<langle>0, a\<rangle>} \<in> Pow(nat \<times> A)\<close>
+      proof(rule PowI, rule equalities.singleton_subsetI)
+        show \<open>\<langle>0, a\<rangle> \<in> nat \<times> A\<close>
+        proof
+          show \<open>0 \<in> nat\<close> by auto
+        next
+          show \<open>a \<in> A\<close> by (rule hyp1)
+        qed
+      qed
+    next
+      show \<open>\<exists>m\<in>nat. partcomp(A, {\<langle>0, a\<rangle>}, m, a, g)\<close>
+      proof
+        show \<open>partcomp(A, {\<langle>0, a\<rangle>}, 0, a, g)\<close>
+          by (rule zerostep)
+      next
+        show \<open>0 \<in> nat\<close> by auto
+      qed
+    qed
+  qed
+qed
+
+lemma l2': \<open>0 \<in> domain(\<Union>pcs(A, a, g))\<close>
+proof
+  show \<open>\<langle>0, a\<rangle> \<in> \<Union>pcs(A, a, g)\<close>
+    by (rule zainupcs)
+qed
+
+text \<open>Push an ordered pair to the end of partial computation t
+and obtain another partial computation.\<close>
+lemma shortlem :
+  assumes mnat:\<open>m\<in>nat\<close>
+  assumes F:\<open>partcomp(A,t,m,a,g)\<close>
+  shows \<open>partcomp(A,cons(\<langle>succ(m), g ` <t`m, m>\<rangle>, t),succ(m),a,g)\<close>
+proof(rule partcompE[OF F])
+  assume F1:\<open>t \<in> succ(m) \<rightarrow> A\<close>
+  assume F2:\<open>t ` 0 = a\<close>
+  assume F3:\<open>satpc(t, m, g)\<close>
+  show ?thesis (*\<open>partcomp(A,cons(\<langle>succ(m), g ` <t`m, m>\<rangle>, t),succ(m),a,g)\<close> *)
+  proof
+    have ljk:\<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> (cons(succ(m),succ(m)) \<rightarrow> A)\<close>
+    proof(rule func.fun_extend3[OF F1])
+      show \<open>succ(m) \<notin> succ(m)\<close>
+        by (rule  upair.mem_not_refl)
+      have tmA:\<open>t ` m \<in> A\<close>
+        by (rule func.apply_funtype[OF F1], auto)
+      show \<open>g ` \<langle>t ` m, m\<rangle> \<in> A\<close>
+        by(rule func.apply_funtype[OF hyp2], auto, rule tmA, rule mnat)
+    qed
+    have \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> (cons(succ(m),succ(m)) \<rightarrow> A)\<close>
+      by (rule ljk)
+    then have \<open>cons(\<langle>cons(m, m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> cons(cons(m, m), cons(m, m)) \<rightarrow> A\<close>
+      by (unfold succ_def)
+    then show \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) \<in> succ(succ(m)) \<rightarrow> A\<close>
+      by (unfold succ_def, assumption)
+    show \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` 0 = a\<close>
+    proof(rule trans, rule func.fun_extend_apply[OF F1])
+      show \<open>succ(m) \<notin> succ(m)\<close> by (rule  upair.mem_not_refl)
+      show \<open>(if 0 = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` 0) = a\<close>
+        by(rule trans, rule upair.if_not_P, auto, rule F2)
+    qed
+    show \<open>satpc(cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t), succ(m), g)\<close>
+    proof(unfold satpc_def, rule ballI)
+      fix n
+      assume Q:\<open>n \<in> succ(m)\<close>
+      show \<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` succ(n)
+= g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+      proof(rule trans, rule func.fun_extend_apply[OF F1], rule upair.mem_not_refl)
+        show \<open>(if succ(n) = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` succ(n)) =
+    g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+        proof(rule upair.succE[OF Q])
+          assume Y:\<open>n=m\<close>
+          show \<open>(if succ(n) = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` succ(n)) =
+    g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+          proof(rule trans, rule upair.if_P)
+            from Y show \<open>succ(n) = succ(m)\<close> by auto
+          next
+            have L1:\<open>t ` m = cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n\<close>
+            proof(rule sym, rule trans, rule func.fun_extend_apply[OF F1], rule upair.mem_not_refl)
+              show \<open> (if n = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` n) = t ` m\<close>
+              proof(rule trans, rule upair.if_not_P)
+                from Y show \<open>t ` n = t ` m\<close> by auto
+                show \<open>n \<noteq> succ(m)\<close>
+                proof(rule not_sym)
+                  show \<open>succ(m) \<noteq> n\<close>
+                    by(rule subst, rule sym, rule Y, rule upair.succ_neq_self)
+                qed
+              qed
+            qed
+            from Y
+            have L2:\<open>m = n\<close>
+              by auto
+            have L:\<open> \<langle>t ` m, m\<rangle> = \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+              by(rule subst_context2[OF L1 L2])
+            show \<open> g ` \<langle>t ` m, m\<rangle> = g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+              by(rule subst_context[OF L])
+          qed
+        next
+          assume Y:\<open>n \<in> m\<close>
+          show \<open>(if succ(n) = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` succ(n)) =
+                g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+          proof(rule trans, rule upair.if_not_P)
+            show \<open>succ(n) \<noteq> succ(m)\<close>
+              by(rule contrapos, rule upair.mem_imp_not_eq, rule Y, rule upair.succ_inject, assumption)
+          next
+            have X:\<open>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n = t ` n\<close>
+            proof(rule trans, rule func.fun_extend_apply[OF F1], rule upair.mem_not_refl)
+              show \<open>(if n = succ(m) then g ` \<langle>t ` m, m\<rangle> else t ` n) = t ` n\<close>
+              proof(rule upair.if_not_P)
+                show \<open>n \<noteq> succ(m)\<close>
+                proof(rule contrapos)
+                  assume q:"n=succ(m)"
+                  from q and Y have M:\<open>succ(m)\<in>m\<close>
+                    by auto
+                  show \<open>m\<in>m\<close>
+                    by(rule Nat.succ_in_naturalD[OF M mnat])
+                next
+                  show \<open>m \<notin> m\<close> by (rule  upair.mem_not_refl)
+                qed
+              qed
+            qed
+            from F3
+            have W:\<open>\<forall>n\<in>m. t ` succ(n) = g ` \<langle>t ` n, n\<rangle>\<close>
+              by (unfold satpc_def)
+            have U:\<open>t ` succ(n) = g ` \<langle>t ` n, n\<rangle>\<close>
+              by (rule bspec[OF W Y])
+            show \<open>t ` succ(n) = g ` \<langle>cons(\<langle>succ(m), g ` \<langle>t ` m, m\<rangle>\<rangle>, t) ` n, n\<rangle>\<close>
+              by (rule trans, rule U, rule sym, rule subst_context[OF X])
+          qed
+        qed
+      qed
+    qed
+  qed
+qed
+
+lemma l2:\<open>nat \<subseteq> domain(\<Union>pcs(A, a, g))\<close>
+proof
+  fix x
+  assume G:\<open>x\<in>nat\<close>
+  show \<open>x \<in> domain(\<Union>pcs(A, a, g))\<close>
+  proof(rule nat_induct[of x])
+    show \<open>x\<in>nat\<close> by (rule G)
+  next
+    fix x
+    assume Q1:\<open>x\<in>nat\<close>
+    assume Q2:\<open>x\<in>domain(\<Union>pcs(A, a, g))\<close>
+    show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
+    proof(rule domainE[OF Q2])
+      fix y
+      assume W1:\<open>\<langle>x, y\<rangle> \<in> (\<Union>pcs(A, a, g))\<close>
+      show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
+      proof(rule UnionE[OF W1])
+        fix t
+        assume E1:\<open>\<langle>x, y\<rangle> \<in> t\<close>
+        assume E2:\<open>t \<in> pcs(A, a, g)\<close>
+        hence E2:\<open>t\<in>{t\<in>Pow(nat*A). \<exists>m \<in> nat. partcomp(A,t,m,a,g)}\<close>
+          by(unfold pcs_def)
+        have E21:\<open>t\<in>Pow(nat*A)\<close>
+          by(rule CollectD1[OF E2])
+        have E22m:\<open>\<exists>m\<in>nat. partcomp(A,t,m,a,g)\<close>
+          by(rule CollectD2[OF E2])
+        show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
+        proof(rule bexE[OF E22m])
+          fix m
+          assume mnat:\<open>m\<in>nat\<close>
+          assume E22P:\<open>partcomp(A,t,m,a,g)\<close>
+          hence E22:\<open>((t:succ(m)\<rightarrow>A) \<and> (t`0=a)) \<and> satpc(t,m,g)\<close>
+            by(unfold partcomp_def, auto)
+          hence E223:\<open>satpc(t,m,g)\<close> by auto
+          hence E223:\<open>\<forall>n \<in> m . t`succ(n) = g ` <t`n, n>\<close>
+            by(unfold satpc_def, auto)
+          from E22 have E221:\<open>(t:succ(m)\<rightarrow>A)\<close>
+            by auto
+          from E221 have domt:\<open>domain(t) = succ(m)\<close>
+            by (rule func.domain_of_fun)
+          from E1 have xind:\<open>x \<in> domain(t)\<close>
+            by (rule equalities.domainI)
+          from xind and domt have xinsm:\<open>x \<in> succ(m)\<close>
+            by auto
+          show \<open>succ(x)\<in>domain(\<Union>pcs(A, a, g))\<close>
+          proof
+        (*proof(rule exE[OF E22])*)
+            show \<open> \<langle>succ(x), g ` <t`x, x>\<rangle> \<in> (\<Union>pcs(A, a, g))\<close> (*?*)
+            proof
+             (*t\<union>{\<langle>succ(x), g ` <t`x, x>\<rangle>}*)
+              show \<open>cons(\<langle>succ(x), g ` <t`x, x>\<rangle>, t) \<in> pcs(A, a, g)\<close>
+              proof(unfold pcs_def, rule CollectI)
+                from E21
+                have L1:\<open>t \<subseteq> nat \<times> A\<close>
+                  by auto
+                from Q1 have J1:\<open>succ(x)\<in>nat\<close>
+                  by auto(*Nat.nat_succI*)
+                have txA: \<open>t ` x \<in> A\<close>
+                  by (rule func.apply_type[OF E221 xinsm])
+                from txA and Q1 have txx:\<open>\<langle>t ` x, x\<rangle> \<in> A \<times> nat\<close>
+                  by auto
+                have secp: \<open>g ` \<langle>t ` x, x\<rangle> \<in> A\<close>
+                  by(rule func.apply_type[OF hyp2 txx])
+                from J1 and secp
+                have L2:\<open>\<langle>succ(x),g ` \<langle>t ` x, x\<rangle>\<rangle> \<in> nat \<times> A\<close>
+                  by auto
+                show \<open> cons(\<langle>succ(x),g ` \<langle>t ` x, x\<rangle>\<rangle>,t) \<in> Pow(nat \<times> A)\<close>
+                proof(rule PowI)
+                  show \<open> cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t) \<subseteq> nat \<times> A\<close>
+                  proof
+                    show \<open>\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle> \<in> nat \<times> A \<and> t \<subseteq> nat \<times> A\<close>
+                      by (rule conjI[OF L2 L1])
+                  qed
+                qed
+              next
+                show \<open>\<exists>m \<in> nat. partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), m, a, g)\<close>
+                proof(rule succE[OF xinsm])
+                  assume xeqm:\<open>x=m\<close>
+                  show \<open>\<exists>m \<in> nat. partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), m, a, g)\<close>
+                  proof
+                    show \<open>partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), succ(x), a, g)\<close>
+                    proof(rule shortlem[OF Q1])
+                      show \<open>partcomp(A, t, x, a, g)\<close>
+                      proof(rule subst[of m x], rule sym, rule xeqm)
+                        show \<open>partcomp(A, t, m, a, g)\<close>
+                          by (rule E22P)
+                      qed
+                    qed
+                  next
+                    from Q1 show \<open>succ(x) \<in> nat\<close> by auto
+                  qed
+                next
+                  assume xinm:\<open>x\<in>m\<close>
+                  have lmm:\<open>cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t) = t\<close>
+                    by (rule addmiddle[OF mnat E22P xinm])
+                  show \<open>\<exists>m\<in>nat. partcomp(A, cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t), m, a, g)\<close>
+                    by(rule subst[of t], rule sym, rule lmm, rule E22m)
+                qed
+              qed
+            next
+              show \<open>\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle> \<in> cons(\<langle>succ(x), g ` \<langle>t ` x, x\<rangle>\<rangle>, t)\<close>
+                by auto
+            qed
+          qed
+        qed
+      qed
+    qed
+  next
+    show \<open>0 \<in> domain(\<Union>pcs(A, a, g))\<close>
+      by (rule l2')
+  qed
+qed
+
+lemma useful : \<open>\<forall>m\<in>nat. \<exists>t. partcomp(A,t,m,a,g)\<close>
+proof(rule nat_induct_bound)
+  show \<open>\<exists>t. partcomp(A, t, 0, a, g)\<close>
+  proof
+    show \<open>partcomp(A, {\<langle>0, a\<rangle>}, 0, a, g)\<close>
+      by (rule zerostep)
+  qed
+next
+  fix m
+  assume mnat:\<open>m\<in>nat\<close>
+  assume G:\<open>\<exists>t. partcomp(A,t,m,a,g)\<close>
+  show \<open>\<exists>t. partcomp(A,t,succ(m),a,g)\<close>
+  proof(rule exE[OF G])
+    fix t
+    assume G:\<open>partcomp(A,t,m,a,g)\<close>
+    show \<open>\<exists>t. partcomp(A,t,succ(m),a,g)\<close>
+    proof
+      show \<open>partcomp(A,cons(\<langle>succ(m), g ` <t`m, m>\<rangle>, t),succ(m),a,g)\<close>
+        by(rule shortlem[OF mnat G])
+    qed
+  qed
+qed
+
+lemma l4 : \<open>(\<Union>pcs(A,a,g)) \<in> nat -> A\<close>
+proof(unfold Pi_def)
+  show \<open> \<Union>pcs(A, a, g) \<in> {f \<in> Pow(nat \<times> A) . nat \<subseteq> domain(f) \<and> function(f)}\<close>
+  proof
+    show \<open>\<Union>pcs(A, a, g) \<in> Pow(nat \<times> A)\<close>
+    proof
+      show \<open>\<Union>pcs(A, a, g) \<subseteq> nat \<times> A\<close>
+        by (rule l1)
+    qed
+  next
+    show \<open>nat \<subseteq> domain(\<Union>pcs(A, a, g)) \<and> function(\<Union>pcs(A, a, g))\<close>
+    proof
+      show \<open>nat \<subseteq> domain(\<Union>pcs(A, a, g))\<close>
+        by (rule l2)
+    next
+      show \<open>function(\<Union>pcs(A, a, g))\<close>
+        by (rule l3)
+    qed
+  qed
+qed
+
+lemma l5: \<open>(\<Union>pcs(A, a, g)) ` 0 = a\<close>
+proof(rule func.function_apply_equality)
+  show \<open>function(\<Union>pcs(A, a, g))\<close>
+    by (rule l3)
+next
+  show \<open>\<langle>0, a\<rangle> \<in> \<Union>pcs(A, a, g)\<close>
+    by (rule zainupcs)
+qed
+
+lemma ballE2:
+  assumes \<open>\<forall>x\<in>AA. P(x)\<close>
+  assumes \<open>x\<in>AA\<close>
+  assumes \<open>P(x) ==> Q\<close>
+  shows Q
+  by (rule assms(3), rule bspec, rule assms(1), rule assms(2))
+
+text \<open> Recall that
+  \<open>satpc(t,\<alpha>,g) == \<forall>n \<in> \<alpha> . t`succ(n) = g ` <t`n, n>\<close>
+  \<open>partcomp(A,t,m,a,g) == (t:succ(m)\<rightarrow>A) \<and> (t`0=a) \<and> satpc(t,m,g)\<close>
+  \<open>pcs(A,a,g) == {t\<in>Pow(nat*A). \<exists>m. partcomp(A,t,m,a,g)}\<close>
+\<close>
+
+lemma l6new: \<open>satpc(\<Union>pcs(A, a, g), nat, g)\<close>
+proof (unfold satpc_def, rule ballI)
+  fix n
+  assume nnat:\<open>n\<in>nat\<close>
+  hence snnat:\<open>succ(n)\<in>nat\<close> by auto
+  (* l2:\<open>nat \<subseteq> domain(\<Union>pcs(A, a, g))\<close> *)
+  show \<open>(\<Union>pcs(A, a, g)) ` succ(n) = g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle>\<close>
+  proof(rule ballE2[OF useful snnat], erule exE)
+    fix t
+    assume Y:\<open>partcomp(A, t, succ(n), a, g)\<close>
+    show \<open>(\<Union>pcs(A, a, g)) ` succ(n) = g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle>\<close>
+    proof(rule partcompE[OF Y])
+      assume Y1:\<open>t \<in> succ(succ(n)) \<rightarrow> A\<close>
+      assume Y2:\<open>t ` 0 = a\<close>
+      assume Y3:\<open>satpc(t, succ(n), g)\<close>
+      hence Y3:\<open>\<forall>x \<in> succ(n) . t`succ(x) = g ` <t`x, x>\<close>
+        by (unfold satpc_def)
+      hence Y3:\<open>t`succ(n) = g ` <t`n, n>\<close>
+        by (rule bspec, auto)
+      have e1:\<open>(\<Union>pcs(A, a, g)) ` succ(n) = t ` succ(n)\<close>
+      proof(rule valofunion, rule pcs_lem, rule hyp1)
+        show \<open>t \<in> pcs(A, a, g)\<close>
+        proof(unfold pcs_def, rule CollectI)
+          show \<open>t \<in> Pow(nat \<times> A)\<close>
+            proof(rule tgb)
+            show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
+          next
+            from snnat
+            show \<open>succ(succ(n)) \<in> nat\<close> by auto
+          qed
+        next
+          show \<open>\<exists>m\<in>nat. partcomp(A, t, m, a, g)\<close>
+            by(rule bexI, rule Y, rule snnat)
+        qed
+      next
+        show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
+      next
+        show \<open>succ(n) \<in> succ(succ(n))\<close> by auto
+      next
+        show \<open>t ` succ(n) = t ` succ(n)\<close> by (rule refl)
+      qed
+      have e2:\<open>(\<Union>pcs(A, a, g)) ` n = t ` n\<close>
+      proof(rule valofunion, rule pcs_lem, rule hyp1)
+        show \<open>t \<in> pcs(A, a, g)\<close>
+        proof(unfold pcs_def, rule CollectI)
+          show \<open>t \<in> Pow(nat \<times> A)\<close>
+          proof(rule tgb)
+            show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
+          next
+            from snnat
+            show \<open>succ(succ(n)) \<in> nat\<close> by auto
+          qed
+        next
+          show \<open>\<exists>m\<in>nat. partcomp(A, t, m, a, g)\<close>
+            by(rule bexI, rule Y, rule snnat)
+        qed
+      next
+        show \<open>t \<in> succ(succ(n)) \<rightarrow> A\<close> by (rule Y1)
+      next
+        show \<open>n \<in> succ(succ(n))\<close> by auto
+      next
+        show \<open>t ` n = t ` n\<close> by (rule refl)
+      qed
+      have e3:\<open>g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle> = g ` \<langle>t ` n, n\<rangle>\<close>
+        by (rule subst[OF e2], rule refl)
+      show \<open>(\<Union>pcs(A, a, g)) ` succ(n) = g ` \<langle>(\<Union>pcs(A, a, g)) ` n, n\<rangle>\<close>
+        by (rule trans, rule e1,rule trans, rule Y3, rule sym, rule e3)
+    qed
+  qed
+qed
+
+section "Recursion theorem"
+
+theorem recursionthm:
+  shows \<open>\<exists>!f. ((f \<in> (nat\<rightarrow>A)) \<and> ((f`0) = a) \<and> satpc(f,nat,g))\<close>
+(* where \<open>satpc(t,\<alpha>,g) == \<forall>n \<in> \<alpha> . t`succ(n) = g ` <t`n, n>\<close> *)
+proof
+  show \<open>\<exists>f. f \<in> nat -> A \<and> f ` 0 = a \<and> satpc(f, nat, g)\<close>
+  proof
+    show \<open>(\<Union>pcs(A,a,g)) \<in> nat -> A \<and> (\<Union>pcs(A,a,g)) ` 0 = a \<and> satpc(\<Union>pcs(A,a,g), nat, g)\<close>
+    proof
+      show \<open>\<Union>pcs(A, a, g) \<in> nat -> A\<close>
+        by (rule l4)
+    next
+      show \<open>(\<Union>pcs(A, a, g)) ` 0 = a \<and> satpc(\<Union>pcs(A, a, g), nat, g)\<close>
+      proof
+        show \<open>(\<Union>pcs(A, a, g)) ` 0 = a\<close>
+          by (rule l5)
+      next
+        show \<open>satpc(\<Union>pcs(A, a, g), nat, g)\<close>
+          by (rule l6new)
+      qed
+    qed
+  qed
+next
+  show \<open>\<And>f y. f \<in> nat -> A \<and>
+           f ` 0 = a \<and>
+           satpc(f, nat, g) \<Longrightarrow>
+           y \<in> nat -> A \<and>
+           y ` 0 = a \<and>
+           satpc(y, nat, g) \<Longrightarrow>
+           f = y\<close>
+    by (rule recuniq)
+qed
+
+end
+
+section "Lemmas for addition"
+
+text \<open>
+Let's define function t(x) = (a+x).
+Firstly we need to define a function \<open>g:nat \<times> nat \<rightarrow> nat\<close>, such that
+\<open>g`\<langle>t`n, n\<rangle> = t`succ(n) = a + (n + 1) = (a + n) + 1 = (t`n) + 1\<close>
+So \<open>g`\<langle>a, b\<rangle> = a + 1\<close> and \<open>g(p) = succ(pr1(p))\<close>
+and \<open>satpc(t,\<alpha>,g) \<Longleftrightarrow> \<forall>n \<in> \<alpha> . t`succ(n) = succ(t`n)\<close>.
+\<close>
+
+definition addg :: \<open>i\<close>
+  where addg_def : \<open>addg == \<lambda>x\<in>(nat*nat). succ(fst(x))\<close>
+
+lemma addgfun: \<open>function(addg)\<close>
+  by (unfold addg_def, rule func.function_lam)
+
+lemma addgsubpow : \<open>addg \<in> Pow((nat \<times> nat) \<times> nat)\<close>
+proof (unfold addg_def, rule subsetD)
+  show \<open>(\<lambda>x\<in>nat \<times> nat. succ(fst(x))) \<in> nat \<times> nat \<rightarrow> nat\<close>
+  proof(rule func.lam_type)
+    fix x
+    assume \<open>x\<in>nat \<times> nat\<close>
+    hence \<open>fst(x)\<in>nat\<close> by auto
+    thus \<open>succ(fst(x)) \<in> nat\<close> by auto
+  qed
+next
+  show \<open>nat \<times> nat \<rightarrow> nat \<subseteq> Pow((nat \<times> nat) \<times> nat)\<close>
+    by (rule pisubsig)
+qed
+
+lemma addgdom : \<open>nat \<times> nat \<subseteq> domain(addg)\<close>
+proof(unfold addg_def)
+  have e:\<open>domain(\<lambda>x\<in>nat \<times> nat. succ(fst(x))) = nat \<times> nat\<close>
+    by (rule domain_lam)  (* "domain(Lambda(A,b)) = A" *)
+  show \<open>nat \<times> nat \<subseteq>
+    domain(\<lambda>x\<in>nat \<times> nat. succ(fst(x)))\<close>
+    by (rule subst, rule sym, rule e, auto)
+qed
+
+lemma plussucc:
+  assumes F:\<open>f \<in> (nat\<rightarrow>nat)\<close>
+  assumes H:\<open>satpc(f,nat,addg)\<close>
+  shows \<open>\<forall>n \<in> nat . f`succ(n) = succ(f`n)\<close>
+proof
+  fix n
+  assume J:\<open>n\<in>nat\<close>
+  from H
+  have H:\<open>\<forall>n \<in> nat . f`succ(n) = (\<lambda>x\<in>(nat*nat). succ(fst(x)))` <f`n, n>\<close>
+    by (unfold satpc_def, unfold addg_def)
+  have H:\<open>f`succ(n) = (\<lambda>x\<in>(nat*nat). succ(fst(x)))` <f`n, n>\<close>
+    by (rule bspec[OF H J])
+  have Q:\<open>(\<lambda>x\<in>(nat*nat). succ(fst(x)))` <f`n, n> = succ(fst(<f`n, n>))\<close>
+  proof(rule func.beta)
+    show \<open>\<langle>f ` n, n\<rangle> \<in> nat \<times> nat\<close>
+    proof
+      show \<open>f ` n \<in> nat\<close>
+        by (rule func.apply_funtype[OF F J])
+      show \<open>n \<in> nat\<close>
+        by (rule J)
+    qed
+  qed
+  have HQ:\<open>f`succ(n) = succ(fst(<f`n, n>))\<close>
+    by (rule trans[OF H Q])
+  have K:\<open>fst(<f`n, n>) = f`n\<close>
+    by auto
+  hence K:\<open>succ(fst(<f`n, n>)) = succ(f`n)\<close>
+    by (rule subst_context)
+  show \<open>f`succ(n) = succ(f`n)\<close>
+    by (rule trans[OF HQ K])
+qed
+
+section "Definition of addition"
+
+text \<open>Theorem that addition of natural numbers exists
+and unique in some sense. Due to theorem 'plussucc' the term
+ \<open>satpc(f,nat,addg)\<close>
+  can be replaced here with
+ \<open>\<forall>n \<in> nat . f`succ(n) = succ(f`n)\<close>.\<close>
+theorem addition:
+  assumes \<open>a\<in>nat\<close>
+  shows
+ \<open>\<exists>!f. ((f \<in> (nat\<rightarrow>nat)) \<and> ((f`0) = a) \<and> satpc(f,nat,addg))\<close>
+proof(rule recthm.recursionthm, unfold recthm_def)
+  show \<open>a \<in> nat \<and> addg \<in> nat \<times> nat \<rightarrow> nat\<close>
+  proof
+    show \<open>a\<in>nat\<close> by (rule assms(1))
+  next
+    show \<open>addg \<in> nat \<times> nat \<rightarrow> nat\<close>
+    proof(unfold Pi_def, rule CollectI)
+      show \<open>addg \<in> Pow((nat \<times> nat) \<times> nat)\<close>
+        by (rule addgsubpow)
+    next
+      have A2: \<open>nat \<times> nat \<subseteq> domain(addg)\<close>
+        by(rule addgdom)
+      have A3: \<open>function(addg)\<close>
+        by (rule addgfun)
+      show \<open>nat \<times> nat \<subseteq> domain(addg) \<and> function(addg)\<close>
+        by(rule conjI[OF A2 A3])
+    qed
+  qed
+qed
+
+end