diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Algorithm.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Algorithm.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Algorithm.thy
@@ -0,0 +1,379 @@
+
+section \<open>Formalization of an efficient Hermite normal form algorithm\<close>
+
+text \<open>We formalize a version of the Hermite normal form algorithm based on reductions modulo
+the determinant. This avoids the growth of the intermediate coefficients.\<close>
+
+subsection \<open>Implementation of the algorithm using generic modulo operation\<close>
+
+text \<open>Exception on generic modulo: currently in Hermite-reduce-above, ordinary div/mod is used,
+  since that is our choice for the complete set of residues.\<close>
+
+theory HNF_Mod_Det_Algorithm
+  imports
+    Jordan_Normal_Form.Gauss_Jordan_IArray_Impl
+    Show.Show_Instances
+    Jordan_Normal_Form.Determinant_Impl
+    Jordan_Normal_Form.Show_Matrix
+    LLL_Basis_Reduction.LLL_Certification   
+    Smith_Normal_Form.SNF_Algorithm_Euclidean_Domain
+    Smith_Normal_Form.SNF_Missing_Lemmas
+    Uniqueness_Hermite_JNF
+    Matrix_Change_Row
+begin
+
+subsubsection \<open>Echelon form algorithm\<close>
+
+fun make_first_column_positive :: "int mat \<Rightarrow> int mat" where
+  "make_first_column_positive A = (
+       Matrix.mat (dim_row A) (dim_col A) \<comment> \<open> Create a matrix of the same dimensions \<close>
+          (\<lambda>(i,j). if A $$(i,0) < 0 then - A $$(i,j) else A $$(i,j)
+            )
+  )"
+
+
+locale mod_operation =
+  fixes generic_mod :: "int \<Rightarrow> int \<Rightarrow> int" (infixl "gmod" 70)
+    and generic_div :: "int \<Rightarrow> int \<Rightarrow> int" (infixl "gdiv" 70)
+begin
+
+text \<open>Version for reducing all elements\<close>
+
+fun reduce :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat" where
+  "reduce a b D A = (let Aaj = A$$(a,0); Abj = A $$ (b,0)     
+  in
+  if Aaj = 0 then A else
+  case euclid_ext2 Aaj Abj of (p,q,u,v,d) \<Rightarrow> \<comment> \<open> p*Aaj + q * Abj = d, u = - Abj/d, v = Aaj/d \<close>
+       Matrix.mat (dim_row A) (dim_col A) \<comment> \<open> Create a matrix of the same dimensions \<close>
+          (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
+                              if k = 0 then if D dvd r then D else r else r gmod D \<comment> \<open> Row a is multiplied by p and added row b multiplied by q, modulo D\<close>
+                   else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
+                               if k = 0 then r else r gmod D \<comment> \<open> Row b is multiplied by v and added row a multiplied by u, modulo D\<close>
+                   else A$$(i,k)  \<comment> \<open> All the other rows remain unchanged\<close>
+            )
+  )"
+
+text \<open>Version for reducing, with abs-checking\<close>
+
+fun reduce_abs :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat" where
+  "reduce_abs a b D A = (let Aaj = A$$(a,0); Abj = A $$ (b,0)     
+  in
+  if Aaj = 0 then A else
+  case euclid_ext2 Aaj Abj of (p,q,u,v,d) \<Rightarrow> \<comment> \<open> p*Aaj + q * Abj = d, u = - Abj/d, v = Aaj/d \<close>
+       Matrix.mat (dim_row A) (dim_col A) \<comment> \<open> Create a matrix of the same dimensions \<close>
+          (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
+                            if abs r > D then if k = 0 \<and> D dvd r then D else r gmod D else r 
+                   else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
+                              if abs r > D then r gmod D else r
+                   else A$$(i,k)  \<comment> \<open> All the other rows remain unchanged\<close>
+            )
+  )"
+
+definition reduce_impl :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat" where
+  "reduce_impl a b D A = (let 
+    row_a = Matrix.row A a; 
+    Aaj = row_a $v 0     
+  in
+  if Aaj = 0 then A else let 
+    row_b = Matrix.row A b;
+    Abj = row_b $v 0 in
+  case euclid_ext2 Aaj Abj of (p,q,u,v,d) \<Rightarrow> 
+    let row_a' = (\<lambda> k ak. let r = (p * ak + q * row_b $v k) in
+              if k = 0 then if D dvd r then D else r else r gmod D);
+        row_b' = (\<lambda> k bk. let r = u * row_a $v k + v * bk in
+                               if k = 0 then r else r gmod D)
+     in change_row a row_a' (change_row b row_b' A)
+  )"
+
+definition reduce_abs_impl :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat" where
+  "reduce_abs_impl a b D A = (let 
+    row_a = Matrix.row A a; 
+    Aaj = row_a $v 0     
+  in
+  if Aaj = 0 then A else let 
+    row_b = Matrix.row A b;
+    Abj = row_b $v 0 in
+  case euclid_ext2 Aaj Abj of (p,q,u,v,d) \<Rightarrow> 
+    let row_a' = (\<lambda> k ak. let r = (p * ak + q * row_b $v k) in
+              if abs r > D then if k = 0 \<and> D dvd r then D else r gmod D else r);
+        row_b' = (\<lambda> k bk. let r = u * row_a $v k + v * bk in
+                                if abs r > D then r gmod D else r)
+     in change_row a row_a' (change_row b row_b' A)
+  )"
+
+lemma reduce_impl: "a < nr \<Longrightarrow> b < nr \<Longrightarrow> 0 < nc \<Longrightarrow> a \<noteq> b \<Longrightarrow> A \<in> carrier_mat nr nc
+  \<Longrightarrow> reduce_impl a b D A = reduce a b D A" 
+  unfolding reduce_impl_def reduce.simps Let_def
+  apply (intro if_cong[OF _ refl], force)
+  apply (intro prod.case_cong refl, force)
+  apply (intro eq_matI, auto)
+  done
+
+
+lemma reduce_abs_impl: "a < nr \<Longrightarrow> b < nr \<Longrightarrow> 0 < nc \<Longrightarrow> a \<noteq> b \<Longrightarrow> A \<in> carrier_mat nr nc
+  \<Longrightarrow> reduce_abs_impl a b D A = reduce_abs a b D A" 
+  unfolding reduce_abs_impl_def reduce_abs.simps Let_def
+  apply (intro if_cong[OF _ refl], force)
+  apply (intro prod.case_cong refl, force)
+  apply (intro eq_matI, auto)
+  done
+  
+
+(* This functions reduce the elements below the position (a,0), given a list of positions 
+   of non-zero positions as input*)
+fun reduce_below :: "nat \<Rightarrow> nat list \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat"
+where "reduce_below a [] D A = A"
+  | "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)"
+
+fun reduce_below_impl :: "nat \<Rightarrow> nat list \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat"
+where "reduce_below_impl a [] D A = A"
+  | "reduce_below_impl a (x # xs) D A = reduce_below_impl a xs D (reduce_impl a x D A)"
+
+lemma reduce_impl_carrier[simp,intro]: "A \<in> carrier_mat m n \<Longrightarrow> reduce_impl a b D A \<in> carrier_mat m n" 
+  unfolding reduce_impl_def Let_def by (auto split: prod.splits)
+
+lemma reduce_below_impl: "a < nr \<Longrightarrow> 0 < nc \<Longrightarrow> (\<And> b. b \<in> set bs \<Longrightarrow> b < nr) \<Longrightarrow> a \<notin> set bs 
+  \<Longrightarrow> A \<in> carrier_mat nr nc \<Longrightarrow> reduce_below_impl a bs D A = reduce_below a bs D A" 
+proof (induct bs arbitrary: A)
+  case (Cons b bs A)
+  show ?case by (simp del: reduce.simps, 
+      subst reduce_impl[of _ nr _ nc], 
+      (insert Cons, auto simp del: reduce.simps)[5],
+      rule Cons(1), insert Cons(2-), auto simp: Let_def split: prod.splits)
+qed simp
+
+
+
+fun reduce_below_abs :: "nat \<Rightarrow> nat list \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat"
+where "reduce_below_abs a [] D A = A"
+  | "reduce_below_abs a (x # xs) D A = reduce_below_abs a xs D (reduce_abs a x D A)"
+
+fun reduce_below_abs_impl :: "nat \<Rightarrow> nat list \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat"
+where "reduce_below_abs_impl a [] D A = A"
+  | "reduce_below_abs_impl a (x # xs) D A = reduce_below_abs_impl a xs D (reduce_abs_impl a x D A)"
+
+lemma reduce_abs_impl_carrier[simp,intro]: "A \<in> carrier_mat m n \<Longrightarrow> reduce_abs_impl a b D A \<in> carrier_mat m n" 
+  unfolding reduce_abs_impl_def Let_def by (auto split: prod.splits)
+
+lemma reduce_abs_below_impl: "a < nr \<Longrightarrow> 0 < nc \<Longrightarrow> (\<And> b. b \<in> set bs \<Longrightarrow> b < nr) \<Longrightarrow> a \<notin> set bs 
+  \<Longrightarrow> A \<in> carrier_mat nr nc \<Longrightarrow> reduce_below_abs_impl a bs D A = reduce_below_abs a bs D A" 
+proof (induct bs arbitrary: A)
+  case (Cons b bs A)
+  show ?case by (simp del: reduce_abs.simps, 
+      subst reduce_abs_impl[of _ nr _ nc], 
+      (insert Cons, auto simp del: reduce_abs.simps)[5],
+      rule Cons(1), insert Cons(2-), auto simp: Let_def split: prod.splits)
+qed simp
+
+text \<open>This function outputs a matrix in echelon form via reductions modulo the determinant\<close>
+
+
+function FindPreHNF :: "bool \<Rightarrow> int \<Rightarrow> int mat \<Rightarrow> int mat"
+  where "FindPreHNF abs_flag D A = 
+  (let m = dim_row A; n = dim_col A in 
+  if m < 2 \<or> n = 0 then A else \<comment> \<open> No operations are carried out if m = 1 \<close>
+  let non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A];
+         A' = (if A$$(0,0) \<noteq> 0 then A
+              else let i = non_zero_positions ! 0  \<comment> \<open> Select the first non-zero position below the first element\<close>
+                   in swaprows 0 i A  
+              );
+        Reduce = (if abs_flag then reduce_below_abs else reduce_below)
+    in
+      if n < 2 then Reduce 0 non_zero_positions D A'  \<comment> \<open> If n = 1, then we have to reduce the column \<close>   
+    else 
+      let         
+        (A_UL,A_UR,A_DL,A_DR) = split_block (Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1; 
+        sub_PreHNF = FindPreHNF abs_flag D A_DR in       
+        four_block_mat A_UL A_UR A_DL sub_PreHNF)"                 
+  by auto termination 
+proof (relation "Wellfounded.measure (\<lambda>(abs_flag,D,A). dim_col A)")
+  show "wf (Wellfounded.measure (\<lambda>(abs_flag,D, A). dim_col A))" by auto
+  fix abs_flag D A m n nz A' R xd A'_UL y A'_UR ya A'_DL A'_DR
+  assume m: "m = dim_row A" and n:"n = dim_col A"
+    and m2: "\<not> (m < 2 \<or> n = 0)" and nz_def: "nz = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A] "
+    and A'_def: "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = nz ! 0 in swaprows 0 i A)"
+    and R_def: "R = (if abs_flag then reduce_below_abs else reduce_below)"
+    and n2: "\<not> n < 2" and "xd = split_block (R 0 nz D (make_first_column_positive A')) 1 1"
+    and "(A'_UL, y) = xd" and "(A'_UR, ya) = y" and "(A'_DL, A'_DR) = ya" 
+  hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
+        = split_block (R 0 nz D (make_first_column_positive A')) 1 1" by force
+  have dr_mk1: "dim_row (make_first_column_positive A) = dim_row A" for A by auto
+  have dr_mk2: "dim_col (make_first_column_positive A) = dim_col A" for A by auto  
+  have r1: "reduce_below a xs D A \<in> carrier_mat m n" if "A \<in> carrier_mat m n" for A a xs
+    using that by (induct a xs D A rule: reduce_below.induct, auto simp add: Let_def euclid_ext2_def) 
+  hence R: "(reduce_below 0 nz D (make_first_column_positive A')) \<in> carrier_mat m n"
+    using A'_def m n 
+    by (metis carrier_matI index_mat_swaprows(2,3) dr_mk1 dr_mk2)
+  have "reduce_below_abs a xs D A \<in> carrier_mat m n" if "A \<in> carrier_mat m n" for A a xs
+    using that by (induct a xs D A rule: reduce_below_abs.induct, auto simp add: Let_def euclid_ext2_def) 
+  hence R2: "(reduce_below_abs 0 nz D (make_first_column_positive A')) \<in> carrier_mat m n"
+    using A'_def m n 
+    by (metis carrier_matI index_mat_swaprows(2,3) dr_mk1 dr_mk2)
+ 
+  have "A'_DR \<in> carrier_mat (m-1) (n-1)"
+    by (cases abs_flag; rule split_block(4)[OF A'_split[symmetric]],insert m2 n2 m n R_def R R2, auto)
+  thus "((abs_flag, D, A'_DR),abs_flag, D, A) \<in> Wellfounded.measure (\<lambda>(abs_flag,D, A). dim_col A)" using n2 m2 n m by auto
+qed
+
+lemma FindPreHNF_code: "FindPreHNF abs_flag D A = 
+  (let m = dim_row A; n = dim_col A in 
+  if m < 2 \<or> n = 0 then A else 
+  let non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A];
+         A' = (if A$$(0,0) \<noteq> 0 then A
+              else let i = non_zero_positions ! 0 in swaprows 0 i A  
+              );
+         Reduce_impl = (if abs_flag then reduce_below_abs_impl else reduce_below_impl)
+    in
+      if n < 2 then Reduce_impl 0 non_zero_positions D A'   
+    else 
+      let         
+        (A_UL,A_UR,A_DL,A_DR) = split_block (Reduce_impl 0 non_zero_positions D (make_first_column_positive A')) 1 1; 
+        sub_PreHNF = FindPreHNF abs_flag D A_DR in       
+        four_block_mat A_UL A_UR A_DL sub_PreHNF)"  (is "?lhs = ?rhs")
+proof -
+  let ?f = "\<lambda>R. (if dim_row A < 2 \<or> dim_col A = 0 then A else if dim_col A < 2
+          then R 0 (filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A]) D
+  (if A $$ (0, 0) \<noteq> 0 then A else swaprows 0 (filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A] ! 0) A)
+  else case split_block (R 0 (filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A]) D
+    (make_first_column_positive (if A $$ (0, 0) \<noteq> 0 then A else 
+      swaprows 0 (filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A] ! 0) A))) 1 1 of
+  (A_UL, A_UR, A_DL, A_DR) \<Rightarrow> four_block_mat A_UL A_UR A_DL (FindPreHNF abs_flag D A_DR))"
+  have M_carrier: "make_first_column_positive (if A $$ (0, 0) \<noteq> 0 then A 
+    else swaprows 0 (filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A] ! 0) A) 
+    \<in> carrier_mat (dim_row A) (dim_col A)"
+    by (smt (z3) index_mat_swaprows(2) index_mat_swaprows(3) make_first_column_positive.simps mat_carrier)
+  have *: "0 \<notin> set (filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A])" by simp
+  have "?lhs = ?f (if abs_flag then reduce_below_abs else reduce_below)"
+    unfolding FindPreHNF.simps[of abs_flag D A] Let_def by presburger
+  also have "... = ?rhs"
+  proof (cases abs_flag)
+    case True
+    have "?f (if abs_flag then reduce_below_abs else reduce_below) = ?f reduce_below_abs" 
+      using True by presburger
+    also have "... = ?f reduce_below_abs_impl" 
+      by ((intro if_cong refl prod.case_cong arg_cong[of _ _ "\<lambda> x. split_block x 1 1"];
+       (subst reduce_abs_below_impl[where nr = "dim_row A" and nc = "dim_col A"])), (auto)[9])
+       (insert M_carrier *, blast+)
+    also have "... = ?f (if abs_flag then reduce_below_abs_impl else reduce_below_impl)" 
+      using True by presburger
+    finally show ?thesis using True unfolding FindPreHNF.simps[of abs_flag D A] Let_def by blast
+  next
+    case False
+    have "?f (if abs_flag then reduce_below_abs else reduce_below) = ?f reduce_below" 
+      using False by presburger
+    also have "... = ?f reduce_below_impl" 
+      by ((intro if_cong refl prod.case_cong arg_cong[of _ _ "\<lambda> x. split_block x 1 1"];
+       (subst reduce_below_impl[where nr = "dim_row A" and nc = "dim_col A"])), (auto)[9])
+       (insert M_carrier *, blast+)
+    also have "... = ?f (if abs_flag then reduce_below_abs_impl else reduce_below_impl)" 
+      using False by presburger
+    finally show ?thesis using False unfolding FindPreHNF.simps[of abs_flag D A] Let_def by blast
+  qed
+  finally show ?thesis by blast
+qed
+end
+
+declare mod_operation.FindPreHNF_code[code]
+declare mod_operation.reduce_below_impl.simps[code]
+declare mod_operation.reduce_impl_def[code]
+declare mod_operation.reduce_below_abs_impl.simps[code]
+declare mod_operation.reduce_abs_impl_def[code]
+
+subsubsection \<open>From echelon form to Hermite normal form\<close>
+
+text \<open>From here on, we define functions to transform a matrix in echelon form into its Hermite
+normal form. Essentially, we are defining the functions that are available in the AFP entry Hermite
+(which uses HOL Analysis + mod-type) in the JNF matrix representation.\<close>
+
+(*Find the first nonzero element of row l (A is upper triangular)*)
+definition find_fst_non0_in_row :: "nat \<Rightarrow> int mat \<Rightarrow> nat option" where
+  "find_fst_non0_in_row l A = (let is = [l ..< dim_col A];
+    Ais = filter (\<lambda>j. A $$ (l, j) \<noteq> 0) is
+    in case Ais of [] \<Rightarrow> None | _ \<Rightarrow> Some (Ais!0))"
+
+primrec Hermite_reduce_above
+where "Hermite_reduce_above (A::int mat) 0 i j = A"
+    | "Hermite_reduce_above A (Suc n) i j = (let
+    Aij = A $$ (i,j);
+    Anj = A $$ (n,j)
+    in 
+    Hermite_reduce_above (addrow (- (Anj div Aij)) n i A) n i j)"
+
+definition Hermite_of_row_i :: "int mat \<Rightarrow> nat \<Rightarrow> int mat" 
+  where "Hermite_of_row_i A i = (
+  case find_fst_non0_in_row i A of None \<Rightarrow> A | Some j \<Rightarrow> 
+    let Aij = A $$(i,j) in
+    if Aij < 0 then Hermite_reduce_above (multrow i (-1) A) i i j
+    else Hermite_reduce_above A i i j)"
+
+
+primrec Hermite_of_list_of_rows 
+  where
+ "Hermite_of_list_of_rows A [] = A" | 
+ "Hermite_of_list_of_rows A (a#xs) = Hermite_of_list_of_rows (Hermite_of_row_i A a) xs"
+
+text \<open>We combine the previous functions to assemble the algorithm\<close>
+
+definition (in mod_operation) "Hermite_mod_det abs_flag A = 
+  (let m = dim_row A; n = dim_col A; 
+   D = abs(det_int A); 
+   A' = A @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n;
+   E = FindPreHNF abs_flag D A';
+   H = Hermite_of_list_of_rows E [0..<m+n]
+  in mat_of_rows n (map (Matrix.row H) [0..<m]))"
+
+subsubsection \<open>Some examples of execution\<close>
+
+declare mod_operation.Hermite_mod_det_def[code]
+
+value "let B = mat_of_rows_list 4 ([[0,3,1,4],[7,1,0,0],[8,0,19,16],[2,0,0,3::int]]) in
+  show (mod_operation.Hermite_mod_det (mod) True B)"
+
+(*
+sage: import sage.matrix.matrix_integer_dense_hnf as matrix_integer_dense_hnf
+sage: A = matrix(ZZ, [[0,3,1,4],[7,1,0,0],[8,0,19,16],[2,0,0,3]])
+sage: A
+[ 0  3  1  4]
+[ 7  1  0  0]
+[ 8  0 19 16]
+[ 2  0  0  3]
+sage:  H, U = matrix_integer_dense_hnf.hnf_with_transformation(A); H
+[   1    0    0  672]
+[   0    1    0  660]
+[   0    0    1  706]
+[   0    0    0 1341]
+sage: 
+*)
+
+
+value "let B = mat_of_rows_list 7 ([
+[  1,  17, -41,  -1,   1,   0,  0],
+[  0,  -1,   2,   0,  -6,   2,   1],
+[  9,   2,   1,   1,  -2,   2,  -5],
+[ -1,  -3,  -1,   0,  -9,   0,   0],
+[  9,  -1,  -9,   0,   0,   0,   1],
+[  1,  -1,   1,   0,   1,  -8,   0],
+[  1,  -1,   0,  -2,  -1,  -1,   0::int]]) in 
+  show (mod_operation.Hermite_mod_det (mod) True B)"
+
+(*
+sage: import sage.matrix.matrix_integer_dense_hnf as matrix_integer_dense_hnf
+sage: A = random_matrix(ZZ,7,7); A
+[  1  17 -41  -1   1   0   0]
+[  0  -1   2   0  -6   2   1]
+[  9   2   1   1  -2   2  -5]
+[ -1  -3  -1   0  -9   0   0]
+[  9  -1  -9   0   0   0   1]
+[  1  -1   1   0   1  -8   0]
+[  1  -1   0  -2  -1  -1   0]
+sage: H, U = matrix_integer_dense_hnf.hnf_with_transformation(A); H
+[     1      0      0      0      0      1 191934]
+[     0      1      0      0      0      0 435767]
+[     0      0      1      0      0      1 331950]
+[     0      0      0      1      0      0 185641]
+[     0      0      0      0      1      0  38022]
+[     0      0      0      0      0      2 477471]
+[     0      0      0      0      0      0 565304]
+*)
+
+end
\ No newline at end of file
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy
@@ -0,0 +1,11563 @@
+
+subsection \<open>Soundness of the algorithm\<close>
+
+theory HNF_Mod_Det_Soundness
+  imports
+    HNF_Mod_Det_Algorithm
+    Signed_Modulo
+begin
+
+hide_const(open) Determinants.det Determinants2.upper_triangular
+  Finite_Cartesian_Product.row Finite_Cartesian_Product.rows
+  Finite_Cartesian_Product.vec
+
+subsubsection \<open>Results connecting lattices and Hermite normal form\<close>
+
+text \<open>The following results will also be useful for proving the soundness of the certification 
+approach.\<close>
+
+lemma of_int_mat_hom_int_id[simp]:
+  fixes A::"int mat"
+  shows "of_int_hom.mat_hom A = A" unfolding map_mat_def by auto
+
+
+definition "is_sound_HNF algorithm associates res 
+    = (\<forall>A. let (P,H) = algorithm A; m = dim_row A; n = dim_col A in 
+        P \<in> carrier_mat m m \<and> H \<in> carrier_mat m n \<and> invertible_mat P \<and> A = P * H 
+        \<and> Hermite_JNF associates res H)"
+
+lemma HNF_A_eq_HNF_PA:
+  fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat"
+  assumes A: "A \<in> carrier_mat n n" and inv_A: "invertible_mat A" 
+    and inv_P: "invertible_mat P" and P: "P \<in> carrier_mat n n"
+    and sound_HNF: "is_sound_HNF HNF associates res"
+    and P1_H1: "(P1,H1) = HNF (P*A)"
+    and P2_H2: "(P2,H2) = HNF A"
+  shows "H1 = H2"
+proof -
+  obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P"
+    and inv_P: "inv_P \<in> carrier_mat n n"
+    using P inv_P obtain_inverse_matrix by blast
+  have P1: "P1 \<in> carrier_mat n n"
+      using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def
+      by (metis (no_types, lifting) P carrier_matD(1) index_mult_mat(2) old.prod.case)
+    have H1: "H1 \<in> carrier_mat n n" using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def
+  by (metis (no_types, lifting) A P carrier_matD(1) carrier_matD(2) case_prodD index_mult_mat(2,3))
+  have invertible_inv_P: "invertible_mat inv_P"
+      using P_inv_P inv_P inv_P_P invertible_mat_def square_mat.simps by blast
+  have P_A_P1_H1: "P * A = P1 * H1" using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) case_prod_conv)
+  hence "A = inv_P * (P1 * H1)"
+    by (smt A P inv_P_P inv_P assoc_mult_mat carrier_matD(1) inverts_mat_def left_mult_one_mat)
+  hence A_inv_P_P1_H1: "A = (inv_P * P1) * H1"
+    by (smt P P1_H1 assoc_mult_mat carrier_matD(1) fst_conv index_mult_mat(2) inv_P 
+        is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+  have A_P2_H2: "A = P2 * H2" using P2_H2 sound_HNF unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) case_prod_conv)
+  have invertible_inv_P_P1: "invertible_mat (inv_P * P1)"
+  proof (rule invertible_mult_JNF[OF inv_P P1 invertible_inv_P])   
+    show "invertible_mat P1"
+      by (smt P1_H1 is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
+  qed
+  show ?thesis
+  proof (rule Hermite_unique_JNF[OF A _ H1 _ _ A_inv_P_P1_H1 A_P2_H2 inv_A invertible_inv_P_P1])
+    show "inv_P * P1 \<in> carrier_mat n n"
+      by (metis carrier_matD(1) carrier_matI index_mult_mat(2) inv_P
+          invertible_inv_P_P1 invertible_mat_def square_mat.simps)
+    show "P2 \<in> carrier_mat n n" 
+      by (smt A P2_H2 carrier_matD(1) is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
+    show "H2 \<in> carrier_mat n n"
+      by (smt A P2_H2 carrier_matD(1) carrier_matD(2) is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+    show "invertible_mat P2"
+      by (smt P2_H2 is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
+    show "Hermite_JNF associates res H1" 
+      by (smt P1_H1 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+    show "Hermite_JNF associates res H2"
+      by (smt P2_H2 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+  qed
+qed
+
+
+context vec_module
+begin
+
+lemma mat_mult_invertible_lattice_eq: 
+  assumes fs: "set fs \<subseteq> carrier_vec n"
+  and gs: "set gs \<subseteq> carrier_vec n"  
+  and P: "P \<in> carrier_mat m m" and invertible_P: "invertible_mat P"
+  and length_fs: "length fs = m" and length_gs: "length gs = m"
+  and prod: "mat_of_rows n fs = (map_mat of_int P) * mat_of_rows n gs" 
+  shows "lattice_of fs = lattice_of gs" 
+proof thm mat_mult_sub_lattice
+  show "lattice_of fs \<subseteq> lattice_of gs"
+    by (rule mat_mult_sub_lattice[OF fs gs _ prod],simp add: length_fs length_gs P)
+next
+  obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P"
+    and inv_P: "inv_P \<in> carrier_mat m m"
+    using P invertible_P obtain_inverse_matrix by blast
+  have "of_int_hom.mat_hom (inv_P) * mat_of_rows n fs 
+      = of_int_hom.mat_hom (inv_P) * ((map_mat of_int P) * mat_of_rows n gs)" 
+    using prod by auto
+  also have "... = of_int_hom.mat_hom (inv_P) * (map_mat of_int P) * mat_of_rows n gs"
+    by (smt P assoc_mult_mat inv_P length_gs map_carrier_mat mat_of_rows_carrier(1))
+  also have "... = of_int_hom.mat_hom (inv_P * P) * mat_of_rows n gs"
+    by (metis P inv_P of_int_hom.mat_hom_mult)
+  also have "... = mat_of_rows n gs"
+    by (metis carrier_matD(1) inv_P inv_P_P inverts_mat_def left_mult_one_mat' 
+        length_gs mat_of_rows_carrier(2) of_int_hom.mat_hom_one)    
+  finally have prod: "mat_of_rows n gs = of_int_hom.mat_hom (inv_P) * mat_of_rows n fs" ..
+  show "lattice_of gs \<subseteq> lattice_of fs"
+    by (rule mat_mult_sub_lattice[OF gs fs _ prod], simp add: length_fs length_gs inv_P)
+qed                     
+
+end
+
+
+context
+  fixes n :: nat
+begin
+
+interpretation vec_module "TYPE(int)" .
+
+lemma lattice_of_HNF:
+  assumes sound_HNF: "is_sound_HNF HNF associates res"
+    and P1_H1: "(P,H) = HNF (mat_of_rows n fs)"
+    and fs: "set fs \<subseteq> carrier_vec n" and len: "length fs = m"
+  shows "lattice_of fs = lattice_of (rows H)"
+proof (rule mat_mult_invertible_lattice_eq[OF fs])
+  have H: "H \<in> carrier_mat m n" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) assms(4) mat_of_rows_carrier(2) mat_of_rows_carrier(3) prod.sel(2) split_beta)
+  have H_rw: "mat_of_rows n (Matrix.rows H) = H" using mat_of_rows_rows H by fast
+  have PH_fs_init: "mat_of_rows n fs = P * H" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) case_prodD)
+  show "mat_of_rows n fs = of_int_hom.mat_hom P * mat_of_rows n (Matrix.rows H)"
+    unfolding H_rw of_int_mat_hom_int_id using PH_fs_init by simp  
+  show "set (Matrix.rows H) \<subseteq> carrier_vec n" using H rows_carrier by blast
+  show "P \<in> carrier_mat m m" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
+    by (metis (no_types, lifting) len case_prodD mat_of_rows_carrier(2))    
+  show "invertible_mat P" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
+    by (metis (no_types, lifting) case_prodD)
+  show "length fs = m" using len by simp
+  show "length (Matrix.rows H) = m" using H by auto
+qed
+end
+
+
+context LLL_with_assms 
+begin            
+
+(*For this proof, it seems that is not necessary fs_init to be a list of independent vectors. 
+The context assumes it, though.*)
+lemma certification_via_eq_HNF:
+  assumes sound_HNF: "is_sound_HNF HNF associates res"
+    and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)"
+    and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)"
+    and H1_H2: "H1 = H2" (*The HNF are equal*)
+    and gs: "set gs \<subseteq> carrier_vec n" and len_gs: "length gs = m"
+  shows "lattice_of gs = lattice_of fs_init" "LLL_with_assms n m gs \<alpha>"
+proof -                                           
+  have "lattice_of fs_init = lattice_of (rows H1)"
+    by (rule lattice_of_HNF[OF sound_HNF P1_H1 fs_init], simp add: len)
+  also have "... = lattice_of (rows H2)" using H1_H2 by auto
+  also have "... = lattice_of gs" 
+    by (rule lattice_of_HNF[symmetric, OF sound_HNF P2_H2 gs len_gs])
+  finally show "lattice_of gs = lattice_of fs_init" ..
+    have invertible_P1: "invertible_mat P1" 
+      using sound_HNF P1_H1 unfolding is_sound_HNF_def
+      by (metis (mono_tags, lifting) case_prodD)
+  have invertible_P2: "invertible_mat P2"
+      using sound_HNF P2_H2 unfolding is_sound_HNF_def
+      by (metis (mono_tags, lifting) case_prodD)
+    have P2: "P2 \<in> carrier_mat m m" 
+      using sound_HNF P2_H2 unfolding is_sound_HNF_def
+      by (metis (no_types, lifting) len_gs case_prodD mat_of_rows_carrier(2))
+    obtain inv_P2 where P2_inv_P2: "inverts_mat P2 inv_P2" and inv_P2_P2: "inverts_mat inv_P2 P2"
+    and inv_P2: "inv_P2 \<in> carrier_mat m m"
+      using P2 invertible_P2 obtain_inverse_matrix by blast
+    have P1: "P1 \<in> carrier_mat m m" 
+      using sound_HNF P1_H1 unfolding is_sound_HNF_def
+      by (metis (no_types, lifting) len case_prodD mat_of_rows_carrier(2))
+    have H1: "H1 \<in> carrier_mat m n" 
+      using sound_HNF P1_H1 unfolding is_sound_HNF_def
+      by (metis (no_types, lifting) case_prodD len mat_of_rows_carrier(2) mat_of_rows_carrier(3))
+    have H2: "H2 \<in> carrier_mat m n" 
+      using sound_HNF P2_H2 unfolding is_sound_HNF_def
+      by (metis (no_types, lifting) len_gs case_prodD mat_of_rows_carrier(2) mat_of_rows_carrier(3))
+    have P2_H2: "P2 * H2 = mat_of_rows n gs"
+      by (smt P2_H2 sound_HNF case_prodD is_sound_HNF_def)
+    have P1_H1_fs: "P1 * H1 = mat_of_rows n fs_init"
+      by (smt P1_H1 sound_HNF case_prodD is_sound_HNF_def)
+    obtain inv_P1 where P1_inv_P1: "inverts_mat P1 inv_P1" and inv_P1_P1: "inverts_mat inv_P1 P1"
+    and inv_P1: "inv_P1 \<in> carrier_mat m m"
+      using P1 invertible_P1 obtain_inverse_matrix by blast
+  show "LLL_with_assms n m gs \<alpha>"
+  proof (rule LLL_change_basis(2)[OF gs len_gs])
+    show "P1 * inv_P2 \<in> carrier_mat m m" using P1 inv_P2 by auto
+    have "mat_of_rows n fs_init = P1 * H1" using sound_HNF P2_H2 unfolding is_sound_HNF_def
+      by (metis (mono_tags, lifting) P1_H1 case_prodD)
+    also have "... = P1 * inv_P2 * P2 * H1"
+      by (smt P1 P2 assoc_mult_mat carrier_matD(1) inv_P2 inv_P2_P2 inverts_mat_def right_mult_one_mat)
+    also have "... = P1 * inv_P2 * P2 * H2" using H1_H2 by blast
+    also have "... = P1 * inv_P2 * (P2 * H2)" 
+      using H2 P2 \<open>P1 * inv_P2 \<in> carrier_mat m m\<close> assoc_mult_mat by blast
+    also have "... = P1 * (inv_P2 * P2 * H2)"
+      by (metis H2 \<open>P1 * H1 = P1 * inv_P2 * P2 * H1\<close> \<open>P1 * inv_P2 * P2 * H2 = P1 * inv_P2 * (P2 * H2)\<close> 
+          H1_H2 carrier_matD(1) inv_P2 inv_P2_P2 inverts_mat_def left_mult_one_mat)
+    also have "... = P1 * (inv_P2 * (P2 * H2))" using H2 P2 inv_P2 by auto
+    also have "... =  P1 * inv_P2 * mat_of_rows n gs"
+      using P2_H2 \<open>P1 * (inv_P2 * P2 * H2) = P1 * (inv_P2 * (P2 * H2))\<close> 
+        \<open>P1 * inv_P2 * (P2 * H2) = P1 * (inv_P2 * P2 * H2)\<close> by auto
+    finally show "mat_of_rows n fs_init = P1 * inv_P2 * mat_of_rows n gs" .
+    show "P2 * inv_P1 \<in> carrier_mat m m" 
+      using P2 inv_P1 by auto
+    have "mat_of_rows n gs = P2 * H2" using sound_HNF P2_H2 unfolding is_sound_HNF_def by metis
+    also have "... = P2 * inv_P1 * P1 * H2"
+      by (smt P1 P2 assoc_mult_mat carrier_matD(1) inv_P1 inv_P1_P1 inverts_mat_def right_mult_one_mat)
+    also have "... = P2 * inv_P1 * P1 * H1" using H1_H2 by blast
+    also have "... = P2 * inv_P1 * (P1 * H1)" 
+      using H1 P1 \<open>P2 * inv_P1 \<in> carrier_mat m m\<close> assoc_mult_mat by blast
+    also have "... = P2 * (inv_P1 * P1 * H1)"
+      by (metis H2 \<open>P2 * H2 = P2 * inv_P1 * P1 * H2\<close> \<open>P2 * inv_P1 * P1 * H1 = P2 * inv_P1 * (P1 * H1)\<close> 
+          H1_H2 carrier_matD(1) inv_P1 inv_P1_P1 inverts_mat_def left_mult_one_mat)
+    also have "... = P2 * (inv_P1 * (P1 * H1))" using H1 P1 inv_P1 by auto
+    also have "... =  P2 * inv_P1 * mat_of_rows n fs_init"
+      using P1_H1_fs \<open>P2 * (inv_P1 * P1 * H1) = P2 * (inv_P1 * (P1 * H1))\<close> 
+        \<open>P2 * inv_P1 * (P1 * H1) = P2 * (inv_P1 * P1 * H1)\<close> by auto
+    finally show "mat_of_rows n gs = P2 * inv_P1 * mat_of_rows n fs_init" .
+  qed
+qed
+
+end
+
+text \<open>Now, we need to generalize some lemmas.\<close>
+
+context vec_module
+begin
+
+(*Generalized version of thm vec_space.finsum_index, now in vec_module*)
+lemma finsum_index:
+  assumes i: "i < n"
+    and f: "f \<in> A \<rightarrow> carrier_vec n"
+    and A: "A \<subseteq> carrier_vec n"
+  shows "finsum V f A $ i = sum (\<lambda>x. f x $ i) A"
+  using A f
+proof (induct A rule: infinite_finite_induct)
+  case empty
+    then show ?case using i by simp next
+  case (insert x X)
+    then have Xf: "finite X"
+      and xX: "x \<notin> X"
+      and x: "x \<in> carrier_vec n"
+      and X: "X \<subseteq> carrier_vec n"
+      and fx: "f x \<in> carrier_vec n"
+      and f: "f \<in> X \<rightarrow> carrier_vec n" by auto
+    have i2: "i < dim_vec (finsum V f X)"
+      using i finsum_closed[OF f] by auto
+    have ix: "i < dim_vec x" using x i by auto
+    show ?case
+      unfolding finsum_insert[OF Xf xX f fx]
+      unfolding sum.insert[OF Xf xX]
+      unfolding index_add_vec(1)[OF i2]
+      using insert lincomb_def
+      by auto
+qed (insert i, auto)
+
+(*Generalized version of thm vec_space.mat_of_rows_mult_as_finsum, now in vec_module*)
+lemma mat_of_rows_mult_as_finsum:
+  assumes "v \<in> carrier_vec (length lst)" "\<And> i. i < length lst \<Longrightarrow> lst ! i \<in> carrier_vec n"
+  defines "f l \<equiv> sum (\<lambda> i. if l = lst ! i then v $ i else 0) {0..<length lst}"
+  shows mat_of_cols_mult_as_finsum:"mat_of_cols n lst *\<^sub>v v = lincomb f (set lst)"
+proof -
+  from assms have "\<forall> i < length lst. lst ! i \<in> carrier_vec n" by blast
+  note an = all_nth_imp_all_set[OF this] hence slc:"set lst \<subseteq> carrier_vec n" by auto
+  hence dn [simp]:"\<And> x. x \<in> set lst \<Longrightarrow> dim_vec x = n" by auto
+  have dl [simp]:"dim_vec (lincomb f (set lst)) = n" using an
+    by (simp add: slc)
+  show ?thesis proof
+    show "dim_vec (mat_of_cols n lst *\<^sub>v v) = dim_vec (lincomb f (set lst))" using assms(1,2) by auto
+    fix i assume i:"i < dim_vec (lincomb f (set lst))" hence i':"i < n" by auto
+    with an have fcarr:"(\<lambda>v. f v \<cdot>\<^sub>v v) \<in> set lst \<rightarrow> carrier_vec n" by auto
+    from i' have "(mat_of_cols n lst *\<^sub>v v) $ i = row (mat_of_cols n lst) i \<bullet> v" by auto
+    also have "\<dots> = (\<Sum>ia = 0..<dim_vec v. lst ! ia $ i * v $ ia)"
+      unfolding mat_of_cols_def row_def scalar_prod_def
+      apply(rule sum.cong[OF refl]) using i an assms(1) by auto
+    also have "\<dots> = (\<Sum>ia = 0..<length lst. lst ! ia $ i * v $ ia)" using assms(1) by auto
+    also have "\<dots> = (\<Sum>x\<in>set lst. f x * x $ i)"
+      unfolding f_def sum_distrib_right apply (subst sum.swap)
+      apply(rule sum.cong[OF refl])
+      unfolding if_distrib if_distribR mult_zero_left sum.delta[OF finite_set] by auto
+    also have "\<dots> = (\<Sum>x\<in>set lst. (f x \<cdot>\<^sub>v x) $ i)"
+      apply(rule sum.cong[OF refl],subst index_smult_vec) using i slc by auto
+    also have "\<dots> = (\<Oplus>\<^bsub>V\<^esub>v\<in>set lst. f v \<cdot>\<^sub>v v) $ i" 
+      unfolding finsum_index[OF i' fcarr slc] by auto
+    finally show "(mat_of_cols n lst *\<^sub>v v) $ i = lincomb f (set lst) $ i"
+      by (auto simp:lincomb_def)
+  qed
+qed
+
+
+lemma lattice_of_altdef_lincomb:
+  assumes "set fs \<subseteq> carrier_vec n"
+  shows "lattice_of fs = {y. \<exists>f. lincomb (of_int \<circ> f) (set fs) = y}"
+  unfolding lincomb_def lattice_of_altdef[OF assms] image_def by auto
+
+end
+
+context vec_module
+begin
+
+(*Generalized version of thm idom_vec.lincomb_as_lincomb_list, now in vec_module*)
+lemma lincomb_as_lincomb_list:
+  fixes ws f
+  assumes s: "set ws \<subseteq> carrier_vec n"
+  shows "lincomb f (set ws) = lincomb_list (\<lambda>i. if \<exists>j<i. ws!i = ws!j then 0 else f (ws ! i)) ws"
+  using assms
+proof (induct ws rule: rev_induct)
+  case (snoc a ws)
+  let ?f = "\<lambda>i. if \<exists>j<i. ws ! i = ws ! j then 0 else f (ws ! i)"
+  let ?g = "\<lambda>i. (if \<exists>j<i. (ws @ [a]) ! i = (ws @ [a]) ! j then 0 else f ((ws @ [a]) ! i)) \<cdot>\<^sub>v (ws @ [a]) ! i"
+  let ?g2= "(\<lambda>i. (if \<exists>j<i. ws ! i = ws ! j then 0 else f (ws ! i)) \<cdot>\<^sub>v ws ! i)"
+  have [simp]: "\<And>v. v \<in> set ws \<Longrightarrow> v \<in> carrier_vec n" using snoc.prems(1) by auto
+  then have ws: "set ws \<subseteq> carrier_vec n" by auto
+  have hyp: "lincomb f (set ws) = lincomb_list ?f ws"
+    by (intro snoc.hyps ws)  
+  show ?case
+  proof (cases "a\<in>set ws")
+    case True    
+    have g_length: "?g (length ws) = 0\<^sub>v n" using True
+      by (auto, metis in_set_conv_nth nth_append)
+    have "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [?g (length ws)]"
+       by auto
+    also have "... = (map ?g [0..<length ws]) @ [0\<^sub>v n]" using g_length by simp
+    finally have map_rw: "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [0\<^sub>v n]" .
+    have "M.sumlist (map ?g2 [0..<length ws]) = M.sumlist (map ?g [0..<length ws])"
+      by (rule arg_cong[of _ _ "M.sumlist"], intro nth_equalityI, auto simp add: nth_append)
+    also have "... =  M.sumlist (map ?g [0..<length ws]) + 0\<^sub>v n "
+      by (metis M.r_zero calculation hyp lincomb_closed lincomb_list_def ws)
+    also have "... = M.sumlist (map ?g [0..<length ws] @ [0\<^sub>v n])" 
+      by (rule M.sumlist_snoc[symmetric], auto simp add: nth_append)
+    finally have summlist_rw: "M.sumlist (map ?g2 [0..<length ws]) 
+      = M.sumlist (map ?g [0..<length ws] @ [0\<^sub>v n])" .
+    have "lincomb f (set (ws @ [a])) = lincomb f (set ws)" using True unfolding lincomb_def
+      by (simp add: insert_absorb)
+    thus ?thesis 
+      unfolding hyp lincomb_list_def map_rw summlist_rw
+      by auto
+  next
+    case False    
+    have g_length: "?g (length ws) = f a \<cdot>\<^sub>v a" using False by (auto simp add: nth_append)
+    have "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [?g (length ws)]"
+       by auto
+    also have "... = (map ?g [0..<length ws]) @ [(f a \<cdot>\<^sub>v a)]" using g_length by simp
+    finally have map_rw: "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [(f a \<cdot>\<^sub>v a)]" .
+    have summlist_rw: "M.sumlist (map ?g2 [0..<length ws]) = M.sumlist (map ?g [0..<length ws])"
+      by (rule arg_cong[of _ _ "M.sumlist"], intro nth_equalityI, auto simp add: nth_append)
+    have "lincomb f (set (ws @ [a])) = lincomb f (set (a # ws))" by auto
+    also have "... = (\<Oplus>\<^bsub>V\<^esub>v\<in>set (a # ws). f v \<cdot>\<^sub>v v)" unfolding lincomb_def ..
+    also have "... = (\<Oplus>\<^bsub>V\<^esub>v\<in> insert a (set ws). f v \<cdot>\<^sub>v v)" by simp    
+    also have "... = (f a \<cdot>\<^sub>v a) + (\<Oplus>\<^bsub>V\<^esub>v\<in> (set ws). f v \<cdot>\<^sub>v v)"
+    proof (rule finsum_insert)
+      show "finite (set ws)" by auto
+      show "a \<notin> set ws" using False by auto
+      show "(\<lambda>v. f v \<cdot>\<^sub>v v) \<in> set ws \<rightarrow> carrier_vec n"
+        using snoc.prems(1) by auto
+      show "f a \<cdot>\<^sub>v a \<in> carrier_vec n" using snoc.prems by auto
+    qed
+    also have "... = (f a \<cdot>\<^sub>v a) + lincomb f (set ws)" unfolding lincomb_def ..
+    also have "... = (f a \<cdot>\<^sub>v a) + lincomb_list ?f ws" using hyp by auto
+    also have "... =  lincomb_list ?f ws  + (f a \<cdot>\<^sub>v a)"
+      using M.add.m_comm lincomb_list_carrier snoc.prems by auto
+    also have "... = lincomb_list (\<lambda>i. if \<exists>j<i. (ws @ [a]) ! i 
+      = (ws @ [a]) ! j then 0 else f ((ws @ [a]) ! i)) (ws @ [a])" 
+    proof (unfold lincomb_list_def map_rw summlist_rw, rule M.sumlist_snoc[symmetric])
+      show "set (map ?g [0..<length ws]) \<subseteq> carrier_vec n" using snoc.prems
+        by (auto simp add: nth_append)
+      show "f a \<cdot>\<^sub>v a \<in> carrier_vec n"
+        using snoc.prems by auto
+    qed
+    finally show ?thesis .
+  qed
+qed auto
+end
+
+context 
+begin
+
+interpretation vec_module "TYPE(int)" .
+
+lemma lattice_of_cols_as_mat_mult:
+  assumes A: "A \<in> carrier_mat n nc" (*Integer matrix*)
+  shows "lattice_of (cols A) = {y\<in>carrier_vec (dim_row A). \<exists>x\<in>carrier_vec (dim_col A). A *\<^sub>v x = y}"
+proof -
+  let ?ws = "cols A"
+  have set_cols_in: "set (cols A) \<subseteq> carrier_vec n" using A unfolding cols_def by auto
+  have "lincomb (of_int \<circ> f)(set  ?ws) \<in> carrier_vec (dim_row A)" for f 
+    using lincomb_closed A
+    by (metis (full_types) carrier_matD(1) cols_dim lincomb_closed)
+  moreover have "\<exists>x\<in>carrier_vec (dim_col A). A *\<^sub>v x = lincomb (of_int \<circ> f) (set (cols A))" for f
+  proof -    
+    let ?g = "(\<lambda>v. of_int (f v))"
+    let ?g' = "(\<lambda>i. if \<exists>j<i. ?ws ! i = ?ws ! j then 0 else ?g (?ws ! i))"           
+    have "lincomb (of_int \<circ> f) (set (cols A)) = lincomb ?g (set ?ws)" unfolding o_def by auto
+    also have "... = lincomb_list ?g' ?ws" 
+      by (rule lincomb_as_lincomb_list[OF set_cols_in])
+    also have "... = mat_of_cols n ?ws *\<^sub>v vec (length ?ws) ?g'" 
+      by (rule lincomb_list_as_mat_mult, insert set_cols_in A, auto)
+    also have "... = A *\<^sub>v (vec (length ?ws) ?g')" using mat_of_cols_cols A by auto
+    finally show ?thesis by auto
+  qed 
+  moreover have "\<exists>f. A *\<^sub>v x = lincomb (of_int \<circ> f) (set (cols A))" 
+    if Ax: "A *\<^sub>v x \<in> carrier_vec (dim_row A)" and x: "x \<in> carrier_vec (dim_col A)" for x 
+  proof -
+    let ?c = "\<lambda>i. x $ i"
+    have x_vec: "vec (length ?ws) ?c = x" using x by auto
+    have "A *\<^sub>v x = mat_of_cols n ?ws *\<^sub>v vec (length ?ws) ?c" using mat_of_cols_cols A x_vec by auto
+    also have "... = lincomb_list ?c ?ws"
+      by (rule lincomb_list_as_mat_mult[symmetric], insert set_cols_in A, auto)
+    also have "... = lincomb (mk_coeff ?ws ?c) (set ?ws)" 
+      by (rule lincomb_list_as_lincomb, insert set_cols_in A, auto)    
+    finally show ?thesis by auto
+  qed
+  ultimately show ?thesis unfolding lattice_of_altdef_lincomb[OF set_cols_in]
+    by (metis (mono_tags, hide_lams))
+qed
+
+
+corollary lattice_of_as_mat_mult:
+  assumes fs: "set fs \<subseteq> carrier_vec n"
+  shows "lattice_of fs = {y\<in>carrier_vec n. \<exists>x\<in>carrier_vec (length fs). (mat_of_cols n fs) *\<^sub>v x = y}"
+proof -
+  have cols_eq: "cols (mat_of_cols n fs) = fs" using cols_mat_of_cols[OF fs] by simp
+  have m: "(mat_of_cols n fs) \<in> carrier_mat n (length fs)" using mat_of_cols_carrier(1) by auto
+  show ?thesis using lattice_of_cols_as_mat_mult[OF m] unfolding cols_eq using m by auto
+qed
+end
+
+context vec_space
+begin
+
+lemma lin_indpt_cols_imp_det_not_0:
+  fixes A::"'a mat"
+  assumes A: "A \<in> carrier_mat n n" and li: "lin_indpt (set (cols A))" and d: "distinct (cols A)" 
+  shows "det A \<noteq> 0"  
+  using A li d det_rank_iff lin_indpt_full_rank by blast
+
+corollary lin_indpt_rows_imp_det_not_0:
+  fixes A::"'a mat"
+  assumes A: "A \<in> carrier_mat n n" and li: "lin_indpt (set (rows A))" and d: "distinct (rows A)" 
+  shows "det A \<noteq> 0"  
+  using A li d det_rank_iff lin_indpt_full_rank
+  by (metis (full_types) Determinant.det_transpose cols_transpose transpose_carrier_mat)
+end
+
+context LLL
+begin
+
+lemma eq_lattice_imp_mat_mult_invertible_cols:
+  assumes fs: "set fs \<subseteq> carrier_vec n"
+  and gs: "set gs \<subseteq> carrier_vec n"  and ind_fs: "lin_indep fs" (*fs is a basis*)
+  and length_fs: "length fs = n" and length_gs: "length gs = n" (*For the moment, only valid for square matrices*)
+  and l: "lattice_of fs = lattice_of gs" 
+shows "\<exists>Q \<in> carrier_mat n n. invertible_mat Q \<and> mat_of_cols n fs = mat_of_cols n gs * Q"
+proof (cases "n=0")
+  case True
+  show ?thesis
+    by (rule bexI[of _ "1\<^sub>m 0"], insert True assms, auto) 
+next
+  case False
+  hence n: "0<n" by simp
+  have ind_RAT_fs: "gs.lin_indpt (set (RAT fs))" using ind_fs
+    by (simp add: cof_vec_space.lin_indpt_list_def)
+  have fs_carrier: "mat_of_cols n fs \<in> carrier_mat n n" by (simp add: length_fs carrier_matI)
+  let ?f = "(\<lambda>i. SOME x. x\<in>carrier_vec (length gs) \<and> (mat_of_cols n gs) *\<^sub>v x = fs ! i)"
+  let ?cols_Q = "map ?f [0..<length fs]"
+  let ?Q = "mat_of_cols n ?cols_Q"
+  show ?thesis
+  proof (rule bexI[of _ ?Q], rule conjI)
+    show Q: "?Q \<in> carrier_mat n n" using length_fs by auto
+    show fs_gs_Q: "mat_of_cols n fs = mat_of_cols n gs * ?Q"
+    proof (rule mat_col_eqI)
+      fix j assume j: "j < dim_col (mat_of_cols n gs * ?Q)"
+      have j2: "j<n" using j Q length_gs by auto
+      have fs_j_in_gs: "fs ! j \<in> lattice_of gs" using fs l basis_in_latticeI j by auto
+      have fs_j_carrier_vec: "fs ! j \<in> carrier_vec n"
+        using fs_j_in_gs gs lattice_of_as_mat_mult by blast      
+      let ?x = "SOME x. x\<in>carrier_vec (length gs) \<and> (mat_of_cols n gs) *\<^sub>v x = fs ! j"
+      have "?x\<in>carrier_vec (length gs) \<and> (mat_of_cols n gs) *\<^sub>v ?x = fs ! j"
+        by (rule someI_ex, insert fs_j_in_gs lattice_of_as_mat_mult[OF gs], auto)
+      hence x: "?x \<in> carrier_vec (length gs)"
+        and gs_x: "(mat_of_cols n gs) *\<^sub>v ?x = fs ! j" by blast+
+      have "col ?Q j = ?cols_Q ! j"
+      proof (rule col_mat_of_cols)
+        show "j < length (map ?f [0..<length fs])" using length_fs j2 by auto
+        have "map ?f [0..<length fs] ! j = ?f ([0..<length fs] ! j)" 
+          by (rule nth_map, insert j2 length_fs, auto) 
+        also have "... = ?f j" by (simp add: length_fs j2)
+        also have "... \<in> carrier_vec n" using x length_gs by auto        
+        finally show "map ?f [0..<length fs] ! j \<in> carrier_vec n" .
+      qed
+      also have "... = ?f ([0..<length fs] ! j)" 
+        by (rule nth_map, insert j2 length_fs, auto)
+      also have "... = ?x" by (simp add: length_fs j2)
+      finally have col_Qj_x: "col ?Q j = ?x" .
+      have "col (mat_of_cols n fs) j = fs ! j"
+        by (metis (no_types, lifting) j Q fs length_fs carrier_matD(2) cols_mat_of_cols cols_nth
+            index_mult_mat(3) mat_of_cols_carrier(3))
+      also have "... = (mat_of_cols n gs) *\<^sub>v ?x" using gs_x by auto
+      also have "... = (mat_of_cols n gs) *\<^sub>v (col ?Q j)" unfolding col_Qj_x by simp
+      also have "... = col (mat_of_cols n gs * ?Q) j"
+        by (rule col_mult2[symmetric, OF _ Q j2], insert length_gs mat_of_cols_def, auto)
+      finally show "col (mat_of_cols n fs) j = col (mat_of_cols n gs * ?Q) j" .      
+    qed (insert length_gs gs, auto)
+    show "invertible_mat ?Q"
+    (* Sketch of the proof:
+      1) fs = gs * Q, proved previously
+      2) gs = fs * Q', similar proof as the previous one.
+      3) fs = fs * Q' * Q
+      4) fs * (?Q' * ?Q - 1\<^sub>m n) = 0\<^sub>m n n and hence (?Q' * ?Q - 1\<^sub>m n) = 0 since fs independent
+      5) det ?Q' = det ?Q = det 1 = 1, then det ?Q = \<plusminus>1 and ?Q invertible since the determinant 
+         divides a unit.
+    *)
+    proof -
+      let ?f' = "(\<lambda>i. SOME x. x\<in>carrier_vec (length fs) \<and> (mat_of_cols n fs) *\<^sub>v x = gs ! i)"
+      let ?cols_Q' = "map ?f' [0..<length gs]"
+      let ?Q' = "mat_of_cols n ?cols_Q'"
+      have Q': "?Q' \<in> carrier_mat n n" using length_gs by auto
+      have gs_fs_Q': "mat_of_cols n gs = mat_of_cols n fs * ?Q'"
+      proof (rule mat_col_eqI)
+        fix j assume j: "j < dim_col (mat_of_cols n fs * ?Q')"
+        have j2: "j<n" using j Q length_gs by auto
+        have gs_j_in_fs: "gs ! j \<in> lattice_of fs" using gs l basis_in_latticeI j by auto
+        have gs_j_carrier_vec: "gs ! j \<in> carrier_vec n"
+          using gs_j_in_fs fs lattice_of_as_mat_mult by blast      
+        let ?x = "SOME x. x\<in>carrier_vec (length fs) \<and> (mat_of_cols n fs) *\<^sub>v x = gs ! j"
+        have "?x\<in>carrier_vec (length fs) \<and> (mat_of_cols n fs) *\<^sub>v ?x = gs ! j"
+          by (rule someI_ex, insert gs_j_in_fs lattice_of_as_mat_mult[OF fs], auto)
+        hence x: "?x \<in> carrier_vec (length fs)"
+          and fs_x: "(mat_of_cols n fs) *\<^sub>v ?x = gs ! j" by blast+
+        have "col ?Q' j = ?cols_Q' ! j"
+        proof (rule col_mat_of_cols)
+          show "j < length (map ?f' [0..<length gs])" using length_gs j2 by auto
+          have "map ?f' [0..<length gs] ! j = ?f' ([0..<length gs] ! j)" 
+            by (rule nth_map, insert j2 length_gs, auto) 
+          also have "... = ?f' j" by (simp add: length_gs j2)
+          also have "... \<in> carrier_vec n" using x length_fs by auto        
+          finally show "map ?f' [0..<length gs] ! j \<in> carrier_vec n" .
+        qed
+        also have "... = ?f' ([0..<length gs] ! j)" 
+          by (rule nth_map, insert j2 length_gs, auto)
+        also have "... = ?x" by (simp add: length_gs j2)
+        finally have col_Qj_x: "col ?Q' j = ?x" .
+        have "col (mat_of_cols n gs) j = gs ! j" by (simp add: length_gs gs_j_carrier_vec j2)
+        also have "... = (mat_of_cols n fs) *\<^sub>v ?x" using fs_x by auto
+        also have "... = (mat_of_cols n fs) *\<^sub>v (col ?Q' j)" unfolding col_Qj_x by simp
+        also have "... = col (mat_of_cols n fs * ?Q') j"
+          by (rule col_mult2[symmetric, OF _ Q' j2], insert length_fs mat_of_cols_def, auto)
+        finally show "col (mat_of_cols n gs) j = col (mat_of_cols n fs * ?Q') j" .      
+      qed (insert length_fs fs, auto)
+      
+      have det_fs_not_zero: "rat_of_int (det (mat_of_cols n fs)) \<noteq> 0"
+      proof -
+        let ?A = "(of_int_hom.mat_hom (mat_of_cols n fs)):: rat mat"
+        have "rat_of_int (det (mat_of_cols n fs)) = det ?A"
+          by simp
+        moreover have "det ?A \<noteq> 0"
+        proof (rule gs.lin_indpt_cols_imp_det_not_0[of ?A])
+          have c_eq: "(set (cols ?A)) = set (RAT fs)"
+            by (metis assms(3) cof_vec_space.lin_indpt_list_def cols_mat_of_cols fs mat_of_cols_map)
+          show "?A \<in> carrier_mat n n" by (simp add: fs_carrier)
+          show "gs.lin_indpt (set (cols ?A))" using ind_RAT_fs c_eq by auto
+          show "distinct (cols ?A)"
+            by (metis ind_fs cof_vec_space.lin_indpt_list_def cols_mat_of_cols fs mat_of_cols_map)
+        qed
+        ultimately show ?thesis by auto
+      qed
+      have Q'Q: "?Q' * ?Q \<in> carrier_mat n n" using Q Q' mult_carrier_mat by blast
+      have fs_fs_Q'Q: "mat_of_cols n fs = mat_of_cols n fs * ?Q' * ?Q" using gs_fs_Q' fs_gs_Q by presburger
+      hence "0\<^sub>m n n = mat_of_cols n fs * ?Q' * ?Q - mat_of_cols n fs" using length_fs by auto
+      also have "... = mat_of_cols n fs * ?Q' * ?Q - mat_of_cols n fs * 1\<^sub>m n"
+        using fs_carrier by auto
+      also have "... = mat_of_cols n fs * (?Q' * ?Q) - mat_of_cols n fs * 1\<^sub>m n"
+        using Q Q' fs_carrier by auto
+      also have "... = mat_of_cols n fs * (?Q' * ?Q - 1\<^sub>m n)"
+        by (rule mult_minus_distrib_mat[symmetric, OF fs_carrier Q'Q], auto)      
+      finally have "mat_of_cols n fs * (?Q' * ?Q - 1\<^sub>m n) = 0\<^sub>m n n" ..
+      have "det (?Q' * ?Q) = 1"
+        by (smt Determinant.det_mult Q Q' Q'Q fs_fs_Q'Q assoc_mult_mat det_fs_not_zero 
+            fs_carrier mult_cancel_left2 of_int_code(2))
+      hence det_Q'_Q_1: "det ?Q * det ?Q' = 1"
+        by (metis (no_types, lifting) Determinant.det_mult Groups.mult_ac(2) Q Q')
+      hence "det ?Q = 1 \<or> det ?Q = -1" by (rule pos_zmult_eq_1_iff_lemma)
+      thus ?thesis using invertible_iff_is_unit_JNF[OF Q] by fastforce
+    qed
+  qed
+qed
+
+
+corollary eq_lattice_imp_mat_mult_invertible_rows:
+  assumes fs: "set fs \<subseteq> carrier_vec n"
+  and gs: "set gs \<subseteq> carrier_vec n"  and ind_fs: "lin_indep fs" (*fs is a basis*)
+  and length_fs: "length fs = n" and length_gs: "length gs = n" (*For the moment, only valid for square matrices*)
+  and l: "lattice_of fs = lattice_of gs" 
+shows "\<exists>P \<in> carrier_mat n n. invertible_mat P \<and> mat_of_rows n fs = P * mat_of_rows n gs"
+proof -
+  obtain Q where Q: "Q \<in> carrier_mat n n" and inv_Q: "invertible_mat Q" 
+    and fs_gs_Q: "mat_of_cols n fs = mat_of_cols n gs * Q" 
+    using eq_lattice_imp_mat_mult_invertible_cols[OF assms] by auto
+  have "invertible_mat Q\<^sup>T" by (simp add: inv_Q invertible_mat_transpose)
+  moreover have "mat_of_rows n fs = Q\<^sup>T * mat_of_rows n gs" using fs_gs_Q
+    by (metis Matrix.transpose_mult Q length_gs mat_of_cols_carrier(1) transpose_mat_of_cols)
+  moreover have "Q\<^sup>T \<in> carrier_mat n n" using Q by auto
+  ultimately show ?thesis by blast
+qed
+end
+
+subsubsection \<open>Missing results\<close>
+
+text \<open>This is a new definition for upper triangular matrix, valid for rectangular matrices. 
+This definition will allow us to prove that echelon form implies upper triangular for any matrix.\<close>
+
+definition "upper_triangular' A = (\<forall>i < dim_row A. \<forall> j<dim_col A. j < i \<longrightarrow> A $$ (i,j) = 0)"
+
+lemma upper_triangular'D[elim] :
+  "upper_triangular' A \<Longrightarrow> j<dim_col A \<Longrightarrow> j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0"
+unfolding upper_triangular'_def by auto
+
+lemma upper_triangular'I[intro] :
+  "(\<And>i j. j<dim_col A \<Longrightarrow> j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0) \<Longrightarrow> upper_triangular' A"
+  unfolding upper_triangular'_def by auto
+
+lemma prod_list_abs(*[simp]?*):
+  fixes xs:: "int list"
+  shows "prod_list (map abs xs) = abs (prod_list xs)"
+  by (induct xs, auto simp add: abs_mult)
+
+lemma euclid_ext2_works:
+  assumes "euclid_ext2 a b = (p,q,u,v,d)"
+  shows "p*a+q*b = d" and "d = gcd a b" and "gcd a b * u = -b" and "gcd a b * v = a"
+  and "u = -b div gcd a b" and "v = a div gcd a b"
+  using assms unfolding euclid_ext2_def
+  by (auto simp add: bezout_coefficients_fst_snd)
+
+lemma res_function_euclidean2: 
+  "res_function (\<lambda>b n::'a::{unique_euclidean_ring}. n mod b)"
+proof- 
+  have "n mod b = n" if "b=0" for n b::"'a :: unique_euclidean_ring" using that by auto
+  hence "res_function_euclidean = (\<lambda>b n::'a. n mod b)" 
+    by (unfold fun_eq_iff res_function_euclidean_def, auto)
+  thus ?thesis using res_function_euclidean by auto
+qed
+
+lemma mult_row_1_id:
+  fixes A:: "'a::semiring_1^'n^'m"
+  shows "mult_row A b 1 = A" unfolding mult_row_def by vector
+
+text \<open>Results about appending rows\<close>
+
+lemma row_append_rows1:
+  assumes A: "A \<in> carrier_mat m n"
+  and B: "B \<in> carrier_mat p n"
+  assumes i: "i < dim_row A"
+  shows "Matrix.row (A @\<^sub>r B) i = Matrix.row A i"  
+proof (rule eq_vecI)
+  have AB_carrier[simp]: "(A @\<^sub>r B) \<in> carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B])
+  thus "dim_vec (Matrix.row (A @\<^sub>r B) i) = dim_vec (Matrix.row A i)"
+    using A B by (auto, insert carrier_matD(2), blast)
+  fix j assume j: "j < dim_vec (Matrix.row A i)" 
+  have "Matrix.row (A @\<^sub>r B) i $v j = (A @\<^sub>r B) $$ (i, j)"
+    by (metis AB_carrier Matrix.row_def j A carrier_matD(2) index_row(2) index_vec)
+  also have "... = (if i < dim_row A then A $$ (i, j) else B $$ (i - m, j))"
+    by (rule append_rows_nth, insert assms j, auto)
+  also have "... = A$$ (i,j)" using i by simp
+  finally show "Matrix.row (A @\<^sub>r B) i $v j = Matrix.row A i $v j" using i j by simp  
+qed
+
+lemma row_append_rows2:
+  assumes A: "A \<in> carrier_mat m n"
+  and B: "B \<in> carrier_mat p n"
+  assumes i: "i \<in> {m..<m+p}"
+  shows "Matrix.row (A @\<^sub>r B) i = Matrix.row B (i - m)"
+proof (rule eq_vecI)
+  have AB_carrier[simp]: "(A @\<^sub>r B) \<in> carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B])
+  thus "dim_vec (Matrix.row (A @\<^sub>r B) i) = dim_vec (Matrix.row B (i-m))"
+    using A B by (auto, insert carrier_matD(2), blast)
+  fix j assume j: "j < dim_vec (Matrix.row B (i-m))" 
+  have "Matrix.row (A @\<^sub>r B) i $v j = (A @\<^sub>r B) $$ (i, j)"
+    by (metis AB_carrier Matrix.row_def j B carrier_matD(2) index_row(2) index_vec)
+  also have "... = (if i < dim_row A then A $$ (i, j) else B $$ (i - m, j))"
+    by (rule append_rows_nth, insert assms j, auto)
+  also have "... = B $$ (i - m, j)" using i A by simp
+  finally show "Matrix.row (A @\<^sub>r B) i $v j = Matrix.row B (i-m) $v j" using i j A B by auto  
+qed
+
+
+lemma rows_append_rows:
+  assumes A: "A \<in> carrier_mat m n"
+  and B: "B \<in> carrier_mat p n"
+shows "Matrix.rows (A @\<^sub>r B) = Matrix.rows A @ Matrix.rows B"
+proof -
+  have AB_carrier: "(A @\<^sub>r B) \<in> carrier_mat (m+p) n" 
+    by (rule carrier_append_rows, insert A B, auto)
+  hence 1: "dim_row (A @\<^sub>r B) = dim_row A + dim_row B" using A B by blast
+  moreover have "Matrix.row (A @\<^sub>r B) i = (Matrix.rows A @ Matrix.rows B) ! i"
+    if i: "i < dim_row (A @\<^sub>r B)" for i
+  proof (cases "i<dim_row A")
+    case True
+    have "Matrix.row (A @\<^sub>r B) i = Matrix.row A i" using A True B row_append_rows1 by blast
+    also have "... = Matrix.rows A ! i" unfolding Matrix.rows_def using True by auto
+    also have "... = (Matrix.rows A @ Matrix.rows B) ! i" using True by (simp add: nth_append)
+    finally show ?thesis .
+  next
+    case False
+    have i_mp: "i < m + p" using AB_carrier A B i by fastforce
+    have "Matrix.row (A @\<^sub>r B) i = Matrix.row B (i-m)" using A False B i row_append_rows2 i_mp
+      by (smt AB_carrier atLeastLessThan_iff carrier_matD(1) le_add1
+          linordered_semidom_class.add_diff_inverse row_append_rows2)
+    also have "... = Matrix.rows B ! (i-m)" unfolding Matrix.rows_def using False i A 1 by auto
+    also have "... = (Matrix.rows A @ Matrix.rows B) ! (i-m+m)"
+      by (metis add_diff_cancel_right' A carrier_matD(1) length_rows not_add_less2 nth_append)
+    also have "... =  (Matrix.rows A @ Matrix.rows B) ! i" using False A by auto
+    finally show ?thesis .
+  qed  
+  ultimately show ?thesis unfolding list_eq_iff_nth_eq by auto  
+qed
+
+
+
+lemma append_rows_nth2:
+  assumes A': "A' \<in> carrier_mat m n"
+  and B: "B \<in> carrier_mat p n"
+  and A_def: "A = (A' @\<^sub>r  B)"
+  and a: "a<m" and ap: "a < p" and j: "j<n"
+  shows "A $$ (a + m, j) = B $$ (a,j)" 
+proof -
+  have "A $$ (a + m, j) = (if a + m < dim_row A' then A' $$ (a + m, j) else B $$ (a + m - m, j))"
+    unfolding A_def by (rule append_rows_nth[OF A' B _ j], insert ap a, auto)
+  also have "... = B $$ (a,j)" using ap a A' by auto
+  finally show ?thesis .
+qed
+
+
+lemma append_rows_nth3:
+  assumes A': "A' \<in> carrier_mat m n"
+  and B: "B \<in> carrier_mat p n"
+  and A_def: "A = (A' @\<^sub>r  B)"
+  and a: "a\<ge>m" and ap: "a < m + p" and j: "j<n"
+  shows "A $$ (a, j) = B $$ (a-m,j)" 
+proof -
+  have "A $$ (a, j) = (if a < dim_row A' then A' $$ (a, j) else B $$ (a - m, j))"
+    unfolding A_def by (rule append_rows_nth[OF A' B _ j], insert ap a, auto)
+  also have "... = B $$ (a-m,j)" using ap a A' by auto
+  finally show ?thesis .
+qed
+
+
+text \<open>Results about submatrices\<close>
+
+lemma pick_first_id: assumes i: "i<n" shows "pick {0..<n} i = i"
+proof -
+  have "i = (card {a \<in> {0..<n}. a < i})" using i
+    by (auto, smt Collect_cong card_Collect_less_nat nat_SN.gt_trans)
+  thus ?thesis using pick_card_in_set i
+    by (metis atLeastLessThan_iff zero_order(1))
+qed
+
+lemma submatrix_index_id:
+  assumes H: "H \<in> carrier_mat m n" and i: "i<k1" and j: "j<k2"
+  and k1: "k1\<le>m" and k2: "k2\<le>n"
+  shows "(submatrix H {0..<k1} {0..<k2}) $$ (i,j) = H $$ (i,j)" 
+proof -
+  let ?I = "{0..<k1}"
+  let ?J = "{0..<k2}"
+  let ?H = "submatrix H ?I ?J"  
+  have km: "k1\<le>m" and kn: "k2\<le>n" using k1 k2 by simp+
+  have card_mk: "card {i. i < m \<and> i < k1} = k1" using km 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  have card_nk: "card {i. i < n \<and> i < k2} = k2" using kn 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  show ?thesis
+  proof- 
+    have pick_j: "pick ?J j = j" by (rule pick_first_id[OF j])
+    have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i])
+    have "submatrix H ?I ?J $$ (i, j) = H $$ (pick ?I i, pick ?J j)" 
+      by (rule submatrix_index, insert H i j card_mk card_nk, auto)
+    also have "... = H $$ (i,j)" using pick_i pick_j by simp
+    finally show ?thesis .
+  qed
+qed
+
+lemma submatrix_carrier_first:
+  assumes H: "H \<in> carrier_mat m n"
+  and k1: "k1 \<le> m" and k2: "k2 \<le> n"
+  shows"submatrix H {0..<k1} {0..<k2} \<in> carrier_mat k1 k2"
+proof -  
+  have km: "k1\<le>m" and kn: "k2\<le>n" using k1 k2 by simp+
+  have card_mk: "card {i. i < m \<and> i < k1} = k1" using km 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  have card_nk: "card {i. i < n \<and> i < k2} = k2" using kn 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  show ?thesis
+    by (smt Collect_cong H atLeastLessThan_iff card_mk card_nk carrier_matD 
+        carrier_matI dim_submatrix zero_order(1))
+qed
+
+
+
+lemma Units_eq_invertible_mat:
+  assumes "A \<in> carrier_mat n n"
+  shows "A \<in> Group.Units (ring_mat TYPE('a::comm_ring_1) n b) = invertible_mat A" (is "?lhs = ?rhs")
+proof -
+  interpret m: ring "ring_mat TYPE('a) n b" by (rule ring_mat)
+  show ?thesis
+  proof
+    assume "?lhs" thus "?rhs"
+      unfolding Group.Units_def 
+      by (insert assms, auto simp add: ring_mat_def invertible_mat_def inverts_mat_def)
+  next
+    assume "?rhs" 
+    from this obtain B where AB: "A * B = 1\<^sub>m n" and BA: "B * A = 1\<^sub>m n" and B: "B \<in> carrier_mat n n"
+      by (metis assms carrier_matD(1) inverts_mat_def obtain_inverse_matrix)
+    hence "\<exists>x\<in>carrier (ring_mat TYPE('a) n b). x \<otimes>\<^bsub>ring_mat TYPE('a) n b\<^esub> A = \<one>\<^bsub>ring_mat TYPE('a) n b\<^esub> 
+      \<and> A \<otimes>\<^bsub>ring_mat TYPE('a) n b\<^esub> x = \<one>\<^bsub>ring_mat TYPE('a) n b\<^esub>"
+      unfolding ring_mat_def by auto
+    thus "?lhs" unfolding Group.Units_def using assms unfolding ring_mat_def by auto
+  qed
+qed
+
+lemma map_first_rows_index:
+  assumes "A \<in> carrier_mat M n" and "m \<le> M" and "i<m" and "ja<n"
+  shows "map (Matrix.row A) [0..<m] ! i $v ja = A $$ (i, ja)"
+  using assms by auto
+
+lemma matrix_append_rows_eq_if_preserves:
+  assumes A: "A \<in> carrier_mat (m+p) n" and B: "B \<in> carrier_mat p n"
+    and eq: "\<forall>i\<in>{m..<m+p}.\<forall>j<n. A$$(i,j) = B $$ (i-m,j)"
+  shows "A = mat_of_rows n [Matrix.row A i. i \<leftarrow> [0..<m]] @\<^sub>r B" (is "_ = ?A' @\<^sub>r _")
+proof (rule eq_matI)
+  have A': "?A' \<in> carrier_mat m n" by (simp add: mat_of_rows_def)
+  hence A'B: "?A' @\<^sub>r B \<in> carrier_mat (m+p) n" using B by blast
+  show "dim_row A = dim_row (?A' @\<^sub>r B)" and "dim_col A = dim_col (?A' @\<^sub>r B)" using A'B A by auto
+  fix i j assume i: "i < dim_row (?A' @\<^sub>r B)"
+    and j: "j < dim_col (?A' @\<^sub>r B)" 
+  have jn: "j<n" using A
+    by (metis append_rows_def dim_col_mat(1) index_mat_four_block(3) index_zero_mat(3) 
+        j mat_of_rows_def nat_arith.rule0)
+  let ?xs = "(map (Matrix.row A) [0..<m])"
+  show "A $$ (i, j) = (?A' @\<^sub>r B) $$ (i, j)"
+  proof (cases "i<m")
+    case True
+    have "(?A' @\<^sub>r B) $$ (i, j) = ?A' $$ (i,j)"      
+      by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i 
+          index_mat_four_block index_zero_mat(3) j length_map length_upt mat_of_rows_carrier(2))
+    also have "... = ?xs ! i $v j" 
+      by (rule mat_of_rows_index, insert i True j, auto simp add: append_rows_def)
+    also have "... = A $$ (i,j)"
+      by (rule map_first_rows_index, insert assms A True i jn, auto)
+    finally show ?thesis ..
+  next
+    case False
+    have "(?A' @\<^sub>r B) $$ (i, j) = B $$ (i-m,j)"      
+      by (smt (z3) A' carrier_matD(1) False append_rows_def i index_mat_four_block j jn length_map
+          length_upt mat_of_rows_carrier(2,3))
+    also have "... = A $$ (i,j)"
+      by (metis False append_rows_def B eq atLeastLessThan_iff carrier_matD(1) diff_zero i 
+          index_mat_four_block(2) index_zero_mat(2) jn le_add1 length_map length_upt 
+          linordered_semidom_class.add_diff_inverse mat_of_rows_carrier(2))
+    finally show ?thesis ..
+  qed
+qed
+
+lemma invertible_mat_first_column_not0:
+  fixes A::"'a :: comm_ring_1 mat"
+  assumes A: "A \<in> carrier_mat n n" and inv_A: "invertible_mat A" and n0: "0<n"
+  shows "col A 0 \<noteq> (0\<^sub>v n)"
+proof (rule ccontr)
+  assume " \<not> col A 0 \<noteq> 0\<^sub>v n" hence col_A0: "col A 0 = 0\<^sub>v n" by simp
+  have "(det A dvd 1)" using inv_A invertible_iff_is_unit_JNF[OF A] by auto
+  hence 1: "det A \<noteq> 0" by auto
+  have "det A = (\<Sum>i<n. A $$ (i, 0) * Determinant.cofactor A i 0)" 
+    by (rule laplace_expansion_column[OF A n0])
+  also have "... = 0" 
+    by (rule sum.neutral, insert col_A0 n0 A, auto simp add: col_def,
+        metis Matrix.zero_vec_def index_vec mult_zero_left)
+  finally show False using 1 by contradiction 
+qed
+
+lemma invertible_mat_mult_int:
+  assumes "A = P * B" 
+    and "P \<in> carrier_mat n n"
+    and "B \<in> carrier_mat n n"
+    and "invertible_mat P" 
+    and "invertible_mat (map_mat rat_of_int B)"
+  shows "invertible_mat (map_mat rat_of_int A)"
+  by (metis (no_types, hide_lams) assms dvd_field_iff 
+      invertible_iff_is_unit_JNF invertible_mult_JNF map_carrier_mat not_is_unit_0 
+      of_int_hom.hom_0 of_int_hom.hom_det of_int_hom.mat_hom_mult)
+
+
+lemma echelon_form_JNF_intro: 
+  assumes "(\<forall>i<dim_row A. is_zero_row_JNF i A \<longrightarrow> \<not> (\<exists>j. j < dim_row A \<and> j>i \<and> \<not> is_zero_row_JNF j A))"
+  and "(\<forall>i j. i<j \<and> j<dim_row A \<and> \<not> (is_zero_row_JNF i A) \<and> \<not> (is_zero_row_JNF j A) 
+         \<longrightarrow> ((LEAST n. A $$ (i, n) \<noteq> 0) < (LEAST n. A $$ (j, n) \<noteq> 0)))"
+  shows "echelon_form_JNF A" using assms unfolding echelon_form_JNF_def by simp
+
+
+lemma echelon_form_submatrix:
+  assumes ef_H: "echelon_form_JNF H" and H: "H \<in> carrier_mat m n"
+  and k: "k \<le> min m n"
+shows "echelon_form_JNF (submatrix H {0..<k} {0..<k})" 
+proof -
+  let ?I = "{0..<k}"
+  let ?H = "submatrix H ?I ?I"  
+  have km: "k\<le>m" and kn: "k\<le>n" using k by simp+
+  have card_mk: "card {i. i < m \<and> i < k} = k" using km 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  have card_nk: "card {i. i < n \<and> i < k} = k" using kn 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  have H_ij: "H $$ (i,j) = (submatrix H ?I ?I) $$ (i,j)"  if i: "i<k" and j: "j<k" for i j
+  proof- 
+    have pick_j: "pick ?I j = j" by (rule pick_first_id[OF j])
+    have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i])
+    have "submatrix H ?I ?I $$ (i, j) = H $$ (pick ?I i, pick ?I j)" 
+      by (rule submatrix_index, insert H i j card_mk card_nk, auto)
+    also have "... = H $$ (i,j)" using pick_i pick_j by simp
+    finally show ?thesis ..
+  qed
+  have H'[simp]: "?H \<in> carrier_mat k k" 
+    using H dim_submatrix[of H "{0..<k}" "{0..<k}"] card_mk card_nk by auto
+  show ?thesis
+  proof (rule echelon_form_JNF_intro, auto)   
+    fix i j assume iH'_0: "is_zero_row_JNF i ?H" and ij: "i < j" and j: "j < dim_row ?H"  
+    have jm: "j<m"
+      by (metis H' carrier_matD(1) j km le_eq_less_or_eq nat_SN.gt_trans)
+    show "is_zero_row_JNF j ?H"
+    proof (rule ccontr)
+      assume j_not0_H': "\<not> is_zero_row_JNF j ?H"
+      define a where "a = (LEAST n. ?H $$ (j,n) \<noteq> 0)"
+      have H'_ja: "?H $$ (j,a) \<noteq> 0" 
+        by (metis (mono_tags) LeastI j_not0_H' a_def is_zero_row_JNF_def)
+      have a: "a < dim_col ?H"
+        by (smt j_not0_H' a_def is_zero_row_JNF_def linorder_neqE_nat not_less_Least order_trans_rules(19))
+      have j_not0_H: "\<not> is_zero_row_JNF j H"
+        by (metis H' H'_ja H_ij a assms(2) basic_trans_rules(19) carrier_matD is_zero_row_JNF_def j kn le_eq_less_or_eq)
+      hence i_not0_H: "\<not> is_zero_row_JNF i H" using ef_H j ij unfolding echelon_form_JNF_def
+        by (metis H' \<open>\<not> is_zero_row_JNF j H\<close> assms(2) carrier_matD(1) ij j km 
+            not_less_iff_gr_or_eq order.strict_trans order_trans_rules(21))
+      hence least_ab: "(LEAST n. H $$ (i, n) \<noteq> 0) < (LEAST n. H $$ (j, n) \<noteq> 0)" using jm
+        using j_not0_H assms(2) echelon_form_JNF_def ef_H ij by blast
+      define b where "b = (LEAST n. H $$ (i, n) \<noteq> 0)"
+      have H_ib: "H $$ (i, b) \<noteq> 0"
+        by (metis (mono_tags, lifting) LeastI b_def i_not0_H is_zero_row_JNF_def)
+      have b: "b < dim_col ?H" using least_ab a unfolding a_def b_def
+        by (metis (mono_tags, lifting) H' H'_ja H_ij a_def carrier_matD dual_order.strict_trans j nat_neq_iff not_less_Least)
+      have H'_ib: "?H $$ (i,b) \<noteq> 0" using H_ib b H_ij H' ij j 
+        by (metis H' carrier_matD dual_order.strict_trans ij j)
+      hence "\<not> is_zero_row_JNF i ?H" using b is_zero_row_JNF_def by blast
+      thus False using iH'_0 by contradiction
+    qed  
+  next
+    fix i j assume ij: "i < j" and j: "j < dim_row ?H"
+    have jm: "j<m"
+      by (metis H' carrier_matD(1) j km le_eq_less_or_eq nat_SN.gt_trans)
+    assume not0_iH': "\<not> is_zero_row_JNF i ?H"
+      and not0_jH': "\<not> is_zero_row_JNF j ?H"
+    define a where "a = (LEAST n. ?H $$ (i, n) \<noteq> 0)"
+    define b where "b = (LEAST n. ?H $$ (j, n) \<noteq> 0)"
+    have H'_ia: "?H $$ (i,a) \<noteq> 0"
+      by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH')
+    have H'_jb: "?H $$ (j,b) \<noteq> 0"
+      by (metis (mono_tags) LeastI_ex b_def is_zero_row_JNF_def not0_jH')
+    have a: "a < dim_row ?H"
+      by (smt H' a_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_iH' not_less_Least)
+    have b: "b < dim_row ?H"
+      by (smt H' b_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_jH' not_less_Least)
+    have a_eq: "a = (LEAST n. H $$ (i, n) \<noteq> 0)"
+      by (smt H' H'_ia H_ij LeastI_ex a a_def carrier_matD(1) ij j linorder_neqE_nat not_less_Least order_trans_rules(19))
+    have b_eq: "b = (LEAST n. H $$ (j, n) \<noteq> 0)"
+      by (smt H' H'_jb H_ij LeastI_ex b b_def carrier_matD(1) ij j linorder_neqE_nat not_less_Least order_trans_rules(19)) 
+    have not0_iH: "\<not> is_zero_row_JNF i H" 
+      by (metis H' H'_ia H_ij a H carrier_matD ij is_zero_row_JNF_def j kn le_eq_less_or_eq order.strict_trans)
+    have not0_jH: "\<not> is_zero_row_JNF j H" 
+      by (metis H' H'_jb H_ij b H carrier_matD is_zero_row_JNF_def j kn le_eq_less_or_eq order.strict_trans)
+    show "(LEAST n. ?H $$ (i, n) \<noteq> 0) < (LEAST n. ?H $$ (j, n) \<noteq> 0)"
+      unfolding a_def[symmetric] b_def[symmetric] a_eq b_eq using not0_iH not0_jH ef_H ij jm H 
+      unfolding echelon_form_JNF_def by auto
+  qed
+qed
+
+
+lemma HNF_submatrix:
+  assumes HNF_H: "Hermite_JNF associates res H" and H: "H \<in> carrier_mat m n"
+  and k: "k \<le> min m n"
+  shows "Hermite_JNF associates res (submatrix H {0..<k} {0..<k})" 
+proof -
+  let ?I = "{0..<k}"
+  let ?H = "submatrix H ?I ?I"  
+  have km: "k\<le>m" and kn: "k\<le>n" using k by simp+
+  have card_mk: "card {i. i < m \<and> i < k} = k" using km 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  have card_nk: "card {i. i < n \<and> i < k} = k" using kn 
+    by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
+  have H_ij: "H $$ (i,j) = (submatrix H ?I ?I) $$ (i,j)"  if i: "i<k" and j: "j<k" for i j
+  proof- 
+    have pick_j: "pick ?I j = j" by (rule pick_first_id[OF j])
+    have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i])
+    have "submatrix H ?I ?I $$ (i, j) = H $$ (pick ?I i, pick ?I j)" 
+      by (rule submatrix_index, insert H i j card_mk card_nk, auto)
+    also have "... = H $$ (i,j)" using pick_i pick_j by simp
+    finally show ?thesis ..
+  qed
+  have H'[simp]: "?H \<in> carrier_mat k k" 
+    using H dim_submatrix[of H "{0..<k}" "{0..<k}"] card_mk card_nk by auto
+  have CS_ass: "Complete_set_non_associates associates" using HNF_H unfolding Hermite_JNF_def by simp
+  moreover have CS_res: "Complete_set_residues res"  using HNF_H unfolding Hermite_JNF_def by simp
+  have ef_H: "echelon_form_JNF H" using HNF_H unfolding Hermite_JNF_def by auto
+  have ef_H': "echelon_form_JNF ?H"
+    by (rule echelon_form_submatrix[OF ef_H H k])
+  have HNF1: "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> associates" 
+    and HNF2: "(\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
+               \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0)))"
+    if i: "i<dim_row ?H" and not0_iH': "\<not> is_zero_row_JNF i ?H" for i
+  proof -
+    define a where "a = (LEAST n. ?H $$ (i, n) \<noteq> 0)"
+    have im: "i<m"
+      by (metis H' carrier_matD(1) km order.strict_trans2 that(1))
+    have H'_ia: "?H $$ (i,a) \<noteq> 0"
+      by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH')
+    have a: "a < dim_row ?H"
+      by (smt H' a_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_iH' not_less_Least)
+    have a_eq: "a = (LEAST n. H $$ (i, n) \<noteq> 0)"
+      by (smt H' H'_ia H_ij LeastI_ex a a_def carrier_matD(1) i linorder_neqE_nat not_less_Least order_trans_rules(19))
+    have H'_ia_H_ia: "?H $$ (i, a) = H $$ (i, a)"  by (metis H' H_ij a carrier_matD(1) i)
+    have not'_iH: "\<not> is_zero_row_JNF i H"
+      by (metis H' H'_ia H'_ia_H_ia a assms(2) carrier_matD(1) carrier_matD(2) is_zero_row_JNF_def kn order.strict_trans2)
+    thus "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> associates" using im
+      by (metis H'_ia_H_ia Hermite_JNF_def a_def a_eq HNF_H H carrier_matD(1))
+    show "(\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
+               \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0)))" 
+    proof -
+      { fix nn :: nat
+    have ff1: "\<forall>n. ?H $$ (n, a) = H $$ (n, a) \<or> \<not> n < k"
+      by (metis (no_types) H' H_ij a carrier_matD(1))
+      have ff2: "i < k"
+    by (metis H' carrier_matD(1) that(1))
+    then have "H $$ (nn, a) \<in> res (H $$ (i, a)) \<longrightarrow> H $$ (nn, a) \<in> res (?H $$ (i, a))"
+    using ff1 by (metis (no_types))
+      moreover
+      { assume "H $$ (nn, a) \<in> res (?H $$ (i, a))"
+        then have "?H $$ (nn, a) = H $$ (nn, a) \<longrightarrow> ?H $$ (nn, a) \<in> res (?H $$ (i, a))"
+            by presburger
+          then have "\<not> nn < i \<or> ?H $$ (nn, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))"
+            using ff2 ff1 a_def order.strict_trans by blast }
+        ultimately have "\<not> nn < i \<or> ?H $$ (nn, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))"
+          using Hermite_JNF_def a_eq assms(1) assms(2) im not'_iH by blast }
+      then show ?thesis
+        by meson
+    qed
+  qed
+  show ?thesis using HNF1 HNF2 ef_H' CS_res CS_ass unfolding Hermite_JNF_def by blast
+qed
+
+lemma HNF_of_HNF_id:
+  fixes H :: "int mat"
+  assumes HNF_H: "Hermite_JNF associates res H"
+  and H: "H \<in> carrier_mat n n"
+  and H_P1_H1: "H = P1 * H1"
+  and inv_P1: "invertible_mat P1"
+  and H1: "H1 \<in> carrier_mat n n" 
+  and P1: "P1 \<in> carrier_mat n n"
+  and HNF_H1: "Hermite_JNF associates res H1"
+  and inv_H: "invertible_mat (map_mat rat_of_int H)"
+  shows "H1 = H" 
+proof (rule HNF_unique_generalized_JNF[OF H P1 H1 _ H H_P1_H1])   
+  show "H = (1\<^sub>m n) * H" using H by auto  
+qed (insert assms, auto)
+
+
+(*Some of the following lemmas could be moved outside this context*)
+
+context
+  fixes n :: nat
+begin
+
+interpretation vec_module "TYPE(int)" .        
+
+lemma lattice_is_monotone:
+  fixes S T
+  assumes S: "set S \<subseteq> carrier_vec n"
+  assumes T: "set T \<subseteq> carrier_vec n"
+  assumes subs: "set S \<subseteq> set T"
+  shows "lattice_of S \<subseteq> lattice_of T"
+proof -
+  have "\<exists>fa. lincomb fa (set T) = lincomb f (set S)" for f
+  proof -
+    let ?f = "\<lambda>i. if i \<in> set T - set S then 0 else f i"
+    have set_T_eq: "set T = set S \<union> (set T - set S)" using subs by blast
+    have l0: "lincomb ?f (set T - set S) = 0\<^sub>v n" by (rule lincomb_zero, insert T, auto)
+    have "lincomb ?f (set T) = lincomb ?f (set S \<union> (set T - set S))" using set_T_eq by simp
+    also have "... = lincomb ?f (set S) + lincomb ?f (set T - set S)"
+      by (rule lincomb_union, insert S T subs, auto)
+    also have "... = lincomb ?f (set S)" using l0 by (auto simp add: S)
+    also have "... = lincomb f (set S)" using S by fastforce
+    finally show ?thesis by blast    
+  qed
+  thus ?thesis unfolding lattice_of_altdef_lincomb[OF S] lattice_of_altdef_lincomb[OF T]
+    by auto
+qed
+
+lemma lattice_of_append:
+  assumes fs: "set fs \<subseteq> carrier_vec n"
+  assumes gs: "set gs \<subseteq> carrier_vec n" 
+  shows "lattice_of (fs @ gs) = lattice_of (gs @ fs)"
+proof -
+  have fsgs: "set (fs @ gs) \<subseteq> carrier_vec n" using fs gs by auto
+  have gsfs: "set (gs @ fs) \<subseteq> carrier_vec n" using fs gs by auto
+  show ?thesis
+    unfolding lattice_of_altdef_lincomb[OF fsgs] lattice_of_altdef_lincomb[OF gsfs] 
+    by auto (metis Un_commute)+
+qed
+
+lemma lattice_of_append_cons:
+  assumes fs: "set fs \<subseteq> carrier_vec n"   and v: "v \<in> carrier_vec n"
+  shows "lattice_of (v # fs) = lattice_of (fs @ [v])"
+proof -
+  have v_fs: "set (v # fs) \<subseteq> carrier_vec n" using fs v by auto
+  hence fs_v: "set (fs @ [v]) \<subseteq> carrier_vec n" by simp
+  show ?thesis
+    unfolding lattice_of_altdef_lincomb[OF v_fs] lattice_of_altdef_lincomb[OF fs_v] by auto
+qed
+
+lemma already_in_lattice_subset:
+  assumes fs: "set fs \<subseteq> carrier_vec n" and inlattice: "v \<in> lattice_of fs"
+  and v: "v \<in> carrier_vec n"
+  shows "lattice_of (v # fs) \<subseteq> lattice_of fs"
+proof (cases "v\<in>set fs")
+  case True
+  then show ?thesis
+    by (metis fs lattice_is_monotone set_ConsD subset_code(1))
+next
+  case False note v_notin_fs = False  
+  obtain g where v_g: "lincomb g (set fs) = v"
+    using lattice_of_altdef_lincomb[OF fs] inlattice by auto
+  have v_fs: "set (v # fs) \<subseteq> carrier_vec n" using v fs by auto
+  have "\<exists>fa. lincomb fa (set fs) = lincomb f (insert v (set fs))" for f
+  proof -
+    have smult_rw: "f v \<cdot>\<^sub>v (lincomb g (set fs)) = lincomb (\<lambda>w. f v * g w) (set fs)" 
+      by (rule lincomb_smult[symmetric, OF fs])
+    have "lincomb f (insert v (set fs)) =  f v \<cdot>\<^sub>v v + lincomb f (set fs)" 
+      by (rule lincomb_insert2[OF _ fs _ v_notin_fs v], auto)
+    also have "... = f v \<cdot>\<^sub>v (lincomb g (set fs)) + lincomb f (set fs)" using v_g by simp
+    also have "... = lincomb (\<lambda>w. f v * g w) (set fs)  + lincomb f (set fs)"
+      unfolding smult_rw by auto
+    also have "... = lincomb (\<lambda>w. (\<lambda>w. f v * g w) w + f w) (set fs)"
+      by (rule lincomb_sum[symmetric, OF _ fs], simp)
+    finally show ?thesis by auto
+  qed
+  thus ?thesis unfolding lattice_of_altdef_lincomb[OF v_fs] lattice_of_altdef_lincomb[OF fs] by auto
+qed
+
+
+lemma already_in_lattice:
+  assumes fs: "set fs \<subseteq> carrier_vec n" and inlattice: "v \<in> lattice_of fs"
+  and v: "v \<in> carrier_vec n"
+  shows "lattice_of fs = lattice_of (v # fs)"
+proof - 
+  have dir1: "lattice_of fs \<subseteq> lattice_of (v # fs)"
+    by (intro lattice_is_monotone, insert fs v, auto)
+  moreover have dir2: "lattice_of (v # fs) \<subseteq> lattice_of fs"
+    by (rule already_in_lattice_subset[OF assms])
+  ultimately show ?thesis by auto
+qed
+
+
+lemma already_in_lattice_append:
+  assumes fs: "set fs \<subseteq> carrier_vec n" and inlattice: "lattice_of gs \<subseteq> lattice_of fs"
+  and gs: "set gs \<subseteq> carrier_vec n"
+shows "lattice_of fs = lattice_of (fs @ gs)"
+  using assms
+proof (induct gs arbitrary: fs)
+  case Nil
+  then show ?case by auto
+next
+  case (Cons a gs)
+  note fs = Cons.prems(1)
+  note inlattice = Cons.prems(2)
+  note gs = Cons.prems(3)
+  have gs_in_fs: "lattice_of gs \<subseteq> lattice_of fs"
+    by (meson basic_trans_rules(23) gs lattice_is_monotone local.Cons(3) set_subset_Cons)
+  have a: "a \<in> lattice_of (fs @ gs)"
+    using basis_in_latticeI fs gs gs_in_fs local.Cons(1) local.Cons(3) by auto
+  have "lattice_of (fs @ a # gs) = lattice_of ((a # gs) @ fs)"
+    by (rule lattice_of_append, insert fs gs, auto) 
+  also have "... = lattice_of (a # (gs @ fs))" by auto
+  also have "... = lattice_of (a # (fs @ gs))"
+    by (rule lattice_of_eq_set, insert gs fs, auto)
+  also have "... = lattice_of (fs @ gs)"
+    by (rule already_in_lattice[symmetric, OF _ a], insert fs gs, auto)
+  also have "... = lattice_of fs" by (rule Cons.hyps[symmetric, OF fs gs_in_fs], insert gs, auto)     
+  finally show ?case ..
+qed
+
+lemma zero_in_lattice:
+  assumes fs_carrier: "set fs \<subseteq> carrier_vec n"
+  shows "0\<^sub>v n \<in> lattice_of fs"
+proof - 
+  have "\<forall>f. lincomb (\<lambda>v. 0 * f v) (set fs) = 0\<^sub>v n"
+      using fs_carrier lincomb_closed lincomb_smult lmult_0 by presburger
+  hence "lincomb (\<lambda>i. 0) (set fs) = 0\<^sub>v n" by fastforce 
+  thus ?thesis unfolding lattice_of_altdef_lincomb[OF fs_carrier] by auto
+qed
+
+
+lemma lattice_zero_rows_subset:
+  assumes H: "H \<in> carrier_mat a n"
+  shows "lattice_of (Matrix.rows (0\<^sub>m m n)) \<subseteq> lattice_of (Matrix.rows H)"
+proof 
+  let ?fs = "Matrix.rows (0\<^sub>m m n)"
+  let ?gs = "Matrix.rows H"
+  have fs_carrier: "set ?fs \<subseteq> carrier_vec n" unfolding Matrix.rows_def by auto
+  have gs_carrier: "set ?gs \<subseteq> carrier_vec n" using H unfolding Matrix.rows_def by auto
+  fix x assume x: "x \<in> lattice_of (Matrix.rows (0\<^sub>m m n))"
+  obtain f where fx: "lincomb (of_int \<circ> f) (set (Matrix.rows (0\<^sub>m m n))) = x"
+    using x lattice_of_altdef_lincomb[OF fs_carrier] by blast
+  have "lincomb (of_int \<circ> f) (set (Matrix.rows (0\<^sub>m m n))) = 0\<^sub>v n"
+    unfolding lincomb_def by (rule M.finsum_all0, unfold Matrix.rows_def, auto)
+  hence "x = 0\<^sub>v n" using fx by auto
+  thus "x \<in> lattice_of (Matrix.rows H)" using zero_in_lattice[OF gs_carrier] by auto 
+qed
+
+(*TODO: move outside this context (the previous lemmas too)*)
+lemma lattice_of_append_zero_rows:
+  assumes H': "H' \<in> carrier_mat m n"
+  and H: "H = H' @\<^sub>r (0\<^sub>m m n)"
+shows "lattice_of (Matrix.rows H) = lattice_of (Matrix.rows H')"
+proof -
+  have "Matrix.rows H = Matrix.rows H' @ Matrix.rows (0\<^sub>m m n)"
+    by (unfold H, rule rows_append_rows[OF H'], auto)
+  also have "lattice_of ... = lattice_of (Matrix.rows H')"
+  proof (rule already_in_lattice_append[symmetric])
+    show "lattice_of (Matrix.rows (0\<^sub>m m n)) \<subseteq> lattice_of (Matrix.rows H')"
+      by (rule lattice_zero_rows_subset[OF H'])
+  qed (insert H', auto simp add: Matrix.rows_def)
+  finally show ?thesis .
+qed
+end
+
+text \<open>Lemmas about echelon form\<close>
+
+lemma echelon_form_JNF_1xn:
+  assumes "A\<in>carrier_mat m n" and "m<2"  
+shows "echelon_form_JNF A"
+  using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def by fastforce
+
+
+lemma echelon_form_JNF_mx1:
+  assumes "A\<in>carrier_mat m n" and "n<2"
+  and "\<forall>i \<in> {1..<m}. A$$(i,0) = 0"
+shows "echelon_form_JNF A"
+  using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def
+    using atLeastLessThan_iff less_2_cases by fastforce
+
+
+lemma echelon_form_mx0:
+  assumes "A \<in> carrier_mat m 0"
+  shows "echelon_form_JNF A" using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def by auto
+
+lemma echelon_form_JNF_first_column_0:
+  assumes eA: "echelon_form_JNF A" and A: "A \<in> carrier_mat m n"
+    and i0: "0<i" and im: "i<m" and n0: "0<n"
+  shows "A $$ (i,0) =0"
+proof (rule ccontr)
+  assume Ai0: "A $$ (i, 0) \<noteq> 0"
+  hence nz_iA:  "\<not> is_zero_row_JNF i A" using n0 A unfolding is_zero_row_JNF_def by auto
+  hence nz_0A: "\<not> is_zero_row_JNF 0 A" using eA A unfolding echelon_form_JNF_def using i0 im by auto
+  have "(LEAST n. A $$ (0, n) \<noteq> 0) < (LEAST n. A $$ (i, n) \<noteq> 0)"
+    using nz_iA nz_0A eA A unfolding echelon_form_JNF_def using i0 im by blast
+  moreover have "(LEAST n. A $$ (i, n) \<noteq> 0) = 0" using Ai0 by simp
+  ultimately show False by auto
+qed
+
+
+lemma is_zero_row_JNF_multrow[simp]: 
+  fixes A::"'a::comm_ring_1 mat"
+  assumes "i<dim_row A"
+  shows "is_zero_row_JNF i (multrow j (- 1) A) = is_zero_row_JNF i A"
+  using assms unfolding is_zero_row_JNF_def by auto
+
+lemma echelon_form_JNF_multrow:
+  assumes "A : carrier_mat m n" and "i<m" and eA: "echelon_form_JNF A"
+  shows "echelon_form_JNF (multrow i (- 1) A)"
+proof (rule echelon_form_JNF_intro)
+  have "A $$ (j, ja) = 0" if  "\<forall>j'<dim_col A. A $$ (ia, j') = 0" 
+    and iaj: "ia < j" and j: "j < dim_row A" and ja: "ja < dim_col A" for ia j ja
+    using assms that unfolding echelon_form_JNF_def is_zero_row_JNF_def 
+    by (meson order.strict_trans) 
+  thus " \<forall>ia<dim_row (multrow i (- 1) A). is_zero_row_JNF ia (multrow i (- 1) A) 
+      \<longrightarrow> \<not> (\<exists>j<dim_row (multrow i (- 1) A). ia < j \<and> \<not> is_zero_row_JNF j (multrow i (- 1) A))"
+    unfolding is_zero_row_JNF_def by simp 
+  have Least_eq: "(LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) = (LEAST n. A $$ (ia, n) \<noteq> 0)"
+    if ia: "ia < dim_row A" and nz_ia_mrA: "\<not> is_zero_row_JNF ia (multrow i (- 1) A)" for ia
+  proof (rule Least_equality)
+    have nz_ia_A: "\<not> is_zero_row_JNF ia A" using nz_ia_mrA ia by auto
+    have Least_Aian_n: "(LEAST n. A $$ (ia, n) \<noteq> 0) < dim_col A"
+      by (smt dual_order.strict_trans is_zero_row_JNF_def not_less_Least not_less_iff_gr_or_eq nz_ia_A)
+    show "multrow i (- 1) A $$ (ia, LEAST n. A $$ (ia, n) \<noteq> 0) \<noteq> 0"
+      by (smt LeastI Least_Aian_n class_cring.cring_simprules(22) equation_minus_iff ia
+          index_mat_multrow(1) is_zero_row_JNF_def mult_minus1 nz_ia_A)
+    show " \<And>y. multrow i (- 1) A $$ (ia, y) \<noteq> 0 \<Longrightarrow> (LEAST n. A $$ (ia, n) \<noteq> 0) \<le> y"
+      by (metis (mono_tags, lifting) Least_Aian_n class_cring.cring_simprules(22) ia 
+          index_mat_multrow(1) leI mult_minus1 order.strict_trans wellorder_Least_lemma(2))
+  qed
+  have "(LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) < (LEAST n. multrow i (- 1) A $$ (j, n) \<noteq> 0)"
+    if ia_j: "ia < j" and
+      j: "j < dim_row A"
+      and nz_ia_A: "\<not> is_zero_row_JNF ia A"
+      and nz_j_A: "\<not> is_zero_row_JNF j A"
+    for ia j
+  proof -
+    have ia: "ia < dim_row A" using ia_j j by auto
+    show ?thesis using Least_eq[OF ia] Least_eq[OF j] nz_ia_A nz_j_A 
+        is_zero_row_JNF_multrow[OF ia] is_zero_row_JNF_multrow[OF j] eA ia_j j
+      unfolding echelon_form_JNF_def by simp
+  qed 
+  thus "\<forall>ia j.
+       ia < j \<and> j < dim_row (multrow i (- 1) A) \<and> \<not> is_zero_row_JNF ia (multrow i (- 1) A)
+        \<and> \<not> is_zero_row_JNF j (multrow i (- 1) A) \<longrightarrow>
+       (LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) < (LEAST n. multrow i (- 1) A $$ (j, n) \<noteq> 0)"
+    by auto 
+qed
+
+
+(*The following lemma is already in HOL Analysis (thm echelon_form_imp_upper_triagular),
+but only for square matrices. We prove it here for rectangular matrices.*)
+thm echelon_form_imp_upper_triagular
+
+(*First we prove an auxiliary statement*)
+lemma echelon_form_JNF_least_position_ge_diagonal:
+  assumes eA: "echelon_form_JNF A" 
+  and A: "A: carrier_mat m n"
+  and nz_iA: "\<not> is_zero_row_JNF i A"
+  and im: "i<m"
+shows "i\<le>(LEAST n. A $$ (i,n) \<noteq> 0)"
+  using nz_iA im
+proof (induct i rule: less_induct)
+  case (less i)
+  note nz_iA = less.prems(1) 
+  note im = less.prems(2)
+  show ?case
+  proof (cases "i=0")
+    case True show ?thesis using True by blast
+  next
+    case False
+    show ?thesis
+    proof (rule ccontr)
+      assume " \<not> i \<le> (LEAST n. A $$ (i, n) \<noteq> 0)"
+      hence i_least: "i > (LEAST n. A $$ (i, n) \<noteq> 0)" by auto
+      have nz_i1A: "\<not> is_zero_row_JNF (i-1) A" 
+        using nz_iA im False A eA unfolding echelon_form_JNF_def
+        by (metis Num.numeral_nat(7) Suc_pred carrier_matD(1) gr_implies_not0 
+            lessI linorder_neqE_nat order.strict_trans)  
+      have "i-1\<le>(LEAST n. A $$ (i-1,n) \<noteq> 0)" by (rule less.hyps, insert im nz_i1A False, auto)
+      moreover have "(LEAST n. A $$ (i,n) \<noteq> 0) > (LEAST n. A $$ (i-1,n) \<noteq> 0)"
+        using nz_i1A nz_iA im False A eA unfolding echelon_form_JNF_def by auto   
+      ultimately show False using i_least by auto
+    qed
+  qed
+qed
+
+
+lemma echelon_form_JNF_imp_upper_triangular:
+  assumes eA: "echelon_form_JNF A" 
+  shows "upper_triangular A"
+proof
+  fix i j assume ji: "j<i" and i: "i<dim_row A"
+  have A: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
+  show "A $$ (i,j) = 0"
+  proof (cases "is_zero_row_JNF i A")
+    case False
+    have "i\<le> (LEAST n. A $$(i,n) \<noteq> 0)"
+      by (rule echelon_form_JNF_least_position_ge_diagonal[OF eA A False i])
+    then show ?thesis 
+      using ji not_less_Least order.strict_trans2 by blast
+  next
+    case True
+      (*
+    Problem detected: at this point, we don't know if j < dim_col A. 
+    That is, upper_triangular definition only works for matrices \<in> carrier_mat m n with n\<ge>m.
+    The definition is: 
+       - upper_triangular A \<equiv> \<forall>i < dim_row A. \<forall> j < i. A $$ (i,j) = 0
+     But we need here:
+       - upper_triangular A \<equiv> \<forall>i < dim_row A. \<forall> j < dim_col A. j < i  \<longrightarrow> A $$ (i,j) = 0
+  
+    Anyway, the existing definition makes sense since upper triangular is usually 
+    restricted to square matrices.
+  *)
+    then show ?thesis unfolding is_zero_row_JNF_def oops
+
+
+(*We do the same with the new definition upper_triangular'*)
+lemma echelon_form_JNF_imp_upper_triangular:
+  assumes eA: "echelon_form_JNF A" 
+  shows "upper_triangular' A"
+proof
+  fix i j assume ji: "j<i" and i: "i<dim_row A" and j: "j<dim_col A"
+  have A: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
+  show "A $$ (i,j) = 0"
+  proof (cases "is_zero_row_JNF i A")
+    case False
+    have "i\<le> (LEAST n. A $$(i,n) \<noteq> 0)"
+      by (rule echelon_form_JNF_least_position_ge_diagonal[OF eA A False i])
+    then show ?thesis 
+      using ji not_less_Least order.strict_trans2 by blast
+  next
+    case True     
+    then show ?thesis unfolding is_zero_row_JNF_def using j by auto
+  qed
+qed
+
+
+lemma upper_triangular_append_zero:
+  assumes uH: "upper_triangular' H" 
+  and H: "H \<in> carrier_mat (m+m) n" and mn: "n\<le>m"
+  shows "H = mat_of_rows n (map (Matrix.row H) [0..<m]) @\<^sub>r 0\<^sub>m m n" (is "_ = ?H' @\<^sub>r 0\<^sub>m m n")
+proof 
+  have H': "?H' \<in> carrier_mat m n" using H uH by auto
+  have H'0: "(?H' @\<^sub>r 0\<^sub>m m n) \<in> carrier_mat (m+m) n" by (simp add: H')
+  thus dr: "dim_row H = dim_row (?H' @\<^sub>r 0\<^sub>m m n)" using H H'  by (simp add: append_rows_def) 
+  show dc: "dim_col H = dim_col (?H' @\<^sub>r 0\<^sub>m m n)" using H H'  by (simp add: append_rows_def) 
+  fix i j assume i: "i < dim_row (?H' @\<^sub>r 0\<^sub>m m n)" and j: "j < dim_col (?H' @\<^sub>r 0\<^sub>m m n)"
+  show "H $$ (i, j) = (?H' @\<^sub>r 0\<^sub>m m n) $$ (i, j)"
+  proof (cases "i<m")
+    case True
+    have "H $$ (i, j) = ?H' $$ (i,j)"
+      by (metis True H' append_rows_def H carrier_matD index_mat_four_block(3) index_zero_mat(3) j 
+          le_add1 map_first_rows_index mat_of_rows_carrier(2) mat_of_rows_index nat_arith.rule0)
+    then show ?thesis
+      by (metis (mono_tags, lifting) H' True add.comm_neutral append_rows_def 
+          carrier_matD(1) i index_mat_four_block index_zero_mat(3) j)
+  next
+    case False 
+    have imn: "i<m+m" using i dr H by auto
+    have jn: "j<n" using j dc H by auto
+    have ji: "j<i" using j i False mn jn by linarith
+    hence "H $$ (i, j) = 0" using uH unfolding upper_triangular'_def dr imn using i jn 
+      by (simp add: dc j)
+    also have "... = (?H' @\<^sub>r 0\<^sub>m m n) $$ (i, j)"
+      by (smt False H' append_rows_def assms(2) carrier_matD(1) carrier_matD(2) dc imn
+          index_mat_four_block(1,3) index_zero_mat j less_diff_conv2 linorder_not_less)
+    finally show ?thesis .
+  qed
+qed
+
+subsubsection \<open>The algorithm is sound\<close>
+
+lemma find_fst_non0_in_row: 
+  assumes A: "A \<in> carrier_mat m n"
+  and res: "find_fst_non0_in_row l A = Some j"
+  shows "A $$ (l,j) \<noteq> 0" "l \<le> j" "j < dim_col A"
+proof -
+  let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
+  from res[unfolded find_fst_non0_in_row_def Let_def]
+  have xs: "?xs \<noteq> []" by (cases ?xs, auto)
+  have j_in_xs: "j \<in> set ?xs" using res unfolding find_fst_non0_in_row_def Let_def
+    by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
+  show "A $$ (l,j) \<noteq> 0" "l \<le> j" "j < dim_col A" using j_in_xs by auto+  
+qed
+
+
+lemma find_fst_non0_in_row_zero_before: 
+  assumes A: "A \<in> carrier_mat m n"
+  and res: "find_fst_non0_in_row l A = Some j"
+  shows "\<forall>j'\<in>{l..<j}. A $$ (l,j') = 0"
+proof -
+  let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
+  from res[unfolded find_fst_non0_in_row_def Let_def]
+  have xs: "?xs \<noteq> []" by (cases ?xs, auto)
+  have j_in_xs: "j \<in> set ?xs" using res unfolding find_fst_non0_in_row_def Let_def
+    by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
+  have j_xs0: "j = ?xs ! 0"
+    by (smt res[unfolded find_fst_non0_in_row_def Let_def] list.case(2) list.exhaust option.inject xs)
+  show "\<forall>j'\<in>{l..<j}. A $$ (l,j') = 0"
+  proof (rule+, rule ccontr)
+    fix j' assume j': "j' : {l..<j}" and Alj': "A $$ (l, j') \<noteq> 0"
+    have j'j: "j'<j" using j' by auto
+    have j'_in_xs: "j' \<in> set ?xs"
+      by (metis (mono_tags, lifting) A Set.member_filter j' Alj' res atLeastLessThan_iff filter_set
+          find_fst_non0_in_row(3) nat_SN.gt_trans set_upt)  
+    have l_rw: "[l..<dim_col A] = [l ..<j] @[j..<dim_col A]"
+      using assms(1) assms(2) find_fst_non0_in_row(3) j' upt_append by auto
+    have xs_rw: "?xs = filter (\<lambda>j. A $$ (l, j) \<noteq> 0) ([l ..<j] @[j..<dim_col A])"
+      using l_rw by auto
+    hence "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..<j] = []" using j_xs0 
+      by (metis (no_types, lifting) Set.member_filter atLeastLessThan_iff filter_append filter_set
+          length_greater_0_conv nth_append nth_mem order_less_irrefl set_upt)
+    thus False using j_xs0 j' j_xs0 
+      by (metis Set.member_filter filter_empty_conv filter_set j'_in_xs set_upt)
+  qed
+qed
+
+
+corollary find_fst_non0_in_row_zero_before': 
+  assumes A: "A \<in> carrier_mat m n"
+  and res: "find_fst_non0_in_row l A = Some j"
+  and "j' \<in> {l..<j}"
+  shows "A $$ (l,j') = 0" using find_fst_non0_in_row_zero_before assms by auto
+
+lemma find_fst_non0_in_row_LEAST: 
+  assumes A: "A \<in> carrier_mat m n"
+  and ut_A: "upper_triangular' A"
+  and res: "find_fst_non0_in_row l A = Some j"
+  and lm: "l<m"
+shows "j = (LEAST n. A $$ (l,n) \<noteq> 0)"
+proof (rule Least_equality[symmetric])
+  show " A $$ (l, j) \<noteq> 0" using res find_fst_non0_in_row(1) by blast
+  show "\<And>y. A $$ (l, y) \<noteq> 0 \<Longrightarrow> j \<le> y"
+  proof (rule ccontr)
+    fix y assume Aly: "A $$ (l, y) \<noteq> 0" and jy: " \<not> j \<le> y "
+    have yn: "y < n"
+      by (metis A jy carrier_matD(2) find_fst_non0_in_row(3) leI less_imp_le_nat nat_SN.compat res)
+    have "A $$(l,y) = 0"
+    proof (cases "y\<in>{l..<j}")
+      case True
+      show ?thesis by (rule find_fst_non0_in_row_zero_before'[OF A res True])
+    next
+      case False hence "y<l" using jy by auto
+      thus ?thesis using ut_A A lm unfolding upper_triangular'_def using yn by blast
+    qed
+    thus False using Aly by contradiction
+  qed 
+qed
+
+
+
+lemma find_fst_non0_in_row_None': 
+  assumes A: "A \<in> carrier_mat m n"  
+  and lm: "l<m"
+shows "(find_fst_non0_in_row l A = None) = (\<forall>j\<in>{l..<dim_col A}. A $$ (l,j) = 0)" (is "?lhs = ?rhs")
+proof
+  assume res: ?lhs
+  let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
+  from res[unfolded find_fst_non0_in_row_def Let_def]
+  have xs: "?xs = []" by (cases ?xs, auto)
+  have "A $$ (l, j) = 0" if j: "j\<in>{l..<dim_col A}" for j
+    using xs by (metis (mono_tags, lifting) empty_filter_conv j set_upt)
+  thus "?rhs" by blast
+next
+  assume rhs: ?rhs
+  show ?lhs
+  proof (rule ccontr)
+    assume "find_fst_non0_in_row l A \<noteq> None" 
+    from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast
+    hence "A $$ (l,j) \<noteq> 0" and  "l\<le>j" and "j<dim_col A" using find_fst_non0_in_row[OF A r] by blast+
+    thus False using rhs by auto  
+  qed
+qed
+
+
+lemma find_fst_non0_in_row_None: 
+  assumes A: "A \<in> carrier_mat m n"
+  and ut_A: "upper_triangular' A"
+  and lm: "l<m"
+shows "(find_fst_non0_in_row l A = None) = (is_zero_row_JNF l A)" (is "?lhs = ?rhs")
+proof
+  assume res: ?lhs
+  let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
+  from res[unfolded find_fst_non0_in_row_def Let_def]
+  have xs: "?xs = []" by (cases ?xs, auto)
+  have "A $$ (l, j) = 0" if j: "j < dim_col A" for j
+  proof (cases "j<l")
+    case True
+    then show ?thesis using ut_A A lm j unfolding upper_triangular'_def by blast
+  next
+    case False
+    hence j_ln: "j \<in> {l..<dim_col A}" using A lm j by simp
+    then show ?thesis using xs by (metis (mono_tags, lifting) empty_filter_conv set_upt)
+  qed
+  thus "?rhs" unfolding is_zero_row_JNF_def by blast
+next
+  assume rhs: ?rhs
+  show ?lhs
+  proof (rule ccontr)
+    assume "find_fst_non0_in_row l A \<noteq> None" 
+    from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast
+    hence "A $$ (l,j) \<noteq> 0" and "j<dim_col A" using find_fst_non0_in_row[OF A r] by blast+
+    hence "\<not> is_zero_row_JNF l A" unfolding is_zero_row_JNF_def using lm A by auto
+    thus False using rhs by contradiction    
+  qed
+qed
+
+lemma make_first_column_positive_preserves_dimensions:
+  shows [simp]: "dim_row (make_first_column_positive A) = dim_row A" 
+    and [simp]: "dim_col (make_first_column_positive A) = dim_col A"
+  by (auto)
+
+
+lemma make_first_column_positive_works: 
+  assumes "A\<in>carrier_mat m n" and i: "i<m" and "0<n"
+  shows "make_first_column_positive A $$ (i,0) \<ge> 0"
+  and "j<n \<Longrightarrow> A $$ (i,0) < 0 \<Longrightarrow> (make_first_column_positive A) $$ (i,j) = - A $$ (i,j)"
+  and "j<n \<Longrightarrow> A $$ (i,0) \<ge> 0 \<Longrightarrow> (make_first_column_positive A) $$ (i,j) = A $$ (i,j)"
+  using assms by auto 
+
+
+lemma make_first_column_positive_invertible: 
+  shows  "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (dim_row A) (dim_row A) 
+  \<and> make_first_column_positive A = P * A" 
+proof -
+  let ?P = "Matrix.mat (dim_row A) (dim_row A)
+          (\<lambda>(i,j). if i = j then if A $$(i,0) < 0 then - 1 else 1 else 0::int)"
+  have "invertible_mat ?P"
+  proof -
+    have "(map abs (diag_mat ?P)) = replicate (length ((map abs (diag_mat ?P)))) 1" 
+      by (rule replicate_length_same[symmetric], auto simp add: diag_mat_def)
+    hence m_rw: "(map abs (diag_mat ?P)) = replicate (dim_row A) 1" by (auto simp add: diag_mat_def)
+    have "Determinant.det ?P = prod_list (diag_mat ?P)" by (rule det_upper_triangular, auto)
+    also have "abs ... = prod_list (map abs (diag_mat ?P))" unfolding prod_list_abs by blast
+    also have " ... = prod_list (replicate (dim_row A) 1)" using m_rw by simp
+    also have "... = 1" by auto
+    finally have "\<bar>Determinant.det ?P\<bar> = 1" by blast
+    hence "Determinant.det ?P dvd 1" by fastforce
+    thus ?thesis using invertible_iff_is_unit_JNF mat_carrier by blast (*Thanks to the new bridge*)
+  qed    
+  moreover have "make_first_column_positive A = ?P * A" (is "?M = _")
+  proof (rule eq_matI)
+    show "dim_row ?M = dim_row (?P * A)" and "dim_col ?M = dim_col (?P * A)" by auto
+    fix i j assume i: "i < dim_row (?P * A)" and j: "j < dim_col (?P * A)"
+    have set_rw: "{0..<dim_row A} = insert i ({0..<dim_row A} - {i})" using i by auto
+      have rw0: "(\<Sum>ia \<in> {0..<dim_row A } - {i}. Matrix.row ?P i $v ia * col A j $v ia) = 0"
+        by (rule sum.neutral, insert i, auto)        
+    have "(?P * A) $$ (i, j) = Matrix.row ?P i \<bullet> col A j" using i j by auto
+    also have "... = (\<Sum>ia = 0..<dim_row A. Matrix.row ?P i $v ia * col A j $v ia)"
+        unfolding scalar_prod_def by auto
+      also have "... =  (\<Sum>ia \<in> insert i ({0..<dim_row A} - {i}). Matrix.row ?P i $v ia * col A j $v ia)"
+        using set_rw by argo
+      also have "... = Matrix.row ?P i $v i * col A j $v i 
+        + (\<Sum>ia \<in> {0..<dim_row A } - {i}. Matrix.row ?P i $v ia * col A j $v ia)" 
+        by (rule sum.insert, auto)
+      also have "... = Matrix.row ?P i $v i * col A j $v i" unfolding rw0 by simp
+      finally have *: "(?P * A) $$ (i, j) = Matrix.row ?P i $v i * col A j $v i" .
+    also have "... = ?M $$ (i,j)" 
+      by (cases " A $$ (i, 0) < 0", insert i j, auto simp add: col_def)
+    finally show "?M $$ (i, j) = (?P * A) $$ (i, j)" ..
+  qed
+  moreover have "?P \<in> carrier_mat (dim_row A) (dim_row A)" by auto
+  ultimately show ?thesis by blast
+qed
+
+locale proper_mod_operation = mod_operation +
+  assumes dvd_gdiv_mult_right[simp]: "b > 0 \<Longrightarrow> b dvd a \<Longrightarrow> (a gdiv b) * b = a"
+    and gmod_gdiv: "y > 0 \<Longrightarrow> x gmod y = x - x gdiv y * y"
+    and dvd_imp_gmod_0: "0 < a \<Longrightarrow> a dvd b \<Longrightarrow> b gmod a = 0" 
+    and gmod_0_imp_dvd: "a gmod b = 0 \<Longrightarrow> b dvd a" 
+    and gmod_0[simp]: "n gmod 0 = n" "n > 0 \<Longrightarrow> 0 gmod n = 0"
+begin
+lemma reduce_alt_def_not0: 
+  assumes "A $$ (a,0) \<noteq> 0" and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A $$ (b,0))"
+  shows "reduce a b D A =
+       Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
+                              if k = 0 then if D dvd r then D else r else r gmod D
+                   else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
+                              if k = 0 then r else r gmod D
+                   else A$$(i,k))" (is "_ = ?rhs")
+  and 
+   "reduce_abs a b D A =
+       Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
+                              if abs r > D then if k = 0 \<and> D dvd r then D else r gmod D else r 
+                   else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
+                              if abs r > D then r gmod D else r
+                   else A$$(i,k))" (is "_ = ?rhs_abs")
+proof -
+  have "reduce a b D A =
+       (case euclid_ext2 (A$$(a,0)) (A $$ (b,0)) of (p,q,u,v,d) \<Rightarrow>
+       Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
+                               if k = 0 then if D dvd r then D else r else r gmod D
+                   else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
+                                if k = 0 then r else r gmod D
+                   else A$$(i,k)
+            ))" using assms by auto
+  also have "... = ?rhs" unfolding reduce.simps Let_def 
+    by (rule eq_matI, insert pquvd) (metis (no_types, lifting) split_conv)+
+  finally show "reduce a b D A = ?rhs" .
+  have "reduce_abs a b D A =
+       (case euclid_ext2 (A$$(a,0)) (A $$ (b,0)) of (p,q,u,v,d) \<Rightarrow>
+       Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
+                               if abs r > D then if k = 0 \<and> D dvd r then D else r gmod D else r 
+                   else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
+                               if abs r > D then r gmod D else r
+                   else A$$(i,k)
+            ))" using assms by auto
+  also have "... = ?rhs_abs" unfolding reduce.simps Let_def 
+    by (rule eq_matI, insert pquvd) (metis (no_types, lifting) split_conv)+
+  finally show "reduce_abs a b D A = ?rhs_abs" .
+qed
+
+lemma reduce_preserves_dimensions:
+  shows [simp]: "dim_row (reduce a b D A) = dim_row A" 
+    and [simp]: "dim_col (reduce a b D A) = dim_col A"
+  and [simp]: "dim_row (reduce_abs a b D A) = dim_row A" 
+    and [simp]: "dim_col (reduce_abs a b D A) = dim_col A"
+  by (auto simp add: Let_def split_beta)
+
+lemma reduce_carrier:
+  assumes "A \<in> carrier_mat m n"
+  shows "(reduce a b D A) \<in> carrier_mat m n" 
+    and "(reduce_abs a b D A) \<in> carrier_mat m n" 
+  by (insert assms, auto simp add: Let_def split_beta)
+
+lemma reduce_gcd: 
+  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" 
+  and Aaj: "A $$ (a,0) \<noteq> 0"
+shows "(reduce a b D A) $$ (a,0) = (let r = gcd (A$$(a,0)) (A$$(b,0)) in if D dvd r then D else r)" (is "?lhs = ?rhs")
+  and "(reduce_abs a b D A) $$ (a,0) = (let r = gcd (A$$(a,0)) (A$$(b,0)) in if D < r then
+                      if D dvd r then D else r gmod D else r)" (is "?lhs_abs = ?rhs_abs")
+proof -
+  obtain p q u v d where pquvd: "euclid_ext2 (A$$(a,0)) (A$$(b,0)) = (p,q,u,v,d)"
+    using prod_cases5 by blast
+  have "p * A $$ (a, 0) + q * A $$ (b, 0) = d" 
+    using Aaj pquvd is_bezout_ext_euclid_ext2 unfolding is_bezout_ext_def 
+    by (smt Pair_inject bezout_coefficients_fst_snd euclid_ext2_def)
+  also have " ... = gcd (A$$(a,0)) (A$$(b,0))" by (metis euclid_ext2_def pquvd prod.sel(2))
+  finally have pAaj_qAbj_gcd: "p * A $$ (a, 0) + q * A $$ (b, 0) = gcd (A$$(a,0)) (A$$(b,0))" .
+  let ?f = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if k = 0 then if D dvd r then D else r else r gmod D
+              else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in if k = 0 then r else r gmod D else A $$ (i, k))"
+  have "(reduce a b D A) $$ (a,0) = Matrix.mat (dim_row A) (dim_col A) ?f $$ (a, 0)"
+    using Aaj pquvd by auto 
+  also have "... = (let r = p * A $$ (a, 0) + q * A $$ (b, 0) in if (0::nat) = 0 then if D dvd r then D else r else r gmod D)"
+    using A a j by auto
+  also have "... = (if D dvd gcd (A$$(a,0)) (A$$(b,0)) then D else 
+      gcd (A$$(a,0)) (A$$(b,0)))" 
+    by (simp add: pAaj_qAbj_gcd)
+  finally show "?lhs = ?rhs" by auto
+  let ?g = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in 
+                if D < \<bar>r\<bar> then if k = 0 \<and> D dvd r then D else r gmod D else r
+              else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
+                    if D < \<bar>r\<bar> then r gmod D else r else A $$ (i, k))"
+  have "(reduce_abs a b D A) $$ (a,0) = Matrix.mat (dim_row A) (dim_col A) ?g $$ (a, 0)"
+    using Aaj pquvd by auto 
+  also have "... = (let r = p * A $$ (a, 0) + q * A $$ (b, 0) in if D < \<bar>r\<bar> then
+            if (0::nat) = 0 \<and> D dvd r then D else r gmod D else r)"
+    using A a j by auto
+  also have "... = (if D < \<bar>gcd (A$$(a,0)) (A$$(b,0))\<bar> then if D dvd gcd (A$$(a,0)) (A$$(b,0)) then D else 
+      gcd (A$$(a,0)) (A$$(b,0)) gmod D else gcd (A$$(a,0)) (A$$(b,0)))"
+    by (simp add: pAaj_qAbj_gcd)
+  finally show "?lhs_abs = ?rhs_abs" by auto
+qed
+
+
+
+
+lemma reduce_preserves: 
+  assumes A: "A \<in> carrier_mat m n" and j: "j<n" 
+  and Aaj: "A $$ (a,0) \<noteq> 0" and ib: "i\<noteq>b" and ia: "i\<noteq>a" and im: "i<m"
+shows "(reduce a b D A) $$ (i,j) = A $$ (i,j)"  (is "?thesis1")
+and "(reduce_abs a b D A) $$ (i,j) = A $$ (i,j)" (is "?thesis2") 
+proof -
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
+    using prod_cases5 by metis
+  show ?thesis1 unfolding reduce_alt_def_not0[OF Aaj pquvd] using ia im j A ib by auto
+  show ?thesis2 unfolding reduce_alt_def_not0[OF Aaj pquvd] using ia im j A ib by auto
+qed
+
+
+lemma reduce_0: 
+  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a \<noteq> b"
+  and Aaj: "A $$ (a,0) \<noteq> 0"
+  and D: "D \<ge> 0" 
+shows "(reduce a b D A) $$ (b,0) = 0" (is "?thesis1")
+and "(reduce_abs a b D A) $$ (b,0) = 0" (is "?thesis2")
+proof -
+  obtain p q u v d where pquvd: "euclid_ext2 (A$$(a,0)) (A$$(b,0)) = (p,q,u,v,d)"
+    using prod_cases5 by blast
+  hence u: "u = - (A$$(b,0)) div gcd (A$$(a,0)) (A$$(b,0))"
+    using euclid_ext2_works[OF pquvd] by auto
+  have v: "v = A$$(a,0) div gcd (A$$(a,0)) (A$$(b,0))" using euclid_ext2_works[OF pquvd] by auto
+  have uv0: "u * A$$(a,0) + v * A$$(b,0) = 0" using u v
+  proof -
+    have "\<forall>i ia. gcd (ia::int) i * (ia div gcd ia i) = ia"
+    by (meson dvd_mult_div_cancel gcd_dvd1)
+    then have "v * - A $$ (b, 0) = u * A $$ (a, 0)"
+      by (metis (no_types) dvd_minus_iff dvd_mult_div_cancel gcd_dvd2 minus_minus mult.assoc mult.commute u v)
+    then show ?thesis
+      by simp
+  qed
+  let ?f = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in 
+            if k = 0 then if D dvd r then D else r else r gmod D
+              else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
+                   if k = 0 then r else r gmod D else A $$ (i, k))" 
+  have "(reduce a b D A) $$ (b,0) = Matrix.mat (dim_row A) (dim_col A) ?f $$ (b, 0)"
+    using Aaj pquvd by auto 
+  also have "... = (let r = u * A$$(a,0) + v * A$$(b,0) in r)"
+    using A a j ab b by auto
+  also have "... = 0" using uv0 D 
+    by (smt (z3) gmod_0(1) gmod_0(2)) 
+  finally show ?thesis1 .
+  let ?g = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in 
+          if D < \<bar>r\<bar> then if k = 0 \<and> D dvd r then D else r gmod D else r
+              else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
+                  if D < \<bar>r\<bar> then r gmod D else r else A $$ (i, k))" 
+  have "(reduce_abs a b D A) $$ (b,0) = Matrix.mat (dim_row A) (dim_col A) ?g $$ (b, 0)"
+    using Aaj pquvd by auto 
+  also have "... = (let r = u * A$$(a,0) + v * A$$(b,0) in if D < \<bar>r\<bar> then r gmod D else r)"
+    using A a j ab b by auto
+  also have "... = 0" using uv0 D by simp
+  finally show ?thesis2 .
+qed
+end
+
+
+text \<open>Let us show the key lemma: operations modulo determinant don't modify the (integer) row span.\<close>
+
+context LLL_with_assms
+begin
+
+lemma lattice_of_kId_subset_fs_init: 
+  assumes k_det: "k = Determinant.det (mat_of_rows n fs_init)"
+  and mn: "m=n"
+  shows "lattice_of (Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m))) \<subseteq> lattice_of fs_init"
+proof -
+  let ?Z = "(mat_of_rows n fs_init)"
+  let ?RAT = "of_int_hom.mat_hom :: int mat \<Rightarrow> rat mat"
+  have RAT_fs_init: "?RAT (mat_of_rows n fs_init) \<in> carrier_mat n n"
+      using len map_carrier_mat mat_of_rows_carrier(1) mn by blast
+  have det_RAT_fs_init: "Determinant.det (?RAT ?Z) \<noteq> 0"
+  proof (rule gs.lin_indpt_rows_imp_det_not_0[OF RAT_fs_init])   
+    have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init"
+      by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows)
+    thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" 
+      by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def)
+    show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))"
+      using rw cof_vec_space.lin_indpt_list_def lin_dep by auto
+  qed
+  obtain inv_Z where inverts_Z: "inverts_mat (?RAT ?Z) inv_Z" and inv_Z: "inv_Z \<in> carrier_mat m m"
+    by (metis mn det_RAT_fs_init dvd_field_iff invertible_iff_is_unit_JNF
+        len map_carrier_mat mat_of_rows_carrier(1) obtain_inverse_matrix)
+  have det_rat_Z_k: "Determinant.det (?RAT ?Z) = rat_of_int k"
+    using k_det of_int_hom.hom_det by blast
+  have "?RAT ?Z *  adj_mat (?RAT ?Z) = Determinant.det (?RAT ?Z) \<cdot>\<^sub>m 1\<^sub>m n" 
+    by (rule adj_mat[OF RAT_fs_init])
+  hence "inv_Z * (?RAT ?Z *  adj_mat (?RAT ?Z)) = inv_Z * (Determinant.det (?RAT ?Z) \<cdot>\<^sub>m 1\<^sub>m n)" by simp
+  hence k_inv_Z_eq_adj: "(rat_of_int k) \<cdot>\<^sub>m inv_Z = adj_mat (?RAT ?Z)"
+    by (smt Determinant.mat_mult_left_right_inverse RAT_fs_init adj_mat(1,3) mn 
+        carrier_matD det_RAT_fs_init det_rat_Z_k gs.det_nonzero_congruence inv_Z inverts_Z 
+        inverts_mat_def mult_smult_assoc_mat smult_carrier_mat)
+  have adj_mat_Z: "adj_mat (?RAT ?Z) $$ (i,j) \<in> \<int>" if i: "i<m" and j: "j<n" for i j
+  proof -
+    have det_mat_delete_Z: "Determinant.det (mat_delete (?RAT ?Z) j i) \<in> \<int>"
+    proof (rule Ints_det)
+      fix ia ja
+      assume ia: "ia < dim_row  (mat_delete (?RAT ?Z) j i)"
+        and ja: "ja < dim_col  (mat_delete (?RAT ?Z) j i)"
+      have "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) =  (?RAT ?Z) $$ (insert_index j ia, insert_index i ja)"        
+        by (rule mat_delete_index[symmetric], insert i j mn len ia ja RAT_fs_init, auto)
+      also have "... = rat_of_int (?Z $$ (insert_index j ia, insert_index i ja))"
+        by (rule index_map_mat, insert i j ia ja, auto simp add: insert_index_def)
+      also have "... \<in> \<int>" using Ints_of_int by blast
+      finally show "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) \<in> \<int>" .
+    qed
+    have "adj_mat (?RAT ?Z) $$ (i,j) = Determinant.cofactor (?RAT ?Z) j i"
+      unfolding adj_mat_def
+      by (simp add: len i j)
+    also have "... =  (- 1) ^ (j + i) * Determinant.det (mat_delete (?RAT ?Z) j i)"
+      unfolding Determinant.cofactor_def by auto
+    also have "... \<in> \<int>" using det_mat_delete_Z by auto
+    finally show ?thesis .
+  qed                
+  have kinvZ_in_Z: "((rat_of_int k) \<cdot>\<^sub>m inv_Z) $$ (i,j) \<in> \<int>" if i: "i<m" and j: "j<n" for i j
+    using k_inv_Z_eq_adj by (simp add: adj_mat_Z i j)
+  have "?RAT (k \<cdot>\<^sub>m (1\<^sub>m m)) = Determinant.det (?RAT ?Z) \<cdot>\<^sub>m (inv_Z * ?RAT ?Z)" (is "?lhs = ?rhs")
+  proof - 
+    have "(inv_Z * ?RAT ?Z) = (1\<^sub>m m)"
+      by (metis Determinant.mat_mult_left_right_inverse RAT_fs_init mn carrier_matD(1)
+          inv_Z inverts_Z inverts_mat_def)
+    from this have "?rhs = rat_of_int k \<cdot>\<^sub>m (1\<^sub>m m)" using det_rat_Z_k by auto
+    also have "... = ?lhs" by auto
+    finally show ?thesis ..
+  qed
+  also have "... = (Determinant.det (?RAT ?Z) \<cdot>\<^sub>m inv_Z) * ?RAT ?Z"
+    by (metis RAT_fs_init mn inv_Z mult_smult_assoc_mat)
+  also have "... = ((rat_of_int k) \<cdot>\<^sub>m inv_Z) * ?RAT ?Z" by (simp add: k_det)
+  finally have r': "?RAT (k \<cdot>\<^sub>m (1\<^sub>m m)) = ((rat_of_int k) \<cdot>\<^sub>m inv_Z) * ?RAT ?Z" .
+  have r: "(k \<cdot>\<^sub>m (1\<^sub>m m)) = ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z))) * ?Z"
+  proof -
+    have "?RAT ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z))) = ((rat_of_int k) \<cdot>\<^sub>m inv_Z)"
+    proof (rule eq_matI, auto)
+      fix i j assume i: "i < dim_row inv_Z" and j: "j < dim_col inv_Z"
+      have "((rat_of_int k) \<cdot>\<^sub>m inv_Z) $$ (i,j) =  (rat_of_int k * inv_Z $$ (i, j))"
+        using index_smult_mat i j by auto
+      hence kinvZ_in_Z': "... \<in> \<int>" using kinvZ_in_Z i j inv_Z mn by simp
+      show "rat_of_int (int_of_rat (rat_of_int k * inv_Z $$ (i, j))) = rat_of_int k * inv_Z $$ (i, j)" 
+        by (rule int_of_rat, insert kinvZ_in_Z', auto)
+    qed
+    hence "?RAT (k \<cdot>\<^sub>m (1\<^sub>m m)) = ?RAT ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z))) * ?RAT ?Z"
+      using r' by simp
+    also have "... = ?RAT ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) * ?Z)"
+      by (metis RAT_fs_init adj_mat(1) k_inv_Z_eq_adj map_carrier_mat of_int_hom.mat_hom_mult)
+    finally show ?thesis by (rule of_int_hom.mat_hom_inj)
+  qed
+  show ?thesis
+  proof (rule mat_mult_sub_lattice[OF _ fs_init])
+    have rw: "of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) 
+      = map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)" by auto
+    have "mat_of_rows n (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) = (k \<cdot>\<^sub>m (1\<^sub>m m))" 
+      by (metis mn index_one_mat(3) index_smult_mat(3) mat_of_rows_rows)
+    also have "... = of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) * mat_of_rows n fs_init" 
+       using r rw by auto 
+    finally show "mat_of_rows n (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) 
+      = of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) * mat_of_rows n fs_init" .
+   show "set (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> carrier_vec n"using mn unfolding Matrix.rows_def by auto
+   show "map_mat int_of_rat (rat_of_int k \<cdot>\<^sub>m inv_Z) \<in> carrier_mat (length (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m))) (length fs_init)"
+     using len fs_init by (simp add: inv_Z)
+  qed
+qed
+
+end
+
+context LLL_with_assms
+begin
+
+
+lemma lattice_of_append_det_preserves:  
+  assumes k_det: "k = abs (Determinant.det (mat_of_rows n fs_init))"
+  and mn: "m = n"
+  and A: "A = (mat_of_rows n fs_init) @\<^sub>r (k \<cdot>\<^sub>m (1\<^sub>m m))"
+shows "lattice_of (Matrix.rows A) = lattice_of fs_init"
+proof -
+  have "Matrix.rows (mat_of_rows n fs_init @\<^sub>r k \<cdot>\<^sub>m 1\<^sub>m m) = (Matrix.rows (mat_of_rows n fs_init) @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))"
+    by (rule rows_append_rows, insert fs_init len mn, auto)
+  also have "... = (fs_init @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))" by (simp add: fs_init)
+  finally have rw: "Matrix.rows (mat_of_rows n fs_init @\<^sub>r k \<cdot>\<^sub>m 1\<^sub>m m) 
+    = (fs_init @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))" .
+  have "lattice_of (Matrix.rows A) = lattice_of (fs_init @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))"
+    by (rule arg_cong[of _ _ lattice_of], auto simp add: A rw)
+  also have "... = lattice_of fs_init" 
+  proof (cases "k = Determinant.det (mat_of_rows n fs_init)")
+    case True
+    then show ?thesis 
+    by (rule already_in_lattice_append[symmetric, OF fs_init 
+             lattice_of_kId_subset_fs_init[OF _ mn]], insert mn, auto simp add: Matrix.rows_def)
+  next
+    case False
+    hence k2: "k = -Determinant.det (mat_of_rows n fs_init)" using k_det by auto
+    have l: "lattice_of (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> lattice_of fs_init"
+      by (rule lattice_of_kId_subset_fs_init[OF _ mn], insert k2, auto)
+    have l2: "lattice_of (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) = lattice_of (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m))" 
+    proof (rule mat_mult_invertible_lattice_eq)
+      let ?P = "(- 1::int) \<cdot>\<^sub>m 1\<^sub>m m"
+      show P: "?P \<in> carrier_mat m m" by simp
+      have "det ?P = 1 \<or> det ?P = -1" unfolding det_smult by (auto simp add: minus_1_power_even)
+      hence "det ?P dvd 1" by (smt minus_dvd_iff one_dvd)
+      thus " invertible_mat ?P" unfolding invertible_iff_is_unit_JNF[OF P] .
+      have "(- k \<cdot>\<^sub>m 1\<^sub>m m) = ?P * (k \<cdot>\<^sub>m 1\<^sub>m m)"
+        unfolding mat_diag_smult[symmetric] unfolding mat_diag_diag by auto
+      thus " mat_of_rows n (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) = of_int_hom.mat_hom ?P * mat_of_rows n (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m))"
+        by (metis mn index_one_mat(3) index_smult_mat(3) mat_of_rows_rows of_int_mat_hom_int_id)
+      show " set (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> carrier_vec n"
+        and "set (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> carrier_vec n"
+        using assms(2) one_carrier_mat set_rows_carrier smult_carrier_mat by blast+
+    qed (insert mn, auto)
+    hence l2: "lattice_of (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> lattice_of fs_init" using l by auto
+    show ?thesis by (rule already_in_lattice_append[symmetric, OF fs_init l2],
+          insert mn one_carrier_mat set_rows_carrier smult_carrier_mat, blast)
+  qed  
+  finally show ?thesis .
+qed
+
+text \<open>This is another key lemma.
+Here, $A$ is the initial matrix @{text "(mat_of_rows n fs_init)"} augmented with $m$ rows 
+$(k,0,\dots,0),(0,k,0,\dots,0), \dots , (0,\dots,0,k)$ where $k$ is the determinant of 
+@{text "(mat_of_rows n fs_init)"}. 
+With the algorithm of the article, we obtain @{text "H = H' @\<^sub>r (0\<^sub>m m n)"} by means of an invertible 
+matrix $P$ (which is computable). Then, $H$ is the HNF of $A$.
+The lemma shows that $H'$ is the HNF of @{text "(mat_of_rows n fs_init)"}
+and that there exists an invertible matrix to carry out the transformation.\<close>
+
+lemma Hermite_append_det_id:
+  assumes k_det: "k = abs (Determinant.det (mat_of_rows n fs_init))"
+  and mn: "m = n"
+  and A: "A = (mat_of_rows n fs_init) @\<^sub>r (k \<cdot>\<^sub>m (1\<^sub>m m))"
+  and H': "H'\<in> carrier_mat m n"
+  and H_append: "H = H' @\<^sub>r (0\<^sub>m m n)"
+  and P: "P \<in> carrier_mat (m+m) (m+m)"
+  and inv_P: "invertible_mat P"
+  and A_PH: "A = P * H"
+  and HNF_H: "Hermite_JNF associates res H"
+shows "Hermite_JNF associates res H'" 
+  and "(\<exists>P'. invertible_mat P' \<and> P' \<in> carrier_mat m m \<and> (mat_of_rows n fs_init) = P' * H')"
+proof -
+  have A_carrier: "A \<in> carrier_mat (m+m) n" using A mn len by auto
+  let ?A' = "(mat_of_rows n fs_init)"
+  let ?H' = "submatrix H {0..<m} {0..<n}"
+  have nm: "n\<le>m" by (simp add: mn) 
+  have H: "H \<in> carrier_mat (m + m) n" using H_append H' by auto
+  have submatrix_carrier: "submatrix H {0..<m} {0..<n} \<in> carrier_mat m n"
+    by (rule submatrix_carrier_first[OF H], auto)
+  have H'_eq: "H' = ?H'"
+  proof (rule eq_matI)
+    fix i j assume i: "i < dim_row ?H'" and j: "j < dim_col ?H'"
+    have im: "i<m" and jn: "j<n" using i j submatrix_carrier by auto
+    have "?H' $$ (i,j) = H $$ (i,j)"
+      by (rule submatrix_index_id[OF H], insert i j submatrix_carrier, auto)
+    also have "... =  (if i < dim_row H' then H' $$ (i, j) else (0\<^sub>m m n) $$ (i - m, j))"
+      unfolding H_append by (rule append_rows_nth[OF H'], insert im jn, auto)
+    also have "... = H' $$ (i,j)" using H' im jn by simp
+    finally show "H' $$ (i, j) = ?H' $$ (i, j)" ..
+  qed (insert H' submatrix_carrier, auto)  
+  show HNF_H': "Hermite_JNF associates res H'"
+    unfolding H'_eq mn by (rule HNF_submatrix[OF HNF_H H], insert nm, simp)
+  have L_fs_init_A: "lattice_of (fs_init) = lattice_of (Matrix.rows A)" 
+    by (rule lattice_of_append_det_preserves[symmetric, OF k_det mn A])
+  have L_H'_H: "lattice_of (Matrix.rows H') = lattice_of (Matrix.rows H)"
+    using H_append H' lattice_of_append_zero_rows by blast
+  have L_A_H: "lattice_of (Matrix.rows A) = lattice_of (Matrix.rows H)"
+  proof (rule mat_mult_invertible_lattice_eq[OF _ _ P inv_P])
+    show "set (Matrix.rows A) \<subseteq> carrier_vec n" using A_carrier set_rows_carrier by blast
+    show "set (Matrix.rows H) \<subseteq> carrier_vec n" using H set_rows_carrier by blast
+    show "length (Matrix.rows A) = m + m" using A_carrier by auto      
+    show "length (Matrix.rows H) = m + m" using H by auto
+    show "mat_of_rows n (Matrix.rows A) = of_int_hom.mat_hom P * mat_of_rows n (Matrix.rows H)"      
+      by (metis A_carrier H A_PH carrier_matD(2) mat_of_rows_rows of_int_mat_hom_int_id)
+  qed
+  have L_fs_init_H': "lattice_of fs_init = lattice_of (Matrix.rows H')"
+    using L_fs_init_A L_A_H L_H'_H by auto
+  have exists_P2: 
+      "\<exists>P2. P2 \<in> carrier_mat n n \<and> invertible_mat P2 \<and> mat_of_rows n  (Matrix.rows H') = P2 * H'"
+    by (rule exI[of _ "1\<^sub>m n"], insert H' mn, auto)
+  have exist_P': "\<exists>P'\<in>carrier_mat n n. invertible_mat P' 
+      \<and> mat_of_rows n fs_init = P' * mat_of_rows n (Matrix.rows H')"
+    by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init _ lin_dep len[unfolded mn] _ L_fs_init_H'],
+        insert H' mn set_rows_carrier, auto)
+  thus "\<exists>P'. invertible_mat P' \<and> P' \<in> carrier_mat m m \<and> (mat_of_rows n fs_init) = P' * H'"
+    by (metis mn H' carrier_matD(2) mat_of_rows_rows)
+qed
+end
+
+
+
+context proper_mod_operation
+begin
+
+(* Perform the modulo D operation to reduce the element A$$(a,j), assuming A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m m))*)
+definition "reduce_element_mod_D (A::int mat) a j D m =  
+  (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
+  else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
+
+definition "reduce_element_mod_D_abs (A::int mat) a j D m =  
+  (if j = 0 \<and> D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A 
+  else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
+
+lemma reduce_element_mod_D_preserves_dimensions:
+  shows [simp]: "dim_row (reduce_element_mod_D A a j D m) = dim_row A" 
+    and [simp]: "dim_col (reduce_element_mod_D A a j D m) = dim_col A"
+    and [simp]: "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row A" 
+    and [simp]: "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col A"
+  by (auto simp add: reduce_element_mod_D_def reduce_element_mod_D_abs_def Let_def split_beta)
+
+lemma reduce_element_mod_D_carrier:
+  shows "reduce_element_mod_D A a j D m \<in> carrier_mat (dim_row A) (dim_col A)" 
+    and "reduce_element_mod_D_abs A a j D m \<in> carrier_mat (dim_row A) (dim_col A)" by auto
+
+
+lemma reduce_element_mod_D_invertible_mat:
+  assumes A_def: "A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m\<ge>n"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
+    and "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
+  unfolding atomize_conj
+proof (rule conjI; cases "j = 0 \<and> D dvd A$$(a,j)")
+  case True
+  let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D) + 1) a (j + m)"
+  have A: "A \<in> carrier_mat (m + n) n" using A_def A' mn by auto
+  have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
+    unfolding reduce_element_mod_D_def using True by auto
+  also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+  finally have "reduce_element_mod_D A a j D m = ?P * A" .
+  moreover have P: "?P \<in> carrier_mat (m+n) (m+n)" by simp
+  moreover have inv_P: "invertible_mat ?P"
+    by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
+        invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
+  ultimately show ?thesis1 by blast
+  have "reduce_element_mod_D_abs A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
+    unfolding reduce_element_mod_D_abs_def using True by auto
+  also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+  finally have "reduce_element_mod_D_abs A a j D m = ?P * A" .
+  thus ?thesis2 using P inv_P by blast
+next
+  case False note nc1 = False
+  let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
+  have A: "A \<in> carrier_mat (m + n) n" using A_def A' mn by auto
+  have P: "?P \<in> carrier_mat (m+n) (m+n)" by simp
+  have inv_P: "invertible_mat ?P"
+    by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
+        invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
+  show ?thesis1
+  proof (cases "j = 0")
+    case True
+    have "reduce_element_mod_D A a j D m = A" 
+      unfolding reduce_element_mod_D_def using True nc1 by auto
+    thus ?thesis1
+      by (metis A_def A' carrier_append_rows invertible_mat_one 
+          left_mult_one_mat one_carrier_mat smult_carrier_mat)
+  next
+    case False   
+    have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
+      unfolding reduce_element_mod_D_def using False by auto
+    also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+    finally have "reduce_element_mod_D A a j D m = ?P * A" .    
+    thus ?thesis using P inv_P by blast
+  qed
+  have "reduce_element_mod_D_abs A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
+    unfolding reduce_element_mod_D_abs_def using False by auto
+  also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+  finally have "reduce_element_mod_D_abs A a j D m = ?P * A" .    
+  thus ?thesis2 using P inv_P by blast
+qed
+
+
+lemma reduce_element_mod_D_append:
+  assumes A_def: "A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m\<ge>n"
+shows "reduce_element_mod_D A a j D m 
+  = mat_of_rows n [Matrix.row (reduce_element_mod_D A a j D m) i. i \<leftarrow> [0..<m]] @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))" (is "?lhs = ?A' @\<^sub>r ?D")
+and "reduce_element_mod_D_abs A a j D m 
+  = mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a j D m) i. i \<leftarrow> [0..<m]] @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))" (is "?lhs_abs = ?A'_abs @\<^sub>r ?D")
+  unfolding atomize_conj
+proof (rule conjI; rule eq_matI)
+  let ?xs = "(map (Matrix.row (reduce_element_mod_D A a j D m)) [0..<m])"
+  let ?xs_abs = "(map (Matrix.row (reduce_element_mod_D_abs A a j D m)) [0..<m])"
+  have lhs_carrier: "?lhs \<in> carrier_mat (m+n) n"
+    and lhs_carrier_abs: "?lhs_abs \<in> carrier_mat (m+n) n"
+    by (metis (no_types, lifting) add.comm_neutral append_rows_def A_def A' carrier_matD 
+        carrier_mat_triv index_mat_four_block(2,3) index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) 
+        reduce_element_mod_D_preserves_dimensions)+
+  have map_A_carrier[simp]: "?A' \<in> carrier_mat m n" 
+    and map_A_carrier_abs[simp]: "?A'_abs \<in> carrier_mat m n"
+    by (simp add: mat_of_rows_def)+
+  have AD_carrier[simp]: "?A' @\<^sub>r ?D \<in> carrier_mat (m+n) n" 
+    and AD_carrier_abs[simp]: "?A'_abs @\<^sub>r ?D \<in> carrier_mat (m+n) n" 
+    by (rule carrier_append_rows, insert lhs_carrier mn, auto)
+  show "dim_row (?lhs) = dim_row (?A' @\<^sub>r ?D)"  and "dim_col (?lhs) = dim_col (?A' @\<^sub>r ?D)"
+    "dim_row (?lhs_abs) = dim_row (?A'_abs @\<^sub>r ?D)"  and "dim_col (?lhs_abs) = dim_col (?A'_abs @\<^sub>r ?D)"
+    using lhs_carrier lhs_carrier_abs AD_carrier AD_carrier_abs unfolding carrier_mat_def by simp+
+  show "?lhs $$ (i, ja) = (?A' @\<^sub>r ?D) $$ (i, ja)" if i: "i < dim_row (?A' @\<^sub>r ?D)" and ja: "ja < dim_col (?A' @\<^sub>r ?D)" for i ja
+  proof (cases "i<m")
+    case True
+    have ja_n: "ja < n"
+      by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3))
+    have "(?A' @\<^sub>r ?D) $$ (i, ja) = ?A' $$ (i,ja)"
+      by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i 
+          index_mat_four_block index_zero_mat(3) ja length_map length_upt mat_of_rows_carrier(2))
+    also have "... = ?xs ! i $v ja" 
+      by (rule mat_of_rows_index, insert i True ja , auto simp add: append_rows_def)
+    also have "... = ?lhs $$ (i,ja)"
+      by (rule map_first_rows_index, insert assms lhs_carrier True i ja_n, auto)
+    finally show ?thesis ..
+  next
+    case False
+    have ja_n: "ja < n"
+      by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3))
+    have "(?A' @\<^sub>r ?D) $$ (i, ja) =?D $$ (i-m,ja)"
+      by (smt False Nat.add_0_right map_A_carrier append_rows_def carrier_matD i 
+          index_mat_four_block index_zero_mat(3) ja_n)
+    also have "... = ?lhs $$ (i,ja)"
+      by (metis (no_types, lifting) False Nat.add_0_right map_A_carrier append_rows_def A_def A' a 
+          carrier_matD i index_mat_addrow(1) index_mat_four_block(1,2) index_zero_mat(3) ja_n 
+          lhs_carrier reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions)
+    finally show ?thesis ..
+  qed
+  fix i ja assume i: "i < dim_row (?A'_abs @\<^sub>r ?D)" and ja: "ja < dim_col (?A'_abs @\<^sub>r ?D)"
+  have ja_n: "ja < n"
+    by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3))
+  show "?lhs_abs $$ (i, ja) = (?A'_abs @\<^sub>r ?D) $$ (i, ja)"
+  proof (cases "i<m")
+    case True
+    have "(?A'_abs @\<^sub>r ?D) $$ (i, ja) = ?A'_abs $$ (i,ja)"
+      by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i 
+          index_mat_four_block index_zero_mat(3) ja length_map length_upt mat_of_rows_carrier(2))
+    also have "... = ?xs_abs ! i $v ja" 
+      by (rule mat_of_rows_index, insert i True ja , auto simp add: append_rows_def)
+    also have "... = ?lhs_abs $$ (i,ja)"
+      by (rule map_first_rows_index, insert assms lhs_carrier_abs True i ja_n, auto)
+    finally show ?thesis ..
+  next
+    case False
+    have "(?A'_abs @\<^sub>r ?D) $$ (i, ja) = ?D $$ (i-m,ja)"
+      by (smt False Nat.add_0_right map_A_carrier_abs append_rows_def carrier_matD i 
+          index_mat_four_block index_zero_mat(3) ja_n)
+    also have "... = ?lhs_abs $$ (i,ja)"
+      by (metis (no_types, lifting) False Nat.add_0_right map_A_carrier_abs append_rows_def A_def A' a 
+          carrier_matD i index_mat_addrow(1) index_mat_four_block(1,2) index_zero_mat(3) ja_n 
+          lhs_carrier_abs reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions)
+    finally show ?thesis ..
+  qed
+qed
+
+
+lemma reduce_append_rows_eq:
+  assumes A': "A' \<in> carrier_mat m n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))" and a: "a<m" and xm: "x<m" and "0<n"
+  and Aaj: "A $$ (a,0) \<noteq> 0" 
+  shows "reduce a x D A 
+  = mat_of_rows n [Matrix.row ((reduce a x D A)) i. i \<leftarrow> [0..<m]] @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" (is ?thesis1)
+  and "reduce_abs a x D A 
+  = mat_of_rows n [Matrix.row ((reduce_abs a x D A)) i. i \<leftarrow> [0..<m]] @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" (is ?thesis2)
+  unfolding atomize_conj
+proof (rule conjI; rule matrix_append_rows_eq_if_preserves)
+  let ?reduce_ax = "reduce a x D A"
+  let ?reduce_abs = "reduce_abs a x D A"
+ obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+   by (metis prod_cases5)
+  have A: "A: carrier_mat (m+n) n" by (simp add: A_def A')
+  show D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" and "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp+
+  show "?reduce_ax \<in> carrier_mat (m + n) n"  "?reduce_abs \<in> carrier_mat (m + n) n"
+    by (metis Nat.add_0_right append_rows_def A' A_def carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2) index_zero_mat(3) reduce_preserves_dimensions)+
+  show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
+    and "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_abs $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)"
+    unfolding atomize_conj
+  proof (rule conjI; rule+)
+    fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+    have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
+    have i_not_a: "i \<noteq> a" using i a by auto
+    have i_not_x: "i \<noteq> x" using i xm by auto
+    have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
+      unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
+    also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
+      by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
+    finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
+    have "?reduce_abs $$ (i,ja) = A $$ (i,ja)" 
+      unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
+    also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
+      by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
+    finally show "?reduce_abs $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
+  qed
+qed
+
+fun reduce_row_mod_D
+  where "reduce_row_mod_D A a [] D m = A" |
+        "reduce_row_mod_D A a (x # xs) D m = reduce_row_mod_D (reduce_element_mod_D A a x D m) a xs D m"
+
+fun reduce_row_mod_D_abs
+  where "reduce_row_mod_D_abs A a [] D m = A" |
+        "reduce_row_mod_D_abs A a (x # xs) D m = reduce_row_mod_D_abs (reduce_element_mod_D_abs A a x D m) a xs D m"
+
+
+lemma reduce_row_mod_D_preserves_dimensions:
+  shows [simp]: "dim_row (reduce_row_mod_D A a xs D m) = dim_row A" 
+    and [simp]: "dim_col (reduce_row_mod_D A a xs D m) = dim_col A"
+  by (induct A a xs D m rule: reduce_row_mod_D.induct, auto)
+  
+lemma reduce_row_mod_D_preserves_dimensions_abs:
+  shows [simp]: "dim_row (reduce_row_mod_D_abs A a xs D m) = dim_row A" 
+    and [simp]: "dim_col (reduce_row_mod_D_abs A a xs D m) = dim_col A"
+  by (induct A a xs D m rule: reduce_row_mod_D_abs.induct, auto)
+
+lemma reduce_row_mod_D_invertible_mat:
+  assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n" and mn: "m\<ge>n"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_row_mod_D A a xs D m = P * A"
+  using assms
+proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D.induct)
+  case (1 A a D m)
+  show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
+next
+  case (2 A a x xs D m)
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have 1: "reduce_row_mod_D A a (x # xs) D m 
+    = reduce_row_mod_D ?reduce_xs a xs D m" by simp
+  have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D A a x D m = P * A" 
+    by (rule reduce_element_mod_D_invertible_mat, insert "2.prems", auto)
+  from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
+    and R_P: "reduce_element_mod_D A a x D m = P * A" by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
+    show "reduce_element_mod_D A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      by (rule reduce_element_mod_D_append, insert "2.prems", auto)
+  qed (insert "2.prems", auto)   
+  from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
+    and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs"
+    by auto
+  have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
+  moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
+  moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" 
+    by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
+        index_mult_mat reduce_row_mod_D_preserves_dimensions)
+  ultimately show ?case by blast
+qed
+
+
+lemma reduce_row_mod_D_abs_invertible_mat:
+  assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n" and mn: "m\<ge>n"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_row_mod_D_abs A a xs D m = P * A"
+  using assms
+proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D_abs.induct)
+  case (1 A a D m)
+  show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
+next
+  case (2 A a x xs D m)
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
+    = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
+  have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D_abs A a x D m = P * A" 
+    by (rule reduce_element_mod_D_invertible_mat, insert "2.prems", auto)
+  from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
+    and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
+    show "reduce_element_mod_D_abs A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      by (rule reduce_element_mod_D_append, insert "2.prems", auto)
+  qed (insert "2.prems", auto)   
+  from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
+    and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs"
+    by auto
+  have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
+  moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
+  moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" 
+    by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
+        index_mult_mat reduce_row_mod_D_preserves_dimensions_abs)
+  ultimately show ?case by blast
+qed
+end
+
+context proper_mod_operation
+begin
+lemma dvd_gdiv_mult_left[simp]: assumes "b > 0" "b dvd a" shows "b * (a gdiv b) = a"
+  using dvd_gdiv_mult_right[OF assms] by (auto simp: ac_simps)
+
+
+lemma reduce_element_mod_D:
+  assumes A_def: "A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" and mn: "m\<ge>n"
+  and D: "D > 0" 
+  shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k) 
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A")
+    and "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
+      (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) then D else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A_abs")
+unfolding atomize_conj
+proof (rule conjI; rule eq_matI)
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'  by simp
+  have dr: "dim_row ?A = dim_row ?A_abs" and dc: "dim_col ?A = dim_col ?A_abs" by auto
+  have 1: "reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" (is ?thesis1)
+    and 2: "reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A_abs $$ (i, ja)" (is ?thesis2)
+    if i: "i < dim_row ?A" and ja: "ja < dim_col ?A" for i ja
+    unfolding atomize_conj
+  proof (rule conjI; cases "i=a")
+    case False
+    have "reduce_element_mod_D A a j D m = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A 
+    else A
+    else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
+      unfolding reduce_element_mod_D_def by simp
+    also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto     
+    also have "... = ?A $$ (i,ja)" using False using i ja by auto
+    finally show ?thesis1 .
+    have "reduce_element_mod_D_abs A a j D m $$ (i,ja) = A $$ (i, ja)"
+      unfolding reduce_element_mod_D_abs_def mat_addrow_def using False ja i by auto     
+    also have "... = ?A_abs $$ (i,ja)" using False using i ja by auto
+    finally show ?thesis2 .
+  next
+    case True note ia = True
+    have "reduce_element_mod_D A a j D m 
+      = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
+        else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
+      unfolding reduce_element_mod_D_def by simp
+    also have "... $$ (i,ja) = ?A $$ (i,ja)"
+    proof (cases "ja = j")
+      case True note ja_j = True
+      have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto)       
+      also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
+      also have "... = D" by (simp add: True j mn)
+      finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd A$$(a,j)")
+        case True         
+        have 1: "reduce_element_mod_D A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
+          using True ia ja_j unfolding reduce_element_mod_D_def by auto
+        also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
+          unfolding mat_addrow_def using True ja_j ia
+          using A i j by auto
+        also have "... = D"
+        proof -
+          have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
+            using True ia ja_j D by force
+          then show ?thesis
+            by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
+                ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
+        qed   
+        also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto
+        finally show ?thesis
+          using True 1 by auto
+      next
+        case False
+        show ?thesis
+        proof (cases "ja=0")
+          case True
+          then show ?thesis
+            using False i ja ja_j by force
+        next
+          case False
+        have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
+        also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
+          by (subst gmod_gdiv[OF D], auto)
+        also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
+          unfolding A_ja_jaD by (simp add: True ia)
+        finally show ?thesis 
+          using A False True i ia j by auto
+      qed
+    qed
+  next
+      case False
+      have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto)       
+      also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
+      also have "... = 0" using False using A a mn ja j by force        
+      finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
+      then show ?thesis using False i ja by fastforce
+    qed
+    finally show ?thesis1 .
+    have "reduce_element_mod_D_abs A a j D m 
+      = (if j = 0 \<and> D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A
+        else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
+      unfolding reduce_element_mod_D_abs_def by simp
+    also have "... $$ (i,ja) = ?A_abs $$ (i,ja)"
+    proof (cases "ja = j")
+      case True note ja_j = True
+      have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto)       
+      also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
+      also have "... = D" by (simp add: True j mn)
+      finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd A$$(a,j)")
+        case True         
+        have 1: "reduce_element_mod_D_abs A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
+          using True ia ja_j unfolding reduce_element_mod_D_abs_def by auto
+        also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
+          unfolding mat_addrow_def using True ja_j ia
+          using A i j by auto
+        also have "... = D"
+        proof -
+          have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
+            using True ia ja_j D by force
+          then show ?thesis
+            by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
+                ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
+        qed   
+        also have "... = ?A_abs $$ (i,ja)" using True ia A i j ja_j by auto
+        finally show ?thesis
+          using True 1 by auto
+      next
+        case False
+        have i: "i<dim_row ?A_abs" and ja: "ja<dim_col ?A_abs" using i ja by auto
+        have "?A_abs $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
+        also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
+          by (subst gmod_gdiv[OF D], auto)
+        also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
+          unfolding A_ja_jaD by (simp add: True ia)
+        finally show ?thesis 
+          using A False True i ia j by auto
+      qed    
+  next
+      case False
+      have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto)       
+      also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
+      also have "... = 0" using False using A a mn ja j by force        
+      finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
+      then show ?thesis using False i ja by fastforce
+    qed
+    finally show ?thesis2 .  
+  qed
+  from this
+  show "\<And>i ja. i<dim_row ?A \<Longrightarrow> ja < dim_col ?A \<Longrightarrow> reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" 
+    and "\<And>i ja. i<dim_row ?A_abs \<Longrightarrow> ja < dim_col ?A_abs \<Longrightarrow> reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A_abs $$ (i, ja)" 
+    using dr dc by auto
+next
+  show "dim_row (reduce_element_mod_D A a j D m) = dim_row ?A" 
+    and "dim_col (reduce_element_mod_D A a j D m) = dim_col ?A"
+    "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row ?A_abs" 
+    and "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col ?A_abs"
+    by auto
+qed
+
+
+lemma reduce_row_mod_D:
+  assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n"
+    and d: "distinct xs" and "m\<ge>n"
+    and "D > 0" 
+  shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd A$$(i,k) 
+           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))"
+  using assms
+proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D.induct)
+  case (1 A a D m)
+  then show ?case by force
+next
+  case (2 A a x xs D m)
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have 1: "reduce_row_mod_D A a (x # xs) D m 
+    = reduce_row_mod_D ?reduce_xs a xs D m" by simp
+  have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k)
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j<n" for j
+    by (rule reduce_element_mod_D, insert "2.prems" that, auto)
+  have "reduce_row_mod_D ?reduce_xs a xs D m =
+    Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs then 
+    if k=0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k)
+    else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
+    show "reduce_element_mod_D A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      by (rule reduce_element_mod_D_append, insert "2.prems", auto)
+  qed (insert "2.prems", auto)
+  also have "... = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k)
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
+  proof (rule eq_matI) 
+    show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
+    fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
+    have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
+    have xn: "x < n" by (simp add: "2.prems"(4))
+    show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    proof (cases "i=a \<and> j \<in> set xs")
+      case True note ia_jxs = True
+      have j_not_x: "j\<noteq>x"
+        using "2.prems"(5) True by auto
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
+        case True
+        have "?lhs $$ (i,j) = D"
+          using True i j ia_jxs by auto
+        also have "... = ?rhs $$ (i,j)" using i j j_not_x 
+          by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
+        finally show ?thesis .
+      next
+        case False note nc1 = False
+        show ?thesis
+        proof (cases "j=0")
+          case True
+          then show ?thesis
+            by (smt (z3) "2" False case_prod_conv dim_col_mat(1) dim_row_mat(1) i index_mat(1) j j_not_x xn)
+        next
+          case False          
+      have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
+        using True False i j by auto
+      also have "... = A $$ (i,j) gmod D" using 2[OF xn] j_not_x i j by auto
+      also have "... = ?rhs $$ (i,j)" using i j j_not_x \<open>D > 0\<close>        
+        using False True dim_col_mat(1) dim_row_mat(1) index_mat(1) list.set_intros(2) old.prod.case
+        by auto
+      finally show ?thesis .
+    qed
+  qed
+  next
+      case False
+      show ?thesis using 2 i j xn 
+        by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
+    qed   
+  qed  
+  finally show ?case using 1 by simp
+qed
+
+
+
+
+lemma reduce_row_mod_D_abs:
+  assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n"
+    and d: "distinct xs" and "m\<ge>n"
+    and "D > 0" 
+  shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
+             (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd A$$(i,k)
+              then D else A$$(i,k) gmod D else A$$(i,k))"
+  using assms
+proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D_abs.induct)
+  case (1 A a D m)
+  then show ?case by force
+next
+  case (2 A a x xs D m)
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
+    = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
+  have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
+  (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) then D 
+    else A$$(i,k) gmod D else A$$(i,k))" if "j<n" for j
+    by (rule reduce_element_mod_D, insert "2.prems" that, auto)
+  have "reduce_row_mod_D_abs ?reduce_xs a xs D m =
+    Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs then 
+    if k=0 \<and> D dvd ?reduce_xs $$ (i, k) then D
+    else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
+    show "reduce_element_mod_D_abs A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      by (rule reduce_element_mod_D_append, insert "2.prems", auto)
+  qed (insert "2.prems", auto)
+  also have "... = Matrix.mat (dim_row A) (dim_col A)
+            (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 \<and> D dvd A$$(i,k)
+            then D else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
+  proof (rule eq_matI) 
+    show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
+    fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
+    have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
+    have xn: "x < n" by (simp add: "2.prems"(4))
+    show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    proof (cases "i=a \<and> j \<in> set xs")
+      case True note ia_jxs = True
+      have j_not_x: "j\<noteq>x"
+        using "2.prems"(5) True by auto
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
+        case True
+        have "?lhs $$ (i,j) = D"
+          using True i j ia_jxs by auto
+        also have "... = ?rhs $$ (i,j)" using i j j_not_x 
+          by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
+        finally show ?thesis .
+      next
+        case False 
+      have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
+        using True False i j by auto
+      also have "... = A $$ (i,j) gmod D" using 2[OF xn] j_not_x i j by auto
+      also have "... = ?rhs $$ (i,j)" using i j j_not_x \<open>D > 0\<close>  
+        using "2" False True dim_col_mat(1) dim_row_mat(1) index_mat(1) list.set_intros(2) 
+          old.prod.case xn by auto     
+      finally show ?thesis .
+    qed  
+  next
+      case False
+      show ?thesis using 2 i j xn 
+        by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
+    qed   
+  qed  
+  finally show ?case using 1 by simp
+qed
+end
+
+
+text \<open>Now, we prove some transfer rules to connect B\'ezout matrices in HOL Analysis and JNF\<close>
+(*Connecting Bezout Matrix in HOL Analysis (thm bezout_matrix_def) and JNF (thm bezout_matrix_JNF_def)*)
+lemma HMA_bezout_matrix[transfer_rule]:
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: {bezout_ring} ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
+  ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow> 'm \<Rightarrow> _) ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow> 'm \<Rightarrow> _) 
+  ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow> 'n \<Rightarrow> _) ===> (=) ===> (Mod_Type_Connect.HMA_M)) 
+  (bezout_matrix_JNF) (bezout_matrix)" 
+proof (intro rel_funI, goal_cases)
+  case (1 A A' a a' b b' j j' bezout bezout')
+  note HMA_AA'[transfer_rule] = "1"(1)
+  note HMI_aa'[transfer_rule] = "1"(2)
+  note HMI_bb'[transfer_rule] = "1"(3)
+  note HMI_jj'[transfer_rule] = "1"(4)
+  note eq_bezout'[transfer_rule] = "1"(5)
+  show ?case unfolding Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def 
+  proof (rule eq_matI) 
+    let ?A = "Matrix.mat CARD('m) CARD('m) (\<lambda>(i, j). bezout_matrix A' a' b' j' bezout' 
+        $h mod_type_class.from_nat i $h mod_type_class.from_nat j)"
+    show "dim_row (bezout_matrix_JNF A a b j bezout) = dim_row ?A"
+      and "dim_col (bezout_matrix_JNF A a b j bezout) = dim_col ?A"
+      using Mod_Type_Connect.dim_row_transfer_rule[OF HMA_AA']
+      unfolding bezout_matrix_JNF_def by auto  
+    fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A"
+    let ?i = "mod_type_class.from_nat i :: 'm"
+    let ?ja = "mod_type_class.from_nat ja :: 'm"    
+    have i_A: "i < dim_row A"
+      using HMA_AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce
+    have ja_A: "ja < dim_row A"
+      using Mod_Type_Connect.dim_row_transfer_rule[OF HMA_AA'] ja by fastforce
+    have HMA_I_ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i"
+      unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq i by auto
+    have HMA_I_ja'[transfer_rule]: "Mod_Type_Connect.HMA_I ja ?ja"
+      unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq ja by auto
+    have Aaj: "A' $h a' $h j' = A $$ (a,j)" unfolding index_hma_def[symmetric] by (transfer, simp)
+    have Abj: "A' $h b' $h j' = A $$ (b, j)" unfolding index_hma_def[symmetric] by (transfer, simp) 
+    have "?A $$ (i, ja) = bezout_matrix A' a' b' j' bezout' $h ?i $h ?ja" using i ja by auto
+    also have "... = (let (p, q, u, v, d) = bezout' (A' $h a' $h j') (A' $h b' $h j')
+            in if ?i = a' \<and> ?ja = a' then p else if ?i = a' \<and> ?ja = b' then q else if ?i = b' \<and> ?ja = a' 
+            then u else if ?i = b' \<and> ?ja = b' then v else if ?i = ?ja then 1 else 0)" 
+      unfolding bezout_matrix_def by auto
+    also have "... =  (let 
+        (p, q, u, v, d) = bezout (A $$ (a, j)) (A $$ (b, j)) 
+       in
+         if i = a \<and> ja = a then p else
+         if i = a \<and> ja = b then q else
+         if i = b \<and> ja = a then u else
+         if i = b \<and> ja = b then v else
+         if i = ja then 1 else 0)" unfolding eq_bezout' Aaj Abj by (transfer, simp)
+    also have "... = bezout_matrix_JNF A a b j bezout $$ (i,ja)"
+      unfolding bezout_matrix_JNF_def using i_A ja_A by auto
+    finally show "bezout_matrix_JNF A a b j bezout $$ (i, ja) = ?A $$ (i, ja)" ..
+  qed
+qed
+
+(*thm invertible_bezout_matrix must be transferred from HOL Analysis to JNF*)
+
+context
+begin
+
+private lemma invertible_bezout_matrix_JNF_mod_type:
+  fixes A::"'a::{bezout_ring_div} mat"
+  assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
+  assumes ib: "is_bezout_ext bezout"
+  and a_less_b: "a < b" and b: "b<CARD('m)" and j: "j<CARD('n)"
+  and aj: "A $$ (a, j) \<noteq> 0"
+shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
+proof -
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: 'a ^'n :: mod_type ^'m :: mod_type)"
+  define a' where "a' = (Mod_Type.from_nat a :: 'm)"
+  define b' where "b' = (Mod_Type.from_nat b :: 'm)"
+  define j' where "j' = (Mod_Type.from_nat j :: 'n)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
+    unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto
+  have aa'[transfer_rule]: "Mod_Type_Connect.HMA_I a a'"
+    unfolding Mod_Type_Connect.HMA_I_def a'_def using assms
+    using from_nat_not_eq order.strict_trans by blast
+  have bb'[transfer_rule]: "Mod_Type_Connect.HMA_I b b'"
+    unfolding Mod_Type_Connect.HMA_I_def b'_def using assms
+    using from_nat_not_eq order.strict_trans by blast
+  have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j j'"
+    unfolding Mod_Type_Connect.HMA_I_def j'_def using assms
+    using from_nat_not_eq order.strict_trans by blast
+  have [transfer_rule]: "bezout = bezout" ..
+  have [transfer_rule]: "Mod_Type_Connect.HMA_M (bezout_matrix_JNF A a b j bezout) 
+      (bezout_matrix A' a' b' j' bezout)"
+    by transfer_prover
+  have "invertible (bezout_matrix A' a' b' j' bezout)"
+  proof (rule invertible_bezout_matrix[OF ib])
+    show "a' < b'" using a_less_b by (simp add: a'_def b b'_def from_nat_mono)
+    show "A' $h a' $h j' \<noteq> 0" unfolding index_hma_def[symmetric] using aj by (transfer, simp)
+  qed
+  thus ?thesis by (transfer, simp)
+qed 
+
+private lemma invertible_bezout_matrix_JNF_nontriv_mod_ring:
+  fixes A::"'a::{bezout_ring_div} mat"
+  assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
+  assumes ib: "is_bezout_ext bezout"
+  and a_less_b: "a < b" and b: "b<CARD('m)" and j: "j<CARD('n)"
+  and aj: "A $$ (a, j) \<noteq> 0"
+shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
+  using assms invertible_bezout_matrix_JNF_mod_type by (smt CARD_mod_ring) 
+
+
+(*We internalize both sort constraints in one step*)
+lemmas invertible_bezout_matrix_JNF_internalized = 
+  invertible_bezout_matrix_JNF_nontriv_mod_ring[unfolded CARD_mod_ring, 
+      internalize_sort "'m::nontriv", internalize_sort "'c::nontriv"]
+
+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 invertible_bezout_matrix_JNF_nontriv_mod_ring_aux:
+  fixes A::"'a::{bezout_ring_div} mat"
+  assumes "A \<in> carrier_mat m n"
+  assumes ib: "is_bezout_ext bezout"
+  and a_less_b: "a < b" and b: "b<m" and j: "j<n"
+  and aj: "A $$ (a, j) \<noteq> 0"
+shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
+  using invertible_bezout_matrix_JNF_internalized[OF type_to_set2(1) type_to_set(1), where ?'aa = 'b]
+  using assms 
+  using type_to_set1(2) type_to_set2(2) local_typedef1 m by blast
+end
+
+
+(*Canceling the first local type definitions*)
+context
+begin
+
+(*Canceling the first*)
+private lemma invertible_bezout_matrix_JNF_cancelled_first:
+"\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> {0..<int m} \<noteq> {} \<Longrightarrow>
+1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
+(A::'a::bezout_ring_div mat) \<in> carrier_mat m n \<Longrightarrow> is_bezout_ext bezout 
+\<Longrightarrow> a < b \<Longrightarrow> b < m \<Longrightarrow> j < n \<Longrightarrow> A $$ (a, j) \<noteq> 0 \<Longrightarrow> invertible_mat (bezout_matrix_JNF A a b j bezout)"
+  using invertible_bezout_matrix_JNF_nontriv_mod_ring_aux[cancel_type_definition] by blast
+
+(*Canceling the second*)
+private lemma invertible_bezout_matrix_JNF_cancelled_both:
+"{0..<int n} \<noteq> {} \<Longrightarrow> {0..<int m} \<noteq> {} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
+1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
+(A::'a::bezout_ring_div mat) \<in> carrier_mat m n \<Longrightarrow> is_bezout_ext bezout 
+\<Longrightarrow> a < b \<Longrightarrow> b < m \<Longrightarrow> j < n \<Longrightarrow> A $$ (a, j) \<noteq> 0 \<Longrightarrow> invertible_mat (bezout_matrix_JNF A a b j bezout)"
+  using invertible_bezout_matrix_JNF_cancelled_first[cancel_type_definition] by blast
+
+(*The final result in JNF*)
+lemma invertible_bezout_matrix_JNF':
+  fixes A::"'a::{bezout_ring_div} mat"
+  assumes "A \<in> carrier_mat m n"
+  assumes ib: "is_bezout_ext bezout"
+  and a_less_b: "a < b" and b: "b<m" and j: "j<n" 
+  and "n>1" (* Required from the mod_type restrictions*)
+  and aj: "A $$ (a, j) \<noteq> 0"
+shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
+  using invertible_bezout_matrix_JNF_cancelled_both assms by auto
+
+(*Trick: we want to get rid out the "n>1" assumption, which has appeared since CARD('m::mod_type)>1.
+Given an mx1 matrix, we just append another column and the bezout_matrix is the same, so it will
+also be invertible by the previous transfered theorem
+*)
+lemma invertible_bezout_matrix_JNF_n1:
+  fixes A::"'a::{bezout_ring_div} mat"
+  assumes A: "A \<in> carrier_mat m n"
+  assumes ib: "is_bezout_ext bezout"
+  and a_less_b: "a < b" and b: "b<m" and j: "j<n" 
+  and n1: "n=1" (* Required from the mod_type restrictions*)
+  and aj: "A $$ (a, j) \<noteq> 0"
+shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
+proof -
+  let ?A = "A @\<^sub>c (0\<^sub>m m n)"
+  have "(A @\<^sub>c 0\<^sub>m m n) $$ (a, j) =  (if j < dim_col A then A $$ (a, j) else (0\<^sub>m m n) $$ (a, j - n))"     
+    by (rule append_cols_nth[OF A], insert assms, auto)
+  also have "... = A $$ (a,j)" using assms by auto
+  finally have Aaj: "(A @\<^sub>c 0\<^sub>m m n) $$ (a, j) =  A $$ (a,j)" .
+  have "(A @\<^sub>c 0\<^sub>m m n) $$ (b, j) =  (if j < dim_col A then A $$ (b, j) else (0\<^sub>m m n) $$ (b, j - n))"     
+    by (rule append_cols_nth[OF A], insert assms, auto)
+  also have "... = A $$ (b,j)" using assms by auto
+  finally have Abj: "(A @\<^sub>c 0\<^sub>m m n) $$ (b, j) = A $$ (b, j)" .
+  have dr: "dim_row A = dim_row ?A"  by (simp add: append_cols_def)
+  have dc: "dim_col ?A = 2"
+    by (metis Suc_1 append_cols_def A n1 carrier_matD(2) index_mat_four_block(3) 
+        index_zero_mat(3) plus_1_eq_Suc)
+  have bz_eq: "bezout_matrix_JNF A a b j bezout = bezout_matrix_JNF ?A a b j bezout"
+    unfolding bezout_matrix_JNF_def Aaj Abj dr by auto
+  have "invertible_mat (bezout_matrix_JNF ?A a b j bezout)"
+    by (rule invertible_bezout_matrix_JNF', insert assms Aaj Abj dr dc, auto)
+  thus ?thesis using bz_eq by simp
+qed
+
+(*The final result in JNF without requiring n>1*)
+corollary invertible_bezout_matrix_JNF:
+  fixes A::"'a::{bezout_ring_div} mat"
+  assumes "A \<in> carrier_mat m n"
+  assumes ib: "is_bezout_ext bezout"
+  and a_less_b: "a < b" and b: "b<m" and j: "j<n" 
+  and aj: "A $$ (a, j) \<noteq> 0"
+shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
+  using invertible_bezout_matrix_JNF_n1 invertible_bezout_matrix_JNF' assms
+  by (metis One_nat_def gr_implies_not0 less_Suc0 not_less_iff_gr_or_eq)
+
+end
+end
+
+text \<open>We continue with the soundness of the algorithm\<close>
+
+lemma bezout_matrix_JNF_mult_eq:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a\<le>m"  and b: "b\<le>m" and ab: "a \<noteq> b" 
+  and A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat n n"
+  assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))"
+  shows "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k)
+            ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A")
+proof (rule eq_matI) 
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' B by simp
+  hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto  
+  show dr: "dim_row ?A = dim_row (?BM * A)" and dc: "dim_col ?A = dim_col (?BM * A)"
+    unfolding bezout_matrix_JNF_def by auto
+  fix i ja assume i: "i < dim_row  (?BM * A)" and ja: "ja < dim_col (?BM * A)"
+  let ?f = "\<lambda>ia. (bezout_matrix_JNF A a b j euclid_ext2) $$ (i,ia) * A $$ (ia,ja)"
+  have dv: "dim_vec (col A ja) = m+n" using A by auto
+  have i_dr: "i<dim_row A" using i A unfolding bezout_matrix_JNF_def by auto
+  have a_dr: "a<dim_row A" using A a ja by auto
+  have b_dr: "b<dim_row A" using A b ja by auto
+  show "?A $$ (i,ja) = (?BM * A) $$ (i,ja)"
+  proof -
+    have "(?BM * A) $$ (i,ja) = Matrix.row ?BM i \<bullet> col A ja"
+      by (rule index_mult_mat, insert i ja, auto)
+    also have "... = (\<Sum>ia = 0..<dim_vec (col A ja). 
+          Matrix.row (bezout_matrix_JNF A a b j euclid_ext2) i $v ia * col A ja $v ia)"
+      by (simp add: scalar_prod_def)
+    also have "... = (\<Sum>ia = 0..<m+n. ?f ia)"
+      by (rule sum.cong, insert A i dr dc, auto) (smt bezout_matrix_JNF_def carrier_matD(1) 
+          dim_col_mat(1) index_col index_mult_mat(3) index_row(1) ja)
+    also have "... = (\<Sum>ia \<in> ({a,b} \<union> ({0..<m+n} - {a,b})). ?f ia)"
+      by (rule sum.cong, insert a a_dr b A ja, auto)
+    also have "... = sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b})" 
+      by (rule sum.union_disjoint, auto)
+    finally have BM_A_ija_eq: "(?BM * A) $$ (i,ja) = sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b})" by auto
+    show ?thesis
+    proof (cases "i = a")
+      case True
+      have sum0: "sum ?f ({0..<m+n} - {a,b}) = 0"
+      proof (rule sum.neutral, rule)
+        fix x assume x: "x \<in> {0..<m + n} - {a, b}"
+        hence xm: "x < m+n" by auto
+        have x_not_i: "x \<noteq> i" using True x by blast
+        have x_dr: "x < dim_row A" using x A by auto
+        have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
+          unfolding bezout_matrix_JNF_def 
+          unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
+        thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
+      qed
+      have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = p" 
+        unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True pquvd 
+        by (auto, metis split_conv)
+      have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = q"
+        unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True pquvd ab
+        by (auto, metis split_conv)
+      have "sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
+      also have "... = p * A $$ (a, ja) + q * A $$ (b, ja)" unfolding fa fb by simp
+      also have "... = ?A $$ (i,ja)" using A True dr i ja by auto
+      finally show ?thesis using BM_A_ija_eq by simp
+    next
+      case False note i_not_a = False
+      show ?thesis
+      proof (cases "i=b")
+        case True
+        have sum0: "sum ?f ({0..<m+n} - {a,b}) = 0"
+        proof (rule sum.neutral, rule)
+          fix x assume x: "x \<in> {0..<m + n} - {a, b}"
+          hence xm: "x < m+n" by auto
+          have x_not_i: "x \<noteq> i" using True x by blast
+          have x_dr: "x < dim_row A" using x A by auto
+          have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
+            unfolding bezout_matrix_JNF_def 
+            unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
+          thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
+        qed
+        have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = u" 
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True i_not_a pquvd 
+          by (auto, metis split_conv)
+        have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = v"
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True i_not_a pquvd ab
+          by (auto, metis split_conv)
+        have "sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
+        also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" unfolding fa fb by simp
+        also have "... = ?A $$ (i,ja)" using A True i_not_a dr i ja by auto
+        finally show ?thesis using BM_A_ija_eq by simp
+      next
+        case False note i_not_b = False
+        have sum0: "sum ?f ({0..<m+n} - {a,b} - {i}) = 0" 
+        proof (rule sum.neutral, rule)
+          fix x assume x: "x \<in> {0..<m + n} - {a, b} - {i}"
+          hence xm: "x < m+n" by auto
+          have x_not_i: "x \<noteq> i" using x by blast
+          have x_dr: "x < dim_row A" using x A by auto
+          have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
+            unfolding bezout_matrix_JNF_def 
+            unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
+          thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
+        qed
+        have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = 0" 
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using False i_not_a pquvd 
+          by auto
+        have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = 0" 
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using False i_not_a pquvd 
+          by auto
+        have "sum ?f ({0..<m+n} - {a,b}) = sum ?f (insert i ({0..<m+n} - {a,b} - {i}))"
+          by (rule sum.cong, insert i_dr A i_not_a i_not_b, auto)
+        also have "... = ?f i + sum ?f ({0..<m+n} - {a,b} - {i})" by (rule sum.insert, auto)
+        also have "... = ?f i" using sum0 by simp
+        also have "... = ?A $$ (i,ja)"
+          unfolding bezout_matrix_JNF_def using i_not_a i_not_b  A dr i ja by fastforce
+        finally show ?thesis unfolding BM_A_ija_eq by (simp add: ab fa fb)
+      qed    
+    qed
+  qed
+qed
+
+
+
+
+context proper_mod_operation
+begin
+
+lemma reduce_invertible_mat: 
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a \<noteq> b" 
+  and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and Aaj: "A $$ (a,0) \<noteq> 0"
+  and a_less_b: "a < b"
+  and mn: "m\<ge>n"
+  and D_ge0: "D > 0"
+shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce a b D A) = P * A" (is ?thesis1)
+proof -
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
+    by (metis prod_cases5)
+  let ?A = "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k)
+            )"
+  have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' by simp
+  hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
+
+  let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" 
+  have A'_BZ_A: "?A = ?BM * A"
+    by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def D pquvd], insert a b, auto)  
+  have invertible_bezout: "invertible_mat ?BM"
+    by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ j Aaj],
+        insert a_less_b b, auto)      
+  have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
+
+  define xs where "xs = [0..<n]"
+  let ?reduce_a = "reduce_row_mod_D ?A a xs D m"
+  let ?A' = "mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
+  have A_A'_D: "?A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+)
+    fix i j assume i: "i \<in> {m..<m + n}" and j: "j < n"
+    have "?A $$ (i,j) = A $$ (i,j)" using i a b A j by auto
+    also have "... = (if i < dim_row A' then A' $$(i,j) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,j))"
+      by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto)
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" using i A' by auto
+    finally show "?A $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" .   
+  qed
+  have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
+    (\<lambda>(i, k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd ?A$$(i,k) then D
+              else ?A $$ (i, k) else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
+    by (rule reduce_row_mod_D[OF A_A'_D _ a _], insert xs_def mn D_ge0, auto)  
+  have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n"  using reduce_a_eq A by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
+    by (rule reduce_row_mod_D_invertible_mat[OF A_A'_D _ a], insert xs_def mn, auto)    
+  from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
+    and reduce_a_PA: "?reduce_a = P * ?A" by blast
+  define ys where "ys = [1..<n]"
+  let ?reduce_b = "reduce_row_mod_D ?reduce_a b ys D m"
+  let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
+  have reduce_a_B'_D: "?reduce_a = ?B' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+)
+    fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+    have i_not_a:"i\<noteq>a" and i_not_b: "i\<noteq>b" using i a b by auto
+    have "?reduce_a $$ (i,ja) = ?A $$ (i, ja)"
+      unfolding reduce_a_eq using i i_not_a i_not_b ja A by auto      
+    also have "... = A $$ (i,ja)"  using i i_not_a i_not_b ja A by auto
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)"
+      by (smt D append_rows_nth A' A_def atLeastLessThan_iff 
+          carrier_matD(1) i ja less_irrefl_nat nat_SN.compat)    
+    finally show "?reduce_a $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .
+  qed
+  have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
+    (\<lambda>(i, k). if i = b \<and> k \<in> set ys then if k = 0 then if D dvd ?reduce_a$$(i,k) then D else ?reduce_a $$ (i, k)
+      else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
+    by (rule reduce_row_mod_D[OF reduce_a_B'_D _ b _ _ mn], unfold ys_def, insert D_ge0, auto)
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
+    by (rule reduce_row_mod_D_invertible_mat[OF reduce_a_B'_D _ b _ mn], insert ys_def, auto)    
+  from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
+    and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
+  have reduce_b_eq_reduce: "?reduce_b = (reduce a b D A)"
+  proof (rule eq_matI)
+    show dr_eq: "dim_row ?reduce_b = dim_row (reduce a b D A)" 
+      and dc_eq: "dim_col ?reduce_b = dim_col (reduce a b D A)"
+      using reduce_preserves_dimensions by auto
+    fix i ja assume i: "i<dim_row (reduce a b D A)" and ja: "ja< dim_col (reduce a b D A)"
+    have im: "i<m+n" using A i reduce_preserves_dimensions(1) by auto
+    have ja_n: "ja<n" using A ja reduce_preserves_dimensions(2) by auto
+    show "?reduce_b $$ (i,ja) = (reduce a b D A) $$ (i,ja)"
+    proof (cases "(i\<noteq>a \<and> i\<noteq>b)")
+      case True
+      have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
+        by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions)
+      also have "... = ?A $$ (i,ja)"
+        by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
+            reduce_a_eq reduce_preserves_dimensions(1) split_conv)
+      also have "... = A $$ (i,ja)" using A True im ja_n by auto
+      also have "... = (reduce a b D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
+        using im ja_n A True by auto
+      finally show ?thesis .      
+    next
+      case False note a_or_b = False
+      show ?thesis
+      proof (cases "i=a")
+        case True note ia = True
+        hence i_not_b: "i\<noteq>b" using ab by auto
+        show ?thesis
+        proof -
+          have ja_in_xs: "ja \<in> set xs"
+            unfolding xs_def using True ja_n im a A unfolding set_filter by auto
+          have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
+                reduce_b_eq reduce_row_mod_D_preserves_dimensions(2))
+          show ?thesis 
+          proof (cases "ja = 0 \<and> D dvd p*A$$(a,ja) + q*A$$(b,ja)")
+            case True
+            have "?reduce_a $$ (i,ja) = D"
+              unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+            also have "... = (reduce a b D A) $$ (i,ja)"
+              unfolding reduce_alt_def_not0[OF Aaj pquvd]
+              using True a_or_b i_not_b ja_n im A False                
+              by auto 
+            finally show ?thesis using 1 by simp
+          next
+            case False note nc1 = False
+            show ?thesis
+            proof (cases "ja=0")
+              case True
+              then show ?thesis
+                by (smt (z3) "1" A assms(3) assms(7) dim_col_mat(1) dim_row_mat(1) euclid_ext2_works i ia im index_mat(1)
+                    ja ja_in_xs old.prod.case pquvd reduce_gcd reduce_preserves_dimensions reduce_a_eq)
+            next
+              case False
+              have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
+                unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+              also have "... = (reduce a b D A) $$ (i,ja)"
+                unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
+              finally show ?thesis using 1 by simp
+          qed    
+        qed        
+      qed
+      next
+        case False note i_not_a = False
+        have i_drb: "i<dim_row ?reduce_b"
+          and i_dra: "i<dim_row ?reduce_a"
+          and ja_drb: "ja < dim_col ?reduce_b"
+          and ja_dra: "ja < dim_col ?reduce_a" using reduce_carrier[OF A] i ja A dr_eq dc_eq by auto
+          have ib: "i=b" using False a_or_b by auto
+        show ?thesis
+        proof (cases "ja \<in> set  ys")
+          case True note ja_in_ys = True     
+          hence ja_not0: "ja \<noteq> 0" unfolding ys_def by auto
+          have "?reduce_b $$ (i,ja) = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D
+                else ?reduce_a $$ (i, ja) else ?reduce_a $$ (i, ja) gmod D)"
+            unfolding reduce_b_eq using i_not_a True  ja ja_in_ys 
+            by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
+          also have "... = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) else ?A $$ (i, ja) gmod D)"
+            unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto
+          also have "... = (reduce a b D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ja_not0 False a_or_b ib ja_n im A 
+            using i_not_a by auto                
+          finally show ?thesis .
+        next
+          case False
+          hence ja0:"ja = 0" using ja_n unfolding ys_def by auto
+          have rw0: "u * A $$ (a, ja) + v * A $$ (b, ja) = 0"
+            unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0
+            by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
+          have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt False a_or_b dc_eq dim_row_mat(1) dr_eq i index_mat(1) ja 
+                prod.simps(2) reduce_b_eq reduce_row_mod_D_preserves_dimensions(2))
+          also have "... = ?A $$ (i, ja)"
+            unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A  by auto
+          also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" 
+            by (smt (verit, ccfv_SIG) A \<open>ja = 0\<close> assms(3) assms(5) carrier_matD(2) i ib index_mat(1)
+                old.prod.case reduce_preserves_dimensions(1))  
+          also have "... = (reduce a b D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] 
+            using False a_or_b i_not_a ja_n im A ja0 by auto
+          finally show ?thesis .
+        qed
+      qed      
+    qed    
+  qed
+  have inv_QPBM: "invertible_mat (Q * P * ?BM)"
+    by (meson BM P Q inv_P inv_Q invertible_bezout invertible_mult_JNF mult_carrier_mat)
+  moreover have "(Q*P*?BM) \<in> carrier_mat (m + n) (m + n)" using BM P Q by auto
+  moreover have "(reduce a b D A) = (Q*P*?BM) * A"
+  proof -
+    have "?BM * A = ?A" using A'_BZ_A by auto
+    hence "P * (?BM * A) = ?reduce_a" using reduce_a_PA by auto
+    hence "Q * (P * (?BM * A)) = ?reduce_b" using reduce_b_Q_reduce by auto
+    thus ?thesis using reduce_b_eq_reduce
+      by (smt A A'_BZ_A A_carrier BM P Q assoc_mult_mat mn mult_carrier_mat reduce_a_PA)  
+  qed
+  ultimately show ?thesis by blast
+qed
+
+
+lemma reduce_abs_invertible_mat: 
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a \<noteq> b" 
+  and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and Aaj: "A $$ (a,0) \<noteq> 0"
+  and a_less_b: "a < b"
+  and mn: "m\<ge>n"
+  and D_ge0: "D > 0"
+shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a b D A) = P * A" (is ?thesis1)
+proof -
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
+    by (metis prod_cases5)
+  let ?A = "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k)
+            )"
+  have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' by simp
+  hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
+
+  let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" 
+  have A'_BZ_A: "?A = ?BM * A"
+    by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def D pquvd], insert a b, auto)  
+  have invertible_bezout: "invertible_mat ?BM"
+    by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ j Aaj],
+        insert a_less_b b, auto)      
+  have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
+
+  define xs where "xs = filter (\<lambda>i. abs (?A $$ (a,i)) > D) [0..<n]"
+  let ?reduce_a = "reduce_row_mod_D_abs ?A a xs D m"
+  let ?A' = "mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
+  have A_A'_D: "?A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+)
+    fix i j assume i: "i \<in> {m..<m + n}" and j: "j < n"
+    have "?A $$ (i,j) = A $$ (i,j)" using i a b A j by auto
+    also have "... = (if i < dim_row A' then A' $$(i,j) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,j))"
+      by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto)
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" using i A' by auto
+    finally show "?A $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" .   
+  qed
+  have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
+    (\<lambda>(i, k). if i = a \<and> k \<in> set xs then 
+      if k = 0 \<and> D dvd ?A$$(i,k) then D else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
+    by (rule reduce_row_mod_D_abs[OF A_A'_D _ a _], insert xs_def mn D_ge0, auto)  
+  have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n"  using reduce_a_eq A by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
+    by (rule reduce_row_mod_D_abs_invertible_mat[OF A_A'_D _ a], insert xs_def mn, auto)    
+  from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
+    and reduce_a_PA: "?reduce_a = P * ?A" by blast
+  define ys where "ys = filter (\<lambda>i. abs (?A $$ (b,i)) > D) [0..<n]"
+  let ?reduce_b = "reduce_row_mod_D_abs ?reduce_a b ys D m"
+  let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
+  have reduce_a_B'_D: "?reduce_a = ?B' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+)
+    fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+    have i_not_a:"i\<noteq>a" and i_not_b: "i\<noteq>b" using i a b by auto
+    have "?reduce_a $$ (i,ja) = ?A $$ (i, ja)"
+      unfolding reduce_a_eq using i i_not_a i_not_b ja A by auto      
+    also have "... = A $$ (i,ja)"  using i i_not_a i_not_b ja A by auto
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)"
+      by (smt D append_rows_nth A' A_def atLeastLessThan_iff 
+          carrier_matD(1) i ja less_irrefl_nat nat_SN.compat)    
+    finally show "?reduce_a $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .
+  qed
+  have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
+    (\<lambda>(i, k). if i = b \<and> k \<in> set ys then if k = 0 \<and> D dvd ?reduce_a$$(i,k) then D 
+      else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
+    by (rule reduce_row_mod_D_abs[OF reduce_a_B'_D _ b _ _ mn], unfold ys_def, insert D_ge0, auto)
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
+    by (rule reduce_row_mod_D_abs_invertible_mat[OF reduce_a_B'_D _ b _ mn], insert ys_def, auto)    
+  from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
+    and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
+  have reduce_b_eq_reduce: "?reduce_b = (reduce_abs a b D A)"
+  proof (rule eq_matI)
+    show dr_eq: "dim_row ?reduce_b = dim_row (reduce_abs a b D A)" 
+      and dc_eq: "dim_col ?reduce_b = dim_col (reduce_abs a b D A)"
+      using reduce_preserves_dimensions by auto
+    fix i ja assume i: "i<dim_row (reduce_abs a b D A)" and ja: "ja< dim_col (reduce_abs a b D A)"
+    have im: "i<m+n" using A i reduce_preserves_dimensions(3) by auto
+    have ja_n: "ja<n" using A ja reduce_preserves_dimensions(4) by auto
+    show "?reduce_b $$ (i,ja) = (reduce_abs a b D A) $$ (i,ja)"
+    proof (cases "(i\<noteq>a \<and> i\<noteq>b)")
+      case True
+      have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
+        by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions_abs)
+      also have "... = ?A $$ (i,ja)"
+        by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
+            reduce_a_eq reduce_preserves_dimensions(3) split_conv)
+      also have "... = A $$ (i,ja)" using A True im ja_n by auto
+      also have "... = (reduce_abs a b D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
+        using im ja_n A True by auto
+      finally show ?thesis .      
+    next
+      case False note a_or_b = False
+      show ?thesis
+      proof (cases "i=a")
+        case True note ia = True
+        hence i_not_b: "i\<noteq>b" using ab by auto
+        show ?thesis
+        proof (cases "abs((p*A$$(a,ja) + q*A$$(b,ja))) > D")
+          case True note ge_D = True
+          have ja_in_xs: "ja \<in> set xs"
+            unfolding xs_def using True ja_n im a A unfolding set_filter by auto
+          have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
+                reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
+          show ?thesis 
+          proof (cases "ja = 0 \<and> D dvd p*A$$(a,ja) + q*A$$(b,ja)")
+            case True
+            have "?reduce_a $$ (i,ja) = D"
+              unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+            also have "... = (reduce_abs a b D A) $$ (i,ja)"
+              unfolding reduce_alt_def_not0[OF Aaj pquvd]
+              using True a_or_b i_not_b ja_n im A False ge_D               
+              by auto 
+            finally show ?thesis using 1 by simp
+          next
+            case False
+            have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
+              unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+            also have "... = (reduce_abs a b D A) $$ (i,ja)"
+              unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
+            finally show ?thesis using 1 by simp
+          qed        
+        next
+          case False
+          have ja_in_xs: "ja \<notin> set xs"
+            unfolding xs_def using False ja_n im a A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
+                reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
+          also have "... = ?A $$ (i, ja)"
+            unfolding reduce_a_eq using False ab a_or_b i_not_b ja_n im a A ja_in_xs by auto
+          also have "... = (reduce_abs a b D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_b ja_n im A by auto
+          finally show ?thesis .
+        qed      
+      next
+        case False note i_not_a = False
+        have i_drb: "i<dim_row ?reduce_b"
+          and i_dra: "i<dim_row ?reduce_a"
+          and ja_drb: "ja < dim_col ?reduce_b"
+          and ja_dra: "ja < dim_col ?reduce_a" using reduce_carrier[OF A] i ja A dr_eq dc_eq by auto
+          have ib: "i=b" using False a_or_b by auto
+        show ?thesis
+        proof (cases "abs((u*A$$(a,ja) + v * A$$(b,ja))) > D")
+          case True note ge_D = True
+          have ja_in_ys: "ja \<in> set ys"
+            unfolding ys_def using True False ib ja_n im a b A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?reduce_a $$ (i, ja) gmod D)"          
+            unfolding reduce_b_eq using i_not_a True  ja ja_in_ys 
+            by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
+          also have "... = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) gmod D)"   
+            unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto
+          also have "... = (reduce_abs a b D A) $$ (i,ja)"
+          proof (cases "ja = 0 \<and> D dvd ?reduce_a$$(i,ja)")
+            case True
+            have ja0: "ja=0" using True by auto
+            have "u * A $$ (a, ja) + v * A $$ (b, ja) = 0"
+              unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0
+              by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
+            hence abs_0: "abs((u*A$$(a,ja) + v * A$$(b,ja))) = 0" by auto
+            show ?thesis using abs_0 D_ge0 ge_D by linarith           
+          next
+            case False
+            then show ?thesis 
+              unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ge_D False a_or_b ib ja_n im A 
+              using i_not_a by auto           
+          qed              
+          finally show ?thesis .
+        next
+          case False
+          have ja_in_ys: "ja \<notin> set ys"
+            unfolding ys_def using i_not_a False ib ja_n im a b A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq                         
+            using i_dra ja_dra ja_in_ys by auto
+          also have "... = ?A $$ (i, ja)"
+            unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A  by auto
+          also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" 
+            unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A ja_in_ys by auto            
+          also have "... = (reduce_abs a b D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] 
+            using False a_or_b i_not_a ja_n im A by auto
+          finally show ?thesis .
+        qed
+      qed      
+    qed    
+  qed
+  have inv_QPBM: "invertible_mat (Q * P * ?BM)"
+    by (meson BM P Q inv_P inv_Q invertible_bezout invertible_mult_JNF mult_carrier_mat)
+  moreover have "(Q*P*?BM) \<in> carrier_mat (m + n) (m + n)" using BM P Q by auto
+  moreover have "(reduce_abs a b D A) = (Q*P*?BM) * A"
+  proof -
+    have "?BM * A = ?A" using A'_BZ_A by auto
+    hence "P * (?BM * A) = ?reduce_a" using reduce_a_PA by auto
+    hence "Q * (P * (?BM * A)) = ?reduce_b" using reduce_b_Q_reduce by auto
+    thus ?thesis using reduce_b_eq_reduce
+      by (smt A A'_BZ_A A_carrier BM P Q assoc_mult_mat mn mult_carrier_mat reduce_a_PA)  
+  qed
+  ultimately show ?thesis by blast
+qed
+
+
+
+
+lemma reduce_element_mod_D_case_m':
+  assumes A_def: "A = A' @\<^sub>r  B" and B: "B\<in>carrier_mat n n"
+  and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" 
+  and mn: "m>=n" and B1: "B $$ (j, j) = D" and B2: "(\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
+  and D0: "D > 0" 
+  shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k) then D
+                   else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A")
+proof (rule eq_matI)
+  have jm: "j<m" using mn j by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
+  fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A"
+  show "reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)"
+ proof (cases "i=a")
+    case False
+    have "reduce_element_mod_D A a j D m = (if j = 0 then if D dvd A$$(a,j)
+        then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
+        else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
+      unfolding reduce_element_mod_D_def by simp
+    also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto     
+    also have "... = ?A $$ (i,ja)" using False using i ja by auto
+    finally show ?thesis .
+  next
+    case True note ia = True
+    have "reduce_element_mod_D A a j D m 
+      = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
+        else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
+      unfolding reduce_element_mod_D_def by simp
+    also have "... $$ (i,ja) = ?A $$ (i,ja)"
+    proof (cases "ja = j")
+      case True note ja_j = True
+      have "A $$ (j + m, ja) = B $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A B mn, auto)  
+      also have "... = D" using True j mn B1 B2 B by auto      
+      finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
+
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd A$$(a,j)")
+        case True         
+        have 1: "reduce_element_mod_D A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
+          using True ia ja_j unfolding reduce_element_mod_D_def by auto
+        also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
+          unfolding mat_addrow_def using True ja_j ia
+          using A i j by auto
+        also have "... = D"
+        proof -
+          have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
+            using True ia ja_j using D0 by force
+          then show ?thesis
+            by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
+                ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
+        qed   
+        also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto
+        finally show ?thesis
+          using True 1 by auto
+      next
+        case False
+        show ?thesis
+        proof (cases "j=0")
+          case True
+          then show ?thesis 
+            using False i ja by auto
+        next
+          case False
+          have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
+          also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
+            by (subst gmod_gdiv[OF D0], auto)
+          also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
+            unfolding A_ja_jaD by (simp add: True ia)
+          finally show ?thesis 
+            using A False True i ia j by auto
+      qed
+    qed
+    next
+      case False
+      have "A $$ (j + m, ja) = B $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A B, auto)
+      also have "... = 0" using False using A a mn ja j B2 by force        
+      finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
+      then show ?thesis using False i ja by fastforce
+    qed
+    finally show ?thesis .
+  qed
+next
+  show "dim_row (reduce_element_mod_D A a j D m) = dim_row ?A" 
+    and "dim_col (reduce_element_mod_D A a j D m) = dim_col ?A"
+    using reduce_element_mod_D_def by auto
+qed
+
+
+
+
+lemma reduce_element_mod_D_abs_case_m':
+  assumes A_def: "A = A' @\<^sub>r  B" and B: "B\<in>carrier_mat n n"
+  and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" 
+  and mn: "m>=n" and B1: "B $$ (j, j) = D" and B2: "(\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
+  and D0: "D > 0" 
+  shows "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) then D else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A")
+proof (rule eq_matI)
+  have jm: "j<m" using mn j by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
+  fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A"
+  show "reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A $$ (i, ja)"
+ proof (cases "i=a")
+    case False
+    have "reduce_element_mod_D_abs A a j D m = (if j = 0 \<and> D dvd A$$(a,j)
+        then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A
+        else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
+      unfolding reduce_element_mod_D_abs_def by simp
+    also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto     
+    also have "... = ?A $$ (i,ja)" using False using i ja by auto
+    finally show ?thesis .
+  next
+    case True note ia = True
+    have "reduce_element_mod_D_abs A a j D m 
+      = (if j = 0 \<and> D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A
+        else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
+      unfolding reduce_element_mod_D_abs_def by simp
+    also have "... $$ (i,ja) = ?A $$ (i,ja)"
+    proof (cases "ja = j")
+      case True note ja_j = True
+      have "A $$ (j + m, ja) = B $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A B mn, auto)  
+      also have "... = D" using True j mn B1 B2 B by auto      
+      finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
+
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd A$$(a,j)")
+        case True         
+        have 1: "reduce_element_mod_D_abs A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
+          using True ia ja_j unfolding reduce_element_mod_D_abs_def by auto
+        also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
+          unfolding mat_addrow_def using True ja_j ia
+          using A i j by auto
+        also have "... = D"
+        proof -
+          have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
+            using True ia ja_j using D0 by force
+          then show ?thesis
+            by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
+                ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
+        qed   
+        also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto
+        finally show ?thesis
+          using True 1 by auto
+      next
+        case False        
+          have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
+          also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
+            by (subst gmod_gdiv[OF D0], auto)
+          also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
+            unfolding A_ja_jaD by (simp add: True ia)
+          finally show ?thesis 
+            using A False True i ia j by auto
+        qed    
+    next
+      case False
+      have "A $$ (j + m, ja) = B $$ (j,ja)"
+        by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A B, auto)
+      also have "... = 0" using False using A a mn ja j B2 by force        
+      finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
+      then show ?thesis using False i ja by fastforce
+    qed
+    finally show ?thesis .
+  qed
+next
+  show "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row ?A" 
+    and "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col ?A"
+    using reduce_element_mod_D_abs_def by auto
+qed
+
+
+lemma reduce_row_mod_D_case_m':
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and "a < m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and d: "distinct xs" and "m\<ge>n"
+    and D: "D > 0" 
+  shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd A$$(i,k) then D
+                   else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
+  case (1 A a D m)
+  then show ?case by force
+next
+  case (2 A a x xs D m)
+  note A_A'B = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(7)
+  note d = "2.prems"(6)
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
+    by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
+            carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
+            reduce_element_mod_D_preserves_dimensions)
+  have 1: "reduce_row_mod_D A a (x # xs) D m 
+    = reduce_row_mod_D ?reduce_xs a xs D m" by simp
+  have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k) 
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
+    by (rule reduce_element_mod_D_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
+  have "reduce_row_mod_D ?reduce_xs a xs D m =
+    Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
+    then if k = 0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k) else
+    ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
+  proof (rule "2.hyps"[OF _ B _ a _ _ mn])
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
+    show "reduce_element_mod_D A a x D m = ?A' @\<^sub>r B"
+    proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B])
+      show " \<forall>i\<in>{m..<m + n}. \<forall>j<n. reduce_element_mod_D A a x D m $$ (i, j) = B $$ (i - m, j) "       
+        by (smt A_A'B A' B a Metric_Arith.nnf_simps(7) add_diff_cancel_left' atLeastLessThan_iff
+            carrier_matD index_mat_addrow(1) index_row(1) le_add_diff_inverse2 less_diff_conv
+            reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions reduce_xs_carrier
+            row_append_rows2)        
+    qed
+  qed (insert "2.prems", auto simp add: mat_of_rows_def)
+  also have "... = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k)
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
+  proof (rule eq_matI) 
+    show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
+    fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
+    have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
+    have xn: "x < n" 
+      by (simp add: "2.prems"(5))
+    show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    proof (cases "i=a \<and> j \<in> set xs")
+      case True note ia_jxs = True
+      have j_not_x: "j\<noteq>x" using d True by auto
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
+        case True
+        have "?lhs $$ (i,j) = D"
+          using True i j ia_jxs by auto
+        also have "... = ?rhs $$ (i,j)" using i j j_not_x 
+          by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
+        finally show ?thesis .
+      next
+        case False
+        show ?thesis
+        proof (cases "j=0")
+          case True
+          then show ?thesis
+            by (smt (z3) "2" dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j list.set(2) old.prod.case)
+        next
+          case False
+          have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
+            using True False i j by auto
+          also have "... = A $$ (i,j) gmod D" using 2[OF ] j_not_x i j by auto
+          also have "... = ?rhs $$ (i,j)" using i j j_not_x 
+            using False True dim_col_mat(1) dim_row_mat(1) index_mat(1) 
+              list.set_intros(2) old.prod.case by auto
+          finally show ?thesis .
+        qed
+    qed
+  next
+      case False
+      show ?thesis using 2 i j xn 
+        by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
+    qed   
+  qed  
+  finally show ?case using 1 by simp
+qed
+
+
+
+
+lemma reduce_row_mod_D_abs_case_m':
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and "a < m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and d: "distinct xs" and "m\<ge>n"
+    and D: "D > 0" 
+  shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd A$$(i,k) then D
+                   else A$$(i,k) gmod D else A$$(i,k))"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
+  case (1 A a D m)
+  then show ?case by force
+next
+  case (2 A a x xs D m)
+  note A_A'B = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(7)
+  note d = "2.prems"(6)
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
+    by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
+            carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
+            reduce_element_mod_D_preserves_dimensions)
+  have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
+    = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
+  have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
+           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) 
+            then D else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
+    by (rule reduce_element_mod_D_abs_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
+  have "reduce_row_mod_D_abs ?reduce_xs a xs D m =
+    Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
+    then if k = 0 \<and> D dvd ?reduce_xs $$ (i, k) then D else
+    ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
+  proof (rule "2.hyps"[OF _ B _ a _ _ mn])
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
+    show "reduce_element_mod_D_abs A a x D m = ?A' @\<^sub>r B"
+    proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B])
+      show " \<forall>i\<in>{m..<m + n}. \<forall>j<n. reduce_element_mod_D_abs A a x D m $$ (i, j) = B $$ (i - m, j) "       
+        by (smt A_A'B A' B a Metric_Arith.nnf_simps(7) add_diff_cancel_left' atLeastLessThan_iff
+            carrier_matD index_mat_addrow(1) index_row(1) le_add_diff_inverse2 less_diff_conv
+            reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions reduce_xs_carrier
+            row_append_rows2)        
+    qed
+  qed (insert "2.prems", auto simp add: mat_of_rows_def)
+  also have "... = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 \<and> D dvd A$$(i,k)
+          then D else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
+  proof (rule eq_matI) 
+    show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
+    fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
+    have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
+    have xn: "x < n" 
+      by (simp add: "2.prems"(5))
+    show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    proof (cases "i=a \<and> j \<in> set xs")
+      case True note ia_jxs = True
+      have j_not_x: "j\<noteq>x" using d True by auto
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
+        case True
+        have "?lhs $$ (i,j) = D"
+          using True i j ia_jxs by auto
+        also have "... = ?rhs $$ (i,j)" using i j j_not_x 
+          by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
+        finally show ?thesis .
+      next
+        case False        
+        have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
+         using True False i j by auto
+       also have "... = A $$ (i,j) gmod D" using 2[OF ] j_not_x i j by auto
+       also have "... = ?rhs $$ (i,j)" using i j j_not_x
+         by (smt False True \<open>Matrix.mat (dim_row ?reduce_xs) 
+           (dim_col ?reduce_xs) (\<lambda>(i, k). if i = a \<and> k \<in> set xs 
+           then if k = 0 \<and> D dvd  ?reduce_xs $$ (i, k) 
+           then D else  ?reduce_xs $$ (i, k) gmod D 
+           else  ?reduce_xs $$ (i, k)) $$ (i, j) =  ?reduce_xs $$ (i, j) gmod D\<close> 
+               calculation dim_col_mat(1) dim_row_mat(1) dvd_imp_gmod_0[OF \<open>D > 0\<close>] index_mat(1) 
+               insert_iff list.set(2) gmod_0_imp_dvd prod.simps(2))
+       finally show ?thesis .
+     qed   
+  next
+      case False
+      show ?thesis using 2 i j xn 
+        by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
+    qed   
+  qed  
+  finally show ?case using 1 by simp
+qed
+
+
+
+lemma
+  assumes A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat n n"
+  and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m\<ge>n"
+shows reduce_element_mod_D_invertible_mat_case_m: 
+  "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
+  and reduce_element_mod_D_abs_invertible_mat_case_m:
+  "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+      reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
+  unfolding atomize_conj
+proof (rule conjI; cases "j = 0 \<and> D dvd A$$(a,j)")
+  case True
+  let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D) + 1) a (j + m)"
+  have A: "A \<in> carrier_mat (m + n) n" using A_def A' B mn by auto
+  have "reduce_element_mod_D_abs A a j D m =  addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
+    unfolding reduce_element_mod_D_abs_def using True by auto
+  also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+  finally have rw: "reduce_element_mod_D_abs A a j D m = ?P * A" .
+  have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
+    unfolding reduce_element_mod_D_def using True by auto
+  also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+  finally have "reduce_element_mod_D A a j D m = ?P * A" .
+  moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
+  moreover have "invertible_mat ?P"
+    by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
+        invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
+  ultimately show ?thesis1 and ?thesis2 using rw by blast+
+next
+  case False
+  show ?thesis1
+  proof (cases "j=0")
+    case True
+    have "reduce_element_mod_D A a j D m = A" unfolding reduce_element_mod_D_def using False True by auto
+    then show ?thesis
+      by (metis A_def assms(2) assms(3) carrier_append_rows invertible_mat_one left_mult_one_mat one_carrier_mat)
+  next
+    case False
+    let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
+    have A: "A \<in> carrier_mat (m + n) n" using A_def B A' mn by auto
+    have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
+      unfolding reduce_element_mod_D_def using False by auto
+    also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+    finally have "reduce_element_mod_D A a j D m = ?P * A" .
+    moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
+    moreover have "invertible_mat ?P"
+      by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
+          invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
+    ultimately show ?thesis by blast
+  qed
+  show ?thesis2
+  proof -
+    let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
+    have A: "A \<in> carrier_mat (m + n) n" using A_def B A' mn by auto
+    have "reduce_element_mod_D_abs A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
+      unfolding reduce_element_mod_D_abs_def using False by auto
+    also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+    finally have "reduce_element_mod_D_abs A a j D m = ?P * A" .
+    moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
+    moreover have "invertible_mat ?P"
+      by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
+          invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
+    ultimately show ?thesis by blast
+  qed
+qed
+
+
+lemma reduce_row_mod_D_invertible_mat_case_m:
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and a: "a < m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and mn: "m\<ge>n"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_row_mod_D A a xs D m = P * A"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
+  case (1 A a D m)
+  show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
+next
+  case (2 A a x xs D m)
+  note A_def = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(6)  
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have 1: "reduce_row_mod_D A a (x # xs) D m 
+    = reduce_row_mod_D ?reduce_xs a xs D m" by simp
+  have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D A a x D m = P * A" 
+    by (rule reduce_element_mod_D_invertible_mat_case_m, insert "2.prems", auto)
+  from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
+    and R_P: "reduce_element_mod_D A a x D m = P * A" by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
+      \<and> reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
+    let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
+
+    show reduce_xs_A'B': "?reduce_xs = ?A' @\<^sub>r ?B'"
+      by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
+          index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(2))
+    show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
+    proof
+      fix j assume j_in_xs: "j \<in> set xs"
+      have jn: "j<n" using j_in_xs j by auto
+      have "?B' $$ (j, j) = ?reduce_xs $$ (m+j,j)"
+        by (smt "2"(7) Groups.add_ac(2) jn reduce_xs_A'B' add_diff_cancel_left' append_rows_nth2
+            diff_zero length_map length_upt mat_of_rows_carrier(1) nat_SN.compat)
+      also have "... = B $$ (j,j)" 
+        by (smt "2"(2) "2"(5) A' P R_P add_diff_cancel_left' append_rows_def carrier_matD
+            group_cancel.rule0 index_mat_addrow(1) index_mat_four_block(1) index_mat_four_block(2,3)
+            index_mult_mat(2) index_zero_mat(3) jn le_add1 linorder_not_less nat_SN.plus_gt_right_mono 
+            reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions(1))
+      also have "... = D" using j j_in_xs by auto
+      finally have B'_jj: "?B' $$ (j, j) = D" by auto
+      moreover have "\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0" 
+      proof 
+        fix j' assume j': "j' \<in>{0..<n} - {j}"
+        have "?B' $$ (j, j') = ?reduce_xs $$ (m+j,j')"
+          by (smt mn Diff_iff j' add.commute add_diff_cancel_left' 
+              append_rows_nth2 atLeastLessThan_iff diff_zero jn length_map length_upt 
+              mat_of_rows_carrier(1) nat_SN.compat reduce_xs_A'B')
+        also have "... = B $$ (j,j')"
+          by (smt "2"(2) "2"(5) A' Diff_iff P R_P j' add.commute add_diff_cancel_left'  
+            append_rows_def atLeastLessThan_iff carrier_matD group_cancel.rule0 index_mat_addrow(1)
+            index_mat_four_block index_mult_mat(2) index_zero_mat(3) jn nat_SN.plus_gt_right_mono 
+            not_add_less2 reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions(1))
+        also have "... = 0" using j j_in_xs j' by auto
+        finally show "?B' $$ (j, j') = 0" .
+      qed
+      ultimately show "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
+        using jn by blast
+    qed
+    show "?A' : carrier_mat m n" by auto      
+    show "?B' : carrier_mat n n" by auto
+    show "a<m" using "2.prems" by auto
+    show "n\<le>m" using "2.prems" by auto    
+  qed
+  from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
+    and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs"
+    by auto
+  have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
+  moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
+  moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" 
+    by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
+        index_mult_mat reduce_row_mod_D_preserves_dimensions)
+  ultimately show ?case by blast
+qed
+
+
+
+
+lemma reduce_row_mod_D_abs_invertible_mat_case_m:
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and a: "a < m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and mn: "m\<ge>n"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_row_mod_D_abs A a xs D m = P * A"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
+  case (1 A a D m)
+  show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
+next
+  case (2 A a x xs D m)
+  note A_def = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(6)  
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
+    = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
+  have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D_abs A a x D m = P * A" 
+    by (rule reduce_element_mod_D_abs_invertible_mat_case_m, insert "2.prems", auto)
+  from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
+    and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
+      \<and> reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
+    let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
+
+    show reduce_xs_A'B': "?reduce_xs = ?A' @\<^sub>r ?B'"
+      by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
+          index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(4))
+    show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
+    proof
+      fix j assume j_in_xs: "j \<in> set xs"
+      have jn: "j<n" using j_in_xs j by auto
+      have "?B' $$ (j, j) = ?reduce_xs $$ (m+j,j)"
+        by (smt "2"(7) Groups.add_ac(2) jn reduce_xs_A'B' add_diff_cancel_left' append_rows_nth2
+            diff_zero length_map length_upt mat_of_rows_carrier(1) nat_SN.compat)
+      also have "... = B $$ (j,j)" 
+        by (smt "2"(2) "2"(5) A' P R_P add_diff_cancel_left' append_rows_def carrier_matD
+            group_cancel.rule0 index_mat_addrow(1) index_mat_four_block(1) index_mat_four_block(2,3)
+            index_mult_mat(2) index_zero_mat(3) jn le_add1 linorder_not_less nat_SN.plus_gt_right_mono 
+            reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions(3))
+      also have "... = D" using j j_in_xs by auto
+      finally have B'_jj: "?B' $$ (j, j) = D" by auto
+      moreover have "\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0" 
+      proof 
+        fix j' assume j': "j' \<in>{0..<n} - {j}"
+        have "?B' $$ (j, j') = ?reduce_xs $$ (m+j,j')"
+          by (smt mn Diff_iff j' add.commute add_diff_cancel_left' 
+              append_rows_nth2 atLeastLessThan_iff diff_zero jn length_map length_upt 
+              mat_of_rows_carrier(1) nat_SN.compat reduce_xs_A'B')
+        also have "... = B $$ (j,j')"
+          by (smt "2"(2) "2"(5) A' Diff_iff P R_P j' add.commute add_diff_cancel_left'  
+            append_rows_def atLeastLessThan_iff carrier_matD group_cancel.rule0 index_mat_addrow(1)
+            index_mat_four_block index_mult_mat(2) index_zero_mat(3) jn nat_SN.plus_gt_right_mono 
+            not_add_less2 reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions(3))
+        also have "... = 0" using j j_in_xs j' by auto
+        finally show "?B' $$ (j, j') = 0" .
+      qed
+      ultimately show "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
+        using jn by blast
+    qed
+    show "?A' : carrier_mat m n" by auto      
+    show "?B' : carrier_mat n n" by auto
+    show "a<m" using "2.prems" by auto
+    show "n\<le>m" using "2.prems" by auto    
+  qed
+  from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
+    and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs"
+    by auto
+  have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
+  moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
+  moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" 
+    by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
+        index_mult_mat reduce_row_mod_D_preserves_dimensions_abs)
+  ultimately show ?case by blast
+qed
+
+
+
+
+(*Similar to thm reduce_row_mod_D_case_m' but including the case a = m. 
+This could substitute the previous version.*)
+lemma reduce_row_mod_D_case_m'':
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and "a \<le> m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and d: "distinct xs" and "m\<ge>n" and "0 \<notin> set xs"
+    and "D > 0" 
+  shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd A$$(i,k) then D
+                    else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
+  case (1 A a D m)
+  then show ?case by force
+next
+  case (2 A a x xs D m)
+  note A_A'B = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(7)
+  note d = "2.prems"(6)
+  note zero_not_xs = "2.prems"(8)
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
+    by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
+            carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
+            reduce_element_mod_D_preserves_dimensions)
+  have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast
+  have 1: "reduce_row_mod_D A a (x # xs) D m 
+    = reduce_row_mod_D ?reduce_xs a xs D m" by simp
+  have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k)
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
+    by (rule reduce_element_mod_D_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
+  have "reduce_row_mod_D ?reduce_xs a xs D m =
+    Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
+    then if k=0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k)
+    else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
+  proof (rule "2.hyps"[OF _ _ _ a _ _ mn])
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
+    define B' where "B' = mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<dim_row A]]"
+    show A'': "?A' : carrier_mat m n" by auto
+    show B': "B' : carrier_mat n n" unfolding B'_def using mn A by auto 
+    show reduce_split: "?reduce_xs = ?A' @\<^sub>r B'" 
+      by (metis B'_def append_rows_split carrier_matD
+          reduce_element_mod_D_preserves_dimensions(1) reduce_xs_carrier le_add1)
+    show "\<forall>j\<in>set xs. j<n \<and> (B' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B' $$ (j, j') = 0)"
+    proof 
+      fix j assume j_xs: "j\<in>set xs"
+      have "B $$ (j,j') = B' $$ (j,j')" if j': "j'<n" for j'
+      proof -
+        have "B $$ (j,j') = A $$ (m+j,j')"
+          by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
+              index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
+        also have "... = ?reduce_xs $$ (m+j,j')"
+          by (smt (verit, ccfv_threshold) A'' diff_add_zero index_mat_addrow(3) neq0_conv
+              a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_def
+              cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
+              j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
+        also have "... = B'$$ (j,j')"
+          by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
+              append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
+        finally show ?thesis .
+      qed
+      thus "j < n \<and> B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. B' $$ (j, j') = 0)" using j
+        by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
+    qed          
+  qed (insert "2.prems", auto simp add: mat_of_rows_def)
+  also have "... = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k) 
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
+  proof (rule eq_matI) 
+    show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
+    fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
+    have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
+    have xn: "x < n" 
+      by (simp add: "2.prems"(5))
+    show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    proof (cases "i=a \<and> j \<in> set xs")
+      case True note ia_jxs = True
+      have j_not_x: "j\<noteq>x" using d True by auto
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
+        case True
+        have "?lhs $$ (i,j) = D"
+          using True i j ia_jxs by auto
+        also have "... = ?rhs $$ (i,j)" using i j j_not_x
+          by (metis "2.prems"(8) True ia_jxs list.set_intros(2))
+        finally show ?thesis .
+      next
+        case False   
+        show ?thesis
+          by (smt (z3) "2" "2.prems"(8) dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j j_not_x list.set(2) old.prod.case)     
+    qed
+  next
+      case False
+      show ?thesis using 2 i j xn
+        by (smt (z3) "2.prems"(8) False carrier_matD(2) dim_row_mat(1) index_mat(1) 
+            insert_iff jn list.set(2) old.prod.case reduce_element_mod_D_preserves_dimensions(2) reduce_xs_carrier)
+    qed   
+  qed  
+  finally show ?case using 1 by simp
+qed
+
+
+
+
+(*Similar to thm reduce_row_mod_D_abs_case_m' but including the case a = m. 
+This could substitute the previous version.*)
+lemma reduce_row_mod_D_abs_case_m'':
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and "a \<le> m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and d: "distinct xs" and "m\<ge>n" and "0 \<notin> set xs"
+    and "D > 0" 
+  shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd A$$(i,k) then D
+                   else A$$(i,k) gmod D else A$$(i,k))"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
+  case (1 A a D m)
+  then show ?case by force
+next
+  case (2 A a x xs D m)
+  note A_A'B = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(7)
+  note d = "2.prems"(6)
+  note zero_not_xs = "2.prems"(8)
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
+    by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
+            carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
+            reduce_element_mod_D_preserves_dimensions)
+  have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast
+  have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
+    = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
+  have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k)
+          then D else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
+    by (rule reduce_element_mod_D_abs_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
+  have "reduce_row_mod_D_abs ?reduce_xs a xs D m =
+    Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
+    then if k=0 \<and> D dvd ?reduce_xs $$ (i, k) then D 
+    else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
+  proof (rule "2.hyps"[OF _ _ _ a _ _ mn])
+    let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
+    define B' where "B' = mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<dim_row A]]"
+    show A'': "?A' : carrier_mat m n" by auto
+    show B': "B' : carrier_mat n n" unfolding B'_def using mn A by auto 
+    show reduce_split: "?reduce_xs = ?A' @\<^sub>r B'" 
+      by (metis B'_def append_rows_split carrier_matD
+          reduce_element_mod_D_preserves_dimensions(3) reduce_xs_carrier le_add1)
+    show "\<forall>j\<in>set xs. j<n \<and> (B' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B' $$ (j, j') = 0)"
+    proof 
+      fix j assume j_xs: "j\<in>set xs"
+      have "B $$ (j,j') = B' $$ (j,j')" if j': "j'<n" for j'
+      proof -
+        have "B $$ (j,j') = A $$ (m+j,j')"
+          by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
+              index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
+        also have "... = ?reduce_xs $$ (m+j,j')"
+          by (smt (verit, ccfv_threshold) A'' diff_add_zero index_mat_addrow(3) neq0_conv
+              a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_abs_def
+              cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
+              j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
+        also have "... = B'$$ (j,j')"
+          by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
+              append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
+        finally show ?thesis .
+      qed
+      thus "j < n \<and> B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. B' $$ (j, j') = 0)" using j
+        by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
+    qed          
+  qed (insert "2.prems", auto simp add: mat_of_rows_def)
+  also have "... = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k) 
+          then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
+  proof (rule eq_matI) 
+    show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
+    fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
+    have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
+    have xn: "x < n" 
+      by (simp add: "2.prems"(5))
+    show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    proof (cases "i=a \<and> j \<in> set xs")
+      case True note ia_jxs = True
+      have j_not_x: "j\<noteq>x" using d True by auto
+      show ?thesis
+      proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
+        case True
+        have "?lhs $$ (i,j) = D"
+          using True i j ia_jxs by auto
+        also have "... = ?rhs $$ (i,j)" using i j j_not_x
+          by (metis "2.prems"(8) True ia_jxs list.set_intros(2))
+        finally show ?thesis .
+      next
+        case False   
+        show ?thesis
+          by (smt (z3) "2" "2.prems"(8) dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j j_not_x list.set(2) old.prod.case)     
+    qed
+  next
+      case False
+      show ?thesis using 2 i j xn
+        by (smt (z3) "2.prems"(8) False carrier_matD(2) dim_row_mat(1) index_mat(1) 
+            insert_iff jn list.set(2) old.prod.case reduce_element_mod_D_preserves_dimensions(4) reduce_xs_carrier)
+    qed   
+  qed  
+  finally show ?case using 1
+    by (smt (verit, ccfv_SIG) "2.prems"(8) cong_mat split_conv)
+qed
+
+
+
+lemma
+  assumes A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat n n"
+  and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" and mn: "m\<ge>n" and j0: "j\<noteq>0"
+shows reduce_element_mod_D_invertible_mat_case_m':
+  "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
+  and reduce_element_mod_D_abs_invertible_mat_case_m': 
+  "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
+proof -
+  let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
+  have jm: "j+m \<noteq>a" using j0 a by auto
+  have A: "A \<in> carrier_mat (m + n) n" using A_def A' B mn by auto
+  have rw: "reduce_element_mod_D A a j D m = reduce_element_mod_D_abs A a j D m" 
+    unfolding reduce_element_mod_D_def reduce_element_mod_D_abs_def using j0 by auto
+  have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
+    unfolding reduce_element_mod_D_def using j0 by auto
+  also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
+  finally have "reduce_element_mod_D A a j D m = ?P * A" .
+  moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
+  moreover have "invertible_mat ?P"
+    by (metis addrow_mat_carrier det_addrow_mat dvd_mult_right jm
+        invertible_iff_is_unit_JNF mult.right_neutral semiring_gcd_class.gcd_dvd1)
+  ultimately show ?thesis1 and ?thesis2 using rw by metis+
+qed
+
+(*Similar to reduce_row_mod_D_invertible_mat_case_m but including the case a = m, and then
+adding the assumption 0 not in set xs.*)
+lemma reduce_row_mod_D_invertible_mat_case_m':
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and a: "a \<le> m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and d: "distinct xs" and mn: "m\<ge>n" and "0\<notin> set xs"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_row_mod_D A a xs D m = P * A"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
+  case (1 A a D m)
+  show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
+next
+  case (2 A a x xs D m)
+  note A_A'B = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(7)
+  note d = "2.prems"(6)
+  note zero_not_xs = "2.prems"(8)
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
+    by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
+            carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
+            reduce_element_mod_D_preserves_dimensions)
+  have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast 
+  let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
+  have 1: "reduce_row_mod_D A a (x # xs) D m 
+    = reduce_row_mod_D ?reduce_xs a xs D m" by simp
+  have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D A a x D m = P * A"
+    by (rule reduce_element_mod_D_invertible_mat_case_m'[OF A_A'B B A' a _ mn],
+        insert zero_not_xs j, auto)
+  from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
+    and R_P: "reduce_element_mod_D A a x D m = P * A" by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
+      \<and> reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
+    let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
+    show B': "?B' \<in> carrier_mat n n" by auto
+    show A'': "?A' : carrier_mat m n" by auto
+    show reduce_split: "?reduce_xs = ?A' @\<^sub>r ?B'"
+      by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
+          index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(2))
+    show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
+    proof
+      fix j assume j_xs: "j\<in>set xs"
+      have "B $$ (j,j') = ?B' $$ (j,j')" if j': "j'<n" for j'
+      proof -
+        have "B $$ (j,j') = A $$ (m+j,j')"
+          by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
+              index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
+        also have "... = ?reduce_xs $$ (m+j,j')"
+          by (smt (verit, ccfv_SIG) not_add_less1
+              a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_def
+              cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
+              j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
+        also have "... = ?B'$$ (j,j')"
+          by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
+              append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
+        finally show ?thesis .
+      qed
+      thus "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)" using j
+        by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
+    qed        
+  qed (insert d zero_not_xs a mn, auto)
+  from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
+    and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs"
+    by auto
+  have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
+  moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
+  moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" 
+    by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
+        index_mult_mat reduce_row_mod_D_preserves_dimensions)
+  ultimately show ?case by blast
+qed
+
+
+
+lemma reduce_row_mod_D_abs_invertible_mat_case_m':
+  assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
+    and A': "A' \<in> carrier_mat m n" and a: "a \<le> m" 
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
+    and d: "distinct xs" and mn: "m\<ge>n" and "0\<notin> set xs"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_row_mod_D_abs A a xs D m = P * A"
+  using assms
+proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
+  case (1 A a D m)
+  show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
+next
+  case (2 A a x xs D m)
+  note A_A'B = "2.prems"(1)
+  note B = "2.prems"(2)
+  note A' = "2.prems"(3)
+  note a = "2.prems"(4)
+  note j = "2.prems"(5)
+  note mn = "2.prems"(7)
+  note d = "2.prems"(6)
+  note zero_not_xs = "2.prems"(8)
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
+    by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
+            carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
+            reduce_element_mod_D_preserves_dimensions)
+  have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast 
+  let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
+  have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
+    = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
+  have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
+    reduce_element_mod_D_abs A a x D m = P * A"
+    by (rule reduce_element_mod_D_abs_invertible_mat_case_m'[OF A_A'B B A' a _ mn],
+        insert zero_not_xs j, auto)
+  from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
+    and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
+      \<and> reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs"
+  proof (rule "2.hyps")
+    let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
+    let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
+    show B': "?B' \<in> carrier_mat n n" by auto
+    show A'': "?A' : carrier_mat m n" by auto
+    show reduce_split: "?reduce_xs = ?A' @\<^sub>r ?B'"
+      by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
+          index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(4))
+    show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
+    proof
+      fix j assume j_xs: "j\<in>set xs"
+      have "B $$ (j,j') = ?B' $$ (j,j')" if j': "j'<n" for j'
+      proof -
+        have "B $$ (j,j') = A $$ (m+j,j')"
+          by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
+              index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
+        also have "... = ?reduce_xs $$ (m+j,j')"
+          by (smt (verit, ccfv_SIG) not_add_less1
+              a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_abs_def
+              cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
+              j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
+        also have "... = ?B'$$ (j,j')"
+          by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
+              append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
+        finally show ?thesis .
+      qed
+      thus "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)" using j
+        by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
+    qed        
+  qed (insert d zero_not_xs a mn, auto)
+  from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
+    and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs"
+    by auto
+  have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
+  moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
+  moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" 
+    by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
+        index_mult_mat reduce_row_mod_D_preserves_dimensions_abs)
+  ultimately show ?case by blast
+qed
+
+
+lemma reduce_invertible_mat_case_m: 
+  assumes A': "A' \<in> carrier_mat m n" and B: "B \<in> carrier_mat n n"
+    and a: "a<m" and ab: "a \<noteq> m" 
+  and A_def: "A = A' @\<^sub>r B"
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"  
+  and Aaj: "A $$ (a,0) \<noteq> 0"
+  and mn: "m\<ge>n"
+  and n0: "0<n"
+  and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
+  and A2_def: "A2 = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
+                   else if i = m then u * A$$(a,k) + v * A$$(m,k)
+                   else A$$(i,k)
+            )"
+  and xs_def: "xs = [1..<n]"
+  and ys_def: "ys = [1..<n]"
+    and j_ys: "\<forall>j\<in>set ys. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
+    and D0: "D > 0"
+  and Am0_D: "A $$ (m, 0) \<in> {0,D}"
+  and Am0_D2: "A $$ (m, 0) = 0 \<longrightarrow> A $$ (a, 0) = D"
+shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce a m D A) = P * A"
+proof -
+  let ?A = "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
+                   else if i = m then u * A$$(a,k) + v * A$$(m,k)
+                   else A$$(i,k)
+            )"
+  have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" using mn by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
+  hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
+
+  let ?BM = "bezout_matrix_JNF A a m 0 euclid_ext2"
+  
+  have A'_BZ_A: "?A = ?BM * A"
+    by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def B pquvd], insert a, auto)  
+  have invertible_bezout: "invertible_mat ?BM"
+    by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a _ _ Aaj], insert a n0, auto)      
+  have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
+  let ?reduce_a = "reduce_row_mod_D ?A a xs D m"
+  define A'1 where "A'1 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
+  define A'2 where "A'2 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]]"
+  have A_A'_D: "?A = A'1 @\<^sub>r A'2" using append_rows_split A
+    by (metis (no_types, lifting) A'1_def A'2_def A_carrier carrier_matD le_add1)
+  have j_A'1_A'2: "\<forall>j\<in>set xs. j < n \<and> A'2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. A'2 $$ (j, j') = 0)"
+    proof (rule ballI)
+      fix ja assume ja: "ja\<in>set xs"
+      have ja_n: "ja < n" using ja unfolding xs_def by auto
+      have ja2: "ja < dim_row A - m" using A mn ja_n by auto
+      have ja_m: "ja < m" using ja_n mn by auto
+      have ja_not_0: "ja \<noteq> 0" using ja unfolding xs_def by auto
+      show "ja < n \<and> A'2 $$ (ja, ja) = D \<and> (\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
+      proof -
+        have "A'2 $$ (ja, ja) = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v ja"
+          by (metis (no_types, lifting) A A'2_def add_diff_cancel_left' carrier_matD(1) 
+              ja_n length_map length_upt mat_of_rows_index)
+        also have "... = ?A $$ (m + ja, ja)" using A mn ja_n by auto
+        also have "... = A $$ (m+ja, ja)" using A a mn ja_n ja_not_0 by auto
+        also have "... =  (A' @\<^sub>r B) $$ (m + ja, ja)" unfolding A_def ..
+        also have "... = B $$ (ja, ja)"
+          by (metis B Groups.add_ac(2) append_rows_nth2 assms(1) ja_n mn nat_SN.compat)
+        also have "... = D" using j ja by blast
+        finally have A2_D: "A'2 $$ (ja, ja) = D" .
+
+        moreover have "(\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
+        proof (rule ballI)
+          fix j' assume j': "j': {0..<n} - {ja}"
+          have "A'2 $$ (ja, j') = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v j'"
+            unfolding A'2_def by (rule mat_of_rows_index, insert j' ja_n ja2, auto)
+          also have "... = ?A $$ (m + ja, j')" using A mn ja_n j' by auto
+          also have "... = A $$ (m+ja, j')" using A a mn ja_n ja_not_0 j' by auto
+          also have "... =  (A' @\<^sub>r B) $$ (ja + m, j')" unfolding A_def
+            by (simp add: add.commute)
+          also have "... = B $$ (ja, j')"
+            by (rule append_rows_nth2[OF A' B _ ja_m ja_n], insert j', auto)
+          also have "... = 0" using mn j' ja_n j ja by auto
+          finally show "A'2 $$ (ja, j') = 0" .
+        qed
+        ultimately show ?thesis using ja_n by simp
+      qed
+    qed
+  have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
+    (\<lambda>(i, k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd ?A $$ (i, k) then D
+    else ?A $$ (i, k) else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
+  proof (rule reduce_row_mod_D_case_m'[OF A_A'_D _ _ a j_A'1_A'2 _ mn D0])    
+    show "A'2 \<in> carrier_mat n n" using A A'2_def by auto
+    show "A'1 \<in> carrier_mat m n" by (simp add: A'1_def mat_of_rows_def) 
+    show "distinct xs" using distinct_filter distinct_upt xs_def by blast
+  qed
+  have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n" using reduce_a_eq A by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
+    by (rule reduce_row_mod_D_invertible_mat_case_m[OF A_A'_D _ _ _ j_A'1_A'2 mn],
+        insert a A A'2_def A'1_def, auto)
+  from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
+    and reduce_a_PA: "?reduce_a = P * ?A" by blast
+  let ?reduce_b = "reduce_row_mod_D ?reduce_a m ys D m"
+  let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
+  define reduce_a1 where "reduce_a1 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
+  define reduce_a2 where "reduce_a2 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [m..<dim_row ?reduce_a]]"
+  have reduce_a_split: "?reduce_a = reduce_a1 @\<^sub>r reduce_a2"
+    by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto)  
+  have zero_notin_ys: "0 \<notin> set ys"
+  proof -
+    have m: "m<dim_row A" using A n0 by auto
+    have "?A $$ (m,0) =  u * A $$ (a, 0) + v * A $$ (m, 0)" using m n0 a A by auto
+    also have "... = 0" using pquvd
+      by (smt dvd_mult_div_cancel euclid_ext2_def euclid_ext2_works(3) more_arith_simps(11)
+          mult.commute mult_minus_left prod.sel(1) prod.sel(2) semiring_gcd_class.gcd_dvd1)
+    finally show ?thesis using D0 unfolding ys_def by auto
+  qed
+  have reduce_a2: "reduce_a2 \<in> carrier_mat n n" unfolding reduce_a2_def using A by auto
+  have reduce_a1: "reduce_a1 \<in> carrier_mat m n" unfolding reduce_a1_def using A by auto
+  have j2: "\<forall>j\<in>set ys. j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
+  proof
+    fix j assume j_in_ys: "j \<in> set ys"
+    have a_jm: "a \<noteq> j+m" using a by auto
+    have m_not_jm: "m \<noteq> j + m" using zero_notin_ys j_in_ys by fastforce
+    have jm: "j+m < dim_row ?A" using A_carrier j_in_ys unfolding ys_def by auto
+    have jn: "j < dim_col ?A" using A_carrier j_in_ys unfolding ys_def by auto
+    have jm': "j+m < dim_row A" using A_carrier j_in_ys unfolding ys_def by auto
+    have jn': "j < dim_col A" using A_carrier j_in_ys unfolding ys_def by auto
+    have "reduce_a2 $$ (j, j') = B $$ (j,j')" if j': "j'<n" for j'
+    proof -
+      have "reduce_a2 $$ (j, j') = ?reduce_a $$ (j+m,j')"
+        by (rule append_rows_nth2[symmetric, OF reduce_a1 reduce_a2 reduce_a_split],
+            insert j_in_ys mn j', auto simp add: ys_def)
+      also have "... = ?A $$ (j+m, j')" using reduce_a_eq jm jn a_jm j' A_carrier by auto          
+      also have "... = A $$ (j+m, j')" using a_jm m_not_jm jm' jn' j' A_carrier by auto
+      also have "... = B $$ (j,j')"
+        by (smt A append_rows_nth2 A' B A_def mn carrier_matD(2) jn' le_Suc_ex that trans_less_add1)
+      finally show ?thesis .
+    qed
+    thus "j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
+      using j_ys j_in_ys by auto
+  qed
+  have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
+    (\<lambda>(i, k). if i = m \<and> k \<in> set ys then if k = 0 then if D dvd ?reduce_a $$ (i, k) then D
+      else ?reduce_a $$ (i, k) else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
+    by (rule reduce_row_mod_D_case_m''[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
+        insert D0, auto simp add: ys_def)    
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
+    by (rule reduce_row_mod_D_invertible_mat_case_m'[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
+        auto simp add: ys_def) 
+  from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
+    and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
+  have reduce_b_eq_reduce: "?reduce_b = (reduce a m D A)"
+  proof (rule eq_matI)
+    show dr_eq: "dim_row ?reduce_b = dim_row (reduce a m D A)" 
+      and dc_eq: "dim_col ?reduce_b = dim_col (reduce a m D A)"
+      using reduce_preserves_dimensions by auto
+    fix i ja assume i: "i<dim_row (reduce a m D A)" and ja: "ja< dim_col (reduce a m D A)"
+    have im: "i<m+n" using A i reduce_preserves_dimensions(1) by auto
+    have ja_n: "ja<n" using A ja reduce_preserves_dimensions(2) by auto
+    show "?reduce_b $$ (i,ja) = (reduce a m D A) $$ (i,ja)"    
+    proof (cases "(i\<noteq>a \<and> i\<noteq>m)")
+      case True
+      have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
+        by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions)
+      also have "... = ?A $$ (i,ja)"
+        by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
+            reduce_a_eq reduce_preserves_dimensions(1) split_conv)
+      also have "... = A $$ (i,ja)" using A True im ja_n by auto
+      also have "... = (reduce a m D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
+        using im ja_n A True by auto
+      finally show ?thesis .      
+    next
+      case False note a_or_b = False
+      have gcd_pq: "p * A $$ (a, 0) + q * A $$ (m, 0) = gcd (A $$ (a, 0)) (A $$ (m, 0))"
+        by (metis assms(10) euclid_ext2_works(1) euclid_ext2_works(2))
+      have gcd_le_D: "gcd (A $$ (a, 0)) (A $$ (m, 0)) \<le> D"        
+        by (metis Am0_D D0 assms(17) empty_iff gcd_le1_int gcd_le2_int insert_iff)
+      show ?thesis
+      proof (cases "i=a")
+        case True note ia = True
+        hence i_not_b: "i\<noteq>m" using ab by auto
+        have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
+                reduce_b_eq reduce_row_mod_D_preserves_dimensions(2))
+        show ?thesis
+        proof (cases "ja=0")
+          case True note ja0 = True           
+          hence ja_notin_xs: "ja \<notin> set xs" unfolding xs_def by auto
+          have "?reduce_a $$ (i,ja) = p * A $$ (a, 0) + q * A $$ (m, 0)" 
+            unfolding reduce_a_eq using True ja0 ab a_or_b i_not_b ja_n im a A False ja_notin_xs
+            by auto
+          also have "... = (reduce a m D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd]
+            using True a_or_b i_not_b ja_n im A False               
+            using gcd_le_D gcd_pq Am0_D Am0_D2 by auto 
+          finally show ?thesis using 1 by auto
+        next
+          case False
+          hence ja_in_xs: "ja \<in> set xs"
+            unfolding xs_def using True ja_n im a A unfolding set_filter by auto
+          have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
+            unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+          also have "... = (reduce a m D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
+          finally show ?thesis using 1 by simp
+        qed
+      next
+        case False note i_not_a = False
+        have i_drb: "i<dim_row ?reduce_b" 
+          and i_dra: "i<dim_row ?reduce_a" 
+          and ja_drb: "ja < dim_col ?reduce_b"
+          and ja_dra: "ja < dim_col ?reduce_a" using i ja reduce_carrier[OF A] A ja_n im by auto
+        have ib: "i=m" using False a_or_b by auto
+        show ?thesis
+        proof (cases "ja = 0")
+          case True note ja0 = True
+          have uv: "u * A $$ (a, ja) + v * A $$ (m, ja) = 0"
+            unfolding euclid_ext2_works[OF pquvd[symmetric]] True
+            by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
+          have "?reduce_b $$ (i,ja) = u * A $$ (a, ja) + v * A $$ (m, ja)"
+            by (smt (z3) A A_carrier True assms(4) carrier_matD i ib index_mat(1) reduce_a_eq
+                ja_dra old.prod.case reduce_preserves_dimensions(1) zero_notin_ys reduce_b_eq
+                reduce_row_mod_D_preserves_dimensions)
+          also have "... = 0" using uv by blast
+          also have "... = (reduce a m D A) $$ (i,ja)" 
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using True False a_or_b ib ja_n im A 
+              using i_not_a uv by auto
+          finally show ?thesis by auto
+        next
+          case False
+          have ja_in_ys: "ja \<in> set ys"
+            unfolding ys_def using False ib ja_n im a  A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D
+                                  else ?reduce_a $$ (i, ja) else ?reduce_a $$ (i, ja) gmod D)"
+            unfolding reduce_b_eq using i_not_a  ja ja_in_ys 
+            by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
+          also have "... = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D
+                            else ?A $$ (i, ja) else ?A $$ (i, ja) gmod D)"
+            unfolding reduce_a_eq using ab a_or_b ib False ja_n im a A ja_in_ys by auto
+          also have "... = (reduce a m D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using  False a_or_b ib ja_n im A 
+            using i_not_a  by auto         
+          finally show ?thesis .
+        qed
+      qed
+    qed
+  qed
+  have r: "?reduce_a = (P*?BM) * A" using A A'_BZ_A BM P reduce_a_PA by auto
+  have "Q * P * ?BM : carrier_mat (m+n) (m+n)" using P BM Q by auto
+  moreover have "invertible_mat (Q * P*?BM)"
+    using inv_P invertible_bezout BM P invertible_mult_JNF inv_Q Q by (metis mult_carrier_mat)
+  moreover have "(reduce a m D A) = (Q * P * ?BM) * A" using reduce_a_eq r reduce_b_eq_reduce
+    by (smt BM P Q assoc_mult_mat carrier_matD carrier_mat_triv 
+        dim_row_mat(1) index_mult_mat(2,3) reduce_b_Q_reduce)
+  ultimately show ?thesis by auto
+qed
+
+
+
+lemma reduce_abs_invertible_mat_case_m: 
+  assumes A': "A' \<in> carrier_mat m n" and B: "B \<in> carrier_mat n n"
+    and a: "a<m" and ab: "a \<noteq> m" 
+  and A_def: "A = A' @\<^sub>r B"
+    and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"  
+  and Aaj: "A $$ (a,0) \<noteq> 0"
+  and mn: "m\<ge>n"
+  and n0: "0<n"
+  and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
+  and A2_def: "A2 = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
+                   else if i = m then u * A$$(a,k) + v * A$$(m,k)
+                   else A$$(i,k)
+            )"
+  and xs_def: "xs = filter (\<lambda>i. abs (A2 $$ (a,i)) > D) [0..<n]"
+  and ys_def: "ys = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]"
+    and j_ys: "\<forall>j\<in>set ys. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
+    and D0: "D > 0"
+shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a m D A) = P * A"
+proof -
+  let ?A = "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
+                   else if i = m then u * A$$(a,k) + v * A$$(m,k)
+                   else A$$(i,k)
+            )"
+  note xs_def = xs_def[unfolded A2_def]
+  note ys_def = ys_def[unfolded A2_def]
+  have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" using mn by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
+  hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
+
+  let ?BM = "bezout_matrix_JNF A a m 0 euclid_ext2"
+  
+  have A'_BZ_A: "?A = ?BM * A"
+    by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def B pquvd], insert a, auto)  
+  have invertible_bezout: "invertible_mat ?BM"
+    by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a _ _ Aaj], insert a n0, auto)      
+  have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
+  let ?reduce_a = "reduce_row_mod_D_abs ?A a xs D m"
+  define A'1 where "A'1 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
+  define A'2 where "A'2 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]]"
+  have A_A'_D: "?A = A'1 @\<^sub>r A'2" using append_rows_split A
+    by (metis (no_types, lifting) A'1_def A'2_def A_carrier carrier_matD le_add1)
+  have j_A'1_A'2: "\<forall>j\<in>set xs. j < n \<and> A'2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. A'2 $$ (j, j') = 0)"
+    proof (rule ballI)
+      fix ja assume ja: "ja\<in>set xs"
+      have ja_n: "ja < n" using ja unfolding xs_def by auto
+      have ja2: "ja < dim_row A - m" using A mn ja_n by auto
+      have ja_m: "ja < m" using ja_n mn by auto
+      have abs_A_a_ja_D: "\<bar>(?A $$ (a,ja))\<bar> > D" using ja unfolding xs_def by auto
+      have ja_not_0: "ja \<noteq> 0"
+      proof (rule ccontr, simp)
+        assume ja_a: "ja = 0" 
+        have A_mja_D: "A$$(m,ja) = D"
+        proof -
+          have "A$$(m,ja) = (A' @\<^sub>r B) $$ (m, ja)" unfolding A_def ..
+          also have "... = B $$ (m-m,ja)"                        
+            by (metis B append_rows_nth A' assms(9) carrier_matD(1) ja_a less_add_same_cancel1 less_irrefl_nat)
+          also have "... = B $$ (0,0)" unfolding ja_a by auto
+          also have "... = D" using mn unfolding ja_a using ja_n ja j ja_a by auto 
+          finally show ?thesis .
+        qed
+        have "?A $$ (a, ja) = p*A$$(a,ja) + q*A$$(m,ja)" using A_carrier ja_n a A by auto
+        also have "... = d" using pquvd A assms(2) ja_n ja_a
+          by (simp add: bezout_coefficients_fst_snd euclid_ext2_def)
+        also have "... = gcd (A$$(a,ja)) (A$$(m,ja))"
+          by (metis euclid_ext2_works(2) ja_a pquvd)
+        also have "abs(...) \<le> D" using A_mja_D  by (simp add: D0)       
+        finally have "abs (?A $$ (a, ja)) \<le> D" .
+        thus False using abs_A_a_ja_D by auto
+      qed      
+      show "ja < n \<and> A'2 $$ (ja, ja) = D \<and> (\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
+      proof -
+        have "A'2 $$ (ja, ja) = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v ja"
+          by (metis (no_types, lifting) A A'2_def add_diff_cancel_left' carrier_matD(1) 
+              ja_n length_map length_upt mat_of_rows_index)
+        also have "... = ?A $$ (m + ja, ja)" using A mn ja_n by auto
+        also have "... = A $$ (m+ja, ja)" using A a mn ja_n ja_not_0 by auto
+        also have "... =  (A' @\<^sub>r B) $$ (m + ja, ja)" unfolding A_def ..
+        also have "... = B $$ (ja, ja)"
+          by (metis B Groups.add_ac(2) append_rows_nth2 assms(1) ja_n mn nat_SN.compat)
+        also have "... = D" using j ja by blast
+        finally have A2_D: "A'2 $$ (ja, ja) = D" .
+
+        moreover have "(\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
+        proof (rule ballI)
+          fix j' assume j': "j': {0..<n} - {ja}"
+          have "A'2 $$ (ja, j') = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v j'"
+            unfolding A'2_def by (rule mat_of_rows_index, insert j' ja_n ja2, auto)
+          also have "... = ?A $$ (m + ja, j')" using A mn ja_n j' by auto
+          also have "... = A $$ (m+ja, j')" using A a mn ja_n ja_not_0 j' by auto
+          also have "... =  (A' @\<^sub>r B) $$ (ja + m, j')" unfolding A_def
+            by (simp add: add.commute)
+          also have "... = B $$ (ja, j')"
+            by (rule append_rows_nth2[OF A' B _ ja_m ja_n], insert j', auto)
+          also have "... = 0" using mn j' ja_n j ja by auto
+          finally show "A'2 $$ (ja, j') = 0" .
+        qed
+        ultimately show ?thesis using ja_n by simp
+      qed
+    qed
+  have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
+    (\<lambda>(i, k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd ?A $$ (i, k) then D else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
+  proof (rule reduce_row_mod_D_abs_case_m'[OF A_A'_D _ _ a j_A'1_A'2 _ mn D0])    
+    show "A'2 \<in> carrier_mat n n" using A A'2_def by auto
+    show "A'1 \<in> carrier_mat m n" by (simp add: A'1_def mat_of_rows_def) 
+    show "distinct xs" using distinct_filter distinct_upt xs_def by blast
+  qed
+  have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n" using reduce_a_eq A by auto
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
+    by (rule reduce_row_mod_D_abs_invertible_mat_case_m[OF A_A'_D _ _ _ j_A'1_A'2 mn],
+        insert a A A'2_def A'1_def, auto)
+  from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
+    and reduce_a_PA: "?reduce_a = P * ?A" by blast
+  let ?reduce_b = "reduce_row_mod_D_abs ?reduce_a m ys D m"
+  let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
+  define reduce_a1 where "reduce_a1 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
+  define reduce_a2 where "reduce_a2 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [m..<dim_row ?reduce_a]]"
+  have reduce_a_split: "?reduce_a = reduce_a1 @\<^sub>r reduce_a2"
+    by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto)  
+  have zero_notin_ys: "0 \<notin> set ys"
+  proof -
+    have m: "m<dim_row A" using A n0 by auto
+    have "?A $$ (m,0) =  u * A $$ (a, 0) + v * A $$ (m, 0)" using m n0 a A by auto
+    also have "... = 0" using pquvd
+      by (smt dvd_mult_div_cancel euclid_ext2_def euclid_ext2_works(3) more_arith_simps(11)
+          mult.commute mult_minus_left prod.sel(1) prod.sel(2) semiring_gcd_class.gcd_dvd1)
+    finally show ?thesis using D0 unfolding ys_def by auto
+  qed
+  have reduce_a2: "reduce_a2 \<in> carrier_mat n n" unfolding reduce_a2_def using A by auto
+  have reduce_a1: "reduce_a1 \<in> carrier_mat m n" unfolding reduce_a1_def using A by auto
+  have j2: "\<forall>j\<in>set ys. j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
+  proof
+    fix j assume j_in_ys: "j \<in> set ys"
+    have a_jm: "a \<noteq> j+m" using a by auto
+    have m_not_jm: "m \<noteq> j + m" using zero_notin_ys j_in_ys by fastforce
+    have jm: "j+m < dim_row ?A" using A_carrier j_in_ys unfolding ys_def by auto
+    have jn: "j < dim_col ?A" using A_carrier j_in_ys unfolding ys_def by auto
+    have jm': "j+m < dim_row A" using A_carrier j_in_ys unfolding ys_def by auto
+    have jn': "j < dim_col A" using A_carrier j_in_ys unfolding ys_def by auto
+    have "reduce_a2 $$ (j, j') = B $$ (j,j')" if j': "j'<n" for j'
+    proof -
+      have "reduce_a2 $$ (j, j') = ?reduce_a $$ (j+m,j')"
+        by (rule append_rows_nth2[symmetric, OF reduce_a1 reduce_a2 reduce_a_split],
+            insert j_in_ys mn j', auto simp add: ys_def)
+      also have "... = ?A $$ (j+m, j')" using reduce_a_eq jm jn a_jm j' A_carrier by auto          
+      also have "... = A $$ (j+m, j')" using a_jm m_not_jm jm' jn' j' A_carrier by auto
+      also have "... = B $$ (j,j')"
+        by (smt A append_rows_nth2 A' B A_def mn carrier_matD(2) jn' le_Suc_ex that trans_less_add1)
+      finally show ?thesis .
+    qed
+    thus "j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
+      using j_ys j_in_ys by auto
+  qed
+  have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
+    (\<lambda>(i, k). if i = m \<and> k \<in> set ys then if k = 0 \<and> D dvd ?reduce_a $$ (i, k) then D else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
+    by (rule reduce_row_mod_D_abs_case_m''[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
+        insert D0, auto simp add: ys_def)    
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
+    by (rule reduce_row_mod_D_abs_invertible_mat_case_m'[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
+        auto simp add: ys_def) 
+  from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
+    and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
+  have reduce_b_eq_reduce: "?reduce_b = (reduce_abs a m D A)"
+  proof (rule eq_matI)
+    show dr_eq: "dim_row ?reduce_b = dim_row (reduce_abs a m D A)" 
+      and dc_eq: "dim_col ?reduce_b = dim_col (reduce_abs a m D A)"
+      using reduce_preserves_dimensions by auto
+    fix i ja assume i: "i<dim_row (reduce_abs a m D A)" and ja: "ja< dim_col (reduce_abs a m D A)"
+    have im: "i<m+n" using A i reduce_preserves_dimensions(3) by auto
+    have ja_n: "ja<n" using A ja reduce_preserves_dimensions(4) by auto
+    show "?reduce_b $$ (i,ja) = (reduce_abs a m D A) $$ (i,ja)"    
+    proof (cases "(i\<noteq>a \<and> i\<noteq>m)")
+      case True
+      have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
+        by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions_abs)
+      also have "... = ?A $$ (i,ja)"
+        by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
+            reduce_a_eq reduce_preserves_dimensions(3) split_conv)
+      also have "... = A $$ (i,ja)" using A True im ja_n by auto
+      also have "... = (reduce_abs a m D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
+        using im ja_n A True by auto
+      finally show ?thesis .      
+    next
+      case False note a_or_b = False
+      show ?thesis
+      proof (cases "i=a")
+        case True note ia = True
+        hence i_not_b: "i\<noteq>m" using ab by auto
+        show ?thesis
+        proof (cases "abs((p*A$$(a,ja) + q*A$$(m,ja))) > D")
+          case True note ge_D = True
+          have ja_in_xs: "ja \<in> set xs"
+            unfolding xs_def using True ja_n im a A unfolding set_filter by auto
+          have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
+                reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
+          show ?thesis 
+          proof (cases "ja = 0 \<and> D dvd p*A$$(a,ja) + q*A$$(m,ja)")
+            case True
+            have "?reduce_a $$ (i,ja) = D"
+              unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+            also have "... = (reduce_abs a m D A) $$ (i,ja)"
+              unfolding reduce_alt_def_not0[OF Aaj pquvd]
+              using True a_or_b i_not_b ja_n im A False ge_D               
+              by auto 
+            finally show ?thesis using 1 by simp
+          next
+            case False
+            have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
+              unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
+            also have "... = (reduce_abs a m D A) $$ (i,ja)"
+              unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
+            finally show ?thesis using 1 by simp
+          qed        
+        next
+          case False
+          have ja_in_xs: "ja \<notin> set xs"
+            unfolding xs_def using False ja_n im a A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
+                reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
+          also have "... = ?A $$ (i, ja)"
+            unfolding reduce_a_eq using False ab a_or_b i_not_b ja_n im a A ja_in_xs by auto
+          also have "... = (reduce_abs a m D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_b ja_n im A by auto
+          finally show ?thesis .
+        qed
+      next
+        case False note i_not_a = False
+        have i_drb: "i<dim_row ?reduce_b" 
+          and i_dra: "i<dim_row ?reduce_a" 
+          and ja_drb: "ja < dim_col ?reduce_b"
+          and ja_dra: "ja < dim_col ?reduce_a" using i ja reduce_carrier[OF A] A ja_n im by auto
+          have ib: "i=m" using False a_or_b by auto
+        show ?thesis
+        proof (cases "abs((u*A$$(a,ja) + v * A$$(m,ja))) > D")
+          case True note ge_D = True
+          have ja_in_ys: "ja \<in> set ys"
+            unfolding ys_def using True False ib ja_n im a  A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?reduce_a $$ (i, ja) gmod D)"
+            unfolding reduce_b_eq using i_not_a True  ja ja_in_ys 
+            by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
+          also have "... = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) gmod D)"
+            unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto
+          also have "... = (reduce_abs a m D A) $$ (i,ja)"
+          proof (cases "ja = 0 \<and> D dvd ?reduce_a$$(i,ja)")
+            case True
+            have ja0: "ja=0" using True by auto
+            have "u * A $$ (a, ja) + v * A $$ (m, ja) = 0"
+              unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0
+              by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
+            hence abs_0: "abs((u*A$$(a,ja) + v * A$$(m,ja))) = 0" by auto
+            show ?thesis using abs_0 D0 ge_D by linarith           
+          next
+            case False
+            then show ?thesis 
+              unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ge_D False a_or_b ib ja_n im A 
+              using i_not_a by auto           
+          qed      
+          finally show ?thesis .
+        next
+          case False
+          have ja_in_ys: "ja \<notin> set ys"
+            unfolding ys_def using i_not_a False ib ja_n im a  A unfolding set_filter by auto
+          have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
+            by (smt False a_or_b dc_eq dim_row_mat(1) dr_eq i index_mat(1) ja ja_in_ys
+                prod.simps(2) reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
+          also have "... = ?A $$ (i, ja)"
+            unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A ja_in_ys by auto
+          also have "... = (reduce_abs a m D A) $$ (i,ja)"
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_a ja_n im A by auto
+          finally show ?thesis .
+        qed
+      qed      
+    qed    
+  qed
+  have r: "?reduce_a = (P*?BM) * A" using A A'_BZ_A BM P reduce_a_PA by auto
+  have "Q * P * ?BM : carrier_mat (m+n) (m+n)" using P BM Q by auto
+  moreover have "invertible_mat (Q * P*?BM)"
+    using inv_P invertible_bezout BM P invertible_mult_JNF inv_Q Q by (metis mult_carrier_mat)
+  moreover have "(reduce_abs a m D A) = (Q * P * ?BM) * A" using reduce_a_eq r reduce_b_eq_reduce
+    by (smt BM P Q assoc_mult_mat carrier_matD carrier_mat_triv 
+        dim_row_mat(1) index_mult_mat(2,3) reduce_b_Q_reduce)
+  ultimately show ?thesis by auto
+qed
+
+
+
+
+lemma reduce_not0:
+  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and a_less_b: "a<b" and j: "0<n" and b: "b<m"
+    and Aaj: "A $$ (a,0) \<noteq> 0" and D0: "D \<noteq> 0"
+  shows "reduce a b D A $$ (a, 0) \<noteq> 0" (is "?reduce $$ (a,0) \<noteq> _")
+  and "reduce_abs a b D A $$ (a, 0) \<noteq> 0" (is "?reduce_abs $$ (a,0) \<noteq> _")
+proof -
+  have "?reduce $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in if D dvd r then D else r)" 
+    by (rule reduce_gcd[OF A _ j Aaj], insert a, simp)
+  also have "... \<noteq> 0" unfolding Let_def using D0 
+    by (smt Aaj gcd_eq_0_iff gmod_0_imp_dvd)
+  finally show "reduce a b D A $$ (a, 0) \<noteq> 0" .
+  have "?reduce_abs $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in 
+        if D < r then if D dvd r then D else r gmod D else r)"
+    by (rule reduce_gcd[OF A _ j Aaj], insert a, simp)
+  also have "... \<noteq> 0" unfolding Let_def using D0 
+    by (smt Aaj gcd_eq_0_iff gmod_0_imp_dvd)
+  finally show "reduce_abs a b D A $$ (a, 0) \<noteq> 0" .
+qed
+
+lemma reduce_below_not0:
+ assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" 
+    and Aaj: "A $$ (a,0) \<noteq> 0" 
+and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D\<noteq> 0"
+  shows "reduce_below a xs D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
+  using assms
+proof (induct a xs D A arbitrary: A rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note Aaj = "2.prems"(4)
+  note d = "2.prems"(5)
+  note D0 = "2.prems"(7)
+  note x_less_xxs = "2.prems"(6)
+  have xm: "x < m" using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
+    by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
+  have h: "reduce_below a xs D (reduce a x D A) $$ (a,0) \<noteq> 0"
+  proof (rule "2.hyps")
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A a _ j xm Aaj D0], insert x_less_xxs, simp)
+  qed (insert A a j Aaj d x_less_xxs xm reduce_ax D0, auto)
+  thus ?case by auto
+qed
+
+
+
+lemma reduce_below_abs_not0:
+ assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" 
+    and Aaj: "A $$ (a,0) \<noteq> 0" 
+and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D\<noteq> 0"
+  shows "reduce_below_abs a xs D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
+  using assms
+proof (induct a xs D A arbitrary: A rule: reduce_below_abs.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note Aaj = "2.prems"(4)
+  note d = "2.prems"(5)
+  note D0 = "2.prems"(7)
+  note x_less_xxs = "2.prems"(6)
+  have xm: "x < m" using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce_abs a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
+    by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
+  have h: "reduce_below_abs a xs D (reduce_abs a x D A) $$ (a,0) \<noteq> 0"
+  proof (rule "2.hyps")
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A a _ j xm Aaj D0], insert x_less_xxs, simp)
+  qed (insert A a j Aaj d x_less_xxs xm reduce_ax D0, auto)
+  thus ?case by auto
+qed
+
+
+
+lemma reduce_below_not0_case_m:
+ assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+    and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "D \<noteq> 0"
+  shows "reduce_below a (xs@[m]) D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
+  using assms
+proof (induct a xs D A arbitrary: A A' rule: reduce_below.induct)
+  case (1 a D A)
+  note A' = "1.prems"(1)
+  note a = "1.prems"(2)
+  note n = "1.prems"(3)
+  note A_def = "1.prems"(4)
+  note Aaj = "1.prems"(5)
+  note mn = "1.prems"(6)
+  note all_less_xxs = "1.prems"(7)
+  note D0 = "1.prems"(8)
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  have "reduce_below a ([] @ [m]) D A $$ (a, 0) = reduce_below a [m] D A $$ (a, 0)" by auto
+  also have "... = reduce a m D A $$ (a, 0)" by auto
+  also have "... \<noteq> 0"
+    by (rule reduce_not0[OF A _ a n _ Aaj D0], insert a n, auto)
+  finally show ?case .
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note n = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note x_less_xxs = "2.prems"(7)
+  note D0= "2.prems"(8)
+  have xm: "x < m" using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m+n) n"
+    by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
+  have h: "reduce_below a (xs@[m]) D (reduce a x D A) $$ (a,0) \<noteq> 0"
+  proof (rule "2.hyps")
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ _ _ _ D0], insert x_less_xxs j Aaj, auto)
+    let ?reduce_ax' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "?reduce_ax = ?reduce_ax' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule reduce_append_rows_eq[OF A' A_def a xm n Aaj])
+  qed (insert A a j Aaj x_less_xxs xm reduce_ax mn D0, auto)
+  thus ?case by auto
+qed
+
+lemma reduce_below_abs_not0_case_m:
+ assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+    and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "D \<noteq> 0"
+  shows "reduce_below_abs a (xs@[m]) D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
+  using assms
+proof (induct a xs D A arbitrary: A A' rule: reduce_below_abs.induct)
+  case (1 a D A)
+  note A' = "1.prems"(1)
+  note a = "1.prems"(2)
+  note n = "1.prems"(3)
+  note A_def = "1.prems"(4)
+  note Aaj = "1.prems"(5)
+  note mn = "1.prems"(6)
+  note all_less_xxs = "1.prems"(7)
+  note D0 = "1.prems"(8)
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  have "reduce_below_abs a ([] @ [m]) D A $$ (a, 0) = reduce_below_abs a [m] D A $$ (a, 0)" by auto
+  also have "... = reduce_abs a m D A $$ (a, 0)" by auto
+  also have "... \<noteq> 0"
+    by (rule reduce_not0[OF A _ a n _ Aaj D0], insert a n, auto)
+  finally show ?case .
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note n = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note x_less_xxs = "2.prems"(7)
+  note D0= "2.prems"(8)
+  have xm: "x < m" using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce_abs a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m+n) n"
+    by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
+  have h: "reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (a,0) \<noteq> 0"
+  proof (rule "2.hyps")
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ _ _ _ D0], insert x_less_xxs j Aaj, auto)
+    let ?reduce_ax' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "?reduce_ax = ?reduce_ax' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule reduce_append_rows_eq[OF A' A_def a xm n Aaj])
+  qed (insert A a j Aaj x_less_xxs xm reduce_ax mn D0, auto)
+  thus ?case by auto
+qed
+
+
+
+
+
+lemma reduce_below_invertible_mat:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "m\<ge>n"
+    and "D>0"
+  shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below a xs D A = P * A)"
+  using assms
+proof (induct a xs D A arbitrary: A' rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case
+    by (metis append_rows_def carrier_matD(1) index_mat_four_block(2) reduce_below.simps(1)
+        index_smult_mat(2) index_zero_mat(2) invertible_mat_one left_mult_one_mat' one_carrier_mat)
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note d = "2.prems"(6)
+  note x_less_xxs = "2.prems"(7)
+  note mn = "2.prems"(8)
+  note D_ge0 = "2.prems"(9)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  have xm: "x < m" using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
+    \<and> reduce_below a xs D (reduce a x D A) = P * reduce a x D A)"
+  proof (rule "2.hyps"[OF _ a j _ _ ])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+  qed (insert mn d x_less_xxs D_ge0, auto)
+  from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
+    and rb_Pr: "reduce_below a xs D (reduce a x D A) = P * reduce a x D A" by blast
+  have *: "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" by simp
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce a x D A) = Q * A"
+    by (rule reduce_invertible_mat[OF A' a j xm _ A_def Aaj ], insert "2.prems", auto)
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
+    and r_QA: "reduce a x D A = Q * A" by blast
+  have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
+  moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
+  moreover have "reduce_below a (x # xs) D A = (P*Q) * A" 
+    by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
+        r_QA rb_Pr reduce_preserves_dimensions(1))
+  ultimately show ?case by blast
+qed
+
+
+lemma reduce_below_abs_invertible_mat:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "m\<ge>n"
+    and "D>0"
+  shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below_abs a xs D A = P * A)"
+  using assms
+proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct)
+  case (1 a D A)
+  then show ?case
+    by (metis carrier_append_rows invertible_mat_one left_mult_one_mat one_carrier_mat
+        reduce_below_abs.simps(1) smult_carrier_mat)
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note d = "2.prems"(6)
+  note x_less_xxs = "2.prems"(7)
+  note mn = "2.prems"(8)
+  note D_ge0 = "2.prems"(9)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  have xm: "x < m" using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce_abs a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
+    \<and> reduce_below_abs a xs D (reduce_abs a x D A) = P * reduce_abs a x D A)"
+  proof (rule "2.hyps"[OF _ a j _ _ ])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+  qed (insert mn d x_less_xxs D_ge0, auto)
+  from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
+    and rb_Pr: "reduce_below_abs a xs D (reduce_abs a x D A) = P * reduce_abs a x D A" by blast
+  have *: "reduce_below_abs a (x # xs) D A = reduce_below_abs a xs D (reduce_abs a x D A)" by simp
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a x D A) = Q * A"
+    by (rule reduce_abs_invertible_mat[OF A' a j xm _ A_def Aaj ], insert "2.prems", auto)
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
+    and r_QA: "reduce_abs a x D A = Q * A" by blast
+  have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
+  moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
+  moreover have "reduce_below_abs a (x # xs) D A = (P*Q) * A" 
+    by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
+        r_QA rb_Pr reduce_preserves_dimensions(3))
+  ultimately show ?case by blast
+qed
+
+
+
+lemma reduce_below_preserves:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m+n"
+  and "D>0"
+  shows "reduce_below a xs D A $$ (i,j) = A $$ (i,j)"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note ia = "2.prems"(10)
+  note imm = "2.prems"(11)
+  note D_ge0 = "2.prems"(12)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) 2 add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below a (x # xs) D A $$ (i, j) = reduce_below a xs D (reduce a x D A) $$ (i, j)"
+    by auto
+  also have "... = reduce a x D A $$ (i, j)"
+  proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
+    show "i \<notin> set xs" using i_set_xxs by auto
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    show "?A' \<in> carrier_mat m n" by auto    
+  qed  
+  also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
+  finally show ?case .
+qed
+
+
+
+
+lemma reduce_below_abs_preserves:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m+n"
+  and "D>0"
+  shows "reduce_below_abs a xs D A $$ (i,j) = A $$ (i,j)"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note ia = "2.prems"(10)
+  note imm = "2.prems"(11)
+  note D_ge0 = "2.prems"(12)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce_abs a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) 2 add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below_abs a (x # xs) D A $$ (i, j) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, j)"
+    by auto
+  also have "... = reduce_abs a x D A $$ (i, j)"
+  proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
+    show "i \<notin> set xs" using i_set_xxs by auto
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    show "?A' \<in> carrier_mat m n" by auto    
+  qed  
+  also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
+  finally show ?case .
+qed
+
+
+
+lemma reduce_below_0:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D>0"
+  shows "reduce_below a xs D A $$ (i,0) = 0"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note D_ge0 = "2.prems"(10)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  show ?case
+  proof (cases "i=x")
+    case True
+    have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
+      by auto
+    also have "... = (reduce a x D A) $$ (i, 0)"
+    proof (rule reduce_below_preserves[OF _ a j _ _ mn ])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+        by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])      
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto
+      show "i \<notin> set xs" using True d by auto
+      show "i \<noteq> a" using "2.prems" by blast
+      show "i < m + n"
+        by (simp add: True trans_less_add1 xm)
+    qed (insert D_ge0)
+    also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto)
+    finally show ?thesis .
+  next
+    case False note i_not_x = False    
+    have h: "reduce_below a xs D (reduce a x D A) $$ (i, 0) = 0 "
+    proof (rule "2.hyps"[OF _ a j _ _ mn])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
+        show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
+        proof (rule+)
+          fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+          have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
+          have i_not_a: "i \<noteq> a" using i a by auto
+          have i_not_x: "i \<noteq> x" using i xm by auto
+          have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
+          also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
+            by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
+          finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
+        qed
+      qed
+      show "i \<in> set xs" using i_set_xxs i_not_x by auto
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto
+    qed (insert D_ge0)
+    have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
+      by auto
+    also have "... = 0" using h .
+    finally show ?thesis .
+  qed
+qed
+
+lemma reduce_below_abs_0:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D>0"
+  shows "reduce_below_abs a xs D A $$ (i,0) = 0"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note D_ge0 = "2.prems"(10)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce_abs a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  show ?case
+  proof (cases "i=x")
+    case True
+    have "reduce_below_abs a (x # xs) D A $$ (i, 0) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)"
+      by auto
+    also have "... = (reduce_abs a x D A) $$ (i, 0)"
+    proof (rule reduce_below_abs_preserves[OF _ a j _ _ mn ])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+        by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])      
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto
+      show "i \<notin> set xs" using True d by auto
+      show "i \<noteq> a" using "2.prems" by blast
+      show "i < m + n"
+        by (simp add: True trans_less_add1 xm)
+    qed (insert D_ge0)
+    also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto)
+    finally show ?thesis .
+  next
+    case False note i_not_x = False    
+    have h: "reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0) = 0 "
+    proof (rule "2.hyps"[OF _ a j _ _ mn])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
+        show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
+        proof (rule+)
+          fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+          have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
+          have i_not_a: "i \<noteq> a" using i a by auto
+          have i_not_x: "i \<noteq> x" using i xm by auto
+          have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
+          also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
+            by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
+          finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
+        qed
+      qed
+      show "i \<in> set xs" using i_set_xxs i_not_x by auto
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto
+    qed (insert D_ge0)
+    have "reduce_below_abs a (x # xs) D A $$ (i, 0) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)"
+      by auto
+    also have "... = 0" using h .
+    finally show ?thesis .
+  qed
+qed
+
+
+
+
+lemma reduce_below_preserves_case_m:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m+n" and "i\<noteq> m"
+  and "D>0"
+  shows "reduce_below a (xs @ [m]) D A $$ (i,j) = A $$ (i,j)"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
+  case (1 a D A)
+  have "reduce_below a ([] @ [m]) D A $$ (i, j) =  reduce_below a [m] D A $$ (i, j)" by auto
+  also have "... = reduce a m D A $$ (i,j)" by auto
+  also have "... = A $$ (i,j)"
+    by (rule reduce_preserves, insert "1", auto)
+  finally show ?case .
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note ia = "2.prems"(10)
+  note imm = "2.prems"(11)
+  note D_ge0 = "2.prems"(13)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) A' A_def add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below a ((x # xs) @ [m]) D A $$ (i, j) 
+      = reduce_below a (xs@[m]) D (reduce a x D A) $$ (i, j)"
+    by auto
+  also have "... = reduce a x D A $$ (i, j)"
+  proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm _ D_ge0])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
+    show "i \<notin> set xs" using i_set_xxs by auto
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    show "?A' \<in> carrier_mat m n" by auto    
+    show "i\<noteq>m" using "2.prems" by auto
+  qed  
+  also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
+  finally show ?case .
+qed
+
+
+lemma reduce_below_abs_preserves_case_m:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m+n" and "i\<noteq> m"
+  and "D>0"
+  shows "reduce_below_abs a (xs @ [m]) D A $$ (i,j) = A $$ (i,j)"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
+  case (1 a D A)
+  have "reduce_below_abs a ([] @ [m]) D A $$ (i, j) = reduce_below_abs a [m] D A $$ (i, j)" by auto
+  also have "... = reduce_abs a m D A $$ (i,j)" by auto
+  also have "... = A $$ (i,j)"
+    by (rule reduce_preserves, insert "1", auto)
+  finally show ?case .
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note ia = "2.prems"(10)
+  note imm = "2.prems"(11)
+  note D_ge0 = "2.prems"(13)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce_abs a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) A' A_def add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, j) 
+      = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (i, j)"
+    by auto
+  also have "... = reduce_abs a x D A $$ (i, j)"
+  proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm _ D_ge0])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
+    show "i \<notin> set xs" using i_set_xxs by auto
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    show "?A' \<in> carrier_mat m n" by auto    
+    show "i\<noteq>m" using "2.prems" by auto
+  qed  
+  also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
+  finally show ?case .
+qed
+
+
+
+lemma reduce_below_0_case_m1:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "m\<noteq>a"
+  and "D>0"
+  shows "reduce_below a (xs @ [m]) D A $$ (m,0) = 0"
+  using assms
+proof (induct a xs D A arbitrary: A' rule: reduce_below.induct)
+  case (1 a D A)
+  have A: "A \<in> carrier_mat (m+n) n" using "1" by auto
+  have " reduce_below a ([] @ [m]) D A $$ (m, 0) =  reduce_below a [m] D A $$ (m, 0)" by auto
+  also have "... = reduce a m D A $$ (m,0)" by auto
+  also have "... = 0" by (rule reduce_0[OF A], insert "1.prems", auto)
+  finally show ?case .
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note d = "2.prems"(7)
+  note xxs_less_m = "2.prems"(8)
+  note ma = "2.prems"(9)
+  note D_ge0 = "2.prems"(10)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below a ((x # xs) @ [m]) D A $$ (m, 0) = reduce_below a (xs@[m]) D (reduce a x D A) $$ (m, 0)"
+    by auto
+  also have "... = 0"
+  proof (rule "2.hyps"[OF ])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+    show "?A' \<in> carrier_mat m n" by auto    
+  qed (insert "2.prems", auto)
+  finally show ?case .
+qed
+
+lemma reduce_below_abs_0_case_m1:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "m\<noteq>a"
+  and "D>0"
+  shows "reduce_below_abs a (xs @ [m]) D A $$ (m,0) = 0"
+  using assms
+proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct)
+  case (1 a D A)
+  have A: "A \<in> carrier_mat (m+n) n" using "1" by auto
+  have " reduce_below_abs a ([] @ [m]) D A $$ (m, 0) =  reduce_below_abs a [m] D A $$ (m, 0)" by auto
+  also have "... = reduce_abs a m D A $$ (m,0)" by auto
+  also have "... = 0" by (rule reduce_0[OF A], insert "1.prems", auto)
+  finally show ?case .
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note d = "2.prems"(7)
+  note xxs_less_m = "2.prems"(8)
+  note ma = "2.prems"(9)
+  note D_ge0 = "2.prems"(10)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce_abs a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (m, 0) = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (m, 0)"
+    by auto
+  also have "... = 0"
+  proof (rule "2.hyps"[OF ])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+    show "?A' \<in> carrier_mat m n" by auto    
+  qed (insert "2.prems", auto)
+  finally show ?case .
+qed
+
+
+
+lemma reduce_below_preserves_case_m2:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m+n"
+  and "D>0"
+  shows "reduce_below a (xs @ [m]) D A $$ (i,0) = reduce_below a xs D A $$ (i,0)"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note ia = "2.prems"(10)
+  note imm = "2.prems"(11)
+  note D_ge0 = "2.prems"(12)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) A_def A' add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  show ?case
+  proof (cases "i=x")
+    case True
+    have "reduce_below a ((x # xs) @ [m]) D A $$ (i, 0) 
+      = reduce_below a (xs @ [m]) D (reduce a x D A) $$ (i, 0)"
+      by auto
+    also have "... = (reduce a x D A) $$ (i, 0)"
+    proof (rule reduce_below_preserves_case_m[OF _ a j _ _ mn _ _ _ _ _ _ D_ge0])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
+        show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
+        proof (rule+)
+          fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+          have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
+          have i_not_a: "i \<noteq> a" using i a by auto
+          have i_not_x: "i \<noteq> x" using i xm by auto
+          have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
+          also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
+            by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
+          finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
+        qed
+      qed
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto
+      show "i \<notin> set xs" using True d by auto
+      show "i \<noteq> a" using "2.prems" by blast
+      show "i < m + n" 
+        by (simp add: True trans_less_add1 xm)
+      show "i \<noteq> m"  by (simp add: True less_not_refl3 xm)
+    qed
+    also have "... = 0" unfolding True by (rule reduce_0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    also have "... = reduce_below a (x # xs) D A $$ (i, 0) "
+      unfolding True by (rule reduce_below_0[symmetric], insert "2.prems", auto)
+    finally show ?thesis .
+  next
+    case False
+    have "reduce_below a ((x # xs) @ [m]) D A $$ (i, 0) 
+      = reduce_below a (xs@[m]) D (reduce a x D A) $$ (i, 0)"
+      by auto
+    also have "... = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
+    proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+        by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
+      show "i \<in> set xs" using i_set_xxs False by auto
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto    
+    qed  
+    also have "... = reduce_below a (x # xs) D A $$ (i, 0)" by auto
+    finally show ?thesis .
+  qed
+qed
+
+
+lemma reduce_below_abs_preserves_case_m2:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m+n"
+  and "D>0"
+  shows "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = reduce_below_abs a xs D A $$ (i,0)"
+  using assms
+proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note i_set_xxs = "2.prems"(7)
+  note d = "2.prems"(8)
+  note xxs_less_m = "2.prems"(9)
+  note ia = "2.prems"(10)
+  note imm = "2.prems"(11)
+  note D_ge0 = "2.prems"(12)
+  have D0: "D\<noteq>0" using D_ge0 by simp
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce_abs a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) A_def A' add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  show ?case
+  proof (cases "i=x")
+    case True
+    have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, 0) 
+      = reduce_below_abs a (xs @ [m]) D (reduce_abs a x D A) $$ (i, 0)"
+      by auto
+    also have "... = (reduce_abs a x D A) $$ (i, 0)"
+    proof (rule reduce_below_abs_preserves_case_m[OF _ a j _ _ mn _ _ _ _ _ _ D_ge0])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
+        show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
+        proof (rule+)
+          fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
+          have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
+          have i_not_a: "i \<noteq> a" using i a by auto
+          have i_not_x: "i \<noteq> x" using i xm by auto
+          have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
+            unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
+          also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
+            by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
+          finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
+        qed
+      qed
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto
+      show "i \<notin> set xs" using True d by auto
+      show "i \<noteq> a" using "2.prems" by blast
+      show "i < m + n" 
+        by (simp add: True trans_less_add1 xm)
+      show "i \<noteq> m"  by (simp add: True less_not_refl3 xm)
+    qed
+    also have "... = 0" unfolding True by (rule reduce_0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    also have "... = reduce_below_abs a (x # xs) D A $$ (i, 0) "
+      unfolding True by (rule reduce_below_abs_0[symmetric], insert "2.prems", auto)
+    finally show ?thesis .
+  next
+    case False
+    have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, 0) 
+      = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (i, 0)"
+      by auto
+    also have "... = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)"
+    proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
+      let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+      show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+        by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
+      show "i \<in> set xs" using i_set_xxs False by auto
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+        by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "?A' \<in> carrier_mat m n" by auto    
+    qed  
+    also have "... = reduce_below_abs a (x # xs) D A $$ (i, 0)" by auto
+    finally show ?thesis .
+  qed
+qed
+
+
+lemma reduce_below_0_case_m:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<in> set (xs @ [m])" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D>0"
+  shows "reduce_below a (xs @ [m]) D A $$ (i,0) = 0"
+proof (cases "i=m")
+  case True
+  show ?thesis by (unfold True, rule reduce_below_0_case_m1, insert assms, auto)
+next
+  case False
+  have "reduce_below a (xs @ [m]) D A $$ (i,0) = reduce_below a (xs) D A $$ (i,0)"
+    by (rule reduce_below_preserves_case_m2[OF A' a j A_def Aaj mn], insert assms False, auto) 
+  also have "... = 0" by (rule reduce_below_0, insert assms False, auto)
+  finally show ?thesis .
+qed
+
+
+lemma reduce_below_abs_0_case_m:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes "i \<in> set (xs @ [m])" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D>0"
+  shows "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = 0"
+proof (cases "i=m")
+  case True
+  show ?thesis by (unfold True, rule reduce_below_abs_0_case_m1, insert assms, auto)
+next
+  case False
+  have "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = reduce_below_abs a (xs) D A $$ (i,0)"
+    by (rule reduce_below_abs_preserves_case_m2[OF A' a j A_def Aaj mn], insert assms False, auto) 
+  also have "... = 0" by (rule reduce_below_abs_0, insert assms False, auto)
+  finally show ?thesis .
+qed
+
+
+lemma reduce_below_0_case_m_complete:
+  assumes A': "A' \<in> carrier_mat m n" and a: "0<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (0,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
+    and ia: "i\<noteq>0"
+  and xs_def: "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and D: "D>0"
+  shows "reduce_below 0 (xs @ [m]) D A $$ (i,0) = 0"
+proof (cases "i \<in> set (xs @ [m])")
+  case True
+  show ?thesis by (rule reduce_below_0_case_m[OF A' a j A_def Aaj mn True d_xs xs D])
+next
+  case False
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by simp
+  have "reduce_below 0 (xs @ [m]) D A $$ (i,0) = A $$ (i,0)"    
+    by (rule reduce_below_preserves_case_m[OF A' a j A_def Aaj mn _ _ _ _ _ _ D],
+        insert i_mn d_xs xs ia False, auto) 
+  also have "... = 0"  using False ia i_mn A unfolding xs_def by auto    
+  finally show ?thesis .
+qed
+
+
+
+lemma reduce_below_abs_0_case_m_complete:
+  assumes A': "A' \<in> carrier_mat m n" and a: "0<m" and j: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (0,0) \<noteq> 0"
+    and mn: "m\<ge>n"
+  assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
+    and ia: "i\<noteq>0"
+  and xs_def: "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and D: "D>0"
+  shows "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = 0"
+proof (cases "i \<in> set (xs @ [m])")
+  case True
+  show ?thesis by (rule reduce_below_abs_0_case_m[OF A' a j A_def Aaj mn True d_xs xs D])
+next
+  case False
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by simp
+  have "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = A $$ (i,0)"    
+    by (rule reduce_below_abs_preserves_case_m[OF A' a j A_def Aaj mn _ _ _ _ _ _ D],
+        insert i_mn d_xs xs ia False, auto) 
+  also have "... = 0"  using False ia i_mn A unfolding xs_def by auto    
+  finally show ?thesis .
+qed
+
+
+(*Now we take care of the mth row of A*)
+lemma reduce_below_invertible_mat_case_m:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and n0: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x" 
+    and D0: "D>0"
+  shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below a (xs@[m]) D A = P * A)"
+  using assms
+proof (induct a xs D A arbitrary: A' rule: reduce_below.induct)
+  case (1 a D A)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
+    by (metis prod_cases5)
+  have D: "D \<cdot>\<^sub>m (1\<^sub>m n) : carrier_mat n n" by auto
+  note A' = "1.prems"(1)
+  note a = "1.prems"(2)
+  note j = "1.prems"(3)
+  note A_def = "1.prems"(4)
+  note Aaj = "1.prems"(5)
+  note mn = "1.prems"(6)  
+  note D0 = "1.prems"(9)
+  have Am0_D: "A $$ (m, 0) = D"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
+      by (smt (z3) "1"(1) "1"(3) "1"(4) D append_rows_nth3 diff_is_0_eq diff_self_eq_0 less_add_same_cancel1)
+    also have "... = D" by (simp add: n0)
+    finally show ?thesis .
+  qed
+  have "reduce_below a ([]@[m]) D A = reduce a m D A" by auto
+  let ?A = "Matrix.mat (dim_row A) (dim_col A) 
+      (\<lambda>(i, k). if i = a then p * A $$ (a, k) + q * A $$ (m, k) else 
+        if i = m then u * A $$ (a, k) + v * A $$ (m, k) else A $$ (i, k))"
+  let ?xs = "[1..<n]"
+  let ?ys = "[1..<n]"  
+  have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce a m D A = P * A"
+    by (rule reduce_invertible_mat_case_m[OF A' D a _ A_def _ Aaj mn n0 pquvd, of ?xs _ _ ?ys],
+        insert a D0 Am0_D, auto)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note n0 = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note d = "2.prems"(7)
+  note xxs_less_m = "2.prems"(8)
+  note D0 = "2.prems"(9)
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  have Am0_D: "A $$ (m, 0) = D"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
+      by (smt (z3) "2"(2) "2"(4) "2"(5) D1 append_rows_nth3 
+          cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq less_add_same_cancel1)
+    also have "... = D" by (simp add: n0)
+    finally show ?thesis .
+  qed
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
+    \<and> reduce_below a (xs@[m]) D (reduce a x D A) = P * reduce a x D A)"
+  proof (rule "2.hyps"[OF _ a n0 _ _ ])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj])  
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ n0 _ Aaj], insert "2.prems", auto)
+  qed (insert d xxs_less_m mn n0 D0, auto)
+  from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
+    and rb_Pr: "reduce_below a (xs@[m]) D (reduce a x D A) = P * reduce a x D A" by blast
+  have *: "reduce_below a ((x # xs)@[m]) D A = reduce_below a (xs@[m]) D (reduce a x D A)" by simp
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce a x D A) = Q * A"
+    by (rule reduce_invertible_mat[OF A' a n0 xm _ A_def Aaj _ mn D0], insert xxs_less_m, auto)
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
+    and r_QA: "reduce a x D A = Q * A" by blast
+  have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
+  moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
+  moreover have "reduce_below a ((x # xs)@[m]) D A = (P*Q) * A" 
+    by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
+        r_QA rb_Pr reduce_preserves_dimensions(1))
+  ultimately show ?case by blast
+qed
+
+
+
+
+(*Now we take care of the mth row of A*)
+lemma reduce_below_abs_invertible_mat_case_m:
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and n0: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+    and mn: "m\<ge>n" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x" 
+    and D0: "D>0"
+  shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below_abs a (xs@[m]) D A = P * A)"
+  using assms
+proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct)
+  case (1 a D A)
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
+    by (metis prod_cases5)
+  have D: "D \<cdot>\<^sub>m (1\<^sub>m n) : carrier_mat n n" by auto
+  note A' = "1.prems"(1)
+  note a = "1.prems"(2)
+  note j = "1.prems"(3)
+  note A_def = "1.prems"(4)
+  note Aaj = "1.prems"(5)
+  note mn = "1.prems"(6)  
+  note D0 = "1.prems"(9)
+  have Am0_D: "A $$ (m, 0) = D"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
+      by (smt (z3) "1"(1) "1"(3) "1"(4) D append_rows_nth3 diff_is_0_eq diff_self_eq_0 less_add_same_cancel1)
+    also have "... = D" by (simp add: n0)
+    finally show ?thesis .
+  qed
+  have "reduce_below_abs a ([]@[m]) D A = reduce_abs a m D A" by auto
+  let ?A = "Matrix.mat (dim_row A) (dim_col A) 
+      (\<lambda>(i, k). if i = a then p * A $$ (a, k) + q * A $$ (m, k) else 
+        if i = m then u * A $$ (a, k) + v * A $$ (m, k) else A $$ (i, k))"
+  let ?xs = "filter (\<lambda>i. D < \<bar>?A $$ (a, i)\<bar>) [0..<n]"
+  let ?ys = "filter (\<lambda>i. D < \<bar>?A $$ (m, i)\<bar>) [0..<n]"  
+  have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce_abs a m D A = P * A"
+    by (rule reduce_abs_invertible_mat_case_m[OF A' D a _ A_def _ Aaj mn n0 pquvd, of ?xs _ _ ?ys],
+        insert a D0 Am0_D, auto)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A' = "2.prems"(1)
+  note a = "2.prems"(2)
+  note n0 = "2.prems"(3)
+  note A_def = "2.prems"(4)
+  note Aaj = "2.prems"(5)
+  note mn = "2.prems"(6)
+  note d = "2.prems"(7)
+  note xxs_less_m = "2.prems"(8)
+  note D0 = "2.prems"(9)
+  have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
+  have xm: "x < m"  using "2.prems" by auto
+  have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
+  have Am0_D: "A $$ (m, 0) = D"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
+      by (smt (z3) "2"(2) "2"(4) "2"(5) D1 append_rows_nth3 
+          cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq less_add_same_cancel1)
+    also have "... = D" by (simp add: n0)
+    finally show ?thesis .
+  qed
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce_abs a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
+    \<and> reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) = P * reduce_abs a x D A)"
+  proof (rule "2.hyps"[OF _ a n0 _ _ ])
+    let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
+    show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+      by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj])  
+    show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
+      by (rule reduce_not0[OF A _ _ n0 _ Aaj], insert "2.prems", auto)
+  qed (insert d xxs_less_m mn n0 D0, auto)
+  from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
+    and rb_Pr: "reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) = P * reduce_abs a x D A" by blast
+  have *: "reduce_below_abs a ((x # xs)@[m]) D A = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A)" by simp
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a x D A) = Q * A"
+    by (rule reduce_abs_invertible_mat[OF A' a n0 xm _ A_def Aaj _ mn D0], insert xxs_less_m, auto)
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
+    and r_QA: "reduce_abs a x D A = Q * A" by blast
+  have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
+  moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
+  moreover have "reduce_below_abs a ((x # xs)@[m]) D A = (P*Q) * A" 
+    by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
+        r_QA rb_Pr reduce_preserves_dimensions(3))
+  ultimately show ?case by blast
+qed
+
+end
+
+hide_const (open) C
+
+text \<open>This lemma will be very important, since it will allow us to prove that the output
+matrix is in echelon form.\<close>
+
+lemma echelon_form_four_block_mat:
+  assumes A: "A \<in> carrier_mat 1 1"
+  and B: "B \<in> carrier_mat 1 (n-1)"
+  and D: "D \<in> carrier_mat (m-1) (n-1)"
+  and H_def: "H = four_block_mat A B (0\<^sub>m (m-1) 1) D"
+  and A00: "A $$ (0,0) \<noteq> 0"
+  and e_D: "echelon_form_JNF D"
+  and m: "m>0" and n: "n>0"
+shows "echelon_form_JNF H"
+proof (rule echelon_form_JNF_intro)
+  have H: "H \<in> carrier_mat m n"
+    by (metis H_def Num.numeral_nat(7) A D m n carrier_matD carrier_mat_triv
+        index_mat_four_block(2,3) linordered_semidom_class.add_diff_inverse not_less_eq)
+  have Hij_Dij: "H $$ (i+1,j+1) = D $$ (i,j)" if i: "i<m-1" and j: "j<n-1" for i j
+  proof -
+    have "H $$ (i+1,j+1) =  (if (i+1) < dim_row A then if (j+1) < dim_col A then A $$ ((i+1), (j+1)) 
+    else B $$ ((i+1), (j+1) - dim_col A) else if (j+1) < dim_col A then 
+    (0\<^sub>m (m-1) 1) $$ ((i+1) - dim_row A, (j+1)) else D $$ ((i+1) - dim_row A, (j+1) - dim_col A))"
+      unfolding H_def by (rule index_mat_four_block, insert A D i j, auto)
+    also have "... = D $$ ((i+1) - dim_row A, (j+1) - dim_col A)" using A D i j B m n by auto
+    also have "... = D $$ (i,j)" using A by auto
+    finally show ?thesis .
+  qed
+  have Hij_Dij':  "H $$ (i,j) = D $$ (i-1,j-1)" 
+    if i: "i<m" and j: "j<n" and i0: "i>0" and j0: "j>0" for i j
+    by (metis (no_types, lifting) H H_def Num.numeral_nat(7) A carrier_matD 
+        index_mat_four_block less_Suc0 less_not_refl3 i j i0 j0)
+  have Hi0: "H$$(i,0) = 0" if i: "i\<in>{1..<m}" for i
+  proof -
+    have "H $$ (i,0) =  (if i < dim_row A then if 0 < dim_col A then A $$ (i, 0) 
+      else B $$ (i, 0 - dim_col A) else if 0 < dim_col A then 
+      (0\<^sub>m (m-1) 1) $$ (i - dim_row A, 0) else D $$ (i - dim_row A, 0 - dim_col A))"
+      unfolding H_def by (rule index_mat_four_block, insert A D i, auto)
+    also have "... = (0\<^sub>m (m-1) 1) $$ (i - dim_row A, 0)" using A D i m n by auto
+    also have "... = 0" using i A n by auto
+    finally show ?thesis .
+  qed
+  have A00_H00: "A $$ (0,0) = H $$ (0,0)" unfolding H_def using A by auto
+  have "is_zero_row_JNF j H" if zero_iH: "is_zero_row_JNF i H" and ij: "i < j" and j: "j < dim_row H"
+    for i j 
+  proof -
+    have "\<not> is_zero_row_JNF 0 H" unfolding is_zero_row_JNF_def using m n H A00 A00_H00 by auto
+    hence i_not0: "i\<noteq>0" using zero_iH by meson
+    have "is_zero_row_JNF (i-1) D" using zero_iH i_not0 Hij_Dij m n D H unfolding is_zero_row_JNF_def
+      by (auto, smt (z3) Suc_leI carrier_matD(1) le_add_diff_inverse2 Hij_Dij One_nat_def Suc_pred carrier_matD(1) j le_add_diff_inverse2
+          less_diff_conv less_imp_add_positive plus_1_eq_Suc that(2) trans_less_add1)
+    hence "is_zero_row_JNF (j-1) D" using ij e_D D j m i_not0 unfolding echelon_form_JNF_def
+      by (auto, smt H Nat.lessE Suc_pred carrier_matD(1) diff_Suc_1 diff_Suc_less order.strict_trans)
+    thus ?thesis
+      by (smt A H H_def Hi0 D atLeastLessThan_iff carrier_matD index_mat_four_block(1)
+          is_zero_row_JNF_def le_add1 less_one linordered_semidom_class.add_diff_inverse not_less_eq
+          plus_1_eq_Suc ij j zero_order(3))
+  qed
+  thus "\<forall>i<dim_row H. is_zero_row_JNF i H \<longrightarrow> \<not> (\<exists>j<dim_row H. i < j \<and> \<not> is_zero_row_JNF j H)"
+    by blast
+  have "(LEAST n. H $$ (i, n) \<noteq> 0) < (LEAST n. H $$ (j, n) \<noteq> 0)"
+    if ij: "i < j" and j: "j < dim_row H" and not_zero_iH: "\<not> is_zero_row_JNF i H" 
+    and not_zero_jH: "\<not> is_zero_row_JNF j H" for i j
+  proof (cases "i = 0")
+    case True
+    have "(LEAST n. H $$ (i, n) \<noteq> 0) = 0" unfolding True using A00_H00 A00 by auto
+    then show ?thesis
+      by (metis (mono_tags) H Hi0 LeastI True atLeastLessThan_iff carrier_matD(1) 
+          is_zero_row_JNF_def leI less_one not_gr0 ij j not_zero_jH)
+  next
+    case False note i_not0 = False
+    let ?least_H = "(LEAST n. H $$ (i, n) \<noteq> 0)"
+    let ?least_Hj = "(LEAST n. H $$ (j, n) \<noteq> 0)"
+
+    have least_not0: "(LEAST n. H $$ (i, n) \<noteq> 0) \<noteq> 0" 
+    proof -
+      have "\<exists>n. H $$ (i, n) \<noteq> 0 \<and> H $$ (i, 0) = 0"
+        by (metis (no_types) False H Hi0 Num.numeral_nat(7) atLeastLessThan_iff carrier_matD(1)
+            is_zero_row_JNF_def j nat_LEAST_True nat_neq_iff not_less_Least not_less_eq order.strict_trans
+            ij not_zero_iH wellorder_Least_lemma(1) wellorder_Least_lemma(2))
+      then show ?thesis
+        by (metis (mono_tags, lifting) LeastI_ex)
+    qed
+    have least_not0j: "(LEAST n. H $$ (j, n) \<noteq> 0) \<noteq> 0"
+    proof -
+      have "\<exists>n. H $$ (j, 0) = 0 \<and> H $$ (j, n) \<noteq> 0"
+        by (metis (no_types) H Hi0 LeastI_ex Num.numeral_nat(7) atLeastLessThan_iff carrier_matD(1)
+            is_zero_row_JNF_def linorder_neqE_nat not_gr0 not_less_Least not_less_eq order_trans_rules(19)
+            ij j not_zero_jH wellorder_Least_lemma(2))
+      then show ?thesis
+        by (metis (mono_tags, lifting) LeastI_ex)
+    qed
+    have least_n: "?least_H<n"
+      by (smt H carrier_matD(2) dual_order.strict_trans is_zero_row_JNF_def 
+          not_less_Least not_less_iff_gr_or_eq not_zero_iH)
+    have Hil: "H $$ (i,?least_H) \<noteq> 0" and ln':"(\<forall>n'. (H $$ (i, n') \<noteq> 0) \<longrightarrow> ?least_H \<le> n')" 
+      by (metis (mono_tags, lifting) is_zero_row_JNF_def that(3) wellorder_Least_lemma)+
+    have Hil_Dil: "H $$ (i,?least_H) = D $$ (i-1,?least_H - 1)"      
+    proof -
+      have "H $$ (i,?least_H) = (if i < dim_row A then if ?least_H < dim_col A then A $$ (i, ?least_H) 
+      else B $$ (i, ?least_H - dim_col A) else if ?least_H < dim_col A then 
+      (0\<^sub>m (m-1) 1) $$ (i - dim_row A, ?least_H) else D $$ (i - dim_row A, ?least_H - dim_col A))"
+        unfolding H_def
+        by (rule index_mat_four_block, insert False j ij H A D n least_n, auto simp add: H_def)
+      also have "... = D $$ (i - 1, ?least_H - 1)"
+        using False j ij H A D n least_n B Hi0 Hil by auto
+      finally show ?thesis .
+    qed
+    have not_zero_iD: "\<not> is_zero_row_JNF (i-1) D" 
+      by (metis (no_types, lifting) Hil Hil_Dil D carrier_matD(2) is_zero_row_JNF_def le_add1 
+          le_add_diff_inverse2 least_n least_not0 less_diff_conv less_one
+          linordered_semidom_class.add_diff_inverse)
+    have not_zero_jD: "\<not> is_zero_row_JNF (j-1) D"
+      by (smt H Hij_Dij' One_nat_def Suc_pred D m carrier_matD diff_Suc_1 ij is_zero_row_JNF_def j
+          least_not0j less_Suc0 less_Suc_eq_0_disj less_one neq0_conv not_less_Least not_less_eq
+          plus_1_eq_Suc not_zero_jH zero_order(3))
+    have "?least_H - 1 = (LEAST n. D $$ (i-1, n) \<noteq> 0 \<and> n<dim_col D)"
+    proof (rule Least_equality[symmetric], rule)
+      show "D $$ (i - 1, ?least_H - 1) \<noteq> 0" using Hil Hil_Dil by auto
+      show "(LEAST n. H $$ (i, n) \<noteq> 0) - 1 < dim_col D" using least_n least_not0 H D n by auto
+      fix n' assume "D $$ (i - 1, n') \<noteq> 0 \<and> n' < dim_col D" 
+      hence Di1n'1: "D $$ (i - 1, n') \<noteq> 0" and n': "n' < dim_col D" by auto
+      have "(LEAST n. H $$ (i, n) \<noteq> 0) \<le> n' + 1"
+      proof (rule Least_le)
+        have "H $$ (i, n'+1) = D $$ (i -1, (n'+1)-1)"
+          by (rule Hij_Dij', insert i_not0 False H A ij j n' D, auto)
+        thus Hin': "H $$ (i, n'+1) \<noteq> 0" using False Di1n'1 Hij_Dij' by auto
+      qed
+      thus  "(LEAST n. H $$ (i, n) \<noteq> 0) -1 \<le> n'" using least_not0 by auto
+    qed
+    also have "... = (LEAST n. D $$ (i-1, n) \<noteq> 0)"
+    proof (rule Least_equality)
+      have "D $$ (i - 1, LEAST n. D $$ (i - 1, n) \<noteq> 0) \<noteq> 0" 
+        by (metis (mono_tags, lifting) Hil Hil_Dil LeastI_ex)
+      moreover have leastD: "(LEAST n. D $$ (i - 1, n) \<noteq> 0) < dim_col D"
+        by (smt dual_order.strict_trans is_zero_row_JNF_def linorder_neqE_nat
+            not_less_Least not_zero_iD) 
+      ultimately show "D $$ (i - 1, LEAST n. D $$ (i - 1, n) \<noteq> 0) \<noteq> 0 
+        \<and> (LEAST n. D $$ (i - 1, n) \<noteq> 0) < dim_col D" by simp  
+      fix y assume "D $$ (i - 1, y) \<noteq> 0 \<and> y < dim_col D" 
+      thus "(LEAST n. D $$ (i - 1, n) \<noteq> 0) \<le> y" by (meson wellorder_Least_lemma(2))
+    qed
+    finally have leastHi_eq: "?least_H - 1 = (LEAST n. D $$ (i-1, n) \<noteq> 0)" .
+    have least_nj: "?least_Hj<n"
+      by (smt H carrier_matD(2) dual_order.strict_trans is_zero_row_JNF_def 
+          not_less_Least not_less_iff_gr_or_eq not_zero_jH)
+    have Hjl: "H $$ (j,?least_Hj) \<noteq> 0" and ln':"(\<forall>n'. (H $$ (j, n') \<noteq> 0) \<longrightarrow> ?least_Hj \<le> n')" 
+      by (metis (mono_tags, lifting) is_zero_row_JNF_def not_zero_jH wellorder_Least_lemma)+
+    have Hjl_Djl: "H $$ (j,?least_Hj) = D $$ (j-1,?least_Hj - 1)"      
+    proof -
+      have "H $$ (j,?least_Hj) = (if j < dim_row A then if ?least_Hj < dim_col A then A $$ (j, ?least_Hj) 
+      else B $$ (j, ?least_Hj - dim_col A) else if ?least_Hj < dim_col A then 
+      (0\<^sub>m (m-1) 1) $$ (j - dim_row A, ?least_Hj) else D $$ (j - dim_row A, ?least_Hj - dim_col A))"
+        unfolding H_def
+        by (rule index_mat_four_block, insert False j ij H A D n least_nj, auto simp add: H_def)
+      also have "... = D $$ (j - 1, ?least_Hj - 1)"
+        using False j ij H A D n least_n B Hi0 Hjl by auto
+      finally show ?thesis .
+    qed
+    have "(LEAST n. H $$ (j, n) \<noteq> 0) - 1 = (LEAST n. D $$ (j-1, n) \<noteq> 0 \<and> n<dim_col D)"
+    proof (rule Least_equality[symmetric], rule)
+      show "D $$ (j - 1, ?least_Hj - 1) \<noteq> 0" using Hil Hil_Dil
+        by (smt H Hij_Dij' LeastI_ex carrier_matD is_zero_row_JNF_def j least_not0j 
+            linorder_neqE_nat not_gr0 not_less_Least order.strict_trans ij not_zero_jH)
+      show "(LEAST n. H $$ (j, n) \<noteq> 0) - 1 < dim_col D" using least_nj least_not0j H D n by auto
+      fix n' assume "D $$ (j - 1, n') \<noteq> 0 \<and> n' < dim_col D" 
+      hence Di1n'1: "D $$ (j - 1, n') \<noteq> 0" and n': "n' < dim_col D" by auto
+      have "(LEAST n. H $$ (j, n) \<noteq> 0) \<le> n' + 1"
+      proof (rule Least_le)
+        have "H $$ (j, n'+1) = D $$ (j -1, (n'+1)-1)"
+          by (rule Hij_Dij', insert i_not0 False H A ij j n' D, auto)
+        thus Hin': "H $$ (j, n'+1) \<noteq> 0" using False Di1n'1 Hij_Dij' by auto
+      qed
+      thus  "(LEAST n. H $$ (j, n) \<noteq> 0) -1 \<le> n'" using least_not0 by auto
+    qed
+    also have "... = (LEAST n. D $$ (j-1, n) \<noteq> 0)"
+    proof (rule Least_equality)
+      have "D $$ (j - 1, LEAST n. D $$ (j - 1, n) \<noteq> 0) \<noteq> 0" 
+        by (metis (mono_tags, lifting) Hjl Hjl_Djl LeastI_ex)
+      moreover have leastD: "(LEAST n. D $$ (j - 1, n) \<noteq> 0) < dim_col D"
+        by (smt dual_order.strict_trans is_zero_row_JNF_def linorder_neqE_nat
+            not_less_Least not_zero_jD) 
+      ultimately show "D $$ (j - 1, LEAST n. D $$ (j - 1, n) \<noteq> 0) \<noteq> 0 
+        \<and> (LEAST n. D $$ (j - 1, n) \<noteq> 0) < dim_col D" by simp  
+      fix y assume "D $$ (j - 1, y) \<noteq> 0 \<and> y < dim_col D" 
+      thus "(LEAST n. D $$ (j - 1, n) \<noteq> 0) \<le> y" by (meson wellorder_Least_lemma(2))
+    qed
+    finally have leastHj_eq: "(LEAST n. H $$ (j, n) \<noteq> 0) - 1 = (LEAST n. D $$ (j-1, n) \<noteq> 0)" .
+    have ij': "i-1 < j-1" using ij False by auto
+    have "j-1 < dim_row D "  using D H ij j by auto
+    hence "(LEAST n. D $$ (i-1, n) \<noteq> 0) < (LEAST n. D $$ (j-1, n) \<noteq> 0)" 
+      using e_D echelon_form_JNF_def ij' not_zero_jD order.strict_trans by blast    
+    thus ?thesis using leastHj_eq leastHi_eq by auto
+  qed
+  thus "\<forall>i j. i < j \<and> j < dim_row H \<and> \<not> is_zero_row_JNF i H \<and> \<not> is_zero_row_JNF j H 
+  \<longrightarrow> (LEAST n. H $$ (i, n) \<noteq> 0) < (LEAST n. H $$ (j, n) \<noteq> 0)" by blast    
+qed
+
+context mod_operation
+begin
+
+
+lemma reduce_below:
+  assumes "A \<in> carrier_mat m n"
+  shows "reduce_below a xs D A \<in> carrier_mat m n" 
+  using assms 
+  by (induct a xs D A rule: reduce_below.induct, auto simp add: Let_def euclid_ext2_def) 
+
+lemma reduce_below_preserves_dimensions:
+ shows [simp]: "dim_row (reduce_below a xs D A) = dim_row A" 
+    and [simp]: "dim_col (reduce_below a xs D A) = dim_col A"
+  using reduce_below[of A "dim_row A" "dim_col A"] by auto
+
+
+lemma reduce_below_abs:
+  assumes "A \<in> carrier_mat m n"
+  shows "reduce_below_abs a xs D A \<in> carrier_mat m n" 
+  using assms 
+  by (induct a xs D A rule: reduce_below_abs.induct, auto simp add: Let_def euclid_ext2_def) 
+
+lemma reduce_below_abs_preserves_dimensions:
+ shows [simp]: "dim_row (reduce_below_abs a xs D A) = dim_row A" 
+    and [simp]: "dim_col (reduce_below_abs a xs D A) = dim_col A"
+  using reduce_below_abs[of A "dim_row A" "dim_col A"] by auto
+
+
+lemma FindPreHNF_1xn:
+ assumes A: "A \<in> carrier_mat m n" and "m<2 \<or> n = 0"
+ shows "FindPreHNF abs_flag D A \<in> carrier_mat m n" using assms by auto
+
+lemma FindPreHNF_mx1:
+ assumes A: "A \<in> carrier_mat m n" and "m\<ge>2" and "n \<noteq> 0" "n<2"
+ shows "FindPreHNF abs_flag D A \<in> carrier_mat m n"
+proof (cases "abs_flag")
+  case True
+  let ?nz = "(filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<m])"
+  have "FindPreHNF abs_flag D A =  (let non_zero_positions = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<m]
+     in reduce_below_abs 0 non_zero_positions D (if A $$ (0, 0) \<noteq> 0 then A else 
+  let i = non_zero_positions ! 0 in swaprows 0 i A))" 
+    using assms True by auto
+  also have "... =  reduce_below_abs 0 ?nz D (if A $$ (0, 0) \<noteq> 0 then A 
+  else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto
+  also have "... \<in> carrier_mat m n" using A by auto
+  finally show ?thesis .  
+next
+  case False
+  let ?nz = "(filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<m])"
+  have "FindPreHNF abs_flag D A =  (let non_zero_positions = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<m]
+     in reduce_below 0 non_zero_positions D (if A $$ (0, 0) \<noteq> 0 then A else 
+  let i = non_zero_positions ! 0 in swaprows 0 i A))" 
+    using assms False by auto
+  also have "... =  reduce_below 0 ?nz D (if A $$ (0, 0) \<noteq> 0 then A 
+  else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto
+  also have "... \<in> carrier_mat m n" using A by auto
+  finally show ?thesis .
+qed
+  
+
+lemma FindPreHNF_mxn2:
+ assumes A: "A \<in> carrier_mat m n" and m: "m\<ge>2" and n: "n\<ge>2"
+ shows "FindPreHNF abs_flag D A \<in> carrier_mat m n" 
+using assms
+proof (induct abs_flag D A arbitrary: m n rule: FindPreHNF.induct)
+  case (1 abs_flag D A)
+  note A = "1.prems"(1)
+  note m = "1.prems"(2)
+  note n = "1.prems"(3)
+  define non_zero_positions where "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  define A' where "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
+  define Reduce where [simp]: "Reduce = (if abs_flag then reduce_below_abs else reduce_below)"
+  obtain A'_UL A'_UR A'_DL A'_DR where A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
+    = split_block (Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1"     
+    by (metis prod_cases4)
+  define sub_PreHNF where "sub_PreHNF = FindPreHNF abs_flag D A'_DR"
+  have A': "A' \<in> carrier_mat m n" unfolding A'_def using A by auto
+  have A'_DR: "A'_DR \<in> carrier_mat (m -1) (n-1)"
+    by (cases abs_flag; rule split_block(4)[OF A'_split[symmetric]], insert Reduce_def A A' m n, auto)
+  have sub_PreHNF: "sub_PreHNF \<in> carrier_mat (m - 1) (n-1)"
+  proof (cases "m-1<2")
+    case True
+    show ?thesis using A'_DR True unfolding sub_PreHNF_def by auto
+  next
+    case False note m' = False
+    show ?thesis
+    proof (cases "n-1<2")
+      case True
+      show ?thesis 
+        unfolding sub_PreHNF_def by (rule FindPreHNF_mx1[OF A'_DR _ _ True], insert n m', auto)
+    next
+      case False
+      show ?thesis
+        by (unfold sub_PreHNF_def, rule "1.hyps"
+            [of m n, OF _ _ _ non_zero_positions_def A'_def Reduce_def _ A'_split _ _ _ A'_DR],
+            insert A False n m' Reduce_def, auto)
+    qed  
+  qed      
+  have A'_UL: "A'_UL \<in> carrier_mat 1 1"
+    by (cases abs_flag; rule split_block(1)[OF A'_split[symmetric], of "m-1" "n-1"], insert n m A', auto) 
+  have A'_UR: "A'_UR \<in> carrier_mat 1 (n-1)"
+    by (cases abs_flag; rule split_block(2)[OF A'_split[symmetric], of "m-1"], insert n m A', auto)
+  have A'_DL: "A'_DL \<in> carrier_mat (m - 1) 1"
+     by (cases abs_flag; rule split_block(3)[OF A'_split[symmetric], of _ "n-1"], insert n m A', auto)
+  have *: "(dim_col A = 0) = False" using 1(2-) by auto
+  have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" 
+    unfolding FindPreHNF.simps[of abs_flag D A] using A'_split m n A
+    unfolding Let_def sub_PreHNF_def  A'_def non_zero_positions_def * 
+    apply (cases abs_flag)
+    by (smt (z3) Reduce_def carrier_matD(1) carrier_matD(2) linorder_not_less prod.simps(2))+
+  also have "... \<in> carrier_mat m n"
+    by (smt m A'_UL One_nat_def add.commute carrier_matD carrier_mat_triv index_mat_four_block(2,3) 
+        le_add_diff_inverse2 le_eq_less_or_eq lessI n nat_SN.compat numerals(2) sub_PreHNF)  
+  finally show ?case .
+qed
+
+
+lemma FindPreHNF:
+ assumes A: "A \<in> carrier_mat m n"
+ shows "FindPreHNF abs_flag D A \<in> carrier_mat m n" 
+  using assms FindPreHNF_mxn2[OF A] FindPreHNF_mx1[OF A] FindPreHNF_1xn[OF A]
+  using linorder_not_less by blast
+end
+
+lemma make_first_column_positive_append_id:
+ assumes A': "A' \<in> carrier_mat m n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and D0: "D>0"
+  and n0: "0<n"
+  shows "make_first_column_positive A 
+  = mat_of_rows n (map (Matrix.row (make_first_column_positive A)) [0..<m]) @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+proof (rule matrix_append_rows_eq_if_preserves)
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  thus "make_first_column_positive A \<in> carrier_mat (m + n) n" by auto
+  have "make_first_column_positive A $$ (i, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)"
+    if j: "j<n" and i: "i \<in> {m..<m + n}" for i j
+  proof -
+    have i_mn: "i<m+n" using i by auto
+    have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, 0)" unfolding A_def
+      by (smt A append_rows_def assms(1) assms(2) atLeastLessThan_iff carrier_matD 
+          index_mat_four_block less_irrefl_nat nat_SN.compat j i n0)
+    also have "... \<ge> 0" using D0 mult_not_zero that(2) by auto
+    finally have Ai0: "A$$(i,0)\<ge>0" .
+    have "make_first_column_positive A $$ (i, j) = A$$(i,j)"
+      using make_first_column_positive_works[OF A i_mn n0] j Ai0 by auto
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" unfolding A_def
+      by (smt A append_rows_def A' A_def atLeastLessThan_iff carrier_matD 
+          index_mat_four_block less_irrefl_nat nat_SN.compat i j)
+    finally show ?thesis .
+  qed
+  thus "\<forall>i\<in>{m..<m + n}. \<forall>j<n. make_first_column_positive A $$ (i, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)"
+    by simp
+qed (auto)
+
+
+lemma A'_swaprows_invertible_mat:
+  fixes A::"int mat"
+  assumes A: "A\<in>carrier_mat m n"
+  assumes A'_def: "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
+  and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and nz_empty: "A$$(0,0) =0 \<Longrightarrow> non_zero_positions \<noteq> []"
+  and m0: "0<m"
+shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> A' = P * A"
+proof (cases "A$$(0,0) \<noteq> 0")
+  case True
+  then show ?thesis
+    by (metis A A'_def invertible_mat_one left_mult_one_mat one_carrier_mat)
+next
+  case False
+  have nz_empty: "non_zero_positions \<noteq> []" using nz_empty False by simp
+  let ?i = "non_zero_positions ! 0"
+  let ?M = "(swaprows_mat m 0 ?i) :: int mat"
+  have i_set_nz: "?i \<in> set (non_zero_positions)" using nz_empty by auto
+  have im: "?i < m" using A nz_def i_set_nz by auto
+  have i_not0: "?i \<noteq> 0" using A nz_def i_set_nz by auto
+  have "A' = swaprows 0 ?i A" using False A'_def by simp
+  also have "... = ?M * A"
+    by (rule swaprows_mat[OF A], insert nz_def nz_empty False A m0 im, auto) 
+  finally have 1: "A' = ?M * A" .
+  have 2: "?M \<in> carrier_mat m m" by auto
+  have "Determinant.det ?M = - 1"
+    by (rule det_swaprows_mat[OF m0 im i_not0[symmetric]])
+  hence 3: "invertible_mat ?M" using invertible_iff_is_unit_JNF[OF 2] by auto  
+  show ?thesis using 1 2 3 by blast
+qed
+
+lemma swaprows_append_id:
+ assumes A': "A' \<in> carrier_mat m n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+  and i:"i<m"
+  shows "swaprows 0 i A 
+  = mat_of_rows n (map (Matrix.row (swaprows 0 i A)) [0..<m]) @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+proof (rule matrix_append_rows_eq_if_preserves)
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  show swap: "swaprows 0 i A \<in> carrier_mat (m + n) n" by (simp add: A)
+  have "swaprows 0 i A $$ (ia, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)"
+    if ia: "ia \<in> {m..<m + n}" and j: "j<n" for ia j
+  proof -
+    have "swaprows 0 i A $$ (ia, j) = A $$ (ia,j)" using i ia j A by auto
+    also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" 
+      by (smt A append_rows_def A' A_def atLeastLessThan_iff carrier_matD 
+          index_mat_four_block less_irrefl_nat nat_SN.compat ia j)
+    finally show "swaprows 0 i A $$ (ia, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" .
+  qed
+  thus "\<forall>ia\<in>{m..<m + n}. \<forall>j<n. swaprows 0 i A $$ (ia, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" by simp
+qed (simp)
+
+
+
+lemma non_zero_positions_xs_m:
+  fixes A::"'a::comm_ring_1 mat"
+  assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A': "A' \<in> carrier_mat m n" 
+  and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and m0: "0<m" and n0: "0<n"
+  and D0: "D \<noteq> 0"
+shows "\<exists>xs. non_zero_positions = xs @ [m] \<and> distinct xs \<and> (\<forall>x\<in>set xs. x < m \<and> 0 < x)"
+proof -  
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  let ?xs = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+  have l_rw: "[1..<dim_row A] = [1..<m+1]@[m+1..<dim_row A]" using A m0 n0
+    by (auto, metis Suc_leI less_add_same_cancel1 upt_add_eq_append upt_conv_Cons)
+  have f0: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A]) = []"
+  proof (rule filter_False) 
+    have "A $$ (i,0) = 0" if i: "i\<in>set [m + 1..<dim_row A]" for i
+    proof -
+      have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i-m,0)"
+        by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto)
+      also have "... = 0" using i A by auto
+      finally show ?thesis .        
+    qed
+    thus "\<forall>x\<in>set [m + 1..<dim_row A]. \<not> A $$ (x, 0) \<noteq> 0" by blast
+  qed
+  have fm: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [m] = [m]"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
+      by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto)
+    also have "... = D" using m0 n0 by auto
+    finally show ?thesis using D0 by auto
+  qed
+  have "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m+1]@[m+1..<dim_row A])"
+    using nz_def l_rw by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1] @ filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A])"
+    by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1]" using f0 by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m]@[m])" using m0 by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m] @ [m]" using fm by auto
+  finally have "non_zero_positions = ?xs @ [m]" .
+  moreover have "distinct ?xs" by auto
+  moreover have "(\<forall>x\<in>set ?xs. x < m \<and> 0 < x)" by auto
+  ultimately show ?thesis by blast
+qed
+
+
+
+
+lemma non_zero_positions_xs_m':
+  fixes A::"'a::comm_ring_1 mat"
+  assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A': "A' \<in> carrier_mat m n" 
+  and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and m0: "0<m" and n0: "0<n"
+  and D0: "D \<noteq> 0"
+shows "non_zero_positions = (filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]) @ [m] 
+  \<and> distinct (filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]) 
+  \<and> (\<forall>x\<in>set (filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]). x < m \<and> 0 < x)"
+proof -  
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  let ?xs = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+  have l_rw: "[1..<dim_row A] = [1..<m+1]@[m+1..<dim_row A]" using A m0 n0
+    by (auto, metis Suc_leI less_add_same_cancel1 upt_add_eq_append upt_conv_Cons)
+  have f0: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A]) = []"
+  proof (rule filter_False) 
+    have "A $$ (i,0) = 0" if i: "i\<in>set [m + 1..<dim_row A]" for i
+    proof -
+      have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i-m,0)"
+        by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto)
+      also have "... = 0" using i A by auto
+      finally show ?thesis .        
+    qed
+    thus "\<forall>x\<in>set [m + 1..<dim_row A]. \<not> A $$ (x, 0) \<noteq> 0" by blast
+  qed
+  have fm: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [m] = [m]"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
+      by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto)
+    also have "... = D" using m0 n0 by auto
+    finally show ?thesis using D0 by auto
+  qed
+  have "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m+1]@[m+1..<dim_row A])"
+    using nz_def l_rw by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1] @ filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A])"
+    by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1]" using f0 by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m]@[m])" using m0 by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m] @ [m]" using fm by auto
+  finally have "non_zero_positions = ?xs @ [m]" .
+  moreover have "distinct ?xs" by auto
+  moreover have "(\<forall>x\<in>set ?xs. x < m \<and> 0 < x)" by auto
+  ultimately show ?thesis by blast
+qed
+
+lemma A_A'D_eq_first_n_rows:
+ assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A': "A' \<in> carrier_mat m n" 
+  and mn: "m\<ge>n"
+shows "(mat_of_rows n (map (Matrix.row A') [0..<n])) 
+  = (mat_of_rows n (map (Matrix.row A) [0..<n]))" (is "?lhs = ?rhs")
+proof (rule eq_matI) 
+  show dr: "dim_row ?lhs = dim_row ?rhs" and dc: "dim_col ?lhs = dim_col ?rhs" by auto
+  have D: "D \<cdot>\<^sub>m 1\<^sub>m n : carrier_mat n n" by simp
+  fix i j assume i: "i<dim_row ?rhs" and j: "j<dim_col ?rhs"
+  have "?lhs $$ (i,j) = A' $$ (i,j)" using i j dr dc A' mn by (simp add: mat_of_rows_def)
+  also have "... = A $$ (i,j)" using append_rows_nth[OF A' D] i j dr dc A' mn A_def by auto
+  also have "... = ?rhs $$ (i,j)" using i j dr dc A' A_def mn
+    by (metis D calculation carrier_matD(1) diff_zero gr_implies_not0 length_map length_upt 
+        linordered_semidom_class.add_diff_inverse mat_of_rows_carrier(2,3)
+        mat_of_rows_index nat_SN.compat nth_map_upt row_append_rows1)
+  finally show "?lhs $$ (i,j) = ?rhs $$ (i,j)" .
+qed
+
+lemma non_zero_positions_xs_m_invertible:  
+  assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A': "A' \<in> carrier_mat m n" 
+  and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and m0: "0<m" and n0: "0<n"
+  and D0: "D \<noteq> 0"
+  and inv_A'': "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..<n])))"
+  and A'00: "A' $$ (0,0) = 0"
+  and mn: "m\<ge>n"
+shows "length non_zero_positions > 1"
+proof -  
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  have D: "D \<cdot>\<^sub>m 1\<^sub>m n : carrier_mat n n" by auto
+  let ?RAT = "map_mat rat_of_int"
+  let ?A'' = "(mat_of_rows n (map (Matrix.row A') [0..<n]))"
+  have A'': "?A'' \<in> carrier_mat n n" by auto
+  have RAT_A'': "?RAT ?A'' \<in> carrier_mat n n" by auto
+  let ?ys = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+  let ?xs = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<n]"
+  have xs_not_empty:"?xs \<noteq> []"
+  proof (rule ccontr)
+    assume "\<not> ?xs \<noteq> []" hence xs0: "?xs = []" by simp
+    have A00: "A $$ (0,0) = 0" 
+    proof -
+      have "A $$ (0,0) = A'$$(0,0)" unfolding A_def using append_rows_nth[OF A' D] m0 n0 A' by auto
+      thus ?thesis using A'00 by simp
+    qed
+    hence "(\<forall>i\<in>set [1..<n]. A $$ (i,0) = 0)"
+      by (metis (mono_tags, lifting) empty_filter_conv xs0)
+    hence *: "(\<forall>i<n. A $$ (i,0) = 0)" using A00 n0 using linorder_not_less by force
+    have "col ?A'' 0 = 0\<^sub>v n"
+    proof (rule eq_vecI)
+      show "dim_vec (col ?A'' 0) = dim_vec (0\<^sub>vn)" using A' by auto
+      fix i assume i: "i < dim_vec (0\<^sub>v n)" 
+      have "col ?A'' 0 $v i = ?A'' $$ (i,0)" by (rule index_col, insert i A' n0, auto)
+      also have "... = A $$ (i,0)" 
+        unfolding A_def using i A append_rows_nth[OF A' D _ n0] A' mn 
+        by (metis A'' n0 carrier_matD(1) index_zero_vec(2) le_add2 map_first_rows_index
+            mat_of_rows_carrier(2) mat_of_rows_index nat_SN.compat)
+      also have "... = 0" using * i by auto
+      finally show "col ?A'' 0 $v i = 0\<^sub>v n $v i" using i by auto
+    qed
+    hence "col (?RAT ?A'') 0 = 0\<^sub>v n" by auto
+    hence "\<not> invertible_mat (?RAT ?A'')"
+      using invertible_mat_first_column_not0[OF RAT_A'' _ n0] by auto
+    thus False using inv_A'' by contradiction
+  qed
+  have l_rw: "[1..<dim_row A] = [1..<m+1]@[m+1..<dim_row A]" using A m0 n0
+    by (auto, metis Suc_leI less_add_same_cancel1 upt_add_eq_append upt_conv_Cons)
+  have f0: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A]) = []"
+  proof (rule filter_False) 
+    have "A $$ (i,0) = 0" if i: "i\<in>set [m + 1..<dim_row A]" for i
+    proof -
+      have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i-m,0)"
+        by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto)
+      also have "... = 0" using i A by auto
+      finally show ?thesis .        
+    qed
+    thus "\<forall>x\<in>set [m + 1..<dim_row A]. \<not> A $$ (x, 0) \<noteq> 0" by blast
+  qed
+  have fm: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [m] = [m]"
+  proof -
+    have "A $$ (m, 0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
+      by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto)
+    also have "... = D" using m0 n0 by auto
+    finally show ?thesis using D0 by auto
+  qed
+  have "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m+1]@[m+1..<dim_row A])"
+    using nz_def l_rw by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1] @ filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A])"
+    by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1]" using f0 by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m]@[m])" using m0 by auto
+  also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m] @ [m]" using fm by auto
+  finally have nz: "non_zero_positions = ?ys @ [m]" .
+  moreover have ys_not_empty: "?ys \<noteq> []" using xs_not_empty mn
+    by (metis (no_types, lifting) atLeastLessThan_iff empty_filter_conv nat_SN.compat set_upt)
+  show ?thesis unfolding nz using ys_not_empty by auto  
+qed
+
+
+
+corollary non_zero_positions_length_xs:  
+  assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A': "A' \<in> carrier_mat m n" 
+  and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  and m0: "0<m" and n0: "0<n"
+  and D0: "D \<noteq> 0"
+  and inv_A'': "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..<n])))"
+  and A'00: "A' $$ (0,0) = 0"
+  and mn: "m\<ge>n"
+  and nz_xs_m: "non_zero_positions = xs @ [m]"
+shows "length xs > 0"
+proof -  
+  have "length non_zero_positions > 1" 
+    by (rule non_zero_positions_xs_m_invertible[OF A_def A' nz_def m0 n0 D0 inv_A'' A'00 mn])
+  thus ?thesis using nz_xs_m by auto  
+qed
+
+
+
+lemma make_first_column_positive_nz_conv:
+  assumes "i<dim_row A" and "j<dim_col A"
+  shows "(make_first_column_positive A $$ (i, j) \<noteq> 0) = (A $$ (i, j) \<noteq> 0)"
+  using assms unfolding make_first_column_positive.simps by auto
+
+
+
+lemma make_first_column_positive_00:
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+    and A'': "A'' : carrier_mat m n"
+  assumes nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+    and A'_def: "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
+    and m0: "0<m" and n0: "0<n" and D0: "D \<noteq> 0" and mn: "m\<ge>n"
+  shows "make_first_column_positive A' $$ (0, 0) \<noteq> 0"
+proof -
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
+  hence A': "A' \<in> carrier_mat (m+n) n" unfolding A'_def by auto 
+  have "(make_first_column_positive A' $$ (0, 0) \<noteq> 0) = (A' $$ (0, 0) \<noteq> 0)"
+    by (rule make_first_column_positive_nz_conv, insert m0 n0 A', auto)
+  moreover have "A' $$ (0, 0) \<noteq> 0"
+  proof (cases "A $$ (0, 0) \<noteq> 0")
+    case True
+    then show ?thesis unfolding A'_def by auto
+  next
+    case False
+    have "A $$ (0, 0) = A'' $$ (0, 0)"
+      by (smt add_gr_0 append_rows_def A_def A'' carrier_matD index_mat_four_block(1) mn n0 nat_SN.compat)
+    hence A''00: "A''$$(0,0) = 0" using False by auto
+    let ?i = "non_zero_positions ! 0"
+    obtain xs where non_zero_positions_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
+      and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
+      using non_zero_positions_xs_m[OF A_def A'' nz_def m0 n0] using D0 by fast    
+    have Ai0:"A $$ (?i,0) \<noteq> 0"
+      by (smt append.simps(1) append_Cons append_same_eq nz_def in_set_conv_nth length_greater_0_conv
+          list.simps(3) local.non_zero_positions_xs_m mem_Collect_eq set_filter)  
+    have "A' $$ (0, 0) = swaprows 0 ?i A $$ (0,0)"  using False A'_def by auto
+    also have "... \<noteq> 0" using A Ai0 n0 by auto  
+    finally show ?thesis .
+  qed
+  ultimately show ?thesis by blast
+qed
+
+
+context proper_mod_operation
+begin
+lemma reduce_below_0_case_m_make_first_column_positive:
+  assumes A': "A' \<in> carrier_mat m n" and m0: "0<m" and n0: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and mn: "m\<ge>n"
+  assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
+    and ia: "i\<noteq>0"
+    and A''_def: "A'' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
+    and D0: "D>0"
+    and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  shows "reduce_below 0 non_zero_positions D (make_first_column_positive A'') $$ (i,0) = 0"
+proof -
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+  have nz_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
+    and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
+    using non_zero_positions_xs_m'[OF A_def A' nz_def m0 n0] using D0 A unfolding nz_def xs_def by auto
+  have A'': "A'' \<in> carrier_mat (m+n) n" using A' A_def A''_def by auto
+  have D_not0: "D\<noteq>0" using D0 by auto
+  have Ai0: "A $$ (i, 0) = 0" if im: "i>m" and imn: "i<m+n" for i
+  proof-
+    have D: "(D \<cdot>\<^sub>m (1\<^sub>m n)) \<in> carrier_mat n n" by simp
+    have "A $$ (i, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (i-m, 0)"
+      unfolding A_def using append_rows_nth[OF A' D imn n0] im A' by auto 
+    also have "... = 0" using im imn n0 by auto
+    finally show ?thesis .
+  qed
+  let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A'')) [0..<m])"
+  have M': "?M' \<in> carrier_mat m n" using A'' by auto
+  have mk0: "make_first_column_positive A'' $$ (0, 0) \<noteq> 0"
+    by (rule make_first_column_positive_00[OF A_def A' nz_def A''_def m0 n0 D_not0 mn])
+  have M_M'D: "make_first_column_positive A'' = ?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" if xs_empty: "xs \<noteq> []"
+  proof (cases "A$$(0,0) \<noteq> 0")
+    case True
+    then have *: "make_first_column_positive A'' = make_first_column_positive A"
+      unfolding A''_def by auto        
+    show ?thesis 
+      by (unfold *, rule make_first_column_positive_append_id[OF A' A_def D0 n0])
+  next
+    case False
+    then have *: "make_first_column_positive A'' 
+                  = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)"
+      unfolding A''_def by auto
+    show ?thesis
+    proof (unfold *, rule make_first_column_positive_append_id)
+      let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..<m])"
+      show "swaprows 0 (non_zero_positions ! 0) A =  ?S @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      proof (rule swaprows_append_id[OF A' A_def])
+        have A'00: "A' $$ (0, 0) = 0"          
+          by (metis (no_types, lifting) A False add_pos_pos append_rows_def A' A_def 
+              carrier_matD index_mat_four_block m0 n0)
+        have length_xs: "length xs > 0" using xs_empty by auto
+        have "non_zero_positions ! 0 = xs ! 0" unfolding nz_xs_m
+          by (meson length_xs nth_append)
+        thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp
+      qed
+    qed (insert n0 D0, auto)            
+  qed
+  show ?thesis
+  proof (cases "xs = []")
+    case True note xs_empty = True
+    have "reduce_below 0 non_zero_positions D (make_first_column_positive A'') 
+      = reduce 0 m D (make_first_column_positive A'')"
+      unfolding nz_xs_m True by auto
+
+    also have "...  $$ (i, 0) = 0"
+    proof (cases "i=m")
+      case True
+      from D0 have "D \<ge> 1" "D \<ge> 0" by auto
+      then show ?thesis using D0 True
+        by (metis A add_sign_intros(2) A''_def carrier_matD(1) carrier_matD(2) carrier_matI 
+            index_mat_swaprows(2) index_mat_swaprows(3) less_add_same_cancel1 m0 
+            make_first_column_positive_preserves_dimensions mk0 n0 neq0_conv reduce_0)
+    next
+      case False note i_not_m = False
+      have nz_m: "non_zero_positions ! 0 = m" unfolding nz_xs_m True by auto
+      let ?M = "make_first_column_positive A''"
+      have M: "?M \<in> carrier_mat (m+n) n" using A'' by auto
+      show ?thesis
+      proof (cases "A$$(0,0) = 0")
+        case True
+        have "reduce 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
+          by (rule reduce_preserves[OF M n0 mk0 False ia i_mn])
+        also have Mi0: "... = abs (A'' $$ (i,0))"
+          by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
+              make_first_column_positive_preserves_dimensions n0 prod.simps(2))
+        also have Mi02: "... = abs (A $$ (i,0)) " unfolding A''_def nz_m
+          using True A False i_mn ia n0 by auto
+        also have "... = 0"
+        proof -
+          have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
+            using xs_empty xs_def by presburger
+          then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
+          then show ?thesis
+            by (metis (no_types) Ai0 False arith_simps(43) assms(9) atLeastLessThan_iff i_mn
+                le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
+        qed
+        finally show ?thesis .
+      next
+        case False hence A00: "A $$ (0,0) \<noteq> 0" by simp
+        have "reduce 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
+          by (rule reduce_preserves[OF M n0 mk0 i_not_m ia i_mn])
+        also have Mi0: "... = abs (A'' $$ (i,0))"
+          by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
+              make_first_column_positive_preserves_dimensions n0 prod.simps(2))
+        also have Mi02: "... = abs (swaprows 0 m A $$ (i,0)) " unfolding A''_def nz_m
+          using A00 A i_not_m i_mn ia n0 by auto
+        also have "... = abs (A $$ (i,0))" using False ia A00 Mi0 A''_def calculation Mi02 by presburger  
+        also have "... = 0"
+        proof -
+          have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
+            using True xs_def by presburger
+          then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
+          then show ?thesis
+            by (metis (no_types) Ai0 i_not_m arith_simps(43) ia atLeastLessThan_iff i_mn
+                le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
+        qed
+        finally show ?thesis .
+      qed
+    qed
+    finally show ?thesis .
+  next
+    case False note xs_not_empty = False
+    note M_M'D = M_M'D[OF xs_not_empty]
+    show ?thesis   
+    proof (cases "i \<in> set (xs @ [m])")
+      case True
+      show ?thesis  
+        by (unfold nz_xs_m, rule reduce_below_0_case_m[OF M' m0 n0 M_M'D mk0 mn True d_xs all_less_m D0])
+    next
+      case False note i_notin_xs_m = False
+      have 1: "reduce_below 0 (xs @ [m]) D (make_first_column_positive A'') $$ (i,0) 
+        = (make_first_column_positive A'') $$ (i,0)"    
+        by (rule reduce_below_preserves_case_m[OF M' m0 n0 M_M'D mk0 mn _ d_xs all_less_m ia i_mn _ D0],
+            insert False, auto) 
+      have "((make_first_column_positive A'') $$ (i,0) \<noteq> 0) = (A'' $$ (i,0) \<noteq> 0)"
+        by (rule make_first_column_positive_nz_conv, insert A'' i_mn n0, auto)
+      hence 2: "((make_first_column_positive A'') $$ (i,0) = 0) = (A'' $$ (i,0) = 0)" by auto
+      have 3: "(A'' $$ (i,0) = 0)"
+      proof (cases "A$$(0,0) \<noteq> 0")
+        case True
+        then have "A'' $$ (i, 0) = A $$ (i, 0)" unfolding A''_def by auto
+        also have "... = 0" using False ia i_mn A nz_xs_m Ai0 unfolding nz_def xs_def by auto
+        finally show ?thesis by auto
+      next
+        case False hence A00: "A $$ (0,0) = 0" by simp
+        let ?i = "non_zero_positions ! 0"
+        have i_noti: "i\<noteq>?i" 
+          using i_notin_xs_m unfolding nz_xs_m
+          by (metis Nil_is_append_conv length_greater_0_conv list.distinct(2) nth_mem)
+        have "A''$$(i,0) = (swaprows 0 ?i A) $$ (i,0)" using False unfolding A''_def by auto
+        also have "... = A $$ (i,0)" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def by fastforce  
+        also have "... = 0" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def 
+          by (smt nz_def atLeastLessThan_iff carrier_matD(1) less_one linorder_not_less
+              mem_Collect_eq nz_xs_m set_filter set_upt xs_def) 
+        finally show ?thesis .
+      qed
+      show ?thesis using 1 2 3 nz_xs_m by argo
+    qed
+  qed
+qed
+
+
+lemma reduce_below_abs_0_case_m_make_first_column_positive:
+  assumes A': "A' \<in> carrier_mat m n" and m0: "0<m" and n0: "0<n"
+    and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+    and mn: "m\<ge>n"
+  assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
+    and ia: "i\<noteq>0"
+    and A''_def: "A'' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
+    and D0: "D>0"
+    and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  shows "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A'') $$ (i,0) = 0"
+proof -
+  have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
+  define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+  have nz_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
+    and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
+    using non_zero_positions_xs_m'[OF A_def A' nz_def m0 n0] using D0 A unfolding nz_def xs_def by auto
+  have A'': "A'' \<in> carrier_mat (m+n) n" using A' A_def A''_def by auto
+  have D_not0: "D\<noteq>0" using D0 by auto
+  have Ai0: "A $$ (i, 0) = 0" if im: "i>m" and imn: "i<m+n" for i
+  proof-
+    have D: "(D \<cdot>\<^sub>m (1\<^sub>m n)) \<in> carrier_mat n n" by simp
+    have "A $$ (i, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (i-m, 0)"
+      unfolding A_def using append_rows_nth[OF A' D imn n0] im A' by auto 
+    also have "... = 0" using im imn n0 by auto
+    finally show ?thesis .
+  qed
+  let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A'')) [0..<m])"
+  have M': "?M' \<in> carrier_mat m n" using A'' by auto
+  have mk0: "make_first_column_positive A'' $$ (0, 0) \<noteq> 0"
+    by (rule make_first_column_positive_00[OF A_def A' nz_def A''_def m0 n0 D_not0 mn])
+  have M_M'D: "make_first_column_positive A'' = ?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" if xs_empty: "xs \<noteq> []"
+  proof (cases "A$$(0,0) \<noteq> 0")
+    case True
+    then have *: "make_first_column_positive A'' = make_first_column_positive A"
+      unfolding A''_def by auto        
+    show ?thesis 
+      by (unfold *, rule make_first_column_positive_append_id[OF A' A_def D0 n0])
+  next
+    case False
+    then have *: "make_first_column_positive A'' 
+                  = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)"
+      unfolding A''_def by auto
+    show ?thesis
+    proof (unfold *, rule make_first_column_positive_append_id)
+      let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..<m])"
+      show "swaprows 0 (non_zero_positions ! 0) A =  ?S @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      proof (rule swaprows_append_id[OF A' A_def])
+        have A'00: "A' $$ (0, 0) = 0"          
+          by (metis (no_types, lifting) A False add_pos_pos append_rows_def A' A_def 
+              carrier_matD index_mat_four_block m0 n0)
+        have length_xs: "length xs > 0" using xs_empty by auto
+        have "non_zero_positions ! 0 = xs ! 0" unfolding nz_xs_m
+          by (meson length_xs nth_append)
+        thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp
+      qed
+    qed (insert n0 D0, auto)            
+  qed
+  show ?thesis
+  proof (cases "xs = []")
+    case True note xs_empty = True
+    have "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A'') 
+      = reduce_abs 0 m D (make_first_column_positive A'')"
+      unfolding nz_xs_m True by auto
+
+    also have "...  $$ (i, 0) = 0"
+    proof (cases "i=m")
+      case True
+      from D0 have "D \<ge> 1" "D \<ge> 0" by auto
+      then show ?thesis using D0 True
+        by (metis A add_sign_intros(2) A''_def carrier_matD(1) carrier_matD(2) carrier_matI 
+            index_mat_swaprows(2) index_mat_swaprows(3) less_add_same_cancel1 m0 
+            make_first_column_positive_preserves_dimensions mk0 n0 neq0_conv reduce_0)
+    next
+      case False note i_not_m = False
+      have nz_m: "non_zero_positions ! 0 = m" unfolding nz_xs_m True by auto
+      let ?M = "make_first_column_positive A''"
+      have M: "?M \<in> carrier_mat (m+n) n" using A'' by auto
+      show ?thesis
+      proof (cases "A$$(0,0) = 0")
+        case True
+        have "reduce_abs 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
+          by (rule reduce_preserves[OF M n0 mk0 False ia i_mn])
+        also have Mi0: "... = abs (A'' $$ (i,0))"
+          by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
+              make_first_column_positive_preserves_dimensions n0 prod.simps(2))
+        also have Mi02: "... = abs (A $$ (i,0)) " unfolding A''_def nz_m
+          using True A False i_mn ia n0 by auto
+        also have "... = 0"
+        proof -
+          have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
+            using xs_empty xs_def by presburger
+          then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
+          then show ?thesis
+            by (metis (no_types) Ai0 False arith_simps(43) assms(9) atLeastLessThan_iff i_mn
+                le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
+        qed
+        finally show ?thesis .
+      next
+        case False hence A00: "A $$ (0,0) \<noteq> 0" by simp
+        have "reduce_abs 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
+          by (rule reduce_preserves[OF M n0 mk0 i_not_m ia i_mn])
+        also have Mi0: "... = abs (A'' $$ (i,0))"
+          by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
+              make_first_column_positive_preserves_dimensions n0 prod.simps(2))
+        also have Mi02: "... = abs (swaprows 0 m A $$ (i,0)) " unfolding A''_def nz_m
+          using A00 A i_not_m i_mn ia n0 by auto
+        also have "... = abs (A $$ (i,0))" using False ia A00 Mi0 A''_def calculation Mi02 by presburger  
+        also have "... = 0"
+        proof -
+          have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
+            using True xs_def by presburger
+          then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
+          then show ?thesis
+            by (metis (no_types) Ai0 i_not_m arith_simps(43) ia atLeastLessThan_iff i_mn
+                le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
+        qed
+        finally show ?thesis .
+      qed
+    qed
+    finally show ?thesis .
+  next
+    case False note xs_not_empty = False
+    note M_M'D = M_M'D[OF xs_not_empty]
+    show ?thesis   
+    proof (cases "i \<in> set (xs @ [m])")
+      case True
+      show ?thesis  
+        by (unfold nz_xs_m, rule reduce_below_abs_0_case_m[OF M' m0 n0 M_M'D mk0 mn True d_xs all_less_m D0])
+    next
+      case False note i_notin_xs_m = False
+      have 1: "reduce_below_abs 0 (xs @ [m]) D (make_first_column_positive A'') $$ (i,0) 
+        = (make_first_column_positive A'') $$ (i,0)"    
+        by (rule reduce_below_abs_preserves_case_m[OF M' m0 n0 M_M'D mk0 mn _ d_xs all_less_m ia i_mn _ D0],
+            insert False, auto) 
+      have "((make_first_column_positive A'') $$ (i,0) \<noteq> 0) = (A'' $$ (i,0) \<noteq> 0)"
+        by (rule make_first_column_positive_nz_conv, insert A'' i_mn n0, auto)
+      hence 2: "((make_first_column_positive A'') $$ (i,0) = 0) = (A'' $$ (i,0) = 0)" by auto
+      have 3: "(A'' $$ (i,0) = 0)"
+      proof (cases "A$$(0,0) \<noteq> 0")
+        case True
+        then have "A'' $$ (i, 0) = A $$ (i, 0)" unfolding A''_def by auto
+        also have "... = 0" using False ia i_mn A nz_xs_m Ai0 unfolding nz_def xs_def by auto
+        finally show ?thesis by auto
+      next
+        case False hence A00: "A $$ (0,0) = 0" by simp
+        let ?i = "non_zero_positions ! 0"
+        have i_noti: "i\<noteq>?i" 
+          using i_notin_xs_m unfolding nz_xs_m
+          by (metis Nil_is_append_conv length_greater_0_conv list.distinct(2) nth_mem)
+        have "A''$$(i,0) = (swaprows 0 ?i A) $$ (i,0)" using False unfolding A''_def by auto
+        also have "... = A $$ (i,0)" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def by fastforce  
+        also have "... = 0" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def 
+          by (smt nz_def atLeastLessThan_iff carrier_matD(1) less_one linorder_not_less
+              mem_Collect_eq nz_xs_m set_filter set_upt xs_def) 
+        finally show ?thesis .
+      qed
+      show ?thesis using 1 2 3 nz_xs_m by argo
+    qed
+  qed
+qed
+
+
+lemma FindPreHNF_invertible_mat_2xn:
+  assumes A: "A \<in> carrier_mat m n" and "m<2"
+  shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
+  using assms
+  by (auto, metis invertible_mat_one left_mult_one_mat one_carrier_mat)
+
+
+lemma FindPreHNF_invertible_mat_mx2:
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A'': "A'' \<in> carrier_mat m n" and n2: "n<2" and n0: "0<n" and D_g0: "D>0" and mn: "m\<ge>n"
+shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
+proof -
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
+  have m0: "m>0" using mn n2 n0 by auto
+  have D0: "D\<noteq>0" using D_g0 by auto
+  show ?thesis
+  proof (cases "m+n<2")
+    case True
+    show ?thesis by (rule FindPreHNF_invertible_mat_2xn[OF A True])
+  next
+    case False note mn_le_2 = False
+    have dr_A: "dim_row A \<ge>2" using False n2 A by auto
+    have dc_A: "dim_col A < 2" using n2 A by auto
+    let ?non_zero_positions = "filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<dim_row A]" 
+    let ?A' = "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)"
+    define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+    let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)"
+    have nz_xs_m: "?non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
+      and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
+      using non_zero_positions_xs_m'[OF A_def A'' _ m0 n0 D0] using D0 A unfolding xs_def by auto  
+    have *: "FindPreHNF abs_flag D A = (if abs_flag then reduce_below_abs 0 ?non_zero_positions D ?A' 
+        else reduce_below 0 ?non_zero_positions D ?A')"
+      using dr_A dc_A by (auto simp add: Let_def) 
+    have l: "length ?non_zero_positions > 1" if "xs\<noteq>[]" using that unfolding nz_xs_m by auto
+    have inv: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
+      \<and> reduce_below 0 ?non_zero_positions D ?A' = P * ?A'"
+    proof (cases "A $$ (0,0) \<noteq>0")
+      case True
+      show ?thesis
+        by (unfold nz_xs_m, rule reduce_below_invertible_mat_case_m
+            [OF A'' m0 n0 _ _ mn d_xs all_less_m], insert A_def True D_g0, auto)
+    next
+      case False hence A00: "A $$ (0,0) = 0" by auto
+      let ?S = "swaprows 0 (?non_zero_positions ! 0) A"
+      have rw: "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)
+          = ?S" using False by auto
+      show ?thesis
+      proof (cases "xs = []")
+        case True
+        have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
+        obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
+          by (metis prod_cases5)        
+        have Am0: "A $$ (m,0) = D"
+        proof -
+          have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
+            by (smt (z3) A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
+                less_add_same_cancel1 less_diff_conv diff_add nat_less_le)
+          also have "... = D" by (simp add: n0)
+          finally show ?thesis .
+        qed
+        have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
+        have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
+        have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
+          using pquvd Sm0 S00 Am0 A00 by auto
+        have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto
+        also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
+        have " \<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and>
+           reduce 0 m D (swaprows 0 m A) = P * (swaprows 0 m A)"
+        proof (rule reduce_invertible_mat_case_m[OF _ _ m0 _ _ _ _ mn n0])
+          show "swaprows 0 m A $$ (0, 0) \<noteq> 0" using S00 D0 by auto
+          define S' where  "S' = mat_of_rows n (map (Matrix.row ?S) [0..<m])"
+          define S'' where "S'' = mat_of_rows n (map (Matrix.row ?S) [m..<m+n])"
+          define A2 where "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
+             (\<lambda>(i, k). if i = 0 then p * A $$ (m, k) + q * A $$ (0, k)
+             else if i = m then u * A $$ (m, k) + v * A $$ (0, k) else A $$ (i, k))"
+          show S_S'_S'': "swaprows 0 m A = S' @\<^sub>r S''" unfolding S'_def S''_def
+            by (metis A append_rows_split carrier_matD index_mat_swaprows(2,3) le_add1 nth_Cons_0 nz_m)
+          show S': "S' \<in> carrier_mat m n" unfolding S'_def by fastforce
+          show S'': "S'' \<in> carrier_mat n n" unfolding S''_def by fastforce
+          show "0 \<noteq> m" using m0 by simp
+          show "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
+            using pquvd by simp
+          show "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
+         (\<lambda>(i, k). if i = 0 then p * swaprows 0 m A $$ (0, k) + q * swaprows 0 m A $$ (m, k)
+         else if i = m then u * swaprows 0 m A $$ (0, k) + v * swaprows 0 m A $$ (m, k) else swaprows 0 m A $$ (i, k))"
+            (is "_ = ?rhs") using A A2_def by auto
+          define xs' where "xs' = [1..<n]"
+          define ys' where  "ys' = [1..<n]"
+          show "xs' = [1..<n]" unfolding xs'_def by auto
+          show "ys' = [1..<n]" unfolding ys'_def by auto
+          have S''D: "(S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
+            if jn: "j<n" and j0: "j>0" for j
+          proof -
+            have "S'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
+            proof -
+              have "S'' $$ (j, i) = swaprows 0 m A $$ (j+m,i)"
+                by (metis S' S'' S_S'_S'' append_rows_nth2 mn nat_SN.compat i_n jn)
+              also have "... = A $$ (j+m,i)" using A jn j0 i_n by auto
+              also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
+                by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
+                    carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
+              finally show ?thesis .
+            qed
+            thus ?thesis using jn j0 by auto
+          qed
+          have "0 \<notin> set xs'"
+          proof -
+            have "A2 $$ (0,0) = p * A $$ (m, 0) + q * A $$ (0, 0)" 
+              using A A2_def n0 by auto
+            also have "... = gcd (A $$ (m, 0)) (A $$ (0, 0))"
+              by (metis euclid_ext2_works(1) euclid_ext2_works(2) pquvd2)
+            also have "... = D" using Am0 A00 D_g0 by auto             
+            finally have "A2 $$ (0,0) = D" .
+            thus ?thesis unfolding xs'_def using D_g0 by auto
+          qed
+          thus "\<forall>j\<in>set xs'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"  
+            using S''D xs'_def by auto
+          have "0 \<notin> set ys'"
+          proof -
+            have "A2 $$ (m,0) = u * A $$ (m, 0) + v * A $$ (0, 0)"
+              using A A2_def n0 m0 by auto
+            also have "... = - A $$ (0, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (m, 0) 
+              + A $$ (m, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (0, 0)"
+              by (simp add: euclid_ext2_works[OF pquvd2[symmetric]])
+            also have "... = 0" using A00 Am0 by auto
+            finally have "A2 $$ (m,0) = 0" .
+            thus ?thesis unfolding ys'_def using D_g0 by auto
+          qed
+          thus "\<forall>j\<in>set ys'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
+            using S''D ys'_def by auto    
+          show "swaprows 0 m A $$ (m, 0) \<in> {0, D}" using Sm0 by blast
+          thus "swaprows 0 m A $$ (m, 0) = 0 \<longrightarrow> swaprows 0 m A $$ (0, 0) = D"
+            using S00 by linarith                  
+        qed (insert D_g0)      
+        then show ?thesis by (simp add: False nz_m)
+      next
+        case False note xs_not_empty = False
+        show ?thesis       
+      proof (unfold nz_xs_m, rule reduce_below_invertible_mat_case_m[OF _ m0 n0 _ _ mn d_xs all_less_m D_g0])
+        let ?S' = "mat_of_rows n (map (Matrix.row ?S) [0..<m])"
+        show "?S' \<in> carrier_mat m n" by auto
+        have l: "length ?non_zero_positions > 1" using l False by blast
+        hence nz0_less_m: "?non_zero_positions ! 0 < m"
+          by (metis One_nat_def add.commute add.left_neutral all_less_m append_Cons_nth_left 
+              length_append less_add_same_cancel1 list.size(3,4) nth_mem nz_xs_m)    
+        have "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m])
+        thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" 
+          using rw nz_xs_m by argo
+        have "?S $$ (0, 0) \<noteq> 0"
+          by (smt A l add_pos_pos carrier_matD index_mat_swaprows(1) le_eq_less_or_eq length_greater_0_conv
+              less_one linorder_not_less list.size(3) m0 mem_Collect_eq n0 nth_mem set_filter)
+        thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) \<noteq> 0"
+          using rw nz_xs_m by algebra
+      qed
+    qed
+  qed
+    have inv2: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
+      \<and> reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'"
+    proof (cases "A $$ (0,0) \<noteq>0")
+      case True
+      show ?thesis
+        by (unfold nz_xs_m, rule reduce_below_abs_invertible_mat_case_m
+            [OF A'' m0 n0 _ _ mn d_xs all_less_m], insert A_def True D_g0, auto)
+    next
+      case False hence A00: "A $$ (0,0) = 0" by auto
+      let ?S = "swaprows 0 (?non_zero_positions ! 0) A"
+      have rw: "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)
+          = ?S" using False by auto
+      show ?thesis
+      proof (cases "xs = []")
+        case True
+        have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
+        obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
+          by (metis prod_cases5)        
+        have Am0: "A $$ (m,0) = D"
+        proof -
+          have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
+            by (smt (z3) A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
+                less_add_same_cancel1 less_diff_conv diff_add nat_less_le)
+          also have "... = D" by (simp add: n0)
+          finally show ?thesis .
+        qed
+        have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
+        have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
+        have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
+          using pquvd Sm0 S00 Am0 A00 by auto
+        have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto
+        also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
+        have " \<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and>
+           reduce_abs 0 m D (swaprows 0 m A) = P * (swaprows 0 m A)"
+        proof (rule reduce_abs_invertible_mat_case_m[OF _ _ m0 _ _ _ _ mn n0])
+          show "swaprows 0 m A $$ (0, 0) \<noteq> 0" using S00 D0 by auto
+          define S' where  "S' = mat_of_rows n (map (Matrix.row ?S) [0..<m])"
+          define S'' where "S'' = mat_of_rows n (map (Matrix.row ?S) [m..<m+n])"
+          define A2 where "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
+             (\<lambda>(i, k). if i = 0 then p * A $$ (m, k) + q * A $$ (0, k)
+             else if i = m then u * A $$ (m, k) + v * A $$ (0, k) else A $$ (i, k))"
+          show S_S'_S'': "swaprows 0 m A = S' @\<^sub>r S''" unfolding S'_def S''_def
+            by (metis A append_rows_split carrier_matD index_mat_swaprows(2,3) le_add1 nth_Cons_0 nz_m)
+          show S': "S' \<in> carrier_mat m n" unfolding S'_def by fastforce
+          show S'': "S'' \<in> carrier_mat n n" unfolding S''_def by fastforce
+          show "0 \<noteq> m" using m0 by simp
+          show "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
+            using pquvd by simp
+          show "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
+         (\<lambda>(i, k). if i = 0 then p * swaprows 0 m A $$ (0, k) + q * swaprows 0 m A $$ (m, k)
+         else if i = m then u * swaprows 0 m A $$ (0, k) + v * swaprows 0 m A $$ (m, k) else swaprows 0 m A $$ (i, k))"
+            (is "_ = ?rhs") using A A2_def by auto
+          define xs' where "xs' = filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]"
+          define ys' where  "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]"
+          show "xs' = filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]" unfolding xs'_def by auto
+          show "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]" unfolding ys'_def by auto
+          have S''D: "(S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
+            if jn: "j<n" and j0: "j>0" for j
+          proof -
+            have "S'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
+            proof -
+              have "S'' $$ (j, i) = swaprows 0 m A $$ (j+m,i)"
+                by (metis S' S'' S_S'_S'' append_rows_nth2 mn nat_SN.compat i_n jn)
+              also have "... = A $$ (j+m,i)" using A jn j0 i_n by auto
+              also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
+                by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
+                    carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
+              finally show ?thesis .
+            qed
+            thus ?thesis using jn j0 by auto
+          qed
+          have "0 \<notin> set xs'"
+          proof -
+            have "A2 $$ (0,0) = p * A $$ (m, 0) + q * A $$ (0, 0)" 
+              using A A2_def n0 by auto
+            also have "... = gcd (A $$ (m, 0)) (A $$ (0, 0))"
+              by (metis euclid_ext2_works(1) euclid_ext2_works(2) pquvd2)
+            also have "... = D" using Am0 A00 D_g0 by auto             
+            finally have "A2 $$ (0,0) = D" .
+            thus ?thesis unfolding xs'_def using D_g0 by auto
+          qed
+          thus "\<forall>j\<in>set xs'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"  
+            using S''D xs'_def by auto
+          have "0 \<notin> set ys'"
+          proof -
+            have "A2 $$ (m,0) = u * A $$ (m, 0) + v * A $$ (0, 0)"
+              using A A2_def n0 m0 by auto
+            also have "... = - A $$ (0, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (m, 0) 
+              + A $$ (m, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (0, 0)"
+              by (simp add: euclid_ext2_works[OF pquvd2[symmetric]])
+            also have "... = 0" using A00 Am0 by auto
+            finally have "A2 $$ (m,0) = 0" .
+            thus ?thesis unfolding ys'_def using D_g0 by auto
+          qed
+          thus "\<forall>j\<in>set ys'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
+            using S''D ys'_def by auto    
+        qed (insert D_g0)      
+        then show ?thesis by (simp add: False nz_m)
+      next
+        case False note xs_not_empty = False
+        show ?thesis       
+      proof (unfold nz_xs_m, rule reduce_below_abs_invertible_mat_case_m[OF _ m0 n0 _ _ mn d_xs all_less_m D_g0])
+        let ?S' = "mat_of_rows n (map (Matrix.row ?S) [0..<m])"
+        show "?S' \<in> carrier_mat m n" by auto
+        have l: "length ?non_zero_positions > 1" using l False by blast
+        hence nz0_less_m: "?non_zero_positions ! 0 < m"
+          by (metis One_nat_def add.commute add.left_neutral all_less_m append_Cons_nth_left 
+              length_append less_add_same_cancel1 list.size(3,4) nth_mem nz_xs_m)    
+        have "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m])
+        thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" 
+          using rw nz_xs_m by argo
+        have "?S $$ (0, 0) \<noteq> 0"
+          by (smt A l add_pos_pos carrier_matD index_mat_swaprows(1) le_eq_less_or_eq length_greater_0_conv
+              less_one linorder_not_less list.size(3) m0 mem_Collect_eq n0 nth_mem set_filter)
+        thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) \<noteq> 0"
+          using rw nz_xs_m by algebra
+      qed
+    qed
+  qed
+  show ?thesis
+  proof (cases abs_flag)
+    case False
+    from inv obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
+      and r_PA': "reduce_below 0 ?non_zero_positions D ?A' = P * ?A'" by blast
+    have Find_rw: "FindPreHNF abs_flag D A = reduce_below 0 ?non_zero_positions D ?A'"
+      using n0 A dr_A dc_A False * by (auto simp add: Let_def)
+    have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?A' = P * A" 
+      by (rule A'_swaprows_invertible_mat[OF A], insert non_zero_positions_xs_m n0 m0 l nz_xs_m, auto) 
+    from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)"
+      and inv_Q: "invertible_mat Q" and A'_QA: "?A' = Q * A" by blast
+    have "reduce_below 0 ?non_zero_positions D ?A' = (P * Q) * A" using Q A'_QA P r_PA' A by auto
+    moreover have "invertible_mat (P*Q)" using P Q inv_P inv_Q invertible_mult_JNF by blast
+    moreover have "(P*Q) \<in> carrier_mat (m + n) (m + n)" using P Q by auto
+    ultimately show ?thesis using Find_rw by metis
+  next
+    case True
+    from inv2 obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
+      and r_PA': "reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'" by blast
+    have Find_rw: "FindPreHNF abs_flag D A = reduce_below_abs 0 ?non_zero_positions D ?A'"
+      using n0 A dr_A dc_A True * by (auto simp add: Let_def)
+    have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?A' = P * A" 
+      by (rule A'_swaprows_invertible_mat[OF A], insert non_zero_positions_xs_m n0 m0 l nz_xs_m, auto) 
+    from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)"
+      and inv_Q: "invertible_mat Q" and A'_QA: "?A' = Q * A" by blast
+    have "reduce_below_abs 0 ?non_zero_positions D ?A' = (P * Q) * A" using Q A'_QA P r_PA' A by auto
+    moreover have "invertible_mat (P*Q)" using P Q inv_P inv_Q invertible_mult_JNF by blast
+    moreover have "(P*Q) \<in> carrier_mat (m + n) (m + n)" using P Q by auto
+    ultimately show ?thesis using Find_rw by metis
+  qed     
+  qed
+qed
+
+
+corollary FindPreHNF_echelon_form_mx0:
+  assumes "A \<in> carrier_mat m 0"
+  shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
+  by (rule echelon_form_mx0, rule FindPreHNF[OF assms])
+               
+
+lemma FindPreHNF_echelon_form_mx1:
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A'': "A'' \<in> carrier_mat m n" and n2: "n<2" and D_g0: "D>0" and mn: "m\<ge>n"
+shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
+proof (cases "n=0")
+  case True
+  have A: "A \<in> carrier_mat m 0" using A_def A'' True 
+    by (metis add.comm_neutral append_rows_def carrier_matD carrier_matI index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3)) 
+  show ?thesis unfolding True by (rule FindPreHNF_echelon_form_mx0, insert A, auto)
+next
+  case False hence n0: "0<n" by auto
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
+  have m0: "m>0" using mn n2 n0 by auto
+  have D0: "D\<noteq>0" using D_g0 by auto
+  show ?thesis
+  proof (cases "m+n<2")
+    case True
+    show ?thesis by (rule echelon_form_JNF_1xn[OF _ True], rule FindPreHNF[OF A])
+  next
+    case False note mn_le_2 = False
+    have dr_A: "dim_row A \<ge>2" using False n2 A by auto
+    have dc_A: "dim_col A < 2" using n2 A by auto
+    let ?non_zero_positions = "filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<dim_row A]" 
+    let ?A' = "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)" 
+    define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
+    let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)"
+    have nz_xs_m: "?non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
+      and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
+      using non_zero_positions_xs_m'[OF A_def A'' _ m0 n0 D0] using D0 A unfolding xs_def by auto  
+    have *: "FindPreHNF abs_flag D A = (if abs_flag then reduce_below_abs 0 ?non_zero_positions D ?A' 
+        else reduce_below 0 ?non_zero_positions D ?A')"
+      using dr_A dc_A by (auto simp add: Let_def) 
+    have l: "length ?non_zero_positions > 1" if "xs\<noteq>[]" using that unfolding nz_xs_m by auto
+    have e: "echelon_form_JNF (reduce_below 0 ?non_zero_positions D ?A')"
+    proof (cases "A $$ (0,0) \<noteq>0")
+      case True note A00 = True
+      have 1: "reduce_below 0 ?non_zero_positions D ?A' = reduce_below 0 ?non_zero_positions D A"
+        using True by auto
+      have "echelon_form_JNF (reduce_below 0 ?non_zero_positions D A)"
+      proof (rule echelon_form_JNF_mx1[OF _ n2]) 
+        show "reduce_below 0 ?non_zero_positions D A \<in> carrier_mat (m+n) n" using A by auto
+        show "\<forall>i\<in>{1..<m + n}. reduce_below 0 ?non_zero_positions D A $$ (i, 0) = 0"
+        proof 
+          fix i assume i: "i \<in> {1..<m + n}"
+          show "reduce_below 0 ?non_zero_positions D A $$ (i, 0) =0"
+          proof (cases "i\<in>set ?non_zero_positions")
+            case True
+            show ?thesis unfolding nz_xs_m 
+              by (rule reduce_below_0_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m D_g0],
+                  insert nz_xs_m True, auto)
+          next
+            case False note i_notin_set = False
+            have "reduce_below 0 ?non_zero_positions D A $$ (i, 0) = A $$ (i, 0)" unfolding nz_xs_m 
+              by (rule reduce_below_preserves_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m _ _ _ D_g0],
+                  insert i nz_xs_m i_notin_set, auto)
+            also have "... = 0" using i_notin_set i A unfolding set_filter by auto
+            finally show ?thesis .        
+          qed
+        qed
+      qed
+      thus ?thesis using 1 by argo
+    next
+      case False hence A00: "A $$ (0,0) = 0" by simp
+      let ?i = "((xs @ [m]) ! 0)"
+      let ?S = "swaprows 0 ?i A"
+      let ?S' = "mat_of_rows n (map (Matrix.row (swaprows 0 ?i A)) [0..<m])"
+      have rw: "(if A$$(0, 0) \<noteq> 0 then A else let i = ?non_zero_positions!0 in swaprows 0 i A) = ?S"
+        using A00 nz_xs_m by auto
+      have S: "?S \<in> carrier_mat (m+n) n" using A by auto
+      have A00_eq_A'00: "A $$ (0, 0) = A'' $$ (0, 0)" 
+        by (metis A'' A_def add_gr_0 append_rows_def n0 carrier_matD index_mat_four_block(1) m0)
+      show ?thesis
+      proof (cases "xs=[]")
+        case True
+        have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
+        obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
+          by (metis prod_cases5)        
+        have Am0: "A $$ (m,0) = D"
+        proof -
+          have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
+            by (smt A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
+                less_add_same_cancel1 less_diff_conv ordered_cancel_comm_monoid_diff_class.diff_add
+                nat_less_le)
+          also have "... = D" by (simp add: n0)
+          finally show ?thesis .
+        qed
+        have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
+        have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
+        have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
+          using pquvd Sm0 S00 Am0 A00 by auto
+        have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto
+        also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
+        finally have *: "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D (swaprows 0 m A)" .
+        have "echelon_form_JNF (reduce 0 m D (swaprows 0 m A))"
+        proof (rule echelon_form_JNF_mx1[OF _ n2])
+          show "reduce 0 m D (swaprows 0 m A) \<in> carrier_mat (m+n) n"
+            using A n2 reduce_carrier by (auto simp add: Let_def) 
+          show "\<forall>i\<in>{1..<m+n}. reduce 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
+          proof
+            fix i assume i: "i \<in> {1..<m+n}"
+            show "reduce 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
+            proof (cases "i=m")
+              case True
+              show ?thesis
+              proof (unfold True, rule reduce_0[OF _ _ n0])
+                show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto
+              qed (insert m0 n0 S00 D_g0, auto)
+            next
+              case False
+              have "reduce 0 m D (swaprows 0 m A) $$ (i, 0) = (swaprows 0 m A) $$ (i, 0)"
+              proof (rule reduce_preserves[OF _ n0])
+                show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto  
+              qed (insert m0 n0 S00 D_g0 False i, auto)
+              also have "... = A $$ (i, 0)" using i False A n0 by auto
+              also have "... = 0"
+              proof (rule ccontr)
+                assume "A $$ (i, 0) \<noteq> 0" hence "i \<in> set ?non_zero_positions" using i A by auto 
+                hence "i=m" using nz_xs_m True by auto
+                thus False using False by contradiction
+              qed
+              finally show ?thesis .
+            qed 
+          qed
+        qed       
+        then show ?thesis using * by presburger
+      next
+        case False        
+      have l: "length ?non_zero_positions > 1"    using False nz_xs_m by auto   
+      hence l_xs: "length xs > 0" using nz_xs_m by auto
+      hence xs_m_less_m: "(xs@[m]) ! 0 < m" by (simp add: all_less_m nth_append)
+      have S00: "?S $$ (0,0) \<noteq> 0"
+        by (smt A add_pos_pos append_Cons_nth_left n0 carrier_matD index_mat_swaprows(1)
+            l_xs m0 mem_Collect_eq nth_mem set_filter xs_def)
+      have S': "?S' \<in> carrier_mat m n" using A by auto
+      have S_S'D: "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def xs_m_less_m]) 
+      have 2: "reduce_below 0 ?non_zero_positions D ?A' = reduce_below 0 ?non_zero_positions D ?S"
+        using A00 nz_xs_m by algebra
+      have "echelon_form_JNF (reduce_below 0 ?non_zero_positions D ?S)"
+      proof (rule echelon_form_JNF_mx1[OF _ n2])
+        show "reduce_below 0 ?non_zero_positions D ?S \<in> carrier_mat (m+n) n" using A by auto
+        show "\<forall>i\<in>{1..<m + n}. reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) = 0"
+        proof 
+          fix i assume i: "i \<in> {1..<m + n}"
+          show "reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) =0"
+          proof (cases "i\<in>set ?non_zero_positions")
+            case True
+            show ?thesis unfolding nz_xs_m 
+              by (rule reduce_below_0_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m D_g0],
+                  insert True nz_xs_m, auto)
+          next
+            case False note i_notin_set = False
+            have "reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) = ?S $$ (i, 0)" unfolding nz_xs_m 
+              by (rule reduce_below_preserves_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m _ _ _ D_g0],
+                  insert i nz_xs_m i_notin_set, auto)
+            also have "... = 0" using i_notin_set i A S00 n0 unfolding set_filter by auto              
+            finally show ?thesis .        
+          qed
+        qed
+      qed
+      thus ?thesis using 2 by argo
+    qed
+  qed
+    have e2: "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D ?A')"
+    proof (cases "A $$ (0,0) \<noteq>0")
+      case True note A00 = True
+      have 1: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_below_abs 0 ?non_zero_positions D A"
+        using True by auto
+      have "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D A)"
+      proof (rule echelon_form_JNF_mx1[OF _ n2]) 
+        show "reduce_below_abs 0 ?non_zero_positions D A \<in> carrier_mat (m+n) n" using A by auto
+        show "\<forall>i\<in>{1..<m + n}. reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) = 0"
+        proof 
+          fix i assume i: "i \<in> {1..<m + n}"
+          show "reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) =0"
+          proof (cases "i\<in>set ?non_zero_positions")
+            case True
+            show ?thesis unfolding nz_xs_m 
+              by (rule reduce_below_abs_0_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m D_g0],
+                  insert nz_xs_m True, auto)
+          next
+            case False note i_notin_set = False
+            have "reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) = A $$ (i, 0)" unfolding nz_xs_m 
+              by (rule reduce_below_abs_preserves_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m _ _ _ D_g0],
+                  insert i nz_xs_m i_notin_set, auto)
+            also have "... = 0" using i_notin_set i A unfolding set_filter by auto
+            finally show ?thesis .        
+          qed
+        qed
+      qed
+      thus ?thesis using 1 by argo
+    next
+      case False hence A00: "A $$ (0,0) = 0" by simp
+      let ?i = "((xs @ [m]) ! 0)"
+      let ?S = "swaprows 0 ?i A"
+      let ?S' = "mat_of_rows n (map (Matrix.row (swaprows 0 ?i A)) [0..<m])"
+      have rw: "(if A$$(0, 0) \<noteq> 0 then A else let i = ?non_zero_positions!0 in swaprows 0 i A) = ?S"
+        using A00 nz_xs_m by auto
+      have S: "?S \<in> carrier_mat (m+n) n" using A by auto
+      have A00_eq_A'00: "A $$ (0, 0) = A'' $$ (0, 0)" 
+        by (metis A'' A_def add_gr_0 append_rows_def n0 carrier_matD index_mat_four_block(1) m0)
+      show ?thesis
+      proof (cases "xs=[]")
+        case True
+        have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
+        obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
+          by (metis prod_cases5)        
+        have Am0: "A $$ (m,0) = D"
+        proof -
+          have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
+            by (smt A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
+                less_add_same_cancel1 less_diff_conv ordered_cancel_comm_monoid_diff_class.diff_add
+                nat_less_le)
+          also have "... = D" by (simp add: n0)
+          finally show ?thesis .
+        qed
+        have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
+        have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
+        have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
+          using pquvd Sm0 S00 Am0 A00 by auto
+        have "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_abs 0 m D ?A'" unfolding nz_m by auto
+        also have "... = reduce_abs 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
+        finally have *: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_abs 0 m D (swaprows 0 m A)" .
+        have "echelon_form_JNF (reduce_abs 0 m D (swaprows 0 m A))"
+        proof (rule echelon_form_JNF_mx1[OF _ n2])
+          show "reduce_abs 0 m D (swaprows 0 m A) \<in> carrier_mat (m+n) n"
+            using A n2 reduce_carrier by (auto simp add: Let_def) 
+          show "\<forall>i\<in>{1..<m+n}. reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
+          proof
+            fix i assume i: "i \<in> {1..<m+n}"
+            show "reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
+            proof (cases "i=m")
+              case True
+              show ?thesis
+              proof (unfold True, rule reduce_0[OF _ _ n0])
+                show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto
+              qed (insert m0 n0 S00 D_g0, auto)
+            next
+              case False
+              have "reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = (swaprows 0 m A) $$ (i, 0)"
+              proof (rule reduce_preserves[OF _ n0])
+                show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto  
+              qed (insert m0 n0 S00 D_g0 False i, auto)
+              also have "... = A $$ (i, 0)" using i False A n0 by auto
+              also have "... = 0"
+              proof (rule ccontr)
+                assume "A $$ (i, 0) \<noteq> 0" hence "i \<in> set ?non_zero_positions" using i A by auto 
+                hence "i=m" using nz_xs_m True by auto
+                thus False using False by contradiction
+              qed
+              finally show ?thesis .
+            qed 
+          qed
+        qed       
+        then show ?thesis using * by presburger
+      next
+        case False        
+      have l: "length ?non_zero_positions > 1"    using False nz_xs_m by auto   
+      hence l_xs: "length xs > 0" using nz_xs_m by auto
+      hence xs_m_less_m: "(xs@[m]) ! 0 < m" by (simp add: all_less_m nth_append)
+      have S00: "?S $$ (0,0) \<noteq> 0"
+        by (smt A add_pos_pos append_Cons_nth_left n0 carrier_matD index_mat_swaprows(1)
+            l_xs m0 mem_Collect_eq nth_mem set_filter xs_def)
+      have S': "?S' \<in> carrier_mat m n" using A by auto
+      have S_S'D: "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def xs_m_less_m]) 
+      have 2: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_below_abs 0 ?non_zero_positions D ?S"
+        using A00 nz_xs_m by algebra
+      have "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D ?S)"
+      proof (rule echelon_form_JNF_mx1[OF _ n2])
+        show "reduce_below_abs 0 ?non_zero_positions D ?S \<in> carrier_mat (m+n) n" using A by auto
+        show "\<forall>i\<in>{1..<m + n}. reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) = 0"
+        proof 
+          fix i assume i: "i \<in> {1..<m + n}"
+          show "reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) =0"
+          proof (cases "i\<in>set ?non_zero_positions")
+            case True
+            show ?thesis unfolding nz_xs_m 
+              by (rule reduce_below_abs_0_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m D_g0],
+                  insert True nz_xs_m, auto)
+          next
+            case False note i_notin_set = False
+            have "reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) = ?S $$ (i, 0)" unfolding nz_xs_m 
+              by (rule reduce_below_abs_preserves_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m _ _ _ D_g0],
+                  insert i nz_xs_m i_notin_set, auto)
+            also have "... = 0" using i_notin_set i A S00 n0 unfolding set_filter by auto              
+            finally show ?thesis .        
+          qed
+        qed
+      qed
+      thus ?thesis using 2 by argo
+    qed
+  qed
+    thus ?thesis using * e by presburger
+  qed
+qed
+
+
+lemma FindPreHNF_works_n_ge2:
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A'': "A'' \<in> carrier_mat m n" and "n\<ge>2" and m_le_n: "m\<ge>n" and "D>0"
+shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A \<and> echelon_form_JNF (FindPreHNF abs_flag D A)"
+  using assms
+proof (induct abs_flag D A arbitrary: A'' m n rule: FindPreHNF.induct)
+  case (1 abs_flag D A)  
+  note A_def = "1.prems"(1)
+  note A'' = "1.prems"(2)
+  note n = "1.prems"(3)
+  note m_le_n = "1.prems"(4)
+  note D0 = "1.prems"(5)
+  let ?RAT = "map_mat rat_of_int"
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
+  have mn: "2\<le>m+n" using n by auto
+  have m0: "0<m" using n m_le_n by auto
+  have n0: "0<n" using n by simp
+  have D_not0: "D\<noteq>0" using D0 by auto
+  define non_zero_positions where "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
+  define A' where "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
+  let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)"
+  obtain A'_UL A'_UR A'_DL A'_DR where A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
+    = split_block (?Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1"     
+    by (metis prod_cases4)
+  define sub_PreHNF where "sub_PreHNF = FindPreHNF abs_flag D A'_DR"
+  obtain xs where non_zero_positions_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
+    and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
+    using non_zero_positions_xs_m[OF A_def A'' non_zero_positions_def m0 n0] using D0 by fast
+  define M where "M = (make_first_column_positive A')"  
+  have A': "A' \<in> carrier_mat (m+n) n" unfolding A'_def using A by auto 
+  have mk_A'_not0:"make_first_column_positive A' $$ (0,0) \<noteq> 0"
+    by (rule make_first_column_positive_00[OF A_def A'' non_zero_positions_def
+          A'_def m0 n0 D_not0 m_le_n])  
+  have M: "M \<in> carrier_mat (m+n) n" using A' M_def by auto
+  let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A')) [0..<m])"
+  have M': "?M' \<in> carrier_mat m n" by auto            
+  have M_M'D: "make_first_column_positive A' = ?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" if xs_empty: "xs \<noteq> []"
+  proof (cases "A$$(0,0) \<noteq> 0")
+    case True
+    then have *: "make_first_column_positive A' = make_first_column_positive A"
+      unfolding A'_def by auto        
+    show ?thesis 
+      by (unfold *, rule make_first_column_positive_append_id[OF A'' A_def D0 n0])
+  next
+    case False
+    then have *: "make_first_column_positive A' 
+                  = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)"
+      unfolding A'_def by auto
+    show ?thesis
+    proof (unfold *, rule make_first_column_positive_append_id)
+      let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..<m])"
+      show "swaprows 0 (non_zero_positions ! 0) A =  ?S @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
+      proof (rule swaprows_append_id[OF A'' A_def])
+        have A''00: "A'' $$ (0, 0) = 0"
+          by (metis (no_types, lifting) A A'' A_def False add_sign_intros(2) append_rows_def
+              carrier_matD index_mat_four_block m0 n0)
+        have length_xs: "length xs > 0" using xs_empty by auto
+        have "non_zero_positions ! 0 = xs ! 0" unfolding non_zero_positions_xs_m
+          by (meson length_xs nth_append)
+        thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp
+      qed
+    qed (insert n0 D0, auto)            
+  qed
+  have A'_DR: "A'_DR \<in> carrier_mat (m + (n-1)) (n-1)"
+    by (rule split_block(4)[OF A'_split[symmetric]], insert n M M_def, auto)  
+  have sub_PreHNF: "sub_PreHNF \<in> carrier_mat (m + (n -1)) (n-1)"
+    unfolding sub_PreHNF_def by (rule FindPreHNF[OF A'_DR])
+  hence sub_PreHNF': "sub_PreHNF \<in> carrier_mat (m+n - 1) (n-1)" using n by auto
+  have A'_UL: "A'_UL \<in> carrier_mat 1 1"
+    by (rule split_block(1)[OF A'_split[symmetric], of "m+n-1" "n-1"], insert n A', auto) 
+  have A'_UR: "A'_UR \<in> carrier_mat 1 (n-1)"
+    by (rule split_block(2)[OF A'_split[symmetric], of "m+n-1"], insert n A', auto)
+  have A'_DL: "A'_DL \<in> carrier_mat (m + (n - 1)) 1"
+    by (rule split_block(3)[OF A'_split[symmetric], of _ "n-1"], insert n A', auto)
+
+  show ?case
+  proof (cases abs_flag)
+    case True note abs_flag = True
+      hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
+    = split_block (reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')) 1 1"   using A'_split by auto
+    let ?R = "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')"
+   have fbm_R: "four_block_mat A'_UL A'_UR A'_DL A'_DR 
+     = reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')"
+    by (rule split_block(5)[symmetric, OF A'_split[symmetric], of "m+n-1" "n-1"], insert A' n, auto)
+  have A'_DL0: "A'_DL = (0\<^sub>m (m + (n - 1)) 1)"   
+  proof (rule eq_matI)
+    show "dim_row A'_DL = dim_row (0\<^sub>m (m + (n - 1)) 1)"
+      and "dim_col A'_DL = dim_col (0\<^sub>m (m + (n - 1)) 1)" using A'_DL by auto    
+    fix i j assume i: "i < dim_row (0\<^sub>m (m + (n - 1)) 1)" and j: "j < dim_col (0\<^sub>m (m + (n - 1)) 1)"
+    have j0: "j=0" using j by auto
+    have "0 = ?R $$ (i+1,j)"
+    proof (unfold M_def non_zero_positions_xs_m j0, 
+        rule reduce_below_abs_0_case_m_make_first_column_positive[symmetric,
+          OF A'' m0 n0 A_def m_le_n _  d_xs all_less_m _ _ D0 _ ])
+      show "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)"
+        using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
+      show "xs @ [m] = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A]"
+        using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
+    qed (insert i n0, auto)
+    also have "... = four_block_mat A'_UL A'_UR A'_DL A'_DR $$ (i+1,j)" unfolding fbm_R ..
+    also have "... = (if i+1 < dim_row A'_UL then if j < dim_col A'_UL 
+            then A'_UL $$ (i+1, j) else A'_UR $$ (i+1, j - dim_col A'_UL)
+            else if j < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j)
+            else A'_DR $$ (i+1 - dim_row A'_UL, j - dim_col A'_UL))"
+      by (rule index_mat_four_block, insert A'_UL A'_DR i j, auto)
+    also have "... = A'_DL $$ (i, j)" using A'_UL A'_UR i j by auto
+    finally show "A'_DL $$ (i, j) = 0\<^sub>m (m + (n - 1)) 1 $$ (i, j)" using i j by auto
+  qed
+
+  let ?A'_DR_m = "mat_of_rows (n-1) [Matrix.row A'_DR i. i \<leftarrow> [0..<m]]"
+  have A'_DR_m: "?A'_DR_m \<in> carrier_mat m (n-1)" by auto
+  have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)"
+  proof (rule eq_matI)
+    show dr: "dim_row A'_DR = dim_row (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))" 
+      by (metis A'_DR A'_DR_m append_rows_def carrier_matD(1) index_mat_four_block(2) 
+          index_one_mat(2) index_smult_mat(2) index_zero_mat(2))
+    show dc: "dim_col A'_DR = dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
+      by (metis A'_DR A'_DR_m add.comm_neutral append_rows_def
+          carrier_matD(2) index_mat_four_block(3) index_zero_mat(3))  
+    fix i j assume i: "i < dim_row(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
+      and j: "j<dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
+    have jn1: "j<n-1" using dc j A'_DR by auto
+    show "A'_DR $$ (i,j) = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
+    proof (cases "i<m")
+      case True
+      have "A'_DR $$ (i,j) = ?A'_DR_m $$ (i,j)"
+        by (metis A'_DR A'_DR_m True dc carrier_matD(1) carrier_matD(2) j le_add1 
+            map_first_rows_index mat_of_rows_carrier(2) mat_of_rows_index)
+      also have "... = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
+        by (metis (mono_tags, lifting) A'_DR A'_DR_m True append_rows_def 
+            carrier_matD dc i index_mat_four_block j)
+      finally show ?thesis .
+    next
+      case False note i_ge_m = False
+      let ?reduce_below = "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')"
+      have 1: "(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
+        by (smt A'_DR A'_DR_m False append_rows_nth carrier_matD carrier_mat_triv dc dr i
+            index_one_mat(2) index_one_mat(3) index_smult_mat(2,3) j)
+      have "?reduce_below = four_block_mat A'_UL A'_UR A'_DL A'_DR" using fbm_R ..
+      also have "... $$ (i+1,j+1) = (if i+1 < dim_row A'_UL then if j+1 < dim_col A'_UL 
+              then A'_UL $$ (i+1, j+1) else A'_UR $$ (i+1, j+1 - dim_col A'_UL)
+              else if j+1 < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j+1)
+              else A'_DR $$ (i+1 - dim_row A'_UL, j+1 - dim_col A'_UL))"
+        by (rule index_mat_four_block, insert i j A'_UL A'_DR dr dc, auto)
+      also have "... = A'_DR $$ (i,j)" using A'_UL by auto
+      finally have 2: "?reduce_below $$ (i+1,j+1) = A'_DR $$ (i,j)" .
+      show ?thesis 
+      proof (cases "xs = []")
+        case True note xs_empty = True
+        have i1_m: "i + 1 \<noteq> m" 
+          using False less_add_one by blast
+        have j1n: "j+1<n"
+          using jn1 less_diff_conv by blast
+        have i1_mn: "i+1<m + n"
+          using i i_ge_m
+          by (metis A'_DR carrier_matD(1) dr less_diff_conv sub_PreHNF sub_PreHNF')
+        have "?reduce_below = reduce_abs 0 m D M"
+          unfolding non_zero_positions_xs_m xs_empty M_def by auto
+        also have "... $$ (i+1,j+1) = M $$ (i+1, j+1)"
+          by (rule reduce_preserves[OF M j1n _ i1_m _ i1_mn], insert M_def mk_A'_not0, auto)         
+        also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
+        proof (cases "A $$ (0,0) = 0")
+          case True
+          let ?S = "(swaprows 0 m A)"
+          have S: "?S \<in> carrier_mat (m+n) n" using A by auto
+          have Si10: "?S $$ (i+1,0) = 0"
+          proof -
+            have "?S $$ (i+1,0) = A $$ (i+1,0)" using i1_m n0 i1_mn S by auto
+            also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
+              by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
+                  index_mat_four_block less_imp_diff_less n0)
+            also have "... = 0" using i_ge_m n0 i1_mn by auto
+            finally show ?thesis .
+          qed
+          have "M $$ (i+1, j+1) = (make_first_column_positive ?S) $$ (i+1,j+1)"
+            by (simp add: A'_def M_def True non_zero_positions_xs_m xs_empty)
+          also have "... = (if ?S $$ (i+1,0) < 0 then - ?S $$ (i+1,j+1) else ?S $$ (i+1,j+1))" 
+            unfolding make_first_column_positive.simps using S i1_mn j1n by auto
+          also have "... = ?S $$ (i+1,j+1)" using Si10 by auto
+          also have "... = A $$ (i+1,j+1)" using i1_m n0 i1_mn S jn1 by auto
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
+            by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
+                index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
+          finally show ?thesis .
+        next
+          case False         
+          have Ai10: "A $$ (i+1,0) = 0"
+          proof -
+            have "A $$ (i+1,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
+              by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
+                  index_mat_four_block less_imp_diff_less n0)
+            also have "... = 0" using i_ge_m n0 i1_mn by auto
+            finally show ?thesis .
+          qed          
+          have "M $$ (i+1, j+1) = (make_first_column_positive A) $$ (i+1,j+1)"
+            by (simp add: A'_def M_def False True non_zero_positions_xs_m)
+          also have "... = (if A $$ (i+1,0) < 0 then - A $$ (i+1,j+1) else A $$ (i+1,j+1))" 
+            unfolding make_first_column_positive.simps using A i1_mn j1n by auto
+          also have "... = A $$ (i+1,j+1)" using Ai10 by auto
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
+            by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
+                index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
+          finally show ?thesis .
+        qed
+        also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
+          by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
+        also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
+          by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
+              linorder_not_less add_diff_cancel_right' add_diff_cancel_right' add_diff_cancel_left')
+        also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
+          by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
+        finally show ?thesis using 1 2 by auto
+      next
+        case False     
+      have "?reduce_below $$ (i+1, j+1) = M $$ (i+1, j+1)"
+      proof (unfold non_zero_positions_xs_m M_def,
+          rule reduce_below_abs_preserves_case_m[OF M' m0 _ M_M'D mk_A'_not0 m_le_n _ d_xs all_less_m _ _ _ D0])            
+        show "j + 1 < n" using jn1 by auto
+        show "i + 1 \<notin> set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto
+        show "i + 1 \<noteq> 0" by auto
+        show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto
+        show " i + 1 \<noteq> m" using i_ge_m by auto
+      qed (insert False)
+      also have "... = (?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo
+      also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
+      proof -
+        have f1: "1 + j < n"
+          by (metis Groups.add_ac(2) jn1 less_diff_conv)
+        have f2: "\<forall>n. \<not> n + i < m"
+          by (meson i_ge_m linorder_not_less nat_SN.compat not_add_less2)
+        have "i < m + (n - 1)"
+          by (metis (no_types) A'_DR carrier_matD(1) dr i)
+        then have "1 + i < m + n"
+          using f1 by linarith
+        then show ?thesis
+          using f2 f1 by (metis (no_types) Groups.add_ac(2) M' append_rows_def carrier_matD(1) 
+              dim_col_mat(1) index_mat_four_block(1) index_one_mat(2) index_smult_mat(2) 
+              index_zero_mat(2,3) mat_of_rows_def nat_arith.rule0)
+      qed
+      also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
+        by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
+      also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
+        by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
+            linorder_not_less add_diff_cancel_right' add_diff_cancel_left')
+      also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
+        by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
+      finally have 3: "?reduce_below $$ (i+1,j+1) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" .            
+      show ?thesis using 1 2 3 by presburger
+    qed              
+  qed
+qed
+  let ?A'_DR_n = "mat_of_rows (n - 1) (map (Matrix.row A'_DR) [0..<n - 1])"
+  have hyp: "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR 
+  \<and> echelon_form_JNF sub_PreHNF" 
+  proof (cases "2 \<le> n - 1")
+    case True
+    show ?thesis
+      by (unfold sub_PreHNF_def, rule "1.hyps"[OF _ _ _ non_zero_positions_def A'_def _ _ _ _ _])
+         (insert A n D0 m_le_n True A'DR_A'DR_m_D A A'_split abs_flag, auto)
+  next
+    case False
+    have "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR"
+      by (unfold sub_PreHNF_def, rule FindPreHNF_invertible_mat_mx2
+          [OF A'DR_A'DR_m_D A'_DR_m _ _ D0 _])
+          (insert False m_le_n n0 m0 "1"(4), auto)
+    moreover have "echelon_form_JNF sub_PreHNF" unfolding sub_PreHNF_def 
+      by (rule FindPreHNF_echelon_form_mx1[OF A'DR_A'DR_m_D A'_DR_m _ D0 _],
+          insert False n0 m_le_n, auto) 
+    ultimately show ?thesis by simp
+  qed  
+  from this obtain P where P: "P \<in> carrier_mat (m + (n - 1)) (m + (n - 1))"
+    and inv_P: "invertible_mat P" and sub_PreHNF_P_A'_DR: "sub_PreHNF = P * A'_DR" by blast
+  define P' where "P' = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m+(n-1))) (0\<^sub>m (m+(n-1)) 1) P)"
+  have P': "P' \<in> carrier_mat (m+n) (m+n)" 
+  proof -
+    have "P' \<in> carrier_mat (1 + (m+(n-1))) (1 + (m+(n-1))) "
+      unfolding P'_def by (rule four_block_carrier_mat[OF _ P], simp) 
+    thus ?thesis using n by auto
+  qed
+  have inv_P': "invertible_mat P'" 
+    unfolding P'_def by (rule invertible_mat_four_block_mat_lower_right[OF P inv_P])
+  have dr_A2: "dim_row A \<ge> 2" using A m0 n by auto
+  have dc_A2: "dim_col A \<ge> 2" using n A by blast
+  have *: "(dim_col A = 0) = False" using dc_A2 by auto
+  have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" 
+    unfolding FindPreHNF.simps[of abs_flag D A] using A'_split mn n A dr_A2 dc_A2 abs_flag
+    unfolding Let_def sub_PreHNF_def M_def A'_def non_zero_positions_def *    
+    by (smt (z3) linorder_not_less split_conv)
+  also have "... = P' * (reduce_below_abs 0 non_zero_positions D M)"
+  proof -
+    have "P' * (reduce_below_abs 0 non_zero_positions D M) 
+      = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m + (n - 1))) (0\<^sub>m (m + (n - 1)) 1) P 
+      * four_block_mat A'_UL A'_UR A'_DL A'_DR"
+      unfolding P'_def fbm_R[unfolded M_def[symmetric], symmetric] ..
+    also have "... = four_block_mat 
+            ((1\<^sub>m 1) * A'_UL + (0\<^sub>m 1 (m + (n - 1)) * A'_DL)) 
+            ((1\<^sub>m 1) * A'_UR + (0\<^sub>m 1 (m + (n - 1))) * A'_DR) 
+            ((0\<^sub>m (m + (n - 1)) 1) * A'_UL + P * A'_DL) 
+            ((0\<^sub>m (m + (n - 1)) 1) * A'_UR + P * A'_DR)" 
+      by (rule mult_four_block_mat[OF _ _ _ P A'_UL A'_UR A'_DL A'_DR], auto)
+    also have "... = four_block_mat A'_UL A'_UR (P * A'_DL) (P * A'_DR)"
+      by (rule cong_four_block_mat, insert A'_UL A'_UR A'_DL A'_DR P, auto)
+    also have "... = four_block_mat A'_UL A'_UR (0\<^sub>m (m + (n - 1)) 1) sub_PreHNF"
+      unfolding A'_DL0 sub_PreHNF_P_A'_DR using P by simp
+    also have "... = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF"
+      unfolding A'_DL0 by simp
+    finally show ?thesis ..
+  qed
+  finally have Find_P'_reduceM: "FindPreHNF abs_flag D A =  P' * (reduce_below_abs 0 non_zero_positions D M)" .
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m + n) (m + n) 
+    \<and> reduce_below_abs 0 (xs @ [m]) D M = Q * M"
+  proof (cases "xs = []")
+    case True note xs_empty = True
+    have rw: "reduce_below_abs 0 (xs @ [m]) D M = reduce_abs 0 m D M" using True by auto
+    obtain p q u v d where pquvd: "(p, q, u, v, d) = euclid_ext2 (M $$ (0, 0)) (M $$ (m, 0))"
+      by (simp add: euclid_ext2_def)
+    have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce_abs 0 m D M = P * M"  
+    proof (rule reduce_abs_invertible_mat_case_m[OF _ _ m0 _ _ _ _ m_le_n n0 pquvd])
+          show "M $$ (0, 0) \<noteq> 0" 
+            using M_def mk_A'_not0 by blast
+          define M' where  "M' = mat_of_rows n (map (Matrix.row M) [0..<m])"
+          define M'' where "M'' = mat_of_rows n (map (Matrix.row M) [m..<m+n])"
+          define A2 where "A2 = Matrix.mat (dim_row M) (dim_col M)
+          (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
+                    else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
+                    else M $$ (i, k))"
+          show M_M'_M'': "M = M' @\<^sub>r M''" unfolding M'_def M''_def            
+            by (metis M append_rows_split carrier_matD le_add1)
+          show M': "M' \<in> carrier_mat m n" unfolding M'_def by fastforce
+          show M'': "M'' \<in> carrier_mat n n" unfolding M''_def by fastforce
+          show "0 \<noteq> m" using m0 by simp
+          show "A2 = Matrix.mat (dim_row M) (dim_col M)
+          (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
+                    else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
+                    else M $$ (i, k))"
+            (is "_ = ?rhs") using A A2_def by auto
+          define xs' where "xs' =  filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]"
+          define ys' where  "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]"
+          show "xs' = filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]" unfolding xs'_def by auto
+          show "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]" unfolding ys'_def by auto
+          have M''D: "(M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
+            if jn: "j<n" and j0: "j>0" for j
+          proof -
+            have Ajm0: "A $$ (j+m,0) = 0"
+            proof -
+              have "A $$ (j+m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j+m-m,0)"
+                by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' add.commute append_rows_def carrier_matD
+                    diff_add_inverse2 index_mat_four_block index_one_mat(2) index_smult_mat(2)
+                    le_add2 less_diff_conv2 n0 not_add_less2 that(1))
+              also have "... = 0" using jn j0 by auto
+              finally show ?thesis .
+            qed
+            have "M'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
+            proof (cases "A$$(0,0) = 0")
+              case True 
+              have "M'' $$ (j, i) = make_first_column_positive (swaprows 0 m A) $$ (j+m,i)"                
+                by (smt A'_def Groups.add_ac(2) M' M'' M_M'_M'' M_def True append.simps(1) 
+                    append_rows_nth3 diff_add_inverse2 jn le_add2 local.non_zero_positions_xs_m
+                    nat_add_left_cancel_less nth_Cons_0 that xs_empty)
+              also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
+              also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
+                by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
+                    carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
+              finally show ?thesis .            
+            next
+              case False
+              have "A' = A" unfolding A'_def non_zero_positions_xs_m using False True by auto
+              hence "M'' $$ (j, i) = make_first_column_positive A $$ (j+m,i)"                
+                by (smt m_le_n M' M'' M_M'_M'' M_def append_rows_nth2 jn nat_SN.compat that)                
+              also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
+              also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
+                by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
+                    carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
+              finally show ?thesis .
+            qed                           
+            thus ?thesis using jn j0 by auto
+          qed
+          have Am0D: "A$$(m,0) = D"
+          proof -
+            have "A$$(m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
+              by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' append_rows_def carrier_matD
+                  diff_less_mono2 diff_self_eq_0 index_mat_four_block index_one_mat(2) 
+                  index_smult_mat(2) less_add_same_cancel1 n0 semiring_norm(137))
+            also have "... = D" using m0 n0 by auto
+            finally show ?thesis .
+          qed
+          hence S00D: "(swaprows 0 m A) $$ (0,0) = D" using n0 m0 A by auto
+          have Sm00: "(swaprows 0 m A) $$ (m,0) = A$$(0,0)" using n0 m0 A by auto
+          have M00D: "M $$ (0, 0) = D" if A00: "A$$(0,0) = 0"
+          proof -
+            have "M $$ (0,0) = (make_first_column_positive (swaprows 0 m A)) $$ (0,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if (swaprows 0 m A) $$ (0,0) < 0 then - (swaprows 0 m A) $$(0,0)
+                              else (swaprows 0 m A) $$(0,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = (swaprows 0 m A) $$(0,0)" using S00D D0 by auto
+            also have "... = D" using S00D by auto
+            finally show ?thesis .
+          qed
+          have Mm00: "M $$ (m, 0) = 0" if A00: "A$$(0,0) = 0"
+          proof -
+            have "M $$ (m,0) = (make_first_column_positive (swaprows 0 m A)) $$ (m,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if (swaprows 0 m A) $$ (m,0) < 0 then - (swaprows 0 m A) $$(m,0)
+                              else (swaprows 0 m A) $$(m,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = (swaprows 0 m A) $$(m,0)" using Sm00 A00 D0 by auto
+            also have "... = 0" using Sm00 A00 by auto
+            finally show ?thesis .
+          qed
+          have M000: "M $$ (0, 0) = abs (A$$(0,0))" if A00: "A$$(0,0) \<noteq> 0"
+          proof -
+            have "M $$ (0,0) = (make_first_column_positive A) $$ (0,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if A $$ (0,0) < 0 then - A $$(0,0)
+                              else A $$(0,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = abs (A$$(0,0))" using Sm00 A00 by auto
+            finally show ?thesis .
+          qed
+          have Mm0D: "M $$ (m, 0) = D" if A00: "A $$ (0,0) \<noteq> 0"
+          proof -
+            have "M $$ (m,0) = (make_first_column_positive A) $$ (m,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if A $$ (m,0) < 0 then - A $$(m,0)
+                              else A $$(m,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = A $$(m,0)" using S00D D0 Am0D by auto
+            also have "... = D" using Am0D D0 by auto
+            finally show ?thesis .
+          qed
+          have "0 \<notin> set xs'"
+          proof -
+            have "A2 $$ (0,0) = p * M $$ (0, 0) + q * M $$ (m, 0)" 
+              using A A2_def n0 M by auto
+            also have "... = gcd (M $$ (0, 0)) (M $$ (m, 0))"
+              by (metis euclid_ext2_works(1,2) pquvd)
+            also have "abs ... \<le> D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce
+            finally have "abs (A2 $$ (0,0)) \<le> D" .
+            thus ?thesis unfolding xs'_def using D0 by auto
+          qed
+          thus "\<forall>j\<in>set xs'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"  
+            using M''D xs'_def by auto
+          have "0 \<notin> set ys'"
+          proof -
+            have "A2 $$ (m,0) = u * M $$ (0, 0) + v * M $$ (m, 0)"
+              using A A2_def n0 m0 M by auto
+            also have "... = - M $$ (m, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (0, 0) 
+                + M $$ (0, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (m, 0) "
+              by (simp add: euclid_ext2_works[OF pquvd[symmetric]])
+            also have "... = 0" using M00D Mm00 M000 Mm0D
+              by (smt dvd_div_mult_self euclid_ext2_works(3) euclid_ext2_works(5)
+                  more_arith_simps(11) mult.commute mult_minus_left pquvd semiring_gcd_class.gcd_dvd1)
+            finally have "A2 $$ (m,0) = 0" .
+            thus ?thesis unfolding ys'_def using D0 by auto
+          qed
+          thus "\<forall>j\<in>set ys'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
+            using M''D ys'_def by auto   
+        qed (insert D0)
+        then show ?thesis using rw by auto
+  next
+    case False
+    show ?thesis
+      by (unfold M_def, rule reduce_below_abs_invertible_mat_case_m[OF M' m0 n0 M_M'D[OF False] 
+          mk_A'_not0 m_le_n d_xs all_less_m D0])
+  qed
+   
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
+    and reduce_QM: "reduce_below_abs 0 (xs @ [m]) D M = Q * M" by blast
+  have "\<exists>R. invertible_mat R 
+    \<and> R \<in> carrier_mat (dim_row A') (dim_row A') \<and> M = R * A'"
+    by (unfold M_def, rule make_first_column_positive_invertible)
+  from this obtain R where inv_R: "invertible_mat R"
+    and R: "R \<in> carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> A' = P * A" 
+    by (rule A'_swaprows_invertible_mat[OF A A'_def non_zero_positions_def],
+        insert non_zero_positions_xs_m n m0, auto)
+  from this obtain S where inv_S: "invertible_mat S"
+   and S: "S \<in> carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A" 
+    using A by auto
+  have "(P'*Q*R*S) \<in> carrier_mat (m+n) (m+n)" using P' Q R S A' A by auto
+  moreover have "FindPreHNF abs_flag D A = (P'*Q*R*S) * A" using Find_P'_reduceM reduce_QM 
+    unfolding  M_RA' A'_SA M_def
+    by (smt A' A'_SA P' Q R S assoc_mult_mat carrier_matD carrier_mat_triv index_mult_mat(2,3) 
+        non_zero_positions_xs_m)
+  moreover have "invertible_mat (P'*Q*R*S)" using inv_P' inv_Q inv_R inv_S using P' Q R S A' A 
+    by (metis carrier_matD carrier_mat_triv index_mult_mat(2,3) invertible_mult_JNF)
+  ultimately have exists_inv: "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
+    \<and> FindPreHNF abs_flag D A = P * A" by blast
+  moreover have "echelon_form_JNF (FindPreHNF abs_flag D A)" 
+  proof (rule echelon_form_four_block_mat[OF A'_UL A'_UR sub_PreHNF'   ])
+    show "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR (0\<^sub>m (m + n - 1) 1) sub_PreHNF" 
+      using A'_DL0 FindPreHNF_as_fbm sub_PreHNF sub_PreHNF' by auto
+    have "A'_UL $$ (0, 0) = ?R $$ (0,0)"
+      by (metis (mono_tags, lifting) A A'_DR A'_UL Find_P'_reduceM M_def 
+          \<open>FindPreHNF abs_flag D A = P' * Q * R * S * A\<close> add_Suc_right add_sign_intros(2) carrier_matD fbm_R
+          index_mat_four_block(1,3) index_mult_mat(3) m0 n0 plus_1_eq_Suc
+          zero_less_one_class.zero_less_one)
+    also have "... \<noteq> 0"
+    proof (cases "xs=[]")
+      case True
+      have "?R $$ (0,0) = reduce_abs 0 m D M $$ (0,0)"
+        unfolding non_zero_positions_xs_m True M_def by simp
+      also have "... \<noteq> 0"
+        by (metis D_not0 M M_def add_pos_pos less_add_same_cancel1 m0 mk_A'_not0 n0 reduce_not0)
+      finally show ?thesis .
+    next
+      case False
+      show ?thesis
+        by (unfold non_zero_positions_xs_m,
+          rule reduce_below_abs_not0_case_m[OF M' m0 n0 M_M'D[OF False] mk_A'_not0 m_le_n all_less_m D_not0])     
+    qed       
+    finally show "A'_UL $$ (0, 0) \<noteq> 0" .
+  qed (insert mn n hyp, auto)
+  ultimately show ?thesis by blast
+  next
+    case False
+      hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
+    = split_block (reduce_below 0 non_zero_positions D (make_first_column_positive A')) 1 1"   using A'_split by auto
+    let ?R = "reduce_below 0 non_zero_positions D (make_first_column_positive A')"
+   have fbm_R: "four_block_mat A'_UL A'_UR A'_DL A'_DR 
+     = reduce_below 0 non_zero_positions D (make_first_column_positive A')"
+    by (rule split_block(5)[symmetric, OF A'_split[symmetric], of "m+n-1" "n-1"], insert A' n, auto)
+  have A'_DL0: "A'_DL = (0\<^sub>m (m + (n - 1)) 1)"   
+  proof (rule eq_matI)
+    show "dim_row A'_DL = dim_row (0\<^sub>m (m + (n - 1)) 1)"
+      and "dim_col A'_DL = dim_col (0\<^sub>m (m + (n - 1)) 1)" using A'_DL by auto    
+    fix i j assume i: "i < dim_row (0\<^sub>m (m + (n - 1)) 1)" and j: "j < dim_col (0\<^sub>m (m + (n - 1)) 1)"
+    have j0: "j=0" using j by auto
+    have "0 = ?R $$ (i+1,j)"
+    proof (unfold M_def non_zero_positions_xs_m j0, 
+        rule reduce_below_0_case_m_make_first_column_positive[symmetric,
+          OF A'' m0 n0 A_def m_le_n _  d_xs all_less_m _ _ D0 _ ])
+      show "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)"
+        using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
+      show "xs @ [m] = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A]"
+        using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
+    qed (insert i n0, auto)
+    also have "... = four_block_mat A'_UL A'_UR A'_DL A'_DR $$ (i+1,j)" unfolding fbm_R ..
+    also have "... = (if i+1 < dim_row A'_UL then if j < dim_col A'_UL 
+            then A'_UL $$ (i+1, j) else A'_UR $$ (i+1, j - dim_col A'_UL)
+            else if j < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j)
+            else A'_DR $$ (i+1 - dim_row A'_UL, j - dim_col A'_UL))"
+      by (rule index_mat_four_block, insert A'_UL A'_DR i j, auto)
+    also have "... = A'_DL $$ (i, j)" using A'_UL A'_UR i j by auto
+    finally show "A'_DL $$ (i, j) = 0\<^sub>m (m + (n - 1)) 1 $$ (i, j)" using i j by auto
+  qed
+
+  let ?A'_DR_m = "mat_of_rows (n-1) [Matrix.row A'_DR i. i \<leftarrow> [0..<m]]"
+  have A'_DR_m: "?A'_DR_m \<in> carrier_mat m (n-1)" by auto
+  have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)"
+  proof (rule eq_matI)
+    show dr: "dim_row A'_DR = dim_row (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))" 
+      by (metis A'_DR A'_DR_m append_rows_def carrier_matD(1) index_mat_four_block(2) 
+          index_one_mat(2) index_smult_mat(2) index_zero_mat(2))
+    show dc: "dim_col A'_DR = dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
+      by (metis A'_DR A'_DR_m add.comm_neutral append_rows_def
+          carrier_matD(2) index_mat_four_block(3) index_zero_mat(3))  
+    fix i j assume i: "i < dim_row(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
+      and j: "j<dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
+    have jn1: "j<n-1" using dc j A'_DR by auto
+    show "A'_DR $$ (i,j) = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
+    proof (cases "i<m")
+      case True
+      have "A'_DR $$ (i,j) = ?A'_DR_m $$ (i,j)"
+        by (metis A'_DR A'_DR_m True dc carrier_matD(1) carrier_matD(2) j le_add1 
+            map_first_rows_index mat_of_rows_carrier(2) mat_of_rows_index)
+      also have "... = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
+        by (metis (mono_tags, lifting) A'_DR A'_DR_m True append_rows_def 
+            carrier_matD dc i index_mat_four_block j)
+      finally show ?thesis .
+    next
+      case False note i_ge_m = False
+      let ?reduce_below = "reduce_below 0 non_zero_positions D (make_first_column_positive A')"
+      have 1: "(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
+        by (smt A'_DR A'_DR_m False append_rows_nth carrier_matD carrier_mat_triv dc dr i
+            index_one_mat(2) index_one_mat(3) index_smult_mat(2,3) j)
+      have "?reduce_below = four_block_mat A'_UL A'_UR A'_DL A'_DR" using fbm_R ..
+      also have "... $$ (i+1,j+1) = (if i+1 < dim_row A'_UL then if j+1 < dim_col A'_UL 
+              then A'_UL $$ (i+1, j+1) else A'_UR $$ (i+1, j+1 - dim_col A'_UL)
+              else if j+1 < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j+1)
+              else A'_DR $$ (i+1 - dim_row A'_UL, j+1 - dim_col A'_UL))"
+        by (rule index_mat_four_block, insert i j A'_UL A'_DR dr dc, auto)
+      also have "... = A'_DR $$ (i,j)" using A'_UL by auto
+      finally have 2: "?reduce_below $$ (i+1,j+1) = A'_DR $$ (i,j)" .
+      show ?thesis 
+      proof (cases "xs = []")
+        case True note xs_empty = True
+        have i1_m: "i + 1 \<noteq> m" 
+          using False less_add_one by blast
+        have j1n: "j+1<n"
+          using jn1 less_diff_conv by blast
+        have i1_mn: "i+1<m + n"
+          using i i_ge_m
+          by (metis A'_DR carrier_matD(1) dr less_diff_conv sub_PreHNF sub_PreHNF')
+        have "?reduce_below = reduce 0 m D M"
+          unfolding non_zero_positions_xs_m xs_empty M_def by auto
+        also have "... $$ (i+1,j+1) = M $$ (i+1, j+1)"
+          by (rule reduce_preserves[OF M j1n _ i1_m _ i1_mn], insert M_def mk_A'_not0, auto)         
+        also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
+        proof (cases "A $$ (0,0) = 0")
+          case True
+          let ?S = "(swaprows 0 m A)"
+          have S: "?S \<in> carrier_mat (m+n) n" using A by auto
+          have Si10: "?S $$ (i+1,0) = 0"
+          proof -
+            have "?S $$ (i+1,0) = A $$ (i+1,0)" using i1_m n0 i1_mn S by auto
+            also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
+              by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
+                  index_mat_four_block less_imp_diff_less n0)
+            also have "... = 0" using i_ge_m n0 i1_mn by auto
+            finally show ?thesis .
+          qed
+          have "M $$ (i+1, j+1) = (make_first_column_positive ?S) $$ (i+1,j+1)"
+            by (simp add: A'_def M_def True non_zero_positions_xs_m xs_empty)
+          also have "... = (if ?S $$ (i+1,0) < 0 then - ?S $$ (i+1,j+1) else ?S $$ (i+1,j+1))" 
+            unfolding make_first_column_positive.simps using S i1_mn j1n by auto
+          also have "... = ?S $$ (i+1,j+1)" using Si10 by auto
+          also have "... = A $$ (i+1,j+1)" using i1_m n0 i1_mn S jn1 by auto
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
+            by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
+                index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
+          finally show ?thesis .
+        next
+          case False         
+          have Ai10: "A $$ (i+1,0) = 0"
+          proof -
+            have "A $$ (i+1,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
+              by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
+                  index_mat_four_block less_imp_diff_less n0)
+            also have "... = 0" using i_ge_m n0 i1_mn by auto
+            finally show ?thesis .
+          qed          
+          have "M $$ (i+1, j+1) = (make_first_column_positive A) $$ (i+1,j+1)"
+            by (simp add: A'_def M_def False True non_zero_positions_xs_m)
+          also have "... = (if A $$ (i+1,0) < 0 then - A $$ (i+1,j+1) else A $$ (i+1,j+1))" 
+            unfolding make_first_column_positive.simps using A i1_mn j1n by auto
+          also have "... = A $$ (i+1,j+1)" using Ai10 by auto
+          also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
+            by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
+                index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
+          finally show ?thesis .
+        qed
+        also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
+          by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
+        also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
+          by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
+              linorder_not_less add_diff_cancel_right' add_diff_cancel_right' add_diff_cancel_left')
+        also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
+          by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
+        finally show ?thesis using 1 2 by auto
+      next
+        case False     
+      have "?reduce_below $$ (i+1, j+1) = M $$ (i+1, j+1)"
+      proof (unfold non_zero_positions_xs_m M_def,
+          rule reduce_below_preserves_case_m[OF M' m0 _ M_M'D mk_A'_not0 m_le_n _ d_xs all_less_m _ _ _ D0])            
+        show "j + 1 < n" using jn1 by auto
+        show "i + 1 \<notin> set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto
+        show "i + 1 \<noteq> 0" by auto
+        show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto
+        show " i + 1 \<noteq> m" using i_ge_m by auto
+      qed (insert False)
+      also have "... = (?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo
+      also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
+      proof -
+        have f1: "1 + j < n"
+          by (metis Groups.add_ac(2) jn1 less_diff_conv)
+        have f2: "\<forall>n. \<not> n + i < m"
+          by (meson i_ge_m linorder_not_less nat_SN.compat not_add_less2)
+        have "i < m + (n - 1)"
+          by (metis (no_types) A'_DR carrier_matD(1) dr i)
+        then have "1 + i < m + n"
+          using f1 by linarith
+        then show ?thesis
+          using f2 f1 by (metis (no_types) Groups.add_ac(2) M' append_rows_def carrier_matD(1) 
+              dim_col_mat(1) index_mat_four_block(1) index_one_mat(2) index_smult_mat(2) 
+              index_zero_mat(2,3) mat_of_rows_def nat_arith.rule0)
+      qed
+      also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
+        by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
+      also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
+        by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
+            linorder_not_less add_diff_cancel_right' add_diff_cancel_left')
+      also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
+        by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
+      finally have 3: "?reduce_below $$ (i+1,j+1) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" .            
+      show ?thesis using 1 2 3 by presburger
+    qed              
+  qed
+qed
+  let ?A'_DR_n = "mat_of_rows (n - 1) (map (Matrix.row A'_DR) [0..<n - 1])"
+  have hyp: "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR 
+  \<and> echelon_form_JNF sub_PreHNF" 
+  proof (cases "2 \<le> n - 1")
+    case True
+    show ?thesis
+      by (unfold sub_PreHNF_def, rule "1.hyps"[OF _ _ _ non_zero_positions_def A'_def _ _ _ _ _])
+         (insert A n D0 m_le_n True A'DR_A'DR_m_D A A'_split False, auto)
+  next
+    case False
+    have "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR"
+      by (unfold sub_PreHNF_def, rule FindPreHNF_invertible_mat_mx2
+          [OF A'DR_A'DR_m_D A'_DR_m _ _ D0 _])
+          (insert False m_le_n n0 m0 "1"(4), auto)
+    moreover have "echelon_form_JNF sub_PreHNF" unfolding sub_PreHNF_def 
+      by (rule FindPreHNF_echelon_form_mx1[OF A'DR_A'DR_m_D A'_DR_m _ D0 _],
+          insert False n0 m_le_n, auto) 
+    ultimately show ?thesis by simp
+  qed  
+  from this obtain P where P: "P \<in> carrier_mat (m + (n - 1)) (m + (n - 1))"
+    and inv_P: "invertible_mat P" and sub_PreHNF_P_A'_DR: "sub_PreHNF = P * A'_DR" by blast
+  define P' where "P' = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m+(n-1))) (0\<^sub>m (m+(n-1)) 1) P)"
+  have P': "P' \<in> carrier_mat (m+n) (m+n)" 
+  proof -
+    have "P' \<in> carrier_mat (1 + (m+(n-1))) (1 + (m+(n-1))) "
+      unfolding P'_def by (rule four_block_carrier_mat[OF _ P], simp) 
+    thus ?thesis using n by auto
+  qed
+  have inv_P': "invertible_mat P'" 
+    unfolding P'_def by (rule invertible_mat_four_block_mat_lower_right[OF P inv_P])
+  have dr_A2: "dim_row A \<ge> 2" using A m0 n by auto
+  have dc_A2: "dim_col A \<ge> 2" using n A by blast
+  have *: "(dim_col A = 0) = False" using dc_A2 by auto
+  have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" 
+    unfolding FindPreHNF.simps[of abs_flag D A] using A'_split mn n A dr_A2 dc_A2 False
+    unfolding Let_def sub_PreHNF_def M_def A'_def non_zero_positions_def *    
+    by (smt (z3) linorder_not_less split_conv)
+  also have "... = P' * (reduce_below 0 non_zero_positions D M)"
+  proof -
+    have "P' * (reduce_below 0 non_zero_positions D M) 
+      = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m + (n - 1))) (0\<^sub>m (m + (n - 1)) 1) P 
+      * four_block_mat A'_UL A'_UR A'_DL A'_DR"
+      unfolding P'_def fbm_R[unfolded M_def[symmetric], symmetric] ..
+    also have "... = four_block_mat 
+            ((1\<^sub>m 1) * A'_UL + (0\<^sub>m 1 (m + (n - 1)) * A'_DL)) 
+            ((1\<^sub>m 1) * A'_UR + (0\<^sub>m 1 (m + (n - 1))) * A'_DR) 
+            ((0\<^sub>m (m + (n - 1)) 1) * A'_UL + P * A'_DL) 
+            ((0\<^sub>m (m + (n - 1)) 1) * A'_UR + P * A'_DR)" 
+      by (rule mult_four_block_mat[OF _ _ _ P A'_UL A'_UR A'_DL A'_DR], auto)
+    also have "... = four_block_mat A'_UL A'_UR (P * A'_DL) (P * A'_DR)"
+      by (rule cong_four_block_mat, insert A'_UL A'_UR A'_DL A'_DR P, auto)
+    also have "... = four_block_mat A'_UL A'_UR (0\<^sub>m (m + (n - 1)) 1) sub_PreHNF"
+      unfolding A'_DL0 sub_PreHNF_P_A'_DR using P by simp
+    also have "... = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF"
+      unfolding A'_DL0 by simp
+    finally show ?thesis ..
+  qed
+  finally have Find_P'_reduceM: "FindPreHNF abs_flag D A =  P' * (reduce_below 0 non_zero_positions D M)" .
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m + n) (m + n) 
+    \<and> reduce_below 0 (xs @ [m]) D M = Q * M"
+  proof (cases "xs = []")
+    case True note xs_empty = True
+    have rw: "reduce_below 0 (xs @ [m]) D M = reduce 0 m D M" using True by auto
+    obtain p q u v d where pquvd: "(p, q, u, v, d) = euclid_ext2 (M $$ (0, 0)) (M $$ (m, 0))"
+      by (simp add: euclid_ext2_def)
+    have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce 0 m D M = P * M"  
+    proof (rule reduce_invertible_mat_case_m[OF _ _ m0 _ _ _ _ m_le_n n0 pquvd])
+          show "M $$ (0, 0) \<noteq> 0" 
+            using M_def mk_A'_not0 by blast
+          define M' where  "M' = mat_of_rows n (map (Matrix.row M) [0..<m])"
+          define M'' where "M'' = mat_of_rows n (map (Matrix.row M) [m..<m+n])"
+          define A2 where "A2 = Matrix.mat (dim_row M) (dim_col M)
+          (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
+                    else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
+                    else M $$ (i, k))"
+          show M_M'_M'': "M = M' @\<^sub>r M''" unfolding M'_def M''_def            
+            by (metis M append_rows_split carrier_matD le_add1)
+          show M': "M' \<in> carrier_mat m n" unfolding M'_def by fastforce
+          show M'': "M'' \<in> carrier_mat n n" unfolding M''_def by fastforce
+          show "0 \<noteq> m" using m0 by simp
+          show "A2 = Matrix.mat (dim_row M) (dim_col M)
+          (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
+                    else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
+                    else M $$ (i, k))"
+            (is "_ = ?rhs") using A A2_def by auto
+          define xs' where "xs' = [1..<n]"
+          define ys' where  "ys' = [1..<n]"
+          show "xs' = [1..<n]" unfolding xs'_def by auto
+          show "ys' = [1..<n]" unfolding ys'_def by auto
+          have M''D: "(M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
+            if jn: "j<n" and j0: "j>0" for j
+          proof -
+            have Ajm0: "A $$ (j+m,0) = 0"
+            proof -
+              have "A $$ (j+m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j+m-m,0)"
+                by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' add.commute append_rows_def carrier_matD
+                    diff_add_inverse2 index_mat_four_block index_one_mat(2) index_smult_mat(2)
+                    le_add2 less_diff_conv2 n0 not_add_less2 that(1))
+              also have "... = 0" using jn j0 by auto
+              finally show ?thesis .
+            qed
+            have "M'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
+            proof (cases "A$$(0,0) = 0")
+              case True 
+              have "M'' $$ (j, i) = make_first_column_positive (swaprows 0 m A) $$ (j+m,i)"                
+                by (smt A'_def Groups.add_ac(2) M' M'' M_M'_M'' M_def True append.simps(1) 
+                    append_rows_nth3 diff_add_inverse2 jn le_add2 local.non_zero_positions_xs_m
+                    nat_add_left_cancel_less nth_Cons_0 that xs_empty)
+              also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
+              also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
+                by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
+                    carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
+              finally show ?thesis .            
+            next
+              case False
+              have "A' = A" unfolding A'_def non_zero_positions_xs_m using False True by auto
+              hence "M'' $$ (j, i) = make_first_column_positive A $$ (j+m,i)"                
+                by (smt m_le_n M' M'' M_M'_M'' M_def append_rows_nth2 jn nat_SN.compat that)                
+              also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
+              also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
+                by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
+                    carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
+              finally show ?thesis .
+            qed                           
+            thus ?thesis using jn j0 by auto
+          qed
+          have Am0D: "A$$(m,0) = D"
+          proof -
+            have "A$$(m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
+              by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' append_rows_def carrier_matD
+                  diff_less_mono2 diff_self_eq_0 index_mat_four_block index_one_mat(2) 
+                  index_smult_mat(2) less_add_same_cancel1 n0 semiring_norm(137))
+            also have "... = D" using m0 n0 by auto
+            finally show ?thesis .
+          qed
+          hence S00D: "(swaprows 0 m A) $$ (0,0) = D" using n0 m0 A by auto
+          have Sm00: "(swaprows 0 m A) $$ (m,0) = A$$(0,0)" using n0 m0 A by auto
+          have M00D: "M $$ (0, 0) = D" if A00: "A$$(0,0) = 0"
+          proof -
+            have "M $$ (0,0) = (make_first_column_positive (swaprows 0 m A)) $$ (0,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if (swaprows 0 m A) $$ (0,0) < 0 then - (swaprows 0 m A) $$(0,0)
+                              else (swaprows 0 m A) $$(0,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = (swaprows 0 m A) $$(0,0)" using S00D D0 by auto
+            also have "... = D" using S00D by auto
+            finally show ?thesis .
+          qed
+          have Mm00: "M $$ (m, 0) = 0" if A00: "A$$(0,0) = 0"
+          proof -
+            have "M $$ (m,0) = (make_first_column_positive (swaprows 0 m A)) $$ (m,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if (swaprows 0 m A) $$ (m,0) < 0 then - (swaprows 0 m A) $$(m,0)
+                              else (swaprows 0 m A) $$(m,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = (swaprows 0 m A) $$(m,0)" using Sm00 A00 D0 by auto
+            also have "... = 0" using Sm00 A00 by auto
+            finally show ?thesis .
+          qed
+          have M000: "M $$ (0, 0) = abs (A$$(0,0))" if A00: "A$$(0,0) \<noteq> 0"
+          proof -
+            have "M $$ (0,0) = (make_first_column_positive A) $$ (0,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if A $$ (0,0) < 0 then - A $$(0,0)
+                              else A $$(0,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = abs (A$$(0,0))" using Sm00 A00 by auto
+            finally show ?thesis .
+          qed
+          have Mm0D: "M $$ (m, 0) = D" if A00: "A $$ (0,0) \<noteq> 0"
+          proof -
+            have "M $$ (m,0) = (make_first_column_positive A) $$ (m,0)"
+              unfolding M_def A'_def using A00
+              by (simp add: True non_zero_positions_xs_m)
+            also have "... = (if A $$ (m,0) < 0 then - A $$(m,0)
+                              else A $$(m,0))"
+              unfolding make_first_column_positive.simps using m0 n0 A by auto
+            also have "... = A $$(m,0)" using S00D D0 Am0D by auto
+            also have "... = D" using Am0D D0 by auto
+            finally show ?thesis .
+          qed
+          have "0 \<notin> set xs'"
+          proof -
+            have "A2 $$ (0,0) = p * M $$ (0, 0) + q * M $$ (m, 0)" 
+              using A A2_def n0 M by auto
+            also have "... = gcd (M $$ (0, 0)) (M $$ (m, 0))"
+              by (metis euclid_ext2_works(1,2) pquvd)
+            also have "abs ... \<le> D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce
+            finally have "abs (A2 $$ (0,0)) \<le> D" .
+            thus ?thesis unfolding xs'_def using D0 by auto
+          qed
+          thus "\<forall>j\<in>set xs'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"  
+            using M''D xs'_def by auto
+          have "0 \<notin> set ys'"
+          proof -
+            have "A2 $$ (m,0) = u * M $$ (0, 0) + v * M $$ (m, 0)"
+              using A A2_def n0 m0 M by auto
+            also have "... = - M $$ (m, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (0, 0) 
+                + M $$ (0, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (m, 0) "
+              by (simp add: euclid_ext2_works[OF pquvd[symmetric]])
+            also have "... = 0" using M00D Mm00 M000 Mm0D
+              by (smt dvd_div_mult_self euclid_ext2_works(3) euclid_ext2_works(5)
+                  more_arith_simps(11) mult.commute mult_minus_left pquvd semiring_gcd_class.gcd_dvd1)
+            finally have "A2 $$ (m,0) = 0" .
+            thus ?thesis unfolding ys'_def using D0 by auto
+          qed
+          thus "\<forall>j\<in>set ys'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
+            using M''D ys'_def by auto   
+          show "M $$ (m, 0) \<in> {0,D}" using Mm00 Mm0D by blast
+          show " M $$ (m, 0) = 0 \<longrightarrow> M $$ (0, 0) = D"  using Mm00 Mm0D D_not0 M00D by blast          
+        qed (insert D0)
+        then show ?thesis using rw by auto
+  next
+    case False
+    show ?thesis
+      by (unfold M_def, rule reduce_below_invertible_mat_case_m[OF M' m0 n0 M_M'D[OF False] 
+          mk_A'_not0 m_le_n d_xs all_less_m D0])
+  qed
+   
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
+    and reduce_QM: "reduce_below 0 (xs @ [m]) D M = Q * M" by blast
+  have "\<exists>R. invertible_mat R 
+    \<and> R \<in> carrier_mat (dim_row A') (dim_row A') \<and> M = R * A'"
+    by (unfold M_def, rule make_first_column_positive_invertible)
+  from this obtain R where inv_R: "invertible_mat R"
+    and R: "R \<in> carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> A' = P * A" 
+    by (rule A'_swaprows_invertible_mat[OF A A'_def non_zero_positions_def],
+        insert non_zero_positions_xs_m n m0, auto)
+  from this obtain S where inv_S: "invertible_mat S"
+   and S: "S \<in> carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A" 
+    using A by auto
+  have "(P'*Q*R*S) \<in> carrier_mat (m+n) (m+n)" using P' Q R S A' A by auto
+  moreover have "FindPreHNF abs_flag D A = (P'*Q*R*S) * A" using Find_P'_reduceM reduce_QM 
+    unfolding  M_RA' A'_SA M_def
+    by (smt A' A'_SA P' Q R S assoc_mult_mat carrier_matD carrier_mat_triv index_mult_mat(2,3) 
+        non_zero_positions_xs_m)
+  moreover have "invertible_mat (P'*Q*R*S)" using inv_P' inv_Q inv_R inv_S using P' Q R S A' A 
+    by (metis carrier_matD carrier_mat_triv index_mult_mat(2,3) invertible_mult_JNF)
+  ultimately have exists_inv: "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
+    \<and> FindPreHNF abs_flag D A = P * A" by blast
+  moreover have "echelon_form_JNF (FindPreHNF abs_flag D A)" 
+  proof (rule echelon_form_four_block_mat[OF A'_UL A'_UR sub_PreHNF'   ])
+    show "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR (0\<^sub>m (m + n - 1) 1) sub_PreHNF" 
+      using A'_DL0 FindPreHNF_as_fbm sub_PreHNF sub_PreHNF' by auto
+    have "A'_UL $$ (0, 0) = ?R $$ (0,0)"
+      by (metis (mono_tags, lifting) A A'_DR A'_UL Find_P'_reduceM M_def 
+          \<open>FindPreHNF abs_flag D A = P' * Q * R * S * A\<close> add_Suc_right add_sign_intros(2) carrier_matD fbm_R
+          index_mat_four_block(1,3) index_mult_mat(3) m0 n0 plus_1_eq_Suc
+          zero_less_one_class.zero_less_one)
+    also have "... \<noteq> 0"
+    proof (cases "xs=[]")
+      case True
+      have "?R $$ (0,0) = reduce 0 m D M $$ (0,0)"
+        unfolding non_zero_positions_xs_m True M_def by simp
+      also have "... \<noteq> 0"
+        by (metis D_not0 M M_def add_pos_pos less_add_same_cancel1 m0 mk_A'_not0 n0 reduce_not0)
+      finally show ?thesis .
+    next
+      case False
+      show ?thesis
+        by (unfold non_zero_positions_xs_m,
+          rule reduce_below_not0_case_m[OF M' m0 n0 M_M'D[OF False] mk_A'_not0 m_le_n all_less_m D_not0])     
+    qed       
+    finally show "A'_UL $$ (0, 0) \<noteq> 0" .
+  qed (insert mn n hyp, auto)
+  ultimately show ?thesis by blast
+qed
+qed
+
+lemma
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+  and A'': "A'' \<in> carrier_mat m n" and "n\<ge>2" and m_le_n: "m\<ge>n" and "D>0"
+shows FindPreHNF_invertible_mat_n_ge2: "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
+and FindPreHNF_echelon_form_n_ge2: "echelon_form_JNF (FindPreHNF abs_flag D A)"
+  using FindPreHNF_works_n_ge2[OF assms] by blast+
+
+lemma FindPreHNF_invertible_mat:
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+    and A'': "A'' \<in> carrier_mat m n" and n0: "0<n" and mn: "m\<ge>n" and D: "D>0"
+  shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
+proof -
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
+  show ?thesis
+  proof (cases "m+n<2")
+    case True
+    show ?thesis by (rule FindPreHNF_invertible_mat_2xn[OF A True])
+  next
+    case False note m_ge2 = False
+    show ?thesis
+    proof (cases "n<2")
+      case True
+      show ?thesis by (rule FindPreHNF_invertible_mat_mx2[OF A_def A'' True n0 D mn])
+    next
+      case False
+      show ?thesis 
+        by (rule FindPreHNF_invertible_mat_n_ge2[OF A_def A'' _ mn D], insert False, auto)
+    qed  
+  qed
+qed
+
+
+lemma FindPreHNF_echelon_form:
+  assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
+    and A'': "A'' \<in> carrier_mat m n" and mn: "m\<ge>n" and D: "D>0"
+  shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
+proof -
+  have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
+  have FindPreHNF: "(FindPreHNF abs_flag D A) \<in> carrier_mat (m+n) n" by (rule FindPreHNF[OF A])
+  show ?thesis
+  proof (cases "m+n<2")
+    case True
+    show ?thesis by (rule echelon_form_JNF_1xn[OF FindPreHNF True])
+  next
+    case False note m_ge2 = False
+    show ?thesis
+    proof (cases "n<2")
+      case True
+      show ?thesis by (rule FindPreHNF_echelon_form_mx1[OF A_def A'' True D mn])
+    next
+      case False
+      show ?thesis 
+        by (rule FindPreHNF_echelon_form_n_ge2[OF A_def A'' _ mn D], insert False, auto)
+    qed  
+  qed
+qed
+end
+
+text \<open>We connect the algorithm developed in the Hermite AFP entry with ours. This would permit
+to reuse many existing results and prove easily the soundness.\<close>
+
+(*In HOL Analysis*)
+thm Hermite.Hermite_reduce_above.simps
+thm Hermite.Hermite_of_row_i_def
+thm Hermite.Hermite_of_upt_row_i_def
+thm Hermite.Hermite_of_def
+
+(*In JNF*)
+thm Hermite_reduce_above.simps
+thm Hermite_of_row_i_def
+thm Hermite_of_list_of_rows.simps
+thm mod_operation.Hermite_mod_det_def
+
+(*Connecting Hermite.Hermite_reduce_above and Hermite_reduce_above*)
+thm Hermite.Hermite_reduce_above.simps Hermite_reduce_above.simps
+
+context includes lifting_syntax
+begin
+
+definition "res_int = (\<lambda>b n::int. n mod b)"
+
+lemma res_function_res_int: 
+  "res_function res_int"
+  using res_function_euclidean2 unfolding res_int_def by auto
+
+lemma HMA_Hermite_reduce_above[transfer_rule]: 
+  assumes "n<CARD('m)"
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
+    ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_M)) 
+  (\<lambda>A i j. Hermite_reduce_above A n i j)
+  (\<lambda>A i j. Hermite.Hermite_reduce_above A n i j res_int)"
+proof (intro rel_funI, goal_cases)
+  case (1 A A' i i' j j')
+  then show ?case using assms
+  proof (induct n arbitrary: A A')
+    case 0
+    then show ?case by auto
+  next
+    case (Suc n)
+    note AA'[transfer_rule] = "Suc.prems"(1)
+    note ii'[transfer_rule] = "Suc.prems"(2)
+    note jj'[transfer_rule] = "Suc.prems"(3)
+    note Suc_n_less_m = "Suc.prems"(4)
+
+    let ?H_JNF = "HNF_Mod_Det_Algorithm.Hermite_reduce_above"
+    let ?H_HMA = "Hermite.Hermite_reduce_above"
+    let ?from_nat_rows = "mod_type_class.from_nat :: _ \<Rightarrow> 'm"
+    have nn[transfer_rule]: "Mod_Type_Connect.HMA_I n (?from_nat_rows n)" 
+      unfolding Mod_Type_Connect.HMA_I_def
+      by (simp add: Suc_lessD Suc_n_less_m mod_type_class.from_nat_to_nat)
+
+    have Anj: "A' $h (?from_nat_rows n) $h j' = A $$ (n,j)" 
+      by (unfold index_hma_def[symmetric], transfer, simp)
+    have Aij: "A' $h i' $h j' = A $$ (i,j)" by (unfold index_hma_def[symmetric], transfer, simp)
+    let ?s = "(- (A $$ (n, j) div A $$ (i, j)))"
+    let ?s' = "((res_int (A' $h i' $h j') (A' $h ?from_nat_rows n $h j') 
+      - A' $h ?from_nat_rows n $h j') div A' $h i' $h j')"
+    have ss'[transfer_rule]: "?s = ?s'" unfolding res_int_def Anj Aij
+      by (metis (no_types, hide_lams) Groups.add_ac(2) add_diff_cancel_left' div_by_0 
+          minus_div_mult_eq_mod more_arith_simps(7) nat_arith.rule0 nonzero_mult_div_cancel_right
+          uminus_add_conv_diff)
+    have H_JNF_eq: "?H_JNF A (Suc n) i j = ?H_JNF (addrow (- (A $$ (n, j) div A $$ (i, j))) n i A) n i j"
+      by auto
+    have H_HMA_eq: "?H_HMA A' (Suc n) i' j' res_int = ?H_HMA (row_add A' (?from_nat_rows n) i' ?s') n i' j' res_int"
+      by (auto simp add: Let_def)
+    have "Mod_Type_Connect.HMA_M (?H_JNF (addrow ?s n i A) n i j) 
+      (?H_HMA (row_add A' (?from_nat_rows n) i' ?s') n i' j' res_int)" 
+      by (rule "Suc.hyps"[OF _ ii' jj'], transfer_prover, insert Suc_n_less_m, simp)
+    thus ?case using H_JNF_eq H_HMA_eq by auto
+  qed
+qed
+
+
+corollary HMA_Hermite_reduce_above': 
+  assumes "n<CARD('m)"
+  and "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)"
+  and "Mod_Type_Connect.HMA_I i i'" and "Mod_Type_Connect.HMA_I j j'"
+  shows"Mod_Type_Connect.HMA_M (Hermite_reduce_above A n i j) (Hermite.Hermite_reduce_above A' n i' j' res_int)"
+  using HMA_Hermite_reduce_above assms unfolding rel_fun_def by metis
+
+
+lemma HMA_Hermite_of_row_i[transfer_rule]: 
+  assumes upt_A: "upper_triangular' A"
+  and AA': "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)"
+  and ii': "Mod_Type_Connect.HMA_I i i'"
+  shows "Mod_Type_Connect.HMA_M (Hermite_of_row_i A i)
+  (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')"
+proof -
+  note AA'[transfer_rule]
+  note ii'[transfer_rule]
+  have i: "i<dim_row A"
+    by (metis (full_types) AA' ii' Mod_Type_Connect.HMA_I_def 
+        Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card)  
+  show ?thesis
+  proof (cases "is_zero_row i' A'")
+    case True
+    hence "is_zero_row_JNF i A" by (transfer, simp)
+    hence "find_fst_non0_in_row i A = None" using find_fst_non0_in_row_None[OF _ upt_A i] by auto
+    thus ?thesis using True AA' unfolding Hermite.Hermite_of_row_i_def Hermite_of_row_i_def by auto
+  next
+    case False
+    have nz_iA: "\<not> is_zero_row_JNF i A" using False by transfer
+    hence "find_fst_non0_in_row i A \<noteq> None" using find_fst_non0_in_row_None[OF _ upt_A i] by auto
+    from this obtain j where j: "find_fst_non0_in_row i A = Some j" by blast
+    have j_eq: "j = (LEAST n. A $$ (i,n) \<noteq> 0)"
+      by (rule find_fst_non0_in_row_LEAST[OF _ upt_A j i], auto)
+    have H_JNF_rw: "(Hermite_of_row_i A i) = 
+    (if A $$ (i, j) < 0 then Hermite_reduce_above (multrow i (- 1) A) i i j
+     else Hermite_reduce_above A i i j)" unfolding Hermite_of_row_i_def using j by auto
+    let ?H_HMA = "Hermite.Hermite_of_row_i"
+    let ?j' = "(LEAST n. A' $h i' $h n \<noteq> 0)"
+    have ii'2: "(mod_type_class.to_nat i') = i" using ii'
+      by (simp add: Mod_Type_Connect.HMA_I_def)                                            
+    have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'"
+      unfolding j_eq index_hma_def[symmetric] by (rule HMA_LEAST[OF AA' ii' nz_iA])
+    have Aij: "A $$ (i, j) = A' $h i' $h (LEAST n. A' $h i' $h n \<noteq> 0)"
+      by (subst index_hma_def[symmetric], transfer', simp)
+    have H_HMA_rw: "?H_HMA ass_function_euclidean res_int A' i' = 
+    Hermite.Hermite_reduce_above (mult_row A' i' (\<bar>A' $h i' $h ?j'\<bar> 
+      div A' $h i' $h ?j'))
+     (mod_type_class.to_nat i') i' ?j' res_int" 
+      unfolding Hermite.Hermite_of_row_i_def Let_def ass_function_euclidean_def
+      by (auto simp add: False)
+    have im: "i < CARD('m)" using ii' unfolding Mod_Type_Connect.HMA_I_def
+      using mod_type_class.to_nat_less_card by blast
+    show ?thesis
+    proof (cases "A $$ (i, j) < 0")
+      case True
+      have A'i'j'_le_0: "A' $h i' $h ?j' < 0" using Aij True by auto
+      hence 1: "(\<bar>A' $h i' $h ?j'\<bar> div A' $h i' $h ?j') 
+          = -1" using div_pos_neg_trivial by auto
+      have [transfer_rule]: "Mod_Type_Connect.HMA_M (multrow i (- 1) A) 
+      (mult_row A' i' (\<bar>A' $h i' $h ?j'\<bar> 
+      div A' $h i' $h ?j'))" unfolding 1 by transfer_prover      
+      have H_HMA_rw2: "Hermite_of_row_i A i = Hermite_reduce_above (multrow i (- 1) A) i i j"
+        using True H_JNF_rw by auto
+      have *: "Mod_Type_Connect.HMA_M (Hermite_reduce_above (multrow i (- 1) A) i i j) 
+        (Hermite.Hermite_reduce_above (mult_row A' i' (\<bar>A' $h i' $h ?j'\<bar> 
+        div A' $h i' $h ?j'))
+        (mod_type_class.to_nat i') i' ?j' res_int) "
+        unfolding 1 ii'2
+        by (rule HMA_Hermite_reduce_above'[OF im _ ii' jj'], transfer_prover)
+       show ?thesis unfolding H_JNF_rw H_HMA_rw unfolding H_HMA_rw2 using True * by auto
+    next
+      case False
+      have Aij_not0: "A $$ (i, j) \<noteq> 0" using j_eq nz_iA
+        by (metis (mono_tags) LeastI is_zero_row_JNF_def)
+      have A'i'j'_le_0: "A' $h i' $h ?j' > 0" using False Aij_not0 Aij by auto
+      hence 1: "(\<bar>A' $h i' $h ?j'\<bar> div A' $h i' $h ?j') = 1" by auto
+      have H_HMA_rw2: "Hermite_of_row_i A i = Hermite_reduce_above A i i j"
+        using False H_JNF_rw by auto
+      have *: "?H_HMA ass_function_euclidean res_int A' i' = 
+      (Hermite.Hermite_reduce_above A' (mod_type_class.to_nat i') i' ?j' res_int)"
+        using H_HMA_rw unfolding 1 unfolding mult_row_1_id by simp
+      have "Mod_Type_Connect.HMA_M (Hermite_reduce_above A i i j) 
+        (Hermite.Hermite_reduce_above A' (mod_type_class.to_nat i') i' ?j' res_int)"
+        unfolding 1 ii'2
+        by (rule HMA_Hermite_reduce_above'[OF im AA' ii' jj'])
+      then show ?thesis using H_HMA_rw * H_HMA_rw2 by presburger
+    qed        
+  qed
+qed
+
+
+lemma Hermite_of_list_of_rows_append:
+"Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x"
+  by (induct xs arbitrary: A, auto)
+
+
+lemma Hermite_reduce_above[simp]: "Hermite_reduce_above A n i j \<in> carrier_mat (dim_row A) (dim_col A)"  
+proof (induct n arbitrary: A)
+  case 0
+  then show ?case by auto
+next
+  case (Suc n)    
+  let ?A = "(addrow (- (A $$ (n, j) div A $$ (i, j))) n i A)"  
+  have "Hermite_reduce_above A (Suc n) i j = Hermite_reduce_above ?A n i j"
+    by (auto simp add: Let_def)
+  also have "... \<in> carrier_mat (dim_row ?A) (dim_col ?A)" by(rule Suc.hyps)
+  finally show ?case by auto  
+qed                           
+
+
+lemma Hermite_of_row_i: "Hermite_of_row_i A i \<in> carrier_mat (dim_row A) (dim_col A)" 
+proof -
+  have "Hermite_reduce_above (multrow i (- 1) A) i i a 
+    \<in> carrier_mat (dim_row (multrow i (- 1) A)) (dim_col (multrow i (- 1) A))" 
+    for a by (rule Hermite_reduce_above)
+  thus ?thesis
+    unfolding Hermite_of_row_i_def using Hermite_reduce_above 
+    by (cases "find_fst_non0_in_row i A", auto)
+qed
+
+end
+
+
+text \<open>We now move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix
+representation.\<close>
+
+(*thm echelon_form_Hermite_of_row will be transferred from HOL Analysis to JNF*)
+
+context
+begin
+
+private lemma echelon_form_Hermite_of_row_mod_type:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
+  assumes eA: "echelon_form_JNF A"
+  and i: "i<CARD('m)"
+  shows "echelon_form_JNF (Hermite_of_row_i A i)"
+proof -
+  have uA: "upper_triangular' A" by (rule echelon_form_JNF_imp_upper_triangular[OF eA])
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
+  define i' where "i' = (Mod_Type.from_nat i :: 'm)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
+    unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto
+  have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i i'"
+    unfolding Mod_Type_Connect.HMA_I_def i'_def using assms
+    using from_nat_not_eq order.strict_trans by blast 
+  have eA'[transfer_rule]: "echelon_form A'" using eA by transfer
+  have [transfer_rule]: "Mod_Type_Connect.HMA_M 
+    (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i) 
+    (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')"
+    by (rule HMA_Hermite_of_row_i[OF uA AA' ii'])
+  have "echelon_form (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')"
+    by (rule echelon_form_Hermite_of_row[OF ass_function_euclidean res_function_res_int eA'])    
+  thus ?thesis by (transfer, simp)
+qed 
+
+
+private lemma echelon_form_Hermite_of_row_nontriv_mod_ring:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
+  assumes eA: "echelon_form_JNF A"
+  and "i<CARD('m)"
+  shows "echelon_form_JNF (Hermite_of_row_i A i)"
+using assms echelon_form_Hermite_of_row_mod_type by (smt CARD_mod_ring) 
+
+(*We internalize both sort constraints in one step*)
+lemmas echelon_form_Hermite_of_row_nontriv_mod_ring_internalized = 
+  echelon_form_Hermite_of_row_nontriv_mod_ring[unfolded CARD_mod_ring, 
+      internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
+
+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 echelon_form_Hermite_of_row_nontriv_mod_ring_aux:
+ fixes A::"int mat"
+  assumes "A \<in> carrier_mat m n"
+  assumes eA: "echelon_form_JNF A"
+  and "i<m"
+shows "echelon_form_JNF (Hermite_of_row_i A i)"  
+  using echelon_form_Hermite_of_row_nontriv_mod_ring_internalized
+    [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
+        type_to_set1(1)[OF local_typedef1 local_typedef2]]
+  using assms 
+  using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
+
+end
+
+(*Canceling the first local type definitions*)
+context
+begin
+
+(*Canceling the first*)
+
+private lemma echelon_form_Hermite_of_row_i_cancelled_first:
+"\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n 
+  \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A \<Longrightarrow> i < m 
+  \<Longrightarrow> echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i)"
+  using echelon_form_Hermite_of_row_nontriv_mod_ring_aux[cancel_type_definition, of m n A i]
+  by auto  
+
+(*Canceling the second*)
+private lemma echelon_form_Hermite_of_row_i_cancelled_both:
+"1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A \<Longrightarrow> i < m 
+  \<Longrightarrow> echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i)"
+  using echelon_form_Hermite_of_row_i_cancelled_first[cancel_type_definition, of n m A i] by simp
+
+(*The final results in JNF*)
+
+lemma echelon_form_JNF_Hermite_of_row_i':
+ fixes A::"int mat"
+  assumes "A \<in> carrier_mat m n"
+  assumes eA: "echelon_form_JNF A"
+  and "i<m"
+  and "1 < m" and "1 < n" (*Required from the mod_type restrictions*)
+shows "echelon_form_JNF (Hermite_of_row_i A i)"  
+  using echelon_form_Hermite_of_row_i_cancelled_both assms by auto
+
+
+corollary echelon_form_JNF_Hermite_of_row_i:
+  fixes A::"int mat"
+  assumes eA: "echelon_form_JNF A"
+    and i: "i<dim_row A"
+  shows "echelon_form_JNF (Hermite_of_row_i A i)"  
+proof (cases "dim_row A < 2")
+  case True
+  show ?thesis 
+    by (rule echelon_form_JNF_1xn[OF Hermite_of_row_i True])
+next
+  case False note m_ge2 = False
+  show ?thesis
+  proof (cases "1<dim_col A")
+    case True
+    show ?thesis by (rule echelon_form_JNF_Hermite_of_row_i'[OF _ eA i _ True], insert m_ge2, auto)
+  next
+    case False
+    hence dc_01: "dim_col A \<in> {0,1}" by auto
+    show ?thesis
+    proof (cases "dim_col A = 0")
+      case True
+      have H: "Hermite_of_row_i A i \<in> carrier_mat (dim_row A) (dim_col A)"
+        using Hermite_of_row_i by blast
+      show ?thesis by (rule echelon_form_mx0, insert True H, auto)
+    next
+      case False
+      hence dc_1: "dim_col A = 1" using dc_01 by simp
+      then show ?thesis     
+      proof (cases "i=0")
+        case True      
+        have eA': "echelon_form_JNF (multrow 0 (- 1) A)"
+          by (rule echelon_form_JNF_multrow[OF _ _ eA], insert m_ge2, auto)
+        show ?thesis using True unfolding Hermite_of_row_i_def
+          by (cases "find_fst_non0_in_row 0 A", insert eA eA', auto)
+      next
+        case False  
+        have all_zero: "(\<forall>j\<in>{i..<dim_col A}. A $$ (i, j) = 0)" unfolding dc_1 using False by auto
+        hence "find_fst_non0_in_row i A = None" using find_fst_non0_in_row_None'[OF _ i] by blast
+        hence "Hermite_of_row_i A i = A" unfolding Hermite_of_row_i_def by auto
+        then show ?thesis using eA by auto
+      qed  
+    qed  
+  qed
+qed
+
+
+
+lemma Hermite_of_list_of_rows:
+ "(Hermite_of_list_of_rows A xs) \<in> carrier_mat (dim_row A) (dim_col A)"
+proof (induct xs arbitrary: A rule: rev_induct)
+  case Nil
+  then show ?case by auto
+next
+  case (snoc x xs)
+  let ?A = "(Hermite_of_list_of_rows A xs)"
+  have hyp: "(Hermite_of_list_of_rows A xs) \<in> carrier_mat (dim_row A) (dim_col A)" by (rule snoc.hyps)
+  have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i ?A x"
+    using Hermite_of_list_of_rows_append by auto
+  also have "... \<in> carrier_mat (dim_row ?A) (dim_col ?A)" using Hermite_of_row_i by auto
+  finally show ?case using hyp by auto  
+qed
+
+lemma echelon_form_JNF_Hermite_of_list_of_rows:
+  assumes "A\<in>carrier_mat m n"
+ and "\<forall>x\<in>set xs. x < m"
+  and "echelon_form_JNF A"
+shows "echelon_form_JNF (Hermite_of_list_of_rows A xs)"
+  using assms
+proof (induct xs arbitrary: A rule: rev_induct)
+  case Nil
+  then show ?case by auto
+next
+  case (snoc x xs)
+  have hyp: "echelon_form_JNF (Hermite_of_list_of_rows A xs)"
+    by (rule snoc.hyps, insert snoc.prems, auto)
+  have H_Axs: "(Hermite_of_list_of_rows A xs) \<in> carrier_mat (dim_row A) (dim_col A)" 
+    by (rule Hermite_of_list_of_rows)
+  have "(Hermite_of_list_of_rows A (xs @ [x])) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x"
+    using Hermite_of_list_of_rows_append by simp
+  also have "echelon_form_JNF ..."
+  proof (rule echelon_form_JNF_Hermite_of_row_i[OF hyp])
+    show "x < dim_row (Hermite_of_list_of_rows A xs)" using snoc.prems H_Axs by auto
+  qed
+  finally show ?case .
+qed
+
+
+
+
+lemma HMA_Hermite_of_upt_row_i[transfer_rule]: 
+  assumes "xs = [0..<i]"
+    and "\<forall>x\<in>set xs. x < CARD('m)"
+  assumes "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)" 
+    and "echelon_form_JNF A"
+  shows "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A xs)
+  (Hermite.Hermite_of_upt_row_i A' i ass_function_euclidean res_int)"
+  using assms
+proof (induct xs arbitrary: A A' i rule: rev_induct)
+  case Nil
+  have "i=0" using Nil by (metis le_0_eq upt_eq_Nil_conv)
+  then show ?case using Nil unfolding Hermite_of_upt_row_i_def by auto
+next
+  case (snoc x xs)
+  note xs_x_eq = snoc.prems(1)
+  note all_xm = snoc.prems(2)
+  note AA' = snoc.prems(3)
+  note upt_A = snoc.prems(4)
+  let ?x' = "(mod_type_class.from_nat x::'m)"
+  have xm: "x < CARD('m)" using all_xm by auto
+  have xx'[transfer_rule]: "Mod_Type_Connect.HMA_I x ?x'"
+    unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq xm by blast
+  have last_i1: "last [0..<i] = i-1"
+    by (metis append_is_Nil_conv last_upt list.simps(3) neq0_conv xs_x_eq upt.simps(1))
+  have "last (xs @ [x]) = i-1" using xs_x_eq last_i1 by auto
+  hence x_i1: "x = i-1" by auto
+  have xs_eq: "xs = [0..<x]" using xs_x_eq x_i1
+    by (metis add_diff_inverse_nat append_is_Nil_conv append_same_eq less_one list.simps(3)
+        plus_1_eq_Suc upt_Suc upt_eq_Nil_conv)
+  have list_rw: "[0..<i] = 0 #[1..<i]" 
+    by (auto, metis append_is_Nil_conv list.distinct(2) upt_rec xs_x_eq)
+  have 1: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x"
+    unfolding Hermite_of_list_of_rows_append by auto
+  let ?H_upt_HA = "Hermite.Hermite_of_upt_row_i"
+  let ?H_HA = "Hermite.Hermite_of_row_i ass_function_euclidean res_int"
+  have "(Hermite_of_upt_row_i A' i ass_function_euclidean res_int) = 
+    foldl ?H_HA A' (map mod_type_class.from_nat [0..<i])"
+    unfolding Hermite_of_upt_row_i_def by auto
+  also have "... = foldl ?H_HA A' ((map mod_type_class.from_nat [0..<i-1])@[?x'])"
+    by (metis list.simps(8) list.simps(9) map_append x_i1 xs_eq xs_x_eq)
+  also have "... = foldl ?H_HA (?H_upt_HA A' (i - 1) ass_function_euclidean res_int) [?x']"
+    unfolding foldl_append unfolding Hermite_of_upt_row_i_def[symmetric] by auto
+  also have "... = ?H_HA (Hermite_of_upt_row_i A' (i - 1) ass_function_euclidean res_int) ?x'" by auto
+  finally have 2: "?H_upt_HA A' i ass_function_euclidean res_int =
+    ?H_HA (Hermite_of_upt_row_i A' (i - 1) ass_function_euclidean res_int) ?x'" .
+
+  have hyp[transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A xs)
+              (Hermite_of_upt_row_i A' (i - 1) ass_function_euclidean res_int)"
+    by (rule snoc.hyps[OF _ _ AA' upt_A], insert xs_eq x_i1 xm, auto)
+
+  have upt_H_Axs:"upper_triangular' (Hermite_of_list_of_rows A xs)"
+  proof (rule echelon_form_JNF_imp_upper_triangular, 
+      rule echelon_form_JNF_Hermite_of_list_of_rows[OF _ _ upt_A])
+    show "A\<in>carrier_mat (CARD('m)) (CARD('n))"
+      using Mod_Type_Connect.dim_col_transfer_rule
+        Mod_Type_Connect.dim_row_transfer_rule snoc(4) by blast
+    show "\<forall>x\<in>set xs. x < CARD('m)" using all_xm by auto
+  qed
+  show ?case unfolding 1 2 
+  by (rule HMA_Hermite_of_row_i[OF upt_H_Axs hyp xx'])
+qed
+
+(*This is the lemma that I will transfer to JNF to get the soundness*)
+lemma Hermite_Hermite_of_upt_row_i:
+  assumes a: "ass_function ass"
+    and r: "res_function res"
+    and eA: "echelon_form A"
+  shows "Hermite (range ass) (\<lambda>c. range (res c)) (Hermite_of_upt_row_i A (nrows A) ass res)" 
+proof -
+  let ?H = "(Hermite_of_upt_row_i A (nrows A) ass res)"  
+  show ?thesis
+  proof (rule Hermite_intro, auto)
+    show "Complete_set_non_associates (range ass)"
+      by (simp add: ass_function_Complete_set_non_associates a)
+    show "Complete_set_residues (\<lambda>c. range (res c))"
+      by (simp add: r res_function_Complete_set_residues)
+    show "echelon_form ?H"
+      by (rule echelon_form_Hermite_of_upt_row_i[OF eA a r])  
+    fix i
+    assume i: "\<not> is_zero_row i ?H" 
+    show "?H $ i $ (LEAST n. ?H $ i $ n \<noteq> 0) \<in> range ass"
+    proof -
+      have non_zero_i_eA: "\<not> is_zero_row i A"
+        using Hermite_of_upt_row_preserves_zero_rows[OF _ _ a r] i eA by blast   
+      have least: "(LEAST n. ?H $h i $h n \<noteq> 0) = (LEAST n. A $h i $h n \<noteq> 0)"
+        by (rule Hermite_of_upt_row_i_Least[OF non_zero_i_eA eA a r], simp)
+      have "?H $ i $ (LEAST n. A $ i $ n \<noteq> 0) \<in> range ass"
+        by (rule Hermite_of_upt_row_i_in_range[OF non_zero_i_eA eA a r], auto)
+      thus ?thesis unfolding least by auto
+    qed
+  next
+    fix i j assume i: "\<not> is_zero_row i ?H" and j: "j < i"
+    show "?H $ j $ (LEAST n. ?H $ i $ n \<noteq> 0)
+    \<in> range (res (?H $ i $ (LEAST n. ?H $ i $ n \<noteq> 0)))"
+    proof -
+      have non_zero_i_eA: "\<not> is_zero_row i A"
+        using Hermite_of_upt_row_preserves_zero_rows[OF _ _ a r] i eA by blast   
+      have least: "(LEAST n. ?H $h i $h n \<noteq> 0) = (LEAST n. A $h i $h n \<noteq> 0)"
+        by (rule Hermite_of_upt_row_i_Least[OF non_zero_i_eA eA a r], simp)
+      have "?H $ j $ (LEAST n. A $ i $ n \<noteq> 0) \<in> range (res (?H $ i $ (LEAST n. A $ i $ n \<noteq> 0)))"
+        by (rule Hermite_of_upt_row_i_in_range_res[OF non_zero_i_eA eA a r _ _ j], auto)
+      thus ?thesis unfolding least by auto
+    qed
+  qed
+qed
+
+
+lemma Hermite_of_row_i_0:
+  "Hermite_of_row_i A 0 = A \<or> Hermite_of_row_i A 0 = multrow 0 (- 1) A"
+    by (cases "find_fst_non0_in_row 0 A", unfold Hermite_of_row_i_def, auto)
+
+lemma Hermite_JNF_intro:
+assumes 
+"Complete_set_non_associates associates" "(Complete_set_residues res)" "echelon_form_JNF A"
+ "(\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) \<in> associates)"
+ "(\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> (\<forall>j. j<i \<longrightarrow> A $$ (j, (LEAST n. A $$ (i, n) \<noteq> 0)) 
+     \<in> res (A $$ (i,(LEAST n. A $$ (i,n) \<noteq> 0)))))"
+shows "Hermite_JNF associates res A"
+  using assms unfolding Hermite_JNF_def by auto
+
+lemma least_multrow:
+  assumes "A \<in> carrier_mat m n" and "i<m" and eA: "echelon_form_JNF A"
+  assumes ia: "ia < dim_row A" and nz_ia_mrA: "\<not> is_zero_row_JNF ia (multrow i (- 1) A)"
+  shows "(LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) = (LEAST n. A $$ (ia, n) \<noteq> 0)"
+proof (rule Least_equality)
+  have nz_ia_A: "\<not> is_zero_row_JNF ia A" using nz_ia_mrA ia by auto
+  have Least_Aian_n: "(LEAST n. A $$ (ia, n) \<noteq> 0) < dim_col A"
+    by (smt dual_order.strict_trans is_zero_row_JNF_def not_less_Least not_less_iff_gr_or_eq nz_ia_A)
+  show "multrow i (- 1) A $$ (ia, LEAST n. A $$ (ia, n) \<noteq> 0) \<noteq> 0"
+    by (smt LeastI Least_Aian_n class_cring.cring_simprules(22) equation_minus_iff ia
+        index_mat_multrow(1) is_zero_row_JNF_def mult_minus1 nz_ia_A)
+  show " \<And>y. multrow i (- 1) A $$ (ia, y) \<noteq> 0 \<Longrightarrow> (LEAST n. A $$ (ia, n) \<noteq> 0) \<le> y"
+    by (metis (mono_tags, lifting) Least_Aian_n class_cring.cring_simprules(22) ia 
+        index_mat_multrow(1) leI mult_minus1 order.strict_trans wellorder_Least_lemma(2))
+qed
+
+
+lemma Hermite_Hermite_of_row_i:
+  assumes A: "A \<in> carrier_mat 1 n"
+  shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_row_i A 0)"
+proof (rule Hermite_JNF_intro)
+  show "Complete_set_non_associates (range ass_function_euclidean)"   
+    using ass_function_Complete_set_non_associates ass_function_euclidean by blast
+  show "Complete_set_residues (\<lambda>c. range (res_int c))"
+    using res_function_Complete_set_residues res_function_res_int by blast
+  show "echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A 0)"
+    by (metis (full_types) assms carrier_matD(1) echelon_form_JNF_Hermite_of_row_i
+        echelon_form_JNF_def less_one not_less_zero)
+  let ?H = "Hermite_of_row_i A 0"
+  show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H 
+      \<longrightarrow> ?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
+  proof (auto)
+    fix i assume i: "i<dim_row ?H" and nz_iH: "\<not> is_zero_row_JNF i ?H"
+    have nz_iA: "\<not> is_zero_row_JNF i A"
+      by (metis (full_types) Hermite_of_row_i Hermite_of_row_i_0 carrier_matD(1)
+          i is_zero_row_JNF_multrow nz_iH)
+    have "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<ge> 0"
+    proof (cases "find_fst_non0_in_row 0 A")
+      case None
+       then show ?thesis using nz_iH unfolding Hermite_of_row_i_def
+         by (smt HNF_Mod_Det_Algorithm.Hermite_of_row_i_def upper_triangular'_def assms 
+             carrier_matD(1) find_fst_non0_in_row_None i less_one not_less_zero option.simps(4))
+    next
+      case (Some a)
+      have upA: "upper_triangular' A" using A unfolding upper_triangular'_def by auto
+      have eA: "echelon_form_JNF A" by (metis A Suc_1 echelon_form_JNF_1xn lessI)
+      have i0: "i=0" using Hermite_of_row_i[of A 0] A i by auto        
+      have Aia: "A $$ (i,a) \<noteq> 0" and a0: "0 \<le> a" and an: "a<n"
+        using i0 Some assms find_fst_non0_in_row by auto+
+      have l: "(LEAST n. A $$ (i, n) \<noteq> 0) = (LEAST n.  multrow 0 (- 1) A $$ (i, n) \<noteq> 0)"
+        by (rule least_multrow[symmetric, OF A _ eA _], insert nz_iA i A i0, auto)
+      have a1: "a = (LEAST n. A $$ (i, n) \<noteq> 0)"
+        by (rule find_fst_non0_in_row_LEAST[OF A upA], insert Some i0, auto)
+      hence a2: "a = (LEAST n.  multrow 0 (- 1) A $$ (i, n) \<noteq> 0)" unfolding l by simp
+      have m1: "multrow 0 (- 1) A $$ (i, LEAST n. multrow 0 (- 1) A $$ (i, n) \<noteq> 0) 
+          = (- 1) * A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0)"
+        by (metis Hermite_of_row_i_0 a1 a2 an assms carrier_matD(2) i i0 index_mat_multrow(1,4))
+      then show ?thesis using nz_iH Some a1 Aia a2 i0 unfolding Hermite_of_row_i_def by auto 
+    qed
+    thus "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
+      using ass_function_int ass_function_int_UNIV by auto
+    qed
+    show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H \<longrightarrow> (\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
+    \<in> range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))))"
+      using Hermite_of_row_i[of A 0] A by auto
+  qed
+  
+lemma Hermite_of_row_i_0_eq_0:
+  assumes A: "A\<in>carrier_mat m n" and i: "i>0" and eA: "echelon_form_JNF A" and im: "i<m"
+    and n0: "0<n"
+  shows "Hermite_of_row_i A 0 $$ (i, 0) = 0"
+proof -
+  have Ai0: "A $$ (i, 0) = 0" by (rule echelon_form_JNF_first_column_0[OF eA A i im n0]) 
+  show ?thesis
+  proof (cases "find_fst_non0_in_row 0 A")
+    case None  
+    thus ?thesis using Ai0 unfolding Hermite_of_row_i_def by auto 
+  next
+    case (Some a)
+    have "A $$ (0, a) \<noteq> 0"  and a0: "0 \<le> a" and an: "a<n"
+      using find_fst_non0_in_row[OF A Some] A by auto
+    then show ?thesis using Some Ai0 A an a0 im unfolding Hermite_of_row_i_def mat_multrow_def by auto
+  qed
+qed
+
+  
+
+lemma Hermite_Hermite_of_row_i_mx1:
+  assumes A: "A \<in> carrier_mat m 1" and eA: "echelon_form_JNF A"
+  shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_row_i A 0)"
+proof (rule Hermite_JNF_intro)
+  show "Complete_set_non_associates (range ass_function_euclidean)"   
+    using ass_function_Complete_set_non_associates ass_function_euclidean by blast
+  show "Complete_set_residues (\<lambda>c. range (res_int c))"
+    using res_function_Complete_set_residues res_function_res_int by blast
+  have H: "Hermite_of_row_i A 0 : carrier_mat m 1" using A Hermite_of_row_i[of A] by auto
+  have upA: "upper_triangular' A"
+    by (simp add: eA echelon_form_JNF_imp_upper_triangular)
+  show eH: "echelon_form_JNF (Hermite_of_row_i A 0)"
+  proof (rule echelon_form_JNF_mx1[OF H])
+    show "\<forall>i\<in>{1..<m}. HNF_Mod_Det_Algorithm.Hermite_of_row_i A 0 $$ (i, 0) = 0"
+      using Hermite_of_row_i_0_eq_0 assms by auto
+  qed (simp)
+  let ?H = "Hermite_of_row_i A 0"
+  show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H 
+      \<longrightarrow> ?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
+  proof (auto)
+    fix i assume i: "i<dim_row ?H" and nz_iH: "\<not> is_zero_row_JNF i ?H"
+    have nz_iA: "\<not> is_zero_row_JNF i A"
+      by (metis (full_types) Hermite_of_row_i Hermite_of_row_i_0 carrier_matD(1)
+          i is_zero_row_JNF_multrow nz_iH)    
+    have "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<ge> 0"
+    proof (cases "find_fst_non0_in_row 0 A")
+      case None
+      have "is_zero_row_JNF i A"
+        by (metis H upper_triangular'_def None assms(1) carrier_matD find_fst_non0_in_row_None
+            i is_zero_row_JNF_def less_one linorder_neqE_nat not_less0 upA)
+       then show ?thesis using nz_iH None unfolding Hermite_of_row_i_def by auto
+     next
+      case (Some a)
+      have Aia: "A $$ (0,a) \<noteq> 0" and a0: "0 \<le> a" and an: "a<1"
+        using find_fst_non0_in_row[OF A Some] A by auto  
+      have nz_j_mA: "is_zero_row_JNF j (multrow 0 (- 1) A)" if j0: "j>0" and jm: "j<m" for j 
+        unfolding is_zero_row_JNF_def using A j0 jm upA by auto
+      show ?thesis
+      proof (cases "i=0")
+        case True
+        then show ?thesis
+          using nz_iH Some nz_j_mA A H i Aia an unfolding Hermite_of_row_i_def by auto
+      next
+        case False
+        have nz_iA: "is_zero_row_JNF i A"
+          by (metis False H Hermite_of_row_i_0 carrier_matD(1) i is_zero_row_JNF_multrow not_gr0 nz_iH nz_j_mA)
+        hence "is_zero_row_JNF i (multrow 0 (- 1) A)" using A H i by auto
+        then show ?thesis using nz_iH Some nz_j_mA False nz_iA 
+          unfolding Hermite_of_row_i_def by fastforce
+      qed
+    qed
+    thus "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
+      using ass_function_int ass_function_int_UNIV by auto
+    qed
+    show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H \<longrightarrow> (\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
+    \<in> range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))))"
+    proof auto
+      fix i j assume i: "i<dim_row ?H" and nz_iH: "\<not> is_zero_row_JNF i ?H" and ji: "j<i"
+      have "i=0"
+        by (metis H upper_triangular'_def One_nat_def nz_iH eH i carrier_matD(2) nat_neq_iff
+            echelon_form_JNF_imp_upper_triangular is_zero_row_JNF_def less_Suc0 not_less_zero)
+      thus "?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
+           \<in> range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0)))" using ji by auto
+    qed
+qed
+
+
+lemma Hermite_of_list_of_rows_1xn:
+  assumes A: "A \<in> carrier_mat 1 n"
+    and eA: "echelon_form_JNF A" 
+    and x: "\<forall>x \<in> set xs. x < 1" and xs: "xs\<noteq>[]"
+  shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
+  using x xs
+proof (induct xs rule: rev_induct)
+  case Nil
+  then show ?case by auto
+next
+  case (snoc x xs)
+  have x0: "x=0" using snoc.prems by auto
+  show ?case 
+  proof (cases "xs = []")
+    case True    
+    have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0"
+      unfolding Hermite_of_list_of_rows_append x0 using True by auto
+    then show ?thesis using Hermite_Hermite_of_row_i[OF A] by auto
+  next
+    case False
+    have x0: "x=0" using snoc.prems by auto
+    have hyp: "Hermite_JNF (range ass_function_euclidean) 
+      (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
+        by (rule snoc.hyps, insert snoc.prems False, auto)
+    have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) 0"
+      unfolding Hermite_of_list_of_rows_append hyp x0 ..
+    thus ?thesis
+      by (metis A Hermite_Hermite_of_row_i Hermite_of_list_of_rows carrier_matD(1))
+  qed
+qed
+
+
+lemma Hermite_of_row_i_id_mx1:
+  assumes H': "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) A"
+    and x: "x<dim_row A" and A: "A\<in>carrier_mat m 1"
+shows "Hermite_of_row_i A x = A"  
+proof (cases "find_fst_non0_in_row x A")
+  case None
+  then show ?thesis unfolding Hermite_of_row_i_def by auto
+next
+  case (Some a)
+  have eH: "echelon_form_JNF A" using H' unfolding Hermite_JNF_def by simp
+  have ut_A: "upper_triangular' A" by (simp add: eH echelon_form_JNF_imp_upper_triangular)
+  have a_least: "a = (LEAST n. A $$ (x,n) \<noteq> 0)" 
+    by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto)
+  have Axa: "A $$ (x, a) \<noteq> 0" and xa: "x\<le>a" and a: "a<dim_col A"
+    using find_fst_non0_in_row[OF A Some] unfolding a_least by auto
+  have nz_xA: "\<not> is_zero_row_JNF x A" using Axa xa x a unfolding is_zero_row_JNF_def by blast
+  have a0: "a = 0" using a A by auto
+  have x0: "x=0" using echelon_form_JNF_first_column_0[OF eH A] Axa a0 xa by blast  
+  have "A $$ (x, a) \<in> (range ass_function_euclidean)" 
+    using nz_xA H' x unfolding a_least unfolding Hermite_JNF_def by auto
+  hence "A $$ (x, a) > 0" using Axa unfolding image_def ass_function_euclidean_def by auto
+  then show ?thesis unfolding Hermite_of_row_i_def using Some x0 by auto
+qed
+
+lemma Hermite_of_row_i_id_mx1':
+  assumes eA: "echelon_form_JNF A"
+    and x: "x<dim_row A" and A: "A\<in>carrier_mat m 1"
+shows "Hermite_of_row_i A x = A \<or> Hermite_of_row_i A x = multrow 0 (- 1) A" 
+proof (cases "find_fst_non0_in_row x A")
+  case None
+  then show ?thesis unfolding Hermite_of_row_i_def by auto
+next
+  case (Some a)
+  have ut_A: "upper_triangular' A" by (simp add: eA echelon_form_JNF_imp_upper_triangular)
+  have a_least: "a = (LEAST n. A $$ (x,n) \<noteq> 0)" 
+    by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto)
+  have Axa: "A $$ (x, a) \<noteq> 0" and xa: "x\<le>a" and a: "a<dim_col A"
+    using find_fst_non0_in_row[OF A Some] unfolding a_least by auto
+  have nz_xA: "\<not> is_zero_row_JNF x A" using Axa xa x a unfolding is_zero_row_JNF_def by blast
+  have a0: "a = 0" using a A by auto
+  have x0: "x=0" using echelon_form_JNF_first_column_0[OF eA A] Axa a0 xa by blast
+  show ?thesis by (cases "A $$(x,a)>0", unfold Hermite_of_row_i_def, insert Some x0, auto)
+qed
+
+
+lemma Hermite_of_list_of_rows_mx1:
+  assumes A: "A \<in> carrier_mat m 1"
+    and eA: "echelon_form_JNF A" 
+    and x: "\<forall>x \<in> set xs. x < m" and xs: "xs=[0..<i]" and i: "i>0"
+  shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
+  using x xs i
+proof (induct xs arbitrary: i rule: rev_induct)
+  case Nil
+  then show ?case by (metis neq0_conv not_less upt_eq_Nil_conv)
+next
+  case (snoc x xs)
+  note all_n_xs_x = snoc.prems(1)
+  note xs_x = snoc.prems(2)
+  note i0 = snoc.prems(3)
+  have i_list_rw:"[0..<i] = [0..<i-1] @ [i-1]" using i0 less_imp_Suc_add by fastforce
+  hence xs: "xs = [0..<i-1]" using xs_x by force
+  hence x: "x=i-1" using i_list_rw xs_x by auto
+  have H: "Hermite_of_list_of_rows A xs \<in> carrier_mat m 1"
+    using A Hermite_of_list_of_rows[of A xs] by auto
+  show ?case
+  proof (cases "i-1=0")
+    case True
+    hence xs_empty: "xs = []" using xs by auto
+    have *: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0"
+      unfolding Hermite_of_list_of_rows_append xs_empty x True by simp    
+    show ?thesis unfolding * by (rule Hermite_Hermite_of_row_i_mx1[OF A eA])
+  next
+    case False          
+    have hyp: "Hermite_JNF (range ass_function_euclidean) 
+      (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
+      by (rule snoc.hyps[OF _ xs], insert False all_n_xs_x, auto)
+    have "Hermite_of_list_of_rows A (xs @ [x]) 
+        = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" 
+      unfolding Hermite_of_list_of_rows_append ..
+    also have "... = (Hermite_of_list_of_rows A xs)"
+      by (rule Hermite_of_row_i_id_mx1[OF hyp _ H], insert snoc.prems H x, auto)
+    finally show ?thesis using hyp by auto
+  qed
+qed
+
+
+
+lemma invertible_Hermite_of_list_of_rows_1xn:
+  assumes "A \<in> carrier_mat 1 n"
+  shows "\<exists>P. P \<in> carrier_mat 1 1 \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<1] = P * A"
+proof -
+  let ?H = "Hermite_of_list_of_rows A [0..<1]"
+  have "?H = Hermite_of_row_i A 0" by auto 
+  hence H_or: "?H = A \<or> ?H = multrow 0 (- 1) A"
+    using Hermite_of_row_i_0 by simp
+  show ?thesis
+  proof (cases "?H = A")
+    case True
+    then show ?thesis
+      by (metis assms invertible_mat_one left_mult_one_mat one_carrier_mat)
+  next
+    case False
+    hence H_mr: "?H = multrow 0 (- 1) A" using H_or by simp
+    let ?M = "multrow_mat 1 0 (-1)::int mat"
+    show ?thesis
+    proof (rule exI[of _ "?M"])
+      have "?M \<in> carrier_mat 1 1" by auto
+      moreover have "invertible_mat ?M"
+        by (metis calculation det_multrow_mat det_one dvd_mult_right invertible_iff_is_unit_JNF
+            invertible_mat_one one_carrier_mat square_eq_1_iff zero_less_one_class.zero_less_one)
+      moreover have "?H= ?M * A"
+        by (metis H_mr assms multrow_mat)      
+      ultimately show "?M \<in> carrier_mat 1 1 \<and> invertible_mat (?M) 
+  \<and> Hermite_of_list_of_rows A [0..<1] = ?M * A" by blast
+    qed
+  qed
+qed
+
+
+
+lemma invertible_Hermite_of_list_of_rows_mx1':
+  assumes A: "A \<in> carrier_mat m 1" and eA: "echelon_form_JNF A"
+    and xs_i: "xs = [0..<i]" and xs_m: "\<forall>x\<in>set xs. x < m" and i: "i>0"
+  shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A xs = P * A"
+  using xs_i xs_m i
+proof (induct xs arbitrary: i rule: rev_induct)
+  case Nil
+  then show ?case by (metis diff_zero length_upt list.size(3) zero_order(3))
+next
+  case (snoc x xs)
+  note all_n_xs_x = snoc.prems(2)
+  note xs_x = snoc.prems(1)
+  note i0 = snoc.prems(3)
+  have i_list_rw:"[0..<i] = [0..<i-1] @ [i-1]" using i0 less_imp_Suc_add by fastforce
+  hence xs: "xs = [0..<i-1]" using xs_x by force
+  hence x: "x=i-1" using i_list_rw xs_x by auto
+  have H: "Hermite_of_list_of_rows A xs \<in> carrier_mat m 1"
+    using A Hermite_of_list_of_rows[of A xs] by auto
+  show ?case
+  proof (cases "i-1=0")
+    case True
+    hence xs_empty: "xs = []" using xs by auto
+    let ?H = "Hermite_of_list_of_rows A (xs @ [x])"
+    have *: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0"
+      unfolding Hermite_of_list_of_rows_append xs_empty x True by simp  
+    hence H_or: "?H = A \<or> ?H = multrow 0 (- 1) A" using Hermite_of_row_i_0 by simp
+    thus ?thesis
+    proof (cases "?H=A")
+      case True
+      then show ?thesis unfolding * 
+        by (metis A invertible_mat_one left_mult_one_mat one_carrier_mat)
+    next
+      case False
+      hence H_mr: "?H = multrow 0 (- 1) A" using H_or by simp    
+      let ?M = "multrow_mat m 0 (-1)::int mat"
+    show ?thesis 
+    proof (rule exI[of _ "?M"])
+      have "?M \<in> carrier_mat m m" by auto
+      moreover have "invertible_mat ?M"
+        by (metis (full_types) det_multrow_mat dvd_mult_right invertible_iff_is_unit_JNF
+            invertible_mat_zero more_arith_simps(10) mult_minus1_right multrow_mat_carrier neq0_conv)
+      moreover have "?H = ?M * A" unfolding H_mr using A multrow_mat by blast            
+      ultimately show "?M \<in> carrier_mat m m \<and> invertible_mat ?M \<and> ?H = ?M * A" by blast
+    qed
+  qed
+  next
+    case False
+    let ?A = "(Hermite_of_list_of_rows A xs)"
+    have A': "?A \<in> carrier_mat m 1" using A Hermite_of_list_of_rows[of A xs] by simp
+    have hyp: "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A xs = P * A"
+      by (rule snoc.hyps[OF xs], insert False all_n_xs_x, auto)
+    have rw: "Hermite_of_list_of_rows A (xs @ [x]) 
+        = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" 
+      unfolding Hermite_of_list_of_rows_append ..
+    have *: "Hermite_of_row_i ?A x = ?A \<or> Hermite_of_row_i ?A x = multrow 0 (- 1) ?A"
+    proof (rule Hermite_of_row_i_id_mx1'[OF _ _ A'])
+      show "echelon_form_JNF ?A"
+        using A eA echelon_form_JNF_Hermite_of_list_of_rows snoc(3) by auto
+      show "x < dim_row ?A" using A' x i A by (simp add: snoc(3))
+    qed
+    show ?thesis
+    proof (cases "Hermite_of_row_i ?A x = ?A")
+    case True
+      then show ?thesis 
+        by (simp add: hyp rw)
+    next
+      case False
+      let ?M = "multrow_mat m 0 (-1)::int mat"
+      obtain P where P: "P \<in> carrier_mat m m" 
+        and inv_P: "invertible_mat P" and H_PA: "Hermite_of_list_of_rows A xs = P * A"
+        using hyp by auto
+      have M: "?M \<in> carrier_mat m m" by auto
+      have inv_M: "invertible_mat ?M"
+        by (metis (full_types) det_multrow_mat dvd_mult_right invertible_iff_is_unit_JNF
+            invertible_mat_zero more_arith_simps(10) mult_minus1_right multrow_mat_carrier neq0_conv)
+      have H_MA': "Hermite_of_row_i ?A x = ?M * ?A" using False * H multrow_mat by metis
+      have inv_MP: "invertible_mat (?M*P)" using M inv_M P inv_P invertible_mult_JNF by blast
+      moreover have MP: "(?M*P) \<in> carrier_mat m m" using M P by fastforce
+      moreover have "Hermite_of_list_of_rows A (xs @ [x]) = (?M*P) * A"
+        by (metis A H_MA' H_PA M P assoc_mult_mat rw)  
+      ultimately show ?thesis by blast
+    qed  
+  qed
+qed
+
+
+corollary invertible_Hermite_of_list_of_rows_mx1:
+  assumes "A \<in> carrier_mat m 1" and eA: "echelon_form_JNF A"
+  shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
+proof (cases "m=0")
+  case True
+  then show ?thesis 
+    by (auto, metis assms(1) invertible_mat_one left_mult_one_mat one_carrier_mat)
+next
+  case False
+  then show ?thesis using invertible_Hermite_of_list_of_rows_mx1' assms by simp
+qed
+  
+
+lemma Hermite_of_list_of_rows_mx0:
+  assumes A: "A \<in> carrier_mat m 0"
+  and xs: "xs = [0..<i]" and x: "\<forall>x\<in> set xs. x < m"
+shows "Hermite_of_list_of_rows A xs = A"
+  using xs x
+proof (induct xs arbitrary: i rule: rev_induct)
+  case Nil
+  then show ?case by auto
+next
+  case (snoc x xs)    
+  note all_n_xs_x = snoc.prems(2)
+  note xs_x = snoc.prems(1)
+  have i0: "i>0" using neq0_conv snoc(2) by fastforce
+  have i_list_rw:"[0..<i] = [0..<i-1] @ [i-1]" using i0 less_imp_Suc_add by fastforce
+  hence xs: "xs = [0..<i-1]" using xs_x by force
+  hence x: "x=i-1" using i_list_rw xs_x by auto
+  have H: "Hermite_of_list_of_rows A xs \<in> carrier_mat m 0"
+    using A Hermite_of_list_of_rows[of A xs] by auto
+  define A' where "A' = (Hermite_of_list_of_rows A xs)"
+  have A'A: "A' = A" by (unfold A'_def, rule snoc.hyps, insert snoc.prems xs, auto)
+  have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A' x"
+    using Hermite_of_list_of_rows_append A'_def by auto
+  also have "... = A"
+  proof (cases "find_fst_non0_in_row x A'")
+    case None
+    then show ?thesis unfolding Hermite_of_row_i_def using A'A by auto
+    next
+      case (Some a)
+    then show ?thesis
+      by (metis (full_types) A'A A carrier_matD(2) find_fst_non0_in_row(3) zero_order(3))
+  qed
+  finally show ?case .
+qed
+
+
+text \<open>Again, we move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix
+representation.\<close>
+
+(*
+The following lemmas will be transferred from HOL Analysis to JNF:
+thm Hermite_Hermite_of_upt_row_i
+thm invertible_Hermite_of_upt_row_i
+*)
+
+context
+begin
+
+private lemma Hermite_Hermite_of_list_of_rows_mod_type:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
+  assumes eA: "echelon_form_JNF A"
+shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<CARD('m)])"
+proof -
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
+    unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto 
+  have eA'[transfer_rule]: "echelon_form A'" using eA by transfer
+  have [transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A [0..<CARD('m)]) 
+  (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)"
+    by (rule HMA_Hermite_of_upt_row_i[OF _ _ AA' eA], auto)
+  have [transfer_rule]: " (range ass_function_euclidean) =  (range ass_function_euclidean)" ..
+  have [transfer_rule]: "(\<lambda>c. range (res_int c)) = (\<lambda>c. range (res_int c))" ..
+  have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto
+  have "Hermite (range ass_function_euclidean) (\<lambda>c. range (res_int c)) 
+  (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)"
+    by (unfold n, rule Hermite_Hermite_of_upt_row_i[OF ass_function_euclidean res_function_res_int eA'])    
+  thus ?thesis by transfer
+qed 
+
+private lemma invertible_Hermite_of_list_of_rows_mod_type:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
+  assumes eA: "echelon_form_JNF A"
+  shows "\<exists>P. P \<in> carrier_mat CARD('m) CARD('m) \<and> 
+    invertible_mat P \<and> Hermite_of_list_of_rows A [0..<CARD('m)] = P * A"
+proof -
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
+    unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto 
+  have eA'[transfer_rule]: "echelon_form A'" using eA by transfer
+  have [transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A [0..<CARD('m)]) 
+  (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)"
+    by (rule HMA_Hermite_of_upt_row_i[OF _ _ AA' eA], auto)
+  have [transfer_rule]: " (range ass_function_euclidean) =  (range ass_function_euclidean)" ..
+  have [transfer_rule]: "(\<lambda>c. range (res_int c)) = (\<lambda>c. range (res_int c))" ..
+  have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto
+  have "\<exists>P. invertible P \<and> Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int 
+      = P ** A'" by (rule invertible_Hermite_of_upt_row_i[OF ass_function_euclidean])
+  thus ?thesis by (transfer, auto)
+qed
+
+
+private lemma Hermite_Hermite_of_list_of_rows_nontriv_mod_ring:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
+  assumes eA: "echelon_form_JNF A"
+shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<CARD('m)])"
+using assms Hermite_Hermite_of_list_of_rows_mod_type by (smt CARD_mod_ring) 
+
+private lemma invertible_Hermite_of_list_of_rows_nontriv_mod_ring:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
+  assumes eA: "echelon_form_JNF A"
+  shows "\<exists>P. P \<in> carrier_mat CARD('m) CARD('m) \<and> 
+    invertible_mat P \<and> Hermite_of_list_of_rows A [0..<CARD('m)] = P * A"
+using assms invertible_Hermite_of_list_of_rows_mod_type by (smt CARD_mod_ring) 
+
+
+(*We internalize both sort constraints in one step*)
+lemmas Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_internalized = 
+  Hermite_Hermite_of_list_of_rows_nontriv_mod_ring[unfolded CARD_mod_ring, 
+      internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
+
+lemmas invertible_Hermite_of_list_of_rows_nontriv_mod_ring_internalized = 
+  invertible_Hermite_of_list_of_rows_nontriv_mod_ring[unfolded CARD_mod_ring, 
+      internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
+
+
+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 Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_aux:
+ fixes A::"int mat"
+   assumes "A \<in> carrier_mat m n"
+  assumes eA: "echelon_form_JNF A"
+shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
+  using Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_internalized
+    [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
+        type_to_set1(1)[OF local_typedef1 local_typedef2]]
+  using assms 
+  using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
+
+
+
+lemma invertible_Hermite_of_list_of_rows_nontriv_mod_ring_aux:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat m n"
+  assumes eA: "echelon_form_JNF A"
+  shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
+using invertible_Hermite_of_list_of_rows_nontriv_mod_ring_internalized
+    [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
+        type_to_set1(1)[OF local_typedef1 local_typedef2]]
+  using assms 
+  using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
+end
+
+
+(*Canceling the first local type definitions*)
+context
+begin
+
+(*Canceling the first*)
+private lemma invertible_Hermite_of_list_of_rows_cancelled_first:
+  "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} 
+  \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A 
+  \<Longrightarrow> \<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
+  using invertible_Hermite_of_list_of_rows_nontriv_mod_ring_aux[cancel_type_definition, of m n A]
+  by auto  
+
+(*Canceling the second*)
+private lemma invertible_Hermite_of_list_of_rows_cancelled_both:
+  "1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A 
+  \<Longrightarrow> \<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
+  using invertible_Hermite_of_list_of_rows_cancelled_first[cancel_type_definition, of n m A] by simp
+
+
+(*Canceling the first*)
+
+private lemma Hermite_Hermite_of_list_of_rows_cancelled_first:
+"\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow>
+  1 < m \<Longrightarrow>
+  1 < n \<Longrightarrow>
+  A \<in> carrier_mat m n \<Longrightarrow>
+  echelon_form_JNF A 
+  \<Longrightarrow> Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
+  using Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_aux[cancel_type_definition, of m n A]
+  by auto  
+
+(*Canceling the second*)
+private lemma Hermite_Hermite_of_list_of_rows_cancelled_both:
+"1 < m \<Longrightarrow>
+  1 < n \<Longrightarrow>
+  A \<in> carrier_mat m n \<Longrightarrow>
+  echelon_form_JNF A 
+  \<Longrightarrow> Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
+  using Hermite_Hermite_of_list_of_rows_cancelled_first[cancel_type_definition, of n m A] by simp
+
+
+(*The final results in JNF*)
+
+lemma Hermite_Hermite_of_list_of_rows':
+ fixes A::"int mat"
+  assumes "A \<in> carrier_mat m n"
+    and "echelon_form_JNF A"  
+  and "1 < m" and "1 < n" (*Required from the mod_type restrictions*)
+shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"  
+  using Hermite_Hermite_of_list_of_rows_cancelled_both assms by auto
+
+corollary Hermite_Hermite_of_list_of_rows:
+ fixes A::"int mat"
+  assumes A: "A \<in> carrier_mat m n"
+    and eA: "echelon_form_JNF A"  
+shows "Hermite_JNF (range ass_function_euclidean) 
+  (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
+proof (cases "m=0 \<or> n=0")
+  case True
+  then show ?thesis 
+    by (auto, metis Hermite_Hermite_of_row_i Hermite_JNF_def A eA carrier_matD(1) one_carrier_mat zero_order(3))   
+     (metis Hermite_Hermite_of_row_i Hermite_JNF_def Hermite_of_list_of_rows A carrier_matD(2) 
+       echelon_form_mx0 is_zero_row_JNF_def mat_carrier zero_order(3))
+next
+  case False note not_m0_or_n0 = False
+  show ?thesis
+  proof (cases "m=1 \<or> n=1")
+    case True
+    then show ?thesis
+      by (metis False Hermite_of_list_of_rows_1xn Hermite_of_list_of_rows_mx1 A eA 
+          atLeastLessThan_iff linorder_not_less neq0_conv set_upt upt_eq_Nil_conv)
+  next
+    case False
+    show ?thesis
+      by (rule Hermite_Hermite_of_list_of_rows'[OF A eA], insert not_m0_or_n0 False, auto)
+  qed
+qed
+
+lemma invertible_Hermite_of_list_of_rows:
+  assumes A: "A \<in> carrier_mat m n"
+  and eA: "echelon_form_JNF A"
+shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
+proof (cases "m=0 \<or> n=0")
+  case True
+  have *: "Hermite_of_list_of_rows A [0..<m] = A" if n: "n=0"
+    by (rule Hermite_of_list_of_rows_mx0, insert A n, auto)
+  show ?thesis using True
+    by (auto, metis assms(1) invertible_mat_one left_mult_one_mat one_carrier_mat)
+       (metis (full_types) "*" assms(1) invertible_mat_one left_mult_one_mat one_carrier_mat)
+next
+  case False note mn = False
+  show ?thesis
+  proof (cases "m=1 \<or> n=1")
+    case True
+    then show ?thesis 
+      using A eA invertible_Hermite_of_list_of_rows_1xn invertible_Hermite_of_list_of_rows_mx1 by blast
+  next
+    case False
+    then show ?thesis 
+      using invertible_Hermite_of_list_of_rows_cancelled_both[OF _ _ A eA] False mn by auto
+  qed  
+qed
+end
+end
+end
+end
+
+
+text \<open>Now we have all the required stuff to prove the soundness of the algorithm.\<close>
+
+context proper_mod_operation
+begin
+
+(*
+thm invertible_Hermite_of_list_of_rows
+thm Hermite_Hermite_of_list_of_rows
+thm LLL_with_assms.Hermite_append_det_id
+thm FindPreHNF_invertible_mat
+thm FindPreHNF_echelon_form
+*)
+
+lemma Hermite_mod_det_mx0:
+  assumes "A \<in> carrier_mat m 0"
+  shows "Hermite_mod_det abs_flag A = A"
+  unfolding Hermite_mod_det_def Let_def using assms by auto
+
+lemma Hermite_JNF_mx0:
+  assumes A: "A \<in> carrier_mat m 0"
+  shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) A"
+  unfolding Hermite_JNF_def using A echelon_form_mx0 unfolding is_zero_row_JNF_def 
+  using ass_function_Complete_set_non_associates[OF ass_function_euclidean]
+  using res_function_Complete_set_residues[OF res_function_res_int] by auto
+  
+
+lemma Hermite_mod_det_soundness_mx0:
+  assumes  A: "A \<in> carrier_mat m n"
+  and n0: "n=0"
+shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)" 
+and "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)"
+proof -
+  have A: "A \<in> carrier_mat m 0" using A n0 by blast
+  then show "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)"
+    using Hermite_JNF_mx0[OF A] Hermite_mod_det_mx0[OF A] by auto
+  show "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)"
+    by (metis A Hermite_mod_det_mx0 invertible_mat_one left_mult_one_mat one_carrier_mat)
+qed
+
+
+lemma Hermite_mod_det_soundness_mxn:
+  assumes mn: "m = n"
+  and A: "A \<in> carrier_mat m n"
+  and n0: "0<n"
+  and inv_RAT_A: "invertible_mat (map_mat rat_of_int A)"
+shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)" 
+  and "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)"
+proof -
+  define D A' E H H' where D_def: "D = \<bar>Determinant.det A\<bar>"
+  and A'_def: "A' = A @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" and E_def: "E = FindPreHNF abs_flag D A'"
+  and H_def: "H = Hermite_of_list_of_rows E [0..<m+n]"
+  and H'_def: "H' = mat_of_rows n (map (Matrix.row H) [0..<m])"
+  have A': "A' \<in> carrier_mat (m+n) n" using A A A'_def by auto
+  let ?RAT = "of_int_hom.mat_hom :: int mat \<Rightarrow> rat mat"
+  have RAT_A: "?RAT A \<in> carrier_mat n n"
+    using A map_carrier_mat mat_of_rows_carrier(1) mn by auto 
+  have det_RAT_fs_init: "det (?RAT A) \<noteq> 0"
+    using inv_RAT_A unfolding invertible_iff_is_unit_JNF[OF RAT_A] by auto
+  moreover have "mat_of_rows n (map (Matrix.row A') [0..<n]) = A"
+  proof
+    let ?A' = "mat_of_rows n (map (Matrix.row A') [0..<n])"    
+    show dr: "dim_row ?A' = dim_row A" and dc: "dim_col ?A' = dim_col A" using A mn by auto
+    fix i j assume i: "i < dim_row A" and j: "j < dim_col A"
+    have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" using mn by auto
+    have "?A' $$ (i,j) =  (map (Matrix.row A') [0..<n]) ! i $v j"
+      by (rule mat_of_rows_index, insert i j dr dc A, auto) 
+    also have "... = A' $$ (i,j)" using A' mn i j A by auto
+    also have "... = A $$ (i,j)" unfolding A'_def using i append_rows_nth[OF A D] mn j A by auto
+    finally show "?A' $$ (i, j) = A $$ (i, j)" .
+  qed
+  ultimately have inv_RAT_A'n: 
+    "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..<n])))" 
+    using inv_RAT_A by auto
+  have eE: "echelon_form_JNF E"
+    by (unfold E_def, rule FindPreHNF_echelon_form[OF A'_def A _ _],
+        insert mn D_def det_RAT_fs_init, auto)
+  have E: "E \<in> carrier_mat (m+n) n" unfolding E_def by (rule FindPreHNF[OF A'])
+  have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> E = P * A'"
+  by (unfold E_def, rule FindPreHNF_invertible_mat[OF A'_def A n0 _ _],
+      insert mn D_def det_RAT_fs_init, auto)
+  from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)"
+    and inv_P: "invertible_mat P" and E_PA': "E = P * A'"
+    by blast
+  have "\<exists>Q. Q \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat Q \<and> H = Q * E"
+    by (unfold H_def, rule invertible_Hermite_of_list_of_rows[OF E eE])  
+  from this obtain Q where Q: "Q \<in> carrier_mat (m+n) (m+n)"
+    and inv_Q: "invertible_mat Q" and H_QE: "H = Q * E" by blast
+  let ?ass ="(range ass_function_euclidean)"
+  let ?res = "(\<lambda>c. range (res_int c))"
+  have Hermite_H: "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) H"
+    by (unfold H_def, rule Hermite_Hermite_of_list_of_rows[OF E eE])
+  hence eH: "echelon_form_JNF H" unfolding Hermite_JNF_def by auto
+  have H': "H' \<in> carrier_mat m n" using H'_def by auto
+  have H_H'0: "H = H' @\<^sub>r 0\<^sub>m m n"
+  proof (unfold H'_def, rule upper_triangular_append_zero)
+    show "upper_triangular' H" using eH by (rule echelon_form_JNF_imp_upper_triangular)
+    show "H \<in> carrier_mat (m + m) n"
+      unfolding H_def using Hermite_of_list_of_rows[of E] E mn by auto
+  qed (insert mn, simp)
+  obtain P' where PP': "inverts_mat P P'"
+    and P'P: "inverts_mat P' P" and P': "P' \<in> carrier_mat (m+n) (m+n)"         
+    using P inv_P obtain_inverse_matrix by blast
+  obtain Q' where QQ': "inverts_mat Q Q'"
+    and Q'Q: "inverts_mat Q' Q" and Q': "Q' \<in> carrier_mat (m+n) (m+n)"         
+    using Q inv_Q obtain_inverse_matrix by blast
+  have P'Q': "(P'*Q') \<in> carrier_mat (m + m) (m + m)" using P' Q' mn by simp
+  have A'_P'Q'H: "A' = P' * Q' * H"
+  proof -
+    have QP: "Q * P \<in> carrier_mat (m + m) (m + m)" using Q P mn by auto
+    have "H = Q * (P * A')" using H_QE E_PA' by auto
+    also have "... = (Q * P) * A'" using A' P Q by auto
+    also have "(P' * Q') * ... = ((P' * Q') * (Q * P)) * A'" using A' P'Q' QP mn by auto
+    also have "... =  (P' * (Q' * Q) * P) * A'"
+      by (smt P P' P'Q' Q Q' assms(1) assoc_mult_mat)
+    also have "... = (P'*P) * A'" 
+      by (metis P' Q' Q'Q carrier_matD(1) inverts_mat_def right_mult_one_mat)
+    also have "... = A'"
+      by (metis A' P' P'P carrier_matD(1) inverts_mat_def left_mult_one_mat)
+    finally show "A' = P' * Q' * H" ..
+  qed
+  have inv_P'Q': "invertible_mat (P' * Q')"
+    by (metis P' P'P PP' Q' Q'Q QQ' carrier_matD(1) carrier_matD(2) invertible_mat_def
+        invertible_mult_JNF square_mat.simps)
+  interpret vec_module "TYPE(int)" .
+  interpret B: cof_vec_space n "TYPE(rat)" .
+  interpret A: LLL_with_assms n m "(Matrix.rows A)" "4/3"
+  proof       
+    show "length (rows A) = m " using A unfolding Matrix.rows_def by simp
+    have s: "set (map of_int_hom.vec_hom (rows A)) \<subseteq> carrier_vec n"
+      using A unfolding Matrix.rows_def by auto
+    have rw: "(map of_int_hom.vec_hom (rows A)) = (rows (?RAT A))" 
+      by (metis A s carrier_matD(2) mat_of_rows_map mat_of_rows_rows rows_mat_of_rows set_rows_carrier subsetI)
+    have "B.lin_indpt (set (map of_int_hom.vec_hom (rows A)))"
+      unfolding rw by (rule B.det_not_0_imp_lin_indpt_rows[OF RAT_A det_RAT_fs_init])
+    moreover have "distinct (map of_int_hom.vec_hom (rows A)::rat Matrix.vec list)"
+    proof (rule ccontr)
+      assume " \<not> distinct (map of_int_hom.vec_hom (rows A)::rat Matrix.vec list)"
+      from this obtain i j where "row (?RAT A) i = row (?RAT A) j" and "i \<noteq> j" and "i < n" and "j < n"
+        unfolding rw
+        by (metis Determinant.det_transpose RAT_A add_0 cols_transpose det_RAT_fs_init 
+            not_add_less2 transpose_carrier_mat vec_space.det_rank_iff vec_space.non_distinct_low_rank)
+      thus False using Determinant.det_identical_rows[OF RAT_A] using det_RAT_fs_init RAT_A by auto      
+    qed      
+    ultimately show "B.lin_indpt_list (map of_int_hom.vec_hom (rows A))"
+      using s unfolding B.lin_indpt_list_def by auto
+  qed (simp)
+  have A_eq: "mat_of_rows n (Matrix.rows A) = A" using A mat_of_rows_rows by blast
+  have D_A: "D = \<bar>det (mat_of_rows n (rows A))\<bar>" using D_def A_eq by auto
+  have Hermite_H': "Hermite_JNF ?ass ?res H'"
+    by (rule A.Hermite_append_det_id(1)[OF _ mn _ H' H_H'0 P'Q' inv_P'Q' A'_P'Q'H Hermite_H],
+         insert D_def A'_def mn A inv_RAT_A D_A A_eq, auto) 
+  have dc: "dim_row A = m" and dr: "dim_col A = n" using A by auto
+  have Hermite_mod_det_H': "Hermite_mod_det abs_flag A = H'" 
+    unfolding Hermite_mod_det_def Let_def H'_def H_def E_def A'_def D_def dc dr det_int by blast
+  show "Hermite_JNF ?ass ?res (Hermite_mod_det abs_flag A)" using Hermite_mod_det_H' Hermite_H' by simp
+  have "\<exists>R. invertible_mat R \<and> R \<in> carrier_mat m m \<and> A = R * H'"
+    by (subst A_eq[symmetric], 
+        rule A.Hermite_append_det_id(2)[OF _ mn _ H' H_H'0 P'Q' inv_P'Q' A'_P'Q'H Hermite_H],
+        insert D_def A'_def mn A inv_RAT_A D_A A_eq, auto)
+  from this obtain R where inv_R: "invertible_mat R" 
+    and R: "R \<in> carrier_mat m m" and A_RH': "A = R * H'"
+    by blast
+  obtain R' where inverts_R: "inverts_mat R R'" and R': "R' \<in> carrier_mat m m"    
+    by (meson R inv_R obtain_inverse_matrix)
+  have inv_R': "invertible_mat R'" using inverts_R unfolding invertible_mat_def inverts_mat_def
+    using R R' mat_mult_left_right_inverse by auto
+  moreover have "H' = R' * A"
+  proof -
+    have "R' * A = R' * (R * H')" using A_RH' by auto
+    also have "... = (R'*R) * H'" using H' R R' by auto
+    also have "... = H'"
+      by (metis H' R R' mat_mult_left_right_inverse carrier_matD(1) 
+          inverts_R inverts_mat_def left_mult_one_mat)
+    finally show ?thesis ..
+  qed
+  ultimately show "\<exists>S. invertible_mat S \<and> S \<in> carrier_mat m m \<and> Hermite_mod_det abs_flag A = S * A" 
+    using R' Hermite_mod_det_H' by blast
+qed
+
+
+lemma Hermite_mod_det_soundness:
+  assumes mn: "m = n"
+  and A_def: "A \<in> carrier_mat m n"
+  and i: "invertible_mat (map_mat rat_of_int A)"
+shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)" 
+  and "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)" 
+  using A_def Hermite_mod_det_soundness_mx0(1) Hermite_mod_det_soundness_mxn(1) mn i 
+  by blast (insert Hermite_mod_det_soundness_mx0(2) Hermite_mod_det_soundness_mxn(2) assms, blast)
+
+
+text \<open>We can even move the whole echelon form algorithm @{text "echelon_form_of"} from HOL Analysis 
+to JNF and then we can combine it with @{text "Hermite_of_list_of_rows"} to have another 
+HNF algorithm which is not efficient, but valid for arbitrary matrices.\<close>
+
+lemma reduce_D0:
+"reduce a b 0 A = (let Aaj = A$$(a,0); Abj = A $$ (b,0)     
+  in
+  if Aaj = 0 then A else
+  case euclid_ext2 Aaj Abj of (p,q,u,v,d) \<Rightarrow> 
+       Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then  (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then  u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k)
+            )
+  )" (is "?lhs = ?rhs")
+proof 
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A $$ (a, 0)) (A $$ (b, 0))"
+    by (simp add: euclid_ext2_def) 
+  have *:" Matrix.mat (dim_row A) (dim_col A)
+        (\<lambda>(i, k).
+            if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if 0 < \<bar>r\<bar> then 
+                                  if k = 0 \<and> 0 dvd r then 0 else r mod 0 else r
+            else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
+                              if 0 < \<bar>r\<bar> then r mod 0 else r else A $$ (i, k)) 
+        = Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then  (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then  u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k) 
+            )" 
+    by (rule eq_matI, auto simp add: Let_def)
+  show "dim_row ?lhs = dim_row ?rhs" 
+    unfolding reduce.simps Let_def by (smt dim_row_mat(1) pquvd prod.simps(2))
+  show "dim_col ?lhs = dim_col ?rhs"
+    unfolding reduce.simps Let_def by (smt dim_col_mat(1) pquvd prod.simps(2))
+  fix i j assume i: "i<dim_row ?rhs" and j: "j<dim_col ?rhs"
+  show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
+    by (cases " A $$ (a, 0) = 0", insert * pquvd i j, auto simp add: case_prod_beta Let_def)
+qed
+
+
+
+lemma bezout_matrix_JNF_mult_eq':
+  assumes A': "A' \<in> carrier_mat m n" and a: "a<m"  and b: "b<m" and ab: "a \<noteq> b" 
+  and A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat t n"
+  assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))"
+  shows "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k)
+            ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A")
+proof (rule eq_matI) 
+  have A: "A \<in> carrier_mat (m+t) n" using A_def A' B by simp
+  hence A_carrier: "?A \<in> carrier_mat (m+t) n" by auto  
+  show dr: "dim_row ?A = dim_row (?BM * A)" and dc: "dim_col ?A = dim_col (?BM * A)"
+    unfolding bezout_matrix_JNF_def by auto
+  fix i ja assume i: "i < dim_row  (?BM * A)" and ja: "ja < dim_col (?BM * A)"
+  let ?f = "\<lambda>ia. (bezout_matrix_JNF A a b j euclid_ext2) $$ (i,ia) * A $$ (ia,ja)"
+  have dv: "dim_vec (col A ja) = m+t" using A by auto
+  have i_dr: "i<dim_row A" using i A unfolding bezout_matrix_JNF_def by auto
+  have a_dr: "a<dim_row A" using A a ja by auto
+  have b_dr: "b<dim_row A" using A b ja by auto
+  show "?A $$ (i,ja) = (?BM * A) $$ (i,ja)"
+  proof -
+    have "(?BM * A) $$ (i,ja) = Matrix.row ?BM i \<bullet> col A ja"
+      by (rule index_mult_mat, insert i ja, auto)
+    also have "... = (\<Sum>ia = 0..<dim_vec (col A ja). 
+          Matrix.row (bezout_matrix_JNF A a b j euclid_ext2) i $v ia * col A ja $v ia)"
+      by (simp add: scalar_prod_def)
+    also have "... = (\<Sum>ia = 0..<m+t. ?f ia)"
+      by (rule sum.cong, insert A i dr dc, auto) (smt bezout_matrix_JNF_def carrier_matD(1) 
+          dim_col_mat(1) index_col index_mult_mat(3) index_row(1) ja)
+    also have "... = (\<Sum>ia \<in> ({a,b} \<union> ({0..<m+t} - {a,b})). ?f ia)"
+      by (rule sum.cong, insert a a_dr b A ja, auto)
+    also have "... = sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b})" 
+      by (rule sum.union_disjoint, auto)
+    finally have BM_A_ija_eq: "(?BM * A) $$ (i,ja) = sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b})" by auto
+    show ?thesis
+    proof (cases "i = a")
+      case True
+      have sum0: "sum ?f ({0..<m+t} - {a,b}) = 0"
+      proof (rule sum.neutral, rule)
+        fix x assume x: "x \<in> {0..<m + t} - {a, b}"
+        hence xm: "x < m+t" by auto
+        have x_not_i: "x \<noteq> i" using True x by blast
+        have x_dr: "x < dim_row A" using x A by auto
+        have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
+          unfolding bezout_matrix_JNF_def 
+          unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
+        thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
+      qed
+      have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = p" 
+        unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True pquvd 
+        by (auto, metis split_conv)
+      have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = q"
+        unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True pquvd ab
+        by (auto, metis split_conv)
+      have "sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
+      also have "... = p * A $$ (a, ja) + q * A $$ (b, ja)" unfolding fa fb by simp
+      also have "... = ?A $$ (i,ja)" using A True dr i ja by auto
+      finally show ?thesis using BM_A_ija_eq by simp
+    next
+      case False note i_not_a = False
+      show ?thesis
+      proof (cases "i=b")
+        case True
+        have sum0: "sum ?f ({0..<m+t} - {a,b}) = 0"
+        proof (rule sum.neutral, rule)
+          fix x assume x: "x \<in> {0..<m + t} - {a, b}"
+          hence xm: "x < m+t" by auto
+          have x_not_i: "x \<noteq> i" using True x by blast
+          have x_dr: "x < dim_row A" using x A by auto
+          have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
+            unfolding bezout_matrix_JNF_def 
+            unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
+          thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
+        qed
+        have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = u" 
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True i_not_a pquvd 
+          by (auto, metis split_conv)
+        have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = v"
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True i_not_a pquvd ab
+          by (auto, metis split_conv)
+        have "sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
+        also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" unfolding fa fb by simp
+        also have "... = ?A $$ (i,ja)" using A True i_not_a dr i ja by auto
+        finally show ?thesis using BM_A_ija_eq by simp
+      next
+        case False note i_not_b = False
+        have sum0: "sum ?f ({0..<m+t} - {a,b} - {i}) = 0" 
+        proof (rule sum.neutral, rule)
+          fix x assume x: "x \<in> {0..<m + t} - {a, b} - {i}"
+          hence xm: "x < m+t" by auto
+          have x_not_i: "x \<noteq> i" using x by blast
+          have x_dr: "x < dim_row A" using x A by auto
+          have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
+            unfolding bezout_matrix_JNF_def 
+            unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
+          thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
+        qed
+        have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = 0" 
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using False i_not_a pquvd 
+          by auto
+        have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = 0" 
+          unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using False i_not_a pquvd 
+          by auto
+        have "sum ?f ({0..<m+t} - {a,b}) = sum ?f (insert i ({0..<m+t} - {a,b} - {i}))"
+          by (rule sum.cong, insert i_dr A i_not_a i_not_b, auto)
+        also have "... = ?f i + sum ?f ({0..<m+t} - {a,b} - {i})" by (rule sum.insert, auto)
+        also have "... = ?f i" using sum0 by simp
+        also have "... = ?A $$ (i,ja)"
+          unfolding bezout_matrix_JNF_def using i_not_a i_not_b  A dr i ja by fastforce
+        finally show ?thesis unfolding BM_A_ija_eq by (simp add: ab fa fb)
+      qed    
+    qed
+  qed
+qed
+
+
+
+lemma bezout_matrix_JNF_mult_eq2:
+  assumes A: "A \<in> carrier_mat m n" and a: "a<m"  and b: "b<m" and ab: "a \<noteq> b" 
+  assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))"
+  shows "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k)
+            ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A")
+proof (rule bezout_matrix_JNF_mult_eq'[OF A a b ab _ _ pquvd])
+  show "A = A @\<^sub>r (0\<^sub>m 0 n)" by (rule eq_matI, unfold append_rows_def, auto)
+  show "(0\<^sub>m 0 n) \<in> carrier_mat 0 n" by auto
+qed
+
+
+lemma reduce_invertible_mat_D0_BM:
+  assumes A: "A \<in> carrier_mat m n"
+  and a: "a < m"
+  and b: "b < m"
+  and ab: "a \<noteq> b"
+  and Aa0: "A$$(a,0) \<noteq> 0"
+  shows "reduce a b 0 A = (bezout_matrix_JNF A a b 0 euclid_ext2) * A"
+proof -
+ obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
+    by (simp add: euclid_ext2_def)
+  let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2"
+  let ?A = "Matrix.mat (dim_row A) (dim_col A)
+          (\<lambda>(i,k). if i = a then  (p*A$$(a,k) + q*A$$(b,k))
+                   else if i = b then  u * A$$(a,k) + v * A$$(b,k)
+                   else A$$(i,k))"
+  have A'_BZ_A: "?A = ?BM * A"
+    by (rule bezout_matrix_JNF_mult_eq2[OF A _ _ ab pquvd], insert a b, auto)  
+  moreover have "?A = reduce a b 0 A" using pquvd Aa0 unfolding reduce_D0 Let_def
+    by (metis (no_types, lifting) split_conv)
+  ultimately show ?thesis by simp
+qed
+
+
+lemma reduce_invertible_mat_D0:
+  assumes A: "A \<in> carrier_mat m n"
+  and a: "a < m"
+  and b: "b < m"
+  and n0: "0<n"
+  and ab: "a \<noteq> b"
+  and a_less_b: "a<b"
+  shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce a b 0 A = P * A"
+proof (cases "A$$(a,0) = 0")
+  case True
+  then show ?thesis
+    by (smt A invertible_mat_one left_mult_one_mat one_carrier_mat reduce.simps)
+next
+  case False
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
+    by (simp add: euclid_ext2_def)
+  let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2"
+  have "reduce a b 0 A = ?BM * A"  by (rule reduce_invertible_mat_D0_BM[OF A a b ab False])
+  moreover have invertible_bezout: "invertible_mat ?BM"
+    by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ n0 False],
+        insert a_less_b b, auto)      
+  moreover have BM: "?BM \<in> carrier_mat m m" unfolding bezout_matrix_JNF_def using A by auto
+  ultimately show ?thesis by blast
+qed
+
+lemma reduce_below_invertible_mat_D0:
+  assumes A': "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D=0"
+shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce_below a xs D A = P * A)"
+  using assms
+proof (induct a xs D A arbitrary: A rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case
+    by (auto, metis invertible_mat_one left_mult_one_mat one_carrier_mat)
+next
+  case (2 a x xs D A)
+  note A = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note d = "2.prems"(4)
+  note x_xs = "2.prems"(5)
+  note D0 = "2.prems"(6)
+  have xm: "x < m" using "2.prems" by auto
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m
+    \<and> reduce_below a xs D (reduce a x D A) = P * reduce a x D A)"
+    by (rule "2.hyps"[OF _ a j _ _ ],insert  d x_xs  D0 reduce_ax, auto)   
+  from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat m m"
+    and rb_Pr: "reduce_below a xs D (reduce a x D A) = P * reduce a x D A" by blast
+  have *: "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" by simp
+  have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat m m \<and> (reduce a x D A) = Q * A"
+    by (unfold D0, rule reduce_invertible_mat_D0[OF A a xm j], insert "2.prems", auto)
+  from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat m m"
+    and r_QA: "reduce a x D A = Q * A" by blast
+  have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
+  moreover have "P * Q \<in> carrier_mat m m" using P Q by auto
+  moreover have "reduce_below a (x # xs) D A = (P*Q) * A" 
+    by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
+        r_QA rb_Pr reduce_preserves_dimensions(1))
+  ultimately show ?case by blast
+qed
+
+
+(*This lemma permits to get rid of one assumption in reduce_not0*)
+lemma reduce_not0':
+  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and a_less_b: "a<b" and j: "0<n" and b: "b<m"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+  shows "reduce a b 0 A $$ (a, 0) \<noteq> 0" (is "?reduce_ab $$ (a,0) \<noteq> _")
+proof -
+  have "?reduce_ab $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in if 0 dvd r then 0 else r)" 
+    by (rule reduce_gcd[OF A _ j Aaj], insert a, simp)
+  also have "... \<noteq> 0" unfolding Let_def
+    by (simp add: assms(6))
+  finally show ?thesis .
+qed
+
+
+lemma reduce_below_preserves_D0:
+  assumes A': "A \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+  assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+    and "i\<noteq>a" and "i<m"
+  and "D=0"
+  shows "reduce_below a xs D A $$ (i,j) = A $$ (i,j)"
+  using assms
+proof (induct a xs D A arbitrary: A i rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case by auto
+next
+  case (2 a x xs D A)
+  note A = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note Aaj = "2.prems"(4)
+  note i_set_xxs = "2.prems"(5)
+  note d = "2.prems"(6)
+  note xxs_less_m = "2.prems"(7)
+  note ia = "2.prems"(8)
+  note im = "2.prems"(9)
+  note D0 = "2.prems"(10)
+  have xm: "x < m"  using "2.prems" by auto
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "(reduce a x D A)"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  have "reduce_below a (x # xs) D A $$ (i, j) = reduce_below a xs D (reduce a x D A) $$ (i, j)"
+    by auto
+  also have "... = reduce a x D A $$ (i, j)"
+  proof (rule "2.hyps"[OF _ a j _ _ ])   
+    show "i \<notin> set xs" using i_set_xxs by auto
+    show "distinct xs" using d by auto
+    show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+    show "reduce a x D A $$ (a, 0) \<noteq> 0"
+      by (unfold D0, rule reduce_not0'[OF A _ _ _ _ Aaj], insert "2.prems", auto)
+    show "reduce a x D A \<in> carrier_mat m n" using reduce_ax by linarith
+  qed (insert "2.prems", auto)
+  also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
+  finally show ?case .
+qed
+
+
+
+lemma reduce_below_0_D0:
+  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
+    and Aaj: "A $$ (a,0) \<noteq> 0"
+  assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
+  and "D=0"
+  shows "reduce_below a xs D A $$ (i,0) = 0"
+  using assms
+proof (induct a xs D A arbitrary: A i rule: reduce_below.induct)
+  case (1 a D A)
+  then show ?case by auto 
+next
+  case (2 a x xs D A)
+  note A = "2.prems"(1)
+  note a = "2.prems"(2)
+  note j = "2.prems"(3)
+  note Aaj = "2.prems"(4)
+  note i_set_xxs = "2.prems"(5)
+  note d = "2.prems"(6)
+  note xxs_less_m = "2.prems"(7)
+  note D0 = "2.prems"(8)
+  have xm: "x < m"  using "2.prems" by auto
+  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
+    by (metis prod_cases5)
+  let ?reduce_ax = "reduce a x D A"
+  have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
+    by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
+        carrier_matD carrier_mat_triv index_mat_four_block(2,3)
+        index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
+  show ?case
+  proof (cases "i=x")
+    case True
+    have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
+      by auto
+    also have "... = (reduce a x D A) $$ (i, 0)"
+    proof (rule reduce_below_preserves_D0[OF _ a j _ _ ])
+      show "reduce a x D A \<in> carrier_mat m n" using reduce_ax by linarith
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce a x D A $$ (a, 0) \<noteq> 0"
+        by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto)
+      show "i \<notin> set xs" using True d by auto
+      show "i \<noteq> a" using "2.prems" by blast
+      show "i < m" by (simp add: True trans_less_add1 xm)
+    qed (insert D0)
+    also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto)
+    finally show ?thesis .
+  next
+    case False note i_not_x = False    
+    have h: "reduce_below a xs D (reduce a x D A) $$ (i, 0) = 0 "
+    proof (rule "2.hyps"[OF _ a j _ _ ])
+      show "reduce a x D A \<in> carrier_mat m n" using reduce_ax by linarith
+      show "i \<in> set xs" using i_set_xxs i_not_x by auto
+      show "distinct xs" using d by auto
+      show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
+      show "reduce a x D A $$ (a, 0) \<noteq> 0"
+        by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto)
+    qed (insert D0)
+    have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
+      by auto
+    also have "... = 0" using h .
+    finally show ?thesis .
+  qed
+qed
+
+end
+
+text \<open>Definition of the echelon form algorithm in JNF\<close>
+
+primrec bezout_iterate_JNF
+where "bezout_iterate_JNF A 0 i j bezout = A"
+    | "bezout_iterate_JNF A (Suc n) i j bezout = 
+        (if (Suc n) \<le> i then A else 
+              bezout_iterate_JNF (bezout_matrix_JNF A i ((Suc n)) j bezout * A) n i j bezout)"
+
+definition 
+  "echelon_form_of_column_k_JNF bezout A' k = 
+    (let (A, i) = A' 
+     in if (i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0) then (A, i) else 
+        if (\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0) then (A, i + 1) else
+            let n = (LEAST n. A $$ (n,k) \<noteq> 0 \<and> i \<le> n); 
+                interchange_A = swaprows i n A
+           in
+            (bezout_iterate_JNF (interchange_A) (dim_row A - 1) i k bezout, i + 1) )"
+
+
+definition "echelon_form_of_upt_k_JNF A k bezout = (fst (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<Suc k]))"
+definition "echelon_form_of_JNF A bezout = echelon_form_of_upt_k_JNF A (dim_col A - 1) bezout"
+
+
+context includes lifting_syntax
+begin
+
+lemma HMA_bezout_iterate[transfer_rule]: 
+  assumes "n<CARD('m)"
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
+     ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (=) ===> (Mod_Type_Connect.HMA_M)) 
+  (\<lambda>A i j bezout. bezout_iterate_JNF A n i j bezout)  
+  (\<lambda>A i j bezout. bezout_iterate A n i j bezout)
+  "
+proof (intro rel_funI, goal_cases)
+  case (1 A A' i i' j j' bezout bezout')
+  then show ?case using assms
+  proof (induct n arbitrary: A A')
+    case 0
+    then show ?case by auto
+  next
+    case (Suc n)
+    note AA'[transfer_rule] = "Suc.prems"(1)
+    note ii'[transfer_rule] = "Suc.prems"(2)
+    note jj'[transfer_rule] = "Suc.prems"(3)
+    note bb'[transfer_rule] = "Suc.prems"(4)
+    note Suc_n_less_m = "Suc.prems"(5)
+    let ?BI_JNF = "bezout_iterate_JNF"
+    let ?BI_HMA = "bezout_iterate"
+    let ?from_nat_rows = "mod_type_class.from_nat :: _ \<Rightarrow> 'm"
+    have Sucn[transfer_rule]: "Mod_Type_Connect.HMA_I (Suc n) (?from_nat_rows (Suc n))"
+      unfolding Mod_Type_Connect.HMA_I_def
+      by (simp add: Suc_lessD Suc_n_less_m mod_type_class.from_nat_to_nat)
+    have n: " n < CARD('m)" using Suc_n_less_m by simp
+    have [transfer_rule]: 
+      "Mod_Type_Connect.HMA_M (?BI_JNF (bezout_matrix_JNF A i (Suc n) j bezout * A) n i j bezout)
+     (?BI_HMA (bezout_matrix A' i' (?from_nat_rows (Suc n)) j' bezout' ** A') n i' j' bezout')"    
+      by (rule Suc.hyps[OF _ ii' jj' bb' n], transfer_prover)
+    moreover have "Suc n \<le> i \<Longrightarrow>  Suc n \<le> mod_type_class.to_nat i'"
+      and "Suc n > i \<Longrightarrow> Suc n > mod_type_class.to_nat i'" 
+      by (metis "1"(2) Mod_Type_Connect.HMA_I_def)+
+    ultimately show ?case using AA' by auto
+  qed
+qed
+
+
+corollary HMA_bezout_iterate'[transfer_rule]: 
+  fixes A'::"int ^ 'n :: mod_type ^ 'm :: mod_type"
+  assumes n: "n<CARD('m)"
+  and "Mod_Type_Connect.HMA_M A A'"
+   and "Mod_Type_Connect.HMA_I i i'" and "Mod_Type_Connect.HMA_I j j'" 
+ shows "Mod_Type_Connect.HMA_M (bezout_iterate_JNF A n i j bezout) (bezout_iterate A' n i' j' bezout)"
+  using assms HMA_bezout_iterate[OF n] unfolding rel_fun_def by force
+
+
+
+lemma snd_echelon_form_of_column_k_JNF_le_dim_row:
+  assumes "i<dim_row A"
+  shows "snd (echelon_form_of_column_k_JNF bezout (A,i) k ) \<le> dim_row A"   
+  using assms unfolding echelon_form_of_column_k_JNF_def by auto
+
+
+
+lemma HMA_echelon_form_of_column_k[transfer_rule]: 
+  assumes k: "k<CARD('n)"
+  shows "((=) ===> rel_prod (Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) (\<lambda>a b. a=b \<and> a\<le>CARD('m))
+    ===> (rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m)))) 
+  (\<lambda>bezout A. echelon_form_of_column_k_JNF bezout A k)  
+  (\<lambda>bezout A. echelon_form_of_column_k bezout A k)
+  "
+proof (intro rel_funI, goal_cases)
+  case (1 bezout bezout' xa ya )
+  obtain A i where xa: "xa = (A,i)" using surjective_pairing by blast
+  obtain A' i' where ya: "ya = (A',i')" using surjective_pairing by blast
+  have ii'[transfer_rule]: "i=i'" using "1"(2) xa ya by auto
+  have i_le_m: "i\<le>CARD('m)"  using "1"(2) xa ya by auto
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" using "1"(2) xa ya by auto
+  have bb'[transfer_rule]: "bezout=bezout'" using "1" by auto
+  let ?from_nat_rows = "mod_type_class.from_nat :: _ \<Rightarrow> 'm"
+  let ?from_nat_cols = "mod_type_class.from_nat :: _ \<Rightarrow> 'n"
+  have kk'[transfer_rule]: "Mod_Type_Connect.HMA_I k (?from_nat_cols k)"
+    by (simp add: Mod_Type_Connect.HMA_I_def assms mod_type_class.to_nat_from_nat_id)
+  have c1_eq: "(i = dim_row A) = (i = nrows A')"
+    by (metis AA' Mod_Type_Connect.dim_row_transfer_rule nrows_def)
+  have c2_eq: "(\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0) 
+      = (\<forall>m\<ge>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs") if i_not: "i\<noteq>dim_row A" 
+  proof 
+    assume lhs: "?lhs"
+    show "?rhs"
+    proof (rule+)    
+      fix m 
+      assume im: "?from_nat_rows i \<le> m"
+      have im': "i<CARD('m)" using i_le_m i_not
+        by (simp add: c1_eq dual_order.order_iff_strict nrows_def)
+      let ?m' = "mod_type_class.to_nat m"
+      have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I ?m' m" 
+        by (simp add: Mod_Type_Connect.HMA_I_def)
+      from im have "mod_type_class.to_nat (?from_nat_rows i) \<le> ?m'"
+        by (simp add: to_nat_mono')
+      hence "?m' >= i" using im im' by (simp add: mod_type_class.to_nat_from_nat_id)
+      hence "?m' \<in> {i..<dim_row A}"
+        using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card by fastforce
+      hence "A $$ (?m', k) = 0" using lhs by auto
+      moreover have "A $$ (?m', k) = A' $h m $h ?from_nat_cols k" unfolding index_hma_def[symmetric] by transfer_prover
+      ultimately show "A' $h m $h ?from_nat_cols k = 0" by simp
+    qed
+  next
+    assume rhs: "?rhs"
+    show "?lhs"
+    proof (rule)
+      fix m assume m: "m \<in> {i..<dim_row A}"
+      let ?m = "?from_nat_rows m"
+      have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I m ?m" 
+        by (metis AA' Mod_Type_Connect.HMA_I_def Mod_Type_Connect.dim_row_transfer_rule
+            atLeastLessThan_iff m mod_type_class.from_nat_to_nat)
+      have m_ge_i: "?m\<ge>?from_nat_rows i"
+        using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono' m by fastforce
+      hence "A' $h ?m $h ?from_nat_cols k = 0" using rhs by auto
+      moreover have "A $$ (m, k) = A' $h ?m $h ?from_nat_cols k"
+        unfolding index_hma_def[symmetric] by transfer_prover
+      ultimately show "A $$ (m, k) = 0" by simp
+    qed
+  qed
+  show ?case 
+  proof (cases "(i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0)")
+    case True   
+    hence *: "(\<forall>m\<ge>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0) \<or> (i = nrows A')"
+      using c1_eq c2_eq by auto
+    have "echelon_form_of_column_k_JNF bezout xa k = (A,i)" 
+      unfolding echelon_form_of_column_k_JNF_def using True xa by auto
+    moreover have "echelon_form_of_column_k bezout ya k = (A',i')"
+      unfolding echelon_form_of_column_k_def Let_def using * ya ii' by simp
+    ultimately show ?thesis unfolding xa ya rel_prod.simps using AA' ii' bb' i_le_m by blast    
+  next
+    case False note not_c1 = False
+    hence im': "i<CARD('m)"
+      by (metis c1_eq dual_order.order_iff_strict i_le_m nrows_def)
+    have *: "(\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0) 
+      = (\<forall>m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs")
+    proof 
+      assume lhs: "?lhs"
+      show "?rhs"
+      proof (rule+)    
+        fix m 
+        assume im: "?from_nat_rows i < m"     
+        let ?m' = "mod_type_class.to_nat m"
+        have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I ?m' m" 
+          by (simp add: Mod_Type_Connect.HMA_I_def)
+        from im have "mod_type_class.to_nat (?from_nat_rows i) < ?m'"
+          by (simp add: to_nat_mono)
+        hence "?m' > i" using im im' by (simp add: mod_type_class.to_nat_from_nat_id)
+        hence "?m' \<in> {i+1..<dim_row A}"
+          using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card by fastforce
+        hence "A $$ (?m', k) = 0" using lhs by auto
+        moreover have "A $$ (?m', k) = A' $h m $h ?from_nat_cols k" unfolding index_hma_def[symmetric] by transfer_prover
+        ultimately show "A' $h m $h ?from_nat_cols k = 0" by simp
+      qed
+    next
+      assume rhs: "?rhs"
+      show "?lhs"
+      proof (rule)
+        fix m assume m: "m \<in> {i+1..<dim_row A}"
+        let ?m = "?from_nat_rows m"
+        have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I m ?m" 
+          by (metis AA' Mod_Type_Connect.HMA_I_def Mod_Type_Connect.dim_row_transfer_rule
+              atLeastLessThan_iff m mod_type_class.from_nat_to_nat)
+        have m_ge_i: "?m>?from_nat_rows i"
+          by (metis Mod_Type_Connect.HMA_I_def One_nat_def add_Suc_right atLeastLessThan_iff from_nat_mono
+              le_simps(3) m mm' mod_type_class.to_nat_less_card nat_arith.rule0)
+        hence "A' $h ?m $h ?from_nat_cols k = 0" using rhs by auto
+        moreover have "A $$ (m, k) = A' $h ?m $h ?from_nat_cols k"
+          unfolding index_hma_def[symmetric] by transfer_prover
+        ultimately show "A $$ (m, k) = 0" by simp
+      qed
+    qed
+    show ?thesis
+    proof (cases "(\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0)")
+      case True
+      have "echelon_form_of_column_k_JNF bezout xa k = (A,i+1)" 
+        unfolding echelon_form_of_column_k_JNF_def using True xa not_c1 by auto
+      moreover have "echelon_form_of_column_k bezout ya k = (A',i'+1)"
+        unfolding echelon_form_of_column_k_def Let_def using ya ii' * True c1_eq c2_eq not_c1 by auto
+      ultimately show ?thesis unfolding xa ya rel_prod.simps using AA' ii' bb' i_le_m
+        by (metis Mod_Type_Connect.dim_row_transfer_rule le_neq_implies_less le_simps(3) not_c1 semiring_norm(175))      
+    next
+      case False
+      hence *: "\<not> (\<forall>m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" using * by auto
+      have **: "\<not> ((\<forall>m\<ge>?from_nat_rows i. A' $h m $h ?from_nat_cols k = 0) \<or> i = nrows A')"
+        using c1_eq c2_eq not_c1 by auto
+      define n where "n=(LEAST n. A $$ (n,k) \<noteq> 0 \<and> i \<le> n)"
+      define n' where "n'=(LEAST n. A' $ n $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> n)"
+      let ?interchange_A = "swaprows i n A"
+      let ?interchange_A' = "interchange_rows A' (?from_nat_rows i') n'"      
+      have nn'[transfer_rule]: "Mod_Type_Connect.HMA_I n n'"
+      proof -
+        let ?n' = "mod_type_class.to_nat n'"
+        have exist: "\<exists>n. A' $ n $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> n"
+          using * by auto
+        from this obtain a where c: "A' $ a $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> a" by blast        
+        have "n = ?n'"
+        proof (unfold n_def, rule Least_equality)
+          have n'n'[transfer_rule]: "Mod_Type_Connect.HMA_I ?n' n'"
+            by (simp add: Mod_Type_Connect.HMA_I_def)
+          have e: "(A' $ n' $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> n')"
+            by (metis (mono_tags, lifting) LeastI c2_eq n'_def not_c1) 
+          hence  "i \<le> mod_type_class.to_nat n'" 
+            using im' mod_type_class.from_nat_to_nat to_nat_mono' by fastforce       
+          moreover have "A' $ n' $ ?from_nat_cols k = A $$ (?n', k)" 
+            unfolding index_hma_def[symmetric] by (transfer', auto)
+          ultimately show "A $$ (?n', k) \<noteq> 0 \<and> i \<le> ?n'"
+            using e by auto
+          show " \<And>y. A $$ (y, k) \<noteq> 0 \<and> i \<le> y \<Longrightarrow> mod_type_class.to_nat n' \<le> y"
+            by (smt AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def assms from_nat_mono
+                from_nat_mono' index_mat(1) linorder_not_less mod_type_class.from_nat_to_nat_id
+                mod_type_class.to_nat_less_card n'_def order.strict_trans prod.simps(2) wellorder_Least_lemma(2))
+        qed
+        thus ?thesis unfolding Mod_Type_Connect.HMA_I_def by auto
+      qed
+      have dr1[transfer_rule]: "(nrows A' - 1) = (dim_row A - 1)" unfolding nrows_def
+        using AA' Mod_Type_Connect.dim_row_transfer_rule by force
+      have ii'2[transfer_rule]: "Mod_Type_Connect.HMA_I i (?from_nat_rows i')"
+        by (metis "**" Mod_Type_Connect.HMA_I_def i_le_m ii' le_neq_implies_less
+            mod_type_class.to_nat_from_nat_id nrows_def)
+      have ii'3[transfer_rule]: "Mod_Type_Connect.HMA_I i' (?from_nat_rows i')" 
+        using ii' ii'2 by blast
+      let ?BI_JNF = "(bezout_iterate_JNF (?interchange_A) (dim_row A - 1) i k bezout)"
+      let ?BI_HA = "(bezout_iterate (?interchange_A') (nrows A' - 1) (?from_nat_rows i) (?from_nat_cols k) bezout)"
+      have e_rw: "echelon_form_of_column_k_JNF bezout xa k = (?BI_JNF,i+1)"
+        unfolding echelon_form_of_column_k_JNF_def n_def using False xa not_c1 by auto
+      have e_rw2: "echelon_form_of_column_k bezout ya k = (?BI_HA,i+1)"
+        unfolding echelon_form_of_column_k_def Let_def n'_def using * ya ** ii' by auto
+      have s[transfer_rule]: "Mod_Type_Connect.HMA_M (swaprows i' n A) (interchange_rows A' (?from_nat_rows i') n')" 
+        by transfer_prover
+      have n_CARD: "(nrows A' - 1) < CARD('m)" unfolding nrows_def by auto
+      note a[transfer_rule] = HMA_bezout_iterate[OF n_CARD]
+      have BI[transfer_rule]:"Mod_Type_Connect.HMA_M ?BI_JNF ?BI_HA" unfolding ii' dr1 
+        by (rule HMA_bezout_iterate'[OF _ s ii'3 kk'], insert n_CARD, transfer', simp)
+      thus ?thesis using e_rw e_rw2 bb'
+        by (metis (mono_tags, lifting) AA' False Mod_Type_Connect.dim_row_transfer_rule 
+            atLeastLessThan_iff dual_order.trans order_less_imp_le rel_prod_inject)
+    qed
+  qed
+qed
+
+corollary HMA_echelon_form_of_column_k'[transfer_rule]: 
+  assumes k: "k<CARD('n)" and "i\<le>CARD('m)"
+  and "(Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) A A'"
+  shows "(rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m))) 
+  (echelon_form_of_column_k_JNF bezout (A,i) k)  
+  (echelon_form_of_column_k bezout (A',i) k)"
+  using assms HMA_echelon_form_of_column_k[OF k] unfolding rel_fun_def by force
+
+lemma HMA_foldl_echelon_form_of_column_k:
+  assumes k: "k\<le>CARD('n)"
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)
+    ===> (rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m)))) 
+  (\<lambda>A bezout. (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<k]))  
+  (\<lambda>A bezout. (foldl (echelon_form_of_column_k bezout) (A,0) [0..<k]))"
+proof (intro rel_funI, goal_cases)
+  case (1 A A' bezout bezout')
+  then show ?case using assms
+  proof (induct k arbitrary: A A' )
+    case 0
+    then show ?case by auto
+  next
+     case (Suc k)
+    note AA'[transfer_rule] = "Suc.prems"(1)
+    note bb'[transfer_rule] = "Suc.prems"(2)
+    note Suc_k_less_m = "Suc.prems"(3)
+    let ?foldl_JNF = "foldl (echelon_form_of_column_k_JNF bezout) (A,0)"
+    let ?foldl_HA = "foldl (echelon_form_of_column_k bezout') (A',0)"
+    have set_rw: "[0..<Suc k] = [0..<k] @ [k]" by auto
+    have f_JNF: "?foldl_JNF [0..<Suc k] = echelon_form_of_column_k_JNF bezout (?foldl_JNF [0..<k]) k" 
+      by auto
+    have f_HA: "?foldl_HA [0..<Suc k] = echelon_form_of_column_k bezout' (?foldl_HA [0..<k]) k" 
+      by auto
+    have hyp[transfer_rule]: "rel_prod Mod_Type_Connect.HMA_M (\<lambda>a b. a=b \<and> a\<le>CARD('m)) (?foldl_JNF [0..<k]) (?foldl_HA [0..<k])"
+      by (rule Suc.hyps[OF AA'], insert Suc.prems, auto)
+    show ?case unfolding f_JNF unfolding f_HA bb' using HMA_echelon_form_of_column_k'
+      by (smt "1"(2) Suc_k_less_m Suc_le_lessD hyp rel_prod.cases)
+  qed
+qed
+
+
+
+lemma HMA_echelon_form_of_upt_k[transfer_rule]:
+  assumes k: "k<CARD('n)"
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)
+    ===> (Mod_Type_Connect.HMA_M)) 
+  (\<lambda>A bezout. echelon_form_of_upt_k_JNF A k bezout)  
+  (\<lambda>A bezout. echelon_form_of_upt_k A k bezout)
+  "
+proof (intro rel_funI, goal_cases)
+  case (1 A A' bezout bezout')
+  have k': "Suc k \<le> CARD('n)" using k by auto
+  have rel_foldl: "(rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m))) 
+  (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<Suc k])  
+  (foldl (echelon_form_of_column_k bezout) (A',0) [0..<Suc k])"
+    using HMA_foldl_echelon_form_of_column_k[OF k'] by (smt "1"(1) rel_fun_def)
+  then show ?case using assms unfolding echelon_form_of_upt_k_JNF_def echelon_form_of_upt_k_def    
+    by (metis (no_types, lifting) "1"(2) prod.collapse rel_prod_inject)
+qed
+ 
+
+lemma HMA_echelon_form_of[transfer_rule]:
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)
+    ===> (Mod_Type_Connect.HMA_M)) 
+  (\<lambda>A bezout. echelon_form_of_JNF A bezout)  
+  (\<lambda>A bezout. echelon_form_of A bezout)
+  "
+proof (intro rel_funI, goal_cases)
+  case (1 A A' bezout bezout')
+  note AA'[transfer_rule] = 1(1)
+  note bb'[transfer_rule] = 1(2)
+  have *: "(dim_col A - 1) < CARD('n)" using 1
+    using Mod_Type_Connect.dim_col_transfer_rule by force
+  note **[transfer_rule] = HMA_echelon_form_of_upt_k[OF *]
+  have [transfer_rule]: "(ncols A' - 1) = (dim_col A - 1)"
+    by (metis "1"(1) Mod_Type_Connect.dim_col_transfer_rule ncols_def)
+  have [transfer_rule]: "(dim_col A - 1) = (dim_col A - 1)" ..
+  show ?case unfolding echelon_form_of_def echelon_form_of_JNF_def bb'
+    by (metis (mono_tags) "**" "1"(1) \<open>ncols A' - 1 = dim_col A - 1\<close> rel_fun_def)
+qed
+end
+
+
+context
+begin
+
+private lemma echelon_form_of_euclidean_invertible_mod_type:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
+  shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (CARD('m::mod_type)) (CARD('m::mod_type)) 
+    \<and> P * A = echelon_form_of_JNF A euclid_ext2 
+    \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
+proof -
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
+    unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto   
+  have [transfer_rule]: "Mod_Type_Connect.HMA_M 
+    (echelon_form_of_JNF A euclid_ext2) (echelon_form_of A' euclid_ext2)" 
+    by transfer_prover  
+  have "\<exists>P. invertible P \<and> P**A' = (echelon_form_of A' euclid_ext2) 
+         \<and> echelon_form (echelon_form_of A' euclid_ext2)"
+    by (rule echelon_form_of_euclidean_invertible)    
+  thus ?thesis by (transfer, auto)
+qed 
+
+
+private lemma echelon_form_of_euclidean_invertible_nontriv_mod_ring:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
+  shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (CARD('m)) (CARD('m)) 
+    \<and> P * A = echelon_form_of_JNF A euclid_ext2 
+    \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
+  using assms echelon_form_of_euclidean_invertible_mod_type by (smt CARD_mod_ring)
+
+(*We internalize both sort constraints in one step*)
+lemmas echelon_form_of_euclidean_invertible_nontriv_mod_ring_internalized = 
+  echelon_form_of_euclidean_invertible_nontriv_mod_ring[unfolded CARD_mod_ring, 
+      internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
+
+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 echelon_form_of_euclidean_invertible_nontriv_mod_ring_aux:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat m n"
+  shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m
+    \<and> P * A = echelon_form_of_JNF A euclid_ext2 
+    \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
+ using echelon_form_of_euclidean_invertible_nontriv_mod_ring_internalized
+    [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
+        type_to_set1(1)[OF local_typedef1 local_typedef2]]
+  using assms 
+  using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
+
+end
+
+
+(*Canceling the first local type definitions*)
+context
+begin
+
+(*Canceling the first*)
+
+private lemma echelon_form_of_euclidean_invertible_cancelled_first:
+"\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
+  A \<in> carrier_mat m n \<Longrightarrow> \<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m
+  \<and> P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
+  using echelon_form_of_euclidean_invertible_nontriv_mod_ring_aux[cancel_type_definition, of m n A]
+  by force  
+
+(*Canceling the second*)
+private lemma echelon_form_of_euclidean_invertible_cancelled_both:
+"1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> \<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m 
+  \<and> P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
+  using echelon_form_of_euclidean_invertible_cancelled_first[cancel_type_definition, of n m A]
+  by force
+
+(*The final result in JNF*)
+
+lemma echelon_form_of_euclidean_invertible':
+ fixes A::"int mat"
+  assumes "A \<in> carrier_mat m n" 
+  and "1 < m" and "1 < n" (*Required from the mod_type restrictions*)
+  shows "\<exists>P. invertible_mat P \<and>
+        P \<in> carrier_mat m m \<and> P * A = echelon_form_of_JNF A euclid_ext2 
+        \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"  
+  using echelon_form_of_euclidean_invertible_cancelled_both assms by auto
+end
+end
+
+context mod_operation
+begin
+
+definition "FindPreHNF_rectangular A 
+  =   (let m = dim_row A; n = dim_col A in 
+  if m < 2 \<or> n = 0 then A else \<comment> \<open> No operations are carried out if m = 1 \<close>
+  if n = 1 then 
+        let non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A] in
+        if non_zero_positions = [] then A
+        else let A' = (if A$$(0,0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)
+            in reduce_below_impl 0 non_zero_positions 0 A'
+  else (echelon_form_of_JNF A euclid_ext2))"
+
+text \<open>This is the (non-efficient) HNF algorithm obtained from the echelon form and Hermite normal 
+form AFP entries\<close>
+
+definition "HNF_algorithm_from_HA A 
+            = Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<(dim_row A)]"
+
+(*
+  Now we can combine FindPreHNF_rectangular, FindPreHNF and Hermite_of_list_of_rows to get
+  an algorithm to compute the HNF of any matrix (if it is square and invertible, then the HNF is
+  computed reducing entries modulo D)
+*)
+
+text \<open>Now we can combine @{text"FindPreHNF_rectangular"}, @{text"FindPreHNF"}
+  and @{text"Hermite_of_list_of_rows"} to get an algorithm to compute the HNF of any matrix
+  (if it is square and invertible, then the HNF is computed reducing entries modulo D)\<close>
+
+definition "HNF_algorithm abs_flag A = 
+  (let m = dim_row A; n = dim_col A in
+  if m \<noteq> n then Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<m]
+  else
+    let D = abs (det_int A) in
+    if D = 0 then Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<m]
+    else 
+      let A' = A @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n;
+          E = FindPreHNF abs_flag D A';
+          H = Hermite_of_list_of_rows E [0..<m+n]
+      in mat_of_rows n (map (Matrix.row H) [0..<m]))"
+
+end
+
+declare mod_operation.FindPreHNF_rectangular_def[code]
+declare mod_operation.HNF_algorithm_from_HA_def[code]
+declare mod_operation.HNF_algorithm_def[code]
+
+context proper_mod_operation
+begin
+
+(*With some work, we could get this lemma for matrices whose elements belong to a Bézout domain*)
+lemma FindPreHNF_rectangular_soundness:
+  fixes A::"int mat"
+  assumes A: "A \<in> carrier_mat m n" 
+  shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> P * A = FindPreHNF_rectangular A 
+    \<and> echelon_form_JNF (FindPreHNF_rectangular A)"  
+proof (cases "m < 2 \<or> n = 0")
+  case True
+  then show ?thesis
+    by (smt A FindPreHNF_rectangular_def carrier_matD echelon_form_JNF_1xn echelon_form_mx0
+        invertible_mat_one left_mult_one_mat one_carrier_mat)
+next
+  case False 
+  have m1: "m>1" using False by auto
+  have n0: "n>0" using False by auto
+  show ?thesis
+  proof (cases "n=1")
+    case True note n1 = True
+    let ?nz = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]" 
+    let ?A' = "(if A$$(0,0) \<noteq> 0 then A else let i = ?nz ! 0 in swaprows 0 i A)"
+    have A': "?A' \<in> carrier_mat m n" using A by auto
+    have A'00: "?A' $$ (0,0) \<noteq> 0" if "?nz \<noteq> []" 
+      by (smt True assms carrier_matD index_mat_swaprows(1) length_greater_0_conv m1
+          mem_Collect_eq nat_SN.gt_trans nth_mem set_filter that zero_less_one_class.zero_less_one)
+    have e_r: "echelon_form_JNF (reduce_below 0 ?nz 0 ?A')" if nz_not_empty: "?nz \<noteq> []" 
+    proof (rule echelon_form_JNF_mx1)
+      show "(reduce_below 0 ?nz 0 ?A') \<in> carrier_mat m n"  using A reduce_below by auto
+      have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0" if i: "i \<in> {1..<m}" for i
+      proof (cases "i \<in> set ?nz")
+        case True
+        show ?thesis
+          by (rule reduce_below_0_D0[OF A' _ _ A'00 True], insert m1 n0 True A nz_not_empty, auto)
+      next
+        case False
+        have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = ?A' $$ (i,0)" 
+          by (rule reduce_below_preserves_D0[OF A' _ _ A'00 False], insert m1 n0 True A i nz_not_empty, auto)
+        also have "... = 0" using False n1 assms that by auto
+        finally show ?thesis .
+      qed
+      thus "\<forall>i \<in> {1..<m}. (reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0"
+        by simp
+    qed (insert True, simp)
+    have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce_below 0 ?nz 0 ?A' = P * ?A'" 
+      by (rule reduce_below_invertible_mat_D0[OF A'], insert m1 n0 True A, auto)
+    moreover have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> ?A' = P * A"   if "?nz \<noteq> []"
+      using A A'_swaprows_invertible_mat m1 that by blast 
+    ultimately have e_inv: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce_below 0 ?nz 0 ?A' = P * A"
+      if "?nz \<noteq> []"
+      by (smt that A assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
+    have e_r1: "echelon_form_JNF A" if nz_empty: "?nz = []" 
+    proof (rule echelon_form_JNF_mx1[OF A])
+      show "\<forall>i\<in>{1..<m}. A $$ (i, 0) = 0 " using nz_empty
+        by (metis (mono_tags, lifting) A carrier_matD(1) empty_filter_conv set_upt)
+    qed (insert n1, simp)
+    have e_inv1: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> A = P * A"
+      by (metis A invertible_mat_one left_mult_one_mat one_carrier_mat)
+    have "FindPreHNF_rectangular A = (if ?nz = [] then A else reduce_below_impl 0 ?nz 0 ?A')"
+      unfolding FindPreHNF_rectangular_def Let_def using m1 n1 A True by auto
+    also have "reduce_below_impl 0 ?nz 0 ?A' = reduce_below 0 ?nz 0 ?A'"
+      by (rule reduce_below_impl[OF _ _ _ _ A'], insert m1 n0 A, auto)
+    finally show ?thesis using e_inv e_r e_r1 e_inv1 by metis
+  next
+    case False
+    have f_rw: "FindPreHNF_rectangular A = echelon_form_of_JNF A euclid_ext2"
+      unfolding FindPreHNF_rectangular_def Let_def using m1 n0 A False by auto
+    show ?thesis unfolding f_rw 
+      by (rule echelon_form_of_euclidean_invertible'[OF A], insert False n0 m1, auto)
+  qed
+qed
+
+lemma HNF_algorithm_from_HA_soundness:
+  assumes A: "A \<in> carrier_mat m n"
+  shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm_from_HA A)
+    \<and> (\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm_from_HA A) = P * A)"
+proof -
+  have m: "dim_row A = m" using A by auto
+  have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm_from_HA A) = P * (FindPreHNF_rectangular A))"
+    unfolding HNF_algorithm_from_HA_def m
+  proof (rule invertible_Hermite_of_list_of_rows)
+    show "FindPreHNF_rectangular A \<in> carrier_mat m n"
+      by (smt A FindPreHNF_rectangular_soundness mult_carrier_mat)
+    show "echelon_form_JNF (FindPreHNF_rectangular A)" 
+      using FindPreHNF_rectangular_soundness by blast
+  qed
+  moreover have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (FindPreHNF_rectangular A) = P * A)"    
+    by (metis A FindPreHNF_rectangular_soundness)
+  ultimately have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm_from_HA A) = P * A)"
+    by (smt assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
+  moreover have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm_from_HA A)"
+    by (metis A FindPreHNF_rectangular_soundness HNF_algorithm_from_HA_def m 
+        Hermite_Hermite_of_list_of_rows mult_carrier_mat)
+  ultimately show ?thesis by simp
+qed
+
+
+text \<open>Soundness theorem for any matrix\<close>
+lemma HNF_algorithm_soundness:
+  assumes A: "A \<in> carrier_mat m n"
+  shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm abs_flag A)
+    \<and> (\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm abs_flag A) = P * A)"
+proof (cases "m\<noteq>n \<or> Determinant.det A = 0")
+  case True
+  have H_rw: "HNF_algorithm abs_flag A = Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<m]"
+    using True A unfolding HNF_algorithm_def Let_def by auto
+  have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm abs_flag A) = P * (FindPreHNF_rectangular A))"
+    unfolding H_rw
+  proof (rule invertible_Hermite_of_list_of_rows)
+    show "FindPreHNF_rectangular A \<in> carrier_mat m n"
+      by (smt A FindPreHNF_rectangular_soundness mult_carrier_mat)
+    show "echelon_form_JNF (FindPreHNF_rectangular A)" 
+      using FindPreHNF_rectangular_soundness by blast
+  qed
+  moreover have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (FindPreHNF_rectangular A) = P * A)"    
+    by (metis A FindPreHNF_rectangular_soundness)
+  ultimately have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm abs_flag A) = P * A)"
+    by (smt assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
+  moreover have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm abs_flag A)"
+    by (metis A FindPreHNF_rectangular_soundness H_rw Hermite_Hermite_of_list_of_rows mult_carrier_mat)
+  ultimately show ?thesis by simp
+next
+  case False
+  hence mn: "m=n" and det_A_not0:"(Determinant.det A) \<noteq> 0" by auto
+  have inv_RAT_A: "invertible_mat (map_mat rat_of_int A)"
+  proof -
+    have "det (map_mat rat_of_int A) \<noteq> 0" using det_A_not0 by auto
+    thus ?thesis 
+      by (metis False assms dvd_field_iff invertible_iff_is_unit_JNF map_carrier_mat)
+  qed
+  have "HNF_algorithm abs_flag A = Hermite_mod_det abs_flag A"
+    unfolding HNF_algorithm_def Hermite_mod_det_def Let_def using False A by simp    
+  then show ?thesis using Hermite_mod_det_soundness[OF mn A inv_RAT_A] by auto
+qed
+end
+
+
+text \<open>New predicate of soundness of a HNF algorithm, without providing explicitly the transformation matrix.\<close>
+
+definition "is_sound_HNF' algorithm associates res 
+    = (\<forall>A. let H = algorithm A; m = dim_row A; n = dim_col A in Hermite_JNF associates res H 
+        \<and> H \<in> carrier_mat m n \<and> (\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> A = P * H))"
+
+lemma is_sound_HNF_conv:
+  assumes s: "is_sound_HNF' algorithm associates res"
+  shows "is_sound_HNF (\<lambda>A. let H = algorithm A in (SOME P. P \<in> carrier_mat (dim_row A) (dim_row A)
+    \<and> invertible_mat P \<and> A = P * H, H)) associates res"
+proof (unfold is_sound_HNF_def Let_def prod.case, rule allI)
+  fix A::"'a mat"
+  define m where "m = dim_row A"
+  obtain P where P: "P \<in> carrier_mat m m \<and> invertible_mat P \<and> A = P * (algorithm A)" 
+    using s unfolding is_sound_HNF'_def Let_def m_def by auto
+  let ?some_P = "(SOME P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> A = P * algorithm A)"
+  have some_P: "?some_P \<in> carrier_mat m m \<and> invertible_mat ?some_P \<and> A = ?some_P * algorithm A"
+    by (smt P verit_sko_ex_indirect)
+  moreover have "algorithm A \<in> carrier_mat (dim_row A) (dim_col A)"
+    and  "Hermite_JNF associates res (algorithm A)" using s unfolding is_sound_HNF'_def Let_def by auto    
+  ultimately show "?some_P \<in> carrier_mat m m \<and> algorithm A \<in> carrier_mat m (dim_col A) 
+    \<and> invertible_mat ?some_P \<and> A = ?some_P * algorithm A \<and> Hermite_JNF associates res (algorithm A)"
+    unfolding is_sound_HNF_def Let_def m_def by (auto split: prod.split)
+qed
+
+context proper_mod_operation
+begin
+corollary is_sound_HNF'_HNF_algorithm:
+   "is_sound_HNF' (HNF_algorithm abs_flag) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
+proof -
+  have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm abs_flag A)" for A
+    using HNF_algorithm_soundness by blast
+  moreover have "HNF_algorithm abs_flag A \<in> carrier_mat (dim_row A) (dim_col A)" for A
+    by (metis HNF_algorithm_soundness carrier_matI mult_carrier_mat)
+  moreover have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> A = P * HNF_algorithm abs_flag A" for A 
+  proof -
+    have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> HNF_algorithm abs_flag A = P *  A"
+      using HNF_algorithm_soundness by blast
+    from this obtain P where P: "P \<in> carrier_mat (dim_row A) (dim_row A)" and inv_P: "invertible_mat P"
+      and H_PA: "HNF_algorithm abs_flag A = P *  A" by blast
+    obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
+      using inv_P unfolding invertible_mat_def by auto
+    have P': "P' \<in> carrier_mat (dim_row A) (dim_row A) "
+      by (metis P PP' P'P carrier_matD carrier_mat_triv index_mult_mat(3) index_one_mat(3) inverts_mat_def)
+    moreover have inv_P': "invertible_mat P'"
+      by (metis P' P'P PP' carrier_matD(1) carrier_matD(2) invertible_mat_def square_mat.simps)
+    moreover have "A = P' * HNF_algorithm abs_flag A"
+      by (smt H_PA P P'P assoc_mult_mat calculation(1) carrier_matD(1) carrier_matI inverts_mat_def left_mult_one_mat')
+    ultimately show ?thesis by auto
+  qed
+  ultimately show ?thesis
+    unfolding is_sound_HNF'_def Let_def by auto
+qed
+
+
+corollary is_sound_HNF'_HNF_algorithm_from_HA:
+   "is_sound_HNF' (HNF_algorithm_from_HA) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
+proof -
+  have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm_from_HA A)" for A
+    using HNF_algorithm_from_HA_soundness by blast
+  moreover have "HNF_algorithm_from_HA A \<in> carrier_mat (dim_row A) (dim_col A)" for A
+    by (metis HNF_algorithm_from_HA_soundness carrier_matI mult_carrier_mat)
+  moreover have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> A = P * HNF_algorithm_from_HA A" for A 
+  proof -
+    have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> HNF_algorithm_from_HA A = P *  A"
+      using HNF_algorithm_from_HA_soundness by blast
+    from this obtain P where P: "P \<in> carrier_mat (dim_row A) (dim_row A)" and inv_P: "invertible_mat P"
+      and H_PA: "HNF_algorithm_from_HA A = P *  A" by blast
+    obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
+      using inv_P unfolding invertible_mat_def by auto
+    have P': "P' \<in> carrier_mat (dim_row A) (dim_row A) "
+      by (metis P PP' P'P carrier_matD carrier_mat_triv index_mult_mat(3) index_one_mat(3) inverts_mat_def)
+    moreover have inv_P': "invertible_mat P'"
+      by (metis P' P'P PP' carrier_matD(1) carrier_matD(2) invertible_mat_def square_mat.simps)
+    moreover have "A = P' * HNF_algorithm_from_HA A"
+      by (smt H_PA P P'P assoc_mult_mat calculation(1) carrier_matD(1) carrier_matI inverts_mat_def left_mult_one_mat')
+    ultimately show ?thesis by auto
+  qed
+  ultimately show ?thesis
+    unfolding is_sound_HNF'_def Let_def by auto
+qed
+end
+
+text \<open>Some work to make the algorithm executable\<close>
+
+definition find_non0' :: "nat \<Rightarrow> nat \<Rightarrow> 'a::comm_ring_1 mat \<Rightarrow> nat option" where
+  "find_non0' i k A = (let is = [i ..< dim_row A];
+    Ais = filter (\<lambda>j. A $$ (j, k) \<noteq> 0) is
+    in case Ais of [] \<Rightarrow> None | _ \<Rightarrow> Some (Ais!0))"
+
+lemma find_non0': 
+  assumes A: "A \<in> carrier_mat m n"
+  and res: "find_non0' i k A = Some j"
+  shows "A $$ (j,k) \<noteq> 0" "i \<le> j" "j < dim_row A"
+proof -
+  let ?xs = "filter (\<lambda>j. A $$ (j,k) \<noteq> 0) [i ..< dim_row A]"
+  from res[unfolded find_non0'_def Let_def]
+  have xs: "?xs \<noteq> []" by (cases ?xs, auto)
+  have j_in_xs: "j \<in> set ?xs" using res unfolding find_non0'_def Let_def
+    by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
+  show "A $$ (j,k) \<noteq> 0" "i \<le> j" "j < dim_row A" using j_in_xs by auto+  
+qed
+
+
+lemma find_non0'_w_zero_before: 
+  assumes A: "A \<in> carrier_mat m n"
+  and res: "find_non0' i k A = Some j"
+  shows "\<forall>j'\<in>{i..<j}. A $$ (j',k) = 0"
+proof -
+  let ?xs = "filter (\<lambda>j. A $$ (j, k) \<noteq> 0) [i ..< dim_row A]"
+  from res[unfolded find_non0'_def Let_def]
+  have xs: "?xs \<noteq> []" by (cases ?xs, auto)
+  have j_in_xs: "j \<in> set ?xs" using res unfolding find_non0'_def Let_def
+    by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
+  have j_xs0: "j = ?xs ! 0"
+    by (smt res[unfolded find_non0'_def Let_def] list.case(2) list.exhaust option.inject xs)
+  show "\<forall>j'\<in>{i..<j}. A $$ (j',k) = 0"
+  proof (rule+, rule ccontr)
+    fix j' assume j': "j' : {i..<j}" and Alj': "A $$ (j',k) \<noteq> 0"
+    have j'j: "j'<j" using j' by auto
+    have j'_in_xs: "j' \<in> set ?xs" 
+      by (metis (mono_tags, lifting) A Alj' Set.member_filter atLeastLessThan_iff filter_set
+          find_non0'(3) j' nat_SN.gt_trans res set_upt)
+    have l_rw: "[i..<dim_row A] = [i ..<j] @[j..<dim_row A]"
+      using assms(1) assms(2) find_non0'(3) j' upt_append 
+      by (metis atLeastLessThan_iff le_trans linorder_not_le) 
+    have xs_rw: "?xs = filter (\<lambda>j. A $$ (j,k) \<noteq> 0) ([i ..<j] @[j..<dim_row A])"
+      using l_rw by auto
+    hence "filter (\<lambda>j. A $$ (j,k) \<noteq> 0) [i ..<j] = []" using j_xs0 
+      by (metis (no_types, lifting) Set.member_filter atLeastLessThan_iff filter_append filter_set
+          length_greater_0_conv nth_append nth_mem order_less_irrefl set_upt)
+    thus False using j_xs0 j' j_xs0 
+      by (metis Set.member_filter filter_empty_conv filter_set j'_in_xs set_upt)
+  qed
+qed
+
+
+lemma find_non0'_LEAST: 
+  assumes A: "A \<in> carrier_mat m n"
+  and res: "find_non0' i k A = Some j"
+shows "j = (LEAST n. A $$ (n,k) \<noteq> 0 \<and> i\<le>n)"
+proof (rule Least_equality[symmetric])
+  show " A $$ (j, k) \<noteq> 0 \<and> i \<le> j" 
+    using A res find_non0'[OF A] by auto
+  show " \<And>y. A $$ (y, k) \<noteq> 0 \<and> i \<le> y \<Longrightarrow> j \<le> y"
+    by (meson A res atLeastLessThan_iff find_non0'_w_zero_before linorder_not_le)
+qed
+
+lemma echelon_form_of_column_k_JNF_code[code]:
+  "echelon_form_of_column_k_JNF bezout (A,i) k = 
+    (if (i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0) then (A, i) else 
+        if (\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0) then (A, i + 1) else
+            let n = the (find_non0' i k A); 
+                interchange_A = swaprows i n A
+           in
+            (bezout_iterate_JNF (interchange_A) (dim_row A - 1) i k bezout, i + 1))"
+proof (cases "\<not> ((i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0)) 
+            \<and> \<not> (\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0)")
+  case True
+  let ?n = "the (find_non0' i k A)"
+  let ?interchange_A = "swaprows i ?n A"
+  have f_rw: "(the (find_non0' i k A)) = (LEAST n. A $$ (n, k) \<noteq> 0 \<and> i \<le> n)"
+  proof (rule find_non0'_LEAST)
+    have "find_non0' i k A \<noteq> None" using True unfolding find_non0'_def Let_def
+      by (auto split: list.split)
+         (metis (mono_tags, lifting) atLeastLessThan_iff atLeastLessThan_upt empty_filter_conv)
+    thus "find_non0' i k A = Some (the (find_non0' i k A))" by auto
+  qed (auto)
+  show ?thesis unfolding echelon_form_of_column_k_JNF_def Let_def f_rw using True by auto
+next
+  case False
+  then show ?thesis unfolding echelon_form_of_column_k_JNF_def by auto
+qed
+
+
+subsection \<open>Instantiation of the HNF-algorithm with modulo-operation\<close>
+
+text \<open>We currently use a Boolean flag to indicate whether standard-mod or symmetric modulo
+  should be used.\<close>
+
+lemma sym_mod: "proper_mod_operation sym_mod sym_div" 
+  by (unfold_locales, auto simp: sym_mod_sym_div)
+
+lemma standard_mod: "proper_mod_operation (mod) (div)" 
+  by (unfold_locales, auto, intro HOL.nitpick_unfold(7))
+
+definition HNF_algorithm :: "bool \<Rightarrow> int mat \<Rightarrow> int mat" where
+  "HNF_algorithm use_sym_mod = (if use_sym_mod 
+    then mod_operation.HNF_algorithm sym_mod False else mod_operation.HNF_algorithm (mod) True)" 
+
+definition HNF_algorithm_from_HA :: "bool \<Rightarrow> int mat \<Rightarrow> int mat" where
+  "HNF_algorithm_from_HA use_sym_mod = (if use_sym_mod 
+    then mod_operation.HNF_algorithm_from_HA sym_mod else mod_operation.HNF_algorithm_from_HA (mod))"
+
+
+corollary is_sound_HNF'_HNF_algorithm:
+   "is_sound_HNF' (HNF_algorithm use_sym_mod) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
+  using proper_mod_operation.is_sound_HNF'_HNF_algorithm[OF sym_mod]
+    proper_mod_operation.is_sound_HNF'_HNF_algorithm[OF standard_mod]
+  unfolding HNF_algorithm_def by (cases use_sym_mod, auto)
+
+corollary is_sound_HNF'_HNF_algorithm_from_HA:
+   "is_sound_HNF' (HNF_algorithm_from_HA use_sym_mod) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
+  using proper_mod_operation.is_sound_HNF'_HNF_algorithm_from_HA[OF sym_mod]
+    proper_mod_operation.is_sound_HNF'_HNF_algorithm_from_HA[OF standard_mod]
+  unfolding HNF_algorithm_from_HA_def by (cases use_sym_mod, auto)
+
+
+(*Examples:*)
+(*Rectangular matrix (6x4)*)
+value [code]"let A = mat_of_rows_list 4 (
+  [[0,3,1,4],
+   [7,1,0,0],
+   [8,0,19,16],
+   [2,0,0,3::int],
+   [9,-3,2,5],
+   [6,3,2,4]]) in
+  show (HNF_algorithm True A)"
+
+(*Rectangular matrix (4x6)*)
+
+value [code]"let A = mat_of_rows_list 6 (
+  [[0,3,1,4,8,7],
+   [7,1,0,0,4,1],
+   [8,0,19,16,33,5],
+   [2,0,0,3::int,-5,8]]) in
+  show (HNF_algorithm False A)"
+
+(*Singular matrix*)
+value [code]"let A = mat_of_rows_list 6 (
+  [[0,3,1,4,8,7],
+   [7,1,0,0,4,1],
+   [8,0,19,16,33,5],
+   [0,3,1,4,8,7],
+   [2,0,0,3::int,-5,8],
+   [2,4,6,8,10,12]]) in
+  show (Determinant.det A, HNF_algorithm True A)"
+
+(*Invertible matrix*)
+value [code]"let A = mat_of_rows_list 6 (
+  [[0,3,1,4,8,7],
+   [7,1,0,0,4,1],
+   [8,0,19,16,33,5],
+   [5,6,1,2,8,7],
+   [2,0,0,3::int,-5,8],
+   [2,4,6,8,10,12]]) in
+  show (Determinant.det A, HNF_algorithm True A)"
+
+end
\ No newline at end of file
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/LLL_Certification_via_HNF.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/LLL_Certification_via_HNF.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/LLL_Certification_via_HNF.thy
@@ -0,0 +1,424 @@
+section \<open>LLL certification via Hermite normal forms\<close>
+
+text \<open>In this file, we define the new certified approach and prove its soundness.\<close>
+
+theory LLL_Certification_via_HNF
+  imports 
+   LLL_Basis_Reduction.LLL_Certification
+   Jordan_Normal_Form.DL_Rank
+   HNF_Mod_Det_Soundness
+begin
+
+
+context LLL_with_assms
+begin
+
+lemma m_le_n: "m\<le>n"
+proof -
+  have "gs.lin_indpt (set (RAT fs_init))"
+    using cof_vec_space.lin_indpt_list_def lin_dep by blast
+  moreover have "gs.dim = n"
+    by (simp add: gs.dim_is_n)
+  moreover have "card (set (RAT fs_init)) = m"
+    using LLL_invD(2) LLL_inv_initial_state cof_vec_space.lin_indpt_list_def distinct_card lin_dep
+    by blast
+  ultimately show ?thesis using gs.li_le_dim 
+    by (metis cof_vec_space.lin_indpt_list_def gs.fin_dim lin_dep)
+qed
+
+end
+
+text \<open>This lemma is a generalization of the theorem named @{text "HNF_A_eq_HNF_PA"}, using
+the new uniqueness statement of the HNF. We provide two versions, one
+assuming the existence and the other one obtained from a sound algorithm.\<close>
+
+lemma HNF_A_eq_HNF_PA'_exist:
+  fixes A::"int mat"
+  assumes A: "A \<in> carrier_mat n n" and inv_A: "invertible_mat (map_mat rat_of_int A)" 
+    and inv_P: "invertible_mat P" and P: "P \<in> carrier_mat n n"
+    and HNF_H1: "Hermite_JNF associates res H1"
+    and H1: "H1 \<in> carrier_mat n n"
+    and HNF_H2: "Hermite_JNF associates res H2"
+    and H2: "H2 \<in> carrier_mat n n"
+    and sound_HNF1: "\<exists>P1. P1 \<in> carrier_mat n n \<and> invertible_mat P1 \<and> (P * A) = P1 * H1"
+    and sound_HNF2: "\<exists>P2. P2 \<in> carrier_mat n n \<and> invertible_mat P2 \<and> A = P2 * H2"
+  shows "H1 = H2"
+proof -
+  obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P"
+    and inv_P: "inv_P \<in> carrier_mat n n"
+    using P inv_P obtain_inverse_matrix by blast
+  obtain P1 where P1: "P1 \<in> carrier_mat n n" and inv_P1: "invertible_mat P1" and P1_H1: "P* A = P1 * H1"
+    using sound_HNF1 by auto
+  obtain P2 where P2: "P2 \<in> carrier_mat n n" and inv_P2: "invertible_mat P2" and P2_H2: "A = P2 * H2"
+    using sound_HNF2 by auto
+  have invertible_inv_P: "invertible_mat inv_P"
+      using P_inv_P inv_P inv_P_P invertible_mat_def square_mat.simps by blast
+  have P_A_P1_H1: "P * A = P1 * H1" using P1_H1 P2_H2 unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) case_prod_conv)
+  hence "A = inv_P * (P1 * H1)"
+    by (smt A P inv_P_P inv_P assoc_mult_mat carrier_matD(1) inverts_mat_def left_mult_one_mat)
+  hence A_inv_P_P1_H1: "A = (inv_P * P1) * H1" using P P1_H1 assoc_mult_mat inv_P H1 P1 by auto
+  have invertible_inv_P_P1: "invertible_mat (inv_P * P1)"
+    by (rule invertible_mult_JNF[OF inv_P P1 invertible_inv_P inv_P1])   
+  show ?thesis
+  proof (rule HNF_unique_generalized_JNF[OF A _ H1 P2 H2 A_inv_P_P1_H1 P2_H2 
+        inv_A invertible_inv_P_P1 inv_P2 HNF_H1 HNF_H2])
+    show "inv_P * P1 \<in> carrier_mat n n"
+      by (metis carrier_matD(1) carrier_matI index_mult_mat(2) inv_P
+          invertible_inv_P_P1 invertible_mat_def square_mat.simps)    
+  qed
+qed
+
+
+corollary HNF_A_eq_HNF_PA':
+  fixes A::"int mat"
+  assumes A: "A \<in> carrier_mat n n" and inv_A: "invertible_mat (map_mat rat_of_int A)" 
+    and inv_P: "invertible_mat P" and P: "P \<in> carrier_mat n n"
+    and sound_HNF: "is_sound_HNF HNF associates res"
+    and P1_H1: "(P1,H1) = HNF (P*A)"
+    and P2_H2: "(P2,H2) = HNF A"
+  shows "H1 = H2" 
+proof -
+  have H1: "H1 \<in> carrier_mat n n"
+    by (smt P1_H1 A P carrier_matD index_mult_mat is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+  have H2: "H2 \<in> carrier_mat n n"
+    by (smt P2_H2 A carrier_matD index_mult_mat is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+  have HNF_H1: "Hermite_JNF associates res H1" 
+    by (smt P1_H1 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+  have HNF_H2: "Hermite_JNF associates res H2"
+    by (smt P2_H2 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
+  have sound_HNF1: "\<exists>P1. P1 \<in> carrier_mat n n \<and> invertible_mat P1 \<and> (P * A) = P1 * H1"
+    using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) P carrier_matD(1) index_mult_mat(2) old.prod.simps(2))
+  have sound_HNF2: "\<exists>P2. P2 \<in> carrier_mat n n \<and> invertible_mat P2 \<and> A = P2 * H2"
+    using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
+    by (metis (mono_tags, lifting) A P2_H2 carrier_matD(1) old.prod.simps(2))
+  show ?thesis 
+    by (rule HNF_A_eq_HNF_PA'_exist[OF A inv_A inv_P P HNF_H1 H1 HNF_H2 H2 sound_HNF1 sound_HNF2])
+qed
+
+
+context LLL_with_assms
+begin
+
+
+lemma certification_via_eq_HNF2_exist:
+  assumes HNF_H1: "Hermite_JNF associates res H1"
+    and H1: "H1 \<in> carrier_mat n n"
+    and HNF_H2: "Hermite_JNF associates res H2"
+    and H2: "H2 \<in> carrier_mat n n"
+    and sound_HNF1: "\<exists>P1. P1 \<in> carrier_mat n n \<and> invertible_mat P1 \<and> (mat_of_rows n fs_init) = P1 * H1"
+    and sound_HNF2: "\<exists>P2. P2 \<in> carrier_mat n n \<and> invertible_mat P2 \<and> (mat_of_rows n gs) = P2 * H2"
+    and gs: "set gs \<subseteq> carrier_vec n" 
+    and l: "lattice_of fs_init = lattice_of gs"
+    and mn: "m = n" and len_gs: "length gs = n" (*For the moment, only for square matrices*)
+  shows "H1 = H2"
+proof -
+  have "\<exists>P \<in> carrier_mat n n. invertible_mat P \<and> mat_of_rows n fs_init = P * mat_of_rows n gs"    
+    by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init gs lin_dep len[unfolded mn] len_gs l])
+  from this obtain P where P: "P \<in> carrier_mat n n" and inv_P: "invertible_mat P"
+    and fs_P_gs: "mat_of_rows n fs_init = P * mat_of_rows n gs" by auto
+   obtain P1 where P1: "P1 \<in> carrier_mat n n" and inv_P1: "invertible_mat P1" and P1_H1: "(mat_of_rows n fs_init) = P1 * H1"
+    using sound_HNF1 by auto
+  obtain P2 where P2: "P2 \<in> carrier_mat n n" and inv_P2: "invertible_mat P2" and P2_H2: "(mat_of_rows n gs) = P2 * H2"
+    using sound_HNF2 by auto
+  have P1_H1_2: "P * mat_of_rows n gs = P1 * H1"
+    using P1_H1 fs_P_gs by auto
+  have gs_carrier: "mat_of_rows n gs \<in> carrier_mat n n" by (simp add: len_gs carrier_matI)
+  show ?thesis
+  proof (rule HNF_A_eq_HNF_PA'_exist[OF gs_carrier _ inv_P P HNF_H1 H1 HNF_H2 H2 _ sound_HNF2])
+    from inv_P obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
+      using invertible_mat_def by blast
+    let ?RAT = "of_int_hom.mat_hom :: int mat \<Rightarrow> rat mat"
+    have det_RAT_fs_init: "det (?RAT (mat_of_rows n fs_init)) \<noteq> 0"
+    proof (rule gs.lin_indpt_rows_imp_det_not_0)
+      show "?RAT (mat_of_rows n fs_init) \<in> carrier_mat n n"
+        using len map_carrier_mat mat_of_rows_carrier(1) mn by blast
+      have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init"
+        by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows)
+      thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" 
+        by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def)
+      show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))"
+        using rw cof_vec_space.lin_indpt_list_def lin_dep by auto
+    qed
+    hence d: "det (?RAT (mat_of_rows n fs_init)) dvd 1" using dvd_field_iff by blast
+    hence inv_RAT_fs_init: "invertible_mat (?RAT (mat_of_rows n fs_init))"
+      using invertible_iff_is_unit_JNF by (metis mn len map_carrier_mat mat_of_rows_carrier(1))
+    have "invertible_mat (?RAT P)"
+      by (metis P dvd_field_iff inv_P invertible_iff_is_unit_JNF map_carrier_mat 
+          not_is_unit_0 of_int_hom.hom_0 of_int_hom.hom_det)
+    have "det (?RAT (mat_of_rows n fs_init)) = det (?RAT P) * det (?RAT (mat_of_rows n gs))"
+      by (metis Determinant.det_mult P fs_P_gs gs_carrier of_int_hom.hom_det of_int_hom.hom_mult)
+    hence "det (?RAT (mat_of_rows n gs)) \<noteq> 0" using d by auto 
+    thus "invertible_mat (?RAT (mat_of_rows n gs))"
+      by (meson dvd_field_iff gs_carrier invertible_iff_is_unit_JNF map_carrier_mat)
+    show "\<exists>P1. P1 \<in> carrier_mat n n \<and> invertible_mat P1 \<and> P * mat_of_rows n gs = P1 * H1"
+      using P1 P1_H1_2 inv_P1 by blast
+  qed
+qed
+
+lemma certification_via_eq_HNF2:
+  assumes sound_HNF: "is_sound_HNF HNF associates res"
+    and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)"
+    and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)"    
+    and gs: "set gs \<subseteq> carrier_vec n" 
+    and l: "lattice_of fs_init = lattice_of gs"
+    and mn: "m = n" and len_gs: "length gs = n" (*For the moment, only for square matrices*)
+  shows "H1 = H2"
+proof -
+  have "\<exists>P \<in> carrier_mat n n. invertible_mat P \<and> mat_of_rows n fs_init = P * mat_of_rows n gs"    
+    by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init gs lin_dep len[unfolded mn] len_gs l])
+  from this obtain P where P: "P \<in> carrier_mat n n" and inv_P: "invertible_mat P"
+    and fs_P_gs: "mat_of_rows n fs_init = P * mat_of_rows n gs" by auto
+  have P1_H1_2: "(P1,H1) = HNF (P * mat_of_rows n gs)" using fs_P_gs P1_H1 by auto  
+  have gs_carrier: "mat_of_rows n gs \<in> carrier_mat n n" by (simp add: len_gs carrier_matI)
+  show ?thesis
+  proof (rule HNF_A_eq_HNF_PA'[OF gs_carrier _ inv_P P sound_HNF P1_H1_2 P2_H2])
+    from inv_P obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
+      using invertible_mat_def by blast
+    let ?RAT = "of_int_hom.mat_hom :: int mat \<Rightarrow> rat mat"
+    have det_RAT_fs_init: "det (?RAT (mat_of_rows n fs_init)) \<noteq> 0"
+    proof (rule gs.lin_indpt_rows_imp_det_not_0)
+      show "?RAT (mat_of_rows n fs_init) \<in> carrier_mat n n"
+        using len map_carrier_mat mat_of_rows_carrier(1) mn by blast
+      have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init"
+        by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows)
+      thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" 
+        by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def)
+      show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))"
+        using rw cof_vec_space.lin_indpt_list_def lin_dep by auto
+    qed
+    hence d: "det (?RAT (mat_of_rows n fs_init)) dvd 1" using dvd_field_iff by blast
+    hence inv_RAT_fs_init: "invertible_mat (?RAT (mat_of_rows n fs_init))"
+      using invertible_iff_is_unit_JNF by (metis mn len map_carrier_mat mat_of_rows_carrier(1))
+    have "invertible_mat (?RAT P)"
+      by (metis P dvd_field_iff inv_P invertible_iff_is_unit_JNF map_carrier_mat 
+          not_is_unit_0 of_int_hom.hom_0 of_int_hom.hom_det)
+    have "det (?RAT (mat_of_rows n fs_init)) = det (?RAT P) * det (?RAT (mat_of_rows n gs))"
+      by (metis Determinant.det_mult P fs_P_gs gs_carrier of_int_hom.hom_det of_int_hom.hom_mult)
+    hence "det (?RAT (mat_of_rows n gs)) \<noteq> 0" using d by auto 
+    thus "invertible_mat (?RAT (mat_of_rows n gs))"
+      by (meson dvd_field_iff gs_carrier invertible_iff_is_unit_JNF map_carrier_mat)
+  qed
+qed
+
+
+corollary lattice_of_eq_via_HNF:
+  assumes sound_HNF: "is_sound_HNF HNF associates res"
+    and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)"
+    and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)"    
+    and gs: "set gs \<subseteq> carrier_vec n"     
+    and mn: "m = n" and len_gs: "length gs = n"
+  shows "(H1 = H2) \<longleftrightarrow> (lattice_of fs_init = lattice_of gs)"
+  using certification_via_eq_HNF certification_via_eq_HNF2 assms by metis
+end
+
+
+
+context
+begin
+
+interpretation vec_module "TYPE(int)" n .
+
+lemma lattice_of_eq_via_HNF_paper:
+  fixes F G :: "int mat" and HNF :: "int mat \<Rightarrow> int mat"
+  assumes sound_HNF': "is_sound_HNF' HNF \<A> \<R>" (* HNF is a sound algorithm *)  
+    and inv_F_Q: "invertible_mat (map_mat rat_of_int F)" (* invertible over Q *)
+    and FG: "{F,G} \<subseteq> carrier_mat n n"
+  shows "(HNF F = HNF G) \<longleftrightarrow> (lattice_of (rows F) = lattice_of (rows G))"
+proof -
+  define HNF' 
+    where "HNF' = (\<lambda>A. let H = HNF A 
+    in (SOME P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> A = P * H, H))"
+  have sound_HNF': "is_sound_HNF HNF' \<A> \<R>" by (unfold HNF'_def, rule is_sound_HNF_conv[OF sound_HNF'])
+  have F_eq: "F = mat_of_rows n (rows F)" and G_eq: "G = mat_of_rows n (rows G)"
+    using FG by auto
+  interpret L: LLL_with_assms n n "(rows F)" "4/3"
+  proof 
+    interpret gs: cof_vec_space n "TYPE(rat)" .
+    thm gs.upper_triangular_imp_lin_indpt_rows
+  let ?RAT ="map_mat rat_of_int"
+    have m_rw: "(map (map_vec rat_of_int) (rows F)) = rows (?RAT F)"
+      unfolding Matrix.rows_def by auto
+    show "gs.lin_indpt_list (map (map_vec rat_of_int) (rows F))"
+    proof -
+      have det_RAT_F: "det (?RAT F) \<noteq> 0"         
+        by (metis inv_F_Q carrier_mat_triv invertible_iff_is_unit_JNF 
+            invertible_mat_def not_is_unit_0 square_mat.simps)
+      have d_RAT_F: "distinct (rows (?RAT F))"
+      proof (rule ccontr)
+        assume "\<not> distinct (rows (?RAT F))" 
+        from this obtain i j 
+          where ij: "row (?RAT F) i = row (?RAT F) j"
+            and i: "i<dim_row (?RAT F)" and j: "j<dim_row (?RAT F)" 
+            and i_not_j: "i\<noteq>j"
+          unfolding Matrix.rows_def distinct_conv_nth by auto
+        have "det (?RAT F) = 0" using ij i j i_not_j
+          by (metis Determinant.det_def Determinant.det_identical_rows carrier_mat_triv)
+        thus False using inv_F_Q
+          by (metis carrier_mat_triv invertible_iff_is_unit_JNF invertible_mat_def 
+              not_is_unit_0 square_mat.simps)
+      qed     
+      moreover have "\<not> gs.lin_dep (set (rows (?RAT F)))"
+        using gs.det_not_0_imp_lin_indpt_rows[OF _ det_RAT_F] using FG by auto
+      ultimately show ?thesis
+        unfolding gs.lin_indpt_list_def m_rw using FG unfolding Matrix.rows_def by auto      
+    qed 
+  qed (insert FG F_eq, auto)
+  show ?thesis 
+  proof (rule L.lattice_of_eq_via_HNF[OF sound_HNF'])
+    show "(fst (HNF' F), HNF F) = HNF' (mat_of_rows n (rows F))" 
+      unfolding HNF'_def Let_def using F_eq by auto
+    show "(fst (HNF' G), HNF G) = HNF' (mat_of_rows n (rows G))" 
+      unfolding HNF'_def Let_def using G_eq by auto
+    show "length (rows G) = n " using FG by auto
+    show "set (rows G) \<subseteq> carrier_vec n" using FG
+      by (metis G_eq mat_of_rows_carrier(3) rows_carrier)
+  qed (simp)
+qed
+end
+
+text \<open>We define a new const similar to @{text "external_lll_solver"},
+but now it only returns the reduced matrix.\<close>
+
+consts external_lll_solver' :: "integer \<times> integer \<Rightarrow> integer list list \<Rightarrow> integer list list" 
+
+hide_type (open) Finite_Cartesian_Product.vec
+
+
+text \<open>The following definition is an adaptation of @{text "reduce_basis_external"}\<close>
+
+definition reduce_basis_external' :: "(int mat \<Rightarrow> int mat) \<Rightarrow> rat \<Rightarrow> int vec list \<Rightarrow> int vec list" where
+  "reduce_basis_external' HNF \<alpha> fs = (case fs of Nil \<Rightarrow> [] | Cons f _ \<Rightarrow> (let 
+    rb = reduce_basis \<alpha>;
+    fsi = map (map integer_of_int o list_of_vec) fs;
+    n = dim_vec f;
+    m = length fs;
+    gsi = external_lll_solver' (map_prod integer_of_int integer_of_int (quotient_of \<alpha>)) fsi;
+    gs = (map (vec_of_list o map int_of_integer) gsi) in
+    if \<not> (length gs = m \<and> (\<forall> gi \<in> set gs. dim_vec gi = n)) then
+      Code.abort (STR ''error in external LLL invocation: dimensions of reduced basis do not fit\<newline>input to external solver: ''
+        + String.implode (show fs) + STR ''\<newline>\<newline>'') (\<lambda> _. rb fs)
+     else 
+      let Fs = mat_of_rows n fs;
+          Gs = mat_of_rows n gs;
+          H1 = HNF Fs;
+          H2 = HNF Gs in 
+           if (H1 = H2) then rb gs 
+          else Code.abort (STR ''the reduced matrix does not span the same lattice\<newline>f,g,P1,P2,H1,H2 are as follows\<newline>''
+            + String.implode (show Fs) + STR ''\<newline>\<newline>''
+            + String.implode (show Gs) + STR ''\<newline>\<newline>''
+            + String.implode (show H1) + STR ''\<newline>\<newline>''
+            + String.implode (show H2) + STR ''\<newline>\<newline>''
+            ) (\<lambda> _. rb fs))
+    )" 
+
+locale certification = LLL_with_assms +
+  fixes HNF::"int mat \<Rightarrow> int mat" and associates res (*HNF operation without explicit transformation matrix*)
+  assumes sound_HNF': "is_sound_HNF' HNF associates res"
+begin
+
+lemma reduce_basis_external': assumes res: "reduce_basis_external' HNF \<alpha> fs_init = fs" 
+  shows "reduced fs m" "LLL_invariant True m fs" 
+proof (atomize(full), goal_cases)
+  case 1
+  show ?case
+  proof (cases "LLL_Impl.reduce_basis \<alpha> fs_init = fs")
+    case True   
+    from reduce_basis[OF this] show ?thesis by simp
+  next
+    case False note a = False
+    show ?thesis
+    proof (cases fs_init)
+      case Nil
+      with res have "fs = []" unfolding reduce_basis_external'_def by auto
+      with False Nil have False by (simp add: LLL_Impl.reduce_basis_def)
+      thus ?thesis ..
+    next
+      case (Cons f rest) 
+      from Cons fs_init len have dim_fs_n: "dim_vec f = n" by auto
+      let ?ext = "external_lll_solver' (map_prod integer_of_int integer_of_int (quotient_of \<alpha>)) 
+        (map (map integer_of_int \<circ> list_of_vec) fs_init)" 
+      note res = res[unfolded reduce_basis_external'_def Cons Let_def list.case Code.abort_def dim_fs_n,
+          folded Cons]
+      define gs where "gs = map (vec_of_list o map int_of_integer) ?ext" 
+      define Fs where "Fs = mat_of_rows n fs_init"
+      define Gs where "Gs = mat_of_rows n gs"
+      define H1 where "H1 = HNF Fs"
+      define H2 where "H2 = HNF Gs"
+      note res = res[unfolded ext option.simps split len dim_fs_n, folded gs_def]
+      from res False have not: "(\<not> (length gs = m \<and> (\<forall>gi\<in>set gs. dim_vec gi = n))) = False" 
+        by (auto split: if_splits)
+      note res = res[unfolded this if_False]
+      from not have gs: "set gs \<subseteq> carrier_vec n" 
+        and len_gs: "length gs = m" by auto
+      show ?thesis
+      proof (cases "H1 = H2")
+        case True
+        hence H1_eq_H2: "H1 = H2" by auto
+        let ?HNF = "(\<lambda>A. let H = HNF A in (SOME P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> A = P * H, H))"
+        obtain P1 where P1_H1: "(P1,H1) = ?HNF Fs" by (metis H1_def)
+        obtain P2 where P2_H2: "(P2,H2) = ?HNF Gs" by (metis H2_def)
+        have sound_HNF: "is_sound_HNF ?HNF associates res"
+          by (rule is_sound_HNF_conv[OF sound_HNF'])
+        have laticce_gs_fs_init: "lattice_of gs = lattice_of fs_init" 
+          and gs_assms: "LLL_with_assms n m gs \<alpha>"
+          by (rule certification_via_eq_HNF[OF sound_HNF P1_H1[unfolded Fs_def] 
+                P2_H2[unfolded Gs_def] H1_eq_H2 gs len_gs])+
+        from res a True   
+        have gs_fs:  "LLL_Impl.reduce_basis \<alpha> gs = fs"  by (auto split:  prod.split) 
+        have lattice_gs_fs: "lattice_of gs = lattice_of fs" 
+          and "gram_schmidt_fs.reduced n (map of_int_hom.vec_hom fs) \<alpha> m" 
+          and "gs.lin_indpt_list (map of_int_hom.vec_hom fs)"
+          and "length fs = length gs" 
+          using LLL_with_assms.reduce_basis gs_fs gs_assms laticce_gs_fs_init gs_assms 
+          using LLL_with_assms_def len_gs unfolding LLL.L_def by fast+             
+        from this show ?thesis
+          using laticce_gs_fs_init gs_assms LLL_with_assms_def lattice_gs_fs
+          unfolding LLL_invariant_def L_def by auto               
+      next
+        case False
+        then show ?thesis 
+          using a Fs_def Gs_def res H1_def H2_def by auto
+      qed
+    qed
+  qed
+qed
+end
+
+context LLL_with_assms
+begin
+
+text \<open>We interpret the certification context using our formalized @{text "HNF_algorithm"}\<close>
+
+interpretation efficient_cert: certification n m fs_init \<alpha> "HNF_algorithm use_sym_mod" "range ass_function_euclidean" "\<lambda>c. range (res_int c)"  
+  by (unfold_locales, rule is_sound_HNF'_HNF_algorithm)
+
+(*We get the final lemma for our algorithm. It works for any matrix, but it only applies operations
+modulo determinant for non-singular matrices.*)
+thm efficient_cert.reduce_basis_external' 
+
+text \<open>Same, but applying the naive HNF algorithm, moved to JNF library from the echelon form 
+  and Hermite normal form AFP entries\<close>
+
+interpretation cert: certification n m fs_init \<alpha> "HNF_algorithm_from_HA use_sym_mod" "range ass_function_euclidean" "\<lambda>c. range (res_int c)"  
+  by (unfold_locales, rule is_sound_HNF'_HNF_algorithm_from_HA)
+thm cert.reduce_basis_external'
+
+(*Explicit versions for paper-presentation:*)
+lemma RBE_HNF_algorithm_efficient:
+  assumes "reduce_basis_external' (HNF_algorithm use_sym_mod) \<alpha> fs_init = fs"
+  shows "gram_schmidt_fs.reduced n (map of_int_hom.vec_hom fs) \<alpha> m"
+    and "LLL_invariant True m fs" using efficient_cert.reduce_basis_external' assms by blast+
+
+lemma RBE_HNF_algorithm_naive:
+  assumes "reduce_basis_external' (HNF_algorithm_from_HA use_sym_mod) \<alpha> fs_init = fs"
+  shows "gram_schmidt_fs.reduced n (map of_int_hom.vec_hom fs) \<alpha> m"
+    and "LLL_invariant True m fs" using cert.reduce_basis_external' assms by blast+
+
+end
+
+lemma external_lll_solver'_code[code]: 
+  "external_lll_solver' = Code.abort (STR ''require proper implementation of external_lll_solver'') (\<lambda> _. external_lll_solver')" 
+  by simp
+end
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Matrix_Change_Row.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Matrix_Change_Row.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Matrix_Change_Row.thy
@@ -0,0 +1,62 @@
+section \<open>Missing Matrix Operations\<close>
+
+text \<open>In this theory we provide an operation that can change a single
+  row in a matrix efficiently, and all other rows in the matrix implementation
+  will be reused.\<close>
+
+(* TODO: move this part into JNF-AFP-entry *)
+
+theory Matrix_Change_Row
+  imports 
+    Jordan_Normal_Form.Matrix_IArray_Impl
+    Polynomial_Interpolation.Missing_Unsorted
+begin
+
+definition change_row :: "nat \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
+  "change_row k f A = mat (dim_row A) (dim_col A) (\<lambda> (i,j). 
+     if i = k then f j (A $$ (k,j)) else A $$ (i,j))"
+
+lemma change_row_carrier[simp]: 
+  "(change_row k f A \<in> carrier_mat nr nc) = (A \<in> carrier_mat nr nc)" 
+  "dim_row (change_row k f A) = dim_row A" 
+  "dim_col (change_row k f A) = dim_col A" 
+  unfolding change_row_def carrier_mat_def by auto
+
+lemma change_row_index[simp]: "A \<in> carrier_mat nr nc \<Longrightarrow> i < nr \<Longrightarrow> j < nc \<Longrightarrow>
+  change_row k f A $$ (i,j) = (if i = k then f j (A $$ (k,j)) else A $$ (i,j))" 
+  "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> change_row k f A $$ (i,j) = (if i = k then f j (A $$ (k,j)) else A $$ (i,j))" 
+  unfolding change_row_def by auto
+
+lift_definition change_row_impl :: "nat \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a mat_impl \<Rightarrow> 'a mat_impl" is
+  "\<lambda> k f (nr,nc,A). let Ak = IArray.sub A k; Arows = IArray.list_of A;
+     Ak' = IArray.IArray (map (\<lambda> (i,c). f i c) (zip [0 ..< nc] (IArray.list_of Ak)));
+     A' = IArray.IArray (Arows [k := Ak'])
+     in (nr,nc,A')" 
+proof (auto, goal_cases)
+  case (1 k f nc b row)
+  show ?case 
+  proof (cases b)
+    case (IArray rows)
+    with 1 have "row \<in> set rows \<or> k < length rows 
+       \<and> row = IArray (map (\<lambda> (i,c). f i c) (zip [0 ..< nc] (IArray.list_of (rows ! k))))"
+      by (cases "k < length rows", auto simp: set_list_update dest: in_set_takeD in_set_dropD)
+    with 1 IArray show ?thesis by (cases, auto)
+  qed
+qed
+
+lemma change_row_code[code]: "change_row k f (mat_impl A) = (if k < dim_row_impl A 
+  then mat_impl (change_row_impl k f A) 
+  else Code.abort (STR ''index out of bounds in change_row'') (\<lambda> _. change_row k f (mat_impl A)))"
+  (is "?l = ?r")
+proof (cases "k < dim_row_impl A")
+  case True
+  hence id: "?r = mat_impl (change_row_impl k f A)" by simp
+  show ?thesis unfolding id unfolding change_row_def
+  proof (rule eq_matI, goal_cases)
+    case (1 i j)
+    thus ?case using True
+      by (transfer, auto simp: mk_mat_def)
+  qed (transfer, auto)+
+qed simp
+
+end
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/ROOT b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/ROOT
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/ROOT
@@ -0,0 +1,22 @@
+chapter AFP
+  
+session Modular_arithmetic_LLL_and_HNF_algorithms (AFP) = Smith_Normal_Form +
+  options [timeout = 1200]
+  sessions
+    LLL_Basis_Reduction 
+    Show
+    Jordan_Normal_Form
+    Hermite
+  theories
+    Matrix_Change_Row
+    Signed_Modulo
+    Storjohann_Mod_Operation
+    Storjohann
+    Storjohann_Impl
+    Uniqueness_Hermite
+    Uniqueness_Hermite_JNF
+    HNF_Mod_Det_Algorithm
+    HNF_Mod_Det_Soundness
+    LLL_Certification_via_HNF
+  document_files
+    "root.tex"
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Signed_Modulo.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Signed_Modulo.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Signed_Modulo.thy
@@ -0,0 +1,109 @@
+section \<open>Signed Modulo Operation\<close>
+
+theory Signed_Modulo
+  imports 
+    Berlekamp_Zassenhaus.Poly_Mod
+    Sqrt_Babylonian.Sqrt_Babylonian_Auxiliary
+begin
+
+text \<open>The upcoming definition of symmetric modulo 
+  is different to the HOL-Library-Signed\_Division.smod, since
+  here the modulus will be in range $\{-m/2,...,m/2\}$, 
+  whereas there -1 symmod m = m - 1.
+
+  The advantage of have range $\{-m/2,...,m/2\}$ is that small negative
+  numbers are represented by small numbers.
+
+  One limitation is that the symmetric modulo is only working properly,
+  if the modulus is a positive number.\<close>
+
+definition sym_mod :: "int \<Rightarrow> int \<Rightarrow> int" (infixl "symmod" 70) where
+  "sym_mod x y = poly_mod.inv_M y (x mod y)"
+
+lemma sym_mod_code[code]: "sym_mod x y = (let m = x mod y
+   in if m + m \<le> y then m else m - y)" 
+  unfolding sym_mod_def poly_mod.inv_M_def Let_def ..
+
+lemma sym_mod_zero[simp]: "n symmod 0 = n" "n > 0 \<Longrightarrow> 0 symmod n = 0"
+  unfolding sym_mod_def poly_mod.inv_M_def by auto
+
+lemma sym_mod_range: "y > 0 \<Longrightarrow> x symmod y \<in> {- ((y - 1) div 2) .. y div 2}"
+  unfolding sym_mod_def poly_mod.inv_M_def using pos_mod_bound[of y x]
+  by (cases "x mod y \<ge> y", auto) 
+    (smt (verit) Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign half_nonnegative_int_iff)+
+
+text \<open>The range is optimal in the sense that exactly y elements can be represented.\<close>
+lemma card_sym_mod_range: "y > 0 \<Longrightarrow> card {- ((y - 1) div 2) .. y div 2} = y" 
+  by simp
+
+lemma sym_mod_abs: "y > 0 \<Longrightarrow> \<bar>x symmod y\<bar> < y"
+  "y \<ge> 1 \<Longrightarrow> \<bar>x symmod y\<bar> \<le> y div 2"
+  using sym_mod_range[of y x] by auto
+
+
+lemma sym_mod_sym_mod[simp]: "x symmod y symmod y = x symmod (y :: int)" 
+  unfolding sym_mod_def using poly_mod.M_def poly_mod.M_inv_M_id by auto
+
+lemma sym_mod_diff_eq: "(a symmod c - b symmod c) symmod c = (a - b) symmod c" 
+  unfolding sym_mod_def
+  by (metis mod_diff_cong mod_mod_trivial poly_mod.M_def poly_mod.M_inv_M_id)
+
+lemma sym_mod_sym_mod_cancel: "c dvd b \<Longrightarrow> a symmod b symmod c = a symmod c" 
+  using mod_mod_cancel[of c b] unfolding sym_mod_def
+  by (metis poly_mod.M_def poly_mod.M_inv_M_id)
+
+lemma sym_mod_diff_right_eq: "(a - b symmod c) symmod c = (a - b) symmod c" 
+  using sym_mod_diff_eq by (metis sym_mod_sym_mod)
+
+lemma sym_mod_mult_right_eq: "a * (b symmod c) symmod c = a * b symmod c" 
+  unfolding sym_mod_def by (metis poly_mod.M_def poly_mod.M_inv_M_id mod_mult_right_eq)
+
+lemma dvd_imp_sym_mod_0 [simp]:
+  "b symmod a = 0" if "a > 0" "a dvd b"
+  unfolding sym_mod_def poly_mod.inv_M_def using that by simp
+
+lemma sym_mod_0_imp_dvd [dest!]:
+  "b dvd a" if "a symmod b = 0"
+  using that unfolding sym_mod_def poly_mod.inv_M_def
+  by (smt (verit) Euclidean_Division.pos_mod_bound dvd_eq_mod_eq_0)
+
+definition sym_div :: "int \<Rightarrow> int \<Rightarrow> int" (infixl "symdiv" 70) where
+  "sym_div x y = (let d = x div y; m = x mod y in 
+       if m + m \<le> y then d else d + 1)"
+
+lemma of_int_mod_integer: "(of_int (x mod y) :: integer) = (of_int x :: integer) mod (of_int y)" 
+  using integer_of_int_eq_of_int modulo_integer.abs_eq by presburger
+
+lemma sym_div_code[code]: 
+  "sym_div x y = (let yy = integer_of_int y in 
+     (case divmod_integer (integer_of_int x) yy
+     of (d, m) \<Rightarrow> if m + m \<le> yy then int_of_integer d else (int_of_integer (d + 1))))"
+  unfolding sym_div_def Let_def divmod_integer_def split
+  apply (rule if_cong, subst of_int_le_iff[symmetric], unfold of_int_add)
+  by (subst (1 2) of_int_mod_integer, auto)
+
+lemma sym_mod_sym_div: assumes y: "y > 0" shows "x symmod y = x - sym_div x y * y"
+proof -
+  let ?z = "x - y * (x div y)" 
+  let ?u = "y * (x div y)" 
+  have "x = y * (x div y) + x mod y" using y by simp
+  hence id: "x mod y = ?z" by linarith
+  have "x symmod y = poly_mod.inv_M y ?z" unfolding sym_mod_def id by auto
+  also have "\<dots> = (if ?z + ?z \<le> y then ?z else ?z - y)" unfolding poly_mod.inv_M_def ..
+  also have "\<dots> = x - (if (x mod y) + (x mod y) \<le> y then x div y else x div y + 1) * y" 
+    by (simp add: algebra_simps id)
+  also have "(if (x mod y) + (x mod y) \<le> y then x div y else x div y + 1) = sym_div x y" 
+    unfolding sym_div_def Let_def ..
+  finally show ?thesis .
+qed
+  
+lemma dvd_sym_div_mult_right [simp]:
+  "(a symdiv b) * b = a" if "b > 0" "b dvd a"
+  using sym_mod_sym_div[of b a] that by simp
+
+lemma dvd_sym_div_mult_left [simp]:
+  "b * (a symdiv b) = a" if "b > 0" "b dvd a"
+  using dvd_sym_div_mult_right[OF that] by (simp add: ac_simps)
+
+
+end
\ No newline at end of file
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann.thy
@@ -0,0 +1,2327 @@
+section \<open>Storjohann's basis reduction algorithm (abstract version)\<close>
+
+text \<open>This theory contains the soundness proofs of Storjohann's basis
+  reduction algorithms, both for the normal and the improved-swap-order variant.
+
+  The implementation of Storjohann's version of LLL uses modular operations throughout.
+  It is an abstract implementation that is already quite close to what the actual implementation will be.
+   In particular, the swap operation here is derived from the computation lemma for the swap
+   operation in the old, integer-only formalization of LLL.\<close>
+
+theory Storjohann
+  imports 
+    Storjohann_Mod_Operation
+    LLL_Basis_Reduction.LLL_Number_Bounds
+    Sqrt_Babylonian.NthRoot_Impl
+begin
+
+subsection \<open>Definition of algorithm\<close>
+
+text \<open>In the definition of the algorithm, the first-flag determines, whether only the first vector
+  of the reduced basis should be computed, i.e., a short vector. Then the modulus can be slightly
+  decreased in comparison to the required modulus for computing the whole reduced matrix.\<close>
+
+fun max_list_rats_with_index :: "(int * int * nat) list \<Rightarrow> (int * int * nat)" where
+  "max_list_rats_with_index [x] = x" |
+  "max_list_rats_with_index ((n1,d1,i1) # (n2,d2,i2) # xs) 
+     = max_list_rats_with_index ((if n1 * d2 \<le> n2 * d1 then (n2,d2,i2) else (n1,d1,i1)) # xs)"
+
+context LLL
+begin
+
+definition "log_base = (10 :: int)" 
+
+definition bound_number :: "bool \<Rightarrow> nat" where
+  "bound_number first = (if first \<and> m \<noteq> 0 then 1 else m)" 
+
+definition compute_mod_of_max_gso_norm :: "bool \<Rightarrow> rat \<Rightarrow> int" where
+  "compute_mod_of_max_gso_norm first mn = log_base ^ (log_ceiling log_base (max 2 (
+     root_rat_ceiling 2 (mn * (rat_of_nat (bound_number first) + 3)) + 1)))"
+
+definition g_bnd_mode :: "bool \<Rightarrow> rat \<Rightarrow> int vec list \<Rightarrow> bool" where 
+  "g_bnd_mode first b fs = (if first \<and> m \<noteq> 0 then sq_norm (gso fs 0) \<le> b else g_bnd b fs)" 
+
+definition d_of where "d_of dmu i = (if i = 0 then 1 :: int else dmu $$ (i - 1, i - 1))"
+
+definition compute_max_gso_norm :: "bool \<Rightarrow> int mat \<Rightarrow> rat \<times> nat" where
+  "compute_max_gso_norm first dmu = (if m = 0 then (0,0) else 
+      case max_list_rats_with_index (map (\<lambda> i. (d_of dmu (Suc i), d_of dmu i, i)) [0 ..< (if first then 1 else m)])
+      of (num, denom, i) \<Rightarrow> (of_int num / of_int denom, i))"
+
+
+context
+  fixes p :: int \<comment> \<open>the modulus\<close>
+    and first :: bool \<comment> \<open>only compute first vector of reduced basis\<close>
+begin
+
+definition basis_reduction_mod_add_row :: 
+  "int vec list \<Rightarrow> int mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (int vec list \<times> int mat)"  where
+  "basis_reduction_mod_add_row mfs dmu i j = 
+    (let c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j)) in
+      (if c = 0 then (mfs, dmu) 
+        else (mfs[ i := (map_vec (\<lambda> x. x symmod p)) (mfs ! i - c \<cdot>\<^sub>v mfs ! j)], 
+             mat m m (\<lambda>(i',j'). (if (i' = i \<and> j' \<le> j) 
+                then (if j'=j then (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+                      else (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+                            symmod (p * d_of dmu j' * d_of dmu (Suc j')))
+                else (dmu $$ (i',j')))))))"
+
+fun basis_reduction_mod_add_rows_loop where
+  "basis_reduction_mod_add_rows_loop mfs dmu i 0 = (mfs, dmu)"
+| "basis_reduction_mod_add_rows_loop mfs dmu i (Suc j) = (
+     let (mfs', dmu') = basis_reduction_mod_add_row mfs dmu i j
+      in basis_reduction_mod_add_rows_loop mfs' dmu' i j)" 
+
+definition basis_reduction_mod_swap_dmu_mod :: "int mat \<Rightarrow> nat \<Rightarrow> int mat" where
+  "basis_reduction_mod_swap_dmu_mod dmu k = mat m m (\<lambda>(i, j). (
+    if j < i \<and> (j = k \<or> j = k - 1) then 
+        dmu $$ (i, j) symmod (p * d_of dmu j * d_of dmu (Suc j))
+    else dmu $$ (i, j)))"
+
+definition basis_reduction_mod_swap where
+  "basis_reduction_mod_swap mfs dmu k = 
+     (mfs[k := mfs ! (k - 1), k - 1 := mfs ! k],
+      basis_reduction_mod_swap_dmu_mod (mat m m (\<lambda>(i,j). (
+      if j < i then
+        if i = k - 1 then 
+           dmu $$ (k, j)
+        else if i = k \<and> j \<noteq> k - 1 then 
+             dmu $$ (k - 1, j)
+        else if i > k \<and> j = k then
+           ((d_of dmu (Suc k)) * dmu $$ (i, k - 1) - dmu $$ (k, k - 1) * dmu $$ (i, j)) 
+              div (d_of dmu k)
+        else if i > k \<and> j = k - 1 then
+           (dmu $$ (k, k - 1) * dmu $$ (i, j) + dmu $$ (i, k) * (d_of dmu (k-1)))
+              div (d_of dmu k)
+        else dmu $$ (i, j)
+      else if i = j then 
+        if i = k - 1 then 
+          ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) 
+            div (d_of dmu k)
+        else (d_of dmu (Suc i))
+      else dmu $$ (i, j))
+    )) k)" 
+
+fun basis_reduction_adjust_mod where
+  "basis_reduction_adjust_mod mfs dmu = 
+    (let (b,g_idx) = compute_max_gso_norm first dmu;
+         p' = compute_mod_of_max_gso_norm first b
+        in if p' < p then 
+           let mfs' = map (map_vec (\<lambda>x. x symmod p')) mfs;
+               d_vec = vec (Suc m) (\<lambda> i. d_of dmu i);
+               dmu' = mat m m (\<lambda> (i,j). if j < i then dmu $$ (i,j) 
+                 symmod (p' * d_vec $ j * d_vec $ (Suc j)) else
+                 dmu $$ (i,j))
+             in (p', mfs', dmu', g_idx)
+           else (p, mfs, dmu, g_idx))" 
+
+definition basis_reduction_adjust_swap_add_step where
+  "basis_reduction_adjust_swap_add_step mfs dmu g_idx i = (
+    let i1 = i - 1; 
+        (mfs1, dmu1) = basis_reduction_mod_add_row mfs dmu i i1;
+        (mfs2, dmu2) = basis_reduction_mod_swap mfs1 dmu1 i
+      in if i1 = g_idx then basis_reduction_adjust_mod mfs2 dmu2
+         else (p, mfs2, dmu2, g_idx))"
+
+
+definition basis_reduction_mod_step where
+  "basis_reduction_mod_step mfs dmu g_idx i (j :: int) = (if i = 0 then (p, mfs, dmu, g_idx, Suc i, j)
+     else let di = d_of dmu i;
+              (num, denom) = quotient_of \<alpha>
+      in if di * di * denom \<le> num * d_of dmu (i - 1) * d_of dmu (Suc i) then
+          (p, mfs, dmu, g_idx, Suc i, j)
+      else let (p', mfs', dmu', g_idx') = basis_reduction_adjust_swap_add_step mfs dmu g_idx i
+          in (p', mfs', dmu', g_idx', i - 1, j + 1))" 
+
+primrec basis_reduction_mod_add_rows_outer_loop where
+  "basis_reduction_mod_add_rows_outer_loop mfs dmu 0 = (mfs, dmu)" |
+  "basis_reduction_mod_add_rows_outer_loop mfs dmu (Suc i) = 
+    (let (mfs', dmu') = basis_reduction_mod_add_rows_outer_loop mfs dmu i in
+      basis_reduction_mod_add_rows_loop mfs' dmu' (Suc i) (Suc i))"
+end
+
+text \<open>the main loop of the normal Storjohann algorithm\<close>
+partial_function (tailrec) basis_reduction_mod_main where
+  "basis_reduction_mod_main p first mfs dmu g_idx i (j :: int) = (
+    (if i < m 
+       then 
+         case basis_reduction_mod_step p first mfs dmu g_idx i j
+         of (p', mfs', dmu', g_idx', i', j') \<Rightarrow>  
+           basis_reduction_mod_main p' first mfs' dmu' g_idx' i' j'
+       else
+         (p, mfs, dmu)))"
+
+definition compute_max_gso_quot:: "int mat \<Rightarrow> (int * int * nat)" where
+  "compute_max_gso_quot dmu = max_list_rats_with_index 
+    (map (\<lambda>i. ((d_of dmu (i+1)) * (d_of dmu (i+1)), (d_of dmu (i+2)) * (d_of dmu i), Suc i)) [0..<(m-1)])"
+
+text \<open>the main loop of Storjohann's algorithm with improved swap order\<close>
+partial_function (tailrec) basis_reduction_iso_main where
+  "basis_reduction_iso_main p first mfs dmu g_idx (j :: int) = (
+    (if m > 1 then
+      (let (max_gso_num, max_gso_denum, indx) = compute_max_gso_quot dmu;
+        (num, denum) = quotient_of \<alpha> in
+        (if (max_gso_num * denum  > num * max_gso_denum) then
+            case basis_reduction_adjust_swap_add_step p first mfs dmu g_idx indx of
+              (p', mfs', dmu', g_idx') \<Rightarrow>
+          basis_reduction_iso_main p' first mfs' dmu' g_idx' (j + 1) 
+         else
+           (p, mfs, dmu)))
+     else (p, mfs, dmu)))"
+
+definition compute_initial_mfs where
+  "compute_initial_mfs p = map (map_vec (\<lambda>x. x symmod p)) fs_init"
+
+definition compute_initial_dmu where
+  "compute_initial_dmu p dmu = mat m m (\<lambda>(i',j'). if j' < i' 
+        then dmu $$ (i', j') symmod (p * d_of dmu j' * d_of dmu (Suc j')) 
+        else dmu $$ (i', j'))"
+
+definition "dmu_initial = (let dmu = d\<mu>_impl fs_init
+   in mat m m (\<lambda> (i,j). 
+   if j \<le> i then d\<mu>_impl fs_init !! i !! j else 0))"
+
+definition "compute_initial_state first = 
+  (let dmu = dmu_initial;
+       (b, g_idx) = compute_max_gso_norm first dmu;
+       p = compute_mod_of_max_gso_norm first b
+     in (p, compute_initial_mfs p, compute_initial_dmu p dmu, g_idx))" 
+
+text \<open>Storjohann's algorithm\<close>
+definition reduce_basis_mod :: "int vec list" where
+  "reduce_basis_mod = (
+     let first = False;
+         (p0, mfs0, dmu0, g_idx) = compute_initial_state first;
+         (p', mfs', dmu') = basis_reduction_mod_main p0 first mfs0 dmu0 g_idx 0 0;
+         (mfs'', dmu'') = basis_reduction_mod_add_rows_outer_loop p' mfs' dmu' (m-1)
+      in mfs'')"
+
+text \<open>Storjohann's algorithm with improved swap order\<close>
+definition reduce_basis_iso :: "int vec list" where
+  "reduce_basis_iso = (
+     let first = False; 
+         (p0, mfs0, dmu0, g_idx) = compute_initial_state first;
+         (p', mfs', dmu') = basis_reduction_iso_main p0 first mfs0 dmu0 g_idx 0;
+         (mfs'', dmu'') = basis_reduction_mod_add_rows_outer_loop p' mfs' dmu' (m-1)
+      in mfs'')"
+
+text \<open>Storjohann's algorithm for computing a short vector\<close>
+definition 
+  "short_vector_mod = (
+     let first = True;
+         (p0, mfs0, dmu0, g_idx) = compute_initial_state first;
+         (p', mfs', dmu') = basis_reduction_mod_main p0 first mfs0 dmu0 g_idx 0 0
+      in hd mfs')"
+
+text \<open>Storjohann's algorithm (iso-variant) for computing a short vector\<close>
+definition 
+  "short_vector_iso = (
+     let first = True; 
+         (p0, mfs0, dmu0, g_idx) = compute_initial_state first;
+         (p', mfs', dmu') = basis_reduction_iso_main p0 first mfs0 dmu0 g_idx 0
+      in hd mfs')"
+end
+
+subsection \<open>Towards soundness of Storjohann's algorithm\<close>
+
+lemma max_list_rats_with_index_in_set: 
+  assumes max: "max_list_rats_with_index xs = (nm, dm, im)"
+  and len: "length xs \<ge> 1"
+shows "(nm, dm, im) \<in> set xs"
+  using assms
+proof (induct xs rule: max_list_rats_with_index.induct)
+  case (2 n1 d1 i1 n2 d2 i2 xs)
+  have "1 \<le> length ((if n1 * d2 \<le> n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) # xs)" by simp
+  moreover have "max_list_rats_with_index ((if n1 * d2 \<le> n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) # xs)
+              = (nm, dm, im)" using 2 by simp
+  moreover have "(if n1 * d2 \<le> n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) \<in>
+        set ((n1, d1, i1) # (n2, d2, i2) # xs)" by simp
+  moreover then have "set ((if n1 * d2 \<le> n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) # xs) \<subseteq>
+        set ((n1, d1, i1) # (n2, d2, i2) # xs)" by auto
+  ultimately show ?case using 2(1) by auto
+qed auto
+
+lemma max_list_rats_with_index: assumes "\<And> n d i. (n,d,i) \<in> set xs \<Longrightarrow> d > 0" 
+  and max: "max_list_rats_with_index xs = (nm, dm, im)" 
+  and "(n,d,i) \<in> set xs" 
+shows "rat_of_int n / of_int d \<le> of_int nm / of_int dm" 
+  using assms
+proof (induct xs arbitrary: n d i rule: max_list_rats_with_index.induct)
+  case (2 n1 d1 i1 n2 d2 i2 xs n d i)
+  let ?r = "rat_of_int" 
+  from 2(2) have "d1 > 0" "d2 > 0" by auto
+  hence d: "?r d1 > 0" "?r d2 > 0" by auto
+  have "(n1 * d2 \<le> n2 * d1) = (?r n1 * ?r d2 \<le> ?r n2 * ?r d1)" 
+    unfolding of_int_mult[symmetric] by presburger
+  also have "\<dots> = (?r n1 / ?r d1 \<le> ?r n2 / ?r d2)" using d 
+    by (smt divide_strict_right_mono leD le_less_linear mult.commute nonzero_mult_div_cancel_left 
+        not_less_iff_gr_or_eq times_divide_eq_right)
+  finally have id: "(n1 * d2 \<le> n2 * d1) = (?r n1 / ?r d1 \<le> ?r n2 / ?r d2)" .
+  obtain n' d' i' where new: "(if n1 * d2 \<le> n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) = (n',d',i')" 
+    by force  
+  have nd': "(n',d',i') \<in> {(n1,d1,i1), (n2, d2, i2)}" using new[symmetric] by auto
+  from 2(3) have res: "max_list_rats_with_index ((n',d',i') # xs) = (nm, dm, im)" using new by auto
+  note 2 = 2[unfolded new]
+  show ?case 
+  proof (cases "(n,d,i) \<in> set xs")
+    case True
+    show ?thesis 
+      by (rule 2(1)[of n d, OF 2(2) res], insert True nd', force+)
+  next
+    case False
+    with 2(4) have "n = n1 \<and> d = d1 \<or> n = n2 \<and> d = d2" by auto
+    hence "?r n / ?r d \<le> ?r n' / ?r d'" using new[unfolded id]
+      by (metis linear prod.inject)
+    also have "?r n' / ?r d' \<le> ?r nm / ?r dm" 
+      by (rule 2(1)[of n' d', OF 2(2) res], insert nd', force+)
+    finally show ?thesis .
+  qed
+qed auto
+
+context LLL
+begin
+
+lemma log_base: "log_base \<ge> 2" unfolding log_base_def by auto
+
+definition LLL_invariant_weak' :: "nat \<Rightarrow> int vec list \<Rightarrow> bool" where 
+  "LLL_invariant_weak' i fs = ( 
+    gs.lin_indpt_list (RAT fs) \<and> 
+    lattice_of fs = L \<and>
+    weakly_reduced fs i \<and>
+    i \<le> m \<and> 
+    length fs = m    
+  )" 
+
+lemma LLL_invD_weak: assumes "LLL_invariant_weak' i fs"
+  shows 
+  "lin_indep fs" 
+  "length (RAT fs) = m" 
+  "set fs \<subseteq> carrier_vec n"
+  "\<And> i. i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" 
+  "\<And> i. i < m \<Longrightarrow> gso fs i \<in> carrier_vec n" 
+  "length fs = m"
+  "lattice_of fs = L" 
+  "weakly_reduced fs i"
+  "i \<le> m"
+proof (atomize (full), goal_cases)
+  case 1
+  interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs"
+    by (standard) (use assms LLL_invariant_weak'_def gs.lin_indpt_list_def in auto)
+  show ?case
+    using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier
+    by (auto simp add: LLL_invariant_weak'_def gram_schmidt_fs.reduced_def)
+qed
+
+lemma LLL_invI_weak: assumes  
+  "set fs \<subseteq> carrier_vec n"
+  "length fs = m"
+  "lattice_of fs = L" 
+  "i \<le> m"
+  "lin_indep fs" 
+  "weakly_reduced fs i" 
+shows "LLL_invariant_weak' i fs" 
+  unfolding LLL_invariant_weak'_def Let_def using assms by auto
+
+lemma LLL_invw'_imp_w: "LLL_invariant_weak' i fs \<Longrightarrow> LLL_invariant_weak fs" 
+  unfolding LLL_invariant_weak'_def LLL_invariant_weak_def by auto
+  
+lemma basis_reduction_add_row_weak: 
+  assumes Linvw: "LLL_invariant_weak' i fs"
+  and i: "i < m"  and j: "j < i" 
+  and fs': "fs' = fs[ i := fs ! i - c \<cdot>\<^sub>v fs ! j]" 
+shows "LLL_invariant_weak' i fs'"
+  "g_bnd B fs \<Longrightarrow> g_bnd B fs'" 
+proof (atomize(full), goal_cases)
+  case 1
+  note Linv = LLL_invw'_imp_w[OF Linvw]
+  note main = basis_reduction_add_row_main[OF Linv i j fs']
+  have bnd: "g_bnd B fs \<Longrightarrow> g_bnd B fs'" using main(6) unfolding g_bnd_def by auto
+  note new = LLL_inv_wD[OF main(1)]
+  note old = LLL_invD_weak[OF Linvw]
+  have red: "weakly_reduced fs' i" using \<open>weakly_reduced fs i\<close> main(6) \<open>i < m\<close>
+    unfolding gram_schmidt_fs.weakly_reduced_def by auto
+  have inv: "LLL_invariant_weak' i fs'" using LLL_inv_wD[OF main(1)] \<open>i < m\<close>
+    by (intro LLL_invI_weak, auto intro: red)
+  show ?case using inv red main bnd by auto
+qed
+
+lemma LLL_inv_weak_m_impl_i:
+  assumes inv: "LLL_invariant_weak' m fs"
+  and i: "i \<le> m"
+shows "LLL_invariant_weak' i fs"
+proof -
+  have "weakly_reduced fs i" using LLL_invD_weak(8)[OF inv]
+    by (meson assms(2) gram_schmidt_fs.weakly_reduced_def le_trans less_imp_le_nat linorder_not_less)
+  then show ?thesis
+    using LLL_invI_weak[of fs i, OF LLL_invD_weak(3,6,7)[OF inv] _ LLL_invD_weak(1)[OF inv]] 
+      LLL_invD_weak(2,4,5,8-)[OF inv] i by simp
+qed
+ 
+definition mod_invariant where 
+  "mod_invariant b p first = (b \<le> rat_of_int (p - 1)^2 / (rat_of_nat (bound_number first) + 3)
+     \<and> (\<exists> e. p = log_base ^ e))"  
+
+lemma compute_mod_of_max_gso_norm: assumes mn: "mn \<ge> 0"
+  and m: "m = 0 \<Longrightarrow> mn = 0" 
+  and p: "p = compute_mod_of_max_gso_norm first mn" 
+shows  
+  "p > 1" 
+  "mod_invariant mn p first" 
+proof -
+  let ?m = "bound_number first" 
+  define p' where "p' = root_rat_ceiling 2 (mn * (rat_of_nat ?m + 3)) + 1" 
+  define p'' where "p'' = max 2 p'" 
+  define q where "q = real_of_rat (mn * (rat_of_nat ?m + 3))" 
+  have *: "-1 < (0 :: real)" by simp
+  also have "0 \<le> root 2 (real_of_rat (mn * (rat_of_nat ?m + 3)))" using mn by auto
+  finally have "p' \<ge> 0 + 1" unfolding p'_def
+    by (intro plus_left_mono, simp)
+  hence p': "p' > 0" by auto
+  have p'': "p'' > 1" unfolding p''_def by auto
+  have pp'': "p \<ge> p''" unfolding compute_mod_of_max_gso_norm_def p  p'_def[symmetric] p''_def[symmetric]
+    using log_base p'' log_ceiling_sound by auto
+  hence pp': "p \<ge> p'" unfolding p''_def by auto    
+  show "p > 1" using pp'' p'' by auto
+
+  have q0: "q \<ge> 0" unfolding q_def using mn m by auto
+  have "(mn \<le> rat_of_int (p' - 1)^2 / (rat_of_nat ?m + 3)) 
+    = (real_of_rat mn \<le> real_of_rat (rat_of_int (p' - 1)^2 / (rat_of_nat ?m + 3)))" using of_rat_less_eq by blast
+  also have "\<dots> = (real_of_rat mn \<le> real_of_rat (rat_of_int (p' - 1)^2) / real_of_rat (rat_of_nat ?m + 3))" by (simp add: of_rat_divide)
+  also have "\<dots> = (real_of_rat mn \<le> ((real_of_int (p' - 1))^2) / real_of_rat (rat_of_nat ?m + 3))" 
+    by (metis of_rat_of_int_eq of_rat_power)
+  also have "\<dots> = (real_of_rat mn \<le> (real_of_int \<lceil>sqrt q\<rceil>)^2 / real_of_rat (rat_of_nat ?m + 3))" 
+    unfolding p'_def sqrt_def q_def by simp
+  also have "\<dots>" 
+  proof -
+    have "real_of_rat mn \<le> q / real_of_rat (rat_of_nat ?m + 3)" unfolding q_def using m
+      by (auto simp: of_rat_mult)
+    also have "\<dots> \<le> (real_of_int \<lceil>sqrt q\<rceil>)^2 / real_of_rat (rat_of_nat ?m + 3)" 
+    proof (rule divide_right_mono)
+      have "q = (sqrt q)^2" using q0 by simp
+      also have "\<dots> \<le> (real_of_int \<lceil>sqrt q\<rceil>)^2" 
+        by (rule power_mono, auto simp: q0)
+      finally show "q \<le> (real_of_int \<lceil>sqrt q\<rceil>)^2" .
+    qed auto
+    finally show ?thesis .
+  qed
+  finally have "mn \<le> rat_of_int (p' - 1)^2 / (rat_of_nat ?m + 3)" .
+  also have "\<dots> \<le> rat_of_int (p - 1)^2 / (rat_of_nat ?m + 3)"
+    unfolding power2_eq_square
+    by (intro divide_right_mono mult_mono, insert p' pp', auto) 
+  finally have "mn \<le> rat_of_int (p - 1)^2 / (rat_of_nat ?m + 3)" .
+  moreover have "\<exists> e. p = log_base ^ e" unfolding p compute_mod_of_max_gso_norm_def by auto
+  ultimately show "mod_invariant mn p first" unfolding mod_invariant_def by auto
+qed
+
+lemma g_bnd_mode_cong: assumes "\<And> i. i < m \<Longrightarrow> gso fs i = gso fs' i"
+  shows "g_bnd_mode first b fs = g_bnd_mode first b fs'"
+  using assms unfolding g_bnd_mode_def g_bnd_def by auto
+
+definition LLL_invariant_mod :: "int vec list \<Rightarrow> int vec list \<Rightarrow> int mat \<Rightarrow> int \<Rightarrow> bool \<Rightarrow> rat \<Rightarrow> nat \<Rightarrow> bool" where 
+  "LLL_invariant_mod fs mfs dmu p first b i = ( 
+    length fs = m \<and>
+    length mfs = m \<and>
+    i \<le> m \<and>
+    lattice_of fs = L \<and>
+    gs.lin_indpt_list (RAT fs) \<and>
+    weakly_reduced fs i \<and>
+    (map (map_vec (\<lambda>x. x symmod p)) fs = mfs) \<and>
+    (\<forall>i' < m. \<forall> j' < i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j')) \<and>
+    (\<forall>i' < m. \<forall>j' < m. d\<mu> fs i' j' = dmu $$ (i',j')) \<and>
+    p > 1 \<and>
+    g_bnd_mode first b fs \<and>
+    mod_invariant b p first
+)"
+
+lemma LLL_invD_mod: assumes "LLL_invariant_mod fs mfs dmu p first b i"
+shows 
+  "length mfs = m"
+  "i \<le> m"
+  "length fs = m"
+  "lattice_of fs = L"
+  "gs.lin_indpt_list (RAT fs)"
+  "weakly_reduced fs i"
+  "(map (map_vec (\<lambda>x. x symmod p)) fs = mfs)"
+  "(\<forall>i' < m. \<forall>j' < i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j'))"
+  "(\<forall>i' < m. \<forall>j' < m. d\<mu> fs i' j' = dmu $$ (i',j'))"
+  "\<And> i. i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" 
+  "set fs \<subseteq> carrier_vec n"
+  "\<And> i. i < m \<Longrightarrow> gso fs i \<in> carrier_vec n" 
+  "\<And> i. i < m \<Longrightarrow> mfs ! i \<in> carrier_vec n"
+  "set mfs \<subseteq> carrier_vec n"
+  "p > 1"
+  "g_bnd_mode first b fs"
+  "mod_invariant b p first"
+proof (atomize (full), goal_cases)
+  case 1
+  interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs"
+    using assms LLL_invariant_mod_def gs.lin_indpt_list_def 
+    by (meson gram_schmidt_fs_Rn.intro gram_schmidt_fs_lin_indpt.intro gram_schmidt_fs_lin_indpt_axioms.intro)
+  have allfs: "\<forall>i < m. fs ! i \<in> carrier_vec n" using assms gs'.f_carrier 
+    by (simp add: LLL.LLL_invariant_mod_def)
+  then have setfs: "set fs \<subseteq> carrier_vec n" by (metis LLL_invariant_mod_def assms in_set_conv_nth subsetI)
+  have allgso: "(\<forall>i < m. gso fs i \<in> carrier_vec n)" using assms gs'.gso_carrier
+    by (simp add: LLL.LLL_invariant_mod_def)
+  show ?case
+    using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier allfs allgso 
+      LLL_invariant_mod_def gram_schmidt_fs.reduced_def in_set_conv_nth setfs by fastforce
+qed
+
+lemma LLL_invI_mod: assumes 
+  "length mfs = m"
+  "i \<le> m"
+  "length fs = m"
+  "lattice_of fs = L"
+  "gs.lin_indpt_list (RAT fs)"
+  "weakly_reduced fs i"
+  "map (map_vec (\<lambda>x. x symmod p)) fs = mfs"
+  "(\<forall>i' < m. \<forall>j' < i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j'))"
+  "(\<forall>i' < m. \<forall>j' < m. d\<mu> fs i' j' = dmu $$ (i',j'))"
+  "p > 1"
+  "g_bnd_mode first b fs"
+  "mod_invariant b p first"
+shows "LLL_invariant_mod fs mfs dmu p first b i" 
+  unfolding LLL_invariant_mod_def using assms by blast
+
+definition LLL_invariant_mod_weak :: "int vec list \<Rightarrow> int vec list \<Rightarrow> int mat \<Rightarrow> int \<Rightarrow> bool \<Rightarrow> rat \<Rightarrow> bool" where 
+  "LLL_invariant_mod_weak fs mfs dmu p first b = ( 
+    length fs = m \<and>
+    length mfs = m \<and>
+    lattice_of fs = L \<and>
+    gs.lin_indpt_list (RAT fs) \<and>
+    (map (map_vec (\<lambda>x. x symmod p)) fs = mfs) \<and>
+    (\<forall>i' < m. \<forall> j' < i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j')) \<and>
+    (\<forall>i' < m. \<forall>j' < m. d\<mu> fs i' j' = dmu $$ (i',j')) \<and>
+    p > 1 \<and>
+    g_bnd_mode first b fs \<and>
+    mod_invariant b p first
+)"
+
+lemma LLL_invD_modw: assumes "LLL_invariant_mod_weak fs mfs dmu p first b"
+shows 
+  "length mfs = m"
+  "length fs = m"
+  "lattice_of fs = L"
+  "gs.lin_indpt_list (RAT fs)"
+  "(map (map_vec (\<lambda>x. x symmod p)) fs = mfs)"
+  "(\<forall>i' < m. \<forall>j' < i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j'))"
+  "(\<forall>i' < m. \<forall>j' < m. d\<mu> fs i' j' = dmu $$ (i',j'))"
+  "\<And> i. i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" 
+  "set fs \<subseteq> carrier_vec n"
+  "\<And> i. i < m \<Longrightarrow> gso fs i \<in> carrier_vec n" 
+  "\<And> i. i < m \<Longrightarrow> mfs ! i \<in> carrier_vec n"
+  "set mfs \<subseteq> carrier_vec n"
+  "p > 1"
+  "g_bnd_mode first b fs"
+  "mod_invariant b p first"
+proof (atomize (full), goal_cases)
+  case 1
+  interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs"
+    using assms LLL_invariant_mod_weak_def gs.lin_indpt_list_def 
+    by (meson gram_schmidt_fs_Rn.intro gram_schmidt_fs_lin_indpt.intro gram_schmidt_fs_lin_indpt_axioms.intro)
+  have allfs: "\<forall>i < m. fs ! i \<in> carrier_vec n" using assms gs'.f_carrier 
+    by (simp add: LLL.LLL_invariant_mod_weak_def)
+  then have setfs: "set fs \<subseteq> carrier_vec n" by (metis LLL_invariant_mod_weak_def assms in_set_conv_nth subsetI)
+  have allgso: "(\<forall>i < m. gso fs i \<in> carrier_vec n)" using assms gs'.gso_carrier
+    by (simp add: LLL.LLL_invariant_mod_weak_def)
+  show ?case
+    using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier allfs allgso 
+      LLL_invariant_mod_weak_def gram_schmidt_fs.reduced_def in_set_conv_nth setfs by fastforce
+qed
+
+lemma LLL_invI_modw: assumes 
+  "length mfs = m"
+  "length fs = m"
+  "lattice_of fs = L"
+  "gs.lin_indpt_list (RAT fs)"
+  "map (map_vec (\<lambda>x. x symmod p)) fs = mfs"
+  "(\<forall>i' < m. \<forall>j' < i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j'))"
+  "(\<forall>i' < m. \<forall>j' < m. d\<mu> fs i' j' = dmu $$ (i',j'))"
+  "p > 1"
+  "g_bnd_mode first b fs"
+  "mod_invariant b p first"
+shows "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  unfolding LLL_invariant_mod_weak_def using assms by blast
+
+lemma dd\<mu>:
+  assumes i: "i < m"
+  shows "d fs (Suc i) = d\<mu> fs i i"
+proof-
+  have "\<mu> fs i i = 1" using i by (simp add: gram_schmidt_fs.\<mu>.simps)
+  then show ?thesis using d\<mu>_def by simp
+qed
+
+lemma d_of_main: assumes "(\<forall>i' < m. d\<mu> fs i' i' = dmu $$ (i',i'))"
+  and "i \<le> m"
+shows "d_of dmu i = d fs i" 
+proof (cases "i = 0")
+  case False
+  with assms have "i - 1 < m" by auto
+  from assms(1)[rule_format, OF this] dd\<mu>[OF this, of fs] False
+  show ?thesis by (simp add: d_of_def)
+next
+  case True
+  thus ?thesis unfolding d_of_def True d_def by simp
+qed
+
+lemma d_of: assumes inv: "LLL_invariant_mod fs mfs dmu p b first j"
+  and "i \<le> m" 
+shows "d_of dmu i = d fs i" 
+  by (rule d_of_main[OF _ assms(2)], insert LLL_invD_mod(9)[OF inv], auto)
+
+lemma d_of_weak: assumes inv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and "i \<le> m" 
+shows "d_of dmu i = d fs i" 
+  by (rule d_of_main[OF _ assms(2)], insert LLL_invD_modw(7)[OF inv], auto)
+
+lemma compute_max_gso_norm: assumes dmu: "(\<forall>i' < m. d\<mu> fs i' i' = dmu $$ (i',i'))" 
+  and Linv: "LLL_invariant_weak fs" 
+shows "g_bnd_mode first (fst (compute_max_gso_norm first dmu)) fs" 
+  "fst (compute_max_gso_norm first dmu) \<ge> 0" 
+  "m = 0 \<Longrightarrow> fst (compute_max_gso_norm first dmu) = 0" 
+proof -
+  show gbnd: "g_bnd_mode first (fst (compute_max_gso_norm first dmu)) fs" 
+  proof (cases "first \<and> m \<noteq> 0")
+    case False
+    have "?thesis = (g_bnd (fst (compute_max_gso_norm first dmu)) fs)" unfolding g_bnd_mode_def using False by auto
+    also have \<dots> unfolding g_bnd_def
+    proof (intro allI impI)
+      fix i
+      assume i: "i < m" 
+      have id: "(if first then 1 else m) = m" using False i by auto
+      define list where "list = map (\<lambda> i. (d_of dmu (Suc i), d_of dmu i, i)) [0 ..< m ]" 
+      obtain num denom j where ml: "max_list_rats_with_index list = (num, denom, j)" 
+        by (metis prod_cases3)
+      have dpos: "d fs i > 0" using LLL_d_pos[OF Linv, of i]  i by auto
+      have pos: "(n, d, i) \<in> set list \<Longrightarrow> 0 < d" for n d i 
+        using LLL_d_pos[OF Linv] unfolding list_def using d_of_main[OF dmu] by auto
+      from i have "list ! i \<in> set list" using i unfolding list_def by auto
+      also have "list ! i = (d_of dmu (Suc i), d_of dmu i, i)" unfolding list_def using i by auto
+      also have "\<dots> = (d fs (Suc i), d fs i, i)" using d_of_main[OF dmu] i by auto
+      finally have "(d fs (Suc i), d fs i, i) \<in> set list" . 
+      from max_list_rats_with_index[OF pos ml this] 
+      have "of_int (d fs (Suc i)) / of_int (d fs i) \<le> fst (compute_max_gso_norm first dmu)" 
+        unfolding compute_max_gso_norm_def list_def[symmetric] ml id split using i by auto
+      also have "of_int (d fs (Suc i)) / of_int (d fs i) = sq_norm (gso fs i)" 
+        using LLL_d_Suc[OF Linv i] dpos by auto
+      finally show "sq_norm (gso fs i) \<le> fst (compute_max_gso_norm first dmu)" .
+    qed
+    finally show ?thesis .
+  next
+    case True
+    thus ?thesis unfolding g_bnd_mode_def compute_max_gso_norm_def using d_of_main[OF dmu] 
+      LLL_d_Suc[OF Linv, of 0] LLL_d_pos[OF Linv, of 0] LLL_d_pos[OF Linv, of 1] by auto
+  qed
+  show "fst (compute_max_gso_norm first dmu) \<ge> 0" 
+  proof (cases "m = 0")
+    case True
+    thus ?thesis unfolding compute_max_gso_norm_def by simp
+  next
+    case False
+    hence 0: "0 < m" by simp
+    have "0 \<le> sq_norm (gso fs 0)" by blast
+    also have "\<dots> \<le> fst (compute_max_gso_norm first dmu)" 
+      using gbnd[unfolded g_bnd_mode_def g_bnd_def] using 0 by metis
+    finally show ?thesis .
+  qed
+qed (auto simp: LLL.compute_max_gso_norm_def)
+
+
+lemma increase_i_mod:
+  assumes Linv: "LLL_invariant_mod fs mfs dmu p first b i"
+  and i: "i < m" 
+  and red_i: "i \<noteq> 0 \<Longrightarrow> sq_norm (gso fs (i - 1)) \<le> \<alpha> * sq_norm (gso fs i)"
+shows "LLL_invariant_mod fs mfs dmu p first b (Suc i)" "LLL_measure i fs > LLL_measure (Suc i) fs" 
+proof -
+  note inv = LLL_invD_mod[OF Linv]
+  from inv have red: "weakly_reduced fs i"  by (auto)
+  from red red_i i have red: "weakly_reduced fs (Suc i)" 
+    unfolding gram_schmidt_fs.weakly_reduced_def
+    by (intro allI impI, rename_tac ii, case_tac "Suc ii = i", auto)
+  show "LLL_invariant_mod fs mfs dmu p first b (Suc i)"
+    by (intro LLL_invI_mod, insert inv red i, auto)
+  show "LLL_measure i fs > LLL_measure (Suc i) fs" unfolding LLL_measure_def using i by auto
+qed
+
+lemma basis_reduction_mod_add_row_main:
+  assumes Linvmw: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and i: "i < m"  and j: "j < i" 
+  and c: "c = round (\<mu> fs i j)"
+  and mfs': "mfs' = mfs[ i := (map_vec (\<lambda> x. x symmod p)) (mfs ! i - c \<cdot>\<^sub>v mfs ! j)]"
+  and dmu': "dmu' = mat m m (\<lambda>(i',j'). (if (i' = i \<and> j' \<le> j) 
+        then (if j'=j then (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+              else (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+                    symmod (p * (d_of dmu j') * (d_of dmu (Suc j'))))
+        else (dmu $$ (i',j'))))"
+shows "(\<exists>fs'. LLL_invariant_mod_weak fs' mfs' dmu' p first b \<and>
+        LLL_measure i fs' = LLL_measure i fs
+        \<and> (\<mu>_small_row i fs (Suc j) \<longrightarrow> \<mu>_small_row i fs' j) 
+        \<and> (\<forall>k < m. gso fs' k = gso fs k)
+        \<and> (\<forall>ii \<le> m. d fs' ii = d fs ii)
+        \<and> \<bar>\<mu> fs' i j\<bar> \<le> 1 / 2
+        \<and> (\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs' i' j' = \<mu> fs i' j')
+        \<and> (LLL_invariant_mod fs mfs dmu p first b i \<longrightarrow> LLL_invariant_mod fs' mfs' dmu' p first b i))"
+proof -
+  define fs' where "fs' = fs[ i := fs ! i - c \<cdot>\<^sub>v fs ! j]"
+  from LLL_invD_modw[OF Linvmw] have gbnd: "g_bnd_mode first b fs" and p1: "p > 1" and pgtz: "p > 0" by auto
+  have Linvww: "LLL_invariant_weak fs" using LLL_invD_modw[OF Linvmw] LLL_invariant_weak_def by simp
+  have 
+    Linvw': "LLL_invariant_weak fs'" and
+    01: "c = round (\<mu> fs i j) \<Longrightarrow> \<mu>_small_row i fs (Suc j) \<Longrightarrow> \<mu>_small_row i fs' j" and
+    02: "LLL_measure i fs' = LLL_measure i fs" and
+    03: "\<And> i. i < m \<Longrightarrow> gso fs' i = gso fs i" and
+    04: "\<And> i' j'. i' < m \<Longrightarrow> j' < m \<Longrightarrow> 
+      \<mu> fs' i' j' = (if i' = i \<and> j' \<le> j then \<mu> fs i j' - of_int c * \<mu> fs j j' else \<mu> fs i' j')" and
+    05: "\<And> ii. ii \<le> m \<Longrightarrow> d fs' ii = d fs ii" and 
+    06: "\<bar>\<mu> fs' i j\<bar> \<le> 1 / 2" and
+    061: "(\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs i' j' = \<mu> fs' i' j')"
+    using basis_reduction_add_row_main[OF Linvww i j fs'_def] c i by auto
+  have 07: "lin_indep fs'" and 
+    08: "length fs' = m" and 
+    09: "lattice_of fs' = L" using LLL_inv_wD Linvw' by auto
+  have 091: "fs_int_indpt n fs'" using 07 using Gram_Schmidt_2.fs_int_indpt.intro by simp
+  define I where "I = {(i',j'). i' = i \<and> j' < j}"
+  have 10: "I \<subseteq> {(i',j'). i' < m \<and> j' < i'}" "(i,j)\<notin> I" "\<forall>j' \<ge> j. (i,j') \<notin> I" using I_def i j by auto
+  obtain fs'' where 
+    11: "lattice_of fs'' = L" and
+    12: "map (map_vec (\<lambda> x. x symmod p)) fs'' = map (map_vec (\<lambda> x. x symmod p)) fs'" and
+    13: "lin_indep fs''" and
+    14: "length fs'' = m" and
+    15: "(\<forall> k < m. gso fs'' k = gso fs' k)" and
+    16: "(\<forall> k \<le> m. d fs'' k = d fs' k)" and
+    17: "(\<forall> i' < m. \<forall> j' < m. d\<mu> fs'' i' j' = 
+      (if (i',j') \<in> I then d\<mu> fs' i' j' symmod (p * d fs' j' * d fs' (Suc j')) else d\<mu> fs' i' j'))"
+    using mod_finite_set[OF 07 08 10(1) 09 pgtz] by blast
+  have 171: "(\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs'' i' j' = \<mu> fs' i' j')"
+  proof -
+    {
+      fix i' j'
+      assume i'j': "i' < i" "j' \<le> i'"
+      have "rat_of_int (d\<mu> fs'' i' j') = rat_of_int (d\<mu> fs' i' j')" using "17" I_def i i'j' by auto
+      then have "rat_of_int (int_of_rat (rat_of_int (d fs'' (Suc j')) * \<mu> fs'' i' j')) = 
+        rat_of_int (int_of_rat (rat_of_int (d fs' (Suc j')) * \<mu> fs' i' j'))"
+        using d\<mu>_def i'j' j by auto
+      then have "rat_of_int (d fs'' (Suc j')) * \<mu> fs'' i' j' = 
+        rat_of_int (d fs' (Suc j')) * \<mu> fs' i' j'" 
+        by (smt "08" "091" "13" "14" d_def dual_order.strict_trans fs_int.d_def 
+            fs_int_indpt.fs_int_mu_d_Z fs_int_indpt.intro i i'j'(1) i'j'(2) int_of_rat(2))
+      then have "\<mu> fs'' i' j' = \<mu> fs' i' j'" by (smt "16" 
+            LLL_d_pos[OF Linvw'] Suc_leI int_of_rat(1)
+            dual_order.strict_trans fs'_def i i'j' j 
+            le_neq_implies_less nonzero_mult_div_cancel_left of_int_hom.hom_zero)
+    }
+    then show ?thesis by simp
+  qed
+  then have 172: "(\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs'' i' j' = \<mu> fs i' j')" using 061 by simp (* goal *)
+  have 18: "LLL_measure i fs'' = LLL_measure i fs'" using 16 LLL_measure_def logD_def D_def by simp
+  have 19: "(\<forall>k < m. gso fs'' k = gso fs k)" using 03 15 by simp
+  have "\<forall>j' \<in> {j..(m-1)}. j' < m" using j i by auto
+  then have 20: "\<forall>j' \<in> {j..(m-1)}. d\<mu> fs'' i j' = d\<mu> fs' i j'" 
+    using 10(3) 17 Suc_lessD less_trans_Suc by (meson atLeastAtMost_iff i)
+  have 21: "\<forall>j' \<in> {j..(m-1)}. \<mu> fs'' i j' = \<mu> fs' i j'" 
+  proof -
+    {
+      fix j'
+      assume j': "j' \<in> {j..(m-1)}"
+      define \<mu>'' :: rat where "\<mu>'' = \<mu> fs'' i j'"
+      define \<mu>' :: rat where "\<mu>' = \<mu> fs' i j'"
+      have "rat_of_int (d\<mu> fs'' i j') = rat_of_int (d\<mu> fs' i j')" using 20 j' by simp
+      moreover have "j' < length fs'" using i j' 08 by auto
+      ultimately have "rat_of_int (d fs' (Suc j')) * gram_schmidt_fs.\<mu> n (map of_int_hom.vec_hom fs') i j'
+        = rat_of_int (d fs'' (Suc j')) * gram_schmidt_fs.\<mu> n (map of_int_hom.vec_hom fs'') i j'"
+        using 20 08 091 13 14 fs_int_indpt.d\<mu>_def fs_int.d_def fs_int_indpt.d\<mu> d\<mu>_def d_def i fs_int_indpt.intro j'
+        by metis
+      then have "rat_of_int (d fs' (Suc j')) * \<mu>'' = rat_of_int (d fs' (Suc j')) * \<mu>'" 
+        using 16 i j' \<mu>'_def \<mu>''_def unfolding d\<mu>_def by auto
+      moreover have "0 < d fs' (Suc j')" using LLL_d_pos[OF Linvw', of "Suc j'"] i j' by auto
+      ultimately have "\<mu> fs'' i j' = \<mu> fs' i j'" using \<mu>'_def \<mu>''_def by simp
+    }
+    then show ?thesis by simp
+  qed
+  then have 22: "\<mu> fs'' i j = \<mu> fs' i j" using i j by simp
+  then have 23: "\<bar>\<mu> fs'' i j\<bar> \<le> 1 / 2" using 06 by simp (* goal *)
+  have 24: "LLL_measure i fs'' = LLL_measure i fs" using 02 18 by simp (* goal *)
+  have 25: "(\<forall> k \<le> m. d fs'' k = d fs k)" using 16 05 by simp (* goal *)
+  have 26: "(\<forall> k < m. gso fs'' k = gso fs k)" using 15 03 by simp (* goal *)
+  have 27: "\<mu>_small_row i fs (Suc j) \<Longrightarrow> \<mu>_small_row i fs'' j"
+    using 21 01 \<mu>_small_row_def i j c by auto (* goal *)
+  have 28: "length fs = m" "length mfs = m" using LLL_invD_modw[OF Linvmw] by auto
+  have 29: "map (map_vec (\<lambda>x. x symmod p)) fs = mfs" using assms LLL_invD_modw by simp
+  have 30: "\<And> i. i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" "\<And> i. i < m \<Longrightarrow> mfs ! i \<in> carrier_vec n"
+    using LLL_invD_modw[OF Linvmw] by auto
+  have 31: "\<And> i. i < m \<Longrightarrow> fs' ! i \<in> carrier_vec n" using fs'_def 30(1) 
+    using "08" "091" fs_int_indpt.f_carrier by blast
+  have 32: "\<And> i. i < m \<Longrightarrow> mfs' ! i \<in> carrier_vec n" unfolding mfs' using 30(2) 28(2) 
+    by (metis (no_types, lifting) Suc_lessD j less_trans_Suc map_carrier_vec minus_carrier_vec 
+        nth_list_update_eq nth_list_update_neq smult_closed)
+  have 33: "length mfs' = m" using 28(2) mfs' by simp (* invariant goal *)
+  then have 34: "map (map_vec (\<lambda>x. x symmod p)) fs' = mfs'"
+  proof -
+    {
+      fix i' j'
+      have j2: "j < m" using j i by auto
+      assume i': "i' < m"
+      assume j': "j' < n"
+      then have fsij: "(fs ! i' $ j') symmod p = mfs ! i' $ j'" using 30 i' j' 28 29 by fastforce
+      have "mfs' ! i $ j' = (mfs ! i $ j'- (c \<cdot>\<^sub>v mfs ! j) $ j') symmod p"
+        unfolding mfs' using 30(2) j' 28 j2 
+        by (metis (no_types, lifting) carrier_vecD i index_map_vec(1) index_minus_vec(1) 
+            index_minus_vec(2) index_smult_vec(2) nth_list_update_eq)
+      then have mfs'ij: "mfs' ! i $ j' = (mfs ! i $ j'- c * mfs ! j $ j') symmod p" 
+        unfolding mfs' using 30(2) i' j' 28 j2 by fastforce
+      have "(fs' ! i' $ j') symmod p = mfs' ! i' $ j'"
+      proof(cases "i' = i")
+        case True
+        show ?thesis using fs'_def mfs' True 28 fsij 
+        proof -
+          have "fs' ! i' $ j' = (fs ! i' - c \<cdot>\<^sub>v fs ! j) $ j'" using fs'_def True i' j' 28(1) by simp
+          also have "\<dots> = fs ! i' $ j' - (c \<cdot>\<^sub>v fs ! j) $ j'" using i' j' 30(1)
+            by (metis Suc_lessD carrier_vecD i index_minus_vec(1) index_smult_vec(2) j less_trans_Suc)
+          finally have "fs' ! i' $ j' = fs ! i' $ j' - (c \<cdot>\<^sub>v fs ! j) $ j'" by auto
+          then have "(fs' ! i' $ j') symmod p = (fs ! i' $ j' - (c \<cdot>\<^sub>v fs ! j) $ j') symmod p" by auto
+          also have "\<dots> = ((fs ! i' $ j') symmod p - ((c \<cdot>\<^sub>v fs ! j) $ j') symmod p) symmod p"
+            by (simp add: sym_mod_diff_eq)
+          also have "(c \<cdot>\<^sub>v fs ! j) $ j' = c * (fs ! j $ j')" 
+            using i' j' True 28 30(1) j
+            by (metis Suc_lessD carrier_vecD index_smult_vec(1) less_trans_Suc)
+          also have "((fs ! i' $ j') symmod p - (c * (fs ! j $ j')) symmod p) symmod p = 
+            ((fs ! i' $ j') symmod p - c * ((fs ! j $ j') symmod p)) symmod p" 
+            using i' j' True 28 30(1) j by (metis sym_mod_diff_right_eq sym_mod_mult_right_eq)
+          also have "((fs ! j $ j') symmod p) = mfs ! j $ j'" using 30 i' j' 28 29 j2 by fastforce
+          also have "((fs ! i' $ j') symmod p - c * mfs ! j $ j') symmod p = 
+            (mfs ! i' $ j' - c * mfs ! j $ j') symmod p" using fsij by simp
+          finally show ?thesis using mfs'ij by (simp add: True)
+        qed
+      next
+        case False
+        show ?thesis using fs'_def mfs' False 28 fsij by simp
+      qed
+    }
+    then have "\<forall>i' < m. (map_vec (\<lambda>x. x symmod p)) (fs' ! i') = mfs' ! i'"
+      using 31 32 33 08 by fastforce
+    then show ?thesis using 31 32 33 08 by (simp add: map_nth_eq_conv)
+  qed
+  then have 35: "map (map_vec (\<lambda>x. x symmod p)) fs'' = mfs'" using 12 by simp (* invariant req. *)
+  have 36: "lin_indep fs''"  using 13 by simp (* invariant req. *)
+  have Linvw'': "LLL_invariant_weak fs''" using LLL_invariant_weak_def 11 13 14 by simp
+  have 39: "(\<forall>i' < m. \<forall>j' < i'. \<bar>d\<mu> fs'' i' j'\<bar> < p * d fs'' j' * d fs'' (Suc j'))" (* invariant req. *)
+  proof -
+    {
+      fix i' j'
+      assume i': "i' < m"
+      assume j': "j' < i'"
+      define pdd where "pdd = (p * d fs'' j' * d fs'' (Suc j'))"
+      then have pddgtz: "pdd > 0" 
+        using pgtz j' LLL_d_pos[OF Linvw', of "Suc j'"] LLL_d_pos[OF Linvw', of j'] j' i' 16 by simp
+      have "\<bar>d\<mu> fs'' i' j'\<bar> < p * d fs'' j' * d fs'' (Suc j')"
+      proof(cases "i' = i")
+        case i'i: True
+        then show ?thesis
+        proof (cases "j' < j")
+          case True
+          then have eq'': "d\<mu> fs'' i' j' = d\<mu> fs' i' j' symmod (p * d fs'' j' * d fs'' (Suc j'))"
+            using 16 17 10 I_def True i' j' i'i by simp
+          have "0 < pdd" using pddgtz by simp
+          then show ?thesis unfolding eq'' unfolding pdd_def[symmetric] using sym_mod_abs by blast
+        next
+          case fls: False
+          then have "(i',j') \<notin> I" using I_def i'i by simp
+          then have dmufs''fs': "d\<mu> fs'' i' j' = d\<mu> fs' i' j'" using 17 i' j' by simp
+          show ?thesis
+          proof (cases "j' = j")
+            case True
+            define \<mu>'' where "\<mu>'' = \<mu> fs'' i' j'" 
+            define d'' where "d'' = d fs'' (Suc j')"
+            have pge1: "p \<ge> 1" using pgtz by simp
+            have lh: "\<bar>\<mu>''\<bar> \<le> 1 / 2" using 23 True i'i \<mu>''_def by simp
+            moreover have eq: "d\<mu> fs'' i' j' = \<mu>'' * d''" using d\<mu>_def i' j' \<mu>''_def d''_def 
+              by (smt "14" "36" LLL.d_def Suc_lessD fs_int.d_def fs_int_indpt.d\<mu> fs_int_indpt.intro 
+                  int_of_rat(1) less_trans_Suc mult_of_int_commute of_rat_mult of_rat_of_int_eq)
+            moreover have Sj': "Suc j' \<le> m" "j' \<le> m" using True j' i i' by auto
+            moreover then have gtz: "0 < d''" using LLL_d_pos[OF Linvw''] d''_def by simp
+            moreover have "rat_of_int \<bar>d\<mu> fs'' i' j'\<bar> = \<bar>\<mu>'' * (rat_of_int d'')\<bar>" 
+              using eq by (metis of_int_abs of_rat_hom.injectivity of_rat_mult of_rat_of_int_eq)
+            moreover then have "\<bar>\<mu>'' * rat_of_int d'' \<bar> =  \<bar>\<mu>''\<bar> * rat_of_int \<bar>d''\<bar>"
+              by (metis (mono_tags, hide_lams) abs_mult of_int_abs)
+            moreover have "\<dots> = \<bar>\<mu>''\<bar> * rat_of_int d'' " using gtz by simp
+            moreover have "\<dots> < rat_of_int d''" using lh gtz by simp
+            ultimately have "rat_of_int \<bar>d\<mu> fs'' i' j'\<bar> < rat_of_int d''" by simp
+            then have "\<bar>d\<mu> fs'' i' j'\<bar> <  d fs'' (Suc j')" using d''_def by simp
+            then have "\<bar>d\<mu> fs'' i' j'\<bar> < p * d fs'' (Suc j')" using pge1
+              by (smt mult_less_cancel_right2)
+            then show ?thesis using pge1 LLL_d_pos[OF Linvw'' Sj'(2)] gtz unfolding d''_def
+              by (smt mult_less_cancel_left2 mult_right_less_imp_less)
+          next
+            case False
+            have "j' < m" using i' j' by simp
+            moreover have "j' > j" using False fls by simp
+            ultimately have "\<mu> fs' i' j' = \<mu> fs i' j'" using i' 04 i by simp
+            then have "d\<mu> fs' i' j' = d\<mu> fs i' j'" using d\<mu>_def i' j' 05 by simp
+            then have "d\<mu> fs'' i' j' = d\<mu> fs i' j'" using dmufs''fs' by simp
+            then show ?thesis using LLL_invD_modw[OF Linvmw] i' j' 25 by simp
+          qed
+        qed
+      next
+        case False
+        then have "(i',j') \<notin> I" using I_def by simp
+        then have dmufs''fs': "d\<mu> fs'' i' j' = d\<mu> fs' i' j'" using 17 i' j' by simp
+        have "\<mu> fs' i' j' = \<mu> fs i' j'" using i' 04 j' False by simp
+        then have "d\<mu> fs' i' j' = d\<mu> fs i' j'" using d\<mu>_def i' j' 05 by simp
+        moreover then have "d\<mu> fs'' i' j' = d\<mu> fs i' j'" using dmufs''fs' by simp
+        then show ?thesis using LLL_invD_modw[OF Linvmw] i' j' 25 by simp
+      qed
+    }
+    then show ?thesis by simp
+  qed
+  have 40: "(\<forall>i' < m. \<forall>j' < m. i' \<noteq> i \<or> j' > j \<longrightarrow> d\<mu> fs' i' j' = dmu $$ (i',j'))"
+  proof -
+    {
+      fix i' j'
+      assume i': "i' < m" and j': "j' < m"
+      assume assm: "i' \<noteq> i \<or> j' > j"
+      have "d\<mu> fs' i' j' = dmu $$ (i',j')"
+      proof (cases "i' \<noteq> i")
+        case True
+        then show ?thesis using fs'_def LLL_invD_modw[OF Linvmw] d\<mu>_def i i' j j'
+          04 28(1) LLL_invI_weak basis_reduction_add_row_main(8)[OF Linvww] by auto
+      next
+        case False
+        then show ?thesis 
+          using 05 LLL_invD_modw[OF Linvmw] d\<mu>_def i j j' 04 assm by simp
+      qed
+    }
+    then show ?thesis by simp
+  qed
+  have 41: "\<forall>j' \<le> j. d\<mu> fs' i j' = dmu $$ (i,j') - c * dmu $$ (j,j')"
+  proof -
+    {
+      let ?oi = "of_int :: _ \<Rightarrow> rat" 
+      fix j'
+      assume j': "j' \<le> j"
+      define dj' \<mu>i \<mu>j where "dj' = d fs (Suc j')" and "\<mu>i = \<mu> fs i j'" and "\<mu>j = \<mu> fs j j'"
+      have "?oi (d\<mu> fs' i j') = ?oi (d fs (Suc j')) * (\<mu> fs i j' - ?oi c * \<mu> fs j j')"
+        using j' 04 d\<mu>_def 
+        by (smt "05" "08" "091" Suc_leI d_def diff_diff_cancel fs_int.d_def 
+            fs_int_indpt.fs_int_mu_d_Z i int_of_rat(2) j less_imp_diff_less less_imp_le_nat)
+      also have "\<dots> = (?oi dj') * (\<mu>i - of_int c * \<mu>j)" 
+        using dj'_def \<mu>i_def \<mu>j_def by (simp add: of_rat_mult)
+      also have "\<dots> = (rat_of_int dj') * \<mu>i - of_int c * (rat_of_int dj') * \<mu>j" by algebra
+      also have "\<dots> = rat_of_int (d\<mu> fs i j') - ?oi c * rat_of_int (d\<mu> fs j j')" unfolding dj'_def \<mu>i_def \<mu>j_def
+        using i j j' d\<mu>_def
+        using "28"(1) LLL.LLL_invD_modw(4) Linvmw d_def fs_int.d_def fs_int_indpt.fs_int_mu_d_Z fs_int_indpt.intro by auto
+      also have "\<dots> = rat_of_int (dmu $$ (i,j')) - ?oi c * rat_of_int (dmu $$ (j,j'))" 
+        using LLL_invD_modw(7)[OF Linvmw] d\<mu>_def j' i j by auto
+      finally have "?oi (d\<mu> fs' i j') = rat_of_int (dmu $$ (i,j')) - ?oi c * rat_of_int (dmu $$ (j,j'))" by simp
+      then have "d\<mu> fs' i j' = dmu $$ (i,j') - c * dmu $$ (j,j')"
+        using of_int_eq_iff by fastforce
+    }
+    then show ?thesis by simp
+  qed
+  have 42: "(\<forall>i' < m. \<forall>j' < m. d\<mu> fs'' i' j' = dmu' $$ (i',j'))"
+  proof -
+    {
+      fix i' j'
+      assume i': "i' < m" and j': "j' < m"
+      have "d\<mu> fs'' i' j' = dmu' $$ (i',j')" 
+      proof (cases "i' = i")
+        case i'i: True
+        then show ?thesis
+        proof (cases "j' > j")
+          case True
+          then have "(i',j')\<notin>I" using I_def by simp
+          moreover then have "d\<mu> fs' i' j' = d\<mu> fs i' j'" using "04" "05" True Suc_leI d\<mu>_def i' j' by simp
+          moreover have "dmu' $$ (i',j') = dmu $$ (i',j')" using dmu' True i' j' by simp
+          ultimately show ?thesis using "17" "40" True i' j' by auto
+        next
+          case False
+          then have j'lej: "j' \<le> j" by simp
+          then have eq': "d\<mu> fs' i j' = dmu $$ (i,j') - c * dmu $$ (j,j')" using 41 by simp
+          have id: "d_of dmu j' = d fs j'" "d_of dmu (Suc j') = d fs (Suc j')" 
+            using d_of_weak[OF Linvmw] \<open>j' < m\<close> by auto
+          show ?thesis
+          proof (cases "j' \<noteq> j")
+            case True
+            then have j'ltj: "j' < j" using True False by simp
+            then have "(i',j') \<in> I" using I_def True i'i by simp
+            then have "d\<mu> fs'' i' j' = 
+              (dmu $$ (i,j') - c * dmu $$ (j,j')) symmod (p * d fs' j' * d fs' (Suc j'))"
+              using 17 i' 41 j'lej by (simp add: j' i'i)
+            also have "\<dots> = (dmu $$ (i,j') - c * dmu $$ (j,j')) symmod (p * d fs j' * d fs (Suc j'))"
+              using 05 i j'ltj j by simp
+            also have "\<dots> = dmu' $$ (i,j')" 
+              unfolding dmu' index_mat(1)[OF \<open>i < m\<close> \<open>j' < m\<close>] split id using j'lej True by auto
+            finally show ?thesis using i'i by simp
+          next
+            case False
+            then have j'j: "j' = j" by simp
+            then have "d\<mu> fs'' i j' = d\<mu> fs' i j'" using 20 j' by simp
+            also have "\<dots> = dmu $$ (i,j') - c * dmu $$ (j,j')" using eq' by simp
+            also have "\<dots> = dmu' $$ (i,j')" using dmu' j'j i j' by simp
+            finally show ?thesis using i'i by simp
+          qed
+        qed
+      next
+        case False
+        then have "(i',j')\<notin>I" using I_def by simp
+        moreover then have "d\<mu> fs' i' j' = d\<mu> fs i' j'" by (simp add: "04" "05" False Suc_leI d\<mu>_def i' j')
+        moreover then have "dmu' $$ (i',j') = dmu $$ (i',j')" using dmu' False i' j' by simp
+        ultimately show ?thesis using "17" "40" False i' j' by auto
+      qed
+    }
+    then show ?thesis by simp
+  qed
+  from gbnd 26 have gbnd: "g_bnd_mode first b fs''" using g_bnd_mode_cong[of fs'' fs] by simp
+  {
+    assume Linv: "LLL_invariant_mod fs mfs dmu p first b i"
+    have Linvw: "LLL_invariant_weak' i fs" using Linv LLL_invD_mod LLL_invI_weak by simp
+    note Linvww = LLL_invw'_imp_w[OF Linvw]
+    have 00: "LLL_invariant_weak' i fs'" using Linvw basis_reduction_add_row_weak[OF Linvw i j fs'_def] by auto
+    have 37: "weakly_reduced fs'' i" using 15 LLL_invD_weak(8)[OF 00] gram_schmidt_fs.weakly_reduced_def 
+      by (smt Suc_lessD i less_trans_Suc) (* invariant req. *)
+    have 38: "LLL_invariant_weak' i fs''"
+      using 00 11 14 36 37 i 31 12  LLL_invariant_weak'_def by blast
+    have "LLL_invariant_mod fs'' mfs' dmu' p first b i"
+      using LLL_invI_mod[OF 33 _ 14 11 13 37 35 39 42 p1 gbnd LLL_invD_mod(17)[OF Linv]] i by simp
+  }
+  moreover have "LLL_invariant_mod_weak fs'' mfs' dmu' p first b"
+    using LLL_invI_modw[OF 33 14 11 13 35 39 42 p1 gbnd LLL_invD_modw(15)[OF Linvmw]] by simp
+  ultimately show ?thesis using 27 23 24 25 26 172 by auto
+qed
+
+definition D_mod :: "int mat \<Rightarrow> nat" where "D_mod dmu = nat (\<Prod> i < m. d_of dmu i)"
+
+definition logD_mod :: "int mat \<Rightarrow> nat"
+  where "logD_mod dmu = (if \<alpha> = 4/3 then (D_mod dmu) else nat (floor (log (1 / of_rat reduction) (D_mod dmu))))" 
+end
+
+locale fs_int'_mod = 
+  fixes n m fs_init \<alpha> i fs mfs dmu p first b 
+  assumes LLL_inv_mod: "LLL.LLL_invariant_mod n m fs_init \<alpha> fs mfs dmu p first b i"
+
+context LLL_with_assms
+begin
+
+lemma basis_reduction_swap_weak': assumes Linvw: "LLL_invariant_weak' i fs"
+  and i: "i < m"
+  and i0: "i \<noteq> 0"
+  and mu_F1_i: "\<bar>\<mu> fs i (i-1)\<bar> \<le> 1 / 2"
+  and norm_ineq: "sq_norm (gso fs (i - 1)) > \<alpha> * sq_norm (gso fs i)" 
+  and fs'_def: "fs' = fs[i := fs ! (i - 1), i - 1 := fs ! i]" 
+shows "LLL_invariant_weak' (i - 1) fs'" 
+proof -
+  note inv = LLL_invD_weak[OF Linvw]
+  note invw = LLL_invw'_imp_w[OF Linvw]
+  note main = basis_reduction_swap_main[OF invw disjI2[OF mu_F1_i] i i0 norm_ineq fs'_def]
+  note inv' = LLL_inv_wD[OF main(1)]
+  from \<open>weakly_reduced fs i\<close> have "weakly_reduced fs (i - 1)" 
+    unfolding gram_schmidt_fs.weakly_reduced_def by auto
+  also have "weakly_reduced fs (i - 1) = weakly_reduced fs' (i - 1)" 
+    unfolding gram_schmidt_fs.weakly_reduced_def 
+    by (intro all_cong, insert i0 i main(5), auto)
+  finally have red: "weakly_reduced fs' (i - 1)" .
+  show "LLL_invariant_weak' (i - 1) fs'" using i
+    by (intro LLL_invI_weak red inv', auto)
+qed
+
+lemma basis_reduction_add_row_done_weak: 
+  assumes Linv: "LLL_invariant_weak' i fs"
+  and i: "i < m" 
+  and mu_small: "\<mu>_small_row i fs 0" 
+shows "\<mu>_small fs i"
+proof -
+  note inv = LLL_invD_weak[OF Linv]
+  from mu_small 
+  have mu_small: "\<mu>_small fs i" unfolding \<mu>_small_row_def \<mu>_small_def by auto
+  show ?thesis
+    using i mu_small LLL_invI_weak[OF inv(3,6,7,9,1)] by auto
+qed     
+
+lemma LLL_invariant_mod_to_weak_m_to_i: assumes
+  inv: "LLL_invariant_mod fs mfs dmu p first b m"
+  and i: "i \<le> m"
+shows "LLL_invariant_mod fs mfs dmu p first b i"
+  "LLL_invariant_weak' m fs"
+  "LLL_invariant_weak' i fs"
+proof -
+  show "LLL_invariant_mod fs mfs dmu p first b i" 
+  proof -
+    have "LLL_invariant_weak' m fs" using LLL_invD_mod[OF inv] LLL_invI_weak by simp
+    then have "LLL_invariant_weak' i fs" using LLL_inv_weak_m_impl_i i by simp
+    then have "weakly_reduced fs i" using i LLL_invD_weak(8) by simp
+    then show ?thesis using LLL_invD_mod[OF inv] LLL_invI_mod i by simp
+  qed
+  then show fsinvwi: "LLL_invariant_weak' i fs" using LLL_invD_mod LLL_invI_weak by simp
+  show "LLL_invariant_weak' m fs" using LLL_invD_mod[OF inv] LLL_invI_weak by simp
+qed
+
+lemma basis_reduction_mod_swap_main: 
+  assumes Linvmw: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and k: "k < m"
+  and k0: "k \<noteq> 0"
+  and mu_F1_i: "\<bar>\<mu> fs k (k-1)\<bar> \<le> 1 / 2"
+  and norm_ineq: "sq_norm (gso fs (k - 1)) > \<alpha> * sq_norm (gso fs k)" 
+  and mfs'_def: "mfs' = mfs[k := mfs ! (k - 1), k - 1 := mfs ! k]"
+  and dmu'_def: "dmu' = (mat m m (\<lambda>(i,j). (
+      if j < i then
+        if i = k - 1 then 
+           dmu $$ (k, j)
+        else if i = k \<and> j \<noteq> k - 1 then 
+             dmu $$ (k - 1, j)
+        else if i > k \<and> j = k then
+           ((d_of dmu (Suc k)) * dmu $$ (i, k - 1) - dmu $$ (k, k - 1) * dmu $$ (i, j)) 
+              div (d_of dmu k)
+        else if i > k \<and> j = k - 1 then
+           (dmu $$ (k, k - 1) * dmu $$ (i, j) + dmu $$ (i, k) * (d_of dmu (k-1)))
+              div (d_of dmu k)
+        else dmu $$ (i, j)
+      else if i = j then 
+        if i = k - 1 then 
+          ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) 
+            div (d_of dmu k)
+        else (d_of dmu (Suc i))
+      else dmu $$ (i, j))
+    ))"
+  and dmu'_mod_def: "dmu'_mod = mat m m (\<lambda>(i, j). (
+        if j < i \<and> (j = k \<or> j = k - 1) then 
+          dmu' $$ (i, j) symmod (p * (d_of dmu' j) * (d_of dmu' (Suc j)))
+        else dmu' $$ (i, j)))"
+shows "(\<exists>fs'. LLL_invariant_mod_weak fs' mfs' dmu'_mod p first b \<and>
+        LLL_measure (k-1) fs' < LLL_measure k fs \<and>
+        (LLL_invariant_mod fs mfs dmu p first b k \<longrightarrow> LLL_invariant_mod fs' mfs' dmu'_mod p first b (k-1)))" 
+proof - 
+  define fs' where "fs' = fs[k := fs ! (k - 1), k - 1 := fs ! k]"
+  have pgtz: "p > 0" and p1: "p > 1" using LLL_invD_modw[OF Linvmw] by auto
+  have invw: "LLL_invariant_weak fs" using LLL_invD_modw[OF Linvmw] LLL_invariant_weak_def by simp
+  note swap_main = basis_reduction_swap_main(3-)[OF invw disjI2[OF mu_F1_i] k k0 norm_ineq fs'_def]
+  note dd\<mu>_swap = d_d\<mu>_swap[OF invw disjI2[OF mu_F1_i] k k0 norm_ineq fs'_def]
+  have invw': "LLL_invariant_weak fs'" using fs'_def assms invw basis_reduction_swap_main(1) by simp
+  have 02: "LLL_measure k fs > LLL_measure (k - 1) fs'" by fact
+  have 03: "\<And> i j. i < m \<Longrightarrow> j < i \<Longrightarrow> 
+          d\<mu> fs' i j = (
+        if i = k - 1 then 
+           d\<mu> fs k j
+        else if i = k \<and> j \<noteq> k - 1 then 
+             d\<mu> fs (k - 1) j
+        else if i > k \<and> j = k then
+           (d fs (Suc k) * d\<mu> fs i (k - 1) - d\<mu> fs k (k - 1) * d\<mu> fs i j) div d fs k
+        else if i > k \<and> j = k - 1 then 
+           (d\<mu> fs k (k - 1) * d\<mu> fs i j + d\<mu> fs i k * d fs (k - 1)) div d fs k
+        else d\<mu> fs i j)"
+    using dd\<mu>_swap by auto
+  have 031: "\<And>i. i < k-1 \<Longrightarrow> gso fs' i = gso fs i" 
+    using swap_main(2) k k0 by auto
+  have 032: "\<And> ii. ii \<le> m \<Longrightarrow> of_int (d fs' ii) = (if ii = k then 
+           sq_norm (gso fs' (k - 1)) / sq_norm (gso fs (k - 1)) * of_int (d fs k)
+           else of_int (d fs ii))" 
+    by fact 
+  have gbnd: "g_bnd_mode first b fs'"
+  proof (cases "first \<and> m \<noteq> 0")
+    case True
+    have "sq_norm (gso fs' 0) \<le> sq_norm (gso fs 0)" 
+    proof (cases "k - 1 = 0")
+      case False
+      thus ?thesis using 031[of 0] by simp
+    next
+      case *: True
+      have k_1: "k - 1 < m" using k by auto
+      from * k0 have k1: "k = 1" by simp
+      (* this is a copy of what is done in LLL.swap-main, should be made accessible in swap-main *)
+      have "sq_norm (gso fs' 0) \<le> abs (sq_norm (gso fs' 0))" by simp
+      also have "\<dots> = abs (sq_norm (gso fs 1) + \<mu> fs 1 0 * \<mu> fs 1 0 * sq_norm (gso fs 0))" 
+        by (subst swap_main(3)[OF k_1, unfolded *], auto simp: k1)
+      also have "\<dots> \<le> sq_norm (gso fs 1) + abs (\<mu> fs 1 0) * abs (\<mu> fs 1 0) * sq_norm (gso fs 0)"
+        by (simp add: sq_norm_vec_ge_0)
+      also have "\<dots> \<le> sq_norm (gso fs 1) + (1 / 2) * (1 / 2) * sq_norm (gso fs 0)" 
+        using mu_F1_i[unfolded k1] 
+        by (intro plus_right_mono mult_mono, auto)
+      also have "\<dots> < 1 / \<alpha> * sq_norm (gso fs 0) + (1 / 2) * (1 / 2) * sq_norm (gso fs 0)" 
+        by (intro add_strict_right_mono, insert norm_ineq[unfolded mult.commute[of \<alpha>],
+          THEN mult_imp_less_div_pos[OF \<alpha>0(1)]] k1, auto)
+      also have "\<dots> = reduction * sq_norm (gso fs 0)" unfolding reduction_def
+        using \<alpha>0 by (simp add: ring_distribs add_divide_distrib)
+      also have "\<dots> \<le> 1 * sq_norm (gso fs 0)" using reduction(2)
+        by (intro mult_right_mono, auto)
+      finally show ?thesis by simp
+    qed
+    thus ?thesis using LLL_invD_modw(14)[OF Linvmw] True
+      unfolding g_bnd_mode_def by auto
+  next
+    case False
+    from LLL_invD_modw(14)[OF Linvmw] False have "g_bnd b fs" unfolding g_bnd_mode_def by auto
+    hence "g_bnd b fs'" using g_bnd_swap[OF k k0 invw mu_F1_i norm_ineq fs'_def] by simp
+    thus ?thesis using False unfolding g_bnd_mode_def by auto
+  qed
+  note d_of = d_of_weak[OF Linvmw]
+  have 033: "\<And> i. i < m \<Longrightarrow> d\<mu> fs' i i = (
+            if i = k - 1 then 
+             ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) 
+                div (d_of dmu k)
+            else (d_of dmu (Suc i)))"  
+  proof -
+    fix i
+    assume i: "i < m"
+    have "d\<mu> fs' i i = d fs' (Suc i)" using dd\<mu> i by simp
+    also have "\<dots> = (if i = k - 1 then 
+          (d fs (Suc k) * d fs (k - 1) + d\<mu> fs k (k - 1) * d\<mu> fs k (k - 1)) div d fs k 
+        else d fs (Suc i))"
+      by (subst dd\<mu>_swap, insert dd\<mu> k0 i, auto)
+    also have "\<dots> = (if i = k - 1 then 
+        ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) 
+          div (d_of dmu k)
+       else (d_of dmu (Suc i)))" (is "_ = ?r") 
+      using d_of i k LLL_invD_modw(7)[OF Linvmw] by auto
+    finally show "d\<mu> fs' i i = ?r" .
+  qed
+  have 04: "lin_indep fs'" "length fs' = m" "lattice_of fs' = L" using LLL_inv_wD[OF invw'] by auto
+  define I where "I = {(i, j). i < m \<and> j < i \<and> (j = k \<or> j = k - 1)}"
+  then have Isubs: "I \<subseteq> {(i,j). i < m \<and> j < i}" using k k0 by auto
+  obtain fs'' where 
+    05: "lattice_of fs'' = L" and
+    06: "map (map_vec (\<lambda> x. x symmod p)) fs'' = map (map_vec (\<lambda> x. x symmod p)) fs'" and
+    07: "lin_indep fs''" and
+    08: "length fs'' = m" and
+    09: "(\<forall> k < m. gso fs'' k = gso fs' k)" and
+    10: "(\<forall> k \<le> m. d fs'' k = d fs' k)" and
+    11: "(\<forall> i' < m. \<forall> j' < m. d\<mu> fs'' i' j' = 
+           (if (i',j') \<in> I then d\<mu> fs' i' j' symmod (p * d fs' j' * d fs' (Suc j')) else d\<mu> fs' i' j'))"
+    using mod_finite_set[OF 04(1) 04(2) Isubs 04(3) pgtz] by blast
+  have 13: "length mfs' = m" using mfs'_def LLL_invD_modw(1)[OF Linvmw] by simp (* invariant requirement *)
+  have 14: "map (map_vec (\<lambda> x. x symmod p)) fs'' = mfs'"  (* invariant requirement *)
+    using 06 fs'_def k k0 04(2) LLL_invD_modw(5)[OF Linvmw]
+    by (metis (no_types, lifting) length_list_update less_imp_diff_less map_update mfs'_def nth_map)
+  have "LLL_measure (k - 1) fs'' = LLL_measure (k - 1) fs'" using 10 LLL_measure_def logD_def D_def by simp
+  then have 15: "LLL_measure (k - 1) fs'' < LLL_measure k fs" using 02 by simp (* goal *)
+  {
+    fix i' j'
+    assume i'j': "i'<m" "j'<i'" 
+      and neq: "j' \<noteq> k" "j' \<noteq> k - 1"
+    hence j'k: "j' \<noteq> k" "Suc j' \<noteq> k" using k0 by auto
+    hence "d fs'' j' = d fs j'" "d fs'' (Suc j') = d fs (Suc j')" 
+      using \<open>k < m\<close> i'j' k0
+        10[rule_format, of j'] 032[rule_format, of j']
+        10[rule_format, of "Suc j'"] 032[rule_format, of "Suc j'"] 
+      by auto
+  } note d_id = this
+
+  have 16: "\<forall>i'<m. \<forall>j'<i'. \<bar>d\<mu> fs'' i' j'\<bar> < p * d fs'' j' * d fs'' (Suc j')" (* invariant requirement *)
+  proof -
+    {
+      fix i' j'
+      assume i'j': "i'<m" "j'<i'"
+      have "\<bar>d\<mu> fs'' i' j'\<bar> < p * d fs'' j' * d fs'' (Suc j')"
+      proof (cases "(i',j') \<in> I")
+        case True
+        define pdd where "pdd = (p * d fs' j' * d fs' (Suc j'))"
+        have pdd_pos: "pdd > 0" using pgtz i'j' LLL_d_pos[OF invw'] pdd_def by simp
+        have "d\<mu> fs'' i' j' = d\<mu> fs' i' j' symmod pdd" using True 11 i'j' pdd_def by simp
+        then have "\<bar>d\<mu> fs'' i' j'\<bar> < pdd" using True 11 i'j' pdd_pos sym_mod_abs by simp
+        then show ?thesis unfolding pdd_def using 10 i'j' by simp
+      next
+        case False
+        from False[unfolded I_def] i'j' have neg: "j' \<noteq> k" "j' \<noteq> k - 1" by auto
+        
+        consider (1) "i' = k - 1 \<or> i' = k" | (2) "\<not> (i' = k - 1 \<or> i' = k)"  
+          using False i'j' unfolding I_def by linarith
+        thus ?thesis
+        proof cases
+          case **: 1
+          let ?i'' = "if i' = k - 1 then k else k -1" 
+          from ** neg i'j' have i'': "?i'' < m" "j' < ?i''" using k0 k by auto
+          have "d\<mu> fs'' i' j' = d\<mu> fs' i' j'" using 11 False i'j' by simp
+          also have "\<dots> = d\<mu> fs ?i'' j'" unfolding 03[OF \<open>i' < m\<close> \<open>j' < i'\<close>]
+            using ** neg by auto
+          finally show ?thesis using LLL_invD_modw(6)[OF Linvmw, rule_format, OF i''] unfolding d_id[OF i'j' neg] by auto
+        next
+          case **: 2
+          hence neq: "j' \<noteq> k" "j' \<noteq> k - 1" using False k k0 i'j' unfolding I_def by auto
+          have "d\<mu> fs'' i' j' = d\<mu> fs' i' j'" using 11 False i'j' by simp
+          also have "\<dots> = d\<mu> fs i' j'" unfolding 03[OF \<open>i' < m\<close> \<open>j' < i'\<close>] using ** neq by auto
+          finally show ?thesis using LLL_invD_modw(6)[OF Linvmw, rule_format, OF i'j'] using d_id[OF i'j' neq] by auto
+        qed
+      qed
+    }
+    then show ?thesis by simp
+  qed
+  have 17: "\<forall>i'<m. \<forall>j'<m. d\<mu> fs'' i' j' = dmu'_mod $$ (i', j')" (* invariant requirement *)
+  proof -
+    {
+      fix i' j'
+      assume i'j': "i'<m" "j'<i'"
+      have d'dmu': "\<forall>j' < m. d fs' (Suc j') = dmu' $$ (j', j')" using dd\<mu> dmu'_def 033 by simp
+      have eq': "d\<mu> fs' i' j' = dmu' $$ (i', j')"
+      proof -
+        have t00: "d\<mu> fs k j' = dmu $$ (k, j')" and
+          t01: "d\<mu> fs (k - 1) j' =  dmu $$ (k - 1, j')" and
+          t04: "d\<mu> fs k (k - 1) = dmu $$ (k, k - 1)" and
+          t05: "d\<mu> fs i' k = dmu $$ (i', k)"
+          using LLL_invD_modw(7)[OF Linvmw] i'j' k dd\<mu> k0 by auto 
+        have t03: "d fs k = d\<mu> fs (k-1) (k-1)" using k0 k by (metis LLL.dd\<mu> Suc_diff_1 lessI not_gr_zero)
+        have t06: "d fs (k - 1) = (d_of dmu (k-1))" using d_of k by auto
+        have t07: "d fs k = (d_of dmu k)" using d_of k by auto
+        have j': "j' < m" using i'j' by simp
+        have "d\<mu> fs' i' j' = (if i' = k - 1 then 
+                   dmu $$ (k, j')
+                else if i' = k \<and> j' \<noteq> k - 1 then 
+                   dmu $$ (k - 1, j')
+                else if i' > k \<and> j' = k then
+                   (dmu $$ (k, k) * dmu $$ (i', k - 1) - dmu $$ (k, k - 1) * dmu $$ (i', j')) div (d_of dmu k)
+                else if i' > k \<and> j' = k - 1 then 
+                   (dmu $$ (k, k - 1) * dmu $$ (i', j') + dmu $$ (i', k) * d fs (k - 1)) div (d_of dmu k)
+                else dmu $$ (i', j'))"
+          using dd\<mu> k t00 t01 t03 LLL_invD_modw(7)[OF Linvmw] k i'j' j' 03 t07 by simp
+        then show ?thesis using dmu'_def i'j' j' t06 t07 by (simp add: d_of_def)
+      qed
+      have "d\<mu> fs'' i' j' = dmu'_mod $$ (i', j')"
+      proof (cases "(i',j') \<in> I")
+        case i'j'I: True
+        have j': "j' < m" using i'j' by simp
+        show ?thesis
+        proof -
+          have "dmu'_mod $$ (i',j') = dmu' $$ (i',j') 
+                  symmod (p * (d_of dmu' j') * (d_of dmu' (Suc j')))"
+            using dmu'_mod_def i'j' i'j'I I_def by simp
+          also have "d_of dmu' j' = d fs' j'" 
+            using j' d'dmu' d_def Suc_diff_1 less_imp_diff_less unfolding d_of_def 
+            by (cases j', auto)
+          finally have "dmu'_mod $$ (i',j') = dmu' $$ (i',j') symmod (p * d fs' j' * d fs' (Suc j'))"
+            using dd\<mu>[OF j'] d'dmu' j' by (auto simp: d_of_def)
+          then show ?thesis using i'j'I 11 i'j' eq' by simp
+        qed
+      next
+        case False
+        have "d\<mu> fs'' i' j' = d\<mu> fs' i' j'" using False 11 i'j' by simp
+        also have "\<dots> = dmu' $$ (i', j')" unfolding eq' ..
+        finally show ?thesis unfolding dmu'_mod_def using False[unfolded I_def] i'j' by auto
+      qed
+    }
+    moreover have "\<forall>i' j'. i' < m \<longrightarrow> j' < m \<longrightarrow> i' = j' \<longrightarrow> d\<mu> fs'' i' j' = dmu'_mod $$ (i', j')" 
+      using dd\<mu> dmu'_def 033 10 dmu'_mod_def 11 I_def by simp
+    moreover {
+      fix i' j'
+      assume i'j'': "i' < m" "j' < m" "i' < j'"
+      then have \<mu>z: "\<mu> fs'' i' j' = 0" by (simp add: gram_schmidt_fs.\<mu>.simps)
+      have "dmu'_mod $$ (i',j') = dmu' $$ (i',j')" using dmu'_mod_def i'j'' by auto
+      also have "\<dots> = d\<mu> fs i' j'" using LLL_invD_modw(7)[OF Linvmw] i'j'' dmu'_def by simp
+      also have "\<dots> = 0" using d\<mu>_def i'j'' by (simp add: gram_schmidt_fs.\<mu>.simps)
+      finally have "d\<mu> fs'' i' j' =  dmu'_mod $$ (i',j')" using \<mu>z d_def i'j'' d\<mu>_def by simp
+    }
+    ultimately show ?thesis by (meson nat_neq_iff)
+  qed
+  from gbnd 09 have g_bnd: "g_bnd_mode first b fs''" using g_bnd_mode_cong[of fs' fs''] by auto
+  {
+    assume Linv: "LLL_invariant_mod fs mfs dmu p first b k"
+    have 00: "LLL_invariant_weak' k fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp
+    note swap_weak' = basis_reduction_swap_weak'[OF 00 k k0 mu_F1_i norm_ineq fs'_def]
+    have 01: "LLL_invariant_weak' (k - 1) fs'" by fact
+    have 12: "weakly_reduced fs'' (k-1)" (* invariant requirement *)
+      using 031 09 k LLL_invD_weak(8)[OF 00] unfolding gram_schmidt_fs.weakly_reduced_def by simp
+    have "LLL_invariant_mod fs'' mfs' dmu'_mod p first b (k-1)" 
+      using LLL_invI_mod[OF 13 _ 08 05 07 12 14 16 17 p1 g_bnd LLL_invD_mod(17)[OF Linv]] k by simp
+  }
+  moreover have "LLL_invariant_mod_weak fs'' mfs' dmu'_mod p first b"
+    using LLL_invI_modw[OF 13 08 05 07 14 16 17 p1 g_bnd LLL_invD_modw(15)[OF Linvmw]] by simp
+  ultimately show ?thesis using 15 by auto
+qed
+
+lemma dmu_quot_is_round_of_\<mu>:
+  assumes Linv: "LLL_invariant_mod fs mfs dmu p first b i'"
+    and c: "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" 
+    and i: "i < m"
+    and j: "j < i"
+  shows "c = round(\<mu> fs i j)" 
+proof -
+  have Linvw: "LLL_invariant_weak' i' fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp
+  have j2: "j < m" using i j by simp
+  then have j3: "Suc j \<le> m" by simp
+  have \<mu>1: "\<mu> fs j j = 1" using i j by (meson gram_schmidt_fs.\<mu>.elims less_irrefl_nat)
+  have inZ: "rat_of_int (d fs (Suc j)) * \<mu> fs i j \<in> \<int>" using fs_int_indpt.fs_int_mu_d_Z_m_m i j
+      LLL_invD_mod(5)[OF Linv] LLL_invD_weak(2) Linvw d_def fs_int.d_def fs_int_indpt.intro by auto
+  have "c = round(rat_of_int (d\<mu> fs i j) / rat_of_int (d\<mu> fs j j))" using LLL_invD_mod(9) Linv i j c 
+    by (simp add: round_num_denom d_of_def)
+  then show ?thesis using LLL_d_pos[OF LLL_invw'_imp_w[OF Linvw] j3] j i inZ d\<mu>_def \<mu>1 by simp
+qed
+
+lemma dmu_quot_is_round_of_\<mu>_weak:
+  assumes Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+    and c: "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" 
+    and i: "i < m"
+    and j: "j < i"
+  shows "c = round(\<mu> fs i j)" 
+proof -
+  have Linvww: "LLL_invariant_weak fs" using LLL_invD_modw[OF Linv] LLL_invariant_weak_def by simp
+  have j2: "j < m" using i j by simp
+  then have j3: "Suc j \<le> m" by simp
+  have \<mu>1: "\<mu> fs j j = 1" using i j by (meson gram_schmidt_fs.\<mu>.elims less_irrefl_nat)
+  have inZ: "rat_of_int (d fs (Suc j)) * \<mu> fs i j \<in> \<int>" using fs_int_indpt.fs_int_mu_d_Z_m_m i j
+      LLL_invD_modw[OF Linv] d_def fs_int.d_def fs_int_indpt.intro by auto
+  have "c = round(rat_of_int (d\<mu> fs i j) / rat_of_int (d\<mu> fs j j))" using LLL_invD_modw(7) Linv i j c 
+    by (simp add: round_num_denom d_of_def)
+  then show ?thesis using LLL_d_pos[OF Linvww j3] j i inZ d\<mu>_def \<mu>1 by simp
+qed  
+
+lemma basis_reduction_mod_add_row: assumes 
+  Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  and res: "basis_reduction_mod_add_row p mfs dmu i j = (mfs', dmu')" 
+  and i: "i < m"
+  and j: "j < i"
+  and igtz: "i \<noteq> 0"
+shows "(\<exists>fs'. LLL_invariant_mod_weak fs' mfs' dmu' p first b \<and>
+        LLL_measure i fs' = LLL_measure i fs \<and>
+        (\<mu>_small_row i fs (Suc j) \<longrightarrow> \<mu>_small_row i fs' j) \<and>
+        \<bar>\<mu> fs' i j\<bar> \<le> 1 / 2 \<and>
+        (\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs' i' j' = \<mu> fs i' j') \<and>
+        (LLL_invariant_mod fs mfs dmu p first b i \<longrightarrow> LLL_invariant_mod fs' mfs' dmu' p first b i) \<and>
+        (\<forall>ii \<le> m. d fs' ii = d fs ii))"
+proof -
+  define c where "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" 
+  then have c: "c = round(\<mu> fs i j)" using dmu_quot_is_round_of_\<mu>_weak[OF Linv c_def i j] by simp
+  show ?thesis
+  proof (cases "c = 0")
+    case True
+    then have pair_id: "(mfs', dmu') = (mfs, dmu)" 
+      using res c_def unfolding basis_reduction_mod_add_row_def Let_def by auto
+    moreover have "\<bar>\<mu> fs i j\<bar> \<le> inverse 2" using c[symmetric, unfolded True] 
+      by (simp add: round_def, linarith)
+    moreover then have "(\<mu>_small_row i fs (Suc j) \<longrightarrow> \<mu>_small_row i fs j)" 
+      unfolding \<mu>_small_row_def using Suc_leI le_neq_implies_less by blast
+    ultimately show ?thesis using Linv pair_id by auto
+  next
+    case False
+    then have pair_id: "(mfs', dmu') = (mfs[i := map_vec (\<lambda>x. x symmod p) (mfs ! i - c \<cdot>\<^sub>v mfs ! j)],
+                mat m m (\<lambda>(i', j'). if i' = i \<and> j' \<le> j
+                  then if j' = j then dmu $$ (i, j') - c * dmu $$ (j, j')
+                       else (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+                              symmod (p * (d_of dmu j') * (d_of dmu (Suc j')))
+                  else dmu $$ (i', j')))" 
+      using res c_def unfolding basis_reduction_mod_add_row_def Let_def by auto
+    then have mfs': "mfs' = mfs[i := map_vec (\<lambda>x. x symmod p) (mfs ! i - c \<cdot>\<^sub>v mfs ! j)]"
+      and dmu': "dmu' = mat m m (\<lambda>(i', j'). if i' = i \<and> j' \<le> j
+                  then if j' = j then dmu $$ (i, j') - c * dmu $$ (j, j')
+                       else (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+                              symmod (p * (d_of dmu j') * (d_of dmu (Suc j')))
+                  else dmu $$ (i', j'))" by auto
+    show ?thesis using basis_reduction_mod_add_row_main[OF Linv i j c mfs' dmu'] by blast
+  qed
+qed
+
+lemma basis_reduction_mod_swap: assumes
+  Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and mu: "\<bar>\<mu> fs k (k-1)\<bar> \<le> 1 / 2"
+  and res: "basis_reduction_mod_swap p mfs dmu k = (mfs', dmu'_mod)" 
+  and cond: "sq_norm (gso fs (k - 1)) > \<alpha> * sq_norm (gso fs k)"
+  and i: "k < m" "k \<noteq> 0" 
+shows "(\<exists>fs'. LLL_invariant_mod_weak fs' mfs' dmu'_mod p first b \<and>
+        LLL_measure (k - 1) fs' < LLL_measure k fs \<and>
+        (LLL_invariant_mod fs mfs dmu p first b k \<longrightarrow> LLL_invariant_mod fs' mfs' dmu'_mod p first b (k-1)))"
+  using res[unfolded basis_reduction_mod_swap_def basis_reduction_mod_swap_dmu_mod_def] 
+    basis_reduction_mod_swap_main[OF Linv i mu cond] by blast
+
+lemma basis_reduction_adjust_mod: assumes 
+  Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  and res: "basis_reduction_adjust_mod p first mfs dmu = (p', mfs', dmu', g_idx')" 
+shows "(\<exists>fs' b'. (LLL_invariant_mod fs mfs dmu p first b i \<longrightarrow> LLL_invariant_mod fs' mfs' dmu' p' first b' i) \<and>
+       LLL_invariant_mod_weak fs' mfs' dmu' p' first b' \<and>
+       LLL_measure i fs' = LLL_measure i fs)"
+proof (cases "\<exists> g_idx. basis_reduction_adjust_mod p first mfs dmu = (p, mfs, dmu, g_idx)")
+  case True
+  thus ?thesis using res Linv by auto
+next
+  case False
+  obtain b' g_idx where norm: "compute_max_gso_norm first dmu = (b', g_idx)" by force
+  define p'' where "p'' = compute_mod_of_max_gso_norm first b'" 
+  define d_vec where "d_vec = vec (Suc m) (\<lambda>i. d_of dmu i)" 
+  define mfs'' where "mfs'' = map (map_vec (\<lambda>x. x symmod p'')) mfs"  
+  define dmu'' where "dmu'' = mat m m (\<lambda>(i, j).
+                   if j < i then dmu $$ (i, j) symmod (p'' * d_vec $ j * d_vec $ Suc j)
+                   else dmu $$ (i, j))" 
+  note res = res False
+  note res = res[unfolded basis_reduction_adjust_mod.simps Let_def norm split, 
+      folded p''_def, folded d_vec_def mfs''_def, folded dmu''_def]
+  from res have pp': "p'' < p" and id: "dmu' = dmu''" "mfs' = mfs''" "p' = p''" "g_idx' = g_idx"
+    by (auto split: if_splits)
+  define I where "I = {(i',j'). i' < m \<and> j' < i'}"
+  note inv = LLL_invD_modw[OF Linv]
+  from inv(4) have lin: "gs.lin_indpt_list (RAT fs)" .
+  from inv(3) have lat: "lattice_of fs = L" .
+  from inv(2) have len: "length fs = m" .
+  have weak: "LLL_invariant_weak fs" using Linv
+    by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_weak_def)
+  from compute_max_gso_norm[OF _ weak, of dmu first, unfolded norm] inv(7)
+  have bnd: "g_bnd_mode first b' fs" and b': "b' \<ge> 0" "m = 0 \<Longrightarrow> b' = 0" by auto
+  from compute_mod_of_max_gso_norm[OF b' p''_def] 
+  have p'': "0 < p''" "1 < p''" "mod_invariant b' p'' first" 
+    by auto
+  obtain fs' where 
+    01: "lattice_of fs' = L" and
+    02: "map (map_vec (\<lambda> x. x symmod p'')) fs' = map (map_vec (\<lambda> x. x symmod p'')) fs" and
+    03: "lin_indep fs'" and
+    04: "length fs' = m" and
+    05: "(\<forall> k < m. gso fs' k = gso fs k)" and
+    06: "(\<forall> k \<le> m. d fs' k = d fs k)" and
+    07: "(\<forall> i' < m. \<forall> j' < m. d\<mu> fs' i' j' = 
+      (if (i',j') \<in> I then d\<mu> fs i' j' symmod (p'' * d fs j' * d fs (Suc j')) else d\<mu> fs i' j'))"
+    using mod_finite_set[OF lin len _ lat, of I] I_def p'' by blast
+  from bnd 05 have bnd: "g_bnd_mode first b' fs'" using g_bnd_mode_cong[of fs fs'] by auto
+  have D: "D fs = D fs'" unfolding D_def using 06 by auto  
+
+
+  have Linv': "LLL_invariant_mod_weak fs' mfs'' dmu'' p'' first b'"
+  proof (intro LLL_invI_modw p'' 04 03 01 bnd)
+    {
+      have "mfs'' = map (map_vec (\<lambda>x. x symmod p'')) mfs" by fact
+      also have "\<dots> = map (map_vec (\<lambda>x. x symmod p'')) (map (map_vec (\<lambda>x. x symmod p)) fs)" 
+        using inv by simp
+      also have "\<dots> = map (map_vec (\<lambda>x. x symmod p symmod p'')) fs" by auto
+      also have "(\<lambda> x. x symmod p symmod p'') = (\<lambda> x. x symmod p'')" 
+      proof (intro ext)
+        fix x
+        from \<open>mod_invariant b p first\<close>[unfolded mod_invariant_def] obtain e where 
+          p: "p = log_base ^ e" by auto
+        from p''[unfolded mod_invariant_def] obtain e' where
+          p'': "p'' = log_base ^ e'" by auto
+        from pp'[unfolded p p''] log_base have "e' \<le> e" by simp
+        hence dvd: "p'' dvd p" unfolding p p'' using log_base by (metis le_imp_power_dvd)
+        thus "x symmod p symmod p'' = x symmod p''"  
+          by (intro sym_mod_sym_mod_cancel)
+      qed
+      finally show "map (map_vec (\<lambda>x. x symmod p'')) fs' = mfs''" unfolding 02 ..
+    }
+    thus "length mfs'' = m" using 04 by auto
+    show "\<forall>i'<m. \<forall>j'<i'. \<bar>d\<mu> fs' i' j'\<bar> < p'' * d fs' j' * d fs' (Suc j')"
+    proof -
+      {
+        fix i' j'
+        assume i'j': "i' < m" "j' < i'"
+        then have "d\<mu> fs' i' j' = d\<mu> fs i' j' symmod (p'' * d fs' j' * d fs' (Suc j'))"
+          using 07 06 unfolding I_def by simp
+        then have "\<bar>d\<mu> fs' i' j'\<bar> < p'' * d fs' j' * d fs' (Suc j')" 
+          using sym_mod_abs p'' LLL_d_pos[OF weak] mult_pos_pos
+          by (smt "06" i'j' less_imp_le_nat less_trans_Suc nat_SN.gt_trans)
+      }
+      then show ?thesis by simp
+    qed
+    from inv(7) have dmu: "i' < m \<Longrightarrow> j' < m \<Longrightarrow> dmu $$ (i', j') = d\<mu> fs i' j'" for i' j'
+      by auto
+    note d_of = d_of_weak[OF Linv]
+    have dvec: "i \<le> m \<Longrightarrow> d_vec $ i = d fs i" for i unfolding d_vec_def using d_of by auto
+    show "\<forall>i'<m. \<forall>j'<m. d\<mu> fs' i' j' = dmu'' $$ (i', j')" 
+      using 07 unfolding dmu''_def I_def 
+      by (auto simp: dmu dvec)
+  qed
+
+  moreover 
+  {
+    assume linv: "LLL_invariant_mod fs mfs dmu p first b i" 
+    note inv = LLL_invD_mod[OF linv]
+    hence i: "i \<le> m" by auto
+    have norm: "j < m \<Longrightarrow> \<parallel>gso fs j\<parallel>\<^sup>2 = \<parallel>gso fs' j\<parallel>\<^sup>2" for j
+      using 05 by auto
+    have "weakly_reduced fs i = weakly_reduced fs' i" 
+      unfolding gram_schmidt_fs.weakly_reduced_def using i
+      by (intro all_cong arg_cong2[where f = "(\<le>)"] arg_cong[where f = "\<lambda> x. _ * x"] norm, auto)
+    with inv have "weakly_reduced fs' i" by auto
+    hence "LLL_invariant_mod fs' mfs'' dmu'' p'' first b' i" using inv         
+      by (intro LLL_invI_mod LLL_invD_modw[OF Linv'])
+  }
+
+  moreover have "LLL_measure i fs' = LLL_measure i fs" 
+    unfolding LLL_measure_def logD_def D ..
+  ultimately show ?thesis unfolding id by blast
+qed
+
+lemma alpha_comparison: assumes 
+  Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and alph: "quotient_of \<alpha> = (num, denom)" 
+  and i: "i < m" 
+  and i0: "i \<noteq> 0" 
+shows "(d_of dmu i * d_of dmu i * denom \<le> num * d_of dmu (i - 1) * d_of dmu (Suc i))
+  = (sq_norm (gso fs (i - 1)) \<le> \<alpha> * sq_norm (gso fs i))" 
+proof - 
+  note inv = LLL_invD_modw[OF Linv]
+  interpret fs_indep: fs_int_indpt n fs
+    by (unfold_locales, insert inv, auto)
+  from inv(2) i have ifs: "i < length fs" by auto
+  note d_of_fs = d_of_weak[OF Linv]
+  show ?thesis 
+    unfolding fs_indep.d_sq_norm_comparison[OF alph ifs i0, symmetric]
+    by (subst (1 2 3 4) d_of_fs, use i d_def fs_indep.d_def in auto)
+qed
+
+lemma basis_reduction_adjust_swap_add_step: assumes 
+  Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  and res: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx i = (p', mfs', dmu', g_idx')" 
+  and alph: "quotient_of \<alpha> = (num, denom)" 
+  and ineq: "\<not> (d_of dmu i * d_of dmu i * denom
+              \<le> num * d_of dmu (i - 1) * d_of dmu (Suc i))" 
+  and i: "i < m" 
+  and i0: "i \<noteq> 0" 
+shows "\<exists>fs' b'. LLL_invariant_mod_weak fs' mfs' dmu' p' first b' \<and>
+        LLL_measure (i - 1) fs' < LLL_measure i fs \<and>
+        LLL_measure (m - 1) fs' < LLL_measure (m - 1) fs \<and>
+        (LLL_invariant_mod fs mfs dmu p first b i \<longrightarrow> 
+         LLL_invariant_mod fs' mfs' dmu' p' first b' (i - 1))"
+proof -
+  obtain mfs0 dmu0 where add: "basis_reduction_mod_add_row p mfs dmu i (i-1) = (mfs0, dmu0)" by force
+  obtain mfs1 dmu1 where swap: "basis_reduction_mod_swap p mfs0 dmu0 i = (mfs1, dmu1)" by force
+  note res = res[unfolded basis_reduction_adjust_swap_add_step_def Let_def add split swap]
+  from i0 have ii: "i - 1 < i" by auto
+  from basis_reduction_mod_add_row[OF Linv add i ii i0]
+  obtain fs0 where Linv0: "LLL_invariant_mod_weak fs0 mfs0 dmu0 p first b" 
+    and meas0: "LLL_measure i fs0 = LLL_measure i fs" 
+    and small: "\<bar>\<mu> fs0 i (i - 1)\<bar> \<le> 1 / 2" 
+    and Linv0': "LLL_invariant_mod fs mfs dmu p first b i \<Longrightarrow> LLL_invariant_mod fs0 mfs0 dmu0 p first b i" 
+    by blast
+  {
+    have id: "d_of dmu0 i = d_of dmu i" "d_of dmu0 (i - 1) = d_of dmu (i - 1)"
+      "d_of dmu0 (Suc i) = d_of dmu (Suc i)"
+      using i i0 add[unfolded basis_reduction_mod_add_row_def Let_def]
+      by (auto split: if_splits simp: d_of_def)
+    from ineq[folded id, unfolded alpha_comparison[OF Linv0 alph i i0]]
+    have "\<parallel>gso fs0 (i - 1)\<parallel>\<^sup>2 > \<alpha> * \<parallel>gso fs0 i\<parallel>\<^sup>2" by simp
+  } note ineq = this
+  from Linv have "LLL_invariant_weak fs" 
+    by (auto simp: LLL_invariant_weak_def LLL_invariant_mod_weak_def)
+  from basis_reduction_mod_swap[OF Linv0 small swap ineq i i0, unfolded meas0] Linv0'
+  obtain fs1 where Linv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p first b"
+    and meas1: "LLL_measure (i - 1) fs1 < LLL_measure i fs" 
+    and Linv1': "LLL_invariant_mod fs mfs dmu p first b i \<Longrightarrow> LLL_invariant_mod fs1 mfs1 dmu1 p first b (i - 1)" 
+    by auto
+  show ?thesis
+  proof (cases "i - 1 = g_idx")
+    case False
+    with res have id: "p' = p" "mfs' = mfs1" "dmu' = dmu1" "g_idx' = g_idx" by auto
+    show ?thesis unfolding id using Linv1' meas1 Linv1 by (intro exI[of _ fs1] exI[of _ b], auto simp: LLL_measure_def)
+  next
+    case True
+    with res have adjust: "basis_reduction_adjust_mod p first mfs1 dmu1 = (p', mfs', dmu', g_idx')" by simp
+    from basis_reduction_adjust_mod[OF Linv1 adjust, of "i - 1"] Linv1'
+    obtain fs' b' where Linvw: "LLL_invariant_mod_weak fs' mfs' dmu' p' first b'"
+      and Linv: "LLL_invariant_mod fs mfs dmu p first b i \<Longrightarrow> LLL_invariant_mod fs' mfs' dmu' p' first b' (i - 1)"
+      and meas: "LLL_measure (i - 1) fs' = LLL_measure (i - 1) fs1" 
+      by blast
+    note meas = meas1[folded meas]
+    from meas have meas': "LLL_measure (m - 1) fs' < LLL_measure (m - 1) fs" 
+      unfolding LLL_measure_def using i by auto
+    show ?thesis
+      by (intro exI conjI impI, rule Linvw, rule meas, rule meas', rule Linv) 
+  qed
+qed
+
+
+lemma basis_reduction_mod_step: assumes 
+  Linv: "LLL_invariant_mod fs mfs dmu p first b i" 
+  and res: "basis_reduction_mod_step p first mfs dmu g_idx i j = (p', mfs', dmu', g_idx', i', j')" 
+  and i: "i < m" 
+shows "\<exists>fs' b'. LLL_measure i' fs' < LLL_measure i fs \<and> LLL_invariant_mod fs' mfs' dmu' p' first b' i'"
+proof -
+  note res = res[unfolded basis_reduction_mod_step_def Let_def]
+  from Linv have Linvw: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+    by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def)
+  show ?thesis
+  proof (cases "i = 0")
+    case True
+    then have ids: "mfs' = mfs" "dmu' = dmu" "i' = Suc i" "p' = p" using res by auto
+    have "LLL_measure i' fs < LLL_measure i fs \<and> LLL_invariant_mod fs mfs' dmu' p first b i'"
+      using increase_i_mod[OF Linv i] True res ids inv by simp
+    then show ?thesis using res ids inv by auto
+  next
+    case False
+    hence id: "(i = 0) = False" by auto
+    obtain num denom where alph: "quotient_of \<alpha> = (num, denom)" by force
+    note res = res[unfolded id if_False alph split]
+    let ?comp = "d_of dmu i * d_of dmu i * denom \<le> num * d_of dmu (i - 1) * d_of dmu (Suc i)" 
+    show ?thesis
+    proof (cases ?comp)
+      case False
+      hence id: "?comp = False" by simp
+      note res = res[unfolded id if_False]
+      let ?step = "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx i" 
+      from res have step: "?step = (p', mfs', dmu', g_idx')" 
+        and i': "i' = i - 1" 
+        by (cases ?step, auto)+
+      from basis_reduction_adjust_swap_add_step[OF Linvw step alph False i \<open>i \<noteq> 0\<close>] Linv
+      show ?thesis unfolding i' by blast
+    next
+      case True
+      hence id: "?comp = True" by simp
+      note res = res[unfolded id if_True]
+      from res have ids: "p' = p" "mfs' = mfs" "dmu' = dmu" "i' = Suc i" by auto
+      from True alpha_comparison[OF Linvw alph i False]
+      have ineq: "sq_norm (gso fs (i - 1)) \<le> \<alpha> * sq_norm (gso fs i)" by simp
+      from increase_i_mod[OF Linv i ineq]
+      show ?thesis unfolding ids by auto
+    qed
+  qed
+qed
+
+lemma basis_reduction_mod_main: assumes "LLL_invariant_mod fs mfs dmu p first b i" 
+  and res: "basis_reduction_mod_main p first mfs dmu g_idx i j = (p', mfs', dmu')" 
+shows "\<exists>fs' b'. LLL_invariant_mod fs' mfs' dmu' p' first b' m" 
+  using assms
+proof (induct "LLL_measure i fs" arbitrary: i mfs dmu j p b fs g_idx rule: less_induct)
+  case (less i fs mfs dmu j p b g_idx)
+  hence fsinv: "LLL_invariant_mod fs mfs dmu p first b i" by auto
+  note res = less(3)[unfolded basis_reduction_mod_main.simps[of p first mfs dmu g_idx i j]]
+  note inv = less(2)
+  note IH = less(1)
+  show ?case
+  proof (cases "i < m")
+    case i: True
+    obtain p' mfs' dmu' g_idx' i' j' where step: "basis_reduction_mod_step p first mfs dmu g_idx i j = (p', mfs', dmu', g_idx', i', j')" 
+      (is "?step = _") by (cases ?step, auto)
+    then obtain fs' b' where Linv: "LLL_invariant_mod fs' mfs' dmu' p' first b' i'" 
+      and decr: "LLL_measure i' fs' < LLL_measure i fs"
+      using basis_reduction_mod_step[OF fsinv step i] i fsinv by blast 
+    note res = res[unfolded step split]
+    from res i show ?thesis using IH[OF decr Linv] by auto
+  next
+    case False
+    with LLL_invD_mod[OF fsinv] res have i: "i = m" "p' = p" by auto
+    then obtain fs' b' where "LLL_invariant_mod fs' mfs' dmu' p first b' m" using False res fsinv by simp
+    then show ?thesis using i by auto
+  qed
+qed
+
+lemma compute_max_gso_quot_alpha: 
+  assumes inv: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  and max: "compute_max_gso_quot dmu = (msq_num, msq_denum, idx)"
+  and alph: "quotient_of \<alpha> = (num, denum)" 
+  and cmp: "(msq_num * denum  > num * msq_denum) = cmp" 
+  and m: "m > 1" 
+shows "cmp \<Longrightarrow> idx \<noteq> 0 \<and> idx < m \<and> \<not> (d_of dmu idx * d_of dmu idx * denum
+              \<le> num * d_of dmu (idx - 1) * d_of dmu (Suc idx))" 
+  and "\<not> cmp \<Longrightarrow> LLL_invariant_mod fs mfs dmu p first b m" 
+proof -
+  from inv
+  have fsinv: "LLL_invariant_weak fs" 
+    by (simp add: LLL_invariant_mod_weak_def LLL_invariant_weak_def)
+  define qt where "qt = (\<lambda>i. ((d_of dmu (i + 1)) * (d_of dmu (i + 1)),
+            (d_of dmu (i + 2)) * (d_of dmu i), Suc i))"
+  define lst where "lst = (map (\<lambda>i. qt i) [0..<(m-1)])"
+  have msqlst: "(msq_num, msq_denum, idx) = max_list_rats_with_index lst"
+    using max lst_def qt_def unfolding compute_max_gso_quot_def by simp
+  have nz: "\<And>n d i. (n, d, i) \<in> set lst \<Longrightarrow> d > 0"
+    unfolding lst_def qt_def using d_of_weak[OF inv] LLL_d_pos[OF fsinv] by auto
+  have geq: "\<forall>(n, d, i) \<in> set lst. rat_of_int msq_num / of_int msq_denum \<ge> rat_of_int n / of_int d"
+    using max_list_rats_with_index[of lst] nz msqlst by (metis (no_types, lifting) case_prodI2)
+  have len: "length lst \<ge> 1" using m unfolding lst_def by simp
+  have inset: "(msq_num, msq_denum, idx) \<in> set lst"
+    using max_list_rats_with_index_in_set[OF msqlst[symmetric] len] nz by simp
+  then have idxm: "idx \<in> {1..<m}" using lst_def[unfolded qt_def] by auto
+  then have idx0: "idx \<noteq> 0" and idx: "idx < m" by auto
+  have 00: "(msq_num, msq_denum, idx)  = qt (idx - 1)" using lst_def inset qt_def by auto
+  then have id_qt: "msq_num = d_of dmu idx * d_of dmu idx" "msq_denum = d_of dmu (Suc idx) * d_of dmu (idx - 1)" 
+    unfolding qt_def by auto
+  have "msq_denum = (d_of dmu (idx + 1)) * (d_of dmu (idx - 1))"
+    using 00 unfolding qt_def by simp
+  then have dengt0: "msq_denum > 0" using d_of_weak[OF inv] idxm LLL_d_pos[OF fsinv] by auto
+  have \<alpha>dengt0: "denum > 0" using alph by (metis quotient_of_denom_pos)
+  from cmp[unfolded id_qt]
+  have cmp: "cmp = (\<not> (d_of dmu idx * d_of dmu idx * denum \<le> num * d_of dmu (idx - 1) * d_of dmu (Suc idx)))" 
+    by (auto simp: ac_simps)
+  {
+    assume cmp    
+    from this[unfolded cmp] 
+    show "idx \<noteq> 0 \<and> idx < m \<and> \<not> (d_of dmu idx * d_of dmu idx * denum
+              \<le> num * d_of dmu (idx - 1) * d_of dmu (Suc idx))" using idx0 idx by auto
+  }
+  {
+    assume "\<not> cmp" 
+    from this[unfolded cmp] have small: "d_of dmu idx * d_of dmu idx * denum \<le> num * d_of dmu (idx - 1) * d_of dmu (Suc idx)" by auto
+    note d_pos = LLL_d_pos[OF fsinv]
+    have gso: "k < m \<Longrightarrow> sq_norm (gso fs k) = of_int (d fs (Suc k)) / of_int (d fs k)" for k using 
+        LLL_d_Suc[OF fsinv, of k] d_pos[of k] by simp
+    have gso_pos: "k < m \<Longrightarrow> sq_norm (gso fs k) > 0" for k 
+      using gso[of k] d_pos[of k] d_pos[of "Suc k"] by auto
+    from small[unfolded alpha_comparison[OF inv alph idx idx0]]
+    have alph: "sq_norm (gso fs (idx - 1)) \<le> \<alpha> * sq_norm (gso fs idx)" .
+    with gso_pos[OF idx] have alph: "sq_norm (gso fs (idx - 1)) / sq_norm (gso fs idx) \<le> \<alpha>" 
+      by (metis mult_imp_div_pos_le)
+    have weak: "weakly_reduced fs m" unfolding gram_schmidt_fs.weakly_reduced_def
+    proof (intro allI impI, goal_cases)
+      case (1 i)
+      from idx have idx1: "idx - 1 < m" by auto
+      from geq[unfolded lst_def]
+      have mem: "(d_of dmu (Suc i) * d_of dmu (Suc i),
+            d_of dmu (Suc (Suc i)) * d_of dmu i, Suc i) \<in> set lst" 
+        unfolding lst_def qt_def using 1 by auto
+      have "sq_norm (gso fs i) / sq_norm (gso fs (Suc i)) = 
+        of_int (d_of dmu (Suc i) * d_of dmu (Suc i)) / of_int (d_of dmu (Suc (Suc i)) * d_of dmu i)" 
+        using gso idx0 d_of_weak[OF inv] 1 by auto
+      also have "\<dots> \<le> rat_of_int msq_num / rat_of_int msq_denum" 
+        using geq[rule_format, OF mem, unfolded split] by auto
+      also have "\<dots> = sq_norm (gso fs (idx - 1)) / sq_norm (gso fs idx)" 
+        unfolding id_qt gso[OF idx] gso[OF idx1] using idx0 d_of_weak[OF inv] idx by auto
+      also have "\<dots> \<le> \<alpha>" by fact
+      finally show "sq_norm (gso fs i) \<le> \<alpha> * sq_norm (gso fs (Suc i))" using gso_pos[OF 1]
+        using pos_divide_le_eq by blast
+    qed
+    with inv show "LLL_invariant_mod fs mfs dmu p first b m" 
+      by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def)
+  }
+qed
+  
+
+lemma small_m: 
+  assumes inv: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  and m: "m \<le> 1" 
+shows "LLL_invariant_mod fs mfs dmu p first b m" 
+proof -
+  have weak: "weakly_reduced fs m" unfolding gram_schmidt_fs.weakly_reduced_def using m
+    by auto
+  with inv show "LLL_invariant_mod fs mfs dmu p first b m" 
+    by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def)
+qed
+
+lemma basis_reduction_iso_main: assumes "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and res: "basis_reduction_iso_main p first mfs dmu g_idx j = (p', mfs', dmu')" 
+shows "\<exists>fs' b'. LLL_invariant_mod fs' mfs' dmu' p' first b' m" 
+  using assms
+proof (induct "LLL_measure (m-1) fs" arbitrary: fs mfs dmu j p b g_idx rule: less_induct)
+  case (less fs mfs dmu j p b g_idx)
+  have inv: "LLL_invariant_mod_weak fs mfs dmu p first b" using less by auto
+  hence fsinv: "LLL_invariant_weak fs" 
+    by (simp add: LLL_invariant_mod_weak_def LLL_invariant_weak_def)
+  note res = less(3)[unfolded basis_reduction_iso_main.simps[of p first mfs dmu g_idx j]]
+  note IH = less(1)
+  obtain msq_num msq_denum idx where max: "compute_max_gso_quot dmu = (msq_num, msq_denum, idx)" 
+    by (metis prod_cases3)
+  obtain num denum where alph: "quotient_of \<alpha> = (num, denum)" by force
+  note res = res[unfolded max alph Let_def split]
+  consider (small) "m \<le> 1" | (final) "m > 1" "\<not> (num * msq_denum < msq_num * denum)" | (step) "m > 1" "num * msq_denum < msq_num * denum" 
+    by linarith
+  thus ?case
+  proof cases
+    case *: step
+    obtain p1 mfs1 dmu1 g_idx1 where step: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx idx = (p1, mfs1, dmu1, g_idx1)"
+      by (metis prod_cases4)
+    from res[unfolded step split] * have res: "basis_reduction_iso_main p1 first mfs1 dmu1 g_idx1 (j + 1) = (p', mfs', dmu')" by auto
+    from compute_max_gso_quot_alpha(1)[OF inv max alph refl *]
+    have idx0: "idx \<noteq> 0" and idx: "idx < m" and cmp: "\<not> d_of dmu idx * d_of dmu idx * denum \<le> num * d_of dmu (idx - 1) * d_of dmu (Suc idx)" by auto
+    from basis_reduction_adjust_swap_add_step[OF inv step alph cmp idx idx0] obtain fs1 b1 
+      where inv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p1 first b1" and meas: "LLL_measure (m - 1) fs1 < LLL_measure (m - 1) fs" 
+      by auto
+    from IH[OF meas inv1 res] show ?thesis .
+  next
+    case small
+    with res small_m[OF inv] show ?thesis by auto
+  next
+    case final 
+    from compute_max_gso_quot_alpha(2)[OF inv max alph refl final]
+      final show ?thesis using res by auto
+  qed
+qed
+
+lemma basis_reduction_mod_add_rows_loop_inv': assumes 
+  fsinv: "LLL_invariant_mod fs mfs dmu p first b m" 
+  and res: "basis_reduction_mod_add_rows_loop p mfs dmu i i = (mfs', dmu')" 
+  and i: "i < m" 
+shows "\<exists>fs'. LLL_invariant_mod fs' mfs' dmu' p first b m \<and>
+        (\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs i' j' = \<mu> fs' i' j') \<and>
+        \<mu>_small fs' i"
+proof -
+  {
+    fix j
+    assume j: "j \<le> i" and mu_small: "\<mu>_small_row i fs j" 
+      and resj: "basis_reduction_mod_add_rows_loop p mfs dmu i j = (mfs', dmu')"
+    have "\<exists>fs'. LLL_invariant_mod fs' mfs' dmu' p first b m \<and>
+        (\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs i' j' = \<mu> fs' i' j') \<and>
+        (\<mu>_small fs' i)"
+    proof (insert fsinv mu_small resj i j, induct j arbitrary: fs mfs dmu mfs' dmu')
+      case (0 fs)
+      then have "(mfs', dmu') = (mfs, dmu)" by simp
+      then show ?case 
+        using LLL_invariant_mod_to_weak_m_to_i(3) basis_reduction_add_row_done_weak 0 by auto
+    next
+      case (Suc j)
+      hence j: "j < i" by auto
+      have in0: "i \<noteq> 0" using Suc(6) by simp
+      define c where "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))"
+      have c2: "c = round (\<mu> fs i j)" using dmu_quot_is_round_of_\<mu>[OF _ _ i j] c_def Suc by simp
+        define mfs'' where "mfs'' = (if c=0 then mfs else mfs[ i := (map_vec (\<lambda> x. x symmod p)) (mfs ! i - c \<cdot>\<^sub>v mfs ! j)])"
+        define dmu'' where "dmu'' = (if c=0 then dmu else mat m m (\<lambda>(i',j'). (if (i' = i \<and> j' \<le> j) 
+        then (if j'=j then (dmu $$ (i,j') - c * dmu $$ (j,j')) 
+              else (dmu $$ (i,j') - c * dmu $$ (j,j')) symmod (p * (d_of dmu j') * (d_of dmu (Suc j'))))
+        else (dmu $$ (i',j')))))"
+        have 00: "basis_reduction_mod_add_row p mfs dmu i j = (mfs'', dmu'')" 
+          using mfs''_def dmu''_def unfolding basis_reduction_mod_add_row_def c_def[symmetric] by simp
+        then have 01: "basis_reduction_mod_add_rows_loop p mfs'' dmu'' i j = (mfs', dmu')" 
+          using basis_reduction_mod_add_rows_loop.simps(2)[of p mfs dmu i j] Suc by simp
+        have fsinvi: "LLL_invariant_mod fs mfs dmu p first b i" using LLL_invariant_mod_to_weak_m_to_i[OF Suc(2)] i by simp
+        then have fsinvmw: "LLL_invariant_mod_weak fs mfs dmu p first b" using LLL_invD_mod LLL_invI_modw by simp
+        obtain fs'' where fs''invi: "LLL_invariant_mod fs'' mfs'' dmu'' p first b i" and
+          \<mu>_small': "(\<mu>_small_row i fs (Suc j) \<longrightarrow> \<mu>_small_row i fs'' j)" and
+          \<mu>s: "(\<forall>i' j'. i' < i \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs'' i' j' = \<mu> fs i' j')"
+          using Suc basis_reduction_mod_add_row[OF fsinvmw 00 i j] fsinvi by auto
+        moreover then have \<mu>sm: "\<mu>_small_row i fs'' j" using Suc by simp
+        have fs''invwi: "LLL_invariant_weak' i fs''" using LLL_invD_mod[OF fs''invi] LLL_invI_weak by simp
+        have fsinvwi: "LLL_invariant_weak' i fs" using LLL_invD_mod[OF fsinvi] LLL_invI_weak by simp
+        note invw = LLL_invw'_imp_w[OF fsinvwi]
+        note invw'' = LLL_invw'_imp_w[OF fs''invwi]
+        have "LLL_invariant_mod fs'' mfs'' dmu'' p first b m"
+        proof -
+          have "(\<forall> l. Suc l < m \<longrightarrow> sq_norm (gso fs'' l) \<le> \<alpha> * sq_norm (gso fs'' (Suc l)))"
+          proof -
+            {
+              fix l
+              assume l: "Suc l < m"
+              have "sq_norm (gso fs'' l) \<le> \<alpha> * sq_norm (gso fs'' (Suc l))"
+              proof (cases "i \<le> Suc l")
+                case True
+                have deq: "\<And>k. k < m \<Longrightarrow> d fs (Suc k) = d fs'' (Suc k)" 
+                  using dd\<mu> LLL_invD_mod(9)[OF fs''invi] LLL_invD_mod(9)[OF Suc(2)] dmu''_def j by simp
+                {
+                  fix k
+                  assume k: "k < m"
+                  then have "d fs (Suc k) = d fs'' (Suc k)" 
+                    using dd\<mu> LLL_invD_mod(9)[OF fs''invi] LLL_invD_mod(9)[OF Suc(2)] dmu''_def j by simp
+                  have "d fs 0 = 1" "d fs'' 0 = 1" using d_def by auto
+                  moreover have sqid: "sq_norm (gso fs'' k) = rat_of_int (d fs'' (Suc k)) / rat_of_int (d fs'' k)"
+                    using LLL_d_Suc[OF invw''] LLL_d_pos[OF invw''] k
+                    by (smt One_nat_def Suc_less_eq Suc_pred le_imp_less_Suc mult_eq_0_iff less_imp_le_nat
+                        nonzero_mult_div_cancel_right of_int_0_less_iff of_int_hom.hom_zero)
+                  moreover have "sq_norm (gso fs k) = rat_of_int (d fs (Suc k)) / rat_of_int (d fs k)"
+                    using LLL_d_Suc[OF invw] LLL_d_pos[OF invw] k
+                    by (smt One_nat_def Suc_less_eq Suc_pred le_imp_less_Suc mult_eq_0_iff less_imp_le_nat
+                        nonzero_mult_div_cancel_right of_int_0_less_iff of_int_hom.hom_zero)
+                  ultimately have "sq_norm (gso fs k) = sq_norm (gso fs'' k)" using k deq 
+                      LLL_d_pos[OF invw] LLL_d_pos[OF invw'']
+                    by (metis (no_types, lifting) Nat.lessE Suc_lessD old.nat.inject zero_less_Suc)
+                }
+                then show ?thesis using LLL_invD_mod(6)[OF Suc(2)] by (simp add: gram_schmidt_fs.weakly_reduced_def l)
+              next
+                case False
+                then show ?thesis using LLL_invD_mod(6)[OF fs''invi] gram_schmidt_fs.weakly_reduced_def
+                  by (metis less_or_eq_imp_le nat_neq_iff)
+              qed
+            }
+            then show ?thesis by simp
+          qed
+          then have "weakly_reduced fs'' m" using gram_schmidt_fs.weakly_reduced_def by blast
+          then show ?thesis using LLL_invD_mod[OF fs''invi] LLL_invI_mod by simp
+        qed
+        then show ?case using "01" Suc.hyps i j less_imp_le_nat \<mu>sm \<mu>s by metis
+    qed
+  }
+  then show ?thesis using \<mu>_small_row_refl res by auto
+qed
+
+lemma basis_reduction_mod_add_rows_outer_loop_inv:
+  assumes inv: "LLL_invariant_mod fs mfs dmu p first b m"
+  and "(mfs', dmu') = basis_reduction_mod_add_rows_outer_loop p mfs dmu i"
+  and i: "i < m"
+shows "(\<exists>fs'. LLL_invariant_mod fs' mfs' dmu' p first b m \<and> 
+  (\<forall>j. j \<le> i \<longrightarrow> \<mu>_small fs' j))"
+proof(insert assms, induct i arbitrary: fs mfs dmu mfs' dmu')
+  case (0 fs)
+  then show ?case using \<mu>_small_def by auto
+next
+  case (Suc i fs mfs dmu mfs' dmu')
+  obtain mfs'' dmu'' where mfs''dmu'': "(mfs'', dmu'')
+    = basis_reduction_mod_add_rows_outer_loop p mfs dmu i" by (metis surj_pair)
+  then obtain fs'' where fs'': "LLL_invariant_mod fs'' mfs'' dmu'' p first b m" 
+    and 00: "(\<forall>j. j \<le> i \<longrightarrow> \<mu>_small fs'' j)" using Suc by fastforce
+  have "(mfs', dmu') = basis_reduction_mod_add_rows_loop p mfs'' dmu'' (Suc i) (Suc i)"
+    using Suc(3,4) mfs''dmu'' by (smt basis_reduction_mod_add_rows_outer_loop.simps(2) case_prod_conv)
+  then obtain fs' where 01: "LLL_invariant_mod fs' mfs' dmu' p first b m" 
+    and 02: "\<forall>i' j'. i' < (Suc i) \<longrightarrow> j' \<le> i' \<longrightarrow> \<mu> fs'' i' j' = \<mu> fs' i' j'" and 03: "\<mu>_small fs' (Suc i)"
+    using fs'' basis_reduction_mod_add_rows_loop_inv' Suc by metis
+  moreover have "\<forall>j. j \<le> (Suc i) \<longrightarrow> \<mu>_small fs' j" using 02 00 03 \<mu>_small_def by (simp add: le_Suc_eq)
+  ultimately show ?case by blast
+qed
+
+lemma basis_reduction_mod_fs_bound:
+  assumes Linv: "LLL_invariant_mod fs mfs dmu p first b k"
+  and mu_small: "\<mu>_small fs i"
+  and i: "i < m"
+  and nFirst: "\<not> first" 
+shows "fs ! i = mfs ! i"
+proof -
+  from LLL_invD_mod(16-17)[OF Linv] nFirst g_bnd_mode_def
+  have gbnd: "g_bnd b fs" and bp: "b \<le> (rat_of_int (p - 1))\<^sup>2 / (rat_of_nat m + 3)" 
+    by (auto simp: mod_invariant_def bound_number_def)
+  have Linvw: "LLL_invariant_weak' k fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp
+  have "fs_int_indpt n fs" using LLL_invD_mod(5)[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro by simp
+  then interpret fs: fs_int_indpt n fs
+    using fs_int_indpt.sq_norm_fs_via_sum_mu_gso by simp
+  have "\<parallel>gso fs 0\<parallel>\<^sup>2 \<le> b" using gbnd i unfolding g_bnd_def by blast
+  then have b0: "0 \<le> b" using sq_norm_vec_ge_0 dual_order.trans by auto
+  have 00: "of_int \<parallel>fs ! i\<parallel>\<^sup>2 = (\<Sum>j\<leftarrow>[0..<Suc i]. (\<mu> fs i j)\<^sup>2 * \<parallel>gso fs j\<parallel>\<^sup>2)" 
+    using fs.sq_norm_fs_via_sum_mu_gso LLL_invD_mod[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro i by simp 
+  have 01: "\<forall>j < i. (\<mu> fs i j)\<^sup>2 * \<parallel>gso fs j\<parallel>\<^sup>2 \<le> (1 / rat_of_int 4) * \<parallel>gso fs j\<parallel>\<^sup>2"
+  proof -
+    {
+      fix j
+      assume j: "j < i"
+      then have "\<bar>fs.gs.\<mu> i j\<bar> \<le> 1 / (rat_of_int 2)" 
+        using mu_small Power.linordered_idom_class.abs_square_le_1 j unfolding \<mu>_small_def by simp
+      moreover have "\<bar>\<mu> fs i j\<bar> \<ge> 0" by simp
+      ultimately have "\<bar>\<mu> fs i j\<bar>\<^sup>2 \<le> (1 / rat_of_int 2)\<^sup>2" 
+        using Power.linordered_idom_class.abs_le_square_iff by fastforce
+      also have "\<dots> = 1 / (rat_of_int 4)" by (simp add: field_simps)
+      finally have "\<bar>\<mu> fs i j\<bar>\<^sup>2 \<le> 1 / rat_of_int 4" by simp
+    }
+    then show ?thesis using fs.gs.\<mu>.simps by (metis mult_right_mono power2_abs sq_norm_vec_ge_0)
+  qed
+  then have 0111: "\<And>j. j \<in> set [0..<i] \<Longrightarrow> (\<mu> fs i j)\<^sup>2 * \<parallel>gso fs j\<parallel>\<^sup>2 \<le> (1 / rat_of_int 4) * \<parallel>gso fs j\<parallel>\<^sup>2"
+    by simp
+  {
+    fix j
+    assume j: "j < n" 
+    have 011: "(\<mu> fs i i)\<^sup>2 * \<parallel>gso fs i\<parallel>\<^sup>2 = 1 * \<parallel>gso fs i\<parallel>\<^sup>2"
+      using fs.gs.\<mu>.simps by simp
+    have 02: "\<forall>j < Suc i. \<parallel>gso fs j\<parallel>\<^sup>2 \<le> b"
+      using gbnd i unfolding g_bnd_def by simp
+    have 03: "length [0..<Suc i] = (Suc i)" by simp
+    have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 = (\<Sum>j\<leftarrow>[0..<i]. (\<mu> fs i j)\<^sup>2 * \<parallel>gso fs j\<parallel>\<^sup>2) + \<parallel>gso fs i\<parallel>\<^sup>2"
+      unfolding 00 using 011 by simp
+    also have "(\<Sum>j\<leftarrow>[0..<i]. (\<mu> fs i j)\<^sup>2 * \<parallel>gso fs j\<parallel>\<^sup>2) \<le> (\<Sum>j\<leftarrow>[0..<i]. ((1 / rat_of_int 4) * \<parallel>gso fs j\<parallel>\<^sup>2))"
+      using Groups_List.sum_list_mono[OF 0111] by fast
+    finally have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 \<le> (\<Sum>j\<leftarrow>[0..<i]. ((1 / rat_of_int 4) * \<parallel>gso fs j\<parallel>\<^sup>2)) + \<parallel>gso fs i\<parallel>\<^sup>2"
+      by simp
+    also have "(\<Sum>j\<leftarrow>[0..<i]. ((1 / rat_of_int 4) * \<parallel>gso fs j\<parallel>\<^sup>2)) \<le> (\<Sum>j\<leftarrow>[0..<i]. (1 / rat_of_int 4) * b)" 
+      by (intro sum_list_mono, insert 02, auto)
+    also have " \<parallel>gso fs i\<parallel>\<^sup>2 \<le> b" using 02 by simp
+    finally have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 \<le> (\<Sum>j\<leftarrow>[0..<i]. (1 / rat_of_int 4) * b) + b" by simp
+    also have "\<dots> = (rat_of_nat i) * ((1 / rat_of_int 4) *  b) + b" 
+      using 03 sum_list_triv[of "(1 / rat_of_int 4) * b" "[0..<i]"] by simp
+    also have "\<dots> = (rat_of_nat i) / 4 * b + b" by simp
+    also have "\<dots> = ((rat_of_nat i) / 4 + 1)* b" by algebra
+    also have "\<dots> = (rat_of_nat i + 4) / 4 * b" by simp
+    finally have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 \<le> (rat_of_nat i + 4) / 4 * b" by simp
+    also have "\<dots> \<le> (rat_of_nat (m + 3)) / 4 * b" using i b0 times_left_mono by fastforce
+    finally have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 \<le> rat_of_nat (m+3) / 4 * b" by simp
+    moreover have "\<bar>fs ! i $ j\<bar>\<^sup>2 \<le> \<parallel>fs ! i\<parallel>\<^sup>2" using vec_le_sq_norm LLL_invD_mod(10)[OF Linv] i j by blast
+    ultimately have 04: "of_int (\<bar>fs ! i $ j\<bar>\<^sup>2) \<le> rat_of_nat (m+3) / 4 * b" using ge_trans i by linarith
+    then have 05: "real_of_int (\<bar>fs ! i $ j\<bar>\<^sup>2) \<le> real_of_rat (rat_of_nat (m+3) / 4 * b)" 
+    proof -
+      from j have "rat_of_int (\<bar>fs ! i $ j\<bar>\<^sup>2) \<le> rat_of_nat (m+3) / 4 * b" using 04 by simp
+      then have "real_of_int (\<bar>fs ! i $ j\<bar>\<^sup>2) \<le> real_of_rat (rat_of_nat (m+3) / 4 * b)" 
+        using j of_rat_less_eq by (metis of_rat_of_int_eq)
+      then show ?thesis by simp
+    qed
+    define rhs where "rhs = real_of_rat (rat_of_nat (m+3) / 4 * b)"
+    have rhs0: "rhs \<ge> 0" using b0 i rhs_def by simp
+    have fsij: "real_of_int \<bar>fs ! i $ j\<bar> \<ge> 0" by simp
+    have "real_of_int (\<bar>fs ! i $ j\<bar>\<^sup>2) = (real_of_int \<bar>fs ! i $ j\<bar>)\<^sup>2" by simp
+    then have "(real_of_int \<bar>fs ! i $ j\<bar>)\<^sup>2 \<le> rhs" using 05 j rhs_def by simp
+    then have g1: "real_of_int \<bar>fs ! i $ j\<bar> \<le> sqrt rhs" using NthRoot.real_le_rsqrt by simp
+    have pbnd: "2 * \<bar>fs ! i $ j\<bar> < p"
+    proof -
+      have "rat_of_nat (m+3) / 4 * b \<le> (rat_of_nat (m +3) / 4) * (rat_of_int (p - 1))\<^sup>2 / (rat_of_nat m+3)"
+        using bp b0 i times_left_mono SN_Orders.of_nat_ge_zero gs.m_comm times_divide_eq_right 
+        by (smt gs.l_null le_divide_eq_numeral1(1))
+      also have "\<dots> = (rat_of_int (p - 1))\<^sup>2 / 4 * (rat_of_nat (m + 3) / rat_of_nat (m + 3))"
+        by (metis (no_types, lifting) gs.m_comm of_nat_add of_nat_numeral times_divide_eq_left)
+      finally have "rat_of_nat (m+3) / 4 * b \<le> (rat_of_int (p - 1))\<^sup>2 / 4" by simp
+      then have "sqrt rhs \<le> sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4))"
+        unfolding rhs_def using of_rat_less_eq by fastforce
+      then have two_ineq: 
+        "2 * \<bar>fs ! i $ j\<bar> \<le> 2 * sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4))"
+        using g1 by linarith
+      have "2 * sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4)) =
+      sqrt (real_of_rat (4 * ((rat_of_int (p - 1))\<^sup>2 / 4)))"
+        by (metis (no_types, hide_lams) real_sqrt_mult of_int_numeral of_rat_hom.hom_mult 
+            of_rat_of_int_eq real_sqrt_four times_divide_eq_right)
+      also have "\<dots> = sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2))" using i by simp
+      also have "(real_of_rat ((rat_of_int (p - 1))\<^sup>2)) = (real_of_rat (rat_of_int (p - 1)))\<^sup>2"
+        using Rat.of_rat_power by blast
+      also have "sqrt ((real_of_rat (rat_of_int (p - 1)))\<^sup>2) = real_of_rat (rat_of_int (p - 1))"
+        using LLL_invD_mod(15)[OF Linv] by simp
+      finally have "2 * sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4)) =
+      real_of_rat (rat_of_int (p - 1))" by simp
+      then have "2 * \<bar>fs ! i $ j\<bar> \<le> real_of_rat (rat_of_int (p - 1))"
+        using two_ineq by simp
+      then show ?thesis by (metis of_int_le_iff of_rat_of_int_eq zle_diff1_eq)
+    qed
+    have p1: "p > 1" using LLL_invD_mod[OF Linv] by blast
+    interpret pm: poly_mod_2 p
+      by (unfold_locales, rule p1)
+    from LLL_invD_mod[OF Linv] have len: "length fs = m" and fs: "set fs \<subseteq> carrier_vec n" by auto
+    from pm.inv_M_rev[OF pbnd, unfolded pm.M_def] have "pm.inv_M (fs ! i $ j mod p) = fs ! i $ j" .
+    also have "pm.inv_M (fs ! i $ j mod p) = mfs ! i $ j" unfolding LLL_invD_mod(7)[OF Linv, symmetric] sym_mod_def
+      using i j len fs by auto
+    finally have "fs ! i $ j = mfs ! i $ j" ..
+  }
+  thus "fs ! i = mfs ! i" using LLL_invD_mod(10,13)[OF Linv i] by auto
+qed
+
+lemma basis_reduction_mod_fs_bound_first:
+  assumes Linv: "LLL_invariant_mod fs mfs dmu p first b k"
+  and m0: "m > 0"
+  and first: "first" 
+shows "fs ! 0 = mfs ! 0"
+proof -
+  from LLL_invD_mod(16-17)[OF Linv] first g_bnd_mode_def m0
+  have gbnd: "sq_norm (gso fs 0) \<le> b" and bp: "b \<le> (rat_of_int (p - 1))\<^sup>2 / 4" 
+    by (auto simp: mod_invariant_def bound_number_def)
+  from LLL_invD_mod[OF Linv] have p1: "p > 1" by blast
+  have Linvw: "LLL_invariant_weak' k fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp
+  have "fs_int_indpt n fs" using LLL_invD_mod(5)[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro by simp
+  then interpret fs: fs_int_indpt n fs
+    using fs_int_indpt.sq_norm_fs_via_sum_mu_gso by simp
+  from gbnd have b0: "0 \<le> b" using sq_norm_vec_ge_0 dual_order.trans by auto
+  have "of_int \<parallel>fs ! 0\<parallel>\<^sup>2 = (\<mu> fs 0 0)\<^sup>2 * \<parallel>gso fs 0\<parallel>\<^sup>2" 
+    using fs.sq_norm_fs_via_sum_mu_gso LLL_invD_mod[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro m0 by simp 
+  also have "\<dots> = \<parallel>gso fs 0\<parallel>\<^sup>2" unfolding fs.gs.\<mu>.simps by (simp add: gs.\<mu>.simps)
+  also have "\<dots> \<le> (rat_of_int (p - 1))\<^sup>2 / 4" using gbnd bp by auto
+  finally have one: "of_int (sq_norm (fs ! 0)) \<le> (rat_of_int (p - 1))\<^sup>2 / 4" .
+  {
+    fix j
+    assume j: "j < n" 
+    have leq: "\<bar>fs ! 0 $ j\<bar>\<^sup>2 \<le> \<parallel>fs ! 0\<parallel>\<^sup>2" using vec_le_sq_norm LLL_invD_mod(10)[OF Linv] m0 j by blast
+    have "rat_of_int ((2 * \<bar>fs ! 0 $ j\<bar>)^2) = rat_of_int (4 * \<bar>fs ! 0 $ j\<bar>\<^sup>2)" by simp
+    also have "\<dots> \<le> 4 * of_int \<parallel>fs ! 0\<parallel>\<^sup>2" using leq by simp
+    also have "\<dots> \<le> 4 * (rat_of_int (p - 1))\<^sup>2 / 4" using one by simp
+    also have "\<dots> = (rat_of_int (p - 1))\<^sup>2" by simp
+    also have "\<dots> = rat_of_int ((p - 1)\<^sup>2)" by simp
+    finally have "(2 * \<bar>fs ! 0 $ j\<bar>)^2 \<le> (p - 1)\<^sup>2" by linarith
+    hence "2 * \<bar>fs ! 0 $ j\<bar> \<le> p - 1" using p1 
+      by (smt power_mono_iff zero_less_numeral)
+    hence pbnd: "2 * \<bar>fs ! 0 $ j\<bar> < p" by simp
+    interpret pm: poly_mod_2 p
+      by (unfold_locales, rule p1)
+    from LLL_invD_mod[OF Linv] m0 have len: "length fs = m" "length mfs = m" 
+      and fs: "fs ! 0 \<in> carrier_vec n" "mfs ! 0 \<in> carrier_vec n" by auto
+    from pm.inv_M_rev[OF pbnd, unfolded pm.M_def] have "pm.inv_M (fs ! 0 $ j mod p) = fs ! 0 $ j" .
+    also have "pm.inv_M (fs ! 0 $ j mod p) = mfs ! 0 $ j" unfolding LLL_invD_mod(7)[OF Linv, symmetric] sym_mod_def
+      using m0 j len fs by auto
+    finally have "mfs ! 0 $ j = fs ! 0 $ j" . 
+  }
+  thus "fs ! 0 = mfs ! 0" using LLL_invD_mod(10,13)[OF Linv m0] by auto
+qed
+
+lemma dmu_initial: "dmu_initial = mat m m (\<lambda> (i,j). d\<mu> fs_init i j)"
+proof -
+  interpret fs: fs_int_indpt n fs_init
+    by (unfold_locales, intro lin_dep)
+  show ?thesis unfolding dmu_initial_def Let_def
+  proof (intro cong_mat refl refl, unfold split, goal_cases)
+    case (1 i j)
+    show ?case
+    proof (cases "j \<le> i")
+      case False
+      thus ?thesis by (auto simp: d\<mu>_def gs.\<mu>.simps)
+    next
+      case True
+      hence id: "d\<mu>_impl fs_init !! i !! j = fs.d\<mu> i j" unfolding fs.d\<mu>_impl
+        by (subst of_fun_nth, use 1 len in force, subst of_fun_nth, insert True, auto)
+      also have "\<dots> = d\<mu> fs_init i j" unfolding fs.d\<mu>_def d\<mu>_def fs.d_def d_def by simp
+      finally show ?thesis using True by auto
+    qed
+  qed
+qed
+
+lemma LLL_initial_invariant_mod: assumes res: "compute_initial_state first = (p, mfs, dmu', g_idx)" 
+shows "\<exists>fs b. LLL_invariant_mod fs mfs dmu' p first b 0" 
+proof -
+  from dmu_initial have dmu: "(\<forall>i' < m. \<forall>j' < m. d\<mu> fs_init i' j' = dmu_initial $$ (i',j'))" by auto
+  obtain b g_idx where norm: "compute_max_gso_norm first dmu_initial = (b,g_idx)" by force
+  note res = res[unfolded compute_initial_state_def Let_def norm split]
+  from res have p: "p = compute_mod_of_max_gso_norm first b" by auto
+  then have p0: "p > 0" unfolding compute_mod_of_max_gso_norm_def using log_base by simp
+  then have p1: "p \<ge> 1" by simp
+  note res = res[folded p]
+  from res[unfolded compute_initial_mfs_def]
+  have mfs: "mfs = map (map_vec (\<lambda>x. x symmod p)) fs_init" by auto
+  from res[unfolded compute_initial_dmu_def]
+  have dmu': "dmu' = mat m m (\<lambda>(i',j'). if j' < i' 
+              then dmu_initial $$ (i', j') symmod (p * d_of dmu_initial j' * d_of dmu_initial (Suc j')) 
+              else dmu_initial $$ (i',j'))" by auto
+  have lat: "lattice_of fs_init = L" by (auto simp: L_def)
+  define I where "I = {(i',j'). i' < m \<and> j' < i'}"
+  obtain fs where 
+    01: "lattice_of fs = L" and
+    02: "map (map_vec (\<lambda> x. x symmod p)) fs = map (map_vec (\<lambda> x. x symmod p)) fs_init" and
+    03: "lin_indep fs" and
+    04: "length fs = m" and
+    05: "(\<forall> k < m. gso fs k = gso fs_init k)" and
+    06: "(\<forall> k \<le> m. d fs k = d fs_init k)" and
+    07: "(\<forall> i' < m. \<forall> j' < m. d\<mu> fs i' j' = 
+      (if (i',j') \<in> I then d\<mu> fs_init i' j' symmod (p * d fs_init j' * d fs_init (Suc j')) else d\<mu> fs_init i' j'))"
+    using mod_finite_set[OF lin_dep len _ lat p0, of I] I_def by blast
+  have inv: "LLL_invariant_weak fs_init"
+    by (intro LLL_inv_wI lat len lin_dep fs_init)
+  have "\<forall>i'<m. d\<mu> fs_init i' i' = dmu_initial $$ (i', i')" unfolding dmu_initial by auto
+  from compute_max_gso_norm[OF this inv, of first, unfolded norm] have gbnd: "g_bnd_mode first b fs_init" 
+    and b0: "0 \<le> b" and mb0: "m = 0 \<Longrightarrow> b = 0" by auto
+  from gbnd 05 have gbnd: "g_bnd_mode first b fs" using g_bnd_mode_cong[of fs fs_init] by auto
+  have d\<mu>dmu': "\<forall>i'<m. \<forall>j'<m. d\<mu> fs i' j' = dmu' $$ (i', j')" using 07 dmu d_of_main[of fs_init dmu_initial]
+    unfolding I_def dmu' by simp
+  have wred: "weakly_reduced fs 0" by (simp add: gram_schmidt_fs.weakly_reduced_def)
+  have fs_carr: "set fs \<subseteq> carrier_vec n" using 03 unfolding gs.lin_indpt_list_def by force
+  have m0: "m \<ge> 0" using len by auto 
+  have Linv: "LLL_invariant_weak' 0 fs"
+    by (intro LLL_invI_weak 03 04 01 wred fs_carr m0)
+  note Linvw = LLL_invw'_imp_w[OF Linv]
+  from compute_mod_of_max_gso_norm[OF b0 mb0 p]
+  have p: "mod_invariant b p first" "p > 1" by auto
+  from len mfs have len': "length mfs = m" by auto
+  have modbnd: "\<forall>i'<m. \<forall>j'<i'. \<bar>d\<mu> fs i' j'\<bar> < p * d fs j' * d fs (Suc j')"
+  proof -
+    have "\<forall> i' < m. \<forall> j' < i'. d\<mu> fs i' j' = d\<mu> fs i' j' symmod (p * d fs j' * d fs (Suc j'))"
+      using I_def 07 06 by simp
+    moreover have "\<forall>j' < m. p * d fs j' * d fs (Suc j') > 0" using p(2) LLL_d_pos[OF Linvw] by simp
+    ultimately show ?thesis using sym_mod_abs
+      by (smt Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign less_trans)
+  qed
+  have "LLL_invariant_mod fs mfs dmu' p first b 0" 
+    using LLL_invI_mod[OF len' m0 04 01 03 wred _ modbnd d\<mu>dmu' p(2) gbnd p(1)] 02 mfs by simp
+  then show ?thesis by auto
+qed
+
+subsection \<open>Soundness of Storjohann's algorithm\<close>
+
+text \<open>For all of these abstract algorithms, we actually formulate their soundness proofs by linking
+  to the LLL-invariant (which implies that @{term fs} is reduced (@{term "LLL_invariant True m fs"})
+  or that the first vector of @{term fs} is short (@{term "LLL_invariant_weak fs \<and> weakly_reduced fs m"}).\<close>
+
+text \<open>Soundness of Storjohann's algorithm\<close>
+lemma reduce_basis_mod_inv: assumes res: "reduce_basis_mod = fs"    
+  shows "LLL_invariant True m fs" 
+proof (cases "m = 0")
+  case True
+  from True have *: "fs_init = []" using len by simp
+  moreover have "fs = []" using res basis_reduction_mod_add_rows_outer_loop.simps(1)
+    unfolding reduce_basis_mod_def Let_def basis_reduction_mod_main.simps[of _ _ _ _ _ 0] 
+      compute_initial_mfs_def compute_initial_state_def compute_initial_dmu_def 
+    unfolding True * by (auto split: prod.splits)
+  ultimately show ?thesis using True LLL_inv_initial_state by blast
+next
+  case False
+  let ?first = False
+  obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4)
+  from LLL_initial_invariant_mod[OF init]
+  obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast
+  note res = res[unfolded reduce_basis_mod_def init Let_def split]
+  obtain p1 mfs1 dmu1 where mfs1dmu1: "(p1, mfs1, dmu1) = basis_reduction_mod_main p ?first mfs0 dmu0 g_idx0 0 0"
+    by (metis prod.exhaust)
+  obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m"
+    using basis_reduction_mod_main[OF fs0 mfs1dmu1[symmetric]] by auto
+  obtain mfs2 dmu2 where mfs2dmu2:
+    "(mfs2, dmu2) = basis_reduction_mod_add_rows_outer_loop p1 mfs1 dmu1 (m-1)" by (metis old.prod.exhaust)
+  obtain fs2 where fs2: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 m" 
+    and \<mu>s: "((\<forall>j. j < m \<longrightarrow> \<mu>_small fs2 j))"
+    using basis_reduction_mod_add_rows_outer_loop_inv[OF _ mfs2dmu2, of fs1 ?first b1] Linv1 False by auto
+  have rbd: "LLL_invariant_weak' m fs2" "\<forall>j < m. \<mu>_small fs2 j"
+    using LLL_invD_mod[OF fs2] LLL_invI_weak \<mu>s by auto
+  have redfs2: "reduced fs2 m" using rbd LLL_invD_weak(8) gram_schmidt_fs.reduced_def \<mu>_small_def by blast
+  have fs: "fs = mfs2" 
+    using res[folded mfs1dmu1, unfolded Let_def split, folded mfs2dmu2, unfolded split] .. 
+  have "\<forall>i < m. fs2 ! i = fs ! i"
+  proof (intro allI impI)
+    fix i
+    assume i: "i < m"
+    then have fs2i: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 i"
+      using fs2 LLL_invariant_mod_to_weak_m_to_i by simp
+    have \<mu>si: "\<mu>_small fs2 i" using \<mu>s i by simp
+    show "fs2 ! i = fs ! i" 
+      using basis_reduction_mod_fs_bound(1)[OF fs2i \<mu>si i] fs by simp
+  qed
+  then have "fs2 = fs"
+    using LLL_invD_mod(1,3,10,13)[OF fs2] fs by (metis nth_equalityI)
+  then show ?thesis using redfs2 fs rbd(1) reduce_basis_def res LLL_invD_weak 
+      LLL_invariant_def by simp
+qed
+
+text \<open>Soundness of Storjohann's algorithm for computing a short vector.\<close>
+lemma short_vector_mod_inv: assumes res: "short_vector_mod = v"    
+  and m: "m > 0" 
+  shows "\<exists> fs. LLL_invariant_weak fs \<and> weakly_reduced fs m \<and> v = hd fs" 
+proof -
+  let ?first = True
+  obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4)
+  from LLL_initial_invariant_mod[OF init]
+  obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast
+  obtain p1 mfs1 dmu1 where main: "basis_reduction_mod_main p ?first mfs0 dmu0 g_idx0 0 0 = (p1, mfs1, dmu1)"
+    by (metis prod.exhaust)
+  obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m"
+    using basis_reduction_mod_main[OF fs0 main] by auto
+  have "v = hd mfs1" using res[unfolded short_vector_mod_def Let_def init split main] ..
+  with basis_reduction_mod_fs_bound_first[OF Linv1 m] LLL_invD_mod(1,3)[OF Linv1] m
+  have v: "v = hd fs1" by (cases fs1; cases mfs1; auto)
+  from Linv1 have Linv1: "LLL_invariant_weak fs1" and red: "weakly_reduced fs1 m" 
+    unfolding LLL_invariant_mod_def LLL_invariant_weak_def by auto
+  show ?thesis  
+    by (intro exI[of _ fs1] conjI Linv1 red v)
+qed
+
+text \<open>Soundness of Storjohann's algorithm with improved swap order\<close>
+lemma reduce_basis_iso_inv: assumes res: "reduce_basis_iso = fs"
+  shows "LLL_invariant True m fs" 
+proof (cases "m = 0")
+  case True
+  then have *: "fs_init = []" using len by simp
+  moreover have "fs = []" using res basis_reduction_mod_add_rows_outer_loop.simps(1)
+    unfolding reduce_basis_iso_def Let_def basis_reduction_iso_main.simps[of _ _ _ _ _ 0] 
+      compute_initial_mfs_def compute_initial_state_def compute_initial_dmu_def
+    unfolding True * by (auto split: prod.splits)
+  ultimately show ?thesis using True LLL_inv_initial_state by blast
+next
+  case False
+  let ?first = False
+  obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4)
+  from LLL_initial_invariant_mod[OF init]
+  obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast
+  have fs0w: "LLL_invariant_mod_weak fs0 mfs0 dmu0 p ?first b" using LLL_invD_mod[OF fs0] LLL_invI_modw by simp 
+  note res = res[unfolded reduce_basis_iso_def init Let_def split]
+  obtain p1 mfs1 dmu1 where mfs1dmu1: "(p1, mfs1, dmu1) = basis_reduction_iso_main p ?first mfs0 dmu0 g_idx0 0"
+    by (metis prod.exhaust)
+  obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m"
+    using basis_reduction_iso_main[OF fs0w mfs1dmu1[symmetric]] by auto
+  obtain mfs2 dmu2 where mfs2dmu2:
+    "(mfs2, dmu2) = basis_reduction_mod_add_rows_outer_loop p1 mfs1 dmu1 (m-1)" by (metis old.prod.exhaust)
+  obtain fs2 where fs2: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 m" 
+    and \<mu>s: "((\<forall>j. j < m \<longrightarrow> \<mu>_small fs2 j))"
+    using basis_reduction_mod_add_rows_outer_loop_inv[OF _ mfs2dmu2, of fs1 ?first b1] Linv1 False by auto
+  have rbd: "LLL_invariant_weak' m fs2" "\<forall>j < m. \<mu>_small fs2 j"
+    using LLL_invD_mod[OF fs2] LLL_invI_weak \<mu>s by auto
+  have redfs2: "reduced fs2 m" using rbd LLL_invD_weak(8) gram_schmidt_fs.reduced_def \<mu>_small_def by blast
+  have fs: "fs = mfs2" 
+    using res[folded mfs1dmu1, unfolded Let_def split, folded mfs2dmu2, unfolded split] .. 
+  have "\<forall>i < m. fs2 ! i = fs ! i"
+  proof (intro allI impI)
+    fix i
+    assume i: "i < m"
+    then have fs2i: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 i"
+      using fs2 LLL_invariant_mod_to_weak_m_to_i by simp
+    have \<mu>si: "\<mu>_small fs2 i" using \<mu>s i by simp
+    show "fs2 ! i = fs ! i" 
+      using basis_reduction_mod_fs_bound(1)[OF fs2i \<mu>si i] fs by simp
+  qed
+  then have "fs2 = fs"
+    using LLL_invD_mod(1,3,10,13)[OF fs2] fs by (metis nth_equalityI)
+  then show ?thesis using redfs2 fs rbd(1) reduce_basis_def res LLL_invD_weak 
+      LLL_invariant_def by simp
+qed
+
+text \<open>Soundness of Storjohann's algorithm to compute short vectors with improved swap order\<close>
+lemma short_vector_iso_inv: assumes res: "short_vector_iso = v"    
+  and m: "m > 0" 
+  shows "\<exists> fs. LLL_invariant_weak fs \<and> weakly_reduced fs m \<and> v = hd fs" 
+proof -
+  let ?first = True
+  obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4)
+  from LLL_initial_invariant_mod[OF init]
+  obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast
+  have fs0w: "LLL_invariant_mod_weak fs0 mfs0 dmu0 p ?first b" using LLL_invD_mod[OF fs0] LLL_invI_modw by simp 
+  obtain p1 mfs1 dmu1 where main: "basis_reduction_iso_main p ?first mfs0 dmu0 g_idx0 0 = (p1, mfs1, dmu1)"
+    by (metis prod.exhaust)
+  obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m"
+    using basis_reduction_iso_main[OF fs0w main] by auto
+  have "v = hd mfs1" using res[unfolded short_vector_iso_def Let_def init split main] ..
+  with basis_reduction_mod_fs_bound_first[OF Linv1 m] LLL_invD_mod(1,3)[OF Linv1] m
+  have v: "v = hd fs1" by (cases fs1; cases mfs1; auto)
+  from Linv1 have Linv1: "LLL_invariant_weak fs1" and red: "weakly_reduced fs1 m" 
+    unfolding LLL_invariant_mod_def LLL_invariant_weak_def by auto
+  show ?thesis  
+    by (intro exI[of _ fs1] conjI Linv1 red v)
+qed
+
+end
+
+text \<open>From the soundness results of these abstract versions of the algorithms, 
+  one just needs to derive actual implementations that may integrate low-level
+  optimizations.\<close>
+
+end
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Impl.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Impl.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Impl.thy
@@ -0,0 +1,1223 @@
+section \<open>Storjohann's basis reduction algorithm (concrete implementation)\<close>
+
+text \<open>We refine the abstract algorithm into a more efficient executable one.\<close>
+
+theory Storjohann_Impl
+  imports 
+    Storjohann
+begin
+
+subsection \<open>Implementation\<close>
+
+text \<open>We basically store four components:
+  \<^item> The $f$-basis (as list, all values taken modulo $p$)
+  \<^item> The $d\mu$-matrix (as nested arrays, all values taken modulo $d_id_{i+1}p$)
+  \<^item> The $d$-values (as array)
+  \<^item> The modulo-values $d_id_{i+1}p$ (as array)
+\<close>
+
+type_synonym state_impl = "int vec list \<times> int iarray iarray \<times> int iarray \<times> int iarray" 
+
+fun di_of :: "state_impl \<Rightarrow> int iarray" where
+  "di_of (mfsi, dmui, di, mods) = di" 
+
+context LLL
+begin
+
+fun state_impl_inv :: "_ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> state_impl \<Rightarrow> bool" where 
+  "state_impl_inv p mfs dmu (mfsi, dmui, di, mods) = (mfsi = mfs \<and> di = IArray.of_fun (d_of dmu) (Suc m)
+     \<and> dmui = IArray.of_fun (\<lambda> i. IArray.of_fun (\<lambda> j. dmu $$ (i,j)) i) m
+     \<and> mods = IArray.of_fun (\<lambda> j. p * di !! j * di !! (Suc j)) (m - 1))" 
+
+definition state_iso_inv :: "(int \<times> int) iarray \<Rightarrow> int iarray \<Rightarrow> bool" where
+  "state_iso_inv prods di = (prods = IArray.of_fun 
+           (\<lambda> i. (di !! (i+1) * di !! (i+1), di !! (i+2) * di !! i)) (m - 1))" 
+
+definition perform_add_row :: "int \<Rightarrow> state_impl \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int iarray \<Rightarrow> int \<Rightarrow> int \<Rightarrow> state_impl" where
+  "perform_add_row p state i j c rowi muij dij1 = (let
+     (mfsi, dmui, di, mods) = state;
+       fsj = mfsi ! j;
+        rowj = dmui !! j
+      in 
+      (case split_at i mfsi of (start, fsi # end) \<Rightarrow> start @ vec n (\<lambda> k. (fsi $ k - c * fsj $ k) symmod p) # end,
+        IArray.of_fun (\<lambda> ii. if i = ii then 
+         IArray.of_fun (\<lambda> jj. if jj < j then 
+              (rowi !! jj - c * rowj !! jj) symmod (mods !! jj)
+            else if jj = j then muij - c * dij1 
+            else rowi !! jj) i
+        else dmui !! ii) m, 
+      di, mods))" 
+
+definition LLL_add_row :: "int \<Rightarrow> state_impl \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> state_impl" where
+  "LLL_add_row p state i j = (let
+     (_, dmui, di, _) = state;
+     rowi = dmui !! i;
+     dij1 = di !! (Suc j);
+     muij = rowi !! j;
+     c = round_num_denom muij dij1
+     in if c = 0 then state
+      else perform_add_row p state i j c rowi muij dij1)"     
+
+
+definition LLL_swap_row :: "int \<Rightarrow> state_impl \<Rightarrow> nat \<Rightarrow> state_impl" where
+  "LLL_swap_row p state k = (case state of (mfsi, dmui, di, mods) \<Rightarrow> let 
+        k1 = k - 1;
+        kS1 = Suc k;
+        muk = dmui !! k; 
+        muk1 = dmui !! k1;
+        mukk1 = muk !! k1;
+        dk1 = di !! k1;
+        dkS1 = di !! kS1;
+        dk = di !! k;
+        dk' = (dkS1 * dk1 + mukk1 * mukk1) div dk;
+        mod1 = p * dk1 * dk';
+        modk = p * dk' * dkS1
+      in 
+      (case split_at k1 mfsi
+        of (start, fsk1 # fsk # end) \<Rightarrow> start @ fsk # fsk1 # end,
+        IArray.of_fun (\<lambda> i. 
+          if i < k1 then dmui !! i
+          else if i > k then 
+             let row_i = dmui !! i; muik = row_i !! k; muik1 = row_i !! k1 in IArray.of_fun 
+                 (\<lambda> j. if j = k1 then ((mukk1 * muik1 + muik * dk1) div dk) symmod mod1 
+                        else if j = k then ((dkS1 * muik1 - mukk1 * muik) div dk) symmod modk  
+                        else row_i !! j) i
+          else if i = k then IArray.of_fun (\<lambda> j. if j = k1 then mukk1 symmod mod1 else muk1 !! j) i
+          else IArray.of_fun ((!!) muk) i 
+          ) m, 
+       IArray.of_fun (\<lambda> i. if i = k then dk' else di !! i) (Suc m), 
+       IArray.of_fun (\<lambda> j. if j = k1 then mod1 else if j = k then modk else mods !! j) (m - 1)))"
+
+definition perform_swap_add where "perform_swap_add p state k k1 c row_k mukk1 dk = 
+(let (fs, dmu, dd, mods) = state; 
+     row_k1 = dmu !! k1; 
+     kS1 = Suc k;
+     mukk1' = mukk1 - c * dk;
+     dk1 = dd !! k1; 
+     dkS1 = dd !! kS1; 
+     dk' = (dkS1 * dk1 + mukk1' * mukk1') div dk; 
+     mod1 = p * dk1 * dk'; 
+     modk = p * dk' * dkS1
+ in 
+      (case split_at k1 fs of (start, fsk1 # fsk # end) \<Rightarrow> 
+         start @ vec n (\<lambda>k. (fsk $ k - c * fsk1 $ k) symmod p) # fsk1 # end,
+       IArray.of_fun
+        (\<lambda>i. if i < k1
+              then dmu !! i
+              else if k < i
+                   then let row_i = dmu !! i;
+                            muik1 = row_i !! k1;
+                            muik = row_i !! k
+                        in IArray.of_fun
+                            (\<lambda>j. if j = k1 then (mukk1' * muik1 + muik * dk1) div dk symmod mod1
+                                 else if j = k then (dkS1 * muik1 - mukk1' * muik) div dk symmod modk 
+                                 else row_i !! j)
+                            i
+                   else if i = k then IArray.of_fun (\<lambda>j. if j = k1 then mukk1' symmod mod1 else row_k1 !! j) k 
+                   else IArray.of_fun (\<lambda>j. (row_k !! j - c * row_k1 !! j) symmod mods !! j) i)
+        m,
+       IArray.of_fun (\<lambda>i. if i = k then dk' else dd !! i) (Suc m), 
+       IArray.of_fun (\<lambda>j. if j = k1 then mod1 else if j = k then modk else mods !! j) (m - 1)))" 
+
+
+definition LLL_swap_add where
+  "LLL_swap_add p state i = (let
+     i1 = i - 1;
+     (_, dmui, di, _) = state;
+     rowi = dmui !! i;
+     dii = di !! i;
+     muij = rowi !! i1;
+     c = round_num_denom muij dii
+     in if c = 0 then LLL_swap_row p state i
+      else perform_swap_add p state i i1 c rowi muij dii)"
+
+definition LLL_max_gso_norm_di :: "bool \<Rightarrow> int iarray \<Rightarrow> rat \<times> nat" where
+  "LLL_max_gso_norm_di first di = 
+      (if first then (of_int (di !! 1), 0) 
+       else case max_list_rats_with_index (map (\<lambda> i. (di !! (Suc i), di !! i, i)) [0 ..< m ])
+      of (num, denom, i) \<Rightarrow> (of_int num / of_int denom, i))" 
+
+definition LLL_max_gso_quot:: "(int * int) iarray \<Rightarrow> (int * int * nat)" where
+  "LLL_max_gso_quot di_prods = max_list_rats_with_index 
+    (map (\<lambda>i. case di_prods !! i of (l,r) \<Rightarrow> (l, r, Suc i)) [0..<(m-1)])"
+
+
+definition LLL_max_gso_norm :: "bool \<Rightarrow> state_impl \<Rightarrow> rat \<times> nat" where
+  "LLL_max_gso_norm first state = (case state of (_, _, di, mods) \<Rightarrow> LLL_max_gso_norm_di first di)" 
+
+definition perform_adjust_mod :: "int \<Rightarrow> state_impl \<Rightarrow> state_impl" where
+  "perform_adjust_mod p state = (case state of (mfsi, dmui, di, _) \<Rightarrow> 
+          let mfsi' = map (map_vec (\<lambda>x. x symmod p)) mfsi;
+              mods = IArray.of_fun (\<lambda> j. p * di !! j * di !! (Suc j)) (m - 1);
+              dmui' = IArray.of_fun (\<lambda> i. let row = dmui !! i in IArray.of_fun (\<lambda> j. row !! j symmod (mods !! j)) i) m
+        in 
+          ((mfsi', dmui', di, mods)))" 
+
+definition mod_of_gso_norm :: "bool \<Rightarrow> rat \<Rightarrow> int" where
+  "mod_of_gso_norm first mn = log_base ^ (log_ceiling log_base (max 2 (
+     root_rat_ceiling 2 (mn * (rat_of_nat (if first then 4 else m + 3))) + 1)))"
+
+definition LLL_adjust_mod :: "int \<Rightarrow> bool \<Rightarrow> state_impl \<Rightarrow> int \<times> state_impl \<times> nat" where
+  "LLL_adjust_mod p first state = ( 
+     let (b', g_idx) = LLL_max_gso_norm first state;
+       p' = mod_of_gso_norm first b'
+      in if p' < p then (p', perform_adjust_mod p' state, g_idx)
+          else (p, state, g_idx) 
+      )" 
+
+definition LLL_adjust_swap_add where
+  "LLL_adjust_swap_add p first state g_idx i = (
+      let state1 = LLL_swap_add p state i
+      in if i - 1 = g_idx then
+      LLL_adjust_mod p first state1 else (p, state1, g_idx))" 
+
+
+definition LLL_step :: "int \<Rightarrow> bool \<Rightarrow> state_impl \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> (int \<times> state_impl \<times> nat) \<times> nat \<times> int" where
+  "LLL_step p first state g_idx i j = (if i = 0 then ((p, state, g_idx), Suc i, j)
+     else let 
+        i1 = i - 1; 
+        iS = Suc i;
+        (_, _, di, _) = state;
+        (num, denom) = quotient_of \<alpha>;
+        d_i = di !! i;
+        d_i1 = di !! i1;
+        d_Si = di !! iS
+       in if d_i * d_i * denom \<le> num * d_i1 * d_Si then
+          ((p, state, g_idx), iS, j) 
+        else (LLL_adjust_swap_add p first state g_idx i, i1, j + 1))" 
+
+partial_function (tailrec) LLL_main :: "int \<Rightarrow> bool \<Rightarrow> state_impl \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int \<times> state_impl"
+  where
+  "LLL_main p first state g_idx i (j :: int) = (
+    (if i < m 
+     then case LLL_step p first state g_idx i j of
+         ((p', state', g_idx'), i', j') \<Rightarrow> 
+         LLL_main p' first state' g_idx' i' j'
+       else
+         (p, state)))"
+
+partial_function (tailrec) LLL_iso_main_inner where
+  "LLL_iso_main_inner p first state di_prods g_idx (j :: int) = (
+      case state of (_, _, di, _) \<Rightarrow>
+    (
+      (let (max_gso_num, max_gso_denum, indx) = LLL_max_gso_quot di_prods;
+        (num, denum) = quotient_of \<alpha> in
+        (if max_gso_num * denum  > num * max_gso_denum then
+           case LLL_adjust_swap_add p first state g_idx indx of 
+              (p', state', g_idx') \<Rightarrow> case state' of (_, _, di', _) \<Rightarrow> 
+              let di_prods' = IArray.of_fun (\<lambda> i. case di_prods !! i of lr \<Rightarrow> 
+                    if i > indx \<or> i + 2 < indx then lr
+                     else case lr of (l,r) 
+                  \<Rightarrow> if i + 1 = indx then let d_idx = di' !! indx in (d_idx * d_idx, r) else (l, di' !! (i + 2) * di' !! i)) (m - 1)
+                in LLL_iso_main_inner p' first state' di_prods' g_idx' (j + 1)
+         else
+           (p, state)))))"
+
+definition LLL_iso_main where
+  "LLL_iso_main p first state g_idx j = (if m > 1 then 
+     case state of (_, _, di, _) \<Rightarrow>
+     let di_prods = IArray.of_fun (\<lambda> i. (di !! (i+1) * di !! (i+1), di !! (i+2) * di !! i)) (m - 1)
+      in LLL_iso_main_inner p first state di_prods g_idx j else (p,state))" 
+
+
+definition LLL_initial :: "bool \<Rightarrow> int \<times> state_impl \<times> nat" where
+  "LLL_initial first = (let init = d\<mu>_impl fs_init;
+      di = IArray.of_fun (\<lambda> i. if i = 0 then 1 else let i1 = i - 1 in init !! i1 !! i1) (Suc m);
+      (b,g_idx) = LLL_max_gso_norm_di first di;
+      p = mod_of_gso_norm first b;
+      mods = IArray.of_fun (\<lambda> j. p * di !! j * di !! (Suc j)) (m - 1);
+      dmui = IArray.of_fun (\<lambda> i. let row = init !! i in IArray.of_fun (\<lambda> j. row !! j symmod (mods !! j)) i) m
+      in (p, (compute_initial_mfs p, dmui, di, mods), g_idx))" 
+
+fun LLL_add_rows_loop where
+  "LLL_add_rows_loop p state i 0 = state"
+| "LLL_add_rows_loop p state i (Suc j) = (
+     let state' = LLL_add_row p state i j
+      in LLL_add_rows_loop p state' i j)" 
+
+primrec LLL_add_rows_outer_loop where
+  "LLL_add_rows_outer_loop p state 0 = state" |
+  "LLL_add_rows_outer_loop p state (Suc i) = 
+    (let state' = LLL_add_rows_outer_loop p state i in
+      LLL_add_rows_loop p state' (Suc i) (Suc i))"
+
+definition 
+  "LLL_reduce_basis = (if m = 0 then [] else
+     let first = False;
+         (p0, state0, g_idx0) = LLL_initial first;
+         (p, state) = LLL_main p0 first state0 g_idx0 0 0;
+         (mfs,_,_,_) = LLL_add_rows_outer_loop p state (m - 1)
+      in mfs)"
+
+definition 
+  "LLL_reduce_basis_iso = (if m = 0 then [] else
+     let first = False;
+         (p0, state0, g_idx0) = LLL_initial first;
+         (p, state) = LLL_iso_main p0 first state0 g_idx0 0;
+         (mfs,_,_,_) = LLL_add_rows_outer_loop p state (m - 1)
+      in mfs)"
+
+definition 
+  "LLL_short_vector = (
+     let first = True;
+         (p0, state0, g_idx0) = LLL_initial first;
+         (p, (mfs,_,_,_)) = LLL_main p0 first state0 g_idx0 0 0
+      in hd mfs)"
+
+definition 
+  "LLL_short_vector_iso = (
+     let first = True;
+         (p0, state0, g_idx0) = LLL_initial first;
+         (p, (mfs,_,_,_)) = LLL_iso_main p0 first state0 g_idx0 0         
+      in hd mfs)"
+
+end
+
+declare LLL.LLL_short_vector_def[code]
+declare LLL.LLL_short_vector_iso_def[code]
+declare LLL.LLL_reduce_basis_def[code]
+declare LLL.LLL_reduce_basis_iso_def[code]
+declare LLL.LLL_iso_main_def[code]
+declare LLL.LLL_iso_main_inner.simps[code]
+declare LLL.LLL_add_rows_outer_loop.simps[code]
+declare LLL.LLL_add_rows_loop.simps[code]
+declare LLL.LLL_initial_def[code]
+declare LLL.LLL_main.simps[code]
+declare LLL.LLL_adjust_mod_def[code]
+declare LLL.LLL_max_gso_norm_def[code]
+declare LLL.perform_adjust_mod_def[code]
+declare LLL.LLL_max_gso_norm_di_def[code]
+declare LLL.LLL_max_gso_quot_def[code]
+declare LLL.LLL_step_def[code]
+declare LLL.LLL_add_row_def[code]
+declare LLL.perform_add_row_def[code]
+declare LLL.LLL_swap_row_def[code]
+declare LLL.LLL_swap_add_def[code]
+declare LLL.LLL_adjust_swap_add_def[code]
+declare LLL.perform_swap_add_def[code]
+declare LLL.mod_of_gso_norm_def[code]
+declare LLL.compute_initial_mfs_def[code]
+declare LLL.log_base_def[code]
+
+
+subsection \<open>Towards soundness proof of implementation\<close>
+
+context LLL
+begin
+lemma perform_swap_add: assumes k: "k \<noteq> 0" "k < m" and fs: "length fs = m"
+  shows "LLL_swap_row p (perform_add_row p (fs, dmu, di, mods) k (k - 1) c (dmu !! k) (dmu !! k !! (k - 1)) (di !! k)) k
+    = perform_swap_add p (fs, dmu, di, mods) k (k - 1) c (dmu !! k) (dmu !! k !! (k - 1)) (di !! k)"
+proof -
+  from k[folded fs] 
+  have drop: "drop k fs = fs ! k # drop (Suc k) fs"
+    by (simp add: Cons_nth_drop_Suc)
+  obtain v where v: "vec n (\<lambda>ka. (fs ! k $ ka - c * fs ! (k - 1) $ ka) symmod p) = v" by auto
+  from k[folded fs] 
+  have drop1: "drop (k - 1) (take k fs @ v # drop (Suc k) fs) = fs ! (k - 1) # v # drop (Suc k) fs" 
+    by (simp add: Cons_nth_drop_Suc) 
+      (smt Cons_nth_drop_Suc Suc_diff_Suc Suc_less_eq Suc_pred diff_Suc_less diff_self_eq_0 drop_take less_SucI take_Suc_Cons take_eq_Nil)
+  from k[folded fs]
+  have drop2: "drop (k - 1) fs = fs ! (k - 1) # fs ! k # drop (Suc k) fs" 
+    by (metis Cons_nth_drop_Suc One_nat_def Suc_less_eq Suc_pred less_SucI neq0_conv)
+  have take: "take (k - 1) (take k fs @ xs) = take (k - 1) fs" for xs using k[folded fs] by auto
+  obtain rowk where rowk: "IArray.of_fun
+                             (\<lambda>jj. if jj < k - 1 then (dmu !! k !! jj - c * dmu !! (k - 1) !! jj) symmod mods !! jj
+                else if jj = k - 1 then dmu !! k !! (k - 1) - c * di !! k else dmu !! k !! jj) k = rowk" 
+    by auto
+  obtain mukk1' where mukk1': "(di !! Suc k * di !! (k - 1) + rowk !! (k - 1) * rowk !! (k - 1)) div di !! k = mukk1'" 
+    by auto
+  have kk1: "k - 1 < k" using k by auto
+  have mukk1'': "(di !! Suc k * di !! (k - 1) +
+             (dmu !! k !! (k - 1) - c * di !! k) * (dmu !! k !! (k - 1) - c * di !! k)) div
+            di !! k = mukk1'"
+    unfolding mukk1'[symmetric] rowk[symmetric] IArray.of_fun_nth[OF kk1] by auto
+  have id: "(k = k) = True" by simp
+  have rowk1: "dmu !! k !! (k - 1) - c * di !! k = rowk !! (k - 1)" 
+    unfolding rowk[symmetric] IArray.of_fun_nth[OF kk1] by simp
+  show ?thesis 
+    unfolding perform_swap_add_def split perform_add_row_def Let_def split LLL_swap_row_def split_at_def
+    unfolding drop list.simps v drop1 take prod.inject drop2 rowk IArray.of_fun_nth[OF \<open>k < m\<close>] id if_True
+    unfolding rowk1
+  proof (intro conjI refl iarray_cong, unfold rowk1[symmetric], goal_cases)    
+    case i: (1 i)
+    show ?case unfolding IArray.of_fun_nth[OF i] IArray.of_fun_nth[OF \<open>k < m\<close>] id if_True mukk1' mukk1''
+      rowk1[symmetric]
+    proof (intro if_cong[OF refl], force, goal_cases)
+      case 3
+      hence i: "i = k - 1" by auto
+      show ?case unfolding i by (intro iarray_cong[OF refl], unfold rowk[symmetric],
+          subst IArray.of_fun_nth, insert k, auto)
+    next
+      case ki: 1 (* k < i *)
+      hence id: "(k = i) = False" by auto 
+      show ?case unfolding id if_False rowk
+        by (intro iarray_cong if_cong refl)
+    next
+      case 2 (* k = i *)
+      show ?case unfolding 2 
+        by (intro iarray_cong if_cong refl, subst IArray.of_fun_nth, insert k, auto)
+    qed
+  qed
+qed
+        
+
+lemma LLL_swap_add_eq: assumes i: "i \<noteq> 0" "i < m" and fs: "length fs = m" 
+  shows "LLL_swap_add p (fs,dmu,di,mods) i = (LLL_swap_row p (LLL_add_row p (fs,dmu,di,mods) i (i - 1)) i)" 
+proof -
+  define c where "c = round_num_denom (dmu !! i !! (i - 1)) (di !! i)"
+  from i have si1: "Suc (i - 1) = i" by auto
+  note res1 = LLL_swap_add_def[of p "(fs,dmu,di,mods)" i, unfolded split Let_def c_def[symmetric]]
+  show ?thesis
+  proof (cases "c = 0")
+    case True
+    thus ?thesis using i unfolding res1 LLL_add_row_def split id c_def Let_def by auto
+  next
+    case False
+    hence c: "(c = 0) = False" by simp
+    have add: "LLL_add_row p (fs, dmu, di, mods) i (i - 1) = 
+       perform_add_row p (fs, dmu, di, mods) i (i - 1) c (dmu !! i) (dmu !! i !! (i - 1)) (di !! i)" 
+      unfolding LLL_add_row_def Let_def split si1 c_def[symmetric] c by auto 
+    show ?thesis unfolding res1 c if_False add 
+      by (subst perform_swap_add[OF assms]) simp
+  qed
+qed
+end
+
+
+context LLL_with_assms
+begin
+
+lemma LLL_mod_inv_to_weak: "LLL_invariant_mod fs mfs dmu p first b i \<Longrightarrow> LLL_invariant_mod_weak fs mfs dmu p first b" 
+  unfolding LLL_invariant_mod_def LLL_invariant_mod_weak_def by auto
+
+declare IArray.of_fun_def[simp del]
+
+lemma LLL_swap_row: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and res: "basis_reduction_mod_swap p mfs dmu k = (mfs', dmu')" 
+  and res': "LLL_swap_row p state k = state'" 
+  and k: "k < m" "k \<noteq> 0" 
+shows "state_impl_inv p mfs' dmu' state'" 
+proof -
+  note inv = LLL_invD_modw[OF Linv]
+  obtain fsi dmui di mods where state: "state = (fsi, dmui, di, mods)" by (cases state, auto)
+  obtain fsi' dmui' di' mods' where state': "state' = (fsi', dmui', di', mods')" by (cases state', auto)
+  from impl[unfolded state, simplified]
+  have id: "fsi = mfs" 
+    "di = IArray.of_fun (d_of dmu) (Suc m)" 
+    "dmui = IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmu $$ (i, j)) i) m" 
+    "mods = IArray.of_fun (\<lambda>j. p * di !! j * di !! Suc j) (m - 1)"
+    by auto
+  have kk1: "dmui !! k !! (k - 1) = dmu $$ (k, k - 1)" using k unfolding id 
+      IArray.of_fun_nth[OF k(1)]
+    by (subst IArray.of_fun_nth, auto)
+  have di: "i \<le> m \<Longrightarrow> di !! i = d_of dmu i" for i
+    unfolding id by (subst IArray.of_fun_nth, auto)
+  have dS1: "di !! Suc k = d_of dmu (Suc k)" using di k by auto
+  have d1: "di !! (k - 1) = d_of dmu (k - 1)" using di k by auto
+  have dk: "di !! k = d_of dmu k" using di k by auto
+  define dk' where "dk' = (d_of dmu (Suc k) * d_of dmu (k - 1) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) div d_of dmu k" 
+  define mod1 where "mod1 = p * d_of dmu (k - 1) * dk'" 
+  define modk where "modk = p * dk' * d_of dmu (Suc k)" 
+  define dmu'' where "dmu'' = (mat m m
+      (\<lambda>(i, j).
+          if j < i
+          then if i = k - 1 then dmu $$ (k, j)
+               else if i = k \<and> j \<noteq> k - 1 then dmu $$ (k - 1, j)
+                    else if k < i \<and> j = k then (d_of dmu (Suc k) * dmu $$ (i, k - 1) - dmu $$ (k, k - 1) * dmu $$ (i, j)) div d_of dmu k
+                         else if k < i \<and> j = k - 1 then (dmu $$ (k, k - 1) * dmu $$ (i, j) + dmu $$ (i, k) * d_of dmu (k - 1)) div d_of dmu k else dmu $$ (i, j)
+          else if i = j then if i = k - 1 then (d_of dmu (Suc k) * d_of dmu (k - 1) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) div d_of dmu k else d_of dmu (Suc i)
+               else dmu $$ (i, j)))" 
+  have drop: "drop (k - 1) fsi = mfs ! (k - 1) # mfs ! k # drop (Suc k) mfs" unfolding id using \<open>length mfs = m\<close> k
+    by (metis Cons_nth_drop_Suc One_nat_def Suc_less_eq Suc_pred less_SucI linorder_neqE_nat not_less0)
+  have dk': "dk' = d_of dmu'' k" unfolding dk'_def d_of_def dmu''_def using k by auto
+  have mod1: "mod1 = p * d_of dmu'' (k - 1) * d_of dmu'' k" unfolding mod1_def dk' using k
+    by (auto simp: dmu''_def d_of_def)
+  have modk: "modk = p * d_of dmu'' k * d_of dmu'' (Suc k)" unfolding modk_def dk' using k
+    by (auto simp: dmu''_def d_of_def)
+  note res = res[unfolded basis_reduction_mod_swap_def, folded dmu''_def, symmetric]
+  note res' = res'[unfolded state state' split_at_def drop list.simps split LLL_swap_row_def Let_def kk1 dS1 d1 dk, 
+      folded dk'_def mod1_def modk_def, symmetric]
+  from res' have fsi': "fsi' = take (k - 1) mfs @ mfs ! k # mfs ! (k - 1) # drop (Suc k) mfs" unfolding id by simp
+  from res' have di': "di' = IArray.of_fun (\<lambda>ii. if ii = k then dk' else di !! ii) (Suc m)" by simp
+  from res' have dmui': "dmui' = IArray.of_fun
+    (\<lambda>i. if i < k - 1 then dmui !! i
+         else if k < i then IArray.of_fun
+                    (\<lambda>j. if j = k - 1
+                         then (dmu $$ (k, k - 1) * dmui !! i !! (k - 1) + dmui !! i !! k * d_of dmu (k - 1)) 
+                                 div d_of dmu k symmod mod1
+                         else if j = k
+                              then (d_of dmu (Suc k) * dmui !! i !! (k - 1) - dmu $$ (k, k - 1) * dmui !! i !! k) 
+                                 div d_of dmu k symmod modk                                   
+                              else dmui !! i !! j)
+                    i
+              else if i = k then IArray.of_fun (\<lambda>j. if j = k - 1 then dmu $$ (k, k - 1) symmod mod1 
+        else dmui !! (k - 1) !! j) i else IArray.of_fun ((!!) (dmui !! k)) i)
+    m" by auto
+  from res' have mods': "mods' = IArray.of_fun (\<lambda>jj. if jj = k - 1 then mod1 else if jj = k then modk else mods !! jj) (m - 1)"
+    by auto
+  from res have dmu': "dmu' = basis_reduction_mod_swap_dmu_mod p dmu'' k" by auto
+  show ?thesis unfolding state' state_impl_inv.simps
+  proof (intro conjI)
+    from res have mfs': "mfs' = mfs[k := mfs ! (k - 1), k - 1 := mfs ! k]" by simp
+    show "fsi' = mfs'" unfolding fsi' mfs' using \<open>length mfs = m\<close> k 
+    proof (intro nth_equalityI, force, goal_cases)
+      case (1 j)
+      have choice: "j = k - 1 \<or> j = k \<or> j < k - 1 \<or> j > k" by linarith
+      have "min (length mfs) (k - 1) = k - 1" using 1 by auto
+      with 1 choice show ?case by (auto simp: nth_append)
+    qed
+    show "di' = IArray.of_fun (d_of dmu') (Suc m)" unfolding di' 
+    proof (intro iarray_cong refl, goal_cases)
+      case i: (1 i)
+      hence "d_of dmu' i = d_of dmu'' i" unfolding dmu' basis_reduction_mod_swap_dmu_mod_def d_of_def
+        by (intro if_cong, auto)
+      also have "\<dots> = ((if i = k then dk' else di !! i))" 
+      proof (cases "i = k")
+        case False
+        hence "d_of dmu'' i = d_of dmu i" unfolding dmu''_def d_of_def using i k
+          by (intro if_cong refl, auto)
+        thus ?thesis using False i k unfolding id by (metis iarray_of_fun_sub)
+      next
+        case True
+        thus ?thesis using dk' by auto
+      qed
+      finally show ?case by simp
+    qed
+    have dkS1: "d_of dmu (Suc k) = d_of dmu'' (Suc k)" 
+      unfolding dmu''_def d_of_def using k by auto
+    have dk1: "d_of dmu (k - 1) = d_of dmu'' (k - 1)" 
+      unfolding dmu''_def d_of_def using k by auto
+    show "dmui' = IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmu' $$ (i, j)) i) m" 
+      unfolding dmui'
+    proof (intro iarray_cong refl, goal_cases)
+      case i: (1 i)
+      consider (1) "i < k - 1" | (2) "i = k - 1" | (3) "i = k" | (4) "i > k" by linarith
+      thus ?case
+      proof (cases)
+        case 1
+        hence *: "(i < k - 1) = True" by simp
+        show ?thesis unfolding * if_True id IArray.of_fun_nth[OF i] using i k 1
+          by (intro iarray_cong refl, auto simp: dmu' basis_reduction_mod_swap_dmu_mod_def, auto simp: dmu''_def)
+      next
+        case 2
+        hence *: "(i < k - 1) = False" "(k < i) = False" "(i = k) = False" using k by auto
+        show ?thesis unfolding * if_False id using i k 2 unfolding IArray.of_fun_nth[OF k(1)]
+          by (intro iarray_cong refl, subst IArray.of_fun_nth, auto simp: dmu' basis_reduction_mod_swap_dmu_mod_def dmu''_def)
+      next
+        case 3
+        hence *: "(i < k - 1) = False" "(k < i) = False" "(i = k) = True" using k by auto
+        show ?thesis unfolding * if_False if_True id IArray.of_fun_nth[OF k(1)]
+        proof (intro iarray_cong refl, goal_cases)
+          case j: (1 j)
+          show ?case
+          proof (cases "j = k - 1")
+            case False
+            hence *: "(j = k - 1) = False" by auto
+            show ?thesis unfolding * if_False using False j k i 3
+              by (subst IArray.of_fun_nth, force, subst IArray.of_fun_nth, force, auto simp: dmu' basis_reduction_mod_swap_dmu_mod_def dmu''_def)
+          next
+            case True
+            hence *: "(j = k - 1) = True" by auto
+            show ?thesis unfolding * if_True unfolding True 3 using k
+              by (auto simp: basis_reduction_mod_swap_dmu_mod_def dmu' dk' mod1 dmu''_def)
+          qed
+        qed
+      next
+        case 4
+        hence *: "(i < k - 1) = False" "(k < i) = True" using k by auto
+        show ?thesis unfolding * if_False if_True id IArray.of_fun_nth[OF k(1)] IArray.of_fun_nth[OF \<open>i < m\<close>]
+        proof (intro iarray_cong refl, goal_cases)
+          case j: (1 j)
+          from 4 have k1: "k - 1 < i" by auto
+          show ?case unfolding IArray.of_fun_nth[OF j] IArray.of_fun_nth[OF 4] IArray.of_fun_nth[OF k1]
+            unfolding mod1 modk dmu' basis_reduction_mod_swap_dmu_mod_def using i j 4 k
+            by (auto intro!: arg_cong[of _ _ "\<lambda> x. x symmod _"], auto simp: dmu''_def)
+        qed
+      qed
+    qed
+    show "mods' = IArray.of_fun (\<lambda>j. p * di' !! j * di' !! Suc j) (m - 1)" 
+      unfolding mods' di' dk' mod1 modk
+    proof (intro iarray_cong refl, goal_cases)
+      case (1 j)
+      hence j: "j < Suc m" "Suc j < Suc m" by auto
+      show ?case unfolding  
+        IArray.of_fun_nth[OF 1]
+        IArray.of_fun_nth[OF j(1)]
+        IArray.of_fun_nth[OF j(2)] id(4) using k di dk1 dkS1
+        by auto
+    qed
+  qed
+qed
+
+
+lemma LLL_add_row: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" 
+  and res: "basis_reduction_mod_add_row p mfs dmu i j = (mfs', dmu')" 
+  and res': "LLL_add_row p state i j = state'" 
+  and i: "i < m"
+  and j: "j < i"
+shows "state_impl_inv p mfs' dmu' state'"
+proof - 
+  note inv = LLL_invD_modw[OF Linv]
+  obtain fsi dmui di mods where state: "state = (fsi, dmui, di, mods)" by (cases state, auto)
+  obtain fsi' dmui' di' mods' where state': "state' = (fsi', dmui', di', mods')" by (cases state', auto)
+  from impl[unfolded state, simplified]
+  have id: "fsi = mfs" 
+    "di = IArray.of_fun (d_of dmu) (Suc m)" 
+    "dmui = IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmu $$ (i, j)) i) m"
+    "mods = IArray.of_fun (\<lambda>j. p * di !! j * di !! Suc j) (m - 1)" 
+    by auto
+  let ?c = "round_num_denom (dmu $$ (i, j)) (d_of dmu (Suc j))" 
+  let ?c' = "round_num_denom (dmui !! i !! j) (di !! Suc j)" 
+  obtain c where c: "?c = c" by auto
+  have c': "?c' = c" unfolding id c[symmetric] using i j
+    by (subst (1 2) IArray.of_fun_nth, (force+)[2],
+      subst IArray.of_fun_nth, force+)
+  have drop: "drop i fsi = mfs ! i # drop (Suc i) mfs" unfolding id using \<open>length mfs = m\<close> i
+    by (metis Cons_nth_drop_Suc)
+  note res = res[unfolded basis_reduction_mod_add_row_def Let_def c, symmetric]
+  note res' = res'[unfolded state state' split LLL_add_row_def Let_def c', symmetric]
+  show ?thesis 
+  proof (cases "c = 0")
+    case True
+    from res[unfolded True] res'[unfolded True] show ?thesis unfolding state' using id by auto
+  next
+    case False
+    hence False: "(c = 0) = False" by simp
+    note res = res[unfolded Let_def False if_False]
+    from res have mfs': "mfs' = mfs[i := map_vec (\<lambda>x. x symmod p) (mfs ! i - c \<cdot>\<^sub>v mfs ! j)]" by auto
+    from res have dmu': "dmu' = mat m m (\<lambda>(i', j').
+        if i' = i \<and> j' \<le> j
+        then if j' = j then dmu $$ (i, j') - c * dmu $$ (j, j')
+             else (dmu $$ (i, j') - c * dmu $$ (j, j')) symmod (p * d_of dmu j' * d_of dmu (Suc j'))
+        else dmu $$ (i', j'))" by auto
+    note res' = res'[unfolded Let_def False if_False perform_add_row_def drop list.simps split_at_def split]
+    from res' have fsi': "fsi' = take i fsi @ vec n (\<lambda>k. (mfs ! i $ k - c * mfs ! j $ k) symmod p) # drop (Suc i) mfs" 
+      by (auto simp: id)
+    from res' have di': "di' = di" and mods': "mods' = mods" by auto
+    from res' have dmui': "dmui' = IArray.of_fun (\<lambda>ii. if i = ii
+          then IArray.of_fun
+                (\<lambda>jj. if jj < j then (dmui !! i !! jj - c * dmui !! j !! jj) symmod (mods !! jj)
+                      else if jj = j then dmui !! i !! j - c * di !! (Suc j) else dmui !! i !! jj)
+                i
+          else dmui !! ii) m" by auto
+    show ?thesis unfolding state' state_impl_inv.simps
+    proof (intro conjI)
+      from inv(11) i j have vec: "mfs ! i \<in> carrier_vec n" "mfs ! j \<in> carrier_vec n" by auto
+      hence id': "map_vec (\<lambda>x. x symmod p) (mfs ! i - c \<cdot>\<^sub>v mfs ! j) = vec n (\<lambda>k. (mfs ! i $ k - c * mfs ! j $ k) symmod p)" 
+        by (intro eq_vecI, auto)
+      show "mods' = IArray.of_fun (\<lambda>j. p * di' !! j * di' !! Suc j) (m - 1)" using id unfolding mods' di' by auto
+      show "fsi' = mfs'" unfolding fsi' mfs' id unfolding id' using \<open>length mfs = m\<close> i
+        by (simp add: upd_conv_take_nth_drop)
+      show "di' = IArray.of_fun (d_of dmu') (Suc m)" 
+        unfolding dmu' di' id d_of_def
+        by (intro iarray_cong if_cong refl, insert i j, auto)
+      show "dmui' = IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmu' $$ (i, j)) i) m" 
+        unfolding dmui'
+      proof (intro iarray_cong refl)
+        fix ii
+        assume ii: "ii < m" 
+        show "(if i = ii
+           then IArray.of_fun
+                 (\<lambda>jj. if jj < j then (dmui !! i !! jj - c * dmui !! j !! jj) symmod (mods !! jj)
+                       else if jj = j then dmui !! i !! j - c * di !! (Suc j) else dmui !! i !! jj)
+                 i
+           else dmui !! ii) =
+          IArray.of_fun (\<lambda>j. dmu' $$ (ii, j)) ii" 
+        proof (cases "i = ii")
+          case False
+          hence *: "(i = ii) = False" by auto
+          show ?thesis unfolding * if_False id dmu' using False i j ii
+            unfolding IArray.of_fun_nth[OF ii]
+            by (intro iarray_cong refl, auto)
+        next
+          case True
+          hence *: "(i = ii) = True" by auto         
+          from i j have "j < m" by simp
+          show ?thesis unfolding * if_True dmu' id IArray.of_fun_nth[OF i] IArray.of_fun_nth[OF \<open>j < m\<close>]
+            unfolding True[symmetric]
+          proof (intro iarray_cong refl, goal_cases)
+            case jj: (1 jj)
+            consider (1) "jj < j" | (2) "jj = j" | (3) "jj > j" by linarith
+            thus ?case 
+            proof cases
+              case 1
+              thus ?thesis using jj i j unfolding id(4)
+                by (subst (1 2 3 4 5 6) IArray.of_fun_nth, auto)
+            next
+              case 2
+              thus ?thesis using jj i j
+                by (subst (5 6) IArray.of_fun_nth, auto simp: d_of_def)
+            next
+              case 3
+              thus ?thesis using jj i j
+                by (subst (7) IArray.of_fun_nth, auto simp: d_of_def)
+            qed
+          qed
+        qed
+      qed
+    qed
+  qed
+qed
+
+
+lemma LLL_max_gso_norm_di: assumes di: "di = IArray.of_fun (d_of dmu) (Suc m)"
+  and m: "m \<noteq> 0" 
+shows "LLL_max_gso_norm_di first di = compute_max_gso_norm first dmu"
+proof -
+  have di: "j \<le> m \<Longrightarrow> di !! j = d_of dmu j" for j unfolding di
+    by (subst IArray.of_fun_nth, auto)
+  have id: "(m = 0) = False" using m by auto
+  show ?thesis
+  proof (cases first)
+    case False
+    hence id': "first = False" by auto
+    show ?thesis unfolding LLL_max_gso_norm_di_def compute_max_gso_norm_def id id' if_False
+      by (intro if_cong refl arg_cong[of _ _ "\<lambda> xs. case max_list_rats_with_index xs of (num, denom, i) \<Rightarrow> (rat_of_int num / rat_of_int denom, i)"], 
+          unfold map_eq_conv, intro ballI, subst (1 2) di, auto)
+  next
+    case True
+    hence id': "first = True" by auto
+    show ?thesis unfolding LLL_max_gso_norm_di_def compute_max_gso_norm_def id id' if_False if_True
+      using m di[of 1]
+      by (simp add: d_of_def)
+  qed
+qed
+
+lemma LLL_max_gso_quot: assumes di: "di = IArray.of_fun (d_of dmu) (Suc m)"
+  and prods: "state_iso_inv di_prods di" 
+shows "LLL_max_gso_quot di_prods = compute_max_gso_quot dmu"
+proof -
+  have di: "j \<le> m \<Longrightarrow> di !! j = d_of dmu j" for j unfolding di
+    by (subst IArray.of_fun_nth, auto)
+  show ?thesis unfolding LLL_max_gso_quot_def compute_max_gso_quot_def prods[unfolded state_iso_inv_def]
+    by (intro if_cong refl arg_cong[of _ _ max_list_rats_with_index], unfold map_eq_conv Let_def, intro ballI,
+     subst IArray.of_fun_nth, force, unfold split,
+     subst (1 2 3 4) di, auto)
+qed
+
+lemma LLL_max_gso_norm: assumes impl: "state_impl_inv p mfs dmu state" 
+  and m: "m \<noteq> 0" 
+shows "LLL_max_gso_norm first state = compute_max_gso_norm first dmu"
+proof -
+  obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di,mods)" 
+    by (metis prod_cases3)
+  from impl[unfolded state state_impl_inv.simps]
+  have di: "di = IArray.of_fun (d_of dmu) (Suc m)" by auto
+  show ?thesis using LLL_max_gso_norm_di[OF di m] unfolding LLL_max_gso_norm_def state split .
+qed
+
+lemma mod_of_gso_norm: "m \<noteq> 0 \<Longrightarrow> mod_of_gso_norm first mn =
+  compute_mod_of_max_gso_norm first mn" 
+  unfolding mod_of_gso_norm_def compute_mod_of_max_gso_norm_def bound_number_def
+  by auto
+
+lemma LLL_adjust_mod: assumes impl: "state_impl_inv p mfs dmu state" 
+  and res: "basis_reduction_adjust_mod p first mfs dmu = (p', mfs', dmu', g_idx)" 
+  and res': "LLL_adjust_mod p first state = (p'', state', g_idx')" 
+  and m: "m \<noteq> 0" 
+shows "state_impl_inv p' mfs' dmu' state' \<and> p'' = p' \<and> g_idx' = g_idx"
+proof -
+  from LLL_max_gso_norm[OF impl m] 
+  have id: "LLL_max_gso_norm first state = compute_max_gso_norm first dmu" by auto
+  obtain b gi where norm: "compute_max_gso_norm first dmu = (b, gi)" by force
+  obtain P where P: "compute_mod_of_max_gso_norm first b = P" by auto
+  note res = res[unfolded basis_reduction_adjust_mod.simps Let_def P norm split]
+  note res' = res'[unfolded LLL_adjust_mod_def id Let_def P norm split mod_of_gso_norm[OF m]]
+  show ?thesis
+  proof (cases "P < p")
+    case False
+    thus ?thesis using res res' impl by (auto split: if_splits)
+  next
+    case True
+    hence id: "(P < p) = True" by auto
+    obtain fsi dmui di mods where state: "state = (fsi, dmui, di, mods)" by (metis prod_cases3)
+    from impl[unfolded state state_impl_inv.simps]
+    have impl: "fsi = mfs" "di = IArray.of_fun (d_of dmu) (Suc m)" "dmui = IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmu $$ (i, j)) i) m" by auto
+    note res = res[unfolded id if_True]
+    from res have mfs': "mfs' = map (map_vec (\<lambda>x. x symmod P)) mfs" 
+       and p': "p' = P" 
+       and dmu': "dmu' = mat m m (\<lambda>(i, j). if j < i then dmu $$ (i, j) symmod (P * vec (Suc m) (d_of dmu) $ j * vec (Suc m) (d_of dmu) $ Suc j) else dmu $$ (i, j))" 
+       and gidx: "g_idx = gi" 
+      by auto
+    let ?mods = "IArray.of_fun (\<lambda>j. P * di !! j * di !! Suc j) (m - 1)" 
+    let ?dmu = "IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmui !! i !! j symmod ?mods !! j) i) m" 
+    note res' = res'[unfolded id if_True state split impl(1) perform_adjust_mod_def Let_def]
+    from res' have p'': "p'' = P" and state': "state' = (map (map_vec (\<lambda>x. x symmod P)) mfs, ?dmu, di, ?mods)" 
+       and gidx': "g_idx' = gi" by auto
+    show ?thesis unfolding state' state_impl_inv.simps mfs' p'' p' gidx gidx'
+    proof (intro conjI refl)
+      show "di = IArray.of_fun (d_of dmu') (Suc m)" unfolding impl
+        by (intro iarray_cong refl, auto simp: dmu' d_of_def)
+      show "?dmu = IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. dmu' $$ (i, j)) i) m" 
+      proof (intro iarray_cong refl, goal_cases)
+        case (1 i j)
+        hence "j < m" "Suc j < Suc m" "j < Suc m" "j < m - 1" by auto
+        show ?case unfolding dmu' impl IArray.of_fun_nth[OF \<open>i < m\<close>] IArray.of_fun_nth[OF \<open>j < i\<close>]
+            IArray.of_fun_nth[OF \<open>j < m\<close>] IArray.of_fun_nth[OF \<open>Suc j < Suc m\<close>]
+            IArray.of_fun_nth[OF \<open>j < Suc m\<close>] IArray.of_fun_nth[OF \<open>j < m - 1\<close>] using 1 by auto
+      qed
+    qed
+  qed
+qed
+
+lemma LLL_adjust_swap_add: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and res: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx k = (p', mfs', dmu', g_idx')" 
+  and res': "LLL_adjust_swap_add p first state g_idx k = (p'',state', G_idx')" 
+  and k: "k < m" and k0: "k \<noteq> 0" 
+shows "state_impl_inv p' mfs' dmu' state'" "p'' = p'" "G_idx' = g_idx'" 
+  "i \<le> m \<Longrightarrow> i \<noteq> k \<Longrightarrow> di_of state' !! i = di_of state !! i" 
+proof (atomize(full), goal_cases)
+  case 1
+  from k have m: "m \<noteq> 0" by auto
+  obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di, mods)" 
+    by (metis prod_cases3)
+  obtain state'' where add': "LLL_add_row p state k (k - 1) = state''" by blast
+  obtain mfs'' dmu'' where add: "basis_reduction_mod_add_row p mfs dmu k (k - 1) = (mfs'', dmu'')" by force
+  obtain mfs3 dmu3 where swap: "basis_reduction_mod_swap p mfs'' dmu'' k = (mfs3, dmu3)" by force
+  obtain state3 where swap': "LLL_swap_row p state'' k = state3" by blast
+  obtain mfsi2 dmui2 di2 mods2 where state2: "state'' = (mfsi2, dmui2, di2, mods2)" by (cases state'', auto)
+  obtain mfsi3 dmui3 di3 mods3 where state3: "state3 = (mfsi3, dmui3, di3, mods3)" by (cases state3, auto)
+  have "length mfsi = m" using impl[unfolded state state_impl_inv.simps] LLL_invD_modw[OF Linv] by auto
+  note res' = res'[unfolded state LLL_adjust_swap_add_def LLL_swap_add_eq[OF k0 k this], folded state, unfolded add' swap' Let_def]
+  note res = res[unfolded basis_reduction_adjust_swap_add_step_def Let_def add split swap]
+  from LLL_add_row[OF impl Linv add add' k] k0
+  have impl': "state_impl_inv p mfs'' dmu'' state''" by auto
+  from basis_reduction_mod_add_row[OF Linv add k _ k0] k0
+  obtain fs'' where Linv': "LLL_invariant_mod_weak fs'' mfs'' dmu'' p first b" by auto
+  from LLL_swap_row[OF impl' Linv' swap swap' k k0] 
+  have impl3: "state_impl_inv p mfs3 dmu3 state3" .
+  have di2: "di2 = di" using add'[unfolded state LLL_add_row_def Let_def split perform_add_row_def state2]
+    by (auto split: if_splits)
+  have di3: "di3 = IArray.of_fun (\<lambda>i. if i = k then (di2 !! Suc k * di2 !! (k - 1) + dmui2 !! k !! (k - 1) * dmui2 !! k !! (k - 1)) div di2 !! k else di2 !! i) (Suc m)" 
+    using swap'[unfolded state2 state3] 
+    unfolding LLL_swap_row_def Let_def by simp 
+  have di3: "i \<le> m \<Longrightarrow> i \<noteq> k \<Longrightarrow> di3 !! i = di !! i"
+    unfolding di2[symmetric] di3 
+    by (subst IArray.of_fun_nth, auto)
+  show ?case
+  proof (cases "k - 1 = g_idx")
+    case True
+    hence id: "(k - 1 = g_idx) = True" by simp
+    note res = res[unfolded id if_True]
+    note res' = res'[unfolded id if_True]
+    obtain mfsi4 dmui4 di4 mods4 where state': "state' = (mfsi4, dmui4, di4, mods4)" by (cases state', auto)
+    from res'[unfolded state3 state' LLL_adjust_mod_def Let_def perform_adjust_mod_def] have di4: "di4 = di3" 
+      by (auto split: if_splits prod.splits)
+    from LLL_adjust_mod[OF impl3 res res' m] di3 state state' di4 res'
+    show ?thesis by auto
+  next
+    case False
+    hence id: "(k - 1 = g_idx) = False" by simp
+    note res = res[unfolded id if_False]
+    note res' = res'[unfolded id if_False]
+    from impl3 res res' di3 state state3 show ?thesis by auto
+  qed
+qed
+  
+
+
+lemma LLL_step: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and res: "basis_reduction_mod_step p first mfs dmu g_idx k j = (p', mfs', dmu', g_idx', k', j')" 
+  and res': "LLL_step p first state g_idx k j = ((p'',state', g_idx''), k'', j'')" 
+  and k: "k < m" 
+shows "state_impl_inv p' mfs' dmu' state' \<and> k'' = k' \<and> p'' = p' \<and> j'' = j' \<and> g_idx'' = g_idx'"
+proof (cases "k = 0")
+  case True
+  thus ?thesis using res res' impl unfolding LLL_step_def basis_reduction_mod_step_def by auto
+next
+  case k0: False
+  hence id: "(k = 0) = False" by simp
+  note res = res[unfolded basis_reduction_mod_step_def id if_False]
+  obtain num denom where alph: "quotient_of \<alpha> = (num,denom)" by force
+  obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di, mods)" 
+    by (metis prod_cases3)
+  note res' = res'[unfolded LLL_step_def id if_False Let_def state split alph, folded state]
+  from k0 have kk1: "k - 1 < k" by auto
+  note res = res[unfolded Let_def alph split]
+  obtain state'' where addi: "LLL_swap_add p state k = state''" by auto
+  from impl[unfolded state state_impl_inv.simps] 
+  have di: "di = IArray.of_fun (d_of dmu) (Suc m)" by auto
+  have id: "di !! k = d_of dmu k" 
+    "di !! (Suc k) = d_of dmu (Suc k)" 
+    "di !! (k - 1) = d_of dmu (k - 1)" 
+    unfolding di using k
+    by (subst IArray.of_fun_nth, force, force)+
+  have "length mfsi = m" using impl[unfolded state state_impl_inv.simps] LLL_invD_modw[OF Linv] by auto
+  note res' = res'[unfolded id]
+  let ?cond = "d_of dmu k * d_of dmu k * denom \<le> num * d_of dmu (k - 1) * d_of dmu (Suc k)" 
+  show ?thesis
+  proof (cases ?cond)
+    case True
+    from True res res' state show ?thesis using impl by auto
+  next
+    case False
+    hence cond: "?cond = False" by simp
+    note res = res[unfolded cond if_False]
+    note res' = res'[unfolded cond if_False]
+    let ?step = "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx k" 
+    let ?step' = "LLL_adjust_swap_add p first state g_idx k" 
+    from res have step: "?step = (p', mfs', dmu', g_idx')" by (cases ?step, auto)
+    note res = res[unfolded step split]
+    from res' have step': "?step' = (p'',state', g_idx'')" by auto
+    note res' = res'[unfolded step']
+    from LLL_adjust_swap_add[OF impl Linv step step' k k0] 
+    show ?thesis using res res' by auto
+  qed
+qed
+
+
+lemma LLL_main: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod fs mfs dmu p first b i"
+  and res: "basis_reduction_mod_main p first mfs dmu g_idx i k = (p', mfs', dmu')" 
+  and res': "LLL_main p first state g_idx i k = (pi', state')" 
+shows "state_impl_inv p' mfs' dmu' state' \<and> pi' = p'"
+  using assms
+proof (induct "LLL_measure i fs" arbitrary: mfs dmu state fs p b k i g_idx rule: less_induct)
+  case (less fs i mfs dmu state p b k g_idx)
+  note impl = less(2)
+  note Linv = less(3)
+  note res = less(4)
+  note res' = less(5)
+  note IH = less(1)
+  note res = res[unfolded basis_reduction_mod_main.simps[of _ _ _ _ _ _ k]]
+  note res' = res'[unfolded LLL_main.simps[of _ _ _ _ _ k]]
+  note Linvw = LLL_mod_inv_to_weak[OF Linv]
+  show ?case
+  proof (cases "i < m")
+    case False
+    thus ?thesis using res res' impl by auto
+  next 
+    case i: True
+    hence id: "(i < m) = True" by simp
+    obtain P'' state'' I'' K'' G_idx'' where step': "LLL_step p first state g_idx i k = ((P'', state'', G_idx''), I'', K'')" 
+      by (metis prod_cases3)
+    obtain p'' mfs'' dmu'' i'' k'' g_idx'' where step: "basis_reduction_mod_step p first mfs dmu g_idx i k = (p'', mfs'', dmu'', g_idx'', i'', k'')" 
+      by (metis prod_cases3)
+    from LLL_step[OF impl Linvw step step' i]
+    have impl'': "state_impl_inv p'' mfs'' dmu'' state''" and ID: "I'' = i''" "K'' = k''" "P'' = p''" "G_idx'' = g_idx''" by auto
+    from basis_reduction_mod_step[OF Linv step i] obtain
+       fs'' b'' where 
+       Linv'': "LLL_invariant_mod fs'' mfs'' dmu'' p'' first b'' i''" and 
+       decr: "LLL_measure i'' fs'' < LLL_measure i fs" by auto
+    note res = res[unfolded id if_True step split]
+    note res' = res'[unfolded id if_True step' split ID]
+    show ?thesis
+      by (rule IH[OF decr impl'' Linv'' res res'])
+  qed
+qed
+
+lemma LLL_iso_main_inner: assumes impl: "state_impl_inv p mfs dmu state" 
+  and di_prods: "state_iso_inv di_prods (di_of state)" 
+  and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and res: "basis_reduction_iso_main p first mfs dmu g_idx k = (p', mfs', dmu')" 
+  and res': "LLL_iso_main_inner p first state di_prods g_idx k = (pi', state')" 
+  and m: "m > 1" 
+shows "state_impl_inv p' mfs' dmu' state' \<and> pi' = p'"
+  using assms(1-5)
+proof (induct "LLL_measure (m - 1) fs" arbitrary: mfs dmu state fs p b k di_prods g_idx rule: less_induct)
+  case (less fs mfs dmu state p b k di_prods g_idx)
+  note impl = less(2)
+  note di_prods  = less(3)
+  note Linv = less(4)
+  note res = less(5)
+  note res' = less(6)
+  note IH = less(1)
+  obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di, mods)" 
+    by (metis prod_cases4)
+  from di_prods state have di_prods: "state_iso_inv di_prods di" by auto
+  obtain num denom idx where quot': "LLL_max_gso_quot di_prods = (num, denom, idx)" 
+    by (metis prod_cases3)
+  note inv = LLL_invD_modw[OF Linv]
+  obtain na da where alph: "quotient_of \<alpha> = (na,da)" by force
+  from impl[unfolded state] have di: "di = IArray.of_fun (d_of dmu) (Suc m)" by auto
+  from LLL_max_gso_quot[OF di di_prods] have quot: "compute_max_gso_quot dmu = LLL_max_gso_quot di_prods" ..
+  obtain cmp where cmp: "(na * denom < num * da) = cmp" by force
+  have "(m > 1) = True" using m by auto
+  note res = res[unfolded basis_reduction_iso_main.simps[of _ _ _ _ _ k] this if_True Let_def quot quot' split alph cmp]
+  note res' = res'[unfolded LLL_iso_main_inner.simps[of _ _ _ _ _ k] state split Let_def quot' alph cmp, folded state]
+  note cmp = compute_max_gso_quot_alpha[OF Linv quot[unfolded quot'] alph cmp m]
+  show ?case
+  proof (cases cmp)
+    case False
+    thus ?thesis using res res' impl by auto
+  next 
+    case True
+    hence id: "cmp = True" by simp 
+    note cmp = cmp(1)[OF True]
+    obtain state'' P'' G_idx'' where step': "LLL_adjust_swap_add p first state g_idx idx = (P'',state'', G_idx'')" 
+      by (metis prod.exhaust)
+    obtain mfs'' dmu'' p'' g_idx'' where step: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx idx = (p'', mfs'', dmu'', g_idx'')" 
+      by (metis prod_cases3)
+    obtain mfsi2 dmui2 di2 mods2 where state2: "state'' = (mfsi2, dmui2, di2, mods2)" by (cases state'', auto)
+    note res = res[unfolded id if_True step split]
+    note res' = res'[unfolded id if_True step' state2 split, folded state2]
+    from cmp have idx0: "idx \<noteq> 0" and idx: "idx < m" and ineq: "\<not> d_of dmu idx * d_of dmu idx * da \<le> na * d_of dmu (idx - 1) * d_of dmu (Suc idx)" 
+      by auto
+    from basis_reduction_adjust_swap_add_step[OF Linv step alph ineq idx idx0]
+    obtain fs'' b'' where Linv'': "LLL_invariant_mod_weak fs'' mfs'' dmu'' p'' first b''" and
+       meas: "LLL_measure (m - 1) fs'' < LLL_measure (m - 1) fs" by auto
+    from LLL_adjust_swap_add[OF impl Linv step step' idx idx0]
+    have impl'': "state_impl_inv p'' mfs'' dmu'' state''" and P'': "P'' = p''" "G_idx'' = g_idx''" 
+      and di_prod_upd: "\<And> i. i \<le> m \<Longrightarrow> i \<noteq> idx \<Longrightarrow> di2 !! i = di !! i" 
+      using state state2 by auto
+    have di_prods: "state_iso_inv (IArray.of_fun
+       (\<lambda>i. if idx < i \<or> i + 2 < idx then di_prods !! i
+            else case di_prods !! i of (l, r) \<Rightarrow> if i + 1 = idx then (di2 !! idx * di2 !! idx, r) else (l, di2 !! (i + 2) * di2 !! i))
+       (m - 1)) di2" unfolding state_iso_inv_def
+      by (intro iarray_cong', insert di_prod_upd, unfold di_prods[unfolded state_iso_inv_def],
+        subst (1 2) IArray.of_fun_nth, auto)
+    show ?thesis 
+      by (rule IH[OF meas impl'' _ Linv'' res res'[unfolded step' P'']], insert di_prods state2, auto)
+  qed
+qed
+
+lemma LLL_iso_main: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b"
+  and res: "basis_reduction_iso_main p first mfs dmu g_idx k = (p', mfs', dmu')" 
+  and res': "LLL_iso_main p first state g_idx k = (pi', state')" 
+shows "state_impl_inv p' mfs' dmu' state' \<and> pi' = p'"
+proof (cases "m > 1")
+  case True
+  from LLL_iso_main_inner[OF impl _ Linv res _ True, unfolded state_iso_inv_def, OF refl, of pi' state'] res' True
+  show ?thesis unfolding LLL_iso_main_def by (cases state, auto)
+next
+  case False
+  thus ?thesis using res res' impl unfolding LLL_iso_main_def
+    basis_reduction_iso_main.simps[of _ _ _ _ _ k] by auto
+qed
+
+lemma LLL_initial: assumes res: "compute_initial_state first = (p, mfs, dmu, g_idx)" 
+  and res': "LLL_initial first = (p', state, g_idx')" 
+  and m: "m \<noteq> 0" 
+shows "state_impl_inv p mfs dmu state \<and> p' = p \<and> g_idx' = g_idx"
+proof -
+  obtain b gi where norm: "compute_max_gso_norm first dmu_initial = (b,gi)" by force
+  obtain P where P: "compute_mod_of_max_gso_norm first b = P" by auto
+  define di where "di = IArray.of_fun (\<lambda>i. if i = 0 then 1 else d\<mu>_impl fs_init !! (i - 1) !! (i - 1)) (Suc m)" 
+  note res = res[unfolded compute_initial_state_def Let_def P norm split]
+  have di: "di = IArray.of_fun (d_of dmu_initial) (Suc m)" 
+    unfolding di_def dmu_initial_def Let_def d_of_def
+    by (intro iarray_cong refl if_cong, auto)  
+  note norm' = LLL_max_gso_norm_di[OF di m, of first, unfolded norm]
+  note res' = res'[unfolded LLL_initial_def Let_def, folded di_def, unfolded norm' P split mod_of_gso_norm[OF m]]
+  from res have p: "p = P" and mfs: "mfs = compute_initial_mfs p" and dmu: "dmu = compute_initial_dmu P dmu_initial" 
+    and g_idx: "g_idx = gi" 
+     by auto
+  let ?mods = "IArray.of_fun (\<lambda>j. P * di !! j * di !! Suc j) (m - 1)" 
+  have di': "di = IArray.of_fun (d_of (compute_initial_dmu P dmu_initial)) (Suc m)" 
+    unfolding di
+    by (intro iarray_cong refl, auto simp: compute_initial_dmu_def d_of_def)
+  from res' have p': "p' = P" and g_idx': "g_idx' = gi" and state: 
+    "state = (compute_initial_mfs P, IArray.of_fun (\<lambda>i. IArray.of_fun (\<lambda>j. d\<mu>_impl fs_init !! i !! j symmod ?mods !! j) i) m, di, ?mods)" 
+    by auto
+  show ?thesis unfolding mfs p state p' dmu state_impl_inv.simps g_idx' g_idx
+  proof (intro conjI refl di' iarray_cong, goal_cases)
+    case (1 i j)
+    hence "j < m" "Suc j < Suc m" "j < Suc m" "j < m - 1" by auto
+    thus ?case unfolding compute_initial_dmu_def di 
+        IArray.of_fun_nth[OF \<open>j < m\<close>]
+        IArray.of_fun_nth[OF \<open>Suc j < Suc m\<close>]
+        IArray.of_fun_nth[OF \<open>j < Suc m\<close>]
+        IArray.of_fun_nth[OF \<open>j < m - 1\<close>]
+      unfolding dmu_initial_def Let_def using 1 by auto
+  qed
+qed 
+
+lemma LLL_add_rows_loop: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod fs mfs dmu p b first i"
+  and res: "basis_reduction_mod_add_rows_loop p mfs dmu i j = (mfs', dmu')" 
+  and res': "LLL_add_rows_loop p state i j = state'" 
+  and j: "j \<le> i" 
+  and i: "i < m" 
+shows "state_impl_inv p mfs' dmu' state'"
+  using assms(1-5)
+proof (induct j arbitrary: fs mfs dmu state)
+  case (Suc j)
+  note impl = Suc(2)
+  note Linv = Suc(3)
+  note res = Suc(4)
+  note res' = Suc(5)
+  note IH = Suc(1)
+  from Suc have j: "j < i" and ji: "j \<le> i" by auto
+  obtain mfs1 dmu1 where add: "basis_reduction_mod_add_row p mfs dmu i j = (mfs1, dmu1)" by force
+  note res = res[unfolded basis_reduction_mod_add_rows_loop.simps Let_def add split]
+  obtain state1 where add': "LLL_add_row p state i j = state1" by auto
+  note res' = res'[unfolded LLL_add_rows_loop.simps Let_def add']
+  note Linvw = LLL_mod_inv_to_weak[OF Linv]
+  from LLL_add_row[OF impl Linvw add add' i j]
+  have impl1: "state_impl_inv p mfs1 dmu1 state1" .
+  from basis_reduction_mod_add_row[OF Linvw add i j] Linv j 
+  obtain fs1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p b first i" by auto
+  show ?case using IH[OF impl1 Linv1 res res' ji] .
+qed auto
+
+lemma LLL_add_rows_outer_loop: assumes impl: "state_impl_inv p mfs dmu state" 
+  and Linv: "LLL_invariant_mod fs mfs dmu p first b m"
+  and res: "basis_reduction_mod_add_rows_outer_loop p mfs dmu i = (mfs', dmu')" 
+  and res': "LLL_add_rows_outer_loop p state i = state'" 
+  and i: "i \<le> m - 1" 
+shows "state_impl_inv p mfs' dmu' state'"
+  using assms
+proof (induct i arbitrary: fs mfs dmu state mfs' dmu' state')
+  case (Suc i)
+  note impl = Suc(2)
+  note Linv = Suc(3)
+  note res = Suc(4)
+  note res' = Suc(5)
+  note i = Suc(6)
+  note IH = Suc(1)
+  from i have im: "i < m" "i \<le> m - 1" "Suc i < m" by auto
+  obtain mfs1 dmu1 where add: "basis_reduction_mod_add_rows_outer_loop p mfs dmu i = (mfs1, dmu1)" by force
+  note res = res[unfolded basis_reduction_mod_add_rows_outer_loop.simps Let_def add split]
+  obtain state1 where add': "LLL_add_rows_outer_loop p state i = state1" by auto
+  note res' = res'[unfolded LLL_add_rows_outer_loop.simps Let_def add']
+  from IH[OF impl Linv add add' im(2)] 
+  have impl1: "state_impl_inv p mfs1 dmu1 state1" .
+  from basis_reduction_mod_add_rows_outer_loop_inv[OF Linv add[symmetric] im(1)]
+  obtain fs1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p first b m" by auto
+  from basis_reduction_mod_add_rows_loop_inv'[OF Linv1 res im(3)] obtain fs' where 
+    Linv': "LLL_invariant_mod fs' mfs' dmu' p first b m" by auto
+  from LLL_add_rows_loop[OF impl1 LLL_invariant_mod_to_weak_m_to_i(1)[OF Linv1] res res' le_refl im(3)] i
+  show ?case by auto
+qed auto
+
+subsection \<open>Soundness of implementation\<close>
+
+text \<open>We just prove that the concrete implementations have the same input-output-behaviour as
+  the abstract versions of Storjohann's algorithms.\<close>
+
+lemma LLL_reduce_basis: "LLL_reduce_basis = reduce_basis_mod" 
+proof (cases "m = 0")
+  case True
+  from LLL_invD[OF reduce_basis_mod_inv[OF refl]] True 
+  have "reduce_basis_mod = []" by auto
+  thus ?thesis using True unfolding LLL_reduce_basis_def by auto
+next
+  case False
+  hence idm: "(m = 0) = False" by auto
+  let ?first = False
+  obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1,g_idx1)" 
+    by (metis prod_cases3)
+  obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" 
+    by (metis prod.exhaust)
+  from LLL_initial[OF init init' False]
+  have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto
+  from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where 
+    inv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 0" by auto
+  obtain p2 mfs2 dmu2 where main: "basis_reduction_mod_main p1 ?first mfs1 dmu1 g_idx1 0 0 = (p2, mfs2, dmu2)" 
+    by (metis prod_cases3)
+  from basis_reduction_mod_main[OF inv1 main] obtain fs2 b2 where 
+    inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto  
+  obtain p2' state2 where main': "LLL_main p1 ?first state1 g_idx1 0 0 = (p2', state2)" 
+    by (metis prod.exhaust)
+  from LLL_main[OF impl1 inv1 main, unfolded id, OF main']
+  have impl2: "state_impl_inv p2 mfs2 dmu2 state2" and p2: "p2' = p2" by auto
+  obtain mfs3 dmu3 where outer: "basis_reduction_mod_add_rows_outer_loop p2 mfs2 dmu2 (m - 1) = (mfs3, dmu3)" by force
+  obtain mfsi3 dmui3 di3 mods3 where outer': "LLL_add_rows_outer_loop p2 state2 (m - 1) = (mfsi3, dmui3, di3, mods3)" 
+    by (metis prod_cases4)
+  from LLL_add_rows_outer_loop[OF impl2 inv2 outer outer' le_refl] 
+  have "state_impl_inv p2 mfs3 dmu3 (mfsi3, dmui3, di3, mods3)" .
+  hence identity: "mfs3 = mfsi3" unfolding state_impl_inv.simps by auto
+  note res = reduce_basis_mod_def[unfolded init main split Let_def outer]
+  note res' = LLL_reduce_basis_def[unfolded init' Let_def main' id split p2 outer' idm if_False]
+  show ?thesis unfolding res res' identity ..
+qed
+
+lemma LLL_reduce_basis_iso: "LLL_reduce_basis_iso = reduce_basis_iso" 
+proof (cases "m = 0")
+  case True
+  from LLL_invD[OF reduce_basis_iso_inv[OF refl]] True 
+  have "reduce_basis_iso = []" by auto
+  thus ?thesis using True unfolding LLL_reduce_basis_iso_def by auto
+next
+  case False
+  hence idm: "(m = 0) = False" by auto
+  let ?first = False
+  obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1, g_idx1)" 
+    by (metis prod_cases3)
+  obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" 
+    by (metis prod.exhaust)
+  from LLL_initial[OF init init' False]
+  have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto
+  from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where 
+    inv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p1 ?first b1" 
+    by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def)
+  obtain p2 mfs2 dmu2 where main: "basis_reduction_iso_main p1 ?first mfs1 dmu1 g_idx1 0 = (p2, mfs2, dmu2)" 
+    by (metis prod_cases3)
+  from basis_reduction_iso_main[OF inv1 main] obtain fs2 b2 where 
+    inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto  
+  obtain p2' state2 where main': "LLL_iso_main p1 ?first state1 g_idx1 0 = (p2', state2)" 
+    by (metis prod.exhaust)
+  from LLL_iso_main[OF impl1 inv1 main, unfolded id, OF main']
+  have impl2: "state_impl_inv p2 mfs2 dmu2 state2" and p2: "p2' = p2" by auto
+  obtain mfs3 dmu3 where outer: "basis_reduction_mod_add_rows_outer_loop p2 mfs2 dmu2 (m - 1) = (mfs3, dmu3)" by force
+  obtain mfsi3 dmui3 di3 mods3 where outer': "LLL_add_rows_outer_loop p2 state2 (m - 1) = (mfsi3, dmui3, di3, mods3)" 
+    by (metis prod_cases4)
+  from LLL_add_rows_outer_loop[OF impl2 inv2 outer outer' le_refl] 
+  have "state_impl_inv p2 mfs3 dmu3 (mfsi3, dmui3, di3, mods3)" .
+  hence identity: "mfs3 = mfsi3" unfolding state_impl_inv.simps by auto
+  note res = reduce_basis_iso_def[unfolded init main split Let_def outer]
+  note res' = LLL_reduce_basis_iso_def[unfolded init' Let_def main' id split p2 outer' idm if_False]
+  show ?thesis unfolding res res' identity ..
+qed
+
+lemma LLL_short_vector: assumes m: "m \<noteq> 0" 
+  shows "LLL_short_vector = short_vector_mod" 
+proof -
+  let ?first = True
+  obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1,g_idx1)" 
+    by (metis prod_cases3)
+  obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" 
+    by (metis prod.exhaust)
+  from LLL_initial[OF init init' m]
+  have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto
+  from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where 
+    inv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 0" by auto
+  obtain p2 mfs2 dmu2 where main: "basis_reduction_mod_main p1 ?first mfs1 dmu1 g_idx1 0 0 = (p2, mfs2, dmu2)" 
+    by (metis prod_cases3)
+  from basis_reduction_mod_main[OF inv1 main] obtain fs2 b2 where 
+    inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto  
+  obtain p2' mfsi2 dmui2 di2 mods2 where main': "LLL_main p1 ?first state1 g_idx1 0 0 = (p2', (mfsi2, dmui2, di2, mods2))" 
+    by (metis prod.exhaust)
+  from LLL_main[OF impl1 inv1 main, unfolded id, OF main']
+  have impl2: "state_impl_inv p2 mfs2 dmu2 (mfsi2, dmui2, di2, mods2)" and p2: "p2' = p2" by auto
+  hence identity: "mfs2 = mfsi2" unfolding state_impl_inv.simps by auto
+  note res = short_vector_mod_def[unfolded init main split Let_def]
+  note res' = LLL_short_vector_def[unfolded init' Let_def main' id split p2]
+  show ?thesis unfolding res res' identity ..
+qed
+
+lemma LLL_short_vector_iso: assumes m: "m \<noteq> 0" 
+  shows "LLL_short_vector_iso = short_vector_iso" 
+proof -
+  let ?first = True
+  obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1,g_idx1)" 
+    by (metis prod_cases3)
+  obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" 
+    by (metis prod.exhaust)
+  from LLL_initial[OF init init' m]
+  have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto
+  from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where 
+    inv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p1 ?first b1" 
+    by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def)
+  obtain p2 mfs2 dmu2 where main: "basis_reduction_iso_main p1 ?first mfs1 dmu1 g_idx1 0 = (p2, mfs2, dmu2)" 
+    by (metis prod_cases3)
+  from basis_reduction_iso_main[OF inv1 main] obtain fs2 b2 where 
+    inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto  
+  obtain p2' mfsi2 dmui2 di2 mods2 where main': "LLL_iso_main p1 ?first state1 g_idx1 0 = (p2', (mfsi2, dmui2, di2, mods2))" 
+    by (metis prod.exhaust)
+  from LLL_iso_main[OF impl1 inv1 main, unfolded id, OF main']
+  have impl2: "state_impl_inv p2 mfs2 dmu2 (mfsi2, dmui2, di2, mods2)" and p2: "p2' = p2" by auto
+  hence identity: "mfs2 = mfsi2" unfolding state_impl_inv.simps by auto
+  note res = short_vector_iso_def[unfolded init main split Let_def]
+  note res' = LLL_short_vector_iso_def[unfolded init' Let_def main' id split p2]
+  show ?thesis unfolding res res' identity ..
+qed
+
+end
+
+end
\ No newline at end of file
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Mod_Operation.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Mod_Operation.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Mod_Operation.thy
@@ -0,0 +1,906 @@
+section \<open>Storjohann's Lemma 13\<close>
+
+text \<open>This theory contains the result that one can always perform a mod-operation on
+  the entries of the $d\mu$-matrix.\<close>
+
+theory Storjohann_Mod_Operation
+  imports 
+    LLL_Basis_Reduction.LLL_Certification
+    Signed_Modulo
+begin 
+
+lemma map_vec_map_vec: "map_vec f (map_vec g v) = map_vec (f o g) v" 
+  by (intro eq_vecI, auto)
+
+context semiring_hom
+begin
+
+(* TODO: move *)
+lemma mat_hom_add: assumes A: "A \<in> carrier_mat nr nc" and B: "B \<in> carrier_mat nr nc"
+  shows "mat\<^sub>h (A + B) = mat\<^sub>h A + mat\<^sub>h B"
+  by (intro eq_matI, insert A B, auto simp: hom_add)
+end
+
+text \<open>We now start to prove lemma 13 of Storjohann's paper.\<close>
+context
+  fixes A I :: "'a :: field mat" and n :: nat
+  assumes A: "A \<in> carrier_mat n n" 
+  and det: "det A \<noteq> 0" 
+  and I: "I = the (mat_inverse A)" 
+begin
+lemma inverse_via_det: "I * A = 1\<^sub>m n" "A * I = 1\<^sub>m n" "I \<in> carrier_mat n n" 
+  "I = mat n n (\<lambda> (i,j). det (replace_col A (unit_vec n j) i) / det A)"
+proof -
+  from det_non_zero_imp_unit[OF A det] 
+  have Unit: "A \<in> Units (ring_mat TYPE('a) n n)" .
+  from mat_inverse(1)[OF A, of n] Unit I have "mat_inverse A = Some I" 
+    by (cases "mat_inverse A", auto)
+  from mat_inverse(2)[OF A this]
+  show left: "I * A = 1\<^sub>m n" and right: "A * I = 1\<^sub>m n" and I: "I \<in> carrier_mat n n" 
+    by blast+
+  {
+    fix i j
+    assume i: "i < n" and j: "j < n" 
+    from I i j have cI: "col I j $ i = I $$ (i,j)" by simp
+    from j have uv: "unit_vec n j \<in> carrier_vec n" by auto
+    from j I have col: "col I j \<in> carrier_vec n" by auto
+    from col_mult2[OF A I j, unfolded right] j
+    have "A *\<^sub>v col I j = unit_vec n j" by simp
+    from cramer_lemma_mat[OF A col i, unfolded this cI]
+    have "I $$ (i,j) = det (replace_col A (unit_vec n j) i) / det A" using det by simp
+  }
+  thus "I = mat n n (\<lambda> (i,j). det (replace_col A (unit_vec n j) i) / det A)"
+    by (intro eq_matI, use I in auto)
+qed
+
+lemma matrix_for_singleton_entry: assumes i: "i < n" and 
+  j: "j < n" 
+  and Rdef: "R = mat n n ( \<lambda> ij. if ij = (i,j) then c :: 'a else 0)" 
+shows "mat n n
+   (\<lambda>(i', j'). if i' = i then c * det (replace_col A (unit_vec n j') j) / det A
+       else 0) * A = R" 
+proof -
+  note I = inverse_via_det(3)
+  have R: "R \<in> carrier_mat n n" unfolding Rdef by auto
+  have "(R * I) * A = R * (I * A)" using I A R by auto
+  also have "I * A = 1\<^sub>m n" unfolding inverse_via_det(1) ..
+  also have "R * \<dots> = R" using R by simp
+  also have "R * I = mat n n (\<lambda> (i',j'). row R i' \<bullet> col I j')"
+    using I R unfolding times_mat_def by simp
+  also have "\<dots> = mat n n ( \<lambda> (i',j'). if i' = i then c * I $$ (j, j') else 0)" 
+    (is "mat n n ?f = mat n n ?g")
+  proof -
+    {
+      fix i' j'
+      assume i': "i' < n" and j': "j' < n" 
+      have "?f (i',j') = ?g (i',j')" 
+      proof (cases "i' = i")
+        case False
+        hence "row R i' = 0\<^sub>v n" unfolding Rdef using i'
+          by (intro eq_vecI, auto simp: Matrix.row_def)
+        thus ?thesis using False i' j' I by simp
+      next
+        case True
+        hence "row R i' = c \<cdot>\<^sub>v unit_vec n j" unfolding Rdef using i' j' i j
+          by (intro eq_vecI, auto simp: Matrix.row_def)
+        with True show ?thesis using i' j' I j by simp
+      qed
+    }
+    thus ?thesis by auto
+  qed
+  finally show ?thesis unfolding inverse_via_det(4) using j 
+    by (auto intro!: arg_cong[of _ _ "\<lambda> x. x * A"])
+qed
+end
+
+lemma (in gram_schmidt_fs_Rn) det_M_1: "det (M m) = 1" 
+proof -
+  have "det (M m) = prod_list (diag_mat (M m))" 
+    by (rule det_lower_triangular[of m], auto simp: \<mu>.simps)
+  also have "\<dots> = 1" 
+    by (rule prod_list_neutral, auto simp: diag_mat_def \<mu>.simps)
+  finally show ?thesis .
+qed
+
+context gram_schmidt_fs_int
+begin
+lemma assumes IM: "IM = the (mat_inverse (M m))" 
+  shows inv_mu_lower_triangular: "\<And> k i. k < i \<Longrightarrow> i < m \<Longrightarrow> IM $$ (k, i) = 0"
+  and inv_mu_diag: "\<And> k. k < m \<Longrightarrow> IM $$ (k, k) = 1"
+  and d_inv_mu_integer: "\<And> i j. i < m \<Longrightarrow> j < m \<Longrightarrow> d i * IM $$ (i,j) \<in> \<int>" 
+  and inv_mu_inverse: "IM * M m = 1\<^sub>m m" "M m * IM = 1\<^sub>m m" "IM \<in> carrier_mat m m" 
+proof - 
+  note * = inverse_via_det[OF M_dim(3) _ IM, unfolded det_M_1]
+  from * show inv: "IM * M m = 1\<^sub>m m" "M m * IM = 1\<^sub>m m" 
+    and IM: "IM \<in> carrier_mat m m"  by auto
+  from * have IM_det: "IM = mat m m (\<lambda>(i, j). det (replace_col (M m) ((unit_vec m) j) i))" 
+    by auto
+  from matrix_equality have "IM * FF = IM * ((M m) * Fs)" by simp
+  also have "\<dots> = (IM * M m) * Fs" using M_dim(3) IM Fs_dim(3)
+    by (metis assoc_mult_mat)
+  also have "\<dots> = Fs" unfolding inv using Fs_dim(3) by simp
+  finally have equality: "IM * FF = Fs" .
+  {
+    fix i k
+    assume i: "k < i" "i < m" 
+    show "IM $$ (k, i) = 0" using i M_dim unfolding IM_det
+      by (simp, subst det_lower_triangular[of m], auto simp: replace_col_def \<mu>.simps diag_mat_def)
+  } note IM_lower_triag = this
+  {
+    fix k
+    assume k: "k < m" 
+    show "IM $$ (k,k) = 1" using k M_dim unfolding IM_det
+      by (simp, subst det_lower_triangular[of m], auto simp: replace_col_def \<mu>.simps diag_mat_def
+        intro!: prod_list_neutral)
+  } note IM_diag_1 = this
+  {
+    fix k
+    assume k: "k < m" 
+    let ?f = "\<lambda> i. IM $$ (k, i) \<cdot>\<^sub>v fs ! i" 
+    let ?sum = "M.sumlist (map ?f [0..<m])" 
+    let ?sumk = "M.sumlist (map ?f [0..<k])" 
+    have set: "set (map ?f [0..<m]) \<subseteq> carrier_vec n" using fs_carrier by auto
+    hence sum: "?sum \<in> carrier_vec n" by simp
+    from set k have setk: "set (map ?f [0..<k]) \<subseteq> carrier_vec n" by auto
+    hence sumk: "?sumk \<in> carrier_vec n" by simp
+    from sum have dim_sum: "dim_vec ?sum = n" by simp
+    have "gso k = row Fs k" using k by auto
+    also have "\<dots> = row (IM * FF) k" unfolding equality ..
+    also have "IM * FF = mat m n (\<lambda> (i,j). row IM i  \<bullet> col FF j)" 
+      unfolding times_mat_def using IM FF_dim by auto
+    also have "row \<dots> k = vec n (\<lambda> j. row IM k \<bullet> col FF j)" 
+      unfolding Matrix.row_def using IM FF_dim k by auto
+    also have "\<dots> = vec n (\<lambda> j. \<Sum> i < m. IM $$ (k, i) * fs ! i $ j)" 
+      by (intro eq_vecI, insert IM k, auto simp: scalar_prod_def Matrix.row_def intro!: sum.cong)
+    also have "\<dots> = ?sum" 
+      by (intro eq_vecI, insert IM, unfold dim_sum, subst sumlist_vec_index, 
+        auto simp: o_def sum_list_sum_nth intro!: sum.cong)
+    also have "[0..<m] = [0..<k] @ [k] @ [Suc k ..<m]" using k
+      by (simp add: list_trisect)
+    also have "M.sumlist (map ?f \<dots>) = ?sumk + 
+      (?f k + M.sumlist (map ?f [Suc k ..< m]))" 
+      unfolding map_append 
+      by (subst M.sumlist_append; (subst M.sumlist_append)?, insert k fs_carrier, auto)
+    also have "M.sumlist (map ?f [Suc k ..< m]) = 0\<^sub>v n" 
+      by (rule sumlist_neutral, insert IM_lower_triag, auto)
+    also have "IM $$ (k,k) = 1" using IM_diag_1[OF k] .
+    finally have gso: "gso k = ?sumk + fs ! k"  using k by simp
+    define b where "b = vec k (\<lambda> j. fs ! j \<bullet> fs ! k)" 
+    {
+      fix j
+      assume jk: "j < k" 
+      with k have j: "j < m" by auto
+      have "fs ! j \<bullet> gso k = fs ! j \<bullet> (?sumk + fs ! k)" 
+        unfolding gso by simp
+      also have "fs ! j \<bullet> gso k = 0" using jk k
+        by (simp add: fi_scalar_prod_gso gram_schmidt_fs.\<mu>.simps)
+      also have "fs ! j \<bullet> (?sumk + fs ! k)
+         = fs ! j \<bullet> ?sumk + fs ! j \<bullet> fs ! k" 
+        by (rule scalar_prod_add_distrib[OF _ sumk], insert j k, auto)
+      also have "fs ! j \<bullet> fs ! k = b $ j" unfolding b_def using jk by simp
+      finally have "b $ j = - (fs ! j \<bullet> ?sumk)" by linarith
+    } note b_index = this
+    let ?x = "vec k (\<lambda> i. - IM $$ (k, i))" 
+    have x: "?x \<in> carrier_vec k" by auto
+    from k have km: "k \<le> m" by simp 
+    have bGx: "b = Gramian_matrix fs k *\<^sub>v (vec k (\<lambda> i. - IM $$ (k, i)))" 
+      unfolding Gramian_matrix_alt_alt_def[OF km]
+    proof (rule eq_vecI; simp)
+      fix i
+      assume i: "i < k" 
+      have "b $ i = - (\<Sum>x\<leftarrow>[0..<k]. fs ! i \<bullet> (IM $$ (k, x) \<cdot>\<^sub>v fs ! x))" 
+        unfolding b_index[OF i]
+        by (subst scalar_prod_right_sum_distrib, insert setk i k, auto simp: o_def)
+      also have "\<dots> = vec k (\<lambda>j. fs ! i \<bullet> fs ! j) \<bullet> vec k (\<lambda>i. - IM $$ (k, i))" 
+        by (subst (3) scalar_prod_def, insert i k, auto simp: o_def sum_list_sum_nth simp flip: sum_negf
+          intro!: sum.cong)
+      finally show "b $ i = vec k (\<lambda>j. fs ! i \<bullet> fs ! j) \<bullet> vec k (\<lambda>i. - IM $$ (k, i))" .
+    qed (simp add: b_def)
+    have G: "Gramian_matrix fs k \<in> carrier_mat k k" 
+      unfolding Gramian_matrix_alt_alt_def[OF km] by simp
+    from cramer_lemma_mat[OF G x, folded bGx Gramian_determinant_def]
+    have "i < k \<Longrightarrow> 
+      d k * IM $$ (k, i) = - det (replace_col (Gramian_matrix fs k) (vec k (\<lambda> j. fs ! j \<bullet> fs ! k)) i)" 
+      for i unfolding b_def by simp
+  } note IM_lower_values = this
+  {
+    fix i j
+    assume i: "i < m" and j: "j < m" 
+    from i have im: "i \<le> m" by auto
+    consider (1) "j < i" | (2) "j = i" | (3) "i < j" by linarith
+    thus "d i * IM $$ (i,j) \<in> \<int>"
+    proof cases
+      case 1
+      show ?thesis unfolding IM_lower_values[OF i 1] replace_col_def Gramian_matrix_alt_alt_def[OF im]
+        by (intro Ints_minus Ints_det, insert i j, auto intro!: Ints_scalar_prod[of _ n] fs_int)
+    next
+      case 3
+      show ?thesis unfolding IM_lower_triag[OF 3 j] by simp
+    next
+      case 2
+      show ?thesis unfolding IM_diag_1[OF i] 2 using i unfolding Gramian_determinant_def
+         Gramian_matrix_alt_alt_def[OF im]
+        by (intro Ints_mult Ints_det, insert i j, auto intro!: Ints_scalar_prod[of _ n] fs_int)
+    qed 
+  }
+qed
+
+definition inv_mu_ij_mat :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int mat" where
+ "inv_mu_ij_mat i j c = (let
+    B = mat m m (\<lambda> ij. if ij = (i,j) then c else 0);
+    C = mat m m (\<lambda> (i,j). the_inv (of_int :: _ \<Rightarrow> 'a) (d i * the (mat_inverse (M m)) $$ (i,j)))
+   in B * C + 1\<^sub>m m)" 
+
+lemma inv_mu_ij_mat: assumes i: "i < m" and ji: "j < i" 
+  shows 
+(* Effect on \<mu> *)
+   "map_mat of_int (inv_mu_ij_mat i j c) * M m =
+    mat m m (\<lambda>ij. if ij = (i, j) then of_int c * d j else 0) + M m" (* only change value of \<mu>_ij *)
+(* Effect on A *)
+  "A \<in> carrier_mat m n \<Longrightarrow> c mod p = 0 \<Longrightarrow> map_mat (\<lambda> x. x mod p) (inv_mu_ij_mat i j c * A) = 
+    (map_mat (\<lambda> x. x mod p) A)" (* no change (mod p) *)
+(* The transformation-matrix is ... *)
+  "inv_mu_ij_mat i j c \<in> carrier_mat m m" (* ... of dimension m*m *)
+  "i' < j' \<Longrightarrow> j' < m \<Longrightarrow> inv_mu_ij_mat i j c $$ (i',j') = 0" (* ... lower triangular *)
+  "k < m \<Longrightarrow> inv_mu_ij_mat i j c $$ (k,k) = 1" (* ... with diagonal all 1 *)  
+proof -
+  obtain IM where IM: "IM = the (mat_inverse (M m))" by auto
+  let ?oi = "of_int :: _ \<Rightarrow> 'a" 
+  let ?C = "mat m m (\<lambda> ij. if ij = (i,j) then ?oi c else 0)" 
+  let ?D = "mat m m (\<lambda> (i,j). d i * IM $$ (i,j))" 
+  have oi: "inj ?oi" unfolding inj_on_def by auto
+  have C: "?C \<in> carrier_mat m m" by auto
+  from i ji have j: "j < m" by auto
+  from j have jm: "{0..<m} = {0..<j} \<union> {j} \<union> {Suc j..<m}" by auto
+  note IM_props = d_inv_mu_integer[OF IM] inv_mu_inverse[OF IM]
+  have mat_oi: "map_mat ?oi (inv_mu_ij_mat i j c) = ?C * ?D + 1\<^sub>m m" (is "?MM = _")
+    unfolding inv_mu_ij_mat_def Let_def IM[symmetric]
+    apply (subst of_int_hom.mat_hom_add, force, force)
+    apply (rule arg_cong2[of _ _ _ _ "(+)"])
+     apply (subst of_int_hom.mat_hom_mult, force, force)
+     apply (rule arg_cong2[of _ _ _ _ "(*)"])
+      apply force
+     apply (rule eq_matI, (auto)[3], goal_cases)
+  proof -
+    case (1 i j)
+    from IM_props(1)[OF 1]
+    show ?case unfolding Ints_def using the_inv_f_f[OF oi] by auto
+  qed auto
+  have "map_mat ?oi (inv_mu_ij_mat i j c) * M m = (?C * ?D) * M m + M m" unfolding mat_oi
+    by (subst add_mult_distrib_mat[of _ m m], auto)
+  also have "(?C * ?D) * M m = ?C * (?D * M m)" 
+    by (rule assoc_mult_mat, auto)
+  also have "?D = mat m m (\<lambda> (i,j). if i = j then d j else 0) * IM" (is "_ = ?E * _")
+  proof (rule eq_matI, insert IM_props(4), auto simp: scalar_prod_def, goal_cases)
+    case (1 i j)
+    hence id: "{0..<m} = {0..<i} \<union> {i} \<union> {Suc i ..<m}" 
+      by (auto simp add: list_trisect)
+    show ?case unfolding id
+      by (auto simp: sum.union_disjoint)
+  qed
+  also have "\<dots> * M m = ?E * (IM * M m)" 
+    by (rule assoc_mult_mat[of _ m m], insert IM_props, auto)
+  also have "IM * M m = 1\<^sub>m m" by fact
+  also have "?E * 1\<^sub>m m = ?E" by simp
+  also have "?C * ?E = mat m m (\<lambda> ij. if ij = (i,j) then ?oi c * d j else 0)" 
+    by (rule eq_matI, auto simp: scalar_prod_def, auto simp: jm sum.union_disjoint)
+  finally show "map_mat ?oi (inv_mu_ij_mat i j c) * M m = 
+    mat m m (\<lambda> ij. if ij = (i,j) then ?oi c * d j else 0) + M m" .
+  show carr: "inv_mu_ij_mat i j c \<in> carrier_mat m m"
+    unfolding inv_mu_ij_mat_def by auto
+  {
+    assume k: "k < m" 
+    have "of_int (inv_mu_ij_mat i j c $$ (k,k)) = ?MM $$ (k,k)" 
+      using carr k by auto
+    also have "\<dots> = (?C * ?D) $$ (k,k) + 1" unfolding mat_oi using k by simp
+    also have "(?C * ?D) $$ (k,k) = 0" using k
+      by (auto simp: scalar_prod_def, auto simp: jm sum.union_disjoint 
+        inv_mu_lower_triangular[OF IM ji i])
+    finally show "inv_mu_ij_mat i j c $$ (k,k) = 1" by simp
+  }
+  {
+    assume ij': "i' < j'" "j' < m"  
+    have "of_int (inv_mu_ij_mat i j c $$ (i',j')) = ?MM $$ (i',j')" 
+      using carr ij' by auto
+    also have "\<dots> = (?C * ?D) $$ (i',j')" unfolding mat_oi using ij' by simp
+    also have "(?C * ?D) $$ (i',j') = (if i' = i then ?oi c * (d j * IM $$ (j, j')) else 0)" 
+      using ij' i j by (auto simp: scalar_prod_def, auto simp: jm sum.union_disjoint)
+    also have "\<dots> = 0" using inv_mu_lower_triangular[OF IM _ ij'(2), of j] ij' i ji by auto
+    finally show "inv_mu_ij_mat i j c $$ (i',j') = 0" by simp
+  }
+  {
+    assume A: "A \<in> carrier_mat m n" and c: "c mod p = 0" 
+    let ?mod = "map_mat (\<lambda> x. x mod p)" 
+    let ?C = "mat m m (\<lambda> ij. if ij = (i,j) then c else 0)" 
+    let ?D = "mat m m (\<lambda> ij. if ij = (i,j) then 1 else (0 :: int))" 
+    define B where "B = mat m m (\<lambda> (i,j). the_inv ?oi (d i * the (mat_inverse (M m)) $$ (i,j)))" 
+    have B: "B \<in> carrier_mat m m" unfolding B_def by auto
+    define BA where "BA = B * A" 
+    have BA: "BA \<in> carrier_mat m n" unfolding BA_def using A B by auto
+    define DBA where "DBA = ?D * BA" 
+    have DBA: "DBA \<in> carrier_mat m n" unfolding DBA_def using BA by auto
+    have "?mod (inv_mu_ij_mat i j c * A) = 
+     ?mod ((?C * B + 1\<^sub>m m) * A)" 
+      unfolding inv_mu_ij_mat_def B_def by simp
+    also have "(?C * B + 1\<^sub>m m) * A = ?C * B * A + A" 
+      by (subst add_mult_distrib_mat, insert A B, auto)
+    also have "?C * B * A = ?C * BA" 
+      unfolding BA_def
+      by (rule assoc_mult_mat, insert A B, auto)
+    also have "?C = c \<cdot>\<^sub>m ?D" 
+      by (rule eq_matI, auto)
+    also have "\<dots> * BA = c \<cdot>\<^sub>m DBA" using BA unfolding DBA_def by auto
+    also have "?mod (\<dots> + A) = ?mod A" 
+      by (rule eq_matI, insert DBA A c, auto simp: mult.assoc) 
+    finally show "?mod (inv_mu_ij_mat i j c * A) = ?mod A" .
+  }
+qed   
+end
+ 
+lemma Gramian_determinant_of_int: assumes fs: "set fs \<subseteq> carrier_vec n" 
+  and j: "j \<le> length fs" 
+shows "of_int (gram_schmidt.Gramian_determinant n fs j)
+  = gram_schmidt.Gramian_determinant n (map (map_vec rat_of_int) fs) j" 
+proof -
+  from j have j: "k < j \<Longrightarrow> k < length fs" for k by auto
+  show ?thesis
+  unfolding gram_schmidt.Gramian_determinant_def
+  by (subst of_int_hom.hom_det[symmetric], rule arg_cong[of _ _ det],
+      unfold gram_schmidt.Gramian_matrix_def Let_def, subst of_int_hom.mat_hom_mult, force, force,
+      unfold map_mat_transpose[symmetric],
+      rule arg_cong2[of _ _ _ _ "\<lambda> x y. x * y\<^sup>T"], insert fs[unfolded set_conv_nth] 
+      j, (fastforce intro!: eq_matI)+)
+qed
+
+context LLL
+begin
+
+(* this lemma might also be useful for swap/add-operation *)
+lemma multiply_invertible_mat: assumes lin: "lin_indep fs" 
+  and len: "length fs = m" 
+  and A: "A \<in> carrier_mat m m" 
+  and A_invertible: "\<exists> B. B \<in> carrier_mat m m \<and> B * A = 1\<^sub>m m" 
+  and fs'_prod: "fs' = Matrix.rows (A * mat_of_rows n fs)" 
+shows "lattice_of fs' = lattice_of fs" 
+  "lin_indep fs'" 
+  "length fs' = m" 
+proof -
+  let ?Mfs = "mat_of_rows n fs" 
+  let ?Mfs' = "mat_of_rows n fs'" 
+  from A_invertible obtain B where B: "B \<in> carrier_mat m m" and inv: "B * A = 1\<^sub>m m" by auto
+  from lin have fs: "set fs \<subseteq> carrier_vec n" unfolding gs.lin_indpt_list_def by auto
+  with len have Mfs: "?Mfs \<in> carrier_mat m n" by auto
+  from A Mfs have prod: "A * ?Mfs \<in> carrier_mat m n" by auto
+  hence fs': "length fs' = m" "set fs' \<subseteq> carrier_vec n" unfolding fs'_prod
+    by (auto simp: Matrix.rows_def Matrix.row_def)  
+  have Mfs_prod': "?Mfs' = A * ?Mfs" 
+    unfolding arg_cong[OF fs'_prod, of "mat_of_rows n"]
+    by (intro eq_matI, auto simp: mat_of_rows_def)
+  have "B * ?Mfs' = B * (A * ?Mfs)" 
+    unfolding Mfs_prod' by simp
+  also have "\<dots> = (B * A) * ?Mfs"
+    by (subst assoc_mult_mat[OF _ A Mfs], insert B, auto)
+  also have "B * A = 1\<^sub>m m" by fact
+  also have "\<dots> * ?Mfs = ?Mfs" using Mfs by auto
+  finally have Mfs_prod: "?Mfs = B * ?Mfs'" ..  
+  interpret LLL: LLL_with_assms n m fs 2
+    by (unfold_locales, auto simp: len lin)
+  from LLL.LLL_change_basis[OF fs'(2,1) B A Mfs_prod Mfs_prod']
+  show latt': "lattice_of fs' = lattice_of fs" and lin': "gs.lin_indpt_list (RAT fs')" 
+    and len': "length fs' = m" 
+    by (auto simp add: LLL_with_assms_def)
+qed
+
+text \<open>This is the key lemma.\<close>
+lemma change_single_element: assumes lin: "lin_indep fs" 
+  and len: "length fs = m" 
+  and i: "i < m" and ji: "j < i"  
+  and A: "A = gram_schmidt_fs_int.inv_mu_ij_mat n (RAT fs)"    \<comment> \<open>the transformation matrix A\<close>
+  and fs'_prod: "fs' = Matrix.rows (A i j c * mat_of_rows n fs)" \<comment> \<open>fs' is the new basis\<close>
+  and latt: "lattice_of fs = L" 
+shows "lattice_of fs' = L"
+  "c mod p = 0 \<Longrightarrow> map (map_vec (\<lambda> x. x mod p)) fs' = map (map_vec (\<lambda> x. x mod p)) fs" 
+  "lin_indep fs'" 
+  "length fs' = m" 
+  "\<And> k. k < m \<Longrightarrow> gso fs' k = gso fs k" 
+  "\<And> k. k \<le> m \<Longrightarrow> d fs' k = d fs k" 
+  "i' < m \<Longrightarrow> j' < m \<Longrightarrow> 
+    \<mu> fs' i' j' = (if (i',j') = (i,j) then rat_of_int (c * d fs j) + \<mu> fs i' j' else \<mu> fs i' j')" 
+  "i' < m \<Longrightarrow> j' < m \<Longrightarrow> 
+    d\<mu> fs' i' j' = (if (i',j') = (i,j) then c * d fs j * d fs (Suc j) + d\<mu> fs i' j' else d\<mu> fs i' j')" 
+proof -
+  let ?A = "A i j c" 
+  let ?Mfs = "mat_of_rows n fs" 
+  let ?Mfs' = "mat_of_rows n fs'" 
+  from lin have fs: "set fs \<subseteq> carrier_vec n" unfolding gs.lin_indpt_list_def by auto
+  with len have Mfs: "?Mfs \<in> carrier_mat m n" by auto
+  interpret gsi: gram_schmidt_fs_int n "RAT fs"
+    rewrites "gsi.inv_mu_ij_mat = A" using lin unfolding A
+    by (unfold_locales, insert lin[unfolded gs.lin_indpt_list_def], auto simp: set_conv_nth)
+  note A = gsi.inv_mu_ij_mat[unfolded length_map len, OF i ji, where c = c]
+  from A(3) Mfs have prod: "?A * ?Mfs \<in> carrier_mat m n" by auto
+  hence fs': "length fs' = m" "set fs' \<subseteq> carrier_vec n" unfolding fs'_prod
+    by (auto simp: Matrix.rows_def Matrix.row_def)  
+  have Mfs_prod': "?Mfs' = ?A * ?Mfs" 
+    unfolding arg_cong[OF fs'_prod, of "mat_of_rows n"]
+    by (intro eq_matI, auto simp: mat_of_rows_def)
+  have detA: "det ?A = 1" 
+    by (subst det_lower_triangular[OF A(4) A(3)], insert A, auto intro!: prod_list_neutral 
+      simp: diag_mat_def)
+  have "\<exists> B. B \<in> carrier_mat m m \<and> B * ?A = 1\<^sub>m m" 
+    by (intro exI[of _ "adj_mat ?A"], insert adj_mat[OF A(3)], auto simp: detA)
+  from multiply_invertible_mat[OF lin len A(3) this fs'_prod] latt
+  show latt': "lattice_of fs' = L" and lin': "gs.lin_indpt_list (RAT fs')" 
+    and len': "length fs' = m" by auto
+  interpret LLL: LLL_with_assms n m fs 2
+    by (unfold_locales, auto simp: len lin)
+  interpret fs: fs_int_indpt n fs
+    by (standard, auto simp: lin)
+  interpret fs': fs_int_indpt n fs'
+    by (standard, auto simp: lin')
+  {
+    assume c: "c mod p = 0" 
+    have id: "rows (map_mat f A) = map (map_vec f) (rows A)" for f A
+      unfolding rows_def by auto
+    have rows_id: "set fs \<subseteq> carrier_vec n \<Longrightarrow> rows (mat_of_rows n fs) = fs" for fs
+      unfolding mat_of_rows_def rows_def 
+      by (force simp: Matrix.row_def set_conv_nth intro!: nth_equalityI)
+    from A(2)[OF Mfs c]
+    have "rows (map_mat (\<lambda>x. x mod p) ?Mfs') = rows (map_mat (\<lambda>x. x mod p) ?Mfs)" unfolding Mfs_prod'
+      by simp
+    from this[unfolded id rows_id[OF fs] rows_id[OF fs'(2)]]
+    show "map (map_vec (\<lambda> x. x mod p)) fs' = map (map_vec (\<lambda> x. x mod p)) fs" .
+  }
+  {
+    define B where "B = ?A" 
+    have gs_eq: "k < m \<Longrightarrow> gso fs' k = gso fs k" for k
+    proof(induct rule: nat_less_induct)
+      case (1 k)
+      then show ?case 
+      proof(cases "k = 0")
+        case True
+        then show ?thesis 
+        proof -
+          have "row ?Mfs' 0 = row ?Mfs 0"
+          proof -
+            have 2: "0\<in> {0..<m}" and 3: "{1..<m} = {0..<m} - {0}" 
+              and 4: "finite {0..<m}" using 1 by auto
+            have "row ?Mfs' 0 = vec n (\<lambda>j. row B 0 \<bullet> col ?Mfs j)" 
+              using row_mult A(3) Mfs 1 Mfs_prod' unfolding B_def by simp
+            also have "\<dots> = vec n (\<lambda>j. (\<Sum>l\<in>{0..<m}. B $$ (0, l) * ?Mfs $$ (l, j)))"
+              using Mfs A(3) len 1 B_def unfolding scalar_prod_def by auto
+            also have "\<dots> = vec n (\<lambda>j. B $$ (0, 0) * ?Mfs $$ (0, j) + 
+              (\<Sum>l\<in>{1..<m}. B $$ (0, l) * ?Mfs $$ (l, j)))"
+              using Groups_Big.comm_monoid_add_class.sum.remove[OF 4 2] 3
+              by (simp add: \<open>\<And>g. sum g {0..<m} = g 0 + sum g ({0..<m} - {0})\<close>)
+            also have "\<dots> = row ?Mfs 0" 
+              using A(4-) 1 unfolding B_def[symmetric] by (simp add: row_def)
+            finally show ?thesis by (simp add: B_def Mfs_prod')
+          qed
+          then show ?thesis using True 1 fs'.f_carrier fs.f_carrier 
+            fs'.gs.fs0_gso0 len' len gsi.fs0_gso0 by auto
+        qed
+      next
+        case False
+        then show ?thesis
+        proof -
+          have gso0kcarr: "gsi.gso ` {0 ..<k} \<subseteq> carrier_vec n"
+            using 1(2) gsi.gso_carrier len by auto
+          hence gsospancarr: "gs.span(gsi.gso ` {0 ..<k}) \<subseteq> carrier_vec n " 
+            using span_is_subset2 by auto
+
+          have fs'_gs_diff_span: 
+            "(RAT fs') !  k - fs'.gs.gso k \<in> gs.span (gsi.gso ` {0 ..<k})"
+          proof -
+            define gs'sum where "gs'sum =
+              gs.M.sumlist (map (\<lambda>ja. fs'.gs.\<mu> k ja \<cdot>\<^sub>v fs'.gs.gso ja) [0..<k])"
+            define gssum where "gssum = 
+              gs.M.sumlist (map (\<lambda>ja. fs'.gs.\<mu> k ja \<cdot>\<^sub>v gsi.gso ja) [0..<k])"
+            have "set (map (\<lambda>ja. fs'.gs.\<mu> k ja \<cdot>\<^sub>v gsi.gso ja) [0..<k]) 
+              \<subseteq> gs.span(gsi.gso ` {0 ..<k})" using 1(2) gs.span_mem gso0kcarr
+              by auto
+            hence gssumspan: "gssum \<in> gs.span(gsi.gso ` {0 ..<k})"
+              using atLeastLessThan_iff gso0kcarr imageE set_map set_upt 
+                vec_space.sumlist_in_span 
+              unfolding gssum_def by (smt subsetD)
+            hence gssumcarr: "gssum \<in> carrier_vec n" 
+              using gsospancarr gssum_def by blast
+            have sumid: "gs'sum = gssum"
+            proof -
+              have "map (\<lambda>ja. fs'.gs.\<mu> k ja \<cdot>\<^sub>v fs'.gs.gso ja) [0..<k] =
+                map (\<lambda>ja. fs'.gs.\<mu> k ja \<cdot>\<^sub>v gsi.gso ja) [0..<k]"
+                using 1 by simp
+              thus ?thesis unfolding gs'sum_def gssum_def by argo
+            qed
+            have "(RAT fs') !  k = fs'.gs.gso k + gssum" 
+              using fs'.gs.fs_by_gso_def len' False 1 sumid 
+              unfolding gs'sum_def by auto
+            hence "(RAT fs') !  k - fs'.gs.gso k = gssum" 
+              using gssumcarr 1(2) len' by auto
+            thus ?thesis using gssumspan by simp
+          qed
+
+          define v2 where "v2 = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..< k])"
+          have v2carr: "v2 \<in> carrier_vec n" 
+          proof -
+            have "set (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..< k]) \<subseteq> carrier_vec n"
+              using len 1(2) fs.f_carrier by auto
+            thus ?thesis unfolding v2_def by simp
+          qed
+          define ratv2 where "ratv2 = (map_vec rat_of_int v2)"
+          have ratv2carr: "ratv2 \<in> carrier_vec n" 
+            unfolding ratv2_def using v2carr by simp
+          have fs'id: "(RAT fs') ! k = (RAT fs) ! k + ratv2"
+          proof -
+            have zkm: "[0..<m] = [0..<(Suc k)] @ [(Suc k)..<m]" using 1(2) 
+              by (metis Suc_lessI append_Nil2 upt_append upt_rec zero_less_Suc)
+            have prep: "set (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<m]) \<subseteq> carrier_vec n" 
+              using len fs.f_carrier by auto
+
+            have "fs' ! k = vec n (\<lambda>j. row B k \<bullet> col ?Mfs j)"
+              using 1(2) Mfs B_def A(3) fs'_prod by simp
+            also have "\<dots> = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<m])"
+            proof -
+              {
+                fix i
+                assume i: "i < n"
+                have "(vec n (\<lambda>j. row B k \<bullet> col ?Mfs j)) $ i = row B k \<bullet> col ?Mfs i" 
+                  using i by auto
+                also have "\<dots> = (\<Sum>j = 0..<m. B $$ (k, j) * ?Mfs $$ (j,i))" 
+                  using A(3) unfolding B_def[symmetric] 
+                  by (smt 1(2) Mfs R.finsum_cong' i atLeastLessThan_iff carrier_matD
+                      dim_col index_col index_row(1) scalar_prod_def)
+                also have "\<dots> = (\<Sum>j = 0..<m. B $$ (k, j) * (fs ! j $ i))"
+                  by (metis (no_types, lifting) R.finsum_cong' atLeastLessThan_iff i
+                      len mat_of_rows_index)
+                also have "\<dots> = 
+                  (\<Sum>j = 0..<m. (map (\<lambda>ja.  B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<m]) ! j $ i)"
+                proof -
+                  have "\<forall>j<m. \<forall>i<n. B $$ (k, j) * (fs ! j $ i) = 
+                    (map (\<lambda>ja.  B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<m]) ! j $ i" 
+                    using 1(2) i A(3) len fs.f_carrier
+                    unfolding B_def[symmetric] by auto
+                  then show ?thesis using i by auto
+                qed
+                also have "\<dots> = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<m]) $ i"
+                  using sumlist_nth i fs.f_carrier carrier_vecD len by simp
+                finally have "(vec n (\<lambda>j. row B k \<bullet> col ?Mfs j)) $ i =
+                  sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<m]) $ i" by auto
+              }
+              then show ?thesis using fs.f_carrier len dim_sumlist by auto
+            qed
+            also have "\<dots> = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) 
+              ([0..<(Suc k)] @ [(Suc k)..<m]))" 
+              using zkm by simp
+            also have "\<dots> = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<(Suc k)]) +
+              sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [(Suc k)..<m])"
+              (is "\<dots> = ?L2 + ?L3")
+              using fs.f_carrier len dim_sumlist sumlist_append prep zkm by auto
+            also have "?L3 = 0\<^sub>v n"
+              using A(4) fs.f_carrier len sumlist_nth carrier_vecD sumlist_carrier 
+                prep zkm unfolding B_def[symmetric] by auto
+            also have "?L2 = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<k]) +
+              B $$ (k, k) \<cdot>\<^sub>v fs ! k" using prep zkm sumlist_snoc by simp
+            also have "\<dots> = sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<k]) + fs ! k"
+              using A(5) 1(2) unfolding B_def[symmetric] by simp
+            finally have "fs' ! k = fs ! k + 
+              sumlist (map (\<lambda>ja. B $$ (k, ja) \<cdot>\<^sub>v fs ! ja) [0..<k])"
+              using prep zkm by (simp add: M.add.m_comm)
+            then have "fs' !  k = fs !  k + v2" unfolding v2_def by simp
+            then show ?thesis using v2carr 1(2) len len' ratv2_def by force
+          qed
+          have ratv2span: "ratv2 \<in> gs.span (gsi.gso ` {0 ..<k})" 
+          proof -
+            have rat: "ratv2 = gs.M.sumlist
+              (map (\<lambda>j. of_int (B $$ (k, j)) \<cdot>\<^sub>v (RAT fs) ! j) [0..<k])"
+            proof -
+              have "set (map (\<lambda>j. of_int (B $$ (k, j)) \<cdot>\<^sub>v (RAT fs) ! j) [0..<k]) 
+                \<subseteq> carrier_vec n"
+                using fs.f_carrier 1(2) len by auto
+              hence carr: "gs.M.sumlist 
+                (map (\<lambda>j. of_int (B $$ (k, j)) \<cdot>\<^sub>v (RAT fs) ! j) [0..<k]) \<in> carrier_vec n"
+                by auto
+              have "set (map (\<lambda>j. B $$ (k, j) \<cdot>\<^sub>v fs ! j) [0..<k]) \<subseteq> carrier_vec n"
+                using fs.f_carrier 1(2) len by auto
+              hence "\<And>i j. i < n \<Longrightarrow> j < k \<Longrightarrow> of_int ((B $$ (k, j) \<cdot>\<^sub>v fs ! j) $ i)
+                = (of_int (B $$ (k, j)) \<cdot>\<^sub>v (RAT fs) ! j) $ i"
+                using 1(2) len by fastforce
+              hence "\<And>i. i < n \<Longrightarrow> ratv2 $ i = gs.M.sumlist
+                (map (\<lambda>j. (of_int (B $$ (k, j)) \<cdot>\<^sub>v (RAT fs) ! j)) [0..<k]) $ i"
+                using fs.f_carrier 1(2) len v2carr gs.sumlist_nth sumlist_nth 
+                  ratv2_def v2_def by simp
+              then show ?thesis using ratv2carr carr by auto
+            qed
+            have "\<And>i. i < k \<Longrightarrow> (RAT fs) ! i = 
+              gs.M.sumlist (map (\<lambda> j. gsi.\<mu> i j \<cdot>\<^sub>v gsi.gso j) [0 ..< Suc i])"
+              using gsi.fi_is_sum_of_mu_gso len 1(2) by auto
+            moreover have "\<And>i. i < k \<Longrightarrow> (\<lambda> j. gsi.\<mu> i j \<cdot>\<^sub>v gsi.gso j) ` {0 ..< Suc i}
+              \<subseteq> gs.span (gsi.gso ` {0 ..<k})"
+              using gs.span_mem gso0kcarr by auto
+            ultimately have "\<And>i. i < k \<Longrightarrow> (RAT fs) ! i \<in> gs.span (gsi.gso ` {0 ..<k})"
+              using gso0kcarr set_map set_upt vec_space.sumlist_in_span subsetD by smt
+            then show ?thesis using rat atLeastLessThan_iff set_upt gso0kcarr imageE 
+              set_map gs.smult_in_span vec_space.sumlist_in_span by smt
+          qed
+          have fs_gs_diff_span:
+            "(RAT fs) !  k - fs'.gs.gso k \<in> gs.span (gsi.gso ` {0 ..<k})"
+          proof -
+            from fs'_gs_diff_span obtain v3 where sp: "v3 \<in> gs.span (gsi.gso ` {0 ..<k})"
+              and eq: "(RAT fs) ! k - fs'.gs.gso k = v3 - ratv2" 
+              using fs'.gs.gso_carrier len' 1(2) ratv2carr fs'id by fastforce
+            have "v3+(-ratv2) \<in> gs.span(gsi.gso ` {0 ..<k})"
+              by (metis sp gs.span_add1 gso0kcarr gram_schmidt.inv_in_span 
+                  gso0kcarr ratv2span)
+            moreover have "v3+(-ratv2) = v3-ratv2" using ratv2carr by auto
+            ultimately have "v3 - ratv2 \<in> gs.span (gsi.gso ` {0 ..<k})" by simp
+            then show ?thesis using eq by auto
+          qed
+          {
+            fix i
+            assume i: "i < k"
+            hence "fs'.gs.gso k \<bullet> fs'.gs.gso i = 0" using 1(2) fs'.gs.orthogonal len' by auto
+            hence "fs'.gs.gso k \<bullet> gsi.gso i = 0" using 1 i by simp
+          }
+          hence "\<And>x. x \<in> gsi.gso ` {0..<k} \<Longrightarrow> fs'.gs.gso k \<bullet> x = 0" by auto
+
+          then show ?thesis
+            using gsi.oc_projection_unique len len' fs_gs_diff_span 1(2) by auto
+        qed
+      qed
+    qed
+
+    have "\<And> i' j'. i' < m \<Longrightarrow> j' < m \<Longrightarrow> \<mu> fs' i' j' = 
+      (map_mat of_int (A i j c) * gsi.M m) $$ (i',j')" and
+      "\<And> k. k < m \<Longrightarrow> gso fs' k = gso fs k"
+    proof -
+      define rB where "rB = map_mat rat_of_int B"
+      have rBcarr: "rB \<in> carrier_mat m m" using A(3) unfolding rB_def B_def by simp
+      define rfs where "rfs = mat_of_rows n (RAT fs)"
+      have rfscarr: "rfs \<in> carrier_mat m n" using Mfs unfolding rfs_def by simp
+
+      {
+        fix i'
+        fix j'
+        assume i': "i' < m"
+        assume j': "j' < m"
+        have prep: 
+          "of_int_hom.vec_hom (row (B * mat_of_rows n fs) i') = row (rB * rfs) i'" 
+          using len i' B_def A(3) rB_def rfs_def by (auto simp: scalar_prod_def)
+        have prep2: "row (rB * rfs) i' = vec n (\<lambda>l. row rB i' \<bullet> col rfs l)"
+          using len fs.f_carrier i' B_def A(3) scalar_prod_def rB_def
+          unfolding rfs_def by auto
+        have prep3: "(vec m (\<lambda> j1. row rfs j1 \<bullet> gsi.gso j' / \<parallel>gsi.gso j'\<parallel>\<^sup>2)) =
+          (vec m (\<lambda> j1. (gsi.M m) $$ (j1, j')))"
+        proof -
+          {
+            fix x y
+            assume x: "x < m" and y: "y < m"
+            have "(gsi.M m) $$ (x,y) = (if y < x then map of_int_hom.vec_hom fs ! x 
+              \<bullet> fs'.gs.gso y / \<parallel>fs'.gs.gso y\<parallel>\<^sup>2 else if x = y then 1 else 0)" 
+              using gsi.\<mu>.simps x y j' len gs_eq gsi.M_index by auto
+            hence "row rfs x \<bullet> gsi.gso y / \<parallel>gsi.gso y\<parallel>\<^sup>2 = (gsi.M m) $$ (x,y)"
+              unfolding rfs_def 
+              by (metis carrier_matD(1) divide_eq_eq fs'.gs.\<beta>_zero fs'.gs.gso_norm_beta 
+                  gs_eq gsi.\<mu>.simps gsi.fi_scalar_prod_gso gsi.fs_carrier len len' 
+                  length_map nth_rows rfs_def rfscarr rows_mat_of_rows x y)
+          }
+          then show ?thesis using j' by auto
+        qed
+        have prep4: "(1 / \<parallel>gsi.gso j'\<parallel>\<^sup>2) \<cdot>\<^sub>v (vec m (\<lambda>j1. row rfs j1 \<bullet> gsi.gso j')) =
+          (vec m (\<lambda>j1. row rfs j1 \<bullet> gsi.gso j' / \<parallel>gsi.gso j'\<parallel>\<^sup>2))" by auto
+
+        have "map of_int_hom.vec_hom fs' ! i' \<bullet> fs'.gs.gso j' / \<parallel>fs'.gs.gso j'\<parallel>\<^sup>2
+           = map of_int_hom.vec_hom fs' ! i' \<bullet> gsi.gso j' / \<parallel>gsi.gso j'\<parallel>\<^sup>2"
+          using gs_eq j' by simp
+        also have "\<dots> = row (rB * rfs) i' \<bullet> gsi.gso j' / \<parallel>gsi.gso j'\<parallel>\<^sup>2"
+          using prep i' len' unfolding rB_def B_def by (simp add: fs'_prod)
+        also have "\<dots> = 
+          (vec n (\<lambda>l. row rB i' \<bullet> col rfs l)) \<bullet> gsi.gso j' / \<parallel>gsi.gso j'\<parallel>\<^sup>2"
+          using prep2 by auto
+        also have "vec n (\<lambda>l. row rB i' \<bullet> col rfs l) = 
+            (vec n (\<lambda>l. (\<Sum>j1=0..<m. (row rB i') $ j1 * (col rfs l) $ j1)))"
+          using gsi.gso_carrier
+          by (metis (no_types) carrier_matD(1) col_def dim_vec rfscarr scalar_prod_def)
+        also have "\<dots> = 
+            (vec n (\<lambda>l. (\<Sum>j1=0..<m. rB $$ (i', j1) * rfs $$ (j1, l))))" 
+          using rBcarr rfscarr i' by auto
+        also have "\<dots> \<bullet> gsi.gso j' = 
+            (\<Sum>j2=0..<n. (vec n 
+            (\<lambda>l. (\<Sum>j1=0..<m. rB $$ (i', j1) * rfs $$ (j1, l)))) $ j2 * (gsi.gso j') $ j2)"
+          using gsi.gso_carrier len j' scalar_prod_def 
+          by (smt gs.R.finsum_cong' gsi.gso_dim length_map)
+        also have "\<dots> = (\<Sum>j2=0..<n.
+            (\<Sum>j1=0..<m. rB $$ (i', j1) * rfs $$ (j1, j2)) * (gsi.gso j') $ j2)"
+          using gsi.gso_carrier len j' by simp
+        also have "\<dots> = (\<Sum>j2=0..<n. (\<Sum>j1=0..<m.
+            rB $$ (i', j1) * rfs $$ (j1, j2) * (gsi.gso j') $ j2))" 
+          by (smt gs.R.finsum_cong' sum_distrib_right)
+        also have "\<dots> = (\<Sum>j1=0..<m. (\<Sum>j2=0..<n.
+            rB $$ (i', j1) * rfs $$ (j1, j2) * (gsi.gso j') $ j2))"
+          using sum.swap by auto
+        also have "\<dots> = (\<Sum>j1=0..<m. rB $$ (i', j1) * (\<Sum>j2=0..<n. 
+            rfs $$ (j1, j2) * (gsi.gso j') $ j2))"
+          using gs.R.finsum_cong' sum_distrib_left by (smt gs.m_assoc)
+        also have "\<dots> = row rB i' \<bullet> (vec m (\<lambda> j1. (\<Sum>j2=0..<n.
+            rfs $$ (j1, j2) * (gsi.gso j') $ j2)))" 
+          using rBcarr rfscarr i' scalar_prod_def
+          by (smt atLeastLessThan_iff carrier_matD(1) carrier_matD(2) dim_vec 
+              gs.R.finsum_cong' index_row(1) index_vec)
+        also have "(vec m (\<lambda> j1. (\<Sum>j2=0..<n. rfs $$ (j1, j2) * (gsi.gso j') $ j2)))
+            =  (vec m (\<lambda> j1. row rfs j1 \<bullet> gsi.gso j'))"
+          using rfscarr gsi.gso_carrier len j' rfscarr by (auto simp add: scalar_prod_def)
+        also have "row rB i' \<bullet> \<dots> / \<parallel>gsi.gso j'\<parallel>\<^sup>2 =
+          row rB i' \<bullet> vec m (\<lambda> j1. row rfs j1 \<bullet> gsi.gso j' / \<parallel>gsi.gso j'\<parallel>\<^sup>2)"
+          using prep4 scalar_prod_smult_right rBcarr carrier_matD(2) dim_vec row_def 
+          by (smt gs.l_one times_divide_eq_left)
+        also have "\<dots> = (rB * (gsi.M m)) $$ (i', j')" 
+          using rBcarr i' j' prep3 gsi.M_def by (simp add: col_def)
+        finally have 
+          "map of_int_hom.vec_hom fs' ! i' \<bullet> fs'.gs.gso j' / \<parallel>fs'.gs.gso j'\<parallel>\<^sup>2 =
+          (rB * (gsi.M m)) $$ (i', j')" by auto
+      }
+      then show "\<And> i' j'. i' < m \<Longrightarrow> j' < m \<Longrightarrow> \<mu> fs' i' j' = 
+        (map_mat of_int (A i j c) * gsi.M m) $$ (i',j')" 
+        using B_def fs'.gs.\<beta>_zero fs'.gs.fi_scalar_prod_gso fs'.gs.gso_norm_beta
+          len' rB_def by auto
+      show "\<And> k. k < m \<Longrightarrow> gso fs' k = gso fs k" using gs_eq by auto
+    qed
+  } note mu_gso = this
+
+  show "\<And> k. k < m \<Longrightarrow> gso fs' k = gso fs k" by fact
+  {
+    fix k
+    have "k \<le> m \<Longrightarrow> rat_of_int (d fs' k) = rat_of_int (d fs k)" for k
+    proof (induct k)
+      case 0
+      show ?case by (simp add: d_def)
+    next
+      case (Suc k)
+      hence k: "k \<le> m" "k < m" by auto 
+      show ?case
+        by (subst (1 2) LLL_d_Suc[OF _ k(2)], auto simp: Suc(1)[OF k(1)] mu_gso(2)[OF k(2)]
+          LLL_invariant_weak_def lin lin' len len' latt latt')
+    qed
+    thus "k \<le> m \<Longrightarrow> d fs' k = d fs k" by simp
+  } note d = this
+  {
+    assume i': "i' < m" and j': "j' < m"
+    have "\<mu> fs' i' j' = (of_int_hom.mat_hom (A i j c) * gsi.M m) $$ (i',j')" by (rule mu_gso(1)[OF i' j'])
+    also have "\<dots> = (if (i',j') = (i,j) then of_int c * gsi.d j else 0) + gsi.M m $$ (i',j')" 
+      unfolding A(1) using i' j' by (auto simp: gsi.M_def)
+    also have "gsi.M m $$ (i',j') = \<mu> fs i' j'" 
+      unfolding gsi.M_def using i' j' by simp
+    also have "gsi.d j = of_int (d fs j)" 
+      unfolding d_def by (subst Gramian_determinant_of_int[OF fs], insert ji i len, auto)
+    finally show mu: "\<mu> fs' i' j' = (if (i',j') = (i,j) then rat_of_int (c * d fs j) + \<mu> fs i' j' else \<mu> fs i' j')" 
+      by simp
+    let ?d = "d fs (Suc j')" 
+    have d_fs: "of_int (d\<mu> fs i' j') = rat_of_int ?d * \<mu> fs i' j'" 
+      unfolding d\<mu>_def 
+      using fs.fs_int_mu_d_Z_m_m[unfolded len, OF i' j'] 
+      by (metis LLL.LLL.d_def assms(2) fs.fs_int_mu_d_Z_m_m fs_int.d_def i' 
+          int_of_rat(2) j')
+    have "rat_of_int (d\<mu> fs' i' j') = rat_of_int (d fs' (Suc j')) * \<mu> fs' i' j'" 
+      unfolding d\<mu>_def 
+      using fs'.fs_int_mu_d_Z_m_m[unfolded len', OF i' j']
+      using LLL.LLL.d_def fs'(1) fs'.d\<mu> fs'.d\<mu>_def fs_int.d_def i' j' by auto
+    also have "d fs' (Suc j') = ?d" by (rule d, insert j', auto)
+    also have "rat_of_int \<dots> * \<mu> fs' i' j' = 
+      (if (i',j') = (i,j) then rat_of_int (c * d fs j * ?d) else 0) + of_int (d\<mu> fs i' j')" 
+      unfolding mu d_fs by (simp add: field_simps)
+    also have "\<dots> = rat_of_int ((if (i',j') = (i,j) then c * d fs j * ?d else 0) + d\<mu> fs i' j')"
+      by simp
+    also have "\<dots> = rat_of_int ((if (i',j') = (i,j) then c * d fs j * d fs (Suc j) + d\<mu> fs i' j' else d\<mu> fs i' j'))"
+      by simp
+    finally show "d\<mu> fs' i' j' = (if (i',j') = (i,j) then c * d fs j * d fs (Suc j) + d\<mu> fs i' j' else d\<mu> fs i' j')" 
+      by simp
+  }
+qed
+
+text \<open>Eventually: Lemma 13 of Storjohann's paper.\<close>
+lemma mod_single_element: assumes lin: "lin_indep fs" 
+  and len: "length fs = m" 
+  and i: "i < m" and ji: "j < i"  
+  and latt: "lattice_of fs = L" 
+  and pgtz: "p > 0"
+shows "\<exists> fs'. lattice_of fs' = L \<and> 
+  map (map_vec (\<lambda> x. x mod p)) fs' = map (map_vec (\<lambda> x. x mod p)) fs \<and>
+  map (map_vec (\<lambda> x. x symmod p)) fs' = map (map_vec (\<lambda> x. x symmod p)) fs \<and>
+  lin_indep fs' \<and>
+  length fs' = m \<and> 
+  (\<forall> k < m. gso fs' k = gso fs k) \<and> 
+  (\<forall> k \<le> m. d fs' k = d fs k) \<and>
+  (\<forall> i' < m. \<forall> j' < m. d\<mu> fs' i' j' = (if (i',j') = (i,j) then d\<mu> fs i j' symmod (p * d fs j' * d fs (Suc j')) else d\<mu> fs i' j'))" 
+proof -
+  have inv: "LLL_invariant_weak fs" using LLL_invariant_weak_def assms by simp
+  let ?mult = "d fs j * d fs (Suc j)" 
+  define M where "M = ?mult" 
+  define pM where "pM = p * M" 
+  then have pMgtz: "pM > 0" using pgtz unfolding pM_def M_def using LLL_d_pos[OF inv] i ji by simp
+  let ?d = "d\<mu> fs i j" 
+  define c where "c = - (?d symdiv pM)" 
+  have d_mod: "?d symmod pM = c * pM + ?d" unfolding c_def using pMgtz sym_mod_sym_div by simp
+  define A where "A = gram_schmidt_fs_int.inv_mu_ij_mat n (RAT fs)" 
+  define fs' where fs': "fs' = Matrix.rows (A i j (c * p) * mat_of_rows n fs)"
+  note main = change_single_element[OF lin len i ji A_def fs' latt]
+  have "map (map_vec (\<lambda>x. x mod p)) fs' = map (map_vec (\<lambda>x. x mod p)) fs" 
+    by (intro main, auto)
+  from arg_cong[OF this, of "map (map_vec (poly_mod.inv_M p))"]
+  have id: "map (map_vec (\<lambda>x. x symmod p)) fs' = map (map_vec (\<lambda>x. x symmod p)) fs" 
+    unfolding map_map o_def sym_mod_def map_vec_map_vec .
+  show ?thesis
+  proof (intro exI[of _ fs'] conjI main allI impI id)
+    fix i' j'
+    assume ij: "i' < m" "j' < m" 
+    have "d\<mu> fs' i' j' = (if (i', j') = (i, j) then (c * p) * M + ?d else d\<mu> fs i' j')" 
+      unfolding main(8)[OF ij] M_def by simp
+    also have "(c * p) * M + ?d = ?d symmod pM" 
+      unfolding d_mod by (simp add: pM_def)
+    finally show "d\<mu> fs' i' j' = (if (i',j') = (i,j) then d\<mu> fs i j' symmod (p * d fs j' * d fs (Suc j')) else d\<mu> fs i' j')" 
+      by (auto simp: pM_def M_def ac_simps)
+  qed auto
+qed 
+
+text \<open>A slight generalization to perform modulo on arbitrary set of indices $I$.\<close>
+lemma mod_finite_set: assumes lin: "lin_indep fs" 
+  and len: "length fs = m" 
+  and I: "I \<subseteq> {(i,j). i < m \<and> j < i}"
+  and latt: "lattice_of fs = L" 
+  and pgtz: "p > 0"
+shows "\<exists> fs'. lattice_of fs' = L \<and>
+  map (map_vec (\<lambda> x. x mod p)) fs' = map (map_vec (\<lambda> x. x mod p)) fs \<and>
+  map (map_vec (\<lambda> x. x symmod p)) fs' = map (map_vec (\<lambda> x. x symmod p)) fs \<and>
+  lin_indep fs' \<and>
+  length fs' = m \<and> 
+  (\<forall> k < m. gso fs' k = gso fs k) \<and> 
+  (\<forall> k \<le> m. d fs' k = d fs k) \<and>
+  (\<forall> i' < m. \<forall> j' < m. d\<mu> fs' i' j' = 
+     (if (i',j') \<in> I then d\<mu> fs i' j' symmod (p * d fs j' * d fs (Suc j')) else d\<mu> fs i' j'))"
+proof -
+  let ?exp = "\<lambda> fs' I i' j'. 
+    d\<mu> fs' i' j' = (if (i',j') \<in> I then d\<mu> fs i' j' symmod (p * d fs j' * d fs (Suc j')) else d\<mu> fs i' j')" 
+  let ?prop = "\<lambda> fs fs'. lattice_of fs' = L \<and> 
+    map (map_vec (\<lambda> x. x mod p)) fs' = map (map_vec (\<lambda> x. x mod p)) fs \<and>
+    map (map_vec (\<lambda> x. x symmod p)) fs' = map (map_vec (\<lambda> x. x symmod p)) fs \<and>
+    lin_indep fs' \<and>
+    length fs' = m \<and> 
+    (\<forall> k < m. gso fs' k = gso fs k) \<and> 
+    (\<forall> k \<le> m. d fs' k = d fs k)" 
+  have "finite I" 
+  proof (rule finite_subset[OF I], rule finite_subset)
+    show "{(i, j). i < m \<and> j < i} \<subseteq> {0..m} \<times> {0..m}" by auto
+  qed auto
+  from this I have "\<exists> fs'. ?prop fs fs' \<and> (\<forall> i' < m. \<forall> j' < m. ?exp fs' I i' j')"
+  proof (induct I)
+    case empty
+    show ?case
+      by (intro exI[of _ fs], insert assms, auto)
+  next
+    case (insert ij I)
+    obtain i j where ij: "ij = (i,j)" by force
+    from ij insert(4) have i: "i < m" "j < i" by auto
+    from insert(3,4) obtain gs where gs: "?prop fs gs" 
+      and exp: "\<And> i' j'. i' < m \<Longrightarrow> j' < m \<Longrightarrow> ?exp gs I i' j'" by auto
+    from gs have "lin_indep gs" "lattice_of gs = L" "length gs = m" by auto
+    from mod_single_element[OF this(1,3) i this(2), of p] 
+    obtain hs where hs: "?prop gs hs" 
+      and exp': "\<And> i' j'. i' < m \<Longrightarrow> j' < m \<Longrightarrow> 
+      d\<mu> hs i' j' = (if (i', j') = (i, j) 
+         then d\<mu> gs i j' symmod (p * d gs j' * d gs (Suc j')) else d\<mu> gs i' j')" 
+      using pgtz by auto
+    from gs i have id: "d gs j = d fs j" "d gs (Suc j) = d fs (Suc j)" by auto
+    show ?case 
+    proof (intro exI[of _ hs], rule conjI; (intro allI impI)?)
+      show "?prop fs hs" using gs hs by auto
+      fix i' j'
+      assume *: "i' < m" "j' < m" 
+      show "?exp hs (insert ij I) i' j'" unfolding exp'[OF *] ij using exp * i
+        by (auto simp: id)
+    qed
+  qed
+  thus ?thesis by auto
+qed
+
+end
+
+end
\ No newline at end of file
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite.thy
@@ -0,0 +1,281 @@
+section \<open>Generalization of the statement about the uniqueness of the Hermite normal form\<close>
+
+theory Uniqueness_Hermite
+imports Hermite.Hermite
+begin
+
+(*This file presents a generalized version of the theorem Hermite_unique when applied to integer
+matrices. More concretely, instead of assuming invertibility over Z of the input matrix A, we now 
+assume invertibility over Q. Only some changes to adapt the original proof are required.*)
+
+instance int :: bezout_ring_div
+proof qed
+
+lemma map_matrix_rat_of_int_mult:
+  shows "map_matrix rat_of_int (A**B) = (map_matrix rat_of_int A)**(map_matrix rat_of_int B)" 
+  unfolding map_matrix_def matrix_matrix_mult_def by auto
+
+lemma det_map_matrix:
+  fixes A :: "int^'n::mod_type^'n::mod_type"
+  shows "det (map_matrix rat_of_int A) = rat_of_int (det A)" 
+  unfolding map_matrix_def unfolding Determinants.det_def by auto
+
+lemma inv_Z_imp_inv_Q:
+  fixes A :: "int^'n::mod_type^'n::mod_type"
+  assumes inv_A: "invertible A"
+  shows "invertible (map_matrix rat_of_int A)"
+proof -
+  have "is_unit (det A)" using inv_A invertible_iff_is_unit by blast
+  hence "is_unit (det (map_matrix rat_of_int A))"
+    by (simp add: det_map_matrix dvd_if_abs_eq)
+  thus ?thesis using invertible_iff_is_unit by blast
+qed
+
+lemma upper_triangular_Z_eq_Q:
+  "upper_triangular (map_matrix rat_of_int A) = upper_triangular A" 
+  unfolding upper_triangular_def by auto
+
+lemma invertible_and_upper_diagonal_not0:
+  fixes H :: "int^'n::mod_type^'n::mod_type"
+  assumes inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
+  shows "H $ i $ i \<noteq> 0"
+proof -
+  let ?RAT_H = "(map_matrix rat_of_int H)"
+  have up_RAT_H: "upper_triangular ?RAT_H"
+    using up_H unfolding upper_triangular_def by auto
+  have "is_unit (det ?RAT_H)" using inv_H using invertible_iff_is_unit by blast
+  hence "?RAT_H $ i $ i \<noteq> 0" using inv_H up_RAT_H is_unit_diagonal
+    by (metis not_is_unit_0)
+  thus ?thesis by auto
+qed
+
+lemma diagonal_least_nonzero:
+  fixes H :: "int^'n::mod_type^'n::mod_type"
+  assumes H: "Hermite associates residues H"
+  and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
+  shows "(LEAST n. H $ i $ n \<noteq> 0) = i"
+proof (rule Least_equality)
+  show "H $ i $ i \<noteq> 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H])
+  fix y
+  assume Hiy: "H $ i $ y \<noteq> 0"
+  show "i \<le> y" 
+    using up_H unfolding upper_triangular_def
+    by (metis (poly_guards_query) Hiy not_less)
+qed
+
+lemma diagonal_in_associates:
+  fixes H :: "int^'n::mod_type^'n::mod_type"
+  assumes H: "Hermite associates residues H"
+  and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
+  shows "H $ i $ i \<in> associates"
+proof -
+  have "H $ i $ i \<noteq> 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H])
+  hence "\<not> is_zero_row i H" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto
+  thus ?thesis using H unfolding Hermite_def unfolding diagonal_least_nonzero[OF H inv_H up_H] 
+    by auto
+qed
+
+lemma above_diagonal_in_residues:
+  fixes H :: "int^'n::mod_type^'n::mod_type"
+  assumes H: "Hermite associates residues H"
+  and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
+  and j_i: "j<i"
+  shows "H $ j $ (LEAST n. H $ i $ n \<noteq> 0) \<in> residues (H $ i $ (LEAST n. H $ i $ n \<noteq> 0))" 
+proof -
+  have "H $ i $ i \<noteq> 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H])
+  hence "\<not> is_zero_row i H" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto
+  thus ?thesis using H j_i unfolding Hermite_def unfolding diagonal_least_nonzero[OF H inv_H up_H] 
+    by auto
+qed
+
+
+lemma Hermite_unique_generalized:
+  fixes K::"int^'n::mod_type^'n::mod_type"
+  assumes A_PH: "A = P ** H" 
+  and A_QK: "A = Q ** K"
+  and inv_A: "invertible (map_matrix rat_of_int A)" (*The original statement assumes "invertible A", 
+                                                      that is, invertibility over integers, which is
+                                                      more restrictive.*)
+  and inv_P: "invertible P"
+  and inv_Q: "invertible Q"
+  and H: "Hermite associates residues H"
+  and K: "Hermite associates residues K"
+  shows "H = K"
+proof -
+  let ?RAT = "map_matrix rat_of_int"
+  have cs_residues: "Complete_set_residues residues" using H unfolding Hermite_def by simp
+  have inv_H: "invertible (?RAT H)"
+  proof -
+    have "?RAT A = ?RAT P ** ?RAT H" using A_PH map_matrix_rat_of_int_mult by blast
+    thus ?thesis
+      by (metis inv_A invertible_left_inverse matrix_inv(1) matrix_mul_assoc)
+  qed
+  have inv_K: "invertible (?RAT K)"
+  proof -
+   have "?RAT A = ?RAT Q ** ?RAT K" using A_QK map_matrix_rat_of_int_mult by blast
+    thus ?thesis
+      by (metis inv_A invertible_left_inverse matrix_inv(1) matrix_mul_assoc)
+  qed
+  define U where "U = (matrix_inv P)**Q"
+  have inv_U: "invertible U" 
+    by (metis U_def inv_P inv_Q invertible_def invertible_mult matrix_inv_left matrix_inv_right)
+  have H_UK: "H = U ** K" using A_PH A_QK inv_P 
+    by (metis U_def matrix_inv_left matrix_mul_assoc matrix_mul_lid)
+  have "Determinants.det K *k U = H ** adjugate K"
+    unfolding H_UK matrix_mul_assoc[symmetric] mult_adjugate_det matrix_mul_mat ..
+  have upper_triangular_H: "upper_triangular H"
+    by (metis H Hermite_def echelon_form_imp_upper_triagular)
+  have upper_triangular_K: "upper_triangular K" 
+    by (metis K Hermite_def echelon_form_imp_upper_triagular)
+  have upper_triangular_U: "upper_triangular U" 
+  proof -
+    have U_H_K: "?RAT U = (?RAT H) ** (matrix_inv (?RAT K))"
+      by (metis H_UK inv_K map_matrix_rat_of_int_mult matrix_inv(2) matrix_mul_assoc matrix_mul_rid)
+    have up_inv_RAT_K: "upper_triangular (matrix_inv (?RAT K))" using upper_triangular_inverse
+      by (simp add: upper_triangular_inverse inv_K upper_triangular_K upper_triangular_Z_eq_Q)
+    have "upper_triangular (?RAT U)" unfolding U_H_K 
+      by (rule upper_triangular_mult[OF _ up_inv_RAT_K], 
+          auto simp add: upper_triangular_H upper_triangular_Z_eq_Q)
+    thus ?thesis using upper_triangular_Z_eq_Q by auto
+  qed
+  have unit_det_U: "is_unit (det U)" by (metis inv_U invertible_iff_is_unit)
+  have is_unit_diagonal_U: "(\<forall>i. is_unit (U $ i $ i))"
+    by (rule is_unit_diagonal[OF upper_triangular_U unit_det_U])
+  have Uii_1: "(\<forall>i. (U $ i $ i) = 1)" and Hii_Kii: "(\<forall>i. (H $ i $ i) = (K $ i $ i))"
+  proof (auto)
+    fix i
+    have Hii: "H $ i $ i \<in> associates" 
+      by (rule diagonal_in_associates[OF H inv_H upper_triangular_H])
+    have Kii: "K $ i $ i \<in> associates"
+      by (rule diagonal_in_associates[OF K inv_K upper_triangular_K])
+    have ass_Hii_Kii: "normalize (H $ i $ i) = normalize (K $ i $ i)"
+      by (metis H_UK is_unit_diagonal_U normalize_mult_unit_left upper_triangular_K upper_triangular_U upper_triangular_mult_diagonal)
+    show Hii_eq_Kii: "H $ i $ i = K $ i $ i"
+      by (metis Hermite_def Hii K Kii ass_Hii_Kii in_Ass_not_associated)
+    have "H $ i $ i = U $ i $ i * K $ i $ i" 
+      by (metis H_UK upper_triangular_K upper_triangular_U upper_triangular_mult_diagonal)
+    thus "U $ i $ i = 1" unfolding Hii_eq_Kii mult_cancel_right1
+      using inv_K invertible_and_upper_diagonal_not0 upper_triangular_K by blast 
+  qed
+  have zero_above: "\<forall>j s. j\<ge>1 \<and> j < ncols A - to_nat s \<longrightarrow> U $ s $ (s + from_nat j) = 0"
+  proof (clarify)
+    fix j s assume  "1 \<le> j" and "j < ncols A - (to_nat (s::'n))"
+    thus "U $ s $ (s + from_nat j) = 0"
+    proof (induct j rule: less_induct)
+      fix p 
+      assume induct_step: "(\<And>y. y < p \<Longrightarrow> 1 \<le> y \<Longrightarrow> y < ncols A - to_nat s \<Longrightarrow> U $ s $ (s + from_nat y) = 0)"
+        and p1: "1 \<le> p" and p2: "p < ncols A - to_nat s"
+      have s_less: "s < s + from_nat p" using p1 p2 unfolding ncols_def
+        by (metis One_nat_def add.commute add_diff_cancel_right' add_lessD1 add_to_nat_def 
+          from_nat_to_nat_id less_diff_conv neq_iff not_le
+          to_nat_from_nat_id to_nat_le zero_less_Suc)
+      show "U $ s $ (s + from_nat p) = 0"
+      proof -
+        have UNIV_rw: "UNIV = insert s (UNIV-{s})" by auto
+        have UNIV_s_rw: "UNIV-{s} = insert (s + from_nat p) ((UNIV-{s}) - {s + from_nat p})" 
+          using p1 p2 s_less unfolding ncols_def by (auto simp: algebra_simps)
+        have sum_rw: "(\<Sum>k\<in>UNIV-{s}. U $ s $ k * K $ k $ (s + from_nat p)) 
+          = U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p) 
+          + (\<Sum>k\<in>(UNIV-{s})-{s + from_nat p}. U $ s $ k * K $ k $ (s + from_nat p))"
+          using UNIV_s_rw sum.insert by (metis (erased, lifting) Diff_iff finite singletonI)
+        have sum_0: "(\<Sum>k\<in>(UNIV-{s})-{s + from_nat p}. U $ s $ k * K $ k $ (s + from_nat p)) = 0"
+        proof (rule sum.neutral, rule)
+          fix x assume x: "x \<in> UNIV - {s} - {s + from_nat p}"
+          show "U $ s $ x * K $ x $ (s + from_nat p) = 0" 
+          proof (cases "x<s")
+            case True
+            thus ?thesis using upper_triangular_U unfolding upper_triangular_def
+              by auto
+          next
+            case False
+            hence x_g_s: "x>s" using x by (metis Diff_iff neq_iff singletonI)
+            show ?thesis 
+            proof (cases "x<s+from_nat p")
+              case True
+              define a where "a = to_nat x - to_nat s"
+              from x_g_s have "to_nat s < to_nat x" by (rule to_nat_mono)
+              hence xa: "x=s+(from_nat a)" unfolding a_def add_to_nat_def
+                by (simp add: less_imp_diff_less to_nat_less_card algebra_simps to_nat_from_nat_id)
+              have "U $ s $ x =0" 
+              proof (unfold xa, rule induct_step)
+                show a_p: "a<p" unfolding a_def using p2 unfolding ncols_def 
+                proof -
+                  have "x < from_nat (to_nat s + to_nat (from_nat p::'n))"
+                    by (metis (no_types) True add_to_nat_def)
+                  hence "to_nat x - to_nat s < to_nat (from_nat p::'n)"
+                    by (simp add: add.commute less_diff_conv2 less_imp_le to_nat_le x_g_s)
+                  thus "to_nat x - to_nat s < p"
+                    by (metis (no_types) from_nat_eq_imp_eq from_nat_to_nat_id le_less_trans 
+                        less_imp_le not_le to_nat_less_card)
+                qed                    
+                show "1 \<le> a" 
+                  by (auto simp add: a_def p1 p2) (metis Suc_leI to_nat_mono x_g_s zero_less_diff)
+                show "a < ncols A - to_nat s" using a_p p2 by auto
+              qed
+              thus ?thesis by simp
+            next
+              case False
+              hence "x>s+from_nat p" using x_g_s x by auto
+              thus ?thesis using upper_triangular_K unfolding upper_triangular_def
+                by auto
+            qed
+          qed 
+        qed
+        have "H $ s $ (s + from_nat p) = (\<Sum>k\<in>UNIV. U $ s $ k * K $ k $ (s + from_nat p))"
+          unfolding H_UK matrix_matrix_mult_def by auto
+        also have "... = (\<Sum>k\<in>insert s (UNIV-{s}). U $ s $ k * K $ k $ (s + from_nat p))"
+          using UNIV_rw by simp
+        also have "... = U $ s $ s * K $ s $ (s + from_nat p) 
+          + (\<Sum>k\<in>UNIV-{s}. U $ s $ k * K $ k $ (s + from_nat p))"
+          by (rule sum.insert, simp_all)
+        also have "... = U $ s $ s * K $ s $ (s + from_nat p) 
+          + U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p)"
+          unfolding sum_rw sum_0 by simp
+        finally have H_s_sp: "H $ s $ (s + from_nat p) 
+          = U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p) + K $ s $ (s + from_nat p)"
+          using Uii_1 by auto
+        hence cong_HK: "cong (H $ s $ (s + from_nat p)) (K $ s $ (s + from_nat p)) (K $ (s+from_nat p) $ (s + from_nat p))"
+          unfolding cong_def by auto
+        have H_s_sp_residues: "(H $ s $ (s + from_nat p)) \<in> residues (K $ (s+from_nat p) $ (s + from_nat p))" 
+          using above_diagonal_in_residues[OF H inv_H upper_triangular_H s_less]
+          unfolding diagonal_least_nonzero[OF H inv_H upper_triangular_H]
+          by (metis Hii_Kii)
+        have K_s_sp_residues: "(K $ s $ (s + from_nat p)) \<in> residues (K $ (s+from_nat p) $ (s + from_nat p))"
+          using above_diagonal_in_residues[OF K inv_K upper_triangular_K s_less]
+          unfolding diagonal_least_nonzero[OF K inv_K upper_triangular_K] .
+        have Hs_sp_Ks_sp: "(H $ s $ (s + from_nat p)) = (K $ s $ (s + from_nat p))"             
+          using cong_HK in_Res_not_congruent[OF cs_residues H_s_sp_residues K_s_sp_residues]
+          by fast
+        have "K $ (s + from_nat p) $ (s + from_nat p) \<noteq> 0"
+          using inv_K invertible_and_upper_diagonal_not0 upper_triangular_K by blast
+        thus ?thesis unfolding from_nat_1 using H_s_sp unfolding Hs_sp_Ks_sp by auto
+      qed 
+    qed 
+  qed
+  have "U = mat 1" 
+  proof (unfold mat_def vec_eq_iff, auto)
+    fix ia show "U $ ia $ ia = 1" using Uii_1 by simp
+    fix i assume i_ia: "i \<noteq> ia"
+    show "U $ i $ ia = 0"
+    proof (cases "ia<i")
+      case True
+      thus ?thesis using upper_triangular_U unfolding upper_triangular_def by auto
+    next
+      case False
+      hence i_less_ia: "i<ia" using i_ia by auto
+      define a where "a = to_nat ia - to_nat i"
+      have ia_eq: "ia = i + from_nat a" unfolding a_def
+        by (metis i_less_ia a_def add_to_nat_def dual_order.strict_iff_order from_nat_to_nat_id 
+            le_add_diff_inverse less_imp_diff_less to_nat_from_nat_id to_nat_less_card to_nat_mono)
+      have "1 \<le> a" unfolding a_def
+        by (metis diff_is_0_eq i_less_ia less_one not_less to_nat_mono)
+      moreover have "a < ncols A - to_nat i"
+        unfolding a_def ncols_def
+        by (metis False diff_less_mono not_less to_nat_less_card to_nat_mono')
+      ultimately show ?thesis using zero_above unfolding ia_eq by blast
+    qed
+  qed
+  thus ?thesis using H_UK matrix_mul_lid by fast
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite_JNF.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite_JNF.thy
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite_JNF.thy
@@ -0,0 +1,823 @@
+section \<open>Uniqueness of Hermite normal form in JNF\<close>
+
+text \<open>This theory contains the proof of the uniqueness theorem of the Hermite normal form in JNF,
+moved from HOL Analysis.\<close>
+
+theory Uniqueness_Hermite_JNF
+  imports 
+  Hermite.Hermite
+  Uniqueness_Hermite
+  Smith_Normal_Form.SNF_Missing_Lemmas
+  Smith_Normal_Form.Mod_Type_Connect
+  Smith_Normal_Form.Finite_Field_Mod_Type_Connection
+begin  
+
+hide_const (open) residues
+
+text \<open>We first define some properties that currently exist in HOL Analysis, but not in
+JNF, namely a predicate for being in echelon form, another one for being in Hermite normal form,
+definition of a row of zeros up to a concrete position, and so on.\<close>
+
+definition is_zero_row_upt_k_JNF :: "nat  => nat =>'a::{zero} mat => bool"
+  where "is_zero_row_upt_k_JNF i k A = (\<forall>j. j < k \<longrightarrow> A $$ (i,j) = 0)"
+
+definition is_zero_row_JNF :: "nat =>'a::{zero} mat  => bool"
+  where "is_zero_row_JNF i A =  (\<forall>j<dim_col A. A $$ (i, j) = 0)"
+
+lemma echelon_form_def': 
+"echelon_form A = (
+    (\<forall>i. is_zero_row i A \<longrightarrow> \<not> (\<exists>j. j>i \<and> \<not> is_zero_row j A)) 
+    \<and>  
+    (\<forall>i j. i<j \<and> \<not> (is_zero_row i A) \<and> \<not> (is_zero_row j A) 
+          \<longrightarrow> ((LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ j $ n \<noteq> 0))))"
+  unfolding echelon_form_def echelon_form_upt_k_def unfolding is_zero_row_def by auto
+
+definition 
+  echelon_form_JNF :: "'a::{bezout_ring} mat \<Rightarrow> bool" 
+  where 
+  "echelon_form_JNF A = (
+    (\<forall>i<dim_row A. is_zero_row_JNF i A \<longrightarrow> \<not> (\<exists>j. j < dim_row A \<and> j>i \<and> \<not> is_zero_row_JNF j A)) 
+    \<and>  
+    (\<forall>i j. i<j \<and> j<dim_row A \<and> \<not> (is_zero_row_JNF i A) \<and> \<not> (is_zero_row_JNF j A) 
+          \<longrightarrow> ((LEAST n. A $$ (i, n) \<noteq> 0) < (LEAST n. A $$ (j, n) \<noteq> 0))))"
+
+
+text \<open>Now, we connect the existing definitions in HOL Analysis to the ones just defined in JNF by
+means of transfer rules.\<close>
+
+context includes lifting_syntax
+begin
+
+
+lemma HMA_is_zero_row_mod_type[transfer_rule]: 
+  "((Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
+    ===> (=)) is_zero_row_JNF is_zero_row"
+proof (intro rel_funI, goal_cases)
+  case (1 i i' A A')
+  note ii' = "1"(1)[transfer_rule]
+  note AA' = "1"(2)[transfer_rule]
+  have "(\<forall>j<dim_col A. A $$ (i, j) = 0) = (\<forall>j. A' $h i' $h j = 0)"
+  proof (rule;rule+)
+    fix j'::'n assume Aij_0: "\<forall>j<dim_col A. A $$ (i, j) = 0" 
+    define j where "j = mod_type_class.to_nat j'"
+    have [transfer_rule]: "Mod_Type_Connect.HMA_I j j'" unfolding Mod_Type_Connect.HMA_I_def j_def by auto
+    have A_ij0': "A $$ (i,j) = 0" using Aij_0 unfolding j_def
+      by (metis AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def 
+          dim_col_mat(1) mod_type_class.to_nat_less_card)
+    hence "index_hma A' i' j' = 0" by transfer
+    thus "A' $h i' $h j' = 0" unfolding index_hma_def by simp
+  next
+    fix j assume 1: "\<forall>j'. A' $h i' $h j' = 0" and 2: "j < dim_col A" 
+    define j'::'n where "j' = mod_type_class.from_nat j"
+    have [transfer_rule]: "Mod_Type_Connect.HMA_I j j'" unfolding Mod_Type_Connect.HMA_I_def j'_def 
+      using Mod_Type.to_nat_from_nat_id[of j, where ?'a = 'n] 2
+      using AA' Mod_Type_Connect.dim_col_transfer_rule by force
+    have "A' $h i' $h j' = 0" using 1 by auto
+    hence "index_hma A' i' j' = 0" unfolding index_hma_def by simp  
+    thus "A $$ (i, j) = 0" by transfer
+  qed
+  thus ?case unfolding is_zero_row_def' is_zero_row_JNF_def by auto
+qed
+
+lemma HMA_echelon_form_mod_type[transfer_rule]: 
+  "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a ::bezout_ring ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=))
+  echelon_form_JNF echelon_form"
+proof (intro rel_funI, goal_cases)
+  case (1 A A')
+  note AA' = "1"(1)[transfer_rule]
+  have 1: "(\<forall>i<dim_row A. is_zero_row_JNF i A \<longrightarrow> \<not> (\<exists>j < dim_row A. j>i \<and> \<not> is_zero_row_JNF j A))
+    = (\<forall>i. is_zero_row i A' \<longrightarrow> \<not> (\<exists>j>i. \<not> is_zero_row j A'))"
+  proof (auto)
+    fix i' j' assume 1: "\<forall>i<dim_row A. is_zero_row_JNF i A \<longrightarrow> (\<forall>j>i. j < dim_row A \<longrightarrow> is_zero_row_JNF j A)"
+      and 2: "is_zero_row i' A'" and 3: "i' < j'"
+    let ?i = "Mod_Type.to_nat i'"
+    let ?j = "Mod_Type.to_nat j'"
+    have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" and jj'[transfer_rule]: "Mod_Type_Connect.HMA_I ?j j'" 
+      unfolding Mod_Type_Connect.HMA_I_def by auto
+    have "is_zero_row_JNF ?i A" using 2 by transfer' 
+    hence "is_zero_row_JNF ?j A" using 1 3 to_nat_mono
+      by (metis AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def
+          dim_row_mat(1) mod_type_class.to_nat_less_card)
+    thus "is_zero_row j' A'" by transfer'
+  next
+    fix i j assume 1: "\<forall>i'. is_zero_row i' A' \<longrightarrow> (\<forall>j'>i'. is_zero_row j' A')"
+      and 2: "is_zero_row_JNF i A" and 3: "i < j" and 4: "j<dim_row A"
+    let ?i' = "Mod_Type.from_nat i::'m"
+    let ?j' = "Mod_Type.from_nat j::'m"
+    have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'"
+      unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id[of i]
+      using 3 4 AA' Mod_Type_Connect.dim_row_transfer_rule less_trans by fastforce
+    have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" 
+      unfolding Mod_Type_Connect.HMA_I_def  using Mod_Type.to_nat_from_nat_id[of j]
+      using 3 4 AA' Mod_Type_Connect.dim_row_transfer_rule less_trans by fastforce
+    have "is_zero_row ?i' A'" using 2 by transfer
+    moreover have "?i' < ?j'" using 3 4 AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono by fastforce
+    ultimately have "is_zero_row ?j' A'" using 1 3 by auto
+    thus "is_zero_row_JNF j A" by transfer
+  qed
+  have 2: "((\<forall>i j. i<j \<and> \<not> (is_zero_row i A') \<and> \<not> (is_zero_row j A') 
+    \<longrightarrow> ((LEAST n. A' $h i $h n \<noteq> 0) < (LEAST n. A' $h j $h n \<noteq> 0)))) 
+    = (\<forall>i j. i<j \<and> j<dim_row A \<and> \<not> (is_zero_row_JNF i A) \<and> \<not> (is_zero_row_JNF j A) 
+    \<longrightarrow> ((LEAST n. A $$ (i, n) \<noteq> 0) < (LEAST n. A $$ (j, n) \<noteq> 0)))"
+  proof (auto)
+    fix i j assume 1: "\<forall>i' j'. i' < j' \<and> \<not> is_zero_row i' A' \<and> \<not> is_zero_row j' A' 
+      \<longrightarrow> (LEAST n'. A' $h i' $h n' \<noteq> 0) < (LEAST n'. A' $h j' $h n' \<noteq> 0)"
+      and ij: "i < j" and j: "j < dim_row A" and i0: "\<not> is_zero_row_JNF i A"
+      and j0: "\<not> is_zero_row_JNF j A"
+    let ?i' = "Mod_Type.from_nat i::'m"
+    let ?j' = "Mod_Type.from_nat j::'m"
+    have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'"
+      unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id[of i]
+      using ij j AA' Mod_Type_Connect.dim_row_transfer_rule less_trans by fastforce
+    have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" 
+      unfolding Mod_Type_Connect.HMA_I_def  using Mod_Type.to_nat_from_nat_id[of j]
+      using ij j AA' Mod_Type_Connect.dim_row_transfer_rule less_trans by fastforce
+    have i'0: "\<not> is_zero_row ?i' A'" using i0 by transfer
+    have j'0: "\<not> is_zero_row ?j' A'" using j0 by transfer
+    have i'j': "?i' < ?j'"
+      using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono ij j by fastforce
+    have l1l2: "(LEAST n'. A' $h ?i' $h n' \<noteq> 0) < (LEAST n'. A' $h ?j' $h n' \<noteq> 0)"
+      using 1 i'0 j'0 i'j' by auto
+    define l1 where "l1 = (LEAST n'. A' $h ?i' $h n' \<noteq> 0)"
+    define l2 where "l2 = (LEAST n'. A' $h ?j' $h n' \<noteq> 0)"
+    let ?least_n1 = "Mod_Type.to_nat l1"
+    let ?least_n2 = "Mod_Type.to_nat l2"
+    have l1[transfer_rule]: "Mod_Type_Connect.HMA_I ?least_n1 l1" and [transfer_rule]: "Mod_Type_Connect.HMA_I ?least_n2 l2"
+      unfolding Mod_Type_Connect.HMA_I_def by auto
+    have "(LEAST n. A $$ (i, n) \<noteq> 0) = ?least_n1" 
+    proof (rule Least_equality)
+      obtain n' where n'1: "A $$ (i,n') \<noteq> 0" and n'2: "n'<dim_col A"
+        using i0 unfolding is_zero_row_JNF_def by auto
+      let ?n' = "Mod_Type.from_nat n'::'n"
+      have n'n'[transfer_rule]: "Mod_Type_Connect.HMA_I n' ?n'"
+        unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id n'2
+        using AA' Mod_Type_Connect.dim_col_transfer_rule by fastforce
+      have "index_hma A' ?i' ?n' \<noteq> 0" using n'1 by transfer
+      hence A'i'n': "A' $h ?i' $h ?n' \<noteq> 0" unfolding index_hma_def by simp
+      have least_le_n': "(LEAST n. A $$ (i, n) \<noteq> 0)  \<le> n'" by (simp add: Least_le n'1)
+      have l1_le_n': "l1 \<le> ?n'" by (simp add: A'i'n' Least_le l1_def)
+      have "A $$ (i, ?least_n1) = index_hma A' ?i' l1" by (transfer, simp)
+      also have "... = A' $h mod_type_class.from_nat i $h l1" unfolding index_hma_def by simp
+      also have "... \<noteq> 0" unfolding l1_def by (metis (mono_tags, lifting) LeastI i'0 is_zero_row_def')
+      finally show "A $$ (i, mod_type_class.to_nat l1) \<noteq> 0" .
+      fix y assume Aiy: "A $$ (i, y) \<noteq> 0"
+      let ?y' = "Mod_Type.from_nat y::'n"
+      show "Mod_Type.to_nat l1 \<le> y"
+      proof (cases "y\<le>n'")
+        case True
+        hence y: "y < dim_col A" using n'2 by auto
+        have yy'[transfer_rule]: "Mod_Type_Connect.HMA_I y ?y'" unfolding Mod_Type_Connect.HMA_I_def
+          apply (rule Mod_Type.to_nat_from_nat_id[symmetric])
+          using y Mod_Type_Connect.dim_col_transfer_rule[OF AA'] by auto
+        have "Mod_Type.to_nat l1 \<le> Mod_Type.to_nat ?y'"
+        proof (rule to_nat_mono')
+          have "index_hma A' ?i' ?y' \<noteq> 0" using Aiy by transfer
+          hence "A' $h ?i' $h ?y' \<noteq> 0" unfolding index_hma_def by simp
+          thus "l1 \<le> ?y'" unfolding l1_def by (simp add: Least_le)
+        qed
+          then show ?thesis by (metis Mod_Type_Connect.HMA_I_def yy')
+        next
+          case False
+          hence "n' < y" by auto
+          then show ?thesis
+            by (metis False Mod_Type_Connect.HMA_I_def dual_order.trans l1_le_n' linear n'n' to_nat_mono')
+        qed
+      qed
+      moreover have "(LEAST n. A $$ (j, n) \<noteq> 0) = ?least_n2"
+      proof (rule Least_equality)
+        obtain n' where n'1: "A $$ (j,n') \<noteq> 0" and n'2: "n'<dim_col A"
+        using j0 unfolding is_zero_row_JNF_def by auto
+      let ?n' = "Mod_Type.from_nat n'::'n"
+      have n'n'[transfer_rule]: "Mod_Type_Connect.HMA_I n' ?n'" 
+        unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id n'2
+        using AA' Mod_Type_Connect.dim_col_transfer_rule by fastforce
+      have "index_hma A' ?j' ?n' \<noteq> 0" using n'1 by transfer
+      hence A'i'n': "A' $h ?j' $h ?n' \<noteq> 0" unfolding index_hma_def by simp
+      have least_le_n': "(LEAST n. A $$ (j, n) \<noteq> 0)  \<le> n'" by (simp add: Least_le n'1)
+      have l1_le_n': "l2 \<le> ?n'" by (simp add: A'i'n' Least_le l2_def)
+      have "A $$ (j, ?least_n2) = index_hma A' ?j' l2" by (transfer, simp)
+      also have "... = A' $h ?j' $h l2" unfolding index_hma_def by simp
+      also have "... \<noteq> 0" unfolding l2_def by (metis (mono_tags, lifting) LeastI j'0 is_zero_row_def')
+      finally show "A $$ (j, mod_type_class.to_nat l2) \<noteq> 0" .
+      fix y assume Aiy: "A $$ (j, y) \<noteq> 0"
+      let ?y' = "Mod_Type.from_nat y::'n"
+      show "Mod_Type.to_nat l2 \<le> y"
+      proof (cases "y\<le>n'")
+        case True
+        hence y: "y < dim_col A" using n'2 by auto
+        have yy'[transfer_rule]: "Mod_Type_Connect.HMA_I y ?y'" unfolding Mod_Type_Connect.HMA_I_def
+          apply (rule Mod_Type.to_nat_from_nat_id[symmetric])
+          using y Mod_Type_Connect.dim_col_transfer_rule[OF AA'] by auto
+        have "Mod_Type.to_nat l2 \<le> Mod_Type.to_nat ?y'"
+        proof (rule to_nat_mono')
+          have "index_hma A' ?j' ?y' \<noteq> 0" using Aiy by transfer
+          hence "A' $h ?j' $h ?y' \<noteq> 0" unfolding index_hma_def by simp
+          thus "l2 \<le> ?y'" unfolding l2_def by (simp add: Least_le)
+        qed
+          then show ?thesis by (metis Mod_Type_Connect.HMA_I_def yy')
+        next
+          case False
+          hence "n' < y" by auto
+          then show ?thesis
+            by (metis False Mod_Type_Connect.HMA_I_def dual_order.trans l1_le_n' linear n'n' to_nat_mono')
+        qed
+      qed
+      ultimately show "(LEAST n. A $$ (i, n) \<noteq> 0) < (LEAST n. A $$ (j, n) \<noteq> 0)"
+        using l1l2 unfolding l1_def l2_def by (simp add: to_nat_mono)
+    next
+      fix i' j' assume 1: "\<forall>i j. i < j \<and> j < dim_row A \<and> \<not> is_zero_row_JNF i A \<and> \<not> is_zero_row_JNF j A 
+      \<longrightarrow> (LEAST n. A $$ (i, n) \<noteq> 0) < (LEAST n. A $$ (j, n) \<noteq> 0)"
+       and i'j': "i' < j'" and i': "\<not> is_zero_row i' A'" and j': "\<not> is_zero_row j' A'"
+      let ?i = "Mod_Type.to_nat i'"
+      let ?j = "Mod_Type.to_nat j'"
+      have [transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" 
+        and [transfer_rule]: "Mod_Type_Connect.HMA_I ?j j'"
+        unfolding Mod_Type_Connect.HMA_I_def by auto
+      have i: "\<not> is_zero_row_JNF ?i A" using i' by transfer'
+      have j: "\<not> is_zero_row_JNF ?j A" using j' by transfer'
+      have ij: "?i < ?j" using i'j' to_nat_mono by blast
+      have j_dim_row: "?j < dim_row A" 
+        using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card by fastforce
+      have least_ij: "(LEAST n. A $$ (?i, n) \<noteq> 0) < (LEAST n. A $$ (?j, n) \<noteq> 0)"
+        using i j ij j_dim_row 1 by auto
+      define l1 where "l1 = (LEAST n'. A $$ (?i, n') \<noteq> 0)"
+      define l2 where "l2 = (LEAST n'. A $$ (?j, n') \<noteq> 0)"
+      let ?least_n1 = "Mod_Type.from_nat l1::'n"
+      let ?least_n2 = "Mod_Type.from_nat l2::'n"
+      have l1_dim_col: "l1 < dim_col A"
+        by (smt is_zero_row_JNF_def j l1_def leI le_less_trans least_ij less_trans not_less_Least)
+      have l2_dim_col: "l2 < dim_col A"
+        by (metis (mono_tags, lifting) Least_le is_zero_row_JNF_def j l2_def le_less_trans)
+      have [transfer_rule]: "Mod_Type_Connect.HMA_I l1 ?least_n1" unfolding Mod_Type_Connect.HMA_I_def
+        using AA' Mod_Type_Connect.dim_col_transfer_rule l1_dim_col Mod_Type.to_nat_from_nat_id
+        by fastforce
+      have [transfer_rule]: "Mod_Type_Connect.HMA_I l2 ?least_n2" unfolding Mod_Type_Connect.HMA_I_def
+        using AA' Mod_Type_Connect.dim_col_transfer_rule l2_dim_col Mod_Type.to_nat_from_nat_id
+        by fastforce
+      have "(LEAST n. A' $h i' $h n \<noteq> 0) = ?least_n1"
+      proof (rule Least_equality)
+        obtain n' where n'1: "A' $h i' $h n' \<noteq> 0" using i' unfolding is_zero_row_def' by auto
+        have "A' $h i' $h ?least_n1 = index_hma A' i' ?least_n1" unfolding index_hma_def by simp
+        also have "... = A$$ (?i, l1)"  by (transfer, simp)
+        also have "... \<noteq> 0" by (metis (mono_tags, lifting) LeastI i is_zero_row_JNF_def l1_def)
+        finally show "A' $h i' $h ?least_n1 \<noteq> 0" .
+      next
+        fix y assume y: "A' $h i' $h y \<noteq> 0"
+        let ?y' = "Mod_Type.to_nat y"
+        have [transfer_rule]: "Mod_Type_Connect.HMA_I ?y' y" unfolding Mod_Type_Connect.HMA_I_def by simp
+        have "?least_n1 \<le> Mod_Type.from_nat ?y'"
+        proof (unfold l1_def, rule from_nat_mono')                      
+          show "Mod_Type.to_nat y < CARD('n)" by (simp add: mod_type_class.to_nat_less_card)
+          have *: "A $$ (mod_type_class.to_nat i', mod_type_class.to_nat y) \<noteq> 0" 
+            using y[unfolded index_hma_def[symmetric]] by transfer'
+          show "(LEAST n'. A $$ (mod_type_class.to_nat i', n') \<noteq> 0) \<le> mod_type_class.to_nat y" 
+            by (rule Least_le, simp add: *)
+        qed
+        also have "... = y" by simp
+        finally show "?least_n1 \<le> y" .
+      qed
+      moreover have "(LEAST n. A' $h j' $h n \<noteq> 0) = ?least_n2"
+      proof (rule Least_equality)
+        obtain n' where n'1: "A' $h j' $h n' \<noteq> 0" using j' unfolding is_zero_row_def' by auto
+        have "A' $h j' $h ?least_n2 = index_hma A' j' ?least_n2" unfolding index_hma_def by simp
+        also have "... = A$$ (?j, l2)"  by (transfer, simp)
+        also have "... \<noteq> 0" by (metis (mono_tags, lifting) LeastI j is_zero_row_JNF_def l2_def)
+        finally show "A' $h j' $h ?least_n2 \<noteq> 0" .
+      next
+        fix y assume y: "A' $h j' $h y \<noteq> 0"
+        let ?y' = "Mod_Type.to_nat y"
+        have [transfer_rule]: "Mod_Type_Connect.HMA_I ?y' y" unfolding Mod_Type_Connect.HMA_I_def by simp
+        have "?least_n2 \<le> Mod_Type.from_nat ?y'"
+        proof (unfold l2_def, rule from_nat_mono')                      
+          show "Mod_Type.to_nat y < CARD('n)" by (simp add: mod_type_class.to_nat_less_card)
+          have *: "A $$ (mod_type_class.to_nat j', mod_type_class.to_nat y) \<noteq> 0" 
+            using y[unfolded index_hma_def[symmetric]] by transfer'
+          show "(LEAST n'. A $$ (mod_type_class.to_nat j', n') \<noteq> 0) \<le> mod_type_class.to_nat y" 
+            by (rule Least_le, simp add: *)
+        qed
+        also have "... = y" by simp
+        finally show "?least_n2 \<le> y" .
+      qed
+      ultimately show "(LEAST n. A' $h i' $h n \<noteq> 0) < (LEAST n. A' $h j' $h n \<noteq> 0)" using least_ij
+        unfolding l1_def l2_def
+        using AA' Mod_Type_Connect.dim_col_transfer_rule from_nat_mono l2_def l2_dim_col
+        by fastforce
+    qed
+   show ?case unfolding echelon_form_JNF_def echelon_form_def' using 1 2 by auto
+qed
+
+
+definition Hermite_JNF :: "'a::{bezout_ring_div,normalization_semidom} set \<Rightarrow> ('a \<Rightarrow> 'a set) \<Rightarrow> 'a mat \<Rightarrow> bool"
+  where "Hermite_JNF associates residues A = (
+  Complete_set_non_associates associates \<and> (Complete_set_residues residues) \<and> echelon_form_JNF A 
+  \<and> (\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) \<in> associates)
+  \<and> (\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> (\<forall>j. j<i \<longrightarrow> A $$ (j, (LEAST n. A $$ (i, n) \<noteq> 0)) 
+     \<in> residues (A $$ (i,(LEAST n. A $$ (i,n) \<noteq> 0)))
+  )))"
+
+
+lemma HMA_LEAST[transfer_rule]:
+  assumes AA': "(Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) A A'"
+  and ii': "Mod_Type_Connect.HMA_I i i'" and zero_i: "\<not> is_zero_row_JNF i A"
+shows "Mod_Type_Connect.HMA_I (LEAST n. A $$ (i, n) \<noteq> 0) (LEAST n. index_hma A' i' n \<noteq> 0)"
+proof -
+  define l where "l = (LEAST n'. A' $h i' $h n' \<noteq> 0)"
+  let ?least_n2 = "Mod_Type.to_nat l"
+  note AA'[transfer_rule] ii'[transfer_rule]
+  have [transfer_rule]: "Mod_Type_Connect.HMA_I ?least_n2 l"
+    by (simp add: Mod_Type_Connect.HMA_I_def)
+  have zero_i': "\<not> is_zero_row i' A'" using zero_i by transfer
+  have "(LEAST n. A $$ (i, n) \<noteq> 0) = ?least_n2"
+      proof (rule Least_equality)
+        obtain n' where n'1: "A $$ (i,n') \<noteq> 0" and n'2: "n'<dim_col A"
+        using zero_i unfolding is_zero_row_JNF_def by auto
+      let ?n' = "Mod_Type.from_nat n'::'n"
+      have n'n'[transfer_rule]: "Mod_Type_Connect.HMA_I n' ?n'" 
+        unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id n'2
+        using AA' Mod_Type_Connect.dim_col_transfer_rule by fastforce
+      have "index_hma A' i' ?n' \<noteq> 0" using n'1 by transfer
+      hence A'i'n': "A' $h i' $h ?n' \<noteq> 0" unfolding index_hma_def by simp
+      have least_le_n': "(LEAST n. A $$ (i, n) \<noteq> 0)  \<le> n'" by (simp add: Least_le n'1)
+      have l1_le_n': "l \<le> ?n'" by (simp add: A'i'n' Least_le l_def)
+      have "A $$ (i, ?least_n2) = index_hma A' i' l" by (transfer, simp)
+      also have "... = A' $h i' $h l" unfolding index_hma_def by simp
+      also have "... \<noteq> 0" unfolding l_def by (metis (mono_tags) A'i'n' LeastI)
+      finally show "A $$ (i, mod_type_class.to_nat l) \<noteq> 0" .
+      fix y assume Aiy: "A $$ (i, y) \<noteq> 0"
+      let ?y' = "Mod_Type.from_nat y::'n"
+      show "Mod_Type.to_nat l \<le> y"
+      proof (cases "y\<le>n'")
+        case True
+        hence y: "y < dim_col A" using n'2 by auto
+        have yy'[transfer_rule]: "Mod_Type_Connect.HMA_I y ?y'" unfolding Mod_Type_Connect.HMA_I_def
+          apply (rule Mod_Type.to_nat_from_nat_id[symmetric])
+          using y Mod_Type_Connect.dim_col_transfer_rule[OF AA'] by auto
+        have "Mod_Type.to_nat l \<le> Mod_Type.to_nat ?y'"
+        proof (rule to_nat_mono')
+          have "index_hma A' i' ?y' \<noteq> 0" using Aiy by transfer
+          hence "A' $h i' $h ?y' \<noteq> 0" unfolding index_hma_def by simp
+          thus "l \<le> ?y'" unfolding l_def by (simp add: Least_le)
+        qed
+          then show ?thesis by (metis Mod_Type_Connect.HMA_I_def yy')
+        next
+          case False
+          hence "n' < y" by auto
+          then show ?thesis
+            by (metis False Mod_Type_Connect.HMA_I_def dual_order.trans l1_le_n' linear n'n' to_nat_mono')
+        qed
+      qed
+      thus ?thesis unfolding Mod_Type_Connect.HMA_I_def l_def index_hma_def by auto
+qed
+
+
+lemma element_least_not_zero_eq_HMA_JNF:
+  fixes A':: "'a :: comm_ring_1 ^ 'n :: mod_type ^ 'm :: mod_type"
+  assumes AA': "Mod_Type_Connect.HMA_M A A'" and jj': "Mod_Type_Connect.HMA_I j j'"
+    and ii': "Mod_Type_Connect.HMA_I i i'" and zero_i': "\<not> is_zero_row i' A'"
+  shows "A $$ (j, LEAST n. A $$ (i, n) \<noteq> 0) = A' $h j' $h (LEAST n. A' $h i' $h n \<noteq> 0)" 
+proof -
+  note AA'[transfer_rule] jj'[transfer_rule] ii'[transfer_rule]
+  have [transfer_rule]: "Mod_Type_Connect.HMA_I (LEAST n. A $$ (i, n) \<noteq> 0) (LEAST n. index_hma A' i' n \<noteq> 0)"
+    by (rule HMA_LEAST[OF AA' ii'], insert zero_i', transfer, simp)
+  have "A' $h j' $h (LEAST n. A' $h i' $h n \<noteq> 0) = index_hma A' j' (LEAST n. index_hma A' i' n \<noteq> 0)" 
+    unfolding index_hma_def by simp
+  also have "... = A $$ (j, LEAST n. A $$ (i, n) \<noteq> 0)" by (transfer', simp)
+  finally show ?thesis by simp
+qed
+
+
+lemma HMA_Hermite[transfer_rule]:
+  shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: {bezout_ring_div,normalization_semidom} ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)) 
+  (Hermite_JNF associates residues) (Hermite associates residues)"
+proof (intro rel_funI, goal_cases)
+  case (1 A A')
+  note AA' = "1"(1)[transfer_rule]
+  have 1: "echelon_form A' = echelon_form_JNF A" by (transfer, simp)
+  have 2: "(\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) \<in> associates) =
+  (\<forall>i. \<not> is_zero_row i A' \<longrightarrow> A' $h i $h (LEAST n. A' $h i $h n \<noteq> 0) \<in> associates)" (is "?lhs = ?rhs")
+  proof 
+    assume lhs: "?lhs"
+    show "?rhs"
+    proof (rule allI, rule impI)
+      fix i' assume zero_i': "\<not> is_zero_row i' A'" 
+      let ?i = "Mod_Type.to_nat i'"
+      have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" unfolding Mod_Type_Connect.HMA_I_def by simp
+      have [simp]: "?i < dim_row A" using Mod_Type.to_nat_less_card[of i']
+        using AA' Mod_Type_Connect.dim_row_transfer_rule by fastforce
+      have zero_i: "\<not> is_zero_row_JNF ?i A" using zero_i' by transfer
+      have [transfer_rule]: "Mod_Type_Connect.HMA_I (LEAST n. A $$ (?i, n) \<noteq> 0) (LEAST n. index_hma A' i' n \<noteq> 0)"
+        by (rule HMA_LEAST[OF AA' ii'], insert zero_i', transfer, simp)
+      have "A' $h i' $h (LEAST n. A' $h i' $h n \<noteq> 0) = A $$ (?i, LEAST n. A $$ (?i, n) \<noteq> 0)"
+        by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i', symmetric])
+      also have "... \<in> associates" using lhs zero_i by simp  
+      finally show "A' $h i' $h (LEAST n. A' $h i' $h n \<noteq> 0) \<in> associates" .
+    qed
+  next
+    assume rhs: "?rhs"
+    show "?lhs"
+    proof (rule allI, rule impI, rule impI)
+      fix i assume zero_i: "\<not> is_zero_row_JNF i A" and i: "i < dim_row A"
+      let ?i' = "Mod_Type.from_nat i :: 'm"
+      have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'" unfolding Mod_Type_Connect.HMA_I_def
+        using Mod_Type.to_nat_from_nat_id AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce
+      have zero_i': "\<not> is_zero_row ?i' A'" using zero_i by transfer
+      have "A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) = A' $h ?i' $h (LEAST n. A' $h ?i' $h n \<noteq> 0)"   
+        by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i'])
+      also have "... \<in> associates" using rhs zero_i' i by simp  
+      finally show "A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) \<in> associates" .
+    qed
+  qed
+  have 3: "(\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> (\<forall>j<i. A $$ (j, LEAST n. A $$ (i, n) \<noteq> 0) 
+            \<in> residues (A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0)))) =
+            (\<forall>i. \<not> is_zero_row i A' \<longrightarrow> (\<forall>j<i. A' $h j $h (LEAST n. A' $h i $h n \<noteq> 0)
+            \<in> residues (A' $h i $h (LEAST n. A' $h i $h n \<noteq> 0))))" (is "?lhs = ?rhs")
+  proof 
+    assume lhs: "?lhs"
+    show "?rhs"
+    proof (rule allI, rule impI, rule allI, rule impI)
+      fix i' j' :: 'm
+      assume zero_i': "\<not> is_zero_row i' A'" and j'i': "j' < i'" 
+      let ?i = "Mod_Type.to_nat i'"
+      have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" unfolding Mod_Type_Connect.HMA_I_def by simp
+      have i: "?i < dim_row A"
+        using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card
+        by fastforce
+      have zero_i: "\<not> is_zero_row_JNF ?i A" using zero_i' by transfer'
+      let ?j = "Mod_Type.to_nat j'"
+      have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I ?j j'" unfolding Mod_Type_Connect.HMA_I_def by simp
+      have ji: "?j<?i" using j'i' to_nat_mono by blast
+      have eq1: "A $$ (?j, LEAST n. A $$ (?i, n) \<noteq> 0) = A' $h j' $h (LEAST n. A' $h i' $h n \<noteq> 0)"
+        by (rule element_least_not_zero_eq_HMA_JNF[OF AA' jj' ii' zero_i'])
+      have eq2: "A $$ (?i, LEAST n. A $$ (?i, n) \<noteq> 0) = A' $h i' $h (LEAST n. A' $h i' $h n \<noteq> 0)"
+        by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i'])
+      show "A' $h j' $h (LEAST n. A' $h i' $h n \<noteq> 0) \<in> residues (A' $h i' $h (LEAST n. A' $h i' $h n \<noteq> 0))"
+        using lhs eq1 eq2 ji i zero_i by fastforce
+    qed
+  next
+    assume rhs: "?rhs"
+    show "?lhs"
+    proof (safe)
+      fix i j assume i: "i < dim_row A" and zero_i: "\<not> is_zero_row_JNF i A" and ji: "j < i"
+      let ?i' = "Mod_Type.from_nat i :: 'm"
+      have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'" unfolding Mod_Type_Connect.HMA_I_def
+        using Mod_Type.to_nat_from_nat_id AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce
+      have zero_i': "\<not> is_zero_row ?i' A'" using zero_i by transfer
+      let ?j' = "Mod_Type.from_nat j :: 'm"
+      have j'i': "?j' < ?i'" using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono i ji
+        by fastforce
+      have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" unfolding Mod_Type_Connect.HMA_I_def
+        using Mod_Type.to_nat_from_nat_id[of j, where ?'a='m] AA' 
+          Mod_Type_Connect.dim_row_transfer_rule[OF AA'] j'i' i ji by auto
+      have zero_i': "\<not> is_zero_row ?i' A'" using zero_i by transfer
+      have eq1: "A $$ (j, LEAST n. A $$ (i, n) \<noteq> 0) = A' $h ?j' $h (LEAST n. A' $h ?i' $h n \<noteq> 0)"
+        by (rule element_least_not_zero_eq_HMA_JNF[OF AA' jj' ii' zero_i'])
+      have eq2: "A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) = A' $h ?i' $h (LEAST n. A' $h ?i' $h n \<noteq> 0)"
+        by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i'])
+      show "A $$ (j, LEAST n. A $$ (i, n) \<noteq> 0) \<in> residues (A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0))"
+        using rhs eq1 eq2 j'i' i zero_i' by fastforce
+    qed
+  qed
+  show "Hermite_JNF associates residues A = Hermite associates residues A'"
+    unfolding Hermite_def Hermite_JNF_def 
+    using 1 2 3 by auto
+qed
+
+
+corollary HMA_Hermite2[transfer_rule]:
+  shows "((=) ===> (=) ===> (Mod_Type_Connect.HMA_M :: _ 
+  \<Rightarrow> 'a :: {bezout_ring_div,normalization_semidom} ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)) 
+  (Hermite_JNF) (Hermite)"
+  by (simp add: HMA_Hermite rel_funI)
+
+
+text \<open>Once the definitions of both libraries are connected, we start to move the theorem about
+the uniqueness of the Hermite normal form (stated in HOL Analysis, named @{text "Hermite_unique"})
+to JNF.\<close>
+
+
+text \<open>Using the previous transfer rules, we get an statement in JNF. However, the matrices
+have @{text "CARD('n::mod_type)"} rows and columns. We want to get rid of that type variable and
+just state that they are of dimension $n \times n$ (expressed via the predicate @{text "carrier_mat"}\<close>
+
+lemma Hermite_unique_JNF':
+  fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat"
+  assumes "A \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "P \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "H \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "Q \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "K \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+  assumes "A = P * H"
+    and "A = Q * K" and "invertible_mat A" and "invertible_mat P" 
+    and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K"
+shows "H = K" 
+proof -
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: 'a ^'n :: mod_type ^'n :: mod_type)"
+  define P' where "P' = (Mod_Type_Connect.to_hma\<^sub>m P :: 'a ^'n :: mod_type ^'n :: mod_type)"
+  define H' where "H' = (Mod_Type_Connect.to_hma\<^sub>m H :: 'a ^'n :: mod_type ^'n :: mod_type)"
+  define Q' where "Q' = (Mod_Type_Connect.to_hma\<^sub>m Q :: 'a ^'n :: mod_type ^'n :: mod_type)"
+  define K' where "K' = (Mod_Type_Connect.to_hma\<^sub>m K :: 'a ^'n :: mod_type ^'n :: mod_type)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto  
+  have PP'[transfer_rule]: "Mod_Type_Connect.HMA_M P P'" unfolding Mod_Type_Connect.HMA_M_def using assms P'_def by auto
+  have HH'[transfer_rule]: "Mod_Type_Connect.HMA_M H H'" unfolding Mod_Type_Connect.HMA_M_def using assms H'_def by auto
+  have QQ'[transfer_rule]: "Mod_Type_Connect.HMA_M Q Q'" unfolding Mod_Type_Connect.HMA_M_def using assms Q'_def by auto
+  have KK'[transfer_rule]: "Mod_Type_Connect.HMA_M K K'" unfolding Mod_Type_Connect.HMA_M_def using assms K'_def by auto
+  have A_PH: "A' = P' ** H'" using assms by transfer
+  moreover have A_QK: "A' = Q' ** K'" using assms by transfer
+  moreover have inv_A: "invertible A'" using assms by transfer
+  moreover have inv_P: "invertible P'" using assms by transfer
+  moreover have inv_Q: "invertible Q'" using assms by transfer
+  moreover have H: "Hermite associates res H'" using assms by transfer
+  moreover have K: "Hermite associates res K'" using assms by transfer
+  ultimately have "H' = K'" using Hermite_unique by blast
+  thus "H=K" by transfer
+qed
+
+
+
+
+text \<open>Since the @{text "mod_type"} restriction relies on many things, the shortcut is to use 
+the @{text "mod_ring"} typedef developed in the Berlekamp-Zassenhaus development. 
+This type definition allows us to apply local type definitions easily.
+Since @{text "mod_ring"} is just an instance of @{text "mod_type"}, it is straightforward to
+obtain the following lemma, where @{text "CARD('n::mod_type)"} has now been substituted by
+@{text "CARD('n::nontriv mod_ring)"}\<close>
+
+corollary Hermite_unique_JNF_with_nontriv_mod_ring:
+  fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat"
+  assumes "A \<in> carrier_mat CARD('n) CARD('n::nontriv mod_ring)"
+    "P \<in> carrier_mat CARD('n) CARD('n)"
+    "H \<in> carrier_mat CARD('n) CARD('n)"
+    "Q \<in> carrier_mat CARD('n) CARD('n)"
+    "K \<in> carrier_mat CARD('n) CARD('n)"
+  assumes "A = P * H"
+    and "A = Q * K" and "invertible_mat A" and "invertible_mat P" 
+    and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K"
+shows "H = K" using Hermite_unique_JNF' assms by (smt CARD_mod_ring)
+
+text \<open>Now, we assume in a context that there exists a type text @{text "'b"} of cardinality $n$
+and we prove inside this context the lemma.\<close>
+
+context
+  fixes n::nat
+  assumes local_typedef: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<n :: int}"
+  and p: "n>1"
+begin
+
+private lemma type_to_set:
+  shows "class.nontriv TYPE('b)" (is ?a) and "n=CARD('b)" (is ?b)
+proof -
+  from local_typedef obtain Rep::"('b \<Rightarrow> int)" and Abs 
+    where t: "type_definition Rep Abs {0..<n :: int}" by auto
+  have "card (UNIV :: 'b set) = card {0..<n}" using t type_definition.card by fastforce
+  also have "... = n" by auto
+  finally show ?b ..
+  then show ?a unfolding class.nontriv_def using p by auto
+qed
+
+
+lemma Hermite_unique_JNF_aux:
+  fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat"
+  assumes "A \<in> carrier_mat n n"
+    "P \<in> carrier_mat n n"
+    "H \<in> carrier_mat n n"
+    "Q \<in> carrier_mat n n "
+    "K \<in> carrier_mat n n"
+  assumes "A = P * H"
+    and "A = Q * K" and "invertible_mat A" and "invertible_mat P" 
+    and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K"
+shows "H = K"
+  using Hermite_unique_JNF_with_nontriv_mod_ring[unfolded CARD_mod_ring,
+      internalize_sort "'n::nontriv", where ?'a='b]
+  unfolding type_to_set(2)[symmetric] using type_to_set(1) assms by blast
+end                     
+
+text \<open>Now, we cancel the local type definition of the previous context. 
+Since the @{text "mod_type"} restriction imposes the type to have cardinality greater than 1, 
+the cases $n=0$ and $n=1$ must be proved separately (they are trivial)\<close>
+
+lemma Hermite_unique_JNF:
+  fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat"
+  assumes A: "A \<in> carrier_mat n n" and P: "P \<in> carrier_mat n n" and H: "H \<in> carrier_mat n n"
+   and Q: "Q \<in> carrier_mat n n" and K: "K \<in> carrier_mat n n"
+ assumes A_PH: "A = P * H" and A_QK: "A = Q * K"
+   and inv_A: "invertible_mat A" and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q"
+   and HNF_H: "Hermite_JNF associates res H" and HNF_K: "Hermite_JNF associates res K"
+  shows "H = K"
+proof (cases "n=0 \<or> n=1")
+  case True note zero_or_one = True
+  show ?thesis
+  proof (cases "n=0")
+    case True
+    then show ?thesis using assms by auto
+  next
+    case False
+    have CS_A: "Complete_set_non_associates associates" using HNF_H unfolding Hermite_JNF_def by simp
+    have H: "H \<in> carrier_mat 1 1" and K: "K\<in> carrier_mat 1 1" using False zero_or_one assms by auto
+    have det_P_dvd_1: "Determinant.det P dvd 1" using invertible_iff_is_unit_JNF inv_P P by blast
+    have det_Q_dvd_1: "Determinant.det Q dvd 1" using invertible_iff_is_unit_JNF inv_Q Q by blast
+    have PH_QK: "Determinant.det P * Determinant.det H = Determinant.det Q * Determinant.det K"
+      using Determinant.det_mult assms by metis
+    hence "Determinant.det P * H $$ (0,0) = Determinant.det Q * K $$ (0,0)"
+      by (metis H K determinant_one_element)
+    obtain u where uH_K: "u * H $$(0,0) = K $$ (0,0)" and unit_u: "is_unit u"
+      by (metis (no_types, hide_lams) H K PH_QK algebraic_semidom_class.dvd_mult_unit_iff det_P_dvd_1 
+          det_Q_dvd_1 det_singleton dvdE dvd_mult_cancel_left mult.commute mult.right_neutral one_dvd)
+    have H00_not_0: "H $$ (0,0) \<noteq> 0"
+      by (metis A A_PH Determinant.det_mult False H P determinant_one_element inv_A
+          invertible_iff_is_unit_JNF mult_not_zero not_is_unit_0 zero_or_one)
+    hence LEAST_H: "(LEAST n. H $$ (0,n) \<noteq> 0) = 0" by simp
+    have H00: "H $$ (0,0) \<in> associates" using HNF_H LEAST_H H H00_not_0 
+      unfolding Hermite_JNF_def is_zero_row_JNF_def by auto
+    have K00_not_0: "K $$ (0,0) \<noteq> 0"
+      by (metis A A_QK Determinant.det_mult False K Q determinant_one_element inv_A
+          invertible_iff_is_unit_JNF mult_not_zero not_is_unit_0 zero_or_one)
+    hence LEAST_K: "(LEAST n. K $$ (0,n) \<noteq> 0) = 0" by simp
+    have K00: "K $$ (0,0) \<in> associates" using HNF_K LEAST_K K K00_not_0 
+      unfolding Hermite_JNF_def is_zero_row_JNF_def by auto
+    have ass_H00_K00: "normalize (H $$ (0,0)) = normalize (K $$ (0,0))"
+      by (metis normalize_mult_unit_left uH_K unit_u)
+    have H00_eq_K00: "H $$ (0,0) = K $$ (0,0)" 
+      using in_Ass_not_associated[OF CS_A H00 K00] ass_H00_K00 by auto
+    show ?thesis by (rule eq_matI, insert H K H00_eq_K00, auto)
+  qed
+next
+  case False
+  hence "{0..<int n} \<noteq> {}" by auto
+  moreover have "n>1" using False by simp
+  ultimately show ?thesis using Hermite_unique_JNF_aux[cancel_type_definition] assms by metis (*Cancel local type definition*)
+qed
+
+end
+
+text \<open>From here on, we apply the same approach to move the new generalized statement about
+the uniqueness Hermite normal form, i.e., the version restricted to integer matrices, but imposing
+invertibility over the rationals.\<close>
+
+(*TODO: move to Mod_Type_Connect in SNF development. 
+  There are two definitions of map_matrix, one in HMA_Connect and one in Finite_Cartesian_Product, 
+  but they are the same.*)
+lemma HMA_map_matrix [transfer_rule]: 
+  "((=) ===> Mod_Type_Connect.HMA_M ===> Mod_Type_Connect.HMA_M) map_mat map_matrix"
+  unfolding map_vector_def map_matrix_def[abs_def] map_mat_def[abs_def] 
+    Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def
+  by auto
+
+
+
+lemma Hermite_unique_generalized_JNF':
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "P \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "H \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "Q \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+    "K \<in> carrier_mat CARD('n::mod_type) CARD('n::mod_type)"
+  assumes "A = P * H"
+    and "A = Q * K" and "invertible_mat (map_mat rat_of_int A)" and "invertible_mat P" 
+    and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K"
+shows "H = K" 
+proof -
+  define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'n :: mod_type)"
+  define P' where "P' = (Mod_Type_Connect.to_hma\<^sub>m P :: int ^'n :: mod_type ^'n :: mod_type)"
+  define H' where "H' = (Mod_Type_Connect.to_hma\<^sub>m H :: int ^'n :: mod_type ^'n :: mod_type)"
+  define Q' where "Q' = (Mod_Type_Connect.to_hma\<^sub>m Q :: int ^'n :: mod_type ^'n :: mod_type)"
+  define K' where "K' = (Mod_Type_Connect.to_hma\<^sub>m K :: int ^'n :: mod_type ^'n :: mod_type)"
+  have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto  
+  have PP'[transfer_rule]: "Mod_Type_Connect.HMA_M P P'" unfolding Mod_Type_Connect.HMA_M_def using assms P'_def by auto
+  have HH'[transfer_rule]: "Mod_Type_Connect.HMA_M H H'" unfolding Mod_Type_Connect.HMA_M_def using assms H'_def by auto
+  have QQ'[transfer_rule]: "Mod_Type_Connect.HMA_M Q Q'" unfolding Mod_Type_Connect.HMA_M_def using assms Q'_def by auto
+  have KK'[transfer_rule]: "Mod_Type_Connect.HMA_M K K'" unfolding Mod_Type_Connect.HMA_M_def using assms K'_def by auto
+  have A_PH: "A' = P' ** H'" using assms by transfer
+  moreover have A_QK: "A' = Q' ** K'" using assms by transfer
+  moreover have inv_A: "invertible (map_matrix rat_of_int A')" using assms by transfer
+  moreover have "invertible (Finite_Cartesian_Product.map_matrix rat_of_int A')"
+    using inv_A unfolding Finite_Cartesian_Product.map_matrix_def map_matrix_def map_vector_def
+    by simp
+  moreover have inv_P: "invertible P'" using assms by transfer
+  moreover have inv_Q: "invertible Q'" using assms by transfer
+  moreover have H: "Hermite associates res H'" using assms by transfer
+  moreover have K: "Hermite associates res K'" using assms by transfer
+  ultimately have "H' = K'" using Hermite_unique_generalized by blast
+  thus "H=K" by transfer
+qed
+
+
+corollary Hermite_unique_generalized_JNF_with_nontriv_mod_ring:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat CARD('n) CARD('n::nontriv mod_ring)"
+    "P \<in> carrier_mat CARD('n) CARD('n)"
+    "H \<in> carrier_mat CARD('n) CARD('n)"
+    "Q \<in> carrier_mat CARD('n) CARD('n)"
+    "K \<in> carrier_mat CARD('n) CARD('n)"
+  assumes "A = P * H"
+    and "A = Q * K" and "invertible_mat (map_mat rat_of_int A)" and "invertible_mat P" 
+    and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K"
+shows "H = K" using Hermite_unique_generalized_JNF' assms by (smt CARD_mod_ring)
+
+
+
+
+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
+
+private lemma type_to_set2:
+  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
+
+
+lemma Hermite_unique_generalized_JNF_aux:
+  fixes A::"int mat"
+  assumes "A \<in> carrier_mat p p"
+    "P \<in> carrier_mat p p"
+    "H \<in> carrier_mat p p"
+    "Q \<in> carrier_mat p p"
+    "K \<in> carrier_mat p p"
+  assumes "A = P * H"
+    and "A = Q * K" and "invertible_mat (map_mat rat_of_int A)" and "invertible_mat P" 
+    and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K"
+shows "H = K"
+  using Hermite_unique_generalized_JNF_with_nontriv_mod_ring[unfolded CARD_mod_ring,
+      internalize_sort "'n::nontriv", where ?'a='b]
+  unfolding type_to_set2(2)[symmetric] using type_to_set2(1) assms by blast
+end                     
+
+
+lemma HNF_unique_generalized_JNF:
+  fixes A::"int mat"
+  assumes A: "A \<in> carrier_mat n n" and P: "P \<in> carrier_mat n n" and H: "H \<in> carrier_mat n n"
+   and Q: "Q \<in> carrier_mat n n" and K: "K \<in> carrier_mat n n"
+ assumes A_PH: "A = P * H" and A_QK: "A = Q * K"
+   and inv_A: "invertible_mat (map_mat rat_of_int A)" and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q"
+   and HNF_H: "Hermite_JNF associates res H" and HNF_K: "Hermite_JNF associates res K"
+  shows "H = K"
+proof (cases "n=0 \<or> n=1")
+  case True note zero_or_one = True
+  show ?thesis
+  proof (cases "n=0")
+    case True
+    then show ?thesis using assms by auto
+  next
+    let ?RAT = "map_mat rat_of_int"
+    case False
+    hence n: "n=1" using zero_or_one by auto
+    have CS_A: "Complete_set_non_associates associates" using HNF_H unfolding Hermite_JNF_def by simp
+    have H: "H \<in> carrier_mat 1 1" and K: "K\<in> carrier_mat 1 1" using False zero_or_one assms by auto
+    have det_P_dvd_1: "Determinant.det P dvd 1" using invertible_iff_is_unit_JNF inv_P P by blast
+    have det_Q_dvd_1: "Determinant.det Q dvd 1" using invertible_iff_is_unit_JNF inv_Q Q by blast
+    have PH_QK: "Determinant.det P * Determinant.det H = Determinant.det Q * Determinant.det K"
+      using Determinant.det_mult assms by metis
+    hence "Determinant.det P * H $$ (0,0) = Determinant.det Q * K $$ (0,0)"
+      by (metis H K determinant_one_element)
+    obtain u where uH_K: "u * H $$(0,0) = K $$ (0,0)" and unit_u: "is_unit u"
+      by (metis (no_types, hide_lams) H K PH_QK algebraic_semidom_class.dvd_mult_unit_iff det_P_dvd_1 
+          det_Q_dvd_1 det_singleton dvdE dvd_mult_cancel_left mult.commute mult.right_neutral one_dvd)
+    have H00_not_0: "H $$ (0,0) \<noteq> 0"
+    proof -      
+      have "?RAT A = ?RAT P * ?RAT H" using A_PH
+        using P H n of_int_hom.mat_hom_mult by blast
+      hence "det (?RAT H) \<noteq> 0" 
+        by (metis A Determinant.det_mult False H P inv_A invertible_iff_is_unit_JNF 
+            map_carrier_mat mult_eq_0_iff not_is_unit_0 zero_or_one)
+      thus ?thesis
+        using H determinant_one_element by force      
+    qed
+    hence LEAST_H: "(LEAST n. H $$ (0,n) \<noteq> 0) = 0" by simp
+    have H00: "H $$ (0,0) \<in> associates" using HNF_H LEAST_H H H00_not_0 
+      unfolding Hermite_JNF_def is_zero_row_JNF_def by auto
+    have K00_not_0: "K $$ (0,0) \<noteq> 0"
+    proof -
+      have "?RAT A = ?RAT Q * ?RAT K" using A_QK
+        using Q K n of_int_hom.mat_hom_mult by blast
+      hence "det (?RAT K) \<noteq> 0" 
+        by (metis A Determinant.det_mult False Q K inv_A invertible_iff_is_unit_JNF 
+            map_carrier_mat mult_eq_0_iff not_is_unit_0 zero_or_one)
+      thus ?thesis
+        using K determinant_one_element by force
+    qed
+    hence LEAST_K: "(LEAST n. K $$ (0,n) \<noteq> 0) = 0" by simp
+    have K00: "K $$ (0,0) \<in> associates" using HNF_K LEAST_K K K00_not_0 
+      unfolding Hermite_JNF_def is_zero_row_JNF_def by auto
+    have ass_H00_K00: "normalize (H $$ (0,0)) = normalize (K $$ (0,0))"
+      by (metis normalize_mult_unit_left uH_K unit_u)
+    have H00_eq_K00: "H $$ (0,0) = K $$ (0,0)" 
+      using in_Ass_not_associated[OF CS_A H00 K00] ass_H00_K00 by auto
+    show ?thesis by (rule eq_matI, insert H K H00_eq_K00, auto)
+  qed
+next
+  case False
+  hence "{0..<int n} \<noteq> {}" by auto
+  moreover have "n>1" using False by simp
+  ultimately show ?thesis 
+    using Hermite_unique_generalized_JNF_aux[cancel_type_definition] assms by metis (*Cancel local type definition*)
+qed 
+
+end
diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/document/root.tex b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/document/root.tex
new file mode 100644
--- /dev/null
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/document/root.tex
@@ -0,0 +1,66 @@
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+	
+% further packages required for unusual symbols (see also
+% isabellesym.sty), use only when needed
+
+%\usepackage{amssymb}
+  %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
+  %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
+  %\<triangleq>, \<yen>, \<lozenge>
+
+%\usepackage{eurosym}
+  %for \<euro>
+
+%\usepackage[only,bigsqcap]{stmaryrd}
+  %for \<Sqinter>
+
+%\usepackage{eufrak}
+  %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
+
+%\usepackage{textcomp}
+  %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
+  %\<currency>
+
+% this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+% for uniform font size
+%\renewcommand{\isastyle}{\isastyleminor}
+
+
+\begin{document}
+
+\title{Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation\footnote{Supported
+by FWF (Austrian Science Fund) project Y757 
+and by project MTM2017-88804-P (Spanish Ministry of Science and Innovation).}}
+%\title{Modulo arithmetic-based algorithms for lattice basis reduction and for computing the Hermite normal form}
+\author{Ralph Bottesch \and Jose Divas\'on \and Ren\'e Thiemann}
+\maketitle
+
+\begin{abstract}
+We verify two algorithms for which modular arithmetic plays an essential role: Storjohann's variant of the LLL lattice basis reduction algorithm and Kopparty's algorithm for computing the Hermite normal form of a matrix. To do this, we also formalize some facts about the modulo operation with symmetric range. Our implementations are based on the original papers, but are otherwise efficient. For basis reduction we formalize two versions: one that includes all of the optimizations/heuristics from Storjohann's paper, and one excluding a heuristic that we observed to often decrease efficiency. We also provide a fast, self-contained certifier for basis reduction, based on the efficient Hermite normal form algorithm.
+\end{abstract}
+
+\tableofcontents
+
+% sane default for proof documents
+\parindent 0pt\parskip 0.5ex
+
+% generated text of all theories
+\input{session}
+
+% optional bibliography
+%\bibliographystyle{abbrv}
+%\bibliography{root}
+
+\end{document}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
diff --git a/thys/ROOTS b/thys/ROOTS
--- a/thys/ROOTS
+++ b/thys/ROOTS
@@ -1,590 +1,591 @@
 ADS_Functor
 AI_Planning_Languages_Semantics
 AODV
 AVL-Trees
 AWN
 Abortable_Linearizable_Modules
 Abs_Int_ITP2012
 Abstract-Hoare-Logics
 Abstract-Rewriting
 Abstract_Completeness
 Abstract_Soundness
 Adaptive_State_Counting
 Affine_Arithmetic
 Aggregation_Algebras
 Akra_Bazzi
 Algebraic_Numbers
 Algebraic_VCs
 Allen_Calculus
 Amicable_Numbers
 Amortized_Complexity
 AnselmGod
 Applicative_Lifting
 Approximation_Algorithms
 Architectural_Design_Patterns
 Aristotles_Assertoric_Syllogistic
 Arith_Prog_Rel_Primes
 ArrowImpossibilityGS
 Attack_Trees
 Auto2_HOL
 Auto2_Imperative_HOL
 AutoFocus-Stream
 Automated_Stateful_Protocol_Verification
 Automatic_Refinement
 AxiomaticCategoryTheory
 BDD
 BNF_CC
 BNF_Operations
 BTree
 Banach_Steinhaus
 Bell_Numbers_Spivey
 Berlekamp_Zassenhaus
 Bernoulli
 Bertrands_Postulate
 Bicategory
 BinarySearchTree
 Binding_Syntax_Theory
 Binomial-Heaps
 Binomial-Queues
 BirdKMP
 Blue_Eyes
 Bondy
 Boolean_Expression_Checkers
 Bounded_Deducibility_Security
 Buchi_Complementation
 Budan_Fourier
 Buffons_Needle
 Buildings
 BytecodeLogicJmlTypes
 C2KA_DistributedSystems
 CAVA_Automata
 CAVA_LTL_Modelchecker
 CCS
 CISC-Kernel
 CRDT
 CYK
 CakeML
 CakeML_Codegen
 Call_Arity
 Card_Equiv_Relations
 Card_Multisets
 Card_Number_Partitions
 Card_Partitions
 Cartan_FP
 Case_Labeling
 Catalan_Numbers
 Category
 Category2
 Category3
 Cauchy
 Cayley_Hamilton
 Certification_Monads
 Chandy_Lamport
 Chord_Segments
 Circus
 Clean
 ClockSynchInst
 Closest_Pair_Points
 CofGroups
 Coinductive
 Coinductive_Languages
 Collections
 Comparison_Sort_Lower_Bound
 Compiling-Exceptions-Correctly
 Complete_Non_Orders
 Completeness
 Complex_Geometry
 Complx
 ComponentDependencies
 ConcurrentGC
 ConcurrentIMP
 Concurrent_Ref_Alg
 Concurrent_Revisions
 Consensus_Refined
 Constructive_Cryptography
 Constructor_Funs
 Containers
 CoreC++
 Core_DOM
 Core_SC_DOM
 Count_Complex_Roots
 CryptHOL
 CryptoBasedCompositionalProperties
 CSP_RefTK
 DFS_Framework
 DPT-SAT-Solver
 DataRefinementIBP
 Datatype_Order_Generator
 Decl_Sem_Fun_PL
 Decreasing-Diagrams
 Decreasing-Diagrams-II
 Deep_Learning
 Delta_System_Lemma
 Density_Compiler
 Dependent_SIFUM_Refinement
 Dependent_SIFUM_Type_Systems
 Depth-First-Search
 Derangements
 Deriving
 Descartes_Sign_Rule
 Dict_Construction
 Differential_Dynamic_Logic
 Differential_Game_Logic
 Dijkstra_Shortest_Path
 Diophantine_Eqns_Lin_Hom
 Dirichlet_L
 Dirichlet_Series
 DiscretePricing
 Discrete_Summation
 DiskPaxos
 DOM_Components
 DynamicArchitectures
 Dynamic_Tables
 E_Transcendental
 Echelon_Form
 EdmondsKarp_Maxflow
 Efficient-Mergesort
 Elliptic_Curves_Group_Law
 Encodability_Process_Calculi
 Epistemic_Logic
 Ergodic_Theory
 Error_Function
 Euler_MacLaurin
 Euler_Partition
 Example-Submission
 Extended_Finite_State_Machine_Inference
 Extended_Finite_State_Machines
 FFT
 FLP
 FOL-Fitting
 FOL_Harrison
 FOL_Seq_Calc1
 Factored_Transition_System_Bounding
 Falling_Factorial_Sum
 Farkas
 FeatherweightJava
 Featherweight_OCL
 Fermat3_4
 FileRefinement
 FinFun
 Finger-Trees
 Finite-Map-Extras
 Finite_Automata_HF
 First_Order_Terms
 First_Welfare_Theorem
 Fishburn_Impossibility
 Fisher_Yates
 Flow_Networks
 Floyd_Warshall
 Flyspeck-Tame
 FocusStreamsCaseStudies
 Forcing
 Formal_Puiseux_Series
 Formal_SSA
 Formula_Derivatives
 Fourier
 Free-Boolean-Algebra
 Free-Groups
 FunWithFunctions
 FunWithTilings
 Functional-Automata
 Functional_Ordered_Resolution_Prover
 Furstenberg_Topology
 GPU_Kernel_PL
 Gabow_SCC
 Game_Based_Crypto
 Gauss-Jordan-Elim-Fun
 Gauss_Jordan
 Gauss_Sums
 Gaussian_Integers
 GenClock
 General-Triangle
 Generalized_Counting_Sort
 Generic_Deriving
 Generic_Join
 GewirthPGCProof
 Girth_Chromatic
 GoedelGod
 Goedel_HFSet_Semantic
 Goedel_HFSet_Semanticless
 Goedel_Incompleteness
 Goodstein_Lambda
 GraphMarkingIBP
 Graph_Saturation
 Graph_Theory
 Green
 Groebner_Bases
 Groebner_Macaulay
 Gromov_Hyperbolicity
 Group-Ring-Module
 HOL-CSP
 HOLCF-Prelude
 HRB-Slicing
 Heard_Of
 Hello_World
 HereditarilyFinite
 Hermite
 Hermite_Lindemann
 Hidden_Markov_Models
 Higher_Order_Terms
 Hoare_Time
 Hood_Melville_Queue
 HotelKeyCards
 Huffman
 Hybrid_Logic
 Hybrid_Multi_Lane_Spatial_Logic
 Hybrid_Systems_VCs
 HyperCTL
 IEEE_Floating_Point
 IMAP-CRDT
 IMO2019
 IMP2
 IMP2_Binary_Heap
 IP_Addresses
 Imperative_Insertion_Sort
 Impossible_Geometry
 Incompleteness
 Incredible_Proof_Machine
 Inductive_Confidentiality
 Inductive_Inference
 InfPathElimination
 InformationFlowSlicing
 InformationFlowSlicing_Inter
 Integration
 Interpreter_Optimizations
 Interval_Arithmetic_Word32
 Iptables_Semantics
 Irrational_Series_Erdos_Straus
 Irrationality_J_Hancl
 Isabelle_C
 Isabelle_Marries_Dirac
 Isabelle_Meta_Model
 IsaGeoCoq
 Jacobson_Basic_Algebra
 Jinja
 JinjaDCI
 JinjaThreads
 JiveDataStoreModel
 Jordan_Hoelder
 Jordan_Normal_Form
 KAD
 KAT_and_DRA
 KBPs
 KD_Tree
 Key_Agreement_Strong_Adversaries
 Kleene_Algebra
 Knuth_Bendix_Order
 Knot_Theory
 Knuth_Bendix_Order
 Knuth_Morris_Pratt
 Koenigsberg_Friendship
 Kruskal
 Kuratowski_Closure_Complement
 LLL_Basis_Reduction
 LLL_Factorization
 LOFT
 LTL
 LTL_Master_Theorem
 LTL_Normal_Form
 LTL_to_DRA
 LTL_to_GBA
 Lam-ml-Normalization
 LambdaAuth
 LambdaMu
 Lambda_Free_EPO
 Lambda_Free_KBOs
 Lambda_Free_RPOs
 Lambert_W
 Landau_Symbols
 Laplace_Transform
 Latin_Square
 LatticeProperties
 Launchbury
 Laws_of_Large_Numbers
 Lazy-Lists-II
 Lazy_Case
 Lehmer
 Lifting_Definition_Option
 LightweightJava
 LinearQuantifierElim
 Linear_Inequalities
 Linear_Programming
 Linear_Recurrences
 Liouville_Numbers
 List-Index
 List-Infinite
 List_Interleaving
 List_Inversions
 List_Update
 LocalLexing
 Localization_Ring
 Locally-Nameless-Sigma
 Lowe_Ontological_Argument
 Lower_Semicontinuous
 Lp
 Lucas_Theorem
 MFMC_Countable
 MFODL_Monitor_Optimized
 MFOTL_Monitor
 MSO_Regex_Equivalence
 Markov_Models
 Marriage
 Mason_Stothers
 Matrices_for_ODEs
 Matrix
 Matrix_Tensor
 Matroids
 Max-Card-Matching
 Median_Of_Medians_Selection
 Menger
 Mereology
 Mersenne_Primes
 MiniML
 Minimal_SSA
 Minkowskis_Theorem
 Minsky_Machines
 Modal_Logics_for_NTS
+Modular_arithmetic_LLL_and_HNF_algorithms
 Modular_Assembly_Kit_Security
 Monad_Memo_DP
 Monad_Normalisation
 MonoBoolTranAlgebra
 MonoidalCategory
 Monomorphic_Monad
 MuchAdoAboutTwo
 Multi_Party_Computation
 Multirelations
 Myhill-Nerode
 Name_Carrying_Type_Inference
 Nash_Williams
 Nat-Interval-Logic
 Native_Word
 Nested_Multisets_Ordinals
 Network_Security_Policy_Verification
 Neumann_Morgenstern_Utility
 No_FTL_observers
 Nominal2
 Noninterference_CSP
 Noninterference_Concurrent_Composition
 Noninterference_Generic_Unwinding
 Noninterference_Inductive_Unwinding
 Noninterference_Ipurge_Unwinding
 Noninterference_Sequential_Composition
 NormByEval
 Nullstellensatz
 Octonions
 OpSets
 Open_Induction
 Optics
 Optimal_BST
 Orbit_Stabiliser
 Order_Lattice_Props
 Ordered_Resolution_Prover
 Ordinal
 Ordinal_Partitions
 Ordinals_and_Cardinals
 Ordinary_Differential_Equations
 PAC_Checker
 PCF
 PLM
 POPLmark-deBruijn
 PSemigroupsConvolution
 Pairing_Heap
 Paraconsistency
 Parity_Game
 Partial_Function_MR
 Partial_Order_Reduction
 Password_Authentication_Protocol
 Pell
 Perfect-Number-Thm
 Perron_Frobenius
 Physical_Quantities
 Pi_Calculus
 Pi_Transcendental
 Planarity_Certificates
 Poincare_Bendixson
 Poincare_Disc
 Polynomial_Factorization
 Polynomial_Interpolation
 Polynomials
 Pop_Refinement
 Posix-Lexing
 Possibilistic_Noninterference
 Power_Sum_Polynomials
 Pratt_Certificate
 Presburger-Automata
 Prim_Dijkstra_Simple
 Prime_Distribution_Elementary
 Prime_Harmonic_Series
 Prime_Number_Theorem
 Priority_Queue_Braun
 Priority_Search_Trees
 Probabilistic_Noninterference
 Probabilistic_Prime_Tests
 Probabilistic_System_Zoo
 Probabilistic_Timed_Automata
 Probabilistic_While
 Program-Conflict-Analysis
 Projective_Geometry
 Projective_Measurements
 Promela
 Proof_Strategy_Language
 PropResPI
 Propositional_Proof_Systems
 Prpu_Maxflow
 PseudoHoops
 Psi_Calculi
 Ptolemys_Theorem
 QHLProver
 QR_Decomposition
 Quantales
 Quaternions
 Quick_Sort_Cost
 RIPEMD-160-SPARK
 ROBDD
 RSAPSS
 Ramsey-Infinite
 Random_BSTs
 Random_Graph_Subgraph_Threshold
 Randomised_BSTs
 Randomised_Social_Choice
 Rank_Nullity_Theorem
 Real_Impl
 Recursion-Addition
 Recursion-Theory-I
 Refine_Imperative_HOL
 Refine_Monadic
 RefinementReactive
 Regex_Equivalence
 Regular-Sets
 Regular_Algebras
 Relation_Algebra
 Relational-Incorrectness-Logic
 Relational_Disjoint_Set_Forests
 Relational_Method
 Relational_Minimum_Spanning_Trees
 Relational_Paths
 Rep_Fin_Groups
 Residuated_Lattices
 Resolution_FOL
 Rewriting_Z
 Ribbon_Proofs
 Robbins-Conjecture
 Robinson_Arithmetic
 Root_Balanced_Tree
 Routing
 Roy_Floyd_Warshall
 SATSolverVerification
 SC_DOM_Components
 SDS_Impossibility
 SIFPL
 SIFUM_Type_Systems
 SPARCv8
 Safe_Distance
 Safe_OCL
 Saturation_Framework
 Saturation_Framework_Extensions
 Shadow_DOM
 Secondary_Sylow
 Security_Protocol_Refinement
 Selection_Heap_Sort
 SenSocialChoice
 Separata
 Separation_Algebra
 Separation_Logic_Imperative_HOL
 SequentInvertibility
 Shadow_SC_DOM
 Shivers-CFA
 ShortestPath
 Show
 Sigma_Commit_Crypto
 Signature_Groebner
 Simpl
 Simple_Firewall
 Simplex
 Skew_Heap
 Skip_Lists
 Slicing
 Sliding_Window_Algorithm
 Smith_Normal_Form
 Smooth_Manifolds
 Sort_Encodings
 Source_Coding_Theorem
 Special_Function_Bounds
 Splay_Tree
 Sqrt_Babylonian
 Stable_Matching
 Statecharts
 Stateful_Protocol_Composition_and_Typing
 Stellar_Quorums
 Stern_Brocot
 Stewart_Apollonius
 Stirling_Formula
 Stochastic_Matrices
 Stone_Algebras
 Stone_Kleene_Relation_Algebras
 Stone_Relation_Algebras
 Store_Buffer_Reduction
 Stream-Fusion
 Stream_Fusion_Code
 Strong_Security
 Sturm_Sequences
 Sturm_Tarski
 Stuttering_Equivalence
 Subresultants
 Subset_Boolean_Algebras
 SumSquares
 Sunflowers
 SuperCalc
 Surprise_Paradox
 Symmetric_Polynomials
 Syntax_Independent_Logic
 Szpilrajn
 TESL_Language
 TLA
 Tail_Recursive_Functions
 Tarskis_Geometry
 Taylor_Models
 Timed_Automata
 Topological_Semantics
 Topology
 TortoiseHare
 Transcendence_Series_Hancl_Rucki
 Transformer_Semantics
 Transition_Systems_and_Automata
 Transitive-Closure
 Transitive-Closure-II
 Treaps
 Tree-Automata
 Tree_Decomposition
 Triangle
 Trie
 Twelvefold_Way
 Tycon
 Types_Tableaus_and_Goedels_God
 UPF
 UPF_Firewall
 UTP
 Universal_Turing_Machine
 UpDown_Scheme
 Valuation
 VectorSpace
 VeriComp
 Verified-Prover
 Verified_SAT_Based_AI_Planning
 VerifyThis2018
 VerifyThis2019
 Vickrey_Clarke_Groves
 VolpanoSmith
 WHATandWHERE_Security
 WOOT_Strong_Eventual_Consistency
 WebAssembly
 Weight_Balanced_Trees
 Well_Quasi_Orders
 Winding_Number_Eval
 Word_Lib
 WorkerWrapper
 XML
 ZFC_in_HOL
 Zeta_3_Irrational
 Zeta_Function
 pGCL