Theory HNF_Mod_Det_Soundness
subsection ‹Soundness of the algorithm›
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 ‹Results connecting lattices and Hermite normal form›
text ‹The following results will also be useful for proving the soundness of the certification
approach.›
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
= (∀A. let (P,H) = algorithm A; m = dim_row A; n = dim_col A in
P ∈ carrier_mat m m ∧ H ∈ carrier_mat m n ∧ invertible_mat P ∧ A = P * H
∧ 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 ∈ carrier_mat n n" and inv_A: "invertible_mat A"
and inv_P: "invertible_mat P" and P: "P ∈ 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 ∈ carrier_mat n n"
using P inv_P obtain_inverse_matrix by blast
have P1: "P1 ∈ 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 ∈ 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 (verit) 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 H1 P1 inv_P by fastforce
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 (verit) 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 ∈ 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 ∈ carrier_mat n n"
by (smt (verit) A P2_H2 carrier_matD(1) is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
show "H2 ∈ carrier_mat n n"
by (smt (verit) 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 (verit) P2_H2 is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
show "Hermite_JNF associates res H1"
by (smt (verit) P1_H1 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
show "Hermite_JNF associates res H2"
by (smt (verit) 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 ⊆ carrier_vec n"
and gs: "set gs ⊆ carrier_vec n"
and P: "P ∈ 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 ⊆ 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 ∈ 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 (verit) 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 ⊆ 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 ⊆ 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 ∈ 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) ⊆ carrier_vec n" using H rows_carrier by blast
show "P ∈ 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
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"
and gs: "set gs ⊆ carrier_vec n" and len_gs: "length gs = m"
shows "lattice_of gs = lattice_of fs_init" "LLL_with_assms n m gs α"
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 ∈ 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 ∈ carrier_mat m m"
using P2 invertible_P2 obtain_inverse_matrix by blast
have P1: "P1 ∈ 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 ∈ 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 ∈ 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 (verit) P2_H2 sound_HNF case_prodD is_sound_HNF_def)
have P1_H1_fs: "P1 * H1 = mat_of_rows n fs_init"
by (smt (verit) 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 ∈ carrier_mat m m"
using P1 invertible_P1 obtain_inverse_matrix by blast
show "LLL_with_assms n m gs α"
proof (rule LLL_change_basis(2)[OF gs len_gs])
show "P1 * inv_P2 ∈ 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 (verit) 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 ‹P1 * inv_P2 ∈ carrier_mat m m› assoc_mult_mat by blast
also have "... = P1 * (inv_P2 * P2 * H2)"
by (metis H2 ‹P1 * H1 = P1 * inv_P2 * P2 * H1› ‹P1 * inv_P2 * P2 * H2 = P1 * inv_P2 * (P2 * H2)›
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 ‹P1 * (inv_P2 * P2 * H2) = P1 * (inv_P2 * (P2 * H2))›
‹P1 * inv_P2 * (P2 * H2) = P1 * (inv_P2 * P2 * H2)› by auto
finally show "mat_of_rows n fs_init = P1 * inv_P2 * mat_of_rows n gs" .
show "P2 * inv_P1 ∈ 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 (verit) 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 ‹P2 * inv_P1 ∈ carrier_mat m m› assoc_mult_mat by blast
also have "... = P2 * (inv_P1 * P1 * H1)"
by (metis H2 ‹P2 * H2 = P2 * inv_P1 * P1 * H2› ‹P2 * inv_P1 * P1 * H1 = P2 * inv_P1 * (P1 * H1)›
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 ‹P2 * (inv_P1 * P1 * H1) = P2 * (inv_P1 * (P1 * H1))›
‹P2 * inv_P1 * (P1 * H1) = P2 * (inv_P1 * P1 * H1)› by auto
finally show "mat_of_rows n gs = P2 * inv_P1 * mat_of_rows n fs_init" .
qed
qed
end
text ‹Now, we need to generalize some lemmas.›
context vec_module
begin
lemma finsum_index:
assumes i: "i < n"
and f: "f ∈ A → carrier_vec n"
and A: "A ⊆ carrier_vec n"
shows "finsum V f A $ i = sum (λ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 ∉ X"
and x: "x ∈ carrier_vec n"
and X: "X ⊆ carrier_vec n"
and fx: "f x ∈ carrier_vec n"
and f: "f ∈ X → 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)
lemma mat_of_rows_mult_as_finsum:
assumes "v ∈ carrier_vec (length lst)" "⋀ i. i < length lst ⟹ lst ! i ∈ carrier_vec n"
defines "f l ≡ sum (λ 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 *⇩v v = lincomb f (set lst)"
proof -
from assms have "∀ i < length lst. lst ! i ∈ carrier_vec n" by blast
note an = all_nth_imp_all_set[OF this] hence slc:"set lst ⊆ carrier_vec n" by auto
hence dn [simp]:"⋀ x. x ∈ set lst ⟹ 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 *⇩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:"(λv. f v ⋅⇩v v) ∈ set lst → carrier_vec n" by auto
from i' have "(mat_of_cols n lst *⇩v v) $ i = row (mat_of_cols n lst) i ∙ v" by auto
also have "… = (∑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 "… = (∑ia = 0..<length lst. lst ! ia $ i * v $ ia)" using assms(1) by auto
also have "… = (∑x∈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 "… = (∑x∈set lst. (f x ⋅⇩v x) $ i)"
apply(rule sum.cong[OF refl],subst index_smult_vec) using i slc by auto
also have "… = (⨁⇘V⇙v∈set lst. f v ⋅⇩v v) $ i"
unfolding finsum_index[OF i' fcarr slc] by auto
finally show "(mat_of_cols n lst *⇩v v) $ i = lincomb f (set lst) $ i"
by (auto simp:lincomb_def)
qed
qed
lemma lattice_of_altdef_lincomb:
assumes "set fs ⊆ carrier_vec n"
shows "lattice_of fs = {y. ∃f. lincomb (of_int ∘ f) (set fs) = y}"
unfolding lincomb_def lattice_of_altdef[OF assms] image_def by auto
end
context vec_module
begin
lemma lincomb_as_lincomb_list:
fixes ws f
assumes s: "set ws ⊆ carrier_vec n"
shows "lincomb f (set ws) = lincomb_list (λi. if ∃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 = "λi. if ∃j<i. ws ! i = ws ! j then 0 else f (ws ! i)"
let ?g = "λi. (if ∃j<i. (ws @ [a]) ! i = (ws @ [a]) ! j then 0 else f ((ws @ [a]) ! i)) ⋅⇩v (ws @ [a]) ! i"
let ?g2= "(λi. (if ∃j<i. ws ! i = ws ! j then 0 else f (ws ! i)) ⋅⇩v ws ! i)"
have [simp]: "⋀v. v ∈ set ws ⟹ v ∈ carrier_vec n" using snoc.prems(1) by auto
then have ws: "set ws ⊆ 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∈set ws")
case True
have g_length: "?g (length ws) = 0⇩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⇩v n]" using g_length by simp
finally have map_rw: "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [0⇩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⇩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⇩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⇩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 ⋅⇩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 ⋅⇩v a)]" using g_length by simp
finally have map_rw: "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [(f a ⋅⇩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 "... = (⨁⇘V⇙v∈set (a # ws). f v ⋅⇩v v)" unfolding lincomb_def ..
also have "... = (⨁⇘V⇙v∈ insert a (set ws). f v ⋅⇩v v)" by simp
also have "... = (f a ⋅⇩v a) + (⨁⇘V⇙v∈ (set ws). f v ⋅⇩v v)"
proof (rule finsum_insert)
show "finite (set ws)" by auto
show "a ∉ set ws" using False by auto
show "(λv. f v ⋅⇩v v) ∈ set ws → carrier_vec n"
using snoc.prems(1) by auto
show "f a ⋅⇩v a ∈ carrier_vec n" using snoc.prems by auto
qed
also have "... = (f a ⋅⇩v a) + lincomb f (set ws)" unfolding lincomb_def ..
also have "... = (f a ⋅⇩v a) + lincomb_list ?f ws" using hyp by auto
also have "... = lincomb_list ?f ws + (f a ⋅⇩v a)"
using M.add.m_comm lincomb_list_carrier snoc.prems by auto
also have "... = lincomb_list (λi. if ∃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]) ⊆ carrier_vec n" using snoc.prems
by (auto simp add: nth_append)
show "f a ⋅⇩v a ∈ 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 ∈ carrier_mat n nc"
shows "lattice_of (cols A) = {y∈carrier_vec (dim_row A). ∃x∈carrier_vec (dim_col A). A *⇩v x = y}"
proof -
let ?ws = "cols A"
have set_cols_in: "set (cols A) ⊆ carrier_vec n" using A unfolding cols_def by auto
have "lincomb (of_int ∘ f)(set ?ws) ∈ carrier_vec (dim_row A)" for f
using lincomb_closed A
by (metis (full_types) carrier_matD(1) cols_dim lincomb_closed)
moreover have "∃x∈carrier_vec (dim_col A). A *⇩v x = lincomb (of_int ∘ f) (set (cols A))" for f
proof -
let ?g = "(λv. of_int (f v))"
let ?g' = "(λi. if ∃j<i. ?ws ! i = ?ws ! j then 0 else ?g (?ws ! i))"
have "lincomb (of_int ∘ 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 *⇩v vec (length ?ws) ?g'"
by (rule lincomb_list_as_mat_mult, insert set_cols_in A, auto)
also have "... = A *⇩v (vec (length ?ws) ?g')" using mat_of_cols_cols A by auto
finally show ?thesis by auto
qed
moreover have "∃f. A *⇩v x = lincomb (of_int ∘ f) (set (cols A))"
if Ax: "A *⇩v x ∈ carrier_vec (dim_row A)" and x: "x ∈ carrier_vec (dim_col A)" for x
proof -
let ?c = "λi. x $ i"
have x_vec: "vec (length ?ws) ?c = x" using x by auto
have "A *⇩v x = mat_of_cols n ?ws *⇩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, opaque_lifting))
qed
corollary lattice_of_as_mat_mult:
assumes fs: "set fs ⊆ carrier_vec n"
shows "lattice_of fs = {y∈carrier_vec n. ∃x∈carrier_vec (length fs). (mat_of_cols n fs) *⇩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) ∈ 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 ∈ carrier_mat n n" and li: "lin_indpt (set (cols A))" and d: "distinct (cols A)"
shows "det A ≠ 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 ∈ carrier_mat n n" and li: "lin_indpt (set (rows A))" and d: "distinct (rows A)"
shows "det A ≠ 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 ⊆ carrier_vec n"
and gs: "set gs ⊆ carrier_vec n" and ind_fs: "lin_indep fs"
and length_fs: "length fs = n" and length_gs: "length gs = n"
and l: "lattice_of fs = lattice_of gs"
shows "∃Q ∈ carrier_mat n n. invertible_mat Q ∧ mat_of_cols n fs = mat_of_cols n gs * Q"
proof (cases "n=0")
case True
show ?thesis
by (rule bexI[of _ "1⇩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 ∈ carrier_mat n n" by (simp add: length_fs carrier_matI)
let ?f = "(λi. SOME x. x∈carrier_vec (length gs) ∧ (mat_of_cols n gs) *⇩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 ∈ 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 ∈ lattice_of gs" using fs l basis_in_latticeI j by auto
have fs_j_carrier_vec: "fs ! j ∈ carrier_vec n"
using fs_j_in_gs gs lattice_of_as_mat_mult by blast
let ?x = "SOME x. x∈carrier_vec (length gs) ∧ (mat_of_cols n gs) *⇩v x = fs ! j"
have "?x∈carrier_vec (length gs) ∧ (mat_of_cols n gs) *⇩v ?x = fs ! j"
by (rule someI_ex, insert fs_j_in_gs lattice_of_as_mat_mult[OF gs], auto)
hence x: "?x ∈ carrier_vec (length gs)"
and gs_x: "(mat_of_cols n gs) *⇩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 "... ∈ carrier_vec n" using x length_gs by auto
finally show "map ?f [0..<length fs] ! j ∈ 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) *⇩v ?x" using gs_x by auto
also have "... = (mat_of_cols n gs) *⇩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"
proof -
let ?f' = "(λi. SOME x. x∈carrier_vec (length fs) ∧ (mat_of_cols n fs) *⇩v x = gs ! i)"
let ?cols_Q' = "map ?f' [0..<length gs]"
let ?Q' = "mat_of_cols n ?cols_Q'"
have Q': "?Q' ∈ 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 ∈ lattice_of fs" using gs l basis_in_latticeI j by auto
have gs_j_carrier_vec: "gs ! j ∈ carrier_vec n"
using gs_j_in_fs fs lattice_of_as_mat_mult by blast
let ?x = "SOME x. x∈carrier_vec (length fs) ∧ (mat_of_cols n fs) *⇩v x = gs ! j"
have "?x∈carrier_vec (length fs) ∧ (mat_of_cols n fs) *⇩v ?x = gs ! j"
by (rule someI_ex, insert gs_j_in_fs lattice_of_as_mat_mult[OF fs], auto)
hence x: "?x ∈ carrier_vec (length fs)"
and fs_x: "(mat_of_cols n fs) *⇩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 "... ∈ carrier_vec n" using x length_fs by auto
finally show "map ?f' [0..<length gs] ! j ∈ 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) *⇩v ?x" using fs_x by auto
also have "... = (mat_of_cols n fs) *⇩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)) ≠ 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 ≠ 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 ∈ 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 ∈ 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⇩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⇩m n"
using fs_carrier by auto
also have "... = mat_of_cols n fs * (?Q' * ?Q) - mat_of_cols n fs * 1⇩m n"
using Q Q' fs_carrier by auto
also have "... = mat_of_cols n fs * (?Q' * ?Q - 1⇩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⇩m n) = 0⇩m n n" ..
have "det (?Q' * ?Q) = 1"
by (smt (verit) 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 ∨ 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 ⊆ carrier_vec n"
and gs: "set gs ⊆ carrier_vec n" and ind_fs: "lin_indep fs"
and length_fs: "length fs = n" and length_gs: "length gs = n"
and l: "lattice_of fs = lattice_of gs"
shows "∃P ∈ carrier_mat n n. invertible_mat P ∧ mat_of_rows n fs = P * mat_of_rows n gs"
proof -
obtain Q where Q: "Q ∈ 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⇧T" by (simp add: inv_Q invertible_mat_transpose)
moreover have "mat_of_rows n fs = Q⇧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⇧T ∈ carrier_mat n n" using Q by auto
ultimately show ?thesis by blast
qed
end
subsubsection ‹Missing results›
text ‹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.›
definition "upper_triangular' A = (∀i < dim_row A. ∀ j<dim_col A. j < i ⟶ A $$ (i,j) = 0)"
lemma upper_triangular'D[elim] :
"upper_triangular' A ⟹ j<dim_col A ⟹ j < i ⟹ i < dim_row A ⟹ A $$ (i,j) = 0"
unfolding upper_triangular'_def by auto
lemma upper_triangular'I[intro] :
"(⋀i j. j<dim_col A ⟹ j < i ⟹ i < dim_row A ⟹ A $$ (i,j) = 0) ⟹ upper_triangular' A"
unfolding upper_triangular'_def by auto
lemma prod_list_abs:
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 (λ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 = (λ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 ‹Results about appending rows›
lemma row_append_rows1:
assumes A: "A ∈ carrier_mat m n"
and B: "B ∈ carrier_mat p n"
assumes i: "i < dim_row A"
shows "Matrix.row (A @⇩r B) i = Matrix.row A i"
proof (rule eq_vecI)
have AB_carrier[simp]: "(A @⇩r B) ∈ carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B])
thus "dim_vec (Matrix.row (A @⇩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 @⇩r B) i $v j = (A @⇩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 @⇩r B) i $v j = Matrix.row A i $v j" using i j by simp
qed
lemma row_append_rows2:
assumes A: "A ∈ carrier_mat m n"
and B: "B ∈ carrier_mat p n"
assumes i: "i ∈ {m..<m+p}"
shows "Matrix.row (A @⇩r B) i = Matrix.row B (i - m)"
proof (rule eq_vecI)
have AB_carrier[simp]: "(A @⇩r B) ∈ carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B])
thus "dim_vec (Matrix.row (A @⇩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 @⇩r B) i $v j = (A @⇩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 @⇩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 ∈ carrier_mat m n"
and B: "B ∈ carrier_mat p n"
shows "Matrix.rows (A @⇩r B) = Matrix.rows A @ Matrix.rows B"
proof -
have AB_carrier: "(A @⇩r B) ∈ carrier_mat (m+p) n"
by (rule carrier_append_rows, insert A B, auto)
hence 1: "dim_row (A @⇩r B) = dim_row A + dim_row B" using A B by blast
moreover have "Matrix.row (A @⇩r B) i = (Matrix.rows A @ Matrix.rows B) ! i"
if i: "i < dim_row (A @⇩r B)" for i
proof (cases "i<dim_row A")
case True
have "Matrix.row (A @⇩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 @⇩r B) i = Matrix.row B (i-m)" using A False B i row_append_rows2 i_mp
by (smt (verit) 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' ∈ carrier_mat m n"
and B: "B ∈ carrier_mat p n"
and A_def: "A = (A' @⇩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' ∈ carrier_mat m n"
and B: "B ∈ carrier_mat p n"
and A_def: "A = (A' @⇩r B)"
and a: "a≥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 ‹Results about submatrices›
lemma pick_first_id: assumes i: "i<n" shows "pick {0..<n} i = i"
proof -
have "i = (card {a ∈ {0..<n}. a < i})" using i
by (auto, smt (verit) 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 ∈ carrier_mat m n" and i: "i<k1" and j: "j<k2"
and k1: "k1≤m" and k2: "k2≤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≤m" and kn: "k2≤n" using k1 k2 by simp+
then have "{i. i < m ∧ i < k1} = {..<k1}" "{i. i < n ∧ i < k2} = {..<k2}" by auto
then have card_mk: "card {i. i < m ∧ i < k1} = k1" and card_nk: "card {i. i < n ∧ i < k2} = k2"
by auto
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 ∈ carrier_mat m n"
and k1: "k1 ≤ m" and k2: "k2 ≤ n"
shows"submatrix H {0..<k1} {0..<k2} ∈ carrier_mat k1 k2"
proof -
have km: "k1≤m" and kn: "k2≤n" using k1 k2 by simp+
then have "{i. i < m ∧ i < k1} = {..<k1}" "{i. i < n ∧ i < k2} = {..<k2}" by auto
then have card_mk: "card {i. i < m ∧ i < k1} = k1" and card_nk: "card {i. i < n ∧ i < k2} = k2"
by auto
show ?thesis
by (smt (verit) 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 ∈ carrier_mat n n"
shows "A ∈ 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⇩m n" and BA: "B * A = 1⇩m n" and B: "B ∈ carrier_mat n n"
by (metis assms carrier_matD(1) inverts_mat_def obtain_inverse_matrix)
hence "∃x∈carrier (ring_mat TYPE('a) n b). x ⊗⇘ring_mat TYPE('a) n b⇙ A = 𝟭⇘ring_mat TYPE('a) n b⇙
∧ A ⊗⇘ring_mat TYPE('a) n b⇙ x = 𝟭⇘ring_mat TYPE('a) n b⇙"
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 ∈ carrier_mat M n" and "m ≤ 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 ∈ carrier_mat (m+p) n" and B: "B ∈ carrier_mat p n"
and eq: "∀i∈{m..<m+p}.∀j<n. A$$(i,j) = B $$ (i-m,j)"
shows "A = mat_of_rows n [Matrix.row A i. i ← [0..<m]] @⇩r B" (is "_ = ?A' @⇩r _")
proof (rule eq_matI)
have A': "?A' ∈ carrier_mat m n" by (simp add: mat_of_rows_def)
hence A'B: "?A' @⇩r B ∈ carrier_mat (m+p) n" using B by blast
show "dim_row A = dim_row (?A' @⇩r B)" and "dim_col A = dim_col (?A' @⇩r B)" using A'B A by auto
fix i j assume i: "i < dim_row (?A' @⇩r B)"
and j: "j < dim_col (?A' @⇩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' @⇩r B) $$ (i, j)"
proof (cases "i<m")
case True
have "(?A' @⇩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' @⇩r B) $$ (i, j) = B $$ (i-m,j)"
by (smt (verit) 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 ∈ carrier_mat n n" and inv_A: "invertible_mat A" and n0: "0<n"
shows "col A 0 ≠ (0⇩v n)"
proof (rule ccontr)
assume " ¬ col A 0 ≠ 0⇩v n" hence col_A0: "col A 0 = 0⇩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 ≠ 0" by auto
have "det A = (∑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 ∈ carrier_mat n n"
and "B ∈ 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, opaque_lifting) 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 "(∀i<dim_row A. is_zero_row_JNF i A ⟶ ¬ (∃j. j < dim_row A ∧ j>i ∧ ¬ is_zero_row_JNF j A))"
and "(∀i j. i<j ∧ j<dim_row A ∧ ¬ (is_zero_row_JNF i A) ∧ ¬ (is_zero_row_JNF j A)
⟶ ((LEAST n. A $$ (i, n) ≠ 0) < (LEAST n. A $$ (j, n) ≠ 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 ∈ carrier_mat m n"
and k: "k ≤ 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≤m" and kn: "k≤n" using k by simp+
then have "{i. i < m ∧ i < k} = {..<k}" "{i. i < n ∧ i < k} = {..<k}" by auto
then have card_mk: "card {i. i < m ∧ i < k} = k" and card_nk: "card {i. i < n ∧ i < k} = k"
by auto
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 ∈ 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': "¬ is_zero_row_JNF j ?H"
define a where "a = (LEAST n. ?H $$ (j,n) ≠ 0)"
have H'_ja: "?H $$ (j,a) ≠ 0"
by (metis (mono_tags) LeastI j_not0_H' a_def is_zero_row_JNF_def)
have a: "a < dim_col ?H"
by (smt (verit) j_not0_H' a_def is_zero_row_JNF_def linorder_neqE_nat not_less_Least order_trans_rules(19))
have j_not0_H: "¬ 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: "¬ is_zero_row_JNF i H" using ef_H j ij unfolding echelon_form_JNF_def
by (metis H' ‹¬ is_zero_row_JNF j H› 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) ≠ 0) < (LEAST n. H $$ (j, n) ≠ 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) ≠ 0)"
have H_ib: "H $$ (i, b) ≠ 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) ≠ 0" using H_ib b H_ij H' ij j
by (metis H' carrier_matD dual_order.strict_trans ij j)
hence "¬ 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': "¬ is_zero_row_JNF i ?H"
and not0_jH': "¬ is_zero_row_JNF j ?H"
define a where "a = (LEAST n. ?H $$ (i, n) ≠ 0)"
define b where "b = (LEAST n. ?H $$ (j, n) ≠ 0)"
have H'_ia: "?H $$ (i,a) ≠ 0"
by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH')
have H'_jb: "?H $$ (j,b) ≠ 0"
by (metis (mono_tags) LeastI_ex b_def is_zero_row_JNF_def not0_jH')
have a: "a < dim_row ?H"
by (smt (verit) 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 (verit) 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) ≠ 0)"
by (smt (verit) 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) ≠ 0)"
by (smt (verit) 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: "¬ 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: "¬ 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) ≠ 0) < (LEAST n. ?H $$ (j, n) ≠ 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 ∈ carrier_mat m n"
and k: "k ≤ 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≤m" and kn: "k≤n" using k by simp+
then have "{i. i < m ∧ i < k} = {..<k}" "{i. i < n ∧ i < k} = {..<k}" by auto
then have card_mk: "card {i. i < m ∧ i < k} = k" and card_nk: "card {i. i < n ∧ i < k} = k"
by auto
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 ∈ 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) ≠ 0) ∈ associates"
and HNF2: "(∀j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) ≠ 0)
∈ res (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0)))"
if i: "i<dim_row ?H" and not0_iH': "¬ is_zero_row_JNF i ?H" for i
proof -
define a where "a = (LEAST n. ?H $$ (i, n) ≠ 0)"
have im: "i<m"
by (metis H' carrier_matD(1) km order.strict_trans2 that(1))
have H'_ia: "?H $$ (i,a) ≠ 0"
by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH')
have a: "a < dim_row ?H"
by (smt (verit) 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) ≠ 0)"
by (smt (verit) 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: "¬ 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) ≠ 0) ∈ associates" using im
by (metis H'_ia_H_ia Hermite_JNF_def a_def a_eq HNF_H H carrier_matD(1))
show "(∀j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) ≠ 0)
∈ res (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0)))"
proof -
{ fix nn :: nat
have ff1: "∀n. ?H $$ (n, a) = H $$ (n, a) ∨ ¬ 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) ∈ res (H $$ (i, a)) ⟶ H $$ (nn, a) ∈ res (?H $$ (i, a))"
using ff1 by (metis (no_types))
moreover
{ assume "H $$ (nn, a) ∈ res (?H $$ (i, a))"
then have "?H $$ (nn, a) = H $$ (nn, a) ⟶ ?H $$ (nn, a) ∈ res (?H $$ (i, a))"
by presburger
then have "¬ nn < i ∨ ?H $$ (nn, LEAST n. ?H $$ (i, n) ≠ 0) ∈ res (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0))"
using ff2 ff1 a_def order.strict_trans by blast }
ultimately have "¬ nn < i ∨ ?H $$ (nn, LEAST n. ?H $$ (i, n) ≠ 0) ∈ res (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 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 ∈ carrier_mat n n"
and H_P1_H1: "H = P1 * H1"
and inv_P1: "invertible_mat P1"
and H1: "H1 ∈ carrier_mat n n"
and P1: "P1 ∈ 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⇩m n) * H" using H by auto
qed (insert assms, auto)
context
fixes n :: nat
begin
interpretation vec_module "TYPE(int)" .
lemma lattice_is_monotone:
fixes S T
assumes S: "set S ⊆ carrier_vec n"
assumes T: "set T ⊆ carrier_vec n"
assumes subs: "set S ⊆ set T"
shows "lattice_of S ⊆ lattice_of T"
proof -
have "∃fa. lincomb fa (set T) = lincomb f (set S)" for f
proof -
let ?f = "λi. if i ∈ set T - set S then 0 else f i"
have set_T_eq: "set T = set S ∪ (set T - set S)" using subs by blast
have l0: "lincomb ?f (set T - set S) = 0⇩v n" by (rule lincomb_zero, insert T, auto)
have "lincomb ?f (set T) = lincomb ?f (set S ∪ (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 ⊆ carrier_vec n"
assumes gs: "set gs ⊆ carrier_vec n"
shows "lattice_of (fs @ gs) = lattice_of (gs @ fs)"
proof -
have fsgs: "set (fs @ gs) ⊆ carrier_vec n" using fs gs by auto
have gsfs: "set (gs @ fs) ⊆ 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 ⊆ carrier_vec n" and v: "v ∈ carrier_vec n"
shows "lattice_of (v # fs) = lattice_of (fs @ [v])"
proof -
have v_fs: "set (v # fs) ⊆ carrier_vec n" using fs v by auto
hence fs_v: "set (fs @ [v]) ⊆ 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 ⊆ carrier_vec n" and inlattice: "v ∈ lattice_of fs"
and v: "v ∈ carrier_vec n"
shows "lattice_of (v # fs) ⊆ lattice_of fs"
proof (cases "v∈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) ⊆ carrier_vec n" using v fs by auto
have "∃fa. lincomb fa (set fs) = lincomb f (insert v (set fs))" for f
proof -
have smult_rw: "f v ⋅⇩v (lincomb g (set fs)) = lincomb (λw. f v * g w) (set fs)"
by (rule lincomb_smult[symmetric, OF fs])
have "lincomb f (insert v (set fs)) = f v ⋅⇩v v + lincomb f (set fs)"
by (rule lincomb_insert2[OF _ fs _ v_notin_fs v], auto)
also have "... = f v ⋅⇩v (lincomb g (set fs)) + lincomb f (set fs)" using v_g by simp
also have "... = lincomb (λw. f v * g w) (set fs) + lincomb f (set fs)"
unfolding smult_rw by auto
also have "... = lincomb (λw. (λ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 ⊆ carrier_vec n" and inlattice: "v ∈ lattice_of fs"
and v: "v ∈ carrier_vec n"
shows "lattice_of fs = lattice_of (v # fs)"
proof -
have dir1: "lattice_of fs ⊆ lattice_of (v # fs)"
by (intro lattice_is_monotone, insert fs v, auto)
moreover have dir2: "lattice_of (v # fs) ⊆ 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 ⊆ carrier_vec n" and inlattice: "lattice_of gs ⊆ lattice_of fs"
and gs: "set gs ⊆ 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 ⊆ lattice_of fs"
by (meson basic_trans_rules(23) gs lattice_is_monotone local.Cons(3) set_subset_Cons)
have a: "a ∈ 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 ⊆ carrier_vec n"
shows "0⇩v n ∈ lattice_of fs"
proof -
have "∀f. lincomb (λv. 0 * f v) (set fs) = 0⇩v n"
using fs_carrier lincomb_closed lincomb_smult lmult_0 by presburger
hence "lincomb (λi. 0) (set fs) = 0⇩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 ∈ carrier_mat a n"
shows "lattice_of (Matrix.rows (0⇩m m n)) ⊆ lattice_of (Matrix.rows H)"
proof
let ?fs = "Matrix.rows (0⇩m m n)"
let ?gs = "Matrix.rows H"
have fs_carrier: "set ?fs ⊆ carrier_vec n" unfolding Matrix.rows_def by auto
have gs_carrier: "set ?gs ⊆ carrier_vec n" using H unfolding Matrix.rows_def by auto
fix x assume x: "x ∈ lattice_of (Matrix.rows (0⇩m m n))"
obtain f where fx: "lincomb (of_int ∘ f) (set (Matrix.rows (0⇩m m n))) = x"
using x lattice_of_altdef_lincomb[OF fs_carrier] by blast
have "lincomb (of_int ∘ f) (set (Matrix.rows (0⇩m m n))) = 0⇩v n"
unfolding lincomb_def by (rule M.finsum_all0, unfold Matrix.rows_def, auto)
hence "x = 0⇩v n" using fx by auto
thus "x ∈ lattice_of (Matrix.rows H)" using zero_in_lattice[OF gs_carrier] by auto
qed
lemma lattice_of_append_zero_rows:
assumes H': "H' ∈ carrier_mat m n"
and H: "H = H' @⇩r (0⇩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⇩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⇩m m n)) ⊆ 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 ‹Lemmas about echelon form›
lemma echelon_form_JNF_1xn:
assumes "A∈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∈carrier_mat m n" and "n<2"
and "∀i ∈ {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 ∈ 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 ∈ 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) ≠ 0"
hence nz_iA: "¬ is_zero_row_JNF i A" using n0 A unfolding is_zero_row_JNF_def by auto
hence nz_0A: "¬ 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) ≠ 0) < (LEAST n. A $$ (i, n) ≠ 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) ≠ 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 "∀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 " ∀ia<dim_row (multrow i (- 1) A). is_zero_row_JNF ia (multrow i (- 1) A)
⟶ ¬ (∃j<dim_row (multrow i (- 1) A). ia < j ∧ ¬ 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) ≠ 0) = (LEAST n. A $$ (ia, n) ≠ 0)"
if ia: "ia < dim_row A" and nz_ia_mrA: "¬ is_zero_row_JNF ia (multrow i (- 1) A)" for ia
proof (rule Least_equality)
have nz_ia_A: "¬ is_zero_row_JNF ia A" using nz_ia_mrA ia by auto
have Least_Aian_n: "(LEAST n. A $$ (ia, n) ≠ 0) < dim_col A"
by (smt (verit) 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) ≠ 0) ≠ 0"
by (smt (verit) 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 " ⋀y. multrow i (- 1) A $$ (ia, y) ≠ 0 ⟹ (LEAST n. A $$ (ia, n) ≠ 0) ≤ 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) ≠ 0) < (LEAST n. multrow i (- 1) A $$ (j, n) ≠ 0)"
if ia_j: "ia < j" and
j: "j < dim_row A"
and nz_ia_A: "¬ is_zero_row_JNF ia A"
and nz_j_A: "¬ 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 "∀ia j.
ia < j ∧ j < dim_row (multrow i (- 1) A) ∧ ¬ is_zero_row_JNF ia (multrow i (- 1) A)
∧ ¬ is_zero_row_JNF j (multrow i (- 1) A) ⟶
(LEAST n. multrow i (- 1) A $$ (ia, n) ≠ 0) < (LEAST n. multrow i (- 1) A $$ (j, n) ≠ 0)"
by auto
qed
thm echelon_form_imp_upper_triagular
lemma echelon_form_JNF_least_position_ge_diagonal:
assumes eA: "echelon_form_JNF A"
and A: "A: carrier_mat m n"
and nz_iA: "¬ is_zero_row_JNF i A"
and im: "i<m"
shows "i≤(LEAST n. A $$ (i,n) ≠ 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 " ¬ i ≤ (LEAST n. A $$ (i, n) ≠ 0)"
hence i_least: "i > (LEAST n. A $$ (i, n) ≠ 0)" by auto
have nz_i1A: "¬ 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≤(LEAST n. A $$ (i-1,n) ≠ 0)" by (rule less.hyps, insert im nz_i1A False, auto)
moreover have "(LEAST n. A $$ (i,n) ≠ 0) > (LEAST n. A $$ (i-1,n) ≠ 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 ∈ 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≤ (LEAST n. A $$(i,n) ≠ 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 oops
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 ∈ 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≤ (LEAST n. A $$(i,n) ≠ 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 ∈ carrier_mat (m+m) n" and mn: "n≤m"
shows "H = mat_of_rows n (map (Matrix.row H) [0..<m]) @⇩r 0⇩m m n" (is "_ = ?H' @⇩r 0⇩m m n")
proof
have H': "?H' ∈ carrier_mat m n" using H uH by auto
have H'0: "(?H' @⇩r 0⇩m m n) ∈ carrier_mat (m+m) n" by (simp add: H')
thus dr: "dim_row H = dim_row (?H' @⇩r 0⇩m m n)" using H H' by (simp add: append_rows_def)
show dc: "dim_col H = dim_col (?H' @⇩r 0⇩m m n)" using H H' by (simp add: append_rows_def)
fix i j assume i: "i < dim_row (?H' @⇩r 0⇩m m n)" and j: "j < dim_col (?H' @⇩r 0⇩m m n)"
show "H $$ (i, j) = (?H' @⇩r 0⇩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' @⇩r 0⇩m m n) $$ (i, j)"
by (smt (verit) 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 ‹The algorithm is sound›
lemma find_fst_non0_in_row:
assumes A: "A ∈ carrier_mat m n"
and res: "find_fst_non0_in_row l A = Some j"
shows "A $$ (l,j) ≠ 0" "l ≤ j" "j < dim_col A"
proof -
let ?xs = "filter (λj. A $$ (l, j) ≠ 0) [l ..< dim_col A]"
from res[unfolded find_fst_non0_in_row_def Let_def]
have xs: "?xs ≠ []" by (cases ?xs, auto)
have j_in_xs: "j ∈ 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) ≠ 0" "l ≤ j" "j < dim_col A" using j_in_xs by auto+
qed
lemma find_fst_non0_in_row_zero_before:
assumes A: "A ∈ carrier_mat m n"
and res: "find_fst_non0_in_row l A = Some j"
shows "∀j'∈{l..<j}. A $$ (l,j') = 0"
proof -
let ?xs = "filter (λj. A $$ (l, j) ≠ 0) [l ..< dim_col A]"
from res[unfolded find_fst_non0_in_row_def Let_def]
have xs: "?xs ≠ []" by (cases ?xs, auto)
have j_in_xs: "j ∈ 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 (verit) res[unfolded find_fst_non0_in_row_def Let_def] list.case(2) list.exhaust option.inject xs)
show "∀j'∈{l..<j}. A $$ (l,j') = 0"
proof (rule+, rule ccontr)
fix j' assume j': "j' : {l..<j}" and Alj': "A $$ (l, j') ≠ 0"
have j'j: "j'<j" using j' by auto
have j'_in_xs: "j' ∈ 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 (λj. A $$ (l, j) ≠ 0) ([l ..<j] @[j..<dim_col A])"
using l_rw by auto
hence "filter (λj. A $$ (l, j) ≠ 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 ∈ carrier_mat m n"
and res: "find_fst_non0_in_row l A = Some j"
and "j' ∈ {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 ∈ 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) ≠ 0)"
proof (rule Least_equality[symmetric])
show " A $$ (l, j) ≠ 0" using res find_fst_non0_in_row(1) by blast
show "⋀y. A $$ (l, y) ≠ 0 ⟹ j ≤ y"
proof (rule ccontr)
fix y assume Aly: "A $$ (l, y) ≠ 0" and jy: " ¬ j ≤ 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∈{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 ∈ carrier_mat m n"
and lm: "l<m"
shows "(find_fst_non0_in_row l A = None) = (∀j∈{l..<dim_col A}. A $$ (l,j) = 0)" (is "?lhs = ?rhs")
proof
assume res: ?lhs
let ?xs = "filter (λj. A $$ (l, j) ≠ 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∈{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 ≠ None"
from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast
hence "A $$ (l,j) ≠ 0" and "l≤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 ∈ 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 (λj. A $$ (l, j) ≠ 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 ∈ {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 ≠ None"
from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast
hence "A $$ (l,j) ≠ 0" and "j<dim_col A" using find_fst_non0_in_row[OF A r] by blast+
hence "¬ 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∈carrier_mat m n" and i: "i<m" and "0<n"
shows "make_first_column_positive A $$ (i,0) ≥ 0"
and "j<n ⟹ A $$ (i,0) < 0 ⟹ (make_first_column_positive A) $$ (i,j) = - A $$ (i,j)"
and "j<n ⟹ A $$ (i,0) ≥ 0 ⟹ (make_first_column_positive A) $$ (i,j) = A $$ (i,j)"
using assms by auto
lemma make_first_column_positive_invertible:
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (dim_row A) (dim_row A)
∧ make_first_column_positive A = P * A"
proof -
let ?P = "Matrix.mat (dim_row A) (dim_row A)
(λ(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 "¦Determinant.det ?P¦ = 1" by blast
hence "Determinant.det ?P dvd 1" by fastforce
thus ?thesis using invertible_iff_is_unit_JNF mat_carrier by blast
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: "(∑ia ∈ {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 ∙ col A j" using i j by auto
also have "... = (∑ia = 0..<dim_row A. Matrix.row ?P i $v ia * col A j $v ia)"
unfolding scalar_prod_def by auto
also have "... = (∑ia ∈ 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
+ (∑ia ∈ {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 ∈ 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 ⟹ b dvd a ⟹ (a gdiv b) * b = a"
and gmod_gdiv: "y > 0 ⟹ x gmod y = x - x gdiv y * y"
and dvd_imp_gmod_0: "0 < a ⟹ a dvd b ⟹ b gmod a = 0"
and gmod_0_imp_dvd: "a gmod b = 0 ⟹ b dvd a"
and gmod_0[simp]: "n gmod 0 = n" "n > 0 ⟹ 0 gmod n = 0"
begin
lemma reduce_alt_def_not0:
assumes "A $$ (a,0) ≠ 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)
(λ(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)
(λ(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 ∧ 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) ⇒
Matrix.mat (dim_row A) (dim_col A)
(λ(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) ⇒
Matrix.mat (dim_row A) (dim_col A)
(λ(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 ∧ 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 ∈ carrier_mat m n"
shows "(reduce a b D A) ∈ carrier_mat m n"
and "(reduce_abs a b D A) ∈ carrier_mat m n"
by (insert assms, auto simp add: Let_def split_beta)
lemma reduce_gcd:
assumes A: "A ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and Aaj: "A $$ (a,0) ≠ 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 (verit) 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 = "(λ(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 = "(λ(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in
if D < ¦r¦ then if k = 0 ∧ 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 < ¦r¦ 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 < ¦r¦ then
if (0::nat) = 0 ∧ D dvd r then D else r gmod D else r)"
using A a j by auto
also have "... = (if D < ¦gcd (A$$(a,0)) (A$$(b,0))¦ 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 ∈ carrier_mat m n" and j: "j<n"
and Aaj: "A $$ (a,0) ≠ 0" and ib: "i≠b" and ia: "i≠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 ∈ carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a ≠ b"
and Aaj: "A $$ (a,0) ≠ 0"
and D: "D ≥ 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 "∀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 = "(λ(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 (verit) gmod_0(1) gmod_0(2))
finally show ?thesis1 .
let ?g = "(λ(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in
if D < ¦r¦ then if k = 0 ∧ 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 < ¦r¦ 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 < ¦r¦ 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 ‹Let us show the key lemma: operations modulo determinant don't modify the (integer) row span.›
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 ⋅⇩m (1⇩m m))) ⊆ lattice_of fs_init"
proof -
let ?Z = "(mat_of_rows n fs_init)"
let ?RAT = "of_int_hom.mat_hom :: int mat ⇒ rat mat"
have RAT_fs_init: "?RAT (mat_of_rows n fs_init) ∈ 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) ≠ 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 ∈ 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) ⋅⇩m 1⇩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) ⋅⇩m 1⇩m n)" by simp
hence k_inv_Z_eq_adj: "(rat_of_int k) ⋅⇩m inv_Z = adj_mat (?RAT ?Z)"
by (smt (verit) 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) ∈ ℤ" 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) ∈ ℤ"
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 "... ∈ ℤ" using Ints_of_int by blast
finally show "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) ∈ ℤ" .
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 "... ∈ ℤ" using det_mat_delete_Z by auto
finally show ?thesis .
qed
have kinvZ_in_Z: "((rat_of_int k) ⋅⇩m inv_Z) $$ (i,j) ∈ ℤ" 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 ⋅⇩m (1⇩m m)) = Determinant.det (?RAT ?Z) ⋅⇩m (inv_Z * ?RAT ?Z)" (is "?lhs = ?rhs")
proof -
have "(inv_Z * ?RAT ?Z) = (1⇩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 ⋅⇩m (1⇩m m)" using det_rat_Z_k by auto
also have "... = ?lhs" by auto
finally show ?thesis ..
qed
also have "... = (Determinant.det (?RAT ?Z) ⋅⇩m inv_Z) * ?RAT ?Z"
by (metis RAT_fs_init mn inv_Z mult_smult_assoc_mat)
also have "... = ((rat_of_int k) ⋅⇩m inv_Z) * ?RAT ?Z" by (simp add: k_det)
finally have r': "?RAT (k ⋅⇩m (1⇩m m)) = ((rat_of_int k) ⋅⇩m inv_Z) * ?RAT ?Z" .
have r: "(k ⋅⇩m (1⇩m m)) = ((map_mat int_of_rat ((rat_of_int k) ⋅⇩m inv_Z))) * ?Z"
proof -
have "?RAT ((map_mat int_of_rat ((rat_of_int k) ⋅⇩m inv_Z))) = ((rat_of_int k) ⋅⇩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) ⋅⇩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': "... ∈ ℤ" 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 ⋅⇩m (1⇩m m)) = ?RAT ((map_mat int_of_rat ((rat_of_int k) ⋅⇩m inv_Z))) * ?RAT ?Z"
using r' by simp
also have "... = ?RAT ((map_mat int_of_rat ((rat_of_int k) ⋅⇩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) ⋅⇩m inv_Z))
= map_mat int_of_rat ((rat_of_int k) ⋅⇩m inv_Z)" by auto
have "mat_of_rows n (Matrix.rows (k ⋅⇩m 1⇩m m)) = (k ⋅⇩m (1⇩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) ⋅⇩m inv_Z)) * mat_of_rows n fs_init"
using r rw by auto
finally show "mat_of_rows n (Matrix.rows (k ⋅⇩m 1⇩m m))
= of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) ⋅⇩m inv_Z)) * mat_of_rows n fs_init" .
show "set (Matrix.rows (k ⋅⇩m 1⇩m m)) ⊆ carrier_vec n"using mn unfolding Matrix.rows_def by auto
show "map_mat int_of_rat (rat_of_int k ⋅⇩m inv_Z) ∈ carrier_mat (length (Matrix.rows (k ⋅⇩m 1⇩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) @⇩r (k ⋅⇩m (1⇩m m))"
shows "lattice_of (Matrix.rows A) = lattice_of fs_init"
proof -
have "Matrix.rows (mat_of_rows n fs_init @⇩r k ⋅⇩m 1⇩m m) = (Matrix.rows (mat_of_rows n fs_init) @ Matrix.rows (k ⋅⇩m (1⇩m m)))"
by (rule rows_append_rows, insert fs_init len mn, auto)
also have "... = (fs_init @ Matrix.rows (k ⋅⇩m (1⇩m m)))" by (simp add: fs_init)
finally have rw: "Matrix.rows (mat_of_rows n fs_init @⇩r k ⋅⇩m 1⇩m m)
= (fs_init @ Matrix.rows (k ⋅⇩m (1⇩m m)))" .
have "lattice_of (Matrix.rows A) = lattice_of (fs_init @ Matrix.rows (k ⋅⇩m (1⇩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 ⋅⇩m 1⇩m m)) ⊆ lattice_of fs_init"
by (rule lattice_of_kId_subset_fs_init[OF _ mn], insert k2, auto)
have l2: "lattice_of (Matrix.rows (- k ⋅⇩m 1⇩m m)) = lattice_of (Matrix.rows (k ⋅⇩m 1⇩m m))"
proof (rule mat_mult_invertible_lattice_eq)
let ?P = "(- 1::int) ⋅⇩m 1⇩m m"
show P: "?P ∈ carrier_mat m m" by simp
have "det ?P = 1 ∨ det ?P = -1" unfolding det_smult by (auto simp add: minus_1_power_even)
hence "det ?P dvd 1" by (smt (verit) minus_dvd_iff one_dvd)
thus " invertible_mat ?P" unfolding invertible_iff_is_unit_JNF[OF P] .
have "(- k ⋅⇩m 1⇩m m) = ?P * (k ⋅⇩m 1⇩m m)"
unfolding mat_diag_smult[symmetric] unfolding mat_diag_diag by auto
thus " mat_of_rows n (Matrix.rows (- k ⋅⇩m 1⇩m m)) = of_int_hom.mat_hom ?P * mat_of_rows n (Matrix.rows (k ⋅⇩m 1⇩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 ⋅⇩m 1⇩m m)) ⊆ carrier_vec n"
and "set (Matrix.rows (k ⋅⇩m 1⇩m m)) ⊆ 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 ⋅⇩m 1⇩m m)) ⊆ 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 ‹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' @⇩r (0⇩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.›
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) @⇩r (k ⋅⇩m (1⇩m m))"
and H': "H'∈ carrier_mat m n"
and H_append: "H = H' @⇩r (0⇩m m n)"
and P: "P ∈ 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 "(∃P'. invertible_mat P' ∧ P' ∈ carrier_mat m m ∧ (mat_of_rows n fs_init) = P' * H')"
proof -
have A_carrier: "A ∈ 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≤m" by (simp add: mn)
have H: "H ∈ carrier_mat (m + m) n" using H_append H' by auto
have submatrix_carrier: "submatrix H {0..<m} {0..<n} ∈ 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⇩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) ⊆ carrier_vec n" using A_carrier set_rows_carrier by blast
show "set (Matrix.rows H) ⊆ 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:
"∃P2. P2 ∈ carrier_mat n n ∧ invertible_mat P2 ∧ mat_of_rows n (Matrix.rows H') = P2 * H'"
by (rule exI[of _ "1⇩m n"], insert H' mn, auto)
have exist_P': "∃P'∈carrier_mat n n. invertible_mat P'
∧ 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 "∃P'. invertible_mat P' ∧ P' ∈ carrier_mat m m ∧ (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
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 ∧ 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 ∈ carrier_mat (dim_row A) (dim_col A)"
and "reduce_element_mod_D_abs A a j D m ∈ carrier_mat (dim_row A) (dim_col A)" by auto
lemma reduce_element_mod_D_invertible_mat:
assumes A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m≥n"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
and "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
unfolding atomize_conj
proof (rule conjI; cases "j = 0 ∧ 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 ∈ 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 ∈ 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 ∈ carrier_mat (m + n) n" using A_def A' mn by auto
have P: "?P ∈ 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' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m≥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 ← [0..<m]] @⇩r (D ⋅⇩m (1⇩m n))" (is "?lhs = ?A' @⇩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 ← [0..<m]] @⇩r (D ⋅⇩m (1⇩m n))" (is "?lhs_abs = ?A'_abs @⇩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 ∈ carrier_mat (m+n) n"
and lhs_carrier_abs: "?lhs_abs ∈ 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' ∈ carrier_mat m n"
and map_A_carrier_abs[simp]: "?A'_abs ∈ carrier_mat m n"
by (simp add: mat_of_rows_def)+
have AD_carrier[simp]: "?A' @⇩r ?D ∈ carrier_mat (m+n) n"
and AD_carrier_abs[simp]: "?A'_abs @⇩r ?D ∈ carrier_mat (m+n) n"
by (rule carrier_append_rows, insert lhs_carrier mn, auto)
show "dim_row (?lhs) = dim_row (?A' @⇩r ?D)" and "dim_col (?lhs) = dim_col (?A' @⇩r ?D)"
"dim_row (?lhs_abs) = dim_row (?A'_abs @⇩r ?D)" and "dim_col (?lhs_abs) = dim_col (?A'_abs @⇩r ?D)"
using lhs_carrier lhs_carrier_abs AD_carrier AD_carrier_abs unfolding carrier_mat_def by simp+
show "?lhs $$ (i, ja) = (?A' @⇩r ?D) $$ (i, ja)" if i: "i < dim_row (?A' @⇩r ?D)" and ja: "ja < dim_col (?A' @⇩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' @⇩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' @⇩r ?D) $$ (i, ja) =?D $$ (i-m,ja)"
by (smt (verit) 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 @⇩r ?D)" and ja: "ja < dim_col (?A'_abs @⇩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 @⇩r ?D) $$ (i, ja)"
proof (cases "i<m")
case True
have "(?A'_abs @⇩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 @⇩r ?D) $$ (i, ja) = ?D $$ (i-m,ja)"
by (smt (verit) 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' ∈ carrier_mat m n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))" and a: "a<m" and xm: "x<m" and "0<n"
and Aaj: "A $$ (a,0) ≠ 0"
shows "reduce a x D A
= mat_of_rows n [Matrix.row ((reduce a x D A)) i. i ← [0..<m]] @⇩r D ⋅⇩m 1⇩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 ← [0..<m]] @⇩r D ⋅⇩m 1⇩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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" and "D ⋅⇩m 1⇩m n ∈ carrier_mat n n" by simp+
show "?reduce_ax ∈ carrier_mat (m + n) n" "?reduce_abs ∈ 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 "∀i∈{m..<m + n}. ∀ja<n. ?reduce_ax $$ (i, ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)"
and "∀i∈{m..<m + n}. ∀ja<n. ?reduce_abs $$ (i, ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)"
unfolding atomize_conj
proof (rule conjI; rule+)
fix i ja assume i: "i ∈ {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 ≠ a" using i a by auto
have i_not_x: "i ≠ 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 ⋅⇩m (1⇩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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" using i A' by auto
finally show "?reduce_ax $$ (i,ja) = (D ⋅⇩m 1⇩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 ⋅⇩m (1⇩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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" using i A' by auto
finally show "?reduce_abs $$ (i,ja) = (D ⋅⇩m 1⇩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' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "∀j∈set xs. j<n" and mn: "m≥n"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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⇩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 "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ 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 ← [0..<m]]"
show "reduce_element_mod_D A a x D m = ?A' @⇩r (D ⋅⇩m (1⇩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 ∈ 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) ∈ 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 (verit) 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' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "∀j∈set xs. j<n" and mn: "m≥n"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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⇩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 "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ 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 ← [0..<m]]"
show "reduce_element_mod_D_abs A a x D m = ?A' @⇩r (D ⋅⇩m (1⇩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 ∈ 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) ∈ 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 (verit) 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' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a≤m" and j: "j<n" and mn: "m≥n"
and D: "D > 0"
shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ 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)
(λ(i,k). if i = a ∧ k = j then if j = 0 ∧ 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 ∈ 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 ⋅⇩m (1⇩m n)) $$ (j,ja)"
by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto)
also have "... = D * (1⇩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 ∧ 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 ⋅⇩m (1⇩m n)) $$ (j,ja)"
by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto)
also have "... = D * (1⇩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 ∧ 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 ⋅⇩m (1⇩m n)) $$ (j,ja)"
by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto)
also have "... = D * (1⇩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 ∧ 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 ⋅⇩m (1⇩m n)) $$ (j,ja)"
by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto)
also have "... = D * (1⇩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 "⋀i ja. i<dim_row ?A ⟹ ja < dim_col ?A ⟹ reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)"
and "⋀i ja. i<dim_row ?A_abs ⟹ ja < dim_col ?A_abs ⟹ 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' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "∀j∈set xs. j<n"
and d: "distinct xs" and "m≥n"
and "D > 0"
shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ k ∈ 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)
(λ(i,k). if i = a ∧ 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) (λ(i,k). if i = a ∧ k ∈ 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 ← [0..<m]]"
show "reduce_element_mod_D A a x D m = ?A' @⇩r (D ⋅⇩m (1⇩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)
(λ(i,k). if i = a ∧ k ∈ 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 ∧ j ∈ set xs")
case True note ia_jxs = True
have j_not_x: "j≠x"
using "2.prems"(5) True by auto
show ?thesis
proof (cases "j=0 ∧ 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 (verit) "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 (verit) "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 ‹D > 0›
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 (verit) 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' @⇩r (D ⋅⇩m (1⇩m n))"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "∀j∈set xs. j<n"
and d: "distinct xs" and "m≥n"
and "D > 0"
shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ k ∈ set xs then if k = 0 ∧ 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)
(λ(i,k). if i = a ∧ k = j then if j = 0 ∧ 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) (λ(i,k). if i = a ∧ k ∈ set xs then
if k=0 ∧ 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 ← [0..<m]]"
show "reduce_element_mod_D_abs A a x D m = ?A' @⇩r (D ⋅⇩m (1⇩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)
(λ(i,k). if i = a ∧ k ∈ set (x # xs) then if k = 0 ∧ 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 ∧ j ∈ set xs")
case True note ia_jxs = True
have j_not_x: "j≠x"
using "2.prems"(5) True by auto
show ?thesis
proof (cases "j=0 ∧ 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 (verit) "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 ‹D > 0›
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 (verit) 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 ‹Now, we prove some transfer rules to connect B\'ezout matrices in HOL Analysis and JNF›
lemma HMA_bezout_matrix[transfer_rule]:
shows "((Mod_Type_Connect.HMA_M :: _ ⇒ 'a :: {bezout_ring} ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _)
===> (Mod_Type_Connect.HMA_I :: _ ⇒ 'm ⇒ _) ===> (Mod_Type_Connect.HMA_I :: _ ⇒ 'm ⇒ _)
===> (Mod_Type_Connect.HMA_I :: _ ⇒ 'n ⇒ _) ===> (=) ===> (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⇩m_def
proof (rule eq_matI)
let ?A = "Matrix.mat CARD('m) CARD('m) (λ(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' ∧ ?ja = a' then p else if ?i = a' ∧ ?ja = b' then q else if ?i = b' ∧ ?ja = a'
then u else if ?i = b' ∧ ?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 ∧ ja = a then p else
if i = a ∧ ja = b then q else
if i = b ∧ ja = a then u else
if i = b ∧ 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
context
begin
private lemma invertible_bezout_matrix_JNF_mod_type:
fixes A::"'a::{bezout_ring_div} mat"
assumes "A ∈ 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) ≠ 0"
shows "invertible_mat (bezout_matrix_JNF A a b j bezout)"
proof -
define A' where "A' = (Mod_Type_Connect.to_hma⇩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' ≠ 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 ∈ 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) ≠ 0"
shows "invertible_mat (bezout_matrix_JNF A a b j bezout)"
using assms invertible_bezout_matrix_JNF_mod_type by (smt (verit) CARD_mod_ring)
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: "∃(Rep :: ('b ⇒ int)) Abs. type_definition Rep Abs {0..<m :: int}"
assumes local_typedef2: "∃(Rep :: ('c ⇒ 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 ⇒ 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 ⇒ 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 ∈ 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) ≠ 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
context
begin
private lemma invertible_bezout_matrix_JNF_cancelled_first:
"∃Rep Abs. type_definition Rep Abs {0..<int n} ⟹ {0..<int m} ≠ {} ⟹
1 < m ⟹ 1 < n ⟹
(A::'a::bezout_ring_div mat) ∈ carrier_mat m n ⟹ is_bezout_ext bezout
⟹ a < b ⟹ b < m ⟹ j < n ⟹ A $$ (a, j) ≠ 0 ⟹ invertible_mat (bezout_matrix_JNF A a b j bezout)"
using invertible_bezout_matrix_JNF_nontriv_mod_ring_aux[cancel_type_definition] by blast
private lemma invertible_bezout_matrix_JNF_cancelled_both:
"{0..<int n} ≠ {} ⟹ {0..<int m} ≠ {} ⟹ 1 < m ⟹ 1 < n ⟹
1 < m ⟹ 1 < n ⟹
(A::'a::bezout_ring_div mat) ∈ carrier_mat m n ⟹ is_bezout_ext bezout
⟹ a < b ⟹ b < m ⟹ j < n ⟹ A $$ (a, j) ≠ 0 ⟹ invertible_mat (bezout_matrix_JNF A a b j bezout)"
using invertible_bezout_matrix_JNF_cancelled_first[cancel_type_definition] by blast
lemma invertible_bezout_matrix_JNF':
fixes A::"'a::{bezout_ring_div} mat"
assumes "A ∈ 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"
and aj: "A $$ (a, j) ≠ 0"
shows "invertible_mat (bezout_matrix_JNF A a b j bezout)"
using invertible_bezout_matrix_JNF_cancelled_both assms by auto
lemma invertible_bezout_matrix_JNF_n1:
fixes A::"'a::{bezout_ring_div} mat"
assumes A: "A ∈ 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"
and aj: "A $$ (a, j) ≠ 0"
shows "invertible_mat (bezout_matrix_JNF A a b j bezout)"
proof -
let ?A = "A @⇩c (0⇩m m n)"
have "(A @⇩c 0⇩m m n) $$ (a, j) = (if j < dim_col A then A $$ (a, j) else (0⇩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 @⇩c 0⇩m m n) $$ (a, j) = A $$ (a,j)" .
have "(A @⇩c 0⇩m m n) $$ (b, j) = (if j < dim_col A then A $$ (b, j) else (0⇩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 @⇩c 0⇩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
corollary invertible_bezout_matrix_JNF:
fixes A::"'a::{bezout_ring_div} mat"
assumes "A ∈ 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) ≠ 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 ‹We continue with the soundness of the algorithm›
lemma bezout_matrix_JNF_mult_eq:
assumes A': "A' ∈ carrier_mat m n" and a: "a≤m" and b: "b≤m" and ab: "a ≠ b"
and A_def: "A = A' @⇩r B" and B: "B ∈ 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)
(λ(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 ∈ carrier_mat (m+n) n" using A_def A' B by simp
hence A_carrier: "?A ∈ 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 = "λ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 ∙ col A ja"
by (rule index_mult_mat, insert i ja, auto)
also have "... = (∑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 "... = (∑ia = 0..<m+n. ?f ia)"
by (rule sum.cong, insert A i dr dc, auto) (smt (verit) bezout_matrix_JNF_def carrier_matD(1)
dim_col_mat(1) index_col index_mult_mat(3) index_row(1) ja)
also have "... = (∑ia ∈ ({a,b} ∪ ({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 ∈ {0..<m + n} - {a, b}"
hence xm: "x < m+n" by auto
have x_not_i: "x ≠ 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 ∈ {0..<m + n} - {a, b}"
hence xm: "x < m+n" by auto
have x_not_i: "x ≠ 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 ∈ {0..<m + n} - {a, b} - {i}"
hence xm: "x < m+n" by auto
have x_not_i: "x ≠ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a ≠ b"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and a_less_b: "a < b"
and mn: "m≥n"
and D_ge0: "D > 0"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ (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)
(λ(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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" by auto
have A: "A ∈ carrier_mat (m+n) n" using A_def A' by simp
hence A_carrier: "?A ∈ 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 ∈ 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 ← [0..<m]]"
have A_A'_D: "?A = ?A' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+)
fix i j assume i: "i ∈ {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 ⋅⇩m (1⇩m n))$$(i-m,j))"
by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto)
also have "... = (D ⋅⇩m 1⇩m n) $$ (i - m, j)" using i A' by auto
finally show "?A $$ (i,j) = (D ⋅⇩m 1⇩m n) $$ (i - m, j)" .
qed
have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A)
(λ(i, k). if i = a ∧ k ∈ 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 ∈ carrier_mat (m+n) n" using reduce_a_eq A by auto
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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 ← [0..<m]]"
have reduce_a_B'_D: "?reduce_a = ?B' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+)
fix i ja assume i: "i ∈ {m..<m + n}" and ja: "ja < n"
have i_not_a:"i≠a" and i_not_b: "i≠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 ⋅⇩m 1⇩m n) $$ (i - m, ja)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" .
qed
have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a)
(λ(i, k). if i = b ∧ k ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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≠a ∧ i≠b)")
case True
have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq
by (smt (verit) 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 (verit) 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≠b" using ab by auto
show ?thesis
proof -
have ja_in_xs: "ja ∈ 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 (verit) 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 ∧ 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 (verit) "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 ∈ set ys")
case True note ja_in_ys = True
hence ja_not0: "ja ≠ 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 (verit) 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 (verit) 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 (verit) 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 ‹ja = 0› 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) ∈ 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 (verit) 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a ≠ b"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and a_less_b: "a < b"
and mn: "m≥n"
and D_ge0: "D > 0"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ (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)
(λ(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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" by auto
have A: "A ∈ carrier_mat (m+n) n" using A_def A' by simp
hence A_carrier: "?A ∈ 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 ∈ carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
define xs where "xs = filter (λ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 ← [0..<m]]"
have A_A'_D: "?A = ?A' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+)
fix i j assume i: "i ∈ {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 ⋅⇩m (1⇩m n))$$(i-m,j))"
by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto)
also have "... = (D ⋅⇩m 1⇩m n) $$ (i - m, j)" using i A' by auto
finally show "?A $$ (i,j) = (D ⋅⇩m 1⇩m n) $$ (i - m, j)" .
qed
have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A)
(λ(i, k). if i = a ∧ k ∈ set xs then
if k = 0 ∧ 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 ∈ carrier_mat (m+n) n" using reduce_a_eq A by auto
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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 (λ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 ← [0..<m]]"
have reduce_a_B'_D: "?reduce_a = ?B' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+)
fix i ja assume i: "i ∈ {m..<m + n}" and ja: "ja < n"
have i_not_a:"i≠a" and i_not_b: "i≠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 ⋅⇩m 1⇩m n) $$ (i - m, ja)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" .
qed
have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a)
(λ(i, k). if i = b ∧ k ∈ set ys then if k = 0 ∧ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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≠a ∧ i≠b)")
case True
have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq
by (smt (verit) 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 (verit) 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≠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 ∈ 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 (verit) 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 ∧ 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 ∉ 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 (verit) 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 ∈ 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 ∧ 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 (verit) i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
also have "... = (if ja = 0 ∧ 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 ∧ 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 (verit) 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 ∉ 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) ∈ 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 (verit) 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' @⇩r B" and B: "B∈carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a≤m" and j: "j<n"
and mn: "m>=n" and B1: "B $$ (j, j) = D" and B2: "(∀j'∈{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)
(λ(i,k). if i = a ∧ 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 ∈ 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 ∧ 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' @⇩r B" and B: "B∈carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a≤m" and j: "j<n"
and mn: "m>=n" and B1: "B $$ (j, j) = D" and B2: "(∀j'∈{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)
(λ(i,k). if i = a ∧ k = j then if j = 0 ∧ 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 ∈ 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 ∧ 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 ∧ 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 ∧ 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' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and "a < m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and d: "distinct xs" and "m≥n"
and D: "D > 0"
shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ k ∈ 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 ∈ 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)
(λ(i,k). if i = a ∧ 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∈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) (λ(i,k). if i = a ∧ k ∈ 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 ← [0..<m]]"
show "reduce_element_mod_D A a x D m = ?A' @⇩r B"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B])
show " ∀i∈{m..<m + n}. ∀j<n. reduce_element_mod_D A a x D m $$ (i, j) = B $$ (i - m, j) "
by (smt (verit) 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)
(λ(i,k). if i = a ∧ k ∈ 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 ∧ j ∈ set xs")
case True note ia_jxs = True
have j_not_x: "j≠x" using d True by auto
show ?thesis
proof (cases "j=0 ∧ 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 (verit) "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 (verit) "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 (verit) 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' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and "a < m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and d: "distinct xs" and "m≥n"
and D: "D > 0"
shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ k ∈ set xs then if k = 0 ∧ 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 ∈ 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)
(λ(i,k). if i = a ∧ k = j then if j = 0 ∧ D dvd A$$(i,k)
then D else A$$(i,k) gmod D else A$$(i,k))" if "j∈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) (λ(i,k). if i = a ∧ k ∈ set xs
then if k = 0 ∧ 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 ← [0..<m]]"
show "reduce_element_mod_D_abs A a x D m = ?A' @⇩r B"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B])
show " ∀i∈{m..<m + n}. ∀j<n. reduce_element_mod_D_abs A a x D m $$ (i, j) = B $$ (i - m, j) "
by (smt (verit) 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)
(λ(i,k). if i = a ∧ k ∈ set (x # xs) then if k = 0 ∧ 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 ∧ j ∈ set xs")
case True note ia_jxs = True
have j_not_x: "j≠x" using d True by auto
show ?thesis
proof (cases "j=0 ∧ 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 (verit) "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 (verit) False True ‹Matrix.mat (dim_row ?reduce_xs)
(dim_col ?reduce_xs) (λ(i, k). if i = a ∧ k ∈ set xs
then if k = 0 ∧ 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›
calculation dim_col_mat(1) dim_row_mat(1) dvd_imp_gmod_0[OF ‹D > 0›] 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 (verit) 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' @⇩r B" and B: "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m≥n"
shows reduce_element_mod_D_invertible_mat_case_m:
"∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
and reduce_element_mod_D_abs_invertible_mat_case_m:
"∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
unfolding atomize_conj
proof (rule conjI; cases "j = 0 ∧ 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 ∈ 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 ∈ 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 ∈ 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 ∈ 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 ∈ 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 ∈ 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' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a < m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and mn: "m≥n"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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⇩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 "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P
∧ 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 ← [0..<m]]"
let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i ← [m..<m+n]]"
show reduce_xs_A'B': "?reduce_xs = ?A' @⇩r ?B'"
by (smt (verit) "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 "∀j∈set xs. j < n ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. ?B' $$ (j, j') = 0)"
proof
fix j assume j_in_xs: "j ∈ set xs"
have jn: "j<n" using j_in_xs j by auto
have "?B' $$ (j, j) = ?reduce_xs $$ (m+j,j)"
using "2"(7) add_diff_cancel_left' jn length_map length_upt
by (smt (verit, ccfv_SIG) "1" "2"(4) A_def B P inv_P R_P add_strict_left_mono carrier_append_rows carrier_matD(1)
carrier_matD(2) index_mult_mat(2) index_row(1) mat_of_rows_index nth_map_upt reduce_row_mod_D_preserves_dimensions(2))
also have "... = B $$ (j,j)"
by (smt (verit) "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 "∀j'∈{0..<n} - {j}. ?B' $$ (j, j') = 0"
proof
fix j' assume j': "j' ∈{0..<n} - {j}"
then have "?B' $$ (j, j') = ?reduce_xs $$ (m+j,j')"
by (smt (z3) mn Diff_iff 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 (verit) "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 ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{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≤m" using "2.prems" by auto
qed
from this obtain P2 where P2: "P2 ∈ 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) ∈ 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 (verit) 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' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a < m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and mn: "m≥n"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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⇩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 "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P
∧ 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 ← [0..<m]]"
let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i ← [m..<m+n]]"
show reduce_xs_A'B': "?reduce_xs = ?A' @⇩r ?B'"
by (smt (verit) "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 "∀j∈set xs. j < n ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. ?B' $$ (j, j') = 0)"
proof
fix j assume j_in_xs: "j ∈ set xs"
have jn: "j<n" using j_in_xs j by auto
have "?B' $$ (j, j) = ?reduce_xs $$ (m+j,j)"
by (smt (z3) "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 (verit) "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 "∀j'∈{0..<n} - {j}. ?B' $$ (j, j') = 0"
proof
fix j' assume j': "j' ∈{0..<n} - {j}"
then
have "?B' $$ (j, j') = ?reduce_xs $$ (m+j,j')"
apply simp
by (metis (mono_tags, lifting) "2"(4) A_def B P R_P add_less_cancel_left carrier_append_rows carrier_matD(1) carrier_matD(2) diff_add_inverse index_mult_mat(2) index_mult_mat(3) index_row(1) jn length_map length_upt mat_of_rows_index nth_map_upt)
also have "... = B $$ (j,j')"
by (smt (verit) "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 ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{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≤m" using "2.prems" by auto
qed
from this obtain P2 where P2: "P2 ∈ 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) ∈ 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 (verit) 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_row_mod_D_case_m'':
assumes A_def: "A = A' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and "a ≤ m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and d: "distinct xs" and "m≥n" and "0 ∉ set xs"
and "D > 0"
shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ k ∈ 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 ∈ 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)
(λ(i,k). if i = a ∧ 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∈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) (λ(i,k). if i = a ∧ k ∈ 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 ← [0..<m]]"
define B' where "B' = mat_of_rows n [Matrix.row ?reduce_xs i. i ← [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' @⇩r B'"
by (metis B'_def append_rows_split carrier_matD
reduce_element_mod_D_preserves_dimensions(1) reduce_xs_carrier le_add1)
show "∀j∈set xs. j<n ∧ (B' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B' $$ (j, j') = 0)"
proof
fix j assume j_xs: "j∈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 (verit) 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 (verit) 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 ∧ B' $$ (j, j) = D ∧ (∀j'∈{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)
(λ(i,k). if i = a ∧ k ∈ 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 ∧ j ∈ set xs")
case True note ia_jxs = True
have j_not_x: "j≠x" using d True by auto
show ?thesis
proof (cases "j=0 ∧ 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 (verit) "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 (verit) "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
lemma reduce_row_mod_D_abs_case_m'':
assumes A_def: "A = A' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and "a ≤ m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and d: "distinct xs" and "m≥n" and "0 ∉ set xs"
and "D > 0"
shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
(λ(i,k). if i = a ∧ k ∈ set xs then if k = 0 ∧ 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 ∈ 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)
(λ(i,k). if i = a ∧ k = j then if j = 0 ∧ D dvd A$$(i,k)
then D else A$$(i,k) gmod D else A$$(i,k))" if "j∈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) (λ(i,k). if i = a ∧ k ∈ set xs
then if k=0 ∧ 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 ← [0..<m]]"
define B' where "B' = mat_of_rows n [Matrix.row ?reduce_xs i. i ← [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' @⇩r B'"
by (metis B'_def append_rows_split carrier_matD
reduce_element_mod_D_preserves_dimensions(3) reduce_xs_carrier le_add1)
show "∀j∈set xs. j<n ∧ (B' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B' $$ (j, j') = 0)"
proof
fix j assume j_xs: "j∈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 (verit) 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 (verit) 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 ∧ B' $$ (j, j) = D ∧ (∀j'∈{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)
(λ(i,k). if i = a ∧ k ∈ 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 ∧ j ∈ set xs")
case True note ia_jxs = True
have j_not_x: "j≠x" using d True by auto
show ?thesis
proof (cases "j=0 ∧ 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 (verit) "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 (verit) "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' @⇩r B" and B: "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a≤m" and j: "j<n" and mn: "m≥n" and j0: "j≠0"
shows reduce_element_mod_D_invertible_mat_case_m':
"∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
and reduce_element_mod_D_abs_invertible_mat_case_m':
"∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ 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 ≠a" using j0 a by auto
have A: "A ∈ 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 ∈ 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
lemma reduce_row_mod_D_invertible_mat_case_m':
assumes A_def: "A = A' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a ≤ m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and d: "distinct xs" and mn: "m≥n" and "0∉ set xs"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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⇩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 ∈ 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 "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P
∧ 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 ← [0..<m]]"
let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i ← [m..<m+n]]"
show B': "?B' ∈ carrier_mat n n" by auto
show A'': "?A' : carrier_mat m n" by auto
show reduce_split: "?reduce_xs = ?A' @⇩r ?B'"
by (smt (verit) "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 "∀j∈set xs. j < n ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. ?B' $$ (j, j') = 0)"
proof
fix j assume j_xs: "j∈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 (verit) 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 (verit) 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 ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{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 ∈ 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) ∈ 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 (verit) 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' @⇩r B" and "B ∈ carrier_mat n n"
and A': "A' ∈ carrier_mat m n" and a: "a ≤ m"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and d: "distinct xs" and mn: "m≥n" and "0∉ set xs"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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⇩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 ∈ 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 "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧
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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P
∧ 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 ← [0..<m]]"
let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i ← [m..<m+n]]"
show B': "?B' ∈ carrier_mat n n" by auto
show A'': "?A' : carrier_mat m n" by auto
show reduce_split: "?reduce_xs = ?A' @⇩r ?B'"
by (smt (verit) "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 "∀j∈set xs. j < n ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. ?B' $$ (j, j') = 0)"
proof
fix j assume j_xs: "j∈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 (verit) 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 (verit) 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 ∧ ?B' $$ (j, j) = D ∧ (∀j'∈{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 ∈ 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) ∈ 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 (verit) 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' ∈ carrier_mat m n" and B: "B ∈ carrier_mat n n"
and a: "a<m" and ab: "a ≠ m"
and A_def: "A = A' @⇩r B"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥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)
(λ(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: "∀j∈set ys. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and D0: "D > 0"
and Am0_D: "A $$ (m, 0) ∈ {0,D}"
and Am0_D2: "A $$ (m, 0) = 0 ⟶ A $$ (a, 0) = D"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ (reduce a m D A) = P * A"
proof -
let ?A = "Matrix.mat (dim_row A) (dim_col A)
(λ(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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" using mn by auto
have A: "A ∈ carrier_mat (m+n) n" using A_def A' B mn by simp
hence A_carrier: "?A ∈ 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 ∈ 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 ← [0..<m]]"
define A'2 where "A'2 = mat_of_rows n [Matrix.row ?A i. i ← [m..<dim_row A]]"
have A_A'_D: "?A = A'1 @⇩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: "∀j∈set xs. j < n ∧ A'2 $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. A'2 $$ (j, j') = 0)"
proof (rule ballI)
fix ja assume ja: "ja∈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 ≠ 0" using ja unfolding xs_def by auto
show "ja < n ∧ A'2 $$ (ja, ja) = D ∧ (∀j'∈{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
proof -
have "A'2 $$ (ja, ja) = [Matrix.row ?A i. i ← [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' @⇩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 "(∀j'∈{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 ← [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' @⇩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)
(λ(i, k). if i = a ∧ k ∈ 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 ∈ carrier_mat n n" using A A'2_def by auto
show "A'1 ∈ 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 ∈ carrier_mat (m+n) n" using reduce_a_eq A by auto
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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 ← [0..<m]]"
define reduce_a1 where "reduce_a1 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i ← [0..<m]]"
define reduce_a2 where "reduce_a2 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i ← [m..<dim_row ?reduce_a]]"
have reduce_a_split: "?reduce_a = reduce_a1 @⇩r reduce_a2"
by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto)
have zero_notin_ys: "0 ∉ 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 (verit) 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 ∈ carrier_mat n n" unfolding reduce_a2_def using A by auto
have reduce_a1: "reduce_a1 ∈ carrier_mat m n" unfolding reduce_a1_def using A by auto
have j2: "∀j∈set ys. j < n ∧ reduce_a2 $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
proof
fix j assume j_in_ys: "j ∈ set ys"
have a_jm: "a ≠ j+m" using a by auto
have m_not_jm: "m ≠ 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')"
using assms(1) assms(2) assms(5) assms(8,14) unfolding A_def
by (meson append_rows_nth2 less_le_trans j' j_in_ys)
finally show ?thesis .
qed
thus "j < n ∧ reduce_a2 $$ (j, j) = D ∧ (∀j'∈{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)
(λ(i, k). if i = m ∧ k ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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≠a ∧ i≠m)")
case True
have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq
by (smt (verit) 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 (verit) 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)) ≤ 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≠m" using ab by auto
have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq
by (smt (verit) 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 ∉ 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 ∈ 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 (verit) 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 (verit) 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 ∈ 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 (verit) 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 (verit) 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' ∈ carrier_mat m n" and B: "B ∈ carrier_mat n n"
and a: "a<m" and ab: "a ≠ m"
and A_def: "A = A' @⇩r B"
and j: "∀j∈set xs. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥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)
(λ(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 (λi. abs (A2 $$ (a,i)) > D) [0..<n]"
and ys_def: "ys = filter (λi. abs (A2 $$ (m,i)) > D) [0..<n]"
and j_ys: "∀j∈set ys. j<n ∧ (B $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. B $$ (j, j') = 0)"
and D0: "D > 0"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ (reduce_abs a m D A) = P * A"
proof -
let ?A = "Matrix.mat (dim_row A) (dim_col A)
(λ(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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" using mn by auto
have A: "A ∈ carrier_mat (m+n) n" using A_def A' B mn by simp
hence A_carrier: "?A ∈ 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 ∈ 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 ← [0..<m]]"
define A'2 where "A'2 = mat_of_rows n [Matrix.row ?A i. i ← [m..<dim_row A]]"
have A_A'_D: "?A = A'1 @⇩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: "∀j∈set xs. j < n ∧ A'2 $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. A'2 $$ (j, j') = 0)"
proof (rule ballI)
fix ja assume ja: "ja∈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: "¦(?A $$ (a,ja))¦ > D" using ja unfolding xs_def by auto
have ja_not_0: "ja ≠ 0"
proof (rule ccontr, simp)
assume ja_a: "ja = 0"
have A_mja_D: "A$$(m,ja) = D"
proof -
have "A$$(m,ja) = (A' @⇩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(...) ≤ D" using A_mja_D by (simp add: D0)
finally have "abs (?A $$ (a, ja)) ≤ D" .
thus False using abs_A_a_ja_D by auto
qed
show "ja < n ∧ A'2 $$ (ja, ja) = D ∧ (∀j'∈{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
proof -
have "A'2 $$ (ja, ja) = [Matrix.row ?A i. i ← [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' @⇩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 "(∀j'∈{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 ← [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' @⇩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)
(λ(i, k). if i = a ∧ k ∈ set xs then if k = 0 ∧ 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 ∈ carrier_mat n n" using A A'2_def by auto
show "A'1 ∈ 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 ∈ carrier_mat (m+n) n" using reduce_a_eq A by auto
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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 ← [0..<m]]"
define reduce_a1 where "reduce_a1 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i ← [0..<m]]"
define reduce_a2 where "reduce_a2 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i ← [m..<dim_row ?reduce_a]]"
have reduce_a_split: "?reduce_a = reduce_a1 @⇩r reduce_a2"
by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto)
have zero_notin_ys: "0 ∉ 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 (verit) 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 ∈ carrier_mat n n" unfolding reduce_a2_def using A by auto
have reduce_a1: "reduce_a1 ∈ carrier_mat m n" unfolding reduce_a1_def using A by auto
have j2: "∀j∈set ys. j < n ∧ reduce_a2 $$ (j, j) = D ∧ (∀j'∈{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
proof
fix j assume j_in_ys: "j ∈ set ys"
have a_jm: "a ≠ j+m" using a by auto
have m_not_jm: "m ≠ 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')"
unfolding A_def
by (meson B append_rows_nth2 assms(1) j_in_ys j_ys mn nat_SN.compat that)
finally show ?thesis .
qed
thus "j < n ∧ reduce_a2 $$ (j, j) = D ∧ (∀j'∈{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)
(λ(i, k). if i = m ∧ k ∈ set ys then if k = 0 ∧ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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≠a ∧ i≠m)")
case True
have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq
by (smt (verit) 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 (verit) 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≠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 ∈ 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 (verit) 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 ∧ 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 ∉ 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 (verit) 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 ∈ 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 ∧ 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 (verit) i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
also have "... = (if ja = 0 ∧ 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 ∧ 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 (verit) 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 ∉ 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 (verit) 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 (verit) 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 ∈ 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) ≠ 0" and D0: "D ≠ 0"
shows "reduce a b D A $$ (a, 0) ≠ 0" (is "?reduce $$ (a,0) ≠ _")
and "reduce_abs a b D A $$ (a, 0) ≠ 0" (is "?reduce_abs $$ (a,0) ≠ _")
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 "... ≠ 0" unfolding Let_def using D0
by (smt (verit) Aaj gcd_eq_0_iff gmod_0_imp_dvd)
finally show "reduce a b D A $$ (a, 0) ≠ 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 "... ≠ 0" unfolding Let_def using D0
by (smt (verit) Aaj gcd_eq_0_iff gmod_0_imp_dvd)
finally show "reduce_abs a b D A $$ (a, 0) ≠ 0" .
qed
lemma reduce_below_not0:
assumes A: "A ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and Aaj: "A $$ (a,0) ≠ 0"
and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "D≠ 0"
shows "reduce_below a xs D A $$ (a, 0) ≠ 0" (is "?R $$ (a,0) ≠ _")
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 ⋅⇩m 1⇩m n ∈ 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 ∈ 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) ≠ 0"
proof (rule "2.hyps")
show "reduce a x D A $$ (a, 0) ≠ 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 ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and Aaj: "A $$ (a,0) ≠ 0"
and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "D≠ 0"
shows "reduce_below_abs a xs D A $$ (a, 0) ≠ 0" (is "?R $$ (a,0) ≠ _")
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 ⋅⇩m 1⇩m n ∈ 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 ∈ 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) ≠ 0"
proof (rule "2.hyps")
show "reduce_abs a x D A $$ (a, 0) ≠ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
and "∀x ∈ set xs. x < m ∧ a < x"
and "D ≠ 0"
shows "reduce_below a (xs@[m]) D A $$ (a, 0) ≠ 0" (is "?R $$ (a,0) ≠ _")
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 ∈ 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 "... ≠ 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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" by simp
have A: "A ∈ 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 ∈ 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) ≠ 0"
proof (rule "2.hyps")
show "reduce a x D A $$ (a, 0) ≠ 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' @⇩r D ⋅⇩m 1⇩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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
and "∀x ∈ set xs. x < m ∧ a < x"
and "D ≠ 0"
shows "reduce_below_abs a (xs@[m]) D A $$ (a, 0) ≠ 0" (is "?R $$ (a,0) ≠ _")
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 ∈ 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 "... ≠ 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 ⋅⇩m 1⇩m n ∈ carrier_mat n n" by simp
have A: "A ∈ 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 ∈ 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) ≠ 0"
proof (rule "2.hyps")
show "reduce_abs a x D A $$ (a, 0) ≠ 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' @⇩r D ⋅⇩m 1⇩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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "m≥n"
and "D>0"
shows "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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: "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n)
∧ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "reduce a x D A $$ (a, 0) ≠ 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 ∈ 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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat (m+n) (m+n) ∧ (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 ∈ 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 ∈ 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 (verit) 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "m≥n"
and "D>0"
shows "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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: "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n)
∧ 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' @⇩r D ⋅⇩m 1⇩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) ≠ 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 ∈ 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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat (m+n) (m+n) ∧ (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 ∈ 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 ∈ 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 (verit) 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' ∈ carrier_mat m n" and a: "a<m" and j: "j<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∉ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)
show "i ∉ set xs" using i_set_xxs by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "j<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∉ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)
show "i ∉ set xs" using i_set_xxs by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∈ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
show "i ∉ set xs" using True d by auto
show "i ≠ 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' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
show "∀i∈{m..<m + n}. ∀ja<n. ?reduce_ax $$ (i, ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)"
proof (rule+)
fix i ja assume i: "i ∈ {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 ≠ a" using i a by auto
have i_not_x: "i ≠ 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 ⋅⇩m (1⇩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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" using i A' by auto
finally show "?reduce_ax $$ (i,ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)" .
qed
qed
show "i ∈ set xs" using i_set_xxs i_not_x by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∈ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
show "i ∉ set xs" using True d by auto
show "i ≠ 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' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
show "∀i∈{m..<m + n}. ∀ja<n. ?reduce_ax $$ (i, ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)"
proof (rule+)
fix i ja assume i: "i ∈ {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 ≠ a" using i a by auto
have i_not_x: "i ≠ 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 ⋅⇩m (1⇩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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" using i A' by auto
finally show "?reduce_ax $$ (i,ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)" .
qed
qed
show "i ∈ set xs" using i_set_xxs i_not_x by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "j<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∉ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠a" and "i<m+n" and "i≠ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)
show "i ∉ set xs" using i_set_xxs by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
show "i≠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' ∈ carrier_mat m n" and a: "a<m" and j: "j<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∉ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠a" and "i<m+n" and "i≠ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)
show "i ∉ set xs" using i_set_xxs by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
show "i≠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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "m≠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 ∈ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "m≠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 ∈ 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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
qed (insert "2.prems", auto)
finally show ?case .
qed
lemma reduce_below_preserves_case_m2:
assumes A': "A' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∈ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
show "∀i∈{m..<m + n}. ∀ja<n. ?reduce_ax $$ (i, ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)"
proof (rule+)
fix i ja assume i: "i ∈ {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 ≠ a" using i a by auto
have i_not_x: "i ≠ 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 ⋅⇩m (1⇩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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" using i A' by auto
finally show "?reduce_ax $$ (i,ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)" .
qed
qed
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
show "i ∉ set xs" using True d by auto
show "i ≠ a" using "2.prems" by blast
show "i < m + n"
by (simp add: True trans_less_add1 xm)
show "i ≠ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "i ∈ set xs" using i_set_xxs False by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∈ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠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≠0" using D_ge0 by simp
have A: "A ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ 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 ∈ 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' @⇩r D ⋅⇩m 1⇩m n"
proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
show "∀i∈{m..<m + n}. ∀ja<n. ?reduce_ax $$ (i, ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)"
proof (rule+)
fix i ja assume i: "i ∈ {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 ≠ a" using i a by auto
have i_not_x: "i ≠ 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 ⋅⇩m (1⇩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 ⋅⇩m 1⇩m n) $$ (i - m, ja)" using i A' by auto
finally show "?reduce_ax $$ (i,ja) = (D ⋅⇩m 1⇩m n) $$ (i - m, ja)" .
qed
qed
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "?A' ∈ carrier_mat m n" by auto
show "i ∉ set xs" using True d by auto
show "i ≠ a" using "2.prems" by blast
show "i < m + n"
by (simp add: True trans_less_add1 xm)
show "i ≠ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])
show "i ∈ set xs" using i_set_xxs False by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce_abs a x D A $$ (a, 0) ≠ 0"
by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "?A' ∈ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∈ set (xs @ [m])" and "distinct xs" and "∀x ∈ set xs. x < m ∧ 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' ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n"
assumes "i ∈ set (xs @ [m])" and "distinct xs" and "∀x ∈ set xs. x < m ∧ 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' ∈ carrier_mat m n" and a: "0<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (0,0) ≠ 0"
and mn: "m≥n"
assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "∀x ∈ set xs. x < m ∧ 0 < x"
and ia: "i≠0"
and xs_def: "xs = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and D: "D>0"
shows "reduce_below 0 (xs @ [m]) D A $$ (i,0) = 0"
proof (cases "i ∈ 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 ∈ 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' ∈ carrier_mat m n" and a: "0<m" and j: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (0,0) ≠ 0"
and mn: "m≥n"
assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "∀x ∈ set xs. x < m ∧ 0 < x"
and ia: "i≠0"
and xs_def: "xs = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and D: "D>0"
shows "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = 0"
proof (cases "i ∈ 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 ∈ 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
lemma reduce_below_invertible_mat_case_m:
assumes A': "A' ∈ carrier_mat m n" and a: "a<m" and n0: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and D0: "D>0"
shows "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ 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 ⋅⇩m (1⇩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 ⋅⇩m (1⇩m n)) $$ (m-m,0)"
unfolding "1"(4)
by (meson "1"(1) "1"(3) D append_rows_nth3 less_add_same_cancel1 order.refl)
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)
(λ(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 "∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n) ∧ 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 ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ carrier_mat n n" by (simp add: mn)
have Am0_D: "A $$ (m, 0) = D"
proof -
have "A $$ (m, 0) = (D ⋅⇩m (1⇩m n)) $$ (m-m,0)"
unfolding "2"(5)
by (meson "2"(2) "2"(4) D1 append_rows_nth3 less_add_same_cancel1 verit_comp_simplify(2))
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 ∈ 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: "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n)
∧ 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' @⇩r D ⋅⇩m 1⇩m n"
by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj])
show "reduce a x D A $$ (a, 0) ≠ 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 ∈ 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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat (m+n) (m+n) ∧ (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 ∈ 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 ∈ 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 (verit) 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_case_m:
assumes A': "A' ∈ carrier_mat m n" and a: "a<m" and n0: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and Aaj: "A $$ (a,0) ≠ 0"
and mn: "m≥n" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and D0: "D>0"
shows "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m+n) (m+n) ∧ 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 ⋅⇩m (1⇩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 ⋅⇩m (1⇩m n)) $$ (m-m,0)"
unfolding "1"(4)
by (meson "1"(1) "1"(3) D append_rows_nth3 le_refl 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)
(λ(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 (λi. D < ¦?A $$ (a, i)¦) [0..<n]"
let ?ys = "filter (λi. D < ¦?A $$ (m, i)¦) [0..<n]"
have "∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n) ∧ 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 ∈ carrier_mat (m+n) n" using A' mn A_def by auto
have xm: "x < m" using "2.prems" by auto
have D1: "D ⋅⇩m 1⇩m n ∈ carrier_mat n n" by (simp add: mn)
have Am0_D: "A $$ (m, 0) = D"
proof -
have "A $$ (m, 0) = (D ⋅⇩m (1⇩m n)) $$ (m-m,0)"
unfolding "2"(5)
by (meson "2"(2) "2"(4) D1 append_rows_nth3 less_add_same_cancel1 order_refl)
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 ∈ 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: "(∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n)
∧ 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' @⇩r D ⋅⇩m 1⇩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) ≠ 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 ∈ 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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat (m+n) (m+n) ∧ (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 ∈ 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 ∈ 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 (verit) 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 ‹This lemma will be very important, since it will allow us to prove that the output
matrix is in echelon form.›
lemma echelon_form_four_block_mat:
assumes A: "A ∈ carrier_mat 1 1"
and B: "B ∈ carrier_mat 1 (n-1)"
and D: "D ∈ carrier_mat (m-1) (n-1)"
and H_def: "H = four_block_mat A B (0⇩m (m-1) 1) D"
and A00: "A $$ (0,0) ≠ 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 ∈ 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⇩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∈{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⇩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⇩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 "¬ 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≠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 (verit) 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 (verit) H Nat.lessE Suc_pred carrier_matD(1) diff_Suc_1 diff_Suc_less order.strict_trans)
thus ?thesis
by (smt (verit) 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 "∀i<dim_row H. is_zero_row_JNF i H ⟶ ¬ (∃j<dim_row H. i < j ∧ ¬ is_zero_row_JNF j H)"
by blast
have "(LEAST n. H $$ (i, n) ≠ 0) < (LEAST n. H $$ (j, n) ≠ 0)"
if ij: "i < j" and j: "j < dim_row H" and not_zero_iH: "¬ is_zero_row_JNF i H"
and not_zero_jH: "¬ is_zero_row_JNF j H" for i j
proof (cases "i = 0")
case True
have "(LEAST n. H $$ (i, n) ≠ 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) ≠ 0)"
let ?least_Hj = "(LEAST n. H $$ (j, n) ≠ 0)"
have least_not0: "(LEAST n. H $$ (i, n) ≠ 0) ≠ 0"
proof -
have ‹dim_row H = m›
using H by auto
with ‹i < j› ‹j < dim_row H› have ‹i < m›
by simp
then have ‹H $$ (i, 0) = 0›
using i_not0 by (auto simp add: Suc_le_eq intro: Hi0)
moreover from is_zero_row_JNF_def [of i H] not_zero_iH
obtain n where ‹H $$ (i, n) ≠ 0›
by blast
ultimately show ?thesis
by (metis (mono_tags, lifting) LeastI)
qed
have least_not0j: "(LEAST n. H $$ (j, n) ≠ 0) ≠ 0"
proof -
have "∃n. H $$ (j, 0) = 0 ∧ H $$ (j, n) ≠ 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 (verit) 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) ≠ 0" and ln':"(∀n'. (H $$ (i, n') ≠ 0) ⟶ ?least_H ≤ 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⇩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: "¬ 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: "¬ is_zero_row_JNF (j-1) D"
by (smt (verit) 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) ≠ 0 ∧ n<dim_col D)"
proof (rule Least_equality[symmetric], rule)
show "D $$ (i - 1, ?least_H - 1) ≠ 0" using Hil Hil_Dil by auto
show "(LEAST n. H $$ (i, n) ≠ 0) - 1 < dim_col D" using least_n least_not0 H D n by auto
fix n' assume "D $$ (i - 1, n') ≠ 0 ∧ n' < dim_col D"
hence Di1n'1: "D $$ (i - 1, n') ≠ 0" and n': "n' < dim_col D" by auto
have "(LEAST n. H $$ (i, n) ≠ 0) ≤ 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) ≠ 0" using False Di1n'1 Hij_Dij' by auto
qed
thus "(LEAST n. H $$ (i, n) ≠ 0) -1 ≤ n'" using least_not0 by auto
qed
also have "... = (LEAST n. D $$ (i-1, n) ≠ 0)"
proof (rule Least_equality)
have "D $$ (i - 1, LEAST n. D $$ (i - 1, n) ≠ 0) ≠ 0"
by (metis (mono_tags, lifting) Hil Hil_Dil LeastI_ex)
moreover have leastD: "(LEAST n. D $$ (i - 1, n) ≠ 0) < dim_col D"
by (smt (verit) 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) ≠ 0) ≠ 0
∧ (LEAST n. D $$ (i - 1, n) ≠ 0) < dim_col D" by simp
fix y assume "D $$ (i - 1, y) ≠ 0 ∧ y < dim_col D"
thus "(LEAST n. D $$ (i - 1, n) ≠ 0) ≤ y" by (meson wellorder_Least_lemma(2))
qed
finally have leastHi_eq: "?least_H - 1 = (LEAST n. D $$ (i-1, n) ≠ 0)" .
have least_nj: "?least_Hj<n"
by (smt (verit) 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) ≠ 0" and ln':"(∀n'. (H $$ (j, n') ≠ 0) ⟶ ?least_Hj ≤ 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⇩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) ≠ 0) - 1 = (LEAST n. D $$ (j-1, n) ≠ 0 ∧ n<dim_col D)"
proof (rule Least_equality[symmetric], rule)
show "D $$ (j - 1, ?least_Hj - 1) ≠ 0" using Hil Hil_Dil
by (smt (verit) 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) ≠ 0) - 1 < dim_col D" using least_nj least_not0j H D n by auto
fix n' assume "D $$ (j - 1, n') ≠ 0 ∧ n' < dim_col D"
hence Di1n'1: "D $$ (j - 1, n') ≠ 0" and n': "n' < dim_col D" by auto
have "(LEAST n. H $$ (j, n) ≠ 0) ≤ 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) ≠ 0" using False Di1n'1 Hij_Dij' by auto
qed
thus "(LEAST n. H $$ (j, n) ≠ 0) -1 ≤ n'" using least_not0 by auto
qed
also have "... = (LEAST n. D $$ (j-1, n) ≠ 0)"
proof (rule Least_equality)
have "D $$ (j - 1, LEAST n. D $$ (j - 1, n) ≠ 0) ≠ 0"
by (metis (mono_tags, lifting) Hjl Hjl_Djl LeastI_ex)
moreover have leastD: "(LEAST n. D $$ (j - 1, n) ≠ 0) < dim_col D"
by (smt (verit) 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) ≠ 0) ≠ 0
∧ (LEAST n. D $$ (j - 1, n) ≠ 0) < dim_col D" by simp
fix y assume "D $$ (j - 1, y) ≠ 0 ∧ y < dim_col D"
thus "(LEAST n. D $$ (j - 1, n) ≠ 0) ≤ y" by (meson wellorder_Least_lemma(2))
qed
finally have leastHj_eq: "(LEAST n. H $$ (j, n) ≠ 0) - 1 = (LEAST n. D $$ (j-1, n) ≠ 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) ≠ 0) < (LEAST n. D $$ (j-1, n) ≠ 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 "∀i j. i < j ∧ j < dim_row H ∧ ¬ is_zero_row_JNF i H ∧ ¬ is_zero_row_JNF j H
⟶ (LEAST n. H $$ (i, n) ≠ 0) < (LEAST n. H $$ (j, n) ≠ 0)" by blast
qed
context mod_operation
begin
lemma reduce_below:
assumes "A ∈ carrier_mat m n"
shows "reduce_below a xs D A ∈ 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 ∈ carrier_mat m n"
shows "reduce_below_abs a xs D A ∈ 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 ∈ carrier_mat m n" and "m<2 ∨ n = 0"
shows "FindPreHNF abs_flag D A ∈ carrier_mat m n" using assms by auto
lemma FindPreHNF_mx1:
assumes A: "A ∈ carrier_mat m n" and "m≥2" and "n ≠ 0" "n<2"
shows "FindPreHNF abs_flag D A ∈ carrier_mat m n"
proof (cases "abs_flag")
case True
let ?nz = "(filter (λi. A $$ (i, 0) ≠ 0) [1..<m])"
have "FindPreHNF abs_flag D A = (let non_zero_positions = filter (λi. A $$ (i, 0) ≠ 0) [Suc 0..<m]
in reduce_below_abs 0 non_zero_positions D (if A $$ (0, 0) ≠ 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) ≠ 0 then A
else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto
also have "... ∈ carrier_mat m n" using A by auto
finally show ?thesis .
next
case False
let ?nz = "(filter (λi. A $$ (i, 0) ≠ 0) [1..<m])"
have "FindPreHNF abs_flag D A = (let non_zero_positions = filter (λi. A $$ (i, 0) ≠ 0) [Suc 0..<m]
in reduce_below 0 non_zero_positions D (if A $$ (0, 0) ≠ 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) ≠ 0 then A
else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto
also have "... ∈ carrier_mat m n" using A by auto
finally show ?thesis .
qed
lemma FindPreHNF_mxn2:
assumes A: "A ∈ carrier_mat m n" and m: "m≥2" and n: "n≥2"
shows "FindPreHNF abs_flag D A ∈ 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 (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
define A' where "A' = (if A $$ (0, 0) ≠ 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' ∈ carrier_mat m n" unfolding A'_def using A by auto
have A'_DR: "A'_DR ∈ 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 ∈ 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 ∈ 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 ∈ 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 ∈ 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 (verit) Reduce_def carrier_matD(1) carrier_matD(2) linorder_not_less prod.simps(2))+
also have "... ∈ carrier_mat m n"
by (smt (verit) 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 ∈ carrier_mat m n"
shows "FindPreHNF abs_flag D A ∈ 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' ∈ carrier_mat m n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩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]) @⇩r (D ⋅⇩m (1⇩m n))"
proof (rule matrix_append_rows_eq_if_preserves)
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
thus "make_first_column_positive A ∈ carrier_mat (m + n) n" by auto
have "make_first_column_positive A $$ (i, j) = (D ⋅⇩m 1⇩m n) $$ (i - m, j)"
if j: "j<n" and i: "i ∈ {m..<m + n}" for i j
proof -
have i_mn: "i<m+n" using i by auto
have "A $$ (i,0) = (D ⋅⇩m 1⇩m n) $$ (i - m, 0)" unfolding A_def
by (smt (verit) 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 "... ≥ 0" using D0 mult_not_zero that(2) by auto
finally have Ai0: "A$$(i,0)≥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 ⋅⇩m 1⇩m n) $$ (i - m, j)" unfolding A_def
by (smt (verit) 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 "∀i∈{m..<m + n}. ∀j<n. make_first_column_positive A $$ (i, j) = (D ⋅⇩m 1⇩m n) $$ (i - m, j)"
by simp
qed (auto)
lemma A'_swaprows_invertible_mat:
fixes A::"int mat"
assumes A: "A∈carrier_mat m n"
assumes A'_def: "A' = (if A $$ (0, 0) ≠ 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
and nz_def: "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and nz_empty: "A$$(0,0) =0 ⟹ non_zero_positions ≠ []"
and m0: "0<m"
shows "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ A' = P * A"
proof (cases "A$$(0,0) ≠ 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 ≠ []" 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 ∈ 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 ≠ 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 ∈ 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' ∈ carrier_mat m n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and i:"i<m"
shows "swaprows 0 i A
= mat_of_rows n (map (Matrix.row (swaprows 0 i A)) [0..<m]) @⇩r (D ⋅⇩m (1⇩m n))"
proof (rule matrix_append_rows_eq_if_preserves)
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
show swap: "swaprows 0 i A ∈ carrier_mat (m + n) n" by (simp add: A)
have "swaprows 0 i A $$ (ia, j) = (D ⋅⇩m 1⇩m n) $$ (ia - m, j)"
if ia: "ia ∈ {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 ⋅⇩m 1⇩m n) $$ (ia - m, j)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (ia - m, j)" .
qed
thus "∀ia∈{m..<m + n}. ∀j<n. swaprows 0 i A $$ (ia, j) = (D ⋅⇩m 1⇩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' @⇩r D ⋅⇩m 1⇩m n"
and A': "A' ∈ carrier_mat m n"
and nz_def: "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and m0: "0<m" and n0: "0<n"
and D0: "D ≠ 0"
shows "∃xs. non_zero_positions = xs @ [m] ∧ distinct xs ∧ (∀x∈set xs. x < m ∧ 0 < x)"
proof -
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
let ?xs = "filter (λi. A $$ (i,0) ≠ 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 (λi. A $$ (i,0) ≠ 0) ([m+1..<dim_row A]) = []"
proof (rule filter_False)
have "A $$ (i,0) = 0" if i: "i∈set [m + 1..<dim_row A]" for i
proof -
have "A $$ (i,0) = (D ⋅⇩m 1⇩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 "∀x∈set [m + 1..<dim_row A]. ¬ A $$ (x, 0) ≠ 0" by blast
qed
have fm: "filter (λi. A $$ (i,0) ≠ 0) [m] = [m]"
proof -
have "A $$ (m, 0) = (D ⋅⇩m 1⇩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 (λi. A $$ (i,0) ≠ 0) ([1..<m+1]@[m+1..<dim_row A])"
using nz_def l_rw by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m+1] @ filter (λi. A $$ (i,0) ≠ 0) ([m+1..<dim_row A])"
by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m+1]" using f0 by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) ([1..<m]@[m])" using m0 by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m] @ [m]" using fm by auto
finally have "non_zero_positions = ?xs @ [m]" .
moreover have "distinct ?xs" by auto
moreover have "(∀x∈set ?xs. x < m ∧ 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' @⇩r D ⋅⇩m 1⇩m n"
and A': "A' ∈ carrier_mat m n"
and nz_def: "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and m0: "0<m" and n0: "0<n"
and D0: "D ≠ 0"
shows "non_zero_positions = (filter (λi. A $$ (i,0) ≠ 0) [1..<m]) @ [m]
∧ distinct (filter (λi. A $$ (i,0) ≠ 0) [1..<m])
∧ (∀x∈set (filter (λi. A $$ (i,0) ≠ 0) [1..<m]). x < m ∧ 0 < x)"
proof -
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
let ?xs = "filter (λi. A $$ (i,0) ≠ 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 (λi. A $$ (i,0) ≠ 0) ([m+1..<dim_row A]) = []"
proof (rule filter_False)
have "A $$ (i,0) = 0" if i: "i∈set [m + 1..<dim_row A]" for i
proof -
have "A $$ (i,0) = (D ⋅⇩m 1⇩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 "∀x∈set [m + 1..<dim_row A]. ¬ A $$ (x, 0) ≠ 0" by blast
qed
have fm: "filter (λi. A $$ (i,0) ≠ 0) [m] = [m]"
proof -
have "A $$ (m, 0) = (D ⋅⇩m 1⇩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 (λi. A $$ (i,0) ≠ 0) ([1..<m+1]@[m+1..<dim_row A])"
using nz_def l_rw by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m+1] @ filter (λi. A $$ (i,0) ≠ 0) ([m+1..<dim_row A])"
by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m+1]" using f0 by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) ([1..<m]@[m])" using m0 by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m] @ [m]" using fm by auto
finally have "non_zero_positions = ?xs @ [m]" .
moreover have "distinct ?xs" by auto
moreover have "(∀x∈set ?xs. x < m ∧ 0 < x)" by auto
ultimately show ?thesis by blast
qed
lemma A_A'D_eq_first_n_rows:
assumes A_def: "A = A' @⇩r D ⋅⇩m 1⇩m n"
and A': "A' ∈ carrier_mat m n"
and mn: "m≥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 ⋅⇩m 1⇩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' @⇩r D ⋅⇩m 1⇩m n"
and A': "A' ∈ carrier_mat m n"
and nz_def: "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and m0: "0<m" and n0: "0<n"
and D0: "D ≠ 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≥n"
shows "length non_zero_positions > 1"
proof -
have A: "A ∈ carrier_mat (m+n) n" using A' A_def by auto
have D: "D ⋅⇩m 1⇩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'' ∈ carrier_mat n n" by auto
have RAT_A'': "?RAT ?A'' ∈ carrier_mat n n" by auto
let ?ys = "filter (λi. A $$ (i,0) ≠ 0) [1..<m]"
let ?xs = "filter (λi. A $$ (i,0) ≠ 0) [1..<n]"
have xs_not_empty:"?xs ≠ []"
proof (rule ccontr)
assume "¬ ?xs ≠ []" 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 "(∀i∈set [1..<n]. A $$ (i,0) = 0)"
by (metis (mono_tags, lifting) empty_filter_conv xs0)
hence *: "(∀i<n. A $$ (i,0) = 0)" using A00 n0 using linorder_not_less by force
have "col ?A'' 0 = 0⇩v n"
proof (rule eq_vecI)
show "dim_vec (col ?A'' 0) = dim_vec (0⇩vn)" using A' by auto
fix i assume i: "i < dim_vec (0⇩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⇩v n $v i" using i by auto
qed
hence "col (?RAT ?A'') 0 = 0⇩v n" by auto
hence "¬ 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 (λi. A $$ (i,0) ≠ 0) ([m+1..<dim_row A]) = []"
proof (rule filter_False)
have "A $$ (i,0) = 0" if i: "i∈set [m + 1..<dim_row A]" for i
proof -
have "A $$ (i,0) = (D ⋅⇩m 1⇩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 "∀x∈set [m + 1..<dim_row A]. ¬ A $$ (x, 0) ≠ 0" by blast
qed
have fm: "filter (λi. A $$ (i,0) ≠ 0) [m] = [m]"
proof -
have "A $$ (m, 0) = (D ⋅⇩m 1⇩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 (λi. A $$ (i,0) ≠ 0) ([1..<m+1]@[m+1..<dim_row A])"
using nz_def l_rw by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m+1] @ filter (λi. A $$ (i,0) ≠ 0) ([m+1..<dim_row A])"
by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m+1]" using f0 by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) ([1..<m]@[m])" using m0 by auto
also have "... = filter (λi. A $$ (i,0) ≠ 0) [1..<m] @ [m]" using fm by auto
finally have nz: "non_zero_positions = ?ys @ [m]" .
moreover have ys_not_empty: "?ys ≠ []" 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' @⇩r D ⋅⇩m 1⇩m n"
and A': "A' ∈ carrier_mat m n"
and nz_def: "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and m0: "0<m" and n0: "0<n"
and D0: "D ≠ 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≥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) ≠ 0) = (A $$ (i, j) ≠ 0)"
using assms unfolding make_first_column_positive.simps by auto
lemma make_first_column_positive_00:
assumes A_def: "A = A'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' : carrier_mat m n"
assumes nz_def: "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
and A'_def: "A' = (if A $$ (0, 0) ≠ 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 ≠ 0" and mn: "m≥n"
shows "make_first_column_positive A' $$ (0, 0) ≠ 0"
proof -
have A: "A ∈ carrier_mat (m+n) n" using A_def A'' by auto
hence A': "A' ∈ carrier_mat (m+n) n" unfolding A'_def by auto
have "(make_first_column_positive A' $$ (0, 0) ≠ 0) = (A' $$ (0, 0) ≠ 0)"
by (rule make_first_column_positive_nz_conv, insert m0 n0 A', auto)
moreover have "A' $$ (0, 0) ≠ 0"
proof (cases "A $$ (0, 0) ≠ 0")
case True
then show ?thesis unfolding A'_def by auto
next
case False
have "A $$ (0, 0) = A'' $$ (0, 0)"
by (smt (verit) 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: "∀x∈set xs. x < m ∧ 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) ≠ 0"
by (smt (verit, ccfv_threshold) add_gr_0 length_append less_numeral_extra(1) list.size(4) local.non_zero_positions_xs_m mem_Collect_eq nth_mem nz_def plus_1_eq_Suc set_filter)
have "A' $$ (0, 0) = swaprows 0 ?i A $$ (0,0)" using False A'_def by auto
also have "... ≠ 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' ∈ carrier_mat m n" and m0: "0<m" and n0: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and mn: "m≥n"
assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "∀x ∈ set xs. x < m ∧ 0 < x"
and ia: "i≠0"
and A''_def: "A'' = (if A $$ (0, 0) ≠ 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 (λi. A $$ (i,0) ≠ 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 ∈ carrier_mat (m+n) n" using A' A_def by auto
define xs where "xs = filter (λi. A $$ (i,0) ≠ 0) [1..<m]"
have nz_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
and all_less_m: "∀x∈set xs. x < m ∧ 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'' ∈ carrier_mat (m+n) n" using A' A_def A''_def by auto
have D_not0: "D≠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 ⋅⇩m (1⇩m n)) ∈ carrier_mat n n" by simp
have "A $$ (i, 0) = (D ⋅⇩m (1⇩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' ∈ carrier_mat m n" using A'' by auto
have mk0: "make_first_column_positive A'' $$ (0, 0) ≠ 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' @⇩r D ⋅⇩m 1⇩m n" if xs_empty: "xs ≠ []"
proof (cases "A$$(0,0) ≠ 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 @⇩r (D ⋅⇩m (1⇩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 ≥ 1" "D ≥ 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 ∈ 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 (verit) 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 (λn. A $$ (n, 0) ≠ 0) [1..<m] = []"
using xs_empty xs_def by presburger
then have "∀n. A $$ (n, 0) = 0 ∨ n ∉ 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) ≠ 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 (verit) 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 (λn. A $$ (n, 0) ≠ 0) [1..<m] = []"
using True xs_def by presburger
then have "∀n. A $$ (n, 0) = 0 ∨ n ∉ 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 ∈ 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) ≠ 0) = (A'' $$ (i,0) ≠ 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) ≠ 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≠?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 (verit) 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' ∈ carrier_mat m n" and m0: "0<m" and n0: "0<n"
and A_def: "A = A' @⇩r (D ⋅⇩m (1⇩m n))"
and mn: "m≥n"
assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "∀x ∈ set xs. x < m ∧ 0 < x"
and ia: "i≠0"
and A''_def: "A'' = (if A $$ (0, 0) ≠ 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 (λi. A $$ (i,0) ≠ 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 ∈ carrier_mat (m+n) n" using A' A_def by auto
define xs where "xs = filter (λi. A $$ (i,0) ≠ 0) [1..<m]"
have nz_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
and all_less_m: "∀x∈set xs. x < m ∧ 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'' ∈ carrier_mat (m+n) n" using A' A_def A''_def by auto
have D_not0: "D≠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 ⋅⇩m (1⇩m n)) ∈ carrier_mat n n" by simp
have "A $$ (i, 0) = (D ⋅⇩m (1⇩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' ∈ carrier_mat m n" using A'' by auto
have mk0: "make_first_column_positive A'' $$ (0, 0) ≠ 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' @⇩r D ⋅⇩m 1⇩m n" if xs_empty: "xs ≠ []"
proof (cases "A$$(0,0) ≠ 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 @⇩r (D ⋅⇩m (1⇩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 ≥ 1" "D ≥ 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 ∈ 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 (verit) 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 (λn. A $$ (n, 0) ≠ 0) [1..<m] = []"
using xs_empty xs_def by presburger
then have "∀n. A $$ (n, 0) = 0 ∨ n ∉ 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) ≠ 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 (verit) 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 (λn. A $$ (n, 0) ≠ 0) [1..<m] = []"
using True xs_def by presburger
then have "∀n. A $$ (n, 0) = 0 ∨ n ∉ 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 ∈ 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) ≠ 0) = (A'' $$ (i,0) ≠ 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) ≠ 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≠?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 (verit) 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 ∈ carrier_mat m n" and "m<2"
shows "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' ∈ carrier_mat m n" and n2: "n<2" and n0: "0<n" and D_g0: "D>0" and mn: "m≥n"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ FindPreHNF abs_flag D A = P * A"
proof -
have A: "A ∈ carrier_mat (m+n) n" using A_def A'' by auto
have m0: "m>0" using mn n2 n0 by auto
have D0: "D≠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 ≥2" using False n2 A by auto
have dc_A: "dim_col A < 2" using n2 A by auto
let ?non_zero_positions = "filter (λi. A $$ (i, 0) ≠ 0) [Suc 0..<dim_row A]"
let ?A' = "(if A $$ (0, 0) ≠ 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)"
define xs where "xs = filter (λi. A $$ (i,0) ≠ 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: "∀x∈set xs. x < m ∧ 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≠[]" using that unfolding nz_xs_m by auto
have inv: "∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n)
∧ reduce_below 0 ?non_zero_positions D ?A' = P * ?A'"
proof (cases "A $$ (0,0) ≠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) ≠ 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 ⋅⇩m 1⇩m n) $$ (m-m, 0)"
unfolding A_def
by (meson append_rows_nth3 assms(2) assms(4) less_add_same_cancel1 one_carrier_mat order_refl smult_carrier_mat)
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 " ∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n) ∧
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) ≠ 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))
(λ(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' @⇩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' ∈ carrier_mat m n" unfolding S'_def by fastforce
show S'': "S'' ∈ carrier_mat n n" unfolding S''_def by fastforce
show "0 ≠ 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))
(λ(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) ∧ (∀j'∈{0..<n}-{j}. S'' $$ (j, j') = 0)"
if jn: "j<n" and j0: "j>0" for j
proof -
have "S'' $$ (j, i) = (D ⋅⇩m 1⇩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 ⋅⇩m 1⇩m n) $$ (j,i)"
by (smt (verit) 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 ∉ 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 "∀j∈set xs'. j<n ∧ (S'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. S'' $$ (j, j') = 0)"
using S''D xs'_def by auto
have "0 ∉ 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 "∀j∈set ys'. j<n ∧ (S'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. S'' $$ (j, j') = 0)"
using S''D ys'_def by auto
show "swaprows 0 m A $$ (m, 0) ∈ {0, D}" using Sm0 by blast
thus "swaprows 0 m A $$ (m, 0) = 0 ⟶ 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' ∈ 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' @⇩r D ⋅⇩m 1⇩m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m])
thus "(if A $$ (0, 0) ≠ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @⇩r D ⋅⇩m 1⇩m n"
using rw nz_xs_m by argo
have "A $$ (filter (λi. A $$ (i, 0) ≠ 0) [Suc 0..<dim_row A] ! 0, 0) ≠ 0"
by (metis (mono_tags, lifting) Cons_eq_filterD l length_nth_simps(1) length_nth_simps(3) list.exhaust not_one_less_zero)
then have "?S $$ (0, 0) ≠ 0"
by (metis A add_sign_intros(2) carrier_matD(1) carrier_matD(2) index_mat_swaprows(1) m0 n0)
thus "(if A $$ (0, 0) ≠ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) ≠ 0"
using rw nz_xs_m by algebra
qed
qed
qed
have inv2: "∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n)
∧ reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'"
proof (cases "A $$ (0,0) ≠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) ≠ 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 ⋅⇩m 1⇩m n) $$ (m-m, 0)"
unfolding A_def
by (meson append_rows_nth3 assms(2) assms(4) less_add_same_cancel1 one_carrier_mat order.refl smult_carrier_mat)
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 " ∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n) ∧
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) ≠ 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))
(λ(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' @⇩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' ∈ carrier_mat m n" unfolding S'_def by fastforce
show S'': "S'' ∈ carrier_mat n n" unfolding S''_def by fastforce
show "0 ≠ 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))
(λ(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 (λi. abs (A2 $$ (0,i)) > D) [0..<n]"
define ys' where "ys' = filter (λi. abs (A2 $$ (m,i)) > D) [0..<n]"
show "xs' = filter (λi. abs (A2 $$ (0,i)) > D) [0..<n]" unfolding xs'_def by auto
show "ys' = filter (λi. abs (A2 $$ (m,i)) > D) [0..<n]" unfolding ys'_def by auto
have S''D: "(S'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. S'' $$ (j, j') = 0)"
if jn: "j<n" and j0: "j>0" for j
proof -
have "S'' $$ (j, i) = (D ⋅⇩m 1⇩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 ⋅⇩m 1⇩m n) $$ (j,i)"
by (smt (verit) 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 ∉ 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 "∀j∈set xs'. j<n ∧ (S'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. S'' $$ (j, j') = 0)"
using S''D xs'_def by auto
have "0 ∉ 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 "∀j∈set ys'. j<n ∧ (S'' $$ (j, j) = D) ∧ (∀j'∈{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' ∈ 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' @⇩r D ⋅⇩m 1⇩m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m])
thus "(if A $$ (0, 0) ≠ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @⇩r D ⋅⇩m 1⇩m n"
using rw nz_xs_m by argo
have "?S $$ (0, 0) ≠ 0"
by (smt (verit) 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) ≠ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) ≠ 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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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) ∈ 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 ∈ 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 "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ ?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 ∈ 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) ∈ 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 ∈ 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'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' ∈ carrier_mat m n" and n2: "n<2" and D_g0: "D>0" and mn: "m≥n"
shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
proof (cases "n=0")
case True
have A: "A ∈ 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 ∈ carrier_mat (m+n) n" using A_def A'' by auto
have m0: "m>0" using mn n2 n0 by auto
have D0: "D≠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 ≥2" using False n2 A by auto
have dc_A: "dim_col A < 2" using n2 A by auto
let ?non_zero_positions = "filter (λi. A $$ (i, 0) ≠ 0) [Suc 0..<dim_row A]"
let ?A' = "(if A $$ (0, 0) ≠ 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)"
define xs where "xs = filter (λi. A $$ (i,0) ≠ 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: "∀x∈set xs. x < m ∧ 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≠[]" 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) ≠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 ∈ carrier_mat (m+n) n" using A by auto
show "∀i∈{1..<m + n}. reduce_below 0 ?non_zero_positions D A $$ (i, 0) = 0"
proof
fix i assume i: "i ∈ {1..<m + n}"
show "reduce_below 0 ?non_zero_positions D A $$ (i, 0) =0"
proof (cases "i∈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) ≠ 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 ∈ 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 ⋅⇩m 1⇩m n) $$ (m-m, 0)"
by (smt (verit) 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) ∈ carrier_mat (m+n) n"
using A n2 reduce_carrier by (auto simp add: Let_def)
show "∀i∈{1..<m+n}. reduce 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
proof
fix i assume i: "i ∈ {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 ∈ 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 ∈ 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) ≠ 0" hence "i ∈ 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 "A $$ ((xs @ [m]) ! 0, 0) ≠ 0"
by (metis (mono_tags, lifting) Cons_eq_filterD List.min_list.cases append_is_Nil_conv nth_Cons_0 nz_xs_m)
then have S00: "?S $$ (0,0) ≠ 0"
using A n0 by auto
have S': "?S' ∈ carrier_mat m n" using A by auto
have S_S'D: "?S = ?S' @⇩r D ⋅⇩m 1⇩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 ∈ carrier_mat (m+n) n" using A by auto
show "∀i∈{1..<m + n}. reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) = 0"
proof
fix i assume i: "i ∈ {1..<m + n}"
show "reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) =0"
proof (cases "i∈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) ≠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 ∈ carrier_mat (m+n) n" using A by auto
show "∀i∈{1..<m + n}. reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) = 0"
proof
fix i assume i: "i ∈ {1..<m + n}"
show "reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) =0"
proof (cases "i∈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) ≠ 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 ∈ 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 ⋅⇩m 1⇩m n) $$ (m-m, 0)"
by (smt (verit) 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) ∈ carrier_mat (m+n) n"
using A n2 reduce_carrier by (auto simp add: Let_def)
show "∀i∈{1..<m+n}. reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
proof
fix i assume i: "i ∈ {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 ∈ 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 ∈ 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) ≠ 0" hence "i ∈ 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 "A $$ ((xs @ [m]) ! 0, 0) ≠ 0"
by (smt (verit) append_Cons_nth_left l_xs mem_Collect_eq nth_mem set_filter xs_def)
then have S00: "?S $$ (0,0) ≠ 0"
using A n0 by auto
have S': "?S' ∈ carrier_mat m n" using A by auto
have S_S'D: "?S = ?S' @⇩r D ⋅⇩m 1⇩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 ∈ carrier_mat (m+n) n" using A by auto
show "∀i∈{1..<m + n}. reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) = 0"
proof
fix i assume i: "i ∈ {1..<m + n}"
show "reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) =0"
proof (cases "i∈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'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' ∈ carrier_mat m n" and "n≥2" and m_le_n: "m≥n" and "D>0"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ FindPreHNF abs_flag D A = P * A ∧ 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 ∈ carrier_mat (m+n) n" using A_def A'' by auto
have mn: "2≤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≠0" using D0 by auto
define non_zero_positions where "non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
define A' where "A' = (if A $$ (0, 0) ≠ 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: "∀x∈set xs. x < m ∧ 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' ∈ carrier_mat (m+n) n" unfolding A'_def using A by auto
have mk_A'_not0:"make_first_column_positive A' $$ (0,0) ≠ 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 ∈ 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' ∈ carrier_mat m n" by auto
have M_M'D: "make_first_column_positive A' = ?M' @⇩r D ⋅⇩m 1⇩m n" if xs_empty: "xs ≠ []"
proof (cases "A$$(0,0) ≠ 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 @⇩r (D ⋅⇩m (1⇩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 ∈ 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 ∈ carrier_mat (m + (n -1)) (n-1)"
unfolding sub_PreHNF_def by (rule FindPreHNF[OF A'_DR])
hence sub_PreHNF': "sub_PreHNF ∈ carrier_mat (m+n - 1) (n-1)" using n by auto
have A'_UL: "A'_UL ∈ 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 ∈ 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 ∈ 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⇩m (m + (n - 1)) 1)"
proof (rule eq_matI)
show "dim_row A'_DL = dim_row (0⇩m (m + (n - 1)) 1)"
and "dim_col A'_DL = dim_col (0⇩m (m + (n - 1)) 1)" using A'_DL by auto
fix i j assume i: "i < dim_row (0⇩m (m + (n - 1)) 1)" and j: "j < dim_col (0⇩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) ≠ 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 (λi. A $$ (i, 0) ≠ 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⇩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 ← [0..<m]]"
have A'_DR_m: "?A'_DR_m ∈ carrier_mat m (n-1)" by auto
have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @⇩r D ⋅⇩m 1⇩m (n - 1)"
proof (rule eq_matI)
show dr: "dim_row A'_DR = dim_row (?A'_DR_m @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩m (n - 1))"
and j: "j<dim_col (?A'_DR_m @⇩r D ⋅⇩m 1⇩m (n - 1))"
have jn1: "j<n-1" using dc j A'_DR by auto
show "A'_DR $$ (i,j) = (?A'_DR_m @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩m (n - 1)) $$ (i,j) = (D ⋅⇩m 1⇩m (n - 1)) $$ (i-m,j)"
by (smt (verit) 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 ≠ 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 ⋅⇩m 1⇩m n) $$ ((i+1)-m, j+1)"
proof (cases "A $$ (0,0) = 0")
case True
let ?S = "(swaprows 0 m A)"
have S: "?S ∈ 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,0)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,j+1)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,0)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,j+1)"
by (smt (verit) 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⇩m n) $$ ((i+1)-m, j+1)"
by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)
also have "... = D *(1⇩m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
by (smt (verit) 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 ⋅⇩m 1⇩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 ∉ set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto
show "i + 1 ≠ 0" by auto
show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto
show " i + 1 ≠ m" using i_ge_m by auto
qed (insert False)
also have "... = (?M' @⇩r D ⋅⇩m 1⇩m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo
also have "... = (D ⋅⇩m 1⇩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: "∀n. ¬ 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⇩m n) $$ ((i+1)-m, j+1)"
by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)
also have "... = D *(1⇩m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
by (smt (verit) 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 ⋅⇩m 1⇩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 ⋅⇩m 1⇩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: "∃P. P∈carrier_mat (m + (n-1)) (m + (n-1)) ∧ invertible_mat P ∧ sub_PreHNF = P * A'_DR
∧ echelon_form_JNF sub_PreHNF"
proof (cases "2 ≤ 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 "∃P. P∈carrier_mat (m + (n-1)) (m + (n-1)) ∧ invertible_mat P ∧ 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 ∈ 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⇩m 1) (0⇩m 1 (m+(n-1))) (0⇩m (m+(n-1)) 1) P)"
have P': "P' ∈ carrier_mat (m+n) (m+n)"
proof -
have "P' ∈ 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 ≥ 2" using A m0 n by auto
have dc_A2: "dim_col A ≥ 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 (verit) 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⇩m 1) (0⇩m 1 (m + (n - 1))) (0⇩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⇩m 1) * A'_UL + (0⇩m 1 (m + (n - 1)) * A'_DL))
((1⇩m 1) * A'_UR + (0⇩m 1 (m + (n - 1))) * A'_DR)
((0⇩m (m + (n - 1)) 1) * A'_UL + P * A'_DL)
((0⇩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⇩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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat (m + n) (m + n)
∧ 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 "∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n) ∧ 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) ≠ 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)
(λ(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' @⇩r M''" unfolding M'_def M''_def
by (metis M append_rows_split carrier_matD le_add1)
show M': "M' ∈ carrier_mat m n" unfolding M'_def by fastforce
show M'': "M'' ∈ carrier_mat n n" unfolding M''_def by fastforce
show "0 ≠ m" using m0 by simp
show "A2 = Matrix.mat (dim_row M) (dim_col M)
(λ(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 (λi. abs (A2 $$ (0,i)) > D) [0..<n]"
define ys' where "ys' = filter (λi. abs (A2 $$ (m,i)) > D) [0..<n]"
show "xs' = filter (λi. abs (A2 $$ (0,i)) > D) [0..<n]" unfolding xs'_def by auto
show "ys' = filter (λi. abs (A2 $$ (m,i)) > D) [0..<n]" unfolding ys'_def by auto
have M''D: "(M'' $$ (j, j) = D) ∧ (∀j'∈{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 ⋅⇩m 1⇩m n) $$ (j+m-m,0)"
by (smt (verit) "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 ⋅⇩m 1⇩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)"
using M' M'' M_M'_M'' unfolding M_def A_def
by (metis (no_types, lifting) "1"(2) "1"(5) A'_def True append.simps(1) append_rows_nth2 i_n jn
non_zero_positions_xs_m nat_SN.compat nth_Cons_0 xs_empty)
also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
also have "... = (D ⋅⇩m 1⇩m n) $$ (j,i)"
by (smt (verit) 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)"
using M' M'' M_M'_M'' unfolding M_def
by (metis (no_types, opaque_lifting) "1"(5) 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 ⋅⇩m 1⇩m n) $$ (j,i)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (m-m,0)"
by (smt (verit) "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) ≠ 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) ≠ 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 ∉ 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 ... ≤ D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce
finally have "abs (A2 $$ (0,0)) ≤ D" .
thus ?thesis unfolding xs'_def using D0 by auto
qed
thus "∀j∈set xs'. j<n ∧ (M'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. M'' $$ (j, j') = 0)"
using M''D xs'_def by auto
have "0 ∉ 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 (verit) 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 "∀j∈set ys'. j<n ∧ (M'' $$ (j, j) = D) ∧ (∀j'∈{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 ∈ carrier_mat (m + n) (m + n)"
and reduce_QM: "reduce_below_abs 0 (xs @ [m]) D M = Q * M" by blast
have "∃R. invertible_mat R
∧ R ∈ carrier_mat (dim_row A') (dim_row A') ∧ 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 ∈ carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ 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 ∈ carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A"
using A by auto
have "(P'*Q*R*S) ∈ 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 (verit) 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: "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P
∧ 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⇩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
‹FindPreHNF abs_flag D A = P' * Q * R * S * A› 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 "... ≠ 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 "... ≠ 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) ≠ 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⇩m (m + (n - 1)) 1)"
proof (rule eq_matI)
show "dim_row A'_DL = dim_row (0⇩m (m + (n - 1)) 1)"
and "dim_col A'_DL = dim_col (0⇩m (m + (n - 1)) 1)" using A'_DL by auto
fix i j assume i: "i < dim_row (0⇩m (m + (n - 1)) 1)" and j: "j < dim_col (0⇩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) ≠ 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 (λi. A $$ (i, 0) ≠ 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⇩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 ← [0..<m]]"
have A'_DR_m: "?A'_DR_m ∈ carrier_mat m (n-1)" by auto
have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @⇩r D ⋅⇩m 1⇩m (n - 1)"
proof (rule eq_matI)
show dr: "dim_row A'_DR = dim_row (?A'_DR_m @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩m (n - 1))"
and j: "j<dim_col (?A'_DR_m @⇩r D ⋅⇩m 1⇩m (n - 1))"
have jn1: "j<n-1" using dc j A'_DR by auto
show "A'_DR $$ (i,j) = (?A'_DR_m @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩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 @⇩r D ⋅⇩m 1⇩m (n - 1)) $$ (i,j) = (D ⋅⇩m 1⇩m (n - 1)) $$ (i-m,j)"
by (smt (verit) 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 ≠ 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 ⋅⇩m 1⇩m n) $$ ((i+1)-m, j+1)"
proof (cases "A $$ (0,0) = 0")
case True
let ?S = "(swaprows 0 m A)"
have S: "?S ∈ 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,0)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,j+1)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,0)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (i+1 - m,j+1)"
by (smt (verit) 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⇩m n) $$ ((i+1)-m, j+1)"
by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)
also have "... = D *(1⇩m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
by (smt (verit) 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 ⋅⇩m 1⇩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 ∉ set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto
show "i + 1 ≠ 0" by auto
show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto
show " i + 1 ≠ m" using i_ge_m by auto
qed (insert False)
also have "... = (?M' @⇩r D ⋅⇩m 1⇩m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo
also have "... = (D ⋅⇩m 1⇩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: "∀n. ¬ 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⇩m n) $$ ((i+1)-m, j+1)"
by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)
also have "... = D *(1⇩m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
by (smt (verit) 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 ⋅⇩m 1⇩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 ⋅⇩m 1⇩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: "∃P. P∈carrier_mat (m + (n-1)) (m + (n-1)) ∧ invertible_mat P ∧ sub_PreHNF = P * A'_DR
∧ echelon_form_JNF sub_PreHNF"
proof (cases "2 ≤ 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 "∃P. P∈carrier_mat (m + (n-1)) (m + (n-1)) ∧ invertible_mat P ∧ 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 ∈ 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⇩m 1) (0⇩m 1 (m+(n-1))) (0⇩m (m+(n-1)) 1) P)"
have P': "P' ∈ carrier_mat (m+n) (m+n)"
proof -
have "P' ∈ 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 ≥ 2" using A m0 n by auto
have dc_A2: "dim_col A ≥ 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 (verit) 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⇩m 1) (0⇩m 1 (m + (n - 1))) (0⇩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⇩m 1) * A'_UL + (0⇩m 1 (m + (n - 1)) * A'_DL))
((1⇩m 1) * A'_UR + (0⇩m 1 (m + (n - 1))) * A'_DR)
((0⇩m (m + (n - 1)) 1) * A'_UL + P * A'_DL)
((0⇩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⇩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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat (m + n) (m + n)
∧ 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 "∃P. invertible_mat P ∧ P ∈ carrier_mat (m + n) (m + n) ∧ 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) ≠ 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)
(λ(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' @⇩r M''" unfolding M'_def M''_def
by (metis M append_rows_split carrier_matD le_add1)
show M': "M' ∈ carrier_mat m n" unfolding M'_def by fastforce
show M'': "M'' ∈ carrier_mat n n" unfolding M''_def by fastforce
show "0 ≠ m" using m0 by simp
show "A2 = Matrix.mat (dim_row M) (dim_col M)
(λ(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) ∧ (∀j'∈{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 ⋅⇩m 1⇩m n) $$ (j+m-m,0)"
by (smt (verit) "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 ⋅⇩m 1⇩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)"
using M' M'' M_M'_M''
by (simp add: M_def A'_def True append_rows_nth3 i_n jn local.non_zero_positions_xs_m xs_empty)
also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
also have "... = (D ⋅⇩m 1⇩m n) $$ (j,i)"
by (smt (verit) 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)"
using M' M'' M_M'_M'' unfolding M_def
by (metis (no_types, opaque_lifting) "1"(5) 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 ⋅⇩m 1⇩m n) $$ (j,i)"
by (smt (verit) 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 ⋅⇩m 1⇩m n) $$ (m-m,0)"
by (smt (verit) "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) ≠ 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) ≠ 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 ∉ 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 ... ≤ D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce
finally have "abs (A2 $$ (0,0)) ≤ D" .
thus ?thesis unfolding xs'_def using D0 by auto
qed
thus "∀j∈set xs'. j<n ∧ (M'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. M'' $$ (j, j') = 0)"
using M''D xs'_def by auto
have "0 ∉ 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 (verit) 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 "∀j∈set ys'. j<n ∧ (M'' $$ (j, j) = D) ∧ (∀j'∈{0..<n}-{j}. M'' $$ (j, j') = 0)"
using M''D ys'_def by auto
show "M $$ (m, 0) ∈ {0,D}" using Mm00 Mm0D by blast
show " M $$ (m, 0) = 0 ⟶ 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 ∈ carrier_mat (m + n) (m + n)"
and reduce_QM: "reduce_below 0 (xs @ [m]) D M = Q * M" by blast
have "∃R. invertible_mat R
∧ R ∈ carrier_mat (dim_row A') (dim_row A') ∧ 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 ∈ carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ 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 ∈ carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A"
using A by auto
have "(P'*Q*R*S) ∈ 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 (verit) 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: "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P
∧ 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⇩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
‹FindPreHNF abs_flag D A = P' * Q * R * S * A› 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 "... ≠ 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 "... ≠ 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) ≠ 0" .
qed (insert mn n hyp, auto)
ultimately show ?thesis by blast
qed
qed
lemma
assumes A_def: "A = A'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' ∈ carrier_mat m n" and "n≥2" and m_le_n: "m≥n" and "D>0"
shows FindPreHNF_invertible_mat_n_ge2: "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ 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'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' ∈ carrier_mat m n" and n0: "0<n" and mn: "m≥n" and D: "D>0"
shows "∃P. P ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat P ∧ FindPreHNF abs_flag D A = P * A"
proof -
have A: "A ∈ 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'' @⇩r D ⋅⇩m 1⇩m n"
and A'': "A'' ∈ carrier_mat m n" and mn: "m≥n" and D: "D>0"
shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
proof -
have A: "A ∈ carrier_mat (m+n) n" using A_def A'' by auto
have FindPreHNF: "(FindPreHNF abs_flag D A) ∈ 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 ‹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.›
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
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
thm Hermite.Hermite_reduce_above.simps Hermite_reduce_above.simps
context includes lifting_syntax
begin
definition "res_int = (λ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 :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _)
===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_M))
(λA i j. Hermite_reduce_above A n i j)
(λ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 :: _ ⇒ '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, opaque_lifting) 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: "¬ is_zero_row_JNF i A" using False by transfer
hence "find_fst_non0_in_row i A ≠ 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) ≠ 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 ≠ 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 ≠ 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' (¦A' $h i' $h ?j'¦
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: "(¦A' $h i' $h ?j'¦ 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' (¦A' $h i' $h ?j'¦
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' (¦A' $h i' $h ?j'¦
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) ≠ 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: "(¦A' $h i' $h ?j'¦ 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 ∈ 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 "... ∈ 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 ∈ carrier_mat (dim_row A) (dim_col A)"
proof -
have "Hermite_reduce_above (multrow i (- 1) A) i i a
∈ 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 ‹We now move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix
representation.›
context
begin
private lemma echelon_form_Hermite_of_row_mod_type:
fixes A::"int mat"
assumes "A ∈ 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⇩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 ∈ 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 (verit) CARD_mod_ring)
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: "∃(Rep :: ('b ⇒ int)) Abs. type_definition Rep Abs {0..<m :: int}"
assumes local_typedef2: "∃(Rep :: ('c ⇒ 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 ∈ 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
context
begin
private lemma echelon_form_Hermite_of_row_i_cancelled_first:
"∃Rep Abs. type_definition Rep Abs {0..<int n} ⟹ 1 < m ⟹ 1 < n
⟹ A ∈ carrier_mat m n ⟹ echelon_form_JNF A ⟹ i < m
⟹ 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
private lemma echelon_form_Hermite_of_row_i_cancelled_both:
"1 < m ⟹ 1 < n ⟹ A ∈ carrier_mat m n ⟹ echelon_form_JNF A ⟹ i < m
⟹ 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
lemma echelon_form_JNF_Hermite_of_row_i':
fixes A::"int mat"
assumes "A ∈ carrier_mat m n"
assumes eA: "echelon_form_JNF A"
and "i<m"
and "1 < m" and "1 < n"
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 ∈ {0,1}" by auto
show ?thesis
proof (cases "dim_col A = 0")
case True
have H: "Hermite_of_row_i A i ∈ 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: "(∀j∈{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) ∈ 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) ∈ 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 "... ∈ 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∈carrier_mat m n"
and "∀x∈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) ∈ 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 "∀x∈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∈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 "∀x∈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
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) (λ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 (λ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: "¬ is_zero_row i ?H"
show "?H $ i $ (LEAST n. ?H $ i $ n ≠ 0) ∈ range ass"
proof -
have non_zero_i_eA: "¬ 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 ≠ 0) = (LEAST n. A $h i $h n ≠ 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 ≠ 0) ∈ 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: "¬ is_zero_row i ?H" and j: "j < i"
show "?H $ j $ (LEAST n. ?H $ i $ n ≠ 0)
∈ range (res (?H $ i $ (LEAST n. ?H $ i $ n ≠ 0)))"
proof -
have non_zero_i_eA: "¬ 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 ≠ 0) = (LEAST n. A $h i $h n ≠ 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 ≠ 0) ∈ range (res (?H $ i $ (LEAST n. A $ i $ n ≠ 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 ∨ 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"
"(∀i<dim_row A. ¬ is_zero_row_JNF i A ⟶ A $$ (i, LEAST n. A $$ (i, n) ≠ 0) ∈ associates)"
"(∀i<dim_row A. ¬ is_zero_row_JNF i A ⟶ (∀j. j<i ⟶ A $$ (j, (LEAST n. A $$ (i, n) ≠ 0))
∈ res (A $$ (i,(LEAST n. A $$ (i,n) ≠ 0)))))"
shows "Hermite_JNF associates res A"
using assms unfolding Hermite_JNF_def by auto
lemma least_multrow:
assumes "A ∈ carrier_mat m n" and "i<m" and eA: "echelon_form_JNF A"
assumes ia: "ia < dim_row A" and nz_ia_mrA: "¬ is_zero_row_JNF ia (multrow i (- 1) A)"
shows "(LEAST n. multrow i (- 1) A $$ (ia, n) ≠ 0) = (LEAST n. A $$ (ia, n) ≠ 0)"
proof (rule Least_equality)
have nz_ia_A: "¬ is_zero_row_JNF ia A" using nz_ia_mrA ia by auto
have Least_Aian_n: "(LEAST n. A $$ (ia, n) ≠ 0) < dim_col A"
by (smt (verit) 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) ≠ 0) ≠ 0"
by (smt (verit) 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 " ⋀y. multrow i (- 1) A $$ (ia, y) ≠ 0 ⟹ (LEAST n. A $$ (ia, n) ≠ 0) ≤ 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 ∈ carrier_mat 1 n"
shows "Hermite_JNF (range ass_function_euclidean) (λ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 (λ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 "∀i<dim_row ?H. ¬ is_zero_row_JNF i ?H
⟶ ?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0) ∈ range ass_function_euclidean"
proof (auto)
fix i assume i: "i<dim_row ?H" and nz_iH: "¬ is_zero_row_JNF i ?H"
have nz_iA: "¬ 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) ≠ 0) ≥ 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 (verit) 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) ≠ 0" and a0: "0 ≤ a" and an: "a<n"
using i0 Some assms find_fst_non0_in_row by auto+
have l: "(LEAST n. A $$ (i, n) ≠ 0) = (LEAST n. multrow 0 (- 1) A $$ (i, n) ≠ 0)"
by (rule least_multrow[symmetric, OF A _ eA _], insert nz_iA i A i0, auto)
have a1: "a = (LEAST n. A $$ (i, n) ≠ 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) ≠ 0)" unfolding l by simp
have m1: "multrow 0 (- 1) A $$ (i, LEAST n. multrow 0 (- 1) A $$ (i, n) ≠ 0)
= (- 1) * A $$ (i, LEAST n. A $$ (i, n) ≠ 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) ≠ 0) ∈ range ass_function_euclidean"
using ass_function_int ass_function_int_UNIV by auto
qed
show "∀i<dim_row ?H. ¬ is_zero_row_JNF i ?H ⟶ (∀j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) ≠ 0)
∈ range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0))))"
using Hermite_of_row_i[of A 0] A by auto
qed
lemma Hermite_of_row_i_0_eq_0:
assumes A: "A∈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) ≠ 0" and a0: "0 ≤ 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 ∈ carrier_mat m 1" and eA: "echelon_form_JNF A"
shows "Hermite_JNF (range ass_function_euclidean) (λ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 (λ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 "∀i∈{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 "∀i<dim_row ?H. ¬ is_zero_row_JNF i ?H
⟶ ?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0) ∈ range ass_function_euclidean"
proof (auto)
fix i assume i: "i<dim_row ?H" and nz_iH: "¬ is_zero_row_JNF i ?H"
have nz_iA: "¬ 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) ≠ 0) ≥ 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) ≠ 0" and a0: "0 ≤ 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) ≠ 0) ∈ range ass_function_euclidean"
using ass_function_int ass_function_int_UNIV by auto
qed
show "∀i<dim_row ?H. ¬ is_zero_row_JNF i ?H ⟶ (∀j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) ≠ 0)
∈ range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0))))"
proof auto
fix i j assume i: "i<dim_row ?H" and nz_iH: "¬ 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) ≠ 0)
∈ range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) ≠ 0)))" using ji by auto
qed
qed
lemma Hermite_of_list_of_rows_1xn:
assumes A: "A ∈ carrier_mat 1 n"
and eA: "echelon_form_JNF A"
and x: "∀x ∈ set xs. x < 1" and xs: "xs≠[]"
shows "Hermite_JNF (range ass_function_euclidean)
(λ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)
(λ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) (λc. range (res_int c)) A"
and x: "x<dim_row A" and A: "A∈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) ≠ 0)"
by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto)
have Axa: "A $$ (x, a) ≠ 0" and xa: "x≤a" and a: "a<dim_col A"
using find_fst_non0_in_row[OF A Some] unfolding a_least by auto
have nz_xA: "¬ 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) ∈ (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∈carrier_mat m 1"
shows "Hermite_of_row_i A x = A ∨ 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) ≠ 0)"
by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto)
have Axa: "A $$ (x, a) ≠ 0" and xa: "x≤a" and a: "a<dim_col A"
using find_fst_non0_in_row[OF A Some] unfolding a_least by auto
have nz_xA: "¬ 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 ∈ carrier_mat m 1"
and eA: "echelon_form_JNF A"
and x: "∀x ∈ set xs. x < m" and xs: "xs=[0..<i]" and i: "i>0"
shows "Hermite_JNF (range ass_function_euclidean)
(λ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 ∈ 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)
(λ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 ∈ carrier_mat 1 n"
shows "∃P. P ∈ carrier_mat 1 1 ∧ invertible_mat P ∧ 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 ∨ ?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 ∈ 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 ∈ carrier_mat 1 1 ∧ invertible_mat (?M)
∧ 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 ∈ carrier_mat m 1" and eA: "echelon_form_JNF A"
and xs_i: "xs = [0..<i]" and xs_m: "∀x∈set xs. x < m" and i: "i>0"
shows "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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 ∈ 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 ∨ ?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 ∈ 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 ∈ carrier_mat m m ∧ invertible_mat ?M ∧ ?H = ?M * A" by blast
qed
qed
next
case False
let ?A = "(Hermite_of_list_of_rows A xs)"
have A': "?A ∈ carrier_mat m 1" using A Hermite_of_list_of_rows[of A xs] by simp
have hyp: "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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 ∨ 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 ∈ 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 ∈ 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) ∈ 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 ∈ carrier_mat m 1" and eA: "echelon_form_JNF A"
shows "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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 ∈ carrier_mat m 0"
and xs: "xs = [0..<i]" and x: "∀x∈ 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 ∈ 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 ‹Again, we move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix
representation.›
context
begin
private lemma Hermite_Hermite_of_list_of_rows_mod_type:
fixes A::"int mat"
assumes "A ∈ carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
assumes eA: "echelon_form_JNF A"
shows "Hermite_JNF (range ass_function_euclidean)
(λc. range (res_int c)) (Hermite_of_list_of_rows A [0..<CARD('m)])"
proof -
define A' where "A' = (Mod_Type_Connect.to_hma⇩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]: "(λc. range (res_int c)) = (λc. range (res_int c))" ..
have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto
have "Hermite (range ass_function_euclidean) (λ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 ∈ carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
assumes eA: "echelon_form_JNF A"
shows "∃P. P ∈ carrier_mat CARD('m) CARD('m) ∧
invertible_mat P ∧ Hermite_of_list_of_rows A [0..<CARD('m)] = P * A"
proof -
define A' where "A' = (Mod_Type_Connect.to_hma⇩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]: "(λc. range (res_int c)) = (λc. range (res_int c))" ..
have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto
have "∃P. invertible P ∧ 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 ∈ 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)
(λ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 (verit) CARD_mod_ring)
private lemma invertible_Hermite_of_list_of_rows_nontriv_mod_ring:
fixes A::"int mat"
assumes "A ∈ carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
assumes eA: "echelon_form_JNF A"
shows "∃P. P ∈ carrier_mat CARD('m) CARD('m) ∧
invertible_mat P ∧ Hermite_of_list_of_rows A [0..<CARD('m)] = P * A"
using assms invertible_Hermite_of_list_of_rows_mod_type by (smt (verit) CARD_mod_ring)
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: "∃(Rep :: ('b ⇒ int)) Abs. type_definition Rep Abs {0..<m :: int}"
assumes local_typedef2: "∃(Rep :: ('c ⇒ 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 ∈ carrier_mat m n"
assumes eA: "echelon_form_JNF A"
shows "Hermite_JNF (range ass_function_euclidean)
(λ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 ∈ carrier_mat m n"
assumes eA: "echelon_form_JNF A"
shows "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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
context
begin
private lemma invertible_Hermite_of_list_of_rows_cancelled_first:
"∃Rep Abs. type_definition Rep Abs {0..<int n}
⟹ 1 < m ⟹ 1 < n ⟹ A ∈ carrier_mat m n ⟹ echelon_form_JNF A
⟹ ∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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
private lemma invertible_Hermite_of_list_of_rows_cancelled_both:
"1 < m ⟹ 1 < n ⟹ A ∈ carrier_mat m n ⟹ echelon_form_JNF A
⟹ ∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ 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
private lemma Hermite_Hermite_of_list_of_rows_cancelled_first:
"∃Rep Abs. type_definition Rep Abs {0..<int n} ⟹
1 < m ⟹
1 < n ⟹
A ∈ carrier_mat m n ⟹
echelon_form_JNF A
⟹ Hermite_JNF (range ass_function_euclidean) (λ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
private lemma Hermite_Hermite_of_list_of_rows_cancelled_both:
"1 < m ⟹
1 < n ⟹
A ∈ carrier_mat m n ⟹
echelon_form_JNF A
⟹ Hermite_JNF (range ass_function_euclidean) (λ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
lemma Hermite_Hermite_of_list_of_rows':
fixes A::"int mat"
assumes "A ∈ carrier_mat m n"
and "echelon_form_JNF A"
and "1 < m" and "1 < n"
shows "Hermite_JNF (range ass_function_euclidean)
(λ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 ∈ carrier_mat m n"
and eA: "echelon_form_JNF A"
shows "Hermite_JNF (range ass_function_euclidean)
(λc. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
proof (cases "m=0 ∨ 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 ∨ 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 ∈ carrier_mat m n"
and eA: "echelon_form_JNF A"
shows "∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ Hermite_of_list_of_rows A [0..<m] = P * A"
proof (cases "m=0 ∨ 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 ∨ 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 ‹Now we have all the required stuff to prove the soundness of the algorithm.›
context proper_mod_operation
begin
lemma Hermite_mod_det_mx0:
assumes "A ∈ 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 ∈ carrier_mat m 0"
shows "Hermite_JNF (range ass_function_euclidean) (λ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 ∈ carrier_mat m n"
and n0: "n=0"
shows "Hermite_JNF (range ass_function_euclidean) (λc. range (res_int c)) (Hermite_mod_det abs_flag A)"
and "(∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ (Hermite_mod_det abs_flag A) = P * A)"
proof -
have A: "A ∈ carrier_mat m 0" using A n0 by blast
then show "Hermite_JNF (range ass_function_euclidean) (λ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 "(∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ (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 ∈ 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) (λc. range (res_int c)) (Hermite_mod_det abs_flag A)"
and "(∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ (Hermite_mod_det abs_flag A) = P * A)"
proof -
define D A' E H H' where D_def: "D = ¦Determinant.det A¦"
and A'_def: "A' = A @⇩r D ⋅⇩m 1⇩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' ∈ carrier_mat (m+n) n" using A A A'_def by auto
let ?RAT = "of_int_hom.mat_hom :: int mat ⇒ rat mat"
have RAT_A: "?RAT A ∈ 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) ≠ 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 ⋅⇩m 1⇩m n ∈ 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 ∈ carrier_mat (m+n) n" unfolding E_def by (rule FindPreHNF[OF A'])
have "∃P. P ∈ carrier_mat (m + n) (m + n) ∧ invertible_mat P ∧ 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 ∈ carrier_mat (m + n) (m + n)"
and inv_P: "invertible_mat P" and E_PA': "E = P * A'"
by blast
have "∃Q. Q ∈ carrier_mat (m+n) (m+n) ∧ invertible_mat Q ∧ H = Q * E"
by (unfold H_def, rule invertible_Hermite_of_list_of_rows[OF E eE])
from this obtain Q where Q: "Q ∈ 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 = "(λc. range (res_int c))"
have Hermite_H: "Hermite_JNF (range ass_function_euclidean) (λ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' ∈ carrier_mat m n" using H'_def by auto
have H_H'0: "H = H' @⇩r 0⇩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 ∈ 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' ∈ 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' ∈ carrier_mat (m+n) (m+n)"
using Q inv_Q obtain_inverse_matrix by blast
have P'Q': "(P'*Q') ∈ 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 ∈ 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 (verit) 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)) ⊆ 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 " ¬ 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 ≠ 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 = ¦det (mat_of_rows n (rows A))¦" 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 "∃R. invertible_mat R ∧ R ∈ carrier_mat m m ∧ 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 ∈ carrier_mat m m" and A_RH': "A = R * H'"
by blast
obtain R' where inverts_R: "inverts_mat R R'" and R': "R' ∈ 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 "∃S. invertible_mat S ∧ S ∈ carrier_mat m m ∧ 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 ∈ carrier_mat m n"
and i: "invertible_mat (map_mat rat_of_int A)"
shows "Hermite_JNF (range ass_function_euclidean) (λc. range (res_int c)) (Hermite_mod_det abs_flag A)"
and "(∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ (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 ‹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.›
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) ⇒
Matrix.mat (dim_row A) (dim_col A)
(λ(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)
(λ(i, k).
if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if 0 < ¦r¦ then
if k = 0 ∧ 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 < ¦r¦ then r mod 0 else r else A $$ (i, k))
= Matrix.mat (dim_row A) (dim_col A)
(λ(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 (verit) dim_row_mat(1) pquvd prod.simps(2))
show "dim_col ?lhs = dim_col ?rhs"
unfolding reduce.simps Let_def by (smt (verit) 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' ∈ carrier_mat m n" and a: "a<m" and b: "b<m" and ab: "a ≠ b"
and A_def: "A = A' @⇩r B" and B: "B ∈ 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)
(λ(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 ∈ carrier_mat (m+t) n" using A_def A' B by simp
hence A_carrier: "?A ∈ 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 = "λ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 ∙ col A ja"
by (rule index_mult_mat, insert i ja, auto)
also have "... = (∑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 "... = (∑ia = 0..<m+t. ?f ia)"
by (rule sum.cong, insert A i dr dc, auto) (smt (verit) bezout_matrix_JNF_def carrier_matD(1)
dim_col_mat(1) index_col index_mult_mat(3) index_row(1) ja)
also have "... = (∑ia ∈ ({a,b} ∪ ({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 ∈ {0..<m + t} - {a, b}"
hence xm: "x < m+t" by auto
have x_not_i: "x ≠ 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 ∈ {0..<m + t} - {a, b}"
hence xm: "x < m+t" by auto
have x_not_i: "x ≠ 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 ∈ {0..<m + t} - {a, b} - {i}"
hence xm: "x < m+t" by auto
have x_not_i: "x ≠ 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 ∈ carrier_mat m n" and a: "a<m" and b: "b<m" and ab: "a ≠ 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)
(λ(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 @⇩r (0⇩m 0 n)" by (rule eq_matI, unfold append_rows_def, auto)
show "(0⇩m 0 n) ∈ carrier_mat 0 n" by auto
qed
lemma reduce_invertible_mat_D0_BM:
assumes A: "A ∈ carrier_mat m n"
and a: "a < m"
and b: "b < m"
and ab: "a ≠ b"
and Aa0: "A$$(a,0) ≠ 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)
(λ(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 ∈ carrier_mat m n"
and a: "a < m"
and b: "b < m"
and n0: "0<n"
and ab: "a ≠ b"
and a_less_b: "a<b"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ reduce a b 0 A = P * A"
proof (cases "A$$(a,0) = 0")
case True
then show ?thesis
by (smt (verit) 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 ∈ 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 ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "D=0"
shows "(∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ 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 ∈ 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: "(∃P. invertible_mat P ∧ P ∈ carrier_mat m m
∧ 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 ∈ 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 "∃Q. invertible_mat Q ∧ Q ∈ carrier_mat m m ∧ (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 ∈ 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 ∈ carrier_mat m m" using P Q by auto
moreover have "reduce_below a (x # xs) D A = (P*Q) * A"
by (smt (verit) 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_not0':
assumes A: "A ∈ 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) ≠ 0"
shows "reduce a b 0 A $$ (a, 0) ≠ 0" (is "?reduce_ab $$ (a,0) ≠ _")
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 "... ≠ 0" unfolding Let_def
by (simp add: assms(6))
finally show ?thesis .
qed
lemma reduce_below_preserves_D0:
assumes A': "A ∈ carrier_mat m n" and a: "a<m" and j: "j<n"
and Aaj: "A $$ (a,0) ≠ 0"
assumes "i ∉ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ a < x"
and "i≠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 ∈ 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 ∉ set xs" using i_set_xxs by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (unfold D0, rule reduce_not0'[OF A _ _ _ _ Aaj], insert "2.prems", auto)
show "reduce a x D A ∈ 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 ∈ carrier_mat m n" and a: "a<m" and j: "0<n"
and Aaj: "A $$ (a,0) ≠ 0"
assumes "i ∈ set xs" and "distinct xs" and "∀x ∈ set xs. x < m ∧ 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 ∈ 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 ∈ carrier_mat m n" using reduce_ax by linarith
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 0"
by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto)
show "i ∉ set xs" using True d by auto
show "i ≠ 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 ∈ carrier_mat m n" using reduce_ax by linarith
show "i ∈ set xs" using i_set_xxs i_not_x by auto
show "distinct xs" using d by auto
show "∀x∈set xs. x < m ∧ a < x" using xxs_less_m by auto
show "reduce a x D A $$ (a, 0) ≠ 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 ‹Definition of the echelon form algorithm in JNF›
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) ≤ 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) ∨ (∀m ∈ {i..<dim_row A}. A $$ (m, k) = 0) then (A, i) else
if (∀m∈{i+1..<dim_row A}. A $$ (m,k) = 0) then (A, i + 1) else
let n = (LEAST n. A $$ (n,k) ≠ 0 ∧ i ≤ 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 :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _)
===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (=) ===> (Mod_Type_Connect.HMA_M))
(λA i j bezout. bezout_iterate_JNF A n i j bezout)
(λ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 :: _ ⇒ '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 ≤ i ⟹ Suc n ≤ mod_type_class.to_nat i'"
and "Suc n > i ⟹ 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 ) ≤ 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 :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _) (λa b. a=b ∧ a≤CARD('m))
===> (rel_prod (Mod_Type_Connect.HMA_M) (λa b. a=b ∧ a≤CARD('m))))
(λbezout A. echelon_form_of_column_k_JNF bezout A k)
(λ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≤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 :: _ ⇒ 'm"
let ?from_nat_cols = "mod_type_class.from_nat :: _ ⇒ '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: "(∀m ∈ {i..<dim_row A}. A $$ (m, k) = 0)
= (∀m≥?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs") if i_not: "i≠dim_row A"
proof
assume lhs: "?lhs"
show "?rhs"
proof (rule+)
fix m
assume im: "?from_nat_rows i ≤ 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) ≤ ?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' ∈ {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 ∈ {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≥?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) ∨ (∀m ∈ {i..<dim_row A}. A $$ (m, k) = 0)")
case True
hence *: "(∀m≥?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0) ∨ (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 *: "(∀m∈{i+1..<dim_row A}. A $$ (m,k) = 0)
= (∀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' ∈ {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 ∈ {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 "(∀m∈{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 im'
by auto
next
case False
hence *: "¬ (∀m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" using * by auto
have **: "¬ ((∀m≥?from_nat_rows i. A' $h m $h ?from_nat_cols k = 0) ∨ i = nrows A')"
using c1_eq c2_eq not_c1 by auto
define n where "n=(LEAST n. A $$ (n,k) ≠ 0 ∧ i ≤ n)"
define n' where "n'=(LEAST n. A' $ n $ ?from_nat_cols k ≠ 0 ∧ ?from_nat_rows i ≤ 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: "∃n. A' $ n $ ?from_nat_cols k ≠ 0 ∧ ?from_nat_rows i ≤ n"
using * by auto
from this obtain a where c: "A' $ a $ ?from_nat_cols k ≠ 0 ∧ ?from_nat_rows i ≤ 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 ≠ 0 ∧ ?from_nat_rows i ≤ n')"
by (metis (mono_tags, lifting) LeastI c2_eq n'_def not_c1)
hence "i ≤ 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) ≠ 0 ∧ i ≤ ?n'"
using e by auto
show " ⋀y. A $$ (y, k) ≠ 0 ∧ i ≤ y ⟹ mod_type_class.to_nat n' ≤ y"
unfolding n'_def
by (smt (verit, del_insts) AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma⇩m_def assms from_nat_mono
from_nat_mono' index_mat(1) less_trans mod_type_class.from_nat_to_nat_id mod_type_class.to_nat_less_card
not_le 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≤CARD('m)"
and "(Mod_Type_Connect.HMA_M :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _) A A'"
shows "(rel_prod (Mod_Type_Connect.HMA_M) (λa b. a=b ∧ a≤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≤CARD('n)"
shows "((Mod_Type_Connect.HMA_M :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _) ===> (=)
===> (rel_prod (Mod_Type_Connect.HMA_M) (λa b. a=b ∧ a≤CARD('m))))
(λA bezout. (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<k]))
(λ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 (λa b. a=b ∧ a≤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 (verit) "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 :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _) ===> (=)
===> (Mod_Type_Connect.HMA_M))
(λA bezout. echelon_form_of_upt_k_JNF A k bezout)
(λ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 ≤ CARD('n)" using k by auto
have rel_foldl: "(rel_prod (Mod_Type_Connect.HMA_M) (λa b. a=b ∧ a≤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 (verit) "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 :: _ ⇒ int ^ 'n :: mod_type ^ 'm :: mod_type ⇒ _) ===> (=)
===> (Mod_Type_Connect.HMA_M))
(λA bezout. echelon_form_of_JNF A bezout)
(λ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) ‹ncols A' - 1 = dim_col A - 1› rel_fun_def)
qed
end
context
begin
private lemma echelon_form_of_euclidean_invertible_mod_type:
fixes A::"int mat"
assumes "A ∈ carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (CARD('m::mod_type)) (CARD('m::mod_type))
∧ P * A = echelon_form_of_JNF A euclid_ext2
∧ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
proof -
define A' where "A' = (Mod_Type_Connect.to_hma⇩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 "∃P. invertible P ∧ P**A' = (echelon_form_of A' euclid_ext2)
∧ 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 ∈ carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat (CARD('m)) (CARD('m))
∧ P * A = echelon_form_of_JNF A euclid_ext2
∧ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
using assms echelon_form_of_euclidean_invertible_mod_type by (smt (verit) CARD_mod_ring)
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: "∃(Rep :: ('b ⇒ int)) Abs. type_definition Rep Abs {0..<m :: int}"
assumes local_typedef2: "∃(Rep :: ('c ⇒ 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 ∈ carrier_mat m n"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat m m
∧ P * A = echelon_form_of_JNF A euclid_ext2
∧ 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
context
begin
private lemma echelon_form_of_euclidean_invertible_cancelled_first:
"∃Rep Abs. type_definition Rep Abs {0..<int n} ⟹ 1 < m ⟹ 1 < n ⟹
A ∈ carrier_mat m n ⟹ ∃P. invertible_mat P ∧ P ∈ carrier_mat m m
∧ P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 ∧ 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
private lemma echelon_form_of_euclidean_invertible_cancelled_both:
"1 < m ⟹ 1 < n ⟹ A ∈ carrier_mat m n ⟹ ∃P. invertible_mat P ∧ P ∈ carrier_mat m m
∧ P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 ∧ 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
lemma echelon_form_of_euclidean_invertible':
fixes A::"int mat"
assumes "A ∈ carrier_mat m n"
and "1 < m" and "1 < n"
shows "∃P. invertible_mat P ∧
P ∈ carrier_mat m m ∧ P * A = echelon_form_of_JNF A euclid_ext2
∧ 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 ∨ n = 0 then A else
if n = 1 then
let non_zero_positions = filter (λi. A $$ (i,0) ≠ 0) [1..<dim_row A] in
if non_zero_positions = [] then A
else let A' = (if A$$(0,0) ≠ 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 ‹This is the (non-efficient) HNF algorithm obtained from the echelon form and Hermite normal
form AFP entries›
definition "HNF_algorithm_from_HA A
= Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<(dim_row A)]"
text ‹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)›
definition "HNF_algorithm abs_flag A =
(let m = dim_row A; n = dim_col A in
if m ≠ 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 @⇩r D ⋅⇩m 1⇩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
lemma FindPreHNF_rectangular_soundness:
fixes A::"int mat"
assumes A: "A ∈ carrier_mat m n"
shows "∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ P * A = FindPreHNF_rectangular A
∧ echelon_form_JNF (FindPreHNF_rectangular A)"
proof (cases "m < 2 ∨ n = 0")
case True
then show ?thesis
by (smt (verit) 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 (λi. A $$ (i,0) ≠ 0) [1..<dim_row A]"
let ?A' = "(if A$$(0,0) ≠ 0 then A else let i = ?nz ! 0 in swaprows 0 i A)"
have A': "?A' ∈ carrier_mat m n" using A by auto
have A'00: "?A' $$ (0,0) ≠ 0" if "?nz ≠ []"
by (smt (verit) 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 ≠ []"
proof (rule echelon_form_JNF_mx1)
show "(reduce_below 0 ?nz 0 ?A') ∈ carrier_mat m n" using A reduce_below by auto
have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0" if i: "i ∈ {1..<m}" for i
proof (cases "i ∈ 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 "∀i ∈ {1..<m}. (reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0"
by simp
qed (insert True, simp)
have "∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ 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 "∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ ?A' = P * A" if "?nz ≠ []"
using A A'_swaprows_invertible_mat m1 that by blast
ultimately have e_inv: "∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ reduce_below 0 ?nz 0 ?A' = P * A"
if "?nz ≠ []"
by (smt (verit) 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 "∀i∈{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: "∃P. invertible_mat P ∧ P ∈ carrier_mat m m ∧ 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 ∈ carrier_mat m n"
shows "Hermite_JNF (range ass_function_euclidean) (λc. range (res_int c)) (HNF_algorithm_from_HA A)
∧ (∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (HNF_algorithm_from_HA A) = P * A)"
proof -
have m: "dim_row A = m" using A by auto
have "(∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (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 ∈ carrier_mat m n"
by (smt (verit) A FindPreHNF_rectangular_soundness mult_carrier_mat)
show "echelon_form_JNF (FindPreHNF_rectangular A)"
using FindPreHNF_rectangular_soundness by blast
qed
moreover have "(∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (FindPreHNF_rectangular A) = P * A)"
by (metis A FindPreHNF_rectangular_soundness)
ultimately have "(∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (HNF_algorithm_from_HA A) = P * A)"
by (smt (verit) assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
moreover have "Hermite_JNF (range ass_function_euclidean) (λ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 ‹Soundness theorem for any matrix›
lemma HNF_algorithm_soundness:
assumes A: "A ∈ carrier_mat m n"
shows "Hermite_JNF (range ass_function_euclidean) (λc. range (res_int c)) (HNF_algorithm abs_flag A)
∧ (∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (HNF_algorithm abs_flag A) = P * A)"
proof (cases "m≠n ∨ 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 "(∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (HNF_algorithm abs_flag A) = P * (FindPreHNF_rectangular A))"
unfolding H_rw
proof (rule invertible_Hermite_of_list_of_rows)
show "FindPreHNF_rectangular A ∈ carrier_mat m n"
by (smt (verit) A FindPreHNF_rectangular_soundness mult_carrier_mat)
show "echelon_form_JNF (FindPreHNF_rectangular A)"
using FindPreHNF_rectangular_soundness by blast
qed
moreover have "(∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (FindPreHNF_rectangular A) = P * A)"
by (metis A FindPreHNF_rectangular_soundness)
ultimately have "(∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ (HNF_algorithm abs_flag A) = P * A)"
by (smt (verit) assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
moreover have "Hermite_JNF (range ass_function_euclidean) (λ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) ≠ 0" by auto
have inv_RAT_A: "invertible_mat (map_mat rat_of_int A)"
proof -
have "det (map_mat rat_of_int A) ≠ 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 ‹New predicate of soundness of a HNF algorithm, without providing explicitly the transformation matrix.›
definition "is_sound_HNF' algorithm associates res
= (∀A. let H = algorithm A; m = dim_row A; n = dim_col A in Hermite_JNF associates res H
∧ H ∈ carrier_mat m n ∧ (∃P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ A = P * H))"
lemma is_sound_HNF_conv:
assumes s: "is_sound_HNF' algorithm associates res"
shows "is_sound_HNF (λA. let H = algorithm A in (SOME P. P ∈ carrier_mat (dim_row A) (dim_row A)
∧ invertible_mat P ∧ 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 ∈ carrier_mat m m ∧ invertible_mat P ∧ A = P * (algorithm A)"
using s unfolding is_sound_HNF'_def Let_def m_def by auto
let ?some_P = "(SOME P. P ∈ carrier_mat m m ∧ invertible_mat P ∧ A = P * algorithm A)"
have some_P: "?some_P ∈ carrier_mat m m ∧ invertible_mat ?some_P ∧ A = ?some_P * algorithm A"
by (metis (mono_tags, lifting) P someI_ex)
moreover have "algorithm A ∈ 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 ∈ carrier_mat m m ∧ algorithm A ∈ carrier_mat m (dim_col A)
∧ invertible_mat ?some_P ∧ A = ?some_P * algorithm A ∧ 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) (λc. range (res_int c))"
proof -
have "Hermite_JNF (range ass_function_euclidean) (λ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 ∈ carrier_mat (dim_row A) (dim_col A)" for A
by (metis HNF_algorithm_soundness carrier_matI mult_carrier_mat)
moreover have "∃P. P ∈ carrier_mat (dim_row A) (dim_row A) ∧ invertible_mat P ∧ A = P * HNF_algorithm abs_flag A" for A
proof -
have "∃P. P ∈ carrier_mat (dim_row A) (dim_row A) ∧ invertible_mat P ∧ HNF_algorithm abs_flag A = P * A"
using HNF_algorithm_soundness by blast
from this obtain P where P: "P ∈ 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' ∈ 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 (verit) 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) (λc. range (res_int c))"
proof -
have "Hermite_JNF (range ass_function_euclidean) (λ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 ∈ carrier_mat (dim_row A) (dim_col A)" for A
by (metis HNF_algorithm_from_HA_soundness carrier_matI mult_carrier_mat)
moreover have "∃P. P ∈ carrier_mat (dim_row A) (dim_row A) ∧ invertible_mat P ∧ A = P * HNF_algorithm_from_HA A" for A
proof -
have "∃P. P ∈ carrier_mat (dim_row A) (dim_row A) ∧ invertible_mat P ∧ HNF_algorithm_from_HA A = P * A"
using HNF_algorithm_from_HA_soundness by blast
from this obtain P where P: "P ∈ 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' ∈ 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 (verit) 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 ‹Some work to make the algorithm executable›
definition find_non0' :: "nat ⇒ nat ⇒ 'a::comm_ring_1 mat ⇒ nat option" where
"find_non0' i k A = (let is = [i ..< dim_row A];
Ais = filter (λj. A $$ (j, k) ≠ 0) is
in case Ais of [] ⇒ None | _ ⇒ Some (Ais!0))"
lemma find_non0':
assumes A: "A ∈ carrier_mat m n"
and res: "find_non0' i k A = Some j"
shows "A $$ (j,k) ≠ 0" "i ≤ j" "j < dim_row A"
proof -
let ?xs = "filter (λj. A $$ (j,k) ≠ 0) [i ..< dim_row A]"
from res[unfolded find_non0'_def Let_def]
have xs: "?xs ≠ []" by (cases ?xs, auto)
have j_in_xs: "j ∈ 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) ≠ 0" "i ≤ j" "j < dim_row A" using j_in_xs by auto+
qed
lemma find_non0'_w_zero_before:
assumes A: "A ∈ carrier_mat m n"
and res: "find_non0' i k A = Some j"
shows "∀j'∈{i..<j}. A $$ (j',k) = 0"
proof -
let ?xs = "filter (λj. A $$ (j, k) ≠ 0) [i ..< dim_row A]"
from res[unfolded find_non0'_def Let_def]
have xs: "?xs ≠ []" by (cases ?xs, auto)
have j_in_xs: "j ∈ 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 (verit) res[unfolded find_non0'_def Let_def] list.case(2) list.exhaust option.inject xs)
show "∀j'∈{i..<j}. A $$ (j',k) = 0"
proof (rule+, rule ccontr)
fix j' assume j': "j' : {i..<j}" and Alj': "A $$ (j',k) ≠ 0"
have j'j: "j'<j" using j' by auto
have j'_in_xs: "j' ∈ 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 (λj. A $$ (j,k) ≠ 0) ([i ..<j] @[j..<dim_row A])"
using l_rw by auto
hence "filter (λj. A $$ (j,k) ≠ 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 ∈ carrier_mat m n"
and res: "find_non0' i k A = Some j"
shows "j = (LEAST n. A $$ (n,k) ≠ 0 ∧ i≤n)"
proof (rule Least_equality[symmetric])
show " A $$ (j, k) ≠ 0 ∧ i ≤ j"
using A res find_non0'[OF A] by auto
show " ⋀y. A $$ (y, k) ≠ 0 ∧ i ≤ y ⟹ j ≤ 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) ∨ (∀m ∈ {i..<dim_row A}. A $$ (m, k) = 0) then (A, i) else
if (∀m∈{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 "¬ ((i = dim_row A) ∨ (∀m ∈ {i..<dim_row A}. A $$ (m, k) = 0))
∧ ¬ (∀m∈{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) ≠ 0 ∧ i ≤ n)"
proof (rule find_non0'_LEAST)
have "find_non0' i k A ≠ 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 ‹Instantiation of the HNF-algorithm with modulo-operation›
text ‹We currently use a Boolean flag to indicate whether standard-mod or symmetric modulo
should be used.›
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 ⇒ int mat ⇒ 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 ⇒ int mat ⇒ 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) (λ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) (λ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)
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)"
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)"
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)"
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