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,899 +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.Bounded_Linear_Function"
     "HOL-Analysis.Line_Segment"
 
 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>\<open>sokal2011really\<close>.
 \<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)        
+      using \<open>Sup (f ` X) \<ge> Sup (g ` X)\<close>
+      by (smt (verit, best) \<open>x \<in> X\<close> \<open>y = f x\<close> imageI)
     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)
+    using \<open>\<And> n. \<parallel>y (Suc n) - y n\<parallel> \<le> c^n\<close>
+    by (metis dual_order.trans norm_ge_zero power_one_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> mult_le_cancel_left_pos 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)      
+      using \<open>0 < 1 - c\<close> divide_le_cancel by fastforce
     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)      
+    by (smt (verit, ccfv_SIG) 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)      
+    by (metis (mono_tags, lifting) \<open>\<parallel>y\<parallel> = 1\<close> cSup_upper2 mem_Collect_eq norm_1_bounded norm_ge_zero)
   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, opaque_lifting) \<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) 
+      by (smt (verit, del_insts) less_cSupD 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>
+  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>
+    then obtain t where t: \<open>x = r *\<^sub>R \<parallel>f *\<^sub>v t\<parallel>\<close> \<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) 
+      unfolding y_def using assms t * by fastforce 
     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) 
+      by (meson assms cSup_upper dual_order.trans mult_le_cancel_left_pos)
   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)  
+      by (simp add: mult.commute pos_le_divide_eq)
   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)
+      by (metis \<open>Suc N \<le> n\<close> \<open>n < m\<close> atLeastSucAtMost_greaterThanAtMost order_less_imp_le)
     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       
+    thus ?thesis using  \<open>\<forall>n. (sum a  {0..n}) \<le> K\<close> by (smt (verit, best))
   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)
+    by (metis add_diff_cancel_left' atLeast0AtMost less_imp_add_positive sum_up_index_split 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>
+    using \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. m > n \<longrightarrow> sum a {Suc n..m} < e\<close> by presburger
+  then 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 
+      by (smt(verit, ccfv_SIG) 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/BenOr_Kozen_Reif/BKR_Decision.thy b/thys/BenOr_Kozen_Reif/BKR_Decision.thy
--- a/thys/BenOr_Kozen_Reif/BKR_Decision.thy
+++ b/thys/BenOr_Kozen_Reif/BKR_Decision.thy
@@ -1,2031 +1,2007 @@
 theory BKR_Decision
   imports BKR_Algorithm
     "Berlekamp_Zassenhaus.Factorize_Rat_Poly"
     "Algebraic_Numbers.Real_Roots"
      BKR_Proofs
     "HOL.Deriv"
 begin
 
 section "Algorithm"
 
 subsection "Parsing"
   (* Formula type *)
 datatype 'a fml =
   And "'a fml" "'a fml"
   | Or "'a fml" "'a fml"
   | Gt 'a   (* 'a > 0 *)
   | Geq 'a  (* 'a \<ge> 0 *)
   | Lt 'a   (* 'a < 0 *)
   | Leq 'a  (* 'a \<le> 0 *)
   | Eq 'a   (* 'a = 0 *)
   | Neq 'a  (* 'a \<noteq> 0 *)
 
 (* Evaluating a formula over a lookup semantics where 'a is nat *)
 primrec lookup_sem :: "nat fml \<Rightarrow> ('a::linordered_field list) \<Rightarrow> bool"
   where
     "lookup_sem (And l r) ls = (lookup_sem l ls \<and> lookup_sem r ls)"
   | "lookup_sem (Or l r) ls = (lookup_sem l ls \<or> lookup_sem r ls)"
   | "lookup_sem (Gt p) ls = (ls ! p > 0)"  
   | "lookup_sem (Geq p) ls = (ls ! p \<ge> 0)" 
   | "lookup_sem (Lt p) ls = (ls ! p < 0)" 
   | "lookup_sem (Leq p) ls = (ls ! p \<le> 0)" 
   | "lookup_sem (Eq p) ls = (ls ! p = 0)" 
   | "lookup_sem (Neq p) ls = (ls ! p \<noteq> 0)" 
 
 (* (compute) all polynomials mentioned in a formula *)
 primrec poly_list :: "'a fml \<Rightarrow> 'a list"
   where
     "poly_list (And l r) = poly_list l @ poly_list r"  
   | "poly_list (Or l r) = poly_list l @ poly_list r"  
   | "poly_list (Gt p) = [p]"
   | "poly_list (Geq p) = [p]"
   | "poly_list (Lt p) = [p]"
   | "poly_list (Leq p) = [p]"
   | "poly_list (Eq p) = [p]"
   | "poly_list (Neq p) = [p]"
 
 primrec index_of_aux :: "'a list \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> nat" where
   "index_of_aux [] y n = n"
 | "index_of_aux (x#xs) y n =
   (if x = y then n else index_of_aux xs y (n+1))"
 
 definition index_of :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where
   "index_of xs y = index_of_aux xs y 0"
 
 definition convert :: "'a fml \<Rightarrow> (nat fml \<times> 'a list)"
   where
     "convert fml = (
     let ps = remdups (poly_list fml)
     in
     (map_fml (index_of ps) fml, ps)
   )"
 
 
 subsection "Factoring"
 
 (* Makes sure the result of factorize_rat_poly is monic *)
 definition factorize_rat_poly_monic :: "rat poly \<Rightarrow> (rat \<times> (rat poly \<times> nat) list)"
   where
     "factorize_rat_poly_monic p = (
     let (c,fs) =  factorize_rat_poly p ;
         lcs = prod_list (map (\<lambda>(f,i). (lead_coeff f) ^ Suc i) fs) ;
         fs = map (\<lambda>(f,i). (normalize f, i)) fs
     in
     (c * lcs,fs)
   )"
 
 (* Factoring an input list of polynomials *)
 definition factorize_polys :: "rat poly list \<Rightarrow> (rat poly list \<times> (rat \<times> (nat \<times> nat) list) list)"
   where
     "factorize_polys ps = (
     let fact_ps = map factorize_rat_poly_monic ps;
         factors = remdups (map fst (concat (map snd fact_ps))) ;
         data = map (\<lambda>(c,fs). (c, map (\<lambda>(f,pow). (index_of factors f, pow) ) fs)) fact_ps
     in
       (factors,data)
   )"
 
 (* After turning a polynomial into factors,
   this turns a sign condition on the factors
   into a sign condition for the polynomial *)
 definition undo_factorize :: "rat \<times> (nat \<times> nat) list \<Rightarrow> rat list \<Rightarrow> rat"
   where
     "undo_factorize cfs signs =
    squash
     (case cfs of (c,fs) \<Rightarrow>
     (c * prod_list (map (\<lambda>(f,pow). (signs ! f) ^ Suc pow) fs)))
   "
 
 definition undo_factorize_polys :: "(rat \<times> (nat \<times> nat) list) list \<Rightarrow> rat list \<Rightarrow> rat list"
   where
     "undo_factorize_polys ls signs = map (\<lambda>l. undo_factorize l signs) ls"
 
 subsection "Auxiliary Polynomial"
 definition crb:: "real poly \<Rightarrow> int" where
   "crb p = ceiling (2 + max_list_non_empty (map (\<lambda> i. norm (coeff p i)) [0 ..< degree p]) 
     / norm (lead_coeff p))"
 
 (* Because we are using prod_list instead of lcm, it's important that this is called 
     when ps is pairwise coprime. *)
 definition coprime_r :: "real poly list \<Rightarrow> real poly"
   where
     "coprime_r ps = pderiv (prod_list ps) * ([:-(crb (prod_list ps)),1:]) * ([:(crb (prod_list ps)),1:])"
 
 
 subsection "Setting Up the Procedure"
   (* 0 indexed *)
 definition insertAt :: "nat \<Rightarrow> 'a  \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "insertAt n x ls = take n ls @ x # (drop n ls)"
 
 (* 0 indexed *)
 definition removeAt :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "removeAt n ls = take n ls @ (drop (n+1) ls)"
 
 definition find_sgas_aux:: "real poly list \<Rightarrow> rat list list"
   where "find_sgas_aux in_list =
   concat (map (\<lambda>i.
     map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (in_list ! i) (removeAt i in_list))
   ) [0..<length in_list])"
 
 (* For an input list of real polynomials, apply BKR to all positions *)
 definition find_sgas :: "real poly list \<Rightarrow> rat list list"
   where
     "find_sgas ps = ( 
     let r = coprime_r ps in
     find_consistent_signs_at_roots r ps @ find_sgas_aux ps
   )"
 
 (* Putting the sign condition preprocessing together with BKR *)
 definition find_consistent_signs :: "rat poly list \<Rightarrow> rat list list"
   where
     "find_consistent_signs ps = (
      let (fs,data) = factorize_polys ps;
          sgas = find_sgas (map (map_poly of_rat) fs);
          rsgas = map (undo_factorize_polys data) sgas
     in
     (if fs = [] then [(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) ps)] else rsgas)
   )"
 
 
 subsection "Deciding Univariate Problems"
 definition decide_universal :: "rat poly fml \<Rightarrow> bool"
   where [code]:
     "decide_universal fml = (
     let (fml_struct,polys) = convert fml;
         conds = find_consistent_signs polys
     in
      list_all (lookup_sem fml_struct) conds
   )"
 
 definition decide_existential :: "rat poly fml \<Rightarrow> bool"
   where [code]:
     "decide_existential fml = (
     let (fml_struct,polys) = convert fml;
         conds = find_consistent_signs polys
     in
       find (lookup_sem fml_struct) conds \<noteq> None
   )"
 
 section "Proofs"
 subsection "Parsing and Semantics"
   (* Evaluating a formula where 'a is a real poly *)
 primrec real_sem :: "real poly fml \<Rightarrow> real \<Rightarrow> bool"
   where
     "real_sem (And l r) x = (real_sem l x \<and> real_sem r x)"
   | "real_sem (Or l r) x = (real_sem l x \<or> real_sem r x)"
   | "real_sem (Gt p) x = (poly p x > 0)" 
   | "real_sem (Geq p) x = (poly p x \<ge> 0)" 
   | "real_sem (Lt p) x = (poly p x < 0)" 
   | "real_sem (Leq p) x = (poly p x \<le> 0)" 
   | "real_sem (Eq p) x = (poly p x = 0)" 
   | "real_sem (Neq p) x = (poly p x \<noteq> 0)" 
 
 (* Evaluating a formula where 'a is a rat poly *)
 primrec fml_sem :: "rat poly fml \<Rightarrow> real \<Rightarrow> bool"
   where
     "fml_sem (And l r) x = (fml_sem l x \<and> fml_sem r x)"
   | "fml_sem (Or l r) x = (fml_sem l x \<or> fml_sem r x)"
   | "fml_sem (Gt p) x = (rpoly p x > 0)" 
   | "fml_sem (Geq p) x = (rpoly p x \<ge> 0)" 
   | "fml_sem (Lt p) x = (rpoly p x < 0)" 
   | "fml_sem (Leq p) x = (rpoly p x \<le> 0)" 
   | "fml_sem (Eq p) x = (rpoly p x = 0)" 
   | "fml_sem (Neq p) x = (rpoly p x \<noteq> 0)" 
 
 lemma poly_list_set_fml:
   shows "set (poly_list fml) = set_fml fml"
   apply (induction) by auto
 
 lemma convert_semantics_lem:
   assumes "\<And>p. p \<in> set (poly_list fml) \<Longrightarrow>
     ls ! (index_of ps p) = rpoly p x"
   shows "fml_sem fml x = lookup_sem (map_fml (index_of ps) fml) ls"
   using assms apply (induct fml)
   by auto
 
 lemma index_of_aux_more:
   shows "index_of_aux ls p n \<ge> n"
   apply (induct ls arbitrary: n)
   apply auto
   using Suc_leD by blast
 
 lemma index_of_aux_lookup:
   assumes "p \<in> set ls"
   shows "(index_of_aux ls p n) - n < length ls"
     "ls ! ((index_of_aux ls p n) - n) = p"
   using assms apply (induct ls arbitrary: n)
   apply auto
   apply (metis Suc_diff_Suc index_of_aux_more lessI less_Suc_eq_0_disj less_le_trans)
   by (metis Suc_diff_Suc index_of_aux_more lessI less_le_trans nth_Cons_Suc)
 
 lemma index_of_lookup:
   assumes "p \<in> set ls"
   shows "index_of ls p < length ls"
     "ls ! (index_of ls p) = p"
   apply (metis assms index_of_aux_lookup(1) index_of_def minus_nat.diff_0)
   by (metis assms index_of_aux_lookup(2) index_of_def minus_nat.diff_0)
 
 lemma convert_semantics:
   shows "fml_sem fml x = lookup_sem (fst (convert fml)) (map (\<lambda>p. rpoly p x) (snd (convert fml)))"
   unfolding convert_def Let_def apply simp
   apply (intro convert_semantics_lem)
   by (simp add: index_of_lookup(1) index_of_lookup(2))
 
 lemma convert_closed:
   shows "\<And>i. i \<in> set_fml (fst (convert fml)) \<Longrightarrow> i < length (snd (convert fml))"
   unfolding convert_def Let_def
   apply (auto simp add: fml.set_map)
   by (simp add: index_of_lookup(1) poly_list_set_fml)
 
 (* Rational sign vector of polynomials qs with rational coefficients at x *)
 definition sign_vec::"rat poly list \<Rightarrow> real \<Rightarrow> rat list"
   where "sign_vec qs x \<equiv>
     map (squash \<circ> (\<lambda>p. rpoly p x)) qs"
 
 (* The set of all rational sign vectors for qs wrt the set S
   When S = UNIV, then this quantifies over all reals *)
 definition consistent_sign_vectors::"rat poly list \<Rightarrow> real set \<Rightarrow> rat list set"
   where "consistent_sign_vectors qs S = (sign_vec qs) ` S"
 
 lemma sign_vec_semantics:
   assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length ls"
   shows "lookup_sem fml (map (\<lambda>p. rpoly p x) ls) = lookup_sem fml (sign_vec ls x)"
   using assms apply (induction)
   by (auto simp add: sign_vec_def squash_def)
 
 (* The universal and existential decision procedure is easy if we know the consistent sign vectors *)
 lemma universal_lookup_sem:
   assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length qs"
   assumes "set signs = consistent_sign_vectors qs UNIV"
   shows "(\<forall>x::real. lookup_sem fml (map (\<lambda>p. rpoly p x) qs)) \<longleftrightarrow>
     list_all (lookup_sem fml) signs"
   using assms(2) unfolding consistent_sign_vectors_def list_all_iff
   by (simp add: assms(1) sign_vec_semantics)
 
 lemma existential_lookup_sem:
   assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length qs"
   assumes "set signs = consistent_sign_vectors qs UNIV"
   shows "(\<exists>x::real. lookup_sem fml (map (\<lambda>p. rpoly p x) qs)) \<longleftrightarrow>
     find (lookup_sem fml) signs \<noteq> None"
   using assms(2) unfolding consistent_sign_vectors_def find_None_iff
   by (simp add: assms(1) sign_vec_semantics)
 
 subsection "Factoring Lemmas"
   (*definition real_factorize_list:: "rat poly list \<Rightarrow> real poly list"
 where "real_factorize_list qs = map (map_poly of_rat) (fst(factorize_polys qs))"
 *)
 interpretation of_rat_poly_hom: map_poly_comm_semiring_hom of_rat..
 interpretation of_rat_poly_hom: map_poly_comm_ring_hom of_rat..
 interpretation of_rat_poly_hom: map_poly_idom_hom of_rat..
 
 lemma finite_prod_map_of_rat_poly_hom:
   shows "poly (real_of_rat_poly (\<Prod>(a,b)\<in>s. f a b)) y = (\<Prod>(a,b)\<in>s. poly (real_of_rat_poly (f a b)) y)"
   apply (simp add: of_rat_poly_hom.hom_prod poly_prod)
   by (simp add: case_prod_app prod.case_distrib)
 
 lemma sign_vec_index_of:
   assumes "f \<in> set ftrs"
   shows "sign_vec ftrs x ! (index_of ftrs f) = squash (rpoly f x)"
   by (simp add: assms index_of_lookup(1) index_of_lookup(2) sign_vec_def)
 
 lemma squash_idem:
   shows "squash (squash x) = squash x"
   unfolding squash_def by auto
 
 lemma squash_mult:
   shows "squash ((a::real) * b) = squash a * squash b"
   unfolding squash_def apply auto
   using less_not_sym mult_neg_neg apply blast
   using mult_less_0_iff by blast
 
 lemma squash_prod_list:
   shows "squash (prod_list (ls::real list)) = prod_list (map squash ls)"
   apply (induction ls)
   unfolding squash_def apply auto
   apply (simp add: mult_less_0_iff)
   by (simp add: zero_less_mult_iff)
 
 lemma squash_pow:
   shows "squash ((x::real) ^ (y::nat)) = (squash x) ^ y"
   unfolding squash_def apply auto
   by (auto simp add: zero_less_power_eq)
 
 lemma squash_real_of_rat[simp]:
   shows "squash (real_of_rat x) = squash x"
   unfolding squash_def by auto
 
 lemma factorize_rat_poly_monic_irreducible_monic:
   assumes "factorize_rat_poly_monic f = (c,fs)"
   assumes "(fi,i) \<in> set fs"
   shows "irreducible fi \<and> monic fi"
 proof -
   obtain c' fs' where cfs: "factorize_rat_poly f = (c',fs')"
     by (meson surj_pair)
   then have fs: "fs = map (\<lambda>(f,i). (normalize f, i)) fs'"
     using factorize_rat_poly_monic_def assms by auto
   obtain "fi'" where "(fi',i) \<in> set fs'" "fi = normalize fi'"
     using assms(2) unfolding fs by auto
   thus ?thesis using factorize_rat_poly irreducible_normalize_iff
     by (metis cfs monic_normalize not_irreducible_zero)
 qed
 
 lemma square_free_normalize:
   assumes "square_free p"
   shows "square_free (normalize p)"
   by (metis assms square_free_multD(3) unit_factor_mult_normalize)
 
 lemma coprime_normalize:
   assumes "coprime a b"
   shows "coprime (normalize a) b"
   using assms by auto
 
 lemma undo_normalize:
   shows "a = Polynomial.smult (unit_factor (lead_coeff a)) (normalize a)"
   by (metis add.right_neutral mult_pCons_right mult_zero_right normalize_mult_unit_factor pCons_0_hom.hom_zero unit_factor_poly_def)
 
 lemma finite_smult_distr:
   assumes "distinct fs"
   shows "(\<Prod>(x,y)\<in>set fs. Polynomial.smult ((f x y)::rat) (g x y)) = 
     Polynomial.smult (\<Prod>(x,y)\<in>set fs. f x y) (\<Prod>(x,y)\<in>set fs. g x y)"
   using assms
 proof (induction fs)
   case Nil
   then show ?case by auto
 next
   case (Cons a fs)
   then show ?case apply auto
     using mult.commute mult_smult_right prod.case_distrib smult_smult split_cong split_conv
     by (simp add: Groups.mult_ac(2) split_beta)
 qed
 
 lemma normalize_coprime_degree:
   assumes "normalize (f::rat poly) = normalize g"
   assumes "coprime f g"
   shows "degree f = 0"
 proof -
   have "f dvd g" by (simp add: assms(1) associatedD2) 
   then have "f dvd 1"
     using assms(2) associatedD1 by auto
   thus ?thesis
     using Missing_Polynomial_Factorial.is_unit_field_poly by blast
 qed
 
 lemma factorize_rat_poly_monic_square_free_factorization:
   assumes res: "factorize_rat_poly_monic f = (c,fs)"
   shows "square_free_factorization f (c,fs)"
 proof (unfold square_free_factorization_def split, intro conjI impI allI)
   obtain c' fs' where cfs: "factorize_rat_poly f = (c',fs')"
     by (meson surj_pair)
   then have fs: "fs = map (\<lambda>(f,i). (normalize f, i)) fs'"
     using factorize_rat_poly_monic_def assms by auto
   have sq: "square_free_factorization f (c',fs')"
     using cfs factorize_rat_poly(1) by blast
   obtain lcs where lcs: "lcs = prod_list (map (\<lambda>(f,i). lead_coeff f ^ Suc i) fs')" by force
   have c: "c = c' * lcs"  using assms unfolding factorize_rat_poly_monic_def cfs Let_def lcs by auto
   show "f = 0 \<Longrightarrow> c = 0" using c cfs by auto                       
   show "f = 0 \<Longrightarrow> fs = []" using fs cfs by auto
   have dist: "distinct fs'" using sq square_free_factorizationD(5) by blast
   show dist2: "distinct fs" unfolding fs
     unfolding distinct_conv_nth apply auto
   proof -
     fix i j
     assume ij: "i < length fs'" "j < length fs'" "i \<noteq> j"
     assume eq: "(case fs' ! i of
             (f, x) \<Rightarrow> (normalize f, x)) =
            (case fs' ! j of
             (f, x) \<Rightarrow> (normalize f, x))"
     obtain f a where fa: "fs' ! i = (f,a)" by force
     obtain g where g: "fs' ! j = (g,a)" "normalize f = normalize g"
       using eq fa  apply auto
       by (metis case_prod_conv prod.collapse prod.inject)
     have "f \<noteq> g" using dist ij fa g
       using nth_eq_iff_index_eq by fastforce
     then have "coprime f g"
       using square_free_factorizationD(3)[OF sq, of f a g a] fa g ij
       apply auto
       using nth_mem by force
     then have "degree f = 0"
       by (simp add: g(2) normalize_coprime_degree)
     thus False
       using fa ij(1) nth_mem sq square_free_factorizationD'(3) by fastforce 
   qed
   have ceq: "c = c' * (\<Prod>(a, i)\<in>set fs'. (lead_coeff a) ^ Suc i)" using c lcs
     by (simp add: dist prod.distinct_set_conv_list) 
   have fseq: " (\<Prod>(a, i)\<in>set fs. a ^ Suc i) =  (\<Prod>(a, i)\<in>set fs'. (normalize a) ^ Suc i)"
     apply (subst prod.distinct_set_conv_list[OF dist])
     apply (subst prod.distinct_set_conv_list[OF dist2])
     unfolding fs apply (auto simp add: o_def )
     by (metis (no_types, lifting) case_prod_conv old.prod.exhaust)
 
   have "f = Polynomial.smult c' (\<Prod>(a, i)\<in>set fs'. a ^ Suc i)"  using sq square_free_factorizationD(1) by blast
   moreover have "... =  Polynomial.smult c' (\<Prod>(a, i)\<in>set fs'. (Polynomial.smult ((unit_factor (lead_coeff a))) (normalize a)) ^ Suc i)"
     apply (subst undo_normalize[symmetric]) by auto
   moreover have "... =  Polynomial.smult c'
     (\<Prod>(a, i)\<in>set fs'. (Polynomial.smult ((lead_coeff a) ^ Suc i) ((normalize a) ^ Suc i)))"
     apply (subst smult_power) by auto
   moreover have "... =  Polynomial.smult c'
     (Polynomial.smult (\<Prod>(a, i)\<in>set fs'. ((lead_coeff a) ^ Suc i))
         (\<Prod>(a, i)\<in>set fs'. (normalize a) ^ Suc i))"
     apply (subst finite_smult_distr) by (auto simp add: dist)
   moreover have "... =  Polynomial.smult (c' * (\<Prod>(a, i)\<in>set fs'. (lead_coeff a) ^ Suc i))
         (\<Prod>(a, i)\<in>set fs'. (normalize a) ^ Suc i)"
     using smult_smult by blast
   moreover have "... = Polynomial.smult c  (\<Prod>(a, i)\<in>set fs. a ^ Suc i)"
     unfolding ceq fseq by auto
   ultimately show "f =  Polynomial.smult c  (\<Prod>(a, i)\<in>set fs. a ^ Suc i)" by auto
   fix a i
   assume ai: "(a,i) \<in> set fs"
   obtain a' where a': "(a',i) \<in> set fs'" "a = normalize a'" using ai unfolding fs by auto
   show "square_free a" using square_free_normalize a'
     using sq square_free_factorizationD(2) by blast
   show "0 < degree a" using degree_normalize a'
     using sq square_free_factorizationD'(3) by fastforce
   fix  b j
   assume bj: "(b,j) \<in> set fs" "(a,i) \<noteq> (b,j)"
   obtain b' where b': "(b',j) \<in> set fs'" "b = normalize b'" using bj unfolding fs by auto
   show "algebraic_semidom_class.coprime a b" using a' b' apply auto
     using bj(2) sq square_free_factorizationD(3) by fastforce
 qed  
 
 lemma undo_factorize_correct:
   assumes "factorize_rat_poly_monic p = (c,fs)"
   assumes "\<And>f p. (f,p) \<in> set fs \<Longrightarrow> f \<in> set ftrs"
   shows "undo_factorize (c,map (\<lambda>(f,pow). (index_of ftrs f, pow)) fs) (sign_vec ftrs x) = squash (rpoly p x)"
 proof -
   have p: "p = smult c (\<Prod>(a, i)\<in> set fs. a ^ Suc i)"
     using assms(1) factorize_rat_poly_monic_square_free_factorization square_free_factorizationD(1) by blast
   have fs: "distinct fs"
     using assms(1) factorize_rat_poly_monic_square_free_factorization square_free_factorizationD(5) by blast
   have "rpoly p x = ((real_of_rat c) * rpoly (\<Prod>(a, i)\<in> set fs. a ^ Suc i) x)"
     using p by (simp add: of_rat_hom.map_poly_hom_smult)
   moreover have "... = ((real_of_rat c) * rpoly (\<Prod>ai\<in> set fs. case ai of (a,i) \<Rightarrow> a ^ Suc i) x)"
     by blast
   moreover have "... = ((real_of_rat c) * (\<Prod>ai\<in> set fs. case ai of (a,i) \<Rightarrow> rpoly (a ^ Suc i) x))"
     by (simp add: finite_prod_map_of_rat_poly_hom)
   moreover have "... = ((real_of_rat c) * (\<Prod>ai\<in> set fs. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i))"
     by (metis (mono_tags, lifting) of_rat_poly_hom.hom_power poly_hom.hom_power split_cong)
   moreover have "...  = ((real_of_rat c) * (prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i) fs)))"
     by (simp add: fs prod.distinct_set_conv_list)
   ultimately have "rpoly p x = ((real_of_rat c) * (prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i) fs)))" by auto
 
   then have "squash (rpoly p x) = squash c * prod_list (map squash (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i) fs))"
     by (auto simp add: squash_mult squash_prod_list o_def)
   moreover have "... = squash c * prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> squash ((rpoly a x) ^ Suc i)) fs)"
     apply (simp add: o_def)
     by (simp add: prod.case_distrib)
   ultimately have rp:"squash(rpoly p x) = squash c * prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> squash (rpoly a x) ^ Suc i) fs)"
     using squash_pow
     by presburger
   have "undo_factorize
      (c, map (\<lambda>(f, pow).(index_of ftrs f, pow)) fs) (sign_vec ftrs x) =
     squash
      (c * (\<Prod>xa\<leftarrow>fs. case xa of (f, y) \<Rightarrow> sign_vec ftrs x ! index_of ftrs f ^ Suc y))"
     unfolding undo_factorize_def apply (auto simp add: o_def)
     by (metis (mono_tags, lifting) case_prod_conv old.prod.exhaust)
   moreover have "... =  squash
      (c * (\<Prod>xa\<leftarrow>fs. case xa of (f, y) \<Rightarrow> (squash (rpoly f x)) ^ Suc y))"
-    using assms(2) sign_vec_index_of
-      map_eq_conv split_cong
-    apply (auto) 
-    by (smt map_eq_conv split_cong)
+    using assms(2) sign_vec_index_of map_eq_conv split_cong by (smt (verit, del_insts))
   ultimately show ?thesis using rp
     by (metis (mono_tags, lifting) of_rat_hom.hom_mult squash_idem squash_mult squash_real_of_rat)
 qed
 
 lemma length_sign_vec[simp]:
   shows "length (sign_vec ps x) = length ps" unfolding sign_vec_def by auto
 
 lemma factorize_polys_has_factors:
   assumes "factorize_polys ps = (ftrs,data)"
   assumes "p \<in> set ps"
   assumes "factorize_rat_poly_monic p = (c,fs)"
   shows "set (map fst fs) \<subseteq> set ftrs"
   using assms unfolding factorize_polys_def Let_def apply auto
   by (metis UN_iff fst_conv image_eqI snd_conv)
 
 lemma factorize_polys_undo_factorize_polys:
   assumes "factorize_polys ps = (ftrs,data)"
   shows "undo_factorize_polys data (sign_vec ftrs x) = sign_vec ps x"
   unfolding list_eq_iff_nth_eq undo_factorize_polys_def apply auto
 proof -
   show leq:"length data = length ps"
     using assms unfolding factorize_polys_def by (auto simp add: Let_def)
   fix i
   assume il:"i < length data"
   obtain c fs where cfs: "factorize_rat_poly_monic (ps ! i) = (c,fs)"
     by (meson surj_pair)
   then have fsts:"set (map fst fs) \<subseteq> set ftrs"
     using assms factorize_polys_has_factors il leq nth_mem by fastforce
   have *:"data ! i = (c,map (\<lambda>(f,pow). (index_of ftrs f, pow)) fs)"
     using assms unfolding factorize_polys_def
     using cfs il by (auto simp add: Let_def cfs)
   have "undo_factorize (data ! i) (sign_vec ftrs x) = squash (rpoly (ps ! i) x)" unfolding *
     apply (subst  undo_factorize_correct[of "ps ! i"])
     apply (auto simp add: cfs)
     using fsts by auto
   thus "undo_factorize (data ! i) (sign_vec ftrs x) =  sign_vec ps x ! i" 
     using leq il sign_vec_def by auto
 qed
 
 lemma factorize_polys_irreducible_monic:
   assumes "factorize_polys ps = (fs,data)"
   shows "distinct fs" "\<And>f. f \<in> set fs \<Longrightarrow> irreducible f \<and> monic f"
   using assms unfolding factorize_polys_def Let_def apply auto
   using factorize_rat_poly_monic_irreducible_monic
   apply (metis prod.collapse) 
   using factorize_rat_poly_monic_irreducible_monic
   by (metis prod.collapse)
 
 lemma factorize_polys_square_free:
   assumes "factorize_polys ps = (fs,data)"
   shows "\<And>f. f \<in> set fs \<Longrightarrow> square_free f"
   using assms factorize_polys_irreducible_monic(2) irreducible_imp_square_free by blast
 
 lemma irreducible_monic_coprime:
   assumes f: "monic f" "irreducible (f::rat poly)" 
   assumes g: "monic g" "irreducible (g::rat poly)"
   assumes "f \<noteq> g"
   shows "coprime f g"
   by (metis (no_types, lifting) assms(5) coprime_0(2) coprime_def' f(1) f(2) g(1) g(2) irreducible_normalized_divisors normalize_dvd_iff normalize_idem normalize_monic)
 
 lemma factorize_polys_coprime:
   assumes "factorize_polys ps = (fs,data)"
   shows "\<And>f g. f \<in> set fs \<Longrightarrow> g \<in> set fs \<Longrightarrow> f \<noteq> g \<Longrightarrow> coprime f g"
   using assms factorize_polys_irreducible_monic(2) irreducible_monic_coprime by auto
 
 lemma coprime_rat_poly_real_poly:
   assumes "coprime p (q::rat poly)"
   shows "coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly)"
   by (metis assms gcd_dvd_1 of_rat_hom.map_poly_gcd of_rat_poly_hom.hom_dvd_1)
 
 lemma coprime_rat_poly_iff_coprimereal_poly:
   shows "coprime p (q::rat poly) \<longleftrightarrow> coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly)"
 proof -
   have forward: "coprime p (q::rat poly) \<longrightarrow> coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly)"
     using coprime_rat_poly_real_poly by auto
   have backward: "coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly) \<Longrightarrow> coprime p (q::rat poly)"
   proof -
     assume copr_real: "comm_monoid_mult_class.coprime (real_of_rat_poly p) (real_of_rat_poly q)"
     have "degree (gcd p (q::rat poly)) > 0 \<Longrightarrow> False" 
     proof -
       assume deg: "degree (gcd p (q::rat poly)) > 0"
       then have "\<exists>y. y dvd p \<and> y dvd q \<and> degree y > 0"
         by blast
       then obtain y where yprop: "y dvd p \<and> y dvd q \<and> degree y > 0"
         by auto
       then have "(real_of_rat_poly y) dvd (real_of_rat_poly p) \<and>
         (real_of_rat_poly y ) dvd (real_of_rat_poly q) \<and> degree y > 0"
         by simp
       then show "False" 
         using copr_real apply (auto)
         by fastforce 
     qed
     then show "comm_monoid_mult_class.coprime p (q::rat poly)" 
       using comm_monoid_gcd_class.gcd_dvd_1
       by (metis Missing_Polynomial_Factorial.is_unit_field_poly copr_real gcd_zero_iff' neq0_conv of_rat_poly_hom.hom_zero)
   qed
   show ?thesis
     using forward backward by auto
 qed
 
 lemma factorize_polys_map_distinct:
   assumes "factorize_polys ps = (fs,data)"
   assumes "fss =  map real_of_rat_poly fs"
   shows "distinct fss"
   using factorize_polys_irreducible_monic[OF assms(1)]
   unfolding assms(2) 
   apply (simp add: distinct_conv_nth)
   by (metis of_rat_eq_iff of_rat_hom.coeff_map_poly_hom poly_eqI)
 
 lemma factorize_polys_map_square_free:
   assumes "factorize_polys ps = (fs,data)"
   assumes "fss =  map real_of_rat_poly fs"
   shows "\<And>f. f \<in> set fss \<Longrightarrow> square_free f"
   using factorize_polys_square_free[OF assms(1)]
   using assms(2) field_hom_0'.square_free_map_poly of_rat_hom.field_hom_0'_axioms by auto 
 
 lemma factorize_polys_map_coprime:
   assumes "factorize_polys ps = (fs,data)"
   assumes "fss =  map real_of_rat_poly fs"
   shows "\<And>f g. f \<in> set fss \<Longrightarrow> g \<in> set fss \<Longrightarrow> f \<noteq> g \<Longrightarrow> coprime f g"
   using factorize_polys_coprime[OF assms(1)] coprime_rat_poly_real_poly unfolding assms(2)
   by auto
 
 lemma coprime_prod_list:
   assumes "\<And>p. p \<in> set ps \<Longrightarrow> p \<noteq> 0"
   assumes "coprime (prod_list ps) (q::real poly)"  
   shows "\<And>p. p \<in> set ps \<Longrightarrow> coprime p q"
 proof -
   fix p
   assume "p \<in> set ps"
   then obtain r where r: "prod_list ps = r * p"
     using remove1_retains_prod by blast
   show "coprime p q"
     apply (rule coprime_prod[of r 1])
     using assms r apply auto
     by blast
 qed
 
 (* basically copied from square_free_factorizationD' *)
 lemma factorize_polys_square_free_prod_list:
   assumes "factorize_polys ps = (fs,data)"
   shows "square_free (prod_list fs)"
 proof (rule square_freeI)
   from factorize_polys_coprime[OF assms]
   have coprime: "\<And>p q. p \<in> set fs \<Longrightarrow> q \<in> set fs \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q" .
   from factorize_polys_square_free[OF assms]
   have sq: "\<And>p. p \<in> set fs \<Longrightarrow> square_free p" .
   thus "prod_list fs \<noteq> 0" unfolding prod_list_zero_iff
     using square_free_def by blast
   fix q
   assume "degree q > 0" "q * q dvd prod_list fs"
   from irreducible\<^sub>d_factor[OF this(1)] this(2) obtain q where 
     irr: "irreducible q" and dvd: "q * q dvd prod_list fs" unfolding dvd_def by auto
   hence dvd': "q dvd prod_list fs" unfolding dvd_def by auto
   from irreducible_dvd_prod_list[OF irr dvd'] obtain b where 
     mem: "b \<in> set fs" and dvd1: "q dvd b" by auto
   from dvd1 obtain k where b: "b = q * k" unfolding dvd_def by auto
   from split_list[OF mem] b obtain bs1 bs2 where bs: "fs = bs1 @ b # bs2" by auto
   from irr have q0: "q \<noteq> 0" and dq: "degree q > 0" unfolding irreducible\<^sub>d_def by auto
   have "square_free (q * k)" using sq b mem by auto
   from this[unfolded square_free_def, THEN conjunct2, rule_format, OF dq] 
   have qk: "\<not> q dvd k" by simp
   from dvd[unfolded bs b] have "q * q dvd q * (k * prod_list (bs1 @ bs2))"
     by (auto simp: ac_simps)
   with q0 have "q dvd k * prod_list (bs1 @ bs2)" by auto
   with irr qk have "q dvd prod_list (bs1 @ bs2)" by auto
   from irreducible_dvd_prod_list[OF irr this] obtain b' where 
     mem': "b' \<in> set (bs1 @ bs2)" and dvd2: "q dvd b'" by fastforce
   from dvd1 dvd2 have "q dvd gcd b b'" by auto
   with dq is_unit_iff_degree[OF q0] have cop: "\<not> coprime b b'" by force
   from mem' have "b' \<in> set fs" unfolding bs by auto
   have b': "b' = b" using coprime
     using \<open>b' \<in> set fs\<close> cop mem by blast
   with mem' bs factorize_polys_irreducible_monic(1)[OF assms] show False by auto
 qed
 
 lemma factorize_polys_map_square_free_prod_list:
   assumes "factorize_polys ps = (fs,data)"
   assumes "fss =  map real_of_rat_poly fs"
   shows "square_free (prod_list fss)"
   using  factorize_polys_square_free_prod_list[OF assms(1)] unfolding assms(2)
   by (simp add: of_rat_hom.square_free_map_poly)
 
 lemma factorize_polys_map_coprime_pderiv:
   assumes "factorize_polys ps = (fs,data)"
   assumes "fss = map real_of_rat_poly fs"
   shows "\<And>f. f \<in> set fss \<Longrightarrow> coprime f (pderiv (prod_list fss))"
 proof -
   fix f
   assume f: "f \<in> set fss"
   from factorize_polys_map_square_free[OF assms]
   have sq: "\<And>p. p \<in> set fss \<Longrightarrow> square_free p" .
   have z: "\<And>p. p \<in> set fss \<Longrightarrow> p \<noteq> 0" using sq square_free_def by blast
   have c: "coprime (prod_list fss) (pderiv (prod_list fss))"
     apply (simp add: separable_def[symmetric] square_free_iff_separable[symmetric])
     using factorize_polys_map_square_free_prod_list[OF assms] .
   from coprime_prod_list[OF z c f]
   show "coprime f (pderiv (prod_list fss))" by auto
 qed
 
 definition pairwise_coprime_list:: "rat poly list \<Rightarrow> bool"
   where "pairwise_coprime_list qs = 
     (\<forall>m < length qs. \<forall> n < length qs.
      m \<noteq> n \<longrightarrow> coprime (qs ! n) (qs ! m))"
 
 (* Restating factorize_polys_map_coprime to match later definitions *)
 lemma coprime_factorize:
   fixes qs:: "rat poly list"
   shows "pairwise_coprime_list (fst(factorize_polys qs))"
 proof -
   let ?fs = "fst(factorize_polys qs)"
   have "(\<forall>m < length ?fs. \<forall> n < length ?fs.
      m \<noteq> n \<longrightarrow> coprime (?fs ! n) (?fs ! m))"
   proof clarsimp 
     fix m n
     assume "m < length (fst (factorize_polys qs))"
     assume "n < length (fst (factorize_polys qs))"
     assume "m \<noteq> n"
     show " algebraic_semidom_class.coprime (fst (factorize_polys qs) ! n)
             (fst (factorize_polys qs) ! m)"
       by (metis \<open>m < length (fst (factorize_polys qs))\<close> \<open>m \<noteq> n\<close> \<open>n < length (fst (factorize_polys qs))\<close> coprime_iff_coprime distinct_conv_nth factorize_polys_coprime factorize_polys_def factorize_polys_irreducible_monic(1) fstI nth_mem)
   qed
   then show ?thesis unfolding pairwise_coprime_list_def by auto
 qed
 
 lemma squarefree_factorization_degree:
   assumes "square_free_factorization p (c,fs)"
   shows "degree p = sum_list (map (\<lambda>(f,c). (c+1) * degree f) fs)"
 proof -
   have "p =
     Polynomial.smult c
      (\<Prod>(a, i)\<in>set fs. a ^ Suc i)" using assms unfolding square_free_factorization_def
     by blast
   then have "degree p = degree (\<Prod>(a, i)\<in>set fs. a ^ Suc i)"
     using assms square_free_factorizationD(4) by fastforce
   also have "... = degree (prod_list (map (\<lambda>(f,c). f ^ Suc c) fs))"
     by (metis assms prod.distinct_set_conv_list square_free_factorizationD(5))
   also have "... = (\<Sum>(a, i)\<leftarrow>fs. degree (a ^ Suc i))"
     apply (subst degree_prod_list_eq)
     apply (auto simp add: o_def)
     using assms degree_0 square_free_factorizationD(2) apply blast
     using assms degree_0 square_free_factorizationD(2) apply blast
     by (simp add: prod.case_distrib)
   ultimately show ?thesis
-    by (smt Polynomial.degree_power_eq add.commute assms degree_0 map_eq_conv plus_1_eq_Suc split_cong square_free_factorizationD(2))  
+    by (smt (verit, ccfv_SIG) Polynomial.degree_power_eq Suc_eq_plus1 assms degree_0 map_eq_conv split_cong square_free_factorizationD(2))
 qed
 
 subsection "Auxiliary Polynomial Lemmas"
 definition roots_of_coprime_r:: "real poly list \<Rightarrow> real set"
   where "roots_of_coprime_r qs = {x. poly (coprime_r qs) x = 0}"
 
 lemma crb_lem_pos: 
   fixes x:: "real"
   fixes p:: "real poly"
   assumes x: "poly p x = 0" 
   assumes p: "p \<noteq> 0" 
   shows "x < crb p"
   using cauchy_root_bound[of p x] apply (auto)
   unfolding crb_def apply (auto)
   using p x 
   by linarith 
 
 lemma crb_lem_neg: 
   fixes x:: "real"
   fixes p:: "real poly"
   assumes x: "poly p x = 0" 
   assumes p: "p \<noteq> 0" 
   shows "x > -crb p"
   using cauchy_root_bound[of p x] apply (auto)
   unfolding crb_def apply (auto)
   using p x by linarith 
 
 (* Show that the product of the polynomial list is 0 at x iff there is a polynomial 
   in the list that is 0 at x *)
 lemma prod_zero:
   shows "\<forall>x . poly (prod_list (qs:: rat poly list)) x = 0 \<longleftrightarrow> (\<exists>q \<in> set (qs). poly q x = 0)" 
   apply auto
   using poly_prod_list_zero_iff apply blast
   using poly_prod_list_zero_iff by blast
 
 lemma coprime_r_zero1: "poly (coprime_r qs) (crb (prod_list qs)) = 0"
   by (simp add: coprime_r_def) 
 
 lemma coprime_r_zero2: "poly (coprime_r qs) (-crb (prod_list qs)) = 0"
   by (simp add: coprime_r_def) 
 
 lemma coprime_mult:
   fixes a:: "real poly"
   fixes b:: "real poly"
   fixes c:: "real poly"
   assumes "algebraic_semidom_class.coprime a b"
   assumes "algebraic_semidom_class.coprime a c"
   shows "algebraic_semidom_class.coprime a (b*c)"
   using assms(1) assms(2) by auto
 
 (* Will be needed when we call the BKR roots on coprime_r *)
 lemma coprime_r_coprime_prop:
   fixes ps:: "rat poly list"
   assumes "factorize_polys ps = (fs,data)"
   assumes "fss = map real_of_rat_poly fs"
   shows "\<And>f. f \<in> set fss \<Longrightarrow> coprime f (coprime_r fss)"
 proof clarsimp 
   fix f:: "real poly"
   assume f_in: "f \<in> set fss"
   have nonz_prod: "prod_list fss \<noteq> 0" using factorize_polys_map_square_free apply (auto)
     using assms(1) assms(2) square_free_def by fastforce 
   have nonz_f: "f \<noteq> 0" using f_in factorize_polys_map_square_free apply (auto)
     using assms(1) assms(2) square_free_def by fastforce 
   have copr_pderiv: "algebraic_semidom_class.coprime f (pderiv (prod_list fss))" using factorize_polys_map_coprime_pderiv
     apply (auto)
     using f_in assms(1) assms(2) by auto 
   have z_iff: "\<forall>x. poly f x = 0 \<longrightarrow> poly (prod_list fss) x = 0"
     using f_in apply (auto)
     using poly_prod_list_zero_iff by blast 
   let ?inf_p = "[:-(crb (prod_list fss)),1:]::real poly"
   have copr_inf: "algebraic_semidom_class.coprime f ([:-(crb (prod_list fss)),1:])"
   proof - 
     have zero_prop: "\<forall>x. poly ?inf_p x = 0 \<longleftrightarrow> x = crb (prod_list fss)" 
       by auto
     have  "poly (prod_list fss) (crb (prod_list fss)) \<noteq> 0"
     proof -
       have h: "\<forall>x. poly (prod_list fss) x = 0 \<longrightarrow> x < (crb (prod_list fss))"
         using nonz_prod crb_lem_pos[where p = "prod_list fss"] 
         by auto
       then  show ?thesis by auto
     qed
     then have nonzero: "poly f (crb (prod_list fss)) \<noteq> 0"
       using z_iff by auto
     then have "\<not>(\<exists>x. poly f x = 0 \<and> poly ?inf_p x = 0)"
       by simp
     have is_unit_gcd: "is_unit (gcd ?inf_p f)"
       using prime_elem_imp_gcd_eq  prime_elem_iff_irreducible linear_irreducible_field
       apply (auto) using nonzero
     proof -
       have f1: "\<forall>x0. - (x0::real) = - 1 * x0"
         by simp
       have "(1::real) \<noteq> 0"
         by auto
       then have "is_unit (gcd (pCons (- 1 * real_of_int (crb (prod_list fss))) 1) f)"
         using f1 by (metis (no_types) is_unit_gcd nonzero one_poly_eq_simps(1) poly_eq_0_iff_dvd prime_elem_imp_coprime prime_elem_linear_field_poly)
       then show "degree (gcd (pCons (- real_of_int (crb (prod_list fss))) 1) f) = 0"
         by simp
     qed 
     then show ?thesis
       using is_unit_gcd
       by (metis gcd.commute gcd_eq_1_imp_coprime is_unit_gcd_iff) 
   qed
   let ?ninf_p = "[:(crb (prod_list fss)),1:]::real poly"
   have copr_neg_inf: "algebraic_semidom_class.coprime f ([:(crb (prod_list fss)),1:])"
   proof - 
     have h: "\<forall>x. poly f x = 0 \<longrightarrow> poly (prod_list fss) x = 0"
       using f_in apply (auto)
       using poly_prod_list_zero_iff by blast 
     have zero_prop: "\<forall>x. poly ?ninf_p x = 0 \<longleftrightarrow> x = -crb (prod_list fss)" 
       by auto
     have  "poly (prod_list fss) (-crb (prod_list fss)) \<noteq> 0"
     proof  -
       have h: "\<forall>x. poly (prod_list fss) x = 0 \<longrightarrow> x > (-crb (prod_list fss))"
         using nonz_prod crb_lem_neg[where p = "prod_list fss"] 
         by auto
       then  show ?thesis by auto
     qed
     then have nonzero: "poly f (-crb (prod_list fss)) \<noteq> 0"
       using z_iff by auto
     then have "\<not>(\<exists>x. poly f x = 0 \<and> poly ?ninf_p x = 0)"
       using zero_prop by auto
     have is_unit_gcd: "is_unit (gcd ?ninf_p f)"
       using prime_elem_imp_gcd_eq  prime_elem_iff_irreducible linear_irreducible_field
       apply (auto) using nonzero
     proof -
       have f1: "(1::real) \<noteq> 0"
         by auto
       have "\<not> pCons (real_of_int (crb (prod_list fss))) 1 dvd f"
         using nonzero by auto
       then show "degree (gcd (pCons (real_of_int (crb (prod_list fss))) 1) f) = 0"
         using f1 by (metis (no_types) Missing_Polynomial_Factorial.is_unit_field_poly coprime_imp_gcd_eq_1 is_unit_gcd_iff one_poly_eq_simps(1) prime_elem_imp_coprime prime_elem_linear_field_poly)
     qed
     then show ?thesis 
       using is_unit_gcd
       by (metis gcd.commute gcd_eq_1_imp_coprime is_unit_gcd_iff) 
   qed
   show "algebraic_semidom_class.coprime f (coprime_r fss)" 
     using copr_pderiv coprime_mult unfolding coprime_r_def
     using copr_inf copr_neg_inf by blast 
 qed
 
 lemma coprime_r_nonzero:
   fixes ps:: "rat poly list"
   assumes "factorize_polys ps = (fs,data)"
   assumes nonempty_fs: "fs \<noteq> []"
   assumes fss_is: "fss = map real_of_rat_poly fs"
   shows "(coprime_r fss) \<noteq> 0"
 proof - 
   have nonempty_fss: "fss \<noteq> []" using nonempty_fs fss_is by auto
   have deg_f: "\<forall>f \<in> set (fs). degree f > 0"
     using factorize_polys_irreducible_monic 
     apply (auto)
     using assms(1) irreducible_degree_field by blast
   then have deg_fss: "\<forall>f \<in> set (fss). degree f > 0"
     using fss_is by simp 
   then have fss_nonz: "\<forall>f \<in> set (fss). f \<noteq> 0"
     by auto
   have "fss \<noteq> [] \<longrightarrow> ((\<forall>f \<in> set (fss). (degree f > 0 \<and> f \<noteq> 0)) \<longrightarrow> degree (prod_list fss) > 0)"
   proof (induct fss)
     case Nil
     then show ?case
       by blast 
   next
     case (Cons a fss)
     show ?case 
     proof clarsimp 
       assume z_lt: "0 < degree a"
       assume anonz: "a \<noteq> 0"
       assume fnonz: "\<forall>f\<in>set fss. 0 < degree f \<and> f \<noteq> 0"
       have h: "degree (a * prod_list fss) = degree a + degree (prod_list fss) "
         using degree_mult_eq[where p = "a", where q = "prod_list fss"] anonz fnonz 
         by auto
       then show "0 < degree (a * prod_list fss)"
         using z_lt Cons.hyps by auto
     qed
   qed
   then have "degree (prod_list fss) > 0"
     using nonempty_fss deg_fss fss_nonz by auto
   then have pderiv_nonzero: "pderiv (prod_list fss) \<noteq> 0"
     by (simp add: pderiv_eq_0_iff)
   have "(([:-(crb (prod_list fss)),1:]) * ([:(crb (prod_list fss)),1:])) \<noteq> 0"
     by auto
   then show ?thesis using pderiv_nonzero
     unfolding coprime_r_def apply (auto)
     by (metis offset_poly_eq_0_lemma right_minus_eq synthetic_div_unique_lemma) 
 qed
 
 lemma Rolle_pderiv:
   fixes q:: "real poly"
   fixes x1 x2:: "real"
   shows "(x1 < x2 \<and> poly q x1 = 0 \<and> poly q x2 = 0) \<longrightarrow> (\<exists>w. x1 < w \<and> w < x2 \<and> poly (pderiv q) w = 0)"
   using Rolle_deriv apply (auto)
   by (metis DERIV_unique Rolle continuous_at_imp_continuous_on poly_DERIV poly_differentiable poly_isCont) 
 
 lemma coprime_r_roots_prop: 
   fixes qs:: "real poly list"
   assumes pairwise_rel_prime: "\<forall>q1 q2. (q1 \<noteq> q2 \<and> (List.member qs q1) \<and> (List.member qs q2))\<longrightarrow> coprime q1 q2"
   shows "\<forall>x1. \<forall>x2. ((x1 < x2 \<and> (\<exists>q1 \<in> set (qs). (poly q1 x1) = 0) \<and> (\<exists>q2\<in> set(qs). (poly q2 x2) = 0)) \<longrightarrow> (\<exists>q. x1 < q \<and> q < x2 \<and> poly (coprime_r qs) q = 0))"
 proof clarsimp
   fix x1:: "real"
   fix x2:: "real"
   fix q1:: "real poly"
   fix q2:: "real poly"
   assume "x1 < x2"
   assume q1_in: "q1 \<in> set qs"
   assume q1_0: "poly q1 x1 = 0"
   assume q2_in: "q2 \<in> set qs"
   assume q2_0: "poly q2 x2 = 0"
   have prod_z_x1: "poly (prod_list qs) x1 = 0" using q1_in q1_0
     using poly_prod_list_zero_iff by blast  
   have prod_z_x2: "poly (prod_list qs) x2 = 0" using q2_in q2_0 
     using poly_prod_list_zero_iff by blast 
   have "\<exists>w>x1. w < x2 \<and> poly (pderiv (prod_list qs)) w = 0" 
     using Rolle_pderiv[where q = "prod_list qs"] prod_z_x1 prod_z_x2
     using \<open>x1 < x2\<close> by blast
   then obtain w where w_def: "w > x1 \<and>w < x2 \<and> poly (pderiv (prod_list qs)) w = 0"
     by auto
   then have "poly (coprime_r qs) w = 0"
     unfolding coprime_r_def
     by simp 
   then show "\<exists>q>x1. q < x2 \<and> poly (coprime_r qs) q = 0"
     using w_def by blast 
 qed
 
 subsection "Setting Up the Procedure: Lemmas"
 definition has_no_zeros::"rat list \<Rightarrow> bool"
   where "has_no_zeros l = (0 \<notin> set l)"
 
 lemma hnz_prop: "has_no_zeros l \<longleftrightarrow> \<not>(\<exists>k < length l. l ! k = 0)"
   unfolding has_no_zeros_def
   by (simp add: in_set_conv_nth)
 
 definition cast_rat_list:: "rat poly list \<Rightarrow> real poly list"
   where "cast_rat_list qs = map real_of_rat_poly qs"
 
 definition consistent_sign_vectors_r::"real poly list \<Rightarrow> real set \<Rightarrow> rat list set"
   where "consistent_sign_vectors_r qs S = (signs_at qs) ` S"
 
 lemma consistent_sign_vectors_consistent_sign_vectors_r:
   shows"consistent_sign_vectors_r (cast_rat_list qs) S = consistent_sign_vectors qs S"
   unfolding consistent_sign_vectors_r_def cast_rat_list_def consistent_sign_vectors_def
     sign_vec_def signs_at_def
   by auto
 
 (* Relies on coprime_rat_poly_real_poly *)
 lemma coprime_over_reals_coprime_over_rats:
   fixes qs:: "rat poly list"
   assumes csa_in: "csa \<in> (consistent_sign_vectors qs UNIV)"
   assumes p1p2: "p1\<noteq>p2 \<and> p1 < length csa \<and> p2 < length csa \<and> csa ! p1 = 0 \<and> csa ! p2 = 0"
   shows "\<not> algebraic_semidom_class.coprime (nth qs p1) (nth qs p2) "
 proof - 
   have isx: "\<exists>(x::real). csa = (sign_vec qs x)" 
     using csa_in unfolding consistent_sign_vectors_def by auto
   then obtain x where havex: "csa = (sign_vec qs x)" by auto
   then have expolys: "poly (real_of_rat_poly (nth qs p1)) x = 0 \<and> poly (real_of_rat_poly (nth qs p2)) x = 0"
     using havex unfolding sign_vec_def squash_def
-    by (smt class_field.neg_1_not_0 length_map map_map nth_map one_neq_zero p1p2)
+    by (smt (verit) class_field.neg_1_not_0 length_map map_map nth_map one_neq_zero p1p2)
   then have "\<not> coprime (real_of_rat_poly (nth qs p1)) ((real_of_rat_poly (nth qs p2))::real poly)"
-    apply (auto) using coprime_poly_0 
-    by blast 
+    using coprime_poly_0 by force
   then show ?thesis
     using coprime_rat_poly_real_poly by auto
 qed
 
 (* This and the following lemma are designed to show that if you have two sgas that aren't the same, 
    there's a 0 in between! The proof uses IVT. It hones in on the component that's changed sign 
    (either from 1 to {0, -1} or from -1 to {0, 1}) *)
 lemma zero_above: 
   fixes qs:: "rat poly list"
   fixes x1:: "real"
   assumes hnz: "has_no_zeros (sign_vec qs x1)"
   shows "(\<forall> x2 > x1. ((sign_vec qs x1) \<noteq> (sign_vec qs x2)) \<longrightarrow> 
   (\<exists>(r::real) > x1. (r \<le> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0))))"
 proof clarsimp 
   fix x2
   assume x1_lt: "x1 < x2"
   assume diff_sign_vec: "sign_vec qs x1 \<noteq> sign_vec qs x2"
   then have "\<exists>q \<in> set qs. squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
     unfolding sign_vec_def
     by simp 
   then obtain q where q_prop: "q \<in> set qs \<and> squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
     by auto
   then have q_in: "q \<in> set qs" by auto
   have poss1: "squash (rpoly q x1) = -1 \<and> squash (rpoly q x2) = 1 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
     using poly_IVT_pos[of x1 x2] using x1_lt unfolding squash_def apply (auto)
     using q_prop by fastforce 
   have poss2: "squash (rpoly q x1) = 1 \<and> squash (rpoly q x2) = -1 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
     using poly_IVT_neg[of x1 x2] using x1_lt unfolding squash_def apply (auto)
     using q_prop by fastforce 
   have poss3: "squash (rpoly q x2) = 0 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
     using x1_lt unfolding squash_def apply (auto)
     using q_prop by blast
   have "(q \<in> set qs \<and> rpoly q x1 = 0) \<longrightarrow> \<not>has_no_zeros (sign_vec qs x1)"
-    unfolding has_no_zeros_def sign_vec_def apply auto
-    by (smt image_iff squash_def)
+    unfolding has_no_zeros_def sign_vec_def
+    by (smt (verit) image_eqI list.set_map o_apply squash_def)
   have not_poss4: "squash (rpoly q x1) \<noteq> 0" 
     using hnz q_in unfolding squash_def
     using \<open>q \<in> set qs \<and> rpoly q x1 = 0 \<longrightarrow> \<not> has_no_zeros (sign_vec qs x1)\<close> by auto 
   then show "\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0)"
-    using q_prop poss1 poss2 poss3 not_poss4 
-    apply (auto)
-     apply (meson squash_def)
-      apply (metis squash_def)
-       apply (metis squash_def) by (meson squash_def)
+    using q_prop poss1 poss2 poss3 not_poss4 by (metis (no_types, lifting) squash_def) 
 qed
 
 lemma zero_below: 
   fixes qs:: "rat poly list"
   fixes x1:: "real"
   assumes hnz: "has_no_zeros (sign_vec qs x1)"
   shows "\<forall>x2 < x1. ((sign_vec qs x1) \<noteq> (sign_vec qs x2)) \<longrightarrow> 
   (\<exists>(r::real) < x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
 proof clarsimp 
   fix x2
   assume x1_gt: "x2 < x1"
   assume diff_sign_vec: "sign_vec qs x1 \<noteq> sign_vec qs x2"
   then have "\<exists>q \<in> set qs. squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
     unfolding sign_vec_def
     by simp 
   then obtain q where q_prop: "q \<in> set qs \<and> squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
     by auto
   then have q_in: "q \<in> set qs" by auto
   have poss1: "squash (rpoly q x1) = -1 \<and> squash (rpoly q x2) = 1 \<longrightarrow> (\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
     using poly_IVT_neg[of x2 x1] using x1_gt unfolding squash_def apply (auto)
     using q_prop by fastforce 
   have poss2: "squash (rpoly q x1) = 1 \<and> squash (rpoly q x2) = -1 \<longrightarrow> (\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
     using poly_IVT_pos[of x2 x1] using x1_gt unfolding squash_def apply (auto)
     using q_prop by fastforce 
   have poss3: "squash (rpoly q x2) = 0 \<longrightarrow> (\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
     using x1_gt unfolding squash_def apply (auto)
     using q_prop by blast
   have "(q \<in> set qs \<and> rpoly q x1 = 0) \<longrightarrow> \<not>has_no_zeros (sign_vec qs x1)"
-    unfolding has_no_zeros_def sign_vec_def apply auto
-    using image_iff squash_def
-    by (smt image_iff squash_def)
+    unfolding has_no_zeros_def sign_vec_def
+    by (smt (verit) comp_apply image_eqI list.set_map squash_def)
   have not_poss4: "squash (rpoly q x1) \<noteq> 0" 
     using hnz q_in unfolding squash_def
     using \<open>q \<in> set qs \<and> rpoly q x1 = 0 \<longrightarrow> \<not> has_no_zeros (sign_vec qs x1)\<close> by auto 
   then show "(\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
-    using q_prop poss1 poss2 poss3 not_poss4 apply (auto)
-    apply (meson squash_def)
-     apply (metis squash_def)
-      apply (metis squash_def)
-       by (meson squash_def)
+    using q_prop poss1 poss2 poss3 not_poss4 by (metis (no_types, lifting) squash_def)
 qed
 
 lemma sorted_list_lemma:
   fixes l:: "real list"
   fixes a b:: "real"
   fixes n:: "nat"
   assumes "a < b"
   assumes "(n + 1) < length l"
   assumes strict_sort: "sorted_wrt (<) l"
   assumes lt_a: "(l ! n) < a"
   assumes b_lt: "b < (l ! (n+1))"
   shows "\<not>(\<exists>(x::real). (List.member l x \<and> a \<le> x \<and> x \<le> b))"
 proof -
   have sorted_hyp_var: "\<forall>q1 < length l. \<forall>q2 < length l. (q1 < q2 \<longrightarrow>
      (l ! q1) < (l ! q2))" 
     using strict_sort by (auto simp: sorted_wrt_iff_nth_less)
   then have sorted_hyp_var2:  "\<forall>q1 < length l. \<forall>q2 < length l. ((l ! q1) < (l ! q2)) \<longrightarrow> q1 < q2"
     using linorder_neqE_nat
     by (metis Groups.add_ac(2) add_mono_thms_linordered_field(5) less_irrefl) 
   have "(\<exists>(x::real). (List.member l x \<and> a \<le> x \<and> x \<le> b)) \<Longrightarrow> False"
   proof -
     assume "(\<exists>(x::real). (List.member l x \<and> a \<le> x \<and> x \<le> b))"
     then obtain x where x_prop: "List.member l x \<and> a \<le> x \<and> x \<le> b" by auto
     then have l_prop: "List.member l x \<and> (l ! n) < x \<and> x < (l ! (n+1))"
       using lt_a b_lt by auto
     have nth_l: "l ! n < x" using l_prop by auto
     have np1th_l: "x < l ! (n+1)" using l_prop by auto
     have "\<exists>k. k < length l \<and> nth l k = x" using l_prop
       by (meson in_set_member index_of_lookup(1) index_of_lookup(2))
     then obtain k where k_prop: "k < length l \<and> nth l k = x" by auto
     have n_lt: "n < k"
       using nth_l sorted_hyp_var k_prop add_lessD1 assms(2) linorder_neqE_nat nat_SN.gt_trans
       by (meson sorted_hyp_var2)
     have k_gt: "k < n + 1" 
       using sorted_hyp_var np1th_l k_prop
       using assms(2) sorted_hyp_var2 by blast 
     show False 
       using n_lt k_gt by auto
   qed
   then show ?thesis by auto
 qed
 
 (* This lemma shows that any zero of coprime_r is either between two roots or it's smaller than the 
 least root (neg inf) or it's greater than the biggest root (pos inf). *)
 lemma roots_of_coprime_r_location_property: 
   fixes qs:: "rat poly list"
   fixes sga:: "rat list"
   fixes zer_list
   assumes pairwise_rel_prime: "pairwise_coprime_list qs"
   assumes all_squarefree: "\<And>q. q \<in> set qs \<Longrightarrow> rsquarefree q"
   assumes x1_prop: "sga = sign_vec qs x1"
   assumes hnz: "has_no_zeros sga"
   assumes zer_list_prop: "zer_list = sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (rpoly q x = 0))}"
   shows "zer_list \<noteq> [] \<longrightarrow> ((x1 < (zer_list ! 0)) \<or> (x1 > (zer_list ! (length zer_list - 1)) \<or>
     (\<exists> n < (length zer_list - 1). x1 > (zer_list ! n) \<and> x1 < (zer_list ! (n+1)))))"
 proof - 
   let ?zer_list = "sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (rpoly q x = 0))} :: real list"
   show ?thesis 
   proof -
     have "((\<forall>q. (List.member qs q) \<longrightarrow> q \<noteq> 0) \<and> has_no_zeros (sign_vec qs x1)) \<Longrightarrow> \<not> List.member ?zer_list x1"
     proof (induct qs)
       case Nil
       then show ?case  apply (auto)
         by (simp add: member_rec(2)) 
     next
       case (Cons a qs)
       then show ?case 
       proof clarsimp 
         assume imp: "((\<forall>q. List.member qs q \<longrightarrow> q \<noteq> 0) \<and>
      has_no_zeros (sign_vec qs x1) \<Longrightarrow>
      \<not> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0})
          x1)"
         assume nonz: "\<forall>q. List.member (a # qs) q \<longrightarrow> q \<noteq> 0"
         assume hnz: " has_no_zeros (sign_vec (a # qs) x1)"
         assume mem_list: "List.member
      (sorted_list_of_set {x. rpoly a x = 0 \<or> (\<exists>q\<in>set qs. rpoly q x = 0)})
      x1"
         have "has_no_zeros (sign_vec (a # qs) x1) \<Longrightarrow> has_no_zeros (sign_vec qs x1)"
         proof - 
           assume hnz: "has_no_zeros (sign_vec (a # qs) x1)"
           have same_vec: "sign_vec (a # qs) x1 = ((if rpoly a x1 > 0 then 1 else if rpoly a x1 = 0 then 0 else -1) # sign_vec (qs) x1)"
             unfolding sign_vec_def squash_def by auto
           have "has_no_zeros ((if rpoly a x1 > 0 then 1 else if rpoly a x1 = 0 then 0 else -1) # sign_vec (qs) x1)
             \<Longrightarrow>  has_no_zeros (sign_vec (qs) x1)"
             by (simp add: has_no_zeros_def)
           then show "has_no_zeros (sign_vec qs x1)" using hnz same_vec by auto
         qed
         then have nmem: "\<not> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) x1"
           using hnz nonz imp apply (auto)
           by (simp add: member_rec(1))
         have "\<forall>q \<in>set qs. q \<noteq> 0"
           using nonz using in_set_member apply (auto) by fastforce 
         then have "\<forall>q \<in>set qs. finite {x. rpoly q x = 0}"
           by (simp add: poly_roots_finite)
         then have fin_set: "finite {x. \<exists>q\<in>set qs. rpoly q x = 0}"
           by auto
         have not_in: "x1 \<notin> {x. \<exists>q\<in>set qs. rpoly q x = 0}" using fin_set nmem set_sorted_list_of_set
             all_squarefree
           apply (auto)
           by (simp add: List.member_def \<open>finite {x. \<exists>q\<in>set qs. rpoly q x = 0}\<close>)
         have x1_in: "x1 \<in> {x. rpoly a x = 0 \<or> (\<exists>q\<in>set qs. rpoly q x = 0)}"
           using mem_list sorted_list_of_set 
         proof -
           have f1: "\<forall>r R. ((r::real) \<in> R \<or> \<not> List.member (sorted_list_of_set R) r) \<or> infinite R"
             by (metis in_set_member set_sorted_list_of_set)
           have "finite {r. rpoly a (r::real) = 0}"
             by (metis (full_types) List.finite_set member_rec(1) nonz real_roots_of_rat_poly(1))
           then show ?thesis
             using f1 \<open>finite {x. \<exists>q\<in>set qs. rpoly q x = 0}\<close> mem_list by fastforce
         qed
         have "rpoly a x1 \<noteq> 0" using hnz 
           unfolding has_no_zeros_def sign_vec_def squash_def by auto
         then show "False" using not_in x1_in 
           by auto
       qed
     qed
     then have non_mem: "\<not> List.member ?zer_list x1"
       using all_squarefree unfolding rsquarefree_def hnz apply (auto)
       using hnz x1_prop
       by (simp add: in_set_member) 
     have "?zer_list \<noteq> [] \<Longrightarrow> ((x1 \<ge> (?zer_list ! 0)) \<and> (x1 \<le> (?zer_list ! (length ?zer_list - 1))))
 \<Longrightarrow> (\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1)))"
     proof - 
-      assume "?zer_list \<noteq> []"
+      assume nonempty: "?zer_list \<noteq> []"
       assume x1_asm: "(x1 \<ge> (?zer_list ! 0)) \<and> (x1 \<le> (?zer_list ! (length ?zer_list - 1)))"
       have nm1: "x1 \<noteq> ?zer_list ! 0" using non_mem
         using \<open>sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} \<noteq> []\<close> in_set_member
         by (metis (no_types, lifting) in_set_conv_nth length_greater_0_conv)
       have nm2: "x1 \<noteq> ?zer_list ! (length ?zer_list -1)" using non_mem
         by (metis (no_types, lifting) One_nat_def \<open>sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} \<noteq> []\<close> diff_Suc_less in_set_member length_greater_0_conv nth_mem) 
       then have x_asm_var: "x1 > (?zer_list ! 0) \<and> x1 < ?zer_list ! (length ?zer_list -1)"
         using x1_asm nm1 nm2 by auto
       have "(\<forall>n. (n < (length ?zer_list - 1) \<and>  x1 \<ge> (?zer_list ! n) \<longrightarrow> x1 \<ge> (?zer_list ! (n+1)))) \<Longrightarrow> False"
       proof - 
         assume assump: "(\<forall>n. (n < (length ?zer_list - 1) \<and>  x1 \<ge> (?zer_list ! n) \<longrightarrow> x1 \<ge> (?zer_list ! (n+1))))"
         have zer_case: "x1 \<ge> ?zer_list ! 0" using x_asm_var by auto
         have all_n: "\<And> n. (n < (length ?zer_list - 1) \<longrightarrow> x1 \<ge> ?zer_list ! n) "
         proof -
           fix n
           show n_lt: "(n < (length ?zer_list - 1) \<longrightarrow> x1 \<ge> ?zer_list ! n)"
           proof (induct n)
             case 0
             then show ?case using zer_case
               by blast 
           next
             case (Suc n)
             then show ?case 
               using assump
               using Suc_eq_plus1 Suc_lessD by presburger 
           qed
         qed
         have "(length ?zer_list - 2) \<le> length ?zer_list -1"
           using diff_le_mono2 one_le_numeral by blast 
         have "x1 \<ge> ?zer_list ! (length ?zer_list - 1)"
         proof -
           have h1: "length ?zer_list = 1 \<longrightarrow> x1 \<ge> ?zer_list ! (length ?zer_list - 1)"
             using assump zer_case by auto
           have h2: "length ?zer_list > 1 \<longrightarrow> x1 \<ge> ?zer_list ! (length ?zer_list - 1)"
             using all_n assump apply (auto)
             by (metis (mono_tags, lifting) Suc_diff_Suc lessI) 
           then show ?thesis using h1 h2 apply (auto)
             using zer_case by blast
         qed
         then show False using all_n x_asm_var  
           by linarith 
       qed
       then show ?thesis
         using x1_asm
-        by (smt One_nat_def Suc_pred \<open>sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} \<noteq> []\<close> in_set_member length_greater_0_conv less_SucI non_mem nth_mem) 
+        by (smt (verit) One_nat_def Suc_pred nonempty in_set_member length_greater_0_conv less_SucI non_mem nth_mem) 
     qed
     then have h1: "(?zer_list \<noteq> [] \<and> (x1 \<ge> (?zer_list ! 0)) \<and> (x1 \<le> (?zer_list ! (length ?zer_list - 1))) \<Longrightarrow>
       (\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1))))"
       by blast
-    then show ?thesis apply (auto)
-      using zer_list_prop not_less
-      by auto 
+    then show ?thesis
+      using zer_list_prop not_less by auto 
   qed
 qed
 
 (* This lemma is essentially saying that the zeros of coprime_r capture all relevant sample points.
 From roots_of_coprime_r_location_property, we know that any zero of coprime_r is either between two 
   roots, or it's smaller than the least root (neg inf), or it's greater than the biggest root (pos inf).
 Then, since the polynomials have constant signs within those intervals, the zeros of coprime_r 
   capture all the relevant information.
 *)
 lemma roots_of_coprime_r_capture_sgas_without_zeros: 
   fixes qs:: "rat poly list"
   fixes sga:: "rat list"
   assumes pairwise_rel_prime: "pairwise_coprime_list qs"
   assumes all_squarefree: "\<And>q. q \<in> set qs \<Longrightarrow> rsquarefree q"
   assumes ex_x1: "sga = sign_vec qs x1"
   assumes hnz: "has_no_zeros sga"
   shows "(\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). sga = (sign_vec qs w))"
 proof - 
   obtain x1 where x1_prop: "sga = (sign_vec qs x1)" using ex_x1 by auto
   let ?zer_list = "sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (rpoly q x = 0))} :: real list"
   have strict_sorted_h: "sorted_wrt (<) ?zer_list" using sorted_sorted_list_of_set
       strict_sorted_iff by auto
   then have sorted_hyp: "\<forall>q < length ?zer_list. (q + 1 < length ?zer_list) \<longrightarrow>
      (?zer_list ! q) < (?zer_list ! (q +1))" 
     using strict_sorted_h by (auto simp: sorted_wrt_iff_nth_less)
   then have sorted_hyp_var: "\<forall>q1 < length ?zer_list. \<forall>q2 < length ?zer_list. (q1 < q2 \<longrightarrow>
      (?zer_list ! q1) < (?zer_list ! q2))"
     using sorted_wrt_iff_nth_less strict_sorted_h by blast
   then have sorted_hyp_var2: "\<forall>q1 < length ?zer_list. ((?zer_list ! q1)::real) \<le> (?zer_list ! (length ?zer_list - 1))"
     by (smt (verit, ccfv_SIG) One_nat_def Suc_pred bot_nat_0.extremum less_Suc_eq_le less_le not_less)
   have nonz_q: "\<forall>q \<in>set qs. q \<noteq> 0"
     using all_squarefree unfolding rsquarefree_def using in_set_member by auto 
   then have "\<forall>q \<in>set qs. finite {x. rpoly q x = 0}"
     by (simp add: poly_roots_finite)
   then have fin_set: "finite {x. \<exists>q\<in>set qs. rpoly q x = 0}"
     by auto
   have x1_and_roots: "?zer_list \<noteq> [] \<longrightarrow> ((x1 < (?zer_list ! 0)) \<or> (x1 > (?zer_list ! (length ?zer_list - 1)) \<or>
     (\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1)))))" 
     using roots_of_coprime_r_location_property x1_prop assms by auto
   have x2gt: "\<forall>x2>x1. sign_vec qs x1 \<noteq> sign_vec qs x2 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))" 
     using hnz x1_prop zero_above[of qs x1] by auto
   have x2lt: "\<forall>x2<x1. sign_vec qs x1 \<noteq> sign_vec qs x2 \<longrightarrow> (\<exists>r<x1. x2 \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
     using hnz x1_prop zero_below[of qs x1] by (auto) 
   have triv_neg_inf_h: "?zer_list = [] \<Longrightarrow>  sga = (sign_vec qs (-crb (prod_list (cast_rat_list qs))))" 
   proof -
     assume empty_zer: "(?zer_list:: real list) = []"
     let ?zer_set = "{x. \<exists>q\<in>set qs. rpoly q x = 0}:: real set"
     have fin_zer: "finite ?zer_set" using fin_set by auto
     have "finite ?zer_set \<Longrightarrow> (sorted_list_of_set ?zer_set = []) = (?zer_set = {})" 
       using fin_zer sorted_list_of_set_eq_Nil_iff[where A = "?zer_set"]  by auto
     then have "(sorted_list_of_set ?zer_set = []) = (?zer_set = {})"
       using fin_zer by auto
     then have nozers: "?zer_set = {}"
       using empty_zer by auto
     then have "\<not>(\<exists>(r::real). (\<exists>(q::rat poly)\<in>set qs. rpoly q r = 0))"
       using nozers by auto
     then have "\<forall>y. sign_vec qs x1 = sign_vec qs y"
     proof -
       fix y
       have gt_prop: "x1 > y \<longrightarrow> sign_vec qs x1 = sign_vec qs y"
         using hnz x1_prop zero_below[of qs x1] apply (auto)
         using \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> by blast
       have lt_prop: "x1 < y \<longrightarrow> sign_vec qs x1 = sign_vec qs y"
         using zero_above[of qs x1] apply (auto)
         using \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> x2gt by blast 
       show ?thesis using gt_prop lt_prop apply (auto)
         apply (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom x2gt x2lt)
         using x2gt x2lt apply (auto)
         apply (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom)
         apply (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom)
         by (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom)
     qed
     then show ?thesis
       by (simp add: x1_prop) 
   qed
   have neg_inf_h: "?zer_list \<noteq>[] \<Longrightarrow> (x1 < (?zer_list ! 0) \<Longrightarrow> sga = (sign_vec qs (-crb (prod_list (cast_rat_list qs)))))" 
   proof - 
     let ?neg_crb = "-crb (prod_list (cast_rat_list qs))"
     assume len_nontriv: "?zer_list \<noteq>[]"
     assume x1_lt: "x1 < ?zer_list ! 0"
     have r_gt: "\<forall>r. (\<exists>q\<in>set qs. rpoly q r = 0) \<longrightarrow> r \<ge> (?zer_list ! 0)"
     proof clarsimp 
       fix q::"rat poly"
       fix r:: "real"
       assume q_in: "q \<in> set qs" 
       assume "rpoly q r = 0"
       then have "r \<in>  {x. \<exists>q\<in>set qs. rpoly q x = 0}" using q_in by auto
       then have "List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) r" 
-        using  in_set_member set_sorted_list_of_set fin_set apply (auto)
-        by (smt \<open>r \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}\<close> fin_set in_set_member set_sorted_list_of_set) 
+        using  in_set_member set_sorted_list_of_set fin_set by (smt (verit, best))
       then show "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! 0 \<le> r"
         using sorted_hyp_var
         by (metis (no_types, lifting) gr_implies_not0 in_set_conv_nth in_set_member not_less sorted_iff_nth_mono sorted_sorted_list_of_set) 
     qed
     have prod_zer: "\<forall>x. (\<exists>q\<in>set qs. rpoly q x = 0) \<longrightarrow> (poly (prod_list (cast_rat_list qs)) x) = 0"
-      using prod_list_zero_iff[where xs = "(cast_rat_list qs)"] unfolding cast_rat_list_def
-      apply (auto)
-      using nonz_q apply blast
-      by (metis (no_types, opaque_lifting) image_eqI list.set_map of_rat_poly_hom.prod_list_map_hom poly_prod_list_zero_iff) 
-    have "?zer_list \<noteq>[] \<longrightarrow> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0})
-     (?zer_list ! 0)" 
+      using prod_list_zero_iff[where xs = "(cast_rat_list qs)"]
+      by (metis cast_rat_list_def image_eqI list.set_map poly_prod_list_zero_iff)
+    have "?zer_list \<noteq>[] \<longrightarrow> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) (?zer_list ! 0)" 
       using nth_Cons_0 apply (auto)
       by (meson gr0I in_set_member length_0_conv nth_mem) 
     then have "?zer_list \<noteq>[] \<longrightarrow> (?zer_list ! 0)
    \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}"
       using in_set_member[where x = "(sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! 0)",
           where xs = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}"]
           set_sorted_list_of_set fin_set
       by blast 
     then have "?zer_list \<noteq>[] \<longrightarrow> (\<exists>q\<in>set qs. rpoly q (?zer_list ! 0) = 0)"
       by blast
     then have poly_zer: "?zer_list \<noteq>[] \<longrightarrow> (poly (prod_list (cast_rat_list qs)) (?zer_list ! 0)) = 0" 
       using prod_zer by auto
     have "\<forall>q. List.member (cast_rat_list qs) q \<longrightarrow>q \<noteq> 0" using nonz_q
       unfolding cast_rat_list_def using in_set_member imageE image_set map_poly_zero of_rat_eq_0_iff
-      by smt
+      by (smt (verit, best))
     then have "(prod_list (cast_rat_list qs)) \<noteq> 0"
-      using prod_list_zero_iff in_set_member apply (auto)
-      by fastforce 
+      using prod_list_zero_iff in_set_member by fastforce 
     then have crb_lt: "?zer_list \<noteq>[] \<longrightarrow> ?neg_crb < ?zer_list ! 0"
       using crb_lem_neg[where p = "(prod_list (cast_rat_list qs))", where x = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! 0"] apply (auto) 
       using poly_zer
       by blast 
     have crb_gt_x1: "?zer_list \<noteq>[] \<longrightarrow> (?neg_crb > x1 \<longrightarrow> (sga \<noteq> (sign_vec qs ?neg_crb)) \<longrightarrow> (\<exists>r>x1. r \<le> ?neg_crb \<and> (\<exists>q\<in>set qs. rpoly q r = 0)))"
-      using x2gt apply (auto)
-      using crb_lt r_gt x1_prop by fastforce 
+      using x2gt crb_lt r_gt x1_prop by fastforce 
     have crb_lt_x1: "?neg_crb < x1 \<longrightarrow> (sga \<noteq> (sign_vec qs ?neg_crb)) \<longrightarrow> (\<exists>r<x1. ?neg_crb \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
-      using x2lt apply (auto)
-      using x1_lt r_gt x1_prop by fastforce  
-    show ?thesis using len_nontriv crb_gt_x1 crb_lt_x1  x1_lt crb_lt r_gt  apply (auto)
-      using x1_prop by blast 
+      using x2lt x1_lt r_gt x1_prop by fastforce  
+    show ?thesis using len_nontriv crb_gt_x1 crb_lt_x1  x1_lt crb_lt r_gt 
+      using x1_prop by auto 
   qed
   have pos_inf_h: "?zer_list \<noteq> [] \<Longrightarrow> (x1 > (?zer_list ! (length ?zer_list - 1)) \<Longrightarrow> sga = (sign_vec qs (crb (prod_list (cast_rat_list qs)))))" 
   proof - 
     let ?pos_crb = "crb (prod_list (cast_rat_list qs))"
     assume len_nontriv: "?zer_list \<noteq>[]"
     assume x1_lt: "x1 > ?zer_list ! (length ?zer_list - 1)"
     have r_gt: "\<And>r. (\<exists>q\<in>set qs. rpoly q r = 0) \<Longrightarrow> r \<le> (?zer_list ! (length ?zer_list - 1))"
     proof - 
       fix r:: "real"
       assume q_in: "(\<exists>q\<in>set qs. rpoly q r = 0)" 
       then obtain q::"rat poly" where q_prop: "q \<in> set qs \<and> rpoly q r = 0" by auto
       then have "r \<in>  {x. \<exists>q\<in>set qs. rpoly q x = 0}" using q_in by auto
       then have "List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) r" 
-        using in_set_member set_sorted_list_of_set fin_set by smt    
+        using in_set_member set_sorted_list_of_set fin_set by (smt (verit))
       then have "\<exists>n < (length ?zer_list). r = ?zer_list ! n"
         by (metis (no_types, lifting) in_set_conv_nth in_set_member)
       then obtain n where n_prop: "n < length ?zer_list \<and> r = ?zer_list ! n"
         by auto
       then show "r \<le> (?zer_list ! (length ?zer_list - 1))"
       proof - 
         have "\<forall>q1. q1 < length ?zer_list \<longrightarrow> (?zer_list ! q1) \<le> (?zer_list ! (length ?zer_list - 1:: nat))"
           using sorted_hyp_var2 by auto
         then have "(?zer_list ! n) \<le> (?zer_list ! (length ?zer_list - 1))"
           using n_prop by auto
         then show ?thesis using n_prop by auto
       qed
     qed
     have prod_zer: "\<forall>x. (\<exists>q\<in>set qs. rpoly q x = 0) \<longrightarrow> (poly (prod_list (cast_rat_list qs)) x) = 0"
       using prod_list_zero_iff[where xs = "(cast_rat_list qs)"] unfolding cast_rat_list_def
       apply (auto)
       using nonz_q apply blast
       by (metis (no_types, opaque_lifting) image_eqI list.set_map of_rat_poly_hom.prod_list_map_hom poly_prod_list_zero_iff) 
     have "?zer_list \<noteq>[] \<longrightarrow> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0})
      (?zer_list ! (length ?zer_list -1))" 
       using nth_Cons_0 apply (auto)
       by (metis (no_types, lifting) diff_less in_set_conv_nth in_set_member length_greater_0_conv length_sorted_list_of_set zero_less_Suc) 
     then have "?zer_list \<noteq>[] \<longrightarrow> (?zer_list ! (length ?zer_list -1))
    \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}"
       using in_set_member[where x = "(sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! (length ?zer_list -1))",
           where xs = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}"]
           set_sorted_list_of_set fin_set
       by blast 
     then have "?zer_list \<noteq>[] \<longrightarrow> (\<exists>q\<in>set qs. rpoly q (?zer_list ! (length ?zer_list -1)) = 0)"
       by blast
     then have poly_zer: "?zer_list \<noteq>[] \<longrightarrow> (poly (prod_list (cast_rat_list qs)) (?zer_list ! (length ?zer_list -1))) = 0" 
       using prod_zer by auto
     have "\<forall>q. List.member (cast_rat_list qs) q \<longrightarrow>q \<noteq> 0" using nonz_q
       unfolding cast_rat_list_def using in_set_member imageE image_set map_poly_zero of_rat_eq_0_iff
-      by smt 
+      by (smt (verit)) 
     then have "(prod_list (cast_rat_list qs)) \<noteq> 0"
       using prod_list_zero_iff in_set_member apply (auto)
       by fastforce 
     then have crb_lt: "?zer_list \<noteq>[] \<longrightarrow> ?pos_crb > ?zer_list ! (length ?zer_list -1)"
       using crb_lem_pos[where p = "(prod_list (cast_rat_list qs))", where x = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! (length ?zer_list -1)"] apply (auto) 
       using poly_zer
       by simp 
     have crb_gt_x1: "?zer_list \<noteq>[] \<longrightarrow> ((?pos_crb::real) > (x1::real) \<longrightarrow> (sga \<noteq> (sign_vec (qs::rat poly list) (?pos_crb::real))) \<longrightarrow> (\<exists>(r::real)<x1. r \<ge> ?pos_crb \<and> (\<exists>(q::rat poly)\<in>set qs. rpoly q r = 0)))"
       using x2gt apply (auto)
       using crb_lt r_gt x1_prop 
       using x1_lt by fastforce 
     have crb_lt_x1: "?pos_crb < x1 \<longrightarrow> (sga \<noteq> (sign_vec qs ?pos_crb)) \<longrightarrow> (\<exists>r>x1. ?pos_crb \<ge> r \<and> (\<exists>q\<in>set qs. poly (real_of_rat_poly q) r = 0))"
       using x2lt apply (auto)
       using x1_lt r_gt x1_prop
       by (meson \<open>prod_list (cast_rat_list qs) \<noteq> 0\<close> crb_lem_pos not_less prod_zer) 
     show ?thesis using len_nontriv crb_gt_x1 crb_lt_x1  x1_lt crb_lt r_gt  apply (auto)
       using x1_prop
       by blast
   qed
   have between_h: "(\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1))) \<Longrightarrow> (\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). sga = (sign_vec qs w))"
   proof - 
     assume "(\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1)))"
     then obtain n where n_prop: "n < (length ?zer_list - 1) \<and> x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1))"
       by auto
     have "\<forall>q1 q2. (q1 \<noteq> q2 \<and> (List.member (cast_rat_list qs) q1) \<and> (List.member (cast_rat_list qs) q2))\<longrightarrow> coprime q1 q2"
       using pairwise_rel_prime coprime_rat_poly_iff_coprimereal_poly
       unfolding pairwise_coprime_list_def
-      by (smt cast_rat_list_def imageE image_set in_set_conv_nth in_set_member)
+      by (smt (verit) cast_rat_list_def imageE image_set in_set_conv_nth in_set_member)
     then have all_prop: "\<forall>x1. \<forall>x2. ((x1 < x2 \<and> (\<exists>q1 \<in> set (cast_rat_list(qs)). (poly q1 x1) = 0) \<and> (\<exists>q2\<in> set((cast_rat_list(qs))). (poly q2 x2) = 0)) \<longrightarrow> (\<exists>q. x1 < q \<and> q < x2 \<and> poly (coprime_r (cast_rat_list qs)) q = 0))"
       using coprime_r_roots_prop 
       by auto
     have exq1: "(\<exists>q1 \<in> set (cast_rat_list(qs)). (poly q1 (?zer_list ! n)) = 0)"
       unfolding cast_rat_list_def using n_prop apply (auto)
       by (smt (verit, ccfv_SIG) One_nat_def Suc_eq_plus1 Suc_lessD fin_set length_sorted_list_of_set less_diff_conv mem_Collect_eq nth_mem set_sorted_list_of_set)    
     have exq2: "(\<exists>q2 \<in> set (cast_rat_list(qs)). (poly q2 (?zer_list ! (n+1))) = 0)"
       unfolding cast_rat_list_def using n_prop One_nat_def Suc_eq_plus1 fin_set less_diff_conv mem_Collect_eq nth_mem set_sorted_list_of_set
       by (smt (verit, ccfv_SIG) image_eqI set_map)
     have n_prop2: "(((?zer_list ! n) < (?zer_list ! (n+1)) \<and> (\<exists>q1 \<in> set (cast_rat_list(qs)). (poly q1 (?zer_list ! n)) = 0) \<and> (\<exists>q2\<in> set((cast_rat_list(qs))). (poly q2 (?zer_list ! (n+1))) = 0)))"
       using exq1 exq2 sorted_hyp n_prop by auto
     then have "(\<exists>q. (?zer_list ! n) < q \<and> q < (?zer_list ! (n+1)) \<and> poly (coprime_r (cast_rat_list qs)) q = 0)" 
       using all_prop n_prop2 by auto
     then  have "\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). (?zer_list ! n) < w \<and> w < (?zer_list ! (n+1))"
       apply (auto)
       using roots_of_coprime_r_def by auto 
     then obtain w where w_prop: "w \<in> (roots_of_coprime_r (cast_rat_list qs)) \<and> (?zer_list ! n) < w \<and> w < (?zer_list ! (n+1))" by auto
     have n_lt1: "n < length ?zer_list" using n_prop
       using add_lessD1 less_diff_conv by blast
     have n_lt2: "n + 1 < length ?zer_list" using n_prop
       using less_diff_conv by blast 
     have sorted_hyp_var3: "?zer_list ! n  < ?zer_list ! (n + 1)" using sorted_hyp 
         n_lt1 n_lt2  by auto 
     then have helper: "w > x1 \<longrightarrow> \<not>(\<exists>(x::real). (List.member ?zer_list x \<and> x1 \<le> x \<and> x \<le> w))"
       using n_prop w_prop x1_prop strict_sorted_h sorted_list_lemma[where n = "n", where l = ?zer_list, where a = "x1", where b = "w"] sorted_hyp_var3 
       by auto
     have no_root1: "w > x1 \<Longrightarrow> \<not>(\<exists>r>x1. r \<le> w \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
     proof - 
       assume "w > x1"
       then have nex: "\<not>(\<exists>(x::real). (List.member ?zer_list x \<and> x1 \<le> x \<and> x \<le> w))"
         using helper by auto
       have "(\<exists>r>x1. r \<le> w \<and> (\<exists>q\<in>set qs. rpoly q r = 0)) \<Longrightarrow> False"
       proof -
         assume "(\<exists>r>x1. r \<le> w \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
         then obtain r where r_prop: "r > x1 \<and>r \<le> w \<and>(\<exists>q\<in>set qs. rpoly q r = 0)" by auto
         then have "List.member ?zer_list r \<and>x1 \<le> r \<and>x1 \<le> w "
-          by (smt fin_set in_set_member mem_Collect_eq set_sorted_list_of_set)
+          by (smt (verit, best) fin_set in_set_member mem_Collect_eq set_sorted_list_of_set)
         then show ?thesis using nex r_prop
           by blast 
       qed
       then show ?thesis by auto
     qed
     have helper2: "w < x1 \<longrightarrow> \<not>(\<exists>(x::real). (List.member ?zer_list x \<and> w \<le> x \<and> x \<le> x1))"
-      using n_prop w_prop x1_prop strict_sorted_h sorted_list_lemma[where n = "n", where l = ?zer_list, where a = "w", where b = "x1"] sorted_hyp_var3 
-      by auto
+      using n_lt2 n_prop sorted_list_lemma strict_sorted_h w_prop by blast
     have no_root2: "w < x1 \<Longrightarrow> \<not>(\<exists>r<x1. w \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0))" 
     proof - 
       assume "w < x1"
       then have nex: "\<not>(\<exists>(x::real). (List.member ?zer_list x \<and>  w \<le> x \<and> x \<le> x1))"
         using helper2 by auto
       have "(\<exists>r<x1. w \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0)) \<Longrightarrow> False"
       proof -
         assume "(\<exists>r<x1. w \<le> r\<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
         then obtain r where r_prop: "r < x1 \<and> w \<le> r \<and>(\<exists>q\<in>set qs. rpoly q r = 0)" by auto
         then have "List.member ?zer_list r \<and> w \<le> r \<and> r \<le> x1 "
-          by (smt fin_set in_set_member mem_Collect_eq set_sorted_list_of_set) 
+          by (smt (verit, best) fin_set in_set_member mem_Collect_eq set_sorted_list_of_set) 
         then show ?thesis using nex r_prop
           by blast 
       qed
       then show ?thesis by auto
     qed
     then have w_gt: "w > x1 \<longrightarrow> (sign_vec qs x1) = (sign_vec qs w)"
       using no_root1 n_prop x2gt by auto
     have w_lt: "w < x1 \<longrightarrow> (sign_vec qs x1)  = (sign_vec qs w)" 
       using no_root2 n_prop x2lt  by auto
     then have "sga = (sign_vec qs w)" using w_gt w_lt x1_prop by auto
     then show "(\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). sga = (sign_vec qs w))"
       using w_prop by auto
   qed
   show ?thesis using triv_neg_inf_h neg_inf_h pos_inf_h between_h x1_and_roots
     by (metis (mono_tags, lifting) coprime_r_zero1 coprime_r_zero2 mem_Collect_eq roots_of_coprime_r_def) 
 qed
 
 (* This lemma heavily relies on the main BKR_Proofs result and also the lemma named
   roots_of_coprime_r_capture_sgas_without_zeros *)
 lemma find_csas_lemma_nozeros:
   fixes qs:: "rat poly list"
   assumes fs: "factorize_polys qs = (fs,data)"
   assumes "fs \<noteq> []"
   shows "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa) \<longleftrightarrow> 
     csa \<in> set (find_consistent_signs_at_roots (coprime_r (cast_rat_list fs))  (cast_rat_list fs))"
 proof -
   let ?new_l = "cast_rat_list fs"
   let ?copr = "coprime_r ?new_l"
   have copr_nonz: "?copr \<noteq> 0"
     using coprime_r_nonzero[OF assms(1-2)] unfolding cast_rat_list_def by auto
   have nontriv_list: "0 < length ?new_l"
     using assms cast_rat_list_def by (auto)
   have pairwise_cp: "(\<And>q. q \<in> set ?new_l \<Longrightarrow>
        algebraic_semidom_class.coprime ?copr q)" using coprime_r_coprime_prop[OF assms(1)]
     apply (auto)
     by (metis cast_rat_list_def comm_monoid_mult_class.coprime_commute coprime_iff_coprime list.set_map) 
   have set_fsga: "set(find_consistent_signs_at_roots ?copr ?new_l) = set(characterize_consistent_signs_at_roots ?copr ?new_l)"
     using find_consistent_signs_at_roots[OF copr_nonz pairwise_cp] by auto
   then have csa_in_hyp: "csa \<in> set (find_consistent_signs_at_roots ?copr ?new_l)
       \<longleftrightarrow> csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)" by auto
   have forward: "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)
      \<Longrightarrow> csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)"
   proof - 
     assume csa_in: "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)"
     have fin: "finite {x. poly (coprime_r (cast_rat_list fs)) x = 0}"
       using copr_nonz poly_roots_finite
       by (simp add: poly_roots_finite fs)
     have pcl: "pairwise_coprime_list fs"
       using coprime_factorize fs
       by (metis fst_conv)
     have sqf: "\<And>q. q \<in> set fs \<Longrightarrow> rsquarefree q"
       using factorize_polys_square_free[OF assms(1)]
       by (metis square_free_rsquarefree) 
     obtain x1 where x1:"csa = sign_vec fs x1"
       using consistent_sign_vectors_def csa_in by auto 
     have hnz: "has_no_zeros csa" using csa_in by auto
     obtain w where w_prop: "w\<in>roots_of_coprime_r (cast_rat_list fs)" "csa = sign_vec fs w"
       using roots_of_coprime_r_capture_sgas_without_zeros[OF pcl sqf x1 hnz]
       by auto
     have w_root: "poly (coprime_r (cast_rat_list fs)) w = 0"
       using w_prop
       by (simp add: roots_of_coprime_r_def) 
     then have "w \<in> {x. poly (coprime_r (cast_rat_list fs)) x = 0}"
       by auto
     then have w_ins: "w \<in> set (characterize_root_list_p (coprime_r (cast_rat_list fs)))"
       using fin set_sorted_list_of_set[where A="{x. poly (coprime_r (cast_rat_list fs)) x = 0}"]
       unfolding characterize_root_list_p_def
       by auto
     have "map ((\<lambda>x. if 0 < x then 1 else if x < 0 then - 1 else 0) \<circ> (\<lambda>p. rpoly p w)) fs =
           map ((\<lambda>x. if 0 < x then 1 else - 1) \<circ> (\<lambda>p. rpoly p w)) fs"
     proof - 
       have "\<not>(\<exists>x \<in> set fs. rpoly x w = 0)"
       proof clarsimp 
         fix x
         assume x_in: "x \<in> set fs"
         assume x_zer: "rpoly x w = 0"
         then have "\<exists>k < length fs. nth fs k = x" 
           using x_in
           by (simp add: in_set_conv_nth) 
         then obtain k where k_prop: "k < length fs \<and> fs ! k = x"
           by auto
         then have "(sign_vec fs w) ! k = 0" using x_zer apply (auto) 
           unfolding sign_vec_def squash_def by auto
         then have "\<not> (has_no_zeros (sign_vec fs w))"
           apply (auto)
           by (simp add: hnz_prop k_prop)
         then show False using hnz unfolding sign_vec_def squash_def
           using \<open>\<not> has_no_zeros (sign_vec fs w)\<close> w_prop(2) by blast
       qed
       then show ?thesis using hnz unfolding sign_vec_def squash_def by auto
     qed
     then have "map ((\<lambda>x. if 0 < x then 1 else if x < 0 then - 1 else 0) \<circ> (\<lambda>p. rpoly p w)) fs =
     map (\<lambda>q. if 0 < poly q w then 1 else - 1)
      (cast_rat_list fs)" 
       unfolding cast_rat_list_def by auto
     then have "csa = map (\<lambda>q. if 0 < poly q w then 1 else - 1)
              (cast_rat_list fs)"
       by (simp add: comp_def sign_vec_def squash_def w_prop(2))    
     then show ?thesis unfolding characterize_consistent_signs_at_roots_def  
       apply (auto) unfolding signs_at_def using w_ins w_prop
       using consistent_sign_vectors_consistent_sign_vectors_r consistent_sign_vectors_def consistent_sign_vectors_r_def signs_at_def by force
   qed
   have backward: "csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l) \<Longrightarrow>
     (csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)"
   proof - 
     assume csa_in: "csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)"
     have csa_in_old_set: "csa \<in> set (characterize_consistent_signs_at_roots_copr ?copr ?new_l)"
       using csa_list_copr_rel copr_nonz csa_in find_consistent_signs_at_roots_copr pairwise_cp set_fsga by auto 
     have "\<forall>(x::real). \<forall> (l::real poly list). rec_list True (\<lambda>h T. If (h = 0) False)
           (map (\<lambda>q. if 0 < poly q x then (1::rat) else (-1::rat))
             l)" 
     proof clarsimp  
       fix x::"real"
       fix l::"real poly list"
       show " rec_list True (\<lambda>h T. If (h = 0) False)
             (map (\<lambda>q. if 0 < poly q x then (1::rat) else (-1::rat)) l) "
       proof (induct l)
         case Nil
         then show ?case
           by simp 
       next
         case (Cons a l)
         then show ?case by auto
       qed
     qed
     then have "\<forall>x. rec_list True (\<lambda>h T. If (h = 0) False)
           (map (\<lambda>q. if 0 < poly q x then (1::rat) else - 1)
             (cast_rat_list fs))" 
       by auto
     then have hnz: "has_no_zeros csa" 
       using csa_in_old_set
       unfolding characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def 
       apply (auto) unfolding has_no_zeros_def  
       by auto
     have "\<exists>w \<in> set(characterize_root_list_p ?copr). csa = consistent_sign_vec_copr ?new_l w" 
       using csa_in_old_set using characterize_consistent_signs_at_roots_copr_def by auto
     then obtain w where w_prop: "w \<in> set (characterize_root_list_p ?copr) \<and> csa = consistent_sign_vec_copr ?new_l w"
       by auto
     then have "poly ?copr w = 0" unfolding characterize_root_list_p_def
       by (simp add: copr_nonz poly_roots_finite)
     then have copr_prop: "\<forall>p \<in> set(?new_l). poly p w \<noteq> 0"
       using w_prop coprime_r_coprime_prop apply (auto)
       by (meson coprime_poly_0 in_set_member pairwise_cp) 
     then have "consistent_sign_vec_copr ?new_l w = sign_vec fs w"
       unfolding sign_vec_def squash_def consistent_sign_vec_copr_def
         cast_rat_list_def by auto
     then show ?thesis using hnz w_prop apply (auto)
       using consistent_sign_vectors_def by blast 
   qed
   have "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)
      \<longleftrightarrow> csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)"
     using forward backward by blast
   then show ?thesis using  csa_in_hyp by auto
 qed
 
 lemma range_eq: 
   fixes a
   fixes b
   shows "a = b \<longrightarrow> range a = range b"
   by simp
 
 lemma removeAt_distinct:
   shows "distinct fss \<Longrightarrow> distinct (removeAt i fss)"
   unfolding removeAt_def
   by (simp add: set_take_disj_set_drop_if_distinct)
 
 lemma consistent_signs_atw:
   assumes "\<And>p. p \<in> set fs \<Longrightarrow> poly p x \<noteq> 0"
   shows "consistent_sign_vec_copr fs x = signs_at fs x"
   unfolding consistent_sign_vec_copr_def signs_at_def squash_def o_def
   by (simp add: assms)
 
 (* This could be an alternate (equivalent) definition *)
 lemma characterize_consistent_signs_at_roots_rw:
   assumes "p \<noteq> 0"
   assumes copr: "\<And>q. q \<in> set fs \<Longrightarrow> coprime p q"
   shows "set (characterize_consistent_signs_at_roots p fs) =
     consistent_sign_vectors_r fs ({x. poly p x = 0})"
   by (simp add: assms(1) characterize_consistent_signs_at_roots_def consistent_sign_vectors_r_def poly_roots_finite characterize_root_list_p_def)
 
 lemma signs_at_insert:
   assumes "i \<le> length qs"
   shows "insertAt i (squash (poly p x)) (signs_at qs x) =
     signs_at (insertAt i p qs) x"
   unfolding insertAt_def signs_at_def o_def using assms take_map apply auto
   apply (subst drop_map) by simp
 
 lemma length_removeAt:
   assumes "i < length ls"
   shows "length (removeAt i ls) = length ls - 1"
   unfolding removeAt_def using assms by auto
 
 lemma insertAt_removeAt:
   assumes "i < length ls"
   shows "insertAt i (ls!i) (removeAt i ls) = ls"
   unfolding insertAt_def removeAt_def using assms apply auto
   by (simp add: Cons_nth_drop_Suc)
 
 lemma insertAt_nth:
   assumes "i \<le> length ls"
   shows "insertAt i n ls ! i = n"
   unfolding insertAt_def using assms
   by (simp add: nth_append_take)
 
 lemma length_signs_at[simp]:
   shows "length (signs_at qs x) = length qs"
   unfolding signs_at_def by auto
 
 lemma find_csa_at_index:
   assumes "i < length fss"
   assumes "\<And>p q. p \<in> set fss \<Longrightarrow> q \<in> set fss \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
   assumes "\<And>p. p \<in> set fss \<Longrightarrow> p \<noteq> 0"
   assumes "distinct fss"
   shows "
   set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) =
     {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}"
 proof -
   from removeAt_distinct[OF assms(4)]
   have neq: "fss ! i \<noteq> 0" using assms by simp
   have cop: "\<And>q. q \<in> set (removeAt i fss) \<Longrightarrow> coprime (fss ! i) q" using assms
     unfolding removeAt_def 
     apply auto
-    using dual_order.strict_trans find_first_unique image_iff less_imp_le_nat less_not_refl nth_image nth_mem
-    apply (smt atLeastLessThan_iff dual_order.strict_trans find_first_unique image_iff less_imp_le_nat less_not_refl nth_image nth_mem) 
+    apply (metis distinct_append in_set_takeD list_update_id not_distinct_conv_prefix nth_mem upd_conv_take_nth_drop)
       by (metis Cons_nth_drop_Suc distinct.simps(2) distinct_drop in_set_dropD nth_mem)
   from find_consistent_signs_at_roots[OF neq] 
   have "set (find_consistent_signs_at_roots (fss ! i) (removeAt i fss)) =
         set (characterize_consistent_signs_at_roots (fss ! i) (removeAt i fss))"
     using cop by auto
   then have eq:  "set (map (insertAt i 0)
           (find_consistent_signs_at_roots (fss ! i)
             (removeAt i fss))) = insertAt i 0 ` set (characterize_consistent_signs_at_roots (fss ! i) (removeAt i fss)) "
     by simp
   from characterize_consistent_signs_at_roots_rw[OF neq cop]
   have eq2: "set (characterize_consistent_signs_at_roots (fss ! i) (removeAt i fss)) = consistent_sign_vectors_r (removeAt i fss)  {x. poly (fss ! i) x = 0}" .
   have ile: "i \<le> length (removeAt i fss)"
     using  length_removeAt[OF assms(1)] assms(1) by linarith
   have 1: "\<And>xb. poly (fss ! i) xb = 0 \<Longrightarrow>
           insertAt i 0 (signs_at (removeAt i fss) xb) \<in> range (signs_at fss)"
   proof -
     fix x
     assume "poly (fss ! i) x = 0"
     then have "insertAt i 0 (signs_at (removeAt i fss) x) =
         insertAt i (squash (poly (fss ! i) x)) (signs_at (removeAt i fss) x)" by (auto simp add: squash_def)
     also have "... =  signs_at (insertAt i (fss ! i)  (removeAt i fss)) x" 
       apply (intro signs_at_insert)
       using  length_removeAt[OF assms(1)]
       using assms(1) by linarith
     also have "... = signs_at fss x" unfolding insertAt_removeAt[OF assms(1)] by auto
     ultimately have *:"insertAt i 0 (signs_at (removeAt i fss) x) = signs_at fss x" by auto
     thus "insertAt i 0 (signs_at (removeAt i fss) x) \<in> range (signs_at fss)" by auto
   qed
   have 2: "\<And>xa. signs_at fss xa ! i = 0 \<Longrightarrow>
           i \<le> length (removeAt i fss) \<Longrightarrow>
           signs_at fss xa
           \<in> insertAt i 0 `
              signs_at (removeAt i fss) `
              {x. poly (fss ! i) x = 0}"
   proof -
     fix x
     assume "signs_at fss x ! i = 0"
     then have z:"poly (fss ! i) x = 0" unfolding signs_at_def o_def squash_def
-      by (smt assms(1) class_field.zero_not_one nth_map zero_neq_neg_one)
+      by (smt (verit, best) assms(1) class_field.zero_not_one nth_map zero_neq_neg_one)
     then have "insertAt i 0 (signs_at (removeAt i fss) x) =
       insertAt i (squash (poly (fss ! i) x)) (signs_at (removeAt i fss) x)" by (auto simp add: squash_def)
     also have "... =  signs_at (insertAt i (fss ! i)  (removeAt i fss)) x" 
       apply (intro signs_at_insert)
       using  length_removeAt[OF assms(1)]
       using assms(1) by linarith
     also have "... = signs_at fss x" unfolding insertAt_removeAt[OF assms(1)] by auto
     ultimately have *:"insertAt i 0 (signs_at (removeAt i fss) x) = signs_at fss x" by auto
     thus "signs_at fss x \<in> insertAt i 0 ` signs_at (removeAt i fss) ` {x. poly (fss ! i) x = 0}"
       using z
       by (metis (mono_tags, lifting) mem_Collect_eq rev_image_eqI)
   qed
   have "insertAt i 0 ` consistent_sign_vectors_r (removeAt i fss)  {x. poly (fss ! i) x = 0} =
          {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}"
     unfolding consistent_sign_vectors_r_def
     apply (auto simp add: 1)
     apply (subst insertAt_nth)
     using ile by (auto simp add: 2)
   thus ?thesis unfolding eq eq2 .
 qed
 
 lemma in_set_concat_map:
   assumes "i < length ls"
   assumes "x \<in> set (f (ls ! i))"
   shows "x \<in> set (concat (map f ls))"
   using assms by auto
 
 lemma find_csas_lemma_onezero_gen:
   fixes qs:: "rat poly list"
   assumes fs: "factorize_polys qs = (fs,data)"
   assumes fss: "fss = cast_rat_list fs"
   shows "(csa \<in> (consistent_sign_vectors_r fss UNIV) \<and> \<not>(has_no_zeros csa))
     \<longleftrightarrow>  csa \<in> set (find_sgas_aux fss)"
 proof -
   have a:"(\<And>p q. p \<in> set fss \<Longrightarrow>
           q \<in> set fss \<Longrightarrow>
           p \<noteq> q \<Longrightarrow> coprime p
            q)"
     using cast_rat_list_def factorize_polys_map_coprime fs fss by blast 
   have b:"(\<And>p. p \<in> set fss \<Longrightarrow> p \<noteq> 0)"
     using factorize_polys_map_square_free_prod_list semidom_class.prod_list_zero_iff square_free_def
     using cast_rat_list_def fs fss by blast
   have c:"distinct fss"
     using factorize_polys_map_distinct[OF assms(1)] assms(2) unfolding cast_rat_list_def
     by auto
   have forwards: "csa \<in> (consistent_sign_vectors_r fss UNIV) \<Longrightarrow>
     \<not> (has_no_zeros csa)
     \<Longrightarrow> csa \<in> set (find_sgas_aux fss)"
     unfolding find_sgas_aux_def
   proof -
     assume csa: "csa \<in> (consistent_sign_vectors_r fss UNIV)"
     assume hnz: "\<not>(has_no_zeros csa)"
     then obtain i where i: "i < length csa" "csa ! i = 0" unfolding hnz_prop by auto
     then have cin: "csa \<in> {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" using csa by auto
     have 1:"i < length fss" using i csa unfolding consistent_sign_vectors_r_def by auto
     from find_csa_at_index[OF 1 a b c]
     have eq: "set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) =
       {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" by auto
     show "csa \<in> set (concat (map (\<lambda>i. map (insertAt i 0) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) [0..<length fss]))"
       using cin i unfolding eq[symmetric]
       apply (intro  in_set_concat_map[of i])
       using 1 by auto      
   qed
   have backwards: "csa \<in> set (find_sgas_aux fss) \<Longrightarrow>
     \<not> (has_no_zeros csa) \<and> csa \<in> (consistent_sign_vectors_r fss UNIV)"
   proof -
     assume *: "csa \<in> set (find_sgas_aux fss)"
     then obtain i where i: "i < length fss"
       "csa \<in> set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss)))"
       unfolding find_sgas_aux_def
       by auto
     from find_csa_at_index[OF i(1) a b c]
     have eq: "set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) =
       {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" by auto
     have *: "csa \<in> {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" using i eq by auto
     then have "length csa = length fss" unfolding consistent_sign_vectors_r_def by auto
     thus ?thesis unfolding has_no_zeros_def using * apply (auto simp add:in_set_conv_nth)
       using i(1) by auto
   qed
   show ?thesis
     using  forwards backwards by blast
 qed
 
 lemma mem_append: "List.member (l1@l2) m \<longleftrightarrow> (List.member l1 m \<or> List.member l2 m)"
   by (simp add: List.member_def)
 
 lemma same_sign_cond_rationals_reals:
   fixes qs:: "rat poly list"
   assumes lenh: "length (fst(factorize_polys qs)) > 0"
   shows "set(find_sgas (map (map_poly of_rat) (fst(factorize_polys qs)))) = consistent_sign_vectors (fst(factorize_polys qs)) UNIV"
 proof - 
   let ?ftrs = "(fst(factorize_polys qs))"
   have pairwise_rel_prime: "pairwise_coprime_list (fst(factorize_polys qs))"
     using factorize_polys_coprime
     by (simp add: coprime_factorize) 
   have all_squarefree:"\<forall>q. (List.member (fst(factorize_polys qs)) q) \<longrightarrow> (rsquarefree q)"
     using factorize_polys_square_free
     by (metis in_set_member prod.collapse square_free_rsquarefree) 
   have allnonzero: "\<forall>q. (List.member ?ftrs q) \<longrightarrow> q \<noteq> 0"
     using all_squarefree apply (auto)
     using rsquarefree_def by blast 
   have h1: "\<forall> csa. (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> \<not> (has_no_zeros csa))
     \<longleftrightarrow>  csa \<in> set (find_sgas_aux (cast_rat_list ?ftrs))"
     using lenh find_csas_lemma_onezero_gen pairwise_rel_prime allnonzero
     by (metis consistent_sign_vectors_consistent_sign_vectors_r eq_fst_iff) 
   have h2: "\<forall>csa. (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> has_no_zeros csa) \<longleftrightarrow> 
     List.member (find_consistent_signs_at_roots (coprime_r (cast_rat_list ?ftrs)) (cast_rat_list ?ftrs)) csa"
     using lenh find_csas_lemma_nozeros pairwise_rel_prime allnonzero
     by (metis in_set_member length_greater_0_conv prod.collapse)
   have h3: "\<forall> csa. List.member (find_sgas (map (map_poly of_rat) ?ftrs)) csa \<longleftrightarrow> 
       ((List.member (find_sgas_aux (cast_rat_list ?ftrs)) csa) \<or>  (List.member (find_consistent_signs_at_roots (coprime_r (cast_rat_list ?ftrs)) (cast_rat_list ?ftrs)) csa))"
     unfolding find_sgas_def cast_rat_list_def using mem_append
     by metis 
   have h4: "\<forall> csa. List.member (find_sgas (map (map_poly of_rat) ?ftrs)) csa \<longleftrightarrow>
    ((csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> has_no_zeros csa) \<or>  (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> \<not> (has_no_zeros csa)))"
     using h1 h2 h3  apply (auto) apply (simp add: in_set_member) by (simp add: in_set_member)  
   have h5: "\<forall>csa. (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> has_no_zeros csa) \<or>  (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> \<not> (has_no_zeros csa))
     \<longleftrightarrow> csa \<in> (consistent_sign_vectors ?ftrs UNIV)"
     by auto 
   then have "\<forall> csa. List.member (find_sgas (map (map_poly of_rat) ?ftrs)) csa \<longleftrightarrow> csa \<in> (consistent_sign_vectors ?ftrs UNIV)"
     using h4
     by blast 
   then show ?thesis using in_set_member apply (auto)
     apply (simp add: in_set_member)
     by (simp add: in_set_member)
 qed
 
 lemma factorize_polys_undo_factorize_polys_set:
   assumes "factorize_polys ps = (ftrs,data)"
   assumes "sgas =  find_sgas (map (map_poly of_rat) ftrs)"
   assumes sgas_set: "set (sgas) = consistent_sign_vectors ftrs UNIV"
   shows "set (map (undo_factorize_polys data) sgas) = consistent_sign_vectors ps UNIV"
 proof -
   have h: "\<forall>x. undo_factorize_polys data (sign_vec ftrs x) = sign_vec ps x" 
     using factorize_polys_undo_factorize_polys
     by (simp add: assms(1)) 
   have h1: "\<forall>x. sign_vec ps x \<in> set (map (undo_factorize_polys data) sgas)"
     using sgas_set
     by (metis UNIV_I consistent_sign_vectors_def h image_eqI image_set) 
   then have subset_h: "consistent_sign_vectors ps UNIV \<subseteq> set (map (undo_factorize_polys data) sgas)"
     unfolding consistent_sign_vectors_def by auto
   have supset_h:  "consistent_sign_vectors ps UNIV \<supseteq> set (map (undo_factorize_polys data) sgas)"
   proof - 
     have "\<forall> ele. ele \<in> set (map (undo_factorize_polys data) sgas) \<longrightarrow>
        (\<exists>n < length sgas. ele = (undo_factorize_polys data (nth sgas n)))"
       using index_of_lookup(1) index_of_lookup(2) by fastforce
     then have "\<forall> ele. ele \<in> set (map (undo_factorize_polys data) sgas) \<longrightarrow>
        (\<exists>x. ele = (undo_factorize_polys data (sign_vec ftrs x)))"
       using sgas_set apply (auto)  using consistent_sign_vectors_def by auto 
     then show ?thesis using h
       using consistent_sign_vectors_def by auto
   qed
   show ?thesis using subset_h supset_h
     by blast 
 qed
 
 lemma main_step_aux1:
   fixes qs:: "rat poly list"
   assumes empty: "(fst(factorize_polys qs)) = []"
   shows "set (find_consistent_signs qs) =  consistent_sign_vectors qs UNIV"
 proof -
   have set_eq: "set (find_consistent_signs qs) = {(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)}"
     using empty unfolding find_consistent_signs_def apply (auto)
     apply (metis fst_conv) 
     by (metis prod.collapse) 
   have deg_q_prop: "fst(factorize_polys qs) = [] \<Longrightarrow> (\<forall>q \<in>set(qs). degree q = 0)"
     apply (rule ccontr)
   proof clarsimp
     fix q
     assume *:"fst(factorize_polys qs) = []"
     assume q: "q \<in> set qs" "0 < degree q"
     obtain arb where "factorize_rat_poly_monic q = (arb,[])"
       using * q unfolding factorize_polys_def apply (auto simp add:Let_def)
       by (metis prod.collapse)
     from squarefree_factorization_degree[OF factorize_rat_poly_monic_square_free_factorization[OF this]]
     have "degree q = 0" by auto
     thus False using q by auto
   qed
   have deg_q_cons: "(\<forall>q \<in>set(qs). degree q = 0) \<Longrightarrow> (consistent_sign_vectors qs UNIV =  {(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)})"
   proof - 
     assume deg_z: "(\<forall>q \<in>set(qs). degree q = 0)"
     then have "\<forall>q \<in>set(qs). \<forall>x y. poly q x = poly q y"
       apply (auto)
       by (meson constant_def constant_degree) 
     then have csv: "consistent_sign_vectors qs UNIV = {sign_vec qs 0}"
       unfolding consistent_sign_vectors_def sign_vec_def apply (auto) 
       apply (metis deg_z degree_0_id of_rat_hom.map_poly_hom_coeff_lift poly_0_coeff_0 poly_const_conv squash_real_of_rat)
       by (metis (mono_tags, lifting) class_semiring.add.one_closed comp_def image_iff list.map_cong0 of_rat_hom.poly_map_poly_0)
     have "sign_vec qs 0 = (map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)"
       unfolding sign_vec_def squash_def by auto
     then show "consistent_sign_vectors qs UNIV =  {(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)}"
       using csv by auto
   qed
   then show ?thesis
     using deg_q_prop deg_q_cons set_eq
     by (simp add: empty) 
 qed
 
 lemma main_step_aux2:
   fixes qs:: "rat poly list"
   assumes lenh: "length (fst(factorize_polys qs)) > 0"
   shows "set (find_consistent_signs qs) =  consistent_sign_vectors qs UNIV"
 proof - 
   let ?fs = "fst(factorize_polys qs)"
   let ?data = "snd(factorize_polys qs)"
   let ?sgas = "find_sgas (map (map_poly of_rat) ?fs)"
   have h0: "set (?sgas) = consistent_sign_vectors ?fs UNIV" 
     using lenh same_sign_cond_rationals_reals coprime_factorize by auto
   then have h1: "set (map (undo_factorize_polys ?data) ?sgas) = consistent_sign_vectors qs UNIV"
     using factorize_polys_undo_factorize_polys_set
     by simp
-  then show ?thesis using lenh apply (auto)
-    apply (smt case_prod_unfold find_consistent_signs_def h1 main_step_aux1) 
-     by (simp add: find_consistent_signs_def prod.case_eq_if)
+  then show ?thesis using lenh
+    by (smt (verit, best) find_consistent_signs_def main_step_aux1 prod.case prod.collapse)
 qed
 
 lemma main_step:
   fixes qs:: "rat poly list"
   shows "set (find_consistent_signs qs) =  consistent_sign_vectors qs UNIV"
   using main_step_aux1 main_step_aux2 by auto
 
 subsection "Decision Procedure: Main Lemmas"
 
 lemma decide_univ_lem_helper:
   assumes "(fml_struct,polys) = convert fml"
   shows "(\<forall>x::real. lookup_sem fml_struct (map (\<lambda>p. rpoly p x) polys)) \<longleftrightarrow>
     (decide_universal fml)"
   using universal_lookup_sem main_step unfolding decide_universal_def apply (auto)
   apply (metis assms convert_closed fst_conv snd_conv)
   by (metis (full_types) assms convert_closed fst_conv snd_conv)
 
 lemma decide_exis_lem_helper:
   assumes "(fml_struct,polys) = convert fml"
   shows "(\<exists>x::real. lookup_sem fml_struct (map (\<lambda>p. rpoly p x) polys)) \<longleftrightarrow>
     (decide_existential fml)"
   using existential_lookup_sem main_step unfolding decide_existential_def apply (auto)
   apply (metis assms convert_closed fst_conv snd_conv)
   by (metis (full_types) assms convert_closed fst_conv snd_conv)
 
 theorem decision_procedure:
   shows "(\<forall>x::real. fml_sem fml x) \<longleftrightarrow> (decide_universal fml)"
     "\<exists>x::real. fml_sem fml x \<longleftrightarrow> (decide_existential fml)" 
   using  convert_semantics_lem decide_univ_lem_helper apply (auto)
   apply (simp add: convert_semantics)   
   apply (metis convert_def convert_semantics fst_conv snd_conv)  
   using convert_semantics_lem 
   by (metis convert_def convert_semantics decide_exis_lem_helper fst_conv snd_conv)
 
 end
\ No newline at end of file
diff --git a/thys/BenOr_Kozen_Reif/BKR_Proofs.thy b/thys/BenOr_Kozen_Reif/BKR_Proofs.thy
--- a/thys/BenOr_Kozen_Reif/BKR_Proofs.thy
+++ b/thys/BenOr_Kozen_Reif/BKR_Proofs.thy
@@ -1,2244 +1,2180 @@
 theory BKR_Proofs
   imports Matrix_Equation_Construction
 
 begin
 
 definition well_def_signs:: "nat => rat list list \<Rightarrow> bool"
   where "well_def_signs num_polys sign_conds \<equiv> \<forall> signs \<in> set(sign_conds). (length signs = num_polys)"
 
 definition satisfies_properties:: "real poly \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> rat list list \<Rightarrow> rat mat \<Rightarrow> bool"
   where "satisfies_properties p qs subsets signs matrix = 
   ( all_list_constr subsets (length qs) \<and> well_def_signs (length qs) signs \<and> distinct signs
   \<and> satisfy_equation p qs subsets signs \<and>  invertible_mat matrix  \<and> matrix = matrix_A signs subsets
   \<and> set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)
   )"
 
 section "Base Case"
 
 lemma mat_base_case:
   shows "matrix_A [[1],[-1]] [[],[0]] = (mat_of_rows_list 2 [[1, 1], [1, -1]])"
-  unfolding matrix_A_def mtx_row_def z_def apply (auto)
-  by (simp add: numeral_2_eq_2)
+  unfolding matrix_A_def mtx_row_def z_def by (auto simp add: numeral_2_eq_2)
 
 lemma base_case_sgas:
   fixes q p:: "real poly"
   assumes nonzero: "p \<noteq> 0"
   assumes rel_prime: "coprime p q"
   shows "set (characterize_consistent_signs_at_roots_copr p [q]) \<subseteq> {[1], [- 1]}"
   unfolding characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def by auto
 
 lemma base_case_sgas_alt:
   fixes p:: "real poly"
   fixes qs:: "real poly list"
   assumes len1: "length qs = 1"
   assumes nonzero: "p \<noteq> 0"
   assumes rel_prime: "\<forall>q. (List.member qs q) \<longrightarrow> coprime p q"
   shows "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> {[1], [- 1]}"
 proof - 
   have ex_q: "\<exists>(q::real poly). qs = [q]" 
     using len1    
     using length_Suc_conv[of qs 0] by auto
   then show ?thesis using base_case_sgas nonzero rel_prime
     apply (auto)
     using characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def by auto
 qed
 
 lemma base_case_satisfy_equation:
   fixes q p:: "real poly"
   assumes nonzero: "p \<noteq> 0"
   assumes rel_prime: "coprime p q"
   shows "satisfy_equation p [q] [[],[0]] [[1],[-1]]"
 proof - 
   have h1: "set (characterize_consistent_signs_at_roots_copr p [q]) \<subseteq> {[1], [- 1]}"
     using base_case_sgas assms by auto
   have h2: " \<forall>qa. List.member [q] qa \<longrightarrow> coprime p qa" using rel_prime
     by (simp add: member_rec(1) member_rec(2))
   have h3: "all_list_constr [[], [0]] (Suc 0)" unfolding all_list_constr_def
     by (simp add: list_constr_def member_def)
   then show ?thesis using matrix_equation[where p = "p", where qs = "[q]", where signs = "[[1],[-1]]", where subsets = "[[],[0]]"]
       nonzero h1 h2 h3 by auto
 qed
 
 lemma base_case_satisfy_equation_alt:
   fixes p:: "real poly"
   fixes qs:: "real poly list"
   assumes len1: "length qs = 1"
   assumes nonzero: "p \<noteq> 0"
   assumes rel_prime: "\<forall>q. (List.member qs q) \<longrightarrow> coprime p q"
   shows "satisfy_equation p qs [[],[0]] [[1],[-1]]"
 proof - 
   have ex_q: "\<exists>(q::real poly). qs = [q]" 
     using len1    
     using length_Suc_conv[of qs 0] by auto
   then show ?thesis using base_case_satisfy_equation nonzero rel_prime
     apply (auto)
     by (simp add: member_rec(1)) 
 qed
 
 lemma base_case_matrix_eq:
   fixes q p:: "real poly"
   assumes nonzero: "p \<noteq> 0"
   assumes rel_prime: "coprime p q"
   shows "(mult_mat_vec (mat_of_rows_list 2 [[1, 1], [1, -1]]) (construct_lhs_vector p [q] [[1],[-1]]) = 
     (construct_rhs_vector p [q] [[],[0]]))"                      
   using mat_base_case base_case_satisfy_equation unfolding satisfy_equation_def
   by (simp add: nonzero rel_prime)
 
 lemma less_two:
   shows "j < Suc (Suc 0) \<longleftrightarrow> j = 0 \<or> j = 1" by auto 
 
 lemma inverse_mat_base_case: 
   shows "inverts_mat (mat_of_rows_list 2 [[1/2, 1/2], [1/2, -(1/2)]]::rat mat) (mat_of_rows_list 2 [[1, 1], [1, -1]]::rat mat)"
   unfolding inverts_mat_def mat_of_rows_list_def mat_eq_iff apply auto
   unfolding less_two by (auto simp add: scalar_prod_def)
 
 lemma inverse_mat_base_case_2: 
   shows "inverts_mat (mat_of_rows_list 2 [[1, 1], [1, -1]]::rat mat) (mat_of_rows_list 2 [[1/2, 1/2], [1/2, -(1/2)]]::rat mat) "
   unfolding inverts_mat_def mat_of_rows_list_def mat_eq_iff apply auto
   unfolding less_two by (auto simp add: scalar_prod_def)
 
 lemma base_case_invertible_mat: 
   shows "invertible_mat (matrix_A [[1], [- 1]] [[], [0]])"
   unfolding invertible_mat_def using inverse_mat_base_case inverse_mat_base_case_2
   apply (auto)
    apply (simp add: mat_base_case mat_of_rows_list_def)
   using mat_base_case by auto 
 
 section "Inductive Step"
 
 subsection "Lemmas on smashing subsets and signs"
 
 lemma signs_smash_property:
   fixes signs1 signs2 :: "'a list list"
   fixes a b:: "nat"
   shows "\<forall> (elem :: 'a list). (elem \<in> (set (signs_smash signs1 signs2)) \<longrightarrow> 
     (\<exists> n m :: nat. 
       elem = ((nth signs1 n)@(nth signs2 m))))"
 proof clarsimp 
   fix elem 
   assume assum: "elem \<in> set (signs_smash signs1 signs2)"
   show "\<exists>n m. elem = signs1 ! n @ signs2 ! m"
     using assum unfolding signs_smash_def apply (auto)
     by (metis in_set_conv_nth) 
 qed
 
 lemma signs_smash_property_set:
   fixes signs1 signs2 :: "'a list list"
   fixes a b:: "nat"
   shows "\<forall> (elem :: 'a list). (elem \<in> (set (signs_smash signs1 signs2)) \<longrightarrow> 
     (\<exists> (elem1::'a list). \<exists> (elem2::'a list). 
       (elem1 \<in> set(signs1) \<and> elem2 \<in> set(signs2) \<and> elem = (elem1@elem2))))"
 proof clarsimp 
   fix elem 
   assume assum: "elem \<in> set (signs_smash signs1 signs2)"
   show "\<exists>elem1. elem1 \<in> set signs1 \<and> (\<exists>elem2. elem2 \<in> set signs2 \<and> elem = elem1 @ elem2)"
     using assum unfolding signs_smash_def by auto
 qed
 
 lemma subsets_smash_property:
   fixes subsets1 subsets2 :: "nat list list"
   fixes n:: "nat"
   shows "\<forall> (elem :: nat list). (List.member (subsets_smash n subsets1 subsets2) elem) \<longrightarrow> 
     (\<exists> (elem1::nat list). \<exists> (elem2::nat list).
       (elem1 \<in> set(subsets1) \<and> elem2 \<in> set(subsets2) \<and> elem = (elem1 @ ((map ((+) n) elem2)))))"
 proof - 
   let ?new_subsets = "(map (map ((+) n)) subsets2)"
     (* a slightly unorthodox use of signs_smash, but it closes the proof *)
   have "subsets_smash n subsets1 subsets2 = signs_smash subsets1 ?new_subsets" 
-    unfolding subsets_smash_def signs_smash_def apply (auto)
-    by (simp add: comp_def) 
+    unfolding subsets_smash_def signs_smash_def by (auto simp add: comp_def)
   then show ?thesis
-    by (smt imageE in_set_member set_map signs_smash_property_set)
+    by (smt (verit) imageE in_set_member set_map signs_smash_property_set)
 qed
 
   (* If subsets for smaller systems are well-defined, then subsets for combined systems
    are well-defined *)
 subsection "Well-defined subsets preserved when smashing"
 
 lemma list_constr_append:
   "list_constr a n \<and> list_constr b n \<longrightarrow> list_constr (a@b) n"
   apply (auto) unfolding list_constr_def
   using list_all_append by blast 
 
 lemma well_def_step: 
   fixes qs1 qs2 :: "real poly list"
   fixes subsets1 subsets2 :: "nat list list"
   assumes well_def_subsets1: "all_list_constr (subsets1) (length qs1)"
   assumes well_def_subsets2: "all_list_constr (subsets2) (length qs2)"
   shows "all_list_constr ((subsets_smash (length qs1) subsets1 subsets2))
      (length (qs1 @ qs2))"
 proof - 
   have h1: "\<forall>elem.
      List.member (subsets_smash (length qs1) subsets1 subsets2) elem \<longrightarrow>
      (\<exists>elem1 elem2. elem1 \<in> set subsets1 \<and> elem2 \<in> set subsets2 \<and> elem = elem1 @ map ((+) (length qs1)) elem2)"
     using subsets_smash_property by blast
   have h2: "\<forall>elem1 elem2. (elem1 \<in> set subsets1 \<and> elem2 \<in> set subsets2) \<longrightarrow> list_constr (elem1 @ map ((+) (length qs1)) elem2) (length (qs1 @ qs2))"
   proof clarsimp 
     fix elem1
     fix elem2
     assume e1: "elem1 \<in> set subsets1"
     assume e2: "elem2 \<in> set subsets2"
     have h1: "list_constr elem1  (length qs1 + length qs2) " 
     proof - 
       have h1: "list_constr elem1  (length qs1)"  using e1 well_def_subsets1 
         unfolding all_list_constr_def
         by (simp add: in_set_member) 
       then show ?thesis unfolding list_constr_def
         by (simp add: list.pred_mono_strong) 
     qed
     have h2: "list_constr (map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
     proof - 
       have h1: "list_constr elem2  (length qs2)"  using e2 well_def_subsets2 
         unfolding all_list_constr_def
         by (simp add: in_set_member) 
       then show ?thesis unfolding list_constr_def
         by (simp add: list_all_length)
     qed    
     show "list_constr (elem1 @ map ((+) (length qs1)) elem2) (length qs1 + length qs2)" 
       using h1 h2 list_constr_append
       by blast 
   qed
   then show ?thesis using h1 unfolding all_list_constr_def by auto
 qed
 
 subsection "Well def signs preserved when smashing"
 lemma well_def_signs_step: 
   fixes qs1 qs2 :: "real poly list"
   fixes signs1 signs2 :: "rat list list"
   assumes "length qs1 > 0"
   assumes "length qs2 > 0"
   assumes well_def1: "well_def_signs (length qs1) signs1"
   assumes well_def2: "well_def_signs (length qs2) signs2"
   shows "well_def_signs (length (qs1@qs2)) (signs_smash signs1 signs2)"
   using well_def1 well_def2 unfolding well_def_signs_def using signs_smash_property_set[of signs1 signs2] length_append by auto
 
 subsection "Distinct signs preserved when smashing"
 
 lemma distinct_map_append:
   assumes "distinct ls"
   shows "distinct (map ((@) xs) ls)"
   unfolding distinct_map inj_on_def using assms by auto
 
 lemma length_eq_append:
   assumes "length y = length b"
   shows "(x @ y = a @ b) \<longleftrightarrow> x=a \<and> y = b"
   by (simp add: assms)
 
 lemma distinct_step:
   fixes qs1 qs2 :: "real poly list"
   fixes signs1 signs2 :: "rat list list"
   assumes well_def1: "well_def_signs n1 signs1"
   assumes well_def2: "well_def_signs n2 signs2"
   assumes distinct1: "distinct signs1"
   assumes distinct2: "distinct signs2"
   shows "distinct (signs_smash signs1 signs2)"
   unfolding signs_smash_def
   using distinct1
 proof(induction signs1)
   case Nil
   then show ?case by auto
 next
   case (Cons a signs1)
   then show ?case apply (auto simp add: distinct2 distinct_map_append)
     using assms unfolding well_def_signs_def
     by (simp add: distinct1 distinct2 length_eq_append)
 qed
 
 (* In this section we will show that if signs1 contains all consistent sign assignments and signs2 
 contains all consistent sign assignments, then their smash contains all consistent sign assignments.  
 Intuitively, this makes sense because signs1 and signs2 are carrying information about different 
 sets of polynomials, and their smash contains all possible combinations of that information.
 *)
 subsection "Consistent sign assignments preserved when smashing"
 
 lemma subset_smash_signs: 
   fixes a1 b1 a2 b2:: "rat list list"
   assumes sub1: "set a1 \<subseteq> set a2"
   assumes sub2: "set b1 \<subseteq> set b2"
   shows "set (signs_smash a1 b1) \<subseteq> set (signs_smash a2 b2)"
 proof -
   have h1: "\<forall>x\<in>set (signs_smash a1 b1). x\<in>set (signs_smash a2 b2)"
   proof clarsimp 
     fix x
     assume x_in: "x \<in> set (signs_smash a1 b1)"
     have h1: "\<exists> n m :: nat. x = (nth a1 n)@(nth b1 m)"
       using signs_smash_property[of a1 b1] x_in
       by blast
     then have h2: "\<exists> p q::nat. x = (nth a2 p)@(nth b2 q)"
       using sub1 sub2 apply (auto)
       by (metis nth_find_first signs_smash_property_set subset_code(1) x_in) 
     then show "x \<in> set (signs_smash a2 b2)" 
       unfolding signs_smash_def apply (auto)
       using signs_smash_property_set sub1 sub2 x_in by fastforce 
   qed
   then show ?thesis
     by blast 
 qed
 
 lemma subset_helper:
   fixes p:: "real poly"
   fixes qs1 qs2 :: "real poly list"
   fixes signs1 signs2 :: "rat list list"
   shows "\<forall> x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2)). 
         \<exists> x1 \<in> set (characterize_consistent_signs_at_roots_copr p qs1). 
         \<exists> x2 \<in> set (characterize_consistent_signs_at_roots_copr p qs2).
         x = x1@x2"
 proof clarsimp 
   fix x
   assume  x_in: "x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2))" 
   have x_in_csv: "x \<in> set(map (consistent_sign_vec_copr (qs1 @ qs2)) (characterize_root_list_p p))"  
     using x_in unfolding characterize_consistent_signs_at_roots_copr_def by simp
   have csv_hyp: "\<forall>r. consistent_sign_vec_copr (qs1 @ qs2) r = (consistent_sign_vec_copr qs1 r)@(consistent_sign_vec_copr qs2 r)"
     unfolding consistent_sign_vec_copr_def by auto
   have exr_iff: "(\<exists>r \<in> set (characterize_root_list_p p). x = consistent_sign_vec_copr (qs1 @ qs2) r) \<longleftrightarrow> (\<exists>r \<in> set (characterize_root_list_p p). x = (consistent_sign_vec_copr qs1 r)@(consistent_sign_vec_copr qs2 r))"
     using csv_hyp by auto
   have exr: "x \<in> set(map (consistent_sign_vec_copr (qs1 @ qs2)) (characterize_root_list_p p)) \<longrightarrow> (\<exists>r \<in> set (characterize_root_list_p p). x = consistent_sign_vec_copr (qs1 @ qs2) r)"
     by auto
   have mem_list1: "\<forall> r \<in> set (characterize_root_list_p p). (consistent_sign_vec_copr qs1 r) \<in> set(map (consistent_sign_vec_copr qs1) (characterize_root_list_p p))"
     by simp
   have mem_list2: "\<forall> r \<in> set (characterize_root_list_p p). (consistent_sign_vec_copr qs2 r) \<in> set(map (consistent_sign_vec_copr qs2) (characterize_root_list_p p))"
     by simp
   then show "\<exists>x1\<in>set (characterize_consistent_signs_at_roots_copr p qs1).
             \<exists>x2\<in>set (characterize_consistent_signs_at_roots_copr p qs2). x = x1 @ x2"
     using x_in_csv exr mem_list1 mem_list2 characterize_consistent_signs_at_roots_copr_def exr_iff by auto
 qed
 
 lemma subset_step:  
   fixes p:: "real poly"
   fixes qs1 qs2 :: "real poly list"
   fixes signs1 signs2 :: "rat list list"
   assumes csa1: "set (characterize_consistent_signs_at_roots_copr p qs1) \<subseteq> set (signs1)"
   assumes csa2: "set (characterize_consistent_signs_at_roots_copr p qs2) \<subseteq> set (signs2)"  
   shows "set (characterize_consistent_signs_at_roots_copr p
           (qs1 @ qs2))
     \<subseteq> set (signs_smash signs1 signs2)"
 proof - 
   have h0: "\<forall> x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2)). \<exists> x1 \<in> set (characterize_consistent_signs_at_roots_copr p qs1). \<exists> x2 \<in> set (characterize_consistent_signs_at_roots_copr p qs2).
      (x = x1@x2)" using subset_helper[of p qs1 qs2]
     by blast 
   then have "\<forall>x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2)). 
           x \<in> set (signs_smash (characterize_consistent_signs_at_roots_copr p qs1) 
           (characterize_consistent_signs_at_roots_copr p qs2))"
     unfolding signs_smash_def apply (auto)
     by fastforce 
   then have "\<forall>x \<in> set (characterize_consistent_signs_at_roots_copr p
           (qs1 @ qs2)). x \<in> set (signs_smash signs1 signs2)"
     using csa1 csa2 subset_smash_signs[of _ signs1 _ signs2] apply (auto)
     by blast 
   thus ?thesis
     by blast 
 qed
 
 subsection "Main Results"
 
 lemma dim_row_mat_of_rows_list[simp]:
   shows "dim_row (mat_of_rows_list nr ls) = length ls"
   unfolding mat_of_rows_list_def by auto
 
 lemma dim_col_mat_of_rows_list[simp]:
   shows "dim_col (mat_of_rows_list nr ls) = nr"
   unfolding mat_of_rows_list_def by auto
 
 lemma dim_row_matrix_A[simp]:
   shows "dim_row (matrix_A signs subsets) = length subsets"
   unfolding matrix_A_def by auto
 
 lemma dim_col_matrix_A[simp]:
   shows "dim_col (matrix_A signs subsets) = length signs"
   unfolding matrix_A_def by auto
 
 lemma length_signs_smash:
   shows
     "length (signs_smash signs1 signs2) = length signs1 * length signs2"
   unfolding signs_smash_def length_concat
   by (auto simp add: o_def sum_list_triv)
 
 lemma length_subsets_smash:
   shows
     "length (subsets_smash n subs1 subs2) = length subs1 * length subs2"
   unfolding subsets_smash_def length_concat
   by (auto simp add: o_def sum_list_triv)
 
 lemma length_eq_concat:
   assumes "\<And>x. x \<in> set ls \<Longrightarrow> length x = n"
   assumes "i < n * length ls"
   shows "concat ls ! i = ls ! (i div n) ! (i mod n)"
   using assms
 proof (induct ls arbitrary: i)
   case Nil
   then show ?case
     by simp
 next
   from assms have \<open>n > 0\<close>
     by (cases \<open>n = 0\<close>) simp_all
   case (Cons a ls)
   show ?case
   proof (cases \<open>n \<le> i\<close>)
     case False
     with Cons show ?thesis
       by (simp add: nth_append)
   next
     case True
     moreover define j where \<open>j = i - n\<close>
     ultimately have \<open>i = n + j\<close>
       by simp
     with Cons \<open>n > 0\<close> show ?thesis
       by (simp add: nth_append div_add_self1)
   qed
 qed
 
 lemma z_append:
   assumes "\<And>i. i \<in> set xs \<Longrightarrow> i < length as"
   shows "z (xs @ (map ((+) (length as)) ys)) (as @ bs) = z xs as * z ys bs"
 proof -
   have 1: "map ((!) (as @ bs)) xs = map ((!) as) xs"
     unfolding list_eq_iff_nth_eq
     using assms by (auto simp add:nth_append)
   have 2: "map ((!) (as @ bs) \<circ> (+) (length as)) ys = map ((!) bs) ys"
     unfolding list_eq_iff_nth_eq
     using assms by auto
   show ?thesis
     unfolding z_def apply auto
     unfolding 1 2 by auto
 qed
 
 (* Shows that the matrix of a smashed system is the Kronecker product of the matrices of the two
   systems being combined *)
 lemma matrix_construction_is_kronecker_product: 
   fixes qs1 :: "real poly list"
   fixes subs1 subs2 :: "nat list list"
   fixes signs1 signs2 :: "rat list list"
     (* n1 is the number of polynomials in the "1" sets *)
   assumes "\<And>l i. l \<in> set subs1 \<Longrightarrow> i \<in> set l \<Longrightarrow> i < n1"
   assumes "\<And>j. j \<in> set signs1 \<Longrightarrow> length j = n1"
   shows "
     (matrix_A (signs_smash signs1 signs2) (subsets_smash n1 subs1 subs2)) =
     kronecker_product (matrix_A signs1 subs1) (matrix_A signs2 subs2)"
   unfolding mat_eq_iff dim_row_matrix_A dim_col_matrix_A
     length_subsets_smash length_signs_smash dim_kronecker
 proof safe
   fix i j
   assume i: "i < length subs1 * length subs2"
      and j: "j < length signs1 * length signs2"
   have ld: "i div length subs2 < length subs1"
     "j div length signs2 < length signs1"
     using i j less_mult_imp_div_less by auto
   have lm: "i mod length subs2 < length subs2"
     "j mod length signs2 < length signs2"
     using i j less_mult_imp_mod_less by auto
 
   have n1: "n1 = length (signs1 ! (j div length signs2))"
     using assms(2) ld(2) nth_mem by blast
 
   have 1: "matrix_A (signs_smash signs1 signs2) (subsets_smash n1 subs1 subs2) $$ (i, j) =
     z (subsets_smash n1 subs1 subs2 ! i) (signs_smash signs1 signs2 ! j)"
     unfolding mat_of_rows_list_def matrix_A_def mtx_row_def
     using i j
     by (simp add: length_signs_smash length_subsets_smash)
   have 2: " ... = z (subs1 ! (i div length subs2) @ map ((+) n1) (subs2 ! (i mod length subs2)))
      (signs1 ! (j div length signs2) @ signs2 ! (j mod length signs2))"
     unfolding signs_smash_def subsets_smash_def
     apply (subst length_eq_concat)
     using i apply (auto simp add: mult.commute)
     apply (subst length_eq_concat)
     using j apply (auto simp add: mult.commute)
     using ld lm by auto
   have 3: "... =
   z (subs1 ! (i div length subs2)) (signs1 ! (j div length signs2)) *
   z (subs2 ! (i mod length subs2)) (signs2 ! (j mod length signs2))"
     unfolding n1
     apply (subst z_append)
      apply (auto simp add: n1[symmetric])
     using assms(1) ld(1) nth_mem by blast
   have 4: "kronecker_product (matrix_A signs1 subs1) (matrix_A signs2 subs2) $$ (i,j) =
     z (subs1 ! (i div length subs2))
      (signs1 ! (j div length signs2)) *
     z (subs2 ! (i mod length subs2))
      (signs2 ! (j mod length signs2))"
     unfolding kronecker_product_def matrix_A_def mat_of_rows_list_def mtx_row_def
     using i j apply (auto simp add: Let_def)
     apply (subst index_mat(1)[OF ld])
     apply (subst index_mat(1)[OF lm])
     using ld lm by auto
   show "matrix_A (signs_smash signs1 signs2) (subsets_smash n1 subs1 subs2) $$ (i, j) =
         kronecker_product (matrix_A signs1 subs1) (matrix_A signs2 subs2) $$ (i, j)"
     using 1 2 3 4 by auto 
 qed
 
 (* Given that two smaller systems satisfy some mild constraints, show that their combined system
   (after smashing the signs and subsets) satisfies the matrix equation, and that the matrix of the
   combined system is invertible. *)
 lemma inductive_step:
   fixes p:: "real poly"
   fixes qs1 qs2 :: "real poly list"
   fixes subsets1 subsets2 :: "nat list list"
   fixes signs1 signs2 :: "rat list list"
   assumes nonzero: "p \<noteq> 0"
   assumes nontriv1: "length qs1 > 0"
   assumes nontriv2: "length qs2 > 0"
   assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
   assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
   assumes welldefined_signs1: "well_def_signs (length qs1) signs1"
   assumes welldefined_signs2: "well_def_signs (length qs2) signs2"
   assumes distinct_signs1: "distinct signs1"
   assumes distinct_signs2: "distinct signs2"
   assumes all_info1: "set (characterize_consistent_signs_at_roots_copr p qs1) \<subseteq> set(signs1)"
   assumes all_info2: "set (characterize_consistent_signs_at_roots_copr p qs2) \<subseteq> set(signs2)"
   assumes welldefined_subsets1: "all_list_constr (subsets1) (length qs1)"
   assumes welldefined_subsets2: "all_list_constr (subsets2) (length qs2)"
   assumes invertibleMtx1: "invertible_mat (matrix_A signs1 subsets1)"
   assumes invertibleMtx2: "invertible_mat (matrix_A signs2 subsets2)"
   shows "satisfy_equation p (qs1@qs2) (subsets_smash (length qs1) subsets1 subsets2) (signs_smash signs1 signs2) 
         \<and> invertible_mat (matrix_A (signs_smash signs1 signs2) (subsets_smash (length qs1) subsets1 subsets2))"
 proof - 
   have h1: "invertible_mat (matrix_A (signs_smash signs1 signs2) (subsets_smash (length qs1) subsets1 subsets2))"
     using matrix_construction_is_kronecker_product
       kronecker_invertible invertibleMtx1 invertibleMtx2
       welldefined_subsets1 welldefined_subsets2 unfolding all_list_constr_def list_constr_def
-    by (smt in_set_conv_nth in_set_member list_all_length well_def_signs_def welldefined_signs1)
+    by (smt (verit) Ball_set member_def well_def_signs_def welldefined_signs1)
   have h2a: "distinct (signs_smash signs1 signs2)" 
     using distinct_signs1 distinct_signs2 welldefined_signs1 welldefined_signs2 nontriv1 nontriv2 
       distinct_step by auto
   have h2ba: "\<forall> q. List.member (qs1 @ qs2) q \<longrightarrow> (List.member qs1 q \<or> List.member qs2 q)" 
     unfolding member_def 
     by auto
   have h2b: "\<forall>q. ((List.member (qs1@qs2) q) \<longrightarrow> (coprime p q))" 
     using h2ba pairwise_rel_prime1 pairwise_rel_prime2 by auto
   have h2c: "all_list_constr ((subsets_smash (length qs1) subsets1 subsets2)) (length (qs1@qs2))" 
     using well_def_step
       welldefined_subsets1 welldefined_subsets2
     by blast
   have h2d: "set (characterize_consistent_signs_at_roots_copr p (qs1@qs2)) \<subseteq> set(signs_smash signs1 signs2)" 
     using subset_step all_info1 all_info2
     by simp 
   have h2: "satisfy_equation p (qs1@qs2) (subsets_smash (length qs1) subsets1 subsets2) (signs_smash signs1 signs2)"
     using matrix_equation[where p="p", where qs="qs1@qs2", where subsets = "subsets_smash (length qs1) subsets1 subsets2",
         where signs = "signs_smash signs1 signs2"] 
         h2a h2b h2c h2d apply (auto) using nonzero by blast
   show ?thesis using h1 h2 by blast
 qed
 
 section "Reduction Step Proofs"
   
 (* Some definitions *)
 definition get_matrix:: "(rat mat \<times> (nat list list \<times> rat list list)) \<Rightarrow> rat mat"
   where "get_matrix data = fst(data)"
 
 definition get_subsets:: "(rat mat \<times> (nat list list \<times> rat list list)) \<Rightarrow> nat list list"
   where "get_subsets data = fst(snd(data))"
 
 definition get_signs:: "(rat mat \<times> (nat list list \<times> rat list list)) \<Rightarrow> rat list list"
   where "get_signs data = snd(snd(data))"
 
 definition reduction_signs:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat \<Rightarrow> rat list list" 
   where "reduction_signs p qs signs subsets matr = 
     (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets matr)))"
 
 definition reduction_subsets:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat \<Rightarrow> nat list list" 
   where "reduction_subsets p qs signs subsets matr = 
     (take_indices subsets (rows_to_keep (reduce_mat_cols matr (solve_for_lhs p qs subsets matr))))"
 
 (* Some basic lemmas *)
 lemma reduction_signs_is_get_signs: "reduction_signs p qs signs subsets m =  get_signs (reduce_system p (qs, (m, (subsets, signs))))"
   unfolding reduction_signs_def get_signs_def
   by (metis reduce_system.simps reduction_step.elims snd_conv) 
 
 lemma reduction_subsets_is_get_subsets: "reduction_subsets p qs signs subsets m =  get_subsets (reduce_system p (qs, (m, (subsets, signs))))"
   unfolding reduction_subsets_def get_subsets_def
   by (metis fst_conv reduce_system.simps reduction_step.elims snd_conv)
 
 lemma find_zeros_from_vec_prop:
   fixes input_vec :: "rat vec"
   shows "\<forall>n < (dim_vec input_vec). ((input_vec $ n \<noteq> 0) \<longleftrightarrow>
          List.member (find_nonzeros_from_input_vec input_vec) n)"
 proof - 
   have h1: "\<forall>n < (dim_vec input_vec). ((input_vec $ n \<noteq> 0) \<longrightarrow>  List.member (find_nonzeros_from_input_vec input_vec) n)" 
     unfolding find_nonzeros_from_input_vec_def List.member_def  by auto
   have h2: "\<forall>n < (dim_vec input_vec). (List.member (find_nonzeros_from_input_vec input_vec) n \<longrightarrow> (input_vec $ n \<noteq> 0) )" 
     unfolding find_nonzeros_from_input_vec_def List.member_def by auto
   show ?thesis using h1 h2 by auto
 qed
 
 
 subsection "Showing sign conditions preserved when reducing"
 
 lemma take_indices_lem:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes arb_list :: "'a list list"
   fixes index_list :: "nat list" 
   fixes n:: "nat"
   assumes lest: "n < length (take_indices arb_list index_list)"
   assumes well_def: "\<forall>q.(List.member index_list q \<longrightarrow> q < length arb_list)"
   shows "\<exists>k<length arb_list.
             (take_indices arb_list index_list) ! n =  arb_list ! k"
   using lest well_def unfolding take_indices_def apply (auto)
   by (metis in_set_member nth_mem)
 
 lemma invertible_means_mult_id:
   fixes A:: "'a::field mat"
   assumes assm: "invertible_mat A"
   shows "matr_option (dim_row A)
      (mat_inverse (A))*A = 1\<^sub>m (dim_row A)"
 proof (cases "mat_inverse(A)")
   obtain n where n: "A \<in> carrier_mat n n"
     using assms invertible_mat_def square_mat.simps by blast
   case None
   then have "A \<notin> Units (ring_mat TYPE('a) n n)"
     by (simp add: mat_inverse(1) n)
   thus ?thesis
     by (meson assms det_non_zero_imp_unit invertible_Units n unit_imp_det_non_zero) 
 next
   case (Some a)
   then show ?thesis
     by (metis assms carrier_matI invertible_mat_def mat_inverse(2) matr_option.simps(2) square_mat.elims(2))
 qed
 
 lemma dim_invertible:
   fixes A:: "'a::field mat"
   fixes n:: "nat"
   assumes assm: "invertible_mat A"
   assumes dim: "A \<in> carrier_mat n n"
   shows "matr_option (dim_row A)
      (mat_inverse (A)) \<in> carrier_mat n n"
 proof (cases "mat_inverse(A)")
   obtain n where n: "A \<in> carrier_mat n n"
     using assms invertible_mat_def square_mat.simps by blast
   case None
   then have "A \<notin> Units (ring_mat TYPE('a) n n)"
     by (simp add: mat_inverse(1) n)
   thus ?thesis
     by (meson assms det_non_zero_imp_unit invertible_Units n unit_imp_det_non_zero) 
 next
   case (Some a)
   then show ?thesis
     using dim mat_inverse(2) by auto 
 qed
 
 lemma mult_assoc:
   fixes A B:: "rat mat"
   fixes v:: "rat vec"
   fixes n:: "nat"
   assumes "A \<in> carrier_mat n n"
   assumes "B \<in> carrier_mat n n"
   assumes "dim_vec v = n"
   shows "A *\<^sub>v (mult_mat_vec B v) =  (A*B)*\<^sub>v v"
   using assms(1) assms(2) assms(3) by auto
 
 lemma size_of_mat:
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   shows "(matrix_A signs subsets) \<in> carrier_mat (length subsets) (length signs)"
   unfolding matrix_A_def carrier_mat_def by auto
 
 lemma size_of_lhs: 
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes signs :: "rat list list" 
   shows "dim_vec (construct_lhs_vector p qs signs) = length signs"
   unfolding construct_lhs_vector_def
   by simp
 
 lemma size_of_rhs: 
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list" 
   shows "dim_vec (construct_rhs_vector p qs subsets) = length subsets"
   unfolding construct_rhs_vector_def
   by simp
 
 lemma same_size:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
   shows "length subsets = length signs"
   using invertible_mat unfolding invertible_mat_def
   using size_of_mat[of signs subsets] size_of_lhs[of p qs signs] size_of_rhs[of p qs subsets]
   by simp
 
 lemma mat_equal_list_lem:
   fixes A:: "'a::field mat"
   fixes B:: "'a::field mat"
   shows "(dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> mat_to_list A = mat_to_list B)
     \<Longrightarrow> A = B"
 proof - 
   assume hyp: "dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> mat_to_list A = mat_to_list B"
   then have "\<And>i j. i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> B $$ (i, j) = A $$ (i, j)"
     unfolding mat_to_list_def by auto
   then show ?thesis using hyp
     unfolding mat_to_list_def
     using eq_matI[of A B]
     by metis 
 qed
 
 lemma mat_inverse_same: "mat_inverse_var A = mat_inverse A"
   unfolding mat_inverse_var_def mat_inverse_def mat_equal_def
-  using mat_equal_list_lem apply (simp)
-  by (smt case_prod_beta index_one_mat(2) index_one_mat(3) mat_equal_list_lem) 
+  by (smt (verit) mat_equal_list_lem split_cong)
 
 lemma construct_lhs_matches_solve_for_lhs:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes match: "satisfy_equation p qs subsets signs"
   assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
   shows "(construct_lhs_vector p qs signs) = solve_for_lhs p qs subsets (matrix_A signs subsets)"
-proof -
-  have matrix_equation_hyp: "(mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs) = (construct_rhs_vector p qs subsets))"
-    using match unfolding satisfy_equation_def by blast
-  then have eqn_hyp: " ((matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs)) = 
-      mult_mat_vec (matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) (construct_rhs_vector p qs subsets))"
-    using invertible_mat 
-    by (simp add: matrix_equation_hyp) 
-  have match_hyp: "length subsets = length signs" using same_size invertible_mat by auto 
-  then have dim_hyp1: "matrix_A signs subsets \<in> carrier_mat (length signs) (length signs)"
-    using size_of_mat
-    by auto 
-  then have dim_hyp2: "matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets)) \<in> carrier_mat (length signs) (length signs)"
-    using invertible_mat dim_invertible
-    by blast 
-  have mult_assoc_hyp: "((matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs)))
-    = (((matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) * (matrix_A signs subsets)) *\<^sub>v  (construct_lhs_vector p qs signs))"
-    using mult_assoc dim_hyp1 dim_hyp2 size_of_lhs by auto
-  have cancel_helper: "(((matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) * (matrix_A signs subsets)) *\<^sub>v  (construct_lhs_vector p qs signs))
-  = (1\<^sub>m (length signs)) *\<^sub>v   (construct_lhs_vector p qs signs)"
-    using invertible_means_mult_id[where A= "matrix_A signs subsets"] dim_hyp1
-    by (simp add: invertible_mat match_hyp) 
-  then have cancel_hyp: "(((matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) * (matrix_A signs subsets)) *\<^sub>v  (construct_lhs_vector p qs signs))
-  = (construct_lhs_vector p qs signs)"
-    apply (auto)
-    by (metis carrier_vec_dim_vec one_mult_mat_vec size_of_lhs)
-  then have mult_hyp: "((matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs)))
-    = (construct_lhs_vector p qs signs)"
-    using mult_assoc_hyp cancel_hyp  
-    by simp
-  then have "(construct_lhs_vector p qs signs) =  (mult_mat_vec (matr_option (dim_row (matrix_A signs subsets))
-     (mat_inverse (matrix_A signs subsets))) (construct_rhs_vector p qs subsets)) "
-    using eqn_hyp
-    by simp 
-  then show ?thesis
-    unfolding solve_for_lhs_def
-    by (simp add: mat_inverse_same)
-qed
+  by (smt (verit) carrier_vec_dim_vec dim_invertible dim_row_matrix_A invertible_mat invertible_means_mult_id mat_inverse_same match mult_assoc one_mult_mat_vec same_size satisfy_equation_def size_of_lhs size_of_mat solve_for_lhs_def)
 
 (* If set(A) is a subset of B then for all n, nth c n = 0 means nth a n not in B  *)
 lemma reduction_signs_set_helper_lemma:
   fixes A:: "rat list set"
   fixes C:: "rat vec"
   fixes B:: "rat list list"
   assumes "dim_vec C = length B"
   assumes sub: "A \<subseteq> set(B)"
   assumes not_in_hyp: "\<forall> n < dim_vec C. C $ n = 0 \<longrightarrow> (nth B n) \<notin> A"
   shows "A \<subseteq> set (take_indices B
              (find_nonzeros_from_input_vec C))"
 proof - 
   have unfold: "\<And> x. (x \<in> A \<Longrightarrow> x \<in> set (take_indices B
              (find_nonzeros_from_input_vec C)))"   
   proof -
     fix x
     assume in_a: "x \<in> A"
     have "x \<in> set (B)" 
       using sub in_a by blast
     then have "\<exists> n < length B. nth B n = x"
       by (simp add: in_set_conv_nth)
     then have "\<exists> n < length B. (nth B n = x \<and> (List.member (find_nonzeros_from_input_vec C) n) = True)"
       using not_in_hyp find_zeros_from_vec_prop[of C]
       using assms(1) in_a by auto 
     thus "x \<in> set (take_indices B
              (find_nonzeros_from_input_vec C))" 
       unfolding take_indices_def
       using member_def by fastforce 
   qed
   then show ?thesis
     by blast 
 qed
 
 lemma reduction_signs_set_helper_lemma2:
   fixes A:: "rat list set"
   fixes C:: "rat vec"
   fixes B:: "rat list list"
   assumes dist: "distinct B"
   assumes eq_len: "dim_vec C = length B"
   assumes sub: "A \<subseteq> set(B)"
   assumes not_in_hyp: "\<forall> n < dim_vec C. C $ n \<noteq> 0 \<longrightarrow> (nth B n) \<in> A"
   shows "set (take_indices B
              (find_nonzeros_from_input_vec C)) \<subseteq> A"
 proof - 
   have unfold: "\<And> x. (x \<in> (set (take_indices B
              (find_nonzeros_from_input_vec C))) \<Longrightarrow> x \<in> A)"   
   proof -
     fix x
     assume in_set: "x \<in> set (take_indices B (find_nonzeros_from_input_vec C))"
     have h: "\<exists>n< dim_vec C. (C $ n \<noteq> 0 \<and> (nth B n) = x)"
     proof - 
       have h1: "\<exists>n < length B.(nth B n) = x" 
         using in_set unfolding take_indices_def
           find_nonzeros_from_input_vec_def eq_len by auto
       have h2: "\<forall>n< length B. (nth B n = x \<longrightarrow> List.member (find_nonzeros_from_input_vec C) n)"
       proof clarsimp 
         fix n
         assume leq_hyp: "n < length B"
         assume x_eq: "x = B ! n"
         have h: "(B !n) \<in> set (map ((!) B) (find_nonzeros_from_input_vec C))"
           using x_eq in_set
           by (simp add: take_indices_def) 
         then have h2: "List.member (map ((!) B) (find_nonzeros_from_input_vec C)) (B ! n)"
           using in_set
           by (meson in_set_member) 
         then have h3: "\<exists>k< length B. (List.member (find_nonzeros_from_input_vec C) k \<and> ((B ! k) = (B ! n)))"
-          by (smt atLeastLessThan_iff eq_len find_nonzeros_from_input_vec_def imageE in_set_member mem_Collect_eq set_filter set_map set_upt)
+          by (smt (verit) atLeastLessThan_iff eq_len find_nonzeros_from_input_vec_def imageE in_set_member mem_Collect_eq set_filter set_map set_upt)
         have h4: "\<forall>v< length B. ((B ! v) = (B ! n) \<longrightarrow> v = n)"
-          using dist apply (auto)
-          using leq_hyp nth_eq_iff_index_eq by blast
+          using dist by (metis find_first_unique leq_hyp)
         then show "List.member (find_nonzeros_from_input_vec C) n"
           using h2 h3 h4 by auto
       qed
       then have "\<forall>n<length B. (nth B n = x \<longrightarrow> C $ n \<noteq> 0)" 
         using find_zeros_from_vec_prop [of C]
         by (simp add: eq_len)
       then show ?thesis using h1 eq_len
         by auto 
     qed
     thus "x \<in> A" using not_in_hyp 
       by blast 
   qed
   then show ?thesis
     by blast 
 qed
 
 (* Show that dropping columns doesn't affect the consistent sign assignments *)
 lemma reduction_doesnt_break_things_signs:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
   shows "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(reduction_signs p qs signs subsets (matrix_A signs subsets))"
 proof - 
   have dim_hyp2: "matr_option (dim_row (matrix_A signs subsets))
      (mat_inverse (matrix_A signs subsets)) \<in> carrier_mat (length signs) (length signs)"
     using invertible_mat dim_invertible
     using same_size by fastforce 
   have "(construct_lhs_vector p qs signs) = solve_for_lhs p qs subsets (matrix_A signs subsets)"
     using construct_lhs_matches_solve_for_lhs assms by auto
   then have "(solve_for_lhs p qs subsets (matrix_A signs subsets)) =
    vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) signs))" 
     using construct_lhs_vector_cleaner assms
     by (metis (mono_tags, lifting) list.map_cong map_map o_apply of_int_of_nat_eq)
   then have "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))). 
        (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n = 0) \<longrightarrow>
        (nth signs n) \<notin> set (characterize_consistent_signs_at_roots_copr p qs))"
   proof - 
     have h0: "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))). 
        (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n = 0) \<longrightarrow> 
        rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = (nth signs n)}) = 0)"
       by (metis (mono_tags, lifting) \<open>construct_lhs_vector p qs signs = solve_for_lhs p qs subsets (matrix_A signs subsets)\<close> construct_lhs_vector_clean nonzero of_nat_0_eq_iff of_rat_of_nat_eq size_of_lhs)
     have h1: "\<forall> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) = 0 \<longrightarrow> 
         (\<nexists> x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w))"
     proof clarsimp 
       fix x
       assume card_asm: "card {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = consistent_sign_vec_copr qs x} = 0"
       assume zero_asm: "poly p x = 0"
       have card_hyp: "{xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = consistent_sign_vec_copr qs x} = {}"
         using card_eq_0_iff
         using card_asm nonzero poly_roots_finite by fastforce 
       have "x \<in> {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = consistent_sign_vec_copr qs x}"
         using zero_asm by auto
       thus "False" using card_hyp
         by blast
     qed
     have h2: "\<And> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) = 0 \<Longrightarrow>
        (\<not>List.member (characterize_consistent_signs_at_roots_copr p qs) w))"
       by (smt (verit, best) characterize_consistent_signs_at_roots_copr_def characterize_root_list_p_def h1 imageE in_set_member mem_Collect_eq nonzero poly_roots_finite set_map set_remdups sorted_list_of_set(1))
     then have h3: "\<forall> w. rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) = 0 \<longrightarrow> 
         w \<notin> set (characterize_consistent_signs_at_roots_copr p qs)"
       by (simp add: in_set_member)
     show ?thesis using h0 h3
       by blast 
   qed
   then have "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set (take_indices signs
              (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
     using all_info
       reduction_signs_set_helper_lemma[where A = "set (characterize_consistent_signs_at_roots_copr p qs)", where B = "signs",
       where C = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"]
     using dim_hyp2 solve_for_lhs_def by (simp add: mat_inverse_same)
   then show ?thesis unfolding reduction_signs_def by auto
 qed
 
 lemma reduction_deletes_bad_sign_conds:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
   shows "set (characterize_consistent_signs_at_roots_copr p qs) = set(reduction_signs p qs signs subsets (matrix_A signs subsets))"
 proof - 
   have dim_hyp2: "matr_option (dim_row (matrix_A signs subsets))
        (mat_inverse (matrix_A signs subsets)) \<in> carrier_mat (length signs) (length signs)"
     using invertible_mat dim_invertible
     using same_size by fastforce 
   have supset: "set (characterize_consistent_signs_at_roots_copr p qs) \<supseteq> set(reduction_signs p qs signs subsets (matrix_A signs subsets))" 
   proof - 
     have "(construct_lhs_vector p qs signs) = solve_for_lhs p qs subsets (matrix_A signs subsets)"
       using construct_lhs_matches_solve_for_lhs assms by auto
     then have "(solve_for_lhs p qs subsets (matrix_A signs subsets)) =
        vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) signs))" 
       using construct_lhs_vector_cleaner assms
       by (metis (mono_tags, lifting) list.map_cong map_map o_apply of_int_of_nat_eq)
     then have "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))). 
            (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n \<noteq> 0) \<longrightarrow>
            (nth signs n) \<in> set (characterize_consistent_signs_at_roots_copr p qs))"
     proof - 
       have h0: "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))). 
            (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n = 0) \<longrightarrow> 
            rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = (nth signs n)}) = 0)"
         by (metis (mono_tags, lifting) \<open>construct_lhs_vector p qs signs = solve_for_lhs p qs subsets (matrix_A signs subsets)\<close> construct_lhs_vector_clean nonzero of_nat_0_eq_iff of_rat_of_nat_eq size_of_lhs)
       have h1: "\<forall> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) \<noteq> 0 \<longrightarrow> 
             (\<exists> x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w))"
       proof clarsimp 
         fix w
         assume card_asm: "0 < card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}"
         show "\<exists>x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w"
           by (metis (mono_tags, lifting) Collect_empty_eq card_asm card_eq_0_iff gr_implies_not0)
       qed
       have h2: "\<And> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) \<noteq> 0 \<Longrightarrow>
            (List.member (characterize_consistent_signs_at_roots_copr p qs) w))"
       proof clarsimp 
         fix w
         assume card_asm: " 0 < card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}"
         have h0: "\<exists>x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w"
           using card_asm
           by (simp add: h1) 
         then show "List.member (characterize_consistent_signs_at_roots_copr p qs) w" 
           unfolding characterize_consistent_signs_at_roots_copr_def
           using in_set_member nonzero poly_roots_finite characterize_root_list_p_def by fastforce
       qed
       then have h3: "\<forall> w. rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) \<noteq> 0 \<longrightarrow> 
             w \<in> set (characterize_consistent_signs_at_roots_copr p qs)"
         by (simp add: in_set_member)
       show ?thesis using h0 h3
         by (metis (no_types, lifting) \<open>solve_for_lhs p qs subsets (matrix_A signs subsets) = vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) signs))\<close> dim_vec_of_list length_map nth_map vec_of_list_index)
     qed
     then have "set (take_indices signs
                  (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) \<subseteq>
               set (characterize_consistent_signs_at_roots_copr p qs)"
       using all_info
         reduction_signs_set_helper_lemma2[where A = "set (characterize_consistent_signs_at_roots_copr p qs)", where B = "signs",
         where C = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"]
       using distinct_signs dim_hyp2 solve_for_lhs_def
       by (simp add: mat_inverse_same)
     then show ?thesis unfolding reduction_signs_def by auto
   qed
   have subset: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(reduction_signs p qs signs subsets (matrix_A signs subsets))" 
     using reduction_doesnt_break_things_signs[of p qs signs subsets] assms
     by blast 
   then show ?thesis using supset subset by auto 
 qed
 
 theorem reduce_system_sign_conditions:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
   shows "set (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))) = set (characterize_consistent_signs_at_roots_copr p qs)"
   unfolding get_signs_def
   using reduction_deletes_bad_sign_conds[of p qs signs subsets] apply (auto)
    apply (simp add: all_info distinct_signs match nonzero reduction_signs_def welldefined_signs1)
   using nonzero invertible_mat apply (metis snd_conv)
   by (metis all_info distinct_signs invertible_mat match nonzero reduction_signs_def snd_conv welldefined_signs1) 
 
 subsection "Showing matrix equation preserved when reducing"
 lemma rows_to_keep_lem:
   fixes A:: "('a::field) mat"
   shows "\<And>ell. ell \<in> set (rows_to_keep A) \<Longrightarrow> ell < dim_row A"
   unfolding rows_to_keep_def
   apply auto
   using rref_pivot_positions
   by (metis carrier_mat_triv gauss_jordan_single(2) gauss_jordan_single(3) index_transpose_mat(3)) 
 
 lemma reduce_system_matrix_equation_preserved:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs: "well_def_signs (length qs) signs"
   assumes welldefined_subsets: "all_list_constr (subsets) (length qs)"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
   assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
   shows "satisfy_equation p qs (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
   (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
 proof - 
   have poly_type_hyp: "p \<noteq> 0" using nonzero by auto
   have distinct_signs_hyp: "distinct (snd (snd (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))))" 
   proof - 
     let ?sym = "(find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
     have h1: "\<forall> i < length (take_indices signs ?sym). \<forall>j < length(take_indices signs ?sym).
       i \<noteq> j \<longrightarrow> nth (take_indices signs ?sym) i \<noteq> nth (take_indices signs ?sym) j" 
       using distinct_signs unfolding take_indices_def 
     proof clarsimp 
       fix i
       fix j
       assume "distinct signs"
       assume "i < length
                 (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
       assume "j < length
                 (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
       assume neq_hyp: "i \<noteq> j"
       assume "signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets 
               (matrix_A signs subsets)) ! i) =
            signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets 
               (matrix_A signs subsets)) ! j)"
       have h1: "find_nonzeros_from_input_vec (solve_for_lhs p qs subsets 
               (matrix_A signs subsets)) ! i \<noteq> find_nonzeros_from_input_vec (solve_for_lhs p qs subsets 
               (matrix_A signs subsets)) ! j"
         unfolding find_nonzeros_from_input_vec_def using neq_hyp
         by (metis \<open>i < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> \<open>j < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> distinct_conv_nth distinct_filter distinct_upt find_nonzeros_from_input_vec_def) 
       then show "False" using distinct_signs
       proof -
         have f1: "\<forall>p ns n. ((n::nat) \<in> {n \<in> set ns. p n}) = (n \<in> set ns \<and> n \<in> Collect p)"
           by simp
         then have f2: "filter (\<lambda>n. solve_for_lhs p qs subsets (matrix_A signs subsets) $ n \<noteq> 0) [0..<dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))] ! i \<in> set [0..<length signs]"
           by (metis (full_types) \<open>i < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> construct_lhs_matches_solve_for_lhs find_nonzeros_from_input_vec_def invertible_mat match nth_mem set_filter size_of_lhs)
         have "filter (\<lambda>n. solve_for_lhs p qs subsets (matrix_A signs subsets) $ n \<noteq> 0) [0..<dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))] ! j \<in> set [0..<length signs]"
           using f1 by (metis (full_types) \<open>j < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> construct_lhs_matches_solve_for_lhs find_nonzeros_from_input_vec_def invertible_mat match nth_mem set_filter size_of_lhs)
         then show ?thesis
           using f2 by (metis \<open>signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)) ! i) = signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)) ! j)\<close> atLeastLessThan_iff distinct_conv_nth distinct_signs find_nonzeros_from_input_vec_def h1 set_upt)
       qed
     qed
     then have "distinct (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
       using distinct_conv_nth by blast 
     then show ?thesis
       using get_signs_def reduction_signs_def reduction_signs_is_get_signs by auto 
   qed
   have all_info_hyp: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(snd (snd (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))))"
     using reduce_system_sign_conditions assms unfolding get_signs_def by auto
   have pairwise_rel_prime_hyp: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))" 
     using pairwise_rel_prime by auto
   have welldefined_hyp: "all_list_constr (fst (snd (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))) (length qs)"
     using welldefined_subsets rows_to_keep_lem
     unfolding all_list_constr_def List.member_def list_constr_def list_all_def
     apply (auto simp add: Let_def take_indices_def take_cols_from_matrix_def)
     using nth_mem by fastforce
   then show ?thesis using poly_type_hyp distinct_signs_hyp all_info_hyp pairwise_rel_prime_hyp welldefined_hyp
     using matrix_equation unfolding get_subsets_def get_signs_def
     by blast 
 qed
 
 (* Show that we are tracking the correct matrix in the algorithm *)
 subsection "Showing matrix preserved"
 lemma reduce_system_matrix_signs_helper_aux:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   fixes S:: "nat list"
   assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length signs"
   assumes nonzero: "p \<noteq> 0"
   shows "alt_matrix_A (take_indices signs S) subsets = take_cols_from_matrix (alt_matrix_A signs subsets) S"
 proof - 
   have h0a: "dim_col (take_cols_from_matrix (alt_matrix_A signs subsets) S) = length (take_indices signs S)" 
     unfolding take_cols_from_matrix_def apply (auto) unfolding take_indices_def by auto
   have h0: "\<forall>i < length (take_indices signs S). (col (alt_matrix_A (take_indices signs S) subsets ) i = 
 col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i)" 
   proof clarsimp
     fix i
     assume asm: "i < length (take_indices signs S)"
     have i_lt: "i < length (map ((!) (cols (alt_matrix_A signs subsets))) S)" using asm
       apply (auto) unfolding take_indices_def by auto
     have h0: " vec (length subsets) (\<lambda>j. z (subsets ! j) (map ((!) signs) S ! i)) = 
       vec (length subsets) (\<lambda>j. z (subsets ! j) (signs ! (S ! i)))" using nth_map
       by (metis \<open>i < length (take_indices signs S)\<close> length_map take_indices_def) 
     have dim: "(map ((!) (cols (alt_matrix_A signs subsets))) S) ! i \<in> carrier_vec (dim_row (alt_matrix_A signs subsets))"
     proof - 
       have "dim_col (alt_matrix_A signs subsets) = length (signs)"
         by (simp add: alt_matrix_A_def) 
       have well_d: "S ! i < length (signs)" using well_def_h
         using i_lt in_set_member by fastforce 
       have 
         map_eq: "(map ((!) (cols (alt_matrix_A signs subsets))) S) ! i  = nth (cols (alt_matrix_A signs subsets))  (S ! i)"
         using i_lt by auto
       have "nth (cols (alt_matrix_A signs subsets))  (S ! i) \<in> carrier_vec (dim_row (alt_matrix_A signs subsets))"
         using col_dim unfolding cols_def using nth_map well_d
         by (simp add: \<open>dim_col (alt_matrix_A signs subsets) = length signs\<close>) 
       then show ?thesis using map_eq unfolding alt_matrix_A_def by auto
     qed
     have h1: "col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i = 
       col (mat_of_cols (dim_row (alt_matrix_A signs subsets)) (map ((!) (cols (alt_matrix_A signs subsets))) S)) i "
       by (simp add: take_cols_from_matrix_def take_indices_def)
     have h2: "col (mat_of_cols (dim_row (alt_matrix_A signs subsets)) (map ((!) (cols (alt_matrix_A signs subsets))) S)) i 
       = nth (map ((!) (cols (alt_matrix_A signs subsets))) S) i " 
       using dim i_lt asm col_mat_of_cols[where j = "i", where n = "(dim_row (alt_matrix_A signs subsets))",
           where vs = "(map ((!) (cols (alt_matrix_A signs subsets))) S)"]
       by blast 
     have h3: "col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i = (col (alt_matrix_A signs subsets) (S !i))"
       using h1 h2 apply (auto)
       by (metis alt_matrix_char asm cols_nth dim_col_mat(1) in_set_member length_map mat_of_rows_list_def matrix_A_def nth_map nth_mem take_indices_def well_def_h)
     have "vec (length subsets) (\<lambda>j. z (subsets ! j) (signs ! (S ! i))) = (col (alt_matrix_A signs subsets) (S !i))"
       by (metis asm in_set_member length_map nth_mem signs_are_cols take_indices_def well_def_h)
     then have "vec (length subsets) (\<lambda>j. z (subsets ! j) (take_indices signs S ! i)) =
       col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i "
       using h0 h3
       by (simp add: take_indices_def) 
     then show "col (alt_matrix_A (take_indices signs S) subsets) i =
          col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i "
       using asm signs_are_cols[where signs = "(take_indices signs S)", where subsets = "subsets"] 
       by auto
   qed
   then show ?thesis   unfolding alt_matrix_A_def take_cols_from_matrix_def apply (auto) 
     using h0a mat_col_eqI
     by (metis alt_matrix_A_def dim_col_mat(1) dim_row_mat(1) h0 mat_of_cols_def take_cols_from_matrix_def) 
 qed
 
 
 lemma reduce_system_matrix_signs_helper:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   fixes S:: "nat list"
   assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length signs"
   assumes nonzero: "p \<noteq> 0"
   shows "matrix_A (take_indices signs S) subsets = take_cols_from_matrix (matrix_A signs subsets) S"
   using reduce_system_matrix_signs_helper_aux alt_matrix_char assms by auto
 
 lemma reduce_system_matrix_subsets_helper_aux:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   fixes S:: "nat list"
   assumes inv: "length subsets \<ge> length signs"
   assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length subsets"
   assumes nonzero: "p \<noteq> 0"
   shows "alt_matrix_A signs (take_indices subsets S) = take_rows_from_matrix (alt_matrix_A signs subsets) S"
 proof - 
   have h0a: "dim_row (take_rows_from_matrix (alt_matrix_A signs subsets) S) = length (take_indices subsets S)" 
     unfolding take_rows_from_matrix_def apply (auto) unfolding take_indices_def by auto
   have h0: "\<forall>i < length (take_indices subsets S). (row (alt_matrix_A signs (take_indices subsets S) ) i = 
 row (take_rows_from_matrix (alt_matrix_A signs subsets) S) i)" 
   proof clarsimp
     fix i
     assume asm: "i < length (take_indices subsets S)"
     have i_lt: "i < length (map ((!) (rows (alt_matrix_A signs subsets))) S)" using asm
       apply (auto) unfolding take_indices_def by auto
     have h0: "row (take_rows_from_matrix (alt_matrix_A signs subsets) S) i =
     row (mat_of_rows (dim_col (alt_matrix_A signs subsets)) (map ((!) (rows (alt_matrix_A signs subsets))) S)) i "
       unfolding take_rows_from_matrix_def take_indices_def by auto
     have dim: "(map ((!) (rows (alt_matrix_A signs subsets))) S) ! i \<in> carrier_vec (dim_col (alt_matrix_A signs subsets))"
     proof - 
       have "dim_col (alt_matrix_A signs subsets) = length (signs)"
         by (simp add: alt_matrix_A_def) 
       then have lenh: "dim_col (alt_matrix_A signs subsets) \<le> length (subsets)"
         using assms
         by auto 
       have well_d: "S ! i < length (subsets)" using well_def_h
         using i_lt in_set_member by fastforce 
       have 
         map_eq: "(map ((!) (rows (alt_matrix_A signs subsets))) S) ! i  = nth (rows (alt_matrix_A signs subsets))  (S ! i)"
         using i_lt by auto
       have "nth (rows (alt_matrix_A signs subsets))  (S ! i) \<in> carrier_vec (dim_col (alt_matrix_A signs subsets))"
         using col_dim unfolding rows_def using nth_map well_d
         using lenh
         by (simp add: alt_matrix_A_def) 
       then show ?thesis using map_eq unfolding alt_matrix_A_def by auto
     qed
     have h1: " row (mat_of_rows (dim_col (alt_matrix_A signs subsets)) (map ((!) (rows (alt_matrix_A signs subsets))) S)) i
       = (row  (alt_matrix_A signs subsets) (S ! i)) "
       using dim i_lt mat_of_rows_row[where i = "i", where n = "(dim_col (alt_matrix_A signs subsets))",
           where vs = "(map ((!) (rows (alt_matrix_A signs subsets))) S)"]
       using alt_matrix_char in_set_member nth_mem well_def_h by fastforce
     have "row (alt_matrix_A signs (take_indices subsets S) ) i = (row  (alt_matrix_A signs subsets) (S ! i))"
       using subsets_are_rows
     proof -
       have f1: "i < length S"
         by (metis (no_types) asm length_map take_indices_def)
       then have "List.member S (S ! i)"
         by (meson in_set_member nth_mem)
       then show ?thesis
         using f1 by (simp add: \<open>\<And>subsets signs. \<forall>i<length subsets. row (alt_matrix_A signs subsets) i = vec (length signs) (\<lambda>j. z (subsets ! i) (signs ! j))\<close> take_indices_def well_def_h)
     qed 
     then show "(row (alt_matrix_A signs (take_indices subsets S) ) i = 
       row (take_rows_from_matrix (alt_matrix_A signs subsets) S) i)" 
       using h0 h1 unfolding take_indices_def by auto
   qed
   then show ?thesis  unfolding alt_matrix_A_def take_rows_from_matrix_def apply (auto) 
     using eq_rowI
     by (metis alt_matrix_A_def dim_col_mat(1) dim_row_mat(1) h0 length_map mat_of_rows_def take_indices_def take_rows_from_matrix_def) 
 qed
 
 
 lemma reduce_system_matrix_subsets_helper:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   fixes S:: "nat list"
   assumes nonzero: "p \<noteq> 0"
   assumes inv: "length subsets \<ge> length signs"
   assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length subsets"
   shows "matrix_A signs (take_indices subsets S) = take_rows_from_matrix (matrix_A signs subsets) S"
   using assms reduce_system_matrix_subsets_helper_aux alt_matrix_char
   by auto
 
 lemma reduce_system_matrix_match:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   assumes inv: "invertible_mat (matrix_A signs subsets)"
   shows "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
   (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))) = 
   (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
 proof -
   let ?A = "(matrix_A signs subsets)"
   let ?lhs_vec = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"
   let ?red_mtx = "(take_rows_from_matrix (reduce_mat_cols (matrix_A signs subsets) ?lhs_vec) (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) ?lhs_vec)))"
   have h1: "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
   (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
    = matrix_A (reduction_signs p qs signs subsets (matrix_A signs subsets)) (reduction_subsets p qs signs subsets (matrix_A signs subsets))"
     using reduction_signs_is_get_signs reduction_subsets_is_get_subsets by auto
   have h1_var: "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
   (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
    = matrix_A (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec)) (take_indices subsets (rows_to_keep (reduce_mat_cols ?A ?lhs_vec)))"
     using h1 reduction_signs_def reduction_subsets_def by auto 
   have h2: "?red_mtx = (take_rows_from_matrix (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec)) (rows_to_keep (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec))))"
     by simp
   have h30: "(construct_lhs_vector p qs signs) = ?lhs_vec"
     using assms construct_lhs_matches_solve_for_lhs
     by simp 
   have h3a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (signs)" 
     using h30 size_of_lhs unfolding find_nonzeros_from_input_vec_def apply (auto)
     by (metis atLeastLessThan_iff filter_is_subset member_def set_upt subset_eq) 
   have h3b_a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (subsets)" 
     using assms h30 size_of_lhs same_size unfolding find_nonzeros_from_input_vec_def apply (auto)
     by (simp add: find_nonzeros_from_input_vec_def h3a)
   have h3ba: "length
      (filter (\<lambda>i. solve_for_lhs p qs subsets (matrix_A signs subsets) $ i \<noteq> 0)
        [0..<length subsets])
     \<le> length subsets" using length_filter_le[where P = "(\<lambda>i. solve_for_lhs p qs subsets (matrix_A signs subsets) $ i \<noteq> 0)",
     where xs = "[0..<length subsets]"] length_upto by auto
   have " length subsets = dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))"
     using h30 inv size_of_lhs same_size[of signs subsets] apply (auto)
     by metis 
   then have "length
      (filter (\<lambda>i. solve_for_lhs p qs subsets (matrix_A signs subsets) $ i \<noteq> 0)
        [0..<dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))])
     \<le> length subsets" using h3ba
     by auto
   then have h3b: "length subsets \<ge> length (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec))" 
     unfolding take_indices_def find_nonzeros_from_input_vec_def by auto
   have h3c: "\<forall>x. List.member (rows_to_keep (reduce_mat_cols ?A ?lhs_vec)) x \<longrightarrow> x < length (subsets)"
   proof clarsimp
     fix x
     assume x_mem: "List.member (rows_to_keep
             (take_cols_from_matrix (matrix_A signs subsets)
               (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) x"
     obtain nn :: "rat list list \<Rightarrow> nat list \<Rightarrow> nat" where
       "\<forall>x2 x3. (\<exists>v4. v4 \<in> set x3 \<and> \<not> v4 < length x2) = (nn x2 x3 \<in> set x3 \<and> \<not> nn x2 x3 < length x2)"
       by moura
     then have f4: "nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> \<not> nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) < length signs \<or> matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
       using h3a nonzero reduce_system_matrix_signs_helper by auto
     then have "matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T)))"
       using f4
       by (metis h3a in_set_member rows_to_keep_def x_mem)
     thus "x < length (subsets)" using x_mem unfolding rows_to_keep_def
       by (metis (no_types) dim_row_matrix_A rows_to_keep_def rows_to_keep_lem)
   qed
   have h3: "matrix_A (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec)) (take_indices subsets (rows_to_keep (reduce_mat_cols ?A ?lhs_vec))) = 
     (take_rows_from_matrix (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec)) (rows_to_keep (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec))))" 
     using inv h3a h3b h3c reduce_system_matrix_subsets_helper reduce_system_matrix_signs_helper
       assms by auto
   show ?thesis using h1 h2 h3
     by (metis fst_conv get_matrix_def h1_var reduce_system.simps reduction_step.simps)
 qed
 
 (* gauss_jordan_single_rank is crucial in this section *)
 subsection "Showing invertibility preserved when reducing"
 
 (* Overall:
   Start with a matrix equation.
   Input a matrix, subsets, and signs.
   Drop columns of the matrix based on the 0's on the LHS---so extract a list of 0's. Reduce signs accordingly.
   Then find a list of rows to delete based on using rank (use the transpose result, pivot positions!),
    and delete those rows.  Reduce subsets accordingly.
   End with a reduced system! *)
 lemma well_def_find_zeros_from_lhs_vec:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes len_eq: "length subsets = length signs"
   assumes inv: "invertible_mat (matrix_A signs subsets)"
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   shows "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
                     (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
           j < length (cols (matrix_A signs subsets)))"
 proof - 
   fix i
   fix j
   assume j_in: " j \<in> set (find_nonzeros_from_input_vec
                       (solve_for_lhs p qs subsets (matrix_A signs subsets))) "
   let ?og_mat = "(matrix_A signs subsets)"
   let ?lhs = "(solve_for_lhs p qs subsets ?og_mat)"
   let ?new_mat = "(take_rows_from_matrix (reduce_mat_cols ?og_mat ?lhs) (rows_to_keep (reduce_mat_cols ?og_mat ?lhs)))"
   have "square_mat (matrix_A signs subsets)" using inv
     using invertible_mat_def by blast
   then have mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)" 
     using size_of_mat
     by auto 
   have "dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)) = (length signs)"
     using size_of_lhs construct_lhs_matches_solve_for_lhs assms
     by (metis (full_types))
   then have h: "j < (length signs)"
     using j_in unfolding find_nonzeros_from_input_vec_def
     by simp 
   then show "j <  length (cols (matrix_A signs subsets))" 
     using mat_size by auto
 qed
 
 lemma take_cols_subsets_og_cols:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes len_eq: "length subsets = length signs"
   assumes inv: "invertible_mat (matrix_A signs subsets)"
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   shows "set (take_indices (cols (matrix_A signs subsets))
           (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))
     \<subseteq> set (cols (matrix_A signs subsets))"
 proof -
   have well_def: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
                     (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
           j < length (cols (matrix_A signs subsets)))"
     using assms well_def_find_zeros_from_lhs_vec by auto
   have "\<forall>x. x \<in> set (take_indices (cols (matrix_A signs subsets))
           (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) 
     \<longrightarrow> x \<in>  set (cols (matrix_A signs subsets))" 
   proof clarsimp 
     fix x
     let ?og_list = "(cols (matrix_A signs subsets))"
     let ?ind_list = "(find_nonzeros_from_input_vec
                      (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
     assume x_in: "x \<in> set (take_indices ?og_list ?ind_list)"
     show "x \<in> set (cols (matrix_A signs subsets))" 
       using x_in unfolding take_indices_def using in_set_member apply (auto)
       using in_set_conv_nth well_def by fastforce
   qed
   then show ?thesis
     by blast 
 qed
 
 lemma reduction_doesnt_break_things_invertibility_step1:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes len_eq: "length subsets = length signs"
   assumes inv: "invertible_mat (matrix_A signs subsets)"
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   shows "vec_space.rank (length signs) (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets))) =
     (length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
 proof - 
   let ?og_mat = "(matrix_A signs subsets)"
   let ?lhs = "(solve_for_lhs p qs subsets ?og_mat)"
   let ?new_mat = "(take_rows_from_matrix (reduce_mat_cols ?og_mat ?lhs) (rows_to_keep (reduce_mat_cols ?og_mat ?lhs)))"
   have "square_mat (matrix_A signs subsets)" using inv
     using invertible_mat_def by blast
   then have mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)" 
     using size_of_mat
     by auto 
   then have mat_size_alt: "?og_mat \<in> carrier_mat (length subsets) (length subsets)" 
     using size_of_mat same_size assms 
     by auto 
   have det_h: "det ?og_mat \<noteq> 0"
     using invertible_det[where A = "matrix_A signs subsets"] mat_size
     using inv by blast
   then have rank_h: "vec_space.rank (length signs) ?og_mat = (length signs)" 
     using vec_space.det_rank_iff  mat_size
     by auto
   then have dist_cols: "distinct (cols ?og_mat)" using mat_size vec_space.non_distinct_low_rank[where A = ?og_mat, where n = "length signs"]
     by auto
   have well_def: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
                     (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
           j < length (cols (matrix_A signs subsets)))"
     using assms well_def_find_zeros_from_lhs_vec by auto
   have dist1: "distinct
      (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
     unfolding find_nonzeros_from_input_vec_def by auto
   have clear: "set (take_indices (cols (matrix_A signs subsets))
           (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))
     \<subseteq> set (cols (matrix_A signs subsets))"
     using assms take_cols_subsets_og_cols by auto
   then have "distinct (take_indices (cols (matrix_A signs subsets))
           (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
     unfolding take_indices_def
     using dist1 dist_cols well_def conjugatable_vec_space.distinct_map_nth[where ls = "cols (matrix_A signs subsets)", where inds = "(find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"]
     by auto
   then have unfold_thesis: "vec_space.rank (length signs) (mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) (find_nonzeros_from_input_vec ?lhs)))
 = (length (find_nonzeros_from_input_vec ?lhs))" 
     using clear inv conjugatable_vec_space.rank_invertible_subset_cols[where A= "matrix_A signs subsets", where B = "(take_indices (cols (matrix_A signs subsets))
          (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"]
     by (simp add: len_eq mat_size take_indices_def)
   then show ?thesis apply (simp) unfolding take_cols_from_matrix_def by auto
 qed
 
 lemma rechar_take_cols: "take_cols_var A B = take_cols_from_matrix A B"
   unfolding take_cols_var_def take_cols_from_matrix_def take_indices_def by auto
 
 lemma rows_and_cols_transpose: "rows M = cols M\<^sup>T"
   using row_transpose  by simp 
 
 lemma take_rows_and_take_cols:  "(take_rows_from_matrix M r) = (take_cols_from_matrix M\<^sup>T r)\<^sup>T"
   unfolding take_rows_from_matrix_def take_cols_from_matrix_def
   using transpose_carrier_mat rows_and_cols_transpose apply (auto)
   by (simp add: transpose_mat_of_cols) 
 
 lemma reduction_doesnt_break_things_invertibility:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes len_eq: "length subsets = length signs"
   assumes inv: "invertible_mat (matrix_A signs subsets)"
   assumes nonzero: "p \<noteq> 0"
   assumes welldefined_signs1: "well_def_signs (length qs) signs"
   assumes distinct_signs: "distinct signs"
   assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
   assumes match: "satisfy_equation p qs subsets signs"
   shows "invertible_mat (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
 proof - 
   let ?og_mat = "(matrix_A signs subsets)"
   let ?lhs = "(solve_for_lhs p qs subsets ?og_mat)"
   let ?step1_mat = "(reduce_mat_cols ?og_mat ?lhs)"
   let ?new_mat = "take_rows_from_matrix ?step1_mat (rows_to_keep ?step1_mat)"
   let ?ind_list = "(find_nonzeros_from_input_vec  ?lhs)"
   have "square_mat (matrix_A signs subsets)" using inv
     using invertible_mat_def by blast
   then have og_mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)" 
     using size_of_mat
     by auto 
   have "dim_col (mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) ?ind_list))
       = (length (find_nonzeros_from_input_vec ?lhs))"
     by (simp add: take_indices_def) 
   then have "mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) ?ind_list)
       \<in> carrier_mat (length signs) (length (find_nonzeros_from_input_vec ?lhs))"
     by (simp add: len_eq mat_of_cols_def)
   then have step1_mat_size: "?step1_mat \<in> carrier_mat (length signs) (length (find_nonzeros_from_input_vec ?lhs))"
     by (simp add: take_cols_from_matrix_def)
   then have "dim_row ?step1_mat \<ge> dim_col ?step1_mat"
     by (metis carrier_matD(1) carrier_matD(2) construct_lhs_matches_solve_for_lhs diff_zero find_nonzeros_from_input_vec_def inv length_filter_le length_upt match size_of_lhs)
   then have gt_eq_assm: "dim_col ?step1_mat\<^sup>T  \<ge> dim_row  ?step1_mat\<^sup>T"
     by simp 
   have det_h: "det ?og_mat \<noteq> 0"
     using invertible_det[where A = "matrix_A signs subsets"] og_mat_size
     using inv by blast
   then have rank_h: "vec_space.rank (length signs) ?og_mat = (length signs)" 
     using vec_space.det_rank_iff  og_mat_size
     by auto
   have rank_drop_cols: "vec_space.rank (length signs) ?step1_mat = (dim_col ?step1_mat)"
     using assms reduction_doesnt_break_things_invertibility_step1 step1_mat_size 
     by auto
   let ?step1_T = "?step1_mat\<^sup>T"
   have rank_transpose: "vec_space.rank (length signs) ?step1_mat = vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) ?step1_T"
     using transpose_rank[of ?step1_mat]
     using step1_mat_size by auto  
   have obv: "?step1_T \<in> carrier_mat (dim_row ?step1_T) (dim_col ?step1_T)" by auto
   have should_have_this:"vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) ?step1_T"
     using obv gt_eq_assm conjugatable_vec_space.gauss_jordan_single_rank[where A = "?step1_T", where n = "dim_row ?step1_T", where nc = "dim_col ?step1_T"]
     by (simp add: take_cols_from_matrix_def take_indices_def)
   then have "vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = dim_col ?step1_mat"
     using rank_drop_cols rank_transpose by auto
   then have with_take_cols_from_matrix: "vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols_from_matrix ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = dim_col ?step1_mat"
-    using rank_transpose rechar_take_cols conjugatable_vec_space.gjs_and_take_cols_var
-    apply (auto)
-    by (smt conjugatable_vec_space.gjs_and_take_cols_var gt_eq_assm obv rechar_take_cols reduce_mat_cols.simps)
+    by (metis rechar_take_cols conjugatable_vec_space.gjs_and_take_cols_var gt_eq_assm obv)
   have "(take_rows_from_matrix ?step1_mat (rows_to_keep ?step1_mat)) = (take_cols_from_matrix ?step1_T  (rows_to_keep ?step1_mat))\<^sup>T"
     using take_rows_and_take_cols
     by blast 
   then have rank_new_mat: "vec_space.rank (dim_row ?new_mat) ?new_mat = dim_col ?step1_mat"
-    using with_take_cols_from_matrix transpose_rank apply (auto)
-  proof -
-    assume a1: "vec_space.rank (length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) (take_cols_from_matrix (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T)))) = dim_col (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
-    have f2: "\<forall>m. vec_space.rank (dim_row (m::rat mat)) m = vec_space.rank (dim_row m\<^sup>T) m\<^sup>T"
-      by (simp add: transpose_rank)
-    have f3: "dim_row (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
-      using \<open>dim_col (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> by force
-    have "vec_space.rank (length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T))))) = dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T"
-      using a1 by (simp add: take_cols_from_matrix_def)
-    then have "vec_space.rank (dim_row (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T)))))\<^sup>T) (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T)))))\<^sup>T = dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T"
-      using f3 f2 by presburger
-    then show "vec_space.rank (dim_col (take_cols_from_matrix (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T (rows_to_keep (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))))) (take_cols_from_matrix (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T (rows_to_keep (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))))\<^sup>T = dim_col (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
-      by (simp add: rows_to_keep_def take_cols_from_matrix_def)
-  qed 
+    using with_take_cols_from_matrix transpose_rank
+    by (metis carrier_matD(2) index_transpose_mat(2) mat_of_cols_carrier(2) rows_to_keep_def step1_mat_size take_cols_from_matrix_def)
   have "length (pivot_positions (gauss_jordan_single (?step1_mat\<^sup>T))) \<le> (length (find_nonzeros_from_input_vec ?lhs))"
     using obv length_pivot_positions_dim_row[where A = "(gauss_jordan_single (?step1_mat\<^sup>T))"]
     by (metis carrier_matD(1) carrier_matD(2) gauss_jordan_single(2) gauss_jordan_single(3) index_transpose_mat(2) step1_mat_size) 
   then have len_lt_eq: "length (pivot_positions (gauss_jordan_single (?step1_mat\<^sup>T))) \<le> dim_col ?step1_mat"
     using step1_mat_size
     by simp 
   have len_gt_false: "length (rows_to_keep ?step1_mat) < (dim_col ?step1_mat) \<Longrightarrow> False"
   proof - 
     assume length_lt: "length (rows_to_keep ?step1_mat) < (dim_col ?step1_mat)"
     have h: "dim_row ?new_mat < (dim_col ?step1_mat)"
       by (metis Matrix.transpose_transpose index_transpose_mat(3) length_lt length_map mat_of_cols_carrier(3) take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
     then show "False" using rank_new_mat
       by (metis Matrix.transpose_transpose carrier_matI index_transpose_mat(2) nat_less_le not_less_iff_gr_or_eq transpose_rank vec_space.rank_le_nc)    
   qed
   then have len_gt_eq: "length (rows_to_keep ?step1_mat) \<ge> (dim_col ?step1_mat)"
     using not_less by blast
   have len_match: "length (rows_to_keep ?step1_mat) = (dim_col ?step1_mat)"
     using len_lt_eq len_gt_eq
     by (simp add: rows_to_keep_def) 
   have mat_match: "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
   (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))) = 
   (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
     using reduce_system_matrix_match[of p qs signs subsets]  assms
     by blast 
   have f2: "length (get_subsets (take_rows_from_matrix (mat_of_cols (dim_row (matrix_A signs subsets)) (map ((!) (cols (matrix_A signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) (rows_to_keep (mat_of_cols (dim_row (matrix_A signs subsets)) (map ((!) (cols (matrix_A signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))), map ((!) subsets) (rows_to_keep (mat_of_cols (dim_row (matrix_A signs subsets)) (map ((!) (cols (matrix_A signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))), map ((!) signs) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
     by (metis (no_types) \<open>dim_col (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> \<open>length (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))) = dim_col (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> length_map reduce_mat_cols.simps reduce_system.simps reduction_step.simps reduction_subsets_def reduction_subsets_is_get_subsets take_cols_from_matrix_def take_indices_def)
   have f3: "\<forall>p ps rss nss m. map ((!) rss) (find_nonzeros_from_input_vec (solve_for_lhs p ps nss m)) = get_signs (reduce_system p (ps, m, nss, rss))"
     by (metis (no_types) reduction_signs_def reduction_signs_is_get_signs take_indices_def)
   have square_final_mat: "square_mat (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
     using mat_match assms size_of_mat same_size   
     apply (auto) using f2 f3
     by (metis (no_types, lifting) Matrix.transpose_transpose fst_conv get_matrix_def index_transpose_mat(2) len_match length_map mat_of_cols_carrier(2) mat_of_cols_carrier(3) reduce_mat_cols.simps take_cols_from_matrix_def take_indices_def take_rows_and_take_cols) 
   have rank_match: "vec_space.rank (dim_row ?new_mat) ?new_mat = dim_row ?new_mat"
     using len_match rank_new_mat
     by (simp add: take_cols_from_matrix_def take_indices_def take_rows_and_take_cols) 
   have "invertible_mat ?new_mat"
     using invertible_det og_mat_size
     using vec_space.det_rank_iff square_final_mat
     by (metis dim_col_matrix_A dim_row_matrix_A fst_conv get_matrix_def mat_match rank_match reduce_system.simps reduction_step.simps size_of_mat square_mat.elims(2))
   then show ?thesis apply (simp)
     by (metis fst_conv get_matrix_def)
 qed
 
 subsection "Well def signs preserved when reducing"
 
 lemma reduction_doesnt_break_length_signs:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes length_init : "\<forall> x\<in> set(signs). length x = length qs"
   assumes sat_eq: "satisfy_equation p qs subsets signs"
   assumes inv_mat: "invertible_mat (matrix_A signs subsets)"
   shows "\<forall>x \<in> set(reduction_signs p qs signs subsets (matrix_A signs subsets)). 
     length x = length qs"
 proof clarsimp 
   fix x
   assume x_in_set: "x \<in> set (reduction_signs p qs signs subsets (matrix_A signs subsets))"
   have "List.member (reduction_signs p qs signs subsets (matrix_A signs subsets)) x"
     using x_in_set by (simp add: in_set_member)
   then have take_ind: "List.member (take_indices signs
      (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) x"
     unfolding reduction_signs_def by auto
   have find_nz_len: "\<forall>y. List.member (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) y \<longrightarrow>  y < length signs"
     using size_of_lhs sat_eq inv_mat construct_lhs_matches_solve_for_lhs[of p qs subsets signs] unfolding find_nonzeros_from_input_vec_def
     by (metis atLeastLessThan_iff filter_is_subset in_set_member set_upt subset_code(1)) 
   then have "\<exists> n < length signs. x = signs ! n"
     using take_ind
     by (metis in_set_conv_nth reduction_signs_def take_indices_lem x_in_set) 
   then show "length x = length qs" using length_init take_indices_lem
     using nth_mem by blast
 qed
 
 subsection "Distinct signs preserved when reducing"
 
 lemma reduction_signs_are_distinct:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes sat_eq: "satisfy_equation p qs subsets signs"
   assumes inv_mat: "invertible_mat (matrix_A signs subsets)"
   assumes distinct_init: "distinct signs"
   shows "distinct (reduction_signs p qs signs subsets (matrix_A signs subsets))"
 proof -
   have solve_construct: "construct_lhs_vector p qs signs =
   solve_for_lhs p qs subsets (matrix_A signs subsets)"
     using construct_lhs_matches_solve_for_lhs assms
     by simp
   have h1: "distinct (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
     unfolding find_nonzeros_from_input_vec_def 
     using distinct_filter
     using distinct_upt by blast 
   have h2: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
           j < length signs)"
   proof - 
     fix j
     assume "j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
     show "j < length signs" using solve_construct size_of_lhs
       by (metis \<open>j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> atLeastLessThan_iff filter_is_subset find_nonzeros_from_input_vec_def set_upt subset_iff)
   qed
   then show ?thesis unfolding reduction_signs_def unfolding take_indices_def
     using distinct_init h1 h2 conjugatable_vec_space.distinct_map_nth[where ls = "signs", where inds = "(find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"]
     by blast
 qed
 
 subsection "Well def subsets preserved when reducing"
 
 lemma reduction_doesnt_break_subsets:  
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes length_init : "all_list_constr subsets (length qs)"
   assumes sat_eq: "satisfy_equation p qs subsets signs"
   assumes inv_mat: "invertible_mat (matrix_A signs subsets)"
   shows "all_list_constr (reduction_subsets p qs signs subsets (matrix_A signs subsets)) (length qs)"
   unfolding all_list_constr_def 
 proof clarsimp
   fix x
   assume in_red_subsets: "List.member (reduction_subsets p qs signs subsets (matrix_A signs subsets)) x "
   have solve_construct: "construct_lhs_vector p qs signs =
   solve_for_lhs p qs subsets (matrix_A signs subsets)"
     using construct_lhs_matches_solve_for_lhs assms
     by simp
   have rows_to_keep_hyp: "\<forall>y. y \<in> set (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))) \<longrightarrow> 
       y < length subsets" 
   proof clarsimp 
     fix y
     assume in_set: "y \<in> set (rows_to_keep
                    (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))"
     have in_set_2: "y \<in> set (rows_to_keep
                    (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (construct_lhs_vector p qs signs))))"
       using in_set solve_construct by simp
     let ?lhs_vec = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"
     have h30: "(construct_lhs_vector p qs signs) = ?lhs_vec"
       using assms construct_lhs_matches_solve_for_lhs
       by simp 
     have h3a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (signs)" 
       using h30 size_of_lhs unfolding find_nonzeros_from_input_vec_def apply (auto)
       by (metis atLeastLessThan_iff filter_is_subset member_def set_upt subset_eq) 
     have h3c: "\<forall>x. List.member (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))) x \<longrightarrow> x < length (subsets)"
     proof clarsimp
       fix x
       assume x_mem: "List.member (rows_to_keep
             (take_cols_from_matrix (matrix_A signs subsets)
               (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) x"
       obtain nn :: "rat list list \<Rightarrow> nat list \<Rightarrow> nat" where
         "\<forall>x2 x3. (\<exists>v4. v4 \<in> set x3 \<and> \<not> v4 < length x2) = (nn x2 x3 \<in> set x3 \<and> \<not> nn x2 x3 < length x2)"
         by moura
       then have f4: "nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> \<not> nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) < length signs \<or> matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
         using h3a nonzero reduce_system_matrix_signs_helper by auto
       then have "matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T)))"
         by (metis h3a in_set_member rows_to_keep_def x_mem)
-      thus "x < length (subsets)" using x_mem unfolding rows_to_keep_def using pivot_positions
-        using  dim_row_matrix_A h3a in_set_member nonzero reduce_system_matrix_signs_helper rows_to_keep_def rows_to_keep_lem
-        apply (auto)
-        by (smt (z3) \<open>M_mat (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (M_mat signs subsets)))) subsets = take_cols_from_matrix (M_mat signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (M_mat signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (M_mat signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (M_mat signs subsets))))\<^sup>T)))\<close> dim_row_matrix_A rows_to_keep_def rows_to_keep_lem)
+      thus "x < length (subsets)" using x_mem unfolding rows_to_keep_def  
+        using dim_row_matrix_A h3a nonzero reduce_system_matrix_signs_helper rows_to_keep_def rows_to_keep_lem
+        by metis
     qed
     then show "y < length subsets" using in_set_member apply (auto)
       using in_set_2 solve_construct by fastforce  
   qed
   show "list_constr x (length qs)" using in_red_subsets  unfolding  reduction_subsets_def 
     using take_indices_lem[of _ subsets]  rows_to_keep_hyp
     by (metis all_list_constr_def in_set_conv_nth in_set_member length_init) 
 qed
 
 section "Overall Lemmas"
 
 lemma combining_to_smash:  "combine_systems p (qs1, m1, (sub1, sgn1)) (qs2, m2, (sub2, sgn2))
  =  smash_systems p qs1 qs2 sub1 sub2 sgn1 sgn2 m1 m2"
   by simp
 
 lemma getter_functions: "calculate_data p qs = (get_matrix (calculate_data p qs), (get_subsets (calculate_data p qs), get_signs (calculate_data p qs))) "
   unfolding get_matrix_def get_subsets_def get_signs_def by auto
 
 subsection "Key properties preserved"
 
 subsubsection "Properties preserved when combining and reducing systems"
 lemma combining_sys_satisfies_properties_helper:
   fixes p:: "real poly"
   fixes qs1 :: "real poly list"
   fixes qs2 :: "real poly list"
   fixes subsets1 subsets2 :: "nat list list"
   fixes signs1 signs2 :: "rat list list" 
   fixes matrix1 matrix2:: "rat mat"
   assumes nonzero: "p \<noteq> 0"
   assumes nontriv1: "length qs1 > 0"
   assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
   assumes nontriv2: "length qs2 > 0"
   assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
   assumes satisfies_properties_sys1: "satisfies_properties p qs1 subsets1 signs1 matrix1"
   assumes satisfies_properties_sys2: "satisfies_properties p qs2 subsets2 signs2 matrix2"
   shows  "satisfies_properties p (qs1@qs2) (get_subsets (snd ((combine_systems p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2))))))) 
   (get_signs (snd ((combine_systems p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2))))))) 
   (get_matrix (snd ((combine_systems p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))"
 proof -     
   let ?subsets = "(get_subsets (snd (combine_systems p (qs1, matrix1, subsets1, signs1)
               (qs2, matrix2, subsets2, signs2))))"
   let ?signs = "(get_signs (snd (combine_systems p (qs1, matrix1, subsets1, signs1) (qs2, matrix2, subsets2, signs2))))"
   let ?matrix = "(get_matrix (snd (combine_systems p (qs1, matrix1, subsets1, signs1) (qs2, matrix2, subsets2, signs2))))"
   have h1: "all_list_constr ?subsets (length (qs1 @ qs2))"
     using well_def_step[of subsets1 qs1 subsets2 qs2] assms
     by (simp add: nontriv2 get_subsets_def satisfies_properties_def smash_systems_def) 
   have h2: "well_def_signs (length (qs1 @ qs2)) ?signs"
     using well_def_signs_step[of qs1 qs2 signs1 signs2]
     using get_signs_def nontriv1 nontriv2 satisfies_properties_def satisfies_properties_sys1 satisfies_properties_sys2 smash_systems_def by auto 
   have h3: "distinct ?signs" 
     using distinct_step[of _ signs1 _ signs2] assms
     using combine_systems.simps get_signs_def satisfies_properties_def smash_systems_def snd_conv by auto
   have h4: "satisfy_equation p (qs1 @ qs2) ?subsets ?signs" 
     using assms inductive_step[of p qs1 qs2 signs1 signs2 subsets1 subsets2]
     using get_signs_def get_subsets_def satisfies_properties_def smash_systems_def
     by auto  
   have h5: " invertible_mat ?matrix"
     using assms inductive_step[of p qs1 qs2 signs1 signs2 subsets1 subsets2]
     by (metis combining_to_smash fst_conv get_matrix_def kronecker_invertible satisfies_properties_def smash_systems_def snd_conv)
   have h6: "?matrix = matrix_A ?signs ?subsets" 
     unfolding get_matrix_def combine_systems.simps smash_systems_def get_signs_def get_subsets_def
     apply simp
     apply (subst matrix_construction_is_kronecker_product[of subsets1 _ signs1 signs2 subsets2])
     apply (metis Ball_set all_list_constr_def in_set_member list_constr_def satisfies_properties_def satisfies_properties_sys1)
     using satisfies_properties_def satisfies_properties_sys1 well_def_signs_def apply blast
     using satisfies_properties_def satisfies_properties_sys1 satisfies_properties_sys2 by auto
   have h7: "set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2))
     \<subseteq> set (?signs)"
     using subset_step[of p qs1 signs1 qs2  signs2] assms
     by (simp add: nonzero get_signs_def satisfies_properties_def smash_systems_def) 
   then show ?thesis unfolding satisfies_properties_def using h1 h2 h3 h4 h5 h6 h7 by blast
 qed
 
 lemma combining_sys_satisfies_properties:
   fixes p:: "real poly"
   fixes qs1 :: "real poly list"
   fixes qs2 :: "real poly list"
   assumes nonzero: "p \<noteq> 0"
   assumes nontriv1: "length qs1 > 0"
   assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
   assumes nontriv2: "length qs2 > 0"
   assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
   assumes satisfies_properties_sys1: "satisfies_properties p qs1 (get_subsets (calculate_data p qs1)) (get_signs (calculate_data p qs1)) (get_matrix (calculate_data p qs1))"
   assumes satisfies_properties_sys2: "satisfies_properties p qs2 (get_subsets (calculate_data p qs2)) (get_signs (calculate_data p qs2)) (get_matrix (calculate_data p qs2))"
   shows  "satisfies_properties p (qs1@qs2) (get_subsets (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) 
   (get_signs (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) 
   (get_matrix (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
   using combining_sys_satisfies_properties_helper
   by (metis getter_functions nontriv1 nontriv2 nonzero pairwise_rel_prime1 pairwise_rel_prime2 nonzero satisfies_properties_sys1 satisfies_properties_sys2) 
 
 lemma reducing_sys_satisfies_properties:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   fixes matrix:: "rat mat"
   assumes nonzero: "p \<noteq> 0"
   assumes nontriv: "length qs > 0"
   assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
   assumes satisfies_properties_sys: "satisfies_properties p qs subsets signs matrix"
   shows  "satisfies_properties p qs (get_subsets (reduce_system p (qs,matrix,subsets,signs)))
   (get_signs (reduce_system p (qs,matrix,subsets,signs)))
   (get_matrix (reduce_system p (qs,matrix,subsets,signs)))"
 proof -
   have h1: " all_list_constr (get_subsets (reduce_system p (qs, matrix, subsets, signs))) (length qs)"
     using reduction_doesnt_break_subsets assms reduction_subsets_is_get_subsets satisfies_properties_def satisfies_properties_sys by auto
   have h2: "well_def_signs (length qs) (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
     using reduction_doesnt_break_length_signs[of signs qs p subsets] assms reduction_signs_is_get_signs satisfies_properties_def well_def_signs_def by auto
   have h3: "distinct (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
     using reduction_signs_are_distinct[of p qs subsets signs] assms reduction_signs_is_get_signs satisfies_properties_def by auto 
   have h4: "satisfy_equation p qs (get_subsets (reduce_system p (qs, matrix, subsets, signs)))
      (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
     using reduce_system_matrix_equation_preserved[of p qs signs subsets] assms satisfies_properties_def by auto
   have h5: "invertible_mat (get_matrix (reduce_system p (qs, matrix, subsets, signs)))"
     using reduction_doesnt_break_things_invertibility assms same_size satisfies_properties_def by auto 
   have h6: "get_matrix (reduce_system p (qs, matrix, subsets, signs)) =
     matrix_A (get_signs (reduce_system p (qs, matrix, subsets, signs)))
      (get_subsets (reduce_system p (qs, matrix, subsets, signs)))"
     using reduce_system_matrix_match[of p qs signs subsets] assms satisfies_properties_def by auto
   have h7: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
     using reduction_doesnt_break_things_signs[of p qs signs subsets] assms reduction_signs_is_get_signs satisfies_properties_def by auto
   then show ?thesis unfolding satisfies_properties_def using h1 h2 h3 h4 h5 h6 h7
     by blast
 qed
 
 subsubsection "For length 1 qs"
 
 lemma  length_1_calculate_data_satisfies_properties:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes len1: "length qs = 1"
   assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
   shows "satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
 proof - 
   have h1: "all_list_constr [[],[0]] (length qs)"
     using len1 unfolding all_list_constr_def list_constr_def apply (auto)
     by (metis (full_types) length_Cons less_Suc0 list.size(3) list_all_length list_all_simps(2) member_rec(1) member_rec(2) nth_Cons_0) 
   have h2: "well_def_signs (length qs) [[1],[-1]]"
     unfolding well_def_signs_def using len1 in_set_member 
     by auto
   have h3: "distinct ([[1],[-1]]::rat list list)" 
     unfolding distinct_def using in_set_member by auto
   have h4: "satisfy_equation p qs [[],[0]] [[1],[-1]]"
     using assms base_case_satisfy_equation_alt[of qs p] by auto
   have h6: "(mat_of_rows_list 2 [[1,1], [1,-1]]::rat mat) = (matrix_A ([[1],[-1]]) ([[],[0]]) :: rat mat)" 
     using mat_base_case by auto
   then have h5: "invertible_mat (mat_of_rows_list 2 [[1,1], [1,-1]]:: rat mat)" 
     using base_case_invertible_mat
     by simp
   have h7:  "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set ([[1],[-1]])"
     using assms base_case_sgas_alt[of qs p]
     by simp  
   have base_case_hyp: "satisfies_properties p qs [[],[0]] [[1],[-1]] (mat_of_rows_list 2 [[1,1], [1,-1]])"
     using h1 h2 h3 h4 h5 h6 h7
     using satisfies_properties_def by blast 
   then have key_hyp: "satisfies_properties p qs (get_subsets (reduce_system p (qs,base_case_info))) (get_signs (reduce_system p (qs,base_case_info))) (get_matrix (reduce_system p (qs,base_case_info)))"
     using reducing_sys_satisfies_properties
     by (metis base_case_info_def len1 nonzero pairwise_rel_prime nonzero zero_less_one_class.zero_less_one) 
   show ?thesis
     by (simp add: key_hyp len1) 
 qed
 
 subsubsection "For arbitrary qs"
 lemma append_not_distinct_helper: "(List.member l1 m \<and> List.member l2 m) \<longrightarrow> (distinct (l1@l2) = False)"
 proof - 
   have h1: "List.member l1 m \<longrightarrow> (\<exists> n. n < length l1 \<and> (nth l1 n) = m)"
     using member_def nth_find_first
     by (simp add: member_def in_set_conv_nth) 
   have h2: "\<forall>n. n < length l1 \<and> (nth l1 n) = m \<longrightarrow> (nth (l1@l2) n) = m"
   proof clarsimp 
     fix n
     assume lt: "n < length l1"
     assume nth_l1: "m = l1 ! n"
     show "(l1 @ l2) ! n = l1 ! n" 
     proof (induct l2)
       case Nil
       then show ?case
         by simp 
     next
       case (Cons a l2)
       then show ?case
         by (simp add: lt nth_append)
     qed
   qed
   have h3: "List.member l1 m \<longrightarrow> (\<exists>n.  n < length l1 \<and> (nth (l1@l2) n) = m)" 
     using h1 h2 by auto
   have h4: "List.member l2 m \<longrightarrow> (\<exists> n. (nth l2 n) = m)"
     by (meson member_def nth_find_first) 
   have h5: "\<forall>n. (nth l2 n) = m \<longrightarrow> (nth (l1@l2) (n + length l1)) = m"
   proof clarsimp 
     fix n
     assume nth_l2: "m = l2 ! n"
     show "(l1 @ l2) ! (n + length l1) = l2 ! n" 
     proof (induct l2)
       case Nil
       then show ?case
         by (metis add.commute nth_append_length_plus) 
     next
       case (Cons a l2)
       then show ?case
         by (simp add: nth_append) 
     qed
   qed
   have h6: "List.member l2 m \<longrightarrow> (\<exists>n. (nth (l1@l2) (n + length l1)) = m)" 
     using h4 h5
     by blast 
   show ?thesis using h3 h6
     by (metis distinct_append equalityI insert_disjoint(1) insert_subset member_def order_refl) 
 qed
 
 lemma  calculate_data_satisfies_properties:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   shows "(p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) )
     \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
 proof (induction "length qs" arbitrary: qs rule: less_induct)
   case less
   have len1_h: "length qs = 1 \<longrightarrow> ( p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
     using  length_1_calculate_data_satisfies_properties
     by blast
   let ?len = "length qs"
   let ?q1 = "take (?len div 2) qs"
   let ?left = "calculate_data p ?q1"
   let ?q2 = "drop (?len div 2) qs"
   let ?right = "calculate_data p ?q2"
   let ?comb = "combine_systems p (?q1,?left) (?q2,?right)"
   let ?red =  "reduce_system p ?comb"
   have h_q1_len: "length qs > 1 \<longrightarrow> (length ?q1 > 0)" by auto 
   have h_q2_len: "length qs > 1 \<longrightarrow> (length ?q2 > 0)" by auto
   have h_q1_copr: "(\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) \<longrightarrow> (\<forall>q. ((List.member ?q1 q) \<longrightarrow> (coprime p q)))"
   proof -
     have mem_hyp: "(\<forall>q. ((List.member ?q1 q) \<longrightarrow> (List.member qs q)))"
       by (meson in_set_member in_set_takeD)
     then show ?thesis
       by blast 
   qed
   have h_q2_copr: "(\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) \<longrightarrow> (\<forall>q. ((List.member ?q2 q) \<longrightarrow> (coprime p q)))"
   proof -
     have mem_hyp: "(\<forall>q. ((List.member ?q2 q) \<longrightarrow> (List.member qs q)))"
       by (meson in_set_dropD in_set_member)
     then show ?thesis
       by blast 
   qed
   have q1_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p ?q1 (get_subsets (calculate_data p ?q1)) (get_signs (calculate_data p ?q1)) (get_matrix (calculate_data p ?q1))"
     using less.hyps[of ?q1] h_q1_len h_q1_copr
     by (auto simp add: Let_def)
   have q2_help: "length qs > 1 \<longrightarrow> length (drop (length qs div 2) qs) < length qs"
     using h_q1_len by auto  
   then have q2_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p ?q2 (get_subsets (calculate_data p ?q2)) (get_signs (calculate_data p ?q2)) (get_matrix (calculate_data p ?q2))"
     using less.hyps[of ?q2] h_q2_len h_q2_copr
     by blast
   have put_tog: "?q1@?q2 = qs"
     using append_take_drop_id by blast 
   then have comb_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> (satisfies_properties p (qs) (get_subsets (snd ((combine_systems p (?q1,calculate_data p ?q1) (?q2,calculate_data p ?q2))))) 
   (get_signs (snd ((combine_systems p (?q1,calculate_data p ?q1) (?q2,calculate_data p ?q2))))) 
   (get_matrix (snd ((combine_systems p (?q1,calculate_data p ?q1) (?q2,calculate_data p ?q2))))))"
     using q1_sat_props q2_sat_props  combining_sys_satisfies_properties
     using h_q1_copr h_q1_len h_q2_copr h_q2_len  put_tog
     by metis
   then have comb_sat: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> 
       (satisfies_properties p (qs) (get_subsets (snd ?comb)) (get_signs (snd ?comb)) (get_matrix (snd ?comb)))"
     by blast
   have red_char: "?red = (reduce_system p (qs,(get_matrix (snd ?comb)),(get_subsets (snd ?comb)),(get_signs (snd ?comb))))"
     using getter_functions
-      by (smt Pair_inject combining_to_smash get_matrix_def get_signs_def get_subsets_def prod.collapse put_tog smash_systems_def)
+      by (smt (verit, best) Pair_inject combining_to_smash get_matrix_def get_signs_def get_subsets_def prod.collapse put_tog smash_systems_def)
   then have "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) )  \<longrightarrow> (satisfies_properties p qs (get_subsets ?red) (get_signs ?red) (get_matrix ?red))"
     using reducing_sys_satisfies_properties comb_sat  by presburger 
-  have len_gt1: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
-    by (smt \<open>1 < length qs \<longrightarrow>  p \<noteq> 0 \<and> 0 < length qs \<and> (\<forall>q. List.member qs q \<longrightarrow> coprime p q) \<longrightarrow> satisfies_properties p qs (get_subsets (reduce_system p (combine_systems p (take (length qs div 2) qs, calculate_data p (take (length qs div 2) qs)) (drop (length qs div 2) qs, calculate_data p (drop (length qs div 2) qs))))) (get_signs (reduce_system p (combine_systems p (take (length qs div 2) qs, calculate_data p (take (length qs div 2) qs)) (drop (length qs div 2) qs, calculate_data p (drop (length qs div 2) qs))))) (get_matrix (reduce_system p (combine_systems p (take (length qs div 2) qs, calculate_data p (take (length qs div 2) qs)) (drop (length qs div 2) qs, calculate_data p (drop (length qs div 2) qs)))))\<close> calculate_data.simps neq0_conv not_less)
+  then have len_gt1: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
+    by (smt (verit, best) calculate_data.simps leD nat_less_le)
   then show ?case using len1_h len_gt1
     by (metis One_nat_def Suc_lessI) 
 qed
 
 
 subsection "Some key results on consistent sign assignments"
 
 lemma find_consistent_signs_at_roots_len1:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes len1: "length qs = 1"
   assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
   shows "set (find_consistent_signs_at_roots p qs) = set (characterize_consistent_signs_at_roots_copr p qs)"
 proof - 
   let ?signs = "[[1],[-1]]::rat list list"
   let ?subsets = "[[],[0]]::nat list list"
   have mat_help: "matrix_A [[1],[-1]] [[],[0]] = (mat_of_rows_list 2 [[1,1], [1,-1]])"
     using mat_base_case by auto
   have well_def_signs: "well_def_signs (length qs) ?signs" unfolding well_def_signs_def 
     using len1 by auto
   have distinct_signs: "distinct ?signs"
     unfolding distinct_def by auto
   have ex_q: "\<exists>(q::real poly). qs = [q]" 
     using len1    
     using length_Suc_conv[of qs 0] by auto
   then have all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(?signs)"
     using assms base_case_sgas apply (auto)
     by (meson in_mono insertE insert_absorb insert_not_empty member_rec(1)) 
   have match: "satisfy_equation p qs ?subsets ?signs"
     using ex_q base_case_satisfy_equation nonzero pairwise_rel_prime
     apply (auto)
     by (simp add: member_rec(1)) 
   have invertible_mat: "invertible_mat (matrix_A ?signs ?subsets)"
     using inverse_mat_base_case inverse_mat_base_case_2 unfolding invertible_mat_def using mat_base_case 
     by auto
   have h: "set (get_signs (reduce_system p (qs, ((matrix_A ?signs ?subsets), (?subsets, ?signs))))) = 
     set (characterize_consistent_signs_at_roots_copr p qs)" 
     using nonzero nonzero well_def_signs distinct_signs all_info match invertible_mat
       reduce_system_sign_conditions[where p = "p", where qs = "qs", where signs = "[[1],[-1]]", where subsets = "[[],[0]]"]
     by blast 
   then have  "set (snd (snd (reduce_system p (qs, ((mat_of_rows_list 2 [[1,1], [1,-1]]), ([[],[0]], [[1],[-1]])))))) = 
     set (characterize_consistent_signs_at_roots_copr p qs)"
     unfolding get_signs_def using mat_help by auto
   then have "set (snd (snd (reduce_system p (qs, base_case_info)))) = set (characterize_consistent_signs_at_roots_copr p qs)"
     unfolding base_case_info_def
     by auto
   then show ?thesis using len1
     by (simp add: find_consistent_signs_at_roots_thm)
 qed
 
 
 lemma smaller_sys_are_good:
   fixes p:: "real poly"
   fixes qs1 :: "real poly list"
   fixes qs2 :: "real poly list"
   fixes subsets :: "nat list list"
   fixes signs :: "rat list list" 
   assumes nonzero: "p \<noteq> 0"
   assumes nontriv1: "length qs1 > 0"
   assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
   assumes nontriv2: "length qs2 > 0"
   assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
   assumes "set(find_consistent_signs_at_roots p qs1) = set(characterize_consistent_signs_at_roots_copr p qs1)"
   assumes "set(find_consistent_signs_at_roots p qs2) = set(characterize_consistent_signs_at_roots_copr p qs2)"
   shows "set(snd(snd(reduce_system p (combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))
     = set(characterize_consistent_signs_at_roots_copr p (qs1@qs2))"
 proof - 
   let ?signs = "(get_signs (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) "
   let ?subsets = "(get_subsets (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) "
   have h0: "satisfies_properties p (qs1@qs2) ?subsets ?signs
     (get_matrix (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
     using calculate_data_satisfies_properties combining_sys_satisfies_properties
     using nontriv1 nontriv2 nonzero pairwise_rel_prime1 pairwise_rel_prime2 nonzero
     by simp
   then have h1: "set(characterize_consistent_signs_at_roots_copr p (qs1@qs2)) \<subseteq> set ?signs"
     unfolding satisfies_properties_def
     by linarith 
   have h2: "well_def_signs (length (qs1@qs2)) ?signs"
     using calculate_data_satisfies_properties
     using h0 satisfies_properties_def by blast 
   have h3: "distinct ?signs" 
     using calculate_data_satisfies_properties
     using h0 satisfies_properties_def by blast 
   have h4: "satisfy_equation p (qs1@qs2) ?subsets ?signs"
     using calculate_data_satisfies_properties
     using h0 satisfies_properties_def by blast 
   have h5: "invertible_mat (matrix_A ?signs ?subsets) "
     using calculate_data_satisfies_properties  
     using h0 satisfies_properties_def
     by auto
   have h: "set (take_indices ?signs 
             (find_nonzeros_from_input_vec (solve_for_lhs p (qs1@qs2) ?subsets  (matrix_A ?signs ?subsets))))
         =  set(characterize_consistent_signs_at_roots_copr p (qs1@qs2))" 
     using h1 h2 h3 h4 h5 reduction_deletes_bad_sign_conds
     using nonzero nonzero reduction_signs_def by auto
   then have h: "set (characterize_consistent_signs_at_roots_copr p (qs1@qs2)) =
     set (reduction_signs p (qs1@qs2) ?signs ?subsets  (matrix_A ?signs ?subsets ))" 
     unfolding reduction_signs_def get_signs_def
     by blast  
   have help_h: "reduction_signs p (qs1@qs2) ?signs ?subsets  (matrix_A ?signs ?subsets) 
       = (take_indices ?signs (find_nonzeros_from_input_vec (solve_for_lhs p (qs1@qs2) ?subsets  (matrix_A ?signs ?subsets))))"
     unfolding reduction_signs_def by auto
   have clear_signs: "(signs_smash (get_signs (calculate_data p qs1)) (get_signs (calculate_data p qs2))) = (get_signs (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
-    by (smt combining_to_smash get_signs_def getter_functions smash_systems_def snd_conv)
+    by (smt (verit) combining_to_smash get_signs_def getter_functions smash_systems_def snd_conv)
   have clear_subsets: "(subsets_smash (length qs1) (get_subsets(calculate_data p qs1)) (get_subsets (calculate_data p qs2))) = (get_subsets (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
-    by (smt Pair_inject combining_to_smash get_subsets_def prod.collapse smash_systems_def)
+    by (smt (verit, best) Pair_inject combining_to_smash get_subsets_def prod.collapse smash_systems_def)
   have "well_def_signs (length qs1) (get_signs (calculate_data p qs1))" 
     using calculate_data_satisfies_properties
     using nontriv1 nonzero pairwise_rel_prime1 nonzero satisfies_properties_def
     by auto 
   then have well_def_signs1: "(\<And>j. j \<in> set (get_signs (calculate_data p qs1)) \<Longrightarrow> length j = (length qs1))"
     using well_def_signs_def by blast 
   have "all_list_constr (get_subsets(calculate_data p qs1))  (length qs1) "
     using calculate_data_satisfies_properties
     using nontriv1 nonzero pairwise_rel_prime1 nonzero satisfies_properties_def
     by auto 
   then have well_def_subsets1: "(\<And>l i. l \<in> set (get_subsets(calculate_data p qs1)) \<Longrightarrow> i \<in> set l \<Longrightarrow> i < (length qs1))"
     unfolding all_list_constr_def list_constr_def using in_set_member
     by (metis in_set_conv_nth list_all_length) 
   have extra_matrix_same: "matrix_A (signs_smash (get_signs (calculate_data p qs1)) (get_signs (calculate_data p qs2)))
          (subsets_smash (length qs1) (get_subsets(calculate_data p qs1)) (get_subsets (calculate_data p qs2))) 
         = kronecker_product (get_matrix (calculate_data p qs1)) (get_matrix (calculate_data p qs2))"
     using  well_def_signs1 well_def_subsets1
     using matrix_construction_is_kronecker_product
     using calculate_data_satisfies_properties nontriv1 nontriv2 nonzero pairwise_rel_prime1 pairwise_rel_prime2 nonzero satisfies_properties_def by auto 
   then have matrix_same: "matrix_A ?signs ?subsets = kronecker_product (get_matrix (calculate_data p qs1)) (get_matrix (calculate_data p qs2))"
     using clear_signs clear_subsets
     by simp
   have comb_sys_h: "snd(snd(reduce_system p (combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))) =
       snd(snd(reduce_system p (qs1@qs2, (matrix_A ?signs ?subsets, (?subsets, ?signs)))))"
     unfolding get_signs_def get_subsets_def using matrix_same
     by (smt combining_to_smash get_signs_def get_subsets_def getter_functions prod.collapse prod.inject smash_systems_def)   
   then have extra_h: " snd(snd(reduce_system p (qs1@qs2, (matrix_A ?signs ?subsets, (?subsets, ?signs))))) = 
       snd(snd(reduction_step (matrix_A ?signs ?subsets) ?signs ?subsets (solve_for_lhs p (qs1@qs2) ?subsets (matrix_A ?signs ?subsets)))) "
     by simp
   then have same_h: "set(snd(snd(reduce_system p (combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) 
       = set (reduction_signs p (qs1@qs2) ?signs ?subsets  (matrix_A ?signs ?subsets ))"
     using comb_sys_h unfolding reduction_signs_def
     by (metis get_signs_def help_h reduction_signs_is_get_signs) 
   then show ?thesis using h
     by blast 
 qed
 
 lemma find_consistent_signs_at_roots_1:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   shows "(p \<noteq> 0 \<and> length qs > 0 \<and>
     (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q)))) \<longrightarrow> 
     set(find_consistent_signs_at_roots p qs) = set(characterize_consistent_signs_at_roots_copr p qs)"
 proof (induction "length qs" arbitrary: qs rule: less_induct)
   case less 
   then show ?case
   proof clarsimp
     assume ind_hyp: "(\<And>qsa.
         length qsa < length qs \<Longrightarrow> qsa \<noteq> [] \<and> (\<forall>q. List.member qsa q \<longrightarrow> coprime p q) \<longrightarrow>
         set (find_consistent_signs_at_roots p qsa) =
         set (characterize_consistent_signs_at_roots_copr p qsa))"
     assume nonzero: "p \<noteq> 0"  
     assume nontriv: "qs \<noteq> []"
     assume copr:" \<forall>q. List.member qs q \<longrightarrow> coprime p q"
     let ?len = "length qs"
     let ?q1 = "take ((?len) div 2) qs"
     let ?left = "calculate_data p ?q1"
     let ?q2 = "drop ((?len) div 2) qs"
     let ?right = "calculate_data p ?q2"
     have nontriv_q1: "length qs>1 \<longrightarrow> length ?q1 > 0" 
       by auto
     have qs_more_q1: "length qs>1 \<longrightarrow> length qs > length ?q1" 
       by auto
     have pairwise_rel_prime_q1: "\<forall>q. ((List.member ?q1 q) \<longrightarrow> (coprime p q))"
     proof clarsimp 
       fix q 
       assume mem: "List.member (take (length qs div 2) qs) q"
       have "List.member qs q" using mem set_take_subset[where n = "length qs div 2"]
       proof -
         show ?thesis
           by (meson \<open>List.member (take (length qs div 2) qs) q\<close> in_set_member in_set_takeD)
       qed  
       then show "coprime p q" 
         using copr by blast 
     qed
     have nontriv_q2: "length qs>1 \<longrightarrow>length ?q2 > 0" 
       by auto
     have qs_more_q2: "length qs>1 \<longrightarrow> length qs > length ?q2" 
       by auto
     have pairwise_rel_prime_q2: "\<forall>q. ((List.member ?q2 q) \<longrightarrow> (coprime p q))" 
     proof clarsimp 
       fix q 
       assume mem: "List.member (drop (length qs div 2) qs) q"
       have "List.member qs q" using mem set_take_subset[where n = "length qs div 2"]
       proof -
         show ?thesis
           by (meson \<open>List.member (drop (length qs div 2) qs) q\<close> in_set_dropD in_set_member)
       qed
       then show "coprime p q" 
         using copr by blast 
     qed
     have key_h: "set (snd (snd (if ?len \<le> Suc 0 then reduce_system p (qs, base_case_info)
                         else   Let (combine_systems p (?q1, ?left) (?q2, ?right))
                                   (reduce_system p)))) =
        set (characterize_consistent_signs_at_roots_copr p qs)" 
     proof - 
       have h_len1 : "?len = 1 \<longrightarrow> set (snd (snd (if ?len \<le> Suc 0 then reduce_system p (qs, base_case_info)
                         else   Let (combine_systems p (?q1, ?left) (?q2, ?right))
                                   (reduce_system p)))) =
        set (characterize_consistent_signs_at_roots_copr p qs)" 
         using find_consistent_signs_at_roots_len1[of p qs] copr nonzero nontriv
         by (simp add: find_consistent_signs_at_roots_thm)
       have h_len_gt1 : "?len > 1 \<longrightarrow> set (snd (snd (if ?len \<le> Suc 0 then reduce_system p (qs, base_case_info)
                         else   Let (combine_systems p (?q1, ?left) (?q2, ?right))
                                   (reduce_system p)))) =
        set (characterize_consistent_signs_at_roots_copr p qs)" 
       proof - 
         have h_imp_a: "?len > 1 \<longrightarrow> set (snd (snd (reduce_system p (combine_systems p (?q1, ?left) (?q2, ?right))))) =
               set (characterize_consistent_signs_at_roots_copr p qs)"
         proof - 
           have h1: "?len > 1 \<longrightarrow> set(snd(snd(?left))) = set (characterize_consistent_signs_at_roots_copr p ?q1)"
             using nontriv_q1 pairwise_rel_prime_q1 ind_hyp[of ?q1] qs_more_q1             by (metis find_consistent_signs_at_roots_thm less_numeral_extra(3) list.size(3))
           have h2: "?len > 1 \<longrightarrow> set(snd(snd(?right))) = set (characterize_consistent_signs_at_roots_copr p ?q2)"
             using nontriv_q2 pairwise_rel_prime_q2 ind_hyp[of ?q2] qs_more_q2
             by (metis (full_types) find_consistent_signs_at_roots_thm list.size(3) not_less_zero)
           show ?thesis using nonzero nontriv_q1 pairwise_rel_prime_q1 nontriv_q2 pairwise_rel_prime_q2 h1 h2
               smaller_sys_are_good
             by (metis append_take_drop_id find_consistent_signs_at_roots_thm)
         qed
         then have h_imp: "?len > 1 \<longrightarrow> set (snd (snd (Let (combine_systems p (?q1, ?left) (?q2, ?right))
                                   (reduce_system p)))) =
        set (characterize_consistent_signs_at_roots_copr p qs)"
           by auto
         then show ?thesis by auto 
       qed
       show ?thesis using h_len1 h_len_gt1
         by (meson \<open>qs \<noteq> []\<close> length_0_conv less_one nat_neq_iff) 
     qed
     then show "set (find_consistent_signs_at_roots p qs) = set (characterize_consistent_signs_at_roots_copr p qs)"
       by (smt One_nat_def calculate_data.simps find_consistent_signs_at_roots_thm length_0_conv nontriv)
   qed
 qed
 
 lemma find_consistent_signs_at_roots_0:
   fixes p:: "real poly"
   assumes "p \<noteq> 0"
   shows "set(find_consistent_signs_at_roots p []) =
          set(characterize_consistent_signs_at_roots_copr p [])"
 proof -
   obtain a b c where abc: "reduce_system p ([1], base_case_info) = (a,b,c)"
     using prod_cases3 by blast 
   have "find_consistent_signs_at_roots p [1] = c" using abc
     by (simp add: find_consistent_signs_at_roots_thm) 
   have *: "set (find_consistent_signs_at_roots p [1]) = set (characterize_consistent_signs_at_roots_copr p [1])"
     apply (subst find_consistent_signs_at_roots_1)
     using assms apply auto
     by (simp add: member_rec(1) member_rec(2))
   have "set(characterize_consistent_signs_at_roots_copr p []) = drop 1 ` set(characterize_consistent_signs_at_roots_copr p [1])"
     unfolding characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def apply simp
     by (smt drop0 drop_Suc_Cons image_cong image_image)
   thus ?thesis using abc *
     apply (auto) apply (simp add: find_consistent_signs_at_roots_thm)
     by (simp add: find_consistent_signs_at_roots_thm) 
 qed
 
 lemma find_consistent_signs_at_roots_copr:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   assumes "p \<noteq> 0"
   assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
   shows "set(find_consistent_signs_at_roots p qs) = set(characterize_consistent_signs_at_roots_copr p qs)"
   by (metis assms find_consistent_signs_at_roots_0 find_consistent_signs_at_roots_1 in_set_member length_greater_0_conv)
 
 lemma find_consistent_signs_at_roots:
   fixes p:: "real poly"
   fixes qs :: "real poly list"
   assumes "p \<noteq> 0"
   assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
   shows "set(find_consistent_signs_at_roots p qs) = set(characterize_consistent_signs_at_roots p qs)"
-  using assms find_consistent_signs_at_roots_copr csa_list_copr_rel
-  by (simp add: in_set_member)
+  by (metis assms csa_list_copr_rel find_consistent_signs_at_roots_copr in_set_member)
 
 (* Prettifying theorem *)
 theorem find_consistent_signs_at_roots_alt:
-assumes "p \<noteq> 0"
-assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
-shows "set (find_consistent_signs_at_roots p qs) = consistent_signs_at_roots p qs"
-using consistent_signs_at_roots_eq assms(1) assms(2) find_consistent_signs_at_roots by auto
+  assumes "p \<noteq> 0"
+  assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
+  shows "set (find_consistent_signs_at_roots p qs) = consistent_signs_at_roots p qs"
+  using consistent_signs_at_roots_eq assms(1) assms(2) find_consistent_signs_at_roots by auto
 
 
 end
\ No newline at end of file
diff --git a/thys/BenOr_Kozen_Reif/More_Matrix.thy b/thys/BenOr_Kozen_Reif/More_Matrix.thy
--- a/thys/BenOr_Kozen_Reif/More_Matrix.thy
+++ b/thys/BenOr_Kozen_Reif/More_Matrix.thy
@@ -1,2013 +1,2007 @@
 theory More_Matrix
   imports "Jordan_Normal_Form.Matrix"
     "Jordan_Normal_Form.DL_Rank"
     "Jordan_Normal_Form.VS_Connect"
     "Jordan_Normal_Form.Gauss_Jordan_Elimination"
 begin
 
 section "Kronecker Product"
 
 definition kronecker_product :: "'a :: ring mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
   "kronecker_product A B =
   (let ra = dim_row A; ca = dim_col A;
        rb = dim_row B; cb = dim_col B
   in
     mat (ra*rb) (ca*cb)
     (\<lambda>(i,j).
       A $$ (i div rb, j div cb) *
       B $$ (i mod rb, j mod cb)
   ))"
 
 lemma arith:
   assumes "d < a"
   assumes "c < b"
   shows "b*d+c < a*(b::nat)"
 proof -
   have "b*d+c < b*(d+1)"
     by (simp add: assms(2))
   thus ?thesis
     by (metis One_nat_def Suc_leI add.right_neutral add_Suc_right assms(1) less_le_trans mult.commute mult_le_cancel2)
 qed
 
 lemma dim_kronecker[simp]:
   "dim_row (kronecker_product A B) = dim_row A * dim_row B"
   "dim_col (kronecker_product A B) = dim_col A * dim_col B"
   unfolding kronecker_product_def Let_def by auto
 
 lemma kronecker_inverse_index:
   assumes "r < dim_row A" "s < dim_col A"
   assumes "v < dim_row B" "w < dim_col B"
   shows "kronecker_product A B $$ (dim_row B*r+v, dim_col B*s+w) = A $$ (r,s) * B $$ (v,w)"
 proof -
   from arith[OF assms(1) assms(3)]
   have "dim_row B*r+v < dim_row A * dim_row B" .
   moreover from arith[OF assms(2) assms(4)]
   have "dim_col B * s + w < dim_col A * dim_col B" .
   ultimately show ?thesis
     unfolding kronecker_product_def Let_def
     using assms by auto
 qed
 
 lemma kronecker_distr_left:
   assumes "dim_row B = dim_row C" "dim_col B = dim_col C"
   shows "kronecker_product A (B+C) = kronecker_product A B + kronecker_product A C"
   unfolding kronecker_product_def Let_def
   using assms apply (auto simp add: mat_eq_iff) 
   by (metis (no_types, lifting) distrib_left index_add_mat(1) mod_less_divisor mult_eq_0_iff neq0_conv not_less_zero)
 
 lemma kronecker_distr_right:
   assumes "dim_row B = dim_row C" "dim_col B = dim_col C"
   shows "kronecker_product (B+C) A = kronecker_product B A + kronecker_product C A"
   unfolding kronecker_product_def Let_def
   using assms by (auto simp add: mat_eq_iff less_mult_imp_div_less distrib_right)
 
 lemma index_mat_mod[simp]: "nr > 0 & nc > 0 \<Longrightarrow> mat nr nc f $$ (i mod nr,j mod nc) = f (i mod nr,j mod nc)"
   by auto
 
 lemma kronecker_assoc:
   shows "kronecker_product A (kronecker_product B C) = kronecker_product (kronecker_product A B) C"
   unfolding kronecker_product_def Let_def
   apply (case_tac "dim_row B * dim_row C > 0 & dim_col B * dim_col C > 0")
    apply (auto simp add: mat_eq_iff less_mult_imp_div_less)
-  by (smt div_mult2_eq div_mult_mod_eq kronecker_inverse_index less_mult_imp_div_less linordered_semiring_strict_class.mult_pos_pos mod_less_divisor mod_mult2_eq mult.assoc mult.commute)
+  by (smt (verit, best) div_less_iff_less_mult div_mult2_eq kronecker_inverse_index linordered_semiring_strict_class.mult_pos_pos mod_less_divisor mod_mult2_eq mult.assoc mult.commute mult_div_mod_eq)
 
 lemma sum_sum_mod_div:
   "(\<Sum>ia = 0::nat..<x. \<Sum>ja = 0..<y. f ia ja) =
    (\<Sum>ia = 0..<x*y. f (ia div y) (ia mod y))"
 proof -
   have 1: "inj_on (\<lambda>ia. (ia div y, ia mod y)) {0..<x * y}"
     by (smt (verit, best) Pair_inject div_mod_decomp inj_onI)
   have 21: "{0..<x} \<times> {0..<y} \<subseteq> (\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y}"
   proof clarsimp
     fix a b
     assume *:"a < x" "b < y"
     have "a * y +  b \<in> {0..<x*y}"
       by (metis arith * atLeastLessThan_iff le0 mult.commute)
     thus "(a, b) \<in> (\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y}"
       using * by (auto simp add: image_iff)
         (metis \<open>a * y + b \<in> {0..<x * y}\<close> add.commute add.right_neutral div_less div_mult_self1 less_zeroE mod_eq_self_iff_div_eq_0 mod_mult_self1)
   qed
   have 22:"(\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y} \<subseteq> {0..<x} \<times> {0..<y}"
     using less_mult_imp_div_less apply auto
     by (metis mod_less_divisor mult.commute neq0_conv not_less_zero)
   have 2: "{0..<x} \<times> {0..<y} = (\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y}"
     using 21 22 by auto
   have *: "(\<Sum>ia = 0::nat..<x. \<Sum>ja = 0..<y. f ia ja) =
         (\<Sum>(x, y)\<in>{0..<x} \<times> {0..<y}. f x y)"
     by (auto simp add: sum.cartesian_product)
   show ?thesis unfolding *
     apply (intro sum.reindex_cong[of "\<lambda>ia. (ia div y, ia mod y)"])
     using 1 2 by auto
 qed
 
 (* Kronecker product distributes over matrix multiplication *)
 lemma kronecker_of_mult:
   assumes "dim_col (A :: 'a :: comm_ring mat) = dim_row C"
   assumes "dim_col B = dim_row D"
   shows "kronecker_product A B * kronecker_product C D = kronecker_product (A * C) (B * D)"
   unfolding kronecker_product_def Let_def mat_eq_iff
 proof clarsimp
   fix i j
   assume ij: "i < dim_row A * dim_row B" "j < dim_col C * dim_col D"
   have 1: "(A * C) $$ (i div dim_row B, j div dim_col D) =
     row A (i div dim_row B) \<bullet> col C (j div dim_col D)"
     using ij less_mult_imp_div_less by (auto intro!: index_mult_mat)
   have 2: "(B * D) $$ (i mod dim_row B, j mod dim_col D) =
     row B (i mod dim_row B) \<bullet> col D (j mod dim_col D)"
     using ij apply (auto intro!: index_mult_mat)
     using gr_implies_not0 apply fastforce
     using gr_implies_not0 by fastforce
   have 3: "\<And>x. x < dim_row C * dim_row D \<Longrightarrow>
          A $$ (i div dim_row B, x div dim_row D) *
          B $$ (i mod dim_row B, x mod dim_row D) *
          (C $$ (x div dim_row D, j div dim_col D) *
           D $$ (x mod dim_row D, j mod dim_col D)) =
          row A (i div dim_row B) $ (x div dim_row D) *
          col C (j div dim_col D) $ (x div dim_row D) *
          (row B (i mod dim_row B) $ (x mod dim_row D) *
           col D (j mod dim_col D) $ (x mod dim_row D))"
   proof -
     fix x
     assume *:"x < dim_row C * dim_row D"
     have 1: "row A (i div dim_row B) $ (x div dim_row D) = A $$ (i div dim_row B, x div dim_row D)"
       by (simp add: * assms(1) less_mult_imp_div_less row_def)
     have 2: "row B (i mod dim_row B) $ (x mod dim_row D) = B $$ (i mod dim_row B, x mod dim_row D)"
       by (metis "*" assms(2) ij(1) index_row(1) mod_less_divisor nat_0_less_mult_iff neq0_conv not_less_zero)
     have 3: "col C (j div dim_col D) $ (x div dim_row D) = C $$ (x div dim_row D, j div dim_col D)"
       by (simp add: "*" ij(2) less_mult_imp_div_less)
     have 4: "col D (j mod dim_col D) $ (x mod dim_row D) = D $$ (x mod dim_row D, j mod dim_col D)"
       by (metis "*" bot_nat_0.not_eq_extremum ij(2) index_col mod_less_divisor mult_zero_right not_less_zero)
     show "A $$ (i div dim_row B, x div dim_row D) *
          B $$ (i mod dim_row B, x mod dim_row D) *
          (C $$ (x div dim_row D, j div dim_col D) *
           D $$ (x mod dim_row D, j mod dim_col D)) =
          row A (i div dim_row B) $ (x div dim_row D) *
          col C (j div dim_col D) $ (x div dim_row D) *
          (row B (i mod dim_row B) $ (x mod dim_row D) *
           col D (j mod dim_col D) $ (x mod dim_row D))" unfolding 1 2 3 4
       by (simp add: mult.assoc mult.left_commute)
   qed
   have *: "(A * C) $$ (i div dim_row B, j div dim_col D) *
         (B * D) $$ (i mod dim_row B, j mod dim_col D) =
     (\<Sum>ia = 0..<dim_row C * dim_row D.
                A $$ (i div dim_row B, ia div dim_row D) *
                B $$ (i mod dim_row B, ia mod dim_row D) *
                (C $$ (ia div dim_row D, j div dim_col D) *
                 D $$ (ia mod dim_row D, j mod dim_col D)))"
     unfolding 1 2 scalar_prod_def sum_product sum_sum_mod_div
     apply (auto simp add: sum_product sum_sum_mod_div intro!: sum.cong)
     using 3 by presburger
   show "vec (dim_col A * dim_col B)
           (\<lambda>j. A $$ (i div dim_row B, j div dim_col B) *
                B $$ (i mod dim_row B, j mod dim_col B)) \<bullet>
        vec (dim_row C * dim_row D)
           (\<lambda>i. C $$ (i div dim_row D, j div dim_col D) *
                D $$ (i mod dim_row D, j mod dim_col D)) =
         (A * C) $$ (i div dim_row B, j div dim_col D) *
         (B * D) $$ (i mod dim_row B, j mod dim_col D)"
     unfolding * scalar_prod_def
     by (auto simp add: assms sum_product sum_sum_mod_div intro!: sum.cong)
 qed
 
 lemma inverts_mat_length:
   assumes "square_mat A" "inverts_mat A B" "inverts_mat B A"
   shows "dim_row B = dim_row A" "dim_col B = dim_col A"
    apply (metis assms(1) assms(3) index_mult_mat(3) index_one_mat(3) inverts_mat_def square_mat.simps)
   by (metis assms(1) assms(2) index_mult_mat(3) index_one_mat(3) inverts_mat_def square_mat.simps)
 
 lemma less_mult_imp_mod_less:
   "m mod i < i" if "m < n * i" for m n i :: nat
   using gr_implies_not_zero that by fastforce
 
 lemma kronecker_one:
   shows "kronecker_product ((1\<^sub>m x)::'a :: ring_1 mat) (1\<^sub>m y) = 1\<^sub>m (x*y)"
   unfolding kronecker_product_def Let_def
   apply  (auto simp add:mat_eq_iff less_mult_imp_div_less less_mult_imp_mod_less)
   by (metis div_mult_mod_eq)
 
 lemma kronecker_invertible:
   assumes "invertible_mat (A :: 'a :: comm_ring_1 mat)" "invertible_mat B"
   shows "invertible_mat (kronecker_product A B)"
 proof -
   obtain Ai where Ai: "inverts_mat A Ai" "inverts_mat Ai A" using assms invertible_mat_def by blast
   obtain Bi where Bi: "inverts_mat B Bi" "inverts_mat Bi B" using assms invertible_mat_def by blast
   have "square_mat (kronecker_product A B)"
     by (metis (no_types, lifting) assms(1) assms(2) dim_col_mat(1) dim_row_mat(1) invertible_mat_def kronecker_product_def square_mat.simps)
   moreover have "inverts_mat (kronecker_product A B) (kronecker_product Ai Bi)"
     using Ai Bi unfolding inverts_mat_def
     by (metis (no_types, lifting) dim_kronecker(1) index_mult_mat(3) index_one_mat(3) kronecker_of_mult kronecker_one)
   moreover have "inverts_mat (kronecker_product Ai Bi) (kronecker_product A B)"
     using Ai Bi unfolding inverts_mat_def
     by (metis (no_types, lifting) dim_kronecker(1) index_mult_mat(3) index_one_mat(3) kronecker_of_mult kronecker_one)
   ultimately show ?thesis unfolding invertible_mat_def by blast
 qed
 
 section "More DL Rank"
 
 (* conjugate matrices *)
 instantiation mat :: (conjugate) conjugate
 begin
 
 definition conjugate_mat :: "'a :: conjugate mat \<Rightarrow> 'a mat"
   where "conjugate m = mat (dim_row m) (dim_col m) (\<lambda>(i,j). conjugate (m $$ (i,j)))"
 
 lemma dim_row_conjugate[simp]: "dim_row (conjugate m) = dim_row m"
   unfolding conjugate_mat_def by auto
 
 lemma dim_col_conjugate[simp]: "dim_col (conjugate m) = dim_col m"
   unfolding conjugate_mat_def by auto
 
 lemma carrier_vec_conjugate[simp]: "m \<in> carrier_mat nr nc \<Longrightarrow> conjugate m \<in> carrier_mat nr nc"
   by (auto)
 
 lemma mat_index_conjugate[simp]:
   shows "i < dim_row m \<Longrightarrow> j < dim_col m \<Longrightarrow> conjugate m  $$ (i,j) = conjugate (m $$ (i,j))"
   unfolding conjugate_mat_def by auto
 
 lemma row_conjugate[simp]: "i < dim_row m \<Longrightarrow> row (conjugate m) i = conjugate (row m i)"
   by (auto)
 
 lemma col_conjugate[simp]: "i < dim_col m \<Longrightarrow> col (conjugate m) i = conjugate (col m i)"
   by (auto)
 
 lemma rows_conjugate: "rows (conjugate m) = map conjugate (rows m)"
   by (simp add: list_eq_iff_nth_eq)
 
 lemma cols_conjugate: "cols (conjugate m) = map conjugate (cols m)"
   by (simp add: list_eq_iff_nth_eq)
 
 instance
 proof
   fix a b :: "'a mat"
   show "conjugate (conjugate a) = a"
     unfolding mat_eq_iff by auto
   let ?a = "conjugate a"
   let ?b = "conjugate b"
   show "conjugate a = conjugate b \<longleftrightarrow> a = b"
     by (metis dim_col_conjugate dim_row_conjugate mat_index_conjugate conjugate_cancel_iff mat_eq_iff)
 qed
 
 end
 
 abbreviation conjugate_transpose :: "'a::conjugate mat  \<Rightarrow> 'a mat"
   where "conjugate_transpose A \<equiv> conjugate (A\<^sup>T)"
 
 notation conjugate_transpose ("(_\<^sup>H)" [1000])
 
 lemma transpose_conjugate:
   shows "(conjugate A)\<^sup>T = A\<^sup>H"
   unfolding conjugate_mat_def
   by auto
 
 lemma vec_module_col_helper:
   fixes A:: "('a :: field) mat"
   shows "(0\<^sub>v (dim_row A) \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A)))"
 proof -
   have "\<forall>v. (0::'a) \<cdot>\<^sub>v v + v = v"
     by auto
   then show "0\<^sub>v (dim_row A) \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A))"
     by (metis cols_dim module_vec_def right_zero_vec smult_carrier_vec vec_space.prod_in_span zero_carrier_vec)
 qed
 
 lemma vec_module_col_helper2:
   fixes A:: "('a :: field) mat"
   shows "\<And>a x. x \<in> LinearCombinations.module.span class_ring
                 \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined,
                    zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr>
                 (set (cols A)) \<Longrightarrow>
            (\<And>a b v. (a + b) \<cdot>\<^sub>v v = a \<cdot>\<^sub>v v + b \<cdot>\<^sub>v v) \<Longrightarrow>
            a \<cdot>\<^sub>v x
            \<in> LinearCombinations.module.span class_ring
                \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined,
                   zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr>
                (set (cols A))"
 proof -
   fix a :: 'a and x :: "'a vec"
   assume "x \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A))"
   then show "a \<cdot>\<^sub>v x \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A))"
     by (metis (full_types) cols_dim idom_vec.smult_in_span module_vec_def)
 qed
 
 lemma vec_module_col: "module (class_ring :: 'a :: field ring)
   (module_vec TYPE('a) 
     (dim_row A)
       \<lparr>carrier :=
          LinearCombinations.module.span
           class_ring (module_vec TYPE('a) (dim_row A)) (set (cols A))\<rparr>)"
 proof -
   interpret abelian_group "module_vec TYPE('a) (dim_row A)
       \<lparr>carrier :=
          LinearCombinations.module.span
           class_ring (module_vec TYPE('a) (dim_row A)) (set (cols A))\<rparr>"
     apply (unfold_locales)
           apply (auto simp add:module_vec_def)
           apply (metis cols_dim module_vec_def partial_object.select_convs(1) ring.simps(2) vec_vs vectorspace.span_add1)
          apply (metis assoc_add_vec cols_dim module_vec_def vec_space.cV vec_vs vectorspace.span_closed)
     using vec_module_col_helper[of A] apply (auto)    
        apply (metis cols_dim left_zero_vec module_vec_def partial_object.select_convs(1) vec_vs vectorspace.span_closed)
       apply (metis cols_dim module_vec_def partial_object.select_convs(1) right_zero_vec vec_vs vectorspace.span_closed)
      apply (metis cols_dim comm_add_vec module_vec_def vec_space.cV vec_vs vectorspace.span_closed)
     unfolding Units_def apply auto
-    by (smt cols_dim module_vec_def partial_object.select_convs(1) uminus_l_inv_vec uminus_r_inv_vec vec_space.vec_neg vec_vs vectorspace.span_closed vectorspace.span_neg)
+    by (metis (no_types, opaque_lifting) cols_dim comm_add_vec module_vec_def partial_object.select_convs(1) uminus_l_inv_vec vec_space.vec_neg vec_vs vectorspace.span_closed vectorspace.span_neg)
   show ?thesis
     apply (unfold_locales)
     unfolding class_ring_simps apply auto
     unfolding module_vec_simps using add_smult_distrib_vec apply auto
      apply (auto simp add:module_vec_def)
     using vec_module_col_helper2
      apply blast
-    using cols_dim module_vec_def partial_object.select_convs(1) smult_add_distrib_vec vec_vs vectorspace.span_closed
-    by (smt (z3))
+    by (smt (verit) cols_dim module_vec_def smult_add_distrib_vec vec_space.cV vec_vs vectorspace.span_closed)
 qed
 
 (* The columns of a matrix form a vectorspace *)
 lemma vec_vs_col: "vectorspace (class_ring :: 'a :: field ring)
   (module_vec TYPE('a) (dim_row A)
       \<lparr>carrier :=
          LinearCombinations.module.span
           class_ring
           (module_vec TYPE('a)
             (dim_row A))
           (set (cols A))\<rparr>)"
   unfolding vectorspace_def
   using vec_module_col class_field 
   by (auto simp: class_field_def)
 
 lemma cols_mat_mul_map:
   shows "cols (A * B) = map ((*\<^sub>v) A) (cols B)"
   unfolding list_eq_iff_nth_eq
   by auto
 
 lemma cols_mat_mul:
   shows "set (cols (A * B)) = (*\<^sub>v) A ` set (cols B)"
   by (simp add: cols_mat_mul_map)
 
 lemma set_obtain_sublist:
   assumes "S \<subseteq> set ls"
   obtains ss where "distinct ss" "S = set ss"
   using assms finite_distinct_list infinite_super by blast
 
 lemma mul_mat_of_cols:
   assumes "A \<in> carrier_mat nr n"
   assumes "\<And>j. j < length cs \<Longrightarrow> cs ! j \<in> carrier_vec n"
   shows "A * (mat_of_cols n cs) = mat_of_cols nr (map ((*\<^sub>v) A) cs)"
   unfolding mat_eq_iff
   using assms apply auto
   apply (subst mat_of_cols_index)
   by auto
 
 lemma helper:
   fixes x y z ::"'a :: {conjugatable_ring, comm_ring}"
   shows "x * (y * z) = y * x * z"
   by (simp add: mult.assoc mult.left_commute)
 
 lemma cscalar_prod_conjugate_transpose:
   fixes x y ::"'a :: {conjugatable_ring, comm_ring} vec"
   assumes "A \<in> carrier_mat nr nc"
   assumes "x \<in> carrier_vec nr"
   assumes "y \<in> carrier_vec nc"
   shows "x \<bullet>c (A *\<^sub>v y) = (A\<^sup>H *\<^sub>v x) \<bullet>c y"
   unfolding mult_mat_vec_def scalar_prod_def
   using assms apply (auto simp add: sum_distrib_left sum_distrib_right sum_conjugate conjugate_dist_mul)
   apply (subst sum.swap)
   by (meson helper mult.assoc mult.left_commute sum.cong)
 
 lemma mat_mul_conjugate_transpose_vec_eq_0:                        
   fixes v ::"'a :: {conjugatable_ordered_ring,semiring_no_zero_divisors,comm_ring} vec"
   assumes "A \<in> carrier_mat nr nc"
   assumes "v \<in> carrier_vec nr"
   assumes "A *\<^sub>v (A\<^sup>H *\<^sub>v v) = 0\<^sub>v nr"
   shows "A\<^sup>H *\<^sub>v v = 0\<^sub>v nc"
 proof -
   have "(A\<^sup>H *\<^sub>v v) \<bullet>c (A\<^sup>H *\<^sub>v v) = (A *\<^sub>v (A\<^sup>H *\<^sub>v v)) \<bullet>c v"
     by (metis (mono_tags, lifting) Matrix.carrier_vec_conjugate assms(1) assms(2) assms(3) carrier_matD(2) conjugate_zero_vec cscalar_prod_conjugate_transpose dim_row_conjugate index_transpose_mat(2) mult_mat_vec_def scalar_prod_left_zero scalar_prod_right_zero vec_carrier)
   also have "... = 0"
     by (simp add: assms(2) assms(3))
       (* this step requires real entries *)
   ultimately have "(A\<^sup>H *\<^sub>v v) \<bullet>c (A\<^sup>H *\<^sub>v v) = 0" by auto
   thus ?thesis
     apply (subst conjugate_square_eq_0_vec[symmetric])
     using assms(1) carrier_dim_vec apply fastforce
     by auto
 qed
 
 lemma row_mat_of_cols:
   assumes "i < nr"
   shows "row (mat_of_cols nr ls) i = vec (length ls) (\<lambda>j. (ls ! j) $i)"
-  by (smt assms dim_vec eq_vecI index_row(1) index_row(2) index_vec mat_of_cols_carrier(2) mat_of_cols_carrier(3) mat_of_cols_index)
+  by (simp add: assms mat_of_cols_index vec_eq_iff)
 
 lemma mat_of_cols_cons_mat_vec:
   fixes v ::"'a::comm_ring vec"
   assumes "v \<in> carrier_vec (length ls)"
   assumes "dim_vec a = nr"
   shows
     "mat_of_cols nr (a # ls) *\<^sub>v (vCons m v) =
    m \<cdot>\<^sub>v a + mat_of_cols nr ls *\<^sub>v v"
   unfolding mult_mat_vec_def vec_eq_iff
   using assms by
     (auto simp add: row_mat_of_cols vec_Suc o_def mult.commute)
 
 lemma smult_vec_zero:
   fixes v ::"'a::ring vec"
   shows "0 \<cdot>\<^sub>v v = 0\<^sub>v (dim_vec v)"
   unfolding smult_vec_def vec_eq_iff
   by (auto)
 
 lemma helper2:
   fixes A ::"'a::comm_ring mat"
   fixes v ::"'a vec"
   assumes "v \<in> carrier_vec (length ss)"
   assumes "\<And>x. x \<in> set ls \<Longrightarrow> dim_vec x = nr"
   shows
     "mat_of_cols nr ss *\<^sub>v v =
    mat_of_cols nr (ls @ ss) *\<^sub>v (0\<^sub>v (length ls) @\<^sub>v v)"
   using assms(2)
 proof (induction ls)
   case Nil
   then show ?case by auto
 next
   case (Cons a ls)
   then show ?case apply (auto simp add:zero_vec_Suc)
     apply (subst mat_of_cols_cons_mat_vec)
     by (auto simp add:assms smult_vec_zero)
 qed
 
 lemma mat_of_cols_mult_mat_vec_permute_list:
   fixes v ::"'a::comm_ring list"
   assumes "f permutes {..<length ss}"
   assumes "length ss = length v"
   shows
     "mat_of_cols nr (permute_list f ss) *\<^sub>v vec_of_list (permute_list f v) =
      mat_of_cols nr ss *\<^sub>v vec_of_list v"
   unfolding mat_of_cols_def mult_mat_vec_def vec_eq_iff scalar_prod_def
 proof clarsimp
   fix i
   assume "i < nr"
   from sum.permute[OF assms(1)]
   have "(\<Sum>ia<length ss. ss ! f ia $ i * v ! f ia) =
   sum ((\<lambda>ia. ss ! f ia $ i * v ! f ia) \<circ> f) {..<length ss}" .
   also have "... = (\<Sum>ia = 0..<length v. ss ! f ia $ i * v ! f ia)"
     using assms(2) calculation lessThan_atLeast0 by auto
   ultimately have *: "(\<Sum>ia = 0..<length v.
              ss ! f ia $ i * v ! f ia) =
          (\<Sum>ia = 0..<length v.
              ss ! ia $ i * v ! ia)"
     by (metis (mono_tags, lifting) \<open>\<And>g. sum g {..<length ss} = sum (g \<circ> f) {..<length ss}\<close> assms(2) comp_apply lessThan_atLeast0 sum.cong)
   show "(\<Sum>ia = 0..<length v.
          vec (length ss) (\<lambda>j. permute_list f ss ! j $ i) $ ia *
          vec_of_list (permute_list f v) $ ia) =
          (\<Sum>ia = 0..<length v. vec (length ss) (\<lambda>j. ss ! j $ i) $ ia * vec_of_list v $ ia)"
     using assms * by (auto simp add: permute_list_nth vec_of_list_index)
 qed
 
 (* permute everything in a subset of the indices to the back *)
 lemma subindex_permutation:
   assumes "distinct ss" "set ss \<subseteq> {..<length ls}"
   obtains f where "f permutes {..<length ls}"
     "permute_list f ls = map ((!) ls) (filter (\<lambda>i. i \<notin> set ss) [0..<length ls]) @ map ((!) ls) ss"
 proof -
   have "set [0..<length ls] = set (filter (\<lambda>i. i \<notin> set ss) [0..<length ls] @ ss)"
     using assms unfolding multiset_eq_iff by auto
   then have "mset [0..<length ls] = mset (filter (\<lambda>i. i \<notin> set ss) [0..<length ls] @ ss)"
     apply (subst set_eq_iff_mset_eq_distinct[symmetric])
     using assms by auto  
   then have "mset ls = mset (map ((!) ls)
            (filter (\<lambda>i. i \<notin> set ss)
              [0..<length ls]) @ map ((!) ls) ss)"
-    by (smt length_map map_append map_nth mset_eq_permutation mset_permute_list permute_list_map)
+    by (metis map_append map_nth mset_map)
   thus ?thesis
     by (metis mset_eq_permutation that)
 qed
 
 lemma subindex_permutation2:
   assumes "distinct ss" "set ss \<subseteq> {..<length ls}"
   obtains f where "f permutes {..<length ls}"
     "ls = permute_list f (map ((!) ls) (filter (\<lambda>i. i \<notin> set ss) [0..<length ls]) @ map ((!) ls) ss)"
   using subindex_permutation
   by (metis assms(1) assms(2) length_permute_list mset_eq_permutation mset_permute_list)
 
 lemma distinct_list_subset_nths:
   assumes "distinct ss" "set ss \<subseteq> set ls"
   obtains ids where "distinct ids" "set ids \<subseteq> {..<length ls}" "ss = map ((!) ls) ids"
 proof -
   let ?ids = "map (\<lambda>i. @j. j < length ls \<and> ls!j = i ) ss"
   have 1: "distinct ?ids" unfolding distinct_map
     using assms apply (auto simp add: inj_on_def)
-    by (smt in_mono in_set_conv_nth tfl_some)
+    by (smt (verit) in_set_conv_nth someI subset_eq)
   have 2: "set ?ids \<subseteq> {..<length ls}"
     using assms apply (auto)
     by (metis (mono_tags, lifting) in_mono in_set_conv_nth tfl_some)
   have 3: "ss = map ((!) ls) ?ids"
     using assms apply (auto simp add: list_eq_iff_nth_eq)
-    by (smt imageI in_set_conv_nth subset_iff tfl_some)
+    by (smt (verit, best) in_set_conv_nth someI subsetD)
   show "(\<And>ids. distinct ids \<Longrightarrow>
             set ids \<subseteq> {..<length ls} \<Longrightarrow>
             ss = map ((!) ls) ids \<Longrightarrow> thesis) \<Longrightarrow>
     thesis" using 1 2 3 by blast
 qed
 
 lemma helper3: 
   fixes A ::"'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat nr nc"
   assumes ss:"distinct ss" "set ss \<subseteq> set (cols A)"
   assumes "v \<in> carrier_vec (length ss)"
   obtains c where "mat_of_cols nr ss *\<^sub>v v = A *\<^sub>v c" "dim_vec c = nc"
 proof -
   from distinct_list_subset_nths[OF ss]
   obtain ids where ids: "distinct ids" "set ids \<subseteq> {..<length (cols A)}"
     and ss: "ss = map ((!) (cols A)) ids" by blast
   let ?ls = " map ((!) (cols A)) (filter (\<lambda>i. i \<notin> set ids) [0..<length (cols A)])"
   from subindex_permutation2[OF ids] obtain f where
     f: "f permutes {..<length (cols A)}"
     "cols A = permute_list f (?ls @ ss)" using ss by blast
   have *: "\<And>x. x \<in> set ?ls \<Longrightarrow> dim_vec x = nr"
     using A by auto
   let ?cs1 = "(list_of_vec (0\<^sub>v (length ?ls) @\<^sub>v v))"
   from helper2[OF assms(4) ]
   have "mat_of_cols nr ss *\<^sub>v v = mat_of_cols nr (?ls @ ss) *\<^sub>v vec_of_list (?cs1)"
     using *
     by (metis vec_list)
   also have "... = mat_of_cols nr (permute_list f (?ls @ ss)) *\<^sub>v vec_of_list (permute_list f ?cs1)"
     apply (auto intro!: mat_of_cols_mult_mat_vec_permute_list[symmetric])
      apply (metis cols_length f(1) f(2) length_append length_map length_permute_list)
     using assms(4) by auto
   also have "... =  A *\<^sub>v vec_of_list (permute_list f ?cs1)" using f(2) assms by auto
   ultimately show
     "(\<And>c. mat_of_cols nr ss *\<^sub>v v = A *\<^sub>v c \<Longrightarrow> dim_vec c = nc \<Longrightarrow> thesis) \<Longrightarrow> thesis"
     by (metis A assms(4) carrier_matD(2) carrier_vecD cols_length dim_vec_of_list f(2) index_append_vec(2) index_zero_vec(2) length_append length_list_of_vec length_permute_list)
 qed
 
 lemma mat_mul_conjugate_transpose_sub_vec_eq_0:                        
   fixes A ::"'a :: {conjugatable_ordered_ring,semiring_no_zero_divisors,comm_ring} mat"
   assumes "A \<in> carrier_mat nr nc"
   assumes "distinct ss" "set ss \<subseteq> set (cols (A\<^sup>H))"
   assumes "v \<in> carrier_vec (length ss)"
   assumes "A *\<^sub>v (mat_of_cols nc ss *\<^sub>v v) = 0\<^sub>v nr"
   shows "(mat_of_cols nc ss *\<^sub>v v) = 0\<^sub>v nc"
 proof -
   have "A\<^sup>H \<in> carrier_mat nc nr" using assms(1) by auto
   from  helper3[OF this assms(2-4)]
   obtain c where c: "mat_of_cols nc ss *\<^sub>v v = A\<^sup>H *\<^sub>v c" "dim_vec c = nr" by blast
   have 1: "c \<in> carrier_vec nr"
     using c carrier_vec_dim_vec by blast
   have 2: "A *\<^sub>v (A\<^sup>H *\<^sub>v c) = 0\<^sub>v nr" using c assms(5) by auto
   from mat_mul_conjugate_transpose_vec_eq_0[OF assms(1) 1 2]
   have "A\<^sup>H *\<^sub>v c = 0\<^sub>v nc" .
   thus ?thesis unfolding c(1)[symmetric] .
 qed
 
 lemma Units_invertible:
   fixes A:: "'a::semiring_1 mat"
   assumes "A \<in> Units (ring_mat TYPE('a) n b)"
   shows "invertible_mat A"
   using assms unfolding Units_def invertible_mat_def
   apply (auto simp add: ring_mat_def)
   using inverts_mat_def by blast
 
 lemma invertible_Units:
   fixes A:: "'a::semiring_1 mat"
   assumes "invertible_mat A"
   shows "A \<in> Units (ring_mat TYPE('a) (dim_row A) b)"
   using assms unfolding Units_def invertible_mat_def
   apply (auto simp add: ring_mat_def)
   by (metis assms carrier_mat_triv invertible_mat_def inverts_mat_def inverts_mat_length(1) inverts_mat_length(2))
 
 lemma invertible_det:
   fixes A:: "'a::field mat"
   assumes "A \<in> carrier_mat n n"
   shows "invertible_mat A \<longleftrightarrow> det A \<noteq> 0"
   apply auto
   using invertible_Units unit_imp_det_non_zero apply fastforce
   using assms by (auto intro!: Units_invertible det_non_zero_imp_unit)
 
 context vec_space begin
 
 lemma find_indices_distinct:
   assumes "distinct ss"
   assumes "i < length ss"
   shows "find_indices (ss ! i) ss = [i]"
 proof -
   have "set (find_indices (ss ! i) ss) = {i}"
     using assms apply auto by (simp add: assms(1) assms(2) nth_eq_iff_index_eq)
   thus ?thesis
     by (metis distinct.simps(2) distinct_find_indices empty_iff empty_set insert_iff list.exhaust list.simps(15)) 
 qed
 
 lemma lin_indpt_lin_comb_list:
   assumes "distinct ss"
   assumes "lin_indpt (set ss)"
   assumes "set ss \<subseteq> carrier_vec n"
   assumes "lincomb_list f ss = 0\<^sub>v n"
   assumes "i < length ss"
   shows "f i = 0"
 proof -
   from lincomb_list_as_lincomb[OF assms(3)]
   have "lincomb_list f ss = lincomb (mk_coeff ss f) (set ss)" .
   also have "... = lincomb  (\<lambda>v. sum f (set (find_indices v ss))) (set ss)"
     unfolding mk_coeff_def
     apply (subst R.sumlist_map_as_finsum)
     by (auto simp add: distinct_find_indices)
   ultimately have "lincomb_list f ss = lincomb  (\<lambda>v. sum f (set (find_indices v ss))) (set ss)" by auto
   then have *:"lincomb (\<lambda>v. sum f (set (find_indices v ss))) (set ss) = 0\<^sub>v n"
     using assms(4) by auto
   have "finite (set ss)" by simp
   from not_lindepD[OF assms(2) this _ _ *]
   have "(\<lambda>v. sum f (set (find_indices v ss))) \<in> set ss \<rightarrow> {0}"
     by auto
   from funcset_mem[OF this]
   have "sum f (set (find_indices (nth ss i) ss)) \<in> {0}"
     using assms(5) by auto
   thus ?thesis unfolding find_indices_distinct[OF assms(1) assms(5)]
     by auto
 qed
 
 (* Note: in this locale dim_row A = n, e.g.:
 lemma foo:
   assumes "dim_row A = n"
   shows "rank A = vec_space.rank (dim_row A) A"
   by (simp add: assms) *)
 
 lemma span_mat_mul_subset:
   assumes "A \<in> carrier_mat n d"
   assumes "B \<in> carrier_mat d nc"
   shows "span (set (cols (A * B))) \<subseteq> span (set (cols A))"
 proof -
   have *: "\<And>v. \<exists>ca. lincomb_list v (cols (A * B)) =
               lincomb_list ca  (cols A)"
   proof -
     fix v
     have "lincomb_list v (cols (A * B)) = (A * B) *\<^sub>v vec nc v"
       apply (subst lincomb_list_as_mat_mult)
        apply (metis assms(1) carrier_dim_vec carrier_matD(1) cols_dim index_mult_mat(2) subset_code(1))
       by (metis assms(1) assms(2) carrier_matD(1) carrier_matD(2) cols_length index_mult_mat(2) index_mult_mat(3) mat_of_cols_cols)
     also have "... = A *\<^sub>v (B *\<^sub>v vec nc v)"
       using assms(1) assms(2) by auto
     also have "... = lincomb_list (\<lambda>i. (B *\<^sub>v vec nc v) $ i) (cols A)"
       apply (subst lincomb_list_as_mat_mult)
       using assms(1) carrier_dim_vec cols_dim apply blast
       by (metis assms(1) assms(2) carrier_matD(1) carrier_matD(2) cols_length dim_mult_mat_vec dim_vec eq_vecI index_vec mat_of_cols_cols)
     ultimately have "lincomb_list v (cols (A * B)) =
               lincomb_list (\<lambda>i. (B *\<^sub>v vec nc v) $ i) (cols A)" by auto
     thus "\<exists>ca. lincomb_list v (cols (A * B)) = lincomb_list ca (cols A)" by auto
   qed
   show ?thesis
     apply (subst span_list_as_span[symmetric])
      apply (metis assms(1) carrier_matD(1) cols_dim index_mult_mat(2))
     apply (subst span_list_as_span[symmetric])
     using assms(1) cols_dim apply blast
     by (auto simp add:span_list_def *)
 qed
 
 lemma rank_mat_mul_right:
   assumes "A \<in> carrier_mat n d"
   assumes "B \<in> carrier_mat d nc"
   shows "rank (A * B) \<le> rank A"
 proof -
   have "subspace class_ring (local.span (set (cols (A*B))))
         (vs (local.span (set (cols A))))"
     unfolding subspace_def
     by (metis assms(1) assms(2) carrier_matD(1) cols_dim index_mult_mat(2) nested_submodules span_is_submodule vec_space.span_mat_mul_subset vec_vs_col)
   from vectorspace.subspace_dim[OF _ this]
   have "vectorspace.dim class_ring
    (vs (local.span (set (cols A)))
     \<lparr>carrier := local.span (set (cols (A * B)))\<rparr>) \<le>
   vectorspace.dim class_ring
       (vs (local.span (set (cols A))))"
     apply auto
     by (metis (no_types) assms(1) carrier_matD(1) fin_dim_span_cols index_mult_mat(2) mat_of_cols_carrier(1) mat_of_cols_cols vec_vs_col)
   thus ?thesis unfolding rank_def
     by auto
 qed
 
 lemma sumlist_drop:
   assumes "\<And>v. v \<in> set ls \<Longrightarrow> dim_vec v = n"
   shows "sumlist ls = sumlist (filter (\<lambda>v. v \<noteq> 0\<^sub>v n) ls)"
   using assms
 proof (induction ls)
   case Nil
   then show ?case by auto
 next
   case (Cons a ls)
   then show ?case using dim_sumlist by auto
 qed
 
 lemma lincomb_list_alt:
   shows "lincomb_list c s =
     sumlist (map2 (\<lambda>i j. i \<cdot>\<^sub>v s ! j) (map (\<lambda>i. c i) [0..<length s]) [0..<length s])"
   unfolding lincomb_list_def
-  by (smt length_map map2_map_map map_nth nth_equalityI nth_map)
+  by (smt (verit, ccfv_SIG) length_map map2_map_map map_nth nth_equalityI nth_map)
 
 lemma lincomb_list_alt2:
   assumes "\<And>v. v \<in> set s \<Longrightarrow> dim_vec v = n"
   assumes "\<And>i. i \<in> set ls \<Longrightarrow> i < length s"
   shows "
     sumlist (map2 (\<lambda>i j. i \<cdot>\<^sub>v s ! j) (map (\<lambda>i. c i) ls) ls) =
     sumlist (map2 (\<lambda>i j. i \<cdot>\<^sub>v s ! j) (map (\<lambda>i. c i) (filter (\<lambda>i. c i \<noteq> 0) ls)) (filter (\<lambda>i. c i \<noteq> 0) ls))"
   using assms(2)
 proof (induction ls)
   case Nil
   then show ?case by auto
 next
   case (Cons a s)
   then show ?case
     apply auto
     apply (subst smult_l_null)
      apply (simp add: assms(1) carrier_vecI)
     apply (subst left_zero_vec)
      apply (subst sumlist_carrier)
       apply auto
     by (metis (no_types, lifting) assms(1) carrier_dim_vec mem_Collect_eq nth_mem set_filter set_zip_rightD)
 qed 
 
 lemma two_set:
   assumes "distinct ls"
   assumes "set ls = set [a,b]"
   assumes "a \<noteq> b"
   shows "ls = [a,b] \<or> ls = [b,a]"
   apply (cases ls)
   using assms(2) apply auto[1]
 proof -
   fix x xs
   assume ls:"ls = x # xs"
   obtain y ys where xs:"xs = y # ys"
     by (metis (no_types) \<open>ls = x # xs\<close> assms(2) assms(3) list.set_cases list.set_intros(1) list.set_intros(2) set_ConsD)
   have 1:"x = a \<or> x = b"
     using \<open>ls = x # xs\<close> assms(2) by auto
   have 2:"y = a \<or> y = b"
     using \<open>ls = x # xs\<close> \<open>xs = y # ys\<close> assms(2) by auto
   have 3:"ys = []"
     by (metis (no_types) \<open>ls = x # xs\<close> \<open>xs = y # ys\<close> assms(1) assms(2) distinct.simps(2) distinct_length_2_or_more in_set_member member_rec(2) neq_Nil_conv set_ConsD)
   show "ls = [a, b] \<or> ls = [b, a]" using ls xs 1 2 3 assms
     by auto
 qed
 
 lemma filter_disj_inds:
   assumes "i < length ls" "j < length ls" "i \<noteq> j"
   shows "filter (\<lambda>ia. ia \<noteq> j \<longrightarrow> ia = i) [0..<length ls] = [i, j] \<or>
   filter (\<lambda>ia. ia \<noteq> j \<longrightarrow> ia = i) [0..<length ls] = [j,i]"
 proof -
   have 1: "distinct (filter (\<lambda>ia. ia = i \<or> ia = j) [0..<length ls])"
     using distinct_filter distinct_upt by blast
   have 2:"set (filter (\<lambda>ia. ia = i \<or> ia = j) [0..<length ls]) = {i, j}"
     using assms by auto
   show ?thesis using two_set[OF 1]
     using assms(3) empty_set filter_cong list.simps(15)
-    by (smt "2" assms(3) empty_set filter_cong list.simps(15))
+    by (smt(verit, ccfv_SIG) "2" assms(3) empty_set filter_cong list.simps(15))
 qed
 
 lemma lincomb_list_indpt_distinct:
   assumes "\<And>v. v \<in> set ls \<Longrightarrow> dim_vec v = n"
   assumes
     "\<And>c. lincomb_list c ls = 0\<^sub>v n \<Longrightarrow> (\<forall>i. i < (length ls) \<longrightarrow> c i = 0)"
   shows "distinct ls"
   unfolding distinct_conv_nth
 proof clarsimp
   fix i j
   assume ij: "i < length ls" "j < length ls" "i \<noteq> j" 
   assume lsij: "ls ! i = ls ! j"
   have "lincomb_list (\<lambda>k. if k = i then 1 else if k = j then -1 else 0) ls =
      (ls ! i) - (ls ! j)"
     unfolding lincomb_list_alt
     apply (subst lincomb_list_alt2[OF assms(1)])
       apply auto
     using  filter_disj_inds[OF ij]
     apply auto
     using ij(3) apply force
     using assms(1) ij(2) apply auto[1]
     using ij(3) apply blast
     using assms(1) ij(2) by auto
   also have "...  = 0\<^sub>v n" unfolding lsij
     apply (rule minus_cancel_vec)
     using \<open>j < length ls\<close> assms(1)
     using carrier_vec_dim_vec nth_mem by blast
   ultimately have "lincomb_list (\<lambda>k. if k = i then 1 else if k = j then -1 else 0) ls = 0\<^sub>v n" by auto
   from assms(2)[OF this]
   show False
     using \<open>i < length ls\<close> by auto
 qed
 
 end
 
 locale conjugatable_vec_space = vec_space f_ty n for
   f_ty::"'a::conjugatable_ordered_field itself"
   and n
 begin                                                           
 
 lemma transpose_rank_mul_conjugate_transpose:
   fixes A :: "'a mat"
   assumes "A \<in> carrier_mat n nc"
   shows "vec_space.rank nc A\<^sup>H \<le> rank (A * A\<^sup>H)"
 proof -
   have 1: "A\<^sup>H \<in> carrier_mat nc n" using assms by auto
   have 2: "A * A\<^sup>H \<in> carrier_mat n n" using assms by auto
       (* S is a maximal linearly independent set of rows A (or cols A\<^sup>T) *)
   let ?P = "(\<lambda>T. T \<subseteq> set (cols A\<^sup>H) \<and> module.lin_indpt class_ring (module_vec TYPE('a) nc) T)"
   have *:"\<And>A. ?P A \<Longrightarrow> finite A \<and> card A \<le> n"
   proof clarsimp
     fix S
     assume S: "S \<subseteq> set (cols A\<^sup>H)"
     have "card S \<le> card (set (cols A\<^sup>H))" using S
       using card_mono by blast
     also have "... \<le> length (cols A\<^sup>H)" using card_length by blast
     also have "... \<le> n" using assms by auto
     ultimately show "finite S \<and> card S \<le> n"
       by (meson List.finite_set S dual_order.trans finite_subset)
   qed
   have **:"?P {}"
     apply (subst module.lin_dep_def)
     by (auto simp add: vec_module)
   from maximal_exists[OF *]
   obtain S where S: "maximal S ?P" using **
     by (metis (no_types, lifting)) 
       (* Some properties of S *)
   from vec_space.rank_card_indpt[OF 1 S]
   have rankeq: "vec_space.rank nc A\<^sup>H = card S" .
 
   have s_hyp: "S \<subseteq> set (cols A\<^sup>H)"
     using S unfolding maximal_def by simp
   have modhyp: "module.lin_indpt class_ring (module_vec TYPE('a) nc) S" 
     using S unfolding maximal_def by simp
 
 (* switch to a list representation *)
   obtain ss where ss: "set ss = S" "distinct ss"
     by (metis (mono_tags) S maximal_def set_obtain_sublist)
   have ss2: "set (map ((*\<^sub>v) A) ss) = (*\<^sub>v) A ` S"
     by (simp add: ss(1))
   have rw_hyp: "cols (mat_of_cols n (map ((*\<^sub>v) A) ss)) = cols  (A * mat_of_cols nc ss)" 
     unfolding cols_def apply (auto)
     using mat_vec_as_mat_mat_mult[of A n nc]
     by (metis (no_types, lifting) "1" assms carrier_matD(1) cols_dim mul_mat_of_cols nth_mem s_hyp ss(1) subset_code(1))
   then have rw: "mat_of_cols n (map ((*\<^sub>v) A) ss) = A * mat_of_cols nc ss"
     by (metis assms carrier_matD(1) index_mult_mat(2) mat_of_cols_carrier(2) mat_of_cols_cols) 
   have indpt: "\<And>c. lincomb_list c (map ((*\<^sub>v) A) ss) = 0\<^sub>v n \<Longrightarrow>
       \<forall>i. (i < (length ss) \<longrightarrow> c i = 0)"
   proof clarsimp
     fix c i
     assume *: "lincomb_list c (map ((*\<^sub>v) A) ss) = 0\<^sub>v n"
     assume i: "i < length ss"
     have "\<forall>w\<in>set (map ((*\<^sub>v) A) ss). dim_vec w = n"
       using assms by auto
     from lincomb_list_as_mat_mult[OF this]
     have "A * mat_of_cols nc ss *\<^sub>v  vec (length ss) c = 0\<^sub>v n"
       using * rw by auto
     then have hq: "A *\<^sub>v (mat_of_cols nc ss *\<^sub>v vec (length ss) c) =  0\<^sub>v n"
       by (metis assms assoc_mult_mat_vec mat_of_cols_carrier(1) vec_carrier)
 
     then have eq1: "(mat_of_cols nc ss *\<^sub>v vec (length ss) c) =  0\<^sub>v nc"
       apply (intro mat_mul_conjugate_transpose_sub_vec_eq_0)
       using assms ss s_hyp by auto
 
 (* Rewrite the inner vector back to a lincomb_list *)
     have dim_hyp2: "\<forall>w\<in>set ss. dim_vec w = nc"
       using ss(1) s_hyp
       by (metis "1" carrier_matD(1) carrier_vecD cols_dim subsetD) 
     from vec_module.lincomb_list_as_mat_mult[OF this, symmetric]
     have "mat_of_cols nc ss *\<^sub>v vec (length ss) c = module.lincomb_list (module_vec TYPE('a) nc) c ss" .
     then have "module.lincomb_list (module_vec TYPE('a) nc) c ss = 0\<^sub>v nc" using eq1 by auto
     from vec_space.lin_indpt_lin_comb_list[OF ss(2) _ _ this i]
     show "c i = 0" using modhyp ss s_hyp
       using "1" cols_dim by blast
   qed
   have distinct: "distinct (map ((*\<^sub>v) A) ss)"
     by (metis (no_types, lifting) assms carrier_matD(1) dim_mult_mat_vec imageE indpt length_map lincomb_list_indpt_distinct ss2)
   then have 3: "card S = card ((*\<^sub>v) A ` S)"
     by (metis ss distinct_card image_set length_map)
   then have 4: "(*\<^sub>v) A ` S \<subseteq> set (cols (A * A\<^sup>H))"
     using cols_mat_mul \<open>S \<subseteq> set (cols A\<^sup>H)\<close> by blast
   have 5: "lin_indpt ((*\<^sub>v) A ` S)"
   proof clarsimp
     assume ld:"lin_dep ((*\<^sub>v) A ` S)"
     have *: "finite ((*\<^sub>v) A ` S)"
       by (metis List.finite_set ss2)
     have **: "(*\<^sub>v) A ` S \<subseteq> carrier_vec n"
       using "2" "4" cols_dim by blast
     from finite_lin_dep[OF * ld **]
     obtain a v where
       a: "lincomb a ((*\<^sub>v) A ` S) = 0\<^sub>v n" and
       v: "v \<in> (*\<^sub>v) A ` S" "a v \<noteq> 0" by blast
     obtain i where i:"v = map ((*\<^sub>v) A) ss ! i" "i < length ss"
       using v unfolding ss2[symmetric]
       using find_first_le nth_find_first by force
     from ss2[symmetric]
     have "set (map ((*\<^sub>v) A) ss)\<subseteq> carrier_vec n" using ** ss2 by auto
     from lincomb_as_lincomb_list_distinct[OF this distinct] have
       "lincomb_list
      (\<lambda>i. a (map ((*\<^sub>v) A) ss ! i))  (map ((*\<^sub>v) A) ss) = 0\<^sub>v n"
       using a ss2 by auto
     from indpt[OF this]
     show False using v i by simp
   qed
   from rank_ge_card_indpt[OF 2 4 5]
   have "card ((*\<^sub>v) A ` S) \<le> rank (A * A\<^sup>H)" .
   thus ?thesis using rankeq 3 by linarith
 qed
 
 lemma conjugate_transpose_rank_le:
   assumes "A \<in> carrier_mat n nc"
   shows "vec_space.rank nc (A\<^sup>H) \<le> rank A"
   by (metis assms carrier_matD(2) carrier_mat_triv dim_row_conjugate dual_order.trans index_transpose_mat(2) rank_mat_mul_right transpose_rank_mul_conjugate_transpose)
 
 lemma conjugate_finsum:
   assumes f: "f : U \<rightarrow> carrier_vec n"
   shows "conjugate (finsum V f U) = finsum V (conjugate \<circ> f) U"
   using f
 proof (induct U rule: infinite_finite_induct)
   case (infinite A)
   then show ?case by auto
 next
   case empty
   then show ?case by auto
 next
   case (insert u U)
   hence f: "f : U \<rightarrow> carrier_vec n" "f u : carrier_vec n"  by auto
   then have cf: "conjugate \<circ> f : U \<rightarrow> carrier_vec n"
     "(conjugate \<circ> f) u : carrier_vec n"
      apply (simp add: Pi_iff)
     by (simp add: f(2))
   then show ?case
     unfolding finsum_insert[OF insert(1) insert(2) f]
     unfolding finsum_insert[OF insert(1) insert(2) cf ]
     apply (subst conjugate_add_vec[of _ n])
     using f(2) apply blast
     using M.finsum_closed f(1) apply blast
     by (simp add: comp_def f(1) insert.hyps(3))
 qed
 
 lemma rank_conjugate_le:
   assumes A:"A \<in> carrier_mat n d"
   shows "rank (conjugate (A)) \<le> rank A"
 proof -
   (* S is a maximal linearly independent set of (conjugate A) *)
   let ?P = "(\<lambda>T. T \<subseteq> set (cols (conjugate A)) \<and> lin_indpt T)"
   have *:"\<And>A. ?P A \<Longrightarrow> finite A \<and> card A \<le> d"
     by (metis List.finite_set assms card_length card_mono carrier_matD(2) cols_length dim_col_conjugate dual_order.trans rev_finite_subset)
   have **:"?P {}"
     by (simp add: finite_lin_indpt2)
   from maximal_exists[OF *]
   obtain S where S: "maximal S ?P" using **
     by (metis (no_types, lifting))
   have s_hyp: "S \<subseteq> set (cols (conjugate A))" "lin_indpt S"
     using S unfolding maximal_def
      apply blast
     by (metis (no_types, lifting) S maximal_def)
   from rank_card_indpt[OF _ S, of d]
   have rankeq: "rank (conjugate A) = card S" using assms by auto 
   have 1:"conjugate ` S \<subseteq> set (cols A)"
     using S apply auto
     by (metis (no_types, lifting) cols_conjugate conjugate_id image_eqI in_mono list.set_map s_hyp(1))
   have 2: "lin_indpt (conjugate ` S)"
     apply (rule ccontr)
     apply (auto simp add: lin_dep_def)
   proof -
     fix T c v
     assume T: "T \<subseteq> conjugate ` S" "finite T" and
       lc:"lincomb c T = 0\<^sub>v n" and "v \<in> T"  "c v \<noteq> 0"
     let ?T = "conjugate ` T"
     let ?c = "conjugate \<circ> c \<circ> conjugate"
     have 1: "finite ?T"  using T by auto
     have 2: "?T \<subseteq> S"  using T by auto
     have 3: "?c \<in> ?T \<rightarrow> UNIV" by auto
     have "lincomb ?c ?T = (\<Oplus>\<^bsub>V\<^esub>x\<in>T. conjugate (c x) \<cdot>\<^sub>v conjugate x)"
       unfolding lincomb_def
       apply (subst finsum_reindex)
         apply auto
        apply (metis "2" carrier_vec_conjugate assms carrier_matD(1) cols_dim image_eqI s_hyp(1) subsetD)
       by (meson conjugate_cancel_iff inj_onI)
     also have "... = (\<Oplus>\<^bsub>V\<^esub>x\<in>T. conjugate (c x \<cdot>\<^sub>v x)) "
       by (simp add: conjugate_smult_vec)
     also have "... = conjugate (\<Oplus>\<^bsub>V\<^esub>x\<in>T. (c x \<cdot>\<^sub>v x))"
       apply(subst conjugate_finsum[of "\<lambda>x.(c x \<cdot>\<^sub>v x)" T])
        apply (auto simp add:o_def)
-      by (smt Matrix.carrier_vec_conjugate Pi_I' T(1) assms carrier_matD(1) cols_dim dim_row_conjugate imageE s_hyp(1) smult_carrier_vec subset_eq) 
+      by (smt (verit, ccfv_SIG) Matrix.carrier_vec_conjugate Pi_I' T(1) assms carrier_matD(1) cols_dim dim_row_conjugate imageE s_hyp(1) smult_carrier_vec subset_eq) 
     also have "... = conjugate (lincomb c T)"
       using lincomb_def by presburger
     ultimately have "lincomb ?c ?T = conjugate (lincomb c T)" by auto
     then have 4:"lincomb ?c ?T = 0\<^sub>v n" using lc by auto
     from not_lindepD[OF s_hyp(2) 1 2 3 4]
     have "conjugate \<circ> c \<circ> conjugate \<in> conjugate ` T \<rightarrow> {0}" .
     then have "c v = 0"
       by (simp add: Pi_iff \<open>v \<in> T\<close>)
     thus False using \<open>c v \<noteq> 0\<close> by auto
   qed
   from rank_ge_card_indpt[OF A 1 2]
   have 3:"card (conjugate ` S) \<le> rank A" .
   have 4: "card (conjugate ` S) = card S"
     apply (auto intro!: card_image)
     by (meson conjugate_cancel_iff inj_onI)
   show ?thesis using rankeq 3 4 by auto
 qed
 
 lemma rank_conjugate:
   assumes "A \<in> carrier_mat n d"
   shows "rank (conjugate A) = rank A"
   using  rank_conjugate_le
   by (metis carrier_vec_conjugate assms conjugate_id dual_order.antisym)
 
 end (* exit the context *)
 
 lemma conjugate_transpose_rank:
   fixes A::"'a::{conjugatable_ordered_field} mat"
   shows "vec_space.rank (dim_row A) A = vec_space.rank (dim_col A) (A\<^sup>H)"
   using  conjugatable_vec_space.conjugate_transpose_rank_le
   by (metis (no_types, lifting) Matrix.transpose_transpose carrier_matI conjugate_id dim_col_conjugate dual_order.antisym index_transpose_mat(2) transpose_conjugate)
 
 lemma transpose_rank:
   fixes A::"'a::{conjugatable_ordered_field} mat"
   shows "vec_space.rank (dim_row A) A = vec_space.rank (dim_col A) (A\<^sup>T)"
   by (metis carrier_mat_triv conjugatable_vec_space.rank_conjugate conjugate_transpose_rank index_transpose_mat(2))
 
 lemma rank_mat_mul_left:
   fixes A::"'a::{conjugatable_ordered_field} mat"
   assumes "A \<in> carrier_mat n d"
   assumes "B \<in> carrier_mat d nc"
   shows "vec_space.rank n (A * B) \<le> vec_space.rank d B"
   by (metis (no_types, lifting) Matrix.transpose_transpose assms(1) assms(2) carrier_matD(1) carrier_matD(2) carrier_mat_triv conjugatable_vec_space.rank_conjugate conjugate_transpose_rank index_mult_mat(3) index_transpose_mat(3) transpose_mult vec_space.rank_mat_mul_right)
 
 section "Results on Invertibility"
 
 (* Extract specific columns of a matrix  *)
 definition take_cols :: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
   where "take_cols A inds = mat_of_cols (dim_row A) (map ((!) (cols A)) (filter ((>) (dim_col A)) inds))"
 
 definition take_cols_var :: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
   where "take_cols_var A inds = mat_of_cols (dim_row A) (map ((!) (cols A)) (inds))"
 
 definition take_rows :: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
   where "take_rows A inds = mat_of_rows (dim_col A) (map ((!) (rows A)) (filter ((>) (dim_row A)) inds))"
 
 lemma cong1:
   "x = y \<Longrightarrow>  mat_of_cols n x = mat_of_cols n y"
   by auto
 
 lemma nth_filter:
   assumes "j < length (filter P ls)"
   shows "P  ((filter P ls) ! j)"
   by (simp add: assms list_ball_nth)
 
 lemma take_cols_mat_mul:
   assumes "A \<in> carrier_mat nr n"
   assumes "B \<in> carrier_mat n nc"
   shows "A * take_cols B inds = take_cols (A * B) inds"
 proof -
   have "\<And>j. j < length (map ((!) (cols B)) (filter ((>) nc) inds)) \<Longrightarrow>
       (map ((!) (cols B)) (filter ((>) nc) inds)) ! j \<in> carrier_vec n"
     using assms apply auto
     apply (subst cols_nth)
     using nth_filter by auto
   from mul_mat_of_cols[OF assms(1) this]
   have "A *  take_cols B inds = mat_of_cols nr (map (\<lambda>x. A *\<^sub>v cols B ! x) (filter ((>) (dim_col B)) inds))"
     unfolding take_cols_def using assms by (auto simp add: o_def)
   also have "... = take_cols (A * B) inds"
     unfolding take_cols_def using assms by (auto intro!: cong1)
   ultimately show ?thesis by auto
 qed
 
 lemma take_cols_carrier_mat:
   assumes "A \<in> carrier_mat nr nc"
   obtains n where "take_cols A inds \<in> carrier_mat nr n"
   unfolding take_cols_def
   using assms
   by fastforce
 
 lemma take_cols_carrier_mat_strict:
   assumes "A \<in> carrier_mat nr nc"
   assumes "\<And>i. i \<in> set inds \<Longrightarrow> i < nc"
   shows "take_cols A inds \<in> carrier_mat nr (length inds)"
   unfolding take_cols_def
   using assms by auto
 
 lemma gauss_jordan_take_cols:  
   assumes "gauss_jordan A (take_cols A inds) = (C,D)"
   shows "D = take_cols C inds"
 proof -
   obtain nr nc where A: "A  \<in> carrier_mat nr nc" by auto
   from take_cols_carrier_mat[OF this]
   obtain n where B: "take_cols A inds \<in> carrier_mat nr n" by auto
   from gauss_jordan_transform[OF A B assms, of undefined]
   obtain P where PP:"P\<in>Units (ring_mat TYPE('a) nr undefined)" and
     CD: "C = P * A" "D = P * take_cols A inds" by blast
   have P: "P \<in> carrier_mat nr nr"
     by (metis (no_types, lifting) Units_def PP mem_Collect_eq partial_object.select_convs(1) ring_mat_def)
   from take_cols_mat_mul[OF P A]
   have "P * take_cols A inds = take_cols (P * A) inds" .
   thus ?thesis using CD by blast  
 qed
 
 lemma dim_col_take_cols:
   assumes "\<And>j. j \<in> set inds \<Longrightarrow> j < dim_col A"
   shows "dim_col (take_cols A inds) = length inds"
   unfolding take_cols_def
   using assms by auto
 
 lemma dim_col_take_rows[simp]:
   shows "dim_col (take_rows A inds) = dim_col A"
   unfolding take_rows_def by auto
 
 lemma cols_take_cols_subset:
   shows "set (cols (take_cols A inds)) \<subseteq> set (cols A)"
   unfolding take_cols_def
   apply (subst cols_mat_of_cols)
    apply auto
   using in_set_conv_nth by fastforce
 
 lemma dim_row_take_cols[simp]:
   shows "dim_row (take_cols A ls) = dim_row A"
   by (simp add: take_cols_def)
 
 lemma dim_row_append_rows[simp]:
   shows "dim_row (A @\<^sub>r B) = dim_row A + dim_row B"
   by (simp add: append_rows_def)
 
 lemma rows_inj:
   assumes "dim_col A = dim_col B"
   assumes "rows A = rows B"
   shows "A = B"
   unfolding mat_eq_iff
   apply auto
     apply (metis assms(2) length_rows)
   using assms(1) apply blast
   by (metis assms(1) assms(2) mat_of_rows_rows)
 
 lemma append_rows_index:
   assumes "dim_col A = dim_col B"
   assumes "i < dim_row A + dim_row B"
   assumes "j < dim_col A"
   shows "(A @\<^sub>r B) $$ (i,j) = (if i < dim_row A then A $$ (i,j) else B $$ (i-dim_row A,j))"
   unfolding append_rows_def
   apply (subst index_mat_four_block)
   using assms by auto
 
 lemma row_append_rows:
   assumes "dim_col A = dim_col B"
   assumes "i < dim_row A + dim_row B"
   shows "row (A @\<^sub>r B) i = (if i < dim_row A then row A i else row B (i-dim_row A))"
   unfolding vec_eq_iff
   using assms by (auto simp add: append_rows_def)
 
 lemma append_rows_mat_mul:
   assumes "dim_col A = dim_col B"
   shows "(A @\<^sub>r B) * C = A * C @\<^sub>r B * C"
   unfolding mat_eq_iff
   apply auto
    apply (simp add: append_rows_def)
   apply (subst index_mult_mat)
     apply auto
    apply (simp add: append_rows_def)
   apply (subst  append_rows_index)
      apply auto
     apply (simp add: append_rows_def)
    apply (metis add.right_neutral append_rows_def assms index_mat_four_block(3) index_mult_mat(1) index_mult_mat(3) index_zero_mat(3) row_append_rows trans_less_add1)
   by (metis add_cancel_right_right add_diff_inverse_nat append_rows_def assms index_mat_four_block(3) index_mult_mat(1) index_mult_mat(3) index_zero_mat(3) nat_add_left_cancel_less row_append_rows)
 
 lemma cardlt:
   shows "card  {i. i < (n::nat)} \<le> n"
   by simp
 
 lemma row_echelon_form_zero_rows:
   assumes row_ech: "row_echelon_form A"
   assumes dim_asm: "dim_col A \<ge> dim_row A"
   shows "take_rows A [0..<length (pivot_positions A)] @\<^sub>r  0\<^sub>m (dim_row A - length (pivot_positions A))  (dim_col A) = A"
 proof -
   have ex_pivot_fun: "\<exists> f. pivot_fun A f (dim_col A)" using row_ech unfolding row_echelon_form_def by auto
   have len_help: "length (pivot_positions A) = card {i. i < dim_row A \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}"
     using ex_pivot_fun pivot_positions[where A = "A",where nr = "dim_row A", where nc = "dim_col A"]
     by auto
   then have len_help2: "length (pivot_positions A) \<le> dim_row A"
     by (metis (no_types, lifting) card_mono cardlt finite_Collect_less_nat le_trans mem_Collect_eq subsetI)
   have fileq: "filter (\<lambda>y. y < dim_row A) [0..< length (pivot_positions A)] = [0..<length (pivot_positions A)]"
     apply (rule filter_True)
     using len_help2 by auto
   have "\<forall>n. card {i. i < n  \<and> row A i \<noteq> 0\<^sub>v (dim_col A)} \<le> n"
   proof clarsimp 
     fix n
     have h: "\<forall>x. x \<in> {i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)} \<longrightarrow> x\<in>{..<n}"
       by simp
     then have h1: "{i. i < n  \<and> row A i \<noteq> 0\<^sub>v (dim_col A)} \<subseteq> {..<n}"
       by blast
     then have h2: "(card {i. i < n  \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}::nat) \<le> (card {..<n}::nat)"
       using card_mono by blast 
     then show "(card {i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}::nat) \<le> (n::nat)" using h2 card_lessThan[of n]
       by auto
   qed
   then have pivot_len: "length (pivot_positions A) \<le> dim_row A "  using len_help
     by simp
   have alt_char: "mat_of_rows (dim_col A)
          (map ((!) (rows A)) (filter (\<lambda>y. y < dim_col A) [0..<length (pivot_positions A)])) = 
       mat_of_rows (dim_col A) (map ((!) (rows A))  [0..<length (pivot_positions A)])"
     using pivot_len dim_asm
     by auto
   have h1: "\<And>i j. i < dim_row A \<Longrightarrow>
            j < dim_col A \<Longrightarrow>
            i < dim_row (take_rows A [0..<length (pivot_positions A)]) \<Longrightarrow>
            take_rows A [0..<length (pivot_positions A)] $$ (i, j) = A $$ (i, j)"
   proof - 
     fix i 
     fix j
     assume "i < dim_row A"
     assume j_lt: "j < dim_col A"
     assume i_lt: "i < dim_row (take_rows A [0..<length (pivot_positions A)])" 
     have lt: "length (pivot_positions A) \<le> dim_row A" using pivot_len by auto
     have h1: "take_rows A [0..<length (pivot_positions A)] $$ (i, j) = (row (take_rows A [0..<length (pivot_positions A)]) i)$j"
       by (simp add: i_lt j_lt)
     then have h2: "(row (take_rows A [0..<length (pivot_positions A)]) i)$j = (row A i)$j"
       using lt alt_char i_lt unfolding take_rows_def by auto
     show "take_rows A [0..<length (pivot_positions A)] $$ (i, j) = A $$ (i, j)"
       using h1 h2
       by (simp add: \<open>i < dim_row A\<close> j_lt) 
   qed
   let ?nc = "dim_col A"
   let ?nr = "dim_row A"
   have h2: "\<And>i j. i < dim_row A \<Longrightarrow>
            j < dim_col A \<Longrightarrow>
            \<not> i < dim_row (take_rows A [0..<length (pivot_positions A)]) \<Longrightarrow>
            0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) $$
            (i - dim_row (take_rows A [0..<length (pivot_positions A)]), j) =
            A $$ (i, j)"
   proof - 
     fix i
     fix j
     assume lt_i: "i < dim_row A"
     assume lt_j: "j < dim_col A"
     assume not_lt: "\<not> i < dim_row (take_rows A [0..<length (pivot_positions A)])"
     let ?ip = "i+1"
     have h0: "\<exists>f. pivot_fun A f (dim_col A) \<and> f i = ?nc"
     proof -  
       have half1: "\<exists>f. pivot_fun A f (dim_col A)" using assms unfolding row_echelon_form_def
         by blast
       have half2: "\<forall>f. pivot_fun A f (dim_col A) \<longrightarrow> f i = ?nc " 
       proof clarsimp
         fix f
         assume is_piv: "pivot_fun A f (dim_col A)"
         have len_pp: "length (pivot_positions A) = card {i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}" using is_piv pivot_positions[of A ?nr ?nc f]
           by auto
         have  "\<forall>i. (i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc) \<longleftrightarrow>  (i < ?nr \<and> f i \<noteq> ?nc)"
           using is_piv pivot_fun_zero_row_iff[of A f ?nc ?nr]
           by blast
         then have len_pp_var: "length (pivot_positions A) = card {i. i < ?nr \<and> f i \<noteq> ?nc}" 
           using len_pp  by auto 
         have allj_hyp: "\<forall>j < ?nr. f j = ?nc \<longrightarrow> ((Suc j) < ?nr \<longrightarrow> f (Suc j) = ?nc)" 
           using is_piv unfolding pivot_fun_def 
           using lt_i
           by (metis le_antisym le_less) 
         have if_then_bad: "f i \<noteq> ?nc \<longrightarrow> (\<forall>j. j \<le> i \<longrightarrow> f j \<noteq> ?nc)"
         proof clarsimp 
           fix j
           assume not_i: "f i \<noteq> ?nc"
           assume j_leq: "j \<le> i"
           assume bad_asm: "f j = ?nc"
           have "\<And>k. k \<ge> j \<Longrightarrow>  k < ?nr \<Longrightarrow> f k = ?nc"
           proof -
             fix k :: nat
             assume a1: "j \<le> k"
             assume a2: "k < dim_row A"
             have f3: "\<And>n. \<not> n < dim_row A \<or> f n \<noteq> f j \<or> \<not> Suc n < dim_row A \<or> f (Suc n) = f j"
               using allj_hyp bad_asm by presburger
             obtain nn :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow> nat" where
               f4: "\<And>n na p nb nc. (\<not> n \<le> na \<or> Suc n \<le> Suc na) \<and> (\<not> p nb \<or> \<not> nc \<le> nb \<or> \<not> p (nn nc nb p) \<or> p nc) \<and> (\<not> p nb \<or> \<not> nc \<le> nb \<or> p nc \<or> p (Suc (nn nc nb p)))"
               using inc_induct order_refl by moura
             then have f5: "\<And>p. \<not> p k \<or> p j \<or> p (Suc (nn j k p))"
               using a1 by presburger
             have f6: "\<And>p. \<not> p k \<or> \<not> p (nn j k p) \<or> p j"
               using f4 a1 by meson
             { assume "nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A) < dim_row A \<and> f (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) \<noteq> dim_col A"
               moreover
               { assume "(nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A) < dim_row A \<and> f (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) \<noteq> dim_col A) \<and> (\<not> j < dim_row A \<or> f j = dim_col A)"
                 then have "\<not> k < dim_row A \<or> f k = dim_col A"
                   using f6
                   by (metis (mono_tags, lifting)) }
               ultimately have "(\<not> j < dim_row A \<or> f j = dim_col A) \<and> (\<not> Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<or> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) = dim_col A) \<or> \<not> k < dim_row A \<or> f k = dim_col A"
                 using bad_asm
                 by blast }
             moreover
             { assume "(\<not> j < dim_row A \<or> f j = dim_col A) \<and> (\<not> Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<or> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) = dim_col A)"
               then have "\<not> k < dim_row A \<or> f k = dim_col A"
                 using f5
               proof -
                 have "\<not> (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<and> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) \<noteq> dim_col A) \<and> \<not> (j < dim_row A \<and> f j \<noteq> dim_col A)"
                   using \<open>(\<not> j < dim_row A \<or> f j = dim_col A) \<and> (\<not> Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<or> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) = dim_col A)\<close> by linarith
                 then have "\<not> (k < dim_row A \<and> f k \<noteq> dim_col A)"
                   by (metis (mono_tags, lifting) a2 bad_asm f5 le_less)
                 then show ?thesis
                   by meson
               qed }
             ultimately show "f k = dim_col A"
               using f3 a2 by (metis (lifting) Suc_lessD bad_asm)
           qed
           then show "False" using lt_i not_i
             using j_leq by blast 
         qed
         have "f i \<noteq> ?nc \<longrightarrow> ({0..<?ip} \<subseteq> {y. y < ?nr \<and> f y \<noteq> dim_col A})"
         proof -
           have h1: "f i \<noteq> dim_col A \<longrightarrow> (\<forall>j\<le>i. j < ?nr \<and> f j \<noteq> dim_col A)"
             using if_then_bad lt_i by auto
           then show ?thesis by auto
         qed
         then have gteq: "f i \<noteq> ?nc \<longrightarrow> (card {i. i < ?nr \<and> f i \<noteq> dim_col A} \<ge> (i+1))"
           using card_lessThan[of ?ip] card_mono[where B = "{i. i < ?nr \<and> f i \<noteq> dim_col A} ", where A = "{0..<?ip}"]
           by auto
         then have clear: "dim_row (take_rows A [0..<length (pivot_positions A)]) = length (pivot_positions A)"
           unfolding take_rows_def using dim_asm fileq by (auto)
         have "i + 1 > length (pivot_positions A)" using not_lt clear by auto
         then show "f i = ?nc" using gteq len_pp_var by auto
       qed
       show ?thesis using half1 half2
         by blast 
     qed
     then have h1a: "row A i =  0\<^sub>v (dim_col A)" 
       using pivot_fun_zero_row_iff[of A _ ?nc ?nr]
       using lt_i by blast
     then have h1: "A $$ (i, j) = 0"
       using index_row(1) lt_i lt_j by fastforce 
     have h2a: "i - dim_row (take_rows A [0..<length (pivot_positions A)]) < dim_row A - length (pivot_positions A)"
       using pivot_len lt_i not_lt
       by (simp add: take_rows_def)
     then have h2: "0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) $$
            (i - dim_row (take_rows A [0..<length (pivot_positions A)]), j) = 0 " 
       unfolding zero_mat_def using pivot_len lt_i lt_j
       using index_mat(1) by blast 
     then show "0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) $$
            (i - dim_row (take_rows A [0..<length (pivot_positions A)]), j) =
            A $$ (i, j)" using h1 h2
       by simp 
   qed
   have h3: "(dim_row (take_rows A [0..<length (pivot_positions A)])::nat) + ((dim_row A::nat) - (length (pivot_positions A)::nat)) =
     dim_row A"
   proof - 
     have h0: "dim_row (take_rows A [0..<length (pivot_positions A)]) = (length (pivot_positions A)::nat)" 
       by (simp add: take_rows_def fileq)
     then show ?thesis using add_diff_inverse_nat  pivot_len
       by linarith
   qed
   have h4: " \<And>i j. i < dim_row A \<Longrightarrow>
            j < dim_col A \<Longrightarrow>
            i < dim_row (take_rows A [0..<length (pivot_positions A)]) +
                (dim_row A - length (pivot_positions A))"
     using pivot_len
     by (simp add: h3) 
   then show ?thesis apply (subst mat_eq_iff)
     using h1 h2 h3 h4 by (auto simp add: append_rows_def)
 qed
 
 lemma length_pivot_positions_dim_row:
   assumes "row_echelon_form A"
   shows "length (pivot_positions A) \<le> dim_row A"
 proof -
   have 1: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
   obtain f where 2: "pivot_fun A f (dim_col A)"
     using assms row_echelon_form_def by blast
   from pivot_positions(4)[OF 1 2] have
     "length (pivot_positions A) = card {i. i < dim_row A \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}" .
   also have "... \<le> card {i. i < dim_row A}"
     apply (rule card_mono)
     by auto
   ultimately show ?thesis by auto
 qed
 
 lemma rref_pivot_positions:
   assumes "row_echelon_form R"
   assumes R: "R \<in> carrier_mat nr nc"
   shows "\<And>i j. (i,j) \<in> set (pivot_positions R) \<Longrightarrow> i < nr \<and> j < nc"
 proof -
   obtain f where f: "pivot_fun R f nc"
     using assms(1) assms(2) row_echelon_form_def by blast
   have *: "\<And>i. i < nr \<Longrightarrow> f i \<le> nc" using f
     using R pivot_funD(1) by blast
   from pivot_positions[OF R f]
   have "set (pivot_positions R) = {(i, f i) |i. i < nr \<and> f i \<noteq> nc}" by auto
   then have **: "set (pivot_positions R) = {(i, f i) |i. i < nr \<and> f i < nc}"
     using *
     by fastforce
   fix i j
   assume "(i, j) \<in> set (pivot_positions R)"
   thus "i < nr \<and> j < nc" using **
     by simp
 qed
 
 lemma pivot_fun_monoton: 
   assumes pf: "pivot_fun A f (dim_col A)"
   assumes dr: "dim_row A = nr"
   shows "\<And> i. i < nr \<Longrightarrow> (\<And> k. ((k < nr \<and> i < k) \<longrightarrow> f i \<le> f k))"
 proof -
   fix i
   assume "i < nr"
   show "(\<And> k. ((k < nr \<and> i < k) \<longrightarrow> f i \<le> f k))"
   proof -
     fix k
     show "((k < nr \<and> i < k) \<longrightarrow> f i \<le> f k)"
     proof (induct k)
       case 0
       then show ?case
         by blast 
     next
       case (Suc k)
       then show ?case 
-        by (smt dr le_less_trans less_Suc_eq less_imp_le_nat pf pivot_funD(1) pivot_funD(3))
+        by (smt (verit, ccfv_SIG) dr le_less_trans less_Suc_eq less_imp_le_nat pf pivot_funD(1) pivot_funD(3))
     qed
   qed
 qed
 
 lemma pivot_positions_contains:
   assumes row_ech: "row_echelon_form A"
   assumes dim_h: "dim_col A \<ge> dim_row A"
   assumes "pivot_fun A f (dim_col A)"
   shows "\<forall>i < (length (pivot_positions A)). (i, f i) \<in> set (pivot_positions A)"
 proof - 
   let ?nr = "dim_row A"
   let ?nc = "dim_col A"
   let ?pp = "pivot_positions A"          
   have i_nr: "\<forall>i < (length ?pp). i < ?nr" using rref_pivot_positions assms
     using length_pivot_positions_dim_row less_le_trans by blast 
   have i_nc: "\<forall>i < (length ?pp). f i < ?nc"
   proof clarsimp 
     fix i
     assume i_lt: "i < length ?pp"
     have fis_nc: "f i = ?nc \<Longrightarrow> (\<forall> k > i. k < ?nr \<longrightarrow> f k = ?nc)"
     proof -
       assume is_nc: "f i = ?nc"
       show "(\<forall> k > i. k < ?nr \<longrightarrow> f k = ?nc)" 
       proof clarsimp
         fix k
         assume k_gt: "k > i"
         assume k_lt: "k < ?nr"
         have fk_lt: "f k \<le> ?nc" using pivot_funD(1)[of A ?nr f ?nc k] k_lt apply (auto)
           using \<open>pivot_fun A f (dim_col A)\<close> by blast 
         show "f k = ?nc"
           using fk_lt is_nc k_gt k_lt assms pivot_fun_monoton[of A f ?nr i k]
           using \<open>pivot_fun A f (dim_col A)\<close> by auto 
       qed
     qed
     have ncimp: "f i = ?nc \<Longrightarrow> (\<forall> k \<ge>i. k \<notin> { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc})"
     proof -
       assume nchyp: "f i = ?nc"
       show "(\<forall> k \<ge>i. k \<notin> { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc})"
       proof clarsimp 
         fix k
         assume i_lt: "i \<le> k" 
         assume k_lt: "k < dim_row A"
         show "row A k = 0\<^sub>v (dim_col A) "
           using i_lt k_lt fis_nc
           using pivot_fun_zero_row_iff[of A f ?nc ?nr]
           using \<open>pivot_fun A f (dim_col A)\<close> le_neq_implies_less nchyp by blast 
       qed
     qed
     then have "f i = ?nc \<Longrightarrow> card { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc} \<le> i"
     proof - 
       assume nchyp: "f i = ?nc"
       have h: "{ i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc} \<subseteq> {0..<i}"
         using atLeast0LessThan le_less_linear nchyp ncimp by blast
       then show " card { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc} \<le> i"
         using card_lessThan
         using subset_eq_atLeast0_lessThan_card by blast 
     qed
     then show "f i < ?nc" using i_lt pivot_positions(4)[of A ?nr ?nc f]
       apply (auto)
       by (metis \<open>pivot_fun A f (dim_col A)\<close> i_nr le_neq_implies_less not_less pivot_funD(1)) 
   qed
   then show ?thesis
     using pivot_positions(1)
-    by (smt \<open>pivot_fun A f (dim_col A)\<close> carrier_matI i_nr less_not_refl mem_Collect_eq)
+    by (smt (verit, ccfv_SIG) \<open>pivot_fun A f (dim_col A)\<close> carrier_matI i_nr less_not_refl mem_Collect_eq)
 qed
 
 lemma pivot_positions_form_helper_1:
   shows "(a, b) \<in> set (pivot_positions_main_gen z A nr nc i j) \<Longrightarrow> i \<le> a"
 proof  (induct i j rule: pivot_positions_main_gen.induct[of nr nc A z])
   case (1 i j)
   then show ?case using  pivot_positions_main_gen.simps[of z A nr nc i j]
-    apply (auto)
-    by (smt Suc_leD le_refl old.prod.inject set_ConsD)
+    by (metis Pair_inject Suc_leD emptyE list.set(1) nle_le set_ConsD)
 qed
 
 lemma pivot_positions_form_helper_2:
   shows "sorted_wrt (<) (map fst (pivot_positions_main_gen z A nr nc i j))"
 proof  (induct i j rule: pivot_positions_main_gen.induct[of nr nc A z])
   case (1 i j)
   then show ?case using  pivot_positions_main_gen.simps[of z A nr nc i j] 
     by (auto simp: pivot_positions_form_helper_1 Suc_le_lessD) 
 qed
 
 lemma sorted_pivot_positions:
   shows "sorted_wrt (<) (map fst (pivot_positions A))"
   using pivot_positions_form_helper_2
   by (simp add: pivot_positions_form_helper_2 pivot_positions_gen_def) 
 
 lemma pivot_positions_form:
   assumes row_ech: "row_echelon_form A"
   assumes dim_h: "dim_col A \<ge> dim_row A"
   shows "\<forall> i < (length (pivot_positions A)). fst ((pivot_positions A) ! i) = i"
 proof clarsimp 
   let ?nr = "dim_row A"
   let ?nc = "dim_col A"
   let ?pp = "pivot_positions A :: (nat \<times> nat) list"
   fix i
   assume i_lt: "i < length (pivot_positions A)"
   have "\<exists>f. pivot_fun A f ?nc" using row_ech unfolding row_echelon_form_def
     by blast
   then obtain f where pf:"pivot_fun A f ?nc"
     by blast                  
   have all_f_in: "\<forall>i < (length ?pp). (i, f i) \<in> set ?pp"
     using pivot_positions_contains pf
       assms 
     by blast   
   have sorted_hyp: "\<And> (p::nat) (q::nat). p < (length ?pp) \<Longrightarrow> q < (length ?pp) \<Longrightarrow> p < q \<Longrightarrow> (fst (?pp ! p) < fst (?pp ! q))"
   proof -
     fix p::nat
     fix q::nat
     assume p_lt: "p < q"
     assume p_welldef: "p < (length ?pp)"
     assume q_welldef: "q < (length ?pp)"
     show "fst (?pp ! p) < fst (?pp ! q)"
-      using sorted_pivot_positions p_lt p_welldef q_welldef apply (auto)
-      by (smt find_first_unique length_map nat_less_le nth_map p_welldef sorted_nth_mono sorted_pivot_positions strict_sorted_iff)     
+      using sorted_pivot_positions p_lt p_welldef q_welldef sorted_wrt_nth_less by fastforce
   qed
   have h: "i < (length ?pp) \<longrightarrow> fst (pivot_positions A ! i) = i"
   proof (induct i)
     case 0
     have "\<exists>j. fst (pivot_positions A ! j) = 0"
       by (metis all_f_in fst_conv i_lt in_set_conv_nth length_greater_0_conv list.size(3) not_less0)
     then obtain j where jth:" fst (pivot_positions A ! j) = 0"
       by blast      
     have "j \<noteq> 0 \<longrightarrow> (fst (pivot_positions A ! 0) > 0 \<longrightarrow> j \<le> 0)"
-      using sorted_hyp apply (auto)
-      by (metis all_f_in fst_conv i_lt in_set_conv_nth length_greater_0_conv list.size(3) neq0_conv not_less0)  
+      by (smt (verit, ccfv_SIG) all_f_in fst_conv i_lt in_set_conv_nth less_nat_zero_code not_gr_zero sorted_hyp)
     then show ?case
       using jth neq0_conv by blast
   next
     case (Suc i)
     have ind_h: "i < length (pivot_positions A) \<longrightarrow> fst (pivot_positions A ! i) = i"
       using Suc.hyps by blast 
     have thesis_h: "(Suc i) < length (pivot_positions A) \<Longrightarrow> fst (pivot_positions A ! (Suc i)) = (Suc i)"
     proof - 
       assume suc_i_lt: "(Suc i) < length (pivot_positions A)"
       have fst_i_is: "fst (pivot_positions A ! i) = i" using suc_i_lt ind_h
         using Suc_lessD by blast 
       have "(\<exists>j < (length ?pp). fst (pivot_positions A ! j) = (Suc i))"
         by (metis suc_i_lt all_f_in fst_conv  in_set_conv_nth)
       then obtain j where jth: "j < (length ?pp) \<and> fst (pivot_positions A ! j) = (Suc i)"
         by blast
       have "j > i"
         using sorted_hyp apply (auto)
         by (metis Suc_lessD \<open>fst (pivot_positions A ! i) = i\<close> jth less_not_refl linorder_neqE_nat n_not_Suc_n suc_i_lt)
       have "j > (Suc i) \<Longrightarrow> False"
       proof -
         assume j_gt: "j > (Suc i)"
         then have h1: "fst (pivot_positions A ! (Suc i)) > i"
           using fst_i_is sorted_pivot_positions
           using sorted_hyp suc_i_lt by force
         have "fst (pivot_positions A ! j) > fst (pivot_positions A ! (Suc i))"
           using jth j_gt sorted_hyp apply (auto)
           by fastforce 
         then have h2: "fst (pivot_positions A ! (Suc i)) < (Suc i)" 
           using jth
           by simp   
         show "False" using h1 h2
           using not_less_eq by blast 
       qed
       show "fst (pivot_positions A ! (Suc i)) = (Suc i)"
         using Suc_lessI \<open>Suc i < j \<Longrightarrow> False\<close> \<open>i < j\<close> jth by blast
     qed
     then show ?case
       by blast 
   qed
   then show "fst (pivot_positions A ! i) = i"
     using i_lt by auto
 qed
 
 lemma take_cols_pivot_eq:
   assumes row_ech: "row_echelon_form A"
   assumes dim_h: "dim_col A \<ge> dim_row A"
   shows "take_cols A (map snd (pivot_positions A)) =
     1\<^sub>m (length (pivot_positions A)) @\<^sub>r
     0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))"
 proof - 
   let ?nr = "dim_row A"
   let ?nc = "dim_col A"
   have h1: " dim_col
      (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
       0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) = (length (pivot_positions A))"
     by (simp add: append_rows_def)
   have len_pivot: "length (pivot_positions A) = card {i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}"
     using row_ech pivot_positions(4) row_echelon_form_def by blast
   have pp_leq_nc: "\<forall>f. pivot_fun A f ?nc \<longrightarrow> (\<forall>i < ?nr. f i \<le> ?nc)" unfolding pivot_fun_def
     by meson 
   have pivot_set: "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) | i. i < ?nr \<and> f i \<noteq> ?nc}"
     using row_ech row_echelon_form_def pivot_positions(1)
     by (smt (verit) Collect_cong carrier_matI)
   then have pivot_set_alt: "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) | i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}"
     using pivot_positions pivot_fun_zero_row_iff Collect_cong carrier_mat_triv
     by (smt (verit, best))
   have "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) | i. f i \<le> ?nc \<and> i < ?nr \<and> f i \<noteq> ?nc}"
     using pivot_set pp_leq_nc by auto
   then have pivot_set_var: "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) | i. i < ?nr \<and> f i < ?nc}"
     by auto
   have "length (map snd (pivot_positions A)) = card (set (map snd (pivot_positions A)))" 
     using row_ech row_echelon_form_def pivot_positions(3) distinct_card[where xs = "map snd (pivot_positions A)"]
     by (metis carrier_mat_triv)
   then have "length (map snd (pivot_positions A)) = card (set (pivot_positions A))"
     by (metis card_distinct distinct_card distinct_map length_map) 
   then have "length (map snd (pivot_positions A)) = card {i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}"
     using pivot_set_alt
     by (simp add: len_pivot) 
   then have length_asm: "length (map snd (pivot_positions A)) = length (pivot_positions A)"
     using len_pivot by linarith
   then have "\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A"
   proof clarsimp 
     fix a
     assume a_in: "List.member (map snd (pivot_positions A)) a"
     have "\<exists>v \<in> set (pivot_positions A). a = snd v" 
       using a_in in_set_member[where xs = "(pivot_positions A)"] apply (auto)
       by (metis in_set_impl_in_set_zip2 in_set_member length_map snd_conv zip_map_fst_snd) 
     then show "a < dim_col A"
       using pivot_set_var in_set_member by auto
   qed
   then have h2b: "(filter (\<lambda>y. y < dim_col A) (map snd (pivot_positions A))) =  (map snd (pivot_positions A))"
     by (meson filter_True in_set_member)
   then have h2a: "length (map ((!) (cols A)) (filter (\<lambda>y. y < dim_col A) (map snd (pivot_positions A)))) = length (pivot_positions A)"
     using length_asm
     by (simp add: h2b) 
   then have h2: "length (pivot_positions A) \<le> dim_row A \<Longrightarrow>
     dim_col (take_cols A (map snd (pivot_positions A))) = (length (pivot_positions A))" 
     unfolding take_cols_def using mat_of_cols_carrier by auto
   have h_len: "length (pivot_positions A) \<le> dim_row A \<Longrightarrow>
     dim_col (take_cols A (map snd (pivot_positions A))) =
     dim_col
      (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
       0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A)))" 
     using h1 h2
     by (simp add: h1 assms length_pivot_positions_dim_row)
   have h2: "\<And>i j. length (pivot_positions A) \<le> dim_row A \<Longrightarrow>
            i < dim_row A \<Longrightarrow>
            j < dim_col
                 (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
                  0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) \<Longrightarrow>
            take_cols A (map snd (pivot_positions A)) $$ (i, j) =
            (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
             0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) $$
            (i, j)" 
   proof -
     fix i 
     fix j 
     let ?pp = "(pivot_positions A)"
     assume len_lt: "length (pivot_positions A) \<le> dim_row A" 
     assume i_lt: " i < dim_row A" 
     assume j_lt: "j < dim_col
                 (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
                  0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A)))"
     let ?w = "((map snd (pivot_positions A)) ! j)"
     have breaking_it_down: "mat_of_cols (dim_row A)
      (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j)  
      =  ((cols A) ! ?w) $ i"
       apply (auto)
       by (metis comp_apply h1 i_lt j_lt length_map mat_of_cols_index nth_map) 
     have h1a: "i < (length ?pp) \<Longrightarrow> (mat_of_cols (dim_row A) (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j) 
         = (1\<^sub>m (length (pivot_positions A))) $$ (i, j))"
     proof - 
       (* need to, using row_ech, rely heavily on pivot_fun_def, that num_cols \<ge> num_rows, and row_echelon form*)
       assume "i < (length ?pp)"
       have "\<exists>f. pivot_fun A f ?nc" using row_ech unfolding row_echelon_form_def
         by blast
       then obtain f where "pivot_fun A f ?nc"
         by blast
       have j_nc: "j < (length ?pp)" using j_lt
         by (simp add: h1) 
       then have j_lt_nr: "j < ?nr" using dim_h
         using len_lt by linarith 
       then have is_this_true: "(pivot_positions A) ! j = (j, f j)" 
         using pivot_positions_form pivot_positions(1)[of A ?nr ?nc f]
       proof -
         have "pivot_positions A ! j \<in> set (pivot_positions A)"
           using j_nc nth_mem by blast
         then have "\<exists>n. pivot_positions A ! j = (n, f n) \<and> n < dim_row A \<and> f n \<noteq> dim_col A"
           using \<open>\<lbrakk>A \<in> carrier_mat (dim_row A) (dim_col A); pivot_fun A f (dim_col A)\<rbrakk> \<Longrightarrow> set (pivot_positions A) = {(i, f i) |i. i < dim_row A \<and> f i \<noteq> dim_col A}\<close> \<open>pivot_fun A f (dim_col A)\<close> by blast
         then show ?thesis
           by (metis (no_types) \<open>\<And>A. \<lbrakk>row_echelon_form A; dim_row A \<le> dim_col A\<rbrakk> \<Longrightarrow> \<forall>i<length (pivot_positions A). fst (pivot_positions A ! i) = i\<close> dim_h fst_conv j_nc row_ech)
       qed
       then have w_is: "?w = f j"
         by (metis h1 j_lt nth_map snd_conv)
       have h0: "i = j \<longrightarrow> ((cols A) ! ?w) $ i = 1" using w_is pivot_funD(4)[of A ?nr f ?nc i]
         by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> \<open>i < length (pivot_positions A)\<close> \<open>pivot_fun A f (dim_col A)\<close> cols_length i_lt in_set_member length_asm mat_of_cols_cols mat_of_cols_index nth_mem)
       have h1:  "i \<noteq> j \<longrightarrow> ((cols A) ! ?w) $ i = 0" using w_is pivot_funD(5)
         by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> \<open>pivot_fun A f (dim_col A)\<close> cols_length h1 i_lt in_set_member j_lt len_lt length_asm less_le_trans mat_of_cols_cols mat_of_cols_index nth_mem)
       show "(mat_of_cols (dim_row A) (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j) 
         = (1\<^sub>m (length (pivot_positions A))) $$ (i, j))" using h0 h1 breaking_it_down
         by (metis \<open>i < length (pivot_positions A)\<close> h2 h_len index_one_mat(1) j_lt len_lt) 
     qed
     have h1b: "i \<ge> (length ?pp) \<Longrightarrow> (mat_of_cols (dim_row A) (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j)  = 0)"
     proof - 
       assume i_gt: "i \<ge> (length ?pp)"
       have h0a: "((cols A) ! ((map snd (pivot_positions A)) ! j)) $ i = (row A i) $ ?w"
         by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> cols_length h1 i_lt in_set_member index_row(1) j_lt length_asm mat_of_cols_cols mat_of_cols_index nth_mem)
       have h0b: 
         "take_rows A [0..<length (pivot_positions A)] @\<^sub>r 0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) = A"
         using assms row_echelon_form_zero_rows[of A]
         by blast 
       then have h0c: "(row A i) = 0\<^sub>v (dim_col A)"  using i_gt
-        using add_diff_cancel_right' add_less_cancel_left diff_is_0_eq' dim_col_take_rows dim_row_append_rows i_lt index_zero_mat(2) index_zero_mat(3) le_add_diff_inverse len_lt less_not_refl3 row_append_rows row_zero zero_less_diff
-        by (smt add_diff_cancel_right' add_less_cancel_left diff_is_0_eq' dim_col_take_rows dim_row_append_rows i_lt index_zero_mat(2) index_zero_mat(3) le_add_diff_inverse len_lt less_not_refl3 row_append_rows row_zero zero_less_diff) 
+        by (smt (verit, best) add_diff_cancel_left' add_diff_cancel_right' add_less_cancel_left dim_col_take_rows 
+            dim_row_append_rows i_lt index_zero_mat(2) index_zero_mat(3) le_Suc_ex len_lt nat_less_le nle_le row_append_rows row_zero)
       then show ?thesis using h0a breaking_it_down apply (auto)
         by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> h1 in_set_member index_zero_vec(1) j_lt length_asm nth_mem) 
     qed
     have h1: " mat_of_cols (dim_row A)
      (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j) =
            (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
             0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) $$
            (i, j) " using h1a h1b
-      apply (auto)
-      by (smt add_diff_inverse_nat add_less_cancel_left append_rows_index h1 i_lt index_one_mat(2) index_one_mat(3) index_zero_mat(1) index_zero_mat(2) index_zero_mat(3) j_lt len_lt not_less)  
+      by (smt (verit) add_diff_inverse_nat append_rows_index diff_less_mono h1 i_lt index_one_mat(2) index_one_mat(3) index_zero_mat(1) index_zero_mat(2) index_zero_mat(3) j_lt leD len_lt not_le_imp_less)
     then show "take_cols A (map snd (pivot_positions A)) $$ (i, j) =
            (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
             0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) $$
            (i, j)" 
       unfolding take_cols_def
       by (simp add: h2b)
   qed
   show ?thesis
     unfolding mat_eq_iff
     using length_pivot_positions_dim_row[OF assms(1)] h_len h2 by auto
 qed
 
 lemma rref_right_mul:
   assumes "row_echelon_form A"
   assumes "dim_col A \<ge> dim_row A"
   shows
     "take_cols A (map snd (pivot_positions A)) * take_rows A [0..<length (pivot_positions A)] = A"
 proof -
   from take_cols_pivot_eq[OF assms] have
     1: "take_cols A (map snd (pivot_positions A)) =
     1\<^sub>m (length (pivot_positions A)) @\<^sub>r
     0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))" .
   have 2: "take_cols A (map snd (pivot_positions A)) * take_rows A [0..<length (pivot_positions A)] =
     take_rows A [0..<length (pivot_positions A)]  @\<^sub>r 0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A)"
     unfolding 1
-    apply (auto simp add: append_rows_mat_mul)
-    by (smt add_diff_cancel_right' assms diff_diff_cancel dim_col_take_rows dim_row_append_rows index_zero_mat(2) left_mult_one_mat' left_mult_zero_mat' length_pivot_positions_dim_row row_echelon_form_zero_rows)   
-  from row_echelon_form_zero_rows[OF assms] have
-    "... = A" .
+    apply (simp add: append_rows_mat_mul)
+    by (metis (no_types, lifting) "1" add_right_imp_eq assms dim_col_take_rows dim_row_append_rows dim_row_take_cols index_one_mat(2) index_zero_mat(2) left_mult_one_mat' left_mult_zero_mat' row_echelon_form_zero_rows)
+  from row_echelon_form_zero_rows[OF assms] have "... = A" .
   thus ?thesis
     by (simp add: "2")
 qed
 
 context conjugatable_vec_space begin
 
 lemma lin_indpt_id:
   shows "lin_indpt (set (cols (1\<^sub>m n)::'a vec list))"
 proof -
   have *: "set (cols (1\<^sub>m n)) = set (rows (1\<^sub>m n))"
     by (metis cols_transpose transpose_one)
   have "det (1\<^sub>m n) \<noteq> 0" using det_one by auto
   from det_not_0_imp_lin_indpt_rows[OF _ this]
   have "lin_indpt (set (rows (1\<^sub>m n)))"
     using one_carrier_mat by blast
   thus ?thesis
     by (simp add: *) 
 qed
 
 lemma lin_indpt_take_cols_id:
   shows "lin_indpt (set (cols (take_cols (1\<^sub>m n) inds)))"
 proof - 
   have subset_h: "set (cols (take_cols (1\<^sub>m n) inds)) \<subseteq> set (cols (1\<^sub>m n)::'a vec list)"
     using cols_take_cols_subset by blast
   then show ?thesis using lin_indpt_id subset_li_is_li by auto
 qed
 
 lemma cols_id_unit_vecs:
   shows "cols (1\<^sub>m d) = unit_vecs d"
   unfolding unit_vecs_def list_eq_iff_nth_eq
   by auto
 
 lemma distinct_cols_id:
   shows "distinct (cols (1\<^sub>m d)::'a vec list)"
   by (simp add: conjugatable_vec_space.cols_id_unit_vecs vec_space.unit_vecs_distinct)
 
 lemma distinct_map_nth:
   assumes "distinct ls"
   assumes "distinct inds"
   assumes "\<And>j. j \<in> set inds \<Longrightarrow> j < length ls"
   shows "distinct (map ((!) ls) inds)"
   by (simp add: assms(1) assms(2) assms(3) distinct_map inj_on_nth)
 
 lemma distinct_take_cols_id:
   assumes "distinct inds"
   shows "distinct (cols (take_cols (1\<^sub>m n) inds) :: 'a vec list)"
   unfolding take_cols_def
   apply (subst cols_mat_of_cols)
    apply (auto intro!:  distinct_map_nth simp add: distinct_cols_id)
   using assms distinct_filter by blast
 
 lemma rank_take_cols:
   assumes "distinct inds"
   shows "rank (take_cols (1\<^sub>m n) inds) = length (filter ((>) n) inds)"
   apply (subst lin_indpt_full_rank[of _ "length (filter ((>) n) inds)"])
      apply (auto simp add: lin_indpt_take_cols_id)
    apply (metis (full_types) index_one_mat(2) index_one_mat(3) length_map mat_of_cols_carrier(1) take_cols_def)
   by (simp add: assms distinct_take_cols_id)
 
 lemma rank_mul_left_invertible_mat:
   fixes A::"'a mat"
   assumes "invertible_mat A"
   assumes "A \<in> carrier_mat n n"
   assumes "B \<in> carrier_mat n nc"
   shows "rank (A * B) = rank B"
 proof -
   obtain C where C: "inverts_mat A C" "inverts_mat C A"
     using assms invertible_mat_def by blast 
   from C have ceq: "C * A = 1\<^sub>m n"
     by (metis assms(2) carrier_matD(2) index_mult_mat(3) index_one_mat(3) inverts_mat_def)
   then have *:"B = C*A*B"
     using assms(3) by auto
   from rank_mat_mul_left[OF assms(2-3)]
   have **: "rank (A*B) \<le> rank B" .
   have 1: "C \<in> carrier_mat n n" using C ceq
     by (metis assms(2) carrier_matD(1) carrier_matI index_mult_mat(3) index_one_mat(3) inverts_mat_def) 
   have 2: "A * B \<in> carrier_mat n nc" using assms by auto  
   have "rank B = rank (C* A * B)" using * by auto
   also have "... \<le> rank (A*B)" using rank_mat_mul_left[OF 1 2]
     using "1" assms(2) assms(3) by auto
   ultimately show ?thesis using ** by auto
 qed
 
 lemma invertible_take_cols_rank:
   fixes A::"'a mat"
   assumes "invertible_mat A"
   assumes "A \<in> carrier_mat n n"
   assumes "distinct inds"
   shows "rank (take_cols A inds) = length (filter ((>) n) inds)"
 proof -
   have " A = A * 1\<^sub>m n" using assms(2) by auto
   then have "take_cols A inds = A * take_cols (1\<^sub>m n) inds"
     by (metis assms(2) one_carrier_mat take_cols_mat_mul)
   then have "rank (take_cols A inds) = rank (take_cols (1\<^sub>m n) inds)"
     by (metis assms(1) assms(2) conjugatable_vec_space.rank_mul_left_invertible_mat one_carrier_mat take_cols_carrier_mat)
   thus ?thesis
     by (simp add: assms(3) conjugatable_vec_space.rank_take_cols)
 qed
 
 lemma rank_take_cols_leq:
   assumes R:"R \<in> carrier_mat n nc"
   shows "rank (take_cols R ls) \<le> rank R"
 proof -
   from take_cols_mat_mul[OF R]
   have "take_cols R ls =  R * take_cols (1\<^sub>m nc) ls"
     by (metis assms one_carrier_mat right_mult_one_mat)
   thus ?thesis
     by (metis assms one_carrier_mat take_cols_carrier_mat vec_space.rank_mat_mul_right)
 qed
 
 lemma rank_take_cols_geq:
   assumes R:"R \<in> carrier_mat n nc"
   assumes t:"take_cols R ls \<in> carrier_mat n r"
   assumes B:"B \<in> carrier_mat r nc"
   assumes "R = (take_cols R ls) * B"
   shows "rank (take_cols R ls) \<ge> rank R"
   by (metis B assms(4) t vec_space.rank_mat_mul_right)
 
 lemma rref_drop_pivots:
   assumes row_ech: "row_echelon_form R"
   assumes dims: "R \<in> carrier_mat n nc"
   assumes order: "nc \<ge> n"
   shows "rank (take_cols R (map snd (pivot_positions R))) = rank R"
 proof -
   let ?B = "take_rows R [0..<length (pivot_positions R)]"
   have equa: "R = take_cols R (map snd (pivot_positions R)) * ?B" using assms rref_right_mul
     by (metis carrier_matD(1) carrier_matD(2))
   have ex_r: "\<exists>r. take_cols R (map snd (pivot_positions R)) \<in> carrier_mat n r \<and> ?B \<in> carrier_mat r nc"
   proof - 
     have h1:
       "take_cols R (map snd (pivot_positions R)) \<in> carrier_mat n (length (pivot_positions R))"
       using assms
       by (metis in_set_impl_in_set_zip2 length_map rref_pivot_positions take_cols_carrier_mat_strict zip_map_fst_snd)
     have "\<exists> f. pivot_fun R f nc" using row_ech unfolding row_echelon_form_def using dims
       by blast
     then have "length (pivot_positions R) = card {i. i < n \<and> row R i \<noteq> 0\<^sub>v nc}"
       using pivot_positions[of R n nc]
       using dims by auto 
     then have "nc \<ge> length (pivot_positions R)" using order
       using carrier_matD(1) dims dual_order.trans length_pivot_positions_dim_row row_ech by blast
     then have "dim_col R \<ge> length (pivot_positions R)" using dims by auto
     then have h2: "?B \<in> carrier_mat (length (pivot_positions R)) nc" unfolding take_rows_def
       using dims 
-      by (smt atLeastLessThan_iff carrier_matD(2) filter_True le_eq_less_or_eq length_map length_pivot_positions_dim_row less_trans map_nth mat_of_cols_carrier(1) row_ech set_upt transpose_carrier_mat transpose_mat_of_rows) 
+      by (smt (verit) atLeastLessThan_iff carrier_matD(2) filter_True le_eq_less_or_eq length_map 
+          length_pivot_positions_dim_row less_trans map_nth mat_of_cols_carrier(1) row_ech set_upt transpose_carrier_mat transpose_mat_of_rows) 
     show ?thesis using h1 h2
       by blast
   qed
     (* prove the other two dimensionality assumptions *)
   have "rank R  \<le> rank (take_cols R (map snd (pivot_positions R)))"
     using dims ex_r rank_take_cols_geq[where R = "R", where B = "?B", where ls = "(map snd (pivot_positions R))", where nc = "nc"]
     using equa by blast
   thus ?thesis
     using assms(2) conjugatable_vec_space.rank_take_cols_leq le_antisym by blast
 qed
 
 lemma gjs_and_take_cols_var:
   fixes A::"'a mat"
   assumes A:"A \<in> carrier_mat n nc"
   assumes order: "nc \<ge> n"
   shows "(take_cols A (map snd (pivot_positions (gauss_jordan_single A)))) = 
   (take_cols_var A (map snd (pivot_positions (gauss_jordan_single A))))"
 proof -
   let ?gjs = "(gauss_jordan_single A)"
   have "\<forall>x. List.member (map snd (pivot_positions (gauss_jordan_single A))) x \<longrightarrow> x \<le> dim_col A"  
     using rref_pivot_positions gauss_jordan_single(3) carrier_matD(2) gauss_jordan_single(2) in_set_impl_in_set_zip2 in_set_member length_map less_irrefl less_trans not_le_imp_less zip_map_fst_snd
-    by (smt A carrier_matD(2) gauss_jordan_single(2) in_set_impl_in_set_zip2 in_set_member length_map less_irrefl less_trans not_le_imp_less zip_map_fst_snd)
+    by (metis (no_types, lifting) carrier_mat_triv)
   then have "(filter (\<lambda>y. y < dim_col A) (map snd (pivot_positions (gauss_jordan_single A)))) = 
     (map snd (pivot_positions (gauss_jordan_single A)))"
     by (metis (no_types, lifting) A carrier_matD(2) filter_True gauss_jordan_single(2) gauss_jordan_single(3) in_set_impl_in_set_zip2 length_map rref_pivot_positions zip_map_fst_snd)
   then show ?thesis unfolding take_cols_def take_cols_var_def
     by simp
 qed
 
 lemma gauss_jordan_single_rank:
   fixes A::"'a mat"
   assumes A:"A \<in> carrier_mat n nc"
   assumes order: "nc \<ge> n"
   shows "rank (take_cols A (map snd (pivot_positions (gauss_jordan_single A)))) = rank A"
 proof -
   let ?R = "gauss_jordan_single A"
   obtain P where P:"P\<in>Units (ring_mat TYPE('a) n undefined)" and
     i: "?R = P * A" using gauss_jordan_transform[OF A]
-    using A assms det_mult det_non_zero_imp_unit det_one gauss_jordan_single(4) mult_not_zero one_neq_zero
-    by (smt A assms det_mult det_non_zero_imp_unit det_one gauss_jordan_single(4) mult_not_zero one_neq_zero)
+    by (metis A carrier_matD(1) fst_eqD gauss_jordan_single_def surj_pair zero_carrier_mat)
   have pcarrier: "P \<in> carrier_mat n n" using P unfolding Units_def
     by (auto simp add: ring_mat_def)
   have "invertible_mat P" using P unfolding invertible_mat_def Units_def inverts_mat_def
     apply auto
      apply (simp add: ring_mat_simps(5))
     by (metis index_mult_mat(2) index_one_mat(2) ring_mat_simps(1) ring_mat_simps(3))
   then
   obtain Pi where Pi: "invertible_mat Pi" "Pi * P = 1\<^sub>m n"
   proof -
     assume a1: "\<And>Pi. \<lbrakk>invertible_mat Pi; Pi * P = 1\<^sub>m n\<rbrakk> \<Longrightarrow> thesis"
     have "dim_row P = n"
       by (metis (no_types) A assms(1) carrier_matD(1) gauss_jordan_single(2) i index_mult_mat(2))
     then show ?thesis
       using a1 by (metis (no_types) \<open>invertible_mat P\<close> index_mult_mat(3) index_one_mat(3) invertible_mat_def inverts_mat_def square_mat.simps)
   qed
   then have pi_carrier:"Pi \<in> carrier_mat n n"
     by (metis carrier_mat_triv index_mult_mat(2) index_one_mat(2) invertible_mat_def square_mat.simps)
   have R1:"row_echelon_form ?R"
     using assms(2) gauss_jordan_single(3) by blast
   have R2: "?R \<in> carrier_mat n nc"
     using A assms(2) gauss_jordan_single(2) by auto
   have Rcm: "take_cols ?R (map snd (pivot_positions ?R))
     \<in> carrier_mat n (length (map snd (pivot_positions ?R)))"
     apply (rule take_cols_carrier_mat_strict[OF R2])
     using rref_pivot_positions[OF R1 R2] by auto
   have "Pi * ?R = A" using i Pi
-    by (smt A \<open>invertible_mat P\<close> assoc_mult_mat carrier_mat_triv index_mult_mat(2) index_mult_mat(3) index_one_mat(3) invertible_mat_def left_mult_one_mat square_mat.simps)
+    by (smt (verit, best) A assoc_mult_mat left_mult_one_mat pcarrier pi_carrier)
   then have "rank (take_cols A (map snd (pivot_positions ?R))) = rank (take_cols (Pi * ?R) (map snd (pivot_positions ?R)))"
     by auto
   also have "... = rank ( Pi * take_cols ?R (map snd (pivot_positions ?R)))"
     by (metis A gauss_jordan_single(2) pi_carrier take_cols_mat_mul)
   also have "... = rank (take_cols ?R (map snd (pivot_positions ?R)))"
     by (intro rank_mul_left_invertible_mat[OF Pi(1) pi_carrier Rcm])
   also have "... = rank ?R"
     using assms(2) conjugatable_vec_space.rref_drop_pivots gauss_jordan_single(3)
     using R1 R2 by blast
   ultimately show ?thesis                                                            
     using A \<open>P \<in> carrier_mat n n\<close> \<open>invertible_mat P\<close> conjugatable_vec_space.rank_mul_left_invertible_mat i
     by auto
 qed
 
 lemma lin_indpt_subset_cols:
   fixes A:: "'a mat"
   fixes B:: "'a vec set"
   assumes "A \<in> carrier_mat n n"
   assumes inv: "invertible_mat A"
   assumes "B \<subseteq> set (cols A)"
   shows "lin_indpt B"
 proof -
   have "det A \<noteq> 0"
     using assms(1) inv invertible_det by blast
   then have "lin_indpt (set (rows A\<^sup>T))"
     using assms(1) idom_vec.lin_dep_cols_imp_det_0 by auto
   thus ?thesis using subset_li_is_li assms(3)
     by auto
 qed
 
 lemma rank_invertible_subset_cols:
   fixes A:: "'a mat"
   fixes B:: "'a vec list"
   assumes inv: "invertible_mat A"
   assumes A_square: "A \<in> carrier_mat n n"
   assumes set_sub: "set (B) \<subseteq> set (cols A)"
   assumes dist_B: "distinct B"
   shows "rank (mat_of_cols n B) = length B"
 proof - 
   let ?B_mat = "(mat_of_cols n B)"
   have h1: "lin_indpt (set(B))" 
     using assms lin_indpt_subset_cols[of A] by auto
   have "set B \<subseteq> carrier_vec n"
     using set_sub A_square cols_dim[of A] by auto
   then have cols_B: "cols (mat_of_cols n B) = B" using cols_mat_of_cols by auto
   then have "maximal (set B) (\<lambda>T. T \<subseteq> set (B) \<and> lin_indpt T)" using h1
     by (simp add: maximal_def subset_antisym)
   then have h2: "maximal (set B) (\<lambda>T. T \<subseteq> set (cols (mat_of_cols n B)) \<and> lin_indpt T)"
     using cols_B by auto
   have h3: "rank (mat_of_cols n B) = card (set B)"
     using h1 h2 rank_card_indpt[of ?B_mat]
     using mat_of_cols_carrier(1) by blast 
   then show ?thesis using assms distinct_card by auto
 qed
 
 end
 
 end
\ No newline at end of file