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
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 ∈