diff --git a/thys/Smith_Normal_Form/Admits_SNF_From_Diagonal_Iff_Bezout_Ring.thy b/thys/Smith_Normal_Form/Admits_SNF_From_Diagonal_Iff_Bezout_Ring.thy
--- a/thys/Smith_Normal_Form/Admits_SNF_From_Diagonal_Iff_Bezout_Ring.thy
+++ b/thys/Smith_Normal_Form/Admits_SNF_From_Diagonal_Iff_Bezout_Ring.thy
@@ -1,893 +1,893 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Generality of the Algorithm to transform from diagonal to Smith normal form\<close>
 
 theory Admits_SNF_From_Diagonal_Iff_Bezout_Ring
   imports   
   Diagonal_To_Smith
   Rings2_Extended
   Smith_Normal_Form_JNF
   Finite_Field_Mod_Type_Connection
 begin
 
 hide_const (open) mat
 
 text \<open>This section provides a formal proof on the generality of the algorithm that transforms
 a diagonal matrix into its Smith normal form. More concretely, we prove that 
 all diagonal matrices with coefficients in a ring R admit Smith normal form if and only if
 R is a B\'ezout ring.
 
 Since our algorithm is defined for B\'ezout rings and for any matrices (including non-square and
 singular ones), this means that it does not exist another algorithm that performs the transformation
 in a more abstract structure.\<close>
 
 text \<open>Firstly, we hide some definitions and facts, since we are interested in the ones 
 developed for the @{text "mod_type"} class.\<close>
 
 hide_const (open) Bij_Nat.to_nat Bij_Nat.from_nat Countable.to_nat Countable.from_nat 
 hide_fact (open) Bij_Nat.to_nat_from_nat_id Bij_Nat.to_nat_less_card
 
 definition "admits_SNF_HA (A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}) = (isDiagonal A 
     \<longrightarrow> (\<exists>P Q. invertible ((P::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type})) 
         \<and> invertible (Q::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}) \<and> Smith_normal_form (P**A**Q)))"
 
 definition "admits_SNF_JNF A = (square_mat (A::'a::comm_ring_1 mat) \<and> isDiagonal_mat A 
   \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> Q \<in> carrier_mat (dim_row A) (dim_row A) 
     \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat (P*A*Q)))"
 
 
 subsection \<open>Proof of the  @{text "\<Longleftarrow>"} implication in HA.\<close>
 
 lemma exists_f_PAQ_Aii':
   fixes A::"'a::{comm_ring_1}^'n::{mod_type}^'n::{mod_type}"
   assumes diag_A: "isDiagonal A"
   shows "\<exists>f. (P**A**Q) $h i $h i = (\<Sum>i\<in>(UNIV::'n set). f i * A $h i $h i)" 
 proof -  
   have rw: "(\<Sum>ka\<in>UNIV. P $h i $h ka * A $h ka $h k) = P $h i $h k * A $h k $h k" for k
   proof -
     have "(\<Sum>ka\<in>UNIV. P $h i $h ka * A $h ka $h k) = (\<Sum>ka\<in>{k}. P $h i $h ka * A $h ka $h k)" 
     proof (rule sum.mono_neutral_right, auto)
       fix ia assume "P $h i $h ia * A $h ia $h k \<noteq> 0" 
       hence "A $h ia $h k \<noteq> 0" by auto
       thus" ia = k" using diag_A unfolding isDiagonal_def by auto  
     qed
     also have "... = P $h i $h k * A $h k $h k" by auto
     finally show ?thesis .
   qed
   let ?f = "\<lambda>k. (\<Sum>ka\<in>UNIV. P $h i $h ka) * Q $h k $h i"
   have "(P**A**Q) $h i $h i = (\<Sum>k\<in>UNIV. (\<Sum>ka\<in>UNIV. P $h i $h ka * A $h ka $h k) * Q $h k $h i)" 
     unfolding matrix_matrix_mult_def by auto  
   also have "... = (\<Sum>k\<in>UNIV.  P $h i $h k * Q $h k $h i * A $h k $h k)" 
     unfolding rw
     by (meson semiring_normalization_rules(16))
   finally show ?thesis by auto
 qed
 
 (*We would like to have the theorems within contexts:
 
 context semiring_1
 begin
 
 lemma foo1:
   fixes foo::"'a::type\<Rightarrow>'a\<Rightarrow>'a"
   shows "foo a = c"
   sorry
 
 end
 
 where 'a has simply type "type". This way, we could have 
 thm semiring_1.foo
 
 Which is: class.semiring_1 ?one ?times ?plus ?zero \<Longrightarrow> ?foo ?a = ?c
 
 However, many of them are proven with type restrictions instead of being proved within a context.
 For example:
 
 lemma foo2:
   fixes foo::"'a::semiring_1\<Rightarrow>'a\<Rightarrow>'a"
   shows "foo a = c" sorry
 
 To convert foo2 to a statement like foo1, we need interalize_sort developed in From Types to Sets.
 
 lemmas foo2 = foo1[internalize_sort "'a :: semiring_1"]
 *)
 
 text \<open>We apply @{text "internalize_sort"} to the lemma that we need\<close>
 
 lemmas diagonal_to_Smith_PQ_exists_internalize_sort 
   = diagonal_to_Smith_PQ_exists[internalize_sort "'a :: bezout_ring"]
 
 text \<open>We get the @{text "\<Longleftarrow>"} implication in HA.\<close>
 
 lemma bezout_ring_imp_diagonal_admits_SNF:
   assumes of: "OFCLASS('a::comm_ring_1, bezout_ring_class)"
   shows "\<forall>A::'a^'n::{mod_type}^'n::{mod_type}. isDiagonal A 
     \<longrightarrow> (\<exists>P Q. 
         invertible (P::'a^'n::mod_type^'n::mod_type) \<and> 
         invertible (Q::'a^'n::mod_type^'n::mod_type) \<and> 
         Smith_normal_form (P**A**Q))"
 proof (rule allI, rule impI)
   fix A::"'a^'n::{mod_type}^'n::{mod_type}"
   assume A: "isDiagonal A" 
   have br: "class.bezout_ring (*) (1::'a) (+) 0 (-) uminus" 
     by (rule OFCLASS_bezout_ring_imp_class_bezout_ring[OF of])   
   show "\<exists>P Q. 
         invertible (P::'a^'n::mod_type^'n::mod_type) \<and> 
         invertible (Q::'a^'n::mod_type^'n::mod_type) \<and> 
         Smith_normal_form (P**A**Q)" by (rule diagonal_to_Smith_PQ_exists_internalize_sort[OF br A])
 qed
 
 subsection \<open>Trying to prove the @{text "\<Longrightarrow>"} implication in HA.\<close>
 
 text\<open>There is a problem: we need to define a matrix with a concrete dimension, which is not 
   possible in HA (the dimension depends on the number of elements on a set, and Isabelle/HOL does
   not feature dependent types)\<close>
 
 lemma
   assumes "\<forall>A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}. admits_SNF_HA A"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)" oops
 
 (*
 lemma   
   assumes "\<forall>A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}. isDiagonal A 
     \<longrightarrow> (\<exists>P Q. invertible P \<and> invertible Q \<and> Smith_normal_form (P**A**Q))"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (rule all_fin_gen_ideals_are_principal_imp_bezout, rule allI, rule impI)
   fix I::"'a set"
   assume fin: "finitely_generated_ideal I"
   obtain S where ig_S: "ideal_generated S = I" and fin_S: "finite S" 
     using fin unfolding finitely_generated_ideal_def by auto
   obtain xs where set_xs: "set xs = S" and d: "distinct xs" 
     using finite_distinct_list[OF fin_S] by blast
   hence length_eq_card: "length xs = card S" using distinct_card by force
 (*
   The proof requires:
   1) Obtain a matrix A whose diagonal entries are the elements of xs
   2) Transform such a matrix A into its Smith normal form by means of elementary operations
   3) Put the diagonal entries of the matrix in Smith normal form as a list ys.
   4) Proof that the first element of ys divides all the other elements of such a list.
   5) Show that, ideal_generated (set xs) = ideal_generated (set ys) = ideal_generated (ys!0).
 *)
   show "principal_ideal I"
 
 qed
 
 (*Alternative statement (same problems)*)
 
 lemma   
   assumes "\<forall>A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}. admits_SNF_HA A"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)" oops
 *)
 
 
 subsection \<open>Proof of the  @{text "\<Longrightarrow>"}  implication in JNF.\<close>
 
 lemma exists_f_PAQ_Aii:
   assumes diag_A: "isDiagonal_mat (A::'a:: comm_ring_1 mat)" 
     and P: "P \<in> carrier_mat n n" 
     and A: "A \<in> carrier_mat n n" 
     and Q: "Q \<in> carrier_mat n n" 
     and i: "i < n" 
   (*  and d: "distinct (diag_mat A)" (*With some work, this assumption can be removed.*)*)
   shows "\<exists>f. (P*A*Q) $$ (i, i) = (\<Sum>i\<in>set (diag_mat A). f i * i)" 
 proof -
   let ?xs = "diag_mat A"
   let ?n = "length ?xs"
   have length_n: "length (diag_mat A) = n"
     by (metis A carrier_matD(1) diag_mat_def diff_zero length_map length_upt)
   have xs_index: "?xs ! i = A $$ (i, i)" if "i<n" for i
     by (metis (no_types, lifting) add.left_neutral diag_mat_def length_map 
         length_n length_upt nth_map_upt that)
   have i_length: "i<length ?xs" using i length_n by auto
   have rw: "(\<Sum>ka = 0..<?n. P $$ (i, ka) * A $$ (ka, k)) = P $$(i, k) * A $$ (k, k)" 
     if k: "k<length ?xs" for k
   proof -
     have "(\<Sum>ka= 0..<?n. P $$ (i, ka) * A $$ (ka, k)) = (\<Sum>ka\<in>{k}. P $$ (i, ka) * A $$ (ka, k))" 
       by (rule sum.mono_neutral_right, auto simp add: k, 
           insert diag_A A length_n that, unfold isDiagonal_mat_def, fastforce)            
     also have "... = P $$(i, k) * A $$ (k, k)" by auto
     finally show ?thesis .
   qed
   let ?positions_of ="\<lambda>x. {i. A$$(i,i) = x \<and> i<length ?xs}"
   let ?T="set ?xs"
   let ?S ="{0..<?n}"
   let ?f = "\<lambda>x.(\<Sum>k\<in>{i. A $$ (i, i) = x \<and> i < length (diag_mat A)}. P $$ (i, k) * Q $$ (k, i))"
   let ?g = "(\<lambda>k. P $$ (i,k) * Q $$ (k, i) * A $$ (k, k))"
   have UNION_positions_of: "\<Union>(?positions_of ` ?T) = ?S" unfolding diag_mat_def by auto
   have "(P*A*Q) $$ (i,i) = (\<Sum>ia = 0..<?n.
         Matrix.row (Matrix.mat ?n ?n (\<lambda>(i, j). \<Sum>ia = 0..<?n. 
         Matrix.row P i $v ia * col A j $v ia)) i $v ia * col Q i $v ia)" 
     unfolding times_mat_def scalar_prod_def 
     using P Q i_length length_n A by auto
   also have "... = (\<Sum>k = 0..<?n. (\<Sum>ka = 0..<?n. P$$(i,ka) * A$$(ka,k)) * Q $$ (k,i))"
   proof (rule sum.cong, auto)
     fix x assume x: "x < length ?xs" 
     have rw_colQ: "col Q i $v x = Q $$ (x, i)"
       using Q i_length x length_n A by auto
     have rw2: " Matrix.row (Matrix.mat ?n ?n
             (\<lambda>(i, j). \<Sum>ia = 0..<length ?xs. Matrix.row P i $v ia * col A j $v ia)) i $v x 
             =(\<Sum>ia = 0..<length ?xs. Matrix.row P i $v ia * col A x $v ia)"
       unfolding row_mat[OF i_length] unfolding index_vec[OF x] by auto
     also have "... = (\<Sum>ia = 0..<length ?xs.  P $$ (i,ia) * A $$ (ia,x))" 
       by (rule sum.cong, insert P i_length x length_n A, auto)
     finally show "Matrix.row (Matrix.mat ?n ?n (\<lambda>(i, j). \<Sum>ia = 0..<?n. Matrix.row P i $v ia 
             * col A j $v ia)) i $v x * col Q i $v x 
             = (\<Sum>ka = 0..<?n. P $$ (i, ka) * A $$ (ka, x)) * Q $$ (x, i)" unfolding rw_colQ by auto
   qed       
   also have "... = (\<Sum>k = 0..<?n. P $$ (i,k) * Q $$ (k, i) * A $$ (k, k))"
-    by (smt rw semiring_normalization_rules(16) sum.ivl_cong)
+    by (smt (verit) rw semiring_normalization_rules(16) sum.ivl_cong)
   also have "... = sum ?g (\<Union>(?positions_of ` ?T))" 
     using UNION_positions_of by auto
   also have "... = (\<Sum>x\<in>?T. sum ?g (?positions_of x))"
     by (rule sum.UNION_disjoint, auto)
   also have "... = (\<Sum>x\<in>set (diag_mat A). (\<Sum>k\<in>{i. A $$ (i, i) = x \<and> i < length (diag_mat A)}. 
     P $$ (i, k) * Q $$ (k, i)) * x)"
     by (rule sum.cong, auto simp add: Groups_Big.sum_distrib_right)  
   finally show ?thesis by auto
 qed
 
 text \<open>Proof of the @{text "\<Longrightarrow>"} implication in JNF.\<close>
 
 lemma diagonal_admits_SNF_imp_bezout_ring_JNF:
   assumes admits_SNF: "\<forall>A n. (A::'a mat) \<in> carrier_mat n n \<and> isDiagonal_mat A
   \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat n n \<and> Q \<in> carrier_mat n n \<and> invertible_mat P \<and> invertible_mat Q 
       \<and> Smith_normal_form_mat (P*A*Q))"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (rule all_fin_gen_ideals_are_principal_imp_bezout, rule allI, rule impI)
   fix I::"'a set"
   assume fin: "finitely_generated_ideal I"
   obtain S where ig_S: "ideal_generated S = I" and fin_S: "finite S" 
     using fin unfolding finitely_generated_ideal_def by auto
   show "principal_ideal I"
   proof (cases "S = {}")
     case True
     then show ?thesis
       by (metis ideal_generated_0 ideal_generated_empty ig_S principal_ideal_def)
   next
     case False    
     obtain xs where set_xs: "set xs = S" and d: "distinct xs" 
       using finite_distinct_list[OF fin_S] by blast
     hence length_eq_card: "length xs = card S" using distinct_card by force
     let ?n = "length xs"
     let ?A = "Matrix.mat ?n ?n (\<lambda>(a,b). if a = b then xs!a else 0)"
     have A_carrier: "?A \<in> carrier_mat ?n ?n" by auto
     have diag_A: "isDiagonal_mat ?A" unfolding isDiagonal_mat_def by auto
     have set_xs_eq: "set xs = {?A$$(i,i)| i. i<dim_row ?A}"
-      by (auto, smt case_prod_conv d distinct_Ex1 index_mat(1))
+      by (auto, smt (verit) case_prod_conv d distinct_Ex1 index_mat(1))
     have set_xs_diag_mat: "set xs = set (diag_mat ?A)" 
       using set_xs_eq unfolding diag_mat_def by auto
     obtain P Q where P: "P \<in> carrier_mat ?n ?n" 
       and Q: "Q \<in> carrier_mat ?n ?n" and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q"
       and SNF_PAQ: "Smith_normal_form_mat (P*?A*Q)" 
       using admits_SNF A_carrier diag_A by blast
     define ys where ys_def: "ys = diag_mat (P*?A*Q)" 
     have ys: "\<forall>i<?n. ys ! i = (P*?A*Q) $$ (i,i)" using P by (auto simp add: ys_def diag_mat_def)
     have length_ys: "length ys = ?n" unfolding ys_def
       by (metis (no_types, lifting) P carrier_matD(1) diag_mat_def 
           index_mult_mat(2) length_map map_nth)    
     have n0: "?n > 0" using False set_xs by blast
     have set_ys_diag_mat: "set ys = set (diag_mat (P*?A*Q))" using ys_def by auto
     let ?i = "ys ! 0"
     have dvd_all: "\<forall>a \<in> set ys. ?i dvd a"
     proof    
       fix a assume a: "a \<in> set ys"
       obtain j where ys_j_a: "ys ! j = a" and jn: "j<?n" by (metis a in_set_conv_nth length_ys) 
       have jP: "j < dim_row P" using jn P by auto
       have jQ: "j < dim_col Q" using jn Q by auto
       have "(P*?A*Q)$$(0,0) dvd (P*?A*Q)$$(j,j)"
         by (rule SNF_first_divides[OF SNF_PAQ], auto simp add: jP jQ)
       thus "ys ! 0 dvd a" using ys length_ys ys_j_a jn n0 by auto
     qed
     have "ideal_generated S = ideal_generated (set xs)" using set_xs by simp
     also have "... = ideal_generated (set ys)"
     proof
       show "ideal_generated (set xs) \<subseteq> ideal_generated (set ys)"
       proof (rule ideal_generated_subset2, rule ballI)
         fix b assume b: "b \<in> set xs"
         obtain i where b_A_ii: "b = ?A $$ (i,i)" and i_length: "i<length xs" 
           using b set_xs_eq by auto
         obtain P' where inverts_mat_P': "inverts_mat P P' \<and> inverts_mat P' P" 
           using inv_P unfolding invertible_mat_def by auto
         have P': "P' \<in> carrier_mat ?n ?n" 
           using inverts_mat_P' 
           unfolding carrier_mat_def inverts_mat_def
           by (auto,metis P carrier_matD index_mult_mat(3) one_carrier_mat)+
         obtain Q' where inverts_mat_Q': "inverts_mat Q Q' \<and> inverts_mat Q' Q"
           using inv_Q unfolding invertible_mat_def by auto
         have Q': "Q' \<in> carrier_mat ?n ?n" 
           using inverts_mat_Q'
           unfolding carrier_mat_def inverts_mat_def
           by (auto,metis Q carrier_matD index_mult_mat(3) one_carrier_mat)+
         have rw_PAQ: "(P'*(P*?A*Q)*Q') $$ (i, i) = ?A $$ (i,i)"
           using inv_P'PAQQ'[OF A_carrier P _ _ Q P' Q'] inverts_mat_P' inverts_mat_Q' by auto
         have diag_PAQ: "isDiagonal_mat (P*?A*Q)" 
           using SNF_PAQ unfolding Smith_normal_form_mat_def by auto
         have PAQ_carrier: "(P*?A*Q) \<in> carrier_mat ?n ?n" using P Q by auto
         obtain f where f: "(P'*(P*?A*Q)*Q') $$ (i, i) = (\<Sum>i\<in>set (diag_mat (P*?A*Q)). f i * i)"
           using exists_f_PAQ_Aii[OF diag_PAQ P' PAQ_carrier Q' i_length] by auto
         hence "?A $$ (i,i) = (\<Sum>i\<in>set (diag_mat (P*?A*Q)). f i * i)" unfolding rw_PAQ .
         thus "b\<in> ideal_generated (set ys)"
           unfolding ideal_explicit using set_ys_diag_mat b_A_ii by auto
       qed      
       show "ideal_generated (set ys) \<subseteq> ideal_generated (set xs)"
       proof (rule ideal_generated_subset2, rule ballI)
         fix b assume b: "b \<in> set ys"
         have d: "distinct (diag_mat ?A)"
           by (metis (no_types, lifting) A_carrier card_distinct carrier_matD(1) diag_mat_def 
              length_eq_card length_map map_nth set_xs set_xs_diag_mat)
         obtain i where b_PAQ_ii: "(P*?A*Q) $$ (i,i) = b" and i_length: "i<length xs" using b ys
           by (metis (no_types, lifting) in_set_conv_nth length_ys)
         obtain f where "(P * ?A * Q) $$ (i, i) = (\<Sum>i\<in>set (diag_mat ?A). f i * i)" 
           using exists_f_PAQ_Aii[OF diag_A P _ Q i_length] by auto
         thus "b \<in> ideal_generated (set xs)" 
           using b_PAQ_ii unfolding set_xs_diag_mat ideal_explicit by auto
       qed
     qed
     also have "... = ideal_generated (set ys - (set ys - {ys!0}))"
     proof (rule ideal_generated_dvd_eq_diff_set)
       show "?i \<in> set ys" using n0
         by (simp add: length_ys)
       show "?i \<notin> set ys - {?i}" by auto
       show "\<forall>j\<in>set ys - {?i}. ?i dvd j" using dvd_all by auto 
       show "finite (set ys - {?i})" by auto
     qed
     also have "... = ideal_generated {?i}"
       by (metis Diff_cancel Diff_not_in insert_Diff insert_Diff_if length_ys n0 nth_mem)
     finally show "principal_ideal I" unfolding principal_ideal_def using ig_S by auto
   qed
 qed
 
 
 
 (*Alternative statement:*)
 corollary diagonal_admits_SNF_imp_bezout_ring_JNF_alt:
   assumes admits_SNF: "\<forall>A. square_mat (A::'a mat) \<and> isDiagonal_mat A 
 \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat (dim_row A) (dim_row A) 
   \<and> Q \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> invertible_mat Q 
   \<and> Smith_normal_form_mat (P*A*Q))"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (rule diagonal_admits_SNF_imp_bezout_ring_JNF, rule allI, rule allI, rule impI)
   fix A::"'a mat" and n assume A: "A \<in> carrier_mat n n \<and> isDiagonal_mat A"
   have "square_mat A" using A by auto
   thus "\<exists>P Q. P \<in> carrier_mat n n \<and> Q \<in> carrier_mat n n 
   \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat (P * A * Q)" 
     using A admits_SNF by blast
 qed
 
 
 subsection \<open>Trying to transfer the @{text "\<Longrightarrow>"} implication to HA.\<close>
 
 text \<open>We first hide some constants defined in @{text "Mod_Type_Connect"} in order to use the ones
 presented in @{text "Perron_Frobenius.HMA_Connect"} by default.\<close>
 
 
 context 
   includes lifting_syntax
 begin
 
 lemma to_nat_mod_type_Bij_Nat:
   fixes a::"'n::mod_type"
   obtains b::'n where "mod_type_class.to_nat a = Bij_Nat.to_nat b"
   using Bij_Nat.to_nat_from_nat_id mod_type_class.to_nat_less_card by metis
 
 lemma inj_on_Bij_nat_from_nat: "inj_on (Bij_Nat.from_nat::nat \<Rightarrow> 'a) {0..<CARD('a::finite)}"  
   by (auto simp add: inj_on_def Bij_Nat.from_nat_def length_univ_list_card 
       nth_eq_iff_index_eq univ_list(1))
 
 text \<open>This lemma only holds if $a$ and $b$ have the same type. Otherwise, 
   it is possible that @{text "Bij_Nat.to_nat a = Bij_Nat.to_nat b"}\<close>
 
 lemma Bij_Nat_to_nat_neq:
   fixes a b ::"'n::mod_type"
   assumes "to_nat a \<noteq> to_nat b"
   shows "Bij_Nat.to_nat a \<noteq> Bij_Nat.to_nat b"  
   using assms to_nat_inj by blast
 
 text \<open>The following proof (a transfer rule for diagonal matrices) 
   is weird, since it does not hold 
   @{text "Bij_Nat.to_nat a = mod_type_class.to_nat a"}. 
 
   At first, it seems possible to obtain the element $a'$ that satisfies 
    @{text "Bij_Nat.to_nat a' = mod_type_class.to_nat a"} and then continue with the proof, but then
   we cannot prove @{text "HMA_I (Bij_Nat.to_nat a') a"}.
 
   This means that we must use the previous lemma @{text "Bij_Nat_to_nat_neq"}, but this imposes the 
   matrix to be square.
   \<close>
 
 lemma HMA_isDiagonal[transfer_rule]: "(HMA_M ===> (=)) 
   isDiagonal_mat (isDiagonal::('a::{zero}^'n::{mod_type}^'n::{mod_type} => bool))"
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note rel_xy [transfer_rule] = "1"
   have "y $h a $h b = 0"
     if all0: "\<forall>i j. i \<noteq> j \<and> i < dim_row x \<and> j < dim_col x \<longrightarrow> x $$ (i, j) = 0"
       and a_noteq_b: "a \<noteq> b" for a::'n and b::'n
   proof -
     have "to_nat a \<noteq> to_nat b" using a_noteq_b by auto
     hence distinct: "Bij_Nat.to_nat a \<noteq> Bij_Nat.to_nat b" by (rule Bij_Nat_to_nat_neq)
     moreover have "Bij_Nat.to_nat a < dim_row x" and "Bij_Nat.to_nat b < dim_col x"
       using Bij_Nat.to_nat_less_card dim_row_transfer_rule rel_xy dim_col_transfer_rule 
       by fastforce+
     ultimately have b: "x $$ (Bij_Nat.to_nat a, Bij_Nat.to_nat b) = 0" using all0 by auto
     have [transfer_rule]: "HMA_I (Bij_Nat.to_nat a) a" by (simp add: HMA_I_def)
     have [transfer_rule]: "HMA_I (Bij_Nat.to_nat b) b" by (simp add: HMA_I_def)
     have "index_hma y a b = 0" using b by (transfer', auto)
     thus ?thesis unfolding index_hma_def .
   qed
   moreover have "x $$ (i, j) = 0" 
     if all0: "\<forall>a b. a \<noteq> b \<longrightarrow> y $h a $h b = 0"
       and ij: "i \<noteq> j" and i: "i < dim_row x" and j: "j < dim_col x" for i j
   proof -
     have i_n: "i < CARD('n)" and j_n: "j < CARD('n)"
       using i j rel_xy dim_row_transfer_rule dim_col_transfer_rule
       by fastforce+
     let ?i' = "Bij_Nat.from_nat i::'n"
     let ?j' = "Bij_Nat.from_nat j::'n"
     have i'_neq_j': "?i' \<noteq> ?j'" using ij i_n j_n Bij_Nat.from_nat_inj by blast
     hence y0: "index_hma y ?i' ?j' = 0" using all0 unfolding index_hma_def by auto    
     have [transfer_rule]: "HMA_I i ?i'" unfolding HMA_I_def
       by (simp add: Bij_Nat.to_nat_from_nat_id i_n)
     have [transfer_rule]: "HMA_I j ?j'" unfolding HMA_I_def
       by (simp add: Bij_Nat.to_nat_from_nat_id j_n)
     show ?thesis using y0 by (transfer, auto)
   qed
   ultimately show ?case unfolding isDiagonal_mat_def isDiagonal_def
     by auto
 qed
 
 text \<open>Indeed, we can prove the transfer rules with the new connection based on the 
   @{text "mod_type"} class, which was developed in the  @{text "Mod_Type_Connect"} file\<close>
 
 text \<open>This is the same lemma as the one presented above, but now using the @{text "to_nat"} function
   defined in the  @{text "mod_type"} class and then we can prove it for non-square matrices, 
   which is very useful since our algorithms are not restricted to square matrices.\<close>
 
 
 lemma HMA_isDiagonal_Mod_Type[transfer_rule]: "(Mod_Type_Connect.HMA_M ===> (=)) 
   isDiagonal_mat (isDiagonal::('a::{zero}^'n::{mod_type}^'m::{mod_type} => bool))"
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note rel_xy [transfer_rule] = "1"
   have "y $h a $h b = 0"
     if all0: "\<forall>i j. i \<noteq> j \<and> i < dim_row x \<and> j < dim_col x \<longrightarrow> x $$ (i, j) = 0"
       and a_noteq_b: "to_nat a \<noteq> to_nat b" for a::'m and b::'n
   proof -
     have distinct: "to_nat a \<noteq> to_nat b" using a_noteq_b by auto
     moreover have "to_nat a < dim_row x" and "to_nat b < dim_col x"
       using to_nat_less_card rel_xy 
       using Mod_Type_Connect.dim_row_transfer_rule Mod_Type_Connect.dim_col_transfer_rule 
       by fastforce+
     ultimately have b: "x $$ (to_nat a, to_nat b) = 0" using all0 by auto
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (to_nat a) a" 
       by (simp add: Mod_Type_Connect.HMA_I_def)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (to_nat b) b" 
       by (simp add: Mod_Type_Connect.HMA_I_def)
     have "index_hma y a b = 0" using b by (transfer', auto)
     thus ?thesis unfolding index_hma_def .
   qed
   moreover have "x $$ (i, j) = 0" 
     if all0: "\<forall>a b. to_nat a \<noteq> to_nat b \<longrightarrow> y $h a $h b = 0"
       and ij: "i \<noteq> j" and i: "i < dim_row x" and j: "j < dim_col x" for i j
   proof -
     have i_n: "i < CARD('m)"
       using i rel_xy by (simp add: Mod_Type_Connect.dim_row_transfer_rule)
     have j_n: "j < CARD('n)"
       using j rel_xy by (simp add: Mod_Type_Connect.dim_col_transfer_rule)
     let ?i' = "from_nat i::'m"
     let ?j' = "from_nat j::'n"
     have "to_nat ?i' \<noteq> to_nat ?j'"
       by (simp add: i_n ij j_n mod_type_class.to_nat_from_nat_id)
     hence y0: "index_hma y ?i' ?j' = 0" using all0 unfolding index_hma_def by auto
     have [transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'" 
       unfolding Mod_Type_Connect.HMA_I_def
       by (simp add: to_nat_from_nat_id i_n)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" 
       unfolding Mod_Type_Connect.HMA_I_def
       by (simp add: to_nat_from_nat_id j_n)
     show ?thesis using y0 by (transfer, auto)
   qed
   ultimately show ?case unfolding isDiagonal_mat_def isDiagonal_def
     by auto
 qed
 
 
 (*We cannot state:
 
  lemma HMA_SNF[transfer_rule]: "(HMA_M ===> (=)) Smith_normal_form_mat
   (Smith_normal_form::'a::{comm_ring_1}^'n::{mod_type}^'n::{mod_type}\<Rightarrow>bool)"
 
 Since we need properties about Suc (Bij_Nat.to_nat a). This means that is mandatory to use
 a bridge that relates the JNF representation with the HA one based on indexes with the mod_type
 class restriction. This is carried out in the file Mod_Type_Connect.
 
 Otherwise, I cannot relate 
 
 x $$ (to_nat a, to_nat a) dvd x $$ (to_nat (a + 1), to_nat (a + 1))
 
 with
 
 y $h a $h a dvd y $h (a + 1) $h (a + 1) 
 
 being such to_nat the one presented in Mod_Type, which is not the same as Bij_Nat.to_nat 
 (mod_type_class.to_nat satisfies more properties that easier the definitions and proofs, 
 and indeed are fundamental for defining the Smith normal form).
 *)
 
 text\<open>We state the transfer rule using the relations developed in the new bride of the file
     @{text "Mod_Type_Connect"}.\<close>
 
 lemma HMA_SNF[transfer_rule]: "(Mod_Type_Connect.HMA_M ===> (=)) Smith_normal_form_mat 
 (Smith_normal_form::'a::{comm_ring_1}^'n::{mod_type}^'m::{mod_type}\<Rightarrow>bool)"
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note rel_xy[transfer_rule] = "1"
   have "y $h a $h b dvd y $h (a + 1) $h (b + 1)"
     if SNF_condition: "\<forall>a. Suc a < dim_row x \<and> Suc a < dim_col x 
       \<longrightarrow> x $$ (a, a) dvd x $$ (Suc a, Suc a)"
       and a1: "Suc (to_nat a) < nrows y" and a2: "Suc (to_nat b) < ncols y"
       and ab: "to_nat a = to_nat b" for a::'m and b::'n      
   proof -
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (to_nat a) a" 
       by (simp add: Mod_Type_Connect.HMA_I_def)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (to_nat (a+1)) (a+1)" 
       by (simp add: Mod_Type_Connect.HMA_I_def)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (to_nat b) b" 
       by (simp add: Mod_Type_Connect.HMA_I_def)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (to_nat (b+1)) (b+1)" 
       by (simp add: Mod_Type_Connect.HMA_I_def)
     have "Suc (to_nat a) < dim_row x" using a1
       by (metis Mod_Type_Connect.dim_row_transfer_rule nrows_def rel_xy)    
     moreover have "Suc (to_nat b) < dim_col x"
       by (metis Mod_Type_Connect.dim_col_transfer_rule a2 ncols_def rel_xy)
     ultimately have "x $$ (to_nat a, to_nat b) dvd x $$ (Suc (to_nat a), Suc (to_nat b))"
       using SNF_condition by (simp add: ab)
     also have "... = x $$ (to_nat (a+1), to_nat (b+1))"
       by (metis Suc_eq_plus1 a1 a2 nrows_def ncols_def to_nat_suc)
     finally have SNF_cond: "x $$ (to_nat a, to_nat b) dvd x $$ (to_nat (a + 1), to_nat (b + 1))" .    
     have "x $$ (to_nat a, to_nat b) = index_hma y a b" by (transfer, simp)
     moreover have "x $$ (to_nat (a + 1), to_nat (b + 1)) = index_hma y (a+1) (b+1)"
       by (transfer, simp)
     ultimately show ?thesis using SNF_cond unfolding index_hma_def by auto
   qed
   moreover have  "x $$ (a, a) dvd x $$ (Suc a, Suc a)"
     if SNF: "\<forall>a b. to_nat a = to_nat b \<and> Suc (to_nat a) < nrows y \<and> Suc (to_nat b) < ncols y
         \<longrightarrow> y $h a $h b dvd y $h (a + 1) $h (b + 1)" 
       and a1: "Suc a < dim_row x" and a2: "Suc a < dim_col x" for a
   proof -
     have dim_row_CARD: "dim_row x = CARD('m)"
       using Mod_Type_Connect.dim_row_transfer_rule rel_xy by blast
     have dim_col_CARD: "dim_col x = CARD('n)"
       using Mod_Type_Connect.dim_col_transfer_rule rel_xy by blast
     let ?a' = "from_nat a::'m"
     let ?b' = "from_nat a::'n"
     have Suc_a_less_CARD: "a + 1 < CARD('m)" using a1 dim_row_CARD by auto
     have Suc_b_less_CARD: "a + 1 < CARD('n)" using a2
       by (metis Mod_Type_Connect.dim_col_transfer_rule Suc_eq_plus1 rel_xy)
     have aa'[transfer_rule]: "Mod_Type_Connect.HMA_I a ?a'"
       unfolding Mod_Type_Connect.HMA_I_def
       by (metis Suc_a_less_CARD add_lessD1 mod_type_class.to_nat_from_nat_id)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (a+1) (?a' + 1)" 
       unfolding Mod_Type_Connect.HMA_I_def
       unfolding from_nat_suc[symmetric] using to_nat_from_nat_id[OF Suc_a_less_CARD] by auto
     have ab'[transfer_rule]: "Mod_Type_Connect.HMA_I a ?b'"
       unfolding Mod_Type_Connect.HMA_I_def 
       by (metis Suc_b_less_CARD add_lessD1 mod_type_class.to_nat_from_nat_id)
     have [transfer_rule]: "Mod_Type_Connect.HMA_I (a+1) (?b' + 1)" 
       unfolding Mod_Type_Connect.HMA_I_def
       unfolding from_nat_suc[symmetric] using to_nat_from_nat_id[OF Suc_b_less_CARD] by auto      
     have aa'1: "a = to_nat ?a'" using aa' by (simp add: Mod_Type_Connect.HMA_I_def)
     have ab'1: "a = to_nat ?b'" using ab' by (simp add: Mod_Type_Connect.HMA_I_def)
     have "Suc (to_nat ?a') < nrows y" using a1 dim_row_CARD
       by (simp add: mod_type_class.to_nat_from_nat_id nrows_def)
     moreover have "Suc (to_nat ?b') < ncols y" using a2 dim_col_CARD
       by (simp add: mod_type_class.to_nat_from_nat_id ncols_def)
     ultimately have SNF': "y $h ?a' $h ?b' dvd y $h (?a' + 1) $h (?b' + 1)" 
       using SNF ab'1 aa'1 by auto    
      have "index_hma y ?a' ?b' = x $$ (a, a)" by (transfer, simp)
      moreover have "index_hma y (?a'+1) (?b'+1) = x $$ (a+1, a+1)" by (transfer, simp)
      ultimately show ?thesis using SNF' unfolding index_hma_def by auto
   qed
   ultimately show ?case unfolding Smith_normal_form_mat_def Smith_normal_form_def
     using rel_xy by (auto) (transfer', auto)+
 qed
 
 
 
 lemma HMA_admits_SNF [transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n::{mod_type} ^ 'n::{mod_type} \<Rightarrow> _) ===> (=)) 
   admits_SNF_JNF admits_SNF_HA"
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note [transfer_rule] = this
   hence id: "dim_row x = CARD('n)" by (auto simp: Mod_Type_Connect.HMA_M_def)
   then show ?case unfolding admits_SNF_JNF_def admits_SNF_HA_def 
     by (transfer, auto, metis "1" Mod_Type_Connect.dim_col_transfer_rule)
 qed  
 end
 
 
 
 (*If the following result holds, then I will get the result.
   
   But the theorem is false, since the assumption fixes the type 'n (within the proof is not 
   arbitrary any more). We cannot quantify over type variables in Isabelle/HOL.*)
 
 (*
 lemma diagonal_admits_SNF_imp_bezout_ring_JNF3:
   assumes admits_SNF: "\<forall>A. (A::'a mat) \<in> carrier_mat (CARD('n)) (CARD('n)) \<and> isDiagonal_mat A 
 \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat (dim_row A) (dim_row A) 
   \<and> Q \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> invertible_mat Q 
   \<and> Smith_normal_form_mat (P*A*Q))"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)" 
   apply (rule diagonal_admits_SNF_imp_bezout_ring_JNF, auto)
 *)
 
 
 text\<open>Here we have a problem when trying to apply local type definitions\<close>
 (*
 Once the assumption is translated to JNF, we get that it holds for all matrices with 
 CARD('n) rows and CARD('n) columns. That is, we do not have the result for any matrix, just 
 for matrices of such dimensions (within the proof, the type 'n is not arbitrary, is fixed).
 *)
 lemma diagonal_admits_SNF_imp_bezout_ring:
   assumes admits_SNF: "\<forall>A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}. isDiagonal A 
     \<longrightarrow> (\<exists>P Q. invertible (P::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}) 
         \<and> invertible (Q::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}) 
         \<and> Smith_normal_form (P**A**Q))"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (rule diagonal_admits_SNF_imp_bezout_ring_JNF, auto)
   fix A::"'a mat" and n 
     assume A: "A \<in> carrier_mat n n" and diag_A: "isDiagonal_mat A"           
   have a: "\<forall>A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type}. admits_SNF_HA A" 
     using admits_SNF unfolding admits_SNF_HA_def .
   have JNF: "\<forall>(A::'a mat)\<in> carrier_mat CARD('n) CARD('n). admits_SNF_JNF A" 
   (*We can get this result, but this does not imply that it holds for any n \<times> n matrix, just 
     for the concrete case that n = CARD('n). Within this proof, we cannot apply local type 
     definitions, since the 'n is not an schematic variable any more, it is fixed.*)
   proof
     fix A::"'a mat" 
     assume A: "A \<in> carrier_mat CARD('n) CARD('n)"
     let ?B = "(Mod_Type_Connect.to_hma\<^sub>m  A::'a::comm_ring_1^'n::{mod_type}^'n::{mod_type})"
     have [transfer_rule]: "Mod_Type_Connect.HMA_M A ?B"
       using A unfolding Mod_Type_Connect.HMA_M_def by auto
     have b: "admits_SNF_HA ?B" using a by auto
     show "admits_SNF_JNF A" using b by transfer
   qed 
   (*Here we cannot apply local type definitions (either cancel_card_constraint or 
   cancel_type_definition) to thm JNF*)
   thus "\<exists>P. P \<in> carrier_mat n n \<and>
              (\<exists>Q. Q \<in> carrier_mat n n \<and> invertible_mat P 
         \<and> invertible_mat Q \<and> Smith_normal_form_mat (P * A * Q))"
     using JNF A diag_A unfolding admits_SNF_JNF_def unfolding square_mat.simps oops
 
 
 text\<open>This means that the @{text "\<Longrightarrow>"}  implication cannot be proven in HA, since we cannot quantify
 over type variables in Isabelle/HOL. We then prove both implications in JNF.\<close>
 
 
 subsection \<open>Transfering the @{text "\<Longleftarrow>"} implication from HA to JNF using transfer rules 
   and local type definitions\<close>
 
 (*
   I need to transfer the theorem bezout_ring_imp_diagonal_admits_SNF (stated in HA) to JNF.
   The first necessary step is to prove transfer rules to connect matrices in HA (when the type
   of the indexes must be mod_type). The original connection HMA_Connect presented in the 
   Perron--Frobenius development just connects matrices of type 'a^'b::finite^'c::finite with 
   the corresponding ones in JNF, but I need to transfer theorems with matrices of type:
   'a^'b::mod_type^'c::mod_type.
 
   The file that allows this bridge is Mod_Type_Connect.  
 
   Once that step is carried out, I would have to transfer the result by means of the lifting
   and transfer package and then apply local type definitions to get rid of the type (that is,
   to change CARD('n) by an arbitrary n).
 
   The usual approach consists of applying lifting and transfer to the theorem, and then we
   obtain a fact like 
         
           A \<in> carrier_mat (CARD('n::mod_type)) (CARD('n::mod_type))
 
   When trying to apply local type definitions (to substitute CARD('n::mod_type) by n), then
   I would have to apply interalize_sort and then proving the restriction class.mod_type (together
   with the operations associated to that class). Since the mod_type class already introduced
   several type restrictions (times, neg_numeral_well_order), operations (+,-) and constants (1,0),
   this means that we have to proceed using dictionary construction. We would have to define
   a mod_type with explicit operations, to get 'a only of type 'a::type.
   
   definition "mod_type_with n (tms::'a\<Rightarrow>'a\<Rightarrow>'a) mns pls zr umns (one'::'a)  
         (less_eq'::'a\<Rightarrow>'a\<Rightarrow>bool) (less'::'a\<Rightarrow>'a\<Rightarrow>bool) (Rep_op::'a\<Rightarrow>int) (Abs_op::int\<Rightarrow>'a)
       \<equiv> (type_definition Rep_op Abs_op {0..<n} \<and>  1 < n
       \<and> (zr = Abs_op 0)
       \<and> (one' = Abs_op 1)
       \<and> (\<forall>x y. pls x y = Abs_op (((Rep_op x) + (Rep_op y)) mod (n)))
       \<and> (\<forall>x y. tms x y = Abs_op (((Rep_op x) * (Rep_op y)) mod (n)))
       \<and> (\<forall>x y. mns x y = Abs_op (((Rep_op x) - (Rep_op y)) mod (n)))
       \<and> (\<forall>x. umns x = Abs_op ((- (Rep_op x)) mod (n)))
       \<and> (\<forall>x y. less' x y \<longrightarrow> (Rep_op x) < (Rep_op y))
       \<and> class.neg_numeral mns pls zr umns
       \<and> class.wellorder less_eq' less')"
 
   Once this is completed, I would have to connect mod_type and mod_type_with, 
   prove new transfer rules and so on. This is the usual approach and has been successfully applied,
   for instance, by Fabian Immler to transform a (type based) library of linear algebra into another
   one with explicit carriers.
 
   Fortunately, in this case there is a shortcut: we can use the type 'a mod_ring from the
   Berlekamp--Zassenhaus development to express the lemma in HA 
   (thm bezout_ring_imp_diagonal_admits_SNF) using that type (the type 'a mod_ring is an instance
   of the mod_type class, and then is a particular case).
 
   This means that any lemma that has a matrix of type 'a^'b::mod_type^'c^'mod_type can be expressed
   as 'a^'b mod_ring^'c mod_ring, where 'b and 'c must satisfy the nontriv restriction 
   (they must have more than one element).
 
   This is done in the file Finite_Field_Mod_Type_Connection, which shows that 'a mod_ring is an
   instance of the mod_type class.
 
   This type 'a mod_ring has a very useful property: CARD('b mod_ring) = CARD('b)
   This means that it is very easy to apply local type definitions. The problematic fact
   would then be transformed to:
   
       A \<in> carrier_mat (CARD('n::nontriv)) (CARD('n::nontriv)). 
 
   It is very easy to apply local type definitions to this fact, since it is very easy to get rid
   of the nontriv restriction (on the contrary, the mod_type restriction was quite hard).
 
 *)
 
 
 (*
   In our concrete case: we write the theorem in terms of the mod_ring type thanks to 
   the file Finite_Field_Mod_Type_Connection.
 
   With this type 'n::nontriv mod_ring I can easily apply local type definitions, since we
   will get CARD(?'n::nontriv).
 *)
 
 lemma bezout_ring_imp_diagonal_admits_SNF_mod_ring:
   assumes of: "OFCLASS('a::comm_ring_1, bezout_ring_class)"
   shows "\<forall>A::'a^'n::nontriv mod_ring^'n::nontriv mod_ring. isDiagonal A 
     \<longrightarrow> (\<exists>P Q. 
         invertible (P::'a^'n::nontriv mod_ring^'n::nontriv mod_ring) \<and> 
         invertible (Q::'a^'n::nontriv mod_ring^'n::nontriv mod_ring) \<and> 
         Smith_normal_form (P**A**Q))" 
   using bezout_ring_imp_diagonal_admits_SNF[OF assms] by auto
 
 lemma bezout_ring_imp_diagonal_admits_SNF_mod_ring_admits: 
   assumes of: "class.bezout_ring (*) (1::'a::comm_ring_1) (+) 0 (-) uminus" (*It is equivalent to the statement based on OFCLASS*)
   shows "\<forall>A::'a^'n::nontriv mod_ring^'n::nontriv mod_ring. admits_SNF_HA A"
   using bezout_ring_imp_diagonal_admits_SNF
         [OF bezout_ring.intro_of_class[OF of]]
   unfolding admits_SNF_HA_def by auto
 
 text\<open>I start here to apply local type definitions\<close>
 
 context
   fixes p::nat
   assumes local_typedef: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<p :: int}"
   and p: "p>1"
 begin
 
 lemma type_to_set:
   shows "class.nontriv TYPE('b)" (is ?a) and "p=CARD('b)" (is ?b)
 proof -
   from local_typedef obtain Rep::"('b \<Rightarrow> int)" and Abs 
     where t: "type_definition Rep Abs {0..<p :: int}" by auto
   have "card (UNIV :: 'b set) = card {0..<p}" using t type_definition.card by fastforce
   also have "... = p" by auto
   finally show ?b ..
   then show ?a unfolding class.nontriv_def using p by auto
 qed
 
 
 text\<open>I transfer the lemma from HA to JNF, substituting @{text "CARD('n)"} by $p$. 
   I apply @{text "internalize-sort"} to @{text "'n"} and get rid of 
   the @{text "nontriv"} restriction.\<close>
 
 lemma bezout_ring_imp_diagonal_admits_SNF_mod_ring_admits_aux:
   assumes "class.bezout_ring (*) (1::'a::comm_ring_1) (+) 0 (-) uminus"
   shows "Ball {A::'a::comm_ring_1 mat. A \<in> carrier_mat p p} admits_SNF_JNF"
   using bezout_ring_imp_diagonal_admits_SNF_mod_ring_admits[untransferred, unfolded CARD_mod_ring, 
       internalize_sort "'n::nontriv", where ?'a='b]
   unfolding type_to_set(2)[symmetric] using type_to_set(1) assms by auto
 end
 
 text\<open>The @{text "\<Longleftarrow>"} implication in JNF\<close>
 
 text\<open>Since @{text "nontriv"} imposes the type to have more than one element, 
   the cases $n=0$ (@{text "A \<in> carrier_mat 0 0"}) and $n = 1$ (@{text "A \<in> carrier_mat 1 1"})
   must be treated separately.\<close>
 
 lemma bezout_ring_imp_diagonal_admits_SNF_mod_ring_admits_aux2:
   assumes of: "class.bezout_ring (*) (1::'a::comm_ring_1) (+) 0 (-) uminus"
   shows "\<forall>(A::'a mat)\<in>carrier_mat n n. admits_SNF_JNF A"
 proof (cases "n = 0")
   case True  
   show ?thesis
     by (rule, unfold True admits_SNF_JNF_def isDiagonal_mat_def invertible_mat_def 
         Smith_normal_form_mat_def carrier_mat_def inverts_mat_def, fastforce)
 next
   case False note not0 = False
   show ?thesis
   proof (cases "n=1") 
   case True
   show ?thesis 
     by (rule, unfold True admits_SNF_JNF_def isDiagonal_mat_def invertible_mat_def 
         Smith_normal_form_mat_def carrier_mat_def inverts_mat_def, auto)
        (metis dvd_1_left index_one_mat(2) index_one_mat(3) less_Suc0 nat_dvd_not_less 
         right_mult_one_mat' zero_less_Suc)
   next
     case False
     then have "n>1" using not0 by auto
     then show ?thesis (*Here I apply the local type definition rule, to cancel the type*)
       using bezout_ring_imp_diagonal_admits_SNF_mod_ring_admits_aux[cancel_type_definition, of n] of 
       by auto
   qed
 qed
     
 text \<open>Alternative statements\<close>
   
 lemma bezout_ring_imp_diagonal_admits_SNF_JNF:
   assumes of: "class.bezout_ring (*) (1::'a::comm_ring_1) (+) 0 (-) uminus"
   shows "\<forall>A::'a mat. admits_SNF_JNF A"
 proof 
   fix A::"'a mat"
   have "A\<in> carrier_mat (dim_row A) (dim_col A)" unfolding carrier_mat_def by auto
   thus "admits_SNF_JNF A" 
     using bezout_ring_imp_diagonal_admits_SNF_mod_ring_admits_aux2[OF of]
     by (metis admits_SNF_JNF_def square_mat.elims(2))
 qed
 
 
 lemma admits_SNF_JNF_alt_def:
   "(\<forall>A::'a::comm_ring_1 mat. admits_SNF_JNF A) 
   = (\<forall>A n. (A::'a mat) \<in> carrier_mat n n \<and> isDiagonal_mat A
   \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat n n \<and> Q \<in> carrier_mat n n \<and> invertible_mat P \<and> invertible_mat Q 
       \<and> Smith_normal_form_mat (P*A*Q)))" (is "?a = ?b")
   by (auto simp add: admits_SNF_JNF_def, metis carrier_matD(1) carrier_matD(2), blast)
 
 
 subsection \<open>Final theorem in JNF\<close>
 text \<open>Final theorem using @{text "class.bezout_ring"}\<close>
 
 theorem diagonal_admits_SNF_iff_bezout_ring:
   shows "class.bezout_ring (*) (1::'a::comm_ring_1) (+) 0 (-) uminus 
   \<longleftrightarrow> (\<forall>A::'a mat. admits_SNF_JNF A)" (is "?a \<longleftrightarrow> ?b")
 proof 
   assume ?a
   thus ?b using bezout_ring_imp_diagonal_admits_SNF_JNF by auto
 next
   assume b: ?b
   have rw: "\<forall>A n. (A::'a mat) \<in> carrier_mat n n \<and> isDiagonal_mat A \<longrightarrow>
           (\<exists>P Q. P \<in> carrier_mat n n \<and> Q \<in> carrier_mat n n \<and> invertible_mat P 
           \<and> invertible_mat Q \<and> Smith_normal_form_mat (P * A * Q))"
     using admits_SNF_JNF_alt_def b by auto  
   show ?a
     using diagonal_admits_SNF_imp_bezout_ring_JNF[OF rw] 
     using OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a]
     by auto
 qed
 
 text \<open>Final theorem using @{text "OFCLASS"}\<close>
 
 theorem diagonal_admits_SNF_iff_bezout_ring':
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class) \<equiv> (\<And>A::'a mat. admits_SNF_JNF A)"
 proof 
   fix A::"'a mat"
   assume a: "OFCLASS('a, bezout_ring_class)"  
   show "admits_SNF_JNF A"
     using OFCLASS_bezout_ring_imp_class_bezout_ring[OF a] diagonal_admits_SNF_iff_bezout_ring
     by auto
 next
   assume "(\<And>A::'a mat. admits_SNF_JNF A)"  
   hence *: "class.bezout_ring (*) (1::'a) (+) 0 (-) uminus" 
     using diagonal_admits_SNF_iff_bezout_ring by auto
   show "OFCLASS('a, bezout_ring_class)"
     by (rule bezout_ring.intro_of_class, rule *)
 qed
 
 end
diff --git a/thys/Smith_Normal_Form/Alternative_Proofs.thy b/thys/Smith_Normal_Form/Alternative_Proofs.thy
--- a/thys/Smith_Normal_Form/Alternative_Proofs.thy
+++ b/thys/Smith_Normal_Form/Alternative_Proofs.thy
@@ -1,373 +1,373 @@
 theory Alternative_Proofs
   imports Smith_Normal_Form.Admits_SNF_From_Diagonal_Iff_Bezout_Ring
           Smith_Normal_Form.Elementary_Divisor_Rings
 begin
 
 
 text \<open>Theorem 2: (C) ==> (A)\<close>
 
 lemma diagonal_2x2_admits_SNF_imp_bezout_ring_JNF:
   assumes admits_SNF: "\<forall>A. (A::'a mat) \<in> carrier_mat 2 2 \<and> isDiagonal_mat A
   \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat 2 2 \<and> Q \<in> carrier_mat 2 2 \<and> invertible_mat P \<and> invertible_mat Q 
       \<and> Smith_normal_form_mat (P*A*Q))"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (intro_classes)
   fix a b::'a
   show "\<exists>p q d. p * a + q * b = d \<and> d dvd a \<and> d dvd b \<and> (\<forall>d'. d' dvd a \<and> d' dvd b \<longrightarrow> d' dvd d)"
   proof (cases "a=b")
     case True
     show ?thesis
       by (metis True add.right_neutral comm_semiring_class.distrib dvd_refl mult_1)
   next
     case False note a_not_b = False
     let ?A = "Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then a else if i = 1 \<and> j = 1 then b else 0)"
     have A_carrier: "?A \<in> carrier_mat 2 2" by auto
     moreover have diag_A: "isDiagonal_mat ?A" by (simp add: isDiagonal_mat_def)
     ultimately obtain P Q where P: "P \<in> carrier_mat 2 2" 
         and Q: "Q \<in> carrier_mat 2 2" and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q"
         and SNF_PAQ: "Smith_normal_form_mat (P*?A*Q)" 
       using admits_SNF by blast 
     let ?p = "P$$(0,0)*Q$$(0,0)"
     let ?q = "P$$(0,1)*Q$$(1,0)"
     let ?d = "(P*?A*Q) $$ (0,0)"
     let ?d' = "(P*?A*Q) $$ (1,1)"
     have d_dvd_d': "?d dvd ?d'" 
       by (metis (no_types, lifting) A_carrier One_nat_def P Q SNF_PAQ SNF_first_divides_all bot_nat_0.not_eq_extremum
           less_Suc_numeral mult_carrier_mat pred_numeral_simps(2) zero_neq_numeral)
     have pa_qb_d: "?p*a + ?q * b = ?d"
     proof -
       let ?U = "P*?A"
       have "?U $$ (0, 0) = P $$ (0,0)* ?A $$ (0,0) + P $$ (0,1)* ?A $$ (1,0)" 
         by (rule mat_mult2_00, insert P, auto)
       also have "... = P $$ (0,0) * a" by auto
       finally have 1: "(P*?A) $$ (0, 0) = P $$ (0,0) * a" .
       have "?U $$ (0, 1) = P $$ (0,0)* ?A $$ (0,1) + P $$ (0,1)* ?A $$ (1,1)"
         by (rule mat_mult2_01, insert P, auto)
       hence 2: "(P*?A) $$ (0, 1)= P $$ (0,1)* b" by auto
       have "?d = ?U $$ (0, 0) * Q $$ (0, 0) + ?U $$ (0, 1) * Q $$ (1, 0)"
         by (rule mat_mult2_00, insert Q P, auto)
       also have "... = ?p*a + ?q * b" unfolding 1 unfolding 2 by auto
       finally show ?thesis ..
     qed    
     have i: "ideal_generated {a, b} = ideal_generated {?d}" 
     proof
       show "ideal_generated {?d} \<subseteq> ideal_generated {a, b}"
       proof (rule ideal_generated_subset2, rule ballI, simp)
         fix x 
         let ?f = "\<lambda>x. if x = a then ?p else ?q"
         show "?d \<in> ideal_generated {a, b}"        
           unfolding ideal_explicit 
           by simp (rule exI[of _ ?f], rule exI[of _ "{a,b}"], 
                   insert a_not_b One_nat_def pa_qb_d, auto)  
       qed
       show "ideal_generated {a, b}  \<subseteq> ideal_generated {?d}" 
       proof -
         obtain P' where inverts_mat_P': "inverts_mat P P' \<and> inverts_mat P' P" 
             using inv_P unfolding invertible_mat_def by auto
           have P': "P' \<in> carrier_mat 2 2" 
             using inverts_mat_P' 
             unfolding carrier_mat_def inverts_mat_def
             by (auto,metis P carrier_matD index_mult_mat(3) one_carrier_mat)+
           obtain Q' where inverts_mat_Q': "inverts_mat Q Q' \<and> inverts_mat Q' Q"
             using inv_Q unfolding invertible_mat_def by auto
           have Q': "Q' \<in> carrier_mat 2 2" 
             using inverts_mat_Q'
             unfolding carrier_mat_def inverts_mat_def
             by (auto,metis Q carrier_matD index_mult_mat(3) one_carrier_mat)+
           have rw_PAQ: "(P'*(P*?A*Q)*Q') $$ (i, i) = ?A $$ (i,i)" for i 
             using inv_P'PAQQ'[OF A_carrier P _ _ Q P' Q'] inverts_mat_P' inverts_mat_Q' by auto
           have diag_PAQ: "isDiagonal_mat (P*?A*Q)" 
             using SNF_PAQ unfolding Smith_normal_form_mat_def by auto
           have PAQ_carrier: "(P*?A*Q) \<in> carrier_mat 2 2" using P Q by auto
           have z1: "0<(2::nat)" and z2: "1<(2::nat)" by auto        
           obtain f where f: "(P'*(P*?A*Q)*Q') $$ (0, 0) = (\<Sum>i\<in>set (diag_mat (P*?A*Q)). f i * i)"          
             using exists_f_PAQ_Aii[OF diag_PAQ P' PAQ_carrier Q' z1] by blast
           obtain g where g: "(P'*(P*?A*Q)*Q') $$ (1, 1) = (\<Sum>i\<in>set (diag_mat (P*?A*Q)). g i * i)"          
             using exists_f_PAQ_Aii[OF diag_PAQ P' PAQ_carrier Q' z2] by blast
           have A00: "?A $$ (0, 0) = (\<Sum>i\<in>set (diag_mat (P*?A*Q)). f i * i)"
             using rw_PAQ[of 0] using f by presburger
           have A11: "?A $$ (1, 1) = (\<Sum>i\<in>set (diag_mat (P*?A*Q)). g i * i)"
             using rw_PAQ[of 1] using g by presburger
           have d_dvd_a: "?d dvd a" using A00 d_dvd_d'
             by (auto, smt (verit, best) A00 A_carrier P Q S00_dvd_all_A SNF_PAQ inv_P inv_Q 
                 numeral_2_eq_2 zero_less_Suc)
           have d_dvd_b: "?d dvd b" using A11 d_dvd_d'
             by (smt (verit, ccfv_threshold) A_carrier One_nat_def P Q S00_dvd_all_A SNF_PAQ 
                 index_mat(1) inv_P inv_Q lessI nat.simps(3) numeral_2_eq_2 split_conv)
         have 1: "a \<in> ideal_generated {?d}" and 2: "b \<in> ideal_generated {?d}"
           using d_dvd_a d_dvd_b dvd_ideal_generated_singleton' ideal_generated_subset_generator
           by blast+
         show ?thesis by (rule ideal_generated_subset2, insert 1 2, auto)
       qed
     qed
     have "\<exists> p q. p * a + q * b = ?d" by (rule ideal_generated_pair_exists[OF i])
     moreover have d_dvd_a: "?d dvd a" and d_dvd_b: "?d dvd b"
       using i ideal_generated_singleton_dvd by blast+
     moreover have "(\<forall>d'. d' dvd a \<and> d' dvd b \<longrightarrow> d' dvd ?d)" using ideal_generated_dvd[OF i] by auto
     ultimately show ?thesis
       by blast
   qed
 qed
 
 
 text \<open>Theorem 2: (A) ==> (C)\<close>
 
 lemma bezout_ring_imp_diagonal_2x2_admits_SNF_JNF:
   assumes c: "OFCLASS('a::comm_ring_1, bezout_ring_class)"
   shows "\<forall>A. (A::'a mat) \<in> carrier_mat 2 2 \<and> isDiagonal_mat A
   \<longrightarrow> (\<exists>P Q. P \<in> carrier_mat 2 2 \<and> Q \<in> carrier_mat 2 2 
       \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat (P*A*Q))"  
   using bezout_ring_imp_diagonal_admits_SNF_JNF
       [OF OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a, OF c]]
   unfolding admits_SNF_JNF_def
   using \<open>\<forall>A. admits_SNF_JNF A\<close> admits_SNF_JNF_alt_def by blast
 
 
 text \<open>Theorem 2: (A) <==> (C)\<close>
 
 lemma diagonal_2x2_admits_SNF_iff_bezout_ring: 
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class) 
     \<equiv> (\<And>A::'a mat. A \<in> carrier_mat 2 2 \<longrightarrow> admits_SNF_JNF A)" (is "?lhs \<equiv> ?rhs")
 proof 
   fix A::"'a mat"
   assume c: "OFCLASS('a, bezout_ring_class)"
   show "A \<in> carrier_mat 2 2 \<longrightarrow> admits_SNF_JNF A"
     using bezout_ring_imp_diagonal_admits_SNF_JNF
           [OF OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a, OF c]]
     unfolding admits_SNF_JNF_def by blast
 next
   assume rhs: "(\<And>A::'a mat. A \<in> carrier_mat 2 2 \<longrightarrow> admits_SNF_JNF A)"
   show "OFCLASS('a::comm_ring_1, bezout_ring_class)"
     by (rule diagonal_2x2_admits_SNF_imp_bezout_ring_JNF, insert rhs, simp add: admits_SNF_JNF_def) 
 qed
 
 text \<open>Theorem 2: (B) <==> (C)\<close>
 lemma diagonal_2x2_admits_SNF_iff_diagonal_admits_SNF:
   shows "(\<forall>(A::'a::comm_ring_1 mat). admits_SNF_JNF A) =
       (\<forall>(A::'a mat) \<in> carrier_mat 2 2. admits_SNF_JNF A)"
 proof 
  assume "\<forall>A::'a mat. admits_SNF_JNF A"
   thus "\<forall>(A::'a mat)\<in>carrier_mat 2 2. admits_SNF_JNF A" 
     by (insert admits_SNF_JNF_alt_def, blast)
 next
   assume "\<forall>A::'a mat \<in>carrier_mat 2 2. admits_SNF_JNF A "
   hence H: "OFCLASS('a, bezout_ring_class)"
     using diagonal_2x2_admits_SNF_iff_bezout_ring[where ?'a = 'a] by auto  
   show "\<forall>A::'a mat. admits_SNF_JNF A" 
     using bezout_ring_imp_diagonal_admits_SNF_JNF
       [OF OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a, OF H]]
     by simp
 qed
 
 text \<open>Theorem 2: final statements\<close>
 
 theorem Theorem2_final:
   shows A_imp_B: "OFCLASS('a::comm_ring_1, bezout_ring_class) 
     \<Longrightarrow> (\<forall>A::'a mat. admits_SNF_JNF A)"
   and B_imp_C: "(\<forall>A::'a mat. admits_SNF_JNF A) \<Longrightarrow> 
       (\<forall>(A::'a mat) \<in> carrier_mat 2 2. admits_SNF_JNF A)"
   and C_imp_A: "(\<forall>(A::'a mat) \<in> carrier_mat 2 2. admits_SNF_JNF A) 
     \<Longrightarrow> OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof
   fix A::"'a mat"
   assume H: "OFCLASS('a, bezout_ring_class)"
   show "admits_SNF_JNF A"
     using bezout_ring_imp_diagonal_admits_SNF_JNF[OF OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a, OF H]]
     by simp
 next
   assume "\<forall>A::'a mat. admits_SNF_JNF A"
   thus "\<forall>(A::'a mat)\<in>carrier_mat 2 2. admits_SNF_JNF A" 
     by (insert admits_SNF_JNF_alt_def, blast)
 next
   assume "\<forall>(A::'a mat)\<in>carrier_mat 2 2. admits_SNF_JNF A" 
   thus "OFCLASS('a, bezout_ring_class)"
     using diagonal_2x2_admits_SNF_iff_bezout_ring[where ?'a = 'a] by auto
 qed
 
 
 theorem Theorem2_final':
   shows A_eq_B: "OFCLASS('a::comm_ring_1, bezout_ring_class) \<equiv> (\<And>A::'a mat. admits_SNF_JNF A)"
   and A_eq_C: "OFCLASS('a::comm_ring_1, bezout_ring_class) \<equiv>
       (\<And>(A::'a mat). A \<in> carrier_mat 2 2 \<longrightarrow> admits_SNF_JNF A)"
   and B_eq_C: "(\<forall>(A::'a::comm_ring_1 mat). admits_SNF_JNF A) =
       (\<forall>(A::'a mat) \<in> carrier_mat 2 2. admits_SNF_JNF A)"
   using diagonal_admits_SNF_iff_bezout_ring' 
   using diagonal_2x2_admits_SNF_iff_bezout_ring
   using diagonal_2x2_admits_SNF_iff_diagonal_admits_SNF by auto
 
 text \<open>Theorem 2: final statement in HA. (A) <==> (C).\<close>
 
 theorem Theorem2_A_eq_C_HA:
    "OFCLASS('a::comm_ring_1, bezout_ring_class) \<equiv> (\<And>(A::'a^2^2). admits_SNF_HA A)"
 proof 
   fix A::"'a^2^2"
   assume H: "OFCLASS('a, bezout_ring_class)"
   let ?A = "Mod_Type_Connect.from_hma\<^sub>m A" 
   have A: "?A \<in> carrier_mat 2 2" by auto
   have [transfer_rule]: "Mod_Type_Connect.HMA_M ?A A" 
     unfolding Mod_Type_Connect.HMA_M_def A by auto
   have "admits_SNF_JNF ?A" using A_imp_B[OF H] by auto
   thus "admits_SNF_HA A" by transfer'
 next
   assume a: "(\<And>A::'a^2^2. admits_SNF_HA A)"
   have [transfer_rule]: "Mod_Type_Connect.HMA_M (Mod_Type_Connect.from_hma\<^sub>m A) A" for A::"'a^2^2" 
     unfolding Mod_Type_Connect.HMA_M_def by auto
   have a': "(\<And>A::'a^2^2. admits_SNF_JNF (Mod_Type_Connect.from_hma\<^sub>m A))" 
   proof -
     fix A::"'a^2^2"
     have ad: "admits_SNF_HA A" using a by simp
     let ?A = "Mod_Type_Connect.from_hma\<^sub>m A" 
     have A: "?A \<in> carrier_mat 2 2" by auto
     have [transfer_rule]: "Mod_Type_Connect.HMA_M ?A A" 
       unfolding Mod_Type_Connect.HMA_M_def A by auto
     show "admits_SNF_JNF (Mod_Type_Connect.from_hma\<^sub>m A)" using ad by transfer'
   qed
   have "(\<forall>A::'a^2^2. admits_SNF_JNF (Mod_Type_Connect.from_hma\<^sub>m A)) 
     = (\<forall>(A::'a mat)\<in>carrier_mat 2 2. admits_SNF_JNF A)" 
   proof (auto)
     fix A::"'a mat" assume a1: "\<forall>A::'a^2^2. admits_SNF_JNF (Mod_Type_Connect.from_hma\<^sub>m A)" 
       and "A \<in> carrier_mat 2 2" 
     thus "admits_SNF_JNF A" by (metis Mod_Type_Connect.from_hma_to_hma\<^sub>m One_nat_def  UNIV_1 a1 
           card.empty card.insert card_bit0 empty_iff finite mult.right_neutral)
   next
     fix A::"'a^2^2" assume "\<forall>A\<in>carrier_mat 2 2. admits_SNF_JNF A"
     have ad: "admits_SNF_HA A" using a by simp
     let ?A = "Mod_Type_Connect.from_hma\<^sub>m A" 
     have A: "?A \<in> carrier_mat 2 2" by auto
     have [transfer_rule]: "Mod_Type_Connect.HMA_M ?A A" 
       unfolding Mod_Type_Connect.HMA_M_def A by auto
     show "admits_SNF_JNF (Mod_Type_Connect.from_hma\<^sub>m A)" using ad by transfer'
   qed
   hence "(\<And>A::'a mat. A \<in> carrier_mat 2 2 \<longrightarrow> admits_SNF_JNF A)" using a' by auto
   thus "OFCLASS('a, bezout_ring_class)" using Theorem2_final'[where ?'a='a] by auto
 qed
 
 
 text \<open>Hermite implies Bezout\<close>
 
 text \<open>Theorem 3, proof for 1x2 matrices\<close>
 lemma theorem3_restricted_12_part1:
   assumes T: "(\<forall>a b::'a::comm_ring_1. \<exists> a1 b1 d. a = a1*d \<and> b = b1*d 
     \<and> ideal_generated {a1,b1} = ideal_generated {1})"
   shows "\<forall>(A::'a mat) \<in> carrier_mat 1 2. admits_triangular_reduction A"
 proof (rule)
   fix A::"'a mat"
   assume A: "A \<in> carrier_mat 1 2"
   let ?a = "A $$ (0,0)"
   let ?b = "A $$ (0,1)"
   obtain a1 b1 d where a: "?a = a1*d" and b: "?b = b1*d" 
     and i: "ideal_generated {a1,b1} = ideal_generated {1}" 
     using T by blast
   obtain s t where sa1tb1:"s*a1+t*b1=1" using ideal_generated_pair_exists_pq1[OF i[simplified]] by blast
   let ?Q = "Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then s else
                                     if  i = 0 \<and> j = 1 then -b1 else
                                     if  i = 1 \<and> j = 0 then t else a1)"
   have Q: "?Q \<in> carrier_mat 2 2" by auto
   have det_Q: "Determinant.det ?Q = 1" unfolding det_2[OF Q] 
     using sa1tb1 by (simp add: mult.commute)
   hence inv_Q: "invertible_mat ?Q" using invertible_iff_is_unit_JNF[OF Q] by auto
   have lower_AQ: "lower_triangular (A*?Q)" 
   proof -
     have "Matrix.row A 0 $v Suc 0 * a1 = Matrix.row A 0 $v 0 * b1" if j2: "j<2" and j0: "0<j" for j
       by (metis A One_nat_def a b carrier_matD(1) carrier_matD(2) index_row(1) lessI 
           more_arith_simps(11) mult.commute numeral_2_eq_2 pos2)
     thus ?thesis unfolding lower_triangular_def using A 
       by (auto simp add: scalar_prod_def sum_two_rw)
   qed
   show "admits_triangular_reduction A" 
     unfolding admits_triangular_reduction_def using lower_AQ inv_Q Q A by force    
 qed
 
 
 lemma theorem3_restricted_12_part2:
   assumes 1: "\<forall>(A::'a::comm_ring_1 mat) \<in> carrier_mat 1 2. admits_triangular_reduction A"
   shows "\<forall>a b::'a. \<exists> a1 b1 d. a = a1*d \<and> b = b1*d \<and> ideal_generated {a1,b1} = ideal_generated {1}"
 proof (rule allI)+
   fix a b::'a
   let ?A = "Matrix.mat 1 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then a else b)"
   obtain Q where AQ: "lower_triangular (?A*Q)" and inv_Q: "invertible_mat Q"
     and Q: "Q \<in> carrier_mat 2 2"
     using 1 unfolding admits_triangular_reduction_def by fastforce
   hence [simp]: "dim_col Q = 2" and [simp]: "dim_row Q = 2" by auto
   let ?s = "Q $$ (0,0)"
   let ?t = "Q $$ (1,0)"
   let ?a1 = "Q $$ (1,1)"
   let ?b1 = "-(Q $$ (0,1))"
   let ?d = "(?A*Q) $$ (0,0)"
   have ab1_ba1: "a*?b1 = b*?a1"
   proof -     
     have  "(?A*Q) $$ (0,1) =  (\<Sum>i = 0..<2. (if i = 0 then a else b) * Q $$ (i, Suc 0))"
       unfolding times_mat_def col_def scalar_prod_def by auto
     also have "... = (\<Sum>i \<in> {0,1}. (if i = 0 then a else b) * Q $$ (i, Suc 0))" 
       by (rule sum.cong, auto)
     also have "... = - a*?b1 + b*?a1" by auto
     finally have "(?A*Q) $$ (0,1) = - a*?b1 + b*?a1" by simp
     moreover have "(?A*Q) $$ (0,1) = 0" using AQ unfolding lower_triangular_def by auto  
     ultimately show ?thesis
       by (metis add_left_cancel more_arith_simps(3) more_arith_simps(7))    
   qed
   have sa_tb_d: "?s*a+?t*b = ?d"
   proof -
     have "?d = (\<Sum>i = 0..<2. (if i = 0 then a else b) * Q $$ (i, 0))"
       unfolding times_mat_def col_def scalar_prod_def by auto
     also have "... = (\<Sum>i \<in> {0,1}. (if i = 0 then a else b) * Q $$ (i, 0))" by (rule sum.cong, auto)
     also have "... = ?s*a+?t*b" by auto
     finally show ?thesis by simp
   qed
   have det_Q_dvd_1: "(Determinant.det Q dvd 1)"
     using invertible_iff_is_unit_JNF[OF Q] inv_Q by auto
   moreover have det_Q_eq: "Determinant.det Q = ?s*?a1 + ?t*?b1" unfolding det_2[OF Q] by simp
   ultimately have "?s*?a1 + ?t*?b1 dvd 1" by auto
   from this obtain u where u_eq: "?s*?a1 + ?t*?b1 = u" and u: "u dvd 1" by auto
   hence eq1: "?s*?a1*a + ?t*?b1*a = u*a"
     by (metis ring_class.ring_distribs(2))
   hence "?s*?a1*a + ?t*?a1*b = u*a"
     by (metis (no_types, lifting) ab1_ba1 mult.assoc mult.commute)
   hence a1d_ua:"?a1*?d=u*a"
-    by (smt Groups.mult_ac(2) distrib_left more_arith_simps(11) sa_tb_d)
+    by (smt (verit) Groups.mult_ac(2) distrib_left more_arith_simps(11) sa_tb_d)
   hence b1d_ub: "?b1*?d=u*b"
-    by (smt Groups.mult_ac(2) Groups.mult_ac(3) ab1_ba1 distrib_right sa_tb_d u_eq)
+    by (smt (verit, ccfv_threshold) Groups.mult_ac(2) Groups.mult_ac(3) ab1_ba1 distrib_right sa_tb_d u_eq)
   obtain inv_u where inv_u: "inv_u * u = 1" using u unfolding dvd_def
     by (metis mult.commute)
   hence inv_u_dvd_1: "inv_u dvd 1" unfolding dvd_def by auto
   have cond1: "(inv_u*?b1)*?d = b" using b1d_ub inv_u
     by (metis (no_types, lifting) Groups.mult_ac(3) more_arith_simps(11) more_arith_simps(6))
   have cond2: "(inv_u*?a1)*?d = a" using a1d_ua inv_u
     by (metis (no_types, lifting) Groups.mult_ac(3) more_arith_simps(11) more_arith_simps(6))
   have "ideal_generated {inv_u*?a1, inv_u*?b1} = ideal_generated {?a1,?b1}"
     by (rule ideal_generated_mult_unit2[OF inv_u_dvd_1])    
   also have "... = UNIV" using ideal_generated_pair_UNIV[OF u_eq u] by simp
   finally have cond3: "ideal_generated {inv_u*?a1, inv_u*?b1} = ideal_generated {1}" by auto
   show "\<exists>a1 b1 d. a = a1 * d \<and> b = b1 * d \<and> ideal_generated {a1, b1} = ideal_generated {1}"
     by (rule exI[of _ "inv_u*?a1"], rule exI[of _ "inv_u*?b1"], rule exI[of _ ?d],
         insert cond1 cond2 cond3, auto)
 qed
 
 
 lemma Hermite_ring_imp_Bezout_ring:
   assumes H: "OFCLASS('a::comm_ring_1, Hermite_ring_class)"
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (intro_classes)
   fix a b::'a
   let ?A = "Matrix.mat 1 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then a else b)"
   have *: "(\<And>(A::'a::comm_ring_1 mat). admits_triangular_reduction A)"
     using OFCLASS_Hermite_ring_def[where ?'a='a] H by auto
   have "admits_triangular_reduction ?A"
     using H unfolding OFCLASS_Hermite_ring_def by auto
   have "\<exists> a1 b1 d. a = a1*d \<and> b = b1*d \<and> ideal_generated {a1,b1} = ideal_generated {1}"
     using theorem3_restricted_12_part2 * by auto
   from this obtain a1 b1 d where a_a'd: "a = a1*d" and b_b'd: "b = b1*d"
     and a'b'_1: "ideal_generated {a1,b1} = ideal_generated {1}"
     by blast
   obtain p q where "p * a1 + q * b1 = 1" using a'b'_1
     using ideal_generated_pair_exists_UNIV by blast
   hence pa_qb_d: "p * a + q * b = d" unfolding a_a'd b_b'd
     by (metis mult.assoc mult_1 ring_class.ring_distribs(2))
   moreover have d_dvd_a: "d dvd a" using a_a'd by auto
   moreover have d_dvd_b: "d dvd b" using b_b'd by auto    
   moreover have "(\<forall>d'. d' dvd a \<and> d' dvd b \<longrightarrow> d' dvd d)" using pa_qb_d by force
   ultimately show "\<exists>p q d. p * a + q * b = d \<and> d dvd a \<and> d dvd b
         \<and> (\<forall>d'. d' dvd a \<and> d' dvd b \<longrightarrow> d' dvd d)" by blast
 qed
 
 end
diff --git a/thys/Smith_Normal_Form/Diagonal_To_Smith.thy b/thys/Smith_Normal_Form/Diagonal_To_Smith.thy
--- a/thys/Smith_Normal_Form/Diagonal_To_Smith.thy
+++ b/thys/Smith_Normal_Form/Diagonal_To_Smith.thy
@@ -1,1895 +1,1896 @@
 (*
     Author:      Jose Divasón
     Email:       jose.divason@unirioja.es           
 *)
 
 section \<open>Algorithm to transform a diagonal matrix into its Smith normal form\<close>
 
 theory Diagonal_To_Smith
   imports Hermite.Hermite
   "HOL-Types_To_Sets.Types_To_Sets"
   Smith_Normal_Form
 begin
 
 
 (*Move this theorem:*)
 lemma invertible_mat_1: "invertible (mat (1::'a::comm_ring_1))"
   unfolding invertible_iff_is_unit by simp
 
 subsection \<open>Implementation of the algorithm\<close>
 
 type_synonym 'a bezout = "'a \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a"
 
 hide_const Countable.from_nat
 hide_const Countable.to_nat
 
 text \<open>The algorithm is based on the one presented by Bradley in his article entitled 
   ``Algorithms for Hermite and Smith normal matrices and linear diophantine equations''. 
   Some improvements have been introduced to get a general version for any matrix (including
   non-square and singular ones).\<close>
 
 text \<open>I also introduced another improvement: the element in the position j does not need 
 to be checked each time, since the element $A_{ii}$ will already divide $A_{jj}$ (where $j \le k$). 
 The gcd will be placed in $A_{ii}$.\<close>
 
 
 (*This version is a valid implementation and permits the formalization, 
   but it would not be executable due to the abstraction*)
 
 (*
 primrec diagonal_to_Smith_i :: "nat list \<Rightarrow> 'a:: {gcd,divide}^'n::mod_type^'n::mod_type \<Rightarrow> 'n::mod_type \<Rightarrow> 'a^'n::mod_type^'n::mod_type" 
  where
 "diagonal_to_Smith_i [] A i  = A" |
 "diagonal_to_Smith_i (j#xs) A i  = (
   if A $ i $ i dvd A $ (from_nat j) $ (from_nat j) then diagonal_to_Smith_i xs A i  (*If it divides, then we proceed.*)
   else 
       let c = gcd (A$i$i) (A$(from_nat j)$(from_nat j));
           A' = (\<chi> a b. if a = i \<and> b = i then c else 
                if a = from_nat j \<and> b = from_nat j 
                then A$ i $ i * (A $ (from_nat j) $ (from_nat j) div c) else A $ a $ b)
       in diagonal_to_Smith_i xs A' i (*We do the step and proceed*)
   )
   "
 *)
 
 text \<open>This function transforms the element $A_{jj}$ in order to be divisible by $A_{ii}$
 (and it changes $A_{ii}$ as well).
 
 The use of @{text "from_nat"} and @{text "from_nat"} is mandatory since the same 
 index $i$ cannot be used for both rows
 and columns at the same time, since they could have different type, concretely, 
 when the matrix is rectangular.\<close>
 
 text\<open>The following definition is valid, but since execution requires the trick of converting
 all operations in terms of rows, then we would be recalculating the B\'ezout coefficients each time.\<close>
 
 (*
 definition "diagonal_step A i j bezout = (let
               (p, q, u, v, d) = bezout (A $ from_nat i $ from_nat i) (A $ (from_nat j) $ (from_nat j)) in 
               (\<chi> a b. if a = from_nat i \<and> b = from_nat i then d else 
                if a = from_nat j \<and> b = from_nat j 
                then  v * (A $ (from_nat j) $ (from_nat j)) else A $ a $ b))"
 *)
 
 text\<open>Thus, the definition is parameterized by the necessary elements instead of the operation, 
      to avoid recalculations.\<close>
 
 definition "diagonal_step A i j d v =               
               (\<chi> a b. if a = from_nat i \<and> b = from_nat i then d else 
                if a = from_nat j \<and> b = from_nat j 
                then  v * (A $ (from_nat j) $ (from_nat j)) else A $ a $ b)"
 
 
 fun diagonal_to_Smith_i :: 
 "nat list \<Rightarrow> 'a::{bezout_ring}^'cols::mod_type^'rows::mod_type \<Rightarrow> nat \<Rightarrow> ('a bezout) 
   \<Rightarrow> 'a^'cols::mod_type^'rows::mod_type" 
  where
 "diagonal_to_Smith_i [] A i bezout = A" |
 "diagonal_to_Smith_i (j#xs) A i bezout = (
   if A $ (from_nat i) $ (from_nat i) dvd A $ (from_nat j) $ (from_nat j) 
       then diagonal_to_Smith_i xs A i bezout
   else let (p, q, u, v, d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j); 
           A' = diagonal_step A i j d v
       in diagonal_to_Smith_i xs A' i bezout
   )
   "
 
 definition "Diagonal_to_Smith_row_i A i bezout 
   = diagonal_to_Smith_i [i+1..<min (nrows A) (ncols A)] A i bezout"
 
 fun diagonal_to_Smith_aux :: " 'a::{bezout_ring}^'cols::mod_type^'rows::mod_type 
   \<Rightarrow> nat list \<Rightarrow> ('a bezout) \<Rightarrow>  'a^'cols::mod_type^'rows::mod_type"
   where
   "diagonal_to_Smith_aux A [] bezout = A" |
   "diagonal_to_Smith_aux A (i#xs) bezout 
           = diagonal_to_Smith_aux (Diagonal_to_Smith_row_i A i bezout) xs bezout"
 
 text\<open>The minimum arises to include the case of non-square matrices (we do not 
   demand the input diagonal matrix to be square, just have zeros in non-diagonal entries).
 
   This iteration does not need to be performed until the last element of the diagonal, 
   because in the second-to-last step the matrix will be already in Smith normal form.\<close>
 
 definition "diagonal_to_Smith A bezout 
   = diagonal_to_Smith_aux A [0..<min (nrows A) (ncols A) - 1] bezout"
 
 subsection\<open>Code equations to get an executable version\<close>
 
 definition diagonal_step_row 
   where "diagonal_step_row A i j c v a = vec_lambda (%b. if a = from_nat i \<and> b = from_nat i then c else 
                if a = from_nat j \<and> b = from_nat j 
                then v * (A $ (from_nat j) $ (from_nat j)) else A $ a $ b)"
 
 lemma diagonal_step_code [code abstract]:
   "vec_nth (diagonal_step_row A i j c v a) = (%b. if a = from_nat i \<and> b = from_nat i then c else 
                if a = from_nat j \<and> b = from_nat j 
                then v * (A $ (from_nat j) $ (from_nat j)) else A $ a $ b)"
   unfolding diagonal_step_row_def by auto 
 
 lemma diagonal_step_code_nth [code abstract]: "vec_nth (diagonal_step A i j c v) 
   = diagonal_step_row A i j c v"
   unfolding diagonal_step_def unfolding diagonal_step_row_def[abs_def]
   by auto
 
 text\<open>Code equation to avoid recalculations when computing the Bezout coefficients. \<close>
 lemma euclid_ext2_code[code]:
  "euclid_ext2 a b = (let ((p,q),d) = euclid_ext a b in (p,q, - b div d, a div d, d))"
   unfolding euclid_ext2_def split_beta Let_def 
   by auto
 
 subsection\<open>Examples of execution\<close>
 
 value "let A= list_of_list_to_matrix [[12,0,0::int],[0,6,0::int],[0,0,2::int]]::int^3^3 
   in matrix_to_list_of_list (diagonal_to_Smith A euclid_ext2)"
 
 text\<open>Example obtained from:
 \url{https://math.stackexchange.com/questions/77063/how-do-i-get-this-matrix-in-smith-normal-form-and-is-smith-normal-form-unique}
 \<close>
 
 value "let A= list_of_list_to_matrix 
     [
     [[:-3,1:],0,0,0],
     [0,[:1,1:],0,0],
     [0,0,[:1,1:],0],
     [0,0,0,[:1,1:]]]::rat poly^4^4 
   in matrix_to_list_of_list (diagonal_to_Smith A euclid_ext2)"
 
 
 text\<open>Polynomial matrix\<close>
 value "let A = list_of_list_to_matrix 
       [
         [[:-3,1:],0,0,0],
         [0,[:1,1:],0,0],
         [0,0,[:1,1:],0],
         [0,0,0,[:1,1:]],
         [0,0,0,0]]::rat poly^4^5 
   in matrix_to_list_of_list (diagonal_to_Smith A euclid_ext2)"
 
 
 subsection\<open>Soundness of the algorithm\<close>
 
 lemma nrows_diagonal_step[simp]: "nrows (diagonal_step A i j c v) = nrows A"
   by (simp add: nrows_def)
 
 lemma ncols_diagonal_step[simp]: "ncols (diagonal_step A i j c v) = ncols A"
   by (simp add: ncols_def)
 
 
 context
   fixes bezout::"'a::{bezout_ring} \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a"
   assumes ib: "is_bezout_ext bezout"
 begin
 
 lemma split_beta_bezout: "bezout a b = 
   (fst(bezout a b),
   fst (snd (bezout a b)),
   fst (snd(snd (bezout a b))),
   fst (snd(snd(snd (bezout a b)))),
   snd (snd(snd(snd (bezout a b)))))" unfolding split_beta by (auto simp add: split_beta)
 
 text\<open>The following lemma shows that @{text "diagonal_to_Smith_i"} preserves the previous element. 
   We use the assumption @{text "to_nat a = to_nat b"} in order to ensure that we are treating with 
   a diagonal entry. Since the matrix could be rectangular, the types of a and b can be different, 
   and thus we cannot write either @{text "a = b"} or @{text "A $ a $ b"}.\<close>
 
 lemma diagonal_to_Smith_i_preserves_previous_diagonal:
   fixes A::"'a:: {bezout_ring}^'b::mod_type^'c::mod_type"
   assumes i_min: "i < min (nrows A) (ncols A)" 
   and "to_nat a \<notin> set xs" and "to_nat a = to_nat b"
   and "to_nat a \<noteq> i"
   and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)"
   shows "(diagonal_to_Smith_i xs A i bezout) $ a $ b = A $ a $ b" 
   using assms
 proof (induct xs A i bezout rule: diagonal_to_Smith_i.induct)
   case (1 A i bezout)
   then show ?case by auto
 next
   case (2 j xs A i bezout)   
   let ?Aii = "A $ from_nat i $ from_nat i"
   let ?Ajj = "A $ from_nat j $ from_nat j"
   let ?p="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?A'="diagonal_step A i j ?d ?v" 
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   show ?case
   proof (cases "?Aii dvd ?Ajj")
     case True
     then show ?thesis
       using "2.hyps" "2.prems" by auto
   next
     case False
     note i_min = 2(3)
     note hyp = 2(2)
     note i_notin = 2(4)
     note a_eq_b = "2.prems"(3)
     note elements_xs = 2(7)
     note a_not_i = 2(6)    
     have a_not_j: "a \<noteq> from_nat j"
       by (metis elements_xs i_notin list.set_intros(1) min_less_iff_conj nrows_def to_nat_from_nat_id)
     have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs ?A' i bezout"
       using False by (auto simp add: split_beta)
     also have "... $ a $ b = ?A' $ a $ b" 
       by (rule hyp[OF False], insert i_notin i_min a_eq_b a_not_i pquvd elements_xs, auto)
     also have "... = A $ a $ b"
       unfolding diagonal_step_def
       using a_not_j a_not_i
-      by (smt i_min min.strict_boundedE nrows_def to_nat_from_nat_id vec_lambda_beta)
+      by (smt (verit, del_insts) i_min min_less_iff_conj nrows_def
+          to_nat_from_nat_id vec_lambda_unique)
     finally show ?thesis .
   qed
 qed
 
 lemma diagonal_step_dvd1[simp]:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type" and j i
   defines "v==case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   and "d==case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
  shows "diagonal_step A i j d v $ from_nat i $ from_nat i dvd A $ from_nat i $ from_nat i"
   using ib unfolding is_bezout_ext_def diagonal_step_def v_def d_def 
   by (auto simp add: split_beta)
 
 lemma diagonal_step_dvd2[simp]:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type" and j i
   defines "v==case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   and "d==case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
  shows "diagonal_step A i j d v $ from_nat i $ from_nat i dvd A $ from_nat j $ from_nat j"
   using ib unfolding is_bezout_ext_def diagonal_step_def v_def d_def 
   by (auto simp add: split_beta)
 
 end
 
 text\<open>Once the step is carried out, the new element ${A'}_{ii}$ will divide the element $A_{ii}$\<close>
 
 lemma diagonal_to_Smith_i_dvd_ii:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
   shows "diagonal_to_Smith_i xs A i bezout $ from_nat i $ from_nat i dvd A $ from_nat i $ from_nat i"
   using ib
 proof (induct xs A i bezout rule: diagonal_to_Smith_i.induct)
   case (1 A i bezout)
   then show ?case by auto
 next
   case (2 j xs A i bezout)   
   let ?Aii = "A $ from_nat i $ from_nat i"
   let ?Ajj = "A $ from_nat j $ from_nat j"
   let ?p="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?A'="diagonal_step A i j ?d ?v" 
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   note ib = "2.prems"(1) 
   show ?case
   proof (cases "?Aii dvd ?Ajj")
     case True
     then show ?thesis 
       using "2.hyps"(1) "2.prems" by auto
   next
     case False
     note hyp = "2.hyps"(2)    
     have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs ?A' i bezout" 
       using False by (auto simp add: split_beta)
     also have "... $ from_nat i $ from_nat i dvd ?A' $ from_nat i $ from_nat i"
       by (rule hyp[OF False], insert pquvd ib, auto)
     also have "... dvd A $ from_nat i $ from_nat i" 
       unfolding diagonal_step_def using ib unfolding is_bezout_ext_def
       by (auto simp add: split_beta) 
     finally show ?thesis .
   qed
 qed
 
 text\<open>Once the step is carried out, the new element ${A'}_{ii}$ 
   divides the rest of elements of the diagonal. This proof requires commutativity (already
   included in the type restriction @{text "bezout_ring"}).\<close>
 
 lemma diagonal_to_Smith_i_dvd_jj:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
   and i_min: "i < min (nrows A) (ncols A)" 
   and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)"
   and "to_nat a \<in> set xs"
   and "to_nat a = to_nat b"
   and "to_nat a \<noteq> i"
   and "distinct xs"
 shows "(diagonal_to_Smith_i xs A i bezout) $ (from_nat i) $ (from_nat i) 
        dvd (diagonal_to_Smith_i xs A i bezout) $ a $ b"   
   using assms
 proof (induct xs A i bezout rule: diagonal_to_Smith_i.induct)
   case (1 A i)
   then show ?case by auto
 next
   case (2 j xs A i bezout)     
   let ?Aii = "A $ from_nat i $ from_nat i"
   let ?Ajj = "A $ from_nat j $ from_nat j"
   let ?p="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?A'="diagonal_step A i j ?d ?v" 
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   note ib = "2.prems"(1) 
   note to_nat_a_not_i = 2(8)
   note i_min = 2(4)  
   note elements_xs = "2.prems"(3)
   note a_eq_b = "2.prems"(5)
   note a_in_j_xs = 2(6)
   note distinct = 2(9)
   show ?case
   proof (cases "?Aii dvd ?Ajj")    
     case True note Aii_dvd_Ajj = True
     show ?thesis 
     proof (cases "to_nat a = j")
       case True
       have a: "a = (from_nat j::'c)" using True by auto
       have b: "b = (from_nat j::'b)"
         using True a_eq_b by auto
       have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs A i bezout" 
         using Aii_dvd_Ajj by auto
       also have "... $ from_nat j $ from_nat j = A $ from_nat j $ from_nat j" 
       proof (rule diagonal_to_Smith_i_preserves_previous_diagonal[OF ib i_min])          
         show "to_nat (from_nat j::'c) \<notin> set xs" using True a_in_j_xs distinct by auto
         show "to_nat (from_nat j::'c) = to_nat (from_nat j::'b)"
           by (metis True a_eq_b from_nat_to_nat_id)
         show "to_nat (from_nat j::'c) \<noteq> i"
           using True to_nat_a_not_i by auto
         show "\<forall>x. x \<in> set xs \<longrightarrow> x < min (nrows A) (ncols A)" using elements_xs by auto
       qed
       finally have "diagonal_to_Smith_i (j # xs) A i bezout $ from_nat j $ from_nat j 
         = A $ from_nat j $ from_nat j " .
       hence "diagonal_to_Smith_i (j # xs) A i bezout $ a $ b = ?Ajj" unfolding a b .
       moreover have "diagonal_to_Smith_i (j # xs) A i bezout $ from_nat i $ from_nat i dvd ?Aii" 
         by (rule diagonal_to_Smith_i_dvd_ii[OF ib])
       ultimately show ?thesis using Aii_dvd_Ajj dvd_trans by auto
     next
       case False
       have a_in_xs: "to_nat a \<in> set xs" using False using "2.prems"(4) by auto
       have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs A i bezout" 
         using True by auto
       also have "...  $ (from_nat i) $ (from_nat i) dvd diagonal_to_Smith_i xs A i bezout $ a $ b" 
         by (rule "2.hyps"(1)[OF True ib i_min _ a_in_xs a_eq_b to_nat_a_not_i]) 
            (insert elements_xs distinct, auto)
       finally show ?thesis .
     qed
   next
     case False note Aii_not_dvd_Ajj = False    
     show ?thesis
     proof (cases "to_nat a \<in> set xs")
       case True note a_in_xs = True    
       have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs ?A' i bezout" 
         using False by (auto simp add: split_beta)
       also have "... $ from_nat i $ from_nat i dvd diagonal_to_Smith_i xs ?A' i bezout $ a $ b"
         by (rule "2.hyps"(2)[OF False _ _ _ _ _ _ _ _ _ a_in_xs a_eq_b to_nat_a_not_i ])
            (insert elements_xs distinct i_min ib pquvd, auto simp add: nrows_def ncols_def)    
       finally show ?thesis .    
     next
       case False
       have to_nat_a_eq_j: "to_nat a = j"
         using False a_in_j_xs by auto
       have a: "a = (from_nat j::'c)" using to_nat_a_eq_j by auto
       have b: "b = (from_nat j::'b)" using to_nat_a_eq_j a_eq_b by auto
       have d_eq: "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs ?A' i bezout" 
         using Aii_not_dvd_Ajj by (simp add: split_beta)
       also have "... $ a $ b = ?A' $ a $ b"
         by (rule diagonal_to_Smith_i_preserves_previous_diagonal[OF ib _ False a_eq_b to_nat_a_not_i])
            (insert i_min elements_xs ib, auto)
       finally have "diagonal_to_Smith_i (j # xs) A i bezout $ a $ b = ?A' $ a $ b" .
       moreover have "diagonal_to_Smith_i (j # xs) A i bezout $ from_nat i $ from_nat i 
         dvd ?A' $ from_nat i $ from_nat i" 
         using d_eq diagonal_to_Smith_i_dvd_ii[OF ib] by simp
       moreover have "?A' $ from_nat i $ from_nat i dvd ?A' $ from_nat j $ from_nat j" 
         unfolding diagonal_step_def using ib unfolding is_bezout_ext_def split_beta
         by (auto, meson dvd_mult)+      
       ultimately show ?thesis using dvd_trans a b by auto        
   qed
 qed
 qed
 
 
 text\<open>The step preserves everything that is not in the diagonal\<close>
 
 lemma diagonal_to_Smith_i_preserves_previous:
   fixes A::"'a:: {bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
     and i_min: "i < min (nrows A) (ncols A)"
   and a_not_b: "to_nat a \<noteq> to_nat b"
   and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)"
   shows "(diagonal_to_Smith_i xs A i bezout) $ a $ b = A $ a $ b" 
   using assms
 proof (induct xs A i bezout rule: diagonal_to_Smith_i.induct)
 case (1 A i)
   then show ?case by auto
 next  
   case (2 j xs A i bezout)     
   let ?Aii = "A $ from_nat i $ from_nat i"
   let ?Ajj = "A $ from_nat j $ from_nat j"
   let ?p="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?A'="diagonal_step A i j ?d ?v" 
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   note ib = "2.prems"(1) 
   show ?case
   proof (cases "?Aii dvd ?Ajj")
     case True
     then show ?thesis 
       using "2.hyps"(1) "2.prems" by auto
   next
     case False
     note hyp = "2.hyps"(2)
     have a1: "a = from_nat i \<longrightarrow> b \<noteq> from_nat i" 
       by (metis "2.prems" a_not_b from_nat_not_eq min.strict_boundedE ncols_def nrows_def)
     have a2: "a = from_nat j \<longrightarrow> b \<noteq> from_nat j"       
       by (metis "2.prems" a_not_b list.set_intros(1) min_less_iff_conj 
           ncols_def nrows_def to_nat_from_nat_id)
     have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs ?A' i bezout" 
       using False by (simp add: split_beta)
     also have "... $ a $ b = ?A' $ a $ b"
       by (rule hyp[OF False], insert "2.prems" ib pquvd, auto)
     also have "... = A $ a $ b" unfolding diagonal_step_def using a1 a2 by auto
     finally show ?thesis .
   qed
 qed
 
 
 lemma diagonal_step_preserves:
   fixes A::"'a::{times}^'b::mod_type^'c::mod_type"
   assumes ai: "a \<noteq> i" and aj: "a \<noteq> j" and a_min: "a < min (nrows A) (ncols A)" 
     and i_min: "i < min (nrows A) (ncols A)"
   and j_min: "j < min (nrows A) (ncols A)"
   shows "diagonal_step A i j d v $ from_nat a $ from_nat b = A $ from_nat a $ from_nat b"
 proof -
   have 1: "(from_nat a::'c) \<noteq> from_nat i"
     by (metis a_min ai from_nat_eq_imp_eq i_min min.strict_boundedE nrows_def)
   have 2: "(from_nat a::'c) \<noteq> from_nat j"
     by (metis a_min aj from_nat_eq_imp_eq j_min min.strict_boundedE nrows_def)
   show ?thesis
     using 1 2 unfolding diagonal_step_def by auto
 qed
 
 context GCD_ring
 begin
 
 lemma gcd_greatest: 
   assumes "is_gcd gcd'" and "c dvd a" and "c dvd b" 
   shows "c dvd gcd' a b" 
   using assms is_gcd_def by blast
 
 end
 
 
 text\<open>This is a key lemma for the soundness of the algorithm.\<close>
 
 lemma diagonal_to_Smith_i_dvd:
   fixes A::"'a:: {bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
   and i_min: "i < min (nrows A) (ncols A)"
   and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)"
   and "\<forall>a b. to_nat a\<in>insert i (set xs) \<and> to_nat a = to_nat b \<longrightarrow> 
       A $ (from_nat c) $ (from_nat c) dvd A $ a $ b"
   and "c \<notin> (set xs)" and c: "c<min (nrows A) (ncols A)"
   and "distinct xs"
   shows "A $ (from_nat c) $ (from_nat c) dvd 
   (diagonal_to_Smith_i xs A i bezout) $ (from_nat i) $ (from_nat i)" 
   using assms
 proof (induct xs A i bezout rule: diagonal_to_Smith_i.induct)
   case (1 A i)
   then show ?case
     by (auto simp add: ncols_def nrows_def to_nat_from_nat_id)
 next
   case (2 j xs A i bezout)
   let ?Aii = "A $ from_nat i $ from_nat i"
   let ?Ajj = "A $ from_nat j $ from_nat j"
   let ?p="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?A'="diagonal_step A i j ?d ?v" 
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   note ib = "2.prems"(1) 
   show ?case
   proof (cases "?Aii dvd ?Ajj")    
     case True note Aii_dvd_Ajj = True
     show ?thesis using True
       using "2.hyps" "2.prems" by force      
   next
     case False 
     let ?Acc = "A $ from_nat c $ from_nat c" 
     let ?D="diagonal_step A i j ?d ?v"
     note hyp = "2.hyps"(2)  
     note dvd_condition = "2.prems"(4)
     note a_eq_b = "2.hyps"
     have 1: "(from_nat c::'c) \<noteq> from_nat i"
       by (metis "2.prems" False c insert_iff list.set_intros(1) 
           min.strict_boundedE ncols_def nrows_def to_nat_from_nat_id)
     have 2: "(from_nat c::'c) \<noteq> from_nat j"
       by (metis  "2.prems" c insertI1 list.simps(15) min_less_iff_conj nrows_def 
           to_nat_from_nat_id)       
     have "?D $ from_nat c $ from_nat c = ?Acc"
       unfolding diagonal_step_def using 1 2 by auto
     have aux: "?D $ from_nat c $ from_nat c dvd ?D $ a $ b"
       if a_in_set: "to_nat a \<in> insert i (set xs)" and ab: "to_nat a = to_nat b" for a b      
     proof -
      have Acc_dvd_Aii: "?Acc dvd ?Aii"
        by (metis "2.prems"(2) "2.prems"(4) insert_iff min.strict_boundedE 
            ncols_def nrows_def to_nat_from_nat_id)
      moreover have Acc_dvd_Ajj: "?Acc dvd ?Ajj"
        by (metis "2.prems"(3) "2.prems"(4) insert_iff list.set_intros(1) 
            min_less_iff_conj ncols_def nrows_def to_nat_from_nat_id)
      ultimately have Acc_dvd_gcd: "?Acc dvd ?d"
        by (metis (mono_tags, lifting) ib is_gcd_def is_gcd_is_bezout_ext)
      show ?thesis 
       using 1 2 Acc_dvd_Ajj Acc_dvd_Aii Acc_dvd_gcd a_in_set ab dvd_condition 
       unfolding diagonal_step_def by auto     
   qed   
     have "?A' $ from_nat c $ from_nat c = A $ from_nat c $ from_nat c" 
       unfolding diagonal_step_def using 1 2 by auto
     moreover have "?A' $ from_nat c $ from_nat c 
       dvd diagonal_to_Smith_i xs ?A' i bezout $ from_nat i $ from_nat i"
       by (rule hyp[OF False _ _ _ _ _ _ ib]) 
          (insert nrows_def ncols_def "2.prems" "2.hyps" aux pquvd, auto)
     ultimately show ?thesis using False by (auto simp add: split_beta)
   qed
 qed
 
 
 lemma diagonal_to_Smith_i_dvd2:
   fixes A::"'a:: {bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout" 
   and i_min: "i < min (nrows A) (ncols A)"
   and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)"
   and dvd_condition: "\<forall>a b. to_nat a \<in> insert i (set xs) \<and> to_nat a = to_nat b \<longrightarrow> 
       A $ (from_nat c) $ (from_nat c) dvd A $ a $ b"
   and c_notin: "c \<notin> (set xs)" 
   and c: "c < min (nrows A) (ncols A)"
   and distinct: "distinct xs"
   and ab: "to_nat a = to_nat b" 
   and a_in: "to_nat a \<in> insert i (set xs)"
   shows "A $ (from_nat c) $ (from_nat c) dvd (diagonal_to_Smith_i xs A i bezout) $ a $ b" 
 proof (cases "a = from_nat i")
   case True
   hence b: "b = from_nat i"
     by (metis ab from_nat_to_nat_id i_min min_less_iff_conj nrows_def to_nat_from_nat_id)
   show ?thesis by (unfold True b, rule diagonal_to_Smith_i_dvd, insert assms, auto)
 next
   case False
   have ai: "to_nat a \<noteq> i" using False by auto
   hence bi: "to_nat b \<noteq> i" by (simp add: ab)
   have "A $ (from_nat c) $ (from_nat c) dvd (diagonal_to_Smith_i xs A i bezout) $ from_nat i $ from_nat i"
     by (rule diagonal_to_Smith_i_dvd, insert assms, auto)
   also have "... dvd (diagonal_to_Smith_i xs A i bezout) $ a $ b" 
     by (rule diagonal_to_Smith_i_dvd_jj, insert assms False ai bi, auto)
   finally show ?thesis .
 qed
 
 
 lemma diagonal_to_Smith_i_dvd2_k:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout" 
   and i_min: "i < min (nrows A) (ncols A)"
   and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<k" and "k\<le>min (nrows A) (ncols A)"
   and dvd_condition: "\<forall>a b. to_nat a \<in> insert i (set xs) \<and> to_nat a = to_nat b \<longrightarrow> 
       A $ (from_nat c) $ (from_nat c) dvd A $ a $ b"
   and c_notin: "c \<notin> (set xs)" 
   and c: "c < min (nrows A) (ncols A)"
   and distinct: "distinct xs"
   and ab: "to_nat a = to_nat b" 
   and a_in: "to_nat a \<in> insert i (set xs)"
   shows "A $ (from_nat c) $ (from_nat c) dvd (diagonal_to_Smith_i xs A i bezout) $ a $ b" 
 proof (cases "a = from_nat i")
   case True
   hence b: "b = from_nat i"
     by (metis ab from_nat_to_nat_id i_min min_less_iff_conj nrows_def to_nat_from_nat_id)
   show ?thesis by (unfold True b, rule diagonal_to_Smith_i_dvd, insert assms, auto)
 next
   case False
   have ai: "to_nat a \<noteq> i" using False by auto
   hence bi: "to_nat b \<noteq> i" by (simp add: ab)
   have "A $ (from_nat c) $ (from_nat c) dvd (diagonal_to_Smith_i xs A i bezout) $ from_nat i $ from_nat i"
     by (rule diagonal_to_Smith_i_dvd, insert assms, auto)
   also have "... dvd (diagonal_to_Smith_i xs A i bezout) $ a $ b" 
     by (rule diagonal_to_Smith_i_dvd_jj, insert assms False ai bi, auto)
   finally show ?thesis .
 qed
 
 
 
 lemma diagonal_to_Smith_row_i_preserves_previous:
   fixes A::"'a:: {bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
   and i_min: "i < min (nrows A) (ncols A)"
   and a_not_b: "to_nat a \<noteq> to_nat b"  
   shows "Diagonal_to_Smith_row_i A i bezout $ a $ b = A $ a $ b" 
     unfolding Diagonal_to_Smith_row_i_def
     by (rule diagonal_to_Smith_i_preserves_previous, insert assms, auto)
 
 
 lemma diagonal_to_Smith_row_i_preserves_previous_diagonal:
   fixes A::"'a:: {bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
   and i_min: "i < min (nrows A) (ncols A)"  
   and a_notin: "to_nat a \<notin> set [i + 1..<min (nrows A) (ncols A)]"
   and ab: "to_nat a = to_nat b"
   and ai: "to_nat a \<noteq> i" 
   shows "Diagonal_to_Smith_row_i A i bezout $ a $ b = A $ a $ b" 
   unfolding Diagonal_to_Smith_row_i_def
   by (rule diagonal_to_Smith_i_preserves_previous_diagonal[OF ib i_min a_notin ab ai], auto)
 
 context
   fixes bezout::"'a::{bezout_ring} \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a"
   assumes ib: "is_bezout_ext bezout"
 begin
 
 lemma diagonal_to_Smith_row_i_dvd_jj:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes "to_nat a \<in> {i..<min (nrows A) (ncols A)}"
   and "to_nat a = to_nat b"
   shows "(Diagonal_to_Smith_row_i A i bezout) $ (from_nat i) $ (from_nat i) 
           dvd (Diagonal_to_Smith_row_i A i bezout) $ a $ b"
 proof (cases "to_nat a = i")
   case True
   then show ?thesis
     by (metis assms(2) dvd_refl from_nat_to_nat_id)
 next
   case False
   show ?thesis 
     unfolding Diagonal_to_Smith_row_i_def 
     by (rule diagonal_to_Smith_i_dvd_jj, insert assms False ib, auto)
 qed
 
 
 lemma diagonal_to_Smith_row_i_dvd_ii:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   shows "Diagonal_to_Smith_row_i A i bezout $ from_nat i $ from_nat i dvd A $ from_nat i $ from_nat i"
   unfolding Diagonal_to_Smith_row_i_def
   by (rule diagonal_to_Smith_i_dvd_ii[OF ib])
 
 
 lemma diagonal_to_Smith_row_i_dvd_jj':
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes a_in: "to_nat a \<in> {i..<min (nrows A) (ncols A)}"
   and ab: "to_nat a = to_nat b" 
   and ci: "c\<le>i"
   and dvd_condition: "\<forall>a b. to_nat a \<in> (set [i..<min (nrows A) (ncols A)]) \<and> to_nat a = to_nat b 
     \<longrightarrow> A $ from_nat c $ from_nat c dvd A $ a $ b"
   shows "(Diagonal_to_Smith_row_i A i bezout) $ (from_nat c) $ (from_nat c) 
           dvd (Diagonal_to_Smith_row_i A i bezout) $ a $ b"
 proof (cases "c = i")
   case True
   then show ?thesis using assms True diagonal_to_Smith_row_i_dvd_jj
     by metis
   next
   case False
   hence ci2: "c<i" using ci by auto
   have 1: "to_nat (from_nat c::'c) \<notin> (set [i+1..<min (nrows A) (ncols A)])"    
     by (metis Suc_eq_plus1 ci atLeastLessThan_iff from_nat_mono 
         le_imp_less_Suc less_irrefl less_le_trans set_upt to_nat_le to_nat_less_card)
   have 2: "to_nat (from_nat c) \<noteq> i"
     using ci2 from_nat_mono to_nat_less_card by fastforce
   have 3: "to_nat (from_nat c::'c) = to_nat (from_nat c::'b)"
     by (metis a_in ab atLeastLessThan_iff ci dual_order.strict_trans2 to_nat_from_nat_id to_nat_less_card)
   have "(Diagonal_to_Smith_row_i A i bezout) $ (from_nat c) $ (from_nat c) 
     = A $(from_nat c) $ (from_nat c)"
     unfolding Diagonal_to_Smith_row_i_def 
     by (rule diagonal_to_Smith_i_preserves_previous_diagonal[OF ib _ 1 3 2], insert assms, auto)
   also have "... dvd (Diagonal_to_Smith_row_i A i bezout) $ a $ b"
     unfolding Diagonal_to_Smith_row_i_def 
     by (rule diagonal_to_Smith_i_dvd2, insert assms False ci ib, auto)  
   finally show ?thesis .
 qed
 end
 
 
 lemma diagonal_to_Smith_aux_append:
   "diagonal_to_Smith_aux A (xs @ ys) bezout 
     = diagonal_to_Smith_aux (diagonal_to_Smith_aux A xs bezout) ys bezout"
   by (induct A xs bezout rule: diagonal_to_Smith_aux.induct, auto)
  
 
 lemma diagonal_to_Smith_aux_append2[simp]:
   "diagonal_to_Smith_aux A (xs @ [ys]) bezout 
     = Diagonal_to_Smith_row_i (diagonal_to_Smith_aux A xs bezout) ys bezout"
   by (induct A xs bezout rule: diagonal_to_Smith_aux.induct, auto)  
 
 
 lemma isDiagonal_eq_upt_k_min:
 "isDiagonal A = isDiagonal_upt_k A (min (nrows A) (ncols A))" 
   unfolding isDiagonal_def isDiagonal_upt_k_def nrows_def ncols_def  
   by (auto, meson less_trans not_less_iff_gr_or_eq to_nat_less_card)
 
 
 lemma isDiagonal_eq_upt_k_max:
 "isDiagonal A = isDiagonal_upt_k A (max (nrows A) (ncols A))" 
   unfolding isDiagonal_def isDiagonal_upt_k_def nrows_def ncols_def  
   by (auto simp add: less_max_iff_disj to_nat_less_card)
 
 lemma isDiagonal: 
   assumes "isDiagonal A"
     and "to_nat a \<noteq> to_nat b" shows "A $ a $ b = 0" 
   using assms unfolding isDiagonal_def by auto
 
 lemma nrows_diagonal_to_Smith_aux[simp]: 
   shows "nrows (diagonal_to_Smith_aux A xs bezout) = nrows A" unfolding nrows_def by auto
 
 lemma ncols_diagonal_to_Smith_aux[simp]:
   shows "ncols (diagonal_to_Smith_aux A xs bezout) = ncols A" unfolding ncols_def by auto
 
 context
   fixes bezout::"'a::{bezout_ring} \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a"
   assumes ib: "is_bezout_ext bezout"
 begin
 
 lemma isDiagonal_diagonal_to_Smith_aux:
   assumes diag_A: "isDiagonal A" and k: "k < min (nrows A) (ncols A)"
   shows "isDiagonal (diagonal_to_Smith_aux A [0..<k] bezout)"
   using k
 proof (induct k)
   case 0
   then show ?case using diag_A by auto
 next
   case (Suc k)
   have "Diagonal_to_Smith_row_i (diagonal_to_Smith_aux A [0..<k] bezout) k bezout $ a $ b = 0" 
     if a_not_b: "to_nat a \<noteq> to_nat b" for a b
   proof -
     have "Diagonal_to_Smith_row_i (diagonal_to_Smith_aux A [0..<k] bezout) k bezout $ a $ b 
       = (diagonal_to_Smith_aux A [0..<k] bezout) $ a $ b"
       by (rule diagonal_to_Smith_row_i_preserves_previous[OF ib _ a_not_b], insert Suc.prems, auto)
     also have "... = 0" 
       by (rule isDiagonal[OF Suc.hyps a_not_b], insert Suc.prems, auto)
     finally show ?thesis .
   qed
   thus ?case unfolding isDiagonal_def by auto
 qed
 end
 
 (*TODO: move!*)
 lemma to_nat_less_nrows[simp]:
   fixes A::"'a^'b::mod_type^'c::mod_type"
     and a::'c
   shows "to_nat a < nrows A"
   by (simp add: nrows_def to_nat_less_card)
 
 lemma to_nat_less_ncols[simp]:
   fixes A::"'a^'b::mod_type^'c::mod_type"
     and a::'b
   shows "to_nat a < ncols A"
   by (simp add: ncols_def to_nat_less_card)
 
 context
   fixes bezout::"'a::{bezout_ring} \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a"
   assumes ib: "is_bezout_ext bezout"
 begin
 
 text\<open>The variables a and b must be arbitrary in the induction\<close>
 lemma diagonal_to_Smith_aux_dvd:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ab: "to_nat a = to_nat b"
   and c: "c < k" and ca: "c \<le> to_nat a" and k: "k<min (nrows A) (ncols A)"
   shows "diagonal_to_Smith_aux A [0..<k] bezout $ from_nat c $ from_nat c
     dvd diagonal_to_Smith_aux A [0..<k] bezout $ a $ b"
   using c ab ca k
 proof (induct k arbitrary: a b)
   case 0
   then show ?case by auto
 next
   case (Suc k)
   note c = Suc.prems(1)
   note ab = Suc.prems(2)
   note ca = Suc.prems(3)
   note k = Suc.prems(4)
   have k_min: "k < min (nrows A) (ncols A)" using k by auto
   have a_less_ncols: "to_nat a < ncols A" using ab by auto
   show ?case
   proof (cases "c=k")
     case True
     hence k: "k\<le>to_nat a" using ca by auto
     show ?thesis unfolding True
       by (auto, rule diagonal_to_Smith_row_i_dvd_jj[OF ib _ ab], insert k a_less_ncols, auto)  
   next
     case False note c_not_k = False
     let ?Dk="diagonal_to_Smith_aux A [0..<k] bezout"
     have ck: "c<k" using Suc.prems False by auto
     have hyp: "?Dk $ from_nat c $ from_nat c dvd ?Dk $ a $ b" 
       by (rule Suc.hyps[OF ck ab ca k_min])
     have Dkk_Daa_bb: "?Dk $ from_nat c $ from_nat c dvd ?Dk $ aa $ bb"
       if "to_nat aa \<in> set [k..<min (nrows ?Dk) (ncols ?Dk)]" and "to_nat aa = to_nat bb"
       for aa bb using Suc.hyps ck k_min that(1) that(2) by auto
     show ?thesis  
     proof (cases "k\<le>to_nat a")
       case True
       show ?thesis
         by (auto, rule diagonal_to_Smith_row_i_dvd_jj'[OF ib _ ab]) 
            (insert True a_less_ncols ck Dkk_Daa_bb, force+)       
     next
       case False
       have "diagonal_to_Smith_aux A [0..<Suc k] bezout $ from_nat c $ from_nat c 
         = Diagonal_to_Smith_row_i ?Dk k bezout $ from_nat c $ from_nat c" by auto
       also have "... = ?Dk $ from_nat c $ from_nat c" 
       proof (rule diagonal_to_Smith_row_i_preserves_previous_diagonal[OF ib])
         show "k < min (nrows ?Dk) (ncols ?Dk)" using k by auto
         show "to_nat (from_nat c::'c) = to_nat (from_nat c::'b)"
           by (metis assms(2) assms(4) less_trans min_less_iff_conj 
              ncols_def nrows_def to_nat_from_nat_id)
         show "to_nat (from_nat c::'c) \<noteq> k"
           using False ca from_nat_mono' to_nat_less_card to_nat_mono' by fastforce      
         show "to_nat (from_nat c::'c) \<notin> set [k + 1..<min (nrows ?Dk) (ncols ?Dk)]"
           by (metis Suc_eq_plus1 atLeastLessThan_iff c ca from_nat_not_eq 
               le_less_trans not_le set_upt to_nat_less_card)
       qed
       also have "... dvd ?Dk $ a $ b" using hyp .
       also have "... = Diagonal_to_Smith_row_i ?Dk k bezout $ a $ b"
         by (rule diagonal_to_Smith_row_i_preserves_previous_diagonal[symmetric, OF ib _ _ ab])
            (insert False k, auto)
       also have "... = diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b" by auto
       finally show ?thesis .
     qed
   qed
 qed
 
 
 lemma Smith_normal_form_upt_k_Suc_imp_k:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes s: "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<Suc k] bezout) k"
   and k: "k<min (nrows A) (ncols A)"
   shows "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<k] bezout) k"
 proof (rule Smith_normal_form_upt_k_intro) 
   let ?Dk="diagonal_to_Smith_aux A [0..<k] bezout"
   fix a::'c and b::'b assume "to_nat a = to_nat b \<and> to_nat a + 1 < k \<and> to_nat b + 1 < k"
   hence ab: "to_nat a = to_nat b" and ak: "to_nat a + 1 < k" and bk: "to_nat b + 1 < k" by auto  
   have a_not_k: "to_nat a \<noteq> k" using ak by auto    
   have a1_less_k1: "to_nat a + 1 < k + 1" using ak by linarith
   have "?Dk $a $ b = diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b"
     by (auto, rule diagonal_to_Smith_row_i_preserves_previous_diagonal[symmetric, OF ib _ _ ab a_not_k]) 
        (insert ak k, auto)
   also have "... dvd diagonal_to_Smith_aux A [0..<Suc k] bezout $ (a + 1) $ (b + 1)" 
     using ab ak bk s unfolding Smith_normal_form_upt_k_def by auto
   also have "... = ?Dk $ (a+1) $ (b+1)"
   proof (auto, rule diagonal_to_Smith_row_i_preserves_previous_diagonal[OF ib])
     show "to_nat (a + 1) \<noteq> k" using ak
       by (metis add_less_same_cancel2 nat_neq_iff not_add_less2 to_nat_0 
          to_nat_plus_one_less_card' to_nat_suc)
     show "to_nat (a + 1) = to_nat (b + 1)"
       by (metis ab ak from_nat_suc from_nat_to_nat_id k less_asym' min_less_iff_conj 
           ncols_def nrows_def suc_not_zero to_nat_from_nat_id to_nat_plus_one_less_card')
     show "to_nat (a + 1) \<notin> set [k + 1..<min (nrows ?Dk) (ncols ?Dk)]"      
       by (metis a1_less_k1 add_to_nat_def atLeastLessThan_iff k less_asym' min.strict_boundedE 
           not_less nrows_def set_upt suc_not_zero to_nat_1 to_nat_from_nat_id to_nat_plus_one_less_card')
     show "k < min (nrows ?Dk) (ncols ?Dk)" using k by auto
   qed
   finally show "?Dk $ a $ b dvd ?Dk $ (a+1) $ (b+1)" .
 next
   let ?Dk="diagonal_to_Smith_aux A [0..<k] bezout"
   fix a::'c and b::'b
   assume "to_nat a \<noteq> to_nat b \<and> (to_nat a < k \<or> to_nat b < k)" 
   hence ab: "to_nat a \<noteq> to_nat b" and ak_bk: "(to_nat a < k \<or> to_nat b < k)" by auto
   have "?Dk $a $ b = diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b"
     by (auto, rule diagonal_to_Smith_row_i_preserves_previous[symmetric, OF ib _ ab], insert k, auto)
   also have "... = 0"
     using ab ak_bk s unfolding Smith_normal_form_upt_k_def isDiagonal_upt_k_def 
     by auto
   finally show "?Dk $ a $ b = 0" .
 qed
 
 
 lemma Smith_normal_form_upt_k_le:
   assumes "a\<le>k" and "Smith_normal_form_upt_k A k"
   shows "Smith_normal_form_upt_k A a" using assms
-  by (smt Smith_normal_form_upt_k_def isDiagonal_upt_k_def less_le_trans)
+  by (smt (verit) Smith_normal_form_upt_k_def isDiagonal_upt_k_def less_le_trans)
 
 lemma Smith_normal_form_upt_k_imp_Suc_k:
   assumes s: "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<k] bezout) k"
   and k: "k<min (nrows A) (ncols A)"
   shows "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<Suc k] bezout) k"
 proof (rule Smith_normal_form_upt_k_intro)
   let ?Dk="diagonal_to_Smith_aux A [0..<k] bezout"
   fix a::'c and b::'b assume "to_nat a = to_nat b \<and> to_nat a + 1 < k \<and> to_nat b + 1 < k"
   hence ab: "to_nat a = to_nat b" and ak: "to_nat a + 1 < k" and bk: "to_nat b + 1 < k" by auto
   have a_not_k: "to_nat a \<noteq> k" using ak by auto    
   have a1_less_k1: "to_nat a + 1 < k + 1" using ak by linarith
   have "diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b = ?Dk $a $ b"
     by (auto, rule diagonal_to_Smith_row_i_preserves_previous_diagonal[OF ib _ _ ab a_not_k]) 
        (insert ak k, auto)
   also have "... dvd ?Dk $ (a+1) $ (b+1)"
     using s ak k ab unfolding Smith_normal_form_upt_k_def by auto
   also have "... = diagonal_to_Smith_aux A [0..<Suc k] bezout $ (a + 1) $ (b + 1)" 
   proof (auto, rule diagonal_to_Smith_row_i_preserves_previous_diagonal[symmetric, OF ib])
     show "to_nat (a + 1) \<noteq> k" using ak
       by (metis add_less_same_cancel2 nat_neq_iff not_add_less2 to_nat_0 
          to_nat_plus_one_less_card' to_nat_suc)
     show "to_nat (a + 1) = to_nat (b + 1)"
       by (metis ab ak from_nat_suc from_nat_to_nat_id k less_asym' min_less_iff_conj 
           ncols_def nrows_def suc_not_zero to_nat_from_nat_id to_nat_plus_one_less_card')
     show "to_nat (a + 1) \<notin> set [k + 1..<min (nrows ?Dk) (ncols ?Dk)]"      
       by (metis a1_less_k1 add_to_nat_def to_nat_plus_one_less_card' less_asym' min.strict_boundedE 
           not_less nrows_def set_upt suc_not_zero to_nat_1 to_nat_from_nat_id atLeastLessThan_iff k)
     show "k < min (nrows ?Dk) (ncols ?Dk)" using k by auto
   qed
   finally show "diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b 
     dvd diagonal_to_Smith_aux A [0..<Suc k] bezout $ (a + 1) $ (b + 1)" .
 next
   let ?Dk="diagonal_to_Smith_aux A [0..<k] bezout"
   fix a::'c and b::'b
   assume "to_nat a \<noteq> to_nat b \<and> (to_nat a < k \<or> to_nat b < k)" 
   hence ab: "to_nat a \<noteq> to_nat b" and ak_bk: "(to_nat a < k \<or> to_nat b < k)" by auto
   have "diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b = ?Dk $a $ b"
     by (auto, rule diagonal_to_Smith_row_i_preserves_previous[OF ib _ ab], insert k, auto)
   also have "... = 0"
     using ab ak_bk s unfolding Smith_normal_form_upt_k_def isDiagonal_upt_k_def 
     by auto
   finally show "diagonal_to_Smith_aux A [0..<Suc k] bezout $ a $ b = 0" .
 qed
 
 corollary Smith_normal_form_upt_k_Suc_eq:
   assumes k: "k<min (nrows A) (ncols A)"
   shows "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<Suc k] bezout) k 
     = Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<k] bezout) k"  
   using Smith_normal_form_upt_k_Suc_imp_k Smith_normal_form_upt_k_imp_Suc_k k 
   by blast
 
 end
 
 lemma nrows_diagonal_to_Smith_i[simp]: "nrows (diagonal_to_Smith_i xs A i bezout) = nrows A"
   by (induct xs A i bezout rule: diagonal_to_Smith_i.induct, auto simp add: nrows_def)
 
 lemma ncols_diagonal_to_Smith_i[simp]: "ncols (diagonal_to_Smith_i xs A i bezout) = ncols A"
   by (induct xs A i bezout rule: diagonal_to_Smith_i.induct, auto simp add: ncols_def)
 
 lemma nrows_Diagonal_to_Smith_row_i[simp]: "nrows (Diagonal_to_Smith_row_i A i bezout) = nrows A" 
   unfolding Diagonal_to_Smith_row_i_def by auto
 
 lemma ncols_Diagonal_to_Smith_row_i[simp]: "ncols (Diagonal_to_Smith_row_i A i bezout) = ncols A" 
   unfolding Diagonal_to_Smith_row_i_def by auto
 
 lemma isDiagonal_diagonal_step:
   assumes diag_A: "isDiagonal A" and i: "i<min (nrows A) (ncols A)"
     and j: "j<min (nrows A) (ncols A)"
   shows "isDiagonal (diagonal_step A i j d v)"
 proof -
   have i_eq: "to_nat (from_nat i::'b) = to_nat (from_nat i::'c)" using i
     by (simp add: ncols_def nrows_def to_nat_from_nat_id)
   moreover have j_eq: "to_nat (from_nat j::'b) = to_nat (from_nat j::'c)" using j
     by (simp add: ncols_def nrows_def to_nat_from_nat_id)
     ultimately show ?thesis
     using assms
     unfolding isDiagonal_def diagonal_step_def by auto
 qed
 
 lemma isDiagonal_diagonal_to_Smith_i:
   assumes "isDiagonal A"
     and elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)" 
     and "i<min (nrows A) (ncols A)"
   shows "isDiagonal (diagonal_to_Smith_i xs A i bezout)"
   using assms
 proof (induct xs A i bezout rule: diagonal_to_Smith_i.induct)
   case (1 A i bezout)
   then show ?case by auto
 next
   case (2 j xs A i bezout)  
   let ?Aii = "A $ from_nat i $ from_nat i"
   let ?Ajj = "A $ from_nat j $ from_nat j"
   let ?p="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?A'="diagonal_step A i j ?d ?v" 
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   show ?case 
   proof (cases "?Aii dvd ?Ajj")
     case True
     thus ?thesis
         using "2.hyps" "2.prems" by auto
   next
     case False
     have "diagonal_to_Smith_i (j # xs) A i bezout = diagonal_to_Smith_i xs ?A' i bezout" 
       using False by (simp add: split_beta) 
     also have "isDiagonal ..." thm "2.prems"
     proof (rule "2.hyps"(2)[OF False])
       show "isDiagonal
         (diagonal_step A i j ?d ?v)" by (rule isDiagonal_diagonal_step, insert "2.prems", auto)
     qed (insert pquvd "2.prems", auto)
     finally show ?thesis .
   qed  
 qed
 
 
 lemma isDiagonal_Diagonal_to_Smith_row_i:
   assumes "isDiagonal A" and "i < min (nrows A) (ncols A)"
   shows "isDiagonal (Diagonal_to_Smith_row_i A i bezout)"   
   using assms isDiagonal_diagonal_to_Smith_i
   unfolding Diagonal_to_Smith_row_i_def by force
 
 
 lemma isDiagonal_diagonal_to_Smith_aux_general:
   assumes elements_xs_range: "\<forall>x. x \<in> set xs \<longrightarrow> x<min (nrows A) (ncols A)" 
   and "isDiagonal A"
 shows "isDiagonal (diagonal_to_Smith_aux A xs bezout)"
   using assms
 proof (induct A xs bezout rule: diagonal_to_Smith_aux.induct)
   case (1 A)
   then show ?case by auto
 next
   case (2 A i xs bezout)  
   note k = "2.prems"(1)
   note elements_xs_range = "2.prems"(2)
   have "diagonal_to_Smith_aux A (i # xs) bezout 
   = diagonal_to_Smith_aux (Diagonal_to_Smith_row_i A i bezout) xs bezout" 
     by auto
   also have "isDiagonal (...)"
     by (rule "2.hyps", insert isDiagonal_Diagonal_to_Smith_row_i "2.prems" k, auto)   
   finally show ?case .
 qed
 
 context
   fixes bezout::"'a::{bezout_ring} \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a \<times> 'a \<times> 'a"
   assumes ib: "is_bezout_ext bezout"
 begin
 
 text\<open>The algorithm is iterated up to position k (not included). Thus, the matrix
 is in Smith normal form up to position k (not included).\<close>
 
 lemma Smith_normal_form_upt_k_diagonal_to_Smith_aux:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes "k<min (nrows A) (ncols A)" and d: "isDiagonal A"
   shows "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<k] bezout) k"
   using assms
 proof (induct k)
   case 0
   then show ?case by auto
 next
   case (Suc k)
   note Suc_k = "Suc.prems"(1)
   have hyp: "Smith_normal_form_upt_k (diagonal_to_Smith_aux A [0..<k] bezout) k"
     by (rule Suc.hyps, insert Suc.prems, simp)
   have k: "k < min (nrows A) (ncols A)" using Suc.prems by auto
   let ?A = "diagonal_to_Smith_aux A [0..<k] bezout"
   let ?D_Suck = "diagonal_to_Smith_aux A [0..<Suc k] bezout"
   have set_rw: "[0..<Suc k] = [0..<k] @ [k]" by auto
   show ?case
   proof (rule Smith_normal_form_upt_k1_intro_diagonal)
     show "Smith_normal_form_upt_k (?D_Suck) k"
       by (rule Smith_normal_form_upt_k_imp_Suc_k[OF ib hyp k])
     show "?D_Suck $ from_nat (k - 1) $ from_nat (k - 1) dvd ?D_Suck $ from_nat k $ from_nat k"
     proof (rule diagonal_to_Smith_aux_dvd[OF ib _ _ _ Suc_k])
       show "to_nat (from_nat k::'c) = to_nat (from_nat k::'b)"
         by (metis k min_less_iff_conj ncols_def nrows_def to_nat_from_nat_id)
       show "k - 1 \<le> to_nat (from_nat k::'c)"
         by (metis diff_le_self k min_less_iff_conj nrows_def to_nat_from_nat_id)
     qed auto
     show "isDiagonal (diagonal_to_Smith_aux A [0..<Suc k] bezout)"
       by (rule isDiagonal_diagonal_to_Smith_aux[OF ib d Suc_k])
   qed
 qed
 
 end
 
 lemma nrows_diagonal_to_Smith[simp]: "nrows (diagonal_to_Smith A bezout) = nrows A"
   unfolding diagonal_to_Smith_def by auto
 
 lemma ncols_diagonal_to_Smith[simp]: "ncols (diagonal_to_Smith A bezout) = ncols A"
   unfolding diagonal_to_Smith_def by auto
 
 lemma isDiagonal_diagonal_to_Smith:
   assumes d: "isDiagonal A"
   shows "isDiagonal (diagonal_to_Smith A bezout)"
   unfolding diagonal_to_Smith_def 
   by (rule isDiagonal_diagonal_to_Smith_aux_general[OF _ d], auto)
 
 text\<open>This is the soundess lemma.\<close>
 
 lemma Smith_normal_form_diagonal_to_Smith:
   fixes A::"'a::{bezout_ring}^'b::mod_type^'c::mod_type"
   assumes ib: "is_bezout_ext bezout"
   and d: "isDiagonal A"
   shows "Smith_normal_form (diagonal_to_Smith A bezout)"
 proof -
   let ?k = "min (nrows A) (ncols A) - 2"
   let ?Dk = "(diagonal_to_Smith_aux A [0..<?k] bezout)"
   have min_eq: "min (nrows A) (ncols A) - 1 = Suc ?k" 
     by (metis Suc_1 Suc_diff_Suc min_less_iff_conj ncols_def nrows_def to_nat_1 to_nat_less_card)
   have set_rw: "[0..<min (nrows A) (ncols A) - 1] = [0..<?k] @ [?k]" 
     unfolding min_eq by auto    
   have d2: "isDiagonal (diagonal_to_Smith A bezout)" 
     by (rule isDiagonal_diagonal_to_Smith[OF d])
   have smith_Suc_k: "Smith_normal_form_upt_k (diagonal_to_Smith A bezout) (Suc ?k)" 
   proof (rule Smith_normal_form_upt_k1_intro_diagonal[OF _ d2])
     have "diagonal_to_Smith A bezout = diagonal_to_Smith_aux A [0..<min (nrows A) (ncols A) - 1] bezout" 
       unfolding diagonal_to_Smith_def by auto
     also have "... = Diagonal_to_Smith_row_i ?Dk ?k bezout" 
       unfolding set_rw
       unfolding diagonal_to_Smith_aux_append2 by auto
     finally have d_rw: "diagonal_to_Smith A bezout = Diagonal_to_Smith_row_i ?Dk ?k bezout" .
     have "Smith_normal_form_upt_k ?Dk ?k" 
       by (rule Smith_normal_form_upt_k_diagonal_to_Smith_aux[OF ib _ d], insert min_eq, linarith)
     thus "Smith_normal_form_upt_k (diagonal_to_Smith A bezout) ?k" unfolding d_rw 
       by (metis Smith_normal_form_upt_k_Suc_eq Suc_1 ib d_rw diagonal_to_Smith_def diff_0_eq_0 
           diff_less min_eq not_gr_zero zero_less_Suc)        
     show "diagonal_to_Smith A bezout $ from_nat (?k - 1) $ from_nat (?k - 1) dvd
           diagonal_to_Smith A bezout $ from_nat ?k $ from_nat ?k"
     proof (unfold diagonal_to_Smith_def, rule diagonal_to_Smith_aux_dvd[OF ib])
       show "?k - 1 < min (nrows A) (ncols A) - 1"
         using min_eq by linarith
       show "min (nrows A) (ncols A) - 1 < min (nrows A) (ncols A)" using min_eq by linarith
       thus "to_nat (from_nat ?k::'c) = to_nat (from_nat ?k::'b)"
         by (metis (mono_tags, lifting) Suc_lessD min_eq min_less_iff_conj 
             ncols_def nrows_def to_nat_from_nat_id)
       show "?k - 1 \<le> to_nat (from_nat ?k::'c)"         
         by (metis (no_types, lifting) diff_le_self from_nat_not_eq lessI less_le_trans 
             min.cobounded1 min_eq nrows_def)     
     qed
   qed
   have s_eq: "Smith_normal_form (diagonal_to_Smith A bezout) 
      = Smith_normal_form_upt_k (diagonal_to_Smith A bezout) 
     (Suc (min (nrows (diagonal_to_Smith A bezout)) (ncols (diagonal_to_Smith A bezout)) - 1))"
     unfolding Smith_normal_form_min by (simp add: ncols_def nrows_def)
   let ?min1="(min (nrows (diagonal_to_Smith A bezout)) (ncols (diagonal_to_Smith A bezout)) - 1)"
   show ?thesis unfolding s_eq
   proof (rule Smith_normal_form_upt_k1_intro_diagonal[OF _ d2])
     show "Smith_normal_form_upt_k (diagonal_to_Smith A bezout) ?min1"
       using smith_Suc_k min_eq by auto   
     have "diagonal_to_Smith A bezout $ from_nat ?k $ from_nat ?k 
       dvd diagonal_to_Smith A bezout $ from_nat (?k + 1) $ from_nat (?k + 1)"
-      by (smt One_nat_def Suc_eq_plus1 ib Suc_pred diagonal_to_Smith_aux_dvd diagonal_to_Smith_def 
+      by (smt (verit) One_nat_def Suc_eq_plus1 ib Suc_pred diagonal_to_Smith_aux_dvd diagonal_to_Smith_def 
           le_add1 lessI min_eq min_less_iff_conj ncols_def nrows_def to_nat_from_nat_id zero_less_card_finite)
     thus "diagonal_to_Smith A bezout $ from_nat (?min1 - 1) $ from_nat (?min1 - 1) 
       dvd diagonal_to_Smith A bezout $ from_nat ?min1 $ from_nat ?min1" 
       using min_eq by auto
   qed
 qed
 
 subsection\<open>Implementation and formal proof 
   of the matrices $P$ and $Q$ which transform the input matrix by means of elementary operations.\<close>
 
 
 fun diagonal_step_PQ :: "'a::{bezout_ring}^'cols::mod_type^'rows::mod_type \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a bezout \<Rightarrow> 
 (
 ('a::{bezout_ring}^'rows::mod_type^'rows::mod_type) \<times>
 ('a::{bezout_ring}^'cols::mod_type^'cols::mod_type)
 )"
   where "diagonal_step_PQ A i k bezout = 
   (let  i_row = from_nat i; k_row = from_nat k; i_col = from_nat i; k_col = from_nat k;
         (p, q, u, v, d) = bezout (A $ i_row $ from_nat i) (A $ k_row $ from_nat k);
         P = row_add (interchange_rows (row_add (mat 1) k_row i_row p) i_row k_row) k_row i_row (-v);
         Q = mult_column (column_add (column_add (mat 1) i_col k_col q) k_col i_col u) k_col (-1)
         in (P,Q)
         )"
 
 text\<open>Examples\<close>
 
 value "let A = list_of_list_to_matrix [[12,0,0::int],[0,6,0::int],[0,0,2::int]]::int^3^3;
             i=0; k=1;
            (p, q, u, v, d) = euclid_ext2 (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k);
             (P,Q) = diagonal_step_PQ A i k euclid_ext2
   in matrix_to_list_of_list (diagonal_step A i k d v)"
 
 value "let A = list_of_list_to_matrix [[12,0,0::int],[0,6,0::int],[0,0,2::int]]::int^3^3;
             i=0; k=1;
            (p, q, u, v, d) = euclid_ext2 (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k);
             (P,Q) = diagonal_step_PQ A i k euclid_ext2
   in matrix_to_list_of_list (P**(A)**Q)"
 
 
 value "let A = list_of_list_to_matrix [[12,0,0::int],[0,6,0::int],[0,0,2::int]]::int^3^3;
             i=0; k=1;
            (p, q, u, v, d) = euclid_ext2 (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k);
             (P,Q) = diagonal_step_PQ A i k euclid_ext2
   in matrix_to_list_of_list (P**(A)**Q)"
 
 
 lemmas diagonal_step_PQ_def = diagonal_step_PQ.simps
 
 lemma from_nat_neq_rows:
   fixes A::"'a^'cols::mod_type^'rows::mod_type"
   assumes i: "i<(nrows A)" and k: "k<(nrows A)" and ik: "i \<noteq> k"
   shows "from_nat i \<noteq> (from_nat k::'rows)"
 proof (rule ccontr, auto)
   let ?i="from_nat i::'rows"
   let ?k="from_nat k::'rows"
   assume "?i = ?k"
   hence "to_nat ?i = to_nat ?k" by auto
   hence "i = k" 
     unfolding to_nat_from_nat_id[OF i[unfolded nrows_def]] 
     unfolding to_nat_from_nat_id[OF k[unfolded nrows_def]] .
   thus False using ik by contradiction
 qed
 
 
 lemma from_nat_neq_cols:
   fixes A::"'a^'cols::mod_type^'rows::mod_type"
   assumes i: "i<(ncols A)" and k: "k<(ncols A)" and ik: "i \<noteq> k"
   shows "from_nat i \<noteq> (from_nat k::'cols)"
 proof (rule ccontr, auto)
   let ?i="from_nat i::'cols"
   let ?k="from_nat k::'cols"
   assume "?i = ?k"
   hence "to_nat ?i = to_nat ?k" by auto
   hence "i = k" 
     unfolding to_nat_from_nat_id[OF i[unfolded ncols_def]] 
     unfolding to_nat_from_nat_id[OF k[unfolded ncols_def]] .
   thus False using ik by contradiction
 qed
 
 
 
 lemma diagonal_step_PQ_invertible_P:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
   and pquvd: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   and i_not_k: "i \<noteq> k" 
   and i: "i<min (nrows A) (ncols A)" and k: "k<min (nrows A) (ncols A)"
 shows "invertible P"
 proof -
   let ?step1 = "(row_add (mat 1) (from_nat k::'rows) (from_nat i) p)"
   let ?step2 = "interchange_rows ?step1 (from_nat i) (from_nat k)"
   let ?step3 = "row_add (?step2) (from_nat k) (from_nat i) (- v)"
   have p: "p = fst (bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k))"
     using pquvd by (metis fst_conv)
   have v: "-v = (- fst (snd (snd (snd (bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k))))))"
     using pquvd by (metis fst_conv snd_conv)
   have i_not_k2: "from_nat k \<noteq> (from_nat i::'rows)" 
     by (rule from_nat_neq_rows, insert i k i_not_k, auto)
   have "invertible ?step3" 
   unfolding row_add_mat_1[of _ _ _ ?step2, symmetric] 
   proof (rule invertible_mult)
     show "invertible (row_add (mat 1) (from_nat k::'rows) (from_nat i) (- v))"
       by (rule invertible_row_add[OF i_not_k2])          
     show "invertible ?step2"      
       by (metis i_not_k2 interchange_rows_mat_1 invertible_interchange_rows
           invertible_mult invertible_row_add)
   qed
   thus ?thesis
     using PQ p v unfolding diagonal_step_PQ_def Let_def split_beta 
     by auto
 qed
 
 
 
 lemma diagonal_step_PQ_invertible_Q:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
   and pquvd: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   and i_not_k: "i \<noteq> k" 
   and i: "i<min (nrows A) (ncols A)" and k: "k<min (nrows A) (ncols A)"
 shows "invertible Q"
 proof -
   let ?step1 = "column_add (mat 1) (from_nat i::'cols) (from_nat k) q"
   let ?step2 = "column_add ?step1 (from_nat k) (from_nat i) u"
   let ?step3 = "mult_column ?step2 (from_nat k) (- 1)"
   have u: "u = (fst (snd (snd (bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)))))"
     by (metis fst_conv pquvd snd_conv)
   have q: "q = (fst (snd (bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k))))"
     by (metis fst_conv pquvd snd_conv)
   have "invertible ?step3"
     unfolding column_add_mat_1[of _ _ _ ?step2, symmetric] 
     unfolding mult_column_mat_1[of  ?step2, symmetric]
   proof (rule invertible_mult)
     show "invertible (mult_column (mat 1) (from_nat k::'cols) (- 1::'a))"
       by (rule invertible_mult_column[of _ "-1"], auto)
     show "invertible ?step2"
       by (metis column_add_mat_1 i i_not_k invertible_column_add invertible_mult k 
           min_less_iff_conj ncols_def to_nat_from_nat_id)
   qed
   thus ?thesis 
     using PQ pquvd u q unfolding diagonal_step_PQ_def
     by (auto simp add: Let_def split_beta)
 qed
 
 lemma mat_q_1[simp]: "mat q $ a $ a = q" unfolding mat_def by auto
 
 lemma mat_q_0[simp]:
   assumes ab: "a \<noteq> b" 
   shows "mat q $ a $ b = 0" using ab unfolding mat_def by auto
 
 text\<open>This is an alternative definition for the matrix P in each step, where entries are 
   given explicitly instead of being computed as a composition of elementary operations. \<close>
 
 lemma diagonal_step_PQ_P_alt:
 fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
   and pquvd: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   and i: "i<min (nrows A) (ncols A)" and k: "k<min (nrows A) (ncols A)" and ik: "i \<noteq> k"
 shows "
   P = (\<chi> a b. 
   if a = from_nat i \<and> b = from_nat i then p else 
   if a = from_nat i \<and> b = from_nat k then 1 else
   if a = from_nat k \<and> b = from_nat i then -v * p + 1 else
   if a = from_nat k \<and> b = from_nat k then -v else
   if a = b then 1 else 0)"
 proof -  
   have ik1: "from_nat i \<noteq> (from_nat k::'rows)"
     using from_nat_neq_rows i ik k by auto
   have "P $ a $ b =
               (if a = from_nat i \<and> b = from_nat i then p
                else if a = from_nat i \<and> b = from_nat k then 1
                     else if a = from_nat k \<and> b = from_nat i then - v * p + 1
                          else if a = from_nat k \<and> b = from_nat k then - v else if a = b then 1 else 0)" 
     for a b
       using PQ ik1  pquvd  
       unfolding diagonal_step_PQ_def 
       unfolding row_add_def interchange_rows_def
       by (auto simp add: Let_def split_beta)
          (metis (mono_tags, opaque_lifting) fst_conv snd_conv)+
     thus ?thesis unfolding vec_eq_iff unfolding vec_lambda_beta by auto
 qed
 
 
 text\<open>This is an alternative definition for the matrix Q in each step, where entries are
   given explicitly instead of being computed as a composition of elementary operations.\<close>
 
 lemma diagonal_step_PQ_Q_alt:
 fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
   and pquvd: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   and i: "i<min (nrows A) (ncols A)" and k: "k<min (nrows A) (ncols A)" and ik: "i \<noteq> k"
 shows "
   Q = (\<chi> a b. 
   if a = from_nat i \<and> b = from_nat i then 1 else 
   if a = from_nat i \<and> b = from_nat k then -u else
   if a = from_nat k \<and> b = from_nat i then q else
   if a = from_nat k \<and> b = from_nat k then -q*u-1 else
   if a = b then 1 else 0)"
 proof -
   have ik1: "from_nat i \<noteq> (from_nat k::'cols)"
     using from_nat_neq_cols i ik k by auto
   have "Q $ a $ b =
   (if a = from_nat i \<and> b = from_nat i then 1 else 
   if a = from_nat i \<and> b = from_nat k then -u else
   if a = from_nat k \<and> b = from_nat i then q else
   if a = from_nat k \<and> b = from_nat k then -q*u-1 else
   if a = b then 1 else 0)"  for a b
   using PQ ik1 pquvd unfolding diagonal_step_PQ_def
   unfolding column_add_def mult_column_def
   by (auto simp add: Let_def split_beta)
      (metis (mono_tags, opaque_lifting) fst_conv snd_conv)+
   thus ?thesis unfolding vec_eq_iff unfolding vec_lambda_beta by auto
 qed
   
 text\<open>P**A can be rewriten as elementary operations over A.\<close>
 
 lemma diagonal_step_PQ_PA:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
     and b: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
 shows "P**A = row_add (interchange_rows 
   (row_add A (from_nat k) (from_nat i) p) (from_nat i) (from_nat k)) (from_nat k) (from_nat i) (- v)" 
 proof -
   let ?i_row = "from_nat i::'rows" and ?k_row = "from_nat k::'rows"
   let ?P1 = "row_add (mat 1) ?k_row ?i_row p"
   let ?P2' = "interchange_rows ?P1 ?i_row ?k_row"
   let ?P2 = "interchange_rows (mat 1) (from_nat i) (from_nat k)"
   let ?P3 = "row_add (mat 1) (from_nat k) (from_nat i) (- v)"
   have "P = row_add ?P2' ?k_row ?i_row (- v)"
     using PQ b unfolding diagonal_step_PQ_def 
     by (auto simp add: Let_def split_beta, metis fstI sndI)
   also have "... = ?P3 ** ?P2'" 
     unfolding row_add_mat_1[of _ _ _ ?P2', symmetric] by auto
   also have "... = ?P3 ** (?P2 ** ?P1)" 
     unfolding interchange_rows_mat_1[of _ _ ?P1, symmetric] by auto  
   also have "... ** A = row_add (interchange_rows 
   (row_add A (from_nat k) (from_nat i) p) (from_nat i) (from_nat k)) (from_nat k) (from_nat i) (- v)"
     by (metis interchange_rows_mat_1 matrix_mul_assoc row_add_mat_1)
   finally show ?thesis .
 qed
 
 
 lemma diagonal_step_PQ_PAQ':
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
     and b: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   shows "P**A**Q = (mult_column (column_add (column_add (P**A) (from_nat i) (from_nat k) q) 
                    (from_nat k) (from_nat i) u) (from_nat k) (- 1))" 
 proof -
   let ?i_col = "from_nat i::'cols" and ?k_col = "from_nat k::'cols"
   let ?Q1="(column_add (mat 1) ?i_col ?k_col q)"
   let ?Q2' = "(column_add ?Q1 ?k_col ?i_col u)"
   let ?Q2 = "column_add (mat 1) (from_nat k) (from_nat i) u"
   let ?Q3 = "mult_column (mat 1) (from_nat k) (- 1)"
   have "Q = mult_column ?Q2' ?k_col (-1)"
     using PQ b unfolding diagonal_step_PQ_def 
     by (auto simp add: Let_def split_beta, metis fstI sndI)
   also have "... = ?Q2' ** ?Q3" 
     unfolding mult_column_mat_1[of ?Q2', symmetric] by auto
   also have "... = (?Q1**?Q2)**?Q3" 
     unfolding column_add_mat_1[of ?Q1, symmetric] by auto
   also have " (P**A) **  ((?Q1**?Q2)**?Q3) = 
     (mult_column (column_add (column_add (P**A) ?i_col ?k_col q) ?k_col ?i_col u) ?k_col (- 1))"
     by (metis (no_types, lifting) column_add_mat_1 matrix_mul_assoc mult_column_mat_1)
   finally show ?thesis .
 qed
 
 corollary diagonal_step_PQ_PAQ:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
     and b: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   shows "P**A**Q = (mult_column (column_add (column_add (row_add (interchange_rows 
                     (row_add A (from_nat k) (from_nat i) p) (from_nat i) 
                     (from_nat k)) (from_nat k) (from_nat i) (- v)) (from_nat i) (from_nat k) q) 
                    (from_nat k) (from_nat i) u) (from_nat k) (- 1))"
   using diagonal_step_PQ_PA diagonal_step_PQ_PAQ' assms by metis
 
 lemma isDiagonal_imp_0: 
   assumes "isDiagonal A"
   and "from_nat a \<noteq> from_nat b"
   and "a < min (nrows A) (ncols A)"
   and "b < min (nrows A) (ncols A)"
   shows "A $ from_nat a $ from_nat b = 0" 
   by (metis assms isDiagonal min.strict_boundedE ncols_def nrows_def to_nat_from_nat_id)
 
 
 
 lemma diagonal_step_PQ:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes PQ: "(P,Q) = diagonal_step_PQ A i k bezout"
     and b: "(p,q,u,v,d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat k $ from_nat k)"
   and i: "i<min (nrows A) (ncols A)" and k: "k<min (nrows A) (ncols A)" and ik: "i \<noteq> k"
   and ib: "is_bezout_ext bezout" and diag: "isDiagonal A"
   shows "diagonal_step A i k d v = P**A**Q"
 proof -
   let ?i_row = "from_nat i::'rows" 
     and ?k_row = "from_nat k::'rows" and ?i_col = "from_nat i::'cols" and ?k_col = "from_nat k::'cols"
   let ?P1 = "(row_add (mat 1) ?k_row ?i_row p)"
   let ?Aii = "A $ ?i_row $ ?i_col"
   let ?Akk = "A $ ?k_row $ ?k_col"
   have k1: "k<ncols A" and k2: "k<nrows A" and i1: "i<nrows A" and i2: "i<ncols A" using i k by auto
   have Aik0: "A $ ?i_row $ ?k_col = 0"
     by (metis diag i ik isDiagonal k min.strict_boundedE ncols_def nrows_def to_nat_from_nat_id)
   have Aki0: "A $ ?k_row $ ?i_col = 0"
     by (metis diag i ik isDiagonal k min.strict_boundedE ncols_def nrows_def to_nat_from_nat_id)
   have du: "d * u = - A $ ?k_row $ ?k_col"
     using b ib unfolding is_bezout_ext_def 
     by (auto simp add: split_beta) (metis fst_conv snd_conv)
   have dv: "d * v = A $ ?i_row $ ?i_col"
     using b ib unfolding is_bezout_ext_def 
     by (auto simp add: split_beta) (metis fst_conv snd_conv)
   have d: "d = p * ?Aii + ?Akk * q" 
     using b ib unfolding is_bezout_ext_def 
     by (auto simp add: split_beta) (metis fst_conv mult.commute snd_conv)
   have "(?Aii - v * (p * ?Aii) - v * ?Akk * q) * u = (?Aii - v * ((p * ?Aii) + ?Akk * q)) * u"
       by (simp add: diff_diff_add distrib_left mult.assoc)
     also have "... = (?Aii*u - d* v *u)"
       by (simp add: mult.commute right_diff_distrib d)
     also have "... = 0" by (simp add: dv)
     finally have rw: "(?Aii - v * (p * ?Aii) - v * ?Akk * q) * u = 0" .
     have a1: "from_nat k \<noteq> (from_nat i::'rows)"
       using from_nat_neq_rows i ik k by auto
     have a2: "from_nat k \<noteq> (from_nat i::'cols)"
       using from_nat_neq_cols i ik k by auto
     have Aab0: "A $ a $ from_nat b = 0" if ab: "a \<noteq> from_nat b" and b_ncols: "b < ncols A" for a b
       by (metis ab b_ncols diag from_nat_to_nat_id isDiagonal ncols_def to_nat_from_nat_id)  
     have Aab0': "A $ from_nat a $ b = 0" if ab: "from_nat a \<noteq> b" and a_nrows: "a < nrows A" for a b
       by (metis ab a_nrows diag from_nat_to_nat_id isDiagonal nrows_def to_nat_from_nat_id)
   show ?thesis
   proof (unfold diagonal_step_def vec_eq_iff, auto)
     show "d = (P ** A ** Q) $ from_nat i $ from_nat i"
       and "d = (P ** A ** Q) $ from_nat i $ from_nat i"
       and "d = (P ** A ** Q) $ from_nat i $ from_nat i"
     unfolding diagonal_step_PQ_PAQ[OF PQ b] 
     unfolding mult_column_def column_add_def interchange_rows_def row_add_def 
       unfolding vec_lambda_beta using a1 a2
       using Aik0 Aki0 d by auto
     show "v * A $ from_nat k $ from_nat k = (P ** A ** Q) $ from_nat k $ from_nat k"
       and "v * A $ from_nat k $ from_nat k = (P ** A ** Q) $ from_nat k $ from_nat k"
       using a1 a2  
       unfolding diagonal_step_PQ_PAQ[OF PQ b] mult_column_def column_add_def 
       unfolding interchange_rows_def row_add_def 
       unfolding vec_lambda_beta unfolding Aik0 Aki0 by (auto simp add: rw)
     fix a::'rows and b::'cols 
     assume ak: "a \<noteq> from_nat k" and ai: "a \<noteq> from_nat i" 
     show "A $ a $ b = (P ** A ** Q) $ a $ b"
       using ai ak a1 a2 Aab0 k1 i2
       unfolding diagonal_step_PQ_PAQ[OF PQ b] 
       unfolding mult_column_def column_add_def interchange_rows_def row_add_def 
       unfolding vec_lambda_beta by auto
   next
     fix a::'rows and b::'cols 
     assume ak: "a \<noteq> from_nat k" and ai: "b \<noteq> from_nat i" 
     show "A $ a $ b = (P ** A ** Q) $ a $ b"
       using ai ak a1 a2 Aab0 Aab0' d du k1 k2 i1 i2
       unfolding diagonal_step_PQ_PAQ[OF PQ b] 
       unfolding mult_column_def column_add_def interchange_rows_def row_add_def 
       unfolding vec_lambda_beta by auto
   next
     fix a::'rows and b::'cols 
     assume ak: "b \<noteq> from_nat k" and ai: "a \<noteq> from_nat i" 
     show "A $ a $ b = (P ** A ** Q) $ a $ b"
       using ai ak a1 a2 Aab0 Aab0' d du k1 k2 i1 i2
       unfolding diagonal_step_PQ_PAQ[OF PQ b] 
       unfolding mult_column_def column_add_def interchange_rows_def row_add_def 
       unfolding vec_lambda_beta apply auto (*TODO: cleanup this sledeghammer proof*)
       proof -
         assume "d = p * ?Aii+ ?Akk* q"
         then have "v * (p * ?Aii) + v * (?Akk* q) = d * v"
           by (simp add: ring_class.ring_distribs(1) semiring_normalization_rules(7))
         then have "?Aii- v * (p * ?Aii) - v * (?Akk* q) = 0"
           by (simp add: diff_diff_add dv)
         then show "?Aii- v * (p * ?Aii) = v * ?Akk* q"
           by force
       qed
     next
     fix a::'rows and b::'cols 
     assume ak: "b \<noteq> from_nat k" and ai: "b \<noteq> from_nat i" 
     show "A $ a $ b = (P ** A ** Q) $ a $ b"
       using ai ak a1 a2 Aab0 Aab0' d du k1 k2 i1 i2
       unfolding diagonal_step_PQ_PAQ[OF PQ b] 
       unfolding mult_column_def column_add_def interchange_rows_def row_add_def 
       unfolding vec_lambda_beta by auto
   qed
 qed
 
 
 
 fun diagonal_to_Smith_i_PQ :: 
 "nat list \<Rightarrow> nat \<Rightarrow> ('a::{bezout_ring} bezout) 
   \<Rightarrow> (('a^'rows::mod_type^'rows::mod_type)\<times>('a^'cols::mod_type^'rows::mod_type)\<times> ('a^'cols::mod_type^'cols::mod_type))
   \<Rightarrow> (('a^'rows::mod_type^'rows::mod_type)\<times> ('a^'cols::mod_type^'rows::mod_type) \<times> ('a^'cols::mod_type^'cols::mod_type))"
  where
 "diagonal_to_Smith_i_PQ [] i bezout (P,A,Q) = (P,A,Q)" |
 "diagonal_to_Smith_i_PQ (j#xs) i bezout (P,A,Q) = (
   if A $ (from_nat i) $ (from_nat i) dvd A $ (from_nat j) $ (from_nat j) 
      then diagonal_to_Smith_i_PQ xs i bezout (P,A,Q)
   else let (p, q, u, v, d) = bezout (A $ from_nat i $ from_nat i) (A $ from_nat j $ from_nat j); 
            A' = diagonal_step A i j d v;
           (P',Q') = diagonal_step_PQ A i j bezout
       in diagonal_to_Smith_i_PQ xs i bezout (P'**P,A',Q**Q') \<comment> \<open>Apply the step\<close>
   )
   "
 
 
 text\<open>This is implemented by fun. This way, I can do pattern-matching for $(P,A,Q)$.\<close>
 
 fun Diagonal_to_Smith_row_i_PQ
   where "Diagonal_to_Smith_row_i_PQ i bezout (P,A,Q) 
   = diagonal_to_Smith_i_PQ [i + 1..<min (nrows A) (ncols A)] i bezout (P,A,Q)"
 
 
 text\<open>Deleted from the simplified and renamed as it would be a definition.\<close>
 
 declare Diagonal_to_Smith_row_i_PQ.simps[simp del]
 lemmas Diagonal_to_Smith_row_i_PQ_def = Diagonal_to_Smith_row_i_PQ.simps
 
 fun diagonal_to_Smith_aux_PQ 
   where
   "diagonal_to_Smith_aux_PQ [] bezout (P,A,Q) = (P,A,Q)" |
   "diagonal_to_Smith_aux_PQ (i#xs) bezout (P,A,Q) 
       = diagonal_to_Smith_aux_PQ xs bezout (Diagonal_to_Smith_row_i_PQ i bezout (P,A,Q))"
 
 
 lemma diagonal_to_Smith_aux_PQ_append:
   "diagonal_to_Smith_aux_PQ (xs @ ys) bezout (P,A,Q)
     = diagonal_to_Smith_aux_PQ ys bezout (diagonal_to_Smith_aux_PQ xs bezout (P,A,Q))"
   by (induct xs bezout "(P,A,Q)" arbitrary: P A Q rule: diagonal_to_Smith_aux_PQ.induct)
      (auto, metis prod_cases3)
 
 
 lemma diagonal_to_Smith_aux_PQ_append2[simp]:
   "diagonal_to_Smith_aux_PQ (xs @ [ys]) bezout (P,A,Q) 
     = Diagonal_to_Smith_row_i_PQ ys bezout (diagonal_to_Smith_aux_PQ xs bezout (P,A,Q))"
 proof (induct xs bezout "(P,A,Q)" arbitrary: P A Q rule: diagonal_to_Smith_aux_PQ.induct)
   case (1 bezout P A Q)
   then show ?case 
     by (metis append.simps(1) diagonal_to_Smith_aux_PQ.simps prod.exhaust)
 next
   case (2 i xs bezout P A Q)
   then show ?case
     by (metis (no_types, opaque_lifting) append_Cons diagonal_to_Smith_aux_PQ.simps(2) prod_cases3)
 qed 
 
 (*
 definition "diagonal_to_Smith_PQ A bezout 
   = diagonal_to_Smith_aux_PQ [0..<min (nrows A) (ncols A) - 1] bezout (mat 1, A, mat 1)"
 *)
 
 context
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type" (*This is the input matrix*)
   and B::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type" (*This is the matrix in each step*)
   and P and Q
   and bezout::"'a bezout"
   assumes PAQ: "P**A**Q = B"
   and P: "invertible P" and Q: "invertible Q"
   and ib: "is_bezout_ext bezout"
 begin
 
 text\<open>The output is the same as the one in the version where $P$ and $Q$ are not computed.\<close>
 
 lemma diagonal_to_Smith_i_PQ_eq:
   assumes P'B'Q': "(P',B',Q') = diagonal_to_Smith_i_PQ xs i bezout (P,B,Q)"
   and xs: "\<forall>x. x \<in> set xs \<longrightarrow> x < min (nrows A) (ncols A)" 
   and diag: "isDiagonal B" and i_notin: "i \<notin> set xs" and i: "i<min (nrows A) (ncols A)"
 shows "B' = diagonal_to_Smith_i xs B i bezout"     
   using assms PAQ ib P Q 
 proof (induct xs i bezout "(P,B,Q)" arbitrary: P B Q rule:diagonal_to_Smith_i_PQ.induct)
   case (1 i bezout P A Q)
   then show ?case by auto
 next
   case (2 j xs i bezout P B Q)
   let ?Bii = "B $ from_nat i $ from_nat i"
   let ?Bjj = "B $ from_nat j $ from_nat j"
   let ?p="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?B'="diagonal_step B i j ?d ?v" 
   let ?P' = "fst (diagonal_step_PQ B i j bezout)"
   let ?Q' = "snd (diagonal_step_PQ B i j bezout)"
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   note hyp = "2.hyps"(2)
     note P'B'Q' = "2.prems"(1)
     note i_min = "2.prems"(5)
     note PAQ_B = "2.prems"(6)
     note i_notin = "2.prems"(4)
     note diagB = "2.prems"(3)    
     note xs_min = "2.prems"(2)      
     note ib = "2.prems"(7)
     note inv_P = "2.prems"(8)
     note inv_Q = "2.prems"(9)
   show ?case
   proof (cases "?Bii dvd ?Bjj")
     case True    
     show ?thesis using "2.prems" "2.hyps"(1) True by auto
   next
     case False    
     have aux: "diagonal_to_Smith_i_PQ (j # xs) i bezout (P, B, Q) 
       = diagonal_to_Smith_i_PQ xs i bezout (?P'**P,?B', Q**?Q')"
       using False by (auto simp add: split_beta)
     have i: "i < min (nrows B) (ncols B)" using i_min unfolding nrows_def ncols_def by auto
     have j: "j < min (nrows B) (ncols B)" using xs_min unfolding nrows_def ncols_def by auto     
     have aux2: "diagonal_to_Smith_i(j # xs) B i bezout = diagonal_to_Smith_i xs ?B' i bezout"
       using False by (auto simp add: split_beta)
     have res: " B' = diagonal_to_Smith_i xs ?B' i bezout"
     proof (rule hyp[OF False])
       show "(P', B', Q') = diagonal_to_Smith_i_PQ xs i bezout (?P'**P,?B', Q**?Q')" 
         using aux P'B'Q' by auto
       have B'_P'B'Q': "?B' = ?P'**B**?Q'"
         by (rule diagonal_step_PQ[OF _ _ i j _ ib diagB], insert i_notin pquvd, auto)
       show "?P'**P ** A ** (Q**?Q') = ?B'"
         unfolding B'_P'B'Q' unfolding PAQ_B[symmetric]
         by (simp add: matrix_mul_assoc)       
       show "isDiagonal ?B'" by (rule isDiagonal_diagonal_step[OF diagB i j])
       show "invertible (?P'** P)"
         by (metis inv_P diagonal_step_PQ_invertible_P i i_notin in_set_member 
            invertible_mult j member_rec(1) prod.exhaust_sel)
       show "invertible (Q ** ?Q')"
         by (metis diagonal_step_PQ_invertible_Q i i_notin inv_Q 
             invertible_mult j list.set_intros(1) prod.collapse)
     qed (insert pquvd xs_min i_min i_notin ib, auto)
     show ?thesis using aux aux2 res by auto
   qed
 qed
 
 
 lemma diagonal_to_Smith_i_PQ':
   assumes P'B'Q': "(P',B',Q') = diagonal_to_Smith_i_PQ xs i bezout (P,B,Q)"
   and xs: "\<forall>x. x \<in> set xs \<longrightarrow> x < min (nrows A) (ncols A)" 
   and diag: "isDiagonal B" and i_notin: "i \<notin> set xs" and i: "i<min (nrows A) (ncols A)"
 shows "B' = P'**A**Q' \<and> invertible P' \<and> invertible Q'"
   using assms PAQ ib P Q
 proof (induct xs i bezout "(P,B,Q)" arbitrary: P B Q rule:diagonal_to_Smith_i_PQ.induct)
   case (1 i bezout)
   then show ?case using PAQ by auto
 next
   case (2 j xs i bezout P B Q)
   let ?Bii = "B $ from_nat i $ from_nat i"
   let ?Bjj = "B $ from_nat j $ from_nat j"
   let ?p="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> p"  
   let ?q="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> q"
   let ?u="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> u"
   let ?v="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> v"
   let ?d="case bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j) of (p,q,u,v,d) \<Rightarrow> d"
   let ?B'="diagonal_step B i j ?d ?v" 
   let ?P' = "fst (diagonal_step_PQ B i j bezout)"
   let ?Q' = "snd (diagonal_step_PQ B i j bezout)"
   have pquvd: "(?p, ?q, ?u, ?v,?d) = bezout (B $ from_nat i $ from_nat i) (B $ from_nat j $ from_nat j)"
     by (simp add: split_beta)
   show ?case
   proof (cases "?Bii dvd ?Bjj")
     case True    
     then show ?thesis using "2.prems"
       using "2.hyps"(1) by auto
   next
     case False
     note hyp = "2.hyps"(2)
     note P'B'Q' = "2.prems"(1)
     note i_min = "2.prems"(5)
     note PAQ_B = "2.prems"(6)
     note i_notin = "2.prems"(4)
     note diagB = "2.prems"(3)    
     note xs_min = "2.prems"(2)      
     note ib = "2.prems"(7)
     note inv_P = "2.prems"(8)
     note inv_Q = "2.prems"(9)
     have aux: "diagonal_to_Smith_i_PQ (j # xs) i bezout (P, B, Q) 
       = diagonal_to_Smith_i_PQ xs i bezout (?P'**P,?B', Q**?Q')"
       using False by (auto simp add: split_beta)
     have i: "i < min (nrows B) (ncols B)" using i_min unfolding nrows_def ncols_def by auto
     have j: "j < min (nrows B) (ncols B)" using xs_min unfolding nrows_def ncols_def by auto     
     show ?thesis
     proof (rule hyp[OF False])
       show "(P', B', Q') = diagonal_to_Smith_i_PQ xs i bezout (?P'**P,?B', Q**?Q')" 
         using aux P'B'Q' by auto
       have B'_P'B'Q': "?B' = ?P'**B**?Q'"
         by (rule diagonal_step_PQ[OF _ _ i j _ ib diagB], insert i_notin pquvd, auto)
       show "?P'**P ** A ** (Q**?Q') = ?B'"
         unfolding B'_P'B'Q' unfolding PAQ_B[symmetric]
         by (simp add: matrix_mul_assoc)       
       show "isDiagonal ?B'" by (rule isDiagonal_diagonal_step[OF diagB i j])
       show "invertible (?P'** P)"
         by (metis inv_P diagonal_step_PQ_invertible_P i i_notin in_set_member 
            invertible_mult j member_rec(1) prod.exhaust_sel)
       show "invertible (Q ** ?Q')"
         by (metis diagonal_step_PQ_invertible_Q i i_notin inv_Q 
             invertible_mult j list.set_intros(1) prod.collapse)
     qed (insert pquvd xs_min i_min i_notin ib, auto)    
   qed
 qed
 
 
 corollary diagonal_to_Smith_i_PQ:
   assumes P'B'Q': "(P',B',Q') = diagonal_to_Smith_i_PQ xs i bezout (P,B,Q)"
   and xs: "\<forall>x. x \<in> set xs \<longrightarrow> x < min (nrows A) (ncols A)" 
   and diag: "isDiagonal B" and i_notin: "i \<notin> set xs" and i: "i<min (nrows A) (ncols A)"
 shows "B' = P'**A**Q' \<and> invertible P' \<and> invertible Q' \<and> B' = diagonal_to_Smith_i xs B i bezout"
   using assms diagonal_to_Smith_i_PQ' diagonal_to_Smith_i_PQ_eq by metis
 
 lemma Diagonal_to_Smith_row_i_PQ_eq:
   assumes P'B'Q': "(P',B',Q') = Diagonal_to_Smith_row_i_PQ i bezout (P,B,Q)"
     and diag: "isDiagonal B" and i: "i < min (nrows A) (ncols A)"
   shows "B' = Diagonal_to_Smith_row_i B i bezout"
   using assms unfolding Diagonal_to_Smith_row_i_def Diagonal_to_Smith_row_i_PQ_def
   using diagonal_to_Smith_i_PQ by (auto simp add: nrows_def ncols_def)
 
 lemma Diagonal_to_Smith_row_i_PQ':
   assumes P'B'Q': "(P',B',Q') = Diagonal_to_Smith_row_i_PQ i bezout (P,B,Q)"
     and diag: "isDiagonal B" and i: "i < min (nrows A) (ncols A)"
   shows "B' = P'**A**Q' \<and> invertible P' \<and> invertible Q'"
   by (rule diagonal_to_Smith_i_PQ'[OF P'B'Q'[unfolded Diagonal_to_Smith_row_i_PQ_def] _ diag _ i],
      auto simp add: nrows_def ncols_def)
 
 lemma Diagonal_to_Smith_row_i_PQ:
   assumes P'B'Q': "(P',B',Q') = Diagonal_to_Smith_row_i_PQ i bezout (P,B,Q)"
     and diag: "isDiagonal B" and i: "i < min (nrows A) (ncols A)"
   shows "B' = P'**A**Q' \<and> invertible P' \<and> invertible Q' \<and> B' = Diagonal_to_Smith_row_i B i bezout"
   using assms Diagonal_to_Smith_row_i_PQ' Diagonal_to_Smith_row_i_PQ_eq by presburger
 
 end
 
 context
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type" (*This is the input matrix*)
   and B::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type" (*This is the matrix in each step*)
   and P and Q
   and bezout::"'a bezout"
   assumes PAQ: "P**A**Q = B"
   and P: "invertible P" and Q: "invertible Q"
   and ib: "is_bezout_ext bezout"
 begin
 
 
 lemma diagonal_to_Smith_aux_PQ:
   assumes P'B'Q': "(P',B',Q') = diagonal_to_Smith_aux_PQ [0..<k] bezout (P,B,Q)"
   and diag: "isDiagonal B" and k:"k<min (nrows A) (ncols A)"
 shows "B' = P'**A**Q' \<and> invertible P' \<and> invertible Q' \<and> B' = diagonal_to_Smith_aux B [0..<k] bezout"
   using k P'B'Q' P Q PAQ diag
 proof (induct k arbitrary: P B Q P' Q' B')
   case 0
   then show ?case using P Q PAQ by auto
 next
   case (Suc k P B Q P' Q' B')
   note Suc_k = Suc.prems(1)
   note PBQ = Suc.prems(2)
   note P = Suc.prems(3)
   note Q = Suc.prems(4)
   note PAQ_B = Suc.prems(5)
   note diag_B = Suc.prems(6)
   let ?Dk = "(diagonal_to_Smith_aux_PQ [0..<k] bezout (P, P ** A ** Q, Q))"
   let ?P' = "fst ?Dk"
   let ?B'="fst (snd ?Dk)"
   let ?Q' = "snd (snd ?Dk)"
   have k: "k<min (nrows A) (ncols A)" using Suc_k by auto
   have hyp: "?B' = ?P' ** A ** ?Q' \<and> invertible ?P' \<and> invertible ?Q' 
       \<and> ?B' = diagonal_to_Smith_aux B [0..<k] bezout"
     by (rule Suc.hyps[OF k _ P Q PAQ_B diag_B], auto simp add: PAQ_B)
   have diag_B': "isDiagonal ?B'"
     by (metis diag_B hyp ib isDiagonal_diagonal_to_Smith_aux k ncols_def nrows_def)
   have "B' = diagonal_to_Smith_aux B [0..<Suc k] bezout"
     by (auto, metis Diagonal_to_Smith_row_i_PQ_eq PAQ_B Suc(3) diag_B' 
         diagonal_to_Smith_aux_PQ_append2 eq_fst_iff hyp ib k sndI upt.simps(2) zero_order(1))
   moreover have "B' = P' ** A ** Q' \<and> invertible P' \<and> invertible Q'"
   proof (rule Diagonal_to_Smith_row_i_PQ')
     show "(P', B', Q') = Diagonal_to_Smith_row_i_PQ k bezout (?P',?B',?Q')" using Suc.prems by auto
     show "invertible ?P'" using hyp by auto
     show "?P' ** A ** ?Q' = ?B'" using hyp by auto
     show "invertible ?Q'" using hyp by auto
     show "is_bezout_ext bezout" using ib by auto
     show "k < min (nrows A) (ncols A)" using k by auto
     show diag_B': "isDiagonal ?B'" using diag_B' by auto
   qed 
   ultimately show ?case by auto
 qed
 
 end
 
 fun diagonal_to_Smith_PQ 
   where "diagonal_to_Smith_PQ A bezout 
   = diagonal_to_Smith_aux_PQ  [0..<min (nrows A) (ncols A) - 1] bezout (mat 1, A ,mat 1)"
 
 declare diagonal_to_Smith_PQ.simps[simp del]
 lemmas diagonal_to_Smith_PQ_def = diagonal_to_Smith_PQ.simps
 
 lemma diagonal_to_Smith_PQ:
   fixes A::"'a::{bezout_ring}^'cols::{mod_type}^'rows::{mod_type}" 
   assumes A: "isDiagonal A" and ib: "is_bezout_ext bezout"
   assumes PBQ: "(P,B,Q) = diagonal_to_Smith_PQ A bezout"
   shows "B = P**A**Q \<and> invertible P \<and> invertible Q \<and> B = diagonal_to_Smith A bezout"   
 proof (unfold diagonal_to_Smith_def, rule diagonal_to_Smith_aux_PQ[OF  _ _ _ ib _ A])
   let ?P = "mat 1::'a^'rows::mod_type^'rows::mod_type"
   let ?Q = "mat 1::'a^'cols::mod_type^'cols::mod_type"
   show "(P, B, Q) = diagonal_to_Smith_aux_PQ [0..<min (nrows A) (ncols A) - 1] bezout (?P, A, ?Q)"
     using PBQ unfolding diagonal_to_Smith_PQ_def .
   show "?P ** A ** ?Q = A" by simp
   show " min (nrows A) (ncols A) - 1 < min (nrows A) (ncols A)"    
     by (metis (no_types, lifting) One_nat_def diff_less dual_order.strict_iff_order le_less_trans 
         min_def mod_type_class.to_nat_less_card ncols_def not_less_eq nrows_not_0 zero_order(1))
 qed (auto simp add: invertible_mat_1)
 
 
 lemma diagonal_to_Smith_PQ_exists:
   fixes A::"'a::{bezout_ring}^'cols::{mod_type}^'rows::{mod_type}" 
   assumes A: "isDiagonal A"
   shows "\<exists>P Q. 
          invertible (P::'a^'rows::{mod_type}^'rows::{mod_type}) 
        \<and> invertible (Q::'a^'cols::{mod_type}^'cols::{mod_type})
        \<and> Smith_normal_form (P**A**Q)"   
 proof -
   obtain bezout::"'a bezout" where ib: "is_bezout_ext bezout"
     using exists_bezout_ext by blast
   obtain P B Q where PBQ: "(P,B,Q) = diagonal_to_Smith_PQ A bezout"
     by (metis prod_cases3)
   have "B = P**A**Q \<and> invertible P \<and> invertible Q \<and> B = diagonal_to_Smith A bezout" 
     by (rule diagonal_to_Smith_PQ[OF A ib PBQ])
   moreover have "Smith_normal_form (P**A**Q)"
     using Smith_normal_form_diagonal_to_Smith assms calculation ib by fastforce
   ultimately show ?thesis by auto
 qed
 
 subsection\<open>The final soundness theorem\<close>
 
 lemma diagonal_to_Smith_PQ':
   fixes A::"'a::{bezout_ring}^'cols::{mod_type}^'rows::{mod_type}" 
   assumes A: "isDiagonal A" and ib: "is_bezout_ext bezout"
   assumes PBQ: "(P,S,Q) = diagonal_to_Smith_PQ A bezout"
   shows "S = P**A**Q \<and> invertible P \<and> invertible Q \<and> Smith_normal_form S"   
   using A PBQ Smith_normal_form_diagonal_to_Smith diagonal_to_Smith_PQ ib by fastforce
 
 end
diff --git a/thys/Smith_Normal_Form/Diagonal_To_Smith_JNF.thy b/thys/Smith_Normal_Form/Diagonal_To_Smith_JNF.thy
--- a/thys/Smith_Normal_Form/Diagonal_To_Smith_JNF.thy
+++ b/thys/Smith_Normal_Form/Diagonal_To_Smith_JNF.thy
@@ -1,659 +1,660 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Algorithm to transform a diagonal matrix into its Smith normal form in JNF\<close>
 
 theory Diagonal_To_Smith_JNF
   imports Admits_SNF_From_Diagonal_Iff_Bezout_Ring
 begin
 
 
 text \<open>In this file, we implement an algorithm to transform a diagonal matrix into its Smith
 normal form, using the JNF library.
 
 There are, at least, three possible options:
 \begin{enumerate}
 \item Implement and prove the soundness of the algorithm from scratch in JNF
 \item Implement it in JNF and connect it to the HOL Analysis version by means of transfer rules.
 Thus, we could obtain the soundness lemma in JNF.
 \item Implement it in JNF, with calls to the HOL Analysis version by means of the functions 
 @{text " from_hma\<^sub>m"} and @{text "to_hma\<^sub>m"}. That is, transform the matrix to HOL Analysis, apply
 the existing algorith in HOL Analysis to get the Smith normal form and then transform the output 
 to JNF. Then, we could try to get the soundness theorem in JNF by means of 
 transfer rules and local type definitions.
 \end{enumerate}
 
 The first option requires much effort. As we will see, the third option is not possible.
 \<close>
 
 
 subsection \<open>Attempt with the third option: definitions and conditional transfer rules\<close>
 
 context
   fixes A::"'a::bezout_ring mat"
   assumes "A \<in> carrier_mat CARD('nr::mod_type) CARD('nc::mod_type)"
 begin
 
 private definition "diagonal_to_Smith_PQ_JNF' bezout = (
   let A' = Mod_Type_Connect.to_hma\<^sub>m A::'a^'nc::mod_type^'nr::mod_type;
      (P,S,Q) = (diagonal_to_Smith_PQ A' bezout)
   in (Mod_Type_Connect.from_hma\<^sub>m P, Mod_Type_Connect.from_hma\<^sub>m S, Mod_Type_Connect.from_hma\<^sub>m Q))"
 
 end
 
 text \<open>This approach will not work. The type is necessary in the definition of the function.
 That is, outside the context, the function will be:
 
 @{text "diagonal_to_Smith_PQ_JNF' TYPE('nc) TYPE('nr) A bezout"}
 
 And we cannot get rid of such @{text "TYPE('nc)"}.
 
 That is, we could get a lemma like:
 
 @{theory_text "
 lemma
   assumes A \<in> carrier_mat m n
   and (P,S,Q) = diagonal_to_Smith_PQ_JNF' TYPE('nr::mod_type) TYPE('nc::mod_type) A bezout
   shows invertible_mat P \<and> invertible_mat Q \<and> S = P * A * Q \<and> Smith_normal_form_mat S
 "}
 
 But we wouldn't be able to get rid of such types.
 \<close>
 
 subsection \<open>Attempt with the second option: implementation and soundness in JNF\<close>
 
 
 definition "diagonal_step_JNF A i j d v =               
               Matrix.mat (dim_row A) (dim_col A) (\<lambda> (a,b). if a = i \<and> b = i then d else 
                if a = j \<and> b = j 
                then v * (A $$ (j,j)) else A $$ (a,b))"
 
 text \<open>Conditional transfer rules are required, so I prove them within context with assumptions.\<close>
 
 context
   includes lifting_syntax
   fixes i and j::nat
   assumes i: "i<min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
   and j: "j<min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
 begin
   
 lemma HMA_diagonal_step[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _) 
     ===> (=) ===> (=) ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A. diagonal_step_JNF A i j) (\<lambda>B. diagonal_step B i j)" 
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def 
       diagonal_step_JNF_def diagonal_step_def)
  (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def, insert from_nat_eq_imp_eq i j, auto)
 
 end
 
 definition diagonal_step_PQ_JNF :: 
   "'a::{bezout_ring} mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a bezout \<Rightarrow> ('a mat \<times> ('a mat))"
   where "diagonal_step_PQ_JNF A i k bezout = 
   (let  m = dim_row A; n = dim_col A;
         (p, q, u, v, d) = bezout (A $$ (i,i)) (A $$ (k,k));
         P = addrow (-v) k i (swaprows i k (addrow p k i (1\<^sub>m m)));
         Q = multcol k (-1) (addcol u k i (addcol q i k (1\<^sub>m n)))
         in (P,Q)
         )"
 
 context
   includes lifting_syntax
   fixes i and k::nat
   assumes i: "i < min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
   and k: "k < min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
 begin
 
 lemma HMA_diagonal_step_PQ[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: bezout_ring ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _) 
     ===> (=) ===> rel_prod Mod_Type_Connect.HMA_M Mod_Type_Connect.HMA_M) 
     (\<lambda>A bezout. diagonal_step_PQ_JNF A i k bezout) (\<lambda>A bezout. diagonal_step_PQ A i k bezout)" 
 proof (intro rel_funI, goal_cases)
   case (1 A A' bezout bezout')  
   note HMA_M_AA'[transfer_rule] = 1(1)
   let ?d_JNF = "(diagonal_step_PQ_JNF A i k bezout)"
   let ?d_HA = "(diagonal_step_PQ A' i k bezout)"
   have [transfer_rule]: "Mod_Type_Connect.HMA_I k (from_nat k::'nc)"
     and [transfer_rule]: "Mod_Type_Connect.HMA_I k (from_nat k::'nr)"
     by (metis Mod_Type_Connect.HMA_I_def k min.strict_boundedE to_nat_from_nat_id)+
   have [transfer_rule]: "Mod_Type_Connect.HMA_I i (from_nat i::'nc)"
     and [transfer_rule]: "Mod_Type_Connect.HMA_I i (from_nat i::'nr)"
       by (metis Mod_Type_Connect.HMA_I_def i min.strict_boundedE to_nat_from_nat_id)+
   have [transfer_rule]: "A $$ (i,i) = A' $h from_nat i $h from_nat i"
   proof -
     have "A $$ (i,i) = index_hma A' (from_nat i) (from_nat i)"  by (transfer, simp)
     also have "... = A' $h from_nat i $h from_nat i" unfolding index_hma_def by auto
     finally show ?thesis .
   qed
   have [transfer_rule]: "A $$ (k,k) = A' $h from_nat k $h from_nat k"
   proof -
     have "A $$ (k,k) = index_hma A' (from_nat k) (from_nat k)"  by (transfer, simp)
     also have "... = A' $h from_nat k $h from_nat k" unfolding index_hma_def by auto
     finally show ?thesis .
   qed
   have dim_row_CARD: "dim_row A = CARD('nr)"
     using HMA_M_AA' Mod_Type_Connect.dim_row_transfer_rule by blast
   have dim_col_CARD: "dim_col A = CARD('nc)"
     using HMA_M_AA' Mod_Type_Connect.dim_col_transfer_rule by blast  
   let ?p = "fst (bezout (A' $h from_nat i $h from_nat i) (A' $h from_nat k $h from_nat k))"
   let ?v = "fst (snd (snd (snd (bezout (A $$ (i, i)) (A $$ (k, k))))))"
   have "Mod_Type_Connect.HMA_M (fst ?d_JNF) (fst ?d_HA)" 
     unfolding diagonal_step_PQ_JNF_def diagonal_step_PQ_def Mod_Type_Connect.HMA_M_def    
     unfolding Let_def split_beta dim_row_CARD
     by (auto, transfer, auto simp add: Mod_Type_Connect.HMA_M_def Rel_def rel_funI)
   moreover have "Mod_Type_Connect.HMA_M (snd ?d_JNF) (snd ?d_HA)"
     unfolding diagonal_step_PQ_JNF_def diagonal_step_PQ_def Mod_Type_Connect.HMA_M_def    
     unfolding Let_def split_beta dim_col_CARD
     by (auto, transfer, auto simp add: Mod_Type_Connect.HMA_M_def Rel_def rel_funI)
   ultimately show ?case unfolding rel_prod_conv using 1
     by (simp add: split_beta)
 qed
 
 end
 
 
 fun diagonal_to_Smith_i_PQ_JNF :: 
   "nat list \<Rightarrow> nat \<Rightarrow> ('a::{bezout_ring} bezout) 
   \<Rightarrow> ('a mat \<times> 'a mat \<times> 'a mat) \<Rightarrow> ('a mat \<times> 'a mat \<times> 'a mat)"
  where
 "diagonal_to_Smith_i_PQ_JNF [] i bezout (P,A,Q) = (P,A,Q)" |
 "diagonal_to_Smith_i_PQ_JNF (j#xs) i bezout (P,A,Q) = (
   if A $$ (i,i) dvd A $$ (j,j) 
      then diagonal_to_Smith_i_PQ_JNF xs i bezout (P,A,Q)
   else let (p, q, u, v, d) = bezout (A $$ (i,i)) (A $$ (j,j)); 
            A' = diagonal_step_JNF A i j d v;
           (P',Q') = diagonal_step_PQ_JNF A i j bezout
       in diagonal_to_Smith_i_PQ_JNF xs i bezout (P'*P,A',Q*Q') \<comment> \<open>Apply the step\<close>
   )
   "
 
 context
   includes lifting_syntax
   fixes i and xs
   assumes i: "i < min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
   and xs: "\<forall>j\<in>set xs. j < min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
 begin
 
 declare diagonal_step_PQ.simps[simp del]
 
 lemma HMA_diagonal_to_Smith_i_PQ_aux: "HMA_M3 (P,A,Q)  
   (P' :: 'a :: bezout_ring ^ 'nr :: mod_type ^ 'nr :: mod_type,
    A' :: 'a :: bezout_ring ^ 'nc :: mod_type ^ 'nr :: mod_type,
    Q' :: 'a :: bezout_ring ^ 'nc :: mod_type ^ 'nc :: mod_type)
   \<Longrightarrow> HMA_M3 (diagonal_to_Smith_i_PQ_JNF xs i bezout (P,A,Q)) 
              (diagonal_to_Smith_i_PQ xs i bezout (P',A',Q'))"
   using i xs
 proof (induct xs i bezout "(P',A',Q')" arbitrary: P' A' Q' P A Q rule: diagonal_to_Smith_i_PQ.induct)
   case (1 i bezout P' A' Q')
   then show ?case by auto
 next
   case (2 j xs i bezout P' A' Q')
   note HMA_M3[transfer_rule] = "2.prems"(1)
   note i = 2(4)
   note j = 2(5)
   note IH1="2.hyps"(1)
   note IH2="2.hyps"(2)
   have j_min: "j < min CARD('nr) CARD('nc)" using j by auto
   have HMA_M_AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" using HMA_M3 by auto
   have [transfer_rule]: "Mod_Type_Connect.HMA_I j (from_nat j::'nc)"  
     and [transfer_rule]: "Mod_Type_Connect.HMA_I j (from_nat j::'nr)"
     by (metis Mod_Type_Connect.HMA_I_def j_min min.strict_boundedE to_nat_from_nat_id)+
   have [transfer_rule]: "Mod_Type_Connect.HMA_I i (from_nat i::'nc)"
     and [transfer_rule]: "Mod_Type_Connect.HMA_I i (from_nat i::'nr)"
       by (metis Mod_Type_Connect.HMA_I_def i min.strict_boundedE to_nat_from_nat_id)+
   have [transfer_rule]: "A $$ (i, i) = A' $h from_nat i $h from_nat i"
   proof -
     have "A $$ (i,i) = index_hma A' (from_nat i) (from_nat i)"  by (transfer, simp)
     also have "... = A' $h from_nat i $h from_nat i" unfolding index_hma_def by auto
     finally show ?thesis .
   qed
   have [transfer_rule]: "A $$ (j, j) = A' $h from_nat j $h from_nat j"
   proof -
     have "A $$ (j,j) = index_hma A' (from_nat j) (from_nat j)"  by (transfer, simp)
     also have "... = A' $h from_nat j $h from_nat j" unfolding index_hma_def by auto
     finally show ?thesis .
   qed
   show ?case
   proof (cases "A $$ (i, i) dvd A $$ (j, j)")
     case True
     hence "A' $h from_nat i $h from_nat i dvd A' $h from_nat j $h from_nat j" by transfer
     then show ?thesis using True IH1 HMA_M3 i j by auto
   next
     case False    
     obtain p q u v d where b: "(p, q, u, v, d) = bezout (A $$ (i,i)) (A $$ (j,j))"
       by (metis prod_cases5)
     let ?A'_JNF = "diagonal_step_JNF A i j d v"
     obtain P''_JNF Q''_JNF where P''Q''_JNF: "(P''_JNF,Q''_JNF) = diagonal_step_PQ_JNF A i j bezout"
       by (metis surjective_pairing)
     have not_dvd: "\<not> A' $h from_nat i $h from_nat i dvd A' $h from_nat j $h from_nat j" using False by transfer
     let ?A' = "diagonal_step A' i j d v"
     obtain P'' Q'' where P''Q'': "(P'',Q'') = diagonal_step_PQ A' i j bezout" 
       by (metis surjective_pairing)
     have b2: "(p, q, u, v, d) = bezout (A' $h from_nat i $h from_nat i) (A' $h from_nat j $h from_nat j)" 
       using b by (transfer,auto)
     let ?D_HA = "diagonal_to_Smith_i_PQ xs i bezout (P''**P',?A',Q'**Q'')"
     let ?D_JNF = "diagonal_to_Smith_i_PQ_JNF xs i bezout (P''_JNF*P,?A'_JNF,Q*Q''_JNF)"
     have rw_1: "diagonal_to_Smith_i_PQ_JNF (j # xs) i bezout (P, A, Q) = ?D_JNF" 
       using False b P''Q''_JNF
       by (auto, unfold split_beta, metis fst_conv snd_conv)
     have rw_2: "diagonal_to_Smith_i_PQ (j # xs) i bezout (P', A', Q') = ?D_HA" 
       using not_dvd b2 P''Q'' by (auto, unfold split_beta, metis fst_conv snd_conv)
     have "HMA_M3 ?D_JNF ?D_HA" 
     proof (rule IH2[OF not_dvd b2], auto)
       have j: "j < min CARD('nr) CARD('nc)" using j by auto
       have [transfer_rule]: "rel_prod Mod_Type_Connect.HMA_M Mod_Type_Connect.HMA_M 
        (diagonal_step_PQ_JNF A i j bezout) (diagonal_step_PQ A' i j bezout)"
         using HMA_diagonal_step_PQ[OF i j] HMA_M_AA' unfolding rel_fun_def by auto
       hence [transfer_rule]: "Mod_Type_Connect.HMA_M P''_JNF P''" 
         and [transfer_rule]: "Mod_Type_Connect.HMA_M Q''_JNF Q''"
         using P''Q'' P''Q''_JNF unfolding rel_prod_conv split_beta
         by (metis fst_conv, metis snd_conv)
       have [transfer_rule]: "Mod_Type_Connect.HMA_M P P'" using HMA_M3 by auto
       show "Mod_Type_Connect.HMA_M (P''_JNF * P) (P'' ** P')" 
         (* apply (transfer, auto) does not finish the goal*)
         by (transfer_prover_start, transfer_step+, auto)      
      (* note HMA_diagonal_step[OF i j,transfer_rule]*)            
      (*transfer does not work for the following goal*)
       show "Mod_Type_Connect.HMA_M (diagonal_step_JNF A i j d v) (diagonal_step A' i j d v)"
         using HMA_diagonal_step[OF i j] HMA_M_AA' unfolding rel_fun_def by auto
       have [transfer_rule]: "Mod_Type_Connect.HMA_M Q Q'" using HMA_M3 by auto
       show "Mod_Type_Connect.HMA_M (Q * Q''_JNF) (Q' ** Q'')"
         by (transfer_prover_start, transfer_step+, auto)
     qed (insert i j P''Q'', auto)
     then show ?thesis using rw_1 rw_2 by auto
   qed
 qed
 
 lemma HMA_diagonal_to_Smith_i_PQ[transfer_rule]: 
   "((=) 
   ===> (HMA_M3 :: (_ \<Rightarrow> (_\<times>('a :: bezout_ring ^ 'nc :: mod_type ^ 'nr :: mod_type) \<times> _) \<Rightarrow>_)) 
   ===> HMA_M3) (diagonal_to_Smith_i_PQ_JNF xs i) (diagonal_to_Smith_i_PQ xs i)" 
 proof (intro rel_funI, goal_cases)
   case (1 x y bezout bezout')
   then show ?case using HMA_diagonal_to_Smith_i_PQ_aux
-    by (auto, smt HMA_M3.elims(2))
+    by (auto, smt (verit) HMA_M3.elims(2))
 qed
 
 end
 
 fun Diagonal_to_Smith_row_i_PQ_JNF
   where "Diagonal_to_Smith_row_i_PQ_JNF i bezout (P,A,Q) 
   = diagonal_to_Smith_i_PQ_JNF [i + 1..<min (dim_row A) (dim_col A)] i bezout (P,A,Q)"
 
 declare Diagonal_to_Smith_row_i_PQ_JNF.simps[simp del]
 lemmas Diagonal_to_Smith_row_i_PQ_JNF_def = Diagonal_to_Smith_row_i_PQ_JNF.simps
 
 context 
   includes lifting_syntax
   fixes i
   assumes i: "i < min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
 begin
 
 lemma HMA_Diagonal_to_Smith_row_i_PQ[transfer_rule]:
   "((=) ===> (HMA_M3 :: (_ \<Rightarrow> (_ \<times> ('a::bezout_ring^'nc::mod_type^'nr::mod_type) \<times> _) \<Rightarrow> _)) ===> HMA_M3) 
   (Diagonal_to_Smith_row_i_PQ_JNF i) (Diagonal_to_Smith_row_i_PQ i)"
 proof (intro rel_funI, clarify, goal_cases)
   case (1 _ bezout P A Q P' A' Q')
   note HMA_M3[transfer_rule] = 1
   let ?xs1="[i + 1..<min (dim_row A) (dim_col A)]"
   let ?xs2="[i + 1..<min (nrows A') (ncols A')]"
   have xs_eq[transfer_rule]: "?xs1 = ?xs2"
     using HMA_M3
     by (auto intro: arg_cong2[where f = upt]
         simp: Mod_Type_Connect.dim_col_transfer_rule Mod_Type_Connect.dim_row_transfer_rule
         nrows_def ncols_def)
   have j_xs: "\<forall>j\<in>set ?xs1. j < min CARD('nr) CARD('nc)" using i
     by (metis atLeastLessThan_iff ncols_def nrows_def set_upt xs_eq)
   have rel: "HMA_M3 (diagonal_to_Smith_i_PQ_JNF ?xs1 i bezout (P,A,Q)) 
             (diagonal_to_Smith_i_PQ ?xs1 i bezout (P',A',Q'))"
   using HMA_diagonal_to_Smith_i_PQ[OF i j_xs] HMA_M3 unfolding rel_fun_def by blast
   then show ?case 
     unfolding Diagonal_to_Smith_row_i_PQ_JNF_def Diagonal_to_Smith_row_i_PQ_def
     by (metis Suc_eq_plus1 xs_eq)
 qed
 
 end
 
 fun diagonal_to_Smith_aux_PQ_JNF 
   where
   "diagonal_to_Smith_aux_PQ_JNF [] bezout (P,A,Q) = (P,A,Q)" |
   "diagonal_to_Smith_aux_PQ_JNF (i#xs) bezout (P,A,Q) 
       = diagonal_to_Smith_aux_PQ_JNF xs bezout (Diagonal_to_Smith_row_i_PQ_JNF i bezout (P,A,Q))"
 
 context
   includes lifting_syntax
   fixes xs
   assumes xs: "\<forall>j\<in>set xs. j < min (CARD('nr::mod_type)) (CARD('nc::mod_type))"
 begin
 
 lemma HMA_diagonal_to_Smith_aux_PQ_JNF[transfer_rule]:
   "((=) ===> (HMA_M3 :: (_ \<Rightarrow> (_ \<times> ('a::bezout_ring^'nc::mod_type^'nr::mod_type) \<times> _) \<Rightarrow> _)) ===> HMA_M3) 
   (diagonal_to_Smith_aux_PQ_JNF xs) (diagonal_to_Smith_aux_PQ xs)"
 proof (intro rel_funI, clarify, goal_cases)
   case (1 _ bezout P A Q P' A' Q')
   note HMA_M3[transfer_rule] = 1
   show ?case
     using xs HMA_M3
   proof (induct xs arbitrary: P' A' Q' P A Q)
     case Nil
     then show ?case by auto
   next
     case (Cons i xs)
     note IH = Cons(1)
     note HMA_M3 = Cons.prems(2)
     have i: "i < min CARD('nr) CARD('nc)" using Cons.prems by auto
     let ?D_JNF = "(Diagonal_to_Smith_row_i_PQ_JNF i bezout (P, A, Q))"
     let ?D_HA = "(Diagonal_to_Smith_row_i_PQ i bezout (P', A', Q'))"
     have rw_1: "diagonal_to_Smith_aux_PQ_JNF (i # xs) bezout (P, A, Q) 
         = diagonal_to_Smith_aux_PQ_JNF xs bezout ?D_JNF" by auto
     have rw_2: "diagonal_to_Smith_aux_PQ (i # xs) bezout (P', A', Q') 
         = diagonal_to_Smith_aux_PQ xs bezout ?D_HA" by auto
     have "HMA_M3 ?D_JNF ?D_HA" 
       using HMA_Diagonal_to_Smith_row_i_PQ[OF i] HMA_M3 unfolding rel_fun_def by blast
     then show ?case
-      by (auto, smt Cons.hyps HMA_M3.elims(2) list.set_intros(2) local.Cons(2))
+      by (auto, smt (verit) Cons.hyps HMA_M3.elims(2) list.set_intros(2) local.Cons(2))
   qed
 qed
 
 end
 
 fun diagonal_to_Smith_PQ_JNF
   where "diagonal_to_Smith_PQ_JNF A bezout 
   = diagonal_to_Smith_aux_PQ_JNF [0..<min (dim_row A) (dim_col A) - 1] 
     bezout (1\<^sub>m (dim_row A),A,1\<^sub>m (dim_col A))"
 
 
 declare diagonal_to_Smith_PQ_JNF.simps[simp del]
 lemmas diagonal_to_Smith_PQ_JNF_def = diagonal_to_Smith_PQ_JNF.simps
 
 lemma diagonal_step_PQ_JNF_dim:
   assumes A: "A \<in> carrier_mat m n"
     and d: "diagonal_step_PQ_JNF A i j bezout = (P,Q)"
   shows "P \<in> carrier_mat m m \<and> Q \<in> carrier_mat n n"
   using A d unfolding diagonal_step_PQ_JNF_def split_beta Let_def by auto
 
 lemma diagonal_step_JNF_dim:
   assumes A: "A \<in> carrier_mat m n"
   shows "diagonal_step_JNF A i j d v \<in> carrier_mat m n"
   using A unfolding diagonal_step_JNF_def by auto
 
 lemma diagonal_to_Smith_i_PQ_JNF_dim:
   assumes "P' \<in> carrier_mat m m \<and> A' \<in> carrier_mat m n \<and> Q' \<in> carrier_mat n n"
     and "diagonal_to_Smith_i_PQ_JNF xs i bezout (P',A',Q') = (P,A,Q)"
   shows "P \<in> carrier_mat m m \<and> A \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"
   using assms 
   proof (induct xs i bezout "(P',A',Q')" arbitrary: P A Q P' A' Q' rule: diagonal_to_Smith_i_PQ_JNF.induct)
     case (1 i bezout P A Q)
     then show ?case by auto
   next
     case (2 j xs i bezout P' A' Q')
     show ?case
     proof (cases "A' $$ (i, i) dvd A' $$ (j, j)")
       case True
       then show ?thesis using 2 by auto
     next
       case False
       obtain p q u v d where b: "(p, q, u, v, d) = bezout (A' $$ (i,i)) (A' $$ (j,j))"
       by (metis prod_cases5)
       let ?A' = "diagonal_step_JNF A' i j d v"
       obtain P'' Q'' where P''Q'': "(P'',Q'') = diagonal_step_PQ_JNF A' i j bezout"
         by (metis surjective_pairing)
       let ?A' = "diagonal_step_JNF A' i j d v"
       let ?D_JNF = "diagonal_to_Smith_i_PQ_JNF xs i bezout (P''*P',?A',Q'*Q'')"
       have rw_1: "diagonal_to_Smith_i_PQ_JNF (j # xs) i bezout (P', A', Q') = ?D_JNF" 
         using False b P''Q''
         by (auto, unfold split_beta, metis fst_conv snd_conv)            
       show ?thesis 
       proof (rule "2.hyps"(2)[OF False b])
         show "?D_JNF = (P,A,Q)" using rw_1 2 by auto
         have "P'' \<in> carrier_mat m m" and "Q'' \<in> carrier_mat n n" 
           using diagonal_step_PQ_JNF_dim[OF _ P''Q''[symmetric]] "2.prems" by auto
         thus "P'' * P' \<in> carrier_mat m m \<and> ?A' \<in> carrier_mat m n \<and> Q' * Q'' \<in> carrier_mat n n" 
           using diagonal_step_JNF_dim 2 by (metis mult_carrier_mat)
     qed (insert P''Q'', auto)  
   qed  
 qed
 
 lemma Diagonal_to_Smith_row_i_PQ_JNF_dim:
   assumes "P' \<in> carrier_mat m m \<and> A' \<in> carrier_mat m n \<and> Q' \<in> carrier_mat n n"
     and "Diagonal_to_Smith_row_i_PQ_JNF i bezout (P',A',Q') = (P,A,Q)"
   shows "P \<in> carrier_mat m m \<and> A \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"
   by (rule diagonal_to_Smith_i_PQ_JNF_dim, insert assms, 
       auto simp add: Diagonal_to_Smith_row_i_PQ_JNF_def)  
 
 lemma diagonal_to_Smith_aux_PQ_JNF_dim:
   assumes "P' \<in> carrier_mat m m \<and> A' \<in> carrier_mat m n \<and> Q' \<in> carrier_mat n n"
     and "diagonal_to_Smith_aux_PQ_JNF xs bezout (P',A',Q') = (P,A,Q)"
   shows "P \<in> carrier_mat m m \<and> A \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"
   using assms 
   proof (induct xs bezout "(P',A',Q')" arbitrary: P A Q P' A' Q' rule: diagonal_to_Smith_aux_PQ_JNF.induct)
     case (1 bezout P A Q)
     then show ?case by simp
   next
     case (2 i xs bezout P' A' Q')
     let ?D="(Diagonal_to_Smith_row_i_PQ_JNF i bezout (P', A', Q'))"
     have "diagonal_to_Smith_aux_PQ_JNF (i # xs) bezout (P', A', Q') = 
       diagonal_to_Smith_aux_PQ_JNF xs bezout ?D" by auto
     hence *: "... = (P,A,Q)" using 2 by auto
     let ?P="fst ?D"
     let ?S="fst (snd ?D)"
     let ?Q="snd (snd ?D)"
     show ?case
     proof (rule "2.hyps")      
       show "Diagonal_to_Smith_row_i_PQ_JNF i bezout (P', A', Q') = (?P,?S,?Q)" by auto
       show "diagonal_to_Smith_aux_PQ_JNF xs bezout (?P, ?S, ?Q) = (P, A, Q)" using * by simp
       show "?P \<in> carrier_mat m m \<and> ?S \<in> carrier_mat m n \<and> ?Q \<in> carrier_mat n n" 
         by (rule Diagonal_to_Smith_row_i_PQ_JNF_dim, insert 2, auto)           
     qed
 qed
 
 lemma diagonal_to_Smith_PQ_JNF_dim:
   assumes "A \<in> carrier_mat m n" 
     and PSQ: "diagonal_to_Smith_PQ_JNF A bezout = (P,S,Q)"
   shows "P \<in> carrier_mat m m \<and> S \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"
   by (rule diagonal_to_Smith_aux_PQ_JNF_dim, insert assms, 
       auto simp add: diagonal_to_Smith_PQ_JNF_def)
 
 context
   includes lifting_syntax
 begin
 
 lemma HMA_diagonal_to_Smith_PQ_JNF[transfer_rule]:
  "((Mod_Type_Connect.HMA_M) ===> (=) ===> HMA_M3) (diagonal_to_Smith_PQ_JNF) (diagonal_to_Smith_PQ)"
 proof (intro rel_funI, clarify, goal_cases)
   case (1 A A' _ bezout)
   let ?xs1 = "[0..<min (dim_row A) (dim_col A) - 1]"
   let ?xs2 = "[0..<min (nrows A') (ncols A') - 1]"
   let ?PAQ="(1\<^sub>m (dim_row A), A, 1\<^sub>m (dim_col A))"
   have dr: "dim_row A = CARD('c)"
     using 1 Mod_Type_Connect.dim_row_transfer_rule by blast
   have dc: "dim_col A = CARD('b)" 
     using 1 Mod_Type_Connect.dim_col_transfer_rule by blast
   have xs_eq: "?xs1 = ?xs2"
     by (simp add: dc dr ncols_def nrows_def)
   have j_xs: "\<forall>j\<in>set ?xs1. j < min CARD('c) CARD('b)"
     using dc dr less_imp_diff_less by auto
   let ?D_JNF = "diagonal_to_Smith_aux_PQ_JNF ?xs1 bezout ?PAQ"
   let ?D_HA = "diagonal_to_Smith_aux_PQ ?xs1 bezout (mat 1, A', mat 1)"
   have mat_rel_init: "HMA_M3 ?PAQ (mat 1, A', mat 1)"
   proof -    
     have "Mod_Type_Connect.HMA_M (1\<^sub>m (dim_row A)) (mat 1::'a^'c::mod_type^'c::mod_type)" 
       unfolding dr by (transfer_prover_start,transfer_step, auto)
     moreover have "Mod_Type_Connect.HMA_M (1\<^sub>m (dim_col A)) (mat 1::'a^'b::mod_type^'b::mod_type)"
       unfolding dc by (transfer_prover_start,transfer_step, auto)
     ultimately show ?thesis using 1 by auto
   qed
   have "HMA_M3 ?D_JNF ?D_HA"
     using HMA_diagonal_to_Smith_aux_PQ_JNF[OF j_xs] mat_rel_init unfolding rel_fun_def by blast
   then show ?case using xs_eq unfolding diagonal_to_Smith_PQ_JNF_def diagonal_to_Smith_PQ_def 
     by auto 
 qed
 
 end
 
 subsection \<open>Applying local type definitions\<close>
 
 text \<open>Now we get the soundness lemma in JNF, via the one in HOL Analysis. I need transfer rules 
 and local type definitions.\<close>
 
 context
   includes lifting_syntax
 begin
 
 
 private lemma diagonal_to_Smith_PQ_JNF_with_types:
   assumes A: "A \<in> carrier_mat CARD('nr::mod_type) CARD('nc::mod_type)"
   and S: "S \<in> carrier_mat CARD('nr) CARD('nc)"
   and P: "P \<in> carrier_mat CARD('nr) CARD('nr)"
   and Q: "Q \<in> carrier_mat CARD('nc) CARD('nc)"
   and PSQ: "diagonal_to_Smith_PQ_JNF A bezout = (P, S, Q)"
   and d:"isDiagonal_mat A" and ib: "is_bezout_ext bezout"
 shows "S = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S"
 proof -
   let ?P = "Mod_Type_Connect.to_hma\<^sub>m P::'a^'nr::mod_type^'nr::mod_type"
   let ?A = "Mod_Type_Connect.to_hma\<^sub>m A::'a^'nc::mod_type^'nr::mod_type"
   let ?Q = "Mod_Type_Connect.to_hma\<^sub>m Q::'a^'nc::mod_type^'nc::mod_type"
   let ?S = "Mod_Type_Connect.to_hma\<^sub>m S::'a^'nc::mod_type^'nr::mod_type"
   have [transfer_rule]: "Mod_Type_Connect.HMA_M A ?A"
     by (simp add: Mod_Type_Connect.HMA_M_def A)
   moreover have [transfer_rule]: "Mod_Type_Connect.HMA_M P ?P"
     by (simp add: Mod_Type_Connect.HMA_M_def P)  
   moreover have [transfer_rule]: "Mod_Type_Connect.HMA_M Q ?Q"
     by (simp add: Mod_Type_Connect.HMA_M_def Q)
   moreover have [transfer_rule]: "Mod_Type_Connect.HMA_M S ?S"
     by (simp add: Mod_Type_Connect.HMA_M_def S)
   ultimately have [transfer_rule]: "HMA_M3 (P,S,Q) (?P,?S,?Q)" by simp
   have [transfer_rule]: "bezout = bezout" ..
   have PSQ2: "(?P,?S,?Q) = diagonal_to_Smith_PQ ?A bezout" by (transfer, insert PSQ, auto)  
   have "?S = ?P**?A**?Q \<and> invertible ?P \<and> invertible ?Q \<and> Smith_normal_form ?S"
     by (rule diagonal_to_Smith_PQ'[OF _ ib PSQ2], transfer, auto simp add: d)  
   with this[untransferred] show ?thesis by auto  
 qed
 
 
 private lemma diagonal_to_Smith_PQ_JNF_mod_ring_with_types:
   assumes A: "A \<in> carrier_mat CARD('nr::nontriv mod_ring) CARD('nc::nontriv mod_ring)"
   and S: "S \<in> carrier_mat CARD('nr mod_ring) CARD('nc mod_ring)"
   and P: "P \<in> carrier_mat CARD('nr mod_ring) CARD('nr mod_ring)"
   and Q: "Q \<in> carrier_mat CARD('nc mod_ring) CARD('nc mod_ring)"
   and PSQ: "diagonal_to_Smith_PQ_JNF A bezout = (P, S, Q)"
   and d:"isDiagonal_mat A" and ib: "is_bezout_ext bezout"
 shows "S = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S"
   by (rule diagonal_to_Smith_PQ_JNF_with_types[OF assms])
 
 
 (*I don't know how to internalize the sort constraint of 'nr and 'nc at once,
 so I do it in two steps.*)
 thm diagonal_to_Smith_PQ_JNF_mod_ring_with_types[unfolded CARD_mod_ring, 
       internalize_sort "'nr::nontriv"]
 
 private lemma diagonal_to_Smith_PQ_JNF_internalized_first:
   "class.nontriv TYPE('a::type) \<Longrightarrow>
   A \<in> carrier_mat CARD('a) CARD('nc::nontriv) \<Longrightarrow>
   S \<in> carrier_mat CARD('a) CARD('nc) \<Longrightarrow>
   P \<in> carrier_mat CARD('a) CARD('a) \<Longrightarrow>
   Q \<in> carrier_mat CARD('nc) CARD('nc) \<Longrightarrow>
   diagonal_to_Smith_PQ_JNF A bezout = (P, S, Q) \<Longrightarrow>
   isDiagonal_mat A \<Longrightarrow> is_bezout_ext bezout \<Longrightarrow> 
   S = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S"
   using diagonal_to_Smith_PQ_JNF_mod_ring_with_types[unfolded CARD_mod_ring, 
       internalize_sort "'nr::nontriv"] by blast
 
 
 private lemma diagonal_to_Smith_PQ_JNF_internalized:
   "class.nontriv TYPE('c::type) \<Longrightarrow>
   class.nontriv TYPE('a::type) \<Longrightarrow>
   A \<in> carrier_mat CARD('a) CARD('c) \<Longrightarrow>
   S \<in> carrier_mat CARD('a) CARD('c) \<Longrightarrow>
   P \<in> carrier_mat CARD('a) CARD('a) \<Longrightarrow>
   Q \<in> carrier_mat CARD('c) CARD('c) \<Longrightarrow>
   diagonal_to_Smith_PQ_JNF A bezout = (P, S, Q) \<Longrightarrow>
   isDiagonal_mat A \<Longrightarrow> is_bezout_ext bezout \<Longrightarrow> 
 S = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S"
   using diagonal_to_Smith_PQ_JNF_internalized_first[internalize_sort "'nc::nontriv"] by blast
 
 
 context
   fixes m::nat and n::nat
   assumes local_typedef1: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<m :: int}"
   assumes local_typedef2: "\<exists>(Rep :: ('c \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<n :: int}"
   and m: "m>1"
   and n: "n>1"
 begin
 
 lemma type_to_set1:
   shows "class.nontriv TYPE('b)" (is ?a) and "m=CARD('b)" (is ?b)
 proof -
   from local_typedef1 obtain Rep::"('b \<Rightarrow> int)" and Abs 
     where t: "type_definition Rep Abs {0..<m :: int}" by auto
   have "card (UNIV :: 'b set) = card {0..<m}" using t type_definition.card by fastforce
   also have "... = m" by auto
   finally show ?b ..
   then show ?a unfolding class.nontriv_def using m by auto
 qed
 
 lemma type_to_set2:
   shows "class.nontriv TYPE('c)" (is ?a) and "n=CARD('c)" (is ?b)
 proof -
   from local_typedef2 obtain Rep::"('c \<Rightarrow> int)" and Abs 
     where t: "type_definition Rep Abs {0..<n :: int}" by blast
   have "card (UNIV :: 'c set) = card {0..<n}" using t type_definition.card by force
   also have "... = n" by auto
   finally show ?b ..
   then show ?a unfolding class.nontriv_def using n by auto
 qed
 
 lemma diagonal_to_Smith_PQ_JNF_local_typedef:  
   assumes A: "isDiagonal_mat A" and ib: "is_bezout_ext bezout"
   and A_dim: "A \<in> carrier_mat m n"
   assumes PSQ: "(P,S,Q) = diagonal_to_Smith_PQ_JNF A bezout"
   shows "S = P*A*Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S
   \<and> P \<in> carrier_mat m m \<and> S \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"  
 proof -  
   have dim_matrices: "P \<in> carrier_mat m m \<and> S \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n" 
     by (rule diagonal_to_Smith_PQ_JNF_dim[OF A_dim PSQ[symmetric]])
   show ?thesis
   using diagonal_to_Smith_PQ_JNF_internalized[where ?'c='c, where ?'a='b, 
       OF type_to_set2(1) type_to_set(1), of m A S P Q]  
   unfolding type_to_set1(2)[symmetric] type_to_set2(2)[symmetric] 
   using assms m dim_matrices local_typedef1 by auto
 qed
 end
 end
 
 (*Canceling the first local type definitions (I was not able to cancel both in one step)*)
 context
 begin
 private lemma diagonal_to_Smith_PQ_JNF_canceled_first:
   "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> {0..<int m} \<noteq> {} \<Longrightarrow>
   1 < m \<Longrightarrow> 1 < n \<Longrightarrow> isDiagonal_mat A \<Longrightarrow> is_bezout_ext bezout \<Longrightarrow>
   A \<in> carrier_mat m n \<Longrightarrow> (P, S, Q) = diagonal_to_Smith_PQ_JNF A bezout \<Longrightarrow>
   S = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S 
   \<and> P \<in> carrier_mat m m \<and> S \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"
   using diagonal_to_Smith_PQ_JNF_local_typedef[cancel_type_definition] by blast
 
 (*Canceling the second*)
 private lemma diagonal_to_Smith_PQ_JNF_canceled_both:
   "{0..<int n} \<noteq> {} \<Longrightarrow> {0..<int m} \<noteq> {} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
   isDiagonal_mat A \<Longrightarrow> is_bezout_ext bezout \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow>
   (P, S, Q) = diagonal_to_Smith_PQ_JNF A bezout \<Longrightarrow> S = P * A * Q \<and>
   invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S 
   \<and> P \<in> carrier_mat m m \<and> S \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"
   using diagonal_to_Smith_PQ_JNF_canceled_first[cancel_type_definition] by blast
 
 subsection \<open>The final result\<close>
 
 lemma diagonal_to_Smith_PQ_JNF:  
   assumes A: "isDiagonal_mat A" and ib: "is_bezout_ext bezout"
   and "A \<in> carrier_mat m n" 
   and PBQ: "(P,S,Q) = diagonal_to_Smith_PQ_JNF A bezout" 
 (*The following two assumptions appear since mod_type requires 1<CARD. 
 Those cases could be treated separately.*)
   and n: "n>1" and m: "m>1" 
   shows "S = P*A*Q \<and> invertible_mat P \<and> invertible_mat Q \<and> Smith_normal_form_mat S
   \<and> P \<in> carrier_mat m m \<and> S \<in> carrier_mat m n \<and> Q \<in> carrier_mat n n"   
-  using diagonal_to_Smith_PQ_JNF_canceled_both[OF _ _ m n] using assms by force
+  using diagonal_to_Smith_PQ_JNF_canceled_both[OF _ _ m n]
+  by (smt (verit, best) assms(1) assms(3) assms(4) assms(6) atLeastLessThan_empty_iff gr_zeroI ib n not_less_iff_gr_or_eq of_nat_0_less_iff)
 end
 end
diff --git a/thys/Smith_Normal_Form/Elementary_Divisor_Rings.thy b/thys/Smith_Normal_Form/Elementary_Divisor_Rings.thy
--- a/thys/Smith_Normal_Form/Elementary_Divisor_Rings.thy
+++ b/thys/Smith_Normal_Form/Elementary_Divisor_Rings.thy
@@ -1,1396 +1,1395 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Elementary divisor rings\<close>
 
 theory Elementary_Divisor_Rings
   imports           
     SNF_Algorithm
     Rings2_Extended
 begin
 
 text \<open>This theory contains the definition of elementary divisor rings and Hermite rings, as 
 well as the corresponding relation between both concepts. 
 It also includes a complete characterization
 for elementary divisor rings, by means of an \emph{if and only if}-statement.
 
 The results presented here follows the article ``Some remarks about elementary divisor rings''
 by Leonard Gillman and Melvin Henriksen.\<close>
 
 subsection \<open>Previous definitions and basic properties of Hermite ring\<close>
 
 definition "admits_triangular_reduction A = 
   (\<exists>U::'a::comm_ring_1 mat. U \<in> carrier_mat (dim_col A) (dim_col A) 
   \<and> invertible_mat U \<and> lower_triangular (A*U))"
 
 class Hermite_ring =
   assumes "\<forall>(A::'a::comm_ring_1 mat). admits_triangular_reduction A"
 
 lemma admits_triangular_reduction_intro:
   assumes "invertible_mat (U::'a::comm_ring_1 mat)" 
     and "U \<in> carrier_mat (dim_col A) (dim_col A)"
     and "lower_triangular (A*U)"
   shows "admits_triangular_reduction A" 
   using assms unfolding admits_triangular_reduction_def by auto
 
 lemma OFCLASS_Hermite_ring_def:
   "OFCLASS('a::comm_ring_1, Hermite_ring_class) 
   \<equiv> (\<And>(A::'a::comm_ring_1 mat). admits_triangular_reduction A)"
 proof 
   fix A::"'a mat"
   assume H: "OFCLASS('a::comm_ring_1, Hermite_ring_class)"
   have "\<forall>A. admits_triangular_reduction (A::'a mat)"
     using conjunctionD2[OF H[unfolded Hermite_ring_class_def class.Hermite_ring_def]] by auto    
   thus "admits_triangular_reduction A" by auto
 next
   assume i: "(\<And>A::'a mat. admits_triangular_reduction A)"
   show "OFCLASS('a, Hermite_ring_class)"
   proof 
     show "\<forall>A::'a mat. admits_triangular_reduction A" using i by auto
   qed
 qed
 
 
 definition admits_diagonal_reduction::"'a::comm_ring_1 mat \<Rightarrow> bool"
   where "admits_diagonal_reduction A = (\<exists>P Q. P \<in> carrier_mat (dim_row A) (dim_row A) \<and>
         Q \<in> carrier_mat (dim_col A) (dim_col A) 
         \<and> invertible_mat P \<and> invertible_mat Q 
         \<and> Smith_normal_form_mat (P * A * Q))"
 
 lemma admits_diagonal_reduction_intro:
   assumes "P \<in> carrier_mat (dim_row A) (dim_row A)"
     and "Q \<in> carrier_mat (dim_col A) (dim_col A)" 
     and "invertible_mat P" and "invertible_mat Q "
     and "Smith_normal_form_mat (P * A * Q)"
   shows "admits_diagonal_reduction A" using assms unfolding admits_diagonal_reduction_def by fast
 
 (*Lemmas for equivalence between admits_diagonal_reduction and is_SNF 
   via the existence of an algorithm*)
 
 lemma admits_diagonal_reduction_imp_exists_algorithm_is_SNF:
   assumes "A \<in> carrier_mat m n"
   and "admits_diagonal_reduction A"
 shows "\<exists>algorithm. is_SNF A (algorithm A)" 
   using assms unfolding is_SNF_def admits_diagonal_reduction_def
   by auto
 
 lemma exists_algorithm_is_SNF_imp_admits_diagonal_reduction:
   assumes "A \<in> carrier_mat m n"
   and "\<exists>algorithm. is_SNF A (algorithm A)"
   shows "admits_diagonal_reduction A"
   using assms unfolding is_SNF_def admits_diagonal_reduction_def
   by auto
 
 lemma admits_diagonal_reduction_eq_exists_algorithm_is_SNF:
   assumes A: "A \<in> carrier_mat m n"
   shows "admits_diagonal_reduction A = (\<exists>algorithm. is_SNF A (algorithm A))"
   using admits_diagonal_reduction_imp_exists_algorithm_is_SNF[OF A]
   using exists_algorithm_is_SNF_imp_admits_diagonal_reduction[OF A]
   by auto
 
 
 lemma admits_diagonal_reduction_imp_exists_algorithm_is_SNF_all:
   assumes "(\<forall>(A::'a::comm_ring_1 mat) \<in> carrier_mat m n. admits_diagonal_reduction A)" 
   shows" (\<exists>algorithm. \<forall>(A::'a mat) \<in> carrier_mat m n. is_SNF A (algorithm A))"
 proof -
   let ?algorithm = "\<lambda>A. SOME (P, S, Q). is_SNF A (P,S,Q)"
   show ?thesis
     by (rule exI[of _ ?algorithm]) (metis (no_types, lifting) 
         admits_diagonal_reduction_imp_exists_algorithm_is_SNF assms case_prod_beta prod.collapse someI)
 qed
 
 lemma exists_algorithm_is_SNF_imp_admits_diagonal_reduction_all:
   assumes "(\<exists>algorithm. \<forall>(A::'a mat) \<in> carrier_mat m n. is_SNF A (algorithm A))"
   shows "(\<forall>(A::'a::comm_ring_1 mat) \<in> carrier_mat m n. admits_diagonal_reduction A)"
   using assms exists_algorithm_is_SNF_imp_admits_diagonal_reduction by blast  
 
  
 lemma admits_diagonal_reduction_eq_exists_algorithm_is_SNF_all:
   shows "(\<forall>(A::'a::comm_ring_1 mat) \<in> carrier_mat m n. admits_diagonal_reduction A) 
   = (\<exists>algorithm. \<forall>(A::'a mat) \<in> carrier_mat m n. is_SNF A (algorithm A))"
   using exists_algorithm_is_SNF_imp_admits_diagonal_reduction_all
   using admits_diagonal_reduction_imp_exists_algorithm_is_SNF_all by auto
 
 
 subsection \<open>The class that represents elementary divisor rings\<close>
 
 class elementary_divisor_ring =
   assumes "\<forall>(A::'a::comm_ring_1 mat). admits_diagonal_reduction A"
 
 
 lemma dim_row_mat_diag[simp]: "dim_row (mat_diag n f) = n" and 
       dim_col_mat_diag[simp]: "dim_col (mat_diag n f) = n" 
   using mat_diag_dim unfolding carrier_mat_def by auto+
 
 
 subsection \<open>Hermite ring implies B\'ezout ring\<close>
 
 (*HERMITE \<Longrightarrow> BEZOUT*)
 
 text \<open>To prove this fact, we make use of the alternative definition for B\'ezout rings:
 each finitely generated ideal is principal\<close>
 
 lemma Hermite_ring_imp_Bezout_ring:
   assumes H: "OFCLASS('a::comm_ring_1, Hermite_ring_class)"
   shows " OFCLASS('a::comm_ring_1, bezout_ring_class)"
 proof (rule all_fin_gen_ideals_are_principal_imp_bezout, rule+)
   fix I::"'a set" assume fin: "finitely_generated_ideal I"
   (*We take the list, put it in a 1xn matrix and then multiply it by a matrix Q that I will obtain*)
   obtain S where ig_S: "ideal_generated S = I" and fin_S: "finite S" 
     using fin unfolding finitely_generated_ideal_def by auto
   obtain xs where set_xs: "set xs = S" and d: "distinct xs" 
     using finite_distinct_list[OF fin_S] by blast
   hence length_eq_card: "length xs = card S" using distinct_card by force
   define n where "n = card S"
   define A where "A = mat_of_rows n [vec_of_list xs]"
   have A[simp]: "A \<in> carrier_mat 1 n" unfolding A_def using mat_of_rows_carrier by auto
   have "\<forall>(A::'a::comm_ring_1 mat). admits_triangular_reduction A" 
     using H unfolding OFCLASS_Hermite_ring_def by auto  
   from this obtain Q where inv_Q: "invertible_mat Q" and t_AQ: "lower_triangular (A*Q)"
     and Q[simp]: "Q \<in> carrier_mat n n"
     unfolding admits_triangular_reduction_def using A by auto  
   have AQ[simp]: "A * Q \<in> carrier_mat 1 n" using A Q by auto
   show "principal_ideal I"
   proof (cases "xs=[]")
   case True
     then show ?thesis
       by (metis empty_set ideal_generated_0 ideal_generated_empty ig_S principal_ideal_def set_xs)
   next
     case False
     have a: "0 < dim_row A" using A by auto
     have "0 < length xs" using False by auto  
     hence b: "0 < dim_col A" using A n_def length_eq_card by auto
     have q0: "0 < dim_col Q" by (metis A Q b carrier_matD(2))
     have n0: "0<n" using \<open>0 < length xs\<close> length_eq_card n_def by linarith
     define d where "d = (A*Q) $$ (0,0)"
         let ?h = "(\<lambda>x. THE i. xs ! i = x \<and> i<n)"
         let ?u = "\<lambda>i. xs ! i"
         have bij: "bij_betw ?h (set xs) {0..<n}" 
         proof (rule bij_betw_imageI)
           show "inj_on ?h (set xs)"
           proof -
             have "x=y" if x: "x \<in> set xs" and y: "y \<in> set xs"
               and xy: "(THE i. xs ! i = x \<and> i < n) = (THE i. xs ! i = y \<and> i < n)" for x y
             proof -
               let ?i = "(THE i. xs ! i = x \<and> i < n)"
               let ?j = "(THE i. xs ! i = y \<and> i < n)"
              obtain i where xs_i: "xs ! i = x \<and> i < n" using x
                 by (metis in_set_conv_nth length_eq_card n_def)
              from this have 1: "xs ! ?i = x \<and> ?i < n"
                by (rule theI, insert d xs_i length_eq_card n_def nth_eq_iff_index_eq, fastforce)
              obtain j where xs_j: "xs ! j = y \<and> j < n" using y
                 by (metis in_set_conv_nth length_eq_card n_def)
              from this have 2: "xs ! ?j = y \<and> ?j < n"
                by (rule theI, insert d xs_j length_eq_card n_def nth_eq_iff_index_eq, fastforce)    
              show ?thesis using 1 2 d xy by argo
            qed
            thus ?thesis unfolding inj_on_def by auto
          qed      
          show "(\<lambda>x. THE i. xs ! i = x \<and> i < n) ` set xs = {0..<n}"
          proof (auto)  
            fix xa assume xa: "xa \<in> set xs"
            let ?i = "(THE i. xs ! i = xa \<and> i < n)"
            obtain i where xs_i: "xs ! i = xa \<and> i < n" using xa
              by (metis in_set_conv_nth length_eq_card n_def)
            from this have 1: "xs ! ?i = xa \<and> ?i < n"
              by (rule theI, insert d xs_i length_eq_card n_def nth_eq_iff_index_eq, fastforce)
            thus "(THE i. xs ! i = xa \<and> i < n) < n" by simp
          next
            fix x assume x: "x<n"
            have "\<exists>xa\<in>set xs. x = (THE i. xs ! i = xa \<and> i < n)"
              by (rule bexI[of _ "xs ! x"], rule the_equality[symmetric], insert x d) 
                 (auto simp add: length_eq_card n_def nth_eq_iff_index_eq)+
            thus "x \<in> (\<lambda>x. THE i. xs ! i = x \<and> i < n) ` set xs" unfolding image_def by auto
          qed
        qed
     have i: "ideal_generated {d} = ideal_generated S"
     proof -    
       have ideal_S_explicit: "ideal_generated S = {y. \<exists>f. (\<Sum>i\<in>S. f i * i) = y}"
         unfolding ideal_explicit2[OF fin_S] by simp
       have "ideal_generated {d} \<subseteq> ideal_generated S"
       proof (rule ideal_generated_subset2, auto simp add: ideal_S_explicit)
         have n: "dim_vec (col Q 0) = n" using Q n_def by auto
         have aux: "Matrix.row A 0 $v i = xs ! i" if i: "i<n" for i
         proof -
           have i2: "i < dim_col A"
             by (simp add: A_def i)
           have "Matrix.row A 0 $v i = A $$ (0,i)" by (rule index_row(1), auto simp add: a b i2)
           also have "... = [vec_of_list xs] ! 0 $v i" 
             unfolding A_def by (rule mat_of_rows_index, auto simp add: i)
           also have "... = xs ! i"
             by (simp add: vec_of_list_index)
           finally show ?thesis .
         qed    
         let ?f = "\<lambda>x. let i = (THE i. xs ! i = x \<and> i < n) in col Q 0 $v i"
         let ?g = "(\<lambda>i. xs ! i * col Q 0 $v i)"
         have "d = (A*Q) $$ (0,0)" unfolding d_def by simp 
         also have "... = Matrix.row A 0 \<bullet> col Q 0" by (rule index_mult_mat(1)[OF a q0])
         also have "... = (\<Sum>i = 0..<dim_vec (col Q 0). Matrix.row A 0 $v i * col Q 0 $v i)" 
           unfolding scalar_prod_def by simp
         also have "... = (\<Sum>i = 0..<n. Matrix.row A 0 $v i * col Q 0 $v i)" unfolding n by auto
         also have "... = (\<Sum>i = 0..<n. xs ! i * col Q 0 $v i)" 
           by (rule sum.cong, auto simp add: aux)
         also have "... = (\<Sum>x \<in> set xs. ?g (?h x))"
           by (rule sum.reindex_bij_betw[symmetric, OF bij])
         also have "... = (\<Sum>x \<in> set xs. ?f x * x)"
         proof (rule sum.cong, auto simp add: Let_def)
           fix x assume x: "x \<in> set xs"
           let ?i = "(THE i. xs ! i = x \<and> i < n)"
           obtain i where xs_i: "xs ! i = x \<and> i < n"
             by (metis in_set_conv_nth x length_eq_card n_def)
           from this have "xs ! ?i = x \<and> ?i < n"
             by (rule theI, insert d xs_i length_eq_card n_def nth_eq_iff_index_eq, fastforce)       
           thus "xs ! ?i * col Q 0 $v ?i = col Q 0 $v ?i * x" by auto
         qed
         also have "... = (\<Sum>x \<in> S. ?f x * x)" using set_xs by auto
         finally show "\<exists>f. (\<Sum>i\<in>S. f i * i) = d" by auto
       qed
       moreover have "ideal_generated S \<subseteq> ideal_generated {d}"
       proof 
         fix x assume x: "x \<in> ideal_generated S" thm Matrix.diag_mat_def
         hence x_xs: "x \<in> ideal_generated (set xs)" by (simp add: set_xs)
         from this obtain f where f: "(\<Sum>i\<in>(set xs). f i * i) = x" using x ideal_explicit2 by auto
         define B where "B = Matrix.vec n (\<lambda>i. f (A $$ (0,i)))"
         have B: "B \<in> carrier_vec n" unfolding B_def by auto
         have "(A *\<^sub>v B) $v 0 = Matrix.row A 0 \<bullet> B" by (rule index_mult_mat_vec[OF a])
         also have "... = sum (\<lambda>i. f (A $$ (0,i)) * A $$ (0,i)) {0..<n}"
           unfolding B_def Matrix.row_def scalar_prod_def by (rule sum.cong, auto simp add: A_def)
         also have "... = sum (\<lambda>i. f i * i) (set xs)"
         proof (rule sum.reindex_bij_betw)
           have 1: "inj_on (\<lambda>x. A $$ (0, x)) {0..<n}"
           proof (unfold inj_on_def, auto)
             fix x y assume x: "x < n" and y: "y < n" and xy: "A $$ (0, x) = A $$ (0, y)"
             have "A $$ (0,x) =  [vec_of_list xs] ! 0 $v x" 
               unfolding A_def by (rule mat_of_rows_index, insert x y, auto)
             also have "... = xs ! x" using x by (simp add: vec_of_list_index)
             finally have 1: "A $$ (0,x) = xs ! x" .
             have "A $$ (0,y) =  [vec_of_list xs] ! 0 $v y" 
               unfolding A_def by (rule mat_of_rows_index, insert x y, auto)
             also have "... = xs ! y" using y by (simp add: vec_of_list_index)
             finally have 2: "A $$ (0,y) = xs ! y" .
             show "x = y" using 1 2 x y d length_eq_card n_def nth_eq_iff_index_eq xy by fastforce
           qed
           have 2: "A $$ (0, xa) \<in> set xs" if xa: "xa < n" for xa
           proof -
             have "A $$ (0,xa) =  [vec_of_list xs] ! 0 $v xa" 
               unfolding A_def by (rule mat_of_rows_index, insert xa, auto)
             also have "... = xs ! xa" using xa by (simp add: vec_of_list_index)
             finally show ?thesis using xa by (simp add: length_eq_card n_def)
           qed
           have 3: "x \<in> (\<lambda>x. A $$ (0, x)) ` {0..<n}" if x: "x\<in> set xs" for x
           proof -
             obtain i where xs: "xs ! i = x \<and> i < n"
               by (metis in_set_conv_nth length_eq_card n_def x)
             have "A $$ (0,i) = [vec_of_list xs] ! 0 $v i" 
               unfolding A_def by (rule mat_of_rows_index, insert xs, auto)
             also have "... = xs ! i" using xs by (simp add: vec_of_list_index) 
             finally show ?thesis using xs unfolding image_def by auto
           qed
           show "bij_betw (\<lambda>x. A $$ (0, x)) {0..<n} (set xs)" using 1 2 3 unfolding bij_betw_def by auto
         qed
         finally have AB00_sum: "(A *\<^sub>v B) $v 0 = sum (\<lambda>i. f i * i) (set xs)" by auto
         hence AB_00_x: "(A *\<^sub>v B) $v 0 = x" using f by auto
         obtain Q' where QQ': "inverts_mat Q Q'" 
           and Q'Q: "inverts_mat Q' Q" and Q': "Q' \<in> carrier_mat n n"
           by (rule obtain_inverse_matrix[OF Q inv_Q], auto) 
         have eq: "A = (A*Q)*Q'" using QQ' unfolding inverts_mat_def
           by (metis A Q Q' assoc_mult_mat carrier_matD(1) right_mult_one_mat)        
         let ?g = "\<lambda>i. Matrix.row (A * Q) 0 $v i * (Matrix.row Q' i \<bullet> B)"
         have sum0: "(\<Sum>i = 1..<n. ?g i) = 0"
         proof (rule sum.neutral, rule)
           fix x assume x: "x \<in> {1..<n}"
           hence "Matrix.row (A * Q) 0 $v x = 0" using t_AQ unfolding lower_triangular_def
             by (auto, metis Q Suc_le_lessD a carrier_matD(2) index_mult_mat(2,3) index_row(1))
           thus "Matrix.row (A * Q) 0 $v x * (Matrix.row Q' x \<bullet> B) = 0" by simp
         qed
         have set_rw: "{0..<n} - {0} = {1..<n}"
           by (simp add: atLeast0LessThan atLeast1_lessThan_eq_remove0) 
         have mat_rw: "(A*Q*Q')*\<^sub>v B = A*Q*\<^sub>v(Q' *\<^sub>v B)"
           by (rule assoc_mult_mat_vec, insert Q Q' B AQ, auto)
         from eq have "A *\<^sub>vB = (A*Q)*\<^sub>v(Q'*\<^sub>v B)" using mat_rw by auto
         from this have "(A *\<^sub>v B) $v 0 = (A * Q *\<^sub>v (Q' *\<^sub>v B)) $v 0" by auto
         also have "... =  Matrix.row (A*Q) 0 \<bullet> (Q' *\<^sub>v B)"
           by (rule index_mult_mat_vec, insert a B_def n0, auto)
         also have "... =  (\<Sum>i = 0..<n. ?g i)" using Q' by (auto simp add: scalar_prod_def)
         also have "... = ?g 0 + (\<Sum>i \<in> {0..<n} - {0}. ?g i)"
           by (metis (no_types, lifting) Q atLeast0LessThan carrier_matD(2) finite_atLeastLessThan 
               lessThan_iff q0 sum.remove)        
         also have "... = ?g 0 + (\<Sum>i = 1..<n. ?g i)" using set_rw by simp        
         also have "... = ?g 0" using sum0 by auto
         also have "... = d * (Matrix.row Q' 0 \<bullet> B)" by (simp add: a d_def q0)
         finally show "x \<in> ideal_generated {d}" using AB_00_x unfolding ideal_generated_singleton 
           using mult.commute by auto
       qed
       ultimately show ?thesis by auto
     qed
     thus "principal_ideal I" unfolding principal_ideal_def ig_S by blast
   qed
 qed
 
 subsection \<open>Elementary divisor ring implies Hermite ring\<close>
 
 context
   assumes "SORT_CONSTRAINT('a::comm_ring_1)"
 begin
 
 
 lemma triangularizable_m0:
 assumes A: "A \<in> carrier_mat m 0" 
 shows "\<exists>U. U \<in> carrier_mat 0 0 \<and> invertible_mat U \<and> lower_triangular (A * U)"
   using A unfolding lower_triangular_def carrier_mat_def invertible_mat_def inverts_mat_def  
   by auto (metis gr_implies_not0 index_one_mat(2) index_one_mat(3) right_mult_one_mat')
 
 lemma triangularizable_0n:
 assumes A: "A \<in> carrier_mat 0 n" 
 shows "\<exists>U. U \<in> carrier_mat n n \<and> invertible_mat U \<and> lower_triangular (A * U)"
   using A unfolding lower_triangular_def carrier_mat_def invertible_mat_def inverts_mat_def  
   by auto (metis index_one_mat(2) index_one_mat(3) right_mult_one_mat')
 
 
 (*To show this, we have to prove that P is a matrix of one element, which is a unit.*)
 lemma diagonal_imp_triangular_1x2:
   assumes A: "A \<in> carrier_mat 1 2" and d: "admits_diagonal_reduction (A::'a mat)"
   shows "admits_triangular_reduction A"
 proof -
   obtain P Q where P: "P \<in> carrier_mat (dim_row A) (dim_row A)"
   and Q: "Q \<in> carrier_mat (dim_col A) (dim_col A)" 
   and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q"
   and SNF: "Smith_normal_form_mat (P * A * Q)"
     using d unfolding admits_diagonal_reduction_def by blast
   have "(P * A * Q) = P * (A * Q)" using P Q assoc_mult_mat by blast
   also have "... = P $$ (0,0) \<cdot>\<^sub>m (A * Q)" by (rule smult_mat_mat_one_element, insert P A Q, auto)
   also have "... = A * (P $$ (0,0) \<cdot>\<^sub>m Q)" using Q by auto
   finally have eq: "(P * A * Q) = A * (P $$ (0,0) \<cdot>\<^sub>m Q)" .
   have inv: "invertible_mat (P $$ (0,0) \<cdot>\<^sub>m Q)"
   proof -
     have d: "Determinant.det P = P $$ (0, 0)" by (rule determinant_one_element, insert P A, auto)
     from this have P_dvd_1: "P $$ (0, 0) dvd 1" 
       using invertible_iff_is_unit_JNF[OF P] using inv_P by auto
     have Q_dvd_1: "Determinant.det Q dvd 1" using inv_Q invertible_iff_is_unit_JNF[OF Q] by simp
     have "Determinant.det (P $$ (0, 0) \<cdot>\<^sub>m Q) =  P $$ (0, 0) ^ dim_col Q * Determinant.det Q" 
       unfolding det_smult by auto
     also have "... dvd 1" using P_dvd_1 Q_dvd_1 unfolding is_unit_mult_iff
       by (metis dvdE dvd_mult_left one_dvd power_mult_distrib power_one)
     finally have det: "(Determinant.det (P $$ (0, 0) \<cdot>\<^sub>m Q) dvd 1)" .
     have PQ: "P $$ (0,0) \<cdot>\<^sub>m Q \<in> carrier_mat 2 2" using A P Q by auto
     show ?thesis using invertible_iff_is_unit_JNF[OF PQ] det by auto
   qed
   moreover have "lower_triangular (A * (P $$ (0,0) \<cdot>\<^sub>m Q))" unfolding lower_triangular_def using SNF eq
     unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
   moreover have "(P $$ (0,0) \<cdot>\<^sub>m Q) \<in> carrier_mat (dim_col A) (dim_col A)" using P Q A by auto
   ultimately show ?thesis unfolding admits_triangular_reduction_def by auto
 qed
 
 lemma triangular_imp_diagonal_1x2:
 assumes A: "A \<in> carrier_mat 1 2" and t: "admits_triangular_reduction (A::'a mat)"
 shows "admits_diagonal_reduction A"
 proof -
  obtain U where U: "U \<in> carrier_mat (dim_col A) (dim_col A)"  
   and inv_U: "invertible_mat U" and AU: "lower_triangular (A * U)" 
    using t unfolding admits_triangular_reduction_def by blast
   have SNF_AU: "Smith_normal_form_mat (A * U)"
     using AU A unfolding Smith_normal_form_mat_def lower_triangular_def isDiagonal_mat_def by auto
   have "A * U = (1\<^sub>m 1) * A * U" using A by auto
   hence SNF: "Smith_normal_form_mat ((1\<^sub>m 1) * A * U)" using SNF_AU by auto
   moreover have "invertible_mat (1\<^sub>m 1)"
     using invertible_mat_def inverts_mat_def by fastforce
   ultimately show ?thesis using inv_U unfolding admits_diagonal_reduction_def
-    by (smt U assms(1) carrier_matD(1) one_carrier_mat)
+    by (smt (verit) U assms(1) carrier_matD(1) one_carrier_mat)
 qed
 
 
 lemma triangular_eq_diagonal_1x2:
  "(\<forall>A\<in>carrier_mat 1 2. admits_triangular_reduction (A::'a mat)) 
   = (\<forall>A\<in>carrier_mat 1 2. admits_diagonal_reduction (A::'a mat))"
   using triangular_imp_diagonal_1x2 diagonal_imp_triangular_1x2 by auto
 
 
 lemma admits_triangular_mat_1x1:
   assumes A: "A \<in> carrier_mat 1 1"
   shows "admits_triangular_reduction (A::'a mat)"
   by (rule admits_triangular_reduction_intro[of "1\<^sub>m 1"], insert A,
       auto simp add: admits_triangular_reduction_def  lower_triangular_def)
 
 
 lemma admits_diagonal_mat_1x1:
   assumes A: "A \<in> carrier_mat 1 1"
   shows "admits_diagonal_reduction (A::'a mat)"
   by (rule admits_diagonal_reduction_intro[of "(1\<^sub>m 1)" _ "(1\<^sub>m 1)"], 
       insert A, auto simp add: Smith_normal_form_mat_def isDiagonal_mat_def)
 
 
 lemma admits_diagonal_imp_admits_triangular_1xn:
   assumes a: "\<forall>A\<in>carrier_mat 1 2. admits_diagonal_reduction (A::'a mat)"
   shows "\<forall>A\<in>carrier_mat 1 n. admits_triangular_reduction (A::'a mat)"
 proof 
   fix A::"'a mat" assume A: "A \<in> carrier_mat 1 n"  
   have "\<exists>U. U \<in> carrier_mat (dim_col A) (dim_col A) 
     \<and> invertible_mat U \<and> lower_triangular (A * U)" (*Zeros above the diagonal*)
     using A
   proof (induct n arbitrary: A rule: less_induct)
     case (less n)
     note A = less.prems(1)
     show ?case
     proof (cases "n=0")
       case True
       then show ?thesis using triangularizable_m0 triangularizable_0n less.prems by auto
     next
       case False note nm_not_0 = False
       from this have n_not_0: "n \<noteq> 0" by auto
       show ?thesis        
       proof (cases "n>2")
         case False note n_less_2 = False
         show ?thesis using admits_triangular_mat_1x1 a diagonal_imp_triangular_1x2 
           unfolding admits_triangular_reduction_def
           by (metis (full_types) admits_triangular_mat_1x1 Suc_1 admits_triangular_reduction_def 
               less(2) less_Suc_eq less_one linorder_neqE_nat n_less_2 nm_not_0 triangular_eq_diagonal_1x2)
       next
         case True note n_ge_2 = True            
         let ?B = "mat_of_row (vec_last (Matrix.row A 0) (n - 1))"
         have "\<exists>V. V\<in> carrier_mat (dim_col ?B) (dim_col ?B) 
         \<and> invertible_mat V \<and> lower_triangular (?B * V)"
         proof (rule less.hyps)     
           show "n-1 < n" using n_not_0 by auto           
           show "mat_of_row (vec_last (Matrix.row A 0) (n - 1)) \<in> carrier_mat 1 (n - 1)" 
             using A by simp
         qed
         from this obtain V where inv_V: "invertible_mat V" and BV: "lower_triangular (?B * V)" 
           and V': "V \<in> carrier_mat (dim_col ?B) (dim_col ?B)"
           by fast  
         have V: "V \<in> carrier_mat (n-1) (n-1)" using V' by auto
         have BV_0: "\<forall>j \<in> {1..<n-1}. (?B * V) $$ (0,j) = 0"
           by (rule, rule lower_triangular_index[OF BV], insert V, auto)
         define b where "b = (?B * V) $$ (0,0)"
         define a where "a = A $$ (0,0)"          
         define ab::"'a mat" where "ab = Matrix.mat 1 2 (\<lambda>(i,j). if i=0 \<and> j=0 then a else b)"
         have ab[simp]: "ab \<in> carrier_mat 1 2" unfolding ab_def by simp
         hence "admits_diagonal_reduction ab" using a by auto
         hence "admits_triangular_reduction ab" using diagonal_imp_triangular_1x2[OF ab] by auto
         from this obtain W where inv_W: "invertible_mat W" and ab_W: "lower_triangular (ab * W)"
           and W: "W \<in> carrier_mat 2 2"
           unfolding admits_triangular_reduction_def using ab by auto
         have id_n2_carrier[simp]: "1\<^sub>m (n-2) \<in> carrier_mat (n-2) (n-2)" by auto
         define U where "U = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (n-1)) (0\<^sub>m (n-1) 1) V) * 
                                 (four_block_mat W (0\<^sub>m 2 (n-2)) (0\<^sub>m (n-2) 2) (1\<^sub>m (n-2)))"
         let ?U1 = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (n-1)) (0\<^sub>m (n-1) 1) V"
         let ?U2 = "four_block_mat W (0\<^sub>m 2 (n-2)) (0\<^sub>m (n-2) 2) (1\<^sub>m (n-2))"
         have U1[simp]: "?U1 \<in>carrier_mat n n" using four_block_carrier_mat[OF _ V] nm_not_0
           by fastforce
         have U2[simp]: "?U2 \<in>carrier_mat n n" using four_block_carrier_mat[OF W id_n2_carrier]              
           by (metis True add_diff_inverse_nat less_imp_add_positive not_add_less1)
         have U[simp]: "U \<in> carrier_mat n n" unfolding U_def using U1 U2 by auto
         moreover have inv_U: "invertible_mat U"
         proof -
           have "invertible_mat ?U1"
             by (metis U1 V det_four_block_mat_lower_left_zero_col det_one inv_V 
                 invertible_iff_is_unit_JNF more_arith_simps(5) one_carrier_mat zero_carrier_mat)
           moreover have "invertible_mat ?U2"
           proof -
             have "Determinant.det ?U2 = Determinant.det W"
               by (rule det_four_block_mat_lower_right_id, insert less.prems W n_ge_2, auto)
             also have " ... dvd 1"
               using W inv_W invertible_iff_is_unit_JNF by auto
             finally show ?thesis using invertible_iff_is_unit_JNF[OF U2] by auto
           qed
           ultimately show ?thesis
             using U1 U2 U_def invertible_mult_JNF by blast
         qed
         moreover have "lower_triangular (A*U)"
         proof -            
           let ?A = "Matrix.mat 1 n (\<lambda>(i,j). if j = 0 then a else if j=1 then b else 0)"
           let ?T = "Matrix.mat 1 n (\<lambda>(i,j). if j = 0 then (ab*W) $$ (0,0) else 0)"
           have "A*?U1 = ?A" 
           proof (rule eq_matI)
             fix i j assume i: "i<dim_row ?A" and j: "j<dim_col ?A"
             have i0: "i=0" using i by auto
             let ?f = "\<lambda> i. A $$ (0, i) * 
             (if i = 0 then if j < 1 then 1\<^sub>m (1) $$ (i, j) else 0\<^sub>m (1) (n - 1) $$ (i, j - 1)
              else if j < 1 then 0\<^sub>m (n - 1) (1) $$ (i - 1, j) else V $$ (i - 1, j - 1))"
             have "(A*?U1) $$ (i,j) = Matrix.row A i \<bullet> col ?U1 j" 
               by (rule index_mult_mat, insert i j A V, auto)           
             also have "... =  (\<Sum>i = 0..<n. ?f i)"
               using i j A V unfolding scalar_prod_def 
               by auto (unfold index_one_mat, insert One_nat_def, presburger)
             also have "... = ?A $$ (i,j)"
             proof (cases "j=0")
               case True
               have rw0: "sum ?f {1..<n} = 0" by (rule sum.neutral, insert True, auto)  
               have set_rw: "{0..<n} = insert 0 {1..<n}" using n_ge_2 by auto
               hence "sum ?f {0..<n} = ?f 0 + sum ?f {1..<n}" by auto
               also have "... = ?f 0" unfolding rw0 by simp
               also have "... = a" using True unfolding a_def by simp
               also have "... = ?A $$ (i,j)" using True i j by auto
               finally show ?thesis .
             next
               case False note j_not_0 = False
               have rw_simp: "Matrix.row (mat_of_row (vec_last (Matrix.row A 0) (n - 1))) 0 
                   = (vec_last (Matrix.row A 0) (n - 1))" unfolding Matrix.row_def by auto               
               let ?g = "\<lambda>i. A $$ (0, i) * V $$ (i - 1, j - 1)"
               let ?h = "\<lambda>i. A $$ (0, i+1) * V $$ (i, j - 1)"
               have f0: "?f 0 = 0" using j_not_0 j by auto
               have set_rw2: "(\<lambda>i. i+1)`{0..<n-1} = {1..<n}" 
                 unfolding image_def using Suc_le_D by fastforce                
               have set_rw: "{0..<n} = insert 0 {1..<n}" using n_ge_2 by auto
               hence "sum ?f {0..<n} = ?f 0 + sum ?f {1..<n}" by auto
               also have "... = sum ?f {1..<n}" using f0 by simp
               also have "... = sum ?g {1..<n}" by (rule sum.cong, insert j_not_0,  auto)
               also have "... = sum ?g ((\<lambda>i. i+1)`{0..<n-1})" using set_rw2 by simp
               also have "... = sum (?g \<circ> (\<lambda>i. i+1)) {0..<n-1}" 
                 by (rule sum.reindex, unfold inj_on_def, auto)
               also have "... = sum ?h {0..<n-1}" by (rule sum.cong, auto)
               also have "... = Matrix.row ?B 0 \<bullet> col V (j-1)" unfolding scalar_prod_def 
               proof (rule sum.cong)
                 fix x assume x: "x \<in> {0..<dim_vec (col V (j - 1))}"
                 have "Matrix.row ?B 0 $v x = ?B $$ (0,x)" by (rule index_row, insert x V, auto)
                 also have "... = (vec_last (Matrix.row A 0) (n - 1)) $v x" 
                   by (rule mat_of_row_index, insert x V, auto)
                 also have "... = A $$ (0, x + 1)"
-                  by (smt Suc_less_eq V add.right_neutral add_Suc_right add_diff_cancel_right' 
+                  by (smt (verit) Suc_less_eq V add.right_neutral add_Suc_right add_diff_cancel_right' 
                       add_diff_inverse_nat atLeastLessThan_iff carrier_matD(1) carrier_matD(2) 
                       dim_col index_row(1) index_row(2) index_vec less.prems less_Suc0 n_not_0 
                       plus_1_eq_Suc vec_last_def x)
                 finally have "Matrix.row ?B 0 $v x = A $$ (0, x + 1)" .
                 moreover have "col V (j - 1) $v x = V $$ (x, j - 1)" using V j x by auto
                 ultimately show "A $$ (0, x + 1) * V $$ (x, j - 1) 
                     = Matrix.row ?B 0 $v x * col V (j - 1) $v x" by simp
               qed (insert V j_not_0, auto)                  
               also have "... = (?B*V) $$ (0,j-1)" 
                 by (rule index_mult_mat[symmetric], insert V j False, auto)
               also have "... = ?A $$ (i, j)" 
                 by (cases "j=1", insert False V j i0 BV_0 b_def, auto simp add: Suc_leI)                               
               finally show ?thesis .
             qed
             finally show "(A*?U1) $$ (i,j) = ?A $$ (i,j)" .
           next
             show "dim_row (A*?U1) = dim_row ?A" using A by auto
             show "dim_col (A*?U1) = dim_col ?A" using U1 by auto          
           qed         
           also have "... * ?U2 = ?T"
           proof -
             let ?A1.0 = "ab"
             let ?B1.0 = "Matrix.mat 1 (n-2) (\<lambda>(i,j). 0)"
             let ?C1.0 = "Matrix.mat 0 2 (\<lambda>(i,j). 0)"
             let ?D1.0 = "Matrix.mat 0 (n-2) (\<lambda>(i,j). 0)"
             let ?B2.0 = "(0\<^sub>m 2 (n - 2))"
             let ?C2.0 = "(0\<^sub>m (n - 2) 2)"
             let ?D2.0 = "1\<^sub>m (n - 2)"
             have A_eq: "?A = four_block_mat ?A1.0 ?B1.0 ?C1.0 ?D1.0" 
               by (rule eq_matI, insert ab_def n_ge_2, auto)
             hence "?A * ?U2 = four_block_mat ?A1.0 ?B1.0 ?C1.0 ?D1.0 * ?U2" by simp
             also have "... = four_block_mat (?A1.0 * W + ?B1.0 * ?C2.0) 
               (?A1.0 * ?B2.0 + ?B1.0 * ?D2.0) (?C1.0 * W + ?D1.0 * ?C2.0) 
               (?C1.0 * ?B2.0 + ?D1.0 * ?D2.0)"
               by (rule mult_four_block_mat, auto simp add: W ab_def)
             also have "... = four_block_mat (?A1.0 * W) (?B1.0) (?C1.0) (?D1.0)"
               by (rule cong_four_block_mat, insert W ab_def, auto)
             also have "... = ?T"
               by (rule eq_matI, insert W n_ge_2 ab_def ab_W, auto simp add: lower_triangular_def)
             finally show ?thesis .                              
           qed
           finally have "A * U = ?T" 
             using assoc_mult_mat[OF _ U1 U2] less.prems unfolding U_def by auto
           moreover have "lower_triangular ?T" unfolding lower_triangular_def by simp
           ultimately show ?thesis by simp
         qed
         ultimately show ?thesis using A U by blast
       qed
     qed
   qed
   from this show "admits_triangular_reduction A" unfolding admits_triangular_reduction_def by simp
 qed
 
 lemma admits_diagonal_imp_admits_triangular:
   assumes a: "\<forall>A\<in>carrier_mat 1 2. admits_diagonal_reduction (A::'a mat)"
   shows "\<forall>A. admits_triangular_reduction (A::'a mat)"
 proof 
   fix A::"'a mat"
   obtain m n where A: "A \<in> carrier_mat m n" by auto
   have "\<exists>U. U \<in> carrier_mat n n \<and> invertible_mat U \<and> lower_triangular (A * U)" (*Zeros above the diagonal*)
     using A
   proof (induct n arbitrary: m A rule: less_induct)
     case (less n)
     note A = less.prems(1)
     show ?case
     proof (cases "n=0 \<or> m=0")
       case True
       then show ?thesis using triangularizable_m0 triangularizable_0n less.prems by auto
     next
       case False note nm_not_0 = False
       from this have m_not_0: "m \<noteq> 0" and n_not_0: "n \<noteq> 0" by auto    
       show ?thesis        
       proof (cases "m = 1")
         case True note m1 = True
         show ?thesis using admits_diagonal_imp_admits_triangular_1xn A m1 a 
           unfolding admits_triangular_reduction_def by blast
       next
         case False note m_not_1 = False
           (* The article says "Right-multiply A by a unimodular matrix V which reduces the first row.
            To do that, I use the first case of the induction (m=1) to reduce the first row. 
            With lemma mult_eq_first_row I will show that A*V reduces the first row.
         *)
         show ?thesis 
         proof (cases "n=1")
           case True
           thus ?thesis using invertible_mat_zero lower_triangular_def
             by (metis carrier_matD(2) det_one gr_implies_not0 invertible_iff_is_unit_JNF less(2) 
                 less_one one_carrier_mat right_mult_one_mat')
         next
           case False note n_not_1 = False                  
           let ?first_row = "mat_of_row (Matrix.row A 0)"
           have first_row: "?first_row \<in> carrier_mat 1 n" using less.prems by auto
           have m1: "m>1" using m_not_1 m_not_0 by linarith
           have n1: "n>1" using n_not_1 n_not_0 by linarith 
           obtain V where lt_first_row_V: "lower_triangular (?first_row * V)"
             and inv_V: "invertible_mat V" and V: "V \<in> carrier_mat n n"
             (*Using the other induction case*)
             using admits_diagonal_imp_admits_triangular_1xn a first_row 
             unfolding admits_triangular_reduction_def by blast
           have AV: "A*V \<in> carrier_mat m n" using V less by auto
           have dim_row_AV: "dim_row (A * V) = 1 + (m-1)" using m1 AV by auto
           have dim_col_AV: "dim_col (A * V) = 1 + (n-1)" using n1 AV by fastforce
           have reduced_first_row: "Matrix.row (?first_row * V) 0 = Matrix.row (A * V) 0"  
             by (rule mult_eq_first_row, insert first_row m1 less.prems, auto)
           obtain a zero B C where split: "split_block (A*V) 1 1 = (a, zero, B, C)"          
             using prod_cases4 by blast
           have a: "a \<in> carrier_mat 1 1" and zero: "zero \<in> carrier_mat 1 (n-1)" and
             B: "B \<in> carrier_mat (m-1) 1" and C: "C \<in> carrier_mat (m-1) (n-1)"
             by (rule split_block[OF split dim_row_AV dim_col_AV])+
           have AV_block: "A*V = four_block_mat a zero B C"
             by (rule split_block[OF split dim_row_AV dim_col_AV])
           have "\<exists>W. W\<in> carrier_mat (n-1) (n-1) \<and> invertible_mat W \<and> lower_triangular (C*W)" 
             by (rule less.hyps, insert n1 C, auto)        
           from this obtain W where inv_W: "invertible_mat W" and lt_CW: "lower_triangular (C*W)" 
             and W: "W \<in> carrier_mat (n-1) (n-1)" by blast
           let ?W2 = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (n-1)) (0\<^sub>m (n-1) 1) W"
           have W2: "?W2 \<in> carrier_mat n n" using V W dim_col_AV by auto
           have "Determinant.det ?W2 = Determinant.det (1\<^sub>m 1) * Determinant.det W" 
             by (rule det_four_block_mat_lower_left_zero_col[OF _ _ _ W], auto)
           hence det_W2: "Determinant.det ?W2 = Determinant.det W" by auto
           hence inv_W2: "invertible_mat ?W2"
             by (metis W four_block_carrier_mat inv_W invertible_iff_is_unit_JNF one_carrier_mat)
           have inv_V_W2: "invertible_mat (V * ?W2)" using inv_W2 inv_V V W2 invertible_mult_JNF by blast
           have "lower_triangular (A*V*?W2)"
           proof -
             let ?T = "(four_block_mat a (0\<^sub>m 1 (n-1)) B (C * W))"
             have zero_eq: "zero = 0\<^sub>m 1 (n-1)"
             proof (rule eq_matI)
               show 1: "dim_row zero = dim_row (0\<^sub>m 1 (n - 1))" and 2: "dim_col zero = dim_col (0\<^sub>m 1 (n - 1))"
                 using zero by auto
               fix i j assume i: "i < dim_row (0\<^sub>m 1 (n - 1))" and j: "j < dim_col (0\<^sub>m 1 (n - 1))"
               have i0: "i=0" using i by auto            
               have "0 = Matrix.row (?first_row * V) 0 $v (j+1)"
                 using lt_first_row_V j unfolding lower_triangular_def
                 by (metis Suc_eq_plus1 carrier_matD(2) index_mult_mat(2,3) index_row(1) less_diff_conv
                     mat_of_row_dim(1) zero zero_less_Suc zero_less_one_class.zero_less_one V 2)
               also have "... = Matrix.row (A*V) 0 $v (j+1)" by (simp add: reduced_first_row)
               also have "... = (A*V) $$ (i, j+1)" using V dim_row_AV i0 j by auto
               also have "... = four_block_mat a zero B C $$ (i, j+1)" by (simp add: AV_block)
               also have "... = (if i < dim_row a then if (j+1) < dim_col a 
               then a $$ (i, (j+1)) else zero $$ (i, (j+1) - dim_col a) else if (j+1) < dim_col a
               then B $$ (i - dim_row a, (j+1)) else C $$ (i - dim_row a, (j+1) - dim_col a))"               
                 by (rule index_mat_four_block, insert a zero i j C, auto)
               also have "... = zero $$ (i, (j+1) - dim_col a)" using a zero i j C by auto
               also have "... = zero $$ (i, j)" using a i by auto
               finally show "zero $$ (i, j) = 0\<^sub>m 1 (n - 1) $$ (i, j)" using i j by auto
             qed
             have rw1: "a * (1\<^sub>m 1) + zero * (0\<^sub>m (n-1) 1) = a" using a zero by auto
             have rw2: "a * (0\<^sub>m 1 (n-1)) + zero * W = 0\<^sub>m 1 (n-1)" using a zero zero_eq W by auto
             have rw3: "B * (1\<^sub>m 1) + C * (0\<^sub>m (n-1) 1) = B" using B C by auto
             have rw4: "B * (0\<^sub>m 1 (n-1)) + C * W = C * W" using B C W by auto
             have "A*V = four_block_mat a zero B C" by (rule AV_block)
             also have "... * ?W2 = four_block_mat (a * (1\<^sub>m 1) + zero * (0\<^sub>m (n-1) 1)) 
           (a * (0\<^sub>m 1 (n-1)) + zero * W) (B * (1\<^sub>m 1) + C * (0\<^sub>m (n-1) 1))
           (B * (0\<^sub>m 1 (n-1)) + C * W)" by (rule mult_four_block_mat[OF a zero B C], insert W, auto)
             also have "... = ?T" using rw1 rw2 rw3 rw4 by simp
             finally have AVW2: "A*V * ?W2 = ..." .
             moreover have "lower_triangular ?T" 
               using lt_CW unfolding lower_triangular_def using a zero B C W
               by (auto, metis (full_types) Suc_less_eq Suc_pred basic_trans_rules(19))
             ultimately show ?thesis by simp
           qed
           then show ?thesis using inv_V_W2 V W2 less.prems
-            by (smt assoc_mult_mat mult_carrier_mat)
+            by (smt (verit) assoc_mult_mat mult_carrier_mat)
         qed
       qed
     qed
   qed
   thus "admits_triangular_reduction A" using A unfolding admits_triangular_reduction_def by simp
 qed
 
 corollary admits_diagonal_imp_admits_triangular':
   assumes a: "\<forall>A. admits_diagonal_reduction (A::'a mat)"
   shows "\<forall>A. admits_triangular_reduction (A::'a mat)"
   using admits_diagonal_imp_admits_triangular assms by blast
 
 
 lemma admits_triangular_reduction_1x2:
   assumes "\<forall>A::'a mat. A \<in> carrier_mat 1 2 \<longrightarrow> admits_triangular_reduction A"
   shows "\<forall>C::'a mat. admits_triangular_reduction C" 
   using admits_diagonal_imp_admits_triangular assms triangular_eq_diagonal_1x2 by auto  
 
  
 lemma Hermite_ring_OFCLASS:
  assumes "\<forall>A \<in> carrier_mat 1 2. admits_triangular_reduction (A::'a mat)"
  shows "OFCLASS('a, Hermite_ring_class)"
 proof
   show "\<forall>A::'a mat. admits_triangular_reduction A" 
     by (rule admits_diagonal_imp_admits_triangular[OF assms[unfolded triangular_eq_diagonal_1x2]])     
 qed
 
 lemma Hermite_ring_OFCLASS':
  assumes "\<forall>A \<in> carrier_mat 1 2.admits_diagonal_reduction (A::'a mat)"
  shows "OFCLASS('a, Hermite_ring_class)"
 proof
   show "\<forall>A::'a mat. admits_triangular_reduction A" 
     by (rule admits_diagonal_imp_admits_triangular[OF assms])     
 qed
 
 lemma theorem3_part1:
   assumes T: "(\<forall>a b::'a. \<exists> a1 b1 d. a = a1*d \<and> b = b1*d 
     \<and> ideal_generated {a1,b1} = ideal_generated {1})"
   shows "\<forall>A::'a mat. admits_triangular_reduction A"
 proof (rule admits_triangular_reduction_1x2, rule allI, rule impI)
   fix A::"'a mat"
   assume A: "A \<in> carrier_mat 1 2"
   let ?a = "A $$ (0,0)"
   let ?b = "A $$ (0,1)"
   obtain a1 b1 d where a: "?a = a1*d" and b: "?b = b1*d" 
     and i: "ideal_generated {a1,b1} = ideal_generated {1}" 
     using T by blast
   obtain s t where sa1tb1:"s*a1+t*b1=1" using ideal_generated_pair_exists_pq1[OF i[simplified]] by blast
   let ?Q = "Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then s else
                                     if  i = 0 \<and> j = 1 then -b1 else
                                     if  i = 1 \<and> j = 0 then t else a1)"
   have Q: "?Q \<in> carrier_mat 2 2" by auto
   have det_Q: "Determinant.det ?Q = 1" unfolding det_2[OF Q] 
     using sa1tb1 by (simp add: mult.commute)
   hence inv_Q: "invertible_mat ?Q" using invertible_iff_is_unit_JNF[OF Q] by auto
   have lower_AQ: "lower_triangular (A*?Q)" 
   proof -
     have "Matrix.row A 0 $v Suc 0 * a1 = Matrix.row A 0 $v 0 * b1" if j2: "j<2" and j0: "0<j" for j
       by (metis A One_nat_def a b carrier_matD(1) carrier_matD(2) index_row(1) lessI 
           more_arith_simps(11) mult.commute numeral_2_eq_2 pos2)
     thus ?thesis unfolding lower_triangular_def using A 
       by (auto simp add: scalar_prod_def sum_two_rw)
   qed
   show "admits_triangular_reduction A" 
     unfolding admits_triangular_reduction_def using lower_AQ inv_Q Q A by force    
 qed
 
 
 lemma theorem3_part2:
   assumes 1: "\<forall>A::'a mat. admits_triangular_reduction A"
   shows "\<forall>a b::'a. \<exists> a1 b1 d. a = a1*d \<and> b = b1*d \<and> ideal_generated {a1,b1} = ideal_generated {1}"
 proof (rule allI)+
   fix a b::'a
   let ?A = "Matrix.mat 1 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then a else b)"
   obtain Q where AQ: "lower_triangular (?A*Q)" and inv_Q: "invertible_mat Q"
     and Q: "Q \<in> carrier_mat 2 2"
     using 1 unfolding admits_triangular_reduction_def by fastforce
   hence [simp]: "dim_col Q = 2" and [simp]: "dim_row Q = 2" by auto
   let ?s = "Q $$ (0,0)"
   let ?t = "Q $$ (1,0)"
   let ?a1 = "Q $$ (1,1)"
   let ?b1 = "-(Q $$ (0,1))"
   let ?d = "(?A*Q) $$ (0,0)"
   have ab1_ba1: "a*?b1 = b*?a1"
   proof -     
     have  "(?A*Q) $$ (0,1) =  (\<Sum>i = 0..<2. (if i = 0 then a else b) * Q $$ (i, Suc 0))"
       unfolding times_mat_def col_def scalar_prod_def by auto
     also have "... = (\<Sum>i \<in> {0,1}. (if i = 0 then a else b) * Q $$ (i, Suc 0))" 
       by (rule sum.cong, auto)
     also have "... = - a*?b1 + b*?a1" by auto
     finally have "(?A*Q) $$ (0,1) = - a*?b1 + b*?a1" by simp
     moreover have "(?A*Q) $$ (0,1) = 0" using AQ unfolding lower_triangular_def by auto  
     ultimately show ?thesis
       by (metis add_left_cancel more_arith_simps(3) more_arith_simps(7))    
   qed
   have sa_tb_d: "?s*a+?t*b = ?d"
   proof -
     have "?d = (\<Sum>i = 0..<2. (if i = 0 then a else b) * Q $$ (i, 0))"
       unfolding times_mat_def col_def scalar_prod_def by auto
     also have "... = (\<Sum>i \<in> {0,1}. (if i = 0 then a else b) * Q $$ (i, 0))" by (rule sum.cong, auto)
     also have "... = ?s*a+?t*b" by auto
     finally show ?thesis by simp
   qed
   have det_Q_dvd_1: "(Determinant.det Q dvd 1)"
     using invertible_iff_is_unit_JNF[OF Q] inv_Q by auto
   moreover have det_Q_eq: "Determinant.det Q = ?s*?a1 + ?t*?b1" unfolding det_2[OF Q] by simp
   ultimately have "?s*?a1 + ?t*?b1 dvd 1" by auto
   from this obtain u where u_eq: "?s*?a1 + ?t*?b1 = u" and u: "u dvd 1" by auto
   hence eq1: "?s*?a1*a + ?t*?b1*a = u*a"
     by (metis ring_class.ring_distribs(2))
   hence "?s*?a1*a + ?t*?a1*b = u*a"
     by (metis (no_types, lifting) ab1_ba1 mult.assoc mult.commute)
   hence a1d_ua:"?a1*?d=u*a"
-    by (smt Groups.mult_ac(2) distrib_left more_arith_simps(11) sa_tb_d)
+    by (smt (verit) Groups.mult_ac(2) distrib_left more_arith_simps(11) sa_tb_d)
   hence b1d_ub: "?b1*?d=u*b"
-    by (smt Groups.mult_ac(2) Groups.mult_ac(3) ab1_ba1 distrib_right sa_tb_d u_eq)
+    by (smt (verit) Groups.mult_ac(2) Groups.mult_ac(3) ab1_ba1 distrib_right sa_tb_d u_eq)
   obtain inv_u where inv_u: "inv_u * u = 1" using u unfolding dvd_def
     by (metis mult.commute)
   hence inv_u_dvd_1: "inv_u dvd 1" unfolding dvd_def by auto
   have cond1: "(inv_u*?b1)*?d = b" using b1d_ub inv_u
     by (metis (no_types, lifting) Groups.mult_ac(3) more_arith_simps(11) more_arith_simps(6))
   have cond2: "(inv_u*?a1)*?d = a" using a1d_ua inv_u
     by (metis (no_types, lifting) Groups.mult_ac(3) more_arith_simps(11) more_arith_simps(6))
   have "ideal_generated {inv_u*?a1, inv_u*?b1} = ideal_generated {?a1,?b1}"
     by (rule ideal_generated_mult_unit2[OF inv_u_dvd_1])    
   also have "... = UNIV" using ideal_generated_pair_UNIV[OF u_eq u] by simp
   finally have cond3: "ideal_generated {inv_u*?a1, inv_u*?b1} = ideal_generated {1}" by auto
   show "\<exists>a1 b1 d. a = a1 * d \<and> b = b1 * d \<and> ideal_generated {a1, b1} = ideal_generated {1}"
     by (rule exI[of _ "inv_u*?a1"], rule exI[of _ "inv_u*?b1"], rule exI[of _ ?d],
         insert cond1 cond2 cond3, auto)
 qed
   
 
 theorem theorem3:
   shows "(\<forall>A::'a mat. admits_triangular_reduction A)
   = (\<forall>a b::'a. \<exists> a1 b1 d. a = a1*d \<and> b = b1*d \<and> ideal_generated {a1,b1} = ideal_generated {1})"
   using theorem3_part1 theorem3_part2 by auto
 
 end
 
 
 
 context comm_ring_1
 begin
 
 
 lemma lemma4_prev:
   assumes a: "a = a1*d" and b: "b = b1*d"
   and i: "ideal_generated {a1,b1} = ideal_generated {1}"
 shows "ideal_generated {a,b} = ideal_generated {d}"
 proof -
  have 1: "\<exists>k. p * (a1 * d) + q * (b1 * d) = k * d" for p q
     by (metis (full_types) local.distrib_right local.mult.semigroup_axioms semigroup.assoc)  
   have "ideal_generated {a,b} \<subseteq> ideal_generated {d}"
   proof -
     have "ideal_generated {a,b} = {p*a+q*b | p q. True}" using ideal_generated_pair by auto
     also have "... = {p*(a1*d)+q*(b1*d) | p q. True}" using a b by auto
     also have "... \<subseteq> {k*d|k. True}" using 1 by auto
     finally show ?thesis
       by (simp add: a b local.dvd_ideal_generated_singleton' local.ideal_generated_subset2)
   qed
   moreover have "ideal_generated{d} \<subseteq> ideal_generated {a,b}" 
   proof (rule ideal_generated_singleton_subset)
     obtain p q where "p*a1+q*b1 = 1" using ideal_generated_pair_exists_UNIV i by auto
     hence "d = p * (a1 * d) + q * (b1 * d)"
       by (metis local.mult_ac(3) local.ring_distribs(1) local.semiring_normalization_rules(12))
     also have "... \<in>  {p*(a1*d)+q*(b1*d) | p q. True}" by auto
     also have "... = ideal_generated {a,b}" unfolding ideal_generated_pair a b by auto
     finally show "d \<in> ideal_generated {a,b}" by simp
   qed (simp)
   ultimately show ?thesis by simp
 qed
 
 
 lemma lemma4:
   assumes a: "a = a1*d" and b: "b = b1*d"
     and i: "ideal_generated {a1,b1} = ideal_generated {1}"
     and i2: "ideal_generated {a,b} = ideal_generated {d'}"
   shows "\<exists>a1' b1'. a = a1' * d' \<and> b = b1' * d' 
     \<and> ideal_generated {a1',b1'} = ideal_generated {1}"
 proof -
   have i3: "ideal_generated {a,b} = ideal_generated {d}" using lemma4_prev assms by auto
   have d_dvd_d': "d dvd d'"
     by (metis a b i2 dvd_ideal_generated_singleton dvd_ideal_generated_singleton' 
         dvd_triv_right ideal_generated_subset2)
   have d'_dvd_d: "d' dvd d" 
     using i3 i2 local.dvd_ideal_generated_singleton by auto
   obtain k and l where d: "d = k*d'" and d': "d' = l*d"
     using d_dvd_d' d'_dvd_d mult_ac unfolding dvd_def by auto
   obtain s t where sa1_tb1: "s*a1 + t*b1 = 1"
     using i ideal_generated_pair_exists_UNIV[of a1 b1] by auto
   let ?a1' = "k * l * t - t + a1 * k"
   let ?b1' = "s - k * l * s + b1 * k"
   have 1: "?a1'*d'=a"
     by (metis a d d' add_ac(2) add_diff_cancel add_diff_eq mult_ac(2) ring_distribs(1,4) 
         semiring_normalization_rules(18))
   have 2: "?b1'*d' = b"
     by (metis (no_types, opaque_lifting) b d d' add_ac(2) add_diff_cancel add_diff_eq mult_ac(2) mult_ac(3) 
         ring_distribs(2,4) semiring_normalization_rules(18)) 
   have "(s*l-b1)*?a1' + (t*l+a1)*?b1' = 1"
   proof -
     have aux_rw1: "s * l * k * l * t = t * l * k * l * s" and aux_rw2: "s * l * t=t * l * s" 
       and aux_rw3: "b1 * a1 * k=a1 * b1 * k" and aux_rw4: "t * l * b1 * k=b1 * k * l * t"
       and aux_rw5: "s * l * a1 * k=a1 * k * l * s"
       using mult.commute mult.assoc by auto
     note aux_rw = aux_rw1 aux_rw2 aux_rw3 aux_rw4 aux_rw5
     have "(s*l-b1)*?a1' + (t*l+a1)*?b1' = s*l*?a1' - b1*?a1' + t*l*?b1'+a1*?b1'"
       using local.add_ac(1) local.left_diff_distrib' local.ring_distribs(2) by auto
     also have "... = s * l * k * l*t - s * l * t + s * l * a1 * k-b1 * k * l * t + b1 * t-b1 * a1 * k
       + t * l * s-t * l * k * l * s + t * l * b1 * k + a1 * s - a1 * k * l * s + a1 * b1 * k"
-      by (smt abel_semigroup.commute add.abel_semigroup_axioms diff_add_eq diff_diff_eq2
-          mult.semigroup_axioms ring_distribs(4) semiring_normalization_rules(34) semigroup.assoc)
+      by (smt (verit) local.add_diff_eq local.diff_add_eq local.diff_diff_eq2 local.mult_ac(1) local.ring_distribs(4))
     also have "... = a1 * s + b1 * t" unfolding aux_rw
-      by (smt add_ac(2) add_ac(3) add_minus_cancel ring_distribs(4) ring_normalization_rules(2))
+      by (smt (verit, ccfv_SIG) local.add_diff_cancel_left' local.diff_add_eq local.eq_diff_eq)
     also have "... = 1" using sa1_tb1 mult.commute by auto
     finally show ?thesis by simp
   qed
   hence "ideal_generated {?a1',?b1'} = ideal_generated {1}"
     using ideal_generated_pair_exists_UNIV[of ?a1' ?b1'] by auto
   thus ?thesis using 1 2 by auto
 qed
 
 
 (*In the article, this is a corollary. But here, this needs more work.*)
 lemma corollary5:
   assumes T: "\<forall>a b. \<exists>a1 b1 d. a = a1 * d \<and> b = b1 * d 
         \<and> ideal_generated {a1, b1} = ideal_generated {1::'a}"
  and i2: "ideal_generated {a,b,c} = ideal_generated {d}"
   shows "\<exists> a1 b1 c1. a = a1 * d \<and> b = b1 * d \<and> c = c1 * d 
   \<and> ideal_generated {a1,b1,c1} = ideal_generated {1}"
 proof -
   have da: "d dvd a" using ideal_generated_singleton_dvd[OF i2] by auto
   have db: "d dvd b" using ideal_generated_singleton_dvd[OF i2] by auto
   have dc: "d dvd c" using ideal_generated_singleton_dvd[OF i2] by auto
   from this obtain c1' where c: "c = c1' * d" using dvd_def mult_ac(2) by auto
   obtain a1 b1 d' where a: "a = a1 * d'" and b: "b = b1 * d' "
     and i: "ideal_generated {a1, b1} = ideal_generated {1::'a}" using T by blast
   have i_ab_d': "ideal_generated {a, b} = ideal_generated {d'}"
     by (simp add: a b i lemma4_prev)
   have i2: "ideal_generated {d', c} = ideal_generated {d}"
     by (rule ideal_generated_triple_pair_rewrite[OF i2 i_ab_d'])  
   obtain u v dp  where d'1: "d' = u * dp" and d'2: "c = v * dp" 
     and xy: "ideal_generated{u,v}=ideal_generated{1}" using T by blast
   have "\<exists>a1' b1'. d' = a1' * d \<and> c = b1' * d \<and> ideal_generated {a1', b1'} = ideal_generated {1}"
     by (rule lemma4[OF d'1 d'2 xy i2])
   from this obtain a1' c1 where d'_a1: "d' = a1' * d" and c: "c = c1 * d" 
     and i3: "ideal_generated {a1', c1} = ideal_generated {1}" by blast
   have r1: "a = a1 * a1' * d" by (simp add: d'_a1 a local.semiring_normalization_rules(18))
   have r2: "b = b1 * a1' * d" by (simp add: d'_a1 b local.semiring_normalization_rules(18))
   have i4: "ideal_generated {a1 * a1',b1 * a1', c1} = ideal_generated {1}"
   proof -
     obtain p q where 1: "p * a1' + q * c1 = 1" 
       using i3 unfolding ideal_generated_pair_exists_UNIV by auto
     obtain x y where 2: "x*a1 + y*b1 = p" using ideal_generated_UNIV_obtain_pair[OF i] by blast
     have "1 = (x*a1 + y*b1) * a1' + q * c1" using 1 2 by auto
     also have "... = x*a1*a1' + y*b1*a1' + q * c1" by (simp add: local.ring_distribs(2))
     finally have "1 = x*a1*a1' + y*b1*a1' + q * c1" .
     hence "1 \<in> ideal_generated {a1 * a1', b1 * a1', c1}" 
       using ideal_explicit2[of "{a1 * a1', b1 * a1', c1}"] sum_three_elements'
       by (simp add: mult_assoc)
     hence "ideal_generated {1} \<subseteq> ideal_generated {a1 * a1',b1 * a1', c1}"
       by (rule ideal_generated_singleton_subset, auto)   
     thus ?thesis by auto
   qed
   show ?thesis using r1 r2 i4 c by auto
 qed
 
 
 end
 
 context
   assumes "SORT_CONSTRAINT('a::comm_ring_1)"
 begin
 
 lemma OFCLASS_elementary_divisor_ring_imp_class:
   assumes "OFCLASS('a::comm_ring_1, elementary_divisor_ring_class)"
   shows " class.elementary_divisor_ring TYPE('a)" 
   by (rule conjunctionD2[OF assms[unfolded elementary_divisor_ring_class_def]])
 
 
 (*ELEMENTARY DIVISOR RING \<Longrightarrow> HERMITE*)
 corollary Elementary_divisor_ring_imp_Hermite_ring:
   assumes "OFCLASS('a::comm_ring_1, elementary_divisor_ring_class) "
   shows "OFCLASS('a::comm_ring_1, Hermite_ring_class)"
 proof
   have "\<forall>A::'a mat. admits_diagonal_reduction A" 
     using OFCLASS_elementary_divisor_ring_imp_class[OF assms] 
     unfolding class.elementary_divisor_ring_def by auto
   thus "\<forall>A::'a mat. admits_triangular_reduction A" 
     using admits_diagonal_imp_admits_triangular by auto
 qed
 
 (*ELEMENTARY DIVISOR RING \<Longrightarrow> BEZOUT*)
 corollary Elementary_divisor_ring_imp_Bezout_ring:
   assumes "OFCLASS('a::comm_ring_1, elementary_divisor_ring_class) "
   shows "OFCLASS('a::comm_ring_1, bezout_ring_class)"
   by (rule Hermite_ring_imp_Bezout_ring, rule Elementary_divisor_ring_imp_Hermite_ring[OF assms])
 
 subsection \<open>Characterization of Elementary divisor rings\<close>
 
 lemma necessity_D': 
   assumes edr: "(\<forall>(A::'a mat). admits_diagonal_reduction A)"
   shows "\<forall>a b c::'a. ideal_generated {a,b,c} = ideal_generated{1} 
   \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1})"
 proof ((rule allI)+, rule impI)
   fix a b c::'a 
   assume i: "ideal_generated {a,b,c} = ideal_generated{1}"  
   define A where "A = Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then a else
                                     if  i = 0 \<and> j = 1 then b else
                                     if  i = 1 \<and> j = 0 then 0 else c)"
   have A: "A \<in> carrier_mat 2 2" unfolding A_def by auto
   obtain P Q where P: "P \<in> carrier_mat (dim_row A) (dim_row A)"
         and Q: "Q \<in> carrier_mat (dim_col A) (dim_col A)" 
         and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q" 
         and SNF_PAQ: "Smith_normal_form_mat (P * A * Q)"
     using edr unfolding admits_diagonal_reduction_def by blast
   have [simp]: "dim_row P = 2" and [simp]: "dim_col P = 2 " and [simp]: "dim_row Q = 2" 
     and [simp]: "dim_col Q = 2" and [simp]: "dim_col A = 2" and [simp]: "dim_row A = 2" 
     using A P Q by auto
   define u where "u = (P*A*Q) $$ (0,0)"  
   define p where "p = P $$ (0,0)"
   define q where "q = P $$ (0,1)"
   define x where "x = Q $$ (0,0)"
   define y where "y = Q $$ (1,0)"
   have eq: "p*a*x + p*b*y + q*c*y = u"
   proof -   
     have rw1: "(\<Sum>ia = 0..<2. P $$ (0, ia) * A $$ (ia, x)) * Q $$ (x, 0) 
     = (\<Sum>ia\<in>{0, 1}. P $$ (0, ia) * A $$ (ia, x)) * Q $$ (x, 0)" 
       for x by (unfold sum_distrib_right, rule sum.cong, auto) 
     have "u = (\<Sum>i = 0..<2. (\<Sum>ia = 0..<2. P $$ (0, ia) * A $$ (ia, i)) * Q $$ (i, 0))"
       unfolding u_def p_def q_def x_def y_def
       unfolding times_mat_def scalar_prod_def by auto
     also have "... = (\<Sum>i \<in>{0,1}. (\<Sum>ia \<in> {0,1}. P $$ (0, ia) * A $$ (ia, i)) * Q $$ (i, 0))"
       by (rule sum.cong[OF _ rw1], auto)    
     also have "... = p*a*x + p*b*y+q*c*y"
       unfolding u_def p_def q_def x_def y_def A_def 
       using ring_class.ring_distribs(2) by auto
     finally show ?thesis ..
   qed  
   have u_dvd_1: "u dvd 1"
   (*
   The article deduces this fact since u divides all the elements of the matrix A. Here, this is 
   already proved using GCD and minors, but it requires the semiring_GCD class.
   At the end, I proved this fact by means of matrix multiplications once the inverse matrices of P
   and Q are obtained.
   *)
   proof (rule ideal_generated_dvd2[OF i])
     define D where "D = (P*A*Q)"
     obtain P' where  P'[simp]: "P' \<in> carrier_mat 2 2" and inv_P: "inverts_mat P' P" 
       using inv_P obtain_inverse_matrix[OF P inv_P]
       by (metis \<open>dim_row A = 2\<close>)      
     obtain Q' where [simp]: "Q' \<in> carrier_mat 2 2" and inv_Q: "inverts_mat Q Q'" 
       using inv_Q obtain_inverse_matrix[OF Q inv_Q]
       by (metis \<open>dim_col A = 2\<close>)
     have D[simp]: "D \<in> carrier_mat 2 2" unfolding D_def by auto
     have e: "P' * D * Q' = A" unfolding D_def by (rule inv_P'PAQQ'[OF _ _ inv_P inv_Q], auto)
     have [simp]: "(P' * D) \<in> carrier_mat 2 2" using D P' mult_carrier_mat by blast
     have D_01: "D $$ (0, 1) = 0" 
       using D_def SNF_PAQ unfolding Smith_normal_form_mat_def isDiagonal_mat_def by force
     have D_10: "D $$ (1, 0) = 0"
       using D_def SNF_PAQ unfolding Smith_normal_form_mat_def isDiagonal_mat_def by force
     have "D $$ (0,0) dvd D $$ (1, 1)" 
       using D_def SNF_PAQ unfolding Smith_normal_form_mat_def by auto
     from this obtain k where D11: "D $$ (1, 1) = D $$ (0,0) * k" unfolding dvd_def by blast
     have P'D_00: "(P' * D) $$ (0, 0) = P' $$ (0, 0) * D $$ (0, 0)" 
       using mat_mult2_00[of P' D] D_10 by auto 
     have P'D_01: "(P' * D) $$ (0, 1) =  P' $$ (0, 1) * D $$ (1, 1)" 
       using mat_mult2_01[of P' D] D_01 by auto
     have P'D_10: "(P' * D) $$ (1, 0) = P' $$ (1, 0) * D $$ (0, 0)" 
       using mat_mult2_10[of P' D] D_10 by auto
     have P'D_11: "(P' * D) $$ (1, 1) = P' $$ (1, 1) * D $$ (1, 1)" 
       using mat_mult2_11[of P' D] D_01 by auto
     have "a = (P' * D * Q') $$ (0,0)" using e A_def by auto
     also have "... = (P' * D) $$ (0, 0) * Q' $$ (0, 0) + (P' * D) $$ (0, 1) * Q' $$ (1, 0)" 
       by (rule mat_mult2_00, auto)
     also have "... = P' $$ (0, 0) * D $$ (0, 0) * Q' $$ (0, 0) 
       + P' $$ (0, 1) * (D $$ (0, 0) * k) * Q' $$ (1, 0)" unfolding P'D_00 P'D_01 D11 ..
     also have "... = D $$ (0, 0) * (P' $$ (0, 0) * Q' $$ (0, 0) 
       + P' $$ (0, 1) * k * Q' $$ (1, 0))" by (simp add: distrib_left)
     finally have u_dvd_a: "u dvd a" unfolding u_def D_def dvd_def by auto
     have "b = (P' * D * Q') $$ (0,1)" using e A_def by auto
     also have "... = (P' * D) $$ (0, 0) * Q' $$ (0, 1) + (P' * D) $$ (0, 1) * Q' $$ (1, 1)" 
       by (rule mat_mult2_01, auto)
     also have "... =  P' $$ (0, 0) * D $$ (0, 0) * Q' $$ (0, 1) +
        P' $$ (0, 1) * (D $$ (0, 0) * k) * Q' $$ (1, 1)" 
       unfolding P'D_00 P'D_01 D11 ..
     also have "... = D $$ (0, 0) * (P' $$ (0, 0) * Q' $$ (0, 1) +
        P' $$ (0, 1) * k * Q' $$ (1, 1))"  by (simp add: distrib_left)
     finally have u_dvd_b: "u dvd b" unfolding u_def D_def dvd_def by auto
     have "c = (P' * D * Q') $$ (1,1)" using e A_def by auto
     also have "... = (P' * D) $$ (1, 0) * Q' $$ (0, 1) + (P' * D) $$ (1, 1) * Q' $$ (1, 1)" 
       by (rule mat_mult2_11, auto)
     also have "... = P' $$ (1, 0) * D $$ (0, 0) * Q' $$ (0, 1) 
         + P' $$ (1, 1) * (D $$ (0, 0) * k) * Q' $$ (1, 1)" unfolding P'D_11 P'D_10 D11 ..
     also have "... = D $$ (0, 0) * (P' $$ (1, 0) * Q' $$ (0, 1) 
         + P' $$ (1, 1) * k * Q' $$ (1, 1))" by (simp add: distrib_left)
     finally have u_dvd_c: "u dvd c" unfolding u_def D_def dvd_def by auto
     show "\<forall>x\<in>{a,b,c}. u dvd x" using u_dvd_a u_dvd_b u_dvd_c by auto
   qed (simp)
   have "ideal_generated {p*a,p*b+q*c} = ideal_generated {1}"
     by (metis (no_types, lifting) eq add.assoc ideal_generated_1 ideal_generated_pair_UNIV 
         mult.commute semiring_normalization_rules(34) u_dvd_1)
   from this show "\<exists>p q. ideal_generated {p * a, p * b + q * c} = ideal_generated {1}"
     by auto
 qed
 
 lemma necessity:
   assumes "(\<forall>(A::'a mat). admits_diagonal_reduction A)"
   shows "(\<forall>(A::'a mat). admits_triangular_reduction A)"
  and "\<forall>a b c::'a. ideal_generated{a,b,c} = ideal_generated{1} 
   \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1})"
   using necessity_D' admits_diagonal_imp_admits_triangular assms
   by blast+
 
 text \<open>In the article, the authors change the notation and assume $(a,b,c) = (1)$. However,
 we have to provide here the complete prove. To to this, I obtained a $D$ matrix such that
 $A' = A*D$ and $D$ is a diagonal matrix with $d$ in the diagonal. Proving that $D$ is 
 left and right commutative, I can follow the reasoning in the article\<close>
 
 lemma sufficiency:
   assumes hermite_ring: "(\<forall>(A::'a mat). admits_triangular_reduction A)"
     and D': "\<forall>a b c::'a. ideal_generated{a,b,c} = ideal_generated{1} 
     \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1})"
   shows "(\<forall>(A::'a mat). admits_diagonal_reduction A)"
 proof -
   have admits_1x2: "\<forall>(A::'a mat) \<in> carrier_mat 1 2. admits_diagonal_reduction A"
     using hermite_ring triangular_eq_diagonal_1x2 by blast
   have admits_2x2: "\<forall>(A::'a mat) \<in> carrier_mat 2 2. admits_diagonal_reduction A"
   proof 
     fix B::"'a mat" assume B: "B \<in> carrier_mat 2 2"
     obtain U where BU: "lower_triangular (B*U)" and inv_U: "invertible_mat U"
       and U: "U \<in> carrier_mat 2 2" 
       using hermite_ring unfolding admits_triangular_reduction_def using B by fastforce
     define A where "A = B*U"
     define a where "a = A $$ (0,0)"
     define b where "b = A $$ (1,0)"
     define c where "c = A $$ (1,1)"
     have A: "A \<in> carrier_mat 2 2" using U B A_def by auto
     have A_01: "A$$(0,1) = 0" using BU U B unfolding lower_triangular_def A_def by auto    
     obtain d::'a where i: "ideal_generated {a,b,c} = ideal_generated {d}"      
       (*This fact is true since all the finitely generated ideals are principal ideals 
         in a Hermite ring*)  
     proof -
       have "OFCLASS('a, bezout_ring_class)" by (rule Hermite_ring_imp_Bezout_ring,
             insert OFCLASS_Hermite_ring_def[where ?'a='a] hermite_ring, auto)                
       hence "class.bezout_ring (*) (1::'a) (+) 0 (-) uminus" 
         using OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a = 'a] by auto
       hence "(\<forall>I::'a::comm_ring_1 set. finitely_generated_ideal I \<longrightarrow> principal_ideal I)"
         using bezout_ring_iff_fin_gen_principal_ideal2 by auto 
       moreover have "finitely_generated_ideal (ideal_generated {a,b,c})" 
         unfolding finitely_generated_ideal_def
         using ideal_ideal_generated by force
       ultimately have "principal_ideal (ideal_generated {a,b,c})" by auto
       thus ?thesis using that unfolding principal_ideal_def by auto
     qed
     have d_dvd_a: "d dvd a" and d_dvd_b: "d dvd b" and d_dvd_c: "d dvd c"
       using i ideal_generated_singleton_dvd by blast+    
     obtain a1 b1 c1 where a1: "a = a1 * d" and b1: "b = b1 * d" and c1: "c = c1 * d"
       and i2: "ideal_generated {a1,b1,c1} = ideal_generated {1}"
     proof -
       have T: "\<forall>a b. \<exists>a1 b1 d. a = a1 * d \<and> b = b1 * d 
         \<and> ideal_generated {a1, b1} = ideal_generated {1::'a}"
         by (rule theorem3_part2[OF hermite_ring]) (*Hermite ring is equivalent to the property T*)
       from this obtain a1' b1' d' where 1: "a = a1' * d'" and 2: "b = b1' * d'"
         and 3: "ideal_generated {a1', b1'} = ideal_generated {1::'a}" by blast
       have "\<exists>a1 b1 c1. a = a1 * d \<and> b = b1 * d \<and> c = c1 * d 
         \<and> ideal_generated {a1, b1, c1} = ideal_generated {1}"
         by (rule corollary5[OF T i])      
       from this show ?thesis using that by auto
     qed
      
     define D where "D = d \<cdot>\<^sub>m (1\<^sub>m 2)"
     define A' where "A' = Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then a1 else
                                     if  i = 1 \<and> j = 0 then b1 else
                                     if  i = 0 \<and> j = 1 then 0 else c1)"
     have D: "D \<in> carrier_mat 2 2" and A': "A'\<in> carrier_mat 2 2" unfolding A'_def D_def by auto
     have A_A'D: "A = A' * D" 
       by (rule eq_matI, insert D A' A a1 b1 c1 A_01 sum_two_rw a_def b_def c_def,
       unfold scalar_prod_def Matrix.row_def col_def  D_def A'_def, 
       auto simp add: sum_two_rw less_Suc_eq numerals(2))    
     have "1\<in> ideal_generated{a1,b1,c1}" using i2  by (simp add: ideal_generated_in) 
     from this obtain f where d: "(\<Sum>i\<in>{a1,b1,c1}. f i * i) = 1"
       using ideal_explicit2[of "{a1,b1,c1}"] by auto
     from this obtain x y z where "x*a1+y*b1+z*c1 = 1" 
       using sum_three_elements[of _ a1 b1 c1] by metis
     hence xa1_yb1_zc1_dvd_1: "x * a1 + y * b1 + z * c1 dvd 1" by auto    
     obtain p q where i3: "ideal_generated {p*a1,p*b1+q*c1} = ideal_generated {1}"
       using D' i2 by blast
     have "ideal_generated {p,q} = UNIV"
     proof -
       obtain X Y where e: "X*p*a1 + Y*(p*b1+q*c1) = 1"
         by (metis i3 ideal_generated_1 ideal_generated_pair_exists_UNIV mult.assoc)
       have "X*p*a1 + Y*(p*b1+q*c1) = X*p*a1 + Y*p*b1+Y*q*c1"
         by (simp add: add.assoc mult.assoc semiring_normalization_rules(34))
       also have "... = (X*a1+Y*b1) * p + (Y * c1) * q"
         by (simp add: mult.commute ring_class.ring_distribs)
       finally have "(X*a1+Y*b1) * p + Y * c1 * q = 1" using e by simp
       from this show ?thesis by (rule ideal_generated_pair_UNIV, simp)
     qed
     from this obtain u v where pu_qv_1: "p*u - q * v = 1"
       by (metis Groups.mult_ac(2) diff_minus_eq_add ideal_generated_1 
           ideal_generated_pair_exists_UNIV mult_minus_left)
     let ?P = "Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then p else
                                     if  i = 1 \<and> j = 0 then q else
                                     if  i = 0 \<and> j = 1 then v else u)"
     have P: "?P \<in> carrier_mat 2 2" by auto
     have "Determinant.det ?P = 1" using pu_qv_1 unfolding det_2[OF P] by (simp add: mult.commute)
     hence inv_P: "invertible_mat ?P"
       by (metis (no_types, lifting) P dvd_refl invertible_iff_is_unit_JNF)
     define S1 where "S1 = A'*?P"
     have S1: "S1 \<in> carrier_mat 2 2" using A' P S1_def mult_carrier_mat by blast
     have S1_00: "S1 $$(0,0) = p*a1" and S1_01: "S1 $$(1,0) = p*b1+q*c1" 
       unfolding S1_def times_mat_def scalar_prod_def using A' P BU U B 
       unfolding A'_def upper_triangular_def      
       by (auto, unfold sum_two_rw, auto simp add: A'_def a_def b_def c_def) 
     obtain q00 and q01 where q00_q01: "p*a1*q00 + (p*b1+q*c1)*q01 = 1" using i3
       by (metis ideal_generated_1 ideal_generated_pair_exists_pq1 mult.commute)
     define q10 where "q10 = - (p*b1+q*c1)"
     define q11 where "q11 = p*a1"
     have q10_q11: "p*a1*q10 + (p*b1+q*c1)*q11 = 0" unfolding q10_def q11_def
       by (auto simp add: Rings.ring_distribs(1) Rings.ring_distribs(4) semiring_normalization_rules(7))  
     let ?Q = "Matrix.mat 2 2 (\<lambda>(i,j). if i = 0 \<and> j = 0 then q00 else
                                     if  i = 1 \<and> j = 0 then q10 else
                                     if  i = 0 \<and> j = 1 then q01 else q11)"
     have Q: "?Q \<in> carrier_mat 2 2" by auto
     have "Determinant.det ?Q = 1" using q00_q01 unfolding det_2[OF Q] unfolding q10_def q11_def
       by (auto, metis (no_types, lifting) add_uminus_conv_diff diff_minus_eq_add more_arith_simps(7)
           more_arith_simps(9) mult.commute)
-    hence inv_Q: "invertible_mat ?Q" by (smt Q dvd_refl invertible_iff_is_unit_JNF)
+    hence inv_Q: "invertible_mat ?Q" by (smt (verit) Q dvd_refl invertible_iff_is_unit_JNF)
     define S2 where "S2 = ?Q * S1 "
     have S2: "S2 \<in> carrier_mat 2 2" using A' P S2_def S1 Q mult_carrier_mat by blast
     have S2_00: "S2 $$ (0,0) = 1" unfolding mat_mult2_00[OF Q S1 S2_def] using q00_q01 
       unfolding S1_00 S1_01 by (simp add: mult.commute)
     have S2_10: "S2 $$ (1,0) = 0" unfolding mat_mult2_10[OF Q S1 S2_def] 
       using q10_q11 unfolding S1_00 S1_01 by (simp add: Groups.mult_ac(2)) 
         (*Now we have a zero in the upper-right position. 
           We want to get also a zero in the lower-left position.*)
     let ?P1 ="(addrow_mat 2 (- (S2$$(0,1))) 0 1)"
     have P1: "?P1 \<in> carrier_mat 2 2" by auto
     have inv_P1: "invertible_mat ?P1"
       by (metis addrow_mat_carrier arithmetic_simps(78) det_addrow_mat dvd_def 
           invertible_iff_is_unit_JNF numeral_One zero_neq_numeral)
     define S3 where "S3 = S2 * ?P1"
     have P1_P_A': " A' *?P *?P1 \<in> carrier_mat 2 2" using P1 P A' mult_carrier_mat by auto
     have S3: "S3 \<in> carrier_mat 2 2" using P1 S2 S3_def mult_carrier_mat by blast
     have S3_00: "S3 $$ (0,0) = 1" using S2_00 unfolding mat_mult2_00[OF S2 P1  S3_def] by auto     
     moreover have S3_01: "S3 $$ (0,1) = 0" using S2_00 unfolding mat_mult2_01[OF S2 P1 S3_def] by auto
     moreover have S3_10: "S3 $$ (1,0) = 0" using S2_10 unfolding mat_mult2_10[OF S2 P1 S3_def] by auto
     ultimately have SNF_S3: "Smith_normal_form_mat S3"
       using S3 unfolding Smith_normal_form_mat_def isDiagonal_mat_def
       using less_2_cases by auto 
     hence SNF_S3_D: "Smith_normal_form_mat (S3*D)"
       using D_def S3 SNF_preserved_multiples_identity by blast
     have "S3 * D = ?Q * A' * ?P * ?P1 * D" using S1_def S2_def S3_def
-      by (smt A' P Q S1 addrow_mat_carrier assoc_mult_mat)
+      by (smt (verit) A' P Q S1 addrow_mat_carrier assoc_mult_mat)
     also have "... = ?Q * A' * ?P * (?P1 * D)"
       by (meson A' D addrow_mat_carrier assoc_mult_mat mat_carrier mult_carrier_mat)
     also have "... = ?Q * A' * ?P * (D * ?P1)" 
       using commute_multiples_identity[OF P1] unfolding D_def by auto
     also have "... = ?Q * A' * (?P * (D * ?P1))"
-      by (smt A' D assoc_mult_mat carrier_matD(1) carrier_matD(2) mat_carrier times_mat_def)
+      by (smt (verit) A' D assoc_mult_mat carrier_matD(1) carrier_matD(2) mat_carrier times_mat_def)
     also have "... = ?Q * A' * (D * (?P * ?P1))"
-      by (smt D D_def P P1 assoc_mult_mat commute_multiples_identity)
+      by (smt (verit) D D_def P P1 assoc_mult_mat commute_multiples_identity)
     also have "... = ?Q * (A' * D) * (?P * ?P1)"
-      by (smt A' D assoc_mult_mat carrier_matD(1) carrier_matD(2) mat_carrier times_mat_def)
+      by (smt (verit) A' D assoc_mult_mat carrier_matD(1) carrier_matD(2) mat_carrier times_mat_def)
     also have "... = ?Q * A * (?P * ?P1)" unfolding A_A'D by auto     
     also have "... = ?Q * B * (U * (?P * ?P1))" unfolding A_def 
-      by (smt B U assoc_mult_mat carrier_matD(1) carrier_matD(2) mat_carrier times_mat_def)
+      by (smt (verit) B U assoc_mult_mat carrier_matD(1) carrier_matD(2) mat_carrier times_mat_def)
    finally have S3_D_rw: "S3 * D = ?Q * B * (U * (?P * ?P1))" .
     show "admits_diagonal_reduction B" 
     proof (rule admits_diagonal_reduction_intro[OF _ _ inv_Q])    
       show "(U* (?P * ?P1)) \<in> carrier_mat (dim_col B) (dim_col B)" using B U by auto
       show "?Q \<in> carrier_mat (dim_row B) (dim_row B)" using Q B by auto
       show "invertible_mat (U * (?P * ?P1))"
         by (metis (no_types, lifting) P1 U carrier_matD(1) carrier_matD(2) inv_P inv_P1 inv_U 
             invertible_mult_JNF mat_carrier times_mat_def)
       show "Smith_normal_form_mat (?Q * B *(U* (?P * ?P1)))" using SNF_S3_D S3_D_rw by simp
     qed    
   qed
   obtain Smith_1x2 where Smith_1x2: "\<forall>(A::'a mat)\<in>carrier_mat 1 2. is_SNF A (Smith_1x2 A)"
     using admits_diagonal_reduction_imp_exists_algorithm_is_SNF_all[OF admits_1x2] by auto
   from this obtain Smith_1x2' 
     where Smith_1x2': "\<forall>(A::'a mat)\<in>carrier_mat 1 2. is_SNF A (1\<^sub>m 1, Smith_1x2' A)"
     using Smith_1xn_two_matrices_all[OF Smith_1x2] by auto
   obtain Smith_2x2 where Smith_2x2: "\<forall>(A::'a mat)\<in>carrier_mat 2 2. is_SNF A (Smith_2x2 A)"
     using admits_diagonal_reduction_imp_exists_algorithm_is_SNF_all[OF admits_2x2] by auto  
   have d: "is_div_op (\<lambda>a b. (SOME k. k * b = a))" using div_op_SOME by auto
   interpret Smith_Impl Smith_1x2' Smith_2x2 "(\<lambda>a b. (SOME k. k * b = a))" 
     using Smith_1x2' Smith_2x2 d by (unfold_locales, auto)
   show ?thesis using is_SNF_Smith_mxn
     by (meson admits_diagonal_reduction_eq_exists_algorithm_is_SNF carrier_mat_triv)
 qed
 
 subsection \<open>Final theorem\<close>
 
 (* Characterization of elementary divisor rings (theorem 6)*)
 
 theorem edr_characterization:
   "(\<forall>(A::'a mat). admits_diagonal_reduction A) = ((\<forall>(A::'a mat). admits_triangular_reduction A) 
   \<and> (\<forall>a b c::'a. ideal_generated{a,b,c} = ideal_generated{1} 
                       \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1})))"
   using necessity sufficiency by blast
 
 
 corollary OFCLASS_edr_characterization:
 "OFCLASS('a, elementary_divisor_ring_class) \<equiv> (OFCLASS('a, Hermite_ring_class) 
   &&& (\<forall>a b c::'a. ideal_generated{a,b,c} = ideal_generated{1} 
     \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1})))" (is "?lhs \<equiv> ?rhs")
 proof 
   assume 1: "OFCLASS('a, elementary_divisor_ring_class)"
   hence admits_diagonal: "\<forall>A::'a mat. admits_diagonal_reduction A"
     using conjunctionD2[OF 1[unfolded elementary_divisor_ring_class_def]] 
     unfolding class.elementary_divisor_ring_def by auto
   have "\<forall>A::'a mat. admits_triangular_reduction A" by (simp add: admits_diagonal necessity(1))
   hence OFCLASS_Hermite: "OFCLASS('a, Hermite_ring_class)" by (intro_classes, simp)
   moreover have "\<forall>a b c::'a. ideal_generated {a, b, c} = ideal_generated {1} 
                   \<longrightarrow> (\<exists>p q. ideal_generated {p * a, p * b + q * c} = ideal_generated {1})"
     using admits_diagonal necessity(2) by blast
   ultimately show "OFCLASS('a, Hermite_ring_class) &&& 
   \<forall>a b c::'a. ideal_generated {a, b, c} = ideal_generated {1} 
   \<longrightarrow> (\<exists>p q. ideal_generated {p * a, p * b + q * c} = ideal_generated {1})"
    by auto
 next
   assume 1: "OFCLASS('a, Hermite_ring_class) &&&
       \<forall>a b c::'a. ideal_generated {a, b, c} = ideal_generated {1} \<longrightarrow>
         (\<exists>p q. ideal_generated {p * a, p * b + q * c} = ideal_generated {1})"
   have H: "OFCLASS('a, Hermite_ring_class)"
       and 2: "\<forall>a b c::'a. ideal_generated {a, b, c} = ideal_generated {1} \<longrightarrow>
         (\<exists>p q. ideal_generated {p * a, p * b + q * c} = ideal_generated {1})"
     using conjunctionD1[OF 1] conjunctionD2[OF 1] by auto
   have "\<forall>A::'a mat. admits_triangular_reduction A" 
     using H unfolding OFCLASS_Hermite_ring_def by auto
   hence a: "\<forall>A::'a mat. admits_diagonal_reduction A" using 2 sufficiency by blast
   show "OFCLASS('a, elementary_divisor_ring_class)" by (intro_classes, simp add: a)
 qed
 
 corollary edr_characterization_class:
 "class.elementary_divisor_ring TYPE('a) 
   = (class.Hermite_ring TYPE('a) 
   \<and> (\<forall>a b c::'a. ideal_generated{a,b,c} = ideal_generated{1} 
 \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1})))" (is "?lhs = (?H \<and> ?D')")
 proof 
   assume 1: ?lhs
   hence admits_diagonal: "\<forall>A::'a mat. admits_diagonal_reduction A" 
     unfolding class.elementary_divisor_ring_def .
   have admits_triangular: "\<forall>A::'a mat. admits_triangular_reduction A"
     using 1 necessity(1) unfolding class.elementary_divisor_ring_def by blast 
   hence "?H" unfolding class.Hermite_ring_def by auto 
   moreover have "?D'" using admits_diagonal necessity(2) by blast
   ultimately show "(?H \<and> ?D')" by simp
 next
   assume HD': "(?H \<and> ?D')"
   hence admits_triangular: "\<forall>A::'a mat. admits_triangular_reduction A"
     unfolding class.Hermite_ring_def by auto
   hence admits_diagonal: "\<forall>A::'a mat. admits_diagonal_reduction A" 
     using edr_characterization HD' by auto      
   thus ?lhs unfolding class.elementary_divisor_ring_def by auto
 qed
 
 
 corollary edr_iff_T_D':
   shows "class.elementary_divisor_ring TYPE('a) = (
     (\<forall>a b::'a. \<exists> a1 b1 d. a = a1*d \<and> b = b1*d \<and> ideal_generated {a1,b1} = ideal_generated {1})
   \<and> (\<forall>a b c::'a. ideal_generated{a,b,c} = ideal_generated{1} 
       \<longrightarrow> (\<exists>p q. ideal_generated {p*a,p*b+q*c} = ideal_generated {1}))
   )" (is "?lhs = (?T \<and> ?D')")
 proof
   assume 1: ?lhs
   hence "\<forall>A::'a mat. admits_triangular_reduction A"
     unfolding class.elementary_divisor_ring_def using necessity(1) by blast 
   hence "?T" using theorem3_part2 by simp
   moreover have "?D'"  using 1 unfolding edr_characterization_class by auto
   ultimately show "(?T \<and> ?D')" by simp
 next
   assume TD': "(?T \<and> ?D')"
   hence "class.Hermite_ring TYPE('a)" 
     unfolding class.Hermite_ring_def using theorem3_part1 TD' by auto
   thus ?lhs using edr_characterization_class TD' by auto
 qed
 
 end
 end
diff --git a/thys/Smith_Normal_Form/Mod_Type_Connect.thy b/thys/Smith_Normal_Form/Mod_Type_Connect.thy
--- a/thys/Smith_Normal_Form/Mod_Type_Connect.thy
+++ b/thys/Smith_Normal_Form/Mod_Type_Connect.thy
@@ -1,583 +1,583 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>A new bridge to convert theorems from JNF to HOL Analysis and vice-versa, 
 based on the @{text "mod_type"} class\<close>
 
 theory Mod_Type_Connect
   imports 
           Perron_Frobenius.HMA_Connect
           Rank_Nullity_Theorem.Mod_Type
           Gauss_Jordan.Elementary_Operations
 begin
 
 text \<open>Some lemmas on @{text "Mod_Type.to_nat"} and @{text "Mod_Type.from_nat"} are added to have 
 them with the same names as the analogous ones for @{text "Bij_Nat.to_nat"} 
 and @{text "Bij_Nat.to_nat"}.\<close>
 
 lemma inj_to_nat: "inj to_nat" by (simp add: inj_on_def)
 lemmas from_nat_inj = from_nat_eq_imp_eq
 lemma range_to_nat: "range (to_nat :: 'a :: mod_type \<Rightarrow> nat) = {0 ..< CARD('a)}"
   by (simp add: bij_betw_imp_surj_on mod_type_class.bij_to_nat)
 
 
 text \<open>This theory is an adaptation of the one presented in @{text "Perron_Frobenius.HMA_Connect"},
   but for matrices and vectors where indexes have the @{text "mod_type"} class restriction.
 
   It is worth noting that some definitions still use the old abbreviation for HOL Analysis 
   (HMA, from HOL Multivariate Analysis) instead of HA. This is done to be consistent with 
   the existing names in the Perron-Frobenius development\<close>
 
 context includes vec.lifting 
 begin
 end
 
 definition from_hma\<^sub>v :: "'a ^ 'n :: mod_type \<Rightarrow> 'a Matrix.vec" where
   "from_hma\<^sub>v v = Matrix.vec CARD('n) (\<lambda> i. v $h from_nat i)"
 
 definition from_hma\<^sub>m :: "'a ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> 'a Matrix.mat" where
   "from_hma\<^sub>m a = Matrix.mat CARD('nr) CARD('nc) (\<lambda> (i,j). a $h from_nat i $h from_nat j)"
 
 definition to_hma\<^sub>v :: "'a Matrix.vec \<Rightarrow> 'a ^ 'n :: mod_type" where
   "to_hma\<^sub>v v = (\<chi> i. v $v to_nat i)"
 
 definition to_hma\<^sub>m :: "'a Matrix.mat \<Rightarrow> 'a ^ 'nc :: mod_type ^ 'nr :: mod_type " where
   "to_hma\<^sub>m a = (\<chi> i j. a $$ (to_nat i, to_nat j))"
 
 lemma to_hma_from_hma\<^sub>v[simp]: "to_hma\<^sub>v (from_hma\<^sub>v v) = v"
   by (auto simp: to_hma\<^sub>v_def from_hma\<^sub>v_def to_nat_less_card)
 
 lemma to_hma_from_hma\<^sub>m[simp]: "to_hma\<^sub>m (from_hma\<^sub>m v) = v"
   by (auto simp: to_hma\<^sub>m_def from_hma\<^sub>m_def to_nat_less_card)
 
 lemma from_hma_to_hma\<^sub>v[simp]:
   "v \<in> carrier_vec (CARD('n)) \<Longrightarrow> from_hma\<^sub>v (to_hma\<^sub>v v :: 'a ^ 'n :: mod_type) = v"
   by (auto simp: to_hma\<^sub>v_def from_hma\<^sub>v_def to_nat_from_nat_id)
 
 lemma from_hma_to_hma\<^sub>m[simp]:
   "A \<in> carrier_mat (CARD('nr)) (CARD('nc)) \<Longrightarrow> from_hma\<^sub>m (to_hma\<^sub>m A :: 'a ^ 'nc :: mod_type  ^ 'nr :: mod_type) = A"
   by (auto simp: to_hma\<^sub>m_def from_hma\<^sub>m_def to_nat_from_nat_id)
 
 lemma from_hma\<^sub>v_inj[simp]: "from_hma\<^sub>v x = from_hma\<^sub>v y \<longleftrightarrow> x = y"
   by (intro iffI, insert to_hma_from_hma\<^sub>v[of x], auto)
 
 lemma from_hma\<^sub>m_inj[simp]: "from_hma\<^sub>m x = from_hma\<^sub>m y \<longleftrightarrow> x = y"
   by(intro iffI, insert to_hma_from_hma\<^sub>m[of x], auto)
 
 definition HMA_V :: "'a Matrix.vec \<Rightarrow> 'a ^ 'n :: mod_type \<Rightarrow> bool" where 
   "HMA_V = (\<lambda> v w. v = from_hma\<^sub>v w)"
 
 definition HMA_M :: "'a Matrix.mat \<Rightarrow> 'a ^ 'nc :: mod_type ^ 'nr :: mod_type  \<Rightarrow> bool" where 
   "HMA_M = (\<lambda> a b. a = from_hma\<^sub>m b)"
 
 definition HMA_I :: "nat \<Rightarrow> 'n :: mod_type \<Rightarrow> bool" where
   "HMA_I = (\<lambda> i a. i = to_nat a)"
 
 
 
 context includes lifting_syntax
 begin
 
 lemma Domainp_HMA_V [transfer_domain_rule]: 
   "Domainp (HMA_V :: 'a Matrix.vec \<Rightarrow> 'a ^ 'n :: mod_type \<Rightarrow> bool) = (\<lambda> v. v \<in> carrier_vec (CARD('n )))"
   by(intro ext iffI, insert from_hma_to_hma\<^sub>v[symmetric], auto simp: from_hma\<^sub>v_def HMA_V_def)
 
 lemma Domainp_HMA_M [transfer_domain_rule]: 
   "Domainp (HMA_M :: 'a Matrix.mat \<Rightarrow> 'a ^ 'nc :: mod_type  ^ 'nr :: mod_type \<Rightarrow> bool) 
   = (\<lambda> A. A \<in> carrier_mat CARD('nr) CARD('nc))"
   by (intro ext iffI, insert from_hma_to_hma\<^sub>m[symmetric], auto simp: from_hma\<^sub>m_def HMA_M_def)
 
 lemma Domainp_HMA_I [transfer_domain_rule]: 
   "Domainp (HMA_I :: nat \<Rightarrow> 'n :: mod_type \<Rightarrow> bool) = (\<lambda> i. i < CARD('n))" (is "?l = ?r")
 proof (intro ext)
   fix i :: nat
   show "?l i = ?r i"
     unfolding HMA_I_def Domainp_iff
     by (auto intro: exI[of _ "from_nat i"] simp: to_nat_from_nat_id to_nat_less_card)
 qed
 
 lemma bi_unique_HMA_V [transfer_rule]: "bi_unique HMA_V" "left_unique HMA_V" "right_unique HMA_V"
   unfolding HMA_V_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma bi_unique_HMA_M [transfer_rule]: "bi_unique HMA_M" "left_unique HMA_M" "right_unique HMA_M"
   unfolding HMA_M_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma bi_unique_HMA_I [transfer_rule]: "bi_unique HMA_I" "left_unique HMA_I" "right_unique HMA_I"
   unfolding HMA_I_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma right_total_HMA_V [transfer_rule]: "right_total HMA_V"
   unfolding HMA_V_def right_total_def by simp
 
 lemma right_total_HMA_M [transfer_rule]: "right_total HMA_M"
   unfolding HMA_M_def right_total_def by simp
 
 lemma right_total_HMA_I [transfer_rule]: "right_total HMA_I"
   unfolding HMA_I_def right_total_def by simp
 
 lemma HMA_V_index [transfer_rule]: "(HMA_V ===> HMA_I ===> (=)) ($v) ($h)"
   unfolding rel_fun_def HMA_V_def HMA_I_def from_hma\<^sub>v_def
   by (auto simp: to_nat_less_card)
 
 
 lemma HMA_M_index [transfer_rule]:
   "(HMA_M ===> HMA_I ===> HMA_I ===> (=)) (\<lambda> A i j. A $$ (i,j)) index_hma"
   by (intro rel_funI, simp add: index_hma_def to_nat_less_card HMA_M_def HMA_I_def from_hma\<^sub>m_def)  
 
 
 lemma HMA_V_0 [transfer_rule]: "HMA_V (0\<^sub>v CARD('n)) (0 :: 'a :: zero ^ 'n:: mod_type)"
   unfolding HMA_V_def from_hma\<^sub>v_def by auto
 
 lemma HMA_M_0 [transfer_rule]: 
   "HMA_M (0\<^sub>m CARD('nr) CARD('nc)) (0 :: 'a :: zero ^ 'nc:: mod_type  ^ 'nr :: mod_type)"
   unfolding HMA_M_def from_hma\<^sub>m_def by auto
 
 lemma HMA_M_1[transfer_rule]:
   "HMA_M (1\<^sub>m (CARD('n))) (mat 1 :: 'a::{zero,one}^'n:: mod_type^'n:: mod_type)"
   unfolding HMA_M_def
   by (auto simp add: mat_def from_hma\<^sub>m_def from_nat_inj)
  
 
 lemma from_hma\<^sub>v_add: "from_hma\<^sub>v v + from_hma\<^sub>v w = from_hma\<^sub>v (v + w)"
   unfolding from_hma\<^sub>v_def by auto
 
 lemma HMA_V_add [transfer_rule]: "(HMA_V ===> HMA_V ===> HMA_V) (+) (+) "
   unfolding rel_fun_def HMA_V_def
   by (auto simp: from_hma\<^sub>v_add)
 
 lemma from_hma\<^sub>v_diff: "from_hma\<^sub>v v - from_hma\<^sub>v w = from_hma\<^sub>v (v - w)"
   unfolding from_hma\<^sub>v_def by auto
 
 lemma HMA_V_diff [transfer_rule]: "(HMA_V ===> HMA_V ===> HMA_V) (-) (-)"
   unfolding rel_fun_def HMA_V_def
   by (auto simp: from_hma\<^sub>v_diff)
 
 lemma from_hma\<^sub>m_add: "from_hma\<^sub>m a + from_hma\<^sub>m b = from_hma\<^sub>m (a + b)"
   unfolding from_hma\<^sub>m_def by auto
 
 lemma HMA_M_add [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (+) (+) "
   unfolding rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_add)
 
 lemma from_hma\<^sub>m_diff: "from_hma\<^sub>m a - from_hma\<^sub>m b = from_hma\<^sub>m (a - b)"
   unfolding from_hma\<^sub>m_def by auto
 
 lemma HMA_M_diff [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (-) (-) "
   unfolding rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_diff)
 
 lemma scalar_product: fixes v :: "'a :: semiring_1 ^ 'n :: mod_type"
   shows "scalar_prod (from_hma\<^sub>v v) (from_hma\<^sub>v w) = scalar_product v w"
   unfolding scalar_product_def scalar_prod_def from_hma\<^sub>v_def dim_vec
   by (simp add: sum.reindex[OF inj_to_nat, unfolded range_to_nat])
 
 lemma [simp]:
   "from_hma\<^sub>m (y :: 'a ^ 'nc :: mod_type ^ 'nr:: mod_type) \<in> carrier_mat (CARD('nr)) (CARD('nc))"
   "dim_row (from_hma\<^sub>m (y :: 'a ^ 'nc:: mod_type  ^ 'nr :: mod_type)) = CARD('nr)"
   "dim_col (from_hma\<^sub>m (y :: 'a ^ 'nc :: mod_type ^ 'nr:: mod_type )) = CARD('nc)"
   unfolding from_hma\<^sub>m_def by simp_all
 
 lemma [simp]:
   "from_hma\<^sub>v (y :: 'a ^ 'n:: mod_type) \<in> carrier_vec (CARD('n))"
   "dim_vec (from_hma\<^sub>v (y :: 'a ^ 'n:: mod_type)) = CARD('n)"
   unfolding from_hma\<^sub>v_def by simp_all
 
 lemma HMA_scalar_prod [transfer_rule]:
   "(HMA_V ===> HMA_V ===> (=)) scalar_prod scalar_product" 
   by (auto simp: HMA_V_def scalar_product)
 
 lemma HMA_row [transfer_rule]: "(HMA_I ===> HMA_M ===> HMA_V) (\<lambda> i a. Matrix.row a i) row"
   unfolding HMA_M_def HMA_I_def HMA_V_def
   by (auto simp: from_hma\<^sub>m_def from_hma\<^sub>v_def to_nat_less_card row_def)
 
 lemma HMA_col [transfer_rule]: "(HMA_I ===> HMA_M ===> HMA_V) (\<lambda> i a. col a i) column"
   unfolding HMA_M_def HMA_I_def HMA_V_def
   by (auto simp: from_hma\<^sub>m_def from_hma\<^sub>v_def to_nat_less_card column_def)
 
 
 lemma HMA_M_mk_mat[transfer_rule]: "((HMA_I ===> HMA_I ===> (=)) ===> HMA_M) 
   (\<lambda> f. Matrix.mat (CARD('nr)) (CARD('nc)) (\<lambda> (i,j). f i j)) 
   (mk_mat :: (('nr \<Rightarrow> 'nc \<Rightarrow> 'a) \<Rightarrow> 'a^'nc:: mod_type^'nr:: mod_type))"
 proof-
   {
     fix x y i j
     assume id: "\<forall> (ya :: 'nr) (yb :: 'nc). (x (to_nat ya) (to_nat yb) :: 'a) = y ya yb"
        and i: "i < CARD('nr)" and j: "j < CARD('nc)"
     from to_nat_from_nat_id[OF i] to_nat_from_nat_id[OF j] id[rule_format, of "from_nat i" "from_nat j"]
     have "x i j = y (from_nat i) (from_nat j)" by auto
   }
   thus ?thesis
     unfolding rel_fun_def mk_mat_def HMA_M_def HMA_I_def from_hma\<^sub>m_def by auto
 qed
 
 lemma HMA_M_mk_vec[transfer_rule]: "((HMA_I ===> (=)) ===> HMA_V) 
   (\<lambda> f. Matrix.vec (CARD('n)) (\<lambda> i. f i)) 
   (mk_vec :: (('n \<Rightarrow> 'a) \<Rightarrow> 'a^'n:: mod_type))"
 proof-
   {
     fix x y i
     assume id: "\<forall> (ya :: 'n). (x (to_nat ya) :: 'a) = y ya"
        and i: "i < CARD('n)" 
     from to_nat_from_nat_id[OF i] id[rule_format, of "from_nat i"]
     have "x i = y (from_nat i)" by auto
   }
   thus ?thesis
     unfolding rel_fun_def mk_vec_def HMA_V_def HMA_I_def from_hma\<^sub>v_def by auto
 qed
 
 
 lemma mat_mult_scalar: "A ** B = mk_mat (\<lambda> i j. scalar_product (row i A) (column j B))"
   unfolding vec_eq_iff matrix_matrix_mult_def scalar_product_def mk_mat_def
   by (auto simp: row_def column_def)
 
 lemma mult_mat_vec_scalar: "A *v v = mk_vec (\<lambda> i. scalar_product (row i A) v)"
   unfolding vec_eq_iff matrix_vector_mult_def scalar_product_def mk_mat_def mk_vec_def
   by (auto simp: row_def column_def)
 
 lemma dim_row_transfer_rule: 
   "HMA_M A (A' :: 'a ^ 'nc:: mod_type ^ 'nr:: mod_type) \<Longrightarrow> (=) (dim_row A) (CARD('nr))"
   unfolding HMA_M_def by auto
 
 lemma dim_col_transfer_rule: 
   "HMA_M A (A' :: 'a ^ 'nc:: mod_type ^ 'nr:: mod_type) \<Longrightarrow> (=) (dim_col A) (CARD('nc))"
   unfolding HMA_M_def by auto
 
 
 lemma HMA_M_mult [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (*) (**)"
 proof -
   {
     fix A B :: "'a :: semiring_1 mat" and A' :: "'a ^ 'n :: mod_type ^ 'nr:: mod_type" 
       and B' :: "'a ^ 'nc :: mod_type ^ 'n:: mod_type"
     assume 1[transfer_rule]: "HMA_M A A'" "HMA_M B B'"
     note [transfer_rule] = dim_row_transfer_rule[OF 1(1)] dim_col_transfer_rule[OF 1(2)]
     have "HMA_M (A * B) (A' ** B')"
       unfolding times_mat_def mat_mult_scalar
       by (transfer_prover_start, transfer_step+, transfer, auto)
   }
   thus ?thesis by blast
 qed
       
 
 lemma HMA_V_smult [transfer_rule]: "((=) ===> HMA_V ===> HMA_V) (\<cdot>\<^sub>v) (*s)"
   unfolding smult_vec_def 
   unfolding rel_fun_def HMA_V_def from_hma\<^sub>v_def
   by auto
 
 lemma HMA_M_mult_vec [transfer_rule]: "(HMA_M ===> HMA_V ===> HMA_V) (*\<^sub>v) (*v)"
 proof -
   {
     fix A :: "'a :: semiring_1 mat" and v :: "'a Matrix.vec"
       and A' :: "'a ^ 'nc :: mod_type ^ 'nr :: mod_type" and v' :: "'a ^ 'nc :: mod_type"
     assume 1[transfer_rule]: "HMA_M A A'" "HMA_V v v'"
     note [transfer_rule] = dim_row_transfer_rule
     have "HMA_V (A *\<^sub>v v) (A' *v v')"
       unfolding mult_mat_vec_def mult_mat_vec_scalar
       by (transfer_prover_start, transfer_step+, transfer, auto)
   }
   thus ?thesis by blast  
 qed
 
 
 lemma HMA_det [transfer_rule]: "(HMA_M ===> (=)) Determinant.det 
   (det :: 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'n :: mod_type \<Rightarrow> 'a)"
 proof -
   {
     fix a :: "'a ^ 'n :: mod_type^ 'n:: mod_type"
     let ?tn = "to_nat :: 'n :: mod_type \<Rightarrow> nat"
     let ?fn = "from_nat :: nat \<Rightarrow> 'n"
     let ?zn = "{0..< CARD('n)}"
     let ?U = "UNIV :: 'n set"
     let ?p1 = "{p. p permutes ?zn}"
     let ?p2 = "{p. p permutes ?U}"  
     let ?f= "\<lambda> p i. if i \<in> ?U then ?fn (p (?tn i)) else i"
     let ?g = "\<lambda> p i. ?fn (p (?tn i))"
     have fg: "\<And> a b c. (if a \<in> ?U then b else c) = b" by auto
     have "?p2 = ?f ` ?p1" 
       by (rule permutes_bij', auto simp: to_nat_less_card to_nat_from_nat_id)
     hence id: "?p2 = ?g ` ?p1" by simp
     have inj_g: "inj_on ?g ?p1"
       unfolding inj_on_def
     proof (intro ballI impI ext, auto)
       fix p q i
       assume p: "p permutes ?zn" and q: "q permutes ?zn"
         and id: "(\<lambda> i. ?fn (p (?tn i))) = (\<lambda> i. ?fn (q (?tn i)))"
       {
         fix i
         from permutes_in_image[OF p] have pi: "p (?tn i) < CARD('n)" by (simp add: to_nat_less_card)
         from permutes_in_image[OF q] have qi: "q (?tn i) < CARD('n)" by (simp add: to_nat_less_card)
         from fun_cong[OF id] have "?fn (p (?tn i))  = from_nat (q (?tn i))" .
         from arg_cong[OF this, of ?tn] have "p (?tn i) = q (?tn i)"
           by (simp add: to_nat_from_nat_id pi qi)
       } note id = this             
       show "p i = q i"
       proof (cases "i < CARD('n)")
         case True
         hence "?tn (?fn i) = i" by (simp add: to_nat_from_nat_id)
         from id[of "?fn i", unfolded this] show ?thesis .
       next
         case False
         thus ?thesis using p q unfolding permutes_def by simp
       qed
     qed
     have mult_cong: "\<And> a b c d. a = b \<Longrightarrow> c = d \<Longrightarrow> a * c = b * d" by simp
     have "sum (\<lambda> p. 
       signof p * (\<Prod>i\<in>?zn. a $h ?fn i $h ?fn (p i))) ?p1
       = sum (\<lambda> p. of_int (sign p) * (\<Prod>i\<in>UNIV. a $h i $h p i)) ?p2"
       unfolding id sum.reindex[OF inj_g]
     proof (rule sum.cong[OF refl], unfold mem_Collect_eq o_def, rule mult_cong)
       fix p
       assume p: "p permutes ?zn"
       let ?q = "\<lambda> i. ?fn (p (?tn i))"
       from id p have q: "?q permutes ?U" by auto
       from p have pp: "permutation p" unfolding permutation_permutes by auto
       let ?ft = "\<lambda> p i. ?fn (p (?tn i))"
       have fin: "finite ?zn" by simp
       have "sign p = sign ?q \<and> p permutes ?zn"
       using p fin proof (induction rule: permutes_induct)
         case id
         show ?case by (auto simp: sign_id[unfolded id_def] permutes_id[unfolded id_def])
       next
         case (swap a b p)
         then have \<open>permutation p\<close>
           using permutes_imp_permutation by blast 
         let ?sab = "Transposition.transpose a b"
         let ?sfab = "Transposition.transpose (?fn a) (?fn b)"
         have p_sab: "permutation ?sab" by (rule permutation_swap_id)
         have p_sfab: "permutation ?sfab" by (rule permutation_swap_id)
         from swap(4) have IH1: "p permutes ?zn" and IH2: "sign p = sign (?ft p)" by auto
         have sab_perm: "?sab permutes ?zn" using swap(1-2) by (rule permutes_swap_id)
         from permutes_compose[OF IH1 this] have perm1: "?sab o p permutes ?zn" .
         from IH1 have p_p1: "p \<in> ?p1" by simp
         hence "?ft p \<in> ?ft ` ?p1" by (rule imageI)
         from this[folded id] have "?ft p permutes ?U" by simp
         hence p_ftp: "permutation (?ft p)" unfolding permutation_permutes by auto
         {
           fix a b
           assume a: "a \<in> ?zn" and b: "b \<in> ?zn" 
           hence "(?fn a = ?fn b) = (a = b)" using swap(1-2)
             by (auto simp add: from_nat_eq_imp_eq)
         } note inj = this
         from inj[OF swap(1-2)] have id2: "sign ?sfab = sign ?sab" unfolding sign_swap_id by simp
         have id: "?ft (Transposition.transpose a b \<circ> p) = Transposition.transpose (?fn a) (?fn b) \<circ> ?ft p"
         proof
           fix c 
           show "?ft (Transposition.transpose a b \<circ> p) c = (Transposition.transpose (?fn a) (?fn b) \<circ> ?ft p) c"
           proof (cases "p (?tn c) = a \<or> p (?tn c) = b")
             case True
             thus ?thesis by (cases, auto simp add: o_def swap_id_eq)
           next
             case False
             hence neq: "p (?tn c) \<noteq> a" "p (?tn c) \<noteq> b" by auto
             have pc: "p (?tn c) \<in> ?zn" unfolding permutes_in_image[OF IH1] 
               by (simp add: to_nat_less_card)
             from neq[folded inj[OF pc swap(1)] inj[OF pc swap(2)]]
             have "?fn (p (?tn c)) \<noteq> ?fn a" "?fn (p (?tn c)) \<noteq> ?fn b" .
             with neq show ?thesis by (auto simp: o_def swap_id_eq)
           qed
         qed
         show ?case unfolding IH2 id sign_compose[OF p_sab \<open>permutation p\<close>] sign_compose[OF p_sfab p_ftp] id2 
           by (rule conjI[OF refl perm1])
       qed
       thus "signof p = of_int (sign ?q)" by simp
       show "(\<Prod>i = 0..<CARD('n). a $h ?fn i $h ?fn (p i)) =
            (\<Prod>i\<in>UNIV. a $h i $h ?q i)" unfolding 
            range_to_nat[symmetric] prod.reindex[OF inj_to_nat]
             by (rule prod.cong[OF refl], unfold o_def, simp)
     qed   
   }
   thus ?thesis unfolding HMA_M_def 
     by (auto simp: from_hma\<^sub>m_def Determinant.det_def det_def)
 qed
 
 lemma HMA_mat[transfer_rule]: "((=) ===> HMA_M) (\<lambda> k. k \<cdot>\<^sub>m 1\<^sub>m CARD('n)) 
   (Finite_Cartesian_Product.mat :: 'a::semiring_1 \<Rightarrow> 'a^'n :: mod_type^'n :: mod_type)"
   unfolding Finite_Cartesian_Product.mat_def[abs_def] rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_def from_nat_inj)
 
 
 lemma HMA_mat_minus[transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) 
   (\<lambda> A B. A + map_mat uminus B) ((-) :: 'a :: group_add ^'nc:: mod_type^'nr:: mod_type 
   \<Rightarrow> 'a^'nc:: mod_type^'nr:: mod_type \<Rightarrow> 'a^'nc:: mod_type^'nr:: mod_type)"
   unfolding rel_fun_def HMA_M_def from_hma\<^sub>m_def by auto
 
 lemma HMA_transpose_matrix [transfer_rule]: 
   "(HMA_M ===> HMA_M) transpose_mat transpose"
   unfolding transpose_mat_def transpose_def HMA_M_def from_hma\<^sub>m_def by auto
 
 
 lemma HMA_invertible_matrix_mod_type[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'n :: mod_type 
       \<Rightarrow> _) ===> (=)) invertible_mat invertible"
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note rel_xy[transfer_rule] = "1"
   have eq_dim: "dim_col x = dim_row x"
     using Mod_Type_Connect.dim_col_transfer_rule Mod_Type_Connect.dim_row_transfer_rule rel_xy 
     by fastforce    
   moreover have "\<exists>A'. y ** A' = mat 1 \<and> A' ** y = mat 1" 
     if xB: "x * B = 1\<^sub>m (dim_row x)" and Bx: "B * x = 1\<^sub>m (dim_row B)" for B
   proof -
     let ?A' = "Mod_Type_Connect.to_hma\<^sub>m B:: 'a :: comm_ring_1 ^ 'n :: mod_type^ 'n :: mod_type" 
     have rel_BA[transfer_rule]: "Mod_Type_Connect.HMA_M B ?A'"
       by (metis (no_types, lifting) Bx Mod_Type_Connect.HMA_M_def eq_dim carrier_mat_triv dim_col_mat(1)
           Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.from_hma_to_hma\<^sub>m index_mult_mat(3) 
           index_one_mat(3) rel_xy xB)
     have [simp]: "dim_row B = CARD('n)" using Mod_Type_Connect.dim_row_transfer_rule rel_BA by blast
     have [simp]: "dim_row x = CARD('n)" using Mod_Type_Connect.dim_row_transfer_rule rel_xy by blast
     have "y ** ?A' = mat 1" using xB by (transfer, simp)
     moreover have "?A' ** y  = mat 1" using Bx by (transfer, simp)
     ultimately show ?thesis by blast
   qed
   moreover have "\<exists>B. x * B = 1\<^sub>m (dim_row x) \<and> B * x = 1\<^sub>m (dim_row B)"
     if yA: "y ** A' = mat 1" and Ay: "A' ** y = mat 1" for A'
   proof -
     let ?B = "(Mod_Type_Connect.from_hma\<^sub>m A')"
     have [simp]: "dim_row x = CARD('n)" using rel_xy Mod_Type_Connect.dim_row_transfer_rule by blast
     have [transfer_rule]: "Mod_Type_Connect.HMA_M ?B A'" by (simp add: Mod_Type_Connect.HMA_M_def)
     hence [simp]: "dim_row ?B = CARD('n)" using dim_row_transfer_rule by auto
     have "x * ?B = 1\<^sub>m (dim_row x)" using yA by (transfer', auto)
     moreover have "?B * x = 1\<^sub>m (dim_row ?B)" using Ay by (transfer', auto)
     ultimately show ?thesis by auto
   qed
   ultimately show ?case unfolding invertible_mat_def invertible_def inverts_mat_def by auto
 qed
 
 
 end
 
 
 text \<open>Some transfer rules for relating the elementary operations are also proved.\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma HMA_swaprows[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b. swaprows a b A) interchange_rows" 
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def interchange_rows_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_swapcols[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b. swapcols a b A) interchange_columns" 
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def interchange_columns_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_addrow[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _) 
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ ) 
     ===> (=)
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b q. addrow q a b A) row_add"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def row_add_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_addcol[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _) 
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ ) 
     ===> (=)
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b q. addcol q a b A) column_add"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def column_add_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_multrow[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )
     ===> (=)     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A i q. multrow i q A) mult_row"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def mult_row_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_multcol[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )
     ===> (=)     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A i q. multcol i q A) mult_column"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def mult_column_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 end
 
 fun HMA_M3 where
   "HMA_M3 (P,A,Q) 
   (P' :: 'a :: comm_ring_1 ^ 'nr :: mod_type ^ 'nr :: mod_type,
    A' :: 'a ^ 'nc :: mod_type ^ 'nr :: mod_type,
    Q' :: 'a ^ 'nc :: mod_type ^ 'nc :: mod_type) = 
   (Mod_Type_Connect.HMA_M P P' \<and> Mod_Type_Connect.HMA_M A A' \<and> Mod_Type_Connect.HMA_M Q Q')"
 
 lemma HMA_M3_def: 
   "HMA_M3 A B = (Mod_Type_Connect.HMA_M (fst A) (fst B) 
   \<and> Mod_Type_Connect.HMA_M (fst (snd A)) (fst (snd B)) 
-  \<and> Mod_Type_Connect.HMA_M (snd (snd A)) (snd (snd B)))"  
-  by (smt HMA_M3.simps prod.collapse)
+  \<and> Mod_Type_Connect.HMA_M (snd (snd A)) (snd (snd B)))"
+  by (smt (verit, ccfv_SIG) HMA_M3.simps prod.collapse)
 
 
 context 
   includes lifting_syntax
 begin
 
 lemma Domainp_HMA_M3 [transfer_domain_rule]: 
  "Domainp (HMA_M3 :: _\<Rightarrow>(_\<times>('a::comm_ring_1^'nc::mod_type^'nr::mod_type)\<times>_)\<Rightarrow>_) 
  = (\<lambda>(P,A,Q). P \<in> carrier_mat CARD('nr) CARD('nr) \<and> A \<in> carrier_mat CARD('nr) CARD('nc) 
   \<and> Q \<in> carrier_mat CARD('nc) CARD('nc))"
 proof -
   let ?HMA_M3 = "HMA_M3::_\<Rightarrow>(_\<times>('a::comm_ring_1^'nc::mod_type^'nr::mod_type)\<times>_)\<Rightarrow>_"
   have 1: "P \<in> carrier_mat CARD('nr) CARD('nr) \<and>
          A \<in> carrier_mat CARD('nr) CARD('nc) \<and> Q \<in> carrier_mat CARD('nc) CARD('nc)"
     if "Domainp ?HMA_M3 (P,A,Q)" for P A Q
       using that unfolding Domainp_iff by (auto simp add: Mod_Type_Connect.HMA_M_def)  
   have 2: "Domainp ?HMA_M3 (P,A,Q)" if PAQ: "P \<in> carrier_mat CARD('nr) CARD('nr)
    \<and> A \<in> carrier_mat CARD('nr) CARD('nc) \<and>Q \<in> carrier_mat CARD('nc) CARD('nc)" for P A Q
   proof -
      let ?P = "Mod_Type_Connect.to_hma\<^sub>m P::'a^'nr::mod_type^'nr::mod_type"
      let ?A = "Mod_Type_Connect.to_hma\<^sub>m A::'a^'nc::mod_type^'nr::mod_type"
      let ?Q = "Mod_Type_Connect.to_hma\<^sub>m Q::'a^'nc::mod_type^'nc::mod_type"
      have "HMA_M3 (P,A,Q) (?P,?A,?Q)"
        by (auto simp add: Mod_Type_Connect.HMA_M_def PAQ)  
      thus ?thesis unfolding Domainp_iff by auto
    qed  
    have "fst x \<in> carrier_mat CARD('nr) CARD('nr) \<and> fst (snd x) \<in> carrier_mat CARD('nr) CARD('nc) 
       \<and> (snd (snd x)) \<in> carrier_mat CARD('nc) CARD('nc)"
     if "Domainp ?HMA_M3 x" for x using 1
     by (metis (full_types) surjective_pairing that)
   moreover have "Domainp ?HMA_M3 x" 
     if "fst x \<in> carrier_mat CARD('nr) CARD('nr) \<and> fst (snd x) \<in> carrier_mat CARD('nr) CARD('nc) 
       \<and> (snd (snd x)) \<in> carrier_mat CARD('nc) CARD('nc)" for x 
     using 2
     by (metis (full_types) surjective_pairing that)
   ultimately show ?thesis by (intro ext iffI, unfold split_beta, metis+) 
 qed
 
 lemma bi_unique_HMA_M3 [transfer_rule]: "bi_unique HMA_M3" "left_unique HMA_M3" "right_unique HMA_M3"
   unfolding HMA_M3_def bi_unique_def left_unique_def right_unique_def
   by (auto simp add: Mod_Type_Connect.HMA_M_def)
 
 lemma right_total_HMA_M3 [transfer_rule]: "right_total HMA_M3"
   unfolding HMA_M_def right_total_def
   by (simp add: Mod_Type_Connect.HMA_M_def)
 
 end
 
 (*
   TODO: add more theorems to connect everything from HA to JNF in this setting.
 *)
 end
diff --git a/thys/Smith_Normal_Form/Rings2_Extended.thy b/thys/Smith_Normal_Form/Rings2_Extended.thy
--- a/thys/Smith_Normal_Form/Rings2_Extended.thy
+++ b/thys/Smith_Normal_Form/Rings2_Extended.thy
@@ -1,809 +1,809 @@
 (*
     Author:      Jose Divasón
     Email:       jose.divason@unirioja.es
 *)
 
 section \<open>Some theorems about rings and ideals\<close>
 
 theory Rings2_Extended
   imports
     Echelon_Form.Rings2
     "HOL-Types_To_Sets.Types_To_Sets"
 begin
 
 subsection \<open>Missing properties on ideals\<close>
 
 lemma ideal_generated_subset2:
   assumes  "\<forall>b\<in>B. b \<in> ideal_generated A"
   shows "ideal_generated B \<subseteq> ideal_generated A"
   by (metis (mono_tags, lifting) InterE assms ideal_generated_def
 ideal_ideal_generated mem_Collect_eq subsetI)
 
 context comm_ring_1
 begin
 
 lemma ideal_explicit: "ideal_generated S
       = {y. \<exists>f U. finite U \<and> U \<subseteq> S \<and> (\<Sum>i\<in>U. f i * i) = y}"
   by (simp add: ideal_generated_eq_left_ideal left_ideal_explicit)
 end
 
 lemma ideal_generated_minus:
   assumes a: "a \<in> ideal_generated (S-{a})"
   shows "ideal_generated S = ideal_generated (S-{a})"
 proof (cases "a \<in> S")
   case True note a_in_S = True
   show ?thesis
   proof
     show "ideal_generated S \<subseteq> ideal_generated (S - {a})"
     proof (rule ideal_generated_subset2, auto)
       fix b assume b: "b \<in> S" show "b \<in> ideal_generated (S - {a})"
       proof (cases "b = a")
         case True
         then show ?thesis using a by auto
       next
         case False
         then show ?thesis using b
           by (simp add: ideal_generated_in)
       qed
     qed
     show "ideal_generated (S - {a}) \<subseteq> ideal_generated S"
       by (rule ideal_generated_subset, auto)
   qed
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma ideal_generated_dvd_eq:
   assumes a_dvd_b: "a dvd b"
   and a: "a \<in> S"
   and a_not_b: "a \<noteq> b"
   shows "ideal_generated S = ideal_generated (S - {b})"
 proof
   show "ideal_generated S \<subseteq> ideal_generated (S - {b})"
   proof (rule ideal_generated_subset2, auto)
     fix x assume x: "x \<in> S"
     show "x \<in> ideal_generated (S - {b})"
     proof (cases "x = b")
       case True
       obtain k where b_ak: "b = a * k" using a_dvd_b unfolding dvd_def by blast
       let ?f = "\<lambda>c. k"
       have "(\<Sum>i\<in>{a}. i * ?f i) = x" using True b_ak by auto
       moreover have "{a} \<subseteq> S - {b}" using a_not_b a by auto
       moreover have "finite {a}" by auto
       ultimately show ?thesis
         unfolding ideal_def
         by (metis True b_ak ideal_def ideal_generated_in ideal_ideal_generated insert_subset right_ideal_def)
     next
       case False
       then show ?thesis by (simp add: ideal_generated_in x)
     qed
   qed
   show "ideal_generated (S - {b}) \<subseteq> ideal_generated S" by (rule ideal_generated_subset, auto)
 qed
 
 lemma ideal_generated_dvd_eq_diff_set:
   assumes i_in_I: "i\<in>I" and i_in_J: "i \<notin> J" and i_dvd_j: "\<forall>j\<in>J. i dvd j"
   and f: "finite J"
   shows "ideal_generated I = ideal_generated (I - J)"
   using f i_in_J i_dvd_j i_in_I
   proof (induct J arbitrary: I)
   case empty
     then show ?case by auto
   next
     case (insert x J)
     have "ideal_generated I = ideal_generated (I-{x})"
       by (rule ideal_generated_dvd_eq[of i], insert insert.prems , auto)
     also have "... = ideal_generated ((I-{x}) - J)"
       by (rule insert.hyps, insert insert.prems insert.hyps, auto)
     also have "... = ideal_generated (I - insert x J)"
       using Diff_insert2[of I x J] by auto
     finally show ?case .
   qed
 
 
 context comm_ring_1
 begin
 
 lemma ideal_generated_singleton_subset:
   assumes d: "d \<in> ideal_generated S" and fin_S: "finite S"
   shows "ideal_generated {d} \<subseteq> ideal_generated S"
 proof
   fix x assume x: "x \<in> ideal_generated {d}"
   obtain k where x_kd: "x = k*d " using x using obtain_sum_ideal_generated[OF x]
     by (metis finite.emptyI finite.insertI sum_singleton)
   show "x \<in> ideal_generated S"
     using d ideal_eq_right_ideal ideal_ideal_generated right_ideal_def mult_commute x_kd by auto
 qed
 
 lemma ideal_generated_singleton_dvd:
   assumes i: "ideal_generated S = ideal_generated {d}" and x: "x \<in> S"
   shows "d dvd x"
   by (metis i x finite.intros dvd_ideal_generated_singleton
       ideal_generated_in ideal_generated_singleton_subset)
 
 lemma ideal_generated_UNIV_insert:
   assumes "ideal_generated S = UNIV"
   shows "ideal_generated (insert a S) = UNIV" using assms
   using local.ideal_generated_subset by blast
 
 lemma ideal_generated_UNIV_union:
   assumes "ideal_generated S = UNIV"
   shows "ideal_generated (A \<union> S) = UNIV"
   using assms local.ideal_generated_subset
   by (metis UNIV_I Un_subset_iff equalityI subsetI)
 
 lemma ideal_explicit2:
   assumes "finite S"
   shows "ideal_generated S = {y. \<exists>f. (\<Sum>i\<in>S. f i * i) = y}"
-  by (smt Collect_cong assms ideal_explicit obtain_sum_ideal_generated mem_Collect_eq subsetI)
+  by (smt (verit) Collect_cong assms ideal_explicit obtain_sum_ideal_generated mem_Collect_eq subsetI)
 
 lemma ideal_generated_unit:
   assumes u: "u dvd 1"
   shows "ideal_generated {u} = UNIV"
 proof -
   have "x \<in> ideal_generated {u}" for x
   proof -
     obtain inv_u where inv_u: "inv_u * u = 1" using u unfolding dvd_def
       using local.mult_ac(2) by blast
     have "x = x * inv_u * u" using inv_u by (simp add: local.mult_ac(1))
     also have "... \<in> {k * u |k. k \<in> UNIV}" by auto
     also have "... = ideal_generated {u}" unfolding ideal_generated_singleton by simp
     finally show ?thesis .
   qed
   thus ?thesis by auto
 qed
 
 
 lemma ideal_generated_dvd_subset:
   assumes x: "\<forall>x \<in> S. d dvd x" and S: "finite S"
   shows "ideal_generated S \<subseteq> ideal_generated {d}"
 proof
   fix x assume "x\<in> ideal_generated S"
   from this obtain f where f: "(\<Sum>i\<in>S. f i * i) = x" using ideal_explicit2[OF S] by auto
   have "d dvd (\<Sum>i\<in>S. f i * i)" by (rule dvd_sum, insert x, auto)
   thus "x \<in> ideal_generated {d}"
     using f dvd_ideal_generated_singleton' ideal_generated_in singletonI by blast
 qed
 
 
 lemma ideal_generated_mult_unit:
   assumes f: "finite S" and u: "u dvd 1"
   shows "ideal_generated ((\<lambda>x. u*x)` S) = ideal_generated S"
   using f
 proof (induct S)
   case empty
   then show ?case by auto
 next
   case (insert x S)
   obtain inv_u where inv_u: "inv_u * u = 1" using u unfolding dvd_def
     using mult_ac by blast
   have f: "finite (insert (u*x) ((\<lambda>x. u*x)` S))" using insert.hyps by auto
   have f2: "finite (insert x S)" by (simp add: insert(1))
   have f3: "finite S" by (simp add: insert)
   have f4: "finite ((*) u ` S)" by (simp add: insert)
   have inj_ux: "inj_on (\<lambda>x. u*x) S" unfolding inj_on_def
     by (auto, metis inv_u local.mult_1_left local.semiring_normalization_rules(18))
   have "ideal_generated ((\<lambda>x. u*x)` (insert x S)) = ideal_generated (insert (u*x) ((\<lambda>x. u*x)` S))"
     by auto
   also have "... = {y. \<exists>f. (\<Sum>i\<in>insert (u*x) ((\<lambda>x. u*x)` S). f i * i) = y}"
     using ideal_explicit2[OF f] by auto
   also have "... = {y. \<exists>f. (\<Sum>i\<in>(insert x S). f i * i) = y}" (is "?L = ?R")
   proof -
     have "a \<in> ?L"  if a: "a \<in> ?R" for a
     proof -
       obtain f where sum_rw: "(\<Sum>i\<in>(insert x S). f i * i) = a" using a by auto
       define b where "b=(\<Sum>i\<in>S. f i * i)"
       have "b \<in> ideal_generated S" unfolding b_def ideal_explicit2[OF f3] by auto
       hence "b \<in> ideal_generated ((*) u ` S)" using insert.hyps(3) by auto
       from this obtain g where "(\<Sum>i\<in>((*) u ` S). g i * i) = b"
         unfolding ideal_explicit2[OF f4] by auto
       hence sum_rw2: "(\<Sum>i\<in>S. f i * i) = (\<Sum>i\<in>((*) u ` S). g i * i)" unfolding b_def by auto
       let ?g = "\<lambda>i. if i = u*x then f x * inv_u else g i"
        have sum_rw3: "sum ((\<lambda>i. g i * i) \<circ> (\<lambda>x. u*x)) S = sum ((\<lambda>i. ?g i * i) \<circ> (\<lambda>x. u*x)) S"
         by (rule sum.cong, auto, metis inv_u local.insert(2) local.mult_1_right
               local.mult_ac(2) local.semiring_normalization_rules(18))
       have sum_rw4: "(\<Sum>i\<in>(\<lambda>x. u*x)` S. g i * i) = sum ((\<lambda>i. g i * i) \<circ> (\<lambda>x. u*x)) S"
         by (rule sum.reindex[OF inj_ux])
       have "a = f x * x + (\<Sum>i\<in>S. f i * i)"
         using sum_rw local.insert(1) local.insert(2) by auto
       also have "... = f x * x + (\<Sum>i\<in>(\<lambda>x. u*x)` S. g i * i)" using sum_rw2 by auto
       also have "... = ?g (u * x) * (u * x) + (\<Sum>i\<in>(\<lambda>x. u*x)` S. g i * i)"
-        using inv_u by (smt local.mult_1_right local.mult_ac(1))
+        using inv_u by (smt (verit) local.mult_1_right local.mult_ac(1))
       also have "... =  ?g (u * x) * (u * x) + sum ((\<lambda>i. g i * i) \<circ> (\<lambda>x. u*x)) S"
         using sum_rw4 by auto
       also have "... = ((\<lambda>i. ?g i * i) \<circ> (\<lambda>x. u*x)) x + sum ((\<lambda>i. g i * i) \<circ> (\<lambda>x. u*x)) S" by auto
       also have "... = ((\<lambda>i. ?g i * i) \<circ> (\<lambda>x. u*x)) x + sum ((\<lambda>i. ?g i * i) \<circ> (\<lambda>x. u*x)) S"
         using sum_rw3 by auto
       also have "... = sum ((\<lambda>i. ?g i * i) \<circ> (\<lambda>x. u*x)) (insert x S)"
         by (rule sum.insert[symmetric], auto simp add: insert)
       also have "... = (\<Sum>i\<in>insert (u * x) ((\<lambda>x. u*x)` S). ?g i * i)"
-        by (smt abel_semigroup.commute f2 image_insert inv_u mult.abel_semigroup_axioms mult_1_right
+        by (smt (verit) abel_semigroup.commute f2 image_insert inv_u mult.abel_semigroup_axioms mult_1_right
             semiring_normalization_rules(18) sum.reindex_nontrivial)
       also have "... = (\<Sum>i\<in>(\<lambda>x. u*x)` (insert x S). ?g i * i)" by auto
       finally show ?thesis by auto
     qed
     moreover have "a \<in> ?R" if a: "a \<in> ?L" for a
     proof -
       obtain f where sum_rw: "(\<Sum>i\<in>(insert (u * x) ((*) u ` S)). f i * i) = a" using a by auto
       have ux_notin: "u*x \<notin> ((*) u ` S)"
         by (metis UNIV_I inj_on_image_mem_iff inj_on_inverseI inv_u local.insert(2) local.mult_1_left
             local.semiring_normalization_rules(18) subsetI)
       let ?f = "(\<lambda>x. f x * x)"
       have "sum ?f ((*) u ` S) \<in> ideal_generated ((*) u ` S)"
         unfolding ideal_explicit2[OF f4] by auto
       from this obtain g where sum_rw1: "sum (\<lambda>i. g i * i) S = sum ?f (((*) u ` S))"
         using insert.hyps(3) unfolding ideal_explicit2[OF f3] by blast
       let ?g = "(\<lambda>i. if i = x  then (f (u*x) *u) * x else g i * i)"
       let ?g' = "\<lambda>i. if i = x  then f (u*x) * u else g i"
       have sum_rw2: "sum (\<lambda>i. g i * i) S = sum ?g S" by (rule sum.cong, insert inj_ux ux_notin, auto)
       have "a = (\<Sum>i\<in>(insert (u * x) ((*) u ` S)). f i * i)" using sum_rw by simp
       also have "... = ?f (u*x) +  sum ?f (((*) u ` S))"
         by (rule sum.insert[OF f4], insert inj_ux) (metis UNIV_I inj_on_image_mem_iff inj_on_inverseI
             inv_u local.insert(2) local.mult_1_left local.semiring_normalization_rules(18) subsetI)
       also have "... = ?f (u*x) + sum (\<lambda>i. g i * i) S" unfolding sum_rw1 by auto
       also have "... = ?g x + sum ?g S" unfolding sum_rw2 using mult.assoc by auto
       also have "... = sum ?g (insert x S)" by (rule sum.insert[symmetric, OF f3 insert.hyps(2)])
       also have "... = sum (\<lambda>i. ?g' i * i) (insert x S)" by (rule sum.cong, auto)
       finally show ?thesis by fast
     qed
     ultimately show ?thesis by blast
   qed
   also have "... = ideal_generated (insert x S)" using ideal_explicit2[OF f2] by auto
   finally show ?case by auto
 qed
 
 corollary ideal_generated_mult_unit2:
   assumes u: "u dvd 1"
   shows "ideal_generated {u*a,u*b} = ideal_generated {a,b}"
 proof -
   let ?S = "{a,b}"
   have "ideal_generated {u*a,u*b} = ideal_generated ((\<lambda>x. u*x)` {a,b})" by auto
   also have "... = ideal_generated {a,b}" by (rule ideal_generated_mult_unit[OF _ u], simp)
   finally show ?thesis .
 qed
 
 lemma ideal_generated_1[simp]: "ideal_generated {1} = UNIV"
   by (metis ideal_generated_unit dvd_ideal_generated_singleton order_refl)
 
 lemma ideal_generated_pair: "ideal_generated {a,b} = {p*a+q*b | p q. True}"
 proof -
   have i: "ideal_generated {a,b} = {y. \<exists>f. (\<Sum>i\<in>{a,b}. f i * i) = y}" using ideal_explicit2 by auto
   show ?thesis
   proof (cases "a=b")
     case True
     show ?thesis using True i
       by (auto, metis mult_ac(2) semiring_normalization_rules)
       (metis (no_types, opaque_lifting) add_minus_cancel mult_ac ring_distribs semiring_normalization_rules)
   next
     case False
     have 1: "\<exists>p q. (\<Sum>i\<in>{a, b}. f i * i) = p * a + q * b" for f
       by (rule exI[of _ "f a"], rule exI[of _ "f b"], rule sum_two_elements[OF False])
     moreover have "\<exists>f. (\<Sum>i\<in>{a, b}. f i * i) = p * a + q * b" for p q
       by (rule exI[of _ "\<lambda>i. if i=a then p else q"],
           unfold sum_two_elements[OF False], insert False, auto)
     ultimately show ?thesis using i by auto
   qed
 qed
 
 lemma ideal_generated_pair_exists_pq1:
   assumes i: "ideal_generated {a,b} = (UNIV::'a set)"
   shows "\<exists>p q. p*a + q*b = 1"
   using i unfolding ideal_generated_pair
-  by (smt iso_tuple_UNIV_I mem_Collect_eq)
+  by (smt (verit) iso_tuple_UNIV_I mem_Collect_eq)
 
 lemma ideal_generated_pair_UNIV:
   assumes sa_tb_u: "s*a+t*b = u" and u: "u dvd 1"
   shows "ideal_generated {a,b} = UNIV"
 proof -
   have f: "finite {a,b}" by simp
   obtain inv_u where inv_u: "inv_u * u = 1" using u unfolding dvd_def
     by (metis mult.commute)
   have "x \<in> ideal_generated {a,b}" for x
   proof (cases "a = b")
     case True
     then show ?thesis
       by (metis UNIV_I dvd_def dvd_ideal_generated_singleton' ideal_generated_unit insert_absorb2
           mult.commute sa_tb_u semiring_normalization_rules(34) subsetI subset_antisym u)
   next
     case False note a_not_b = False
     let ?f = "\<lambda>y. if y = a then inv_u * x * s else inv_u * x * t"
     have "(\<Sum>i\<in>{a,b}. ?f i * i) = ?f a * a + ?f b * b" by (rule sum_two_elements[OF a_not_b])
     also have "... = x" using a_not_b sa_tb_u inv_u
       by (auto, metis mult_ac(1) mult_ac(2) ring_distribs(1) semiring_normalization_rules(12))
     finally show ?thesis unfolding ideal_explicit2[OF f] by auto
   qed
   thus ?thesis by auto
 qed
 
 
 lemma ideal_generated_pair_exists:
   assumes l: "(ideal_generated {a,b} = ideal_generated {d})"
   shows "(\<exists> p q. p*a+q*b = d)"
 proof -
   have d: "d \<in> ideal_generated {d}" by (simp add: ideal_generated_in)
   hence "d \<in> ideal_generated {a,b}" using l by auto
   from this obtain p q where "d = p*a+q*b" using ideal_generated_pair[of a b] by auto
   thus ?thesis by auto
 qed
 
 
 lemma obtain_ideal_generated_pair:
   assumes "c \<in> ideal_generated {a,b}"
   obtains p q where "p*a+q*b=c"
 proof -
   have "c \<in> {p * a + q * b |p q. True}" using assms ideal_generated_pair by auto
   thus ?thesis using that by auto
 qed
 
 lemma ideal_generated_pair_exists_UNIV:
   shows "(ideal_generated {a,b} = ideal_generated {1}) = (\<exists>p q. p*a+q*b = 1)" (is "?lhs = ?rhs")
 proof
   assume r: ?rhs
   have "x \<in> ideal_generated {a,b}" for x
   proof (cases "a=b")
     case True
     then show ?thesis
       by (metis UNIV_I r dvd_ideal_generated_singleton finite.intros ideal_generated_1
           ideal_generated_pair_UNIV ideal_generated_singleton_subset)
   next
     case False
     have f: "finite {a,b}" by simp
     have 1: "1 \<in> ideal_generated {a,b}"
       using ideal_generated_pair_UNIV local.one_dvd r by blast
     hence i: "ideal_generated {a,b} = {y. \<exists>f. (\<Sum>i\<in>{a,b}. f i * i) = y}"
       using ideal_explicit2[of "{a,b}"] by auto
     from this obtain f where f: "f a * a + f b * b = 1" using sum_two_elements 1 False by auto
     let ?f = "\<lambda>y. if y = a then x * f a else x * f b"
     have "(\<Sum>i\<in>{a,b}. ?f i * i) = x" unfolding sum_two_elements[OF False] using f False
       using mult_ac(1) ring_distribs(1) semiring_normalization_rules(12) by force
     thus ?thesis unfolding i by auto
   qed
   thus ?lhs by auto
 next
   assume ?lhs thus ?rhs using ideal_generated_pair_exists[of a b 1] by auto
 qed
 
 corollary ideal_generated_UNIV_obtain_pair:
   assumes "ideal_generated {a,b} = ideal_generated {1}"
   shows " (\<exists>p q. p*a+q*b = d)"
 proof -
   obtain x y where "x*a+y*b = 1" using ideal_generated_pair_exists_UNIV assms by auto
   hence "d*x*a+d*y*b=d"
     using local.mult_ac(1) local.ring_distribs(1) local.semiring_normalization_rules(12) by force
   thus ?thesis by auto
 qed
 
 
 
 lemma sum_three_elements:
   shows "\<exists>x y z::'a. (\<Sum>i\<in>{a,b,c}. f i * i) = x * a + y * b + z * c"
 proof (cases "a \<noteq> b \<and> b \<noteq> c \<and> a \<noteq> c")
   case True
   then show ?thesis by (auto, metis add.assoc)
 next
   case False
   have 1: "\<exists>x y z. f c * c = x * c + y * c + z * c"
     by (rule exI[of _ 0],rule exI[of _ 0], rule exI[of _ "f c"], auto)
   have 2: "\<exists>x y z. f b * b + f c * c = x * b + y * b + z * c"
     by (rule exI[of _ 0],rule exI[of _ "f b"], rule exI[of _ "f c"], auto)
   have 3: "\<exists>x y z. f a * a + f c * c = x * a + y * c + z * c"
     by (rule exI[of _ "f a"],rule exI[of _ 0], rule exI[of _ "f c"], auto)
   have 4: "\<exists>x y z. (\<Sum>i\<in>{c, b, c}. f i * i) = x * c + y * b + z * c" if a: "a = c" and b: "b \<noteq> c"
     by (rule exI[of _ 0],rule exI[of _ "f b"], rule exI[of _ "f c"], insert a b,
         auto simp add: insert_commute)
   show ?thesis using False
     by (cases "b=c", cases "a=c", auto simp add: 1 2 3 4)
 qed
 
 lemma sum_three_elements':
   shows "\<exists>f::'a\<Rightarrow>'a. (\<Sum>i\<in>{a,b,c}. f i * i) = x * a + y * b + z * c"
 proof (cases "a \<noteq> b \<and> b \<noteq> c \<and> a \<noteq> c")
   case True
   let ?f = "\<lambda>i. if i = a then x else if i = b then y else if i = c then z else 0"
   show ?thesis by (rule exI[of _ "?f"], insert True mult.assoc, auto simp add: local.add_ac)
 next
   case False
   have 1: "\<exists>f. f c * c = x * c + y * c + z * c"
     by (rule exI[of _ "\<lambda>i. if i = c then x+y+z else 0"], auto simp add: local.ring_distribs)
   have 2: "\<exists>f. f a * a + f c * c = x * a + y * c + z * c" if bc: " b = c" and ac: "a \<noteq> c"
     by (rule exI[of _ "\<lambda>i. if i = a then x else y+z"], insert ac bc add_ac ring_distribs, auto)
   have 3: "\<exists>f. f b * b + f c * c = x * b + y * b + z * c" if bc: " b \<noteq> c" and ac: "a = b"
     by (rule exI[of _ "\<lambda>i. if i = a then x+y else z"], insert ac bc add_ac ring_distribs, auto)
   have 4: "\<exists>f. (\<Sum>i\<in>{c, b, c}. f i * i) = x * c + y * b + z * c" if a: "a = c" and b: "b \<noteq> c"
     by (rule exI[of _ "\<lambda>i. if i = c then x+z else y"], insert a b add_ac ring_distribs,
         auto simp add: insert_commute)
   show ?thesis using False
     by (cases "b=c", cases "a=c", auto simp add: 1 2 3 4)
 qed
 
 
 (*This is generalizable to arbitrary sets.*)
 lemma ideal_generated_triple_pair_rewrite:
   assumes i1: "ideal_generated {a, b, c} = ideal_generated {d}"
     and i2: "ideal_generated {a, b} = ideal_generated {d'}"
   shows "ideal_generated{d',c} = ideal_generated {d}"
 proof
   have d': "d' \<in> ideal_generated {a,b}" using i2 by (simp add: ideal_generated_in)
   show "ideal_generated {d', c} \<subseteq> ideal_generated {d}"
   proof
     fix x assume x: "x \<in> ideal_generated {d', c}"
     obtain f1 f2 where f: "f1*d' + f2*c = x" using obtain_ideal_generated_pair[OF x] by auto
     obtain g1 g2 where g: "g1*a + g2*b = d'" using obtain_ideal_generated_pair[OF d'] by blast
     have 1: "f1*g1*a + f1*g2*b + f2*c = x"
       using f g local.ring_distribs(1) local.semiring_normalization_rules(18) by auto
     have "x \<in> ideal_generated {a, b, c}"
     proof -
       obtain f where "(\<Sum>i\<in>{a,b,c}. f i * i) = f1*g1*a + f1*g2*b + f2*c"
         using sum_three_elements' 1 by blast
       moreover have "ideal_generated {a,b,c} = {y. \<exists>f. (\<Sum>i\<in>{a,b,c}. f i * i) = y}"
         using ideal_explicit2[of "{a,b,c}"] by simp
       ultimately show ?thesis using 1 by auto
     qed
     thus "x \<in> ideal_generated {d}" using i1 by auto
   qed
   show "ideal_generated {d} \<subseteq> ideal_generated {d', c}"
   proof (rule ideal_generated_singleton_subset)
     obtain f1 f2 f3 where f: "f1*a + f2*b + f3*c = d"
     proof -
       have "d \<in> ideal_generated {a,b,c}" using i1  by (simp add: ideal_generated_in)
       from this obtain f where d: "(\<Sum>i\<in>{a,b,c}. f i * i) = d"
         using ideal_explicit2[of "{a,b,c}"] by auto
       obtain x y z where "(\<Sum>i\<in>{a,b,c}. f i * i) = x * a + y * b + z * c"
         using sum_three_elements by blast
       thus ?thesis using d that by auto
     qed
     obtain k where k: "f1*a + f2*b = k*d'"
     proof -
       have "f1*a + f2*b \<in> ideal_generated{a,b}" using ideal_generated_pair by blast
       also have "... = ideal_generated {d'}" using i2 by simp
       also have "... = {k*d' |k. k\<in>UNIV}" using ideal_generated_singleton by auto
       finally show ?thesis using that by auto
     qed
     have "k*d'+f3*c=d" using f k by auto
     thus "d \<in> ideal_generated {d', c}"
       using ideal_generated_pair by blast
   qed (simp)
 qed
 
 lemma ideal_generated_dvd:
   assumes i: "ideal_generated {a,b::'a} = ideal_generated{d} "
   and a: "d' dvd a" and b: "d' dvd b"
 shows "d' dvd d"
 proof -
   obtain p q where "p*a+q*b = d"
     using i ideal_generated_pair_exists by blast
   thus ?thesis using a b by auto
 qed
 
 lemma ideal_generated_dvd2:
   assumes i: "ideal_generated S = ideal_generated{d::'a} "
   and "finite S"
   and x: "\<forall>x\<in>S. d' dvd x"
 shows "d' dvd d"
   by (metis assms dvd_ideal_generated_singleton ideal_generated_dvd_subset)
 
 end
 
 
 subsection \<open>An equivalent characterization of B\'ezout rings\<close>
 
 text \<open>The goal of this subsection is to prove that a ring is B\'ezout ring if and only if every
   finitely generated ideal is principal.\<close>
 
 definition "finitely_generated_ideal I = (ideal I \<and> (\<exists>S. finite S \<and> ideal_generated S = I))"
 
 context
   assumes "SORT_CONSTRAINT('a::comm_ring_1)"
 begin
 
 
 lemma sum_two_elements':
   fixes d::'a
   assumes s: "(\<Sum>i\<in>{a,b}. f i * i) = d"
   obtains p and q where "d = p * a + q * b"
 proof (cases "a=b")
   case True
   then show ?thesis
     by (metis (no_types, lifting) add_diff_cancel_left' emptyE finite.emptyI insert_absorb2
         left_diff_distrib' s sum.insert sum_singleton that)
 next
   case False
   show ?thesis using s unfolding sum_two_elements[OF False]
     using that by auto
 qed
 
 text \<open>This proof follows Theorem 6-3 in "First Course in Rings and Ideals" by Burton\<close>
 
 lemma all_fin_gen_ideals_are_principal_imp_bezout:
   assumes all: "\<forall>I::'a set. finitely_generated_ideal I \<longrightarrow> principal_ideal I"
   shows "OFCLASS ('a, bezout_ring_class)"
 proof (intro_classes)
   fix a b::'a
   obtain d where ideal_d: "ideal_generated {a,b} = ideal_generated {d}"
     using all unfolding finitely_generated_ideal_def
     by (metis finite.emptyI finite_insert ideal_ideal_generated principal_ideal_def)
   have a_in_d: "a \<in> ideal_generated {d}"
     using ideal_d ideal_generated_subset_generator by blast
   have b_in_d: "b \<in> ideal_generated {d}"
     using ideal_d ideal_generated_subset_generator by blast
   have d_in_ab: "d \<in> ideal_generated {a,b}"
     using ideal_d ideal_generated_subset_generator by auto
   obtain f where "(\<Sum>i\<in>{a,b}. f i * i) = d" using obtain_sum_ideal_generated[OF d_in_ab] by auto
   from this obtain p q where d_eq: "d = p*a + q*b" using sum_two_elements' by blast
   moreover have d_dvd_a: "d dvd a"
     by (metis dvd_ideal_generated_singleton ideal_d ideal_generated_subset insert_commute
         subset_insertI)
   moreover have "d dvd b"
     by (metis dvd_ideal_generated_singleton ideal_d ideal_generated_subset subset_insertI)
   moreover have "d' dvd d" if d'_dvd: "d' dvd a \<and> d' dvd b" for d'
   proof -
     obtain s1 s2 where s1_dvd: "a = s1*d'" and s2_dvd: "b = s2*d'"
       using mult.commute d'_dvd unfolding dvd_def by auto
     have "d = p*a + q*b" using d_eq .
     also have "...= p * s1 * d' + q * s2 *d'" unfolding s1_dvd s2_dvd by auto
     also have "... = (p * s1 + q * s2) * d'" by (simp add: ring_class.ring_distribs(2))
     finally show "d' dvd d" using mult.commute unfolding dvd_def by auto
   qed
   ultimately show "\<exists>p q d. p * a + q * b = d \<and> d dvd a \<and> d dvd b
   \<and> (\<forall>d'. d' dvd a \<and> d' dvd b \<longrightarrow> d' dvd d)" by auto
 qed
 end
 
 
 context bezout_ring
 begin
 
 lemma exists_bezout_extended:
   assumes S: "finite S" and ne: "S \<noteq> {}"
   shows "\<exists>f d. (\<Sum>a\<in>S. f a * a) = d \<and> (\<forall>a\<in>S. d dvd a) \<and> (\<forall>d'. (\<forall>a\<in>S. d' dvd a) \<longrightarrow> d' dvd d)"
   using S ne
 proof (induct S)
   case empty
   then show ?case by auto
 next
   case (insert x S)
   show ?case
   proof (cases  "S={}")
     case True
     let ?f = "\<lambda>x. 1"
     show ?thesis by (rule exI[of _ ?f], insert True, auto)
   next
     case False note ne = False
     note x_notin_S = insert.hyps(2)
     obtain f d where sum_eq_d: "(\<Sum>a\<in>S. f a * a) = d"
       and d_dvd_each_a: "(\<forall>a\<in>S. d dvd a)"
       and d_is_gcd: "(\<forall>d'. (\<forall>a\<in>S. d' dvd a) \<longrightarrow> d' dvd d)"
       using insert.hyps(3)[OF ne] by auto
     have "\<exists>p q d'. p * d + q * x = d' \<and> d' dvd d \<and> d' dvd x \<and> (\<forall>c. c dvd d \<and> c dvd x \<longrightarrow> c dvd d')"
       using exists_bezout by auto
     from this obtain p q d' where pd_qx_d': "p*d + q*x = d'"
       and d'_dvd_d: "d' dvd d" and d'_dvd_x: "d' dvd x"
       and d'_dvd: "\<forall>c. (c dvd d \<and> c dvd x) \<longrightarrow> c dvd d'" by blast
     let ?f = "\<lambda>a. if a = x then q else p * f a"
     have "(\<Sum>a\<in>insert x S. ?f a * a) = d'"
     proof -
       have "(\<Sum>a\<in>insert x S. ?f a * a) = (\<Sum>a\<in>S. ?f a * a) + ?f x * x"
         by (simp add: add_commute insert.hyps(1) insert.hyps(2))
       also have "... = p * (\<Sum>a\<in>S. f a * a) + q * x"
         unfolding sum_distrib_left
         by (auto, rule sum.cong, insert x_notin_S,
             auto simp add: mult.semigroup_axioms semigroup.assoc)
       finally show ?thesis using pd_qx_d' sum_eq_d by auto
     qed
     moreover have "(\<forall>a\<in>insert x S. d' dvd a)"
       by (metis d'_dvd_d d'_dvd_x d_dvd_each_a insert_iff local.dvdE local.dvd_mult_left)
     moreover have " (\<forall>c. (\<forall>a\<in>insert x S. c dvd a) \<longrightarrow> c dvd d')"
       by (simp add: d'_dvd d_is_gcd)
     ultimately show ?thesis by auto
   qed
 qed
 
 end
 
 lemma ideal_generated_empty: "ideal_generated {} = {0}"
   unfolding ideal_generated_def using ideal_generated_0
   by (metis empty_subsetI ideal_generated_def ideal_generated_subset ideal_ideal_generated
       ideal_not_empty subset_singletonD)
 
 
 lemma bezout_imp_all_fin_gen_ideals_are_principal:
   fixes I::"'a :: bezout_ring set"
   assumes fin: "finitely_generated_ideal I"
   shows "principal_ideal I"
 proof -
   obtain S where fin_S: "finite S" and ideal_gen_S: "ideal_generated S = I"
     using fin unfolding finitely_generated_ideal_def by auto
   show ?thesis
   proof (cases "S = {}")
     case True
     then show ?thesis
       using ideal_gen_S unfolding True
       using ideal_generated_empty ideal_generated_0 principal_ideal_def by fastforce
   next
     case False note ne = False
     obtain d f where sum_S_d: "(\<Sum>i\<in>S. f i * i) = d"
     and d_dvd_a: "(\<forall>a\<in>S. d dvd a)" and d_is_gcd: "(\<forall>d'. (\<forall>a\<in>S. d' dvd a) \<longrightarrow> d' dvd d)"
       using exists_bezout_extended[OF fin_S ne] by auto
     have d_in_S: "d \<in> ideal_generated S"
       by (metis fin_S ideal_def ideal_generated_subset_generator
           ideal_ideal_generated sum_S_d sum_left_ideal)
     have "ideal_generated {d} \<subseteq> ideal_generated S"
       by (rule ideal_generated_singleton_subset[OF d_in_S fin_S])
     moreover have "ideal_generated S \<subseteq> ideal_generated {d}"
     proof
       fix x assume x_in_S: "x \<in> ideal_generated S"
       obtain f where sum_S_x: "(\<Sum>a\<in>S. f a * a) = x"
         using fin_S obtain_sum_ideal_generated x_in_S by blast
       have d_dvd_each_a: "\<exists>k. a = k * d" if "a \<in> S" for a
         by (metis d_dvd_a dvdE mult.commute that)
       let ?g = "\<lambda>a. SOME k. a = k*d"
       have "x = (\<Sum>a\<in>S. f a * a)" using sum_S_x by simp
       also have "... = (\<Sum>a\<in>S. f a * (?g a * d))"
       proof (rule sum.cong)
         fix a assume a_in_S: "a \<in> S"
         obtain k where a_kd: "a = k * d" using d_dvd_each_a a_in_S by auto
         have "a = ((SOME k. a = k * d) * d)" by (rule someI_ex, auto simp add: a_kd)
         thus "f a * a = f a * ((SOME k. a = k * d) * d)" by auto
       qed (simp)
       also have "... = (\<Sum>a\<in>S. f a * ?g a * d)" by (rule sum.cong, auto)
       also have "... = (\<Sum>a\<in>S. f a * ?g a)*d" using sum_distrib_right[of _ S d] by auto
       finally show "x \<in> ideal_generated {d}"
         by (meson contra_subsetD dvd_ideal_generated_singleton' dvd_triv_right
             ideal_generated_in singletonI)
     qed
     ultimately show ?thesis unfolding principal_ideal_def using ideal_gen_S by auto
   qed
 qed
 
 text \<open>Now we have the required lemmas to prove the theorem that states that
   a ring is B\'ezout ring if and only if every
   finitely generated ideal is principal. They are the following ones.
 
 \begin{itemize}
 \item @{text "all_fin_gen_ideals_are_principal_imp_bezout"}
 \item @{text "bezout_imp_all_fin_gen_ideals_are_principal"}
 \end{itemize}
 
 However, in order to prove the final lemma, we need the lemmas with no type restrictions.
 For instance, we need a version of theorem @{text "bezout_imp_all_fin_gen_ideals_are_principal"}
 as
 
 @{text "OFCLASS('a,bezout_ring) \<Longrightarrow>"} the theorem with generic types
   (i.e., @{text "'a"} with no type restrictions)
 
 
 or as
 
 @{text "class.bezout_ring _ _ _ _ \<Longrightarrow>"} the theorem with generic
   types (i.e., @{text "'a"} with no type restrictions)
 \<close>
 
 (*A possible workaround is to adapt the proof*)
 (*
 lemma bezout_imp_all_fin_gen_ideals_are_principal_unsatisfactory:
   assumes a1: "class.bezout_ring ( * ) (1::'a::comm_ring_1) (+) 0 (-) uminus" (*Me da igual esto que OFCLASS*)
   shows "\<forall>I::'a set. finitely_generated_ideal I \<longrightarrow> principal_ideal I"
 proof (rule allI, rule impI)
   fix I::"'a set" assume fin: "finitely_generated_ideal I"
   interpret a: bezout_ring "( * )" "(1::'a)" "(+)" 0 "(-)" uminus using a1 .
   interpret dvd "( * )::'a\<Rightarrow>'a\<Rightarrow>'a" .
   interpret b: comm_monoid_add "(+)" "(0::'a)" using a1 by intro_locales
   have c: " class.comm_monoid_add (+) (0::'a)"  using a1 by intro_locales
   have [simp]: "(dvd.dvd ( * ) d a) = (d dvd a)" for d a::'a
     by (auto simp add: dvd.dvd_def dvd_def)
   have [simp]: "comm_monoid_add.sum (+) 0 (\<lambda>a. f a * a) S = sum (\<lambda>a. f a * a) S"
     for f and S::"'a set"
     unfolding sum_def unfolding comm_monoid_add.sum_def[OF c] ..
   obtain S where fin_S: "finite S" and ideal_gen_S: "ideal_generated S = I"
     using fin unfolding finitely_generated_ideal_def by auto
   show "principal_ideal I"
   proof (cases "S = {}")
     case True
     then show ?thesis
       using ideal_gen_S unfolding True
       using ideal_generated_empty ideal_generated_0 principal_ideal_def by fastforce
   next
     case False note ne = False
     obtain d f where sum_S_d: "(\<Sum>i\<in>S. f i * i) = d"
     and d_dvd_a: "(\<forall>a\<in>S. d dvd a)" and d_is_gcd: "(\<forall>d'. (\<forall>a\<in>S. d' dvd a) \<longrightarrow> d' dvd d)"
       using a.exists_bezout_extended[OF fin_S ne] by auto
     have d_in_S: "d \<in> ideal_generated S"
       by (metis fin_S ideal_def ideal_generated_subset_generator
           ideal_ideal_generated sum_S_d sum_left_ideal)
     have "ideal_generated {d} \<subseteq> ideal_generated S"
       by (rule ideal_generated_singleton_subset[OF d_in_S fin_S])
     moreover have "ideal_generated S \<subseteq> ideal_generated {d}"
     proof
       fix x assume x_in_S: "x \<in> ideal_generated S"
       obtain f where sum_S_x: "(\<Sum>a\<in>S. f a * a) = x"
         using fin_S obtain_sum_ideal_generated x_in_S by blast
       have d_dvd_each_a: "\<exists>k. a = k * d" if "a \<in> S" for a
         by (metis d_dvd_a dvdE mult.commute that)
       let ?g = "\<lambda>a. SOME k. a = k*d"
       have "x = (\<Sum>a\<in>S. f a * a)" using sum_S_x by simp
       also have "... = (\<Sum>a\<in>S. f a * (?g a * d))"
       proof (rule sum.cong)
         fix a assume a_in_S: "a \<in> S"
         obtain k where a_kd: "a = k * d" using d_dvd_each_a a_in_S by auto
         have "a = ((SOME k. a = k * d) * d)" by (rule someI_ex, auto simp add: a_kd)
         thus "f a * a = f a * ((SOME k. a = k * d) * d)" by auto
       qed (simp)
       also have "... = (\<Sum>a\<in>S. f a * ?g a * d)" by (rule sum.cong, auto)
       also have "... = (\<Sum>a\<in>S. f a * ?g a)*d" using sum_distrib_right[of _ S d] by auto
       finally show "x \<in> ideal_generated {d}"
         by (meson contra_subsetD dvd_ideal_generated_singleton' dvd_triv_right
             ideal_generated_in singletonI)
     qed
     ultimately show ?thesis unfolding principal_ideal_def using ideal_gen_S by auto
   qed
 qed
 *)
 
 text \<open>Thanks to local type definitions, we can obtain it automatically by means
   of @{text "internalize-sort"}.\<close>
 
 lemma bezout_imp_all_fin_gen_ideals_are_principal_unsatisfactory:
   assumes a1: "class.bezout_ring (*) (1::'b::comm_ring_1) (+) 0 (-) uminus" (*It is algo possible to prove it using OFCLASS*)
   shows "\<forall>I::'b set. finitely_generated_ideal I \<longrightarrow> principal_ideal I"
   using bezout_imp_all_fin_gen_ideals_are_principal[internalize_sort "'a::bezout_ring"]
   using a1 by auto
 
 
 text \<open>The standard library does not connect @{text "OFCLASS"} and @{text "class.bezout_ring"}
 in both directions. Here we show that @{text "OFCLASS \<Longrightarrow> class.bezout_ring"}. \<close>
 
 lemma OFCLASS_bezout_ring_imp_class_bezout_ring:
   assumes "OFCLASS('a::comm_ring_1,bezout_ring_class)"
   shows "class.bezout_ring ((*)::'a\<Rightarrow>'a\<Rightarrow>'a) 1 (+) 0 (-) uminus"
   using assms
   unfolding bezout_ring_class_def class.bezout_ring_def
   using conjunctionD2[of "OFCLASS('a, comm_ring_1_class)"
                          "class.bezout_ring_axioms ((*)::'a\<Rightarrow>'a\<Rightarrow>'a) (+)"]
   by (auto, intro_locales)
 
 text \<open>The other implication can be obtained
   by thm @{text bezout_ring.intro_of_class} \<close>
 thm bezout_ring.intro_of_class
 
 
 (*OFCLASS is a proposition (Prop), and then the following statement is not valid.*)
 
 (*
 lemma
   shows "(\<forall>I::'a::comm_ring_1 set. finitely_generated_ideal I \<longrightarrow> principal_ideal I)
     = OFCLASS('a, bezout_ring_class)"
 *)
 
 (*Thus, we use the meta-equality and the meta universal quantifier.*)
 text \<open>Final theorem (with OFCLASS)\<close>
 lemma bezout_ring_iff_fin_gen_principal_ideal:
     "(\<And>I::'a::comm_ring_1 set. finitely_generated_ideal I \<Longrightarrow> principal_ideal I)
     \<equiv> OFCLASS('a, bezout_ring_class)"
 proof
   show "(\<And>I::'a::comm_ring_1 set. finitely_generated_ideal I \<Longrightarrow> principal_ideal I)
     \<Longrightarrow> OFCLASS('a, bezout_ring_class)"
     using all_fin_gen_ideals_are_principal_imp_bezout [where ?'a='a] by auto
   show "\<And>I::'a::comm_ring_1 set. OFCLASS('a, bezout_ring_class)
     \<Longrightarrow> finitely_generated_ideal I \<Longrightarrow> principal_ideal I"
     using bezout_imp_all_fin_gen_ideals_are_principal_unsatisfactory[where ?'b='a]
     using OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a] by auto
 qed
 
 text \<open>Final theorem (with @{text "class.bezout_ring"})\<close>
 
 lemma bezout_ring_iff_fin_gen_principal_ideal2:
     "(\<forall>I::'a::comm_ring_1 set. finitely_generated_ideal I \<longrightarrow> principal_ideal I)
     = (class.bezout_ring ((*)::'a\<Rightarrow>'a\<Rightarrow>'a) 1 (+) 0 (-) uminus)"
 proof
   show "\<forall>I::'a::comm_ring_1 set. finitely_generated_ideal I \<longrightarrow> principal_ideal I
       \<Longrightarrow> class.bezout_ring (*) 1 (+) (0::'a) (-) uminus"
     using all_fin_gen_ideals_are_principal_imp_bezout[where ?'a='a]
     using OFCLASS_bezout_ring_imp_class_bezout_ring[where ?'a='a]
     by auto
   show "class.bezout_ring (*) 1 (+) (0::'a) (-) uminus \<Longrightarrow> \<forall>I::'a set.
     finitely_generated_ideal I \<longrightarrow> principal_ideal I"
     using bezout_imp_all_fin_gen_ideals_are_principal_unsatisfactory by auto
 qed
 
 end
diff --git a/thys/Smith_Normal_Form/SNF_Algorithm.thy b/thys/Smith_Normal_Form/SNF_Algorithm.thy
--- a/thys/Smith_Normal_Form/SNF_Algorithm.thy
+++ b/thys/Smith_Normal_Form/SNF_Algorithm.thy
@@ -1,2442 +1,2444 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>A general algorithm to transform a matrix into its Smith normal form\<close>
 
 theory SNF_Algorithm
   imports    
     Smith_Normal_Form_JNF
 begin
 
 text \<open>This theory presents an executable algorithm to transform a matrix
 to its Smith normal form.\<close>
 
 subsection \<open>Previous definitions and lemmas\<close>
 
 definition "is_SNF A R = (case R of (P,S,Q) \<Rightarrow> 
   P \<in> carrier_mat (dim_row A) (dim_row A) \<and>
   Q \<in> carrier_mat (dim_col A) (dim_col A) 
   \<and> invertible_mat P \<and> invertible_mat Q 
   \<and> Smith_normal_form_mat S \<and> S = P * A * Q)"
 
 
 lemma is_SNF_intro: 
   assumes "P \<in> carrier_mat (dim_row A) (dim_row A)"
   and "Q \<in> carrier_mat (dim_col A) (dim_col A) "
   and "invertible_mat P" and "invertible_mat Q" 
   and "Smith_normal_form_mat S" and "S = P * A * Q"
 shows "is_SNF A (P,S,Q)" using assms unfolding is_SNF_def by auto
 
 
 (*With the following lemmas, we show that for the case 1xn only column operations are needed
   and the algorithm just needs to return two matrices.*)
 
 lemma Smith_1xn_two_matrices:
   fixes A :: "'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat 1 n" 
   and PSQ: "(P,S,Q) = (Smith_1xn A)"
   and is_SNF: "is_SNF A (Smith_1xn A)"
 shows "\<exists>Smith_1xn'. is_SNF A (1\<^sub>m 1, (Smith_1xn' A))"
 proof -
   let ?Q = "P$$(0,0) \<cdot>\<^sub>m Q"
   have P00_dvd_1: "P $$ (0, 0) dvd 1"
     by (metis (mono_tags, lifting) assms carrier_matD(1) determinant_one_element 
         invertible_iff_is_unit_JNF is_SNF_def prod.simps(2))
   have "is_SNF A (1\<^sub>m 1,S,?Q)"
   proof (rule is_SNF_intro)
     show "invertible_mat (P $$ (0, 0) \<cdot>\<^sub>m Q)"
       by (rule invertible_mat_smult_mat, insert P00_dvd_1 assms, auto simp add: is_SNF_def)
-    show "S = 1\<^sub>m 1 * A * (P $$ (0, 0) \<cdot>\<^sub>m Q)" 
-      by (smt A PSQ is_SNF carrier_matD(2) index_mult_mat(2) index_one_mat(2) left_mult_one_mat
-          mult_smult_assoc_mat mult_smult_distrib smult_mat_mat_one_element is_SNF_def split_conv)      
+    show "S = 1\<^sub>m 1 * A * (P $$ (0, 0) \<cdot>\<^sub>m Q)"
+      by (smt (verit, ccfv_threshold) A PSQ is_SNF assoc_mult_mat carrier_matD(1) carrier_matD(2)
+          case_prodE is_SNF_def left_mult_one_mat mult_carrier_mat mult_smult_distrib prod.simps(1)
+          smult_mat_mat_one_element)
   qed (insert assms, auto simp add: is_SNF_def)
   thus ?thesis by auto
 qed
 
 lemma Smith_1xn_two_matrices_all:
   assumes is_SNF: "\<forall>(A::'a::comm_ring_1 mat) \<in> carrier_mat 1 n. is_SNF A (Smith_1xn A)"
   shows "\<exists>Smith_1xn'. \<forall>(A::'a::comm_ring_1 mat) \<in> carrier_mat 1 n. is_SNF A (1\<^sub>m 1, (Smith_1xn' A))"
 proof -
   let ?Smith_1xn' = "\<lambda>A. let (P,S,Q) = (Smith_1xn A) in (S, P $$ (0, 0) \<cdot>\<^sub>m Q)"
-  show ?thesis by (rule exI[of _ ?Smith_1xn']) (smt Smith_1xn_two_matrices assms carrier_matD 
+  show ?thesis
+    by (rule exI[of _ ?Smith_1xn']) (smt (verit, ccfv_threshold) Smith_1xn_two_matrices assms carrier_matD
         carrier_matI case_prodE determinant_one_element index_smult_mat(2,3) invertible_iff_is_unit_JNF
         invertible_mat_smult_mat smult_mat_mat_one_element left_mult_one_mat is_SNF_def 
         mult_smult_assoc_mat mult_smult_distrib prod.simps(2))
 qed
 
 subsection \<open>Previous operations\<close>
 (*Reduce column, parameterized by a div operation*)
 context 
 assumes "SORT_CONSTRAINT('a::comm_ring_1)"
 begin
 
 definition is_div_op :: "('a\<Rightarrow>'a\<Rightarrow>'a) \<Rightarrow>bool"
   where "is_div_op div_op = (\<forall>a b. b dvd a \<longrightarrow> div_op a b * b = a)"
 
 (* With SOME, we can get a (non-executable) div operation:*)
 lemma div_op_SOME: "is_div_op (\<lambda>a b. (SOME k. k * b = a))"
 proof (unfold is_div_op_def, rule+)
   fix a b::'a assume dvd: "b dvd a" 
   show "(SOME k. k * b = a) * b = a" by (rule someI_ex, insert dvd dvd_def) (metis dvdE mult.commute)
 qed
 
 fun reduce_column_aux :: "('a\<Rightarrow>'a\<Rightarrow>'a) \<Rightarrow> nat list \<Rightarrow> 'a mat \<Rightarrow> ('a mat \<times> 'a mat) \<Rightarrow> ('a mat \<times> 'a mat)"
   where "reduce_column_aux div_op [] H (P,K) = (P,K)" 
   | "reduce_column_aux div_op (i#xs) H (P,K) = (
     \<comment> \<open>Reduce the i-th row\<close>
     let k = div_op (H$$(i,0)) (H $$ (0, 0));
         P' = addrow_mat (dim_row H) (-k) i 0;
         K' = addrow (-k) i 0 K
   in reduce_column_aux div_op xs H (P'*P,K')    
   )"
 
 definition "reduce_column div_op H = reduce_column_aux div_op [2..<dim_row H] H (1\<^sub>m (dim_row H),H)"
 
 
 lemma reduce_column_aux:
   assumes H: "H \<in> carrier_mat m n" 
     and P_init: "P_init \<in> carrier_mat m m"
     and K_init: "K_init \<in> carrier_mat m n"
   and P_init_H_K_init: "P_init * H = K_init"
   and PK_H: "(P,K) = reduce_column_aux div_op xs H (P_init,K_init)"
   and m: "0 < m"
   and inv_P: "invertible_mat P_init"
   and xs: "0 \<notin> set xs"
 shows "P \<in> carrier_mat m m \<and> K \<in> carrier_mat m n \<and> P * H = K \<and> invertible_mat P"
   using assms
   unfolding reduce_column_def
 proof (induct div_op xs H "(P_init,K_init)" arbitrary: P_init K_init rule: reduce_column_aux.induct)
   case (1 div_op H P K)
   then show ?case by simp
 next
   case (2 div_op i xs H P_init K_init)  
   show ?case
   proof (rule "2.hyps")
       let ?x = "div_op (H $$ (i, 0)) (H $$ (0, 0))"
       let ?xa = "addrow_mat (dim_row H) (- ?x) i 0"
       let ?xb = "addrow (- ?x) i 0 K_init"
       show "(P, K) = reduce_column_aux div_op xs H (?xa * P_init, ?xb)" 
         using "2.prems" by (auto simp add: Let_def)
       show "?xa * P_init \<in> carrier_mat m m" using "2"(2) "2"(3) by auto
       show "0 \<notin> set xs" using "2.prems" by auto
       have "?xa * K_init = ?xb" 
         by (rule addrow_mat[symmetric], insert "2.prems", auto)                  
       thus "?xa * P_init * H = ?xb"
         by (metis (no_types, lifting) "2"(5) "2.prems"(1) "2.prems"(2) addrow_mat_carrier 
             assoc_mult_mat carrier_matD(1))
       show "invertible_mat (?xa * P_init)" 
       proof (rule invertible_mult_JNF)
         show xa: "?xa \<in> carrier_mat m m" using "2"(2) by auto        
         have "Determinant.det ?xa = 1" by (rule det_addrow_mat, insert "2.prems", auto)
         thus "invertible_mat ?xa" unfolding invertible_iff_is_unit_JNF[OF xa] by simp     
       qed (auto simp add: "2.prems")
     qed(auto simp add: "2.prems")
   qed
 
 
 lemma reduce_column_aux_preserves:
   assumes H: "H \<in> carrier_mat m n" 
     and P_init: "P_init \<in> carrier_mat m m"
     and K_init: "K_init \<in> carrier_mat m n"
   and P_init_H_K_init: "P_init * H = K_init"
   and PK_H: "(P,K) = reduce_column_aux div_op xs H (P_init,K_init)"
   and m: "0 < m"
   and inv_P: "invertible_mat P_init"
   and xs: "0 \<notin> set xs"  and i: "i \<notin> set xs" and im: "i<m"
 shows "Matrix.row K i = Matrix.row K_init i"
   using PK_H inv_P H P_init K_init m xs i
   unfolding reduce_column_def
 proof (induct div_op xs H "(P_init,K_init)" arbitrary: P_init K_init K rule: reduce_column_aux.induct)
   case (1 div_op H P K)
   then show ?case by auto
 next
   case (2 div_op x xs H P_init K_init)
   thm "2.prems"
   "2.hyps"
       let ?x = "div_op (H $$ (x, 0)) (H $$ (0, 0))"
       let ?xa = "addrow_mat (dim_row H) (- ?x) x 0"
       let ?xb = "addrow (- ?x) x 0 K_init"
       have IH: "Matrix.row K i = Matrix.row ?xb i"
       proof (rule "2.hyps")
         show "(P, K) = reduce_column_aux div_op xs H (?xa * P_init, ?xb)" 
           using "2.prems" by (auto simp add: Let_def)
         show "?xa * P_init \<in> carrier_mat m m"
           using "2"(4) "2"(5) by auto    
         have "?xa * K_init = ?xb" 
           by (rule addrow_mat[symmetric], insert "2.prems", auto)
         show "invertible_mat (?xa * P_init)" 
         proof (rule invertible_mult_JNF)
           show xa: "?xa \<in> carrier_mat m m" using "2.prems" by auto        
           have "Determinant.det ?xa = 1" by (rule det_addrow_mat, insert "2.prems", auto)
           thus "invertible_mat ?xa" unfolding invertible_iff_is_unit_JNF[OF xa] by simp     
         qed (auto simp add: "2.prems")
         show "i \<notin> set xs" using "2"(9) by auto
         show "0 \<notin> set xs" using "2"(8) by auto
       qed(auto simp add: "2.prems")
       also have "... = Matrix.row K_init i"
         by (rule eq_vecI, auto, insert "2" "2.prems" im, auto)    
       finally show ?case .    
 qed
 
 lemma reduce_column_aux_index':
   assumes H: "H \<in> carrier_mat m n" 
     and P_init: "P_init \<in> carrier_mat m m"
     and K_init: "K_init \<in> carrier_mat m n"
   and P_init_H_K_init: "P_init * H = K_init"
   and PK_H: "(P,K) = reduce_column_aux div_op xs H (P_init,K_init)"
   and m: "0 < m"
   and inv_P: "invertible_mat P_init"
   and xs: "0 \<notin> set xs"  
   and "\<forall>x\<in>set xs. x<m"
   and "distinct xs"
 shows "(\<forall>i\<in>set xs. Matrix.row K i = 
     Matrix.row (addrow (-(div_op (H $$ (i, 0)) (H $$ (0, 0)))) i 0 K_init) i)"
   using assms
   unfolding reduce_column_def
 proof (induct div_op xs H "(P_init,K_init)" arbitrary: P_init K_init K rule: reduce_column_aux.induct)
   case (1 div_op H P K)
   then show ?case by simp
 next
   case (2 div_op i xs H P_init K_init)
   let ?x = "div_op (H $$ (i, 0)) (H $$ (0, 0)) "
   let ?xa = "addrow_mat (dim_row H) ?x i 0"
   thm "2.prems"
   thm "2.hyps"
   let ?xb = "addrow (- ?x) i 0 K_init"
   let ?xa = "addrow_mat (dim_row H) (- ?x) i 0"
   have "reduce_column_aux div_op (i#xs) H (P_init,K_init) 
     = reduce_column_aux div_op xs H (?xa*P_init,?xb)"
     by (auto simp add: Let_def)
   hence PK: "(P,K) = reduce_column_aux div_op xs H (?xa*P_init,?xb)" using "2.prems" by simp
       have xa_P_init:  "?xa * P_init \<in> carrier_mat m m" using "2"(2) "2"(3) by auto
       have zero_notin_xs: "0 \<notin> set xs" using "2.prems" by auto
       have "?xa * K_init = ?xb" 
         by (rule addrow_mat[symmetric], insert "2.prems", auto)                  
       hence rw: "?xa * P_init * H = ?xb"
         by (metis (no_types, lifting) "2"(5) "2.prems"(1) "2.prems"(2) addrow_mat_carrier 
             assoc_mult_mat carrier_matD(1))
       have inv_xa_P_init: "invertible_mat (?xa * P_init)" 
       proof (rule invertible_mult_JNF)
         show xa: "?xa \<in> carrier_mat m m" using "2"(2) by auto        
         have "Determinant.det ?xa = 1" by (rule det_addrow_mat, insert "2.prems", auto)
         thus "invertible_mat ?xa" unfolding invertible_iff_is_unit_JNF[OF xa] by simp     
       qed (auto simp add: "2.prems")
       have i1: "i\<noteq>0" using "2.prems"(8) by auto
       have i2: "i<m" by (simp add: "2.prems"(9))
       have i3: "i\<notin>set xs" using 2 by auto
       have d: "distinct xs" using 2 by auto
       have "\<forall>i\<in>set xs. Matrix.row K i = Matrix.row (addrow (- (div_op (H $$ (i, 0)) (H $$ (0, 0)))) 
             i 0 ?xb) i"
     by (rule "2.hyps", insert xa_P_init zero_notin_xs rw inv_xa_P_init d, 
         auto simp add: "2.prems" Let_def)  
   moreover have "Matrix.row (addrow (- (div_op (H $$ (j, 0)) (H $$ (0, 0)))) j 0 ?xb) j 
   = Matrix.row (addrow (- (div_op (H $$ (j, 0)) (H $$ (0, 0)))) j 0 K_init) j" 
     (is "Matrix.row ?lhs j= Matrix.row ?rhs j")
     if j: "j \<in> set xs" for j 
   proof (rule eq_vecI)
     fix ia assume ia: "ia<dim_vec(Matrix.row ?rhs j)"
     let ?k = "div_op (H $$ (j, 0)) (H $$ (0, 0))"
     let ?L = "(addrow (- (div_op (H $$ (i, 0)) (H $$ (0, 0)))) i 0 K_init)"
     have "Matrix.row ?lhs j $v ia = ?lhs $$ (j,ia)"
       by (metis (no_types, lifting) Matrix.row_def ia index_mat_addrow(5) index_row(2) index_vec)
     also have "... = (-?k) * ?L$$(0,ia) + ?L$$(j,ia)"      
-      by (smt "2.prems"(1) "2.prems"(9) carrier_matD(1) ia index_mat_addrow(1,5) index_row(2) 
+      by (smt (verit) "2.prems"(1) "2.prems"(9) carrier_matD(1) ia index_mat_addrow(1,5) index_row(2) 
           insert_iff list.set(2) mult_carrier_mat rw that xa_P_init)
     also have "... = ?rhs $$ (j,ia)" using "2"(10) "2"(4) i1 i3 ia j by auto
     also have "... = Matrix.row ?rhs j $v ia" using 2 ia j by auto
     finally show "Matrix.row ?lhs j $v ia = Matrix.row ?rhs j $v ia" .
   qed (auto)
   ultimately have "\<forall>j\<in>set xs. Matrix.row K j = 
     Matrix.row (addrow (- (div_op (H $$ (j, 0)) (H $$ (0, 0)))) j 0 K_init) j" by auto
   moreover have "Matrix.row K i = Matrix.row ?xb i" 
      by (rule reduce_column_aux_preserves[OF _ xa_P_init _ rw PK _ inv_xa_P_init zero_notin_xs 
             i3 i2],insert "2.prems", auto)
    ultimately show ?case by auto
  qed
 
 corollary reduce_column_aux_index:
   assumes H: "H \<in> carrier_mat m n" 
     and P_init: "P_init \<in> carrier_mat m m"
     and K_init: "K_init \<in> carrier_mat m n"
   and P_init_H_K_init: "P_init * H = K_init"
   and PK_H: "(P,K) = reduce_column_aux div_op xs H (P_init,K_init)"
   and m: "0 < m"
   and inv_P: "invertible_mat P_init"
   and xs: "0 \<notin> set xs"  
   and "\<forall>x\<in>set xs. x<m"
   and "distinct xs"
   and "i\<in>set xs"
 shows "Matrix.row K i = 
     Matrix.row (addrow (-(div_op (H $$ (i, 0)) (H $$ (0, 0)))) i 0 K_init) i"
   using reduce_column_aux_index' assms by simp
 
 
 corollary reduce_column_aux_works:
   assumes H: "H \<in> carrier_mat m n"           
   and PK_H: "(P,K) = reduce_column_aux div_op xs H (1\<^sub>m (dim_row H), H)"
   and m: "0 < m"
   and xs: "0 \<notin> set xs"  
   and xm: "\<forall>x \<in> set xs. x<m"
   and d_xs: "distinct xs"
   and i: "i \<in> set xs"
   and dvd: "H $$ (0, 0) dvd H $$ (i, 0)"
   and j0: "\<forall>j\<in>{1..<n}. H$$(0,j) = 0"
   and j1n: "j\<in>{1..<n}"
   and n: "0<n"
   and id: "is_div_op div_op"
 shows "K $$ (i,0) = 0" and "K$$(i,j) = H $$ (i,j)" 
 proof -
   let ?k = "div_op (H $$ (i, 0)) (H $$ (0, 0))"
   let ?L = "addrow (-?k) i 0 H"
   have kH00_eq_Hi0: "?k * H $$ (0, 0) = H $$ (i, 0)" 
     using id dvd unfolding is_div_op_def by simp
   have *: "Matrix.row K i = Matrix.row ?L i"
     by (rule reduce_column_aux_index[OF H _ _ _ PK_H], insert assms, auto)
   also have " ... $v 0 = ?L $$ (i,0)" by (rule index_row, insert xm i H n, auto)
   also have "... = (- ?k) * H$$(0,0) + H$$(i,0)" by (rule index_mat_addrow, insert i xm H n, auto)
   also have "... = 0" using kH00_eq_Hi0 by auto
   finally show "K $$ (i, 0) = 0"
     by (metis H Matrix.row_def * n carrier_matD(2) dim_vec index_mat_addrow(5) index_vec)
   have "Matrix.row ?L i $v j = ?L $$ (i,j)" by (rule index_row, insert xm i H n j1n, auto)
   also have "... = (- ?k) * H$$(0,j) + H$$(i,j)" by (rule index_mat_addrow, insert xm i H j1n, auto)
   also have "... = H$$(i,j)" using j1n j0 by auto
   finally show "K$$(i,j) = H $$ (i,j)" by (metis H * Matrix.row_def atLeastLessThan_iff 
         carrier_matD(2) dim_vec index_mat_addrow(5) index_vec j1n)
 qed
 
 lemma reduce_column:
   assumes H: "H \<in> carrier_mat m n"           
   and PK_H: "(P,K) = reduce_column div_op H"
   and m: "0 < m"
 shows "P \<in> carrier_mat m m \<and> K \<in> carrier_mat m n \<and> P * H = K \<and> invertible_mat P"
   by (rule reduce_column_aux[OF _ _ _ _ PK_H[unfolded reduce_column_def]], insert assms, auto)
 
 lemma reduce_column_preserves:
   assumes H: "H \<in> carrier_mat m n"           
   and PK_H: "(P,K) = reduce_column div_op H"
   and m: "0 < m"
   and "i\<in>{0,1}"
   and "i<m"
 shows "Matrix.row K i = Matrix.row H i"
   by (rule reduce_column_aux_preserves[OF _ _ _ _ PK_H[unfolded reduce_column_def]], 
       insert assms, auto)
 
 lemma reduce_column_preserves2:
   assumes H: "H \<in> carrier_mat m n"           
   and PK_H: "(P,K) = reduce_column div_op H"
   and m: "0 < m" and i: "i\<in>{0,1}" and im: "i<m" and j: "j<n"
 shows "K $$ (i,j) = H $$ (i,j)"
   using reduce_column_preserves[OF H PK_H m i im]
   by (metis H Matrix.row_def j carrier_matD(2) dim_vec index_vec)
   
 
 corollary reduce_column_works:
   assumes H: "H \<in> carrier_mat m n"           
   and PK_H: "(P,K) = reduce_column div_op H"
   and m: "0 < m"
   and dvd: "H $$ (0, 0) dvd H $$ (i, 0)"
   and j0: "\<forall>j\<in>{1..<n}. H $$ (0, j) = 0"
   and j1n: "j\<in>{1..<n}"
   and n: "0<n"
   and "i\<in>{2..<m}"
   and id: "is_div_op div_op"
 shows "K $$ (i,0) = 0" and "K$$(i,j) = H $$ (i,j)" 
     by (rule reduce_column_aux_works[OF H PK_H[unfolded reduce_column_def]], insert assms, auto)+
 
 end
 
 
 subsection \<open>The implementation\<close>
 
 text \<open>We define a locale where we implement the algorithm. It has three fixed operations:
 \begin{enumerate}
 \item an operation to transform any $1 \times 2$ matrix into its Smith normal form
 \item an operation to transform any $2 \times 2$ matrix into its Smith normal form
 \item an operation that provides a witness for division (this operation always exists over a 
       commutative ring with unit, but maybe we cannot provide a computable algorithm).
 \end{enumerate}
 
 Since we are working in a commutative ring, we can easily get an operation for $2 \times 1$ matrices
 via the $1 \times 2$ operation.
 \<close>
 locale Smith_Impl =   
   fixes Smith_1x2 :: "('a::comm_ring_1) mat \<Rightarrow> ('a mat \<times> 'a mat)"
     and Smith_2x2 :: "'a mat \<Rightarrow> ('a mat \<times> 'a mat \<times> 'a mat)"
     and div_op :: "'a\<Rightarrow>'a\<Rightarrow>'a"
   assumes SNF_1x2_works: "\<forall>(A::'a mat) \<in> carrier_mat 1 2. is_SNF A (1\<^sub>m 1, (Smith_1x2 A))" 
     and SNF_2x2_works: "\<forall>(A::'a mat) \<in> carrier_mat 2 2. is_SNF A (Smith_2x2 A)"
     and id: "is_div_op div_op"
 begin
 
 text \<open>From a $2 \times 2$ matrix (the $B$), we construct the identity matrix of size $n$ with 
 the elements of $B$ placed to modify the first element of a matrix and the element in position 
 $(k,k)$\<close>
 
 definition "make_mat n k (B::'a mat) = (Matrix.mat n n (\<lambda>(i,j). if i = 0 \<and> j = 0 then B$$(0,0) else
     if i = 0 \<and> j = k then B$$(0,1) else if i=k \<and> j = 0 
       then B$$(1,0) else if i=k \<and> j=k then B$$(1,1) 
       else if i=j then 1 else 0))"
 
 lemma make_mat_carrier[simp]:
   shows "make_mat n k B \<in> carrier_mat n n"
   unfolding make_mat_def by auto
 
 lemma upper_triangular_mat_delete_make_mat:
   shows "upper_triangular (mat_delete (make_mat n k B) 0 0)"
 proof -
   {  let ?M = "make_mat n k B"
   fix i j
   assume "i < dim_row ?M - Suc 0" and ji: "j < i"
   hence i_n1: "i < n - 1" by (simp add: make_mat_def)
   hence Suc_i: "Suc i < n" by linarith
   hence Suc_j: "Suc j < n" using ji by auto
   have i1: "insert_index 0 i = Suc i" by (rule insert_index, auto)
   have j1: "insert_index 0 j = Suc j" by (rule insert_index, auto)
   have "mat_delete ?M 0 0 $$ (i, j) = ?M $$ (insert_index 0 i, insert_index 0 j)"
     by (rule mat_delete_index[symmetric, OF _ _ _ i_n1], insert Suc_i Suc_j, auto)   
   also have "... = ?M $$ (Suc i, Suc j)" unfolding i1 j1 by simp
   also have "... = 0" unfolding make_mat_def unfolding index_mat[OF Suc_i Suc_j] using ji by auto
   finally have "mat_delete ?M 0 0 $$ (i, j) = 0" .
   }
   thus ?thesis  unfolding upper_triangular_def by auto
 qed
 
 lemma upper_triangular_mat_delete_make_mat2:
   assumes kn: "k<n"
   shows "upper_triangular (mat_delete (mat_delete (make_mat n k B) 0 k) (k - 1) 0)"
 proof -
   {  let ?M = "local.make_mat n k B"
   let ?MD = "mat_delete ?M 0 k"
   fix i j assume i: "i < dim_row ?M - 2" and ji: "j < i"  
   have insert_in: "insert_index 0 i < n" and insert_Sucin: "insert_index 0 (Suc i) < n"
     using i make_mat_def by auto
   have insert_k_Sucj: "insert_index k (Suc j) < n"
     using insert_in insert_index_def ji by auto
   have insert_j: "insert_index 0 j = Suc j" by simp  
   have "mat_delete ?MD (k - 1) 0 $$ (i, j) = ?MD $$ (insert_index (k-1) i, insert_index 0 j)" 
   proof (rule mat_delete_index[symmetric])
     show "i < n-2" using i by (simp add: make_mat_def)  
     thus "?MD \<in> carrier_mat (Suc (n - 2)) (Suc (n - 2))"
       by (metis Suc_diff_Suc card_num_simps(30) make_mat_carrier mat_delete_carrier 
           nat_diff_split_asm not_less0 not_less_eq numerals(2))
     show "k - 1 < Suc (n - 2)" using kn by auto  
     show "0 < Suc (n - 2)" by blast
     show "j < n - 2" using ji i by (simp add: make_mat_def)  
   qed
   also have "... = ?MD $$ (insert_index (k-1) i, Suc j)" unfolding insert_j by auto
   also have "... = 0"
   proof (cases "i < (k-1)")
     case True
     hence "insert_index (k-1) i = i" by auto
     hence "?MD $$ (insert_index (k-1) i, Suc j) = ?MD $$ (i, Suc j)" by auto
     also have "... = ?M $$ (insert_index 0 i, insert_index k (Suc j))" 
     proof (rule mat_delete_index[symmetric])
       show "?M \<in> carrier_mat (Suc (n-1)) (Suc (n-1))" using assms by auto
       show "0 < Suc (n - 1)" 
         by blast
       show "k < Suc (n - 1)"using kn by simp
       show "i < n - 1" using i using True assms by linarith
       thus "Suc j < n - 1" using ji less_trans_Suc by blast
     qed
     also have "... = 0" unfolding make_mat_def index_mat[OF insert_in insert_k_Sucj]
       using True ji by auto
     finally show ?thesis .
     next
       case False
       hence "insert_index (k-1) i = Suc i" by auto
       hence "?MD $$ (insert_index (k-1) i, Suc j) = ?MD $$ (Suc i, Suc j)" by auto
     also have "... = ?M $$ (insert_index 0 (Suc i), insert_index k (Suc j))" 
     proof (rule mat_delete_index[symmetric])
       show "?M \<in> carrier_mat (Suc (n-1)) (Suc (n-1))" using assms by auto
       thus "Suc i < n - 1" using i using False assms
         by (metis One_nat_def Suc_diff_Suc carrier_matD(1) diff_Suc_1 diff_Suc_eq_diff_pred 
             diff_is_0_eq' linorder_not_less nat.distinct(1) numeral_2_eq_2)
       show "0 < Suc (n - 1)" 
         by blast
       show "k < Suc (n - 1)"using kn by simp
       show "Suc j < n - 1" using ji less_trans_Suc
         using \<open>Suc i < n - 1\<close> by linarith
     qed
     also have "... = 0" unfolding make_mat_def index_mat[OF insert_Sucin insert_k_Sucj]
-      using False ji by (auto, smt insert_index_def less_SucI nat.inject nat_neq_iff)
+      using False ji by (simp add: insert_index_def)
     finally show ?thesis .    
   qed  
   finally have "mat_delete ?MD (k - 1) 0 $$ (i, j) = 0" .
 }
   thus ?thesis unfolding upper_triangular_def by auto
 qed
 
 corollary det_mat_delete_make_mat:
   assumes kn: "k<n"
   shows "Determinant.det (mat_delete (mat_delete (make_mat n k B) 0 k) (k - 1) 0) = 1"
 proof -
   let ?M = "make_mat n k B"
   let ?MD = "mat_delete ?M 0 k"
   let ?MDMD = "mat_delete ?MD (k - 1) 0"
   have eq1: "?MDMD $$ (i,i) = 1" if i: "i<n-2" for i
   proof -
     have i1: "insert_index 0 (insert_index (k-1) i) < n" using i insert_index_def by auto
     have i2: "insert_index k (insert_index 0 i) < n" using i insert_index_def by auto
     have "?MDMD $$ (i, i) = ?MD $$ (insert_index (k-1) i, insert_index 0 i)"
     proof (rule mat_delete_index[symmetric, OF _ _ _ i i])
       show "mat_delete (local.make_mat n k B) 0 k \<in> carrier_mat (Suc (n-2)) (Suc (n-2))"
         by (metis (mono_tags, opaque_lifting) Suc_diff_Suc card_num_simps(30) i make_mat_carrier 
             mat_delete_carrier nat_diff_split_asm not_less0 not_less_eq numerals(2))    
       show "k - 1 < Suc (n - 2)" using kn by auto
       show "0 < Suc (n - 2)" using kn by auto
     qed
     also have "... = ?M $$ (insert_index 0 (insert_index (k-1) i), insert_index k (insert_index 0 i))"
     proof (rule mat_delete_index[symmetric])
       show "make_mat n k B \<in> carrier_mat (Suc (n-1)) (Suc (n-1))" using i by auto    
       show "insert_index (k - 1) i < n - 1" using kn i
         by (metis diff_Suc_eq_diff_pred diff_commute insert_index_def nat_neq_iff not_less0 
             numeral_2_eq_2 zero_less_diff)
       show "insert_index 0 i < n - 1" using i by auto
     qed (insert kn, auto)
     also have "... = 1" unfolding make_mat_def index_mat[OF i1 i2] 
       by (auto, metis One_nat_def diff_Suc_1 insert_index_exclude) 
          (metis One_nat_def diff_Suc_eq_diff_pred insert_index_def zero_less_diff)+
     finally show ?thesis .
   qed
   have "Determinant.det ?MDMD = prod_list (diag_mat ?MDMD)"
     by (meson assms det_upper_triangular make_mat_carrier mat_delete_carrier 
         upper_triangular_mat_delete_make_mat2)
   also have "... = 1" 
   proof (rule prod_list_neutral)
     fix x assume x: "x \<in> set (diag_mat ?MDMD)"
     from this obtain i where index: "x = ?MDMD $$ (i,i)" and i: "i<dim_row ?MDMD"
       unfolding diag_mat_def by auto
     have "?MDMD $$ (i,i) = 1" by (rule eq1, insert i, auto simp add: make_mat_def)  
     thus "x=1" using index by blast
   qed
   finally show ?thesis .
 qed
 
 lemma swaprows_make_mat:
   assumes B: "B \<in> carrier_mat 2 2" and k0: "k\<noteq>0" and k: "k<n"
   shows "swaprows k 0 (make_mat n k B) = make_mat n k (swaprows 1 0 B)" (is "?lhs = ?rhs")
 proof (cases "n=0")
   case True
   then show ?thesis
     using make_mat_def by auto
 next
   case False
   show ?thesis
    proof (rule eq_matI)
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs"
       by (simp add: make_mat_def)+
   next
     let ?M="(make_mat n k B)"
     fix i j assume i: "i < dim_row ?rhs" and j: "j < dim_col ?rhs"
     hence i2: "i < dim_row ?lhs" and j2: "j < dim_col ?lhs" by (auto simp add: make_mat_def)
     then have i3: "i < dim_row ?M" and j3: "j < dim_col ?M" by auto
     then have i4: "i<n" and j4: "j<n" by (metis carrier_matD(1,2) make_mat_carrier)+
     have lhs: "?lhs $$ (i,j) = 
         (if k = i then ?M $$ (0, j) else if 0 = i then ?M $$ (k, j) else ?M $$ (i, j))"
       by (rule index_mat_swaprows, insert i3 j3, auto)
     also have "... = ?rhs $$ (i,j)" using B i4 j4 False k0 k 
       unfolding make_mat_def index_mat[OF i4 j4] by auto
     finally show "?lhs $$ (i, j) = ?rhs $$ (i, j)" .
   qed
 qed
 
 
 lemma cofactor_make_mat_00:
   assumes k: "k<n" and k0: "k\<noteq>0"
   shows "cofactor (make_mat n k B) 0 0 = B $$ (1,1)"
 proof -
   let ?M = "make_mat n k B"
   let ?MD = "mat_delete ?M 0 0"
   have MD_rows: "dim_row ?MD = n-1" by (simp add: make_mat_def)
   have 1: "?MD $$ (i, i) = 1" if i: "i < n - 1" and ik: "Suc i \<noteq> k" for i
   proof -
     have Suc_i: "Suc i < n" using i by linarith
     have "?MD $$ (i, i) = ?M $$ (insert_index 0 i, insert_index 0 i)"
       by (rule mat_delete_index[symmetric, OF _ _ _ i], insert Suc_i, auto)
     also have "... = ?M $$ (Suc i, Suc i)" by simp
     also have "... = 1" unfolding make_mat_def index_mat[OF Suc_i Suc_i] using ik by auto
     finally show ?thesis .
   qed
   have 2: "?MD $$ (i, i) = B$$(1,1)" if i: "i < n - 1" and ik: "Suc i = k" for i
   proof -
     have Suc_i: "Suc i < n" using i by linarith
     have "?MD $$ (i, i) = ?M $$ (insert_index 0 i, insert_index 0 i)"
       by (rule mat_delete_index[symmetric, OF _ _ _ i], insert Suc_i, auto)   
     also have "... = ?M $$ (Suc i, Suc i)" by simp
     also have "... = B$$(1,1)" unfolding make_mat_def index_mat[OF Suc_i Suc_i] using ik by auto
     finally show ?thesis .
   qed
   have set_rw: "insert (k-1) ({0..<dim_row ?MD}-{k-1}) = {0..<dim_row ?MD}" 
     using k k0 MD_rows by auto
   have up: "upper_triangular ?MD" by (rule upper_triangular_mat_delete_make_mat)
   have "Determinant.cofactor (local.make_mat n k B) 0 0 
     = Determinant.det (mat_delete (make_mat n k B) 0 0)" unfolding cofactor_def by auto
   also have "... = prod_list (diag_mat ?MD)" using up
     using det_upper_triangular make_mat_carrier mat_delete_carrier by blast
   also have "... = (\<Prod>i = 0..<dim_row ?MD. ?MD $$ (i, i))" unfolding prod_list_diag_prod by simp
   also have "... = (\<Prod>i \<in> insert (k-1) ({0..<dim_row ?MD}-{k-1}). ?MD $$ (i, i))" 
     using set_rw by simp
   also have "... = ?MD $$ (k-1, k-1) * (\<Prod>i \<in> {0..<dim_row ?MD} - {k-1}. ?MD $$ (i, i))"
     by (metis (no_types, lifting) Diff_iff finite_atLeastLessThan finite_insert prod.insert set_rw singletonI)
   also have "... = B$$(1,1)"
-    by (smt "1" "2" DiffD1 DiffD2 Groups.mult_ac(2) MD_rows add_diff_cancel_left' add_diff_inverse_nat 
+    by (smt (verit) "1" "2" DiffD1 DiffD2 Groups.mult_ac(2) MD_rows add_diff_cancel_left' add_diff_inverse_nat 
         k0 atLeastLessThan_iff class_cring.finprod_all1 insertI1 less_one more_arith_simps(5) 
         plus_1_eq_Suc set_rw)
   finally show ?thesis .
 qed
 
 
 
 lemma cofactor_make_mat_0k:  
   assumes kn: "k<n" and k0: "k\<noteq>0" and n0: "1<n"
   shows "cofactor (make_mat n k B) 0 k = - B $$ (1,0)"
 proof -
   let ?M = "make_mat n k B"
   let ?MD = "mat_delete ?M 0 k"
   have n0: "0<n-1" using n0 by auto
   have MD_carrier: "?MD \<in> carrier_mat (n-1) (n-1)"
     using make_mat_carrier mat_delete_carrier by blast
   have MD_k1: "?MD $$ (k-1, 0) = B $$ (1,0)"
   proof -
     have n0': "0 < n" using n0 by auto
     have insert_i: "insert_index 0 (k-1) = k" using k0 by auto
     have insert_k: "insert_index k 0 = 0" using k0 by auto
     have "?MD $$ (k-1, 0) = ?M $$ (insert_index 0 (k-1), insert_index k 0)"
       by (rule mat_delete_index[symmetric, OF _ _ _ _ n0], insert k0 kn, auto)
     also have "... = ?M $$ (k, 0)" unfolding insert_i insert_k by simp
     also have "... = B $$ (1,0)" using k0 unfolding make_mat_def index_mat[OF kn n0'] by auto
     finally show ?thesis .
   qed  
   have MD0: "?MD $$ (i, 0) = 0" if i: "i<n-1" and ik: "Suc i\<noteq>k" for i
   proof -
     have i2: "Suc i < n" using i by auto
     have n0': "0<n" using n0 by auto
     have insert_i: "insert_index 0 i = Suc i" by simp
     have insert_k: "insert_index k 0 = 0" using k0 by auto
     have "?MD $$ (i, 0) = ?M $$ (insert_index 0 i, insert_index k 0)"
       by (rule mat_delete_index[symmetric, OF _ _ _ i], insert i n0 kn, auto)
     also have "... = ?M $$ (Suc i, 0)" unfolding insert_i insert_k by simp
     also have "... = 0" using ik unfolding make_mat_def index_mat[OF i2 n0'] by auto
     finally show ?thesis .
   qed
   have det_cofactor: "Determinant.cofactor ?MD (k-1) 0 = (-1) ^ (k - 1)"
     unfolding cofactor_def using det_mat_delete_make_mat[OF kn] by auto
   have sum0: "(\<Sum>i\<in>{0..<n - 1}-{k-1}. ?MD $$ (i, 0) * Determinant.cofactor ?MD i 0) = 0"
     by (rule sum.neutral, insert MD0, fastforce)
   have "Determinant.det ?MD = (\<Sum>i<n - 1. ?MD $$ (i, 0) * Determinant.cofactor ?MD i 0)" 
     by (rule laplace_expansion_column[OF MD_carrier n0])
   also have "... = ?MD $$ (k-1, 0) * Determinant.cofactor ?MD (k-1) 0 
       + (\<Sum>i\<in>{0..<n - 1}-{k-1}. ?MD $$ (i, 0) * Determinant.cofactor ?MD i 0)"  
     by (metis (no_types, lifting) Suc_less_eq add_diff_inverse_nat atLeast0LessThan finite_atLeastLessThan 
         k0 kn lessThan_iff less_one n0 nat_diff_split_asm plus_1_eq_Suc rel_simps(70) sum.remove)
   also have "... = ?MD $$ (k-1, 0) * Determinant.cofactor ?MD (k-1) 0" unfolding sum0 by simp
   also have "... = ?MD $$ (k-1, 0) * (-1) ^ (k - 1)" unfolding det_cofactor by auto
   also have "... = (-1) ^ (k - 1) * B $$ (1,0)" using MD_k1 by auto
   finally show ?thesis unfolding cofactor_def
     by (metis (no_types, lifting) arithmetic_simps(49) k0 left_minus_one_mult_self 
         more_arith_simps(11) mult_minus1 power_eq_if) 
 qed
 
 
 lemma invertible_make_mat:
   assumes inv_B: "invertible_mat B" and B: "B \<in> carrier_mat 2 2" 
     and kn: "k<n" and k0: "k\<noteq>0"
   shows "invertible_mat (make_mat n k B)"
 proof -
   let ?M = "(make_mat n k B)"
   have M_carrier: "?M \<in> carrier_mat n n" by auto
   show ?thesis
   proof (cases "n=0")
     case True
     thus ?thesis using M_carrier using invertible_mat_zero by blast
   next
     case False note n_not_0 = False
     show ?thesis
     proof (cases "n=1")
       case True
       then show ?thesis using M_carrier using invertible_mat_zero assms by auto
     next
       case False    
       hence n: "0<n" using n_not_0 by auto
       hence n1: "1<n" using False n_not_0 by auto
       have M00: "?M $$ (0,0) = B $$ (0,0)" by (simp add: make_mat_def n)
       have M0k: "?M $$ (0,k) = B $$ (0,1)" by (simp add: k0 kn make_mat_def n)
       have sum0: "(\<Sum>j\<in>({0..<n}-{0} - {k}). ?M $$ (0, j) * Determinant.cofactor ?M 0 j) = 0"
       proof (rule sum.neutral, rule ballI)
         fix x assume x: "x \<in> {0..<n} - {0} - {k}"
         have "make_mat n k B $$ (0,x) = 0" unfolding make_mat_def using x by auto
         thus "local.make_mat n k B $$ (0, x) * Determinant.cofactor (local.make_mat n k B) 0 x = 0" 
           by simp
       qed
       have cofactor_M_00: "Determinant.cofactor ?M 0 0 = B$$(1,1)"
         by (rule cofactor_make_mat_00[OF kn k0])
       have cofactor_M_0k: "Determinant.cofactor ?M 0 k = - B $$ (1,0)"
         by (rule cofactor_make_mat_0k[OF kn k0 n1])
       have "Determinant.det ?M = (\<Sum>j<n. ?M $$ (0, j) * Determinant.cofactor ?M 0 j)" 
         using laplace_expansion_row[OF M_carrier n] by auto
       also have "... = (\<Sum>j\<in>{0..<n}. ?M $$ (0, j) * Determinant.cofactor ?M 0 j)" 
         by (rule sum.cong, auto)
       also have "... = ?M $$ (0, 0) * Determinant.cofactor ?M 0 0 
         + ?M $$ (0, k) * Determinant.cofactor ?M 0 k 
         + (\<Sum>j\<in>({0..<n}-{0} - {k}). ?M $$ (0, j) * Determinant.cofactor ?M 0 j)" 
         by (metis (no_types, lifting) add_cancel_right_right kn k0 atLeast0LessThan 
             atLeast1_lessThan_eq_remove0 finite_atLeastLessThan insert_Diff_single insert_iff 
             lessThan_iff n sum.atLeast_Suc_lessThan sum.remove sum0)
       also have "... = ?M $$ (0, 0) * Determinant.cofactor ?M 0 0 
         + ?M $$ (0, k) * Determinant.cofactor ?M 0 k" using sum0 by auto
       also have "... = ?M $$ (0, 0) * B $$ (1,1) - ?M $$ (0, k)* B $$ (1,0)" 
         unfolding cofactor_M_00 cofactor_M_0k by auto
       also have "... =  B $$ (0, 0) * B $$ (1,1) - B $$ (0, 1)* B $$ (1,0)" 
         unfolding M00 M0k by auto
       also have "... = Determinant.det B" unfolding det_2[OF B] by auto
       finally have "Determinant.det ?M = Determinant.det B" .
       thus ?thesis unfolding cofactor_def 
         using invertible_iff_is_unit_JNF by (metis B M_carrier inv_B)  
     qed
   qed
 qed
 
 lemma make_mat_index:
   assumes i: "i<n" and j: "j<n"
   shows "make_mat n k B $$ (i,j) = (if i = 0 \<and> j = 0 then B$$(0,0) else
     if i = 0 \<and> j = k then B$$(0,1) else if i=k \<and> j = 0 
       then B$$(1,0) else if i=k \<and> j=k then B$$(1,1) 
       else if i=j then 1 else 0)"
   unfolding make_mat_def index_mat[OF i j] by simp
 
 lemma make_mat_works:
   assumes A: "A\<in>carrier_mat m n" and Suc_i_less_n: "Suc i < n"
     and Q_step_def: "Q_step = (make_mat n (Suc i) (snd (Smith_1x2 
         (Matrix.mat 1 2 (\<lambda>(a,b). if b = 0 then A $$ (0,0) else A $$(0,Suc i))))))"
   shows "A $$ (0,0) * Q_step $$ (0,(Suc i)) + A $$ (0, Suc i) * Q_step $$ (Suc i, Suc i) = 0"
 proof -
   have n0: "0<n" using Suc_i_less_n by simp
   let ?A ="(Matrix.mat 1 2 (\<lambda>(a, b). if b = 0 then A $$ (0, 0) else A $$ (0, Suc i)))"
   let ?S = "fst (Smith_1x2 ?A)"
   let ?Q = "snd (Smith_1x2 ?A)"
   have 1: "(make_mat n (Suc i) ?Q) $$ (0,Suc i) = ?Q $$ (0,1)"
     unfolding make_mat_index[OF n0 Suc_i_less_n] by auto
   have 2: "(make_mat n (Suc i) ?Q) $$ (Suc i, Suc i) = ?Q $$ (1,1)"
     unfolding make_mat_index[OF Suc_i_less_n Suc_i_less_n] by auto
   have is_SNF_A': "is_SNF ?A (1\<^sub>m 1, Smith_1x2 ?A)" using SNF_1x2_works by auto 
   have SNF_S: "Smith_normal_form_mat ?S" and S: "?S = 1\<^sub>m 1 * ?A * ?Q" 
     and Q: "?Q \<in> carrier_mat 2 2"
     using is_SNF_A' unfolding is_SNF_def by auto
   have "?S $$(0,1) = (?A * ?Q) $$(0,1)" unfolding S by auto
   also have "... =  Matrix.row ?A 0 \<bullet> col ?Q 1" by (rule index_mult_mat, insert Q, auto)
   also have "... = (\<Sum>ia = 0..<dim_vec (col ?Q 1). Matrix.row ?A 0 $v ia * col ?Q 1 $v ia)"
     unfolding scalar_prod_def by auto
   also have "... = (\<Sum>ia \<in> {0,1}. Matrix.row ?A 0 $v ia * col ?Q 1 $v ia)"
     by (rule sum.cong, insert Q, auto)
   also have "... = Matrix.row ?A 0 $v 0 * col ?Q 1 $v 0 + Matrix.row ?A 0 $v 1 * col ?Q 1 $v 1"
     using sum_two_elements by auto
   also have "... = A $$ (0,0) * ?Q $$ (0,1) + A $$ (0,Suc i) * ?Q $$ (1,1)"    
-    by (smt One_nat_def Q carrier_matD(1) carrier_matD(2) dim_col_mat(1) dim_row_mat(1) index_col 
+    by (smt (verit) One_nat_def Q carrier_matD(1) carrier_matD(2) dim_col_mat(1) dim_row_mat(1) index_col 
         index_mat(1) index_row(1) lessI numeral_2_eq_2 pos2 prod.simps(2) rel_simps(93))
   finally have "?S $$(0,1) = A $$ (0,0) * ?Q $$ (0,1) + A $$ (0,Suc i) * ?Q $$ (1,1)" by simp
   moreover have "?S $$(0,1) = 0" using SNF_S unfolding Smith_normal_form_mat_def isDiagonal_mat_def
     by (metis (no_types, lifting) Q S card_num_simps(30) carrier_matD(2) index_mult_mat(2) 
         index_mult_mat(3) index_one_mat(2) lessI n_not_Suc_n numeral_2_eq_2)
   ultimately show ?thesis using 1 2 unfolding Q_step_def by auto
 qed
 
 subsubsection \<open>Case $1 \times n$\<close>
 
 fun Smith_1xn_aux :: "nat \<Rightarrow> 'a mat \<Rightarrow> ('a mat \<times> 'a mat) \<Rightarrow> ('a mat \<times> 'a mat)"
   where 
     "Smith_1xn_aux 0 A (S,Q) = (S,Q)" |
     "Smith_1xn_aux (Suc i) A (S,Q) = (let 
        A_step_1x2 = (Matrix.mat 1 2 (\<lambda>(a,b). if b = 0 then S $$ (0,0) else S $$(0,Suc i)));
        (S_step_1x2, Q_step_1x2) = Smith_1x2 A_step_1x2;
       Q_step = make_mat (dim_col A) (Suc i) Q_step_1x2; 
       S' = S * Q_step
       in Smith_1xn_aux i A (S',Q*Q_step))"
 
 definition "Smith_1xn A = (if dim_col A = 0 then (A,1\<^sub>m (dim_col A)) 
   else Smith_1xn_aux (dim_col A - 1) A (A,1\<^sub>m (dim_col A)))"
 
 lemma Smith_1xn_aux_Q_carrier:
   assumes r: "(S',Q') = (Smith_1xn_aux i A (S,Q))"
   assumes A: "A \<in> carrier_mat 1 n" and Q: "Q \<in> carrier_mat n n"
   shows "Q' \<in> carrier_mat n n"
   using A r Q 
 proof (induct i A "(S,Q)" arbitrary: S Q rule: Smith_1xn_aux.induct)
   case (1 A S Q)
   then show ?case by auto
 next
   case (2 i A S Q)
   note A = "2.prems"(1)
   note S'Q' = "2.prems"(2)
   note Q = "2.prems"(3)  
   let ?A_step_1x2 = "(Matrix.mat 1 2 (\<lambda>(a,b). if b = 0 then S $$ (0,0) else S $$(0,Suc i)))"
   let ?S_step_1x2 = "fst (Smith_1x2 ?A_step_1x2)"
   let ?Q_step_1x2 = "snd (Smith_1x2 ?A_step_1x2)"
   let ?Q_step = "make_mat (dim_col A) (Suc i) ?Q_step_1x2"
   have rw: "A * (Q * ?Q_step) = A * Q * ?Q_step"
-    by (smt A Q assoc_mult_mat carrier_matD(2) make_mat_carrier)  
+    by (smt (verit) A Q assoc_mult_mat carrier_matD(2) make_mat_carrier)  
   have Smith_rw: "Smith_1xn_aux (Suc i) A (S, Q) = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)"
     by (auto, metis (no_types, lifting) old.prod.exhaust snd_conv split_conv)
   show ?case 
   proof (rule "2.hyps"[of ?A_step_1x2 "(?S_step_1x2, ?Q_step_1x2)" ?S_step_1x2 ?Q_step_1x2])
     show "S * ?Q_step = S * ?Q_step" ..   
     show "A \<in> carrier_mat 1 n" using A by auto
     show "(S', Q') = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)" using "2.prems" Smith_rw by auto
     show "Q * ?Q_step \<in> carrier_mat n n" using A Q by auto  
   qed (auto)
 qed
 
 
 lemma Smith_1xn_aux_invertible_Q:
   assumes r: "(S',Q') = (Smith_1xn_aux i A (S,Q))"
   assumes A: "A \<in> carrier_mat 1 n" and Q: "Q \<in> carrier_mat n n"
     and i: "i<n" and inv_Q: "invertible_mat Q"
   shows "invertible_mat Q'"
   using r A Q inv_Q i
 proof (induct i A "(S,Q)" arbitrary: S Q rule: Smith_1xn_aux.induct)
   case (1 A S Q)
   then show ?case by auto
 next
   case (2 i A S Q)
   let ?A_step_1x2 = "(Matrix.mat 1 2 (\<lambda>(a,b). if b = 0 then S $$ (0,0) else S $$(0,Suc i)))"
   let ?S_step_1x2 = "fst (Smith_1x2 ?A_step_1x2)"
   let ?Q_step_1x2 = "snd (Smith_1x2 ?A_step_1x2)"
   let ?Q_step = "make_mat (dim_col A) (Suc i) ?Q_step_1x2"
    have Smith_rw: "Smith_1xn_aux (Suc i) A (S, Q) = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)"
      by (auto, metis (no_types, lifting) old.prod.exhaust snd_conv split_conv)
    have i_col: "Suc i < dim_col A"
      using  "2.prems" Suc_lessD by blast
    have i_n: "i<n" by (simp add: "2.prems" Suc_lessD)
   show ?case 
   proof (rule "2.hyps"[of ?A_step_1x2 "(?S_step_1x2, ?Q_step_1x2)" ?S_step_1x2 ?Q_step_1x2])
     show "A \<in> carrier_mat 1 n" using "2.prems" by auto
     show "Q * ?Q_step \<in> carrier_mat n n" using "2.prems" by auto  
     show "S * ?Q_step = S * ?Q_step" ..
     show "(S', Q') = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)" using "2.prems" Smith_rw by auto
     show "invertible_mat (Q * ?Q_step)"
     proof (rule invertible_mult_JNF)
       show "Q \<in> carrier_mat n n" using "2.prems" by auto
       show "?Q_step \<in> carrier_mat n n"  using "2.prems" by auto
       show "invertible_mat Q" using "2.prems" by auto
       show "invertible_mat ?Q_step" 
         by (rule invertible_make_mat[OF _ _ i_col], insert SNF_1x2_works, unfold is_SNF_def, auto)
            (metis (no_types, lifting) case_prodE mat_carrier snd_conv)+        
     qed
   qed (auto simp add: i_n)
 qed
 
 lemma Smith_1xn_aux_S'_AQ':
   assumes r: "(S',Q') = (Smith_1xn_aux i A (S,Q))"
   assumes A: "A \<in> carrier_mat 1 n" and S: "S \<in> carrier_mat 1 n" and Q: "Q \<in> carrier_mat n n"
     and S_AQ: "S = A*Q" and i: "i<n"
   shows "S' = A * Q'"
   using A S r Q S_AQ 
 proof (induct i A "(S,Q)" arbitrary: S Q rule: Smith_1xn_aux.induct)
   case (1 A S Q)
   then show ?case by auto
 next
  case (2 i A S Q)
   let ?A_step_1x2 = "(Matrix.mat 1 2 (\<lambda>(a,b). if b = 0 then S $$ (0,0) else S $$(0,Suc i)))"
   let ?S_step_1x2 = "fst (Smith_1x2 ?A_step_1x2)"
   let ?Q_step_1x2 = "snd (Smith_1x2 ?A_step_1x2)"
   let ?Q_step = "make_mat (dim_col A) (Suc i) ?Q_step_1x2"
   have rw: "A * (Q * ?Q_step) = A * Q * ?Q_step"
-    by (smt "2.prems" assoc_mult_mat carrier_matD(2) make_mat_carrier)  
+    by (smt (verit) "2.prems" assoc_mult_mat carrier_matD(2) make_mat_carrier)  
    have Smith_rw: "Smith_1xn_aux (Suc i) A (S, Q) = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)"
     by (auto, metis (no_types, lifting) old.prod.exhaust snd_conv split_conv)
   show ?case 
   proof (rule "2.hyps"[of ?A_step_1x2 "(?S_step_1x2, ?Q_step_1x2)" ?S_step_1x2 ?Q_step_1x2])
    show "A \<in> carrier_mat 1 n" using "2.prems" by auto
     show "Q * ?Q_step \<in> carrier_mat n n" using "2.prems" by auto  
     show "S * ?Q_step = S * ?Q_step" ..
     show "(S', Q') = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)" using "2.prems" Smith_rw by auto
     show " S * ?Q_step = A * (Q * ?Q_step)" using "2.prems" rw by auto
     show "S * ?Q_step \<in> carrier_mat 1 n"
-      using "2.prems" by (smt carrier_matD(2) make_mat_carrier mult_carrier_mat)
+      using "2.prems" by (smt (verit) carrier_matD(2) make_mat_carrier mult_carrier_mat)
   qed (auto)
 qed
 
 
 lemma Smith_1xn_aux_S'_works:
   assumes r: "(S',Q') = (Smith_1xn_aux i A (S,Q))"
   assumes A: "A \<in> carrier_mat 1 n" and S: "S \<in> carrier_mat 1 n" and Q: "Q \<in> carrier_mat n n"
     and S_AQ: "S = A*Q" and i: "i<n" and j0: "0<j" and jn: "j<n"
   and all_j_zero: "\<forall>j\<in>{i+1..<n}. S $$(0,j) = 0"
   shows "S' $$ (0,j) = 0"
   using A S r Q i S_AQ all_j_zero j0 jn
 proof (induct i A "(S,Q)" arbitrary: S Q rule: Smith_1xn_aux.induct)
   case (1 A S Q)
   then show ?case using j0 jn by auto
 next
  case (2 i A S Q)
   let ?A_step_1x2 = "(Matrix.mat 1 2 (\<lambda>(a,b). if b = 0 then S $$ (0,0) else S $$(0,Suc i)))"
   let ?S_step_1x2 = "fst (Smith_1x2 ?A_step_1x2)"
   let ?Q_step_1x2 = "snd (Smith_1x2 ?A_step_1x2)"
   let ?Q_step = "make_mat (dim_col A) (Suc i) ?Q_step_1x2"
   have i_less_n: "i<n" by (simp add: "2"(6) Suc_lessD)
   have rw: "A * (Q * ?Q_step) = A * Q * ?Q_step"
-    by (smt "2.prems" assoc_mult_mat carrier_matD(2) make_mat_carrier)  
+    by (smt (verit) "2.prems" assoc_mult_mat carrier_matD(2) make_mat_carrier)  
    have Smith_rw: "Smith_1xn_aux (Suc i) A (S, Q) = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)"
      by (auto, metis (no_types, lifting) old.prod.exhaust snd_conv split_conv)
    have S'_AQ': "S' = A*Q'"
      by (rule Smith_1xn_aux_S'_AQ', insert "2.prems", auto)  
   show ?case 
   proof (rule "2.hyps"[of ?A_step_1x2 "(?S_step_1x2, ?Q_step_1x2)" ?S_step_1x2 ?Q_step_1x2])
    show "A \<in> carrier_mat 1 n" using "2.prems" by auto
     show Q_Q_step_carrier: "Q * ?Q_step \<in> carrier_mat n n" using "2.prems" by auto  
     show "S * ?Q_step = S * ?Q_step" ..
     show "(S', Q') = Smith_1xn_aux i A (S * ?Q_step, Q * ?Q_step)" using "2.prems" Smith_rw by auto
     show "S * ?Q_step = A * (Q * ?Q_step)" using "2.prems" rw by auto
     show "S * ?Q_step \<in> carrier_mat 1 n"      
-      using "2.prems" by (smt carrier_matD(2) make_mat_carrier mult_carrier_mat)  
+      using "2.prems" by (smt (verit) carrier_matD(2) make_mat_carrier mult_carrier_mat)  
     show "\<forall>j\<in>{i + 1..<n}. (S * ?Q_step) $$ (0, j) = 0"
     proof (rule ballI)
       fix j assume j: "j\<in>{i + 1..<n}" 
       have "(S * ?Q_step) $$ (0, j) = Matrix.row S 0 \<bullet> col ?Q_step j" 
         by (rule index_mult_mat, insert j "2.prems", auto simp add: make_mat_def)
       also have "... = 0"
       proof (cases "j=Suc i")
         case True
         (*In this case, the element is transformed into a zero thanks to the SNF operation.*)
         let ?f = "\<lambda>x. Matrix.row S 0 $v x * col ?Q_step j $v x"
         let ?set = "{0..<dim_vec (col ?Q_step j)}"
         have set_rw: "?set = insert 0 (insert j (?set - {0} - {j}))"
           using "2.prems" True make_mat_def by auto
         have sum0: "(\<Sum>x \<in> ?set - {0} - {j}. ?f x) = 0"
         proof (rule sum.neutral, rule ballI)
           fix x assume x: "x \<in> ?set - {0} - {j}"
           show "?f x = 0" using "2"(6) "2.prems" True make_mat_def x by auto
         qed
         have "Matrix.row S 0 \<bullet> col ?Q_step j  = (\<Sum>x = 0..<dim_vec (col ?Q_step j). ?f x)"
           unfolding scalar_prod_def by simp
         also have "... = (\<Sum>x \<in> insert 0 (insert j (?set - {0} - {j})). ?f x)" using set_rw by auto
         also have "... = ?f 0 + (\<Sum>x \<in> insert j (?set - {0} - {j}). ?f x)" by (simp add: True)
         also have "... = ?f 0 + ?f j + (\<Sum>x \<in> ?set - {0} - {j}. ?f x)"
           by (simp add: set_rw sum.insert_remove)
         also have "... = ?f 0 + ?f j" using sum0 by auto
         also have "... = S $$ (0,0) * ?Q_step $$ (0, Suc i) + S $$ (0,Suc i) * ?Q_step $$ (Suc i, Suc i)"
           using "2.prems" True make_mat_def by auto
         also have "... = 0" by (rule make_mat_works, insert "2.prems", auto)
         finally show ?thesis .
       next
         (*In this case, the zeroes are preserved. Each multiplication is zero.*)
         case False note j_not_Suc_i = False
         show ?thesis
           unfolding scalar_prod_def
         proof (rule sum.neutral, rule ballI)
           fix x assume x: "x\<in>{0..<dim_vec (col ?Q_step j)}"
           have xn: "x<n" using "2"(2) make_mat_def x by auto
           have jn2: "j<dim_col A" using "2"(2) j by auto
           have xn2: "x<dim_col A" using "2.prems"(1) xn by blast
           have "Matrix.row S 0 $v x = S $$ (0,x)" using "2.prems" make_mat_def x by auto
           moreover have "col ?Q_step j $v x = ?Q_step $$ (x,j)" using Q_Q_step_carrier j x by auto
           ultimately have eq: "Matrix.row S 0 $v x * col ?Q_step j $v x = S $$ (0,x) * ?Q_step $$ (x,j)" by auto
           have S_0x: "S $$ (0,x) = 0" if "Suc i + 1 \<le> x" using "2.prems" xn that by auto
           moreover have "?Q_step $$ (x,j) = 0" if "x\<le>Suc i" 
             using that j j_not_Suc_i unfolding make_mat_def index_mat[OF xn2 jn2] by auto 
           ultimately show "Matrix.row S 0 $v x * (col ?Q_step j) $v x = 0" using eq by force
         qed
       qed
       finally show "(S * ?Q_step) $$ (0, j) = 0" .
     qed
   qed (auto simp add: "2.prems" i_less_n)
 qed
 
 lemma Smith_1xn_works:
   assumes A: "A \<in> carrier_mat 1 n"
   and SQ: "(S,Q) = Smith_1xn A"
 shows "is_SNF A (1\<^sub>m 1, S,Q)"
 proof (cases "n=0")
   case True
   thus ?thesis using assms
     unfolding is_SNF_def
     by (auto simp add: Smith_1xn_def)
 next
   case False 
   hence n0: "0<n" by auto
   show ?thesis
   proof (rule is_SNF_intro) 
     have SQ_eq: "(S,Q) = local.Smith_1xn_aux (dim_col A - 1) A (A,1\<^sub>m (dim_col A))"
       using SQ unfolding Smith_1xn_def by simp
     have col: "dim_col A - 1 < dim_col A" using n0 A by auto
     show "1\<^sub>m 1 \<in> carrier_mat (dim_row A) (dim_row A)" using A by auto
     show Q: "Q \<in> carrier_mat (dim_col A) (dim_col A)" 
       by (rule Smith_1xn_aux_Q_carrier[OF SQ_eq], insert A, auto)
     show "invertible_mat (1\<^sub>m 1)" by simp
     show "invertible_mat Q" by (rule Smith_1xn_aux_invertible_Q[OF SQ_eq], insert A n0, auto)
     have S_AQ: "S = A * Q"
       by (rule Smith_1xn_aux_S'_AQ'[OF SQ_eq], insert A n0, auto)
     thus "S = 1\<^sub>m 1 * A * Q" using A by auto
     have S: "S \<in> carrier_mat 1 n" using S_AQ A Q by auto  
     show "Smith_normal_form_mat S"
     proof (rule Smith_normal_form_mat_intro)
       show "\<forall>a. a + 1 < min (dim_row S) (dim_col S) \<longrightarrow> S $$ (a, a) dvd S $$ (a + 1, a + 1)"
         using S by auto
       have "S $$ (0, j) = 0" if j0: "0 < j" and jn: "j < n" for j
         by (rule Smith_1xn_aux_S'_works[OF SQ_eq], insert A n0 j0 jn, auto)  
       thus "isDiagonal_mat S" unfolding isDiagonal_mat_def using S by simp   
     qed
   qed
 qed
 
 subsubsection \<open>Case $n \times 1$\<close>
 
 (*The case n x 1 can be obtained from the case 1 x n taking inverses appropriately. Thus, I get
   rid of the Smith_2x1 operation, since it seems to be useless.*)
 
 definition "Smith_nx1 A = 
   (let (S,P) = (Smith_1xn_aux (dim_row A - 1) (transpose_mat A) (transpose_mat A,1\<^sub>m (dim_row A))) 
   in (transpose_mat P, transpose_mat S))"
 
 
 lemma Smith_nx1_works:
   assumes A: "A \<in> carrier_mat n 1"
   and SQ: "(P,S) = Smith_nx1 A"
 shows "is_SNF A (P, S,1\<^sub>m 1)"
 proof (cases "n=0")
   case True
   thus ?thesis using assms
     unfolding is_SNF_def
     by (auto simp add: Smith_nx1_def)
 next
   case False
   hence n0: "0<n" by auto
   show ?thesis
   proof (rule is_SNF_intro) 
     have SQ_eq: "(S\<^sup>T, P\<^sup>T) = (Smith_1xn_aux (dim_row A - 1) A\<^sup>T (A\<^sup>T,1\<^sub>m (dim_row A)))"
       using SQ[unfolded Smith_nx1_def] unfolding Let_def split_beta by auto
     have "is_SNF (A\<^sup>T) (1\<^sub>m 1, S\<^sup>T,P\<^sup>T)" 
       by (rule Smith_1xn_works[unfolded Smith_1xn_def, OF _ _], insert SQ_eq A, auto)
     have Pt: "P\<^sup>T \<in> carrier_mat (dim_col (A\<^sup>T)) (dim_col (A\<^sup>T))"
       by (rule Smith_1xn_aux_Q_carrier[OF SQ_eq], insert A n0, auto)
     thus P: "P \<in> carrier_mat (dim_row A) (dim_row A)" by auto
     show "1\<^sub>m 1 \<in> carrier_mat (dim_col A) (dim_col A)" using A by simp
     have "invertible_mat (P\<^sup>T)"
       by (rule Smith_1xn_aux_invertible_Q[OF SQ_eq], insert A n0, auto)
     thus "invertible_mat P" by (metis det_transpose P Pt invertible_iff_is_unit_JNF)
     show "invertible_mat (1\<^sub>m 1)" by simp
     have "S\<^sup>T = A\<^sup>T * P\<^sup>T" 
       by (rule Smith_1xn_aux_S'_AQ'[OF SQ_eq], insert A n0, auto)
     hence "S = P * A" by (metis A transpose_mult transpose_transpose P carrier_matD(1))
     thus "S = P * A * 1\<^sub>m 1" using P A by auto
     hence S: "S \<in> carrier_mat n 1" using P A by auto
     have "is_SNF (A\<^sup>T) (1\<^sub>m 1, S\<^sup>T,P\<^sup>T)" 
       by (rule Smith_1xn_works[unfolded Smith_1xn_def, OF _ _], insert SQ_eq A, auto)  
     hence "Smith_normal_form_mat (S\<^sup>T)" unfolding is_SNF_def by auto
     thus "Smith_normal_form_mat S" unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
   qed
 qed
 
 subsubsection \<open>Case $2 \times n$\<close>
 
 function Smith_2xn :: "'a mat \<Rightarrow> ('a mat \<times> 'a mat \<times> 'a mat)"
   where 
     "Smith_2xn A = (
   if dim_col A = 0 then (1\<^sub>m (dim_row A),A,1\<^sub>m 0) else
   if dim_col A = 1 then let (P,S) = Smith_nx1 A in (P,S, 1\<^sub>m (dim_col A)) else
   if dim_col A = 2 then Smith_2x2 A 
   else
       let A1 = mat_of_cols (dim_row A) [col A 0];
           A2 = mat_of_cols (dim_row A) [col A i. i \<leftarrow> [1..<dim_col A]];
           (P1,D1,Q1) = Smith_2xn A2;
           C = (P1*A1) @\<^sub>c (P1*A2*Q1);
           D = mat_of_cols (dim_row A) [col C 0, col C 1];
           E = mat_of_cols (dim_row A) [col C i. i \<leftarrow> [2..<dim_col A]];
           (P2,D2,Q2) = Smith_2x2 D;
           H = (P2*D*Q2) @\<^sub>c (P2 * E);
           k = (div_op (H $$ (0,2)) (H $$ (0,0)));
           H2 = addcol (-k) 2 0 H;
           (_,_,_,H2_DR) = split_block H2 1 1;
           (H_1xn,Q3) = Smith_1xn H2_DR;
           S = four_block_mat (Matrix.mat 1 1 (\<lambda>(a,b). H$$(0,0))) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m 1 1) H_1xn;
           Q1' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q1;
           Q2' = four_block_mat Q2 (0\<^sub>m 2 (dim_col A - 2)) (0\<^sub>m (dim_col A - 2) 2) (1\<^sub>m (dim_col A - 2));
           Q_div_k = addrow_mat (dim_col A) (-k) 0 2;
           Q3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q3
       in (P2 * P1,S,Q1' * Q2' * Q_div_k * Q3'))"
   by pat_completeness auto
 (*Termination is guaranteed since the algorithm is recursively applied to a 
   submatrix with less columns*)
 termination apply (relation "measure (\<lambda>A. dim_col A)") by auto
 
 lemma Smith_2xn_0:
   assumes A: "A \<in> carrier_mat 2 0"
   shows "is_SNF A (Smith_2xn A)"
 proof -
   have "Smith_2xn A = (1\<^sub>m (dim_row A),A,1\<^sub>m 0)"
     using A by auto
   moreover have "is_SNF A ..." by (rule is_SNF_intro, insert A, auto)
   ultimately show ?thesis by simp
 qed
 
 lemma Smith_2xn_1:
   assumes A: "A \<in> carrier_mat 2 1"
   shows "is_SNF A (Smith_2xn A)"
 proof -
   obtain P S where PS: "Smith_nx1 A = (P,S)" using prod.exhaust by blast
   have *: "is_SNF A (P, S,1\<^sub>m 1)" by (rule Smith_nx1_works[OF A PS[symmetric]])
   moreover have "Smith_2xn A = (P,S, 1\<^sub>m (dim_col A))"
     using A PS by auto
   moreover have "is_SNF A ..." using * A by auto
   ultimately show ?thesis by simp
 qed
 
 lemma Smith_2xn_2:
   assumes A: "A \<in> carrier_mat 2 2"
   shows "is_SNF A (Smith_2xn A)"
 proof -
   have "Smith_2xn A = Smith_2x2 A" using A by auto
   from this show ?thesis using SNF_2x2_works using A by auto
 qed
 
 lemma is_SNF_Smith_2xn_n_ge_2: 
   assumes A: "A \<in> carrier_mat 2 n" and n: "n>2"
   shows "is_SNF A (Smith_2xn A)"
   using A n id
 proof (induct A arbitrary: n rule: Smith_2xn.induct)
   case (1 A)
   note A = "1.prems"(1)
   note n_ge_2 = "1.prems"(2)
   have dim_col_A_g2: "dim_col A > 2" using n_ge_2 A by auto
   define A1 where "A1 = mat_of_cols (dim_row A) [col A 0]"
   define A2 where "A2 = mat_of_cols (dim_row A) [col A i. i \<leftarrow> [1..<dim_col A]]"
   obtain P1 D1 Q1 where P1D1Q1: "(P1,D1,Q1) = Smith_2xn A2" by (metis prod_cases3)
   define C where "C = (P1*A1) @\<^sub>c (P1*A2*Q1)"
   define D where "D = mat_of_cols (dim_row A) [col C 0, col C 1]"
   define E where "E = mat_of_cols (dim_row A) [col C i. i \<leftarrow> [2..<dim_col A]]"
   obtain P2 D2 Q2 where P2D2Q2: "(P2,D2,Q2) = Smith_2x2 D" by (metis prod_cases3)
   define H where "H = (P2*D*Q2) @\<^sub>c (P2 * E)"
   define k where "k = div_op (H $$ (0,2)) (H $$ (0,0))"
   define H2 where "H2 = addcol (-k) 2 0 H"
   obtain H2_UL H2_UR H2_DL H2_DR 
     where split_H2: "(H2_UL, H2_UR, H2_DL, H2_DR) = (split_block H2 1 1)" by (metis prod_cases4)
   obtain H_1xn Q3 where H_1xn_Q3: "(H_1xn,Q3) = Smith_1xn H2_DR" by (metis surj_pair)
   define S where "S = four_block_mat (Matrix.mat 1 1 (\<lambda>(a,b). H$$(0,0))) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m 1 1) H_1xn"
   define Q1' where "Q1' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q1"
   define Q2' where "Q2' = four_block_mat Q2 (0\<^sub>m 2 (dim_col A - 2)) (0\<^sub>m (dim_col A - 2) 2) (1\<^sub>m (dim_col A - 2))"
   define Q_div_k where "Q_div_k = addrow_mat (dim_col A) (-k) 0 2"
   define Q3' where "Q3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q3"
   have Smith_2xn_rw: "Smith_2xn A = (P2 * P1, S, Q1' * Q2' * Q_div_k * Q3')"
   proof (rule prod3_intro)
     have P1_def: "fst (Smith_2xn A2) = P1" and Q1_def: "snd (snd (Smith_2xn A2)) = Q1"
     and P2_def: "fst (Smith_2x2 D) = P2" and Q2_def: "snd (snd (Smith_2x2 D)) = Q2"
     and H_1xn_def: "fst (Smith_1xn H2_DR) = H_1xn" and Q3_def: "snd (Smith_1xn H2_DR) = Q3"     
     and H2_DR_def: "snd (snd (snd (split_block H2 1 1))) = H2_DR"
       using P2D2Q2 P1D1Q1 H_1xn_Q3 split_H2 fstI sndI by metis+
     note aux= P1_def Q1_def Q1'_def Q2'_def Q_div_k_def Q3'_def S_def A1_def[symmetric]
       C_def[symmetric] P2_def Q2_def Q3_def D_def[symmetric] E_def[symmetric] H_def[symmetric]
       k_def[symmetric] H2_def[symmetric] H2_DR_def H_1xn_def A2_def[symmetric]
   show "fst (Smith_2xn A) = P2 * P1" 
     using dim_col_A_g2 unfolding Smith_2xn.simps[of A] Let_def split_beta
     by (insert P1D1Q1 P2D2Q2 D_def C_def, unfold aux, auto simp del: Smith_2xn.simps)
   show "fst (snd (Smith_2xn A)) = S"
     using dim_col_A_g2 unfolding Smith_2xn.simps[of A] Let_def split_beta
     by (insert P1D1Q1 P2D2Q2, unfold aux, auto simp del: Smith_2xn.simps)
   show "snd (snd (Smith_2xn A)) = Q1' * Q2' * Q_div_k * Q3'" 
     using dim_col_A_g2 unfolding Smith_2xn.simps[of A] Let_def split_beta
     by (insert P1D1Q1 P2D2Q2, unfold aux, auto simp del: Smith_2xn.simps)  
   qed
   show ?case
   proof (unfold Smith_2xn_rw, rule is_SNF_intro)    
     have is_SNF_A2: "is_SNF A2 (Smith_2xn A2)" 
     proof (cases "2<dim_col A2")
       case True
       show ?thesis 
         by (rule "1.hyps", insert True A dim_col_A_g2 id, auto simp add: A2_def)
     next
       case False
       hence "dim_col A2 = 2" using n_ge_2 A unfolding A2_def by auto
       hence A2: "A2\<in>carrier_mat 2 2" unfolding A2_def using A by auto
       hence *: "Smith_2xn A2 =  Smith_2x2 A2" by auto
       show ?thesis unfolding * using SNF_2x2_works A2 by auto
     qed
     have A1[simp]: "A1 \<in> carrier_mat (dim_row A) 1" unfolding A1_def by auto
     have A2[simp]: "A2 \<in> carrier_mat (dim_row A) (dim_col A - 1)" unfolding A2_def by auto    
     have P1[simp]: "P1 \<in> carrier_mat (dim_row A) (dim_row A)" 
       and inv_P1: "invertible_mat P1" 
       and Q1: "Q1 \<in> carrier_mat (dim_col A2) (dim_col A2)" and inv_Q1: "invertible_mat Q1"
       and SNF_P1A2Q1: "Smith_normal_form_mat (P1*A2*Q1)"
       using is_SNF_A2 P1D1Q1 A2 unfolding is_SNF_def by fastforce+ 
     have D[simp]: "D \<in> carrier_mat 2 2" unfolding D_def
       by (metis "1"(2) One_nat_def Suc_eq_plus1 carrier_matD(1) list.size(3) 
           list.size(4) mat_of_cols_carrier(1) numerals(2))
     have is_SNF_D: "is_SNF D (Smith_2x2 D)" using SNF_2x2_works D by auto
     hence P2[simp]: "P2 \<in> carrier_mat (dim_row A) (dim_row A)" and inv_P2: "invertible_mat P2"
       and Q2[simp]: "Q2 \<in> carrier_mat (dim_col D) (dim_col D)" and inv_Q2: "invertible_mat Q2"
       using P2D2Q2 D_def unfolding is_SNF_def by force+ 
     show P2_P1: "P2 * P1 \<in> carrier_mat (dim_row A) (dim_row A)" by (rule mult_carrier_mat[OF P2 P1])
     show "invertible_mat (P2 * P1)" by (rule invertible_mult_JNF[OF P2 P1 inv_P2 inv_P1])
     have Q1': "Q1' \<in> carrier_mat (dim_col A) (dim_col A)" using Q1 unfolding Q1'_def
-      by (auto, smt A2 One_nat_def add_diff_inverse_nat carrier_matD(1) carrier_matD(2) carrier_matI 
+      by (auto, smt (verit) A2 One_nat_def add_diff_inverse_nat carrier_matD(1) carrier_matD(2) carrier_matI 
           dim_col_A_g2 gr_implies_not0 index_mat_four_block(2) index_mat_four_block(3) 
           index_one_mat(2) index_one_mat(3) less_Suc0)
     have Q2': "Q2' \<in> carrier_mat (dim_col A) (dim_col A)" using Q2 unfolding Q2'_def
-      by (smt D One_nat_def Suc_lessD add_diff_inverse_nat carrier_matD(1) carrier_matD(2) 
+      by (smt (verit) D One_nat_def Suc_lessD add_diff_inverse_nat carrier_matD(1) carrier_matD(2) 
           carrier_matI dim_col_A_g2 gr_implies_not0 index_mat_four_block(2) index_mat_four_block(3)
           index_one_mat(2) index_one_mat(3) less_2_cases numeral_2_eq_2 semiring_norm(138))
    have H2[simp]: "H2 \<in> carrier_mat (dim_row A) (dim_col A)" using A P2 D unfolding H2_def H_def
-     by (smt E_def Q2 Q2' Q2'_def append_cols_def arithmetic_simps(50) carrier_matD(1) carrier_matD(2) 
+     by (smt (verit) E_def Q2 Q2' Q2'_def append_cols_def arithmetic_simps(50) carrier_matD(1) carrier_matD(2) 
          carrier_mat_triv index_mat_addcol(4) index_mat_addcol(5) index_mat_four_block(2) 
          index_mat_four_block(3) index_mult_mat(2) index_mult_mat(3) index_one_mat(2) index_zero_mat(2) 
          index_zero_mat(3) length_map length_upt mat_of_cols_carrier(3))
    have H'[simp]: "H2_DR \<in> carrier_mat 1 (n - 1)"
      by (rule split_block(4)[OF split_H2[symmetric]], insert H2 A n_ge_2, auto)
    have is_SNF_H': "is_SNF H2_DR (1\<^sub>m 1, H_1xn, Q3)"
      by (rule Smith_1xn_works[OF H' H_1xn_Q3])
    from this have Q3: "Q3 \<in> carrier_mat (dim_col H2_DR) (dim_col H2_DR)" and inv_Q3: "invertible_mat Q3" 
      unfolding is_SNF_def by auto
    have Q3': "Q3' \<in> carrier_mat (dim_col A) (dim_col A)"
      by (metis A A2 H' Q1 Q1' Q1'_def Q3 Q3'_def carrier_matD(1) carrier_matD(2) carrier_matI 
          index_mat_four_block(2) index_mat_four_block(3))   
    have Q_div_k[simp]: "Q_div_k \<in> carrier_mat (dim_col A) (dim_col A)" unfolding Q_div_k_def by auto
    have inv_Q_div_k: "invertible_mat Q_div_k"
      by (metis Q_div_k Q_div_k_def det_addrow_mat det_one invertible_iff_is_unit_JNF 
          invertible_mat_one nat.simps(3) numerals(2) one_carrier_mat)
    show "Q1' * Q2' * Q_div_k * Q3' \<in> carrier_mat (dim_col A) (dim_col A)"
      using Q1' Q2' Q_div_k Q3' by auto
    have inv_Q1': "invertible_mat Q1'"
    proof -
      have "invertible_mat (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (n - 1)) (0\<^sub>m (n - 1) 1) Q1)"
        by (rule invertible_mat_four_block_mat_lower_right, insert Q1 inv_Q1 A2 "1.prems", auto)
      thus ?thesis unfolding Q1'_def using A by auto
    qed
    have inv_Q2': "invertible_mat Q2'"
      by (unfold Q2'_def, rule invertible_mat_four_block_mat_lower_right_id, 
          insert Q2 n_ge_2 inv_Q2 A D, auto)
    have inv_Q3': "invertible_mat Q3'"
    proof -
      have "invertible_mat (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (n - 1)) (0\<^sub>m (n - 1) 1) Q3)"
        by (rule invertible_mat_four_block_mat_lower_right, insert Q3 H' inv_Q3 "1.prems", auto)
      thus ?thesis unfolding Q3'_def using A by auto
    qed
    show "invertible_mat (Q1' * Q2' * Q_div_k * Q3')"
      using inv_Q1' inv_Q2' inv_Q_div_k inv_Q3'
      by (meson Q1' Q2' Q3' Q_div_k invertible_mult_JNF mult_carrier_mat)
    have A_A1_A2: "A = A1 @\<^sub>c A2" unfolding A1_def A2_def append_cols_def 
    proof (rule eq_matI, auto)
      fix i assume i: "i < dim_row A" show 1: "A $$ (i, 0) = mat_of_cols (dim_row A) [col A 0] $$ (i, 0)"       
        by (metis dim_col_A_g2 gr_zeroI i index_col mat_of_cols_Cons_index_0 not_less0)
      let ?xs = "(map (col A) [Suc 0..<dim_col A])"
      fix j
      assume j1: "j < Suc (dim_col A - Suc 0)"
        and j2: "0 < j" 
      have "mat_of_cols (dim_row A) ?xs $$ (i, j - Suc 0) = ?xs ! (j - Suc 0) $v i"
        by (rule mat_of_cols_index, insert j1 j2 i, auto)
      also have "... = A $$ (i,j)" using dim_col_A_g2 i j1 j2 by auto
      finally show "A $$ (i, j) = mat_of_cols (dim_row A) ?xs $$ (i, j - Suc 0)" ..         
      next
        show "dim_col A = Suc (dim_col A - Suc 0)" using n_ge_2 A by auto
    qed
    have C_P1_A_Q1': "C = P1 * A * Q1'"
    proof -
      have aux: "P1 * (A1 @\<^sub>c A2) = ((P1 * A1) @\<^sub>c (P1 * A2))" 
        by (rule append_cols_mult_left, insert A1 A2 P1, auto)
      have "P1 * A * Q1' = P1 * (A1 @\<^sub>c A2) * Q1'" using A_A1_A2 by simp     
      also have "... = ((P1 * A1) @\<^sub>c (P1 * A2)) * Q1'" unfolding aux ..
      also have "... = (P1 * A1) @\<^sub>c ((P1 * A2) * Q1)"
        by (rule append_cols_mult_right_id, insert P1 A1 A2 Q1'_def Q1, auto)
      finally show ?thesis unfolding C_def by auto
    qed
    have E_ij_0: "E $$ (i,j) = 0" if i: "i<dim_row E" and j: "j<dim_col E" and ij: "(i,j) \<noteq> (1,0)" 
       for i j
    proof -
      let ?ws = "(map (col C) [2..<dim_col A])"
      have "E $$ (i,j) = ?ws ! j $v i " 
        by (unfold E_def, rule mat_of_cols_index, insert i j A E_def, auto)
      also have "... = (col C (j+2)) $v i" using E_def j by auto
      also have "... = C $$ (i,j+2)" 
        by (metis C_P1_A_Q1' P1 Q1' E_def carrier_matD(1) carrier_matD(2) index_col index_mult_mat(2)
            index_mult_mat(3) length_map length_upt less_diff_conv mat_of_cols_carrier(2)
            mat_of_cols_carrier(3) i j)
      also have "... = (if j + 2 < dim_col (P1*A1) then (P1*A1) $$ (i, j + 2) 
         else (P1 * A2 * Q1) $$ (i, (j+2) - 1))" 
        unfolding C_def 
        by (rule append_cols_nth, insert i j P1 A1 A2 Q1 A, auto simp add: E_def)    
      also have "... = (P1 * A2 * Q1) $$ (i, j+1)"
        by (metis A1 One_nat_def add.assoc add_diff_cancel_right' add_is_0 arith_special(3) 
            carrier_matD(2) index_mult_mat(3) less_Suc0 zero_neq_numeral)
      also have "... = 0" using SNF_P1A2Q1 unfolding Smith_normal_form_mat_def isDiagonal_mat_def
        by (metis (no_types, lifting) A A2 P1 Q1 Suc_diff_Suc Suc_mono E_def add_Suc_right 
            add_lessD1 arith_extra_simps(6) carrier_matD(1) carrier_matD(2) dim_col_A_g2 
            gr_implies_not0 index_mult_mat(2) index_mult_mat(3) length_map length_upt less_Suc_eq 
            mat_of_cols_carrier(2) mat_of_cols_carrier(3) numeral_2_eq_2 plus_1_eq_Suc i j ij)
      finally show ?thesis .
    qed
    have C_D_E: "C = D @\<^sub>c E"
    proof (rule eq_matI)
      have "C $$ (i, j) = mat_of_cols (dim_row A) [col C 0, col C 1] $$ (i, j)" 
        if  i: "i < dim_row A" and j: "j < 2" for i j
      proof -
        let ?ws = "[col C 0, col C 1]"
        have "mat_of_cols (dim_row A) [col C 0, col C 1] $$ (i, j) = ?ws ! j $v i"
          by (rule mat_of_cols_index, insert i j, auto)       
        also have "... = C $$ (i, j)" using j index_col 
-         by (auto, smt A C_P1_A_Q1' P1 Q1' Suc_lessD carrier_matD i index_col index_mult_mat(2,3) 
+         by (auto, smt (verit) A C_P1_A_Q1' P1 Q1' Suc_lessD carrier_matD i index_col index_mult_mat(2,3) 
              less_2_cases n_ge_2 nth_Cons_0 nth_Cons_Suc numeral_2_eq_2)
        finally show ?thesis by simp
      qed
      moreover have "C $$ (i, j) = mat_of_cols (dim_row A) (map (col C) [2..<dim_col A]) $$ (i, j - 2)"
        if i: "i < dim_row A" and j1: "j < dim_col A" and j2: "j \<ge> 2" for i j
      proof -
        let ?ws = "(map (col C) [2..<dim_col A])"
        have "mat_of_cols (dim_row A) ?ws $$ (i, j - 2) = ?ws ! (j-2) $v i"
          by (rule mat_of_cols_index, insert i j1 j2, auto)       
        also have "... = C $$ (i,j)"
          by (metis C_P1_A_Q1' P1 Q1' add_diff_inverse_nat carrier_matD(1) carrier_matD(2) dim_col_A_g2 
              i index_col index_mult_mat(2) index_mult_mat(3) less_diff_iff less_imp_le_nat 
              linorder_not_less nth_map_upt j1 j2)
        finally show ?thesis by auto
      qed
      ultimately show "\<And>i j. i < dim_row (D @\<^sub>c E) \<Longrightarrow> j < dim_col (D @\<^sub>c E) \<Longrightarrow> C $$ (i, j) = (D @\<^sub>c E) $$ (i, j)" 
        unfolding D_def E_def append_cols_def by (auto simp add: numerals)
      show "dim_row C = dim_row (D @\<^sub>c E)" using P1 A unfolding C_def D_def E_def append_cols_def by auto
      show "dim_col C = dim_col (D @\<^sub>c E)" using A1 Q1 A2 A n_ge_2 
        unfolding C_def D_def E_def append_cols_def by auto
    qed
    have E[simp]: "E\<in>carrier_mat 2 (n-2)" unfolding E_def using A by auto 
    have H[simp]: "H \<in> carrier_mat (dim_row A) (dim_col A)" unfolding H_def append_cols_def using A
-     by (smt E Groups.add_ac(1) One_nat_def P2_P1 Q2 Q2' Q2'_def carrier_matD index_mat_four_block
+     by (smt (verit) E Groups.add_ac(1) One_nat_def P2_P1 Q2 Q2' Q2'_def carrier_matD index_mat_four_block
           plus_1_eq_Suc index_mult_mat index_one_mat index_zero_mat numeral_2_eq_2 carrier_matI)
    have H_P2_P1_A_Q1'_Q2': "H = P2 * P1 * A * Q1' * Q2'"
    proof -
      have aux: "(P2 * D @\<^sub>c P2 * E) = P2 * (D @\<^sub>c E)"
        by (rule append_cols_mult_left[symmetric], insert D E P2 A, auto simp add: D_def E_def)
      have "H = P2 * D * Q2 @\<^sub>c P2 * E" using H_def by auto
      also have "... = (P2 * D @\<^sub>c P2 * E) * Q2'" by (rule append_cols_mult_right_id2[symmetric],
            insert Q2 D Q2'_def, auto simp add: D_def E_def)
      also have "... = (P2 * (D @\<^sub>c E)) * Q2'" using aux by auto
      also have "... = P2 * C * Q2'" unfolding C_D_E by auto
      also have "... = P2 * P1 * A * Q1' * Q2'" unfolding C_P1_A_Q1'
-       by (smt P1 P2 Q1' P2_P1 assoc_mult_mat carrier_mat_triv index_mult_mat(2))
+       by (smt (verit, ccfv_threshold) P1 P2 Q1' assoc_mult_mat carrier_mat_triv mult_carrier_mat)
      finally show ?thesis .
    qed
    have H2_H_Q_div_k: "H2 = H * Q_div_k" unfolding H2_def Q_div_k_def
      by (metis H_P2_P1_A_Q1'_Q2' Q2' addcol_mat carrier_matD(2) dim_col_A_g2 gr_implies_not0 
          mat_carrier times_mat_def zero_order(5))
    hence H2_P2_P1_A_Q1'_Q2'_Q_div_k: "H2 = P2 * P1 * A * Q1' * Q2' * Q_div_k"
      unfolding H_P2_P1_A_Q1'_Q2' by simp
    have H2_as_four_block_mat: "H2 = four_block_mat H2_UL H2_UR H2_DL H2_DR" 
      by (rule split_block[OF split_H2[symmetric], of _ "n-1"], insert H2 A n_ge_2, auto)
    have H2_UL: "H2_UL \<in> carrier_mat 1 1"
      by (rule split_block[OF split_H2[symmetric], of _ "n-1"], insert H2 A n_ge_2, auto)
    have H2_UR: "H2_UR \<in> carrier_mat 1 (dim_col A - 1)"
      by (rule split_block(2)[OF split_H2[symmetric]], insert H2 A n_ge_2, auto)
    have H2_DL: "H2_DL \<in> carrier_mat 1 1"
      by (rule split_block[OF split_H2[symmetric], of _ "n-1"], insert H2 A n_ge_2, auto)
    have H2_DR: "H2_DR \<in> carrier_mat 1 (dim_col A - 1)"
      by (rule split_block[OF split_H2[symmetric]], insert H2 A n_ge_2, auto)
    have H2_UR_00: "H2_UR $$ (0,0) = 0"
    proof -
      have "H2_UR $$ (0,0) = H2 $$ (0,1)"
-       by (smt A H2_H_Q_div_k H2_UL H2_as_four_block_mat H2_def H_P2_P1_A_Q1'_Q2' 
+       by (smt (verit) A H2_H_Q_div_k H2_UL H2_as_four_block_mat H2_def H_P2_P1_A_Q1'_Q2' 
            Num.numeral_nat(7) P2_P1 Q2' add_diff_cancel_left' carrier_matD dim_col_A_g2 index_mat_addcol
            index_mat_four_block index_mult_mat less_trans_Suc plus_1_eq_Suc pos2 semiring_norm(138) 
            zero_less_one_class.zero_less_one)
      also have "... = H $$ (0,1)"
        unfolding H2_def by (rule index_mat_addcol, insert H A n_ge_2, auto) 
      also have "... = (P2 * D * Q2) $$ (0,1)"
-       by (smt C_D_E C_P1_A_Q1' D H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' H_def Q1' 
+       by (smt (verit) C_D_E C_P1_A_Q1' D H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' H_def Q1' 
            Q2 add_lessD1 append_cols_def carrier_matD(1) carrier_matD(2) dim_col_A_g2 
            index_mat_four_block index_mult_mat(2) index_mult_mat(3) lessI numerals(2) plus_1_eq_Suc zero_less_Suc)
      also have "... = 0" using is_SNF_D P2D2Q2 D 
        unfolding is_SNF_def Smith_normal_form_mat_def isDiagonal_mat_def by auto
      finally show "H2_UR $$ (0,0) = 0" .
    qed
    have H2_UR_0j: "H2_UR $$ (0,j) = 0" if j_ge_1: "j > 1" and j: "j<n-1" for j
    proof -
     have col_E_0: "col E (j - 1) = 0\<^sub>v 2"
       by (rule eq_vecI, unfold col_def, insert E E_ij_0 j j_ge_1 n_ge_2, auto) 
         (metis E Suc_diff_Suc Suc_lessD Suc_less_eq Suc_pred carrier_matD index_vec numerals(2), insert E, blast)
     have "H2_UR $$ (0,j) = H2 $$ (0,j+1)"
       by (metis (no_types, lifting) A H2_P2_P1_A_Q1'_Q2'_Q_div_k H2_UL H2_as_four_block_mat H2_def 
           H_P2_P1_A_Q1'_Q2' P2_P1 Q2' add_diff_cancel_right' carrier_matD index_mat_addcol(5) 
           index_mat_four_block index_mult_mat(2,3) less_diff_conv less_numeral_extra(1) not_add_less2 pos2 j)
     also have "... = H $$ (0,j+1)" unfolding H2_def
       by (metis A H2_P2_P1_A_Q1'_Q2'_Q_div_k H2_def H_P2_P1_A_Q1'_Q2' One_nat_def P2_P1 Q_div_k_def 
           add_right_cancel carrier_matD(1) carrier_matD(2) index_mat_addcol(3) index_mat_addcol(5) 
           index_mat_addrow_mat(3) index_mult_mat(2) index_mult_mat(3) less_diff_conv less_not_refl2 
           numerals(2) plus_1_eq_Suc pos2 j j_ge_1)
     also have "... = (if j+1 < dim_col (P2 * D * Q2) 
       then (P2 * D * Q2) $$ (0, j+1) else (P2*E) $$ (0, (j+1) - 2))"
       by (unfold H_def, rule append_cols_nth, insert E P2 A Q2 D j, auto simp add: E_def)
     also have "... = (P2*E) $$ (0, j - 1)" 
       by (metis (no_types, lifting) D One_nat_def Q2 add_Suc_right add_lessD1 arithmetic_simps(50) 
           carrier_matD(2) diff_Suc_Suc index_mult_mat(3) not_less_eq numeral_2_eq_2 j_ge_1)
     also have "... = Matrix.row P2 0 \<bullet> col E (j - 1)" 
       by (rule index_mult_mat, insert P2 j_ge_1 A j, auto simp add: E_def)
     also have "... = 0" unfolding col_E_0 by (simp add: scalar_prod_def)
     finally show ?thesis .
   qed
   have H00_dvd_D01: "H$$(0,0) dvd D$$(0,1)"
   proof -
     have "H$$(0,0) = (P2*D*Q2) $$ (0,0)" unfolding H_def using append_cols_nth D E
-      by (smt A C_D_E C_P1_A_Q1' D H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' 
+      by (smt (verit, ccfv_SIG) A C_D_E C_P1_A_Q1' D H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' 
           One_nat_def P1 Q1' Q2 Suc_lessD append_cols_def carrier_matD dim_col_A_g2 
           index_mat_four_block index_mult_mat numerals(2) plus_1_eq_Suc zero_less_Suc)
     also have "... dvd D$$(0,1)" by (rule S00_dvd_all_A[OF D _ _ inv_P2 inv_Q2],
           insert is_SNF_D P2D2Q2 P2 Q2 D, unfold is_SNF_def, auto)
     finally show ?thesis .    
   qed
   have D01_dvd_H02: "D$$(0,1) dvd H$$(0,2)" and D01_dvd_H12: "D$$(0,1) dvd H$$(1,2)"
   proof -
     have "D$$(0,1) = C$$(0,1)" unfolding C_D_E
-      by (smt A C_D_E C_P1_A_Q1' D One_nat_def P1 Q1' append_cols_def carrier_matD(1) carrier_matD(2) 
+      by (smt (verit) A C_D_E C_P1_A_Q1' D One_nat_def P1 Q1' append_cols_def carrier_matD(1) carrier_matD(2) 
           dim_col_A_g2 index_mat_four_block(1) index_mat_four_block(2) index_mat_four_block(3) 
           index_mult_mat(2) index_mult_mat(3) lessI less_trans_Suc numerals(2) pos2)
       also have "... = (P1*A2*Q1) $$ (0,0)" using C_def
-        by (smt "1"(2) A1 A_A1_A2 P1 Q1 add_diff_cancel_left' append_cols_def card_num_simps(30) 
+        by (smt (verit) "1"(2) A1 A_A1_A2 P1 Q1 add_diff_cancel_left' append_cols_def card_num_simps(30) 
             carrier_matD dim_col_A_g2 index_mat_four_block index_mult_mat less_numeral_extra(4) 
             less_trans_Suc plus_1_eq_Suc pos2)
       also have "... dvd (P1*A2*Q1) $$ (1,1)"
-        by (smt "1"(2) A2 One_nat_def P1 Q1 S00_dvd_all_A SNF_P1A2Q1 carrier_matD(1) carrier_matD(2) dim_col_A_g2 
+        by (smt (verit) "1"(2) A2 One_nat_def P1 Q1 S00_dvd_all_A SNF_P1A2Q1 carrier_matD(1) carrier_matD(2) dim_col_A_g2 
             dvd_elements_mult_matrix_left_right inv_P1 inv_Q1 lessI less_diff_conv numeral_2_eq_2 plus_1_eq_Suc)
       also have "... = C $$ (1,2)" unfolding C_def
-        by (smt "1"(2) A1 A_A1_A2 One_nat_def P1 Q1 append_cols_def carrier_matD(1) carrier_matD(2) diff_Suc_1 
+        by (smt (verit) "1"(2) A1 A_A1_A2 One_nat_def P1 Q1 append_cols_def carrier_matD(1) carrier_matD(2) diff_Suc_1 
             dim_col_A_g2 index_mat_four_block index_mult_mat lessI not_numeral_less_one numeral_2_eq_2)
       also have "... = E $$ (1,0)" unfolding C_D_E
-        by (smt "1"(3) A C_D_E C_P1_A_Q1' D One_nat_def append_cols_def carrier_matD less_irrefl_nat
+        by (smt (verit) "1"(3) A C_D_E C_P1_A_Q1' D One_nat_def append_cols_def carrier_matD less_irrefl_nat
             P1 Q1' diff_Suc_1 diff_Suc_Suc index_mat_four_block index_mult_mat lessI  numerals(2))
       finally have *: "D$$(0,1) dvd E $$(1,0)" by auto
       also have "... dvd (P2*E)$$ (0,0)" 
-        by (smt "1"(3) A E E_ij_0 P2 carrier_matD(1) carrier_matD(2) dvd_0_right 
+        by (smt (verit) "1"(3) A E E_ij_0 P2 carrier_matD(1) carrier_matD(2) dvd_0_right 
             dvd_elements_mult_matrix_left dvd_refl pos2 zero_less_diff) 
       also have "... = H$$(0,2)" unfolding H_def
-        by (smt "1"(3) A C_D_E C_P1_A_Q1' D Groups.add_ac(1) H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat 
+        by (smt (verit) "1"(3) A C_D_E C_P1_A_Q1' D Groups.add_ac(1) H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat 
             H_P2_P1_A_Q1'_Q2' One_nat_def P1 Q1' Q2 add_diff_cancel_left' append_cols_def carrier_matD
              index_mat_four_block index_mult_mat less_irrefl_nat numerals(2) plus_1_eq_Suc pos2)
       finally show "D $$ (0, 1) dvd H $$ (0, 2)" .
       have "E $$(1,0) dvd (P2*E)$$ (1,0)"
-        by (smt "1"(3) A E E_ij_0 P2 carrier_matD(1) carrier_matD(2) dvd_0_right 
+        by (smt (verit) "1"(3) A E E_ij_0 P2 carrier_matD(1) carrier_matD(2) dvd_0_right 
             dvd_elements_mult_matrix_left dvd_refl rel_simps(49) semiring_norm(76) zero_less_diff)
       also have "... = H $$(1,2)" unfolding H_def
-        by (smt A C_D_E C_P1_A_Q1' D H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' 
+        by (smt (verit) A C_D_E C_P1_A_Q1' D H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' 
             One_nat_def P1 Q1' Q2 add_diff_cancel_left' append_cols_def carrier_matD diff_Suc_eq_diff_pred 
             index_mat_four_block index_mult_mat lessI less_irrefl_nat n_ge_2 numerals(2) plus_1_eq_Suc)
       finally show "D$$(0,1) dvd H$$(1,2)" using * by auto
     qed
     have kH00_eq_H02: "k * H $$ (0, 0) = H $$ (0, 2)" 
       using id D01_dvd_H02 H00_dvd_D01 unfolding k_def is_div_op_def by auto
     have H2_UR_01: "H2_UR $$ (0,1) = 0"
     proof -
       have "H2_UR $$ (0,1) = H2 $$ (0,2)"
         by (metis (no_types, lifting) A H2_P2_P1_A_Q1'_Q2'_Q_div_k H2_UL H2_as_four_block_mat One_nat_def 
             P2_P1 Q_div_k_def carrier_matD diff_Suc_1 dim_col_A_g2 index_mat_addrow_mat(3) 
             index_mat_four_block index_mult_mat(2,3) numeral_2_eq_2 pos2 rel_simps(50) rel_simps(68))
       also have "... = (-k) * H $$ (0, 0) + H $$ (0, 2)" 
         by (unfold H2_def, rule index_mat_addcol[of _ ], insert H A n_ge_2, auto)
       also have "... = 0" using kH00_eq_H02 by auto
       finally show ?thesis .
     qed   
    have H2_UR_0: "H2_UR = (0\<^sub>m 1 (n - 1))"
      by (rule eq_matI, insert H2_UR_0j H2_UR_01 H2_UR_00 H2_UR A nat_neq_iff, auto)
    have H2_UL_H: "H2_UL $$ (0,0) = H $$ (0,0)"
    proof -
      have "H2_UL $$ (0,0) = H2 $$ (0,0)"
        by (metis (no_types, lifting) Pair_inject index_mat(1) split_H2 split_block_def 
            zero_less_one_class.zero_less_one)
      also have "... = H $$ (0,0)" 
        unfolding H2_def by (rule index_mat_addcol, insert H A n_ge_2, auto) 
      finally show ?thesis .
    qed
    have H2_DL_H_10: "H2_DL $$ (0,0) = H$$(1,0)"
    proof -
      have "H2_DL $$ (0,0) = H2 $$ (1,0)"
-       by (smt H2_DL One_nat_def Pair_inject add.right_neutral add_Suc_right carrier_matD(1) 
+       by (smt (verit, ccfv_threshold) H2_DL One_nat_def Pair_inject add.right_neutral add_Suc_right carrier_matD(1) 
            dim_row_mat(1) index_mat(1) rel_simps(68) split_H2 split_block_def split_conv)
      also have "... = H$$(1,0)" unfolding H2_def by (rule index_mat_addcol, insert H A n_ge_2, auto) 
      finally show ?thesis .
    qed
    have H_10: "H $$(1,0) = 0"
    proof -
      have "H $$(1,0) = (P2 * D * Q2) $$ (1,0)" unfolding H_def
-       by (smt A C_D_E C_P1_A_Q1' D E One_nat_def P1 P2_P1 Q2 Q2' Q2'_def Suc_lessD append_cols_def 
+       by (smt (verit) A C_D_E C_P1_A_Q1' D E One_nat_def P1 P2_P1 Q2 Q2' Q2'_def Suc_lessD append_cols_def 
            carrier_matD dim_col_A_g2 index_mat_four_block index_mult_mat index_one_mat 
            index_zero_mat lessI numerals(2))
      also have "... = 0" using is_SNF_D P2D2Q2 D 
        unfolding is_SNF_def Smith_normal_form_mat_def isDiagonal_mat_def by auto
      finally show ?thesis .
    qed
    have S_H2_Q3': "S = H2 * Q3'" 
      and S_as_four_block_mat: "S = four_block_mat (H2_UL) (0\<^sub>m 1 (n - 1)) (H2_DL) (H2_DR * Q3)"
    proof -
      have "H2 * Q3' = four_block_mat (H2_UL * 1\<^sub>m 1 + H2_UR * 0\<^sub>m (dim_col A - 1) 1) 
      (H2_UL * 0\<^sub>m 1 (dim_col A - 1) + H2_UR * Q3)
      (H2_DL * 1\<^sub>m 1 + H2_DR * 0\<^sub>m (dim_col A - 1) 1) (H2_DL * 0\<^sub>m 1 (dim_col A - 1) + H2_DR * Q3)"
        unfolding H2_as_four_block_mat Q3'_def 
        by (rule mult_four_block_mat[OF H2_UL H2_UR H2_DL H2_DR], insert Q3 A H', auto)
      also have "... = four_block_mat (H2_UL) (0\<^sub>m 1 (n - 1)) (H2_DL) (H2_DR * Q3)"
        by (rule cong_four_block_mat, insert H2_UR_0 H2_UL H2_UR H2_DL H2_DR Q3, auto)
      also have *: "... = S" unfolding S_def 
      proof (rule cong_four_block_mat)
        show "H2_UL = Matrix.mat 1 1 (\<lambda>(a, b). H $$ (0, 0))" 
          by (rule eq_matI, insert H2_UL H2_UL_H, auto)
        show "H2_DR * Q3 = H_1xn" using is_SNF_H' unfolding is_SNF_def by auto
        show "0\<^sub>m 1 (n - 1) = 0\<^sub>m 1 (dim_col A - 1)" using A by auto
        show "H2_DL = 0\<^sub>m 1 1" using H2_DL H2_DL_H_10 H_10 by auto
      qed
      finally show "S = H2 * Q3'" 
        and "S = four_block_mat (H2_UL) (0\<^sub>m 1 (n - 1)) (H2_DL) (H2_DR * Q3)"
        using * by auto
    qed
    thus "S = P2 * P1 * A * (Q1' * Q2' * Q_div_k * Q3')" unfolding H2_P2_P1_A_Q1'_Q2'_Q_div_k     
-     by (smt Q1' Q2' Q2'_def Q3' Q3'_def Q_div_k assoc_mult_mat 
+     by (smt (verit, ccfv_threshold) Q1' Q2' Q2'_def Q3' Q3'_def Q_div_k assoc_mult_mat 
          carrier_matD carrier_mat_triv index_mult_mat)
    show "Smith_normal_form_mat S"
    proof (rule Smith_normal_form_mat_intro)
      have Sij_0: "S$$(i,j) = 0" if ij: "i \<noteq> j" and i: "i < dim_row S" and j: "j < dim_col S" for i j
      proof (cases "i=1 \<and> j=0")
        case True
        have "S$$(1,0) = 0" using S_as_four_block_mat
          by (metis (no_types, lifting) H2_DL_H_10 H2_UL H_10 One_nat_def True carrier_matD diff_Suc_1 
              index_mat_four_block rel_simps(71) that(2) that(3) zero_less_one_class.zero_less_one)
        then show ?thesis using True by auto
       next
         case False note not_10 = False
         show ?thesis
         proof (cases "i=0")
           case True
           hence j0: "j>0" using ij by auto
           then show ?thesis using S_as_four_block_mat
-            by (smt "1"(2) H2_DR H2_H_Q_div_k H2_UL H_P2_P1_A_Q1'_Q2' Num.numeral_nat(7) P2_P1 Q3 S_H2_Q3'
+            by (smt (verit) "1"(2) H2_DR H2_H_Q_div_k H2_UL H_P2_P1_A_Q1'_Q2' Num.numeral_nat(7) P2_P1 Q3 S_H2_Q3'
                 Suc_pred True carrier_matD index_mat_four_block index_mult_mat index_zero_mat(1)
                 not_less_eq plus_1_eq_Suc pos2 that(3) zero_less_one_class.zero_less_one)
         next
           case False
           have SNF_H_1xn: "Smith_normal_form_mat H_1xn" using is_SNF_H' unfolding is_SNF_def by auto 
           have i1: "i=1" using False ij i H2_DR H2_UL S_as_four_block_mat by auto
           hence j1: "j>1" using ij not_10 by auto thm is_SNF_H'
           have "S$$(i,j) = (if i < dim_row H2_UL then if j < dim_col H2_UL then H2_UL $$ (i, j) 
             else (0\<^sub>m 1 (n - 1)) $$ (i, j - dim_col H2_UL)
             else if j < dim_col H2_UL then H2_DL $$ (i - dim_row H2_UL, j) 
             else (H2_DR * Q3) $$ (i - dim_row H2_UL, j - dim_col H2_UL))"
             unfolding S_as_four_block_mat 
             by (rule index_mat_four_block, insert i j H2_UL H2_DR Q3 S_H2_Q3' H2 Q3' A, auto)
           also have "... = (H2_DR * Q3) $$ (0, j - 1)" using H2_UL i1 not_10 by auto
           also have "... = H_1xn $$ (0,j-1)"
             using S_def calculation i1 j not_10 i by auto           
           also have "... = 0" using SNF_H_1xn j1 i j
             unfolding Smith_normal_form_mat_def isDiagonal_mat_def
             by (simp add: S_def i1)
           finally show ?thesis .
         qed
       qed
       thus "isDiagonal_mat S" unfolding isDiagonal_mat_def by auto
       have "S$$(0,0) dvd S$$(1,1)"
       proof -       
         have dvd_all: "\<forall>i j. i < 2 \<and> j < n \<longrightarrow> H2_UL$$(0,0) dvd (H2 * Q3') $$ (i, j)"
         proof (rule dvd_elements_mult_matrix_right)
           show H2': "H2 \<in> carrier_mat 2 n" using H2 A by auto
           show "Q3' \<in> carrier_mat n n" using Q3' A by auto
           have "H2_UL $$ (0, 0) dvd H2 $$ (i, j)" if i: "i < 2" and j: "j < n"  for i j
           proof (cases "i=0")
             case True
             then show ?thesis
               by (metis (no_types, lifting) A H2_H_Q_div_k H2_UL H2_UR_0 H2_as_four_block_mat 
                   H_P2_P1_A_Q1'_Q2' P2_P1 Q3 Q_div_k S_as_four_block_mat Sij_0 carrier_matD 
                   dvd_0_right dvd_refl index_mat_four_block index_mult_mat(2,3) j less_one pos2)
           next
             case False
             hence i1: "i=1" using i by auto
             have H2_10_0: "H2 $$ (1,0) = 0"
               by (metis (no_types, lifting) H2_H_Q_div_k H2_def H_10 H_P2_P1_A_Q1'_Q2' One_nat_def 
                   Q2' H2' basic_trans_rules(19) carrier_matD dim_col_A_g2 index_mat_addcol(3)
                   index_mult_mat(2,3) lessI numeral_2_eq_2 rel_simps(76))            
             moreover have H2_UL00_dvd_H211:"H2_UL $$ (0, 0) dvd H2 $$ (1, 1)"
             proof - 
               have "H2_UL $$ (0, 0) = H $$ (0, 0)" by (simp add: H2_UL_H)
               also have "... = (P2*D*Q2) $$ (0,0)" unfolding H_def using append_cols_nth D E
-                by (smt A C_D_E C_P1_A_Q1' D H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat 
+                by (smt (verit, ccfv_threshold) A C_D_E C_P1_A_Q1' D H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat 
                     H_P2_P1_A_Q1'_Q2' One_nat_def P1 Q1' Q2 Suc_lessD append_cols_def carrier_matD 
                     dim_col_A_g2 index_mat_four_block index_mult_mat numerals(2) plus_1_eq_Suc zero_less_Suc)
               also have "... dvd (P2*D*Q2) $$ (1,1)" 
                 using is_SNF_D P2D2Q2 unfolding is_SNF_def Smith_normal_form_mat_def by auto 
                 (metis D Q2 carrier_matD index_mult_mat(1) index_mult_mat(2) lessI numerals(2) pos2)
               also have "... = H $$ (1,1)" unfolding H_def using append_cols_nth D E
-                by (smt A C_D_E C_P1_A_Q1' H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' 
+                by (smt (verit, ccfv_threshold) A C_D_E C_P1_A_Q1' H2_DR H2_H_Q_div_k H2_UL H2_as_four_block_mat H_P2_P1_A_Q1'_Q2' 
                     One_nat_def P1 Q1' Q2 append_cols_def carrier_matD(1) carrier_matD(2) dim_col_A_g2 
                     index_mat_four_block index_mult_mat(2) index_mult_mat(3) lessI less_trans_Suc 
                     numerals(2) plus_1_eq_Suc pos2)
               also have "... = H2 $$ (1, 1)" 
                 by (metis A H2_def H_P2_P1_A_Q1'_Q2' One_nat_def P2_P1 Q2' carrier_matD dim_col_A_g2 i i1 
                     index_mat_addcol(3) index_mult_mat(2) index_mult_mat(3) less_trans_Suc nat_neq_iff pos2)
               finally show ?thesis .
             qed
             moreover have H2_UL00_dvd_H212: "H2_UL $$ (0, 0) dvd H2 $$ (1, 2)"
             proof -            
               have "H2_UL $$ (0, 0) = H $$ (0, 0)" by (simp add: H2_UL_H)
               also have "... dvd H $$ (1,2)" using D01_dvd_H12 H00_dvd_D01 dvd_trans by blast
               also have "... = (-k) * H $$ (1,0) + H $$ (1,2)"
                 using H_10 by auto
               also have "... = H2 $$ (1,2)" 
                 unfolding H2_def by (rule index_mat_addcol[symmetric], insert H A n_ge_2, auto)
               finally show ?thesis .
             qed
             moreover have "H2 $$ (1, j) = 0" if j1: "j>2" and j: "j<n"
             proof -
               let ?f = "(\<lambda>(i, j). \<Sum>ia = 0..<dim_vec (col E j). Matrix.row P2 i $v ia * col E j $v ia)"
               have "H2 $$ (1, j) = H $$ (1,j)" unfolding H2_def using j j1 n_ge_2 
                 by (metis (mono_tags, lifting) "1"(2) H2' H_10 H_P2_P1_A_Q1'_Q2' Q2' arithmetic_simps(49) 
                     carrier_matD i i1 index_mat_addcol(1) index_mult_mat semiring_norm(64) H2_H_Q_div_k)
               also have "... = (P2*E)$$ (1,j-2)" unfolding H_def
                 by (smt A C_D_E C_P1_A_Q1' D H2' H2_H_Q_div_k H_P2_P1_A_Q1'_Q2' P1 Q1' Q2 append_cols_def 
                     basic_trans_rules(19) carrier_matD index_mat_four_block index_mult_mat(2) 
                     index_mult_mat(3) j less_one nat_neq_iff not_less_less_Suc_eq numerals(2) j1)
               also have "... =  Matrix.mat (dim_row P2) (dim_col E) ?f $$ (1, j - 2)"
                 unfolding times_mat_def scalar_prod_def by simp 
               also have "... = ?f (1,j-2)" by (rule index_mat, insert P2 E E_def n_ge_2 j j1 A, auto)              
               also have "... = (\<Sum>ia = 0..<2. Matrix.row P2 1 $v ia * col E (j-2) $v ia)" 
                 using E A E_def j j1 by auto
               also have "... = (\<Sum>ia \<in> {0,1}. Matrix.row P2 1 $v ia * col E (j-2) $v ia)" 
                 by (rule sum.cong, auto)
               also have "... = Matrix.row P2 1 $v 0 * col E (j - 2) $v 0 
                     + Matrix.row P2 1 $v 1 * col E (j - 2) $v 1" 
                 by (simp add: sum_two_elements[OF zero_neq_one])
               also have "... = 0" using E_ij_0 E_def E A
-                by (auto, smt D Q2 Q2' Q2'_def Suc_lessD add_cancel_right_right add_diff_inverse_nat 
+                by (auto, smt (verit) D Q2 Q2' Q2'_def Suc_lessD add_cancel_right_right add_diff_inverse_nat 
                     arith_extra_simps(19) carrier_matD i i1 index_col index_mat_four_block(3) 
                     index_one_mat(3) less_2_cases nat_add_left_cancel_less numeral_2_eq_2 
                     semiring_norm(138) semiring_norm(160) j j1 zero_less_diff)                
               finally show ?thesis .
             qed
             ultimately show ?thesis using i1 False
               by (metis One_nat_def dvd_0_right less_2_cases nat_neq_iff j)
           qed                      
           thus "\<forall>i j. i < 2 \<and> j < n \<longrightarrow> H2_UL $$ (0, 0) dvd H2 $$ (i, j)" by auto
         qed
         have "S$$(0,0) = H2_UL $$ (0,0)" using H2_UL S_as_four_block_mat by auto
         also have "... dvd (H2*Q3') $$ (1,1)" using dvd_all n_ge_2 by auto
         also have "... = S $$ (1,1)" using S_H2_Q3' by auto
         finally show ?thesis .       
       qed
       thus "\<forall>a. a + 1 < min (dim_row S) (dim_col S) \<longrightarrow> S $$ (a, a) dvd S $$ (a + 1, a + 1)"
         by (metis "1"(2) H2_H_Q_div_k H_P2_P1_A_Q1'_Q2' One_nat_def P2_P1 S_H2_Q3' Suc_eq_plus1
             index_mult_mat(2) less_Suc_eq less_one min_less_iff_conj numeral_2_eq_2 carrier_matD(1))
     qed
   qed
 qed
 
 
 lemma is_SNF_Smith_2xn: 
   assumes A: "A \<in> carrier_mat 2 n"
   shows "is_SNF A (Smith_2xn A)"
 proof (cases "n>2")
   case True
   then show ?thesis using is_SNF_Smith_2xn_n_ge_2[OF A] by simp
 next
   case False
   hence "n=0 \<or> n=1 \<or> n=2" by auto
   then show ?thesis using Smith_2xn_0 Smith_2xn_1 Smith_2xn_2 A by blast
 qed
 
 subsubsection \<open>Case $n \times 2$\<close>
 
 definition "Smith_nx2 A = (let (P,S,Q) = Smith_2xn A\<^sup>T in
    (Q\<^sup>T, S\<^sup>T, P\<^sup>T))"
 
 lemma is_SNF_Smith_nx2: 
   assumes A: "A \<in> carrier_mat n 2"
   shows "is_SNF A (Smith_nx2 A)"
 proof -
   obtain P S Q where PSQ: "(P,S,Q) = Smith_2xn A\<^sup>T" by (metis prod_cases3)
   hence rw: "Smith_nx2 A = (Q\<^sup>T, S\<^sup>T, P\<^sup>T)" unfolding Smith_nx2_def by (metis split_conv)
   have "is_SNF A\<^sup>T (Smith_2xn A\<^sup>T)" by (rule is_SNF_Smith_2xn, insert id A, auto)
   hence is_SNF_PSQ: "is_SNF A\<^sup>T (P,S,Q)" using PSQ by auto
   show ?thesis
   proof (unfold rw, rule is_SNF_intro)
     show Qt: "Q\<^sup>T \<in> carrier_mat (dim_row A) (dim_row A)"
       and Pt: "P\<^sup>T \<in> carrier_mat (dim_col A) (dim_col A)"
       and "invertible_mat Q\<^sup>T" and "invertible_mat P\<^sup>T"
       using is_SNF_PSQ invertible_mat_transpose unfolding is_SNF_def by auto
     have "Smith_normal_form_mat S" and PATQ: "S =  P * A\<^sup>T * Q"
       using is_SNF_PSQ invertible_mat_transpose unfolding is_SNF_def by auto
     thus "Smith_normal_form_mat S\<^sup>T" unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
     show "S\<^sup>T = Q\<^sup>T * A * P\<^sup>T" using PATQ
-      by (smt Matrix.transpose_mult Matrix.transpose_transpose Pt Qt assoc_mult_mat
+      by (smt (verit, ccfv_threshold) Matrix.transpose_mult Matrix.transpose_transpose Pt Qt assoc_mult_mat
           carrier_mat_triv index_mult_mat(2))
   qed
 qed
 
 subsubsection \<open>Case $m \times n$\<close>
 
 (*This is necessary to avoid a loop with domintros*)
 declare Smith_2xn.simps[simp del]
 
 function (domintros) Smith_mxn :: "'a mat \<Rightarrow> ('a mat \<times> 'a mat \<times> 'a mat)"
   where
     "Smith_mxn A = (
   if dim_row A = 0 \<or> dim_col A = 0 then (1\<^sub>m (dim_row A),A,1\<^sub>m (dim_col A))
   else if dim_row A = 1 then (1\<^sub>m 1, Smith_1xn A) 
   else if dim_row A = 2 then Smith_2xn A
   else if dim_col A = 1 then let (P,S) = Smith_nx1 A in (P,S,1\<^sub>m 1)
   else if dim_col A = 2 then Smith_nx2 A
   else
   let A1 = mat_of_row (Matrix.row A 0);
       A2 = mat_of_rows (dim_col A) [Matrix.row A i. i \<leftarrow> [1..<dim_row A]];
       (P1,D1,Q1) = Smith_mxn A2;
       C = (A1*Q1) @\<^sub>r (P1*A2*Q1);
       D = mat_of_rows (dim_col A) [Matrix.row C 0, Matrix.row C 1];
       E = mat_of_rows (dim_col A) [Matrix.row C i. i \<leftarrow> [2..<dim_row A]];
       (P2,F,Q2) = Smith_2xn D;
       H = (P2*D*Q2) @\<^sub>r (E*Q2);
       (P_H2, H2) = reduce_column div_op H;
       (H2_UL, H2_UR, H2_DL, H2_DR) = split_block H2 1 1;
       (P3,S',Q3) = Smith_mxn H2_DR;
       S = four_block_mat (Matrix.mat 1 1 (\<lambda>(a, b). H $$ (0, 0))) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_row A - 1) 1) S';
       P1' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_row A - 1)) (0\<^sub>m (dim_row A - 1) 1) P1;
       P2' = four_block_mat P2 (0\<^sub>m 2 (dim_row A - 2)) (0\<^sub>m (dim_row A - 2) 2) (1\<^sub>m (dim_row A - 2));
       P3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_row A - 1)) (0\<^sub>m (dim_row A - 1) 1) P3;
       Q3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q3
   in (P3' * P_H2 * P2' * P1',S, Q1 * Q2 * Q3')
 )"
   by pat_completeness fast
 (*Termination is guaranteed since the algorithm is recursively applied to a 
   submatrix with less rows*)
 
 
 (*Now I introduce it again*)
 declare Smith_2xn.simps[simp]
 
 lemma Smith_mxn_dom_nm_less_2: 
   assumes A: "A \<in> carrier_mat m n" and mn: "n\<le>2 \<or> m\<le>2"
   shows "Smith_mxn_dom A"
   by (rule Smith_mxn.domintros, insert assms, auto) (*Takes a while*)
 
 lemma Smith_mxn_pinduct_carrier_less_2: 
   assumes A: "A \<in> carrier_mat m n" and mn: "n\<le>2 \<or> m\<le>2"
   shows "fst (Smith_mxn A) \<in> carrier_mat m m 
   \<and> fst (snd (Smith_mxn A)) \<in> carrier_mat m n
   \<and> snd (snd (Smith_mxn A)) \<in> carrier_mat n n"
 proof -
   have A_dom: "Smith_mxn_dom A" using Smith_mxn_dom_nm_less_2[OF assms] by simp
   show ?thesis
 proof (cases "dim_row A = 0 \<or> dim_col A = 0")
   case True
   have "Smith_mxn A = (1\<^sub>m (dim_row A),A,1\<^sub>m (dim_col A))"
     using Smith_mxn.psimps[OF A_dom] True by auto
   thus ?thesis using A by auto        
 next
   case False note 1 = False
   show ?thesis
   proof (cases "dim_row A = 1")
     case True
     have "Smith_mxn A = (1\<^sub>m 1, Smith_1xn A)"
       using Smith_mxn.psimps[OF A_dom] True 1 by auto
     then show ?thesis using Smith_1xn_works unfolding is_SNF_def
-      by (smt Smith_1xn_aux_Q_carrier Smith_1xn_aux_S'_AQ' Smith_1xn_def True assms(1) carrier_matD 
+      by (smt (verit) Smith_1xn_aux_Q_carrier Smith_1xn_aux_S'_AQ' Smith_1xn_def True assms(1) carrier_matD 
           carrier_matI diff_less fst_conv index_mult_mat not_gr0 one_carrier_mat prod.collapse 
           right_mult_one_mat' snd_conv zero_less_one_class.zero_less_one)
   next
     case False note 2 = False
     then show ?thesis 
     proof (cases "dim_row A = 2")
       case True
       hence A': "A \<in> carrier_mat 2 n" using A by auto
       have "Smith_mxn A = Smith_2xn A" using Smith_mxn.psimps[OF A_dom] True 1 2 by auto
       then show ?thesis using is_SNF_Smith_2xn[OF A'] A unfolding is_SNF_def
         by (metis (mono_tags, lifting) carrier_matD carrier_mat_triv case_prod_beta index_mult_mat(2,3))
     next
       case False note 3 = False
       show ?thesis 
       proof (cases "dim_col A = 1")
         case True
         hence A': "A \<in> carrier_mat m 1" using A by auto
         have "Smith_mxn A = (let (P,S) = Smith_nx1 A in (P,S,1\<^sub>m 1))" 
           using Smith_mxn.psimps[OF A_dom] True 1 2 3 by auto
         then show ?thesis using Smith_nx1_works[OF A'] A unfolding is_SNF_def
           by (metis (mono_tags, lifting) carrier_matD carrier_mat_triv case_prod_unfold 
               index_mult_mat(2,3) surjective_pairing)
       next
         case False
         hence "dim_col A = 2" using 1 2 3 mn A by auto
         hence A': "A \<in> carrier_mat m 2" using A by auto
         hence "Smith_mxn A = Smith_nx2 A" 
           using Smith_mxn.psimps[OF A_dom] 1 2 3 False by auto
         then show ?thesis using is_SNF_Smith_nx2[OF A'] A unfolding is_SNF_def by force
       qed
     qed  
   qed
 qed
 qed
 
 lemma Smith_mxn_pinduct_carrier_ge_2: "\<lbrakk>Smith_mxn_dom A; A \<in> carrier_mat m n; m>2; n>2\<rbrakk> \<Longrightarrow> 
     fst (Smith_mxn A) \<in> carrier_mat m m 
   \<and> fst (snd (Smith_mxn A)) \<in> carrier_mat m n
   \<and> snd (snd (Smith_mxn A)) \<in> carrier_mat n n"
 proof (induct arbitrary: m n rule: Smith_mxn.pinduct)
   case (1 A)
   note A_dom = 1(1)
   note A = "1.prems"(1)
   note m = "1.prems"(2)
   note n = "1.prems"(3)  
   define A1 where "A1 = mat_of_row (Matrix.row A 0)"
   define A2 where "A2 = mat_of_rows (dim_col A) [Matrix.row A i. i \<leftarrow> [1..<dim_row A]]"
   obtain P1 D1 Q1 where P1D1Q1: "(P1,D1,Q1) = Smith_mxn A2" by (metis prod_cases3)
   define C where "C = (A1*Q1) @\<^sub>r (P1*A2*Q1)"
   define D where "D = mat_of_rows (dim_col A) [Matrix.row C 0, Matrix.row C 1]"
   define E where "E = mat_of_rows (dim_col A) [Matrix.row C i. i \<leftarrow> [2..<dim_row A]]"
   obtain P2 F Q2 where P2FQ2: "(P2,F,Q2) = Smith_2xn D" by (metis prod_cases3)
   define H where "H = (P2*D*Q2) @\<^sub>r (E*Q2)"
   obtain P_H2 H2 where P_H2H2: "(P_H2, H2) = reduce_column div_op H" by (metis surj_pair)
   obtain H2_UL H2_UR H2_DL H2_DR where split_H2: "(H2_UL, H2_UR, H2_DL, H2_DR) = split_block H2 1 1"
     by (metis split_block_def)
   obtain P3 S' Q3 where P3S'Q3: "(P3,S',Q3) = Smith_mxn H2_DR" by (metis prod_cases3)
   define S where "S = four_block_mat (Matrix.mat 1 1 (\<lambda>(a, b). H $$ (0, 0))) (0\<^sub>m 1 (dim_col A - 1))
     (0\<^sub>m (dim_row A - 1) 1) S'"
   define P1' where "P1' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_row A - 1)) (0\<^sub>m (dim_row A - 1) 1) P1"
   define P2' where "P2' = four_block_mat P2 (0\<^sub>m 2 (dim_row A - 2)) (0\<^sub>m (dim_row A - 2) 2) (1\<^sub>m (dim_row A - 2))"
   define P3' where "P3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_row A - 1)) (0\<^sub>m (dim_row A - 1) 1) P3"
   define Q3' where "Q3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q3"
   have A1: "A1 \<in> carrier_mat 1 n" unfolding A1_def using A by auto
   have A2: "A2 \<in> carrier_mat (m-1) n" unfolding A2_def using A by auto
   have "fst (Smith_mxn A2) \<in> carrier_mat (m-1) (m-1)
   \<and> fst (snd (Smith_mxn A2)) \<in> carrier_mat (m-1) n
   \<and> snd (snd (Smith_mxn A2)) \<in> carrier_mat n n"
   proof (cases "2 < m - 1")
     case True
     show ?thesis by (rule "1.hyps"(2), insert A m n A2_def A1_def True id, auto)    
   next
     case False
     hence "m=3" using m by auto
     hence A2': "A2 \<in> carrier_mat 2 n" using A2 by auto
-    have A2_dom: "Smith_mxn_dom A2" by (rule Smith_mxn.domintros, insert A2', auto)    
+    have A2_dom: "Smith_mxn_dom A2" using A2' Smith_mxn_dom_nm_less_2 by force
     have "dim_row A2 = 2" using A2 A2' by fast
     hence "Smith_mxn A2 = Smith_2xn A2" 
       using n unfolding Smith_mxn.psimps[OF A2_dom] by auto
     then show ?thesis using is_SNF_Smith_2xn[OF A2'] m A2 unfolding is_SNF_def split_beta
       by (metis carrier_matD carrier_matI index_mult_mat(2,3))
   qed
   hence P1: "P1 \<in> carrier_mat (m-1) (m-1)" 
     and D1: "D1 \<in> carrier_mat (m-1) n" 
     and Q1: "Q1 \<in> carrier_mat n n" using P1D1Q1 by (metis fst_conv snd_conv)+
   have "C \<in> carrier_mat (1 + (m-1)) n" unfolding C_def 
     by (rule carrier_append_rows, insert P1 D1 Q1 A1, auto)
   hence C: "C \<in> carrier_mat m n" using m by simp
   have D: "D \<in> carrier_mat 2 n" unfolding D_def using C A by auto
   have E: "E \<in> carrier_mat (m-2) n" unfolding E_def using A by auto
   have P2: "P2 \<in> carrier_mat 2 2" and Q2: "Q2 \<in> carrier_mat n n" 
     using is_SNF_Smith_2xn[OF D] P2FQ2 D unfolding is_SNF_def by auto
   have "H \<in> carrier_mat (2 + (m-2)) n" unfolding H_def 
     by (rule carrier_append_rows, insert P2 D Q2 E, auto)
   hence H: "H \<in> carrier_mat m n" using m by auto
   have H2: "H2 \<in> carrier_mat m n" using m H P_H2H2 reduce_column by blast
   have H2_DR: "H2_DR \<in> carrier_mat (m - 1) (n - 1)"
     by (rule split_block(4)[OF split_H2[symmetric]], insert H2 m n, auto)
   have "fst (Smith_mxn H2_DR) \<in> carrier_mat (m-1) (m-1)
   \<and> fst (snd (Smith_mxn H2_DR)) \<in> carrier_mat (m-1) (n-1)
   \<and> snd (snd (Smith_mxn H2_DR)) \<in> carrier_mat (n-1) (n-1)"
   proof (cases "2<m-1 \<and> 2<n-1")
     case True
     show ?thesis
     proof (rule "1.hyps"(3)[OF _ _ _ _ _ A1_def A2_def P1D1Q1 _ _ C_def])
       show "(P2,F,Q2) = Smith_2xn D" using P2FQ2 by auto
     qed (insert A P1D1Q1 D_def E_def P2FQ2 P_H2H2 P3S'Q3 H_def split_H2 H2_DR True id, auto)
   next
     case False note m_eq_3_or_n_eq_3 = False
     show ?thesis 
     proof (cases "(2 < m - 1)")
       case True
       hence n3: "n=3" using m_eq_3_or_n_eq_3 n m by auto
       have H2_DR_dom: "Smith_mxn_dom H2_DR"
         by (rule Smith_mxn.domintros, insert H2_DR n3, auto)
       have H2_DR': "H2_DR \<in> carrier_mat (m-1) 2" using H2_DR n3 by auto
       hence "dim_col H2_DR = 2" by simp
       hence "Smith_mxn H2_DR = Smith_nx2 H2_DR" 
         using n H2_DR' True unfolding Smith_mxn.psimps[OF H2_DR_dom] by auto
       then show ?thesis using is_SNF_Smith_nx2[OF H2_DR'] m H2_DR unfolding is_SNF_def by auto
     next
       case False
       hence m3: "m=3" using m_eq_3_or_n_eq_3 n m by auto
       have H2_DR_dom: "Smith_mxn_dom H2_DR"
-        by (rule Smith_mxn.domintros, insert H2_DR m3, auto)
+        using False H2_DR Smith_mxn_dom_nm_less_2 not_less by blast
       have H2_DR': "H2_DR \<in> carrier_mat 2 (n-1)" using H2_DR m3 by auto
       hence "dim_row H2_DR = 2" by simp
       hence "Smith_mxn H2_DR = Smith_2xn H2_DR" 
         using n H2_DR' unfolding Smith_mxn.psimps[OF H2_DR_dom] by auto
       then show ?thesis using is_SNF_Smith_2xn[OF H2_DR'] m H2_DR unfolding is_SNF_def by force
     qed
   qed
   hence P3: "P3 \<in> carrier_mat (m-1) (m-1)"
   and S': "S'\<in> carrier_mat (m-1) (n-1)"
   and Q3: "Q3 \<in> carrier_mat (n-1) (n-1)" using P3S'Q3 by (metis fst_conv snd_conv)+
   have Smith_final: "Smith_mxn A = (P3' * P_H2 * P2' * P1', S, Q1 * Q2 * Q3')"
   proof -
     have P1_def: "P1 = fst (Smith_mxn A2)" and D1_def: "D1 = fst (snd (Smith_mxn A2))" 
       and Q1_def: "Q1 = snd (snd (Smith_mxn A2))" using P1D1Q1 by (metis fstI sndI)+
     have P2_def: "P2 = fst (Smith_2xn D)" and F_def: "F = fst (snd (Smith_2xn D))" 
       and Q2_def: "Q2 = snd (snd (Smith_2xn D))" using P2FQ2 by (metis fstI sndI)+
     have P_H2_def: "P_H2 = fst (reduce_column div_op H)" 
       and H2_def: "H2 = snd (reduce_column div_op H)" 
       using P_H2H2 by (metis fstI sndI)+
     have H2_UL_def: "H2_UL = fst (split_block H2 1 1)" 
       and H2_UR_def: "H2_UR = fst (snd (split_block H2 1 1))" 
       and H2_DL_def: "H2_DL = fst (snd (snd (split_block H2 1 1)))" 
       and H2_DR_def: "H2_DR = snd (snd (snd (split_block H2 1 1)))"
       using split_H2 by (metis fstI sndI)+
     have P3_def: "P3 = fst (Smith_mxn H2_DR)"
       and S'_def: "S' = fst (snd (Smith_mxn H2_DR))" 
       and Q3_def: "Q3 = (snd (snd (Smith_mxn H2_DR)))" using P3S'Q3 by (metis fstI sndI)+
     note aux = Smith_mxn.psimps[OF A_dom] Let_def split_beta
      A1_def[symmetric] A2_def[symmetric] P1_def[symmetric] D1_def[symmetric] Q1_def[symmetric]
      C_def[symmetric] D_def[symmetric] E_def[symmetric] P2_def[symmetric] Q2_def[symmetric]
      F_def[symmetric] H_def[symmetric] P_H2_def[symmetric] H2_def[symmetric] H2_UL_def[symmetric]
      H2_DL_def[symmetric] H2_UR_def[symmetric] H2_DR_def[symmetric] P3_def[symmetric] S'_def[symmetric]
      Q3_def[symmetric] P1'_def[symmetric] P2'_def[symmetric] P3'_def[symmetric] Q1_def[symmetric]
      Q2_def[symmetric] Q3'_def[symmetric] S_def[symmetric]
     show ?thesis by (rule prod3_intro, unfold aux, insert "1.prems", auto)
   qed
   have P1': "P1' \<in> carrier_mat m m" unfolding P1'_def using P1 m by auto
   moreover have P2': "P2' \<in> carrier_mat m m" unfolding P2'_def using P2 m A by auto
   moreover have P3': "P3' \<in> carrier_mat m m" unfolding P3'_def using P3 m by auto
   moreover have P_H2: "P_H2 \<in> carrier_mat m m" using reduce_column[OF H P_H2H2] m by simp
   moreover have "S \<in> carrier_mat m n" unfolding S_def using H A S'
-    by (auto, smt C One_nat_def Suc_pred \<open>C \<in> carrier_mat (1 + (m - 1)) n\<close> carrier_matD carrier_matI 
+    by (auto, smt (verit) C One_nat_def Suc_pred \<open>C \<in> carrier_mat (1 + (m - 1)) n\<close> carrier_matD carrier_matI 
         dim_col_mat(1) dim_row_mat(1) index_mat_four_block n neq0_conv plus_1_eq_Suc zero_order(3))
   moreover have "Q3' \<in> carrier_mat n n" unfolding Q3'_def using Q3 n by auto
   ultimately show ?case using Smith_final Q1 Q2 by auto
 qed
 
 
 corollary Smith_mxn_pinduct_carrier: "\<lbrakk>Smith_mxn_dom A; A \<in> carrier_mat m n\<rbrakk> \<Longrightarrow> 
     fst (Smith_mxn A) \<in> carrier_mat m m 
   \<and> fst (snd (Smith_mxn A)) \<in> carrier_mat m n
   \<and> snd (snd (Smith_mxn A)) \<in> carrier_mat n n"
   using Smith_mxn_pinduct_carrier_ge_2 Smith_mxn_pinduct_carrier_less_2
   by (meson linorder_not_le)
 
 
 termination proof (relation "measure (\<lambda>A. dim_row A)")
   fix A A1 A2 xb P1 y D1 Q1 C D E xf P2 yb Q2 F yc H xj P_H2 H2 xl xm ye xn yf xo yg
   assume 1: "\<not> (dim_row A = 0 \<or> dim_col A = 0)" and 2: "dim_row A \<noteq> 1"
     and 3: "dim_row A \<noteq> 2" and 4: "dim_col A \<noteq> 1" and 5: "dim_col A \<noteq> 2"
     and 6: "A1 = mat_of_row (Matrix.row A 0)"
     and xa_def: "A2 = mat_of_rows (dim_col A) (map (Matrix.row A) [1..<dim_row A])"
     and xb_def: "xb = Smith_mxn A2" and P1_y_xb: "(P1, y) = xb "
     and D1_Q1_y: "(D1, Q1) = y " and C_def: "C = A1 * Q1 @\<^sub>r P1* A2 * Q1 "
     and D_def: "D = mat_of_rows (dim_col A) [Matrix.row C 0, Matrix.row C 1] "
     and E_def: "E = mat_of_rows (dim_col A) (map (Matrix.row C) [2..<dim_row A]) "
     and xf: "xf = Smith_2xn D" and P2_yb_xf: "(P2, yb) = xf" and F_Q2_yb: "(F, Q2) = yb "
     and H_def: "H = P2 * D * Q2 @\<^sub>r E * Q2 " and xj: "xj = reduce_column div_op H "
     and P_H2_H2: "(P_H2, H2) = xj" and b4: "xl = split_block H2 1 1 "
     and b1: "(xm, ye) = xl" and b2: "(xn, yf) = ye" and b3: "(xo, yg) = yf" 
     and A2_dom: "Smith_mxn_dom A2" 
   let ?m = "dim_row A"
   let ?n = "dim_col A"
   have m: "2< ?m" and n: "2 < ?n" using 1 2 3 4 5 6 by auto  
   have A1: "A1 \<in> carrier_mat 1 (dim_col A)" using 6 by auto
   have A2: "A2 \<in> carrier_mat (dim_row A - 1) (dim_col A)" using xa_def by auto
   have "fst (Smith_mxn A2) \<in> carrier_mat (?m-1) (?m-1) 
         \<and> fst (snd (Smith_mxn A2)) \<in> carrier_mat (?m-1) ?n
         \<and> snd (snd (Smith_mxn A2)) \<in> carrier_mat ?n ?n" 
     by (rule Smith_mxn_pinduct_carrier[OF A2_dom A2])
   hence P1: "P1\<in> carrier_mat (?m-1) (?m-1)"and D1: "D1 \<in> carrier_mat (?m-1) ?n"
     and Q1: "Q1 \<in> carrier_mat ?n ?n" using P1_y_xb D1_Q1_y xa_def xb_def by (metis fstI sndI)+
   have C: "C \<in> carrier_mat ?m ?n" unfolding C_def using A1 Q1 P1 A2 Q1 
-    by (smt 1 Suc_pred card_num_simps(30) carrier_append_rows mult_carrier_mat neq0_conv plus_1_eq_Suc)
+    by (smt (verit) 1 Suc_pred card_num_simps(30) carrier_append_rows mult_carrier_mat neq0_conv plus_1_eq_Suc)
   have D: "D \<in> carrier_mat 2 ?n" unfolding D_def using C by auto
   have E: "E \<in> carrier_mat (?m-2) ?n" unfolding E_def using C m by auto
   have P2FQ2: "(P2,F,Q2) = Smith_2xn D" using F_Q2_yb P2_yb_xf xf by blast
   have P2: "P2\<in>carrier_mat 2 2" and F: "F \<in> carrier_mat 2 ?n" and Q2: "Q2 \<in> carrier_mat ?n ?n"
     using is_SNF_Smith_2xn[OF D] D P2FQ2 unfolding is_SNF_def by auto
   have "H \<in> carrier_mat (2 + (?m-2)) ?n" 
     by (unfold H_def, rule carrier_append_rows, insert D Q2 P2 E, auto)
   hence H: "H \<in> carrier_mat ?m ?n" using m by auto
   have H2: "H2 \<in> carrier_mat (dim_row H) (dim_col H)" 
     and P_H2: "P_H2 \<in> carrier_mat (dim_row A) (dim_row A)"
     using reduce_column[OF H xj[unfolded P_H2_H2[symmetric]]] m H by auto    
   have "dim_row yg < dim_row H2"      
     by (rule split_block4_decreases_dim_row, insert b1 b2 b3 b4 m n H H2, auto)
   also have "... = dim_row A" using H2 H by auto
   finally show "(yg, A) \<in> measure dim_row" unfolding in_measure .
 qed (auto)
 
 
 lemma is_SNF_Smith_mxn_less_2: 
   assumes A: "A \<in> carrier_mat m n" and mn: "n\<le>2 \<or> m\<le>2"
   shows "is_SNF A (Smith_mxn A)"
 proof -
   show ?thesis
   proof (cases "dim_row A = 0 \<or> dim_col A = 0")
     case True
     have "Smith_mxn A = (1\<^sub>m (dim_row A),A,1\<^sub>m (dim_col A))"
       using Smith_mxn.simps True by auto
     thus ?thesis using A True unfolding is_SNF_def by auto
   next
     case False note 1 = False
     show ?thesis
     proof (cases "dim_row A = 1")
       case True
       have "Smith_mxn A = (1\<^sub>m 1, Smith_1xn A)"
         using Smith_mxn.simps True 1 by auto
       then show ?thesis using Smith_1xn_works by (metis True carrier_mat_triv surj_pair)
     next
       case False note 2 = False
       then show ?thesis 
       proof (cases "dim_row A = 2")
         case True
         hence A': "A \<in> carrier_mat 2 n" using A by auto
         have "Smith_mxn A = Smith_2xn A" using Smith_mxn.simps True 1 2 by auto
         then show ?thesis using is_SNF_Smith_2xn[OF A'] A by auto
       next
         case False note 3 = False
         show ?thesis 
         proof (cases "dim_col A = 1")
           case True
           hence A': "A \<in> carrier_mat m 1" using A by auto
           have "Smith_mxn A = (let (P,S) = Smith_nx1 A in (P,S,1\<^sub>m 1))" 
             using Smith_mxn.simps True 1 2 3 by auto
           then show ?thesis using Smith_nx1_works[OF A'] A by (auto simp add: case_prod_beta)          
         next
           case False
           hence "dim_col A = 2" using 1 2 3 mn A by auto
           hence A': "A \<in> carrier_mat m 2" using A by auto
           hence "Smith_mxn A = Smith_nx2 A" 
             using Smith_mxn.simps 1 2 3 False by auto
           then show ?thesis using is_SNF_Smith_nx2[OF A'] A by force
         qed
       qed  
     qed
   qed
 qed
 
 
 lemma is_SNF_Smith_mxn_ge_2: 
   assumes A: "A \<in> carrier_mat m n" and m: "m>2" and n: "n>2"
   shows "is_SNF A (Smith_mxn A)"
   using A m n
 proof (induct A arbitrary: m n rule: Smith_mxn.induct)
   case (1 A)
   note A = "1.prems"(1)
   note m = "1.prems"(2)
   note n = "1.prems"(3)  
   have A_dim_not0:  "\<not> (dim_row A = 0 \<or> dim_col A = 0)" and A_dim_row_not1: "dim_row A \<noteq> 1"
     and A_dim_row_not2: "dim_row A \<noteq> 2" and A_dim_col_not1: "dim_col A \<noteq> 1"
     and A_dim_col_not2: "dim_col A \<noteq> 2"
     using A m n by auto
   note A_dim_intro = A_dim_not0 A_dim_row_not1 A_dim_row_not2 A_dim_col_not1 A_dim_col_not2
   define A1 where "A1 = mat_of_row (Matrix.row A 0)"
   define A2 where "A2 = mat_of_rows (dim_col A) [Matrix.row A i. i \<leftarrow> [1..<dim_row A]]"
   obtain P1 D1 Q1 where P1D1Q1: "(P1,D1,Q1) = Smith_mxn A2" by (metis prod_cases3)
   define C where "C = (A1*Q1) @\<^sub>r (P1*A2*Q1)"
   define D where "D = mat_of_rows (dim_col A) [Matrix.row C 0, Matrix.row C 1]"
   define E where "E = mat_of_rows (dim_col A) [Matrix.row C i. i \<leftarrow> [2..<dim_row A]]"
   obtain P2 F Q2 where P2FQ2: "(P2,F,Q2) = Smith_2xn D" by (metis prod_cases3)
   define H where "H = (P2*D*Q2) @\<^sub>r (E*Q2)"
   obtain P_H2 H2 where P_H2H2: "(P_H2, H2) = reduce_column div_op H" by (metis surj_pair)
   obtain H2_UL H2_UR H2_DL H2_DR where split_H2: "(H2_UL, H2_UR, H2_DL, H2_DR) = split_block H2 1 1"
     by (metis split_block_def)
   obtain P3 S' Q3 where P3S'Q3: "(P3,S',Q3) = Smith_mxn H2_DR" by (metis prod_cases3)
   define S where "S = four_block_mat (Matrix.mat 1 1 (\<lambda>(a, b). H $$ (0, 0))) (0\<^sub>m 1 (dim_col A - 1))
     (0\<^sub>m (dim_row A - 1) 1) S'"
   define P1' where "P1' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_row A - 1)) (0\<^sub>m (dim_row A - 1) 1) P1"
   define P2' where "P2' = four_block_mat P2 (0\<^sub>m 2 (dim_row A - 2)) (0\<^sub>m (dim_row A - 2) 2) (1\<^sub>m (dim_row A - 2))"
   define P3' where "P3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_row A - 1)) (0\<^sub>m (dim_row A - 1) 1) P3"
   define Q3' where "Q3' = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_col A - 1) 1) Q3"
   have Smith_final: "Smith_mxn A = (P3' * P_H2 * P2' * P1', S, Q1 * Q2 * Q3')"
   proof -
     have P1_def: "P1 = fst (Smith_mxn A2)" and D1_def: "D1 = fst (snd (Smith_mxn A2))" 
       and Q1_def: "Q1 = snd (snd (Smith_mxn A2))" using P1D1Q1 by (metis fstI sndI)+
     have P2_def: "P2 = fst (Smith_2xn D)" and F_def: "F = fst (snd (Smith_2xn D))" 
       and Q2_def: "Q2 = snd (snd (Smith_2xn D))" using P2FQ2 by (metis fstI sndI)+
     have P_H2_def: "P_H2 = fst (reduce_column div_op H)"
       and H2_def: "H2 = snd (reduce_column div_op H)" 
       using P_H2H2 by (metis fstI sndI)+
     have H2_UL_def: "H2_UL = fst (split_block H2 1 1)" 
       and H2_UR_def: "H2_UR = fst (snd (split_block H2 1 1))" 
       and H2_DL_def: "H2_DL = fst (snd (snd (split_block H2 1 1)))" 
       and H2_DR_def: "H2_DR = snd (snd (snd (split_block H2 1 1)))"
       using split_H2 by (metis fstI sndI)+
     have P3_def: "P3 = fst (Smith_mxn H2_DR)" and S'_def: "S' = fst (snd (Smith_mxn H2_DR))" 
       and Q3_def: "Q3 = (snd (snd (Smith_mxn H2_DR)))" using P3S'Q3 by (metis fstI sndI)+
     note aux = Smith_mxn.simps[of A] Let_def split_beta
       A1_def[symmetric] A2_def[symmetric] P1_def[symmetric] D1_def[symmetric] Q1_def[symmetric]
       C_def[symmetric] D_def[symmetric] E_def[symmetric] P2_def[symmetric] Q2_def[symmetric]
       F_def[symmetric] H_def[symmetric] P_H2_def[symmetric] H2_def[symmetric] H2_UL_def[symmetric]
       H2_DL_def[symmetric] H2_UR_def[symmetric] H2_DR_def[symmetric] P3_def[symmetric] S'_def[symmetric]
       Q3_def[symmetric] P1'_def[symmetric] P2'_def[symmetric] P3'_def[symmetric] Q1_def[symmetric]
       Q2_def[symmetric] Q3'_def[symmetric] S_def[symmetric]
     show ?thesis by (rule prod3_intro, unfold aux, insert "1.prems", auto)
   qed
   show ?case
   proof (unfold Smith_final, rule is_SNF_intro)
     have A1[simp]: "A1 \<in> carrier_mat 1 n" unfolding A1_def using A by auto
     have A2[simp]: "A2 \<in> carrier_mat (m-1) n" unfolding A2_def using A by auto
     have is_SNF_A2: "is_SNF A2 (Smith_mxn A2)"
     proof (cases "n \<le> 2 \<or> m - 1 \<le> 2")
       case True
       then show ?thesis using is_SNF_Smith_mxn_less_2[OF A2] by simp
     next
       case False
       hence n1: "2<n" and m1: "2<m-1" by auto
       show ?thesis by (rule "1.hyps"(1)[OF A_dim_intro A1_def A2_def A2 m1 n1])        
     qed
     have P1[simp]: "P1 \<in> carrier_mat (m-1) (m-1)" 
       and inv_P1: "invertible_mat P1" 
       and Q1: "Q1 \<in> carrier_mat n n" and inv_Q1: "invertible_mat Q1"
       and SNF_P1A2Q1: "Smith_normal_form_mat (P1*A2*Q1)"
       using is_SNF_A2 P1D1Q1 A2 A n m unfolding is_SNF_def by auto
     have C[simp]: "C \<in> carrier_mat m n" unfolding C_def  using P1 Q1 A1 A2 m
-      by (smt "1"(3) A_dim_not0 Suc_pred card_num_simps(30) carrier_append_rows carrier_matD 
+      by (smt (verit) "1"(3) A_dim_not0 Suc_pred card_num_simps(30) carrier_append_rows carrier_matD 
           carrier_mat_triv index_mult_mat(2,3) neq0_conv plus_1_eq_Suc)
     have D[simp]: "D \<in> carrier_mat 2 n" unfolding D_def using A m by auto  
     have is_SNF_D: "is_SNF D (Smith_2xn D)" by (rule is_SNF_Smith_2xn[OF D])
     hence P2[simp]: "P2 \<in> carrier_mat 2 2" and inv_P2: "invertible_mat P2"
       and Q2[simp]: "Q2 \<in> carrier_mat n n" and inv_Q2: "invertible_mat Q2"
       and F[simp]: "F \<in> carrier_mat 2 n" and F_P2DQ2: "F = P2*D*Q2"
       and SNF_F: "Smith_normal_form_mat F"
       using P2FQ2 D_def A unfolding is_SNF_def by auto
     have E[simp]: "E \<in> carrier_mat (m-2) n" unfolding E_def using A by auto
     have H_aux: "H \<in> carrier_mat (2 + (m-2)) n" unfolding H_def 
       by (rule carrier_append_rows, insert P2 D Q2 E F_P2DQ2 F A m n mult_carrier_mat, force)    
     hence H[simp]: "H \<in> carrier_mat m n" using m by auto
     have H2[simp]: "H2 \<in> carrier_mat m n" using m H P_H2H2 A reduce_column by blast
     have H2_DR[simp]: "H2_DR \<in> carrier_mat (m - 1) (n - 1)"
       by (rule split_block(4)[OF split_H2[symmetric]], insert H2 m n A H, auto, insert H2, blast+)    
     have P1'[simp]: "P1' \<in> carrier_mat m m" unfolding P1'_def using P1 m by auto
     have P2'[simp]: "P2' \<in> carrier_mat m m" unfolding P2'_def using P2 m A m 
       by (metis (no_types, lifting) H H_aux carrier_matD carrier_mat_triv 
           index_mat_four_block(2,3) index_one_mat(2,3))
     have is_SNF_H2_DR: "is_SNF H2_DR (Smith_mxn H2_DR)"
     proof (cases "2 < m - 1 \<and> 2 < n - 1")
       case True
       hence m1: "2<m-1" and n1: "2<n-1" by simp+
       show ?thesis
         by (rule "1.hyps"(2)[OF A_dim_intro A1_def A2_def P1D1Q1 _ _ C_def D_def E_def P2FQ2 _ _ H_def
               P_H2H2 _ split_H2 _ _ _ H2_DR m1 n1], auto)
     next
       case False
       hence "m-1\<le>2 \<or> n-1\<le>2" by auto
       then show ?thesis using H2_DR is_SNF_Smith_mxn_less_2 by blast
     qed
     hence P3[simp]: "P3 \<in> carrier_mat (m-1) (m-1)" and inv_P3: "invertible_mat P3"
       and Q3[simp]: "Q3 \<in> carrier_mat (n-1) (n-1)" and inv_Q3: "invertible_mat Q3"
       and S'[simp]: "S' \<in> carrier_mat (m-1) (n-1)" and S'_P3H2_DRQ3: "S' = P3 * H2_DR * Q3"
       and SNF_S': "Smith_normal_form_mat S'"
       using A m n H2_DR P3S'Q3 unfolding is_SNF_def by auto
     have P3'[simp]: "P3' \<in> carrier_mat m m" unfolding P3'_def using P3 m by auto
     have P_H2[simp]: "P_H2 \<in> carrier_mat m m" using reduce_column[OF H P_H2H2] m by simp
     have S[simp]: "S \<in> carrier_mat m n" unfolding S_def using H A S'
-      by (smt A_dim_intro(1) One_nat_def Suc_pred carrier_matD carrier_matI dim_col_mat(1)
+      by (smt (verit) A_dim_intro(1) One_nat_def Suc_pred carrier_matD carrier_matI dim_col_mat(1)
           dim_row_mat(1) index_mat_four_block(2,3) nat_neq_iff not_less_zero plus_1_eq_Suc)
     have Q3'[simp]: "Q3' \<in> carrier_mat n n" unfolding Q3'_def using Q3 n by auto
         (*The following two goals could have been resolved with Smith_mxn_pinduct_carrier, but we need the 
   dimensions of each matrix anyway*)
     show P_final_carrier: "P3' * P_H2 * P2' * P1' \<in> carrier_mat (dim_row A) (dim_row A)" 
       using P3' P_H2 P2' P1' A by (metis carrier_matD carrier_matI index_mult_mat(2,3))
     show Q_final_carrier: "Q1 * Q2 * Q3' \<in> carrier_mat (dim_col A) (dim_col A)"
       using Q1 Q2 Q3' A by (metis carrier_matD carrier_matI index_mult_mat(2,3))
     have inv_P1': "invertible_mat P1'" unfolding P1'_def
       by (rule invertible_mat_four_block_mat_lower_right[OF _ inv_P1], insert A P1, auto)
     have inv_P2': "invertible_mat P2'" unfolding P2'_def
       by (rule invertible_mat_four_block_mat_lower_right_id[OF _ _ _ _ _ inv_P2], insert A m, auto)
     have inv_P3': "invertible_mat P3'" unfolding P3'_def
       by (rule invertible_mat_four_block_mat_lower_right[OF _ inv_P3], insert A P3, auto)
     have inv_P_H2: "invertible_mat P_H2" using reduce_column[OF H P_H2H2] m by simp
     show "invertible_mat (P3' * P_H2 * P2' * P1')" using inv_P1' inv_P2' inv_P3' inv_P_H2
       by (meson P1' P2' P3' P_H2 invertible_mult_JNF mult_carrier_mat)
     have inv_Q3': "invertible_mat Q3'" unfolding Q3'_def
       by (rule invertible_mat_four_block_mat_lower_right[OF _ inv_Q3], insert A Q3, auto)    
     show "invertible_mat (Q1 * Q2 * Q3')" using inv_Q1 inv_Q2 inv_Q3'    
       by (meson Q1 Q2 Q3' invertible_mult_JNF mult_carrier_mat)  
     have A_A1_A2: "A = A1 @\<^sub>r A2" unfolding append_cols_def 
     proof (rule eq_matI)
       have A1_A2': "A1 @\<^sub>r A2 \<in> carrier_mat (1+(m-1)) n" by (rule carrier_append_rows[OF A1 A2])
       hence A1_A2: "A1 @\<^sub>r A2 \<in> carrier_mat m n" using m by simp
       thus "dim_row A = dim_row (A1 @\<^sub>r A2)" and "dim_col A = dim_col (A1 @\<^sub>r A2)" using A by auto
       fix i j assume i: "i < dim_row (A1 @\<^sub>r A2)" and j: "j < dim_col (A1 @\<^sub>r A2)"
       show "A $$ (i, j) = (A1 @\<^sub>r A2) $$ (i, j)"
       proof (cases "i=0")
         case True
         have "(A1 @\<^sub>r A2) $$ (i, j) = (A1 @\<^sub>r A2) $$ (0, j)" using True by simp
         also have "... = four_block_mat A1 (0\<^sub>m (dim_row A1) 0) A2 (0\<^sub>m (dim_row A2) 0) $$ (0,j)"
           unfolding append_rows_def ..
         also have "... = A1 $$ (0,j)" using A1 A1_A2 j by auto
         also have "... = A $$ (0,j)" unfolding A1_def using A1_A2 A i j by auto
         finally show ?thesis using True by simp
       next
         case False
         let ?xs = "(map (Matrix.row A) [1..<dim_row A])"
         have "(A1 @\<^sub>r A2) $$ (i, j) = four_block_mat A1 (0\<^sub>m (dim_row A1) 0) A2 (0\<^sub>m (dim_row A2) 0) $$ (i,j)"
           unfolding append_rows_def ..
         also have "... = A2 $$ (i-1,j)" using A1 A1_A2' A2 False i j by auto
         also have "... = mat_of_rows (dim_col A) ?xs $$ (i - 1, j)" by (simp add: A2_def)
         also have "... = ?xs ! (i-1) $v j" by (rule mat_of_rows_index, insert i False A j m A1_A2, auto)
         also have "... = A $$ (i,j)" using False A A1_A2 i j by auto
         finally show ?thesis ..
       qed    
     qed
     have C_eq: "C = P1' * A * Q1"
     proof -
       have aux: "(A1 @\<^sub>r A2) * Q1 = ((A1 * Q1) @\<^sub>r (A2*Q1))"
         by (rule append_rows_mult_right, insert A1 A2 Q1, auto)
       have "P1' * A * Q1 = P1' * (A1 @\<^sub>r A2) * Q1" using A_A1_A2 by simp
       also have "... =  P1' * ((A1 @\<^sub>r A2) * Q1)" using A A_A1_A2 P1' Q1 assoc_mult_mat by blast
       also have "... = P1' * ((A1 * Q1) @\<^sub>r (A2*Q1))" by (simp add: aux)
       also have "... = (A1 * Q1) @\<^sub>r (P1 * (A2 * Q1))" 
         by (rule append_rows_mult_left_id, insert A1 Q1 A2 P1 P1'_def A, auto)
       also have "... = (A1 * Q1) @\<^sub>r (P1 * A2 * Q1)" using A2 P1 Q1 by auto
       finally show ?thesis unfolding C_def ..
     qed
     have C_D_E: "C = D @\<^sub>r E"
     proof -
       let ?xs = "[Matrix.row C 0, Matrix.row C 1]"
       let ?ys = "(map (Matrix.row C) [0..<2])" 
       have xs_ys: "?xs = ?ys" by (simp add: upt_conv_Cons)
       have D_rw: "D = mat_of_rows (dim_col C) (map (Matrix.row C) [0..<2])" 
         unfolding D_def xs_ys using A C by (metis carrier_matD(2))
       have d1: "dim_col A = dim_col C" using A C by blast
       have d2: "dim_row A = dim_row C" using A C by blast
       show ?thesis unfolding D_rw E_def d1 d2 by (rule append_rows_split, insert m C A d2, auto)
     qed
     have H_eq: "H = P2' * P1' * A * Q1 * Q2"
     proof -
       have aux: "((P2 * D) @\<^sub>r E) = P2' * (D @\<^sub>r E)" 
         by (rule append_rows_mult_left_id2[symmetric, OF D E _ P2], insert P2'_def A, auto)
       have "H = P2 * D * Q2 @\<^sub>r E * Q2" by (simp add: H_def)
       also have "... = (P2 * D @\<^sub>r E) * Q2" 
         by (rule append_rows_mult_right[symmetric, OF mult_carrier_mat[OF P2 D] E Q2])
       also have "... = P2' * (D @\<^sub>r E) * Q2" by (simp add: aux)
       also have "... =  P2' * C * Q2" unfolding C_D_E by simp
       also have "... = P2' * (P1' * A * Q1) * Q2" unfolding C_eq by simp
       also have "... = P2' * P1' * A * Q1 * Q2"
-        by (smt A P1' P2' Q1 \<open>P2' * C * Q2 = P2' * (P1' * A * Q1) * Q2\<close> assoc_mult_mat mult_carrier_mat)
+        by (smt (verit) A P1' P2' Q1 \<open>P2' * C * Q2 = P2' * (P1' * A * Q1) * Q2\<close> assoc_mult_mat mult_carrier_mat)
       finally show ?thesis .    
     qed
     have P_H2_H_H2: "P_H2 * H = H2" using reduce_column[OF H P_H2H2] m by auto
     hence H2_eq: "H2 = P_H2 * P2' * P1' * A * Q1 * Q2" unfolding H_eq
-      by (smt P1' P1'_def P2' P2'_def P_H2 P_final_carrier Q1 Q2 Q_final_carrier assoc_mult_mat 
+      by (smt (verit, ccfv_threshold) P1' P1'_def P2' P2'_def P_H2 P_final_carrier Q1 Q2 Q_final_carrier assoc_mult_mat 
           carrier_matD carrier_mat_triv index_mult_mat(2,3))        
     have H2_as_four_block_mat: "H2 = four_block_mat H2_UL H2_UR H2_DL H2_DR" 
       using split_H2 by (metis (no_types, lifting) H2 P1' P1'_def Q3' Q3'_def carrier_matD 
           index_mat_four_block(2) index_one_mat(2) split_block(5))
     have H2_UL: "H2_UL \<in> carrier_mat 1 1" 
       by (rule split_block(1)[OF split_H2[symmetric], of "m-1" "n-1"], insert H2 A m n, auto, insert H2, blast+)
     have H2_UR: "H2_UR \<in> carrier_mat 1 (n-1)"
       by (rule split_block(2)[OF split_H2[symmetric], of "m-1"], insert H2 A m n, auto, insert H2, blast+)
     have H2_DL: "H2_DL \<in> carrier_mat (m-1) 1"
       by (rule split_block(3)[OF split_H2[symmetric], of _ "n-1"], insert H2 A m n, auto, insert H2, blast+)
     have H2_DR: "H2_DR \<in> carrier_mat (m-1) (n-1)"
       by (rule split_block(4)[OF split_H2[symmetric], of _ "n-1"], insert H2 A m n, auto, insert H2, blast+)
     have H_ij_F_ij: "H$$(i,j) = F $$(i,j)" if i: "i<2" and j: "j<n" for i j
     proof -
       have "H$$(i,j) = (if i < dim_row (P2*D*Q2) then (P2*D*Q2) $$ (i, j) else (E*Q2) $$ (i - 2, j))"      
       proof (unfold H_def, rule append_rows_nth)
         show "P2 * D * Q2 \<in> carrier_mat 2 n" using F F_P2DQ2 by blast
         show "E * Q2 \<in> carrier_mat (m-2) n" using E Q2 using mult_carrier_mat by blast
       qed (insert m j i, auto)
       also have "... = F $$ (i, j)" using F F_P2DQ2 i by auto
       finally show ?thesis .
     qed
     have isDiagonal_F: "isDiagonal_mat F" 
       using is_SNF_D P2FQ2 unfolding is_SNF_def Smith_normal_form_mat_def by auto
     have H_0j_0: "H $$ (0,j) = 0" if j: "j\<in>{1..<n}" for j
     proof -   
       have "H $$ (0,j) = F $$ (0, j)" using H_ij_F_ij j by auto
       also have "... = 0" using isDiagonal_F unfolding isDiagonal_mat_def using F j by auto
       finally show ?thesis .    
     qed
     have H2_0j: "H2 $$ (0,j) = H $$ (0,j)" if j: "j<n" for j
       by (rule reduce_column_preserves2[OF H P_H2H2 _ _ _ j], insert m, auto)
     have H2_UR_0: "H2_UR = (0\<^sub>m 1 (n-1))"
     proof (rule eq_matI)
       show "dim_row H2_UR = dim_row (0\<^sub>m 1 (n - 1))" and "dim_col H2_UR = dim_col (0\<^sub>m 1 (n - 1))"
         using H2_UR by auto
       fix i j assume i: "i < dim_row (0\<^sub>m 1 (n - 1))" and j: "j < dim_col (0\<^sub>m 1 (n - 1))"
       have i0: "i=0" using i by auto
       have 1: "0 < dim_row H2_UL + dim_row H2_DR" using i H2_UL H2_DR by auto
       have 2: "j+1 < dim_col H2_UL + dim_col H2_DR" using j H2_UL H2_DR by auto
       have "H2_UR $$ (i, j) = H2 $$ (0,j+1)"
         unfolding i0 H2_as_four_block_mat using index_mat_four_block(1)[OF 1 2] H2_UL by auto
       also have "... = H $$ (0,j+1)" by (rule H2_0j, insert j, auto)
       also have "... = 0" using H_0j_0 j by auto
       finally show "H2_UR $$ (i, j) = 0\<^sub>m 1 (n - 1) $$ (i, j)" using i j by auto
     qed
     have H2_UL00_H00: "H2_UL $$ (0,0) = H $$ (0,0)"
       using H2_UL H2_as_four_block_mat H2_0j n by fastforce
     have F00_dvd_Dij: "F$$(0,0) dvd D$$(i,j)" if i: "i<2" and j: "j<n" for i j
       by (rule S00_dvd_all_A[OF D P2 Q2 inv_P2 inv_Q2 F_P2DQ2 SNF_F i j])
         (*
     Scheme of the proof:
     - D $$ (1,0) dvd all elements of E
     - F$$(0,0) divides all elements of D, in particular divides D$$(1,0)
     - Hence, F$$(0,0) divides all elements of E.
     - Hence, F$$(0,0) divides all elements of E * Q2
   *)
     have D10_dvd_Eij: "D$$(1,0) dvd E$$(i,j)" if i: "i<m-2" and j: "j<n" for i j
     proof -
       have "D$$(1,0) = C$$(1,0)"
-        by (smt C C_D_E F F_P2DQ2 H H_def One_nat_def Suc_lessD add_diff_cancel_right' append_rows_def
+        by (smt (verit) C C_D_E F F_P2DQ2 H H_def One_nat_def Suc_lessD add_diff_cancel_right' append_rows_def
             arith_special(3) carrier_matD index_mat_four_block index_mult_mat(2) lessI m n plus_1_eq_Suc)
       also have "... = (P1*A2*Q1) $$ (0,0)"
-        by (smt "1"(3) A1 A2 A_A1_A2 A_dim_not0 P1 Q1 Suc_eq_plus1 Suc_lessD add_diff_cancel_right' 
+        by (smt (verit) "1"(3) A1 A2 A_A1_A2 A_dim_not0 P1 Q1 Suc_eq_plus1 Suc_lessD add_diff_cancel_right' 
             append_rows_def arith_special(3) card_num_simps(30) carrier_matD index_mat_four_block 
             index_mult_mat(2,3) less_not_refl2 local.C_def m neq0_conv)
       also have " ... dvd (P1*A2*Q1) $$ (i+1,j)"
         by (rule SNF_first_divides_all[OF SNF_P1A2Q1 _ _ j], insert P1 A2 Q1 i A, auto)
       also have "... = C $$ (i+2,j)" unfolding C_def using append_rows_nth
-        by (smt A A1 A2 A_A1_A2 P1 Q1 Suc_lessD add_Suc_right add_diff_cancel_left' append_rows_def
+        by (smt (verit, ccfv_threshold) A A1 A2 A_A1_A2 P1 Q1 Suc_lessD add_Suc_right add_diff_cancel_left' append_rows_def
             arith_special(3) carrier_matD index_mat_four_block index_mult_mat(2,3) j less_diff_conv 
             not_add_less2 plus_1_eq_Suc that(1))
       also have "... = E$$(i,j)"
-        by (smt C C_D_E D add_diff_cancel_right' append_rows_def carrier_matD index_mat_four_block j i
+        by (smt (verit) C C_D_E D add_diff_cancel_right' append_rows_def carrier_matD index_mat_four_block j i
             less_diff_conv not_add_less2)
       finally show ?thesis .   
     qed
     have F00_H00: "F $$ (0,0) = H $$ (0,0)" using H_ij_F_ij n by auto
     have F00_dvd_Eij: "F$$(0,0) dvd E$$(i,j)" if i: "i<m-2" and j: "j<n" for i j
       by (metis (no_types, lifting) A A_dim_not0 D10_dvd_Eij F00_dvd_Dij arith_special(3) carrier_matD(2) 
           dvd_trans j lessI neq0_conv plus_1_eq_Suc i)
     have F00_dvd_EQ2ij: "F$$(0,0) dvd (E*Q2) $$ (i,j)" if i: "i<m-2" and j: "j<n" for i j
       using dvd_elements_mult_matrix_right[OF E Q2]  F00_dvd_Eij i j by auto
     have H00_dvd_all: "H $$ (0, 0) dvd H $$ (i, j)" if i: "i<m" and j: "j<n" for i j
     proof (cases "i<2")
       case True
       then show ?thesis by (metis F F00_H00 H_ij_F_ij SNF_F SNF_first_divides_all j)
     next
       case False
       have "F $$ (0,0) dvd (E*Q2) $$ (i-2,j)" by (rule F00_dvd_EQ2ij, insert False i j, auto)
       moreover have "H $$ (i, j) = (E*Q2) $$ (i-2,j)"
-        by (smt C C_D_E D F F_P2DQ2 False H_def append_rows_def carrier_matD i 
+        by (smt (verit) C C_D_E D F F_P2DQ2 False H_def append_rows_def carrier_matD i 
             index_mat_four_block index_mult_mat(2) j)
       ultimately show ?thesis using F00_H00 by simp
     qed    
     have H_00_dvd_H_i0: "H $$ (0, 0) dvd H $$ (i, 0)" if i: "i<m" for i
       using H00_dvd_all[OF i] n by auto
     have H2_DL_0: "H2_DL = (0\<^sub>m (m - 1) 1)"
     proof (rule eq_matI)
       show "dim_row (H2_DL) = dim_row (0\<^sub>m (m - 1) 1)"
         and "dim_col (H2_DL) = dim_col (0\<^sub>m (m - 1) 1)" using P3 H2_DL A by auto
       fix i j assume i: "i < dim_row (0\<^sub>m (m - 1) 1)" and j: "j < dim_col (0\<^sub>m (m - 1) 1)"
       have j0: "j=0" using j by auto
       have "(H2_DL) $$ (i, j) = H2 $$ (i+1,0)"
         using H2_UR H2_UR_0 n j0 H2 H2_UL H2_as_four_block_mat i by auto
       also have "... = 0"
       proof (cases "i=0")
         case True
         have "H2 $$ (1,0) = H $$ (1,0)" by (rule reduce_column_preserves2[OF H P_H2H2], insert m n, auto)
         also have "... = F $$ (1,0)" by (rule H_ij_F_ij, insert n, auto)
         also have "... = 0" using isDiagonal_F F n unfolding isDiagonal_mat_def by auto
         finally show ?thesis by (simp add: True)
       next
         case False
         show ?thesis
         proof (rule reduce_column_works(1)[OF H P_H2H2])      
           show "H $$ (0, 0) dvd H $$ (i + 1, 0)" using H_00_dvd_H_i0 False i by simp
           show "\<forall>j\<in>{1..<n}. H $$ (0, j) = 0" using H_0j_0 by auto
           show "i + 1 \<in> {2..<m}" using i False by auto
         qed (insert m n id, auto)
       qed
       finally show "(H2_DL) $$ (i, j) = 0\<^sub>m (m - 1) 1 $$ (i, j)" using i j j0 by auto
     qed
     have "P3'*H2 = four_block_mat H2_UL H2_UR (P3 * H2_DL) (P3 * H2_DR)"
     proof -
       have "P3'*H2 = four_block_mat 
     (1\<^sub>m 1 * H2_UL + 0\<^sub>m 1 (dim_row A - 1) * H2_DL) (1\<^sub>m 1 * H2_UR + 0\<^sub>m 1 (dim_row A - 1) * H2_DR) 
     (0\<^sub>m (dim_row A - 1) 1 * H2_UL + P3 * H2_DL) (0\<^sub>m (dim_row A - 1) 1 * H2_UR + P3 * H2_DR)"
         unfolding P3'_def H2_as_four_block_mat 
         by (rule mult_four_block_mat[OF _ _ _ P3 H2_UL H2_UR H2_DL H2_DR], insert A, auto)
       also have "... = four_block_mat H2_UL H2_UR (P3 * H2_DL) (P3 * H2_DR)"
         by (rule cong_four_block_mat, insert H2_UL A m H2_DL H2_DR H2_UR P3, auto) 
       finally show ?thesis .
     qed
     hence P3'_H2_as_four_block_mat: "P3'*H2 = four_block_mat H2_UL (0\<^sub>m 1 (n-1)) (0\<^sub>m (m - 1) 1) (P3 * H2_DR)"
       unfolding H2_UR_0 H2_DL_0 using P3 by auto
     also have "... * Q3' = S" (is "?lhs = ?rhs")
     proof -
       have "?lhs = four_block_mat H2_UL (0\<^sub>m 1 (n-1)) (0\<^sub>m (m - 1) 1) (P3 * H2_DR) 
     * four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (n - 1)) (0\<^sub>m (n - 1) 1) Q3" unfolding Q3'_def using A by auto
       also have "... = 
     four_block_mat (H2_UL * 1\<^sub>m 1 + (0\<^sub>m 1 (n-1)) * 0\<^sub>m (n - 1) 1) (H2_UL * 0\<^sub>m 1 (n - 1) + (0\<^sub>m 1 (n-1)) * Q3)
      (0\<^sub>m (m - 1) 1 * 1\<^sub>m 1 + P3 * H2_DR * 0\<^sub>m (n - 1) 1) (0\<^sub>m (m - 1) 1 * 0\<^sub>m 1 (n - 1) + P3 * H2_DR * Q3)"
         by (rule mult_four_block_mat[OF H2_UL], insert P3 H2_DR Q3, auto)
       also have "... = four_block_mat H2_UL (0\<^sub>m 1 (n - 1)) (0\<^sub>m (m - 1) 1) (P3 * H2_DR * Q3)"
         by (rule cong_four_block_mat, insert H2_UL A m H2_DL H2_DR H2_UR P3 Q3, auto)
       also have "... = four_block_mat (Matrix.mat 1 1 (\<lambda>(a, b). H $$ (0, 0))) 
       (0\<^sub>m 1 (dim_col A - 1)) (0\<^sub>m (dim_row A - 1) 1) S'"
         by (rule cong_four_block_mat, insert A S'_P3H2_DRQ3 H2_UL00_H00 H2_UL, auto)    
       finally show ?thesis unfolding S_def by simp
     qed
     finally have P3'_H2_Q3'_S: "P3'*H2*Q3' = S" .
     have S_as_four_block_mat: "S = four_block_mat H2_UL (0\<^sub>m 1 (n - 1)) (0\<^sub>m (m - 1) 1) S'"
       unfolding S_def by (rule cong_four_block_mat, insert A S'_P3H2_DRQ3 H2_UL00_H00 H2_UL, auto)    
     show "S = P3' * P_H2 * P2' * P1' * A * (Q1 * Q2 * Q3')" using P3'_H2_Q3'_S unfolding H2_eq
       by (smt P1 P1'_def P2' P2'_def P3 P3'_def P_H2 Q1 Q2 Q3' Q3'_def S Q_final_carrier P_final_carrier
           assoc_mult_mat carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_mult_mat(2,3))
     have H00_dvd_all_H2: "H $$ (0, 0) dvd H2 $$ (i, j)" if i: "i<m" and j: "j<n" for i j
       using  dvd_elements_mult_matrix_left[OF H P_H2] H00_dvd_all i j P_H2_H_H2 by blast
     hence H00_dvd_all_S: "H $$ (0, 0) dvd S $$ (i, j)" if i: "i<m" and j: "j<n" for i j
       using dvd_elements_mult_matrix_left_right[OF H2 P3' Q3'] P3'_H2_Q3'_S i j by auto
     show "Smith_normal_form_mat S"
     proof (rule Smith_normal_form_mat_intro)    
       show "isDiagonal_mat S"
       proof (unfold isDiagonal_mat_def, rule+)
         fix i j assume  "i \<noteq> j \<and> i < dim_row S \<and> j < dim_col S"
         hence ij: "i \<noteq> j" and i: "i < dim_row S" and j: "j < dim_col S" by auto
         have i2: "i < dim_row H2_UL + dim_row S'" and j2: "j < dim_col H2_UL + dim_col S'"
           using S_as_four_block_mat i j by auto
         have "S $$ (i,j) = (if i < dim_row H2_UL then if j < dim_col H2_UL then H2_UL $$ (i, j) 
       else (0\<^sub>m 1 (n - 1)) $$ (i, j - dim_col H2_UL) else if j < dim_col H2_UL 
       then (0\<^sub>m (m - 1) 1) $$ (i - dim_row H2_UL, j) else S' $$ (i - dim_row H2_UL, j - dim_col H2_UL))"
           by (unfold S_as_four_block_mat, rule index_mat_four_block(1)[OF i2 j2])
         also have "... = 0" (is "?lhs = 0")
         proof (cases "i = 0 \<or> j = 0")
           case True
           then show ?thesis unfolding S_def using ij i j S H2_UL by fastforce      
         next
           case False
           have diag_S': "isDiagonal_mat S'" using SNF_S' unfolding Smith_normal_form_mat_def by simp
           have i_not_0: "i\<noteq>0" and j_not_0: "j\<noteq>0" using False by auto
           hence "?lhs = S' $$ (i - dim_row H2_UL, j - dim_col H2_UL)" using i j ij H2_UL by auto
           also have "... = 0" using diag_S' S' H2_UL i_not_0 j_not_0 ij unfolding isDiagonal_mat_def
-            by (smt S_as_four_block_mat add_diff_inverse_nat add_less_cancel_left carrier_matD i 
+            by (smt (verit) S_as_four_block_mat add_diff_inverse_nat add_less_cancel_left carrier_matD i 
                 index_mat_four_block(2,3) j less_one)
           finally show ?thesis .
         qed
         finally show "S $$ (i, j) = 0" .
       qed
       show "\<forall>a. a + 1 < min (dim_row S) (dim_col S) \<longrightarrow> S $$ (a, a) dvd S $$ (a + 1, a + 1)"
       proof safe
         fix i assume i: "i + 1 < min (dim_row S) (dim_col S)"
         show "S $$ (i, i) dvd S $$ (i + 1, i + 1)"
         proof (cases "i=0")
           case True
           have "S $$ (0, 0) = H $$ (0,0)" using H2_UL H2_UL00_H00 S_as_four_block_mat by auto
           also have "... dvd S $$ (1,1)" using H00_dvd_all_S i m n by auto
           finally show ?thesis using True by simp
         next
           case False
           have "S $$ (i, i)= S' $$ (i-1, i-1)" using False S_def i by auto
           also have "... dvd S' $$ (i, i)" using SNF_S' i S' S unfolding Smith_normal_form_mat_def
-            by (smt False H2_UL S_as_four_block_mat add.commute add_diff_inverse_nat carrier_matD 
+            by (smt (verit) False H2_UL S_as_four_block_mat add.commute add_diff_inverse_nat carrier_matD 
                 index_mat_four_block(2,3) less_one min_less_iff_conj nat_add_left_cancel_less)
           also have "... = S $$ (i+1,i+1)" using False S_def i by auto
           finally show ?thesis .
         qed
       qed
     qed
   qed
 qed
 
 subsection \<open>Soundness theorem\<close>
 
 theorem is_SNF_Smith_mxn: 
   assumes A: "A \<in> carrier_mat m n"
   shows "is_SNF A (Smith_mxn A)"
   using is_SNF_Smith_mxn_ge_2[OF A] is_SNF_Smith_mxn_less_2[OF A] by linarith
 
 declare Smith_mxn.simps[code]
 
 end
 
 declare Smith_Impl.Smith_mxn.simps[code_unfold]
 
 definition T_spec :: "('a::{comm_ring_1} \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a \<times> 'a)) \<Rightarrow> bool" 
   where "T_spec T = (\<forall>a b::'a. let (a1,b1,d) = T a b in 
                     a = a1*d \<and> b = b1*d \<and> ideal_generated {a1,b1} = ideal_generated {1})"
 
 definition D'_spec :: "('a::{comm_ring_1} \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a)) \<Rightarrow> bool" 
   where "D'_spec D' = (\<forall>a b c::'a. let (p,q) = D' a b c in 
       ideal_generated{a,b,c} = ideal_generated{1} 
       \<longrightarrow> ideal_generated {p*a,p*b+q*c} = ideal_generated {1})"
 
 end
\ No newline at end of file
diff --git a/thys/Smith_Normal_Form/SNF_Algorithm_Euclidean_Domain.thy b/thys/Smith_Normal_Form/SNF_Algorithm_Euclidean_Domain.thy
--- a/thys/Smith_Normal_Form/SNF_Algorithm_Euclidean_Domain.thy
+++ b/thys/Smith_Normal_Form/SNF_Algorithm_Euclidean_Domain.thy
@@ -1,714 +1,714 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Executable Smith normal form algorithm over Euclidean domains\<close>
 
 theory SNF_Algorithm_Euclidean_Domain
   imports
     Diagonal_To_Smith
     Echelon_Form.Examples_Echelon_Form_Abstract
 
     Elementary_Divisor_Rings 
     Diagonal_To_Smith_JNF
 
     Mod_Type_Connect
     Show.Show_Instances
     Jordan_Normal_Form.Show_Matrix
     Show.Show_Poly    
 begin
 
 text \<open>This provides an executable implementation of the verified general algorithm, provinding
 executable operations over a Euclidean domain.\<close>
 
 lemma zero_less_one_type2: "(0::2) < 1"
 proof -
   have "Mod_Type.from_nat 0 = (0::2)" by (simp add: from_nat_0)
   moreover have "Mod_Type.from_nat 1 = (1::2)" using from_nat_1 by blast
   moreover have "(Mod_Type.from_nat 0::2) < Mod_Type.from_nat 1" by (rule from_nat_mono, auto)
   ultimately show ?thesis by simp
 qed
 
 subsection \<open>Previous code equations\<close>
 (*Firstly, code equations for Mod_Type_Connect.to_hma\<^sub>m*)
 
 definition "to_hma\<^sub>m_row A i
   = (vec_lambda (\<lambda>j. A $$ (Mod_Type.to_nat i, Mod_Type.to_nat j)))"
 
 lemma bezout_matrix_row_code [code abstract]:
   "vec_nth (to_hma\<^sub>m_row A i) = 
       (\<lambda>j. A $$ (Mod_Type.to_nat i, Mod_Type.to_nat j))"
   unfolding to_hma\<^sub>m_row_def by auto 
 
 lemma [code abstract]: "vec_nth (Mod_Type_Connect.to_hma\<^sub>m A) = to_hma\<^sub>m_row A"
   unfolding Mod_Type_Connect.to_hma\<^sub>m_def  unfolding to_hma\<^sub>m_row_def[abs_def]
   by auto
 
 
 subsection \<open>An executable algorithm to transform $2 \times 2$ matrices into its Smith normal form
 in HOL Analysis\<close>
 (*
 
 There are several alternatives to obtain an algorithm to transform a 2x2 matrix (over 
 a euclidean domain) into its Smith normal form. One of them is diagonalize + diagonal to Smith.
 
 To take advantage of existing results in HOL Analysis (HA), we proceed as follows:
 
   1) We implement an algorithm to diagonalize a matrix in HA, taking advantage of the existing 
      bezout matrix
   2) Then, we transform the diagonal matrix to its Smith normal form using the diagonal_to_Smith
      algorithm in HA, already proved.
   3) We define an algorithm in JNF based on the one in HA, which is possible since the types 
      are known. Then, transfer the results to JNF.
 *)
 
 subclass (in euclidean_ring_gcd) bezout_ring_div
 proof qed
 
 (*value[code] "let (P,S,Q) = (diagonal_to_Smith_PQ ((list_of_list_to_matrix [[4,0],[0,10]])::int^2^2) euclid_ext2)
   in (matrix_to_list_of_list P,matrix_to_list_of_list S,matrix_to_list_of_list Q)"*)
 
 context
   fixes bezout::"('a::euclidean_ring_gcd \<Rightarrow> 'a \<Rightarrow> ('a\<times>'a\<times>'a\<times>'a\<times>'a))"
   assumes ib: "is_bezout_ext bezout"
 begin
 
 lemma normalize_bezout_gcd: 
   assumes b: "(p,q,u,v,d) = bezout a b"
   shows "normalize d = gcd a b"
 proof -
   let ?gcd = "(\<lambda>a b. case bezout a b of (x, xa,u,v, gcd') \<Rightarrow> gcd')"
   have is_gcd: "is_gcd ?gcd" by (simp add: ib is_gcd_is_bezout_ext)
   have "(?gcd a b) = d" using b by (metis case_prod_conv)
   moreover have "normalize (?gcd a b) = normalize (gcd a b)"
   proof (rule associatedI)
     show "(?gcd a b) dvd (gcd a b)" using is_gcd is_gcd_def by fastforce
     show "(gcd a b) dvd (?gcd a b)" by (metis (no_types) gcd_dvd1 gcd_dvd2 is_gcd is_gcd_def)
   qed
   ultimately show ?thesis by auto
 qed
 
 end
 
 
 lemma bezout_matrix_works_transpose1:
   assumes ib: "is_bezout_ext bezout"
   and a_not_b: "a \<noteq> b"
 shows "(A**transpose (bezout_matrix (transpose A) a b i bezout)) $ i $ a 
     = snd (snd (snd (snd (bezout (A $ i $ a) (A $ i $ b)))))"
 proof -
   have "(A**transpose (bezout_matrix (transpose A) a b i bezout)) $h i $h a 
     = transpose (A**transpose (bezout_matrix (transpose A) a b i bezout)) $h a $h i"
     by (simp add: transpose_code transpose_row_code)
   also have "... = ((bezout_matrix (transpose A) a b i bezout) ** (transpose A)) $h a $h i"
     by (simp add: matrix_transpose_mul)
   also have "... = snd (snd (snd (snd (bezout ((transpose A) $ a $ i) ((transpose A) $ b $ i)))))"
     by (rule bezout_matrix_works1[OF ib a_not_b])
   also have "... = snd (snd (snd (snd (bezout (A $ i $ a) (A $ i $ b)))))"
     by (simp add: transpose_code transpose_row_code)
   finally show ?thesis .
 qed
 
 lemma invertible_bezout_matrix_transpose:
  fixes A::"'a::{bezout_ring_div}^'cols::{finite,wellorder}^'rows"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b"
   and aj: "A $h i $h a \<noteq> 0"
 shows "invertible (transpose (bezout_matrix (transpose A) a b i bezout))"
 proof -
   have "Determinants.det (bezout_matrix (transpose A) a b i bezout) = 1"
     by (rule det_bezout_matrix[OF ib a_less_b], insert aj, auto simp add: transpose_def)
   hence "Determinants.det (transpose (bezout_matrix (transpose A) a b i bezout)) = 1" by simp
   thus ?thesis by (simp add: invertible_iff_is_unit)
 qed
 
 
 (*I will have to ensure that a is not zero before starting the algorithm (moving the pivot)*)
 function diagonalize_2x2_aux :: "(('a::euclidean_ring_gcd^2^2) \<times> ('a^2^2)\<times>('a^2^2)) \<Rightarrow> 
                                   (('a^2^2) \<times>('a^2^2)\<times>('a^2^2))"
   where "diagonalize_2x2_aux (P,A,Q)  =
 (
   let 
       a = A $h 0 $h 0;
       b = A $h 0 $h 1;
       c = A $h 1 $h 0;
       d = A $h 1 $h 1 in
       if a\<noteq> 0 \<and> \<not> a dvd b then let bezout_mat = transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2) in
        diagonalize_2x2_aux (P, A**bezout_mat,Q**bezout_mat) else
         if  a \<noteq> 0 \<and> \<not> a dvd c then let bezout_mat = bezout_matrix A 0 1 0 euclid_ext2
       in diagonalize_2x2_aux (bezout_mat**P,bezout_mat**A,Q) else \<comment> \<open>We can divide an get zeros\<close>
       let Q' = column_add (Finite_Cartesian_Product.mat 1) 1 0 (- (b div a));
           P' = row_add (Finite_Cartesian_Product.mat 1) 1 0 (- (c div a)) in
         (P'**P,P'**A**Q',Q**Q')
 )" by auto
 
 (*The algorithm terminates since the euclidean size of the A $h 0 $h 0 element gets reduced.*)
 termination 
 proof-
   have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
   have "euclidean_size ((bezout_matrix A 0 1 0 euclid_ext2 ** A) $h 0 $h 0) < euclidean_size (A $h 0 $h 0)"
     if a_not_dvd_c: "\<not> A $h 0 $h 0 dvd A $h 1 $h 0" and a_not0: "A $h 0 $h 0 \<noteq> 0" for A::"'a^2^2"
   proof-
     let ?a = "(A $h 0 $h 0)" let ?c = "(A $h 1 $h 0)"
     obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 ?a ?c" by (metis prod_cases5)
     have "(bezout_matrix A 0 1 0 euclid_ext2 ** A) $h 0 $h 0 = d"      
       by (metis bezout_matrix_works1 ib one_neq_zero pquvd prod.sel(2))
     hence "normalize ((bezout_matrix A 0 1 0 euclid_ext2 ** A) $h 0 $h 0) = normalize d" by auto
     also have "... = gcd ?a ?c" by (rule normalize_bezout_gcd[OF ib pquvd])
     finally have "euclidean_size ((bezout_matrix A 0 1 0 euclid_ext2 ** A) $h 0 $h 0) 
       = euclidean_size (gcd ?a ?c)" by (metis euclidean_size_normalize)
     also have "... < euclidean_size ?a" by (rule euclidean_size_gcd_less1[OF a_not0 a_not_dvd_c])
     finally show ?thesis .
   qed
   moreover have "euclidean_size ((A ** transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)) $h 0 $h 0)
       < euclidean_size (A $h 0 $h 0)"
     if a_not_dvd_b: "\<not> A $h 0 $h 0 dvd A $h 0 $h 1" and a_not0: "A $h 0 $h 0 \<noteq> 0" for A::"'a^2^2"
   proof-
     let ?a = "(A $h 0 $h 0)" let ?b = "(A $h 0 $h 1)"
     obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 ?a ?b" by (metis prod_cases5)
     have "(A ** transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)) $h 0 $h 0 = d"
       by (metis bezout_matrix_works_transpose1 ib pquvd prod.sel(2) zero_neq_one)
     hence "normalize ((A ** transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)) $h 0 $h 0) = normalize d" by auto
     also have "... = gcd ?a ?b" by (rule normalize_bezout_gcd[OF ib pquvd])
     finally have "euclidean_size ((A ** transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)) $h 0 $h 0)
       = euclidean_size (gcd ?a ?b)" by (metis euclidean_size_normalize)
     also have "... < euclidean_size ?a" by (rule euclidean_size_gcd_less1[OF a_not0 a_not_dvd_b])
     finally show ?thesis .
   qed
   ultimately show ?thesis
     by (relation "Wellfounded.measure (\<lambda>(P,A,Q). euclidean_size (A $h 0 $h 0))", auto)
 qed
 
 
 lemma diagonalize_2x2_aux_works:
   assumes  "A = P ** A_input ** Q"
     and "invertible P" and "invertible Q"
     and "(P',D,Q') = diagonalize_2x2_aux (P,A,Q)"
     and "A $h 0 $h 0 \<noteq> 0"
   shows "D = P' ** A_input ** Q' \<and> invertible P' \<and> invertible Q' \<and> isDiagonal D"
   using assms
 proof (induct "(P,A,Q)" arbitrary: P A Q rule: diagonalize_2x2_aux.induct)
   case (1 P A Q)
   let ?a = "A $h 0 $h 0"
   let ?b = "A $h 0 $h 1"
   let ?c = "A $h 1 $h 0"
   let ?d = "A $h 1 $h 1"
   have a_not_0: "?a \<noteq> 0" using "1.prems" by blast
   have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
   have one_not_zero: "1 \<noteq> (0::2)" by auto
   show ?case 
   proof (cases "\<not> ?a dvd ?b")
     case True
     let ?bezout_mat_right = "transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)"
     have "(P', D, Q') = diagonalize_2x2_aux (P, A, Q)" using "1.prems" by blast 
     also have "... = diagonalize_2x2_aux (P, A** ?bezout_mat_right, Q ** ?bezout_mat_right)"
       using True a_not_0 by (auto simp add: Let_def)
     finally have eq: "(P',D,Q') = ..." .
     show ?thesis
     proof (rule "1.hyps"(1)[OF  _ _ _ _ _ _ _ _ _ eq])
       have "invertible ?bezout_mat_right" 
         by (rule invertible_bezout_matrix_transpose[OF ib zero_less_one_type2 a_not_0])
       thus "invertible (Q ** ?bezout_mat_right)"
         using "1.prems" invertible_mult by blast
       show "A ** ?bezout_mat_right = P ** A_input ** (Q ** ?bezout_mat_right)"
         by (simp add: "1.prems" matrix_mul_assoc)    
       show "(A ** ?bezout_mat_right) $h 0 $h 0 \<noteq> 0"
         by (metis (no_types, lifting) a_not_0 bezout_matrix_works_transpose1 bezout_matrix_not_zero  
            bezout_matrix_works1 is_bezout_ext_euclid_ext2 one_neq_zero transpose_code transpose_row_code)
     qed (insert True a_not_0  "1.prems", blast+)
   next
     case False note a_dvd_b = False
     show ?thesis
     proof (cases "\<not> ?a dvd ?c")
       case True
       let ?bezout_mat = "(bezout_matrix A 0 1 0 euclid_ext2)"
       have "(P', D, Q') = diagonalize_2x2_aux (P, A, Q)" using "1.prems" by blast 
       also have "... = diagonalize_2x2_aux (?bezout_mat**P, ?bezout_mat ** A, Q)"
       using True a_dvd_b a_not_0 by (auto simp add: Let_def)
       finally have eq: "(P',D,Q') = ..." .
       show ?thesis 
       proof (rule "1.hyps"(2)[OF _ _ _ _ _ _ _ _ _ _ eq])
         have "invertible ?bezout_mat" 
         by (rule invertible_bezout_matrix[OF ib zero_less_one_type2 a_not_0])
         thus "invertible (?bezout_mat ** P)"
           using "1.prems" invertible_mult by blast
         show "?bezout_mat ** A = (?bezout_mat ** P) ** A_input ** Q"
           by (simp add: "1.prems" matrix_mul_assoc)
         show "(?bezout_mat ** A) $h 0 $h 0 \<noteq> 0"
           by (simp add: a_not_0 bezout_matrix_not_zero is_bezout_ext_euclid_ext2)
       qed (insert True a_not_0 a_dvd_b "1.prems", blast+)
     next
       case False
       hence a_dvd_c: "?a dvd ?c" by simp
       let ?Q' = "column_add (Finite_Cartesian_Product.mat 1) 1 0 (- (?b div ?a))::'a^2^2"
       let ?P' = "(row_add (Finite_Cartesian_Product.mat 1) 1 0 (- (?c div ?a)))::'a^2^2"
       have eq: "(P', D, Q') =  (?P'**P,?P'**A**?Q',Q**?Q')" 
         using "1.prems" a_dvd_b a_dvd_c a_not_0 by (auto simp add: Let_def)
       have d: "isDiagonal (?P'**A**?Q')"
       proof -
         {
         fix a b::2 assume a_not_b: "a \<noteq> b"
         have "(?P' ** A ** ?Q') $h a $h b = 0"
         proof (cases "(a,b) = (0,1)")
           case True
           hence a0: "a = 0" and b1: "b = 1" by auto
           have "(?P' ** A ** ?Q') $h a $h b = (?P' ** (A ** ?Q')) $h a $h b" 
             by (simp add: matrix_mul_assoc)
-          also have "... = (A**?Q') $h a $h b" unfolding row_add_mat_1
-            by (smt True a_not_b prod.sel(2) row_add_def vec_lambda_beta)
+          also have "... = (A**?Q') $h a $h b" 
+            by (simp add: row_add_mat_1 a0 row_add_code row_add_code_nth)
           also have "... = 0" unfolding column_add_mat_1 a0 b1
-            by (smt Groups.mult_ac(2) a_dvd_b ab_group_add_class.ab_left_minus add_0_left
-                add_diff_cancel_left' add_uminus_conv_diff column_add_code_nth column_add_row_def
-                comm_semiring_class.distrib dvd_div_mult_self vec_lambda_beta)
+            by (smt (verit, ccfv_threshold) a_dvd_b column_add_code column_add_code_nth
+                dvd_mult_div_cancel more_arith_simps(4) more_arith_simps(8))
           finally show ?thesis .
         next
           case False
           hence a1: "a = 1" and b0: "b = 0"
             by (metis (no_types, opaque_lifting) False a_not_b exhaust_2 zero_neq_one)+
           have "(?P' ** A ** ?Q') $h a $h b = (?P' ** A) $h a $h b" 
             unfolding a1 b0 column_add_mat_1
             by (simp add: column_add_code_nth column_add_row_def)
           also have "... = 0" unfolding row_add_mat_1 a1 b0
             by (simp add: a_dvd_c row_add_def)
           finally show ?thesis .
         qed}
       thus ?thesis unfolding isDiagonal_def by auto
       qed
       have inv_P': "invertible ?P'" by (rule invertible_row_add[OF one_not_zero])
       have inv_Q': "invertible ?Q'" by (rule invertible_column_add[OF one_not_zero])
       have "invertible (?P'**P)" using "1.prems"(2) inv_P' invertible_mult by blast
       moreover have "invertible (Q**?Q')" using "1.prems"(3) inv_Q' invertible_mult by blast
       moreover have "D = P' ** A_input ** Q'"
         by (metis (no_types, lifting) "1.prems"(1) Pair_inject eq matrix_mul_assoc)
       ultimately show ?thesis using eq d by auto
     qed    
   qed
 qed
 
 
 definition "diagonalize_2x2 A = 
   (if A $h 0 $h 0 = 0 then 
         if A $h 0 $h 1 \<noteq> 0 then 
             let A' = interchange_columns A 0 1;
                 Q' = interchange_columns (Finite_Cartesian_Product.mat 1) 0 1 in
             diagonalize_2x2_aux (Finite_Cartesian_Product.mat 1, A', Q')
         else 
             if A $h 1 $h 0 \<noteq> 0 then
                   let A' = interchange_rows A 0 1;
                       P' = interchange_rows (Finite_Cartesian_Product.mat 1) 0 1 in
                    diagonalize_2x2_aux (P', A', Finite_Cartesian_Product.mat 1)
             else (Finite_Cartesian_Product.mat 1,A,Finite_Cartesian_Product.mat 1)
    else diagonalize_2x2_aux (Finite_Cartesian_Product.mat 1,A,Finite_Cartesian_Product.mat 1)
 )"
 
 
 lemma diagonalize_2x2_works:
   assumes PDQ: "(P,D,Q) = diagonalize_2x2 A"
   shows "D = P ** A ** Q \<and> invertible P \<and> invertible Q \<and> isDiagonal D"
 proof -
   let ?a = "A $h 0 $h 0"
   let ?b = "A $h 0 $h 1"
   let ?c = "A $h 1 $h 0"
   let ?d = "A $h 1 $h 1"
   show ?thesis
   proof (cases "?a = 0")
     case False
     hence eq: "(P,D,Q) = diagonalize_2x2_aux (Finite_Cartesian_Product.mat 1,A,Finite_Cartesian_Product.mat 1)"
       using PDQ unfolding diagonalize_2x2_def by auto 
     show ?thesis 
       by (rule diagonalize_2x2_aux_works[OF _ _ _ eq False], auto simp add: invertible_mat_1)
   next
     case True note a0 = True
     show ?thesis
     proof (cases "?b \<noteq> 0")
       case True
       let ?A' = "interchange_columns A 0 1"
       let ?Q' = "(interchange_columns (Finite_Cartesian_Product.mat 1) 0 1)::'a^2^2"
       have eq: "(P,D,Q) = diagonalize_2x2_aux (Finite_Cartesian_Product.mat 1, ?A', ?Q')"
         using PDQ a0 True unfolding diagonalize_2x2_def by (auto simp add: Let_def)
       show ?thesis 
       proof (rule diagonalize_2x2_aux_works[OF _ _ _ eq _])
         show "?A' $h 0 $h 0 \<noteq> 0"
           by (simp add: True interchange_columns_code interchange_columns_code_nth)
         show "invertible ?Q'" by (simp add: invertible_interchange_columns)
         show "?A' = Finite_Cartesian_Product.mat 1 ** A ** ?Q'"
           by (simp add: interchange_columns_mat_1)
       qed (auto simp add: invertible_mat_1)
     next
       case False note b0 = False
       show ?thesis
       proof (cases "?c \<noteq> 0")
         case True
         let ?A' = "interchange_rows A 0 1"
         let ?P' = "(interchange_rows (Finite_Cartesian_Product.mat 1) 0 1)::'a^2^2"
         have eq: "(P,D,Q) = diagonalize_2x2_aux (?P', ?A',Finite_Cartesian_Product.mat 1)"
           using PDQ a0 b0 True unfolding diagonalize_2x2_def by (auto simp add: Let_def)
         show ?thesis 
         proof (rule diagonalize_2x2_aux_works[OF _ _ _ eq _])
           show "?A' $h 0 $h 0 \<noteq> 0"
             by (simp add: True interchange_columns_code interchange_columns_code_nth)
           show "invertible ?P'" by (simp add: invertible_interchange_rows)
           show "?A' = ?P' ** A ** Finite_Cartesian_Product.mat 1"
             by (simp add: interchange_rows_mat_1)
         qed (auto simp add: invertible_mat_1)
       next
         case False
         have eq: "(P,D,Q) = (Finite_Cartesian_Product.mat 1, A,Finite_Cartesian_Product.mat 1)"
           using PDQ a0 b0 True False unfolding diagonalize_2x2_def by (auto simp add: Let_def)
         have "isDiagonal A" unfolding isDiagonal_def using a0 b0 True False
           by (metis (full_types) exhaust_2 one_neq_zero) 
         thus ?thesis using invertible_mat_1 eq by auto
       qed  
     qed
   qed
 qed
   
 
 definition "diagonalize_2x2_JNF (A::'a::euclidean_ring_gcd mat) 
   = (let (P,D,Q) = diagonalize_2x2 (Mod_Type_Connect.to_hma\<^sub>m A::'a^2^2) in 
   (Mod_Type_Connect.from_hma\<^sub>m P,Mod_Type_Connect.from_hma\<^sub>m D,Mod_Type_Connect.from_hma\<^sub>m Q))"
 
 
 (*Obtained via transfer rules*)
 lemma diagonalize_2x2_JNF_works:
   assumes A: "A \<in> carrier_mat 2 2"
   and PDQ: "(P,D,Q) = diagonalize_2x2_JNF A"
   shows "D = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> isDiagonal_mat D \<and> P\<in>carrier_mat 2 2
   \<and> Q \<in> carrier_mat 2 2 \<and> D \<in> carrier_mat 2 2"
 proof -
   let ?A = "(Mod_Type_Connect.to_hma\<^sub>m A::'a^2^2)"
   have A[transfer_rule]: "Mod_Type_Connect.HMA_M A ?A" 
     using A unfolding Mod_Type_Connect.HMA_M_def by auto
   obtain P_HMA D_HMA Q_HMA where PDQ_HMA: "(P_HMA,D_HMA,Q_HMA) = diagonalize_2x2 ?A" 
     by (metis prod_cases3)
 (*  have "HMA_M3 (diagonalize_2x2_JNF A) (diagonalize_2x2 ?A)"
     using HMA_diagonalize_2x2 A rel_funE by fastforce*)  
   have P: "P = Mod_Type_Connect.from_hma\<^sub>m P_HMA" and Q: "Q = Mod_Type_Connect.from_hma\<^sub>m Q_HMA" 
     and D: "D = Mod_Type_Connect.from_hma\<^sub>m D_HMA" 
     using PDQ_HMA PDQ unfolding diagonalize_2x2_JNF_def 
     by (metis prod.simps(1) split_conv)+ 
   have [transfer_rule]: "Mod_Type_Connect.HMA_M P P_HMA" 
     unfolding Mod_Type_Connect.HMA_M_def using P by auto
   have [transfer_rule]: "Mod_Type_Connect.HMA_M Q Q_HMA" 
     unfolding Mod_Type_Connect.HMA_M_def using Q by auto
   have [transfer_rule]: "Mod_Type_Connect.HMA_M D D_HMA" 
     unfolding Mod_Type_Connect.HMA_M_def using D by auto
   have r: "D_HMA = P_HMA ** ?A ** Q_HMA \<and> invertible P_HMA \<and> invertible Q_HMA \<and> isDiagonal D_HMA"
     by (rule diagonalize_2x2_works[OF PDQ_HMA])
   have "D = P * A * Q \<and> invertible_mat P \<and> invertible_mat Q \<and> isDiagonal_mat D" 
     using r by (transfer, rule)
   thus ?thesis using P Q D by auto 
 qed
 
 
 
 (*The full algorithm in HOL Analysis*)
 definition "Smith_2x2_eucl A = (
   let (P,D,Q) = diagonalize_2x2 A;
       (P',S,Q') = diagonal_to_Smith_PQ D euclid_ext2
   in (P' ** P, S, Q ** Q'))"
 
 lemma Smith_2x2_eucl_works:
   assumes PBQ: "(P,S,Q) = Smith_2x2_eucl A"
   shows "S = P ** A ** Q \<and> invertible P \<and> invertible Q \<and> Smith_normal_form S"   
 proof -
   have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
   obtain P1 D Q1 where P1DQ1: "(P1,D,Q1) = diagonalize_2x2 A" by (metis prod_cases3)
   obtain P2 S' Q2 where P2SQ2:"(P2,S',Q2) = diagonal_to_Smith_PQ D euclid_ext2" 
     by (metis prod_cases3)
   have P: "P = P2 ** P1" and S: "S = S'" and Q: "Q = Q1 ** Q2"
     by (metis (mono_tags, lifting) PBQ Pair_inject Smith_2x2_eucl_def P1DQ1 P2SQ2 old.prod.case)+
   have 1: "D = P1 ** A ** Q1 \<and> invertible P1 \<and> invertible Q1 \<and> isDiagonal D" 
     by (rule diagonalize_2x2_works[OF P1DQ1])
   have 2: "S' = P2 ** D ** Q2 \<and> invertible P2 \<and> invertible Q2 \<and> Smith_normal_form S'"
     by (rule diagonal_to_Smith_PQ'[OF _ ib P2SQ2], insert 1, auto)
   show ?thesis using 1 2 P S Q by (simp add: 2 invertible_mult matrix_mul_assoc)
 qed
 
 
 subsection \<open>An executable algorithm to transform $2 \times 2$ matrices into its Smith normal form
 in JNF\<close>
 (*The full algorithm in JNF*)
 definition "Smith_2x2_JNF_eucl A = (
   let (P,D,Q) = diagonalize_2x2_JNF A;
       (P',S,Q') = diagonal_to_Smith_PQ_JNF D euclid_ext2
   in (P' * P, S, Q * Q'))"
 
 lemma Smith_2x2_JNF_eucl_works:
   assumes A: "A \<in> carrier_mat 2 2"
     and PBQ: "(P,S,Q) = Smith_2x2_JNF_eucl A"
   shows "is_SNF A (P,S,Q)"
 proof -
   have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
   obtain P1 D Q1 where P1DQ1: "(P1,D,Q1) = diagonalize_2x2_JNF A" by (metis prod_cases3)
   obtain P2 S' Q2 where P2SQ2: "(P2,S',Q2) = diagonal_to_Smith_PQ_JNF D euclid_ext2" 
     by (metis prod_cases3)
   have P: "P = P2 * P1" and S: "S = S'" and Q: "Q = Q1 * Q2"
     by (metis (mono_tags, lifting) PBQ Pair_inject Smith_2x2_JNF_eucl_def P1DQ1 P2SQ2 old.prod.case)+             
   have 1: "D = P1 * A * Q1 \<and> invertible_mat P1 \<and> invertible_mat Q1 \<and> isDiagonal_mat D
     \<and> P1 \<in> carrier_mat 2 2 \<and> Q1 \<in> carrier_mat 2 2 \<and> D \<in> carrier_mat 2 2"
     by (rule diagonalize_2x2_JNF_works[OF A P1DQ1])
   have 2: "S' = P2 * D * Q2 \<and> invertible_mat P2 \<and> invertible_mat Q2 \<and> Smith_normal_form_mat S' 
         \<and> P2 \<in> carrier_mat 2 2 \<and> S' \<in> carrier_mat 2 2 \<and> Q2 \<in> carrier_mat 2 2"
     by (rule diagonal_to_Smith_PQ_JNF[OF _ ib _ P2SQ2], insert 1, auto)
   show ?thesis
   proof (rule is_SNF_intro)
     have dim_Q: "Q \<in> carrier_mat 2 2" using Q 1 2 by auto
     have P1AQ1: "(P1*A*Q1) \<in> carrier_mat 2 2" using 1 2 A by auto
     have rw1: "(P1 * A * Q1) * Q2 = (P1 * A * (Q1 * Q2))" 
       by (meson "1" "2" A assoc_mult_mat mult_carrier_mat)
     have rw2: "(P1 * A * Q) = P1 * (A * Q)" by (rule assoc_mult_mat[OF _ A dim_Q], insert 1, auto)
     show "invertible_mat Q" using 1 2 Q invertible_mult_JNF by blast
     show "invertible_mat P" using 1 2 P invertible_mult_JNF by blast
     have "P2 * D * Q2 = P2 * (P1 * A * Q1) * Q2" using 1 2 by auto   
     also have "... = P2 * ((P1 * A * Q1) * Q2)" using 1 2 by auto
     also have "... = P2 * (P1 * A * (Q1 * Q2))" unfolding rw1 by simp
     also have "... = P2 * (P1 * A * Q)" using Q by auto
     also have "... = P2 * (P1 * (A * Q))" unfolding rw2 by simp
     also have "... = P2 * P1 * (A * Q)" by (rule assoc_mult_mat[symmetric], insert 1 2 A Q, auto)
     also have "... = P*(A*Q)" unfolding P by simp
-    also have "... = P*A*Q" by (rule assoc_mult_mat[symmetric], insert 1 2 A Q P, auto)
+    also have "... = P*A*Q"
+      by (smt (verit, ccfv_SIG) "1" "2" A P assoc_mult_mat dim_Q mult_carrier_mat)
     finally show "S = P * A * Q" using 1 2 S by auto
   qed (insert 1 2 P Q A S, auto)
 qed
 
 subsection \<open>An executable algorithm to transform $1 \times 2$ matrices into its Smith normal form\<close>
 
 (*Let's move to prove the case 1x2*)
 
 (*This is not executable since type 1 is not mod_type*)
 definition "Smith_1x2_eucl (A::'a::euclidean_ring_gcd^2^1) = (
   if A $h 0 $h 0 = 0 \<and> A $h 0 $h 1 \<noteq> 0 then 
     let Q = interchange_columns (Finite_Cartesian_Product.mat 1) 0 1;
         A' = interchange_columns A 0 1 in (A',Q)
   else
     if A $h 0 $h 0 \<noteq> 0 \<and> A $h 0 $h 1 \<noteq> 0 then
       let bezout_matrix_right = transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)
       in (A ** bezout_matrix_right, bezout_matrix_right)
     else (A, Finite_Cartesian_Product.mat 1)
   )"
 
 
 lemma Smith_1x2_eucl_works:
   assumes SQ: "(S,Q) = Smith_1x2_eucl A"
   shows "S = A ** Q \<and> invertible Q \<and> S $h 0 $h 1 = 0"
 proof (cases "A $h 0 $h 0 = 0 \<and> A $h 0 $h 1 \<noteq> 0")
   case True
   have Q: "Q = interchange_columns (Finite_Cartesian_Product.mat 1) 0 1"
     and S: "S = interchange_columns A 0 1" 
     using SQ True unfolding Smith_1x2_eucl_def by (auto simp add: Let_def)
   have "S $h 0 $h 1 = 0" by (simp add: S True interchange_columns_code interchange_columns_code_nth)
   moreover have "invertible Q" using Q invertible_interchange_columns by blast
   moreover have "S = A ** Q" by (simp add: Q S interchange_columns_mat_1)
   ultimately show ?thesis by simp
 next
   case False note A00_A01 = False
   show ?thesis
   proof (cases "A $h 0 $h 0 \<noteq> 0 \<and> A $h 0 $h 1 \<noteq> 0")
     case True
     have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
     let ?bezout_matrix_right = "transpose (bezout_matrix (transpose A) 0 1 0 euclid_ext2)"
     have Q: "Q = ?bezout_matrix_right" and S: "S = A**?bezout_matrix_right" 
       using SQ True A00_A01 unfolding Smith_1x2_eucl_def by (auto simp add: Let_def)
     have "invertible Q" unfolding Q
       by (rule invertible_bezout_matrix_transpose[OF ib zero_less_one_type2], insert True, auto)
     moreover have "S $h 0 $h 1 = 0"
-      by (smt Finite_Cartesian_Product.transpose_transpose S True bezout_matrix_works2 ib 
+      by (smt (verit) Finite_Cartesian_Product.transpose_transpose S True bezout_matrix_works2 ib 
           matrix_transpose_mul rel_simps(92) transpose_code transpose_row_code)
     moreover have "S = A**Q" unfolding S Q by simp
     ultimately show ?thesis by simp
   next
     case False
     have Q: "Q = (Finite_Cartesian_Product.mat 1)" and S: "S = A" 
       using SQ False A00_A01 unfolding Smith_1x2_eucl_def by (auto simp add: Let_def)
     show ?thesis using False A00_A01 S Q invertible_mat_1 by auto
   qed
 qed
 
 
 (*Bezout_matrix in JNF*)
 definition bezout_matrix_JNF :: "'a::comm_ring_1 mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat 
     \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a \<times> 'a \<times> 'a \<times> 'a)) \<Rightarrow> 'a mat"
   where 
   "bezout_matrix_JNF A a b j bezout = Matrix.mat (dim_row A) (dim_row A) (\<lambda>(x,y). 
       (let 
         (p, q, u, v, d) = bezout (A $$ (a, j)) (A $$ (b, j)) 
        in
          if x = a \<and> y = a then p else
          if x = a \<and> y = b then q else
          if x = b \<and> y = a then u else
          if x = b \<and> y = b then v else
          if x = y then 1 else 0))"
 
 
 definition "Smith_1x2_eucl_JNF (A::'a::euclidean_ring_gcd mat) = (
   if A $$ (0, 0) = 0 \<and> A $$ (0, 1) \<noteq> 0 then 
     let Q = swaprows_mat 2 0 1;
         A' = swapcols 0 1 A 
      in (A',Q)
   else
     if A $$ (0, 0) \<noteq> 0 \<and> A $$ (0, 1) \<noteq> 0 then
       let bezout_matrix_right = transpose_mat (bezout_matrix_JNF (transpose_mat A) 0 1 0 euclid_ext2)
       in (A * bezout_matrix_right, bezout_matrix_right)
     else (A, 1\<^sub>m 2)
   )"
 
 
 lemma Smith_1x2_eucl_JNF_works:
   assumes A: "A \<in> carrier_mat 1 2"
   and SQ: "(S,Q) = Smith_1x2_eucl_JNF A"
 shows "is_SNF A (1\<^sub>m 1, (Smith_1x2_eucl_JNF A))"
 proof -
   have i: "0<dim_row A" and j: "1<dim_col A" using A by auto
   have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
   show ?thesis
   proof (cases "A $$ (0, 0) = 0 \<and> A $$ (0, 1) \<noteq> 0")
     case True
     have Q: "Q = swaprows_mat 2 0 1"
       and S: "S = swapcols 0 1 A"
       using SQ True unfolding Smith_1x2_eucl_JNF_def by (auto simp add: Let_def)
     have S01: "S $$ (0,1) = 0" unfolding S using index_mat_swapcols j i True by simp
     have dim_S: "S \<in> carrier_mat 1 2" using S A by auto
     moreover have dim_Q: "Q \<in> carrier_mat 2 2" using S Q by auto
     moreover have "invertible_mat Q" (*TODO: better a lemma for invertible swaprows_mat, etc*)
     proof -
       have "Determinant.det (swaprows_mat 2 0 1) = -1" by (rule det_swaprows_mat, auto)
       also have "... dvd 1" by simp
       finally show ?thesis using Q dim_Q invertible_iff_is_unit_JNF by blast
     qed
     moreover have "S = A * Q" unfolding S Q using A by (simp add: swapcols_mat)
     moreover have "Smith_normal_form_mat S" unfolding Smith_normal_form_mat_def isDiagonal_mat_def
       using S01 dim_S less_2_cases by fastforce
     ultimately show ?thesis using SQ S Q A unfolding is_SNF_def by auto
   next
     case False note A00_A01 = False
     show ?thesis
     proof (cases "A $$ (0,0) \<noteq> 0 \<and> A $$ (0,1) \<noteq> 0")
       case True
       have ib: "is_bezout_ext euclid_ext2" by (simp add: is_bezout_ext_euclid_ext2)
       let ?BM = "(bezout_matrix_JNF A\<^sup>T 0 1 0 euclid_ext2)\<^sup>T"
       have Q: "Q = ?BM" and S: "S = A*?BM" 
         using SQ True A00_A01 unfolding Smith_1x2_eucl_JNF_def by (auto simp add: Let_def)
       let ?a = "A $$ (0, 0)" let ?b = "A $$ (0, Suc 0)"
       obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 ?a ?b" by (metis prod_cases5)
       have d: "p*?a + q*?b = d" and u: "u = - ?b div d" and v: "v = ?a div d" 
         using pquvd unfolding euclid_ext2_def using bezout_coefficients_fst_snd by blast+   
       have da: "d dvd ?a" and db: "d dvd ?b" and gcd_ab: "d = gcd ?a ?b" 
         by (metis euclid_ext2_def gcd_dvd1 gcd_dvd2 pquvd prod.sel(2))+
       have dim_S: "S \<in> carrier_mat 1 2" using S A by (simp add: bezout_matrix_JNF_def)
       moreover have dim_Q: "Q \<in> carrier_mat 2 2" using A Q by (simp add: bezout_matrix_JNF_def)
       have "invertible_mat Q" 
       proof -
         have "Determinant.det ?BM = ?BM $$ (0, 0) * ?BM $$ (1, 1) - ?BM $$ (0, 1) * ?BM $$ (1, 0)"
           by (rule det_2, insert A, auto simp add: bezout_matrix_JNF_def)
         also have "... = p * v - u*q" 
           by (insert i j pquvd, auto simp add: bezout_matrix_JNF_def, metis split_conv)
         also have "... = (p * ?a) div d - (q * (-?b)) div d" unfolding v u
           by (simp add: da db div_mult_swap mult.commute)
         also have "... = (p * ?a + q * ?b) div d"
           by (metis (no_types, lifting) da db diff_minus_eq_add div_diff dvd_minus_iff dvd_trans 
               dvd_triv_right more_arith_simps(8))
         also have "... = 1 " unfolding d using True da by fastforce
         finally show ?thesis unfolding Q 
           by (metis (full_types) Determinant.det_def Q carrier_matI invertible_iff_is_unit_JNF 
               not_is_unit_0 one_dvd)
       qed
       moreover have S_AQ: "S = A*Q" unfolding S Q by simp
       moreover have S01: "S $$ (0,1) = 0"
       proof -
         have Q01: "Q $$ (0, 1) = u"
         proof -
           have "?BM $$ (0,1) = (bezout_matrix_JNF A\<^sup>T 0 1 0 euclid_ext2) $$ (1, 0)"
             using Q dim_Q by auto
           also have "... =  (\<lambda>(x::nat, y::nat).
           let (p, q, u, v, d) = euclid_ext2 (A\<^sup>T $$ (0, 0)) (A\<^sup>T $$ (1, 0)) in if x = 0 \<and> y = 0 then p
             else if x = 0 \<and> y = 1 then q else if x = 1 \<and> y = 0 then u else if x = 1 \<and> y = 1 then v
             else if x = y then 1 else 0) (1, 0)"
             unfolding bezout_matrix_JNF_def by (rule index_mat(1), insert A, auto)
           also have "... = u" using pquvd unfolding split_beta Let_def
             by (auto, metis A One_nat_def carrier_matD(2) fst_conv i index_transpose_mat(1) 
                 j rel_simps(51) snd_conv)   
           finally show ?thesis unfolding Q by auto
         qed
         have Q11: "Q $$ (1, 1) = v"
         proof -
           have "?BM $$ (1,1) = (bezout_matrix_JNF A\<^sup>T 0 1 0 euclid_ext2) $$ (1, 1)"
             using Q dim_Q by auto
           also have "... =  (\<lambda>(x::nat, y::nat).
           let (p, q, u, v, d) = euclid_ext2 (A\<^sup>T $$ (0, 0)) (A\<^sup>T $$ (1, 0)) in if x = 0 \<and> y = 0 then p
             else if x = 0 \<and> y = 1 then q else if x = 1 \<and> y = 0 then u else if x = 1 \<and> y = 1 then v
             else if x = y then 1 else 0) (1, 1)"
             unfolding bezout_matrix_JNF_def by (rule index_mat(1), insert A, auto)
           also have "... = v" using pquvd unfolding split_beta Let_def
             by (auto, metis A One_nat_def carrier_matD(2) fst_conv i index_transpose_mat(1) 
                 j rel_simps(51) snd_conv)   
           finally show ?thesis unfolding Q by auto
         qed      
         have "S $$ (0,1) = Matrix.row A 0 \<bullet> col Q 1" using index_mult_mat Q S dim_S i by auto        
         also have "... = (\<Sum>i = 0..<2. Matrix.row A 0 $v i * Q $$ (i, 1))"
           unfolding scalar_prod_def using dim_S dim_Q by auto
         also have "... = (\<Sum>i \<in> {0,1}. Matrix.row A 0 $v i * Q $$ (i, 1))" by (rule sum.cong, auto)
         also have "... = Matrix.row A 0 $v 0 * Q $$ (0, 1) + Matrix.row A 0 $v 1 * Q $$ (1, 1)" 
           using sum_two_elements by auto
         also have "... =  ?a*u + ?b * v" unfolding Q01 Q11 using i index_row(1) j A by auto          
         also have "... = 0" unfolding u v
-          by (smt Groups.mult_ac(2) Groups.mult_ac(3) add.right_inverse add_uminus_conv_diff da db 
+          by (smt (verit) Groups.mult_ac(2) Groups.mult_ac(3) add.right_inverse add_uminus_conv_diff da db 
               diff_minus_eq_add dvd_div_mult_self dvd_neg_div minus_mult_left)
         finally show ?thesis .
       qed
       moreover have "Smith_normal_form_mat S" 
         using less_2_cases S01 dim_S unfolding Smith_normal_form_mat_def isDiagonal_mat_def
         by fastforce
       ultimately show ?thesis using S Q A SQ unfolding is_SNF_def bezout_matrix_JNF_def by force
     next
       case False
       have Q: "Q = 1\<^sub>m 2" and S: "S = A" 
         using SQ False A00_A01 unfolding Smith_1x2_eucl_JNF_def by (auto simp add: Let_def)
       have "is_SNF A (1\<^sub>m 1, A, 1\<^sub>m 2)"
         by (rule is_SNF_intro, insert A False A00_A01 S Q A less_2_cases, 
           unfold Smith_normal_form_mat_def isDiagonal_mat_def, fastforce+)
       thus ?thesis using SQ S Q by auto
     qed
   qed
 qed
 
 subsection \<open>The final executable algorithm to transform any matrix into its Smith normal form\<close>
 
 global_interpretation Smith_ED: Smith_Impl Smith_1x2_eucl_JNF Smith_2x2_JNF_eucl "(div)"
   defines Smith_ED_1xn_aux = Smith_ED.Smith_1xn_aux
     and Smith_ED_nx1 = Smith_ED.Smith_nx1
   and Smith_ED_1xn = Smith_ED.Smith_1xn
   and Smith_ED_2xn = Smith_ED.Smith_2xn
   and Smith_ED_nx2 = Smith_ED.Smith_nx2
   and Smith_ED_mxn = Smith_ED.Smith_mxn
 proof 
   show "\<forall>(A::'a mat)\<in>carrier_mat 1 2. is_SNF A (1\<^sub>m 1, Smith_1x2_eucl_JNF A)"
     using Smith_1x2_eucl_JNF_works prod.collapse by blast
   show "\<forall>A\<in>carrier_mat 2 2. is_SNF A (Smith_2x2_JNF_eucl A)"
     by (simp add: Smith_2x2_JNF_eucl_def Smith_2x2_JNF_eucl_works split_beta)
   show "is_div_op ((div)::'a\<Rightarrow>'a\<Rightarrow>'a::euclidean_ring_gcd)"
     by (unfold is_div_op_def, simp)
 qed
 
 
 (*
 value[code] "let (P,S,Q) = diagonalize_2x2 ((list_of_list_to_matrix [[32,128],[24,20]])::int^2^2)
   in (matrix_to_list_of_list P,matrix_to_list_of_list S,matrix_to_list_of_list Q)"
 value [code]  "show (diagonalize_2x2_JNF (mat_of_rows_list 2 [[1,2::int],[3,4]]))"
 *)
 
 
 (*
 value [code]  "show (Smith_ED_mxn (mat_of_rows_list 2 [[1,2::int],[3,4]]))"
 
 value [code]  "show (Smith_ED_mxn (mat_of_rows_list 2 
   [
     [[:2,4,1:]::rat poly, [:3,2,0,2:]],
     [[:0,2:]  , [:3,2:]]
   ]
 ))"
 *)
 
 
 end
\ No newline at end of file
diff --git a/thys/Smith_Normal_Form/SNF_Missing_Lemmas.thy b/thys/Smith_Normal_Form/SNF_Missing_Lemmas.thy
--- a/thys/Smith_Normal_Form/SNF_Missing_Lemmas.thy
+++ b/thys/Smith_Normal_Form/SNF_Missing_Lemmas.thy
@@ -1,1168 +1,1172 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Missing results\<close>
 
 theory SNF_Missing_Lemmas
   imports
     Hermite.Hermite
     Mod_Type_Connect
     Jordan_Normal_Form.DL_Rank_Submatrix
     "List-Index.List_Index"
 begin
 
 text \<open>This theory presents some missing lemmas that are required for the Smith normal form
 development. Some of them could be added to different AFP entries, such as the Jordan Normal
 Form AFP entry by Ren\'e Thiemann and Akihisa Yamada.
 
 However, not all the lemmas can be added directly, since some imports are required.\<close>
 
 hide_const (open) C
 hide_const (open) measure
 
 subsection \<open>Miscellaneous lemmas\<close>
 
 lemma sum_two_rw: "(\<Sum>i = 0..<2. f i) = (\<Sum>i \<in> {0,1::nat}. f i)"
   by (rule sum.cong, auto)
 
 lemma sum_common_left:
   fixes f::"'a \<Rightarrow> 'b::comm_ring_1"
   assumes "finite A"
   shows "sum (\<lambda>i. c * f i) A = c * sum f A"
   by (simp add: mult_hom.hom_sum)
 
 lemma prod3_intro:
   assumes "fst A = a" and "fst (snd A) = b" and "snd (snd A) = c"
   shows "A = (a,b,c)" using assms by auto
 
 
 subsection \<open>Transfer rules for the HMA\_Connect file of the Perron-Frobenius development\<close>
 
 hide_const (open) HMA_M HMA_I to_hma\<^sub>m from_hma\<^sub>m
 hide_fact (open) from_hma\<^sub>m_def from_hma_to_hma\<^sub>m HMA_M_def HMA_I_def dim_row_transfer_rule
                   dim_col_transfer_rule
 
 context
   includes lifting_syntax
 begin
 
 lemma HMA_invertible_matrix[transfer_rule]:
   "((HMA_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n ^ 'n \<Rightarrow> _) ===> (=)) invertible_mat invertible"
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note rel_xy[transfer_rule] = "1"
   have eq_dim: "dim_col x = dim_row x"
     using HMA_Connect.dim_col_transfer_rule HMA_Connect.dim_row_transfer_rule rel_xy
     by fastforce
   moreover have "\<exists>A'. y ** A' = Finite_Cartesian_Product.mat 1 \<and> A' ** y = Finite_Cartesian_Product.mat 1"
     if xB: "x * B = 1\<^sub>m (dim_row x)" and Bx: "B * x = 1\<^sub>m (dim_row B)" for B
   proof -
     let ?A' = "HMA_Connect.to_hma\<^sub>m B:: 'a :: comm_ring_1 ^ 'n ^ 'n"
     have rel_BA[transfer_rule]: "HMA_M B ?A'"
       by (metis (no_types, lifting) Bx HMA_M_def eq_dim carrier_mat_triv dim_col_mat(1)
           from_hma\<^sub>m_def from_hma_to_hma\<^sub>m index_mult_mat(3) index_one_mat(3) rel_xy xB)
     have [simp]: "dim_row B = CARD('n)" using dim_row_transfer_rule rel_BA by blast
     have [simp]: "dim_row x = CARD('n)" using dim_row_transfer_rule rel_xy by blast
     have "y ** ?A' = Finite_Cartesian_Product.mat 1" using xB by (transfer, simp)
     moreover have "?A' ** y  = Finite_Cartesian_Product.mat 1" using Bx by (transfer, simp)
     ultimately show ?thesis by blast
   qed
   moreover have "\<exists>B. x * B = 1\<^sub>m (dim_row x) \<and> B * x = 1\<^sub>m (dim_row B)"
     if yA: "y ** A' = Finite_Cartesian_Product.mat 1" and Ay: "A' ** y = Finite_Cartesian_Product.mat 1" for A'
   proof -
     let ?B = "(from_hma\<^sub>m A')"
     have [simp]: "dim_row x = CARD('n)" using dim_row_transfer_rule rel_xy by blast
     have [transfer_rule]: "HMA_M ?B A'" by (simp add: HMA_M_def)
     hence [simp]: "dim_row ?B = CARD('n)" using dim_row_transfer_rule by auto
     have "x * ?B = 1\<^sub>m (dim_row x)" using yA by (transfer', auto)
     moreover have "?B * x = 1\<^sub>m (dim_row ?B)" using Ay by (transfer', auto)
     ultimately show ?thesis by auto
   qed
   ultimately show ?case unfolding invertible_mat_def invertible_def inverts_mat_def by auto
 qed
 end
 
 subsection \<open>Lemmas obtained from HOL Analysis using local type definitions\<close>
 
 thm Cartesian_Space.invertible_mult (*In HOL Analysis*)
 thm invertible_iff_is_unit (*In HOL Analysis*)
 thm det_non_zero_imp_unit (*In JNF, but only for fields*)
 thm mat_mult_left_right_inverse (*In JNF, but only for fields*)
 
 lemma invertible_mat_zero:
   assumes A: "A \<in> carrier_mat 0 0"
   shows "invertible_mat A"
   using A unfolding invertible_mat_def inverts_mat_def one_mat_def times_mat_def scalar_prod_def
     Matrix.row_def col_def carrier_mat_def
   by (auto, metis (no_types, lifting) cong_mat not_less_zero)
 
 lemma invertible_mult_JNF:
   fixes A::"'a::comm_ring_1 mat"
   assumes A: "A\<in>carrier_mat n n" and B: "B\<in>carrier_mat n n"
     and inv_A: "invertible_mat A" and inv_B: "invertible_mat B"
 shows "invertible_mat (A*B)"
 proof (cases "n = 0")
   case True
   then show ?thesis using assms
     by (simp add: invertible_mat_zero)
 next
   case False
   then show ?thesis using
       invertible_mult[where ?'a="'a::comm_ring_1", where ?'b="'n::finite", where ?'c="'n::finite",
       where ?'d="'n::finite", untransferred, cancel_card_constraint, OF assms] by auto
 qed
 
 lemma invertible_iff_is_unit_JNF:
   assumes A: "A \<in> carrier_mat n n"
   shows "invertible_mat A \<longleftrightarrow> (Determinant.det A) dvd 1"
 proof (cases "n=0")
   case True
   then show ?thesis using det_dim_zero invertible_mat_zero A by auto
 next
   case False
   then show ?thesis using invertible_iff_is_unit[untransferred, cancel_card_constraint] A by auto
 qed
 
 
 subsection \<open>Lemmas about matrices, submatrices and determinants\<close>
 
 (*This is a generalization of thm mat_mult_left_right_inverse*)
 thm mat_mult_left_right_inverse
 lemma mat_mult_left_right_inverse:
   fixes A :: "'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n n"
     and B: "B \<in> carrier_mat n n" and AB: "A * B = 1\<^sub>m n"
   shows "B * A = 1\<^sub>m n"
 proof -
   have "Determinant.det (A * B) = Determinant.det (1\<^sub>m n)" using AB by auto
   hence "Determinant.det A * Determinant.det B = 1"
     using Determinant.det_mult[OF A B] det_one by auto
   hence det_A: "(Determinant.det A) dvd 1" and det_B: "(Determinant.det B) dvd 1"
     using dvd_triv_left dvd_triv_right by metis+
   hence inv_A: "invertible_mat A" and inv_B: "invertible_mat B"
     using A B invertible_iff_is_unit_JNF by blast+
   obtain B' where inv_BB': "inverts_mat B B'" and inv_B'B: "inverts_mat B' B"
     using inv_B unfolding invertible_mat_def by auto
   have B'_carrier: "B' \<in> carrier_mat n n"
     by (metis B inv_B'B inv_BB' carrier_matD(1) carrier_matD(2) carrier_mat_triv
         index_mult_mat(3) index_one_mat(3) inverts_mat_def)
   have "B * A * B = B" using A AB B by auto
   hence "B * A * (B * B') = B * B'"
-    by (smt A AB B B'_carrier assoc_mult_mat carrier_matD(1) inv_BB' inverts_mat_def one_carrier_mat)
+    by (smt (verit, best) A B B'_carrier assoc_mult_mat mult_carrier_mat)
   thus ?thesis
     by (metis A B carrier_matD(1) carrier_matD(2) index_mult_mat(3) inv_BB'
         inverts_mat_def right_mult_one_mat')
 qed
 
 context comm_ring_1
 begin
 
 lemma col_submatrix_UNIV:
 assumes "j < card {i. i < dim_col A \<and> i \<in> J}"
 shows "col (submatrix A UNIV J) j = col A (pick J j)"
 proof (rule eq_vecI)
   show dim_eq:"dim_vec (col (submatrix A UNIV J) j) = dim_vec (col A (pick J j))"
     by (simp add: dim_submatrix(1))
   fix i assume "i < dim_vec (col A (pick J j))"
   show "col (submatrix A UNIV J) j $v i = col A (pick J j) $v i"
-    by (smt Collect_cong assms col_def dim_col dim_eq dim_submatrix(1)
+    by (smt (verit) Collect_cong assms col_def dim_col dim_eq dim_submatrix(1)
         eq_vecI index_vec pick_UNIV submatrix_index)
 qed
 
 lemma submatrix_split2: "submatrix A I J = submatrix (submatrix A I UNIV) UNIV J" (is "?lhs = ?rhs")
 proof (rule eq_matI)
   show dr: "dim_row ?lhs = dim_row ?rhs"
     by (simp add: dim_submatrix(1))
   show dc: "dim_col ?lhs = dim_col ?rhs"
     by (simp add: dim_submatrix(2))
   fix i j assume i: "i < dim_row ?rhs"
     and j: "j < dim_col ?rhs"
   have "?rhs $$ (i, j) = (submatrix A I UNIV) $$ (pick UNIV i, pick J j)"
   proof (rule submatrix_index)
     show "i < card {i. i < dim_row (submatrix A I UNIV) \<and> i \<in> UNIV}"
       by (metis (full_types) dim_submatrix(1) i)
     show "j < card {j. j < dim_col (submatrix A I UNIV) \<and> j \<in> J}"
       by (metis (full_types) dim_submatrix(2) j)
   qed
   also have "... = A $$ (pick I (pick UNIV i), pick UNIV (pick J j))"
   proof (rule submatrix_index)
     show "pick UNIV i < card {i. i < dim_row A \<and> i \<in> I}"
       by (metis (full_types) dr dim_submatrix(1) i pick_UNIV)
     show "pick J j < card {j. j < dim_col A \<and> j \<in> UNIV}"
       by (metis (full_types) dim_submatrix(2) j pick_le)
   qed
   also have "... = ?lhs $$ (i,j)"
   proof (unfold pick_UNIV, rule submatrix_index[symmetric])
     show "i < card {i. i < dim_row A \<and> i \<in> I}"
       by (metis (full_types) dim_submatrix(1) dr i)
     show "j < card {j. j < dim_col A \<and> j \<in> J}"
       by (metis (full_types) dim_submatrix(2) dc j)
   qed
   finally show "?lhs $$ (i, j) = ?rhs $$ (i, j)" ..
 qed
 
 lemma submatrix_mult:
   "submatrix (A*B) I J = submatrix A I UNIV * submatrix B UNIV J" (is "?lhs = ?rhs")
 proof (rule eq_matI)
   show "dim_row ?lhs = dim_row ?rhs" unfolding submatrix_def by auto
   show "dim_col ?lhs = dim_col ?rhs" unfolding submatrix_def by auto
   fix i j assume i: "i < dim_row ?rhs" and j: "j < dim_col ?rhs"
   have i1: "i < card {i. i < dim_row (A * B) \<and> i \<in> I}"
     by (metis (full_types) dim_submatrix(1) i index_mult_mat(2))
   have j1: "j < card {j. j < dim_col (A * B) \<and> j \<in> J}"
     by (metis dim_submatrix(2) index_mult_mat(3) j)
   have pi: "pick I i < dim_row A" using i1 pick_le by auto
   have pj: "pick J j < dim_col B" using j1 pick_le by auto
   have row_rw: "Matrix.row (submatrix A I UNIV) i = Matrix.row A (pick I i)"
     using i1 row_submatrix_UNIV by auto
   have col_rw: "col (submatrix B UNIV J) j = col B (pick J j)" using j1 col_submatrix_UNIV by auto
   have "?lhs $$ (i,j) =  (A*B) $$ (pick I i, pick J j)" by (rule submatrix_index[OF i1 j1])
   also have "... = Matrix.row A (pick I i) \<bullet> col B (pick J j)" by (rule index_mult_mat(1)[OF pi pj])
   also have "... = Matrix.row (submatrix A I UNIV) i \<bullet> col (submatrix B UNIV J) j"
     using row_rw col_rw by simp
   also have "... = (?rhs) $$ (i,j)" by (rule index_mult_mat[symmetric], insert i j, auto)
   finally show "?lhs $$ (i, j) = ?rhs $$ (i, j)" .
 qed
 
 lemma det_singleton:
   assumes A: "A \<in> carrier_mat 1 1"
   shows "det A = A $$ (0,0)"
   using A unfolding carrier_mat_def Determinant.det_def by auto
 
 lemma submatrix_singleton_index:
   assumes A: "A \<in> carrier_mat n m"
     and an: "a < n" and bm: "b < m"
     shows "submatrix A {a} {b} $$ (0,0) = A $$ (a,b)"
 proof -
   have a: "{i. i = a \<and> i < dim_row A} = {a}" using an A unfolding carrier_mat_def by auto
   have b: "{i. i = b \<and> i < dim_col A} = {b}" using bm A unfolding carrier_mat_def by auto
   have "submatrix A {a} {b} $$ (0,0) = A $$ (pick {a} 0,pick {b} 0)"
     by (rule submatrix_index, insert a b, auto)
   moreover have "pick {a} 0 = a" by (auto, metis (full_types) LeastI)
   moreover have "pick {b} 0 = b" by (auto, metis (full_types) LeastI)
   ultimately show ?thesis by simp
 qed
 end
 
 lemma det_not_inj_on:
   assumes not_inj_on: "\<not> inj_on f {0..<n}"
   shows "det (mat\<^sub>r n n (\<lambda>i. Matrix.row B (f i))) = 0"
 proof -
   obtain i j where i: "i<n" and j: "j<n" and fi_fj: "f i = f j" and ij: "i\<noteq>j"
     using not_inj_on unfolding inj_on_def by auto
   show ?thesis
   proof (rule det_identical_rows[OF _ ij i j])
     let ?B="(mat\<^sub>r n n (\<lambda>i. row B (f i)))"
     show "row ?B i = row ?B j"
     proof (rule eq_vecI, auto)
       fix ia assume ia: "ia < n"
       have "row ?B i $ ia = ?B $$ (i, ia)" by (rule index_row(1), insert i ia, auto)
       also have "... = ?B $$ (j, ia)" by (simp add: fi_fj i ia j)
       also have "... = row ?B j $ ia" by (rule index_row(1)[symmetric], insert j ia, auto)
       finally show "row ?B i $ ia = row (mat\<^sub>r n n (\<lambda>i. row B (f i))) j $ ia" by simp
     qed
     show "mat\<^sub>r n n (\<lambda>i. Matrix.row B (f i)) \<in> carrier_mat n n" by auto
   qed
 qed
 
 
 
 lemma mat_row_transpose: "(mat\<^sub>r nr nc f)\<^sup>T = mat nc nr (\<lambda>(i,j). vec_index (f j) i)"
   by (rule eq_matI, auto)
 
 
 lemma obtain_inverse_matrix:
   assumes A: "A \<in> carrier_mat n n" and i: "invertible_mat A"
   obtains B where "inverts_mat A B" and "inverts_mat B A" and "B \<in> carrier_mat n n"
 proof -
   have "(\<exists>B. inverts_mat A B \<and> inverts_mat B A)" using i unfolding invertible_mat_def by auto
   from this obtain B where AB: "inverts_mat A B" and BA: "inverts_mat B A" by auto
   moreover have "B \<in> carrier_mat n n" using A AB BA unfolding carrier_mat_def inverts_mat_def
     by (auto, metis index_mult_mat(3) index_one_mat(3))+
   ultimately show ?thesis using that by blast
 qed
 
 
 lemma invertible_mat_smult_mat:
   fixes A :: "'a::comm_ring_1 mat"
   assumes inv_A: "invertible_mat A" and k: "k dvd 1"
   shows "invertible_mat (k \<cdot>\<^sub>m A)"
 proof -
   obtain n where A: "A \<in> carrier_mat n n" using inv_A unfolding invertible_mat_def by auto
   have det_dvd_1: "Determinant.det A dvd 1" using inv_A invertible_iff_is_unit_JNF[OF A] by auto
   have "Determinant.det (k \<cdot>\<^sub>m A) = k ^ dim_col A * Determinant.det A" by simp
   also have "... dvd 1" by (rule unit_prod, insert k det_dvd_1 dvd_power_same, force+)
   finally show ?thesis using invertible_iff_is_unit_JNF by (metis A smult_carrier_mat)
 qed
 
 lemma invertible_mat_one[simp]: "invertible_mat (1\<^sub>m n)"
   unfolding invertible_mat_def using inverts_mat_def by fastforce
 
 lemma four_block_mat_dim0:
   assumes A: "A \<in> carrier_mat n n"
   and B: "B \<in> carrier_mat n 0"
   and C: "C \<in> carrier_mat 0 n"
   and D: "D \<in> carrier_mat 0 0"
 shows "four_block_mat A B C D = A"
   unfolding four_block_mat_def using assms by auto
 
 
 lemma det_four_block_mat_lower_right_id:
   assumes A: "A \<in> carrier_mat m m"
 and B: "B = 0\<^sub>m m (n-m)"
 and C: "C = 0\<^sub>m (n-m) m"
 and D: "D = 1\<^sub>m (n-m)"
 and "n>m"
 shows "Determinant.det (four_block_mat A B C D) = Determinant.det A"
   using assms
 proof (induct n arbitrary: A B C D)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   let ?block = "(four_block_mat A B C D)"
   let ?B = "Matrix.mat m (n-m) (\<lambda>(i,j). 0)"
   let ?C = "Matrix.mat (n-m) m (\<lambda>(i,j). 0)"
   let ?D = "1\<^sub>m (n-m)"
   have mat_eq: "(mat_delete ?block n n) = four_block_mat A ?B ?C ?D" (is "?lhs = ?rhs")
   proof (rule eq_matI)
     fix i j assume i: "i < dim_row (four_block_mat A ?B ?C ?D)"
       and j: "j < dim_col (four_block_mat A ?B ?C ?D)"
     let ?f = " (if i < dim_row A then if j < dim_col A then A $$ (i, j) else B $$ (i, j - dim_col A)
      else if j < dim_col A then C $$ (i - dim_row A, j) else D $$ (i - dim_row A, j - dim_col A))"
     let ?g = "(if i < dim_row A then if j < dim_col A then A $$ (i, j) else ?B $$ (i, j - dim_col A)
      else if j < dim_col A then ?C $$ (i - dim_row A, j) else ?D $$ (i - dim_row A, j - dim_col A))"
     have "(mat_delete ?block n n) $$ (i,j) = ?block $$ (i,j)"
       using i j Suc.prems unfolding mat_delete_def by auto
     also have "... = ?f"
       by (rule index_mat_four_block, insert Suc.prems i j, auto)
     also have "... = ?g" using i j Suc.prems by auto
     also have "... = four_block_mat A ?B ?C ?D $$ (i,j)"
       by (rule index_mat_four_block[symmetric], insert Suc.prems i j, auto)
     finally show "?lhs $$ (i,j) = ?rhs $$ (i,j)" .
   qed (insert Suc.prems, auto)
   have nn_1: "?block $$ (n, n) = 1" using Suc.prems by auto
   have rw0: "(\<Sum>i<n. ?block $$ (i,n) * Determinant.cofactor ?block i n) = 0"
   proof (rule sum.neutral, rule)
     fix x assume x: "x \<in> {..<n}"
     have block_index: "?block $$ (x,n) = (if x < dim_row A then if n < dim_col A then A $$ (x, n)
       else B $$ (x, n - dim_col A) else if n < dim_col A then C $$ (x - dim_row A, n)
       else D $$ (x - dim_row A, n - dim_col A))"
       by (rule index_mat_four_block, insert Suc.prems x, auto)
     have "four_block_mat A B C D $$ (x,n) = 0" using x Suc.prems by auto
     thus "four_block_mat A B C D $$ (x, n) * Determinant.cofactor (four_block_mat A B C D) x n = 0"
       by simp
   qed
   have "Determinant.det ?block = (\<Sum>i<Suc n. ?block $$ (i, n) * Determinant.cofactor ?block i n)"
     by (rule laplace_expansion_column, insert Suc.prems, auto)
   also have "... = ?block $$ (n, n) * Determinant.cofactor ?block n n
     + (\<Sum>i<n. ?block $$ (i,n) * Determinant.cofactor ?block i n)"
     by simp
   also have "... = ?block $$ (n, n) * Determinant.cofactor ?block n n" using rw0 by auto
   also have "... = Determinant.cofactor ?block n n" using nn_1 by simp
   also have "... = Determinant.det (mat_delete ?block n n)" unfolding cofactor_def by auto
   also have "... = Determinant.det (four_block_mat A ?B ?C ?D)" using mat_eq by simp
   also have "... = Determinant.det A" (is "Determinant.det ?lhs = Determinant.det ?rhs")
   proof (cases "n = m")
     case True
     have "?lhs = ?rhs" by (rule four_block_mat_dim0, insert Suc.prems True, auto)
     then show ?thesis by simp
   next
     case False
     show ?thesis by (rule Suc.hyps, insert Suc.prems False, auto)
   qed
   finally show ?case .
 qed
 
 
 lemma mult_eq_first_row:
   assumes A: "A \<in> carrier_mat 1 n"
   and B: "B \<in> carrier_mat m n"
   and m0: "m \<noteq> 0"
   and r: "Matrix.row A 0 = Matrix.row B 0"
 shows "Matrix.row (A * V) 0 = Matrix.row (B * V) 0"
 proof (rule eq_vecI)
   show "dim_vec (Matrix.row (A * V) 0) = dim_vec (Matrix.row (B * V) 0)" using A B r by auto
   fix i assume i: "i < dim_vec (Matrix.row (B * V) 0)"
   have "Matrix.row (A * V) 0 $v i = (A * V) $$ (0,i)" by (rule index_row, insert i A, auto)
   also have "... = Matrix.row A 0 \<bullet> col V i" by (rule index_mult_mat, insert A i, auto)
   also have "... = Matrix.row B 0 \<bullet> col V i" using r by auto
   also have "... = (B * V) $$ (0,i)" by (rule index_mult_mat[symmetric], insert m0 B i, auto)
   also have "... = Matrix.row (B * V) 0 $v i" by (rule index_row[symmetric], insert i B m0, auto)
   finally show "Matrix.row (A * V) 0 $v i = Matrix.row (B * V) 0 $v i" .
 qed
 
 
 lemma smult_mat_mat_one_element:
   assumes A: "A \<in> carrier_mat 1 1" and B: "B \<in> carrier_mat 1 n"
   shows "A * B = A $$ (0,0) \<cdot>\<^sub>m B"
 proof (rule eq_matI)
   fix i j assume i: "i < dim_row (A $$ (0, 0) \<cdot>\<^sub>m B)" and j: "j < dim_col (A $$ (0, 0) \<cdot>\<^sub>m B)"
   have i0: "i = 0" using A B i by auto
   have "(A * B) $$ (i, j) =  Matrix.row A i \<bullet> col B j"
     by (rule index_mult_mat, insert i j A B, auto)
   also have "... =  Matrix.row A i $v 0 * col B j $v 0" unfolding scalar_prod_def using B by auto
   also have "... = A$$(i,i) * B$$(i,j)" using A i i0 j by auto
   also have "... = (A $$ (i, i) \<cdot>\<^sub>m B) $$ (i, j)"
     unfolding i by (rule index_smult_mat[symmetric], insert i j B, auto)
   finally show "(A * B) $$ (i, j) = (A $$ (0, 0) \<cdot>\<^sub>m B) $$ (i, j)" using i0 by simp
 qed (insert A B, auto)
 
 lemma determinant_one_element:
   assumes A: "A \<in> carrier_mat 1 1" shows "Determinant.det A = A $$ (0,0)"
 proof -
   have "Determinant.det A = prod_list (diag_mat A)"
     by (rule det_upper_triangular[OF _ A], insert A, unfold upper_triangular_def, auto)
   also have "... = A $$ (0,0)" using A unfolding diag_mat_def by auto
   finally show ?thesis .
 qed
 
 
 
 lemma invertible_mat_transpose:
   assumes inv_A: "invertible_mat (A::'a::comm_ring_1 mat)"
   shows "invertible_mat A\<^sup>T"
 proof -
   obtain n where A: "A \<in> carrier_mat n n"
     using inv_A unfolding invertible_mat_def square_mat.simps by auto
   hence At: "A\<^sup>T \<in> carrier_mat n n" by simp
   have "Determinant.det A\<^sup>T = Determinant.det A"
     by (metis Determinant.det_def Determinant.det_transpose carrier_matI
         index_transpose_mat(2) index_transpose_mat(3))
   also have "... dvd 1" using invertible_iff_is_unit_JNF[OF A] inv_A by simp
   finally show ?thesis  using invertible_iff_is_unit_JNF[OF At] by auto
 qed
 
 lemma dvd_elements_mult_matrix_left:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat m n"
   and P: "P \<in> carrier_mat m m"
   and x: "(\<forall>i j. i<m \<and> j<n \<longrightarrow> x dvd A$$(i,j))"
   shows "(\<forall>i j. i<m \<and> j<n \<longrightarrow> x dvd (P*A)$$(i,j))"
 proof -
   have "x dvd (P * A) $$ (i, j)" if i: "i < m" and j: "j < n" for i j
   proof -
     have "(P * A) $$ (i, j) =  (\<Sum>ia = 0..<m. Matrix.row P i $v ia * col A j $v ia)"
       unfolding times_mat_def scalar_prod_def using A P j i by auto
     also have "... = (\<Sum>ia = 0..<m. Matrix.row P i $v ia *  A $$ (ia,j))"
       by (rule sum.cong, insert A j, auto)
     also have "x dvd ..." using x by (meson atLeastLessThan_iff dvd_mult dvd_sum j)
     finally show ?thesis .
   qed
   thus ?thesis by auto
 qed
 
 
 lemma dvd_elements_mult_matrix_right:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat m n"
   and Q: "Q \<in> carrier_mat n n"
   and x: "(\<forall>i j. i<m \<and> j<n \<longrightarrow> x dvd A$$(i,j))"
   shows "(\<forall>i j. i<m \<and> j<n \<longrightarrow> x dvd (A*Q)$$(i,j))"
 proof -
   have "x dvd (A*Q) $$ (i, j)" if i: "i < m" and j: "j < n" for i j
   proof -
     have "(A*Q) $$ (i, j) =  (\<Sum>ia = 0..<n. Matrix.row A i $v ia * col Q j $v ia)"
       unfolding times_mat_def scalar_prod_def using A Q j i by auto
     also have "... = (\<Sum>ia = 0..<n. A $$ (i, ia) * col Q j $v ia)"
       by (rule sum.cong, insert A Q i, auto)
     also have "x dvd ..." using x
       by (meson atLeastLessThan_iff dvd_mult2 dvd_sum i)
     finally show ?thesis .
   qed
   thus ?thesis by auto
 qed
 
 
 lemma dvd_elements_mult_matrix_left_right:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat m n"
   and P: "P \<in> carrier_mat m m"
   and Q: "Q \<in> carrier_mat n n"
   and x: "(\<forall>i j. i<m \<and> j<n \<longrightarrow> x dvd A$$(i,j))"
 shows "(\<forall>i j. i<m \<and> j<n \<longrightarrow> x dvd (P*A*Q)$$(i,j))"
   using dvd_elements_mult_matrix_left[OF A P x]
   by (meson P A Q dvd_elements_mult_matrix_right mult_carrier_mat)
 
 
 definition append_cols :: "'a :: zero mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" (infixr "@\<^sub>c" 65)where
   "A @\<^sub>c B = four_block_mat A B (0\<^sub>m 0 (dim_col A)) (0\<^sub>m 0 (dim_col B))"
 
 lemma append_cols_carrier[simp,intro]:
   "A \<in> carrier_mat n a \<Longrightarrow> B \<in> carrier_mat n b \<Longrightarrow> (A @\<^sub>c B) \<in> carrier_mat n (a+b)"
   unfolding append_cols_def by auto
 
 lemma append_cols_mult_left:
   assumes A: "A \<in> carrier_mat n a"
   and B: "B \<in> carrier_mat n b"
   and P: "P \<in> carrier_mat n n"
 shows "P * (A @\<^sub>c B) = (P*A) @\<^sub>c (P*B)"
 proof -
   let ?P = "four_block_mat P (0\<^sub>m n 0) (0\<^sub>m 0 n) (0\<^sub>m 0 0)"
   have "P = ?P" by (rule eq_matI, auto)
   hence "P * (A @\<^sub>c B) = ?P * (A @\<^sub>c B)" by simp
   also have "?P * (A @\<^sub>c B) = four_block_mat (P * A + 0\<^sub>m n 0 * 0\<^sub>m 0 (dim_col A))
   (P * B + 0\<^sub>m n 0 * 0\<^sub>m 0 (dim_col B)) (0\<^sub>m 0 n * A + 0\<^sub>m 0 0 * 0\<^sub>m 0 (dim_col A))
   (0\<^sub>m 0 n * B + 0\<^sub>m 0 0 * 0\<^sub>m 0 (dim_col B))" unfolding append_cols_def
     by (rule mult_four_block_mat, insert A B P, auto)
   also have "... = four_block_mat (P * A) (P * B) (0\<^sub>m 0 (dim_col (P*A))) (0\<^sub>m 0 (dim_col (P*B)))"
     by (rule cong_four_block_mat, insert P, auto)
   also have "... = (P*A) @\<^sub>c (P*B)" unfolding append_cols_def by auto
   finally show ?thesis .
 qed
 
 lemma append_cols_mult_right_id:
   assumes A: "(A::'a::semiring_1 mat) \<in> carrier_mat n 1"
   and B: "B \<in> carrier_mat n (m-1)"
   and C: "C = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m - 1)) (0\<^sub>m (m - 1) 1) D"
   and D: "D \<in> carrier_mat (m-1) (m-1)"
 shows "(A @\<^sub>c B) * C = A @\<^sub>c (B * D)"
 proof -
   let ?C = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m - 1)) (0\<^sub>m (m - 1) 1) D"
   have "(A @\<^sub>c B) * C = (A @\<^sub>c B) * ?C" unfolding C by auto
   also have "... = four_block_mat A B (0\<^sub>m 0 (dim_col A)) (0\<^sub>m 0 (dim_col B)) * ?C"
     unfolding append_cols_def by auto
   also have "... = four_block_mat (A * 1\<^sub>m 1 + B * 0\<^sub>m (m - 1) 1) (A * 0\<^sub>m 1 (m - 1) + B * D)
     (0\<^sub>m 0 (dim_col A) * 1\<^sub>m 1 + 0\<^sub>m 0 (dim_col B) * 0\<^sub>m (m - 1) 1)
     (0\<^sub>m 0 (dim_col A) * 0\<^sub>m 1 (m - 1) + 0\<^sub>m 0 (dim_col B) * D)"
     by (rule mult_four_block_mat, insert assms, auto)
   also have "... = four_block_mat A (B * D) (0\<^sub>m 0 (dim_col A)) (0\<^sub>m 0 (dim_col (B*D)))"
     by (rule cong_four_block_mat, insert assms, auto)
   also have "... = A @\<^sub>c (B * D)" unfolding append_cols_def by auto
   finally show ?thesis .
 qed
 
 
 lemma append_cols_mult_right_id2:
  assumes A: "(A::'a::semiring_1 mat) \<in> carrier_mat n a"
    and B: "B \<in> carrier_mat n b"
    and C: "C = four_block_mat D (0\<^sub>m a b) (0\<^sub>m b a) (1\<^sub>m b)"
    and D: "D \<in> carrier_mat a a"
 shows "(A @\<^sub>c B) * C = (A * D) @\<^sub>c B"
 proof -
   let ?C = "four_block_mat D (0\<^sub>m a b) (0\<^sub>m b a) (1\<^sub>m b)"
   have "(A @\<^sub>c B) * C = (A @\<^sub>c B) * ?C" unfolding C by auto
   also have "... = four_block_mat A B (0\<^sub>m 0 a) (0\<^sub>m 0 b) * ?C"
     unfolding append_cols_def using A B by auto
   also have "... = four_block_mat (A * D + B * 0\<^sub>m b a) (A * 0\<^sub>m a b + B * 1\<^sub>m b)
     (0\<^sub>m 0 a * D + 0\<^sub>m 0 b * 0\<^sub>m b a) (0\<^sub>m 0 a * 0\<^sub>m a b + 0\<^sub>m 0 b * 1\<^sub>m b)"
     by (rule mult_four_block_mat, insert A B C D, auto)
   also have "... = four_block_mat (A * D) B (0\<^sub>m 0 (dim_col (A*D))) (0\<^sub>m 0 (dim_col B))"
     by (rule cong_four_block_mat, insert assms, auto)
   also have "... = (A * D) @\<^sub>c B" unfolding append_cols_def by auto
   finally show ?thesis .
 qed
 
 
 lemma append_cols_nth:
   assumes A: "A \<in> carrier_mat n a"
   and B: "B \<in> carrier_mat n b"
   and i: "i<n" and j: "j < a + b"
 shows "(A @\<^sub>c B) $$ (i, j) = (if j < dim_col A then A $$(i,j) else B$$(i,j-a))" (is "?lhs = ?rhs")
 proof -
   let ?C = "(0\<^sub>m 0 (dim_col A))"
   let ?D = "(0\<^sub>m 0 (dim_col B))"
   have i2: "i < dim_row A + dim_row ?D" using i A by auto
   have j2: "j < dim_col A + dim_col (0\<^sub>m 0 (dim_col B))" using j B A by auto
   have "(A @\<^sub>c B) $$ (i, j) = four_block_mat A B ?C ?D $$ (i, j)"
     unfolding append_cols_def by auto
   also have "... = (if i < dim_row A then if j < dim_col A then A $$ (i, j)
   else B $$ (i, j - dim_col A) else if j < dim_col A then ?C $$ (i - dim_row A, j)
   else 0\<^sub>m 0 (dim_col B) $$ (i - dim_row A, j - dim_col A))"
     by (rule index_mat_four_block(1)[OF i2 j2])
   also have "... = ?rhs" using i A by auto
   finally show ?thesis .
 qed
 
 lemma append_cols_split:
   assumes d: "dim_col A > 0"
   shows "A = mat_of_cols (dim_row A) [col A 0] @\<^sub>c
              mat_of_cols (dim_row A) (map (col A) [1..<dim_col A])" (is "?lhs = ?A1 @\<^sub>c ?A2")
 proof (rule eq_matI)
   fix i j assume i: "i < dim_row (?A1 @\<^sub>c ?A2)" and j: "j < dim_col (?A1 @\<^sub>c ?A2)"
   have "(?A1 @\<^sub>c ?A2) $$ (i, j) = (if j < dim_col ?A1 then ?A1 $$(i,j) else ?A2$$(i,j-(dim_col ?A1)))"
     by (rule append_cols_nth, insert i j, auto simp add: append_cols_def)
   also have "... = A $$ (i,j)"
   proof (cases "j< dim_col ?A1")
     case True
     then show ?thesis
       by (metis One_nat_def Suc_eq_plus1 add.right_neutral append_cols_def col_def i
           index_mat_four_block(2) index_vec index_zero_mat(2) less_one list.size(3) list.size(4)
           mat_of_cols_Cons_index_0 mat_of_cols_carrier(2) mat_of_cols_carrier(3))
   next
     case False
     then show ?thesis
       by (metis (no_types, lifting) Suc_eq_plus1 Suc_less_eq Suc_pred add_diff_cancel_right' append_cols_def
           diff_zero i index_col index_mat_four_block(2) index_mat_four_block(3) index_zero_mat(2)
           index_zero_mat(3) j length_map length_upt linordered_semidom_class.add_diff_inverse list.size(3)
           list.size(4) mat_of_cols_carrier(2) mat_of_cols_carrier(3) mat_of_cols_index nth_map_upt
           plus_1_eq_Suc upt_0)
   qed
   finally show "A $$ (i, j) = (?A1 @\<^sub>c ?A2) $$ (i, j)" ..
 qed (auto simp add: append_cols_def d)
 
 
 lemma append_rows_nth:
   assumes A: "A \<in> carrier_mat a n"
   and B: "B \<in> carrier_mat b n"
   and i: "i<a+b" and j: "j < n"
 shows "(A @\<^sub>r B) $$ (i, j) = (if i < dim_row A then A $$(i,j) else B$$(i-a,j))" (is "?lhs = ?rhs")
 proof -
   let ?C = "(0\<^sub>m (dim_row A) 0)"
   let ?D = "(0\<^sub>m (dim_row B) 0)"
   have i2: "i < dim_row A + dim_row ?D" using i j A B by auto
   have j2: "j < dim_col A + dim_col ?D" using i j A B by auto
   have "(A @\<^sub>r B) $$ (i, j) = four_block_mat A ?C B ?D $$ (i, j)"
     unfolding append_rows_def by auto
   also have "... =  (if i < dim_row A then if j < dim_col A then A $$ (i, j) else ?C $$ (i, j - dim_col A)
    else if j < dim_col A then B $$ (i - dim_row A, j) else ?D $$ (i - dim_row A, j - dim_col A))"
     by (rule index_mat_four_block(1)[OF i2 j2])
   also have "... = ?rhs" using i A j B by auto
   finally show ?thesis .
 qed
 
 lemma append_rows_split:
   assumes k: "k\<le>dim_row A"
   shows "A = (mat_of_rows (dim_col A) [Matrix.row A i. i \<leftarrow> [0..<k]]) @\<^sub>r
              (mat_of_rows (dim_col A) [Matrix.row A i. i \<leftarrow> [k..<dim_row A]])" (is "?lhs = ?A1 @\<^sub>r ?A2")
 proof (rule eq_matI)
   have "(?A1 @\<^sub>r ?A2) \<in> carrier_mat (k + (dim_row A-k)) (dim_col A)"
     by (rule carrier_append_rows, insert k, auto)
   hence A1_A2: "(?A1 @\<^sub>r ?A2) \<in> carrier_mat (dim_row A) (dim_col A)" using k by simp
   thus "dim_row A = dim_row (?A1 @\<^sub>r ?A2)" and "dim_col A = dim_col (?A1 @\<^sub>r ?A2)" by auto
   fix i j assume i: "i < dim_row (?A1 @\<^sub>r ?A2)" and j: "j < dim_col (?A1 @\<^sub>r ?A2)"
   have "(?A1 @\<^sub>r ?A2) $$ (i, j) = (if i < dim_row ?A1 then ?A1 $$(i,j) else ?A2$$(i-(dim_row ?A1),j))"
     by (rule append_rows_nth, insert k i j, auto simp add: append_rows_def)
   also have "... = A $$ (i,j)"
   proof (cases "i<dim_row ?A1")
     case True
     then show ?thesis
       by (metis (no_types, lifting) Matrix.row_def add.left_neutral add.right_neutral append_rows_def
           index_mat(1) index_mat_four_block(3) index_vec index_zero_mat(3) j length_map length_upt
           mat_of_rows_carrier(2,3) mat_of_rows_def nth_map_upt prod.simps(2))
   next
     case False
     let ?xs = "(map (Matrix.row A) [k..<dim_row A])"
     have dim_row_A1: "dim_row ?A1 = k" by auto
     have "?A2 $$ (i-k,j) = ?xs ! (i-k) $v j"
       by (rule mat_of_rows_index, insert i k False A1_A2 j, auto)
     also have "... = A $$ (i,j)" using A1_A2 False i j by auto
     finally show ?thesis using A1_A2 False i j by auto
   qed
   finally show " A $$ (i, j) = (?A1 @\<^sub>r ?A2) $$ (i,j)" by simp
 qed
 
 
 
 lemma transpose_mat_append_rows:
  assumes A: "A \<in> carrier_mat a n" and B: "B \<in> carrier_mat b n"
  shows "(A @\<^sub>r B)\<^sup>T = A\<^sup>T @\<^sub>c B\<^sup>T"
-  by (smt append_cols_def append_rows_def A B carrier_matD(1) index_transpose_mat(3)
-      transpose_four_block_mat zero_carrier_mat zero_transpose_mat)
+proof -
+  have "(four_block_mat A (0\<^sub>m a n) B (0\<^sub>m b n))\<^sup>T = four_block_mat A\<^sup>T B\<^sup>T (0\<^sub>m a n)\<^sup>T (0\<^sub>m b n)\<^sup>T" for n
+    by (meson assms(1) assms(2) transpose_four_block_mat zero_carrier_mat)
+  then show ?thesis
+    by (metis Matrix.transpose_transpose append_cols_def append_rows_def assms(1) assms(2)
+        carrier_matD(2) index_transpose_mat(2) transpose_carrier_mat zero_transpose_mat)
+qed
 
 lemma transpose_mat_append_cols:
  assumes A: "A \<in> carrier_mat n a" and B: "B \<in> carrier_mat n b"
  shows "(A @\<^sub>c B)\<^sup>T = A\<^sup>T @\<^sub>r B\<^sup>T"
-  by (metis Matrix.transpose_transpose A B carrier_matD(1) carrier_mat_triv
-      index_transpose_mat(3) transpose_mat_append_rows)
-
+  by (smt (verit, ccfv_threshold) Matrix.transpose_transpose assms(1) assms(2)
+      transpose_carrier_mat transpose_mat_append_rows)
 
 lemma append_rows_mult_right:
   assumes A: "(A::'a::comm_semiring_1 mat) \<in> carrier_mat a n" and B: "B \<in> carrier_mat b n"
     and Q: "Q\<in> carrier_mat n n"
   shows "(A @\<^sub>r B) * Q = (A * Q) @\<^sub>r (B*Q)"
 proof -
   have "transpose_mat ((A @\<^sub>r B) * Q) = Q\<^sup>T * (A @\<^sub>r B)\<^sup>T"
     by (rule transpose_mult, insert A B Q, auto)
   also have "... = Q\<^sup>T * (A\<^sup>T @\<^sub>c B\<^sup>T)" using transpose_mat_append_rows assms by metis
   also have "... = Q\<^sup>T * A\<^sup>T @\<^sub>c Q\<^sup>T * B\<^sup>T"
     using append_cols_mult_left assms by (metis transpose_carrier_mat)
   also have "transpose_mat ... = (A * Q) @\<^sub>r (B*Q)"
-    by (smt A B Matrix.transpose_mult Matrix.transpose_transpose append_cols_def append_rows_def Q
-        carrier_mat_triv index_mult_mat(2) index_transpose_mat(2) transpose_four_block_mat
-        zero_carrier_mat zero_transpose_mat)
+    by (smt (verit, ccfv_threshold) A B Matrix.transpose_mult Matrix.transpose_transpose
+        append_cols_def append_rows_def assms(3) carrier_matD(1) index_mult_mat(2)
+        index_transpose_mat(3) mult_carrier_mat transpose_four_block_mat zero_carrier_mat
+        zero_transpose_mat)
   finally show ?thesis by simp
 qed
 
 lemma append_rows_mult_left_id:
   assumes A: "(A::'a::comm_semiring_1 mat) \<in> carrier_mat 1 n"
-  and B: "B \<in> carrier_mat (m-1) n"
-  and C: "C = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m - 1)) (0\<^sub>m (m - 1) 1) D"
-  and D: "D \<in> carrier_mat (m-1) (m-1)"
-shows "C * (A @\<^sub>r B) = A @\<^sub>r (D * B)"
+    and B: "B \<in> carrier_mat (m-1) n"
+    and C: "C = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m - 1)) (0\<^sub>m (m - 1) 1) D"
+    and D: "D \<in> carrier_mat (m-1) (m-1)"
+  shows "C * (A @\<^sub>r B) = A @\<^sub>r (D * B)"
 proof -
   have "transpose_mat (C * (A @\<^sub>r B)) = (A @\<^sub>r B)\<^sup>T * C\<^sup>T"
     by (metis (no_types, lifting) B C D Matrix.transpose_mult append_rows_def A carrier_matD
         carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2) one_carrier_mat)
   also have "... = (A\<^sup>T @\<^sub>c B\<^sup>T) * C\<^sup>T" using transpose_mat_append_rows[OF A B] by auto
-  also have "... = A\<^sup>T @\<^sub>c (B\<^sup>T * D\<^sup>T)" by (rule append_cols_mult_right_id, insert A B C D, auto)
-  also have "transpose_mat ... = A @\<^sub>r (D * B)"
-    by (smt B D Matrix.transpose_mult Matrix.transpose_transpose append_cols_def append_rows_def A
-        carrier_matD(2) carrier_mat_triv index_mult_mat(3) index_transpose_mat(3)
-        transpose_four_block_mat zero_carrier_mat zero_transpose_mat)
+  also have "... = A\<^sup>T @\<^sub>c (B\<^sup>T * D\<^sup>T)" by (rule append_cols_mult_right_id) (use A B C D in auto)
+  also have "transpose_mat ... = A @\<^sub>r (D * B)" using A
+    by (metis (no_types, opaque_lifting)
+        Matrix.transpose_mult Matrix.transpose_transpose assms(2) assms(4)
+        mult_carrier_mat transpose_mat_append_rows)
   finally show ?thesis by auto
 qed
 
 lemma append_rows_mult_left_id2:
  assumes A: "(A::'a::comm_semiring_1 mat) \<in> carrier_mat a n"
    and B: "B \<in> carrier_mat b n"
    and C: "C = four_block_mat D (0\<^sub>m a b) (0\<^sub>m b a) (1\<^sub>m b)"
    and D: "D \<in> carrier_mat a a"
  shows "C * (A @\<^sub>r B) = (D * A) @\<^sub>r B"
 proof -
   have "(C * (A @\<^sub>r B))\<^sup>T = (A @\<^sub>r B)\<^sup>T * C\<^sup>T" by (rule transpose_mult, insert assms, auto)
   also have "... = (A\<^sup>T @\<^sub>c B\<^sup>T) * C\<^sup>T" by (metis A B transpose_mat_append_rows)
   also have "... = (A\<^sup>T * D\<^sup>T @\<^sub>c B\<^sup>T)" by (rule append_cols_mult_right_id2, insert assms, auto)
   also have "...\<^sup>T = (D * A) @\<^sub>r B"
     by (metis A B D transpose_mult transpose_transpose mult_carrier_mat transpose_mat_append_rows)
   finally show ?thesis by simp
 qed
 
 lemma four_block_mat_preserves_column:
   assumes A: "(A::'a::semiring_1 mat) \<in> carrier_mat n m"
     and B: "B = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m - 1)) (0\<^sub>m (m - 1) 1) C"
   and C: "C \<in> carrier_mat (m-1) (m-1)"
   and i: "i<n" and m: "0<m"
 shows "(A*B) $$ (i,0) = A $$ (i,0)"
 proof -
   let ?A1 = "mat_of_cols n [col A 0]"
   let ?A2 = "mat_of_cols n (map (col A) [1..<dim_col A])"
   have n2: "dim_row A = n" using A by auto
   have "A = ?A1 @\<^sub>c ?A2" by (rule append_cols_split[of A, unfolded n2], insert m A, auto)
   hence "A * B = (?A1 @\<^sub>c ?A2) * B" by simp
   also have "... = ?A1 @\<^sub>c (?A2 * C)" by (rule append_cols_mult_right_id[OF _ _ B C], insert A, auto)
   also have "... $$ (i,0) = ?A1 $$ (i,0)" using append_cols_nth by (simp add: append_cols_def i)
   also have "... = A $$ (i,0)"
     by (metis A i carrier_matD(1) col_def index_vec mat_of_cols_Cons_index_0)
   finally show ?thesis .
 qed
 
 
 definition "lower_triangular A = (\<forall>i j. i < j \<and> i < dim_row A \<and> j < dim_col A \<longrightarrow> A $$ (i,j) = 0)"
 
 lemma lower_triangular_index:
   assumes "lower_triangular A" "i<j" "i < dim_row A" "j < dim_col A"
   shows "A $$ (i,j) = 0"
   using assms unfolding lower_triangular_def by auto
 
 lemma commute_multiples_identity:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat n n"
   shows "A * (k \<cdot>\<^sub>m (1\<^sub>m n)) = (k \<cdot>\<^sub>m (1\<^sub>m n)) * A"
 proof -
   have "(\<Sum>ia = 0..<n. A $$ (i, ia) * (k * (if ia = j then 1 else 0)))
     = (\<Sum>ia = 0..<n. k * (if i = ia then 1 else 0) * A $$ (ia, j))" (is "?lhs=?rhs")
     if i: "i<n" and j: "j<n" for i j
   proof -
     let ?f = "\<lambda>ia. A $$ (i, ia) * (k * (if ia = j then 1 else 0))"
     let ?g = "\<lambda>ia. k * (if i = ia then 1 else 0) * A $$ (ia, j)"
     have rw0: "(\<Sum>ia \<in> ({0..<n}-{j}). ?f ia) = 0" by (rule sum.neutral, auto)
     have rw0': "(\<Sum>ia \<in> ({0..<n}-{i}). ?g ia) = 0" by (rule sum.neutral, auto)
     have "?lhs = ?f j + (\<Sum>ia \<in> ({0..<n}-{j}). ?f ia)"
-      by (smt atLeast0LessThan finite_atLeastLessThan lessThan_iff sum.remove j)
+      by (smt (verit, del_insts) atLeast0LessThan finite_atLeastLessThan
+          lessThan_iff sum.remove that(2))
     also have "... = A $$ (i, j) * k" using rw0 by auto
     also have "... = ?g i + (\<Sum>ia \<in> ({0..<n}-{i}). ?g ia)" using rw0' by auto
     also have "... = ?rhs"
-      by (smt atLeast0LessThan finite_atLeastLessThan lessThan_iff sum.remove i)
+      by (smt (verit, ccfv_SIG) atLeast0LessThan finite_lessThan lessThan_iff sum.remove that(1))
     finally show ?thesis .
   qed
   thus ?thesis using A
-  unfolding times_mat_def scalar_prod_def
-  by auto (rule eq_matI, auto, smt sum.cong)
+    by (metis (no_types, lifting) left_mult_one_mat mult_smult_assoc_mat mult_smult_distrib
+        one_carrier_mat right_mult_one_mat)
 qed
 
 (*This lemma is obtained using Mod_Type_Connect, otherwise we cannot prove HMA_I 0 0.
 The lelma could also be obtained with no use of transfer rules, proving it directly.*)
 lemma det_2:
   assumes A: "A \<in> carrier_mat 2 2"
   shows "Determinant.det A = A$$(0,0) * A $$ (1,1) - A$$(0,1)*A$$(1,0)"
 proof -
   let ?A = "(Mod_Type_Connect.to_hma\<^sub>m A)::'a^2^2"
   have [transfer_rule]: "Mod_Type_Connect.HMA_M A ?A"
     unfolding Mod_Type_Connect.HMA_M_def using from_hma_to_hma\<^sub>m A by auto
   have [transfer_rule]: "Mod_Type_Connect.HMA_I 0 0"
     unfolding Mod_Type_Connect.HMA_I_def by (simp add: to_nat_0)
   have [transfer_rule]: "Mod_Type_Connect.HMA_I 1 1"
     unfolding Mod_Type_Connect.HMA_I_def by (simp add: to_nat_1)
   have "Determinant.det A = Determinants.det ?A" by (transfer, simp)
   also have "... = ?A $h 1 $h 1 * ?A $h 2 $h 2 - ?A $h 1 $h 2 * ?A $h 2 $h 1" unfolding det_2 by simp
   also have "... = ?A $h 0 $h 0 * ?A $h 1 $h 1 - ?A $h 0 $h 1 * ?A $h 1 $h 0"
-    by (smt Groups.mult_ac(2) exhaust_2 semiring_norm(160))
+    by (smt (verit, ccfv_SIG) Groups.mult_ac(2) exhaust_2 semiring_norm(160))
   also have "... = A$$(0,0) * A $$ (1,1) - A$$(0,1)*A$$(1,0)"
     unfolding index_hma_def[symmetric] by (transfer, auto)
   finally show ?thesis .
 qed
 
 lemma mat_diag_smult: "mat_diag n (\<lambda> x. (k::'a::comm_ring_1)) = (k \<cdot>\<^sub>m 1\<^sub>m n)"
 proof -
   have "mat_diag n (\<lambda> x. k) = mat_diag n (\<lambda> x. k * 1)" by auto
   also have "... = mat_diag n (\<lambda> x. k) * mat_diag n (\<lambda> x. 1)" using mat_diag_diag
     by (simp add: mat_diag_def)
   also have "... = mat_diag n (\<lambda> x. k) * (1\<^sub>m n)" by auto  thm mat_diag_mult_left
   also have "... = Matrix.mat n n (\<lambda>(i, j). k * (1\<^sub>m n) $$ (i, j))" by (rule mat_diag_mult_left, auto)
   also have "... = (k \<cdot>\<^sub>m 1\<^sub>m n)" unfolding smult_mat_def by auto
   finally show ?thesis .
 qed
 
 lemma invertible_mat_four_block_mat_lower_right:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat n n" and inv_A: "invertible_mat A"
   shows "invertible_mat (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 n) (0\<^sub>m n 1) A)"
 proof -
   let ?I = "(four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 n) (0\<^sub>m n 1) A)"
   have "Determinant.det ?I = Determinant.det (1\<^sub>m 1) * Determinant.det A"
     by (rule det_four_block_mat_lower_left_zero_col, insert assms, auto)
   also have "... = Determinant.det A" by auto
   finally have "Determinant.det ?I = Determinant.det A" .
   thus ?thesis
     by (metis (no_types, lifting) assms carrier_matD(1) carrier_matD(2) carrier_mat_triv
         index_mat_four_block(2) index_mat_four_block(3) index_one_mat(2) index_one_mat(3)
         invertible_iff_is_unit_JNF)
 qed
 
 
 lemma invertible_mat_four_block_mat_lower_right_id:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat m m" and B: "B = 0\<^sub>m m (n-m)" and C: "C = 0\<^sub>m (n-m) m"
     and D: "D = 1\<^sub>m (n-m)" and "n>m" and inv_A: "invertible_mat A"
   shows "invertible_mat (four_block_mat A B C D)"
 proof -
   have "Determinant.det (four_block_mat A B C D) = Determinant.det A"
     by (rule det_four_block_mat_lower_right_id, insert assms, auto)
   thus ?thesis using inv_A
     by (metis (no_types, lifting) assms(1) assms(4) carrier_matD(1) carrier_matD(2) carrier_mat_triv
         index_mat_four_block(2) index_mat_four_block(3) index_one_mat(2) index_one_mat(3)
         invertible_iff_is_unit_JNF)
 qed
 
 lemma split_block4_decreases_dim_row:
   assumes E: "(A,B,C,D) = split_block E 1 1"
     and E1: "dim_row E > 1" and E2: "dim_col E > 1"
   shows "dim_row D < dim_row E"
 proof -
   have "D \<in> carrier_mat (1 + (dim_row E - 2)) (1 + (dim_col E - 2))"
     by (rule split_block(4)[OF E[symmetric]], insert E1 E2, auto)
   hence "D \<in> carrier_mat (dim_row E - 1) (dim_col E - 1)" using E1 E2 by auto
   thus ?thesis using E1 by auto
 qed
 
 
 lemma inv_P'PAQQ':
   assumes A: "A \<in> carrier_mat n n"
     and P: "P \<in> carrier_mat n n"
     and inv_P: "inverts_mat P' P"
     and inv_Q: "inverts_mat Q Q'"
     and Q: "Q \<in> carrier_mat n n"
     and P': "P' \<in> carrier_mat n n"
     and Q': "Q' \<in> carrier_mat n n"
 shows  "(P'*(P*A*Q)*Q') = A"
 proof -
   have "(P'*(P*A*Q)*Q') = (P'*(P*A*Q*Q'))"
-    by (smt P P' Q Q' assoc_mult_mat carrier_matD(1) carrier_matD(2) carrier_mat_triv
-        index_mult_mat(2) index_mult_mat(3))
+    by (meson P P' Q Q' assms(1) assoc_mult_mat mult_carrier_mat)
   also have "... = ((P'*P)*A*(Q*Q'))"
-    by (smt A P P' Q Q' assoc_mult_mat carrier_matD(1) carrier_matD(2) carrier_mat_triv
-        index_mult_mat(3) inv_Q inverts_mat_def right_mult_one_mat')
+    by (smt (verit, ccfv_SIG) P' Q' assms(1) assms(2) assms(5) assoc_mult_mat mult_carrier_mat)
   finally show ?thesis
     by (metis P' Q A inv_P inv_Q carrier_matD(1) inverts_mat_def
         left_mult_one_mat right_mult_one_mat)
 qed
 
 lemma
   assumes "U \<in> carrier_mat 2 2" and "V \<in> carrier_mat 2 2" and "A = U * V"
 shows mat_mult2_00: "A $$ (0,0) = U $$ (0,0)*V $$ (0,0) + U $$ (0,1)*V $$ (1,0)"
   and mat_mult2_01: "A $$ (0,1) = U $$ (0,0)*V $$ (0,1) + U $$ (0,1)*V $$ (1,1)"
   and mat_mult2_10: "A $$ (1,0) = U $$ (1,0)*V $$ (0,0) + U $$ (1,1)*V $$ (1,0)"
   and mat_mult2_11: "A $$ (1,1) = U $$ (1,0)*V $$ (0,1) + U $$ (1,1)*V $$ (1,1)"
     using assms unfolding times_mat_def Matrix.row_def col_def scalar_prod_def
     using sum_two_rw by auto
 
 
 subsection\<open>Lemmas about @{text "sorted lists"}, @{text "insort"} and @{text "pick"}\<close>
 
 
 lemma sorted_distinct_imp_sorted_wrt:
   assumes "sorted xs" and "distinct xs"
   shows "sorted_wrt (<) xs"
   using assms
   by (induct xs, insert le_neq_trans, auto)
 
 
 lemma sorted_map_strict:
   assumes "strict_mono_on {0..<n} g"
   shows "sorted (map g [0..<n])"
   using assms
   by (induct n, auto simp add: sorted_append strict_mono_on_def less_imp_le)
 
 
 lemma sorted_list_of_set_map_strict:
   assumes "strict_mono_on {0..<n} g"
   shows "sorted_list_of_set (g ` {0..<n}) = map g [0..<n]"
   using assms
   proof (induct n)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   note sg = Suc.prems
   have sg_n: "strict_mono_on {0..<n} g" using sg unfolding strict_mono_on_def by auto
   have g_image_rw: "g ` {0..<Suc n} = insert (g n) (g ` {0..<n})"
     by (simp add: set_upt_Suc)
   have "sorted_list_of_set (g ` {0..<Suc n}) = sorted_list_of_set (insert (g n) (g ` {0..<n}))"
     using g_image_rw by simp
   also have "... = insort (g n) (sorted_list_of_set (g ` {0..<n}))"
   proof (rule sorted_list_of_set_insert)
     have "inj_on g {0..<Suc n}" using sg strict_mono_on_imp_inj_on by blast
     thus "g n \<notin> g ` {0..<n}" unfolding inj_on_def by fastforce
   qed (simp)
   also have "... = insort (g n) (map g [0..<n])"
     using Suc.hyps sg unfolding strict_mono_on_def by auto
   also have "... = map g [0..<Suc n]"
   proof (simp, rule sorted_insort_is_snoc)
     show "sorted (map g [0..<n])" by (rule sorted_map_strict[OF sg_n])
     show "\<forall>x\<in>set (map g [0..<n]). x \<le> g n" using sg unfolding strict_mono_on_def
       by (simp add: less_imp_le)
   qed
   finally show ?case .
 qed
 
 
 lemma sorted_nth_strict_mono:
   "sorted xs \<Longrightarrow> distinct xs \<Longrightarrow>i < j \<Longrightarrow> j < length xs \<Longrightarrow> xs!i < xs!j"
   by (simp add: less_le nth_eq_iff_index_eq sorted_iff_nth_mono_less)
 
 
 lemma sorted_list_of_set_0_LEAST:
   assumes finI: "finite I" and I: "I \<noteq> {}"
   shows "sorted_list_of_set I ! 0 = (LEAST n. n\<in>I)"
 proof (rule Least_equality[symmetric])
   show "sorted_list_of_set I ! 0 \<in> I"
     by (metis I Max_in finI gr_zeroI in_set_conv_nth not_less_zero set_sorted_list_of_set)
   fix y assume "y \<in> I"
   thus "sorted_list_of_set I ! 0 \<le> y"
     by (metis eq_iff finI in_set_conv_nth neq0_conv sorted_iff_nth_mono_less
         sorted_list_of_set(1) sorted_sorted_list_of_set)
 qed
 
 lemma sorted_list_of_set_eq_pick:
   assumes i: "i < length (sorted_list_of_set I)"
   shows "sorted_list_of_set I ! i = pick I i"
 proof -
   have finI: "finite I"
   proof (rule ccontr)
     assume "infinite I"
     hence "length (sorted_list_of_set I) = 0" by auto
     thus False using i by simp
   qed
   show ?thesis
   using i
 proof (induct i)
   case 0
   have I: "I \<noteq> {}" using "0.prems" sorted_list_of_set_empty by blast
   show ?case unfolding pick.simps by (rule sorted_list_of_set_0_LEAST[OF finI I])
 next
   case (Suc i)
   note x_less = Suc.prems
   show ?case
   proof (unfold pick.simps, rule Least_equality[symmetric], rule conjI)
     show 1: "pick I i < sorted_list_of_set I ! Suc i"
       by (metis Suc.hyps Suc.prems Suc_lessD distinct_sorted_list_of_set find_first_unique lessI
           nat_less_le sorted_sorted_list_of_set sorted_wrt_nth_less)
     show "sorted_list_of_set I ! Suc i \<in> I"
       using Suc.prems finI nth_mem set_sorted_list_of_set by blast
     have rw: "sorted_list_of_set I ! i = pick I i"
       using Suc.hyps Suc_lessD x_less by blast
     have sorted_less: "sorted_list_of_set I ! i < sorted_list_of_set I ! Suc i"
       by (simp add: 1 rw)
     fix y assume y: "y \<in> I \<and> pick I i < y"
     show "sorted_list_of_set I ! Suc i \<le> y"
-      by (smt antisym_conv finI in_set_conv_nth less_Suc_eq less_Suc_eq_le nat_neq_iff rw
+      by (smt (verit) antisym_conv finI in_set_conv_nth less_Suc_eq less_Suc_eq_le nat_neq_iff rw
           sorted_iff_nth_mono_less sorted_list_of_set(1) sorted_sorted_list_of_set x_less y)
   qed
 qed
 qed
 
 text\<open>$b$ is the position where we add, $a$ the element to be added and $i$ the position
   that is checked\<close>
 
 lemma insort_nth':
   assumes "\<forall>j<b. xs ! j < a" and "sorted xs" and "a \<notin> set xs"
     and "i < length xs + 1" and "i < b"
     and "xs \<noteq> []" and "b < length xs"
   shows "insort a xs ! i = xs ! i"
   using assms
 proof (induct xs arbitrary: a b i)
   case Nil
   then show ?case by auto
 next
   case (Cons x xs)
   note less = Cons.prems(1)
   note sorted = Cons.prems(2)
   note a_notin = Cons.prems(3)
   note i_length = Cons.prems(4)
   note i_b = Cons.prems(5)
   note b_length = Cons.prems(7)
   show ?case
   proof (cases "a \<le> x")
     case True
     have "insort a (x # xs) ! i = (a # x # xs) ! i" using True by simp
     also have "... =  (x # xs) ! i"
       using Cons.prems(1) Cons.prems(5) True by force
     finally show ?thesis .
   next
     case False note x_less_a = False
     have "insort a (x # xs) ! i = (x # insort a xs) ! i" using False by simp
     also have "... = (x # xs) ! i"
     proof (cases "i = 0")
       case True
       then show ?thesis by auto
     next
       case False
       have "(x # insort a xs) ! i = (insort a xs) ! (i-1)"
         by (simp add: False nth_Cons')
       also have "... = xs ! (i-1)"
       proof (rule Cons.hyps)
         show "sorted xs" using sorted by simp
         show "a \<notin> set xs" using a_notin by simp
         show "i - 1 < length xs + 1" using i_length False by auto
         show "xs \<noteq> []" using i_b b_length by force
         show "i - 1 < b - 1" by (simp add: False diff_less_mono i_b leI)
         show "b - 1 < length xs" using b_length i_b by auto
         show "\<forall>j<b - 1. xs ! j < a" using less less_diff_conv by auto
       qed
       also have "... = (x # xs) ! i" by (simp add: False nth_Cons')
       finally show ?thesis .
     qed
     finally show ?thesis .
   qed
 qed
 
 
 lemma insort_nth:
   assumes  "sorted xs" and "a \<notin> set xs"
     and "i < index (insort a xs) a"
     and "xs \<noteq> []"
   shows "insort a xs ! i = xs ! i"
   using assms
 proof (induct xs arbitrary: a i)
 case Nil
   then show ?case by auto
 next
   case (Cons x xs)
   note sorted = Cons.prems(1)
   note a_notin = Cons.prems(2)
   note i_index = Cons.prems(3)
   show ?case
   proof (cases "a \<le> x")
     case True
     have "insort a (x # xs) ! i = (a # x # xs) ! i" using True by simp
     also have "... = (x # xs) ! i"
       using Cons.prems(1) Cons.prems(3) True by force
     finally show ?thesis .
   next
     case False note x_less_a = False
     show ?thesis
     proof (cases "xs = []")
       case True
       have "x \<noteq> a" using False by auto
       then show ?thesis  using True i_index False by auto
     next
       case False note xs_not_empty = False
       have "insort a (x # xs) ! i = (x # insort a xs) ! i" using x_less_a by simp
       also have "... = (x # xs) ! i"
       proof (cases "i = 0")
         case True
         then show ?thesis by auto
       next
         case False note i0 = False
         have "(x # insort a xs) ! i = (insort a xs) ! (i-1)"
           by (simp add: False nth_Cons')
         also have "... = xs ! (i-1)"
         proof (rule Cons.hyps[OF _ _ _ xs_not_empty])
           show "sorted xs" using sorted by simp
           show "a \<notin> set xs" using a_notin by simp
           have "index (insort a (x # xs)) a = index ((x # insort a xs)) a"
             using x_less_a by auto
           also have "... = index (insort a xs) a + 1"
             unfolding index_Cons using x_less_a by simp
           finally show "i - 1 < index (insort a xs) a" using False i_index by linarith
         qed
         also have "... = (x # xs) ! i" by (simp add: False nth_Cons')
         finally show ?thesis .
       qed
       finally show ?thesis .
     qed
   qed
 qed
 
 lemma insort_nth2:
   assumes "sorted xs" and "a \<notin> set xs"
     and "i < length xs" and "i \<ge> index (insort a xs) a"
     and "xs \<noteq> []"
   shows "insort a xs ! (Suc i) = xs ! i"
   using assms
 proof (induct xs arbitrary: a i)
   case Nil
   then show ?case by auto
 next
   case (Cons x xs)
   note sorted = Cons.prems(1)
   note a_notin = Cons.prems(2)
   note i_length = Cons.prems(3)
   note index_i = Cons.prems(4)
   show ?case
   proof (cases "a \<le> x")
     case True
     have "insort a (x # xs) ! (Suc i) = (a # x # xs) ! (Suc i)" using True by simp
     also have "... =  (x # xs) ! i"
       using Cons.prems(1) Cons.prems(5) True by force
     finally show ?thesis .
   next
     case False note x_less_a = False
     have "insort a (x # xs) ! (Suc i) = (x # insort a xs) ! (Suc i)" using False by simp
     also have "... = (x # xs) ! i"
     proof (cases "i = 0")
         case True
         then show ?thesis using index_i linear x_less_a by fastforce
       next
         case False note i0 = False
         show ?thesis
         proof -
           have Suc_i: "Suc (i - 1) = i"
             using i0 by auto
           have "(x # insort a xs) ! (Suc i) = (insort a xs) ! i"
             by (simp add: nth_Cons')
           also have "... = (insort a xs) ! Suc (i - 1)" using Suc_i by simp
           also have "... = xs ! (i - 1)"
           proof (rule Cons.hyps)
             show "sorted xs" using sorted by simp
             show "a \<notin> set xs" using a_notin by simp
             show "i - 1 < length xs" using i_length using Suc_i by auto
             thus "xs \<noteq> []" by auto
             have "index (insort a (x # xs)) a = index ((x # insort a xs)) a" using x_less_a by simp
             also have "... = index (insort a xs) a + 1" unfolding index_Cons using x_less_a by simp
             finally show "index (insort a xs) a \<le> i - 1" using index_i i0 by auto
           qed
           also have "... = (x # xs) ! i" using Suc_i by auto
           finally show ?thesis .
         qed
       qed
       finally show ?thesis .
     qed
 qed
 
 lemma pick_index:
   assumes a: "a \<in> I" and a'_card: "a' < card I"
   shows "(pick I a' = a) = (index (sorted_list_of_set I) a = a')"
 proof -
   have finI: "finite I" using a'_card card.infinite by force
   have length_I: "length (sorted_list_of_set I) = card I"
     by (metis a'_card card.infinite distinct_card distinct_sorted_list_of_set
         not_less_zero set_sorted_list_of_set)
   let ?i = "index (sorted_list_of_set I) a"
   have "(sorted_list_of_set I) ! a' = pick I a'"
     by (rule sorted_list_of_set_eq_pick, auto simp add: finI a'_card length_I)
   moreover have "(sorted_list_of_set I) ! ?i = a"
     by (rule nth_index, simp add: a finI)
   ultimately show ?thesis
     by (metis a'_card distinct_sorted_list_of_set index_nth_id length_I)
 qed
 
 end
 
diff --git a/thys/Smith_Normal_Form/Smith_Certified.thy b/thys/Smith_Normal_Form/Smith_Certified.thy
--- a/thys/Smith_Normal_Form/Smith_Certified.thy
+++ b/thys/Smith_Normal_Form/Smith_Certified.thy
@@ -1,125 +1,125 @@
 (*
     Author:      Jose Divasón
     Email:       jose.divason@unirioja.es
 *)
 
 section \<open>A certified checker based on an external algorithm to compute Smith normal form\<close>
 
 theory Smith_Certified
   imports
     SNF_Algorithm_Euclidean_Domain
 begin
 
 text\<open>This (unspecified) function takes as input the matrix $A$ and returns five matrices
 $(P,S,Q,P',Q')$, which must satisfy $S = PAQ$, $S$ is in Smith normal form, $P'$ and $Q'$
 are the inverse matrices of $P$ and $Q$ respectively\<close>
 
 text\<open>The matrices are given in terms of lists for the sake of simplicity when connecting the
 function to external solvers, like Mathematica or Sage.\<close>
 
 consts external_SNF ::
   "int list list \<Rightarrow> int list list \<times> int list list \<times> int list list \<times> int list list \<times> int list list"
 
 
 text \<open>We implement the checker by means of the following definition. The checker is implemented
 in the JNF representation of matrices to make use of the Strassen matrix multiplication algorithm.
 In case that the certification fails, then the verified Smith normal form algorithm is executed.
 Thus, we will always get a verified result.\<close>
 
 definition "checker_SNF A = (
     let A' = mat_to_list A; m = dim_row A; n = dim_col A in
       case external_SNF A' of (P_ext,S_ext,Q_ext,P'_ext,Q'_ext) \<Rightarrow> let
           P = mat_of_rows_list m P_ext;
           S = mat_of_rows_list m S_ext;
           Q = mat_of_rows_list m Q_ext;
           P' = mat_of_rows_list m P'_ext;
           Q' = mat_of_rows_list m Q'_ext in
             (if dim_row P = m \<and> dim_col P = m
               \<and> dim_row S = m \<and> dim_col S = n
               \<and> dim_row Q = n \<and> dim_col Q = n
               \<and> dim_row P' = m \<and> dim_col P' = m
               \<and> dim_row Q' = n \<and> dim_col Q' = n
               \<and> P * P' = 1\<^sub>m m \<and> Q * Q' = 1\<^sub>m n
               \<and> Smith_normal_form_mat S \<and> (S = P*A*Q) then
       (P,S,Q) else Code.abort (STR ''Certification failed'') (\<lambda> _. Smith_ED_mxn A))
 )"
 
 theorem checker_SNF_soudness:
   assumes A: "A \<in> carrier_mat m n"
     and c: "checker_SNF A = (P,S,Q)"
   shows "is_SNF A (P,S,Q)"
 proof -
   let ?ext = "external_SNF (mat_to_list A)"
   obtain P_ext S_ext Q_ext P'_ext Q'_ext where ext: "?ext = (P_ext,S_ext,Q_ext,P'_ext,Q'_ext)"
     by (cases "?ext", auto)
   let ?case_external = "let
           P = mat_of_rows_list m P_ext;
           S = mat_of_rows_list m S_ext;
           Q = mat_of_rows_list n Q_ext;
           P' = mat_of_rows_list m P'_ext;
           Q' = mat_of_rows_list n Q'_ext in
             (dim_row P = m \<and> dim_col P = m
               \<and> dim_row S = m \<and> dim_col S = n
               \<and> dim_row Q = n \<and> dim_col Q = n
               \<and> dim_row P' = m \<and> dim_col P' = m
               \<and> dim_row Q' = n \<and> dim_col Q' = n
               \<and> P * P' = 1\<^sub>m m \<and> Q * Q' = 1\<^sub>m n
               \<and> Smith_normal_form_mat S \<and> (S = P*A*Q))"
   show ?thesis
   proof (cases ?case_external)
     case True
     define P' where "P' = mat_of_rows_list m P'_ext"
     define Q' where "Q' = mat_of_rows_list m Q'_ext"
     have S_PAQ: "S = P * A * Q "
       and SNF_S: "Smith_normal_form_mat S" and PP'_1: "P * P' = 1\<^sub>m m" and QQ'_1: "Q * Q' = 1\<^sub>m n"
       and sm_P: "square_mat P" and sm_Q: "square_mat Q"
       using ext True c A
       unfolding checker_SNF_def Let_def mat_of_rows_list_def P'_def Q'_def
       by (auto split: if_splits)
     have inv_P: "invertible_mat P"
     proof (unfold invertible_mat_def, rule conjI, rule sm_P,
         unfold inverts_mat_def, rule exI[of _ P'], rule conjI)
       show *: "P * P' = 1\<^sub>m (dim_row P)"
         by (metis PP'_1 True index_mult_mat(2))
       show "P' * P = 1\<^sub>m (dim_row P')"
       proof (rule mat_mult_left_right_inverse)
         show "P \<in> carrier_mat (dim_row P') (dim_row P')"
           by (metis * P'_def PP'_1 True carrier_mat_triv index_one_mat(2) sm_P square_mat.elims(2))
         show "P' \<in> carrier_mat (dim_row P') (dim_row P')"
           by (metis P'_def True carrier_mat_triv)
         show "P * P' = 1\<^sub>m (dim_row P')"
           by (metis P'_def PP'_1 True)
       qed
     qed
     have inv_Q: "invertible_mat Q"
     proof (unfold invertible_mat_def, rule conjI, rule sm_Q,
         unfold inverts_mat_def, rule exI[of _ Q'], rule conjI)
       show *: "Q * Q' = 1\<^sub>m (dim_row Q)"
         by (metis QQ'_1 True index_mult_mat(2))
       show "Q' * Q = 1\<^sub>m (dim_row Q')"
       proof (rule mat_mult_left_right_inverse)
         show 1: "Q \<in> carrier_mat (dim_row Q') (dim_row Q')"
           by (metis Q'_def QQ'_1 True carrier_mat_triv dim_row_mat(1) index_mult_mat(2)
               mat_of_rows_list_def sm_Q square_mat.simps)
         thus "Q' \<in> carrier_mat (dim_row Q') (dim_row Q')"
           by (metis * carrier_matD(1) carrier_mat_triv index_mult_mat(3) index_one_mat(3))
         show "Q * Q' = 1\<^sub>m (dim_row Q')" using * 1 by auto
       qed
     qed
     have "P \<in> carrier_mat m m"
       by (metis PP'_1 True carrier_matI index_mult_mat(2) sm_P square_mat.simps)
     moreover have  "Q \<in> carrier_mat n n"
       by (metis QQ'_1 True carrier_matI index_mult_mat(2) sm_Q square_mat.simps)
     ultimately show ?thesis unfolding is_SNF_def using inv_P inv_Q SNF_S S_PAQ A by auto
   next
     case False
     hence "checker_SNF A = Smith_ED_mxn A"
       using ext False c A
       unfolding checker_SNF_def Let_def Code.abort_def
-      by (smt carrier_matD case_prod_conv dim_col_mat(1) mat_of_rows_list_def)
+      by (smt (verit) carrier_matD case_prod_conv dim_col_mat(1) mat_of_rows_list_def)
     then show ?thesis using Smith_ED.is_SNF_Smith_mxn[OF A] c unfolding is_SNF_def
       by auto
   qed
 qed
 
 end
diff --git a/thys/Smith_Normal_Form/Smith_Normal_Form.thy b/thys/Smith_Normal_Form/Smith_Normal_Form.thy
--- a/thys/Smith_Normal_Form/Smith_Normal_Form.thy
+++ b/thys/Smith_Normal_Form/Smith_Normal_Form.thy
@@ -1,128 +1,128 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Definition of Smith normal form in HOL Analysis\<close>
 
 theory Smith_Normal_Form
   imports   
     Hermite.Hermite   
 begin
 
 
 subsection \<open>Definitions\<close>
 
 text\<open>Definition of diagonal matrix\<close>
 
 definition "isDiagonal_upt_k A k = (\<forall> a b. (to_nat a \<noteq> to_nat b \<and> (to_nat a < k \<or> (to_nat b < k))) \<longrightarrow> A $ a $ b = 0)"
 definition "isDiagonal A = (\<forall> a b. to_nat a \<noteq> to_nat b \<longrightarrow> A $ a $ b = 0)"
 
 lemma isDiagonal_intro:
   fixes A::"'a::{zero}^'cols::mod_type^'rows::mod_type"
   assumes "\<And>a::'rows. \<And>b::'cols. to_nat a = to_nat b"
   shows "isDiagonal A"
   using assms
   unfolding isDiagonal_def by auto
 
 text\<open>Definition of Smith normal form up to position k. The element $A_{k-1,k-1}$ 
 does not need to divide $A_{k,k}$ and $A_{k,k}$ could have non-zero entries above and below.\<close>
 
   definition "Smith_normal_form_upt_k A k = 
   (
     (\<forall>a b. to_nat a = to_nat b \<and> to_nat a + 1 < k \<and> to_nat b + 1< k \<longrightarrow> A $ a $ b dvd A $ (a+1) $ (b+1))
     \<and> isDiagonal_upt_k A k
   )"
 
 definition "Smith_normal_form A = 
   (
     (\<forall>a b. to_nat a = to_nat b \<and> to_nat a + 1 < nrows A \<and> to_nat b + 1 < ncols A \<longrightarrow> A $ a $ b dvd A $ (a+1) $ (b+1))
     \<and> isDiagonal A    
   )"
 
 subsection \<open>Basic properties\<close>
 
 lemma Smith_normal_form_min: 
   "Smith_normal_form A = Smith_normal_form_upt_k A (min (nrows A) (ncols A))"
   unfolding Smith_normal_form_def Smith_normal_form_upt_k_def nrows_def ncols_def 
   unfolding isDiagonal_upt_k_def isDiagonal_def
-  by (auto, smt Suc_le_eq le_trans less_le min.boundedI not_less_eq_eq suc_not_zero 
+  by (auto, smt (verit) Suc_le_eq le_trans less_le min.boundedI not_less_eq_eq suc_not_zero 
       to_nat_less_card to_nat_plus_one_less_card')
 
 
 lemma Smith_normal_form_upt_k_0[simp]: "Smith_normal_form_upt_k A 0" 
   unfolding Smith_normal_form_upt_k_def 
   unfolding isDiagonal_upt_k_def isDiagonal_def
   by auto
 
 lemma Smith_normal_form_upt_k_intro:
   assumes "(\<And>a b. to_nat a = to_nat b \<and> to_nat a + 1 < k \<and> to_nat b + 1< k \<Longrightarrow> A $ a $ b dvd A $ (a+1) $ (b+1))"
   and "(\<And>a b. (to_nat a \<noteq> to_nat b \<and> (to_nat a < k \<or> (to_nat b < k))) \<Longrightarrow> A $ a $ b = 0)"
 shows "Smith_normal_form_upt_k A k"
   unfolding Smith_normal_form_upt_k_def 
   unfolding isDiagonal_upt_k_def isDiagonal_def using assms by simp
 
 lemma Smith_normal_form_upt_k_intro_alt:
   assumes "(\<And>a b. to_nat a = to_nat b \<and> to_nat a + 1 < k \<and> to_nat b + 1 < k \<Longrightarrow> A $ a $ b dvd A $ (a+1) $ (b+1))"
   and "isDiagonal_upt_k A k"
   shows "Smith_normal_form_upt_k A k"
   using assms 
   unfolding Smith_normal_form_upt_k_def by auto 
 
 lemma Smith_normal_form_upt_k_condition1:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes "Smith_normal_form_upt_k A k" 
   and "to_nat a = to_nat b" and " to_nat a + 1 < k" and "to_nat b + 1 < k "
   shows "A $ a $ b dvd A $ (a+1) $ (b+1)"          
   using assms unfolding Smith_normal_form_upt_k_def by auto
 
 
 lemma Smith_normal_form_upt_k_condition2:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes "Smith_normal_form_upt_k A k" 
   and "to_nat a \<noteq> to_nat b" and "(to_nat a < k \<or> to_nat b < k)"
   shows "((A $ a) $ b) = 0"
   using assms unfolding Smith_normal_form_upt_k_def
   unfolding isDiagonal_upt_k_def isDiagonal_def by auto
 
 
 lemma Smith_normal_form_upt_k1_intro:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes s: "Smith_normal_form_upt_k A k" 
   and cond1: "A $ from_nat (k - 1) $ from_nat (k-1) dvd A $ (from_nat k) $ (from_nat k)"
   and cond2a: "\<forall>a. to_nat a > k \<longrightarrow> A $ a $ from_nat k = 0"
   and cond2b: "\<forall>b. to_nat b > k \<longrightarrow> A $ from_nat k $ b = 0"
 shows "Smith_normal_form_upt_k A (Suc k)"
 proof (rule Smith_normal_form_upt_k_intro)
   fix a::'rows and b::'cols 
   assume a: "to_nat a \<noteq> to_nat b \<and> (to_nat a < Suc k \<or> to_nat b < Suc k)"
   show "A $ a $ b = 0" 
     by (metis Smith_normal_form_upt_k_condition2 a 
         assms(1) cond2a cond2b from_nat_to_nat_id less_SucE nat_neq_iff)
 next
   fix a::'rows and b::'cols 
   assume a: "to_nat a = to_nat b \<and> to_nat a + 1 < Suc k \<and> to_nat b + 1 < Suc k"
   show "A $ a $ b dvd A $ (a + 1) $ (b + 1)"
     by (metis (mono_tags, lifting) Smith_normal_form_upt_k_condition1 a add_diff_cancel_right' cond1
         from_nat_suc from_nat_to_nat_id less_SucE s)
 qed
 
 lemma Smith_normal_form_upt_k1_intro_diagonal:
   fixes A::"'a::{bezout_ring}^'cols::mod_type^'rows::mod_type"
   assumes s: "Smith_normal_form_upt_k A k" 
   and d: "isDiagonal A"
   and cond1: "A $ from_nat (k - 1) $ from_nat (k-1) dvd A $ (from_nat k) $ (from_nat k)"
 shows "Smith_normal_form_upt_k A (Suc k)"
 proof (rule Smith_normal_form_upt_k_intro)
   fix a::'rows and b::'cols 
   assume a: "to_nat a = to_nat b \<and> to_nat a + 1 < Suc k \<and> to_nat b + 1 < Suc k"
   show "A $ a $ b dvd A $ (a + 1) $ (b + 1)"
     by (metis (mono_tags, lifting) Smith_normal_form_upt_k_condition1 a 
         add_diff_cancel_right' cond1 from_nat_suc from_nat_to_nat_id less_SucE s)    
 next
   show "\<And>a b. to_nat a \<noteq> to_nat b \<and> (to_nat a < Suc k \<or> to_nat b < Suc k) \<Longrightarrow> A $ a $ b = 0"
     using d isDiagonal_def by blast
 qed
 
 
 end
\ No newline at end of file
diff --git a/thys/Smith_Normal_Form/Smith_Normal_Form_JNF.thy b/thys/Smith_Normal_Form/Smith_Normal_Form_JNF.thy
--- a/thys/Smith_Normal_Form/Smith_Normal_Form_JNF.thy
+++ b/thys/Smith_Normal_Form/Smith_Normal_Form_JNF.thy
@@ -1,168 +1,169 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>Definition of Smith normal form in JNF\<close>
 
 theory Smith_Normal_Form_JNF
   imports
     SNF_Missing_Lemmas
 begin
 
 text \<open>Now, we define diagonal matrices and Smith normal form in JNF\<close>
 
 definition "isDiagonal_mat A = (\<forall>i j. i \<noteq> j \<and> i < dim_row A \<and> j < dim_col A \<longrightarrow> A$$(i,j) = 0)"
 
 definition "Smith_normal_form_mat A = 
   (
     (\<forall>a. a + 1 < min (dim_row A) (dim_col A) \<longrightarrow> A $$ (a,a) dvd A $$ (a+1,a+1))
     \<and> isDiagonal_mat A    
   )"
 
 lemma SNF_first_divides:
   assumes SNF_A: "Smith_normal_form_mat A" and "(A::('a::comm_ring_1) mat) \<in> carrier_mat n m"
   and i: "i < min (dim_row A) (dim_col A)"
 shows "A $$ (0,0) dvd A $$ (i,i)"
   using i
 proof (induct i)
   case 0
   then show ?case by auto
 next
   case (Suc i)
   show ?case 
     by (metis (full_types) Smith_normal_form_mat_def Suc.hyps Suc.prems 
         Suc_eq_plus1 Suc_lessD SNF_A dvd_trans)
 qed
 
 lemma Smith_normal_form_mat_intro:
   assumes "(\<forall>a. a + 1 < min (dim_row A) (dim_col A) \<longrightarrow> A $$ (a,a) dvd A $$ (a+1,a+1))"
     and "isDiagonal_mat A" 
   shows "Smith_normal_form_mat A"
   unfolding Smith_normal_form_mat_def using assms by auto
 
 lemma Smith_normal_form_mat_m0[simp]:
   assumes A: "A\<in>carrier_mat m 0"
   shows "Smith_normal_form_mat A"
   using A unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
 
 lemma Smith_normal_form_mat_0m[simp]:
   assumes A: "A\<in>carrier_mat 0 m"
   shows "Smith_normal_form_mat A"
   using A unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
 
 lemma S00_dvd_all_A:
   assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat m n"
   and P: "P \<in> carrier_mat m m"
   and Q: "Q \<in> carrier_mat n n"
   and inv_P: "invertible_mat P"
   and inv_Q: "invertible_mat Q"
   and S_PAQ: "S = P*A*Q"
   and SNF_S: "Smith_normal_form_mat S"
   and i: "i<m" and j: "j<n"
 shows "S$$(0,0) dvd A $$ (i,j)"
 proof -
   have S00: "(\<forall>i j. i<m \<and> j<n \<longrightarrow> S$$(0,0) dvd S$$(i,j))"
     using SNF_S unfolding Smith_normal_form_mat_def isDiagonal_mat_def
-    by (smt P Q SNF_first_divides A S_PAQ SNF_S carrier_matD 
+    by (smt (verit) P Q SNF_first_divides A S_PAQ SNF_S carrier_matD 
         dvd_0_right min_less_iff_conj mult_carrier_mat)
     obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
       using inv_P unfolding invertible_mat_def by auto
     obtain Q' where QQ': "inverts_mat Q Q'" and Q'Q: "inverts_mat Q' Q"
       using inv_Q unfolding invertible_mat_def by auto
     have A_P'SQ': "P'*S*Q' = A"
     proof -
       have "P'*S*Q' = P'*(P*A*Q)*Q'" unfolding S_PAQ by auto
       also have "... = (P'*P)*A*(Q*Q')"
-        by (smt A PP' Q Q'Q P assoc_mult_mat carrier_mat_triv index_mult_mat(2) index_mult_mat(3) 
-            index_one_mat(3) inverts_mat_def right_mult_one_mat)
+        by (smt (verit, ccfv_threshold) A P'P PP' Q'Q assms(2) assms(3) assoc_mult_mat
+            carrier_matD(2) carrier_matI index_mult_mat(2) index_mult_mat(3)
+            inverts_mat_def one_carrier_mat)
       also have "... = A"
         by (metis A P'P QQ' A Q P carrier_matD(1) index_mult_mat(3) index_one_mat(3) inverts_mat_def
             left_mult_one_mat right_mult_one_mat)
       finally show ?thesis .
     qed
     have "(\<forall>i j. i<m \<and> j<n \<longrightarrow> S$$(0,0) dvd (P'*S*Q')$$(i,j))"
     proof (rule dvd_elements_mult_matrix_left_right[OF _ _ _ S00])
       show "S \<in> carrier_mat m n" using P A Q S_PAQ by auto
       show "P' \<in> carrier_mat m m"
         by (metis (mono_tags, lifting) A_P'SQ' PP' P A carrier_matD carrier_matI index_mult_mat(2) 
             index_mult_mat(3) inverts_mat_def one_carrier_mat)
       show "Q' \<in> carrier_mat n n"
         by (metis (mono_tags, lifting) A_P'SQ' Q'Q Q A carrier_matD(2) carrier_matI 
             index_mult_mat(3) inverts_mat_def one_carrier_mat)
     qed
     thus ?thesis using A_P'SQ' i j by auto
 qed
 
 
 lemma SNF_first_divides_all:
   assumes SNF_A: "Smith_normal_form_mat A" and A: "(A::('a::comm_ring_1) mat) \<in> carrier_mat m n"
   and i: "i < m" and j: "j<n"
 shows "A $$ (0,0) dvd A $$ (i,j)"
 proof (cases "i=j")
   case True
   then show ?thesis using assms SNF_first_divides by (metis carrier_matD min_less_iff_conj)
 next
   case False
   hence "A$$(i,j) = 0" using SNF_A i j A unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
   then show ?thesis by auto
 qed
 
 (*This can also be obtained from HOL Analysis via local type definitions*)
 lemma SNF_divides_diagonal:
   fixes A::"'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n m" 
     and SNF_A: "Smith_normal_form_mat A"
     and j: "j < min n m"
     and ij: "i\<le>j"
   shows "A$$(i,i) dvd A$$(j,j)" 
   using ij j
 proof (induct j)
   case 0
   then show ?case by auto
 next
   case (Suc j)
   show ?case
   proof (cases "i\<le>j")
     case True
     have "A $$ (i, i) dvd A $$ (j, j)" using Suc.hyps Suc.prems True by simp
     also have "... dvd A $$ (Suc j, Suc j)" 
       using SNF_A Suc.prems A 
       unfolding Smith_normal_form_mat_def by auto
     finally show ?thesis by auto 
   next
     case False
     hence "i=Suc j" using Suc.prems by auto
     then show ?thesis by auto
   qed
 qed
 
 lemma Smith_zero_imp_zero:
   fixes A::"'a::comm_ring_1 mat"
   assumes  A: "A \<in> carrier_mat m n"
     and SNF: "Smith_normal_form_mat A"
     and Aii: "A$$(i,i) = 0" 
     and j: "j<min m n" 
     and ij: "i\<le>j"
   shows "A$$(j,j) = 0"
 proof -
   have "A$$(i,i) dvd A$$(j,j)" by (rule SNF_divides_diagonal[OF A SNF j ij])
   thus ?thesis using Aii by auto
 qed
 
 lemma SNF_preserved_multiples_identity:
   assumes S: "S \<in> carrier_mat m n" and SNF: "Smith_normal_form_mat (S::'a::comm_ring_1 mat)"
   shows "Smith_normal_form_mat (S*(k \<cdot>\<^sub>m 1\<^sub>m n))"
 proof (rule Smith_normal_form_mat_intro)
   have rw: "S*(k \<cdot>\<^sub>m 1\<^sub>m n) = Matrix.mat m n (\<lambda>(i, j). S $$ (i, j) * k)"
     unfolding mat_diag_smult[symmetric] by (rule mat_diag_mult_right[OF S])
   show "isDiagonal_mat (S * (k \<cdot>\<^sub>m 1\<^sub>m n))" 
     using SNF S unfolding Smith_normal_form_mat_def isDiagonal_mat_def rw
     by auto
   show "\<forall>a. a + 1 < min (dim_row (S * (k \<cdot>\<^sub>m 1\<^sub>m n))) (dim_col (S * (k \<cdot>\<^sub>m 1\<^sub>m n))) \<longrightarrow>
         (S * (k \<cdot>\<^sub>m 1\<^sub>m n)) $$ (a, a) dvd (S * (k \<cdot>\<^sub>m 1\<^sub>m n)) $$ (a + 1, a + 1)"
     using SNF S unfolding Smith_normal_form_mat_def isDiagonal_mat_def rw
     by (auto simp add: mult_dvd_mono)
 qed
 
 end