diff --git a/CauchySchwarz.v b/CauchySchwarz.v new file mode 100644 index 0000000..943c6d9 --- /dev/null +++ b/CauchySchwarz.v @@ -0,0 +1,573 @@ +Require Import Psatz. +Require Import Reals. + +Require Export VecSet. + + +Local Close Scope nat_scope. + + +(* some inner product lemmas *) +Lemma inner_product_scale_l : forall {n} (u v : Vector n) (c : C), + ⟨c .* u, v⟩ = c^* * ⟨u,v⟩. +Proof. intros. + unfold inner_product, scale, adjoint, Mmult. + rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded; intros. + lca. +Qed. + +Lemma inner_product_scale_r : forall {n} (u v : Vector n) (c : C), + ⟨u, c .* v⟩ = c * ⟨u,v⟩. +Proof. intros. + unfold inner_product, scale, adjoint, Mmult. + rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded; intros. + lca. +Qed. + +Lemma inner_product_plus_l : forall {n} (u v w : Vector n), + ⟨u .+ v, w⟩ = ⟨u, w⟩ + ⟨v, w⟩. +Proof. intros. + unfold inner_product, scale, adjoint, Mplus, Mmult. + rewrite <- (@big_sum_plus C _ _ C_is_comm_group). + apply big_sum_eq_bounded; intros. + lca. +Qed. + +Lemma inner_product_plus_r : forall {n} (u v w : Vector n), + ⟨u, v .+ w⟩ = ⟨u, v⟩ + ⟨u, w⟩. +Proof. intros. + unfold inner_product, scale, adjoint, Mplus, Mmult. + rewrite <- (@big_sum_plus C _ _ C_is_comm_group). + apply big_sum_eq_bounded; intros. + lca. +Qed. + +Lemma inner_product_adjoint_r : forall {m n} (A : Matrix m n) (u : Vector m) (v : Vector n), + ⟨u, A × v⟩ = ⟨A† × u, v⟩. +Proof. intros. + unfold inner_product. + rewrite Mmult_adjoint, adjoint_involutive, Mmult_assoc. + easy. +Qed. + +Lemma inner_product_adjoint_l : forall {m n} (A : Matrix m n) (u : Vector n) (v : Vector m), + ⟨A × u, v⟩ = ⟨u, A† × v⟩. +Proof. intros. + rewrite inner_product_adjoint_r, adjoint_involutive. + easy. +Qed. + +Lemma inner_product_big_sum_l : forall {n} (u : Vector n) (f : nat -> Vector n) (k : nat), + ⟨big_sum f k, u⟩ = big_sum (fun i => ⟨f i, u⟩) k. +Proof. induction k. + - unfold inner_product; simpl. + rewrite zero_adjoint_eq, Mmult_0_l; easy. + - simpl. + rewrite inner_product_plus_l, IHk. + reflexivity. +Qed. + +Lemma inner_product_big_sum_r : forall {n} (u : Vector n) (f : nat -> Vector n) (k : nat), + ⟨u, big_sum f k⟩ = big_sum (fun i => ⟨u, f i⟩) k. +Proof. induction k. + - unfold inner_product; simpl. + rewrite Mmult_0_r; easy. + - simpl. + rewrite inner_product_plus_r, IHk. + reflexivity. +Qed. + +Lemma inner_product_conj_sym : forall {n} (u v : Vector n), + ⟨u, v⟩ = ⟨v, u⟩^*. +Proof. intros. + unfold inner_product, adjoint, Mmult. + rewrite (@big_sum_func_distr C C _ C_is_group _ C_is_group). + apply big_sum_eq_bounded; intros. + lca. + intros; lca. +Qed. + +Lemma inner_product_mafe_WF_l : forall {n} (u v : Vector n), + ⟨u, v⟩ = ⟨make_WF u, v⟩. +Proof. intros. + unfold inner_product, adjoint, Mmult, make_WF. + apply big_sum_eq_bounded; intros. + bdestruct_all; simpl; easy. +Qed. + +Lemma inner_product_mafe_WF_r : forall {n} (u v : Vector n), + ⟨u, v⟩ = ⟨u, make_WF v⟩. +Proof. intros. + unfold inner_product, adjoint, Mmult, make_WF. + apply big_sum_eq_bounded; intros. + bdestruct_all; simpl; easy. +Qed. + +(* Useful to be able to normalize vectors *) +Definition norm {n} (ψ : Vector n) : R := + sqrt (fst ⟨ψ,ψ⟩). + +Definition normalize {n} (ψ : Vector n) := + / (norm ψ) .* ψ. + +Lemma WF_normalize : forall {n} (ψ : Vector n), + WF_Matrix ψ -> WF_Matrix (normalize ψ). +Proof. intros. + unfold normalize. + auto with wf_db. +Qed. + +#[export] Hint Resolve WF_normalize : wf_db. + +Lemma norm_make_WF : forall {n} (v : Vector n), + norm v = norm (make_WF v). +Proof. intros. + unfold norm, make_WF. + apply f_equal_gen; auto. + apply f_equal_gen; auto. + unfold inner_product, adjoint, Mmult. + apply big_sum_eq_bounded; intros. + bdestruct_all; simpl. + easy. +Qed. + +Lemma norm_scale : forall {n} c (v : Vector n), norm (c .* v) = ((Cmod c) * norm v)%R. +Proof. + intros n c v. + unfold norm, inner_product. + rewrite Mscale_adj. + rewrite Mscale_mult_dist_l, Mscale_mult_dist_r, Mscale_assoc. + unfold scale. + simpl. + replace (fst c * snd c + - snd c * fst c)%R with 0%R. + autorewrite with R_db C_db. + replace (fst c * fst c)%R with (fst c ^ 2)%R by lra. + replace (snd c * snd c)%R with (snd c ^ 2)%R by lra. + rewrite sqrt_mult_alt. + reflexivity. + apply Rplus_le_le_0_compat; apply pow2_ge_0. + lra. +Qed. + +Lemma normalized_norm_1 : forall {n} (v : Vector n), + norm v <> 0 -> norm (normalize v) = 1. +Proof. intros. + unfold normalize. + rewrite norm_scale. + rewrite Cmod_real. + simpl. + autorewrite with R_db. + rewrite Rmult_comm. + rewrite Rinv_mult; try easy. + rewrite <- Rmult_comm. + rewrite <- Rmult_assoc. + rewrite Rinv_r; try easy. + autorewrite with R_db. + reflexivity. + unfold Cinv. + simpl. + autorewrite with R_db. + rewrite Rinv_mult; try easy. + rewrite <- Rmult_assoc. + rewrite Rinv_r; try easy. + autorewrite with R_db. + assert (H' : norm v >= 0). + { assert (H'' : 0 <= norm v). + { apply sqrt_pos. } + lra. } + destruct H' as [H0 | H0]. + left. + assert (H1 : 0 < norm v). { lra. } + apply Rinv_0_lt_compat in H1. + lra. easy. + apply div_real. + easy. +Qed. + +Lemma rewrite_norm : forall {d} (ψ : Vector d), + fst ⟨ψ,ψ⟩ = big_sum (fun i => Cmod (ψ i O) ^ 2)%R d. +Proof. + intros d ψ. unfold inner_product, Mmult. + replace (fun y : nat => (ψ† O y * ψ y O)%C) with (fun y : nat => RtoC (Cmod (ψ y O) ^ 2)). + apply Rsum_big_sum. + apply functional_extensionality. intros. + unfold adjoint. rewrite <- Cmod_sqr. symmetry. apply RtoC_pow. +Qed. + +Local Open Scope nat_scope. + +Lemma norm_real : forall {n} (v : Vector n), snd ⟨v,v⟩ = 0%R. +Proof. intros. unfold inner_product, Mmult, adjoint. + rewrite big_sum_snd_0. easy. + intros. rewrite Cmult_comm. + rewrite Cmult_conj_real. + reflexivity. +Qed. + +Lemma inner_product_ge_0 : forall {d} (ψ : Vector d), + (0 <= fst ⟨ψ,ψ⟩)%R. +Proof. + intros. + unfold inner_product, Mmult, adjoint. + apply big_sum_ge_0. + intro. + rewrite <- Cmod_sqr. + simpl. + autorewrite with R_db. + apply Rmult_le_pos; apply Cmod_ge_0. +Qed. + + +(* why does sqrt_pos exist? *) +Lemma norm_ge_0 : forall {d} (ψ : Vector d), + (0 <= norm ψ)%R. +Proof. intros. + unfold norm. + apply sqrt_positivity. + (* apply sqrt_pos *) + apply inner_product_ge_0. +Qed. + +Lemma norm_squared : forall {d} (ψ : Vector d), + ((norm ψ) ^2)%R = fst ⟨ ψ, ψ ⟩. +Proof. intros. + unfold norm. + rewrite pow2_sqrt; auto. + apply inner_product_ge_0. +Qed. + +(* "Quick" proof of |x| = 0 iff x = 0 *) +Lemma inner_product_zero_iff_zero : forall {n} (v : Vector n), + WF_Matrix v -> (⟨v,v⟩ = C0 <-> v = Zero). +Proof. intros. split. + - intros. + destruct (mat_equiv_dec v Zero). + apply mat_equiv_eq; try easy. + assert (H' : v <> Zero). + { unfold not; intros. + apply n0. rewrite H1. + easy. } + apply nonzero_vec_nonzero_elem in H'; try easy. + destruct H'. + unfold WF_Matrix in H. + bdestruct (x b = a). { easy. } + apply H'' in H3. + apply H' in H3. + apply Cmod_gt_0 in H1. + rewrite H3 in H1. + lra. } + rewrite H0 in H'. + simpl in H'. lra. + assert (H' : v x O = C0). + { apply H. left; easy. } + rewrite H' in H1; easy. + - intros. + unfold inner_product. + rewrite H0. + rewrite Mmult_0_r. + easy. +Qed. + +Lemma norm_zero_iff_zero : forall {n} (v : Vector n), + WF_Matrix v -> (norm v = 0%R <-> v = Zero). +Proof. intros. split. + - intros. + unfold norm in H0. + apply inner_product_zero_iff_zero in H. + unfold inner_product in H. + apply sqrt_eq_0 in H0. + apply H. + apply c_proj_eq. + apply H0. + apply norm_real. + apply inner_product_ge_0. + - intros. + rewrite H0. + unfold norm, inner_product. + rewrite Mmult_0_r. + simpl. apply sqrt_0. +Qed. + +Corollary norm_nonzero_iff_nonzero : forall {n} (v : Vector n), + WF_Matrix v -> (norm v <> 0%R <-> v <> Zero). +Proof. intros. + split; intros; + contradict H0; + apply norm_zero_iff_zero; auto. +Qed. + +Corollary fst_inner_product_zero_iff_zero : forall {n} (v : Vector n), + WF_Matrix v -> ((fst ⟨v,v⟩) = 0%R <-> v = Zero). +Proof. intros; split; intros. + apply inner_product_zero_iff_zero; auto. + apply c_proj_eq; auto. + rewrite norm_real; auto. + apply inner_product_zero_iff_zero in H0; auto. + rewrite H0; easy. +Qed. + +Corollary fst_inner_product_nonzero_iff_nonzero : forall {n} (v : Vector n), + WF_Matrix v -> ((fst ⟨v,v⟩) <> 0%R <-> v <> Zero). +Proof. intros; split; intros; + contradict H0; apply fst_inner_product_zero_iff_zero; easy. +Qed. + +Lemma nonzero_inner_product_gt_0 : forall {d} (ψ : Vector d), + WF_Matrix ψ -> ψ <> Zero -> + (0 < fst ⟨ψ,ψ⟩)%R. +Proof. + intros. + assert (H' : forall r : R, (0 <= r -> r <> 0 -> 0 < r)%R). + intros; lra. + apply H'. + apply inner_product_ge_0. + apply fst_inner_product_nonzero_iff_nonzero; easy. +Qed. + +(* useful in some scenarios and also does not require WF *) +Corollary nonzero_entry_implies_nonzero_norm : forall {n} (v : Vector n) (i : nat), + i < n -> v i 0 <> C0 -> norm v <> 0%R. +Proof. intros. + rewrite norm_make_WF. + apply norm_nonzero_iff_nonzero; auto with wf_db. + contradict H0. + replace C0 with (@Zero n (S O) i O). + rewrite <- H0. + unfold make_WF; bdestruct_all; easy. + lca. +Qed. + +Local Close Scope nat_scope. + +(* We can now prove Cauchy-Schwartz for vectors with inner_product *) +Lemma CS_key_lemma : forall {n} (u v : Vector n), + fst ⟨ (⟨v,v⟩ .* u .+ -1 * ⟨v,u⟩ .* v), (⟨v,v⟩ .* u .+ -1 * ⟨v,u⟩ .* v) ⟩ = + ((fst ⟨v,v⟩) * ((fst ⟨v,v⟩)* (fst ⟨u,u⟩) - (Cmod ⟨u,v⟩)^2 ))%R. +Proof. intros. + replace ((fst ⟨v,v⟩) * ((fst ⟨v,v⟩)* (fst ⟨u,u⟩) - (Cmod ⟨u,v⟩)^2 ))%R with + (fst (⟨v,v⟩ * (⟨v,v⟩ * ⟨u,u⟩ - (Cmod ⟨u,v⟩)^2))). + - apply f_equal. + repeat rewrite inner_product_plus_l; repeat rewrite inner_product_plus_r; + repeat rewrite inner_product_scale_l; repeat rewrite inner_product_scale_r. + replace ((-1 * ⟨ v, u ⟩) ^* * (-1 * ⟨ v, u ⟩ * ⟨ v, v ⟩)) with + ( ⟨ v, u ⟩^* * ⟨ v, u ⟩ * ⟨ v, v ⟩ ) by lca. + replace ((-1 * ⟨ v, u ⟩) ^* * (⟨ v, v ⟩ * ⟨ v, u ⟩) + + ⟨ v, u ⟩ ^* * ⟨ v, u ⟩ * ⟨ v, v ⟩) with C0 by lca. + rewrite (inner_product_conj_sym v u), <- (inner_product_conj_sym v v). + rewrite <- Cmult_assoc. + replace (⟨ u, v ⟩ ^* * ⟨ u, v ⟩) with (Cmod ⟨ u, v ⟩ ^ 2) by apply Cmod_sqr. + lca. + - assert (H := norm_real v). + assert (H0 := norm_real u). + destruct ⟨ v, v ⟩; destruct ⟨ u, u ⟩. + rewrite Cmod_sqr. + replace (⟨ u, v ⟩ ^* * ⟨ u, v ⟩) with (Cmod ⟨ u, v ⟩ ^ 2,0)%R. + simpl in *; subst; lra. + apply c_proj_eq. + unfold Cmod. + rewrite pow2_sqrt. + simpl; lra. + apply Rplus_le_le_0_compat; apply pow2_ge_0. + rewrite Cmult_comm, Cmult_conj_real; easy. +Qed. + +Lemma real_ge_0_aux : forall (a b c : R), + 0 <= a -> 0 < b -> (a = b * c)%R -> + 0 <= c. +Proof. intros. + replace c with (a * / b)%R. + apply Rle_mult_inv_pos; auto. + subst. + replace (b * c * / b)%R with (b * /b * c)%R by lra. + rewrite Rinv_r; try lra. +Qed. + +Lemma real_gt_0_aux : forall (a b c : R), + 0 < a -> 0 < b -> (a = b * c)%R -> + 0 < c. +Proof. intros. + replace c with (a * / b)%R. + apply Rlt_mult_inv_pos; auto. + subst. + replace (b * c * / b)%R with (b * /b * c)%R by lra. + rewrite Rinv_r; try lra. +Qed. + +Lemma Cauchy_Schwartz_ver1 : forall {n} (u v : Vector n), + (Cmod ⟨u,v⟩)^2 <= (fst ⟨u,u⟩) * (fst ⟨v,v⟩). +Proof. intros. + destruct (Req_dec (fst ⟨v,v⟩) 0). + - rewrite H. + rewrite inner_product_mafe_WF_l, inner_product_mafe_WF_r in H. + rewrite inner_product_mafe_WF_r. + assert (H' : make_WF v = Zero). + { apply norm_zero_iff_zero; auto with wf_db. + unfold norm; rewrite H. + apply sqrt_0. } + unfold inner_product. + rewrite H', Mmult_0_r. + unfold Zero. + rewrite Cmod_0. + lra. + - assert (H0 := CS_key_lemma u v). + apply real_ge_0_aux in H0. + lra. + apply inner_product_ge_0. + destruct (inner_product_ge_0 v); lra. +Qed. + +Lemma Cauchy_Schwartz_ver2 : forall {n} (u v : Vector n), + (Cmod ⟨u,v⟩) <= norm u * norm v. +Proof. intros. + rewrite <- (sqrt_pow2 (Cmod ⟨ u, v ⟩)), <- (sqrt_pow2 (norm v)), <- (sqrt_pow2 (norm u)). + rewrite <- sqrt_mult. + apply sqrt_le_1. + all : try apply pow2_ge_0. + apply Rmult_le_pos. + all : try apply pow2_ge_0. + unfold norm. + rewrite pow2_sqrt, pow2_sqrt. + apply Cauchy_Schwartz_ver1. + all : try apply inner_product_ge_0; try apply norm_ge_0. + apply Cmod_ge_0. +Qed. + +Lemma Cplx_Cauchy_vector : + forall n (u v : Vector n), + ((big_sum (fun i => Cmod (u i O) ^ 2) n) * (big_sum (fun i => Cmod (v i O) ^ 2) n) >= + Cmod (big_sum (fun i => ((u i O)^* * (v i O))%C) n) ^ 2)%R. +Proof. intros. + assert (H := Cauchy_Schwartz_ver1 u v). + replace (big_sum (fun i : nat => (Cmod (u i 0%nat) ^ 2)%R) n) with (fst ⟨ u, u ⟩). + replace (big_sum (fun i : nat => (Cmod (v i 0%nat) ^ 2)%R) n) with (fst ⟨ v, v ⟩). + replace (Σ (fun i : nat => (u i 0%nat) ^* * v i 0%nat) n) with (⟨ u, v ⟩). + lra. + all : unfold inner_product, adjoint, Mmult; try easy. + all : rewrite (@big_sum_func_distr C R _ C_is_group _ R_is_group). + all : try apply big_sum_eq_bounded; intros. + all : try rewrite <- Cmod_sqr. + all : try (destruct a; destruct b; simpl; easy). + destruct (v x 0%nat); unfold Cmod, pow, Cmult; simpl; lra. + destruct (u x 0%nat); unfold Cmod, pow, Cmult; simpl; lra. +Qed. + +Local Open Scope nat_scope. + +Lemma Cplx_Cauchy : + forall n (u v : nat -> C), + ((big_sum (fun i => Cmod (u i) ^ 2) n) * (big_sum (fun i => Cmod (v i) ^ 2) n) >= Cmod (big_sum (fun i => ((u i)^* * (v i))%C) n) ^ 2)%R. +Proof. intros. + assert (H := Cplx_Cauchy_vector n (fun i j => u i) (fun i j => v i)). + simpl in *. + easy. +Qed. + +Local Close Scope nat_scope. + + +Lemma Cauchy_Schwartz_strict_ver1 : forall {n} (u v : Vector n), + WF_Matrix u -> WF_Matrix v -> + (forall c d, c <> C0 \/ d <> C0 -> c .* u <> d .* v) -> + (Cmod ⟨u,v⟩)^2 < (fst ⟨u,u⟩) * (fst ⟨v,v⟩). +Proof. intros. + destruct (Req_dec (fst ⟨v,v⟩) 0). + - apply fst_inner_product_zero_iff_zero in H2; auto. + assert (H' : C0 .* u = C1 .* v). + subst. lma. + apply H1 in H'. + easy. + right. + apply C1_neq_C0. + - assert (H3 := CS_key_lemma u v). + assert (H' : forall r, 0 <= r -> r <> 0 -> 0 < r). + intros. + lra. + apply real_gt_0_aux in H3. + lra. + apply H'. + apply inner_product_ge_0. + apply fst_inner_product_nonzero_iff_nonzero; auto with wf_db. + assert (H'' : ⟨ v, v ⟩ .* u <> ⟨ v, u ⟩ .* v). + { apply H1. + left. + contradict H2. + rewrite H2; easy. } + contradict H''. + replace (⟨ v, u ⟩ .* v) with (⟨ v, u ⟩ .* v .+ Zero) by lma. + rewrite <- H''. + lma. (* lma does great here! *) + apply H'; auto. + apply inner_product_ge_0. +Qed. + +Lemma Cauchy_Schwartz_strict_ver2 : forall {n} (u v : Vector n), + WF_Matrix u -> WF_Matrix v -> + linearly_independent (smash u v) -> + Cmod ⟨u,v⟩ < norm u * norm v. +Proof. intros. + rewrite <- (sqrt_pow2 (Cmod ⟨ u, v ⟩)), <- (sqrt_pow2 (norm v)), <- (sqrt_pow2 (norm u)). + rewrite <- sqrt_mult. + apply sqrt_lt_1. + all : try apply pow2_ge_0. + apply Rmult_le_pos. + all : try apply pow2_ge_0. + unfold norm. + rewrite pow2_sqrt, pow2_sqrt. + apply Cauchy_Schwartz_strict_ver1. + all : try apply inner_product_ge_0; try apply norm_ge_0; auto. + intros. + apply Classical_Prop.or_not_and in H2. + contradict H2. + unfold linearly_independent in H1. + assert (H' : list2D_to_matrix [[c]; [-d]] = Zero). + apply H1. + apply WF_list2D_to_matrix; try easy. + intros. repeat (destruct H3; subst; try easy). + replace (@Mmult n (Init.Nat.add (S O) (S O)) (S O) + (smash u v) + (list2D_to_matrix [[c]; [-d]])) with (c .* u .+ (-d) .* v). + rewrite H2; lma. + apply mat_equiv_eq; auto with wf_db. + apply WF_mult; auto with wf_db. + apply WF_list2D_to_matrix; try easy. + intros. repeat (destruct H3; subst; try easy). + unfold mat_equiv; intros. + unfold Mmult, smash, list2D_to_matrix, Mplus, scale; simpl. + destruct j; try lia. + lca. + unfold list2D_to_matrix in H'; simpl in H'. + split. + replace C0 with (@Zero 2%nat 1%nat 0%nat 0%nat) by easy. + rewrite <- H'; easy. + replace d with (- (- d)) by lca. + replace (-d) with C0. lca. + replace C0 with (@Zero 2%nat 1%nat 1%nat 0%nat) by easy. + rewrite <- H'; easy. + apply Cmod_ge_0. +Qed. + + + diff --git a/Complex.v b/Complex.v index d3546a5..2fd4f91 100644 --- a/Complex.v +++ b/Complex.v @@ -624,7 +624,6 @@ Proof. intros. rewrite <- H' in H2. easy. Qed. - Lemma Cinv_mult_distr : forall c1 c2 : C, c1 <> 0 -> c2 <> 0 -> / (c1 * c2) = / c1 * / c2. Proof. intros. @@ -673,7 +672,17 @@ Proof. intros. apply nonzero_div_nonzero; auto. Qed. - +Lemma Cconj_eq_implies_real : forall c : C, c = Cconj c -> snd c = 0%R. +Proof. intros. + unfold Cconj in H. + apply (f_equal snd) in H. + simpl in H. + assert (H' : (2 * snd c = 0)%R). + replace (2 * snd c)%R with (snd c + (- snd c))%R by lra. + lra. + replace (snd c) with (/2 * (2 * snd c))%R by lra. + rewrite H'; lra. +Qed. (** * some C big_sum specific lemmas *) @@ -987,7 +996,19 @@ Lemma Cconj_involutive : forall c, (c^*)^* = c. Proof. intros; lca. Qed. Lemma Cconj_plus_distr : forall (x y : C), (x + y)^* = x^* + y^*. Proof. intros; lca. Qed. Lemma Cconj_mult_distr : forall (x y : C), (x * y)^* = x^* * y^*. Proof. intros; lca. Qed. Lemma Cconj_minus_distr : forall (x y : C), (x - y)^* = x^* - y^*. Proof. intros; lca. Qed. - + +Lemma Cinv_Cconj : forall c : C, (/ (c ^*) = (/ c) ^*)%C. +Proof. intros. + unfold Cinv, Cconj; simpl. + apply c_proj_eq; simpl; try lra. + apply f_equal. lra. + (* this is just Ropp_div or Ropp_div_l, depending on Coq version *) + assert (H' : forall x y : R, (- x / y)%R = (- (x / y))%R). + { intros. lra. } + rewrite <- H'. + apply f_equal. lra. +Qed. + Lemma Cmult_conj_real : forall (c : C), snd (c * c^*) = 0. Proof. intros c. diff --git a/Eigenvectors.v b/Eigenvectors.v index 8d8e0a4..5d38996 100644 --- a/Eigenvectors.v +++ b/Eigenvectors.v @@ -1,10 +1,12 @@ (** This file contains more concepts relevent to quantum computing, as well as some more general linear algebra concepts such as Gram-Schmidt and eigenvectors/eigenvalues. *) - -Require Import List. + +Require Import List. Require Export Complex. +Require Export CauchySchwarz. Require Export Quantum. Require Import FTA. +Require Import Permutations. (****************************) @@ -18,7 +20,7 @@ Ltac Hhelper := unfold I; simpl; C_field_simplify; - try lca; + try lca; C_field. Lemma Y_eq_iXZ : σy = Ci .* σx × σz. Proof. lma'. Qed. @@ -57,23 +59,25 @@ Lemma cnotZ2 : cnot × (I 2 ⊗ σz) = (σz ⊗ σz) × cnot. Proof. lma'. Qed. Local Open Scope nat_scope. Definition orthogonal {n m} (S : Matrix n m) : Prop := - forall i j, i <> j -> inner_product (get_vec i S) (get_vec j S) = C0. + forall i j, i <> j -> inner_product (get_col S i) (get_col S j) = C0. Definition orthonormal {n m} (S : Matrix n m) : Prop := - orthogonal S /\ (forall (i : nat), i < m -> norm (get_vec i S) = 1%R). + orthogonal S /\ (forall (i : nat), i < m -> norm (get_col S i) = 1%R). (* to match WF_Unitary *) Definition WF_Orthonormal {n m} (S : Matrix n m) : Prop := WF_Matrix S /\ orthonormal S. -Lemma inner_product_is_mult : forall {n} (i j : nat) (S : Square n), - inner_product (get_vec i S) (get_vec j S) = (S† × S) i j. -Proof. intros. unfold inner_product, get_vec, Mmult, adjoint. +Lemma inner_product_is_mult : forall {m n} (i j : nat) (S : Matrix m n), + inner_product (get_col S i) (get_col S j) = (S† × S) i j. +Proof. intros. unfold inner_product, get_col, Mmult, adjoint. apply big_sum_eq. apply functional_extensionality; intros. simpl. reflexivity. Qed. + +(* FIXME: this already exists in Cauchyschwarz.v *) Lemma inner_product_comm_conj : forall {n} (v u : Vector n), inner_product v u = Cconj (inner_product u v). Proof. intros. @@ -87,252 +91,1037 @@ Proof. intros. Qed. +(***********************************************) +(** * some useful facts about unitary matrices *) +(***********************************************) -(***************************************************) -(** * showing that all matrices have some eigenvector *) -(***************************************************) -(* We first must define a new type to connect polynomials to matrices *) +Lemma unit_is_orthonormal : forall {n} (U : Square n), + WF_Unitary U <-> WF_Orthonormal U. +Proof. intros n U. split. + - split; try apply H. + split. + * unfold orthogonal. intros. + rewrite inner_product_is_mult. + destruct H as [H1 H]. + rewrite H. + unfold I. bdestruct (i =? j); try lia; easy. + * intros. unfold norm, inner_product. + assert (H1 : ((get_col U i) † × get_col U i) 0%nat 0%nat = + inner_product (get_col U i) (get_col U i)). + { unfold inner_product. reflexivity. } + rewrite H1. rewrite inner_product_is_mult. + destruct H. + rewrite H2. unfold I. + bdestruct (i =? i); bdestruct (i nat -> Polynomial. +Lemma det_by_unit : forall {n} (A B X : Square n), + WF_Matrix A -> WF_Matrix B -> + WF_Unitary X -> (forall i, A × (get_col X i) = B × (get_col X i)) -> A = B. +Proof. intros. assert (H' : A × X = B × X). + { apply det_by_get_col. intros. + do 2 (rewrite <- get_col_mult). + apply H2. } + rewrite <- Mmult_1_r. + rewrite <- (Mmult_1_r _ _ A). + destruct H1. + apply Minv_flip in H3; auto with wf_db. + rewrite <- H3. + do 2 (rewrite <- Mmult_assoc). + rewrite H'. + reflexivity. + all : easy. +Qed. -Notation SquareP n := (MatrixP n n). +Lemma unit_invertible : forall {n} (U : Square n), + WF_Unitary U -> invertible U. +Proof. intros. + destruct H. + exists (adjoint U). + split; auto with wf_db. + split; auto. + apply Minv_flip; auto with wf_db. +Qed. -Definition eval_matP {n m} (A : MatrixP n m) (c : C) : Matrix n m := - fun x y => (A x y)[[c]]. +Lemma unit_det_neq_0 : forall {n} (U : Square n), + WF_Unitary U -> Determinant U <> C0. +Proof. intros. + apply invertible_iff_det_neq_0. + apply H. + apply unit_invertible. + apply H. +Qed. -Definition reduceP {n} (A : SquareP (S n)) (row col : nat) : SquareP n := - fun x y => (if x [C1] - | S 0 => A 0 0 - | S n' => (big_sum (fun i => [(parity i)] *, (A i 0) *, (DeterminantP n' (reduceP A i 0)))%C n) - end. +Definition WF_Diagonal {m n : nat} (A : Matrix m n) : Prop := + WF_Matrix A /\ forall i j, i <> j -> A i j = C0. -Arguments DeterminantP {n}. -Lemma DetP_simplify : forall {n} (A : SquareP (S (S n))), - DeterminantP A = - (big_sum (fun i => [(parity i)] *, (A i 0) *, (DeterminantP (reduceP A i 0)))%C (S (S n))). -Proof. intros. easy. Qed. +Lemma diag_Zero : forall m n : nat, WF_Diagonal (@Zero m n). +Proof. intros n. split; auto with wf_db. Qed. -Lemma Peval_Det : forall {n} (A : SquareP n) (c : C), - Determinant (eval_matP A c) = (DeterminantP A)[[c]]. -Proof. induction n as [| n']. - - intros; lca. - - intros. - destruct n'. - + simpl. easy. - + rewrite DetP_simplify, Det_simplify. - rewrite Psum_eval. - apply big_sum_eq_bounded; intros. - rewrite reduceP_eval_mat, IHn'. - do 2 rewrite Pmult_eval. - repeat apply f_equal_gen; try easy. - unfold Peval; lca. +Lemma diag_I : forall n : nat, WF_Diagonal (I n). +Proof. + intros. + split; auto with wf_db. + intros. + unfold I. + bdestruct (i =? j); try lia; try easy. Qed. -(* not really useful except for in the proof of connect *) -Definition prep_mat {n} (A : Square n) : SquareP n := - (fun x y => if (x =? y) && (x WF_Diagonal (r .* A). +Proof. + intros n r A [H H0]. + split; auto with wf_db. + intros. + unfold scale. + rewrite H0; try lca; easy. +Qed. -Definition deg_elem_leq_1 {n} (A : SquareP n) : Prop := - forall i j, degree (A i j) <= 1. - -Lemma del1_reduce : forall {n} (A : SquareP (S n)) (i j : nat), - deg_elem_leq_1 A -> deg_elem_leq_1 (reduceP A i j). -Proof. unfold deg_elem_leq_1, reduceP in *; intros. - bdestruct_all; easy. +Lemma diag_plus : forall {n} (A B : Square n), + WF_Diagonal A -> WF_Diagonal B -> WF_Diagonal (A .+ B). +Proof. + intros n A B [H H0] [H1 H2]. + split; auto with wf_db. + intros. + unfold Mplus. + rewrite H0, H2; try easy; lca. Qed. -Lemma bound_deg_matP : forall {n} (A : SquareP n), - deg_elem_leq_1 A -> degree (DeterminantP A) <= n. -Proof. induction n as [| n']. - - intros. - unfold degree, compactify; simpl. - destruct (Ceq_dec C1 C0); easy. - - intros. - destruct n'. - + simpl. - apply H. - + rewrite DetP_simplify. - apply Psum_degree; intros. - destruct (Peq_dec (A i 0) []). - rewrite p, Pmult_0_r. - unfold degree; simpl; lia. - destruct (Peq_dec (DeterminantP (reduceP A i 0)) []). - rewrite p, Pmult_0_r. - unfold degree; simpl; lia. - destruct (Peq_dec [parity i] []). - rewrite p. - unfold degree; simpl; lia. - destruct (Peq_dec ([parity i] *, A i 0) []). - rewrite p. - unfold degree; simpl; lia. - repeat rewrite Pmult_degree; auto. - assert (H' : degree [parity i] = 0). - { unfold degree, compactify; simpl. - destruct (Ceq_dec (parity i) C0); easy. } - rewrite H', <- (Nat.add_1_l (S n')), Nat.add_0_l. - apply Nat.add_le_mono; auto. - apply IHn'. - apply del1_reduce; easy. +Lemma diag_mult : forall {m n o : nat} (A : Matrix m n) (B : Matrix n o), + WF_Diagonal A -> WF_Diagonal B -> WF_Diagonal (A × B). +Proof. + intros m n o A B [H H0] [H1 H2]. + split; auto with wf_db. + intros. + unfold Mmult. + apply (@big_sum_0 C C_is_monoid). + intro. + bdestruct (x =? i). + + rewrite H2; try lia; lca. + + rewrite H0, Cmult_0_l. + reflexivity. auto. Qed. -(* we now prove prepmat is del1 *) -Lemma del1_prep_mat : forall {n} (A : Square n), - deg_elem_leq_1 (prep_mat A). -Proof. unfold deg_elem_leq_1, prep_mat; intros. - destruct ((i =? j) && (i WF_Diagonal (pad1 A c). +Proof. intros; split; intros; destruct H; split; auto with wf_db; intros. + destruct i; destruct j; auto; try lia. + unfold pad1, col_wedge, row_wedge, e_i, scale. + lca. + rewrite pad1_conv, H0; auto. + eapply WF_pad1_conv. + apply H. + erewrite <- pad1_conv. + rewrite H0; auto. Qed. -Lemma reduce_prep_mat : forall {n} (A : Square (S n)), - reduceP (prep_mat A) 0 0 = prep_mat (reduce A 0 0). -Proof. intros. - prep_matrix_equality. - unfold reduceP, reduce, prep_mat. - bdestruct_all; simpl; try easy. -Qed. +(* short lemma to prove diag_kron *) +Lemma div_mod_eq : forall (a b m : nat), + m <> 0 -> (a / m = b / m) -> (a mod m = b mod m) -> a = b. +Proof. intros a b m H0 Hdiv Hmod. + rewrite (Nat.mod_eq a m), (Nat.mod_eq b m) in Hmod. + rewrite Hdiv in Hmod. + assert (H : m * (b / m) + (a - m * (b / m)) = m * (b / m) + (b - m * (b / m))). + { rewrite Hmod. reflexivity. } + rewrite <- (le_plus_minus' (m * (b / m)) a) in H. + rewrite <- (le_plus_minus' (m * (b / m)) b) in H. + apply H. + apply Nat.mul_div_le; apply H0. + rewrite <- Hdiv; apply Nat.mul_div_le; apply H0. + apply H0. apply H0. +Qed. -(* this got annoyingly long. Probably want to add some helper lemmas at some point *) -Lemma detP_deg : forall {n} (A : Square n), - degree (DeterminantP (prep_mat A)) = n. -Proof. induction n as [| n']. - - intros. - unfold degree, compactify; simpl. - destruct (Ceq_dec C1 C0); easy. - - intros. - destruct n'. - + unfold degree, compactify; simpl. - destruct (Ceq_dec (- C1) C0); try easy. - assert (H' : - (- C1) = C0). - { rewrite e; lca. } - replace (- - C1) with C1 in H' by lca. - apply C1_neq_C0 in H'; easy. - + rewrite DetP_simplify. - assert (H' : forall n f, big_sum f (S n) = f 0 +, big_sum (fun i => f (S i)) n). - { intros. - induction n. - + simpl. - destruct (f 0); try easy; simpl. - + simpl in *. - rewrite IHn, Pplus_assoc; easy. } - assert (H0 : degree (prep_mat A 0 0) = 1). - { unfold prep_mat. - bdestruct_all; simpl. - unfold degree, compactify; simpl. - destruct (Ceq_dec (- C1) C0); try easy. - assert (H'' := C1_neq_C0). - replace C1 with (-C1 * -C1)%C in H'' by lca. - rewrite e, Cmult_0_l in H''; easy. } - assert (H1 : degree ([parity 0] *, prep_mat A 0 0 *, - DeterminantP (reduceP (prep_mat A) 0 0)) = S (S n')). - { simpl parity. - rewrite Pmult_1_l, Pmult_degree, reduce_prep_mat, H0, IHn'. - easy. - destruct (Peq_dec (prep_mat A 0 0) []); auto. - rewrite p in H0; easy. - destruct (Peq_dec (DeterminantP (reduceP (prep_mat A) 0 0)) []); auto. - rewrite reduce_prep_mat in *. - assert (H1 := (IHn' (reduce A 0 0))). - rewrite p in H1; easy. } - rewrite H', Pplus_comm, Pplus_degree2; auto. - rewrite H1. - apply Nat.lt_succ_r. - apply Psum_degree; intros. - assert (H2 : prep_mat A (S i) 0 = [A (S i) 0]). - { unfold prep_mat. - bdestruct_all; easy. } - rewrite H2. - replace ([parity (S i)] *, [A (S i) 0]) with [parity (S i) * A (S i) 0]%C. - destruct (Peq_dec [(parity (S i) * A (S i) 0)%C] []). - rewrite p; simpl. - unfold degree, compactify; simpl; try lia. - destruct (Peq_dec (DeterminantP (reduceP (prep_mat A) (S i) 0)) []). - rewrite p, Pmult_0_r. - unfold degree, compactify; simpl; try lia. - rewrite Pmult_degree; auto. - rewrite <- Nat.add_0_l. - apply Nat.add_le_mono. - destruct (parity (S i) * A (S i) 0)%C eqn:E. - unfold degree, compactify; simpl. - destruct (Ceq_dec (r, r0) C0); simpl; lia. - apply bound_deg_matP. - apply del1_reduce. - apply del1_prep_mat. - simpl; rewrite Cplus_0_r. easy. +Lemma diag_kron : forall {n m : nat} (A : Square n) (B : Square m), + WF_Diagonal A -> WF_Diagonal B -> WF_Diagonal (A ⊗ B). +Proof. + intros n m A B [H H0] [H1 H2]. + destruct m. + rewrite (WF0_Zero_l 0); try easy. + auto with wf_db. + split; auto with wf_db. + unfold kron. + intros. + bdestruct (i / (S m) =? j / (S m)). + - bdestruct (i mod (S m) =? j mod (S m)). + + apply (div_mod_eq i j (S m)) in H5; try easy. + + rewrite H2; try lca; easy. + - rewrite H0; try lca; easy. +Qed. + +Lemma diag_transpose : forall {n : nat} (A : Square n), + WF_Diagonal A -> WF_Diagonal A⊤. +Proof. intros n A [H H0]. + split; auto with wf_db. + intros. + unfold transpose. + apply H0. auto. +Qed. + +Lemma diag_adjoint : forall {n : nat} (A : Square n), + WF_Diagonal A -> WF_Diagonal A†. +Proof. intros n A [H H0]. + split; auto with wf_db. + unfold adjoint, Cconj. + intros. + rewrite H0. lca. auto. +Qed. + +Lemma diag_kron_n : forall (n : nat) {m : nat} (A : Square m), + WF_Diagonal A -> WF_Diagonal (kron_n n A). +Proof. + intros. + induction n; simpl. + - apply diag_I. + - rewrite Nat.mul_comm. + apply (@diag_kron (m^n) m _ A). + apply IHn. apply H. +Qed. + +Lemma diag_big_kron : forall n (l : list (Square n)), + (forall A, In A l -> WF_Diagonal A) -> + WF_Diagonal (⨂ l). +Proof. + intros. + induction l. + - simpl. apply diag_I. + - simpl. apply (@diag_kron _ (n^(length l)) a (⨂ l)). + apply H. + left. easy. + apply IHl. + intros A H'. apply H. + simpl. auto. +Qed. + +Lemma diag_Mmult_n : forall n {m} (A : Square m), + WF_Diagonal A -> WF_Diagonal (Mmult_n n A). +Proof. + intros. + induction n; simpl. + - apply diag_I. + - apply diag_mult; assumption. +Qed. + +(** defining what it means to be diagonalizable *) +Definition WF_Diagonalizable {n : nat} (A : Square n) : Prop := + WF_Matrix A /\ (exists (X X' B: Square n), + WF_Diagonal B /\ WF_Matrix X /\ WF_Matrix X' /\ X × X' = I n /\ B = X × A × X'). + +Lemma diag_imps_diagble : forall {n} (A : Square n), + WF_Diagonal A -> WF_Diagonalizable A. +Proof. intros n A [H H0]. unfold WF_Diagonalizable. + split; auto. + exists (I n), (I n), A. + split. + split; auto. + split; auto with wf_db. + split; auto with wf_db. + rewrite Mmult_1_l; auto with wf_db. + rewrite Mmult_1_l; auto with wf_db. + rewrite Mmult_1_r; auto with wf_db. +Qed. + +Lemma diagble_Zero : forall n : nat, WF_Diagonalizable (@Zero n n). +Proof. intros. apply diag_imps_diagble. + apply diag_Zero. +Qed. + +Lemma diagble_I : forall n : nat, WF_Diagonalizable (I n). +Proof. intros. apply diag_imps_diagble. + apply diag_I. +Qed. + +Lemma diagble_I1 : WF_Diagonal (I 1). Proof. apply diag_I. Qed. + +Lemma diagble_scale : forall {n : nat} (r : C) (A : Square n), + WF_Diagonalizable A -> WF_Diagonalizable (r .* A). +Proof. + intros n r A [H H0]. + split; auto with wf_db. + do 3 (destruct H0). + destruct H0 as [H1 [H2 [H3 [H4 H5] ] ] ]. + exists x, x0, (r .* x1); split. + apply diag_scale; apply H1. + split; try easy. + split; try easy. + split. + apply H4. + rewrite Mscale_mult_dist_r; + rewrite Mscale_mult_dist_l. + rewrite H5. + reflexivity. +Qed. + +Lemma diagble_switch : forall {n : nat} (A B X X' : Square n), + WF_Matrix A -> WF_Matrix X -> WF_Matrix X' -> + X × X' = I n -> B = X × A × X' -> + A = X' × B × X. +Proof. intros. + rewrite H3. + repeat rewrite <- Mmult_assoc. + apply Minv_flip in H2; auto. + rewrite H2, Mmult_1_l; auto. + rewrite Mmult_assoc. + rewrite H2, Mmult_1_r; auto. +Qed. + +(**************************************) +(** * Defining Cprod, similar to big_sum *) +(**************************************) + +(* could define this using the multiplicative monoid on C, but this would + lead to confusing notation, so I just left it *) +Fixpoint Cprod (f : nat -> C) (n : nat) : C := + match n with + | 0 => C1 + | S n' => (Cprod f n' * f n')%C + end. + +Lemma Cprod_1_bounded : forall (f : nat -> C) (n : nat), + (forall i, i < n -> f i = C1) -> Cprod f n = C1. +Proof. intros. + induction n as [| n']. + - easy. + - simpl. + rewrite H, IHn'; try lca. + intros. + apply H; lia. + lia. +Qed. + +Lemma Cprod_0_bounded : forall (f : nat -> C) (n : nat), + (exists i, i < n /\ f i = C0) -> Cprod f n = C0. +Proof. intros. + induction n as [| n']. + - destruct H; lia. + - destruct H as [i [H1 H2] ]. + bdestruct (i C) (n : nat), + (forall i, i < n -> f i <> C0) -> Cprod f n <> C0. +Proof. induction n; intros; simpl. + apply C1_neq_C0. + apply Cmult_neq_0. + apply IHn; intros. + all : apply H; auto. +Qed. + +Lemma Cprod_eq_bounded : forall (f g : nat -> C) (n : nat), + (forall i : nat, i < n -> f i = g i) -> Cprod f n = Cprod g n. +Proof. intros. + induction n as [| n']. + - easy. + - simpl. + rewrite IHn', H; try lia; try easy. + intros. apply H; lia. +Qed. + +Lemma Cprod_extend_r : forall (f : nat -> C) (n : nat), + (Cprod f n * f n)%C = Cprod f (S n). +Proof. easy. Qed. + +Lemma Cprod_extend_l : forall (f : nat -> C) (n : nat), + (f 0 * (Cprod (fun x => f (S x)) n))%C = Cprod f (S n). +Proof. intros. + induction n. + + simpl; lca. + + simpl. + rewrite Cmult_assoc. + rewrite IHn. + simpl. + reflexivity. +Qed. + +Lemma Cprod_product : forall (f g h : nat -> C) (n : nat), + (forall i, i < n -> h i = (f i * g i)%C) -> ((Cprod f n) * (Cprod g n))%C = Cprod h n. +Proof. induction n. + + intros. lca. + + intros. simpl. + rewrite <- IHn, H; try lca; try lia. + intros. apply H; try lia. +Qed. + +(************************************) +(** * Defining upper triangular matrix *) +(************************************) + +Definition upper_triangular {n} (A : Square n) : Prop := + forall i j, i > j -> A i j = C0. + +Lemma up_tri_Zero : forall n : nat, upper_triangular (@Zero n n). +Proof. intros n. unfold upper_triangular. reflexivity. Qed. + +Lemma up_tri_I : forall n : nat, upper_triangular (I n). +Proof. + unfold upper_triangular, I; intros. + bdestruct (i =? j); try lia; easy. +Qed. + +Lemma up_tri_I1 : upper_triangular (I 1). Proof. apply up_tri_I. Qed. + +Lemma up_tri_scale : forall {n : nat} (r : C) (A : Square n), + upper_triangular A -> upper_triangular (r .* A). +Proof. + unfold upper_triangular, scale. + intros. + rewrite H; try lca; easy. +Qed. + +Lemma up_tri_col_scale_many : forall {n} (A : Square n) (as' : Matrix 1 n), + upper_triangular A -> upper_triangular (col_scale_many A as'). +Proof. intros. + unfold col_scale_many, upper_triangular; intros. + rewrite H; auto; lca. +Qed. + +Lemma up_tri_plus : forall {n} (A B : Square n), + upper_triangular A -> upper_triangular B -> upper_triangular (A .+ B). +Proof. + unfold upper_triangular, Mplus. + intros n A B H H0 i j H1. + rewrite H, H0; try lca; easy. +Qed. + + +Lemma up_tri_mult : forall {n : nat} (A B : Square n), + upper_triangular A -> upper_triangular B -> upper_triangular (A × B). +Proof. + unfold upper_triangular, Mmult. + intros n A B H H0 i j D. + apply (@big_sum_0 C C_is_monoid). + intros x. + bdestruct (x upper_triangular (get_minor A 0 0). +Proof. + unfold upper_triangular, get_minor. + intros. + bdestruct (i + Determinant A = Cprod (fun i => A i i) n. +Proof. induction n as [| n']. + - easy. + - intros. simpl. + destruct n' as [| n'']. + + lca. + + assert (H' : (Cprod (fun i : nat => A i i) (S n'') * A (S n'') (S n'') = + A 0 0 * Cprod (fun i : nat => (get_minor A 0 0) i i) (S n''))%C). + { rewrite <- Cprod_extend_l. + rewrite <- Cprod_extend_r. + rewrite <- Cmult_assoc; easy. } + rewrite H'. + rewrite <- big_sum_extend_l. + rewrite <- Cplus_0_r. + rewrite <- Cplus_assoc. + apply Cplus_simplify. + simpl parity. + rewrite IHn'; try lca. + apply up_tri_get_minor_0; easy. + unfold upper_triangular in H. + rewrite H; try lia. + rewrite <- Cplus_0_r. + apply Cplus_simplify; try lca. + apply (@big_sum_0_bounded C C_is_monoid). + intros. + rewrite H; try lia; lca. +Qed. + +Lemma up_tri_get_minor_upper_half : forall {n : nat} (A : Square (S n)) (i j : nat), + i < j -> upper_triangular A -> + upper_triangular (get_minor A i j). +Proof. intros. + unfold upper_triangular, get_minor. + intros. + bdestruct_all; apply H0; try lia. +Qed. + +Lemma up_tri_adjugate : forall {n : nat} (A : Square n), + upper_triangular A -> upper_triangular (adjugate A). +Proof. intros. + unfold adjugate, upper_triangular; intros. + destruct n; auto. + bdestruct_all; simpl; auto. + rewrite det_up_tri_diags. + rewrite Cprod_0_bounded. + lca. + exists j; split. + lia. + unfold get_minor. + bdestruct_all. + rewrite H; auto; lia. + apply up_tri_get_minor_upper_half; auto. +Qed. + +Lemma up_tri_inverse : forall {n : nat} (A : Square n), + upper_triangular A -> upper_triangular (Minverse A). +Proof. intros. + unfold Minverse. + apply up_tri_scale. + apply up_tri_adjugate. + auto. +Qed. + + +Definition unit_upper_triangular {n} (A : Square n) : Prop := + upper_triangular A /\ forall i, i < n -> A i i = C1. + + +Lemma unit_up_tri_I : forall n : nat, unit_upper_triangular (I n). +Proof. + split. + apply up_tri_I. + intros. + unfold I. + bdestruct_all; easy. +Qed. + +Lemma unit_up_tri_mult : forall {n : nat} (A B : Square n), + unit_upper_triangular A -> unit_upper_triangular B -> unit_upper_triangular (A × B). +Proof. + intros n A B [H H0] [H1 H2]; split. + apply up_tri_mult; auto. + intros. + unfold Mmult. + rewrite (big_sum_unique C1); auto. + exists i; split; auto; split. + rewrite H0, H2; auto; lca. + intros. + bdestruct (x' + Determinant A = C1. +Proof. intros. + rewrite det_up_tri_diags. + rewrite Cprod_1_bounded; auto. + intros. + destruct H. + rewrite H1; auto. + apply H. +Qed. -Lemma connect : forall (n : nat) (A : Square (S n)), - exists (p : Polynomial), (Polynomial.degree p) > 0 /\ - (forall c : C, Determinant (A .+ (-c .* I (S n))) = p[[c]]). + + +(*****************************************************************************************) +(** * Explicitly Constructing the QR factorization of an invertible matrix *) +(*****************************************************************************************) + + +(* proj of v onto u *) +Definition proj {n} (u v : Vector n) : Vector n := + ((inner_product u v) / (inner_product u u)) .* u. + +Definition proj_coef {n} (u v : Vector n) : C := + ((inner_product u v) / (inner_product u u)). + +Lemma proj_inner_product : forall {n} (u v : Vector n), + WF_Matrix u -> inner_product u (proj u v) = inner_product u v. +Proof. intros. + destruct (mat_equiv_dec u Zero). + - unfold inner_product, Mmult, adjoint, proj. + repeat rewrite big_sum_0_bounded; auto. + all : try intros; rewrite m; auto; lca. + - unfold proj, inner_product. + distribute_scale. + unfold scale. + unfold Cdiv. + rewrite <- Cmult_assoc. + rewrite Cinv_l. + lca. + apply inner_product_zero_iff_zero in H. + contradict n0. + unfold norm, inner_product in H. + apply H in n0. + rewrite n0. easy. +Qed. + + + + +(*****************************************************************************************) +(** * Defining and verifying the gram_schmidt algorythm and proving v can be part of an onb *) +(*****************************************************************************************) + +Definition gram_schmidt_single_col {n} (T : Square n) (i : nat) : Square n := + fun x y => if (y =? i) && (x I n + | S i => (gram_schmidt_until_i T i) × + gram_schmidt_single_col (T × (gram_schmidt_until_i T i)) (S i) + end. + +Definition gram_schmidt {n} (T : Square n) : Square n := + T × gram_schmidt_until_i T (n - 1). + + +(* this definition makes the above easier to work with *) +Definition gram_schmidt_on_col {n : nat} (T : Square n) (i : nat) := + (big_sum (fun j => -C1 .* (proj (get_col T j) (get_col T i))) i) .+ (get_col T i). + +Lemma WF_gssc : forall {n} (T : Square n) i, + i < n -> WF_Matrix (gram_schmidt_single_col T i). Proof. intros. - exists (DeterminantP (prep_mat A)). - split; intros. - rewrite detP_deg; lia. - rewrite <- Peval_Det. - apply f_equal_gen; try easy. - prep_matrix_equality. - unfold prep_mat, eval_matP, Peval, I, Mplus, scale. - bdestruct_all; simpl; lca. + unfold gram_schmidt_single_col, WF_Matrix, I; intros. + bdestruct_all; easy. Qed. -Lemma connect2 : forall (n : nat) (A : Square (S n)), - exists (c : C), det_eq_c C0 (A .+ (-c .* I (S n))). +Lemma WF_gsoc : forall {n} (T : Square n) i, + i < n -> WF_Matrix T -> WF_Matrix (gram_schmidt_on_col T i). +Proof. intros. + unfold gram_schmidt_on_col. + apply WF_plus; auto with wf_db. + apply WF_Msum; intros. + unfold proj. + auto with wf_db. +Qed. + +Lemma WF_gsui : forall {n} (T : Square n) i, + i < n -> WF_Matrix T -> WF_Matrix (gram_schmidt_until_i T i). +Proof. induction i; intros. + simpl; auto with wf_db. + simpl. + apply WF_mult. + apply IHi; auto; lia. + apply WF_gssc; auto. +Qed. + +Lemma WF_gram_schmidt : forall {n} (T : Square n), + WF_Matrix T -> WF_Matrix (gram_schmidt T). Proof. intros. - destruct (connect n A) as [p [H H0] ]. - destruct (Fundamental_Theorem_Algebra p); auto. - exists x. - split; auto. - rewrite H0; easy. + destruct n. + - unfold gram_schmidt; simpl. + auto with wf_db. + - unfold gram_schmidt. + apply WF_mult; auto. + apply WF_gsui; auto; lia. +Qed. + +Lemma unit_upper_triangular_gsui : forall {n} (T : Square n) i, + unit_upper_triangular (gram_schmidt_until_i T i). +Proof. induction i. + intros; simpl. + split. + apply up_tri_I. + unfold I; intros; bdestruct_all; lca. + intros; simpl. + apply unit_up_tri_mult. + apply IHi; lia. + split; unfold upper_triangular, gram_schmidt_single_col, I; intros; + bdestruct_all; simpl; auto. +Qed. + + +Lemma gram_schmidt_single_col_hit : forall {n} (T : Square n) (i : nat), + WF_Matrix T -> i < n -> + get_col (T × gram_schmidt_single_col T i) i = gram_schmidt_on_col T i. +Proof. intros. + apply mat_equiv_eq. + auto with wf_db. + apply WF_get_col; apply WF_mult; auto. + apply WF_gssc; auto. + apply WF_gsoc; auto. + unfold mat_equiv; intros. + rewrite <- get_col_mult. + unfold Mmult, get_col, gram_schmidt_single_col, gram_schmidt_on_col. + unfold get_col, Mplus, proj, proj_coef, scale. + bdestruct_all. + rewrite Msum_Csum. + replace n with (i + (n-i)) by lia. + rewrite big_sum_sum. + apply f_equal_gen; try apply f_equal. + apply big_sum_eq_bounded; intros. + bdestruct_all; simpl; lca. + apply lt_minus_O_lt in H0. + destruct (n - i); try lia. + rewrite <- big_sum_extend_l. + bdestruct_all; simpl. + replace (big_sum _ _) with C0. + unfold I; bdestruct_all; simpl. + rewrite <- plus_n_O; lca. + rewrite big_sum_0_bounded; auto. + intros. + unfold I; bdestruct_all; simpl; lca. Qed. -Lemma exists_eigenvector : forall (n : nat) (A : Square (S n)), - WF_Matrix A -> - exists (c : C) (v : Vector (S n)), WF_Matrix v /\ v <> Zero /\ A × v = c.* v. +Lemma gram_schmidt_single_col_miss : forall {n} (T : Square n) (i j : nat), + WF_Matrix T -> j < n -> i <> j -> + get_col (T × gram_schmidt_single_col T i) j = get_col T j. Proof. intros. - destruct (connect2 n A) as [c H0]. - apply lin_dep_det_eq_0 in H0; auto with wf_db. - destruct H0 as [v [H1 [H2 H3] ] ]. - exists c, v. - split; auto. - split; auto. - rewrite Mmult_plus_distr_r, Mscale_mult_dist_l, Mmult_1_l in H3; auto. - assert (H4 : A × v .+ (-c .* v) .+ (c .* v) = (c .* v)). - { rewrite H3. lma. } - rewrite Mplus_assoc in H4. - rewrite <- Mscale_plus_distr_l in H4. - replace (-c + c)%C with C0 in H4 by lca. - rewrite <- H4. - lma. + prep_matrix_equality. + unfold get_col, gram_schmidt_single_col, Mmult, I. + bdestruct_all; auto. + rewrite (big_sum_unique (T x j)); auto. + exists j; split; auto; split. + simpl; bdestruct_all; lca. + intros. + simpl. bdestruct_all; lca. +Qed. + +Lemma gram_schmidt_single_col_ver : forall {n} (T : Square n) (i : nat), + WF_Matrix T -> i < n -> + (forall j k, j < i -> k < i -> j <> k -> inner_product (get_col T j) (get_col T k) = C0) -> + (forall j, j < i -> inner_product (get_col T j) (get_col (T × (gram_schmidt_single_col T i)) i) = C0). +Proof. intros. + rewrite gram_schmidt_single_col_hit; auto. + unfold gram_schmidt_on_col. + rewrite inner_product_plus_r, inner_product_big_sum_r. + erewrite (big_sum_unique _). + 2 : exists j; split; auto; split. + 2 : reflexivity. + rewrite inner_product_scale_r, proj_inner_product; auto with wf_db. + lca. + intros. + unfold proj. + rewrite 2 inner_product_scale_r, (H1 j x'); auto. + lca. +Qed. + +Lemma gram_schmidt_until_i_ver : forall {n} (i j k : nat) (T : Square n), + WF_Matrix T -> i < n -> j <= i -> k <= i -> j <> k -> + inner_product + (get_col (T × gram_schmidt_until_i T i) j) + (get_col (T × gram_schmidt_until_i T i) k) = C0. +Proof. induction i; intros. + destruct j; destruct k; lia. + bdestruct (k orthogonal (gram_schmidt T). +Proof. intros. + destruct n. + - unfold orthogonal, gram_schmidt; intros; simpl; lca. + - unfold orthogonal, gram_schmidt; intros. + replace (S n - 1) with n by lia. + bdestruct (i + linearly_independent T -> i < n -> + get_col (gram_schmidt T) i <> Zero. +Proof. intros. + apply lin_indep_det_neq_0 in H0; auto. + destruct H0. + contradict H2. + apply col_0_Det_0 in H2; auto. + unfold gram_schmidt in H2. + rewrite <- Determinant_multiplicative in H2. + rewrite (unit_up_tri_det_1 (gram_schmidt_until_i T (n - 1))) in H2. + rewrite <- H2; lca. + apply unit_upper_triangular_gsui. +Qed. + + +Definition normalize_cols_scalars {n} (T : Square n) : Matrix 1 n := + fun i j => if (i =? 0) && (j orthogonal T -> + (forall i, i < n -> get_col T i <> Zero) -> + WF_Orthonormal (col_scale_many T (normalize_cols_scalars T)). +Proof. intros. + split; auto with wf_db. + split. + unfold orthogonal; intros. + rewrite 2 get_col_col_scale_many. + rewrite inner_product_scale_l, inner_product_scale_r. + rewrite H0; auto; lca. + intros. + rewrite get_col_col_scale_many. + unfold normalize_cols_scalars. + bdestruct_all; simpl. + apply H1 in H2. + apply norm_nonzero_iff_nonzero in H2; auto with wf_db. + apply normalized_norm_1 in H2. + easy. +Qed. + +(* messy, but the important part is the properties *) +Definition QR_factorization_R_inv {n} (T : Square n) := + (col_scale_many (gram_schmidt_until_i T (n - 1)) + (normalize_cols_scalars (T × gram_schmidt_until_i T (n - 1)))). + +Definition QR_factorization_R {n} (T : Square n) := + Minverse (QR_factorization_R_inv T). + +Definition QR_factorization_Q {n} (T : Square n) := + T × (QR_factorization_R_inv T). + + + +Lemma WF_Matrix_R_inv : forall {n} (T : Square n), + WF_Matrix T -> WF_Matrix (QR_factorization_R_inv T). +Proof. intros. + unfold QR_factorization_R_inv. + apply WF_col_scale_many. + destruct n. + - simpl. auto with wf_db. + - apply WF_gsui; auto; try lia. +Qed. + +Lemma WF_Matrix_R : forall {n} (T : Square n), + WF_Matrix (QR_factorization_R T). +Proof. intros. + unfold QR_factorization_R, Minverse. + apply WF_scale; apply WF_adjugate. +Qed. + +Lemma WF_Matrix_Q : forall {n} (T : Square n), + WF_Matrix T -> WF_Matrix (QR_factorization_Q T). +Proof. intros. + unfold QR_factorization_Q, QR_factorization_R_inv. + destruct n; try easy. + apply WF_mult; auto. + apply WF_col_scale_many. + apply WF_gsui; auto. + lia. +Qed. + +#[export] Hint Resolve WF_Matrix_R_inv WF_Matrix_R WF_Matrix_Q : wf_db. + +Lemma R_inv_upper_tri : forall {n} (T : Square n), + upper_triangular (QR_factorization_R_inv T). +Proof. intros. + unfold QR_factorization_R_inv. + apply up_tri_col_scale_many. + apply unit_upper_triangular_gsui. +Qed. + +Lemma R_upper_tri : forall {n} (T : Square n), + upper_triangular (QR_factorization_R T). +Proof. intros. + unfold QR_factorization_R. + apply up_tri_inverse. + apply R_inv_upper_tri. +Qed. + +Lemma R_inv_det_neq_0 : forall {n} (T : Square n), + WF_Matrix T -> linearly_independent T -> + Determinant (QR_factorization_R_inv T) <> C0. +Proof. intros. + rewrite det_up_tri_diags. + apply Cprod_neq_0_bounded; intros. + unfold QR_factorization_R_inv, col_scale_many, normalize_cols_scalars. + assert (H2 := unit_upper_triangular_gsui T (n-1)). + destruct H2; rewrite H3; auto. + bdestruct_all; simpl. + apply Cmult_neq_0. + apply nonzero_div_nonzero. + apply (gs_on_lin_indep_nonzero_cols T i) in H0; auto. + apply norm_nonzero_iff_nonzero in H0. + contradict H0. + apply RtoC_inj in H0. + easy. + apply WF_get_col; apply WF_gram_schmidt; auto. + apply C1_neq_C0. + apply R_inv_upper_tri. +Qed. + +Lemma Q_is_unitary : forall {n} (T : Square n), + WF_Matrix T -> linearly_independent T -> + WF_Orthonormal (QR_factorization_Q T). +Proof. destruct n; try easy. + intros. + unfold QR_factorization_Q, QR_factorization_R_inv. + rewrite col_scale_many_mult_r, <- Mmult_assoc, <- col_scale_many_mult_r. + apply orthogonal_nonzero_cols_implies_orthonomalizable. + all : try apply WF_mult; auto. + all : try apply WF_gsui; auto; try lia. + apply gram_schmidt_ver in H; easy. + intros. + apply (gs_on_lin_indep_nonzero_cols T i) in H0; auto. +Qed. + +Theorem QR_factorization : forall {n} (T : Square n), + WF_Matrix T -> linearly_independent T -> + T = QR_factorization_Q T × QR_factorization_R T. +Proof. intros. + unfold QR_factorization_Q, QR_factorization_R. + rewrite Mmult_assoc, Mmult_Minverse_r. + rewrite Mmult_1_r; auto. + auto with wf_db. + apply R_inv_det_neq_0; auto. +Qed. + + +(* another useful lemma *) +Lemma QR_preserves_first_col : forall {n} (T : Square n), + WF_Matrix T -> + (QR_factorization_R_inv T) O O .* get_col T O = get_col (QR_factorization_Q T) O. +Proof. intros. + apply mat_equiv_eq; auto with wf_db. + unfold QR_factorization_Q, get_col, scale, mat_equiv, Mmult; intros. + destruct j; try lia; simpl. + destruct n; try lia. + rewrite <- big_sum_extend_l. + rewrite big_sum_0_bounded. + lca. + intros. + rewrite R_inv_upper_tri. + lca. + lia. +Qed. + +Lemma R_inv_00_norm : forall {n} (T : Square n), + n <> 0 -> + WF_Matrix T -> linearly_independent T -> + (QR_factorization_R_inv T) O O = / norm (get_col T 0). +Proof. intros. + destruct n; try lia. + unfold QR_factorization_R_inv, col_scale_many. + assert (H2 := unit_upper_triangular_gsui T (S n - 1)). + destruct H2. + rewrite H3; try lia. + unfold normalize_cols_scalars. + simpl. + rewrite Cmult_1_r. + do 3 try apply f_equal_gen; auto. + apply mat_equiv_eq; auto with wf_db. + apply WF_get_col; apply WF_mult; auto. + apply WF_gsui; try lia; auto. + unfold mat_equiv; intros. + destruct j; try lia. + unfold get_col, Mmult. + rewrite <- big_sum_extend_l; simpl. + rewrite H3, big_sum_0_bounded; auto. + lca. + intros. + rewrite H2; try lia. + lca. + lia. +Qed. + +Corollary R_inv_00_neq_0 : forall {n} (T : Square n), + n <> 0 -> + WF_Matrix T -> linearly_independent T -> + (QR_factorization_R_inv T) O O <> C0. +Proof. intros. + destruct n; try lia. + unfold not; intros. + apply R_inv_det_neq_0 in H1; auto. + apply H1. + rewrite det_up_tri_diags. + rewrite <- Cprod_extend_l, H2. + lca. + apply R_inv_upper_tri. +Qed. + +Corollary R_inv_00_real : forall {n} (T : Square n), + n <> 0 -> + WF_Matrix T -> linearly_independent T -> + snd ((QR_factorization_R_inv T) O O) = 0%R. +Proof. intros. + rewrite R_inv_00_norm; auto. + rewrite div_real; auto. Qed. - + +(* +Corollary R_inv_00_pos : forall {n} (T : Square n), + n <> 0 -> + WF_Matrix T -> linearly_independent T -> + (fst ((QR_factorization_R_inv T) O O) > 0)%R. +Proof. intros. + destruct n; try lia. + unfold QR_factorization_R_inv, col_scale_many. + assert (H2 := unit_upper_triangular_gsui T (S n - 1)). + destruct H2. + rewrite H3; try lia. + unfold normalize_cols_scalars. + remember (/ _ ) as a. + simpl. + autorewrite with R_db. + Admitted. +*) + + + (************************************) (** * Lemmas relating to forming bases *) (************************************) +(* NB: we can do all this constructively (already done in stab_types branch) but since the FTA + proof isn't constructive (this is possible, but very hard), it doesn't matter too much, + since the spectral basis will ultimitely be nonconstructive *) Definition form_basis {n} (v : Vector n) (non_zero : nat) : Matrix n n := fun x y => if (y =? non_zero) @@ -351,10 +1140,10 @@ Proof. unfold WF_Matrix, form_basis, e_i. Qed. Lemma get_v_in_basis : forall {n} (v : Vector n) (x : nat), - WF_Matrix v -> get_vec x (form_basis v x) = v. + WF_Matrix v -> get_col (form_basis v x) x = v. Proof. intros. prep_matrix_equality. - unfold get_vec, form_basis. + unfold get_col, form_basis. bdestruct (y =? 0). rewrite Nat.eqb_refl, H0; easy. unfold WF_Matrix in H. @@ -364,10 +1153,10 @@ Proof. intros. Qed. Lemma get_ei_in_basis : forall {n} (v : Vector n) (x y : nat), - y < n -> y <> x -> get_vec y (form_basis v x) = e_i y. + y < n -> y <> x -> get_col (form_basis v x) y = e_i y. Proof. intros. prep_matrix_equality. - unfold get_vec, form_basis. + unfold get_col, form_basis. bdestruct (y0 =? 0). bdestruct (y =? x); try easy. rewrite H1; easy. @@ -377,19 +1166,20 @@ Qed. Lemma form_basis_ver : forall {n} (v : Vector n) (x : nat), v <> Zero -> WF_Matrix v -> v x 0 <> C0 -> x < n -> - linearly_independent (form_basis v x) /\ get_vec x (form_basis v x) = v. + linearly_independent (form_basis v x) /\ get_col (form_basis v x) x = v. Proof. intros. destruct n; try lia. split. - - apply (mat_prop_col_add_many_conv _ _ x (-C1 .* (make_row_zero x v))); + - apply (mat_prop_col_add_many_conv _ _ x (-C1 .* (make_row_val v x C0))); try easy; auto with invr_db. - unfold scale, make_row_zero. + unfold scale, make_row_val. bdestruct (x =? x); try lia; lca. apply (mat_prop_col_scale_conv _ _ x (/ (v x 0))); auto with invr_db. apply nonzero_div_nonzero; easy. assert (H' : forall A : Square (S n), A = I (S n) -> linearly_independent A). { intros. rewrite H3. - apply lin_indep_invertible; auto with wf_db. + apply lin_indep_iff_invertible; auto with wf_db. unfold invertible. exists (I (S n)). + split; auto with wf_db. unfold Minv. split; rewrite Mmult_1_l; auto with wf_db. } apply H'. @@ -398,8 +1188,8 @@ Proof. intros. apply WF_col_add_many; try easy. apply WF_form_basis; easy. unfold mat_equiv; intros. - unfold col_scale, col_add_many, make_row_zero, - form_basis, scale, gen_new_vec, get_vec. + unfold col_scale, col_add_many, make_row_val, + form_basis, scale, gen_new_col, get_col. assert (H0' : forall a b : C, a = C0 -> (b + a = b)%C). { intros. rewrite H5. lca. } bdestruct (j =? x); bdestruct (j =? i). @@ -434,9 +1224,9 @@ Proof. intros. - apply get_v_in_basis; easy. Qed. -Lemma lin_indep_out_of_v : forall {n} (v : Vector n), +Theorem lin_indep_out_of_v : forall {n} (v : Vector n), WF_Matrix v -> v <> Zero -> - exists S : Square n, WF_Matrix S /\ linearly_independent S /\ get_vec 0 S = v. + exists S : Square n, WF_Matrix S /\ linearly_independent S /\ get_col S 0 = v. Proof. intros. destruct n. - exists Zero. @@ -447,7 +1237,7 @@ Proof. intros. prep_matrix_equality. apply H1; lia. prep_matrix_equality. - unfold get_vec, Zero. + unfold get_col, Zero. unfold WF_Matrix in H. rewrite H; try lia. bdestruct (y =? 0); easy. @@ -462,633 +1252,46 @@ Proof. intros. assert (H' : v x 0 = C0). { apply H. lia. } easy. } - assert (H'' : linearly_independent (form_basis v x) /\ get_vec x (form_basis v x) = v). + assert (H'' : linearly_independent (form_basis v x) /\ get_col (form_basis v x) x = v). { apply form_basis_ver; try easy. } split. apply WF_col_swap; try lia; try easy. apply WF_form_basis; easy. - split. - + apply_mat_prop lin_indep_swap_invr. - apply H3; try lia. - easy. - + rewrite col_swap_diff_order. - rewrite <- (col_swap_get_vec _ 0 x). - apply get_v_in_basis. - easy. -Qed. - - -(*****************************************************************************************) -(** * Defining and verifying the gram_schmidt algorythm and proving v can be part of an onb *) -(*****************************************************************************************) - - -(* proj of v onto u *) -Definition proj {n} (u v : Vector n) : Vector n := - ((inner_product u v) / (inner_product u u)) .* u. - -Definition proj_coef {n} (u v : Vector n) : C := - ((inner_product u v) / (inner_product u u)). - -Lemma proj_inner_product : forall {n} (u v : Vector n), - (norm u) <> 0%R -> inner_product u (proj u v) = inner_product u v. -Proof. intros. - unfold proj, inner_product. - distribute_scale. - unfold scale. - unfold Cdiv. - rewrite <- Cmult_assoc. - rewrite Cinv_l. - lca. - unfold norm, inner_product in H. - intro. apply H. - rewrite H0. simpl. - rewrite sqrt_0. - easy. -Qed. - -Definition gram_schmidt_on_v (n m : nat) (v : Vector n) (S : Matrix n m) := - v .+ (big_sum (fun i => (-C1) .* (proj (get_vec i S) v)) m). - -Definition delta_T {n m} (T : Matrix n (S m)) (i : nat) : C := - match i =? m with - | true => C1 - | _ => - (proj_coef (get_vec i T) (get_vec m T)) - end. - -(* slightly different version thats easier to work with in general case *) -Definition gram_schmidt_on_T (n m : nat) (T : Matrix n (S m)) : Vector n := - big_sum (fun i => (delta_T T) i .* (get_vec i T)) (S m). - -Lemma WF_gs_on_T : forall {n m} (T : Matrix n (S m)), - WF_Matrix T -> WF_Matrix (gram_schmidt_on_T n m T). -Proof. intros. - unfold gram_schmidt_on_T. - apply WF_Msum; intros. - apply WF_scale. - unfold get_vec, WF_Matrix in *; intros. - destruct H1. - - rewrite H; auto. - bdestruct (y =? 0); easy. - - bdestruct (y =? 0); try lia; try easy. -Qed. - -Lemma gram_schmidt_compare : forall {n m} (T : Matrix n (S m)), - inner_product (get_vec m T) (get_vec m T) <> C0 -> - gram_schmidt_on_T n m T = gram_schmidt_on_v n m (get_vec m T) (reduce_col T m). -Proof. intros. - unfold gram_schmidt_on_T, gram_schmidt_on_v. - prep_matrix_equality. - unfold Mplus. - do 2 rewrite Msum_Csum. - rewrite Cplus_comm. - rewrite <- big_sum_extend_r. - apply Cplus_simplify. - - apply big_sum_eq_bounded. - intros. - unfold delta_T. - bdestruct (x0 =? m); try lia. - unfold proj, proj_coef. - distribute_scale. - assert (H' : get_vec x0 (reduce_col T m) = get_vec x0 T). - { prep_matrix_equality; - unfold get_vec, reduce_col. - bdestruct (x0 i < m -> inner_product (get_vec i S) (gram_schmidt_on_v n m v S) = C0. -Proof. intros. - destruct H as [H H1]. - unfold orthogonal in H. - unfold gram_schmidt_on_v. - rewrite inner_product_plus_r, inner_product_big_sum_r. - rewrite (big_sum_unique (-C1 * ⟨ get_vec i S, v ⟩)%C _ m); try lca. - exists i. split; try easy. - split. - - rewrite inner_product_scale_r. - rewrite proj_inner_product. - lca. - rewrite H1; auto; lra. - - intros. - unfold proj. - do 2 rewrite inner_product_scale_r. - apply H in H3. - rewrite H3. - lca. -Qed. - -Definition f_to_vec (n : nat) (f : nat -> C) : Vector n := - fun i j => if (j =? 0) && (i C), WF_Matrix (f_to_vec n f). -Proof. intros. - unfold WF_Matrix, f_to_vec. - intros x y [H | H]. - - bdestruct (y =? 0); bdestruct (x C), - big_sum (fun i => f i .* get_vec i T) (S m) = T × (f_to_vec (S m) f). -Proof. intros. - prep_matrix_equality. - rewrite Msum_Csum. - unfold Mmult. - apply big_sum_eq_bounded. - intros. - unfold f_to_vec, get_vec, scale. - bdestruct (x0 gram_schmidt_on_T n m T <> Zero. -Proof. intros. - unfold not, gram_schmidt_on_T; intros. - rewrite (Msum_to_Mmult T (delta_T T)) in H0. - unfold linearly_independent in H. - apply H in H0. - apply C1_neq_C0. - assert (H'' : f_to_vec (S m) (delta_T T) m 0 = C0). - { rewrite H0. easy. } - rewrite <- H''. - unfold f_to_vec, delta_T. - bdestruct (m inner_product u (normalize v) = C0. -Proof. intros. - unfold normalize in *. - rewrite inner_product_scale_r. - rewrite H. - lca. -Qed. - -Lemma get_vec_reduce_append_miss : forall {n m} (T : Matrix n (S m)) (v : Vector n) (i : nat), - i < m -> get_vec i (col_append (reduce_col T m) v) = get_vec i T. -Proof. intros. - prep_matrix_equality. - unfold get_vec, col_append, reduce_col. - bdestruct_all; easy. -Qed. - -Lemma get_vec_reduce_append_hit : forall {n m} (T : Matrix n (S m)) (v : Vector n), - WF_Matrix v -> get_vec m (col_append (reduce_col T m) v) = v. -Proof. intros. - unfold get_vec, col_append, reduce_col. - prep_matrix_equality. - bdestruct (y =? 0). - - bdestruct_all; subst; easy. - - rewrite H; try lia; easy. -Qed. - -Lemma get_vec_reduce_append_over : forall {n m} (T : Matrix n (S m)) (v : Vector n) (i : nat), - WF_Matrix T -> i > m -> - get_vec i (col_append (reduce_col T m) v) = Zero. -Proof. intros. - prep_matrix_equality. - unfold get_vec, col_append, reduce_col. - bdestruct_all; try easy. - rewrite H. easy. - right. lia. -Qed. - -Lemma extend_onb_ind_step_part1 : forall {n m} (T : Matrix n (S m)), - WF_Matrix T -> linearly_independent T -> orthonormal (reduce_col T m) -> - orthonormal (col_append (reduce_col T m) (normalize (gram_schmidt_on_T n m T))). -Proof. intros. - split. - - unfold orthogonal. - intros. - bdestruct (m C := - fun i => if (i - smash (col_append T1 (gram_schmidt_on_T n m1 (col_append T1 v))) T2 = - @col_add_many n ((S m1) + m2) m1 (f_to_vec (m1 + m2) (delta_T' T1 v m1)) - (smash (col_append T1 v) T2). -Proof. intros. - prep_matrix_equality. - unfold smash, col_append, gram_schmidt_on_T, col_add_many. - bdestruct (y (a + b = a)%C). - intros. rewrite H4. lca. - rewrite p1. - apply big_sum_eq_bounded; intros. - bdestruct (x0 =? m1); bdestruct (x0 WF_Matrix T2 -> WF_Matrix v -> v <> Zero -> - linearly_independent (smash (col_append T1 v) T2) -> - linearly_independent (smash (col_append T1 - (normalize (gram_schmidt_on_T n m1 (col_append T1 v)))) T2). -Proof. intros. - rewrite smash_scale. - apply_mat_prop lin_indep_scale_invr. - apply H5. - unfold not; intros. - assert (H4' : (norm (gram_schmidt_on_T n m1 (col_append T1 v)) * - / norm (gram_schmidt_on_T n m1 (col_append T1 v)) = - norm (gram_schmidt_on_T n m1 (col_append T1 v)) * C0)%C). - { rewrite H6; easy. } - rewrite Cmult_0_r, Cinv_r in H4'. - apply C1_neq_C0; easy. - unfold not; intros. - assert (H5' : WF_Matrix (gram_schmidt_on_T n m1 (col_append T1 v))). - { apply WF_gs_on_T. - apply WF_col_append; easy. } - apply norm_zero_iff_zero in H5'. - apply RtoC_inj in H7. - rewrite H7 in H5'. - apply (gram_schmidt_non_zero (col_append T1 v)). - apply lin_indep_smash in H3; easy. - apply H5'; lra. - rewrite gs_on_T_cols_add; try easy. - apply_mat_prop lin_indep_add_invr. - apply invr_col_add_col_add_many in H6. - inversion H6; subst. - apply H8; try lia; try easy. - unfold f_to_vec, delta_T'. - bdestruct (m1 WF_Matrix T2 -> WF_Matrix v -> - linearly_independent (smash (col_append T1 v) T2) -> orthonormal T1 -> - exists v1, WF_Matrix v1 /\ orthonormal (col_append T1 v1) /\ - linearly_independent (smash (col_append T1 v1) T2). -Proof. intros. - exists (normalize (gram_schmidt_on_T n m1 (col_append T1 v))). - split. unfold normalize. - apply WF_scale. - apply WF_gs_on_T. - apply WF_col_append; try easy. - split. - - apply lin_indep_smash in H2. - assert (H4 := extend_onb_ind_step_part1 (col_append T1 v)). - assert (H' : reduce_col (col_append T1 v) m1 = T1). - { intros. - prep_matrix_equality. - unfold reduce_col, col_append. - bdestruct (y WF_Matrix T2 -> - linearly_independent (smash T1 T2) -> orthonormal T1 -> - exists T2' : Matrix n m2, WF_Matrix T2' /\ orthonormal (smash T1 T2'). -Proof. induction m2 as [| m2']. - - intros. - exists Zero. - split. easy. - rewrite smash_zero; try easy. - rewrite Nat.add_0_r. - apply H2. - - intros. - rewrite (split_col T2) in *. - assert (H3 := (smash_assoc T1 (get_vec 0 T2) (reduce_col T2 0))). - simpl in *. - rewrite <- H3 in H1. - rewrite <- smash_append in H1; try easy. - assert (exists v1, WF_Matrix v1 /\ orthonormal (col_append T1 v1) /\ - linearly_independent (smash (col_append T1 v1) (reduce_col T2 0))). - { apply (extend_onb_ind_step _ _ (get_vec 0 T2)); try easy. - apply WF_reduce_col. lia. - rewrite (split_col T2). easy. - apply WF_get_vec. - rewrite (split_col T2). easy. - assert (add1 : S (m1 + S m2') = S (S m1) + m2'). { lia. } - assert (add2 : S (m1 + 1) = S (S m1)). { lia. } - rewrite add1, add2 in H1. - apply H1. } - destruct H4 as [v [H4 [H5 H6] ] ]. - assert (H7 : exists T2' : Matrix n m2', - WF_Matrix T2' /\ orthonormal (smash (smash T1 v) T2')). - { assert (H'' := (@WF_smash n (S m1) (S O) T1 v)). - assert (H''' : Nat.add (S m1) (S O) = S (S m1)). lia. - apply (IHm2' _ (smash T1 v) (reduce_col T2 0)); try easy. - assert (H' : Nat.add m1 (S O) = S m1). lia. - unfold Nat.add in H'. - rewrite H'. - rewrite H''' in *. - apply H''. - easy. easy. - apply (WF_reduce_col 0 T2); try lia. - rewrite (split_col T2); easy. - assert (add1 : S (Nat.add m1 (S m2')) = S (Nat.add (Nat.add m1 (S O)) m2')). lia. - rewrite add1 in H1. - unfold Nat.add in H1. - unfold Nat.add. - rewrite <- smash_append; try easy. - assert (add2 : Nat.add (S (S m1)) m2' = S (Nat.add (Nat.add m1 (S O)) m2')). lia. - assert (add3 : (S (S m1)) = S (Nat.add m1 (S O))). lia. - rewrite add2, add3 in H6. - unfold Nat.add in H6. - apply H6. - rewrite <- smash_append; try easy. - assert (add4 : S (S m1) = S (Nat.add m1 (S O))). lia. - rewrite add4 in H5. - unfold Nat.add in H5. - apply H5. } - destruct H7. - rewrite smash_assoc in H7. - exists (smash v x). - split. - assert (H' : S m2' = 1 + m2'). lia. rewrite H'. - apply WF_smash; try easy. - assert (add5 : Nat.add (Nat.add (S m1) (S O)) m2' = S (Nat.add m1 (S m2'))). lia. - assert (add6 : (Init.Nat.add (S O) m2') = (S m2')). lia. - rewrite add5, add6 in H7. - apply H7. - apply WF_get_vec. - rewrite (split_col T2). - easy. -Qed. - -Lemma get_vec_vec : forall {n} (v : Vector n), - WF_Matrix v -> get_vec 0 v = v. -Proof. intros. - unfold get_vec. - prep_matrix_equality. - bdestruct (y =? 0). - - rewrite H0; easy. - - unfold WF_Matrix in H. - rewrite H; try easy. - right. - bdestruct (y Zero -> WF_Matrix v -> orthonormal (normalize v). -Proof. intros. - split. - unfold orthogonal, inner_product. - intros. destruct i. - + assert (H' : get_vec j (normalize v) = Zero). - { prep_matrix_equality. - unfold get_vec, normalize. - bdestruct (y =? 0); try easy. - unfold scale. rewrite H0; try lia; lca. } - rewrite H', Mmult_0_r; easy. - + assert (H' : get_vec (S i) (normalize v) = Zero). - { prep_matrix_equality. - unfold get_vec, normalize. - bdestruct (y =? 0); try easy. - unfold scale. rewrite H0; try lia; lca. } - rewrite H', zero_adjoint_eq, Mmult_0_l; easy. - + intros. - destruct i; try lia. - rewrite get_vec_vec. - apply normalized_norm_1. - unfold not; intros; apply H. - apply norm_zero_iff_zero in H0. - apply H0; easy. - unfold normalize. - auto with wf_db. -Qed. -(* the steps here are a bit confusing, but we use these lemmas to - prove the following useful fact *) +(* Given the proof of QR above, we now get this for free! (contrast older branch) *) Theorem onb_out_of_v : forall {n} (v : Vector n), WF_Matrix v -> v <> Zero -> - exists T : Square n, WF_Orthonormal T /\ get_vec 0 T = normalize v. + exists T : Square n, WF_Orthonormal T /\ get_col T 0 = normalize v. Proof. intros. destruct n as [| n]. - assert (H' : v = Zero). prep_matrix_equality. rewrite H; try lia; easy. easy. - - assert (H' : WF_Matrix (normalize v)). - { unfold normalize. - auto with wf_db. } - apply lin_indep_out_of_v in H'; try easy. - destruct H' as [S0 [H1 [H2 H3] ] ]. - rewrite (split_col S0) in H2. - apply (extend_onb (S n) n 0 (get_vec 0 S0) (reduce_col S0 0)) in H2. - destruct H2 as [T [H4 H5] ]. - exists (smash (get_vec 0 S0) T). split; try easy. - assert (H' : S n = 1 + n). lia. rewrite H'. - unfold WF_Orthonormal; split. - apply WF_smash; try easy. - apply WF_get_vec; easy. + - destruct (lin_indep_out_of_v v) as [X [H2 [H3 H4] ] ]; auto. + exists (QR_factorization_Q X). + split. + apply Q_is_unitary; auto. + rewrite <- QR_preserves_first_col, R_inv_00_norm; auto. + rewrite H4. easy. - apply WF_get_vec; easy. - apply (WF_reduce_col 0) in H1; try easy; lia. - rewrite H3; apply orthonormal_normalize_v; easy. - unfold not; intros; apply H0. - prep_matrix_equality. - assert (H2 : (normalize v) x y = C0). - { rewrite H1; easy. } - unfold Zero; simpl. - unfold normalize, scale in H2. - destruct (Ceq_dec (v x y) C0); try easy. - assert (H3 : norm v <> 0%R). - { unfold not; intros. - apply norm_zero_iff_zero in H. - apply H in H3; easy. } - assert (H4 : / norm v <> C0). - { destruct (Ceq_dec (/ norm v) C0); try easy. - assert (H4' : (norm v * / norm v = norm v * C0)%C). - rewrite e; easy. - rewrite Cmult_0_r, Cinv_r in H4'. - assert (H5 : C1 <> C0). - { apply C0_fst_neq. - simpl. - apply R1_neq_R0. } - easy. - apply RtoC_neq; easy. } - apply (Cmult_neq_0 _ (v x y)) in H4; easy. Qed. -(***********************************************) -(** * some useful facts about unitary matrices *) -(***********************************************) - - -Lemma unit_is_orthonormal : forall {n} (U : Square n), - WF_Unitary U <-> WF_Orthonormal U. -Proof. intros n U. split. - - split; try apply H. - split. - * unfold orthogonal. intros. - rewrite inner_product_is_mult. - destruct H as [H1 H]. - rewrite H. - unfold I. bdestruct (i =? j); try lia; easy. - * intros. unfold norm, inner_product. - assert (H1 : ((get_vec i U) † × get_vec i U) 0%nat 0%nat = - inner_product (get_vec i U) (get_vec i U)). - { unfold inner_product. reflexivity. } - rewrite H1. rewrite inner_product_is_mult. - destruct H. - rewrite H2. unfold I. - bdestruct (i =? i); bdestruct (i v <> Zero -> - exists S : Square n, WF_Unitary S /\ get_vec 0 S = normalize v. + exists S : Square n, WF_Unitary S /\ get_col S 0 = normalize v. Proof. intros. apply onb_out_of_v in H; try easy. destruct H as [S [H1 H2] ]. @@ -1096,384 +1299,1155 @@ Proof. intros. apply unit_is_orthonormal; easy. Qed. -Lemma det_by_unit : forall {n} (A B X : Square n), - WF_Matrix A -> WF_Matrix B -> - WF_Unitary X -> (forall i, A × (get_vec i X) = B × (get_vec i X)) -> A = B. -Proof. intros. assert (H' : A × X = B × X). - { apply det_by_get_vec. intros. - do 2 (rewrite <- get_vec_mult). - apply H2. } - rewrite <- Mmult_1_r. - rewrite <- (Mmult_1_r _ _ A). - destruct H1. - apply Minv_flip in H3; auto with wf_db. - rewrite <- H3. - do 2 (rewrite <- Mmult_assoc). - rewrite H'. - reflexivity. - all : easy. + + +(***************************************************) +(** * showing that all matrices have some eigenvector *) +(***************************************************) + +(* We first must define a new type to connect polynomials to matrices *) + +Definition MatrixP (m n : nat) := nat -> nat -> Polynomial. + +Notation SquareP n := (MatrixP n n). + +Definition eval_matP {n m} (A : MatrixP n m) (c : C) : Matrix n m := + fun x y => (A x y)[[c]]. + +Definition get_minorP {n} (A : SquareP (S n)) (row col : nat) : SquareP n := + fun x y => (if x [C1] + | S 0 => A 0 0 + | S n' => (big_sum (fun i => [(parity i)] *, (A i 0) *, (DeterminantP n' (get_minorP A i 0)))%C n) + end. -(***********************************************************************************) -(** * We now define diagonal matrices and diagonizable matrices, proving basic lemmas *) -(***********************************************************************************) +Arguments DeterminantP {n}. -Definition WF_Diagonal {n : nat} (A : Square n) : Prop := - WF_Matrix A /\ forall i j, i <> j -> A i j = C0. +Lemma DetP_simplify : forall {n} (A : SquareP (S (S n))), + DeterminantP A = + (big_sum (fun i => [(parity i)] *, (A i 0) *, (DeterminantP (get_minorP A i 0)))%C (S (S n))). +Proof. intros. easy. Qed. + +Lemma Peval_Det : forall {n} (A : SquareP n) (c : C), + Determinant (eval_matP A c) = (DeterminantP A)[[c]]. +Proof. induction n as [| n']. + - intros; lca. + - intros. + destruct n'. + + simpl. easy. + + rewrite DetP_simplify, Det_simplify. + rewrite Psum_eval. + apply big_sum_eq_bounded; intros. + rewrite get_minorP_eval_mat, IHn'. + do 2 rewrite Pmult_eval. + repeat apply f_equal_gen; try easy. + unfold Peval; lca. +Qed. + +(* not really useful except for in the proof of connect *) +Definition prep_mat {n} (A : Square n) : SquareP n := + (fun x y => if (x =? y) && (x deg_elem_leq_1 (get_minorP A i j). +Proof. unfold deg_elem_leq_1, get_minorP in *; intros. + bdestruct_all; easy. +Qed. + +Lemma bound_deg_matP : forall {n} (A : SquareP n), + deg_elem_leq_1 A -> degree (DeterminantP A) <= n. +Proof. induction n as [| n']. + - intros. + unfold degree, compactify; simpl. + destruct (Ceq_dec C1 C0); easy. + - intros. + destruct n'. + + simpl. + apply H. + + rewrite DetP_simplify. + apply Psum_degree; intros. + destruct (Peq_dec (A i 0) []). + rewrite p, Pmult_0_r. + unfold degree; simpl; lia. + destruct (Peq_dec (DeterminantP (get_minorP A i 0)) []). + rewrite p, Pmult_0_r. + unfold degree; simpl; lia. + destruct (Peq_dec [parity i] []). + rewrite p. + unfold degree; simpl; lia. + destruct (Peq_dec ([parity i] *, A i 0) []). + rewrite p. + unfold degree; simpl; lia. + repeat rewrite Pmult_degree; auto. + assert (H' : degree [parity i] = 0). + { unfold degree, compactify; simpl. + destruct (Ceq_dec (parity i) C0); easy. } + rewrite H', <- (Nat.add_1_l (S n')), Nat.add_0_l. + apply Nat.add_le_mono; auto. + apply IHn'. + apply del1_reduce; easy. +Qed. + +(* we now prove prepmat is del1 *) +Lemma del1_prep_mat : forall {n} (A : Square n), + deg_elem_leq_1 (prep_mat A). +Proof. unfold deg_elem_leq_1, prep_mat; intros. + destruct ((i =? j) && (i f (S i)) n). + { intros. + induction n. + + simpl. + destruct (f 0); try easy; simpl. + + simpl in *. + rewrite IHn, Pplus_assoc; easy. } + assert (H0 : degree (prep_mat A 0 0) = 1). + { unfold prep_mat. + bdestruct_all; simpl. + unfold degree, compactify; simpl. + destruct (Ceq_dec (- C1) C0); try easy. + assert (H'' := C1_neq_C0). + replace C1 with (-C1 * -C1)%C in H'' by lca. + rewrite e, Cmult_0_l in H''; easy. } + assert (H1 : degree ([parity 0] *, prep_mat A 0 0 *, + DeterminantP (get_minorP (prep_mat A) 0 0)) = S (S n')). + { simpl parity. + rewrite Pmult_1_l, Pmult_degree, reduce_prep_mat, H0, IHn'. + easy. + destruct (Peq_dec (prep_mat A 0 0) []); auto. + rewrite p in H0; easy. + destruct (Peq_dec (DeterminantP (get_minorP (prep_mat A) 0 0)) []); auto. + rewrite reduce_prep_mat in *. + assert (H1 := (IHn' (get_minor A 0 0))). + rewrite p in H1; easy. } + rewrite H', Pplus_comm, Pplus_degree2; auto. + rewrite H1. + apply Nat.lt_succ_r. + apply Psum_degree; intros. + assert (H2 : prep_mat A (S i) 0 = [A (S i) 0]). + { unfold prep_mat. + bdestruct_all; easy. } + rewrite H2. + replace ([parity (S i)] *, [A (S i) 0]) with [parity (S i) * A (S i) 0]%C. + destruct (Peq_dec [(parity (S i) * A (S i) 0)%C] []). + rewrite p; simpl. + unfold degree, compactify; simpl; try lia. + destruct (Peq_dec (DeterminantP (get_minorP (prep_mat A) (S i) 0)) []). + rewrite p, Pmult_0_r. + unfold degree, compactify; simpl; try lia. + rewrite Pmult_degree; auto. + rewrite <- Nat.add_0_l. + apply Nat.add_le_mono. + destruct (parity (S i) * A (S i) 0)%C eqn:E. + unfold degree, compactify; simpl. + destruct (Ceq_dec (r, r0) C0); simpl; lia. + apply bound_deg_matP. + apply del1_reduce. + apply del1_prep_mat. + simpl; rewrite Cplus_0_r. easy. +Qed. -Lemma diag_Zero : forall n : nat, WF_Diagonal (@Zero n n). -Proof. intros n. split; auto with wf_db. Qed. +Lemma connect : forall (n : nat) (A : Square (S n)), + exists (p : Polynomial), (Polynomial.degree p) > 0 /\ + (forall c : C, Determinant (A .+ (-c .* I (S n))) = p[[c]]). +Proof. intros. + exists (DeterminantP (prep_mat A)). + split; intros. + rewrite detP_deg; lia. + rewrite <- Peval_Det. + apply f_equal_gen; try easy. + prep_matrix_equality. + unfold prep_mat, eval_matP, Peval, I, Mplus, scale. + bdestruct_all; simpl; lca. +Qed. -Lemma diag_I : forall n : nat, WF_Diagonal (I n). -Proof. - intros. - split; auto with wf_db. - intros. - unfold I. - bdestruct (i =? j); try lia; try easy. +Lemma connect2 : forall (n : nat) (A : Square (S n)), + exists (c : C), det_eq_c C0 (A .+ (-c .* I (S n))). +Proof. intros. + destruct (connect n A) as [p [H H0] ]. + destruct (Fundamental_Theorem_Algebra p); auto. + exists x. + split; auto. + rewrite H0; easy. +Qed. + +Theorem exists_eigenvector : forall (n : nat) (A : Square (S n)), + WF_Matrix A -> + exists (c : C) (v : Vector (S n)), WF_Matrix v /\ v <> Zero /\ A × v = c.* v. +Proof. intros. + destruct (connect2 n A) as [c H0]. + apply lin_dep_det_eq_0 in H0; auto with wf_db. + destruct H0 as [v [H1 [H2 H3] ] ]. + exists c, v. + split; auto. + split; auto. + rewrite Mmult_plus_distr_r, Mscale_mult_dist_l, Mmult_1_l in H3; auto. + assert (H4 : A × v .+ (-c .* v) .+ (c .* v) = (c .* v)). + { rewrite H3. lma. } + rewrite Mplus_assoc in H4. + rewrite <- Mscale_plus_distr_l in H4. + replace (-c + c)%C with C0 in H4 by lca. + rewrite <- H4. + lma. Qed. -Lemma diag_I1 : WF_Diagonal (I 1). Proof. apply diag_I. Qed. +(**************************************************) +(** * Proving that every matrix has a Schur Decomposition *) +(**************************************************) -Lemma diag_scale : forall {n : nat} (r : C) (A : Square n), - WF_Diagonal A -> WF_Diagonal (r .* A). -Proof. - intros n r A [H H0]. - split; auto with wf_db. - intros. - unfold scale. - rewrite H0; try lca; easy. -Qed. +(* first, two helper defs *) +Definition first_col_e_i {m n} (A : Matrix m n) := + forall i, 0 < i -> A i 0 = C0. -Lemma diag_plus : forall {n} (A B : Square n), - WF_Diagonal A -> WF_Diagonal B -> WF_Diagonal (A .+ B). -Proof. - intros n A B [H H0] [H1 H2]. - split; auto with wf_db. - intros. - unfold Mplus. - rewrite H0, H2; try easy; lca. -Qed. +Definition first_row_e_i {m n} (A : Matrix m n) := + forall i, 0 < i -> A 0 i = C0. -Lemma diag_mult : forall {n : nat} (A B : Square n), - WF_Diagonal A -> WF_Diagonal B -> WF_Diagonal (A × B). -Proof. - intros n A B [H H0] [H1 H2]. - split; auto with wf_db. - intros. - unfold Mmult. - apply (@big_sum_0 C C_is_monoid). - intro. - bdestruct (x =? i). - + rewrite H2; try lia; lca. - + rewrite H0, Cmult_0_l. - reflexivity. auto. +Lemma fce_pad1 : forall {m n} (A : Matrix m n) (a : C), + first_col_e_i (pad1 A a). +Proof. intros. + unfold first_col_e_i, pad1, col_wedge, row_wedge, e_i, scale; intros. + bdestruct_all; lca. Qed. -(* short lemma to prove diag_kron *) -Lemma div_mod_eq : forall (a b m : nat), - m <> 0 -> (a / m = b / m) -> (a mod m = b mod m) -> a = b. -Proof. intros a b m H0 Hdiv Hmod. - rewrite (Nat.mod_eq a m), (Nat.mod_eq b m) in Hmod. - rewrite Hdiv in Hmod. - assert (H : m * (b / m) + (a - m * (b / m)) = m * (b / m) + (b - m * (b / m))). - { rewrite Hmod. reflexivity. } - rewrite <- (le_plus_minus' (m * (b / m)) a) in H. - rewrite <- (le_plus_minus' (m * (b / m)) b) in H. - apply H. - apply Nat.mul_div_le; apply H0. - rewrite <- Hdiv; apply Nat.mul_div_le; apply H0. - apply H0. apply H0. +Lemma fre_pad1 : forall {m n} (A : Matrix m n) (a : C), + first_row_e_i (pad1 A a). +Proof. intros. + unfold first_row_e_i, pad1, col_wedge, row_wedge, e_i, scale; intros. + bdestruct_all; lca. Qed. -Lemma diag_kron : forall {n m : nat} (A : Square n) (B : Square m), - WF_Diagonal A -> WF_Diagonal B -> WF_Diagonal (A ⊗ B). -Proof. - intros n m A B [H H0] [H1 H2]. - destruct m. - rewrite (WF0_Zero_l 0); try easy. - auto with wf_db. - split; auto with wf_db. - unfold kron. - intros. - bdestruct (i / (S m) =? j / (S m)). - - bdestruct (i mod (S m) =? j mod (S m)). - + apply (div_mod_eq i j (S m)) in H5; try easy. - + rewrite H2; try lca; easy. - - rewrite H0; try lca; easy. +Lemma frc_and_fre_pad1 : forall {m n} (A : Matrix m n) (a : C), + first_col_e_i (pad1 A a) /\ first_row_e_i (pad1 A a). +Proof. intros. + split. + apply fce_pad1. + apply fre_pad1. Qed. -Lemma diag_transpose : forall {n : nat} (A : Square n), - WF_Diagonal A -> WF_Diagonal A⊤. -Proof. intros n A [H H0]. - split; auto with wf_db. +Lemma fce_mult : forall {m n o} (A : Matrix m n) (B : Matrix n o), + first_col_e_i A -> first_col_e_i B -> + first_col_e_i (A × B). +Proof. intros. + unfold first_col_e_i, Mmult; intros. + rewrite big_sum_0_bounded; auto. intros. - unfold transpose. - apply H0. auto. + destruct x. + rewrite H; auto. + lca. + rewrite H0. + lca. + lia. Qed. -Lemma diag_adjoint : forall {n : nat} (A : Square n), - WF_Diagonal A -> WF_Diagonal A†. -Proof. intros n A [H H0]. - split; auto with wf_db. - unfold adjoint, Cconj. +Lemma fre_mult : forall {m n o} (A : Matrix m n) (B : Matrix n o), + first_row_e_i A -> first_row_e_i B -> + first_row_e_i (A × B). +Proof. intros. + unfold first_row_e_i, Mmult; intros. + rewrite big_sum_0_bounded; auto. intros. - rewrite H0. lca. auto. + destruct x. + rewrite H0; auto. + lca. + rewrite H. + lca. + lia. +Qed. + +Lemma fce_and_fre_mult : forall {m n o} (A : Matrix m n) (B : Matrix n o), + (first_col_e_i A /\ first_row_e_i A) -> + (first_col_e_i B /\ first_row_e_i B) -> + (first_col_e_i (A × B) /\ first_row_e_i (A × B)). +Proof. intros. + destruct H; destruct H0. + split. + apply fce_mult; auto. + apply fre_mult; auto. Qed. -Lemma diag_kron_n : forall (n : nat) {m : nat} (A : Square m), - WF_Diagonal A -> WF_Diagonal (kron_n n A). -Proof. - intros. - induction n; simpl. - - apply diag_I. - - rewrite Nat.mul_comm. - apply (@diag_kron (m^n) m _ A). - apply IHn. apply H. +Lemma fce_get_minor_reduction : forall {m n o} (A : Matrix (S m) (S n)) (B : Matrix (S n) (S o)), + first_col_e_i A -> + get_minor (A × B) 0 0 = (get_minor A 0 0) × (get_minor B 0 0). +Proof. intros. + prep_matrix_equality. + unfold get_minor, Mmult. + bdestruct_all. + rewrite <- big_sum_extend_l. + rewrite H; try lia. + Csimpl. + apply big_sum_eq_bounded. + intros. + bdestruct_all. + easy. Qed. -Lemma diag_big_kron : forall n (l : list (Square n)), - (forall A, In A l -> WF_Diagonal A) -> - WF_Diagonal (⨂ l). -Proof. - intros. - induction l. - - simpl. apply diag_I. - - simpl. apply (@diag_kron _ (n^(length l)) a (⨂ l)). - apply H. - left. easy. - apply IHl. - intros A H'. apply H. - simpl. auto. -Qed. - -Lemma diag_Mmult_n : forall n {m} (A : Square m), - WF_Diagonal A -> WF_Diagonal (Mmult_n n A). -Proof. - intros. - induction n; simpl. - - apply diag_I. - - apply diag_mult; assumption. +Lemma fre_get_minor_reduction : forall {m n o} (A : Matrix (S m) (S n)) (B : Matrix (S n) (S o)), + first_row_e_i B -> + get_minor (A × B) 0 0 = (get_minor A 0 0) × (get_minor B 0 0). +Proof. intros. + prep_matrix_equality. + unfold get_minor, Mmult. + bdestruct_all. + rewrite <- big_sum_extend_l. + rewrite H; try lia. + Csimpl. + apply big_sum_eq_bounded. + intros. + bdestruct_all. + easy. Qed. -(** defining what it means to be diagonalizable *) -Definition WF_Diagonalizable {n : nat} (A : Square n) : Prop := - WF_Matrix A /\ (exists (X X' B: Square n), - WF_Diagonal B /\ WF_Matrix X /\ WF_Matrix X' /\ X × X' = I n /\ B = X × A × X'). +Lemma first_col_e_i_ver_weak : forall {m n} (A : Matrix m n) (c : C), + WF_Matrix A -> get_col A 0 = c .* e_i 0 -> first_col_e_i A. +Proof. intros. + unfold first_col_e_i; intros. + rewrite <- (get_col_conv i 0). + rewrite H0. + unfold scale, e_i. + bdestruct_all; lca. +Qed. -Lemma diag_imps_diagble : forall {n} (A : Square n), - WF_Diagonal A -> WF_Diagonalizable A. -Proof. intros n A [H H0]. unfold WF_Diagonalizable. - split; auto. - exists (I n), (I n), A. - split. - split; auto. - split; auto with wf_db. - split; auto with wf_db. - rewrite Mmult_1_l; auto with wf_db. - rewrite Mmult_1_l; auto with wf_db. - rewrite Mmult_1_r; auto with wf_db. +Lemma first_col_e_i_ver : forall {m n} (A : Matrix m n), + WF_Matrix A -> (first_col_e_i A <-> get_col A 0 = A 0 0 .* e_i 0). +Proof. intros. + split; intros. + - apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv. + intros. + unfold get_col, e_i, scale. + bdestruct_all; subst; try lca. + simpl. + rewrite H0; try lia. + lca. + - eapply first_col_e_i_ver_weak; try apply H0; easy. Qed. -Lemma diagble_Zero : forall n : nat, WF_Diagonalizable (@Zero n n). -Proof. intros. apply diag_imps_diagble. - apply diag_Zero. +Lemma first_entry_e_i : forall {m n} (A : Matrix (S m) n) (c : C), + get_col A 0 = c .* e_i 0 -> A 0 0 = c. +Proof. intros. + rewrite <- (get_col_conv 0 0), H. + unfold scale, e_i. + bdestruct_all. + lca. Qed. -Lemma diagble_I : forall n : nat, WF_Diagonalizable (I n). -Proof. intros. apply diag_imps_diagble. - apply diag_I. +Lemma first_entry_e_i' : forall {m n} (A : Matrix (S m) n) (c : C), + get_col A 0 = c .* e_i 0 -> + get_col A 0 = A 0 0 .* e_i 0. +Proof. intros. + rewrite (first_entry_e_i A c); auto. Qed. -Lemma diagble_I1 : WF_Diagonal (I 1). Proof. apply diag_I. Qed. - -Lemma diagble_scale : forall {n : nat} (r : C) (A : Square n), - WF_Diagonalizable A -> WF_Diagonalizable (r .* A). -Proof. - intros n r A [H H0]. - split; auto with wf_db. - do 3 (destruct H0). - destruct H0 as [H1 [H2 [H3 [H4 H5] ] ] ]. - exists x, x0, (r .* x1); split. - apply diag_scale; apply H1. - split; try easy. - split; try easy. - split. - apply H4. - rewrite Mscale_mult_dist_r; - rewrite Mscale_mult_dist_l. - rewrite H5. - reflexivity. +Lemma upper_triangular_reduction : forall {n} (A : Square (S n)), + first_col_e_i A -> upper_triangular (get_minor A 0 0) -> + upper_triangular A. +Proof. intros. + unfold upper_triangular in *; intros. + destruct j. + rewrite H; auto. + destruct i; try lia. + bdestruct (j WF_Matrix B -> WF_Matrix X -> WF_Matrix X' -> - X × X' = I n -> B = X × A × X' -> - A = X' × B × X. +Lemma upper_triangular_reduction_conv : forall {n} (A : Square (S n)), + upper_triangular A -> + first_col_e_i A /\ upper_triangular (get_minor A 0 0). Proof. intros. - rewrite H4. + split. + unfold first_col_e_i; intros. + rewrite H; auto; lia. + unfold upper_triangular, get_minor; intros. + bdestruct_all. + rewrite H; auto; lia. +Qed. + +Lemma diagonal_reduction : forall {m n} (A : Matrix (S m) (S n)), + WF_Matrix A -> + (first_col_e_i A /\ first_row_e_i A) -> WF_Diagonal (get_minor A 0 0) -> + WF_Diagonal A. +Proof. intros. destruct H0. + split; auto. + destruct H1. + intros. + destruct j. + rewrite H0; auto; lia. + destruct i. + rewrite H2; auto; lia. + replace (A (S i) (S j)) with (get_minor A 0 0 i j). + rewrite H3; auto; lia. + unfold get_minor. + bdestruct_all. easy. +Qed. + + +(* this proof works quite nicely on a higher level now that we have build up many matrix tools *) +Lemma Schur_reduction_step : forall {n} (A : Square (S n)), + WF_Matrix A -> + exists X, WF_Unitary X /\ first_col_e_i (X†×A×X). +Proof. intros n A Hwf. + destruct (exists_eigenvector _ A) as [c [v [H [H0 H1] ] ] ]; auto. + assert (H' := H0). + apply onb_out_of_v in H0; auto. + destruct H0 as [T [ [H2 H3] H4] ]. + exists T. + assert (H5 : WF_Unitary T). + apply unit_is_orthonormal; easy. + split; auto. + apply (first_col_e_i_ver_weak _ c); auto with wf_db. + rewrite matrix_by_basis; try lia. + apply (Mmult_cancel_l T); auto with wf_db. + apply unit_det_neq_0. + apply unit_is_orthonormal. + split; auto. repeat rewrite <- Mmult_assoc. - apply Minv_flip in H3; auto. - rewrite H3, Mmult_1_l; auto. - rewrite Mmult_assoc. - rewrite H3, Mmult_1_r; auto. -Qed. - -(**************************************) -(** * Defining Cprod, similar to big_sum *) -(**************************************) - -(* could define this using the multiplicative monoid on C, but this would - lead to confusing notation, so I just left it *) -Fixpoint Cprod (f : nat -> C) (n : nat) : C := - match n with - | 0 => C1 - | S n' => (Cprod f n' * f n')%C - end. + destruct H5. + apply Minv_flip in H5; auto with wf_db. + rewrite H5, Mscale_mult_dist_r, Mmult_1_l; auto. + rewrite Mmult_assoc, <- matrix_by_basis, H4; try lia. + unfold normalize. + rewrite Mscale_mult_dist_r, H1. + lma'. +Qed. +(* this one is also not too bad, once we have the obscure lemmas above *) +Theorem Schur_form : forall {n} (A : Square n), + WF_Matrix A -> + exists U, WF_Unitary U /\ upper_triangular (U†×A×U). +Proof. induction n; intros. + - exists Zero. + split; split; auto with wf_db. + rewrite Mmult_0_r. + prep_matrix_equality. + unfold I; bdestruct_all; easy. + - destruct (Schur_reduction_step A) as [X [H0 H1] ]; auto. + destruct (IHn (get_minor (X†×A×X) 0 0)) as [X' [H2 H3] ]. + destruct H0; auto with wf_db. + exists (X × pad1 X' C1). + split. + apply Mmult_unitary; auto. + apply pad1_unitary; auto. + lca. + rewrite Mmult_adjoint. + rewrite pad1_adjoint, 2 Mmult_assoc, <- (Mmult_assoc _ A), <- (Mmult_assoc _ X). + apply upper_triangular_reduction. + + repeat (apply fce_mult; try easy); apply fce_pad1. + + rewrite 2 fce_get_minor_reduction; auto. + rewrite <- 2 get_minor_pad1. + rewrite <- Mmult_assoc. + easy. + apply fce_pad1. +Qed. -Lemma Cprod_0_bounded : forall (f : nat -> C) (n : nat), - (exists i, i < n /\ f i = C0) -> Cprod f n = C0. +(* we need a few more lemmas, using the above machinery *) +Lemma normal_tri_is_fce : forall {n} (T : Square n), + WF_Matrix T -> + upper_triangular T -> T† × T = T × T† -> + first_col_e_i (T ⊤). Proof. intros. - induction n as [| n']. - - destruct H; lia. - - destruct H as [i [H1 H2] ]. - bdestruct (i C) (n : nat), - (forall i : nat, i < n -> f i = g i) -> Cprod f n = Cprod g n. -Proof. intros. - induction n as [| n']. - - easy. - - simpl. - rewrite IHn', H; try lia; try easy. - intros. apply H; lia. +(* this is the crucial step of Schur for => spectral theorem *) +Lemma normal_tri_is_diag : forall {n} (T : Square n), + WF_Matrix T -> + upper_triangular T -> T† × T = T × T† -> + WF_Diagonal T. +Proof. induction n; intros. + split; auto. + intros. rewrite H; auto. lia. + assert (H' : (get_minor T 0 0) † × (get_minor T 0 0) + = (get_minor T 0 0) × (get_minor T 0 0) †). + { replace ((get_minor T 0 0) †) with (get_minor (T†) 0 0). + rewrite <- 2 fce_get_minor_reduction. + rewrite H1; easy. + apply upper_triangular_reduction_conv; auto. + apply normal_tri_is_fce in H1; auto. + unfold first_col_e_i in *; unfold adjoint; unfold transpose in H1; intros. + rewrite H1; try lca; lia. + prep_matrix_equality. + unfold get_minor, adjoint. + bdestruct_all; easy. } + apply IHn in H'; auto with wf_db. + apply normal_tri_is_fce in H1; auto. + split; auto; intros. + destruct j. + apply upper_triangular_reduction_conv in H0; destruct H0. + rewrite H0; auto; lia. + destruct i. + unfold first_col_e_i, transpose in H1. + apply H1; lia. + destruct H'. + rewrite <- (H4 i j); try lia. + unfold get_minor. + bdestruct_all. + easy. + apply upper_triangular_reduction_conv. + easy. Qed. -Lemma Cprod_extend_r : forall (f : nat -> C) (n : nat), - (Cprod f n * f n)%C = Cprod f (S n). -Proof. easy. Qed. +Corollary Spectral_Theorem : forall {n} (A : Square n), + WF_Matrix A -> + A † × A = A × A† -> + (exists U, WF_Unitary U /\ WF_Diagonal (U†×A×U)). +Proof. intros. + destruct (Schur_form A) as [U [H1 H2] ]; auto. + exists U. + split; auto. + apply normal_tri_is_diag; auto with wf_db. + destruct H1; auto with wf_db. + Msimpl. + repeat rewrite <- Mmult_assoc. + do 2 (apply f_equal_gen; auto). + repeat rewrite Mmult_assoc. + apply f_equal_gen; auto. + rewrite <- 2 (Mmult_assoc U). + destruct H1. + apply Minv_flip in H3; auto with wf_db. + rewrite H3. + do 2 (rewrite Mmult_1_l; auto). + auto with wf_db. +Qed. -Lemma Cprod_extend_l : forall (f : nat -> C) (n : nat), - (f 0 * (Cprod (fun x => f (S x)) n))%C = Cprod f (S n). +Corollary unit_implies_diagble : forall {n} (A : Square n), + WF_Unitary A -> WF_Diagonalizable A. Proof. intros. - induction n. - + simpl; lca. - + simpl. - rewrite Cmult_assoc. - rewrite IHn. - simpl. - reflexivity. + split. + apply H. + destruct (Spectral_Theorem A). + apply H. + destruct H. + rewrite H0. + apply Minv_flip in H0. + rewrite H0; easy. + all : auto with wf_db. + destruct H0. + exists (x†), x, (x† × A × x). + destruct H0. + repeat (try split; auto with wf_db). Qed. -Lemma Cprod_product : forall (f g h : nat -> C) (n : nat), - (forall i, i < n -> h i = (f i * g i)%C) -> ((Cprod f n) * (Cprod g n))%C = Cprod h n. -Proof. induction n. - + intros. lca. - + intros. simpl. - rewrite <- IHn, H; try lca; try lia. - intros. apply H; try lia. +(* TODO: add a def of unitary diagonalizable. add defs of Hermitian and anti Hermitian. Easily, + we get these matrices are unitary diagonalizable. Perhaps these already exist somewhere *) + +Corollary herm_implies_diagble : forall {n} (A : Square n), + WF_Matrix A -> hermitian A -> WF_Diagonalizable A. +Proof. intros. + split. + apply H. + destruct (Spectral_Theorem A). + apply H. + rewrite H0; easy. + exists (x†), x, (x† × A × x). + destruct H1. + destruct H1. + repeat (try split; auto with wf_db). Qed. -(************************************) -(** * Defining upper triangular matrix *) -(************************************) -Definition upper_triangular {n} (A : Square n) : Prop := - forall i j, i > j -> A i j = C0. +(***************) +(* Proving SVD *) +(***************) -Lemma up_tri_Zero : forall n : nat, upper_triangular (@Zero n n). -Proof. intros n. unfold upper_triangular. reflexivity. Qed. -Lemma up_tri_I : forall n : nat, upper_triangular (I n). -Proof. - unfold upper_triangular, I; intros. - bdestruct (i =? j); try lia; easy. +(* TODO: Reorganize if necessary *) +(* NB: the logic of the first few lemmas here seems a bit random, since I ended up using + a different approach, so things are a bit piecemeal *) + +Local Open Scope R_scope. + +(** facts about Σ *) + +Definition WF_Nonnegative {m n} (A : Matrix m n) := + WF_Matrix A /\ forall (i j : nat), (Re (A i j) >= 0 /\ Im (A i j) = 0)%R. + +Definition ordered_diag {m n} (Σ : Matrix m n) := + (forall i j, (i < n)%nat -> (j <= i)%nat -> Cmod (Σ i i) <= Cmod (Σ j j)). + +Definition nonzero_cutoff {m n} (Σ : Matrix m n) (r : nat) := + (r < n)%nat /\ (forall j, (j < r)%nat -> fst (Σ j j) <> 0) /\ (forall j, (r <= j)%nat -> fst (Σ j j) = 0). + +(* +Definition WF_OrderedSigma {m n} (Σ : Matrix m n) := + WF_Diagonal Σ /\ WF_Nonnegative Σ /\ + (forall i j, (i < j)%nat -> fst (Σ i i) <= fst (Σ j j)). +*) + +Corollary perm_mat_preserves_diag : forall {n} (D : Square n) f, + WF_Diagonal D -> + permutation n f -> + WF_Diagonal ((perm_mat n f)† × D × ((perm_mat n f))). +Proof. intros. + assert (H' : WF_Matrix (adjoint (perm_mat n f) × D × perm_mat n f)). + destruct H; auto with wf_db. + split; auto. + intros. + bdestruct (i + exists U, WF_Unitary U /\ WF_Diagonal (U† × S × U) /\ ordered_diag (U† × S × U). +Proof. intros. + destruct (order_real_function n (fun i => Cmod (S i i))) as [l [H0 H1] ]. + exists ((perm_mat n (stack_fswaps Datatypes.id l))). + split. + apply perm_mat_unitary. + apply stack_fswaps_permutation; auto; apply id_permutation. + split. + apply perm_mat_preserves_diag; auto. + apply stack_fswaps_permutation; auto; apply id_permutation. + unfold ordered_diag; intros. + destruct H. + rewrite 2 perm_mat_conjugate; auto; try lia. + apply H1; try lia. + all : apply stack_fswaps_permutation; auto; apply id_permutation. +Qed. + +Lemma pos_semi_def_diag_implies_nonneg : forall {n} (A : Square n), + WF_Diagonal A -> + hermitian A -> + positive_semidefinite A -> + WF_Nonnegative A. +Proof. intros. + destruct H. + split; auto; intros. + bdestruct (i =? j)%nat; subst. + split. + bdestruct (j + A† × A = Zero -> A = Zero. +Proof. intros. + apply det_by_get_col. + intros. + bdestruct (i WF_Unitary U -> + hermitian X -> + positive_semidefinite X -> + WF_Diagonal (U† × X × U) -> + ordered_diag (U† × X × U) -> + fst ((U† × X × U) O O) = 0 -> + X = Zero. +Proof. intros. + assert (H' : U†×X×U = Zero). + { apply mat_equiv_eq; auto with wf_db. + destruct H0; auto with wf_db. + unfold mat_equiv; intros. + bdestruct (i =? j); subst. + assert (H'' : (U† × X × U) O O = C0). + apply c_proj_eq. + rewrite H5; easy. + apply pos_semi_def_diag_implies_nonneg in H3. + destruct H3. + destruct (H8 O O). + unfold Im in H10; easy. + rewrite <- (adjoint_involutive _ _ U). + replace (U†††) with (U†) by (rewrite adjoint_involutive; easy). + apply unit_conj_hermitian; auto; auto with unit_db. + apply positive_semidefinite_unitary_conj; auto. + unfold Zero; simpl. + apply Cmod_eq_0. + unfold ordered_diag in H4. + apply Rle_antisym. + replace 0 with (Cmod (((U) † × X × U) O O)). + apply H4; auto; lia. + rewrite H'', Cmod_0; easy. + apply Cmod_ge_0. + destruct H3. + rewrite H9; easy. } + symmetry in H'. + apply diagble_switch in H'. + rewrite H', Mmult_0_r, Mmult_0_l; easy. + all : destruct H0; auto with wf_db. +Qed. -Lemma up_tri_scale : forall {n : nat} (r : C) (A : Square n), - upper_triangular A -> upper_triangular (r .* A). -Proof. - unfold upper_triangular, scale. - intros. - rewrite H; try lca; easy. +Lemma AAadjoint_decomposition : forall {m n} (A : Matrix (S m) (S n)), + WF_Matrix A -> A <> Zero -> + exists (V : Square (S n)), + WF_Unitary V /\ WF_Diagonal ((V† × A†) × (A × V)) + /\ fst (((V† × A†) × (A × V)) O O) <> 0%R. +Proof. intros. + destruct (Spectral_Theorem (A† × A)) as [U [H1 H2] ]; auto with wf_db. + distribute_adjoint. + rewrite adjoint_involutive. + lma. + destruct (unitary_orders_diagonal (U†×(A†×A)×U)) as [U' [H3 [H4 H5] ] ]; auto. + exists (U × U'). + split; auto with unit_db. + split. + rewrite Mmult_adjoint. + repeat rewrite <- Mmult_assoc in *. + apply H4. + rewrite <- (Mmult_assoc _ A). + contradict H0. + apply AAadjoint_zero_implies_A_zero; auto. + apply (first_entry_nonzero_if_nonzero_spd _ (U × U')); auto with unit_db; auto with wf_db. + apply AadjointA_hermitian; auto. + apply positive_semidefinite_AadjointA; auto. + all : try rewrite Mmult_adjoint in *; repeat rewrite Mmult_assoc in *; try easy. +Qed. + +Lemma SVD_reduction_step : forall {m n} (A : Matrix (S m) (S n)), + WF_Matrix A -> + exists U V, WF_Unitary U /\ WF_Unitary V /\ + first_col_e_i (U† × A × V) /\ first_row_e_i (U† × A × V). +Proof. intros. + destruct (mat_equiv_dec Zero A). + - exists (I (S m)), (I (S n)). + split; auto with unit_db. + split; auto with unit_db. + replace A with (@Zero (S m) (S n)). + rewrite Mmult_0_r, Mmult_0_l. + unfold first_col_e_i, first_row_e_i; split; intros; easy. + apply mat_equiv_eq; auto with wf_db. + - destruct (AAadjoint_decomposition A) as [V [H1 [H2 H3] ] ]; auto. + contradict n0. + rewrite n0; easy. + assert (H' : get_col (A × V) O <> Zero). + { apply fst_inner_product_nonzero_iff_nonzero. + destruct H1; auto with wf_db. + rewrite inner_product_is_mult. + rewrite Mmult_adjoint. + easy. } + destruct (unit_out_of_v (get_col (A × V) O)) as [U [H4 H5] ]. + destruct H1; auto with wf_db. + easy. + exists U, V. + split; auto; split; auto. + assert (H0' : WF_Matrix ((U) † × A × V)). + destruct H1; destruct H4; auto with wf_db. + split. + assert (H1' : norm (get_col (A × V) 0) .* get_col U 0 = get_col (A × V) 0). + { rewrite H5. + unfold normalize. + rewrite Mscale_assoc, Cinv_r, Mscale_1_l; auto. + contradict H'. + apply RtoC_inj in H'. + apply norm_zero_iff_zero; auto. + destruct H1; auto with wf_db. } + + unfold first_col_e_i; intros. + bdestruct (i + exists (U : Square m) (V : Square n), + WF_Unitary U /\ WF_Unitary V /\ WF_Diagonal (U†×A×V). +Proof. induction m; intros. + - exists (I 0), (I n); + repeat (split; auto with unit_db). + auto with wf_db. + intros. + replace A with (@Zero 0 n). + rewrite Mmult_0_r, Mmult_0_l; easy. + prep_matrix_equality. + rewrite H; auto. + left; lia. + - destruct n. + exists (I (S m)), (I 0); + repeat (split; auto with unit_db). + destruct (SVD_reduction_step A) as [U [V [H0 [H1 H2] ] ] ]; auto. + destruct (IHm n (get_minor (U†×A×V) 0 0)) as [U' [V' [H3 [H4 H5 ] ] ] ]. + destruct H0; destruct H1; auto with wf_db. + exists (U × pad1 U' C1). + exists (V × pad1 V' C1). + assert (H' : WF_Unitary (U × pad1 U' C1)). + { apply Mmult_unitary; auto. + apply pad1_unitary; auto. + lca. } + assert (H0' : WF_Unitary (V × pad1 V' C1)). + { apply Mmult_unitary; auto. + apply pad1_unitary; auto. + lca. } + split; auto; split; auto. + destruct H'; destruct H0'. + apply diagonal_reduction; auto with wf_db. + rewrite Mmult_adjoint, pad1_adjoint, 2 Mmult_assoc, + <- (Mmult_assoc _ A), <- (Mmult_assoc _ V). + repeat (apply fce_and_fre_mult; try apply frc_and_fre_pad1; try easy). + rewrite Mmult_adjoint, pad1_adjoint, 2 Mmult_assoc, fce_get_minor_reduction; auto. + rewrite <- 2 Mmult_assoc, fre_get_minor_reduction; auto. + rewrite <- 2 get_minor_pad1. + rewrite <- Mmult_assoc; easy. + apply fre_pad1. + apply fce_pad1. +Qed. + +Definition normalize_diagonal {m n} (A : Matrix m n) : Square n := + fun i j => if (i =? j) && (i C1 + | right _ => ((Cmod (A i j)) / (A i j))%C + end else C0. + +Lemma normalize_diagonal_unit : forall {m n} (A : Matrix m n), + WF_Unitary (normalize_diagonal A). +Proof. intros. + apply unit_is_orthonormal. + split. + unfold WF_Matrix, normalize_diagonal; intros. + bdestruct_all; simpl; easy. + split. + unfold orthogonal, normalize_diagonal; intros. + unfold inner_product, Mmult, adjoint, get_col. + rewrite big_sum_0_bounded; auto. + intros; simpl. + bdestruct_all; simpl; lca. + intros. + unfold norm, get_col, inner_product, adjoint, Mmult; simpl. + rewrite (big_sum_unique C1). + simpl. + apply sqrt_1. + exists i; split; auto. + split. + unfold normalize_diagonal. + bdestruct_all; simpl. + destruct (Ceq_dec (A i i) 0); try lca. + unfold Cdiv. + rewrite Cconj_mult_distr. + rewrite <- Cinv_Cconj. + replace ((Cmod (A i i)) ^*)%C with (RtoC (Cmod (A i i))). + replace (Cmod (A i i) * / (A i i) ^* * (Cmod (A i i) * / A i i))%C + with ((Cmod (A i i) * Cmod (A i i)) * ((/ (A i i)^* * / (A i i))))%C by lca. + Search (/ _ * / _)%C. + rewrite <- Cinv_mult_distr, <- Cmod_sqr; simpl. + rewrite Cmult_1_r, Cinv_r; auto. + apply Cmult_neq_0. + all : try (contradict n0; apply Cmod_eq_0; apply RtoC_inj in n0; auto). + apply Cconj_neq_0; auto. + auto. + unfold Cconj, Cmod. + apply c_proj_eq; simpl; lra. + intros. + unfold normalize_diagonal. + bdestruct_all; simpl. + lca. +Qed. + +Lemma normalize_diagonal_diagonal : forall {m n} (A : Matrix m n), + WF_Diagonal (normalize_diagonal A). +Proof. intros. + split. + apply normalize_diagonal_unit. + intros. + unfold normalize_diagonal. + bdestruct_all; simpl; easy. Qed. -Lemma up_tri_plus : forall {n} (A B : Square n), - upper_triangular A -> upper_triangular B -> upper_triangular (A .+ B). -Proof. - unfold upper_triangular, Mplus. - intros n A B H H0 i j H1. - rewrite H, H0; try lca; easy. +Lemma normalize_diagonal_diag_entry : forall {m n} (A : Matrix m n) (i : nat), + (i < n)%nat -> + (A × (normalize_diagonal A)) i i = Cmod (A i i). +Proof. intros. + unfold Mmult. + rewrite (big_sum_unique (RtoC (Cmod (A i i)))). + easy. + exists i. + split; auto. + split. + unfold normalize_diagonal. + bdestruct_all; simpl. + destruct (Ceq_dec (A i i) 0). + rewrite e, Cmod_0; simpl; lca. + replace (A i i * (Cmod (A i i) / A i i))%C with + ((A i i) * / (A i i) * (Cmod (A i i)))%C by lca. + rewrite Cinv_r; try lca; auto. + intros. + unfold normalize_diagonal. + bdestruct_all; simpl. + lca. +Qed. + +Lemma normalize_diagonal_ver : forall {m n} (A : Matrix m n), + WF_Diagonal A -> + WF_Nonnegative (A × (normalize_diagonal A)). +Proof. intros. + assert (H' : WF_Diagonal (A × (normalize_diagonal A))). + { apply diag_mult; auto. + apply normalize_diagonal_diagonal. } + split. + destruct H; destruct H'; auto with wf_db. + intros. + bdestruct (i =? j); subst. + bdestruct (j upper_triangular B -> upper_triangular (A × B). -Proof. - unfold upper_triangular, Mmult. - intros n A B H H0 i j D. - apply (@big_sum_0 C C_is_monoid). - intros x. - bdestruct (x + exists (U : Square m) (L : Matrix m n) (V : Square n), + WF_Unitary U /\ WF_Unitary V /\ + WF_Diagonal L /\ WF_Nonnegative L /\ + A = U × L × V†. +Proof. intros. + destruct (SVD_weak A) as [U [V [H0 [H1 H2] ] ] ]; auto. + destruct (normalize_diagonal_ver ((U) † × A × V)); auto. + exists U, ((U) † × A × V × normalize_diagonal ((U) † × A × V)), + (V × (normalize_diagonal (U† × A × V)) ). + split; auto; split. + apply Mmult_unitary; try apply adjoint_unitary; auto. + apply normalize_diagonal_unit. + split. + apply diag_mult; auto. + apply normalize_diagonal_diagonal. + split. + apply normalize_diagonal_ver; auto. + distribute_adjoint. + rewrite <- 4 Mmult_assoc. + destruct H0. + apply Minv_flip in H5; auto with wf_db. + rewrite H5, Mmult_1_l; auto with wf_db. + rewrite (Mmult_assoc (A × V)). + destruct (normalize_diagonal_unit (U† × A × V)). + apply Minv_flip in H7; auto with wf_db. + rewrite H7, Mmult_1_r; auto with wf_db. + destruct H1. + apply Minv_flip in H8; auto with wf_db. + rewrite Mmult_assoc, H8, Mmult_1_r; auto. + destruct H1. + auto with wf_db. +Qed. + + +Local Open Scope C_scope. + + +(***************************) +(* Facts about eigenvalues *) +(***************************) + +Local Close Scope nat_scope. + +(* these two are a bit redundant with inner_product_scale_x *) +Lemma eigenvalue_inner_product_distr_r : forall {n} (A : Square n) (v : Vector n) (λ : C), + A × v = λ .* v -> + ⟨ v, A × v ⟩ = λ * ⟨ v, v ⟩. +Proof. intros. + rewrite H. + unfold inner_product. + rewrite Mscale_mult_dist_r. + easy. Qed. -Lemma up_tri_reduce_0 : forall {n : nat} (A : Square (S n)), - upper_triangular A -> upper_triangular (reduce A 0 0). -Proof. - unfold upper_triangular, reduce. - intros. - bdestruct (i + ⟨ A × v, v ⟩ = λ^* * ⟨ v, v ⟩. +Proof. intros. + rewrite H, inner_product_scale_l. + easy. Qed. -Lemma det_up_tri_diags : forall {n : nat} (A : Square n), - upper_triangular A -> - Determinant A = Cprod (fun i => A i i) n. -Proof. induction n as [| n']. - - easy. - - intros. simpl. - destruct n' as [| n'']. - + lca. - + assert (H' : (Cprod (fun i : nat => A i i) (S n'') * A (S n'') (S n'') = - A 0 0 * Cprod (fun i : nat => (reduce A 0 0) i i) (S n''))%C). - { rewrite <- Cprod_extend_l. - rewrite <- Cprod_extend_r. - rewrite <- Cmult_assoc; easy. } - rewrite H'. - rewrite <- big_sum_extend_l. - rewrite <- Cplus_0_r. - rewrite <- Cplus_assoc. - apply Cplus_simplify. - simpl parity. - rewrite IHn'; try lca. - apply up_tri_reduce_0; easy. - unfold upper_triangular in H. - rewrite H; try lia. - rewrite <- Cplus_0_r. - apply Cplus_simplify; try lca. - apply (@big_sum_0_bounded C C_is_monoid). - intros. - rewrite H; try lia; lca. +Lemma inner_product_adjoint_switch : forall {n} (A : Square n) (u v : Vector n), + ⟨ u, A × v ⟩ = ⟨ A† × u, v ⟩. +Proof. intros. + unfold inner_product. + rewrite Mmult_adjoint, Mmult_assoc, adjoint_involutive. + easy. Qed. +Lemma hermitiam_real_eigenvalues : forall {n} (A : Square n) (v : Vector n) (λ : C), + WF_Matrix A -> + hermitian A -> WF_Matrix v -> + v <> Zero -> + A × v = λ .* v -> + snd λ = 0%R. +Proof. intros. + apply Cconj_eq_implies_real. + apply (Cmult_cancel_r (inner_product v v)). + contradict H2. + apply inner_product_zero_iff_zero; auto. + rewrite <- inner_product_scale_l, <- inner_product_scale_r, <- H3, + inner_product_adjoint_switch. + rewrite H0; easy. +Qed. -(**************************************************) +Lemma unitary_eigenvalues_norm_1 : forall {n} (U : Square n) (v : Vector n) (λ : C), + WF_Unitary U -> WF_Matrix v -> + v <> Zero -> + U × v = λ .* v -> + λ * λ^* = C1. +Proof. intros. + apply (Cmult_cancel_r (inner_product v v)); + try (contradict H1; apply inner_product_zero_iff_zero; easy). + rewrite <- Cmult_assoc. + rewrite <- inner_product_scale_l, <- (inner_product_scale_r _ _ λ), <- H2. + rewrite inner_product_adjoint_r, <- Mmult_assoc. + destruct H. + rewrite H3. + rewrite Mmult_1_l; auto. + lca. +Qed. + + + + (**************************************************) (** * Defining eignestates to be used in type system *) (**************************************************) +Local Open Scope nat_scope. Definition Eigenpair {n : nat} (U : Square n) (p : Vector n * C) : Prop := U × (fst p) = (snd p) .* (fst p). @@ -1513,7 +2487,6 @@ Proof. intros. reflexivity. Qed. - Lemma eigen_scale_div : forall {n} (A : Square n) (v : Vector n) (c1 c2 : C), c2 <> C0 -> Eigenpair (c2 .* A) (v, Cmult c2 c1) -> Eigenpair A (v, c1). Proof. intros. @@ -1524,8 +2497,6 @@ Proof. intros. assumption. Qed. - - Lemma eig_unit_invertible : forall {n} (v : Vector n) (c : C) (X X' B : Square n), WF_Matrix v -> WF_Matrix X -> WF_Matrix X' -> X' × X = I n -> Eigenpair B (X × v, c) -> Eigenpair (X' × B × X) (v, c). @@ -1553,310 +2524,19 @@ Proof. intros. rewrite Mmult_1_l; easy. Qed. +(* potentially redundant with the above *) Lemma eig_unit_norm1 : forall {n} (U : Square n) (c : C), WF_Unitary U -> (exists v, WF_Matrix v /\ v <> Zero /\ Eigenpair U (v, c)) -> (c * c^* = C1)%C. Proof. intros. destruct H0 as [v [H0 [H1 H2] ] ]. - unfold Eigenpair in H2; simpl in H2. - assert (H3 : (U × v)† = (c .* v)†). rewrite H2; easy. - rewrite Mmult_adjoint, Mscale_adj in H3. - assert (H4 : ((v) † × (U) †) × (U × v) = (c ^* .* (v) †) × (c .* v)). - { rewrite H2, H3; easy. } - rewrite Mmult_assoc in H4. - rewrite <- (Mmult_assoc _ U v) in H4. - destruct H as [H5 H]. - rewrite H in H4. - rewrite Mmult_1_l in H4; auto. - rewrite Mscale_mult_dist_r in H4. - rewrite Mscale_mult_dist_l in H4. - rewrite Mscale_assoc in H4. - assert (H' : ((v) † × v) O O = (c * c ^* .* ((v) † × v)) O O). - rewrite <- H4; easy. - assert (H'' : ((v) † × v) O O = inner_product v v). easy. - unfold scale in H'. - rewrite H'' in H'. - apply (Cmult_simplify (inner_product v v) (c * c ^* * inner_product v v) - (/ (inner_product v v)) (/ (inner_product v v))) in H'; try easy. - rewrite <- Cmult_assoc in H'. - rewrite Cinv_r in H'. - - rewrite H'; lca. - unfold not; intros; apply H1. - apply inner_product_zero_iff_zero in H0. - apply H0; easy. -Qed. - - -(** Next, we show that unitary matrices are diagonalizable *) - -(* our approach is to show that there exists X such that XUX^-1 = pad1 c u where u is one - fewer dimension than U. Then, by induction, we can show that U is diagonalizable. The - reduction takes three steps, and then we induct to prove the result. *) - -Lemma unit_has_eigen : forall {n} (A : Square (S n)), - WF_Unitary A -> - exists (c : C) (v : Vector (S n)), Eigenpair A (v, c) /\ v <> Zero /\ WF_Matrix v. -Proof. intros n A [Hwf Hu]. - apply exists_eigenvector in Hwf. - destruct Hwf as [c [v [H [H0 H1] ] ] ]. - exists c. exists v. - split. unfold Eigenpair. - simpl; easy. - auto. + eapply unitary_eigenvalues_norm_1. + apply H. + apply H0. + easy. + easy. Qed. -Lemma unitary_reduction_step1 : forall {n} (A : Square (S n)), - WF_Unitary A -> - exists X, WF_Unitary X /\ - (exists c : C, get_vec 0 (X†×A×X) = c .* e_i 0). -Proof. intros n A [Hwf Hu]. - apply exists_eigenvector in Hwf. - destruct Hwf as [c [v [H [H0 H1] ] ] ]. - assert (H' := H0). - apply onb_out_of_v in H0; auto. - destruct H0 as [T [H2 H3] ]. - exists T. split. - apply unit_is_orthonormal; easy. - exists c. - rewrite matrix_by_basis; try lia. - do 2 rewrite Mmult_assoc. - rewrite <- matrix_by_basis, H3; try lia. - unfold normalize. - rewrite Mscale_mult_dist_r. - rewrite H1. - distribute_scale. - assert (H'' : forall p1 p2 : C, p1 = p2 -> fst p1 = fst p2). - intros. rewrite H0; easy. - assert (H4 : v = (norm v) .* normalize v). - { unfold normalize; distribute_scale. - rewrite Cinv_r; try lma. - apply norm_zero_iff_zero in H. - unfold not; intros. - apply H'. - apply H. - unfold RtoC in H0. - apply H'' in H0. - simpl in H0. - easy. } - rewrite H4, <- H3. - apply unit_is_orthonormal in H2. - destruct H2 as [Hwf HTu]. - rewrite matrix_by_basis; try lia. - distribute_scale. - rewrite <- Mmult_assoc, HTu. - rewrite <- matrix_by_basis, H3, <- H4; try lia. - rewrite Cmult_comm, Cmult_assoc, Cinv_r, Mmult_1_l; auto with wf_db. - lma. unfold not;intros. - apply H'. - apply norm_zero_iff_zero in H. - unfold RtoC in H0. - apply H'' in H0; simpl in H0. - apply H; easy. -Qed. Local Open Scope nat_scope. -(* this proof is horribly long and I feel like theres probably a better way to show this *) -(* TODO : make this better *) -Lemma unitary_reduction_step2 : forall {n} (A : Square (S n)), - WF_Unitary A -> - (exists c : C, get_vec 0 A = c .* e_i 0) -> - (forall (i j : nat), (i = 0 \/ j = 0) /\ i <> j -> A i j = C0). -Proof. intros n A H [c H0] i j H1. - assert (Hc : A 0 0 = c). - { replace (A 0 0) with ((get_vec 0 A) 0 0) by easy. - rewrite H0; lca. } - assert (H2 : (c * c^*)%C = C1). - { apply (eig_unit_norm1 A); try easy. - exists (e_i 0). - split. - apply WF_e_i. - split. unfold not; intros. - apply C1_neq_C0. - replace C1 with (@e_i (S n) 0 0 0) by easy. - rewrite H2; easy. - unfold Eigenpair; simpl. - rewrite <- matrix_by_basis; try easy; lia. } - destruct H1 as [ [H1 | H1] H3]. - - apply transpose_unitary in H. - apply unit_is_orthonormal in H. - destruct H as [Hwf [Ho Hn] ]. - assert (H4 : norm (get_vec 0 A†) = 1%R). - { apply Hn; lia. } - unfold norm in H4. - apply eq_sym in H4. - apply sqrt_1_unique in H4. - replace 1%R with (fst C1) in H4 by easy. - apply (c_proj_eq (((get_vec 0 A†) † × get_vec 0 A†) 0 0) C1) in H4. - unfold Mmult in H4. - rewrite <- big_sum_extend_l in H4. - assert (H' : ((get_vec 0 (A) †) † 0 0 * get_vec 0 (A) † 0 0)%C = C1). - { unfold get_vec, adjoint. - simpl. rewrite Hc. - rewrite Cconj_involutive; easy. } - rewrite H' in H4. - assert (H'' : forall c : C, (C1 + c = C1 -> -C1 + (C1 + c) = -C1 + C1)%C). - { intros. rewrite H; easy. } - apply H'' in H4. - rewrite Cplus_assoc in H4. - replace (-C1 + C1)%C with C0 in H4 by lca. - rewrite Cplus_0_l in H4. - rewrite H1 in *. - destruct j; try lia. - assert (H5 := big_sum_squeeze (fun x : nat => ((get_vec 0 (A) †) † 0 (S x) * - get_vec 0 (A) † (S x) 0)%C) n). - assert (H5' : forall x : nat, - x < n -> - fst ((fun x0 : nat => ((get_vec 0 (A) †) † 0 (S x0) * get_vec 0 (A) † (S x0) 0)%C) x) = - fst C0). - { apply H5. intros. - unfold adjoint, get_vec, Copp. - simpl. - rewrite Ropp_involutive. - unfold Rminus. - replace (- (snd (A 0%nat (S x)) * - snd (A 0%nat (S x))))%R with - ((snd (A 0%nat (S x)))^2)%R by lra. - replace (fst (A 0%nat (S x)) * fst (A 0%nat (S x)))%R with - ((fst (A 0%nat (S x)))^2)%R by lra. - apply Rplus_le_le_0_compat. - all : try apply pow2_ge_0. - rewrite H4; easy. } - simpl in H5'. - assert (H6 := (H5' j)). - bdestruct (j - (forall (i j : nat), (i = 0 \/ j = 0) /\ i <> j -> A i j = C0) -> - exists (A' : Square n), WF_Unitary A' /\ pad1 A' (A 0 0) = A. -Proof. intros n A [Hwf Hu]. - exists (reduce A 0 0). - assert (H' : WF_Matrix (reduce A 0 0)). - { apply WF_reduce; try lia; easy. } - split. split. - apply H'. - apply mat_equiv_eq; auto with wf_db. - unfold mat_equiv; intros. - assert (H2 : ((A) † × A) (S i) (S j) = (I n) i j). - { rewrite Hu. - unfold I. - bdestruct_all; try easy. } - rewrite <- H2. - unfold Mmult. - rewrite <- big_sum_extend_l. - rewrite H, Cmult_0_r, Cplus_0_l. - apply big_sum_eq_bounded; intros. - unfold adjoint. - unfold reduce. - apply Cmult_simplify. - all : simpl; try easy. - lia. - unfold pad1, reduce, col_wedge, row_wedge, scale, e_i. - prep_matrix_equality. - simpl. - bdestruct_all; simpl. - rewrite H1, H2; lca. - 3 : { destruct x; destruct y; try lia. - do 2 rewrite Sn_minus_1; easy. } - 4 : { destruct x; destruct y; try lia. - do 2 rewrite Sn_minus_1; easy. } - all : try rewrite (H x y); try lca; try lia. -Qed. - -Lemma diagble_pad1 : forall {n} (A : Square n) (c : C), - WF_Diagonalizable A -> WF_Diagonalizable (pad1 A c). -Proof. intros n A c [H [X [X' [B [ [Hwf Hd] [H1 [H2 [H3 H4] ] ] ] ] ] ] ]. - split. apply WF_pad1; auto. - exists (pad1 X C1), (pad1 X' C1), (pad1 B c). - split. split; try (apply WF_pad1; auto). - - intros. - destruct i; destruct j; try lia; - unfold pad1, col_wedge, row_wedge, scale, e_i; - bdestruct_all; try easy; try lca. - do 2 rewrite Sn_minus_1. - apply Hd; lia. - apply Hd; lia. - - split; try (apply WF_pad1; auto). - split; try (apply WF_pad1; auto). - split. - rewrite <- pad1_mult, H3, Cmult_1_r, pad1_I. - easy. - do 2 rewrite <- pad1_mult. - rewrite <- H4, Cmult_1_r, Cmult_1_l. - easy. -Qed. - - -(* Now, we can induct and prove the theorem *) -Theorem unit_implies_diagble : forall {n} (A : Square n), - WF_Unitary A -> WF_Diagonalizable A. -Proof. induction n as [| n']. - - intros A [H H0]. - apply WF0_Zero_l in H. - rewrite H. - apply diagble_Zero. - - intros A H. - assert (H0 := H). - apply unitary_reduction_step1 in H. - destruct H as [X [H1 [c H2] ] ]. - assert (H3 : WF_Unitary ((X) † × A × X)). - { do 2 try apply Mmult_unitary. - apply transpose_unitary. - all : easy. } - assert (H4 : (forall (i j : nat), (i = 0 \/ j = 0) /\ i <> j -> - ((X) † × A × X) i j = C0)). - { apply unitary_reduction_step2; try easy. - exists c. easy. } - apply unitary_reduction_step3 in H3; try easy. - destruct H3 as [A' [H5 H6] ]. - assert (H7 : WF_Diagonalizable ((X) † × A × X)). - apply IHn' in H5. - { rewrite <- H6. - apply diagble_pad1. - easy. } - destruct H7 as [Hwf Hd]. - split. - destruct H0; easy. - destruct Hd as [X0 [X0' [B [H7 [H8 [H9 [H10 H11] ] ] ] ] ] ]. - exists (X0 × (X) †). - exists (X × X0'). - exists B. - destruct H1 as [H1wf H1u]. - split; try easy. - split; auto with wf_db. - split; auto with wf_db. - rewrite Mmult_assoc. - rewrite <- (Mmult_assoc X †). - rewrite H1u. - rewrite Mmult_1_l; try easy. - split; try easy. - rewrite H11. - repeat rewrite Mmult_assoc. - easy. -Qed. (************************************************************************************) @@ -1871,13 +2551,13 @@ Definition eq_eigs {n : nat} (U1 U2 : Square n) : Prop := Lemma eq_eigs_implies_eq_diag : forall {n} (D1 D2 : Square n), WF_Diagonal D1 -> WF_Diagonal D2 -> eq_eigs D1 D2 -> D1 = D2. Proof. intros n D1 D2 [H1wf H1d] [H2wf H2d] H. - assert (H2 : forall x, x < n -> D1 x x = D2 x x). + assert (H2 : forall x, (x < n)%nat -> D1 x x = D2 x x). { intros. assert (H1 := H0). apply (diags_have_basis_eigens n D1 x) in H1. apply H in H1. unfold Eigenpair in H1; simpl in H1. - assert (H' : (D1 x x .* @e_i n x) x 0 = D1 x x). + assert (H' : (D1 x x .* @e_i n x) x O = D1 x x). { unfold scale, e_i. bdestruct_all; lca. } rewrite <- H', <- H1. @@ -1946,7 +2626,7 @@ Proof. intros n D1 D2 [H1wf H1d] [H2wf H2d] H. unfold Eigenpair in *; simpl in *. rewrite H4, H5; easy. } assert (H7 : X1 × D1 × X1' = X1 × D2 × X1'). - { apply det_by_get_vec. + { apply det_by_get_col. intros. bdestruct (i = n -> WF_Matrix A -> - get_vec i A = @Zero n 1). + get_col A i = @Zero n 1). { intros. - unfold get_vec. + unfold get_col. prep_matrix_equality. bdestruct_all; try easy. rewrite H9; try lia; easy. } diff --git a/Matrix.v b/Matrix.v index 7fef483..5ea0453 100644 --- a/Matrix.v +++ b/Matrix.v @@ -42,6 +42,12 @@ Definition Matrix (m n : nat) := nat -> nat -> C. Definition WF_Matrix {m n: nat} (A : Matrix m n) : Prop := forall x y, x >= m \/ y >= n -> A x y = C0. +(* makes a matrix well formed *) +Definition make_WF {m n} (A : Matrix m n) : Matrix m n := + fun i j => if (i 0%R. Definition I (n : nat) : Square n := (fun x y => if (x =? y) && (x (if (x =? i) && (x -> C. @@ -276,7 +289,7 @@ Notation "n ⨂ A" := (kron_n n A) (at level 30, no associativity) : matrix_scop Notation "⨂ A" := (big_kron A) (at level 60): matrix_scope. Notation "n ⨉ A" := (Mmult_n n A) (at level 30, no associativity) : matrix_scope. Notation "⟨ u , v ⟩" := (inner_product u v) (at level 0) : matrix_scope. -#[export] Hint Unfold Zero I trace dot Mplus scale Mmult kron mat_equiv transpose +#[export] Hint Unfold Zero I e_i trace dot Mplus scale Mmult kron mat_equiv transpose adjoint : U_db. Ltac destruct_m_1 := @@ -375,6 +388,14 @@ Lemma WF_Matrix_dim_change : forall (m n m' n' : nat) (A : Matrix m n), @WF_Matrix m' n' A. Proof. intros. subst. easy. Qed. +Lemma WF_make_WF : forall {m n} (A : Matrix m n), WF_Matrix (make_WF A). +Proof. intros. + unfold WF_Matrix, make_WF; intros. + destruct H as [H | H]. + bdestruct (x WF_Matrix (scale r A). Proof. @@ -549,9 +578,9 @@ Ltac show_wf := try lca. (* Create HintDb wf_db. *) -#[export] Hint Resolve WF_Zero WF_I WF_I1 WF_mult WF_plus WF_scale WF_transpose +#[export] Hint Resolve WF_Zero WF_I WF_I1 WF_e_i WF_mult WF_plus WF_scale WF_transpose WF_adjoint WF_outer_product WF_big_kron WF_kron_n WF_kron - WF_Mmult_n WF_Msum : wf_db. + WF_Mmult_n WF_make_WF WF_Msum : wf_db. #[export] Hint Extern 2 (_ = _) => unify_pows_two : wf_db. (* Utility tactics *) @@ -605,6 +634,40 @@ Ltac solve_wf := collate_wf; easy. (** * Basic matrix lemmas *) +Lemma mat_equiv_make_WF : forall {m n} (T : Matrix m n), + T == make_WF T. +Proof. unfold make_WF, mat_equiv; intros. + bdestruct (i T = make_WF T. +Proof. intros. + apply mat_equiv_eq; auto with wf_db. + apply mat_equiv_make_WF. +Qed. + +Lemma Mplus_make_WF : forall {n m} (A B : Matrix m n), + make_WF A .+ make_WF B = make_WF (A .+ B). +Proof. intros. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + unfold make_WF, Mplus. + bdestruct (i A = Zero. Proof. intros n A WFA. @@ -1253,7 +1316,8 @@ Lemma sub_mul_mod : (x - y * z) mod z = x mod z. Proof. intros. bdestruct (z =? 0). subst. simpl. lia. - specialize (le_plus_minus_r' (y * z) x H) as G. + specialize (Nat.sub_add (y * z) x H) as G. + rewrite Nat.add_comm in G. remember (x - (y * z)) as r. rewrite <- G. rewrite <- Nat.add_mod_idemp_l by easy. rewrite Nat.mod_mul by easy. easy. @@ -1601,2204 +1665,6 @@ Qed. -(** * Defining matrix altering/col operations *) - - -Definition get_vec {n m} (i : nat) (S : Matrix n m) : Vector n := - fun x y => (if (y =? 0) then S x i else C0). - -Definition get_row {n m} (i : nat) (S : Matrix n m) : Matrix 1 m := - fun x y => (if (x =? 0) then S i y else C0). - -Definition reduce_row {n m} (A : Matrix (S n) m) (row : nat) : Matrix n m := - fun x y => if x if y if x (if x if (j =? m) then v i 0 else T i j. - -Definition row_append {n m} (T : Matrix n m) (v : Matrix 1 m) : Matrix (S n) m := - fun i j => if (i =? n) then v 0 j else T i j. - -(* more general than col_append *) -Definition smash {n m1 m2} (T1 : Matrix n m1) (T2 : Matrix n m2) : Matrix n (m1 + m2) := - fun i j => if j if j if i if (j =? x) - then S i y - else if (j =? y) - then S i x - else S i j. - -Definition row_swap {n m : nat} (S : Matrix n m) (x y : nat) : Matrix n m := - fun i j => if (i =? x) - then S y j - else if (i =? y) - then S x j - else S i j. - -Definition col_scale {n m : nat} (S : Matrix n m) (col : nat) (a : C) : Matrix n m := - fun i j => if (j =? col) - then (a * S i j)%C - else S i j. - -Definition row_scale {n m : nat} (S : Matrix n m) (row : nat) (a : C) : Matrix n m := - fun i j => if (i =? row) - then (a * S i j)%C - else S i j. - -(* adding one column to another *) -Definition col_add {n m : nat} (S : Matrix n m) (col to_add : nat) (a : C) : Matrix n m := - fun i j => if (j =? col) - then (S i j + a * S i to_add)%C - else S i j. - -(* adding one row to another *) -Definition row_add {n m : nat} (S : Matrix n m) (row to_add : nat) (a : C) : Matrix n m := - fun i j => if (i =? row) - then (S i j + a * S to_add j)%C - else S i j. - -(* generalizing col_add *) -Definition gen_new_vec (n m : nat) (S : Matrix n m) (as' : Vector m) : Vector n := - big_sum (fun i => (as' i 0) .* (get_vec i S)) m. - -Definition gen_new_row (n m : nat) (S : Matrix n m) (as' : Matrix 1 n) : Matrix 1 m := - big_sum (fun i => (as' 0 i) .* (get_row i S)) n. - -(* adds all columns to single column *) -Definition col_add_many {n m} (col : nat) (as' : Vector m) (S : Matrix n m) : Matrix n m := - fun i j => if (j =? col) - then (S i j + (gen_new_vec n m S as') i 0)%C - else S i j. - -Definition row_add_many {n m} (row : nat) (as' : Matrix 1 n) (S : Matrix n m) : Matrix n m := - fun i j => if (i =? row) - then (S i j + (gen_new_row n m S as') 0 j)%C - else S i j. - -(* adds single column to each other column *) -Definition col_add_each {n m} (col : nat) (as' : Matrix 1 m) (S : Matrix n m) : Matrix n m := - S .+ ((get_vec col S) × as'). - -Definition row_add_each {n m} (row : nat) (as' : Vector n) (S : Matrix n m) : Matrix n m := - S .+ (as' × get_row row S). - -Definition make_col_zero {n m} (col : nat) (S : Matrix n m) : Matrix n m := - fun i j => if (j =? col) - then C0 - else S i j. - -Definition make_row_zero {n m} (row : nat) (S : Matrix n m) : Matrix n m := - fun i j => if (i =? row) - then C0 - else S i j. - -Definition make_WF {n m} (S : Matrix n m) : Matrix n m := - fun i j => if (i WF_Matrix (get_vec i S). -Proof. unfold WF_Matrix, get_vec in *. - intros. - bdestruct (y =? 0); try lia; try easy. - apply H. - destruct H0. - left; easy. - lia. -Qed. - -Lemma WF_get_row : forall {n m} (i : nat) (S : Matrix n m), - WF_Matrix S -> WF_Matrix (get_row i S). -Proof. unfold WF_Matrix, get_row in *. - intros. - bdestruct (x =? 0); try lia; try easy. - apply H. - destruct H0. - lia. - right; easy. -Qed. - -Lemma WF_reduce_row : forall {n m} (row : nat) (A : Matrix (S n) m), - row < (S n) -> WF_Matrix A -> WF_Matrix (reduce_row A row). -Proof. unfold WF_Matrix, reduce_row. intros. - bdestruct (x b < c -> 1 + a < c). - { lia. } - apply (nibzo x row (S n)) in H2. - simpl in H2. lia. apply H. - + apply H0; auto. - - apply H0. destruct H1. - + left. simpl. lia. - + right. apply H1. -Qed. - -Lemma WF_reduce_col : forall {n m} (col : nat) (A : Matrix n (S m)), - col < (S m) -> WF_Matrix A -> WF_Matrix (reduce_col A col). -Proof. unfold WF_Matrix, reduce_col. intros. - bdestruct (y b < c -> 1 + a < c). - { lia. } - apply (nibzo y col (S m)) in H2. - simpl in H2. lia. apply H. - - apply H0. destruct H1. - + left. apply H1. - + right. simpl. lia. -Qed. - -Lemma rvn_is_rr_n : forall {n : nat} (v : Vector (S n)), - reduce_vecn v = reduce_row v n. -Proof. intros. - prep_matrix_equality. - unfold reduce_row, reduce_vecn. - easy. -Qed. - -Lemma WF_reduce_vecn : forall {n} (v : Vector (S n)), - n <> 0 -> WF_Matrix v -> WF_Matrix (reduce_vecn v). -Proof. intros. - rewrite rvn_is_rr_n. - apply WF_reduce_row; try lia; try easy. -Qed. - -Lemma reduce_is_redrow_redcol : forall {n} (A : Square (S n)) (row col : nat), - reduce A row col = reduce_col (reduce_row A row) col. -Proof. intros. - prep_matrix_equality. - unfold reduce, reduce_col, reduce_row. - bdestruct (x col < S n -> WF_Matrix A -> WF_Matrix (reduce A row col). -Proof. intros. - rewrite reduce_is_redrow_redcol. - apply WF_reduce_col; try easy. - apply WF_reduce_row; try easy. -Qed. - -Lemma WF_col_swap : forall {n m : nat} (S : Matrix n m) (x y : nat), - x < m -> y < m -> WF_Matrix S -> WF_Matrix (col_swap S x y). -Proof. unfold WF_Matrix, col_swap in *. - intros. - bdestruct (y0 =? x); bdestruct (y0 =? y); destruct H2; try lia. - all : apply H1; try (left; apply H2). - auto. -Qed. - -Lemma WF_row_swap : forall {n m : nat} (S : Matrix n m) (x y : nat), - x < n -> y < n -> WF_Matrix S -> WF_Matrix (row_swap S x y). -Proof. unfold WF_Matrix, row_swap in *. - intros. - bdestruct (x0 =? x); bdestruct (x0 =? y); destruct H2; try lia. - all : apply H1; try (right; apply H2). - auto. -Qed. - -Lemma WF_col_scale : forall {n m : nat} (S : Matrix n m) (x : nat) (a : C), - WF_Matrix S -> WF_Matrix (col_scale S x a). -Proof. unfold WF_Matrix, col_scale in *. - intros. - apply H in H0. - rewrite H0. - rewrite Cmult_0_r. - bdestruct (y =? x); easy. -Qed. - -Lemma WF_row_scale : forall {n m : nat} (S : Matrix n m) (x : nat) (a : C), - WF_Matrix S -> WF_Matrix (row_scale S x a). -Proof. unfold WF_Matrix, row_scale in *. - intros. - apply H in H0. - rewrite H0. - rewrite Cmult_0_r. - bdestruct (x0 =? x); easy. -Qed. - -Lemma WF_col_add : forall {n m : nat} (S : Matrix n m) (x y : nat) (a : C), - x < m -> WF_Matrix S -> WF_Matrix (col_add S x y a). -Proof. unfold WF_Matrix, col_add in *. - intros. - bdestruct (y0 =? x); destruct H1; try lia. - do 2 (rewrite H0; auto). lca. - all : apply H0; auto. -Qed. - -Lemma WF_row_add : forall {n m : nat} (S : Matrix n m) (x y : nat) (a : C), - x < n -> WF_Matrix S -> WF_Matrix (row_add S x y a). -Proof. unfold WF_Matrix, row_add in *. - intros. - bdestruct (x0 =? x); destruct H1; try lia. - do 2 (rewrite H0; auto). lca. - all : apply H0; auto. -Qed. - -Lemma WF_gen_new_vec : forall {n m} (S : Matrix n m) (as' : Vector m), - WF_Matrix S -> WF_Matrix (gen_new_vec n m S as'). -Proof. intros. - unfold gen_new_vec. - apply WF_Msum; intros. - apply WF_scale. - apply WF_get_vec. - easy. -Qed. - -Lemma WF_gen_new_row : forall {n m} (S : Matrix n m) (as' : Matrix 1 n), - WF_Matrix S -> WF_Matrix (gen_new_row n m S as'). -Proof. intros. - unfold gen_new_row. - apply WF_Msum; intros. - apply WF_scale. - apply WF_get_row. - easy. -Qed. - -Lemma WF_col_add_many : forall {n m} (col : nat) (as' : Vector m) (S : Matrix n m), - col < m -> WF_Matrix S -> WF_Matrix (col_add_many col as' S). -Proof. unfold WF_Matrix, col_add_many. - intros. - bdestruct (y =? col). - assert (H4 := (WF_gen_new_vec S as')). - rewrite H4, H0; try easy. - lca. destruct H2; lia. - rewrite H0; easy. -Qed. - -Lemma WF_row_add_many : forall {n m} (row : nat) (as' : Matrix 1 n) (S : Matrix n m), - row < n -> WF_Matrix S -> WF_Matrix (row_add_many row as' S). -Proof. unfold WF_Matrix, row_add_many. - intros. - bdestruct (x =? row). - assert (H4 := (WF_gen_new_row S as')). - rewrite H4, H0; try easy. - lca. destruct H2; lia. - rewrite H0; easy. -Qed. - -Lemma WF_col_append : forall {n m} (T : Matrix n m) (v : Vector n), - WF_Matrix T -> WF_Matrix v -> WF_Matrix (col_append T v). -Proof. unfold WF_Matrix in *. - intros; destruct H1 as [H1 | H1]. - - unfold col_append. - rewrite H, H0; try lia. - bdestruct (y =? m); easy. - - unfold col_append. - bdestruct (y =? m); try lia. - apply H; lia. -Qed. - -Lemma WF_row_append : forall {n m} (T : Matrix n m) (v : Matrix 1 m), - WF_Matrix T -> WF_Matrix v -> WF_Matrix (row_append T v). -Proof. unfold WF_Matrix in *. - intros; destruct H1 as [H1 | H1]. - - unfold row_append. - bdestruct (x =? n); try lia. - apply H; lia. - - unfold row_append. - rewrite H, H0; try lia. - bdestruct (x =? n); easy. -Qed. - -Lemma WF_col_wedge : forall {n m} (T : Matrix n m) (v : Vector n) (spot : nat), - spot <= m -> WF_Matrix T -> WF_Matrix v -> WF_Matrix (col_wedge T v spot). -Proof. unfold WF_Matrix in *. - intros; destruct H2 as [H2 | H2]. - - unfold col_wedge. - rewrite H0, H1; try lia. - rewrite H0; try lia. - bdestruct (y WF_Matrix T -> WF_Matrix v -> WF_Matrix (row_wedge T v spot). -Proof. unfold WF_Matrix in *. - intros; destruct H2 as [H2 | H2]. - - unfold row_wedge. - bdestruct (x WF_Matrix T2 -> WF_Matrix (smash T1 T2). -Proof. unfold WF_Matrix, smash in *. - intros. - bdestruct (y WF_Matrix as' -> WF_Matrix (col_add_each col as' S). -Proof. intros. - unfold col_add_each. - apply WF_plus; try easy; - apply WF_mult; try easy; - apply WF_get_vec; easy. -Qed. - -Lemma WF_row_add_each : forall {n m} (row : nat) (as' : Vector n) (S : Matrix n m), - WF_Matrix S -> WF_Matrix as' -> WF_Matrix (row_add_each row as' S). -Proof. intros. - unfold row_add_each. - apply WF_plus; try easy; - apply WF_mult; try easy; - apply WF_get_row; easy. -Qed. - -Lemma WF_make_col_zero : forall {n m} (col : nat) (S : Matrix n m), - WF_Matrix S -> WF_Matrix (make_col_zero col S). -Proof. unfold make_col_zero, WF_Matrix. - intros. - rewrite H; try easy. - bdestruct (y =? col); easy. -Qed. - -Lemma WF_make_row_zero : forall {n m} (row : nat) (S : Matrix n m), - WF_Matrix S -> WF_Matrix (make_row_zero row S). -Proof. unfold make_row_zero, WF_Matrix. - intros. - rewrite H; try easy. - bdestruct (x =? row); easy. -Qed. - -Lemma WF_make_WF : forall {n m} (S : Matrix n m), WF_Matrix (make_WF S). -Proof. intros. - unfold WF_Matrix, make_WF; intros. - destruct H as [H | H]. - bdestruct (x lia : wf_db. - -Lemma get_vec_reduce_col : forall {n m} (i col : nat) (A : Matrix n (S m)), - i < col -> get_vec i (reduce_col A col) = get_vec i A. -Proof. intros. - prep_matrix_equality. - unfold get_vec, reduce_col. - bdestruct (i A = B. -Proof. intros. prep_matrix_equality. - rewrite <- get_vec_conv. - rewrite <- (get_vec_conv _ _ B). - rewrite H. - reflexivity. -Qed. - -Lemma col_scale_reduce_col_same : forall {n m} (T : Matrix n (S m)) (y col : nat) (a : C), - y = col -> reduce_col (col_scale T col a) y = reduce_col T y. -Proof. intros. - prep_matrix_equality. - unfold reduce_col, col_scale. - bdestruct (y0 col < (S c2) -> - reduce (col_swap T (S c1) (S c2)) row col = col_swap (reduce T row col) c1 c2. -Proof. intros. - prep_matrix_equality. - unfold reduce, col_swap. - bdestruct (c1 reduce (col_scale T col a) x y = col_scale (reduce T x y) (col - 1) a. -Proof. intros. - prep_matrix_equality. - destruct col; try lia. - rewrite Sn_minus_1. - unfold reduce, col_scale. - bdestruct (x0 reduce (col_scale T col a) x y = reduce T x y. -Proof. intros. - prep_matrix_equality. - unfold reduce, col_scale. - bdestruct (x0 col -> reduce (col_scale T col a) x y = col_scale (reduce T x y) col a. -Proof. intros. - prep_matrix_equality. - unfold reduce, col_scale. - bdestruct (x0 z -> y <> z -> col_swap T x z = col_swap (col_swap (col_swap T x y) y z) x y. -Proof. intros. - bdestruct (x =? y). - rewrite H1, col_swap_same, col_swap_same. - easy. - prep_matrix_equality. - unfold col_swap. - bdestruct (y =? y); bdestruct (y =? x); bdestruct (y =? z); try lia. - bdestruct (x =? y); bdestruct (x =? x); bdestruct (x =? z); try lia. - bdestruct (z =? y); bdestruct (z =? x); try lia. - bdestruct (y0 =? y); bdestruct (y0 =? x); bdestruct (y0 =? z); - try lia; try easy. - rewrite H10. - easy. -Qed. - -Lemma reduce_row_reduce_col : forall {n m} (A : Matrix (S n) (S m)) (i j : nat), - reduce_col (reduce_row A i) j = reduce_row (reduce_col A j) i. -Proof. intros. - prep_matrix_equality. - unfold reduce_col, reduce_row. - bdestruct (y - (reduce (reduce A x 0) y 0) = (reduce (reduce A (S y) 0) x 0). -Proof. intros. - prep_matrix_equality. - unfold reduce. - bdestruct (y0 0 -> i <> j -> col_swap (col_add (col_swap A j 0) 0 i c) j 0 = col_add A j i c. -Proof. intros. - bdestruct (j =? 0). - - rewrite H1. - do 2 rewrite col_swap_same; easy. - - prep_matrix_equality. - unfold col_swap, col_add. - bdestruct (y =? j); bdestruct (j =? j); try lia; simpl. - destruct j; try lia. - bdestruct (i =? S j); bdestruct (i =? 0); try lia. - rewrite H2; easy. - bdestruct (y =? 0); bdestruct (j =? 0); try easy. - rewrite H4; easy. -Qed. - -Lemma col_swap_col_add_0 : forall {n} (A : Square n) (j : nat) (c : C), - j <> 0 -> col_swap (col_add (col_swap A j 0) 0 j c) j 0 = col_add A j 0 c. -Proof. intros. - prep_matrix_equality. - unfold col_swap, col_add. - bdestruct (y =? j); bdestruct (j =? j); bdestruct (0 =? j); try lia; simpl. - rewrite H0; easy. - bdestruct (y =? 0); bdestruct (j =? 0); try easy. - rewrite H3; easy. -Qed. - -Lemma col_swap_end_reduce_col_hit : forall {n m : nat} (T : Matrix n (S (S m))) (i : nat), - i <= m -> col_swap (reduce_col T i) m i = reduce_col (col_swap T (S m) (S i)) i. -Proof. intros. - prep_matrix_equality. - unfold reduce_col, col_swap. - bdestruct (i C0 -> S = col_scale (col_scale S x a) x (/ a). -Proof. intros. - prep_matrix_equality. - unfold col_scale. - bdestruct (y =? x); try easy. - rewrite Cmult_assoc. - rewrite Cinv_l; try lca; easy. -Qed. - -Lemma row_scale_inv : forall {n m : nat} (S : Matrix n m) (x : nat) (a : C), - a <> C0 -> S = row_scale (row_scale S x a) x (/ a). -Proof. intros. - prep_matrix_equality. - unfold row_scale. - bdestruct (x0 =? x); try easy. - rewrite Cmult_assoc. - rewrite Cinv_l; try lca; easy. -Qed. - -Lemma col_add_double : forall {n m : nat} (S : Matrix n m) (x : nat) (a : C), - col_add S x x a = col_scale S x (C1 + a). -Proof. intros. - prep_matrix_equality. - unfold col_add, col_scale. - bdestruct (y =? x). - - rewrite H; lca. - - easy. -Qed. - -Lemma row_add_double : forall {n m : nat} (S : Matrix n m) (x : nat) (a : C), - row_add S x x a = row_scale S x (C1 + a). -Proof. intros. - prep_matrix_equality. - unfold row_add, row_scale. - bdestruct (x0 =? x). - - rewrite H; lca. - - easy. -Qed. - -Lemma col_add_swap : forall {n m : nat} (S : Matrix n m) (x y : nat) (a : C), - col_swap (col_add S x y a) x y = col_add (col_swap S x y) y x a. -Proof. intros. - prep_matrix_equality. - unfold col_swap, col_add. - bdestruct (y0 =? x); bdestruct (y =? x); - bdestruct (y0 =? y); bdestruct (x =? x); try lia; easy. -Qed. - -Lemma row_add_swap : forall {n m : nat} (S : Matrix n m) (x y : nat) (a : C), - row_swap (row_add S x y a) x y = row_add (row_swap S x y) y x a. -Proof. intros. - prep_matrix_equality. - unfold row_swap, row_add. - bdestruct_all; easy. -Qed. - -Lemma col_add_inv : forall {n m : nat} (S : Matrix n m) (x y : nat) (a : C), - x <> y -> S = col_add (col_add S x y a) x y (-a). -Proof. intros. - prep_matrix_equality. - unfold col_add. - bdestruct (y0 =? x); bdestruct (y =? x); try lia. - lca. easy. -Qed. - -Lemma row_add_inv : forall {n m : nat} (S : Matrix n m) (x y : nat) (a : C), - x <> y -> S = row_add (row_add S x y a) x y (-a). -Proof. intros. - prep_matrix_equality. - unfold row_add. - bdestruct (x0 =? x); bdestruct (y =? x); try lia. - lca. easy. -Qed. - -Lemma mat_equiv_make_WF : forall {n m} (T : Matrix n m), - T == make_WF T. -Proof. unfold make_WF, mat_equiv; intros. - bdestruct (i T = make_WF T. -Proof. intros. - apply mat_equiv_eq; auto with wf_db. - apply mat_equiv_make_WF. -Qed. - -Lemma col_swap_make_WF : forall {n m} (T : Matrix n m) (x y : nat), - x < m -> y < m -> col_swap (make_WF T) x y = make_WF (col_swap T x y). -Proof. intros. - unfold make_WF, col_swap. - prep_matrix_equality. - bdestruct_all; try easy. -Qed. - -Lemma col_scale_make_WF : forall {n m} (T : Matrix n m) (x : nat) (c : C), - col_scale (make_WF T) x c = make_WF (col_scale T x c). -Proof. intros. - unfold make_WF, col_scale. - prep_matrix_equality. - bdestruct_all; try easy; lca. -Qed. - -Lemma col_add_make_WF : forall {n m} (T : Matrix n m) (x y : nat) (c : C), - x < m -> y < m -> col_add (make_WF T) x y c = make_WF (col_add T x y c). -Proof. intros. - unfold make_WF, col_add. - prep_matrix_equality. - bdestruct_all; try easy; lca. -Qed. - -Lemma Mmult_make_WF : forall {n m o} (A : Matrix n m) (B : Matrix m o), - make_WF A × make_WF B = make_WF (A × B). -Proof. intros. - apply mat_equiv_eq; auto with wf_db. - unfold mat_equiv; intros. - unfold make_WF, Mmult. - bdestruct (i gen_new_vec n m T as' = Zero. -Proof. intros. - unfold mat_equiv, gen_new_vec in *. - prep_matrix_equality. - rewrite Msum_Csum. - unfold Zero in *. - apply (@big_sum_0_bounded C C_is_monoid); intros. - rewrite H; try lia. - rewrite Mscale_0_l. - easy. -Qed. - -Lemma gen_new_row_0 : forall {n m} (T : Matrix n m) (as' : Matrix 1 n), - as' == Zero -> gen_new_row n m T as' = Zero. -Proof. intros. - unfold mat_equiv, gen_new_row in *. - prep_matrix_equality. - rewrite Msum_Csum. - unfold Zero in *. - apply (@big_sum_0_bounded C C_is_monoid); intros. - rewrite H; try lia. - rewrite Mscale_0_l. - easy. -Qed. - -Lemma col_add_many_0 : forall {n m} (col : nat) (T : Matrix n m) (as' : Vector m), - as' == Zero -> T = col_add_many col as' T. -Proof. intros. - unfold col_add_many in *. - prep_matrix_equality. - bdestruct (y =? col); try easy. - rewrite gen_new_vec_0; try easy. - unfold Zero; lca. -Qed. - -Lemma row_add_many_0 : forall {n m} (row : nat) (T : Matrix n m) (as' : Matrix 1 n), - as' == Zero -> T = row_add_many row as' T. -Proof. intros. - unfold row_add_many in *. - prep_matrix_equality. - bdestruct (x =? row); try easy. - rewrite gen_new_row_0; try easy. - unfold Zero; lca. -Qed. - -Lemma gen_new_vec_mat_equiv : forall {n m} (T : Matrix n m) (as' bs : Vector m), - as' == bs -> gen_new_vec n m T as' = gen_new_vec n m T bs. -Proof. unfold mat_equiv, gen_new_vec; intros. - prep_matrix_equality. - do 2 rewrite Msum_Csum. - apply big_sum_eq_bounded; intros. - rewrite H; try lia. - easy. -Qed. - -Lemma gen_new_row_mat_equiv : forall {n m} (T : Matrix n m) (as' bs : Matrix 1 n), - as' == bs -> gen_new_row n m T as' = gen_new_row n m T bs. -Proof. unfold mat_equiv, gen_new_row; intros. - prep_matrix_equality. - do 2 rewrite Msum_Csum. - apply big_sum_eq_bounded; intros. - rewrite H; try lia. - easy. -Qed. - -Lemma col_add_many_mat_equiv : forall {n m} (col : nat) (T : Matrix n m) (as' bs : Vector m), - as' == bs -> col_add_many col as' T = col_add_many col bs T. -Proof. intros. - unfold col_add_many. - rewrite (gen_new_vec_mat_equiv _ as' bs); easy. -Qed. - -Lemma row_add_many_mat_equiv : forall {n m} (row : nat) (T : Matrix n m) (as' bs : Matrix 1 n), - as' == bs -> row_add_many row as' T = row_add_many row bs T. -Proof. intros. - unfold row_add_many. - rewrite (gen_new_row_mat_equiv _ as' bs); easy. -Qed. - -Lemma col_add_each_0 : forall {n m} (col : nat) (T : Matrix n m) (v : Matrix 1 m), - v = Zero -> T = col_add_each col v T. -Proof. intros. - rewrite H. - unfold col_add_each. - rewrite Mmult_0_r. - rewrite Mplus_0_r. - easy. -Qed. - -Lemma row_add_each_0 : forall {n m} (row : nat) (T : Matrix n m) (v : Vector n), - v = Zero -> T = row_add_each row v T. -Proof. intros. - rewrite H. - unfold row_add_each. - rewrite Mmult_0_l. - rewrite Mplus_0_r. - easy. -Qed. - -(* allows for induction on col_add_many *) -Lemma col_add_many_col_add : forall {n m} (col e : nat) (T : Matrix n m) (as' : Vector m), - col <> e -> e < m -> as' col 0 = C0 -> - col_add_many col as' T = - col_add (col_add_many col (make_row_zero e as') T) col e (as' e 0). -Proof. intros. - unfold col_add_many, col_add, gen_new_vec. - prep_matrix_equality. - bdestruct (y =? col); try easy. - bdestruct (e =? col); try lia. - rewrite <- Cplus_assoc. - apply Cplus_simplify; try easy. - assert (H' : m = e + (m - e)). lia. - rewrite H'. - do 2 rewrite Msum_Csum. - rewrite big_sum_sum. - rewrite big_sum_sum. - rewrite <- Cplus_assoc. - apply Cplus_simplify. - apply big_sum_eq_bounded; intros. - unfold make_row_zero. - bdestruct (x0 =? e); try lia; easy. - destruct (m - e); try lia. - do 2 rewrite <- big_sum_extend_l. - unfold make_row_zero. - bdestruct (e + 0 =? e); try lia. - unfold scale. - rewrite Cmult_0_l, Cplus_0_l. - rewrite Cplus_comm. - apply Cplus_simplify. - apply big_sum_eq_bounded; intros. - bdestruct (e + S x0 =? e); try lia; easy. - unfold get_vec. simpl. - rewrite Nat.add_0_r; easy. -Qed. - -(* shows that we can eliminate a column in a matrix using col_add_many *) -Lemma col_add_many_cancel : forall {n m} (T : Matrix n (S m)) (as' : Vector (S m)) (col : nat), - col < (S m) -> as' col 0 = C0 -> - (reduce_col T col) × (reduce_row as' col) = -C1 .* (get_vec col T) -> - (forall i : nat, (col_add_many col as' T) i col = C0). -Proof. intros. - unfold col_add_many, gen_new_vec. - bdestruct (col =? col); try lia. - rewrite Msum_Csum. - assert (H' : (big_sum (fun x : nat => (as' x 0 .* get_vec x T) i 0) (S m) = - (@Mmult n m 1 (reduce_col T col) (reduce_row as' col)) i 0)%C). - { unfold Mmult. - replace (S m) with (col + (S (m - col))) by lia; rewrite big_sum_sum. - rewrite (le_plus_minus' col m); try lia; rewrite big_sum_sum. - apply Cplus_simplify. - apply big_sum_eq_bounded; intros. - unfold get_vec, scale, reduce_col, reduce_row. - bdestruct (x S = col_add_many col (-C1 .* as') (col_add_many col as' S). -Proof. intros. - unfold col_add_many, gen_new_vec. - prep_matrix_equality. - bdestruct (y =? col); try easy. - rewrite <- (Cplus_0_r (S x y)). - rewrite <- Cplus_assoc. - apply Cplus_simplify; try lca. - do 2 rewrite Msum_Csum. - rewrite <- (@big_sum_plus Complex.C _ _ C_is_comm_group). - rewrite (@big_sum_0_bounded C C_is_monoid); try lca. - intros. - unfold get_vec, scale. - bdestruct (0 =? 0); bdestruct (x0 =? col); try lia; try lca. - rewrite Msum_Csum. - bdestruct (0 =? 0); try lia. - rewrite H3, H. lca. -Qed. - -(* like above, allows for induction on col_add_each *) -Lemma col_add_each_col_add : forall {n m} (col e : nat) (S : Matrix n m) (as' : Matrix 1 m), - col <> e -> (forall x, as' x col = C0) -> - col_add_each col as' S = - col_add (col_add_each col (make_col_zero e as') S) e col (as' 0 e). -Proof. intros. - prep_matrix_equality. - unfold col_add_each, col_add, make_col_zero, Mmult, Mplus, get_vec, big_sum. - bdestruct (y =? col); bdestruct (y =? e); bdestruct (col =? e); - bdestruct (e =? e); bdestruct (0 =? 0); try lia; try lca. - rewrite H0. - rewrite H2. lca. -Qed. - -Lemma row_add_each_row_add : forall {n m} (row e : nat) (S : Matrix n m) (as' : Vector n), - row <> e -> (forall y, as' row y = C0) -> - row_add_each row as' S = - row_add (row_add_each row (make_row_zero e as') S) e row (as' e 0). -Proof. intros. - prep_matrix_equality. - unfold row_add_each, row_add, make_row_zero, Mmult, Mplus, get_row, big_sum. - bdestruct (x =? row); bdestruct (x =? e); bdestruct (row =? e); - bdestruct (e =? e); bdestruct (0 =? 0); try lia; try lca. - rewrite H0. - rewrite H2. lca. -Qed. - -(* must use make_col_zero here instead of just as' col 0 = C0, since def requires stronger hyp *) -Lemma col_add_each_inv : forall {n m} (col : nat) (as' : Matrix 1 m) (T : Matrix n m), - T = col_add_each col (make_col_zero col (-C1 .* as')) - (col_add_each col (make_col_zero col as') T). -Proof. intros. - prep_matrix_equality. - unfold col_add_each, make_col_zero, Mmult, Mplus, get_vec, scale. - simpl. bdestruct (y =? col); bdestruct (col =? col); try lia; try lca. -Qed. - -Lemma row_add_each_inv : forall {n m} (row : nat) (as' : Vector n) (T : Matrix n m), - T = row_add_each row (make_row_zero row (-C1 .* as')) - (row_add_each row (make_row_zero row as') T). -Proof. intros. - prep_matrix_equality. - unfold row_add_each, make_row_zero, Mmult, Mplus, get_row, scale. - simpl. bdestruct (x =? row); bdestruct (row =? row); try lia; try lca. -Qed. - - -(* we can show that we get from col_XXX to row_XXX via transposing *) -(* helpful, since we can bootstrap many lemmas on cols for rows *) -Lemma get_vec_transpose : forall {n m} (A : Matrix n m) (i : nat), - (get_vec i A)⊤ = get_row i (A⊤). -Proof. intros. - prep_matrix_equality. - unfold get_vec, get_row, transpose. - easy. -Qed. - -Lemma get_row_transpose : forall {n m} (A : Matrix n m) (i : nat), - (get_row i A)⊤ = get_vec i (A⊤). -Proof. intros. - prep_matrix_equality. - unfold get_vec, get_row, transpose. - easy. -Qed. - -Lemma col_swap_transpose : forall {n m} (A : Matrix n m) (x y : nat), - (col_swap A x y)⊤ = row_swap (A⊤) x y. -Proof. intros. - prep_matrix_equality. - unfold row_swap, col_swap, transpose. - easy. -Qed. - -Lemma row_swap_transpose : forall {n m} (A : Matrix n m) (x y : nat), - (row_swap A x y)⊤ = col_swap (A⊤) x y. -Proof. intros. - prep_matrix_equality. - unfold row_swap, col_swap, transpose. - easy. -Qed. - -Lemma col_scale_transpose : forall {n m} (A : Matrix n m) (x : nat) (a : C), - (col_scale A x a)⊤ = row_scale (A⊤) x a. -Proof. intros. - prep_matrix_equality. - unfold row_scale, col_scale, transpose. - easy. -Qed. - -Lemma row_scale_transpose : forall {n m} (A : Matrix n m) (x : nat) (a : C), - (row_scale A x a)⊤ = col_scale (A⊤) x a. -Proof. intros. - prep_matrix_equality. - unfold row_scale, col_scale, transpose. - easy. -Qed. - -Lemma col_add_transpose : forall {n m} (A : Matrix n m) (col to_add : nat) (a : C), - (col_add A col to_add a)⊤ = row_add (A⊤) col to_add a. -Proof. intros. - prep_matrix_equality. - unfold row_add, col_add, transpose. - easy. -Qed. - -Lemma row_add_transpose : forall {n m} (A : Matrix n m) (row to_add : nat) (a : C), - (row_add A row to_add a)⊤ = col_add (A⊤) row to_add a. -Proof. intros. - prep_matrix_equality. - unfold row_add, col_add, transpose. - easy. -Qed. - -Lemma col_add_many_transpose : forall {n m} (A : Matrix n m) (col : nat) (as' : Vector m), - (col_add_many col as' A)⊤ = row_add_many col (as'⊤) (A⊤). -Proof. intros. - prep_matrix_equality. - unfold row_add_many, col_add_many, transpose. - bdestruct (x =? col); try easy. - apply Cplus_simplify; try easy. - unfold gen_new_vec, gen_new_row, get_vec, get_row, scale. - do 2 rewrite Msum_Csum. - apply big_sum_eq_bounded; intros. - easy. -Qed. - -Lemma row_add_many_transpose : forall {n m} (A : Matrix n m) (row : nat) (as' : Matrix 1 n), - (row_add_many row as' A)⊤ = col_add_many row (as'⊤) (A⊤). -Proof. intros. - prep_matrix_equality. - unfold row_add_many, col_add_many, transpose. - bdestruct (y =? row); try easy. - apply Cplus_simplify; try easy. - unfold gen_new_vec, gen_new_row, get_vec, get_row, scale. - do 2 rewrite Msum_Csum. - apply big_sum_eq_bounded; intros. - easy. -Qed. - -Lemma col_add_each_transpose : forall {n m} (A : Matrix n m) (col : nat) (as' : Matrix 1 m), - (col_add_each col as' A)⊤ = row_add_each col (as'⊤) (A⊤). -Proof. intros. - unfold row_add_each, col_add_each. - rewrite Mplus_transpose. - rewrite Mmult_transpose. - rewrite get_vec_transpose. - easy. -Qed. - -Lemma row_add_each_transpose : forall {n m} (A : Matrix n m) (row : nat) (as' : Vector n), - (row_add_each row as' A)⊤ = col_add_each row (as'⊤) (A⊤). -Proof. intros. - unfold row_add_each, col_add_each. - rewrite Mplus_transpose. - rewrite Mmult_transpose. - rewrite get_row_transpose. - easy. -Qed. - - - - -(** the idea is to show that col operations correspond to multiplication by special matrices. *) -(** Thus, we show that the col ops all satisfy various multiplication rules *) -Lemma swap_preserves_mul_lt : forall {n m o} (A : Matrix n m) (B : Matrix m o) (x y : nat), - x < y -> x < m -> y < m -> A × B = (col_swap A x y) × (row_swap B x y). -Proof. intros. - prep_matrix_equality. - unfold Mmult. - bdestruct (x y < m -> A × B = (col_swap A x y) × (row_swap B x y). -Proof. intros. bdestruct (x x < m -> y < m -> A × (row_add B y x a) = (col_add A x y a) × B. -Proof. intros. - prep_matrix_equality. - unfold Mmult. - bdestruct (x y < m -> A × (row_add B y x a) = (col_add A x y a) × B. -Proof. intros. bdestruct (x skip_count skip i. -Proof. intros; unfold skip_count. - bdestruct (i skip_count skip i1 < skip_count skip i2. -Proof. intros; unfold skip_count. - bdestruct (i1 to_add <> col -> - col_add (col_add_many col as' T) col to_add c = - col_add_many col as' (col_add T col to_add c). -Proof. intros. - prep_matrix_equality. - unfold col_add, col_add_many. - bdestruct (y =? col); try lia; try easy. - repeat rewrite <- Cplus_assoc. - apply Cplus_simplify; try easy. - bdestruct (to_add =? col); try lia. - rewrite Cplus_comm. - apply Cplus_simplify; try easy. - unfold gen_new_vec. - do 2 rewrite Msum_Csum. - apply big_sum_eq_bounded; intros. - unfold get_vec, scale; simpl. - bdestruct (x0 =? col); try lca. - rewrite H4, H; lca. -Qed. - -Lemma col_add_many_preserves_mul_some : forall (n m o e col : nat) - (A : Matrix n m) (B : Matrix m o) (v : Vector m), - WF_Matrix v -> (skip_count col e) < m -> col < m -> - (forall i : nat, (skip_count col e) < i -> v i 0 = C0) -> v col 0 = C0 -> - A × (row_add_each col v B) = (col_add_many col v A) × B. -Proof. induction e as [| e]. - - intros. - destruct m; try easy. - rewrite (col_add_many_col_add col (skip_count col 0) _ _); try easy. - rewrite <- (col_add_many_0 col A (make_row_zero (skip_count col 0) v)). - rewrite (row_add_each_row_add col (skip_count col 0) _ _); try easy. - rewrite <- (row_add_each_0 col B (make_row_zero (skip_count col 0) v)). - apply add_preserves_mul; try easy. - apply mat_equiv_eq; auto with wf_db. - unfold mat_equiv; intros. - destruct j; try lia. - unfold make_row_zero. - bdestruct (i =? skip_count col 0); try lia; try easy. - destruct col; destruct i; try easy. - rewrite H2; try easy. unfold skip_count in *. - bdestruct (0 col < m -> v col 0 = C0 -> - A × (row_add_each col v B) = (col_add_many col v A) × B. -Proof. intros. - destruct m; try easy. - destruct m. - - assert (H' : v = Zero). - apply mat_equiv_eq; auto with wf_db. - unfold mat_equiv; intros. - destruct i; destruct j; destruct col; try lia; easy. - rewrite <- col_add_many_0, <- row_add_each_0; try easy. - rewrite H'; easy. - - apply (col_add_many_preserves_mul_some _ _ _ m col); try easy. - unfold skip_count. - bdestruct (m col < m -> v 0 col = C0 -> - A × (row_add_many col v B) = (col_add_each col v A) × B. -Proof. intros. - assert (H' : ((B⊤) × (row_add_each col (v⊤) (A⊤)))⊤ = - ((col_add_many col (v⊤) (B⊤)) × (A⊤))⊤). - rewrite col_add_many_preserves_mul; auto with wf_db; try easy. - do 2 rewrite Mmult_transpose in H'. - rewrite row_add_each_transpose in H'. - rewrite col_add_many_transpose in H'. - repeat rewrite transpose_involutive in H'. - easy. -Qed. - -Lemma col_swap_mult_r : forall {n} (A : Square n) (x y : nat), - x < n -> y < n -> WF_Matrix A -> - col_swap A x y = A × (row_swap (I n) x y). -Proof. intros. - assert (H2 := (swap_preserves_mul A (row_swap (I n) x y) x y)). - rewrite <- (Mmult_1_r _ _ (col_swap A x y)); auto with wf_db. - rewrite H2; try easy. - rewrite <- (row_swap_inv (I n) x y). - reflexivity. -Qed. - -Lemma col_scale_mult_r : forall {n} (A : Square n) (x : nat) (a : C), - WF_Matrix A -> - col_scale A x a = A × (row_scale (I n) x a). -Proof. intros. - rewrite scale_preserves_mul. - rewrite Mmult_1_r; auto with wf_db. -Qed. - -Lemma col_add_mult_r : forall {n} (A : Square n) (x y : nat) (a : C), - x < n -> y < n -> WF_Matrix A -> - col_add A x y a = A × (row_add (I n) y x a). -Proof. intros. - rewrite add_preserves_mul; auto. - rewrite Mmult_1_r; auto with wf_db. -Qed. - -Lemma col_add_many_mult_r : forall {n} (A : Square n) (v : Vector n) (col : nat), - WF_Matrix A -> WF_Matrix v -> col < n -> v col 0 = C0 -> - col_add_many col v A = A × (row_add_each col v (I n)). -Proof. intros. - rewrite col_add_many_preserves_mul; try easy. - rewrite Mmult_1_r; auto with wf_db. -Qed. - -Lemma col_add_each_mult_r : forall {n} (A : Square n) (v : Matrix 1 n) (col : nat), - WF_Matrix A -> WF_Matrix v -> col < n -> v 0 col = C0 -> - col_add_each col v A = A × (row_add_many col v (I n)). -Proof. intros. - rewrite col_add_each_preserves_mul; try easy. - rewrite Mmult_1_r; auto with wf_db. -Qed. - -(* now we prove facts about the ops on (I n) *) -Lemma col_row_swap_invr_I : forall (n x y : nat), - x < n -> y < n -> col_swap (I n) x y = row_swap (I n) x y. -Proof. intros. - prep_matrix_equality. - unfold col_swap, row_swap, I. - bdestruct_all; try easy. -Qed. - -Lemma col_row_scale_invr_I : forall (n x : nat) (c : C), - col_scale (I n) x c = row_scale (I n) x c. -Proof. intros. - prep_matrix_equality. - unfold col_scale, row_scale, I. - bdestruct_all; try easy; lca. -Qed. - -Lemma col_row_add_invr_I : forall (n x y : nat) (c : C), - x < n -> y < n -> col_add (I n) x y c = row_add (I n) y x c. -Proof. intros. - prep_matrix_equality. - unfold col_add, row_add, I. - bdestruct_all; try easy; try lca. -Qed. - -Lemma row_each_col_many_invr_I : forall (n col : nat) (v : Vector n), - WF_Matrix v -> col < n -> v col 0 = C0 -> - row_add_each col v (I n) = col_add_many col v (I n). -Proof. intros. - rewrite <- Mmult_1_r, <- col_add_many_preserves_mul, Mmult_1_l; auto with wf_db. -Qed. - -Lemma row_many_col_each_invr_I : forall (n col : nat) (v : Matrix 1 n), - WF_Matrix v -> col < n -> v 0 col = C0 -> - row_add_many col v (I n) = col_add_each col v (I n). -Proof. intros. - rewrite <- Mmult_1_r, <- col_add_each_preserves_mul, Mmult_1_l; auto with wf_db. -Qed. - -Lemma reduce_append_split : forall {n m} (T : Matrix n (S m)), - WF_Matrix T -> T = col_append (reduce_col T m) (get_vec m T). -Proof. intros. - prep_matrix_equality. - unfold col_append, get_vec, reduce_col. - bdestruct_all; subst; try easy. - do 2 (rewrite H; try lia); easy. -Qed. - -Lemma smash_zero : forall {n m} (T : Matrix n m) (i : nat), - WF_Matrix T -> smash T (@Zero n i) = T. -Proof. intros. - prep_matrix_equality. - unfold smash, Zero. - bdestruct (y WF_Matrix v -> - col_append T v = smash T v. -Proof. intros. - unfold smash, col_append, WF_Matrix in *. - prep_matrix_equality. - bdestruct (y =? m); bdestruct (y v n 0 = C0 -> v = reduce_vecn v. -Proof. intros. unfold reduce_vecn. - prep_matrix_equality. - bdestruct (x (v = Zero <-> (reduce_row v x) = Zero /\ v x 0 = C0). -Proof. intros. split. - - intros. rewrite H0. split. - + prep_matrix_equality. unfold reduce_row. - bdestruct (x0 v <> Zero -> exists x, v x 0 <> C0. -Proof. induction n as [| n']. - - intros. - assert (H' : v = Zero). - { prep_matrix_equality. - unfold Zero. - unfold WF_Matrix in H. - apply H. - left. lia. } - easy. - - intros. - destruct (Ceq_dec (v n' 0) C0). - + destruct (vec_equiv_dec (reduce_row v n') Zero). - * assert (H' := H). - apply (zero_reduce _ n') in H'. - destruct H'. - assert (H' : v = Zero). - { apply H2. - split. - apply mat_equiv_eq; auto with wf_db. - easy. } - easy. - * assert (H1 : exists x, (reduce_row v n') x 0 <> C0). - { apply IHn'; auto with wf_db. - unfold not in *. intros. apply n. - rewrite H1. easy. } - destruct H1. - exists x. - rewrite (last_zero_simplification v); try easy. - + exists n'. - apply n. -Qed. - -Local Close Scope nat_scope. - - -(* some inner product lemmas *) -Lemma inner_product_scale_l : forall {n} (u v : Vector n) (c : C), - ⟨c .* u, v⟩ = c^* * ⟨u,v⟩. -Proof. intros. - unfold inner_product, scale, adjoint, Mmult. - rewrite (@big_sum_mult_l C _ _ _ C_is_ring). - apply big_sum_eq_bounded; intros. - lca. -Qed. - -Lemma inner_product_scale_r : forall {n} (u v : Vector n) (c : C), - ⟨u, c .* v⟩ = c * ⟨u,v⟩. -Proof. intros. - unfold inner_product, scale, adjoint, Mmult. - rewrite (@big_sum_mult_l C _ _ _ C_is_ring). - apply big_sum_eq_bounded; intros. - lca. -Qed. - -Lemma inner_product_plus_l : forall {n} (u v w : Vector n), - ⟨u .+ v, w⟩ = ⟨u, w⟩ + ⟨v, w⟩. -Proof. intros. - unfold inner_product, scale, adjoint, Mplus, Mmult. - rewrite <- (@big_sum_plus C _ _ C_is_comm_group). - apply big_sum_eq_bounded; intros. - lca. -Qed. - -Lemma inner_product_plus_r : forall {n} (u v w : Vector n), - ⟨u, v .+ w⟩ = ⟨u, v⟩ + ⟨u, w⟩. -Proof. intros. - unfold inner_product, scale, adjoint, Mplus, Mmult. - rewrite <- (@big_sum_plus C _ _ C_is_comm_group). - apply big_sum_eq_bounded; intros. - lca. -Qed. - -Lemma inner_product_big_sum_l : forall {n} (u : Vector n) (f : nat -> Vector n) (k : nat), - ⟨big_sum f k, u⟩ = big_sum (fun i => ⟨f i, u⟩) k. -Proof. induction k. - - unfold inner_product; simpl. - rewrite zero_adjoint_eq, Mmult_0_l; easy. - - simpl. - rewrite inner_product_plus_l, IHk. - reflexivity. -Qed. - -Lemma inner_product_big_sum_r : forall {n} (u : Vector n) (f : nat -> Vector n) (k : nat), - ⟨u, big_sum f k⟩ = big_sum (fun i => ⟨u, f i⟩) k. -Proof. induction k. - - unfold inner_product; simpl. - rewrite Mmult_0_r; easy. - - simpl. - rewrite inner_product_plus_r, IHk. - reflexivity. -Qed. - -Lemma inner_product_conj_sym : forall {n} (u v : Vector n), - ⟨u, v⟩ = ⟨v, u⟩^*. -Proof. intros. - unfold inner_product, adjoint, Mmult. - rewrite (@big_sum_func_distr C C _ C_is_group _ C_is_group). - apply big_sum_eq_bounded; intros. - lca. - intros; lca. -Qed. - -Lemma inner_product_mafe_WF_l : forall {n} (u v : Vector n), - ⟨u, v⟩ = ⟨make_WF u, v⟩. -Proof. intros. - unfold inner_product, adjoint, Mmult, make_WF. - apply big_sum_eq_bounded; intros. - bdestruct_all; simpl; easy. -Qed. - -Lemma inner_product_mafe_WF_r : forall {n} (u v : Vector n), - ⟨u, v⟩ = ⟨u, make_WF v⟩. -Proof. intros. - unfold inner_product, adjoint, Mmult, make_WF. - apply big_sum_eq_bounded; intros. - bdestruct_all; simpl; easy. -Qed. - -(* Useful to be able to normalize vectors *) -Definition norm {n} (ψ : Vector n) : R := - sqrt (fst ⟨ψ,ψ⟩). - -Definition normalize {n} (ψ : Vector n) := - / (norm ψ) .* ψ. - -Lemma norm_scale : forall {n} c (v : Vector n), norm (c .* v) = ((Cmod c) * norm v)%R. -Proof. - intros n c v. - unfold norm, inner_product. - rewrite Mscale_adj. - rewrite Mscale_mult_dist_l, Mscale_mult_dist_r, Mscale_assoc. - unfold scale. - simpl. - replace (fst c * snd c + - snd c * fst c)%R with 0%R. - autorewrite with R_db C_db. - replace (fst c * fst c)%R with (fst c ^ 2)%R by lra. - replace (snd c * snd c)%R with (snd c ^ 2)%R by lra. - rewrite sqrt_mult_alt. - reflexivity. - apply Rplus_le_le_0_compat; apply pow2_ge_0. - lra. -Qed. - -Lemma normalized_norm_1 : forall {n} (v : Vector n), - norm v <> 0 -> norm (normalize v) = 1. -Proof. intros. - unfold normalize. - rewrite norm_scale. - rewrite Cmod_real. - simpl. - autorewrite with R_db. - rewrite Rmult_comm. - rewrite Rinv_mult; try easy. - rewrite <- Rmult_comm. - rewrite <- Rmult_assoc. - rewrite Rinv_r; try easy. - autorewrite with R_db. - reflexivity. - unfold Cinv. - simpl. - autorewrite with R_db. - rewrite Rinv_mult; try easy. - rewrite <- Rmult_assoc. - rewrite Rinv_r; try easy. - autorewrite with R_db. - assert (H' : norm v >= 0). - { assert (H'' : 0 <= norm v). - { apply sqrt_pos. } - lra. } - destruct H' as [H0 | H0]. - left. - assert (H1 : 0 < norm v). { lra. } - apply Rinv_0_lt_compat in H1. - lra. easy. - apply div_real. - easy. -Qed. - -Lemma rewrite_norm : forall {d} (ψ : Vector d), - fst ⟨ψ,ψ⟩ = big_sum (fun i => Cmod (ψ i O) ^ 2)%R d. -Proof. - intros d ψ. unfold inner_product, Mmult. - replace (fun y : nat => (ψ† O y * ψ y O)%C) with (fun y : nat => RtoC (Cmod (ψ y O) ^ 2)). - apply Rsum_big_sum. - apply functional_extensionality. intros. - unfold adjoint. rewrite <- Cmod_sqr. symmetry. apply RtoC_pow. -Qed. - -Local Open Scope nat_scope. - -Lemma norm_real : forall {n} (v : Vector n), snd ⟨v,v⟩ = 0%R. -Proof. intros. unfold inner_product, Mmult, adjoint. - rewrite big_sum_snd_0. easy. - intros. rewrite Cmult_comm. - rewrite Cmult_conj_real. - reflexivity. -Qed. - -Lemma inner_product_ge_0 : forall {d} (ψ : Vector d), - (0 <= fst ⟨ψ,ψ⟩)%R. -Proof. - intros. - unfold inner_product, Mmult, adjoint. - apply big_sum_ge_0. - intro. - rewrite <- Cmod_sqr. - simpl. - autorewrite with R_db. - apply Rmult_le_pos; apply Cmod_ge_0. -Qed. - -(* why does sqrt_pos exist? *) -Lemma norm_ge_0 : forall {d} (ψ : Vector d), - (0 <= norm ψ)%R. -Proof. intros. - unfold norm. - apply sqrt_positivity. - (* apply sqrt_pos *) - apply inner_product_ge_0. -Qed. - -Lemma norm_squared : forall {d} (ψ : Vector d), - ((norm ψ) ^2)%R = fst ⟨ ψ, ψ ⟩. -Proof. intros. - unfold norm. - rewrite pow2_sqrt; auto. - apply inner_product_ge_0. -Qed. - -(* "Quick" proof of |x| = 0 iff x = 0 *) -Lemma inner_product_zero_iff_zero : forall {n} (v : Vector n), - WF_Matrix v -> (⟨v,v⟩ = C0 <-> v = Zero). -Proof. intros. split. - - intros. - destruct (mat_equiv_dec v Zero). - apply mat_equiv_eq; try easy. - assert (H' : v <> Zero). - { unfold not; intros. - apply n0. rewrite H1. - easy. } - apply nonzero_vec_nonzero_elem in H'; try easy. - destruct H'. - unfold WF_Matrix in H. - bdestruct (x b = a). { easy. } - apply H'' in H3. - apply H' in H3. - apply Cmod_gt_0 in H1. - rewrite H3 in H1. - lra. } - rewrite H0 in H'. - simpl in H'. lra. - assert (H' : v x O = C0). - { apply H. left; easy. } - rewrite H' in H1; easy. - - intros. - unfold inner_product. - rewrite H0. - rewrite Mmult_0_r. - easy. -Qed. - -Lemma norm_zero_iff_zero : forall {n} (v : Vector n), - WF_Matrix v -> (norm v = 0%R <-> v = Zero). -Proof. intros. split. - - intros. - unfold norm in H0. - apply inner_product_zero_iff_zero in H. - unfold inner_product in H. - apply sqrt_eq_0 in H0. - apply H. - apply c_proj_eq. - apply H0. - apply norm_real. - apply inner_product_ge_0. - - intros. - rewrite H0. - unfold norm, inner_product. - rewrite Mmult_0_r. - simpl. apply sqrt_0. -Qed. - -Local Close Scope nat_scope. - -(* We can now prove Cauchy-Schwartz for vectors with inner_product *) -Lemma CS_key_lemma : forall {n} (u v : Vector n), - fst ⟨ (⟨v,v⟩ .* u .+ -1 * ⟨v,u⟩ .* v), (⟨v,v⟩ .* u .+ -1 * ⟨v,u⟩ .* v) ⟩ = - ((fst ⟨v,v⟩) * ((fst ⟨v,v⟩)* (fst ⟨u,u⟩) - (Cmod ⟨u,v⟩)^2 ))%R. -Proof. intros. - replace ((fst ⟨v,v⟩) * ((fst ⟨v,v⟩)* (fst ⟨u,u⟩) - (Cmod ⟨u,v⟩)^2 ))%R with - (fst (⟨v,v⟩ * (⟨v,v⟩ * ⟨u,u⟩ - (Cmod ⟨u,v⟩)^2))). - - apply f_equal. - repeat rewrite inner_product_plus_l; repeat rewrite inner_product_plus_r; - repeat rewrite inner_product_scale_l; repeat rewrite inner_product_scale_r. - replace ((-1 * ⟨ v, u ⟩) ^* * (-1 * ⟨ v, u ⟩ * ⟨ v, v ⟩)) with - ( ⟨ v, u ⟩^* * ⟨ v, u ⟩ * ⟨ v, v ⟩ ) by lca. - replace ((-1 * ⟨ v, u ⟩) ^* * (⟨ v, v ⟩ * ⟨ v, u ⟩) + - ⟨ v, u ⟩ ^* * ⟨ v, u ⟩ * ⟨ v, v ⟩) with C0 by lca. - rewrite (inner_product_conj_sym v u), <- (inner_product_conj_sym v v). - rewrite <- Cmult_assoc. - replace (⟨ u, v ⟩ ^* * ⟨ u, v ⟩) with (Cmod ⟨ u, v ⟩ ^ 2) by apply Cmod_sqr. - lca. - - assert (H := norm_real v). - assert (H0 := norm_real u). - destruct ⟨ v, v ⟩; destruct ⟨ u, u ⟩. - rewrite Cmod_sqr. - replace (⟨ u, v ⟩ ^* * ⟨ u, v ⟩) with (Cmod ⟨ u, v ⟩ ^ 2,0)%R. - simpl in *; subst; lra. - apply c_proj_eq. - unfold Cmod. - rewrite pow2_sqrt. - simpl; lra. - apply Rplus_le_le_0_compat; apply pow2_ge_0. - rewrite Cmult_comm, Cmult_conj_real; easy. -Qed. - -Lemma real_ge_0_aux : forall (a b c : R), - 0 <= a -> 0 < b -> (a = b * c)%R -> - 0 <= c. -Proof. intros. - replace c with (a * / b)%R. - apply Rle_mult_inv_pos; auto. - subst. - replace (b * c * / b)%R with (b * /b * c)%R by lra. - rewrite Rinv_r; try lra. -Qed. - -Lemma Cauchy_Schwartz_ver1 : forall {n} (u v : Vector n), - (Cmod ⟨u,v⟩)^2 <= (fst ⟨u,u⟩) * (fst ⟨v,v⟩). -Proof. intros. - destruct (Req_dec (fst ⟨v,v⟩) 0). - - rewrite H. - rewrite inner_product_mafe_WF_l, inner_product_mafe_WF_r in H. - rewrite inner_product_mafe_WF_r. - assert (H' : make_WF v = Zero). - { apply norm_zero_iff_zero; auto with wf_db. - unfold norm; rewrite H. - apply sqrt_0. } - unfold inner_product. - rewrite H', Mmult_0_r. - unfold Zero. - rewrite Cmod_0. - lra. - - assert (H0 := CS_key_lemma u v). - apply real_ge_0_aux in H0. - lra. - apply inner_product_ge_0. - destruct (inner_product_ge_0 v); lra. -Qed. - -Lemma Cauchy_Schwartz_ver2 : forall {n} (u v : Vector n), - (Cmod ⟨u,v⟩) <= norm u * norm v. -Proof. intros. - rewrite <- (sqrt_pow2 (Cmod ⟨ u, v ⟩)), <- (sqrt_pow2 (norm v)), <- (sqrt_pow2 (norm u)). - rewrite <- sqrt_mult. - apply sqrt_le_1. - all : try apply pow2_ge_0. - apply Rmult_le_pos. - all : try apply pow2_ge_0. - unfold norm. - rewrite pow2_sqrt, pow2_sqrt. - apply Cauchy_Schwartz_ver1. - all : try apply inner_product_ge_0; try apply norm_ge_0. - apply Cmod_ge_0. -Qed. - -Lemma Cplx_Cauchy_vector : - forall n (u v : Vector n), - ((big_sum (fun i => Cmod (u i O) ^ 2) n) * (big_sum (fun i => Cmod (v i O) ^ 2) n) >= - Cmod (big_sum (fun i => ((u i O)^* * (v i O))%C) n) ^ 2)%R. -Proof. intros. - assert (H := Cauchy_Schwartz_ver1 u v). - replace (big_sum (fun i : nat => (Cmod (u i 0%nat) ^ 2)%R) n) with (fst ⟨ u, u ⟩). - replace (big_sum (fun i : nat => (Cmod (v i 0%nat) ^ 2)%R) n) with (fst ⟨ v, v ⟩). - replace (Σ (fun i : nat => (u i 0%nat) ^* * v i 0%nat) n) with (⟨ u, v ⟩). - lra. - all : unfold inner_product, adjoint, Mmult; try easy. - all : rewrite (@big_sum_func_distr C R _ C_is_group _ R_is_group). - all : try apply big_sum_eq_bounded; intros. - all : try rewrite <- Cmod_sqr. - all : try (destruct a; destruct b; simpl; easy). - destruct (v x 0%nat); unfold Cmod, pow, Cmult; simpl; lra. - destruct (u x 0%nat); unfold Cmod, pow, Cmult; simpl; lra. -Qed. - - -Local Open Scope nat_scope. - -Lemma Cplx_Cauchy : - forall n (u v : nat -> C), - ((big_sum (fun i => Cmod (u i) ^ 2) n) * (big_sum (fun i => Cmod (v i) ^ 2) n) >= Cmod (big_sum (fun i => ((u i)^* * (v i))%C) n) ^ 2)%R. -Proof. intros. - assert (H := Cplx_Cauchy_vector n (fun i j => u i) (fun i j => v i)). - simpl in *. - easy. -Qed. - - (** * Tactics **) (* Note on "using [tactics]": Most generated subgoals will be of the form diff --git a/Pad.v b/Pad.v index cf26225..88c7ba9 100644 --- a/Pad.v +++ b/Pad.v @@ -442,6 +442,14 @@ Lemma pad_A_ctrl_commutes : forall dim m n o A B, Proof. intros. unfold pad_ctrl, pad_u, pad. +(* + bdestruct_all; try lia. + all : repeat rewrite Mmult_0_l; repeat rewrite Mmult_0_r; auto. + prep_matrix_equality. + unfold Mmult. + unfold kron. + apply mat_equiv_eq. apply WF_mult. +*) gridify; trivial. Qed. diff --git a/Permutations.v b/Permutations.v index 3257566..480a4d1 100644 --- a/Permutations.v +++ b/Permutations.v @@ -8,7 +8,8 @@ Local Open Scope nat_scope. Definition permutation (n : nat) (f : nat -> nat) := exists g, forall x, x < n -> (f x < n /\ g x < n /\ g (f x) = x /\ f (g x) = x). -Lemma permutation_is_injective : forall n f, + +Lemma permutation_is_injective : forall n f, permutation n f -> forall x y, x < n -> y < n -> f x = f y -> x = y. Proof. @@ -41,6 +42,31 @@ Proof. assumption. Qed. +Lemma id_permutation : forall n, + permutation n Datatypes.id. +Proof. intros. + exists Datatypes.id. + intros. + unfold Datatypes.id. + easy. +Qed. + +Lemma fswap_permutation : forall n f x y, + permutation n f -> + (x < n)%nat -> + (y < n)%nat -> + permutation n (fswap f x y). +Proof. intros. + replace (fswap f x y) with (f ∘ (fswap (fun i => i) x y))%prg. + apply permutation_compose; auto. + exists (fswap (fun i => i) x y). + intros. unfold fswap. + bdestruct_all; subst; auto. + apply functional_extensionality; intros. + unfold compose, fswap. + bdestruct_all; easy. +Qed. + Lemma fswap_at_boundary_permutation : forall n f x, permutation (S n) f -> (x < S n)%nat -> f x = n -> @@ -55,7 +81,6 @@ Proof. apply Hf. assumption. assumption. } - destruct Hf as [g Hg]. exists (compose (fswap (fun x : nat => x) x n) g). intros x0 Hx0. @@ -99,6 +124,9 @@ Proof. destruct (Hg x0) as [_ [_ [_ ?]]]; lia. Qed. + + + (** vsum terms can be arbitrarily reordered *) Lemma vsum_reorder : forall {d} n (v : nat -> Vector d) f, permutation n f -> @@ -121,6 +149,171 @@ Proof. exists g. auto. Qed. + +(** * showing every permutation is a sequence of fswaps *) + + +(* note the list acts on the left, for example, [s1,s2,...,sk] ⋅ f = s1 ⋅ ( ... ⋅ (sk ⋅ f)) *) +Fixpoint stack_fswaps (f : nat -> nat) (l : list (nat * nat)) := + match l with + | [] => f + | p :: ps => (fswap (Datatypes.id) (fst p) (snd p) ∘ (stack_fswaps f ps))%prg + end. + +Definition WF_fswap_stack n (l : list (nat * nat)) := + forall p, In p l -> (fst p < n /\ snd p < n). + +Lemma WF_fswap_stack_pop : forall n a l, + WF_fswap_stack n (a :: l) -> WF_fswap_stack n l. +Proof. intros. + unfold WF_fswap_stack in *. + intros. + apply H. + right; easy. +Qed. + +Lemma WF_fswap_stack_cons : forall n a l, + fst a < n -> snd a < n -> WF_fswap_stack n l -> WF_fswap_stack n (a :: l). +Proof. intros. + unfold WF_fswap_stack in *. + intros. + destruct H2; subst; auto. +Qed. + +Lemma WF_fswap_miss : forall n l i, + WF_fswap_stack n l -> + n <= i -> + (stack_fswaps Datatypes.id l) i = i. +Proof. induction l. + intros; simpl; easy. + intros; simpl. + unfold compose. + rewrite IHl; auto. + unfold fswap, Datatypes.id; simpl. + destruct (H a). + left; auto. + bdestruct_all; try lia. + apply WF_fswap_stack_pop in H; auto. +Qed. + +Lemma stack_fswaps_permutation : forall {n} (f : nat -> nat) (l : list (nat * nat)), + WF_fswap_stack n l -> + permutation n f -> + permutation n (stack_fswaps f l). +Proof. induction l. + - intros. easy. + - intros. + simpl. + apply permutation_compose. + apply fswap_permutation. + apply id_permutation. + 3 : apply IHl; auto. + 3 : apply WF_fswap_stack_pop in H; auto. + all : apply H; left; easy. +Qed. + +Lemma stack_fswaps_cons : forall (p : nat * nat) (l : list (nat * nat)), + ((stack_fswaps Datatypes.id [p]) ∘ (stack_fswaps Datatypes.id l))%prg = + stack_fswaps Datatypes.id (p :: l). +Proof. intros. + simpl. + rewrite compose_id_right. + easy. +Qed. + +(* +Theorem all_perms_are_fswap_stacks : forall {n} f, + permutation n f -> + exists l, WF_fswap_stack n l /\ f = (stack_fswaps Datatypes.id l) /\ length l = n. +Proof. induction n. + - intros. + exists []; simpl. +*) + +Definition ordered_real_function n (f : nat -> R) := + forall i j, i < n -> j < n -> i <= j -> (f j <= f i)%R. + +Lemma get_real_function_min : forall {n} (f : nat -> R), + exists n0, (n0 < (S n))%nat /\ (forall i, (i < (S n))%nat -> (f n0 <= f i)%R). +Proof. induction n. + - intros. + exists O; intros. + split; auto. + intros. + destruct i; try lia. + lra. + - intros. + destruct (IHn f) as [n0 [H H0] ]. + destruct (Rlt_le_dec (f n0) (f (S n))). + + exists n0; intros. + split; try lia. + intros. + bdestruct (i =? (S n))%nat; subst. + lra. + apply H0. + bdestruct (n0 R), + exists l, WF_fswap_stack n l /\ + ordered_real_function n (f ∘ (stack_fswaps Datatypes.id l))%prg. +Proof. intros. + generalize dependent f. + induction n. + - intros; exists []. + split; auto. + unfold WF_fswap_stack; intros. + destruct H. + simpl. + unfold ordered_real_function; intros; lia. + - intros. + destruct (@get_real_function_min n f) as [n0 [H H0]]. + destruct (IHn (f ∘ (stack_fswaps Datatypes.id [(n0, n)]))%prg) as [l [H1 H2]]. + exists ((n0, n) :: l). + split. + apply WF_fswap_stack_cons; simpl; auto. + unfold WF_fswap_stack in *; intros. + apply H1 in H3. + lia. + rewrite compose_assoc, stack_fswaps_cons in H2. + unfold ordered_real_function in *. + intros. + bdestruct (j =? n); subst. + simpl. + rewrite <- compose_assoc. + assert (H' : permutation (S n) + (fswap Datatypes.id n0 n ∘ stack_fswaps Datatypes.id l)%prg). + { apply permutation_compose. + apply fswap_permutation; auto. + apply id_permutation. + apply stack_fswaps_permutation. + unfold WF_fswap_stack in *; intros. + apply H1 in H6. + lia. + apply id_permutation. } + unfold compose in *. + destruct H' as [g H6]. + destruct (H6 i); auto. + rewrite (WF_fswap_miss n); auto. + replace (fswap Datatypes.id n0 n n) with n0. + apply H0; easy. + unfold fswap, Datatypes.id. + bdestruct_all; simpl; easy. + bdestruct (j nat) : Square n := @@ -136,6 +329,14 @@ Proof. Qed. #[export] Hint Resolve perm_mat_WF : wf_db. +Lemma perm_mat_id : forall n, + perm_mat n (Datatypes.id) = (I n). +Proof. intros. + unfold Datatypes.id, I, perm_mat. + prep_matrix_equality. + bdestruct_all; easy. +Qed. + Lemma perm_mat_unitary : forall n p, permutation n p -> WF_Unitary (perm_mat n p). Proof. @@ -216,6 +417,86 @@ Proof. contradiction. Qed. +Lemma perm_mat_col_swap_I : forall n f i j, + (forall x, x < n -> f x = x) -> + i < n -> j < n -> + perm_mat n (fswap f i j) = col_swap (I n) i j. +Proof. intros. + unfold perm_mat, fswap, col_swap, I. + prep_matrix_equality. + rewrite 2 H; auto. + bdestruct_all; simpl; try lia; auto. + rewrite H in H4; auto; lia. + rewrite H in H4; auto; lia. +Qed. + +Lemma perm_mat_col_swap : forall n f i j, + i < n -> j < n -> + perm_mat n (fswap f i j) = col_swap (perm_mat n f) i j. +Proof. intros. + unfold perm_mat, fswap, col_swap, I. + prep_matrix_equality. + bdestruct_all; simpl; try lia; auto. +Qed. + +Lemma perm_mat_row_swap : forall n f i j, + i < n -> j < n -> + perm_mat n (fswap f i j) = (row_swap (perm_mat n f)† i j)†. +Proof. intros. + unfold perm_mat, fswap, row_swap, I, adjoint. + prep_matrix_equality. + bdestruct_all; simpl; try lia; auto; lca. +Qed. + +Lemma perm_mat_e_i : forall n f i, + i < n -> + permutation n f -> + (perm_mat n f) × e_i i = e_i (f i). +Proof. intros. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + destruct j; try lia. + unfold Mmult. + apply big_sum_unique. + exists i. + split; auto. + split. + unfold e_i, perm_mat. + bdestruct_all; simpl; lca. + intros. + unfold e_i. + bdestruct_all; simpl; lca. +Qed. + +(* with get_entry_with_e_i this became soo much easier *) +Lemma perm_mat_conjugate : forall {n} (A : Square n) f (i j : nat), + WF_Matrix A -> + i < n -> j < n -> + permutation n f -> + ((perm_mat n f)† × A × ((perm_mat n f))) i j = A (f i) (f j). +Proof. intros. + rewrite get_entry_with_e_i, (get_entry_with_e_i A); auto. + rewrite <- 2 Mmult_assoc, <- Mmult_adjoint. + rewrite perm_mat_e_i; auto. + rewrite 3 Mmult_assoc. + rewrite perm_mat_e_i; auto. + all : destruct H2; apply H2; auto. +Qed. + +Lemma perm_mat_conjugate_nonsquare : forall {m n} (A : Matrix m n) f (i j : nat), + WF_Matrix A -> + i < m -> j < n -> + permutation m f -> permutation n f -> + ((perm_mat m f)† × A × ((perm_mat n f))) i j = A (f i) (f j). +Proof. intros. + rewrite get_entry_with_e_i, (get_entry_with_e_i A); auto. + rewrite <- 2 Mmult_assoc, <- Mmult_adjoint. + rewrite perm_mat_e_i; auto. + rewrite 3 Mmult_assoc. + rewrite perm_mat_e_i; auto. + all : destruct H2; destruct H3; try apply H2; try apply H3; auto. +Qed. + (** Given a permutation p over n qubits, construct a permutation over 2^n indices. *) Definition qubit_perm_to_nat_perm n (p : nat -> nat) := fun x:nat => funbool_to_nat n ((nat_to_funbool n x) ∘ p)%prg. diff --git a/Quantum.v b/Quantum.v index 941dcbe..77006f2 100644 --- a/Quantum.v +++ b/Quantum.v @@ -4,6 +4,7 @@ Require Import Psatz. Require Import Reals. Require Export VecSet. +Require Export CauchySchwarz. (* Using our (complex, unbounded) matrices, their complex numbers *) @@ -571,8 +572,14 @@ Lemma WF_bra0 : WF_Matrix ⟨0∣. Proof. show_wf. Qed. Lemma WF_bra1 : WF_Matrix ⟨1∣. Proof. show_wf. Qed. Lemma WF_qubit0 : WF_Matrix ∣0⟩. Proof. show_wf. Qed. Lemma WF_qubit1 : WF_Matrix ∣1⟩. Proof. show_wf. Qed. -Lemma WF_braqubit0 : WF_Matrix ∣0⟩⟨0∣. Proof. show_wf. Qed. -Lemma WF_braqubit1 : WF_Matrix ∣1⟩⟨1∣. Proof. show_wf. Qed. +Lemma WF_braket0 : WF_Matrix ∣0⟩⟨0∣. Proof. show_wf. Qed. +Lemma WF_braket1 : WF_Matrix ∣1⟩⟨1∣. Proof. show_wf. Qed. + +#[deprecated(note="Use WF_braket0 instead")] +Notation WF_braqubit0 := WF_braket0 (only parsing). +#[deprecated(note="Use WF_braket1 instead")] +Notation WF_braqubit1 := WF_braket1 (only parsing). + Lemma WF_bool_to_ket : forall b, WF_Matrix (bool_to_ket b). Proof. destruct b; show_wf. Qed. Lemma WF_bool_to_matrix : forall b, WF_Matrix (bool_to_matrix b). @@ -602,7 +609,7 @@ Lemma WF_ybasis_plus : WF_Matrix ∣R⟩. Proof. show_wf. Qed. Lemma WF_ybasis_minus : WF_Matrix ∣L⟩. Proof. show_wf. Qed. -#[export] Hint Resolve WF_bra0 WF_bra1 WF_qubit0 WF_qubit1 WF_braqubit0 WF_braqubit1 : wf_db. +#[export] Hint Resolve WF_bra0 WF_bra1 WF_qubit0 WF_qubit1 WF_braket0 WF_braket1 WF_braqubit0 WF_braqubit1 : wf_db. #[export] Hint Resolve WF_bool_to_ket WF_bool_to_matrix WF_bool_to_matrix' : wf_db. #[export] Hint Resolve WF_ket WF_bra WF_bools_to_matrix : wf_db. #[export] Hint Resolve WF_xbasis_plus WF_xbasis_minus WF_ybasis_plus WF_ybasis_minus : wf_db. @@ -700,19 +707,31 @@ Proof. bdestruct (y WF_Unitary (A†). + +Lemma transpose_unitary : forall n (A : Matrix n n), WF_Unitary A -> WF_Unitary (A⊤). +Proof. + intros. + simpl. + split. + + destruct H; auto with wf_db. + + destruct H. + replace ((A⊤)†) with ((A†)⊤). + rewrite <- Mmult_transpose. + rewrite Minv_flip; auto with wf_db. + prep_matrix_equality. + unfold transpose, I. + bdestruct_all; easy. + prep_matrix_equality. + unfold transpose, adjoint. + easy. +Qed. + +Lemma adjoint_unitary : forall n (A : Matrix n n), WF_Unitary A -> WF_Unitary (A†). Proof. intros. simpl. @@ -1152,9 +1189,22 @@ Proof. lma. Qed. +Lemma pad1_unitary : forall (n : nat) (c : C) (A : Square n), + WF_Unitary A -> + (c * c ^*)%C = C1 -> + WF_Unitary (pad1 A c). +Proof. intros. + split. + destruct H; auto with wf_db. + rewrite pad1_adjoint, <- pad1_mult. + destruct H. + rewrite H1, Cmult_comm, H0, pad1_I. + easy. +Qed. + -#[export] Hint Resolve transpose_unitary cnot_unitary notc_unitary id_unitary : unit_db. -#[export] Hint Resolve swap_unitary zero_not_unitary kron_unitary big_kron_unitary big_kron_unitary' Mmult_unitary scale_unitary : unit_db. +#[export] Hint Resolve transpose_unitary adjoint_unitary cnot_unitary notc_unitary id_unitary : unit_db. +#[export] Hint Resolve swap_unitary zero_not_unitary kron_unitary big_kron_unitary big_kron_unitary' Mmult_unitary scale_unitary pad1_unitary : unit_db. @@ -1169,46 +1219,103 @@ Proof. reflexivity. Qed. (* Self-adjointness *) (********************) -(* Maybe change to "Hermitian?" *) -Definition id_sa := id_adjoint_eq. -Lemma hadamard_sa : hadamard† = hadamard. +Definition hermitian {n} (A : Square n) := + A† = A. + + + +Lemma I_hermitian : forall {n}, hermitian (I n). +Proof. intros. + apply id_adjoint_eq. +Qed. + +Lemma hadamard_hermitian : hermitian hadamard. Proof. prep_matrix_equality. repeat (try destruct x; try destruct y; try lca; trivial). Qed. -Lemma σx_sa : σx† = σx. +Lemma σx_hermitian : hermitian σx. Proof. prep_matrix_equality. repeat (try destruct x; try destruct y; try lca; trivial). Qed. -Lemma σy_sa : σy† = σy. +Lemma σy_hermitian : hermitian σy. Proof. prep_matrix_equality. repeat (try destruct x; try destruct y; try lca; trivial). Qed. -Lemma σz_sa : σz† = σz. +Lemma σz_hermitian : hermitian σz. Proof. prep_matrix_equality. repeat (try destruct x; try destruct y; try lca; trivial). Qed. -Lemma cnot_sa : cnot† = cnot. +Lemma cnot_hermitian : hermitian cnot. Proof. prep_matrix_equality. repeat (try destruct x; try destruct y; try lca; trivial). Qed. -Lemma swap_sa : swap† = swap. +Lemma swap_hermitian : hermitian swap. Proof. prep_matrix_equality. repeat (try destruct x; try destruct y; try lca; trivial). Qed. + + +(* some more general herm lemmas *) + +Lemma plus_hermitian : forall {n} (A B : Square n), + hermitian A -> hermitian B -> + hermitian (A .+ B). +Proof. intros n A B H H0. + unfold hermitian. + distribute_adjoint. + rewrite H, H0. + easy. +Qed. + +Lemma adjoint_hermitian : forall {n} (A : Square n), + hermitian A -> + hermitian A†. +Proof. intros. + unfold hermitian. + do 2 rewrite H. + easy. +Qed. + +Lemma unit_conj_hermitian : forall {n} (A U : Square n), + hermitian A -> WF_Unitary U -> + hermitian (U × A × U†). +Proof. intros. + destruct H0; auto with wf_db. + unfold hermitian. + rewrite 2 Mmult_adjoint, adjoint_involutive, Mmult_assoc, H. + easy. +Qed. + +Lemma AAadjoint_hermitian : forall {m n} (A : Matrix m n), + hermitian (A × A†). +Proof. intros. + unfold hermitian. + rewrite Mmult_adjoint, adjoint_involutive. + easy. +Qed. + +Lemma AadjointA_hermitian : forall {m n} (A : Matrix m n), + hermitian (A† × A). +Proof. intros. + unfold hermitian. + rewrite Mmult_adjoint, adjoint_involutive. + easy. +Qed. + Lemma control_adjoint : forall n (U : Square n), (control U)† = control (U†). Proof. intros n U. @@ -1225,10 +1332,11 @@ Proof. reflexivity. Qed. -Lemma control_sa : forall (n : nat) (A : Square n), - A† = A -> (control A)† = (control A). +Lemma control_hermitian : forall (n : nat) (A : Square n), + hermitian A -> hermitian (control A). Proof. intros n A H. + unfold hermitian in *. rewrite control_adjoint. rewrite H. easy. @@ -1245,6 +1353,7 @@ Proof. easy. Qed. + (* x and y rotation adjoints aren't x and rotations? *) Lemma rotation_adjoint : forall θ ϕ λ, (rotation θ ϕ λ)† = rotation (-θ) (-λ) (-ϕ). @@ -1263,19 +1372,115 @@ Proof. reflexivity. Qed. +Lemma braket0_hermitian : hermitian ∣0⟩⟨0∣. Proof. lma. Qed. +Lemma braket1_hermitian : hermitian ∣1⟩⟨1∣. Proof. lma. Qed. + + +#[global] Hint Rewrite hadamard_hermitian σx_hermitian σy_hermitian σz_hermitian cnot_hermitian swap_hermitian braket1_hermitian braket0_hermitian control_adjoint phase_adjoint rotation_adjoint : Q_db. + + + +(* THESE ARE TO BE PHASED OUT *) + + + +#[deprecated(note="Use I_hermitian instead")] +Notation id_sa := I_hermitian (only parsing). + +#[deprecated(note="Use hadamard_hermitian instead")] +Notation hadamard_sa := hadamard_hermitian (only parsing). + +#[deprecated(note="Use σx_hermitian instead")] +Notation σx_sa := σx_hermitian (only parsing). + +#[deprecated(note="Use σy_hermitian instead")] +Notation σy_sa := σy_hermitian (only parsing). + +#[deprecated(note="Use σz_hermitian instead")] +Notation σz_sa := σz_hermitian (only parsing). + +#[deprecated(note="Use cnot_hermitian instead")] +Notation cnot_sa := cnot_hermitian (only parsing). + +#[deprecated(note="Use swap_hermitian instead")] +Notation swap_sa := swap_hermitian (only parsing). + +#[deprecated(note="Use control_hermitian instead")] +Notation control_sa := control_hermitian (only parsing). + + +#[deprecated(note="Use braket0_hermitian instead")] +Notation braqubit0_sa := braket0_hermitian (only parsing). + +#[deprecated(note="Use braket1_hermitian instead")] +Notation braqubit1_sa := braket1_hermitian (only parsing). + + + +(* +Definition id_sa := id_adjoint_eq. + +Lemma hadamard_sa : hadamard† = hadamard. +Proof. + prep_matrix_equality. + repeat (try destruct x; try destruct y; try lca; trivial). +Qed. + +Lemma σx_sa : σx† = σx. +Proof. + prep_matrix_equality. + repeat (try destruct x; try destruct y; try lca; trivial). +Qed. + +Lemma σy_sa : σy† = σy. +Proof. + prep_matrix_equality. + repeat (try destruct x; try destruct y; try lca; trivial). +Qed. + +Lemma σz_sa : σz† = σz. +Proof. + prep_matrix_equality. + repeat (try destruct x; try destruct y; try lca; trivial). +Qed. + + +Lemma cnot_sa : cnot† = cnot. +Proof. + prep_matrix_equality. + repeat (try destruct x; try destruct y; try lca; trivial). +Qed. + +Lemma swap_sa : swap† = swap. +Proof. + prep_matrix_equality. + repeat (try destruct x; try destruct y; try lca; trivial). +Qed. + + + + +Lemma control_sa : forall (n : nat) (A : Square n), + A† = A -> (control A)† = (control A). +Proof. + intros n A H. + rewrite control_adjoint. + rewrite H. + easy. +Qed. + + Lemma braqubit0_sa : ∣0⟩⟨0∣† = ∣0⟩⟨0∣. Proof. lma. Qed. Lemma braqubit1_sa : ∣1⟩⟨1∣† = ∣1⟩⟨1∣. Proof. lma. Qed. +*) + #[global] Hint Rewrite hadamard_sa σx_sa σy_sa σz_sa cnot_sa swap_sa braqubit1_sa braqubit0_sa control_adjoint phase_adjoint rotation_adjoint : Q_db. (* Rather use control_adjoint : #[global] Hint Rewrite control_sa using (autorewrite with M_db; reflexivity) : M_db. *) -Lemma cnot_decomposition : ∣1⟩⟨1∣ ⊗ σx .+ ∣0⟩⟨0∣ ⊗ I 2 = cnot. -Proof. solve_matrix. Qed. -Lemma notc_decomposition : σx ⊗ ∣1⟩⟨1∣ .+ I 2 ⊗ ∣0⟩⟨0∣ = notc. -Proof. solve_matrix. Qed. (*********************) (** ** Phase Lemmas **) @@ -1374,9 +1579,63 @@ Qed. (* Positive Semidefiniteness *) (*****************************) +(* TODO: should unify this def with the newly defined inner_product *) Definition positive_semidefinite {n} (A : Square n) : Prop := forall (z : Vector n), WF_Matrix z -> fst ((z† × A × z) O O) >= 0. +Lemma positive_semidefinite_AAadjoint : forall {m n} (A : Matrix m n), + positive_semidefinite (A × A†). +Proof. intros. + unfold positive_semidefinite. + intros. + replace (((z) † × (A × (A) †) × z) 0%nat 0%nat) with (⟨ A† × z, A† × z ⟩). + apply Rle_ge; apply inner_product_ge_0. + unfold inner_product. + distribute_adjoint. + rewrite adjoint_involutive, 3 Mmult_assoc. + easy. +Qed. + +Lemma positive_semidefinite_AadjointA : forall {m n} (A : Matrix m n), + positive_semidefinite (A† × A). +Proof. intros. + assert (H' := (positive_semidefinite_AAadjoint A†)). + rewrite adjoint_involutive in H'. + easy. +Qed. + +Lemma positive_semidefinite_unitary_conj : forall {n} (A U : Square n), + WF_Unitary U -> + positive_semidefinite A -> + positive_semidefinite (U† × A × U). +Proof. intros. + unfold positive_semidefinite in *. + intros. + replace ((z) † × ((U) † × A × U) × z) with (((z) † × (U†)) × A × (U × z)). + rewrite <- Mmult_adjoint. + apply H0. + destruct H; auto with wf_db. + repeat rewrite Mmult_assoc; easy. +Qed. + +Lemma positive_semidefinite_unitary_conj_conv : forall {n} (A U : Square n), + WF_Unitary U -> + positive_semidefinite (U† × A × U) -> + positive_semidefinite A. +Proof. intros. + unfold positive_semidefinite in *. + intros. + replace ((z) † × A × z) with (((U† × z)† × (U† × A × U) × (U† × z))). + apply H0. + destruct H; auto with wf_db. + distribute_adjoint. + rewrite adjoint_involutive. + destruct H. + apply Minv_flip in H2; auto with wf_db. + rewrite 3 Mmult_assoc, <- (Mmult_assoc _ _ z), H2, Mmult_1_l; auto. + rewrite <- 2 (Mmult_assoc U), H2, <- 2 Mmult_assoc, Mmult_1_r; auto with wf_db. +Qed. + Lemma pure_psd : forall (n : nat) (ϕ : Vector n), (WF_Matrix ϕ) -> positive_semidefinite (ϕ × ϕ†). Proof. intros n ϕ WFϕ z WFZ. @@ -1404,9 +1663,9 @@ Lemma braket1_psd : positive_semidefinite ∣1⟩⟨1∣. Proof. apply pure_psd. auto with wf_db. Qed. Lemma H0_psd : positive_semidefinite (hadamard × ∣0⟩⟨0∣ × hadamard). -Proof. +Proof. repeat rewrite Mmult_assoc. - rewrite <- hadamard_sa at 2. + rewrite <- hadamard_hermitian at 2. rewrite <- Mmult_adjoint. repeat rewrite <- Mmult_assoc. apply pure_psd. diff --git a/RowColOps.v b/RowColOps.v new file mode 100644 index 0000000..2127df7 --- /dev/null +++ b/RowColOps.v @@ -0,0 +1,3716 @@ +Require Import Psatz. +Require Import Reals. + +Require Export Matrix. + + + + +(** Here, we define many different types of row and column operations *) + + + + +Local Open Scope nat_scope. + + +(** * Defining matrix altering/col operations *) + +(* in what follows, T is a set of vectors, A is a square, v/as' are vectors/sets of scalars *) + +Definition get_col {m n} (T : Matrix m n) (i : nat) : Vector m := + fun x y => (if (y =? O) then T x i else C0). + +#[deprecated(note="Use get_col instead")] +Notation get_vec i S := (get_col S i) (only parsing). + +Definition get_row {m n} (T : Matrix m n) (i : nat) : Matrix 1 n := + fun x y => (if (x =? O) then T i y else C0). + +Definition reduce_row {m n} (T : Matrix (S m) n) (row : nat) : Matrix m n := + fun x y => if x if y if x (if x if j if j if i if (j =? x) + then T i y + else if (j =? y) + then T i x + else T i j. + +Definition row_swap {m n} (T : Matrix m n) (x y : nat) : Matrix m n := + fun i j => if (i =? x) + then T y j + else if (i =? y) + then T x j + else T i j. + +Definition col_scale {m n} (T : Matrix m n) (col : nat) (a : C) : Matrix m n := + fun i j => if (j =? col) + then (a * T i j)%C + else T i j. + +Definition row_scale {m n} (T : Matrix m n) (row : nat) (a : C) : Matrix m n := + fun i j => if (i =? row) + then (a * T i j)%C + else T i j. + +(* generalizations of col_scale and row_scale. Both sets of as' are vectors where the col/row + corresponds to the scaled col/row. Can also show that this is the same as multiplying + by the identity with scalars on diag *) +Definition col_scale_many {m n} (T : Matrix m n) (as' : Matrix 1 n) : Matrix m n := + fun i j => ((as' O j) * (T i j))%C. + +Definition row_scale_many {m n} (T : Matrix m n) (as' : Vector m) : Matrix m n := + fun i j => ((as' i O) * (T i j))%C. + +(* adding one column to another *) +Definition col_add {m n} (T : Matrix m n) (col to_add : nat) (a : C) : Matrix m n := + fun i j => if (j =? col) + then (T i j + a * T i to_add)%C + else T i j. + +(* adding one row to another *) +Definition row_add {m n} (T : Matrix m n) (row to_add : nat) (a : C) : Matrix m n := + fun i j => if (i =? row) + then (T i j + a * T to_add j)%C + else T i j. + +(* generalizing col_add *) +Definition gen_new_col (m n : nat) (T : Matrix m n) (as' : Vector n) : Vector m := + big_sum (fun i => (as' i O) .* (get_col T i)) n. + +Definition gen_new_row (m n : nat) (T : Matrix m n) (as' : Matrix 1 m) : Matrix 1 n := + big_sum (fun i => (as' O i) .* (get_row T i)) m. + +(* adds all columns to single column *) +Definition col_add_many {m n} (T : Matrix m n) (as' : Vector n) (col : nat) : Matrix m n := + fun i j => if (j =? col) + then (T i j + (gen_new_col m n T as') i O)%C + else T i j. + +Definition row_add_many {m n} (T : Matrix m n) (as' : Matrix 1 m) (row : nat) : Matrix m n := + fun i j => if (i =? row) + then (T i j + (gen_new_row m n T as') O j)%C + else T i j. + +(* adds single column to each other column *) +Definition col_add_each {m n} (T : Matrix m n) (as' : Matrix 1 n) (col : nat) : Matrix m n := + T .+ ((get_col T col) × as'). + +Definition row_add_each {m n} (T : Matrix m n) (as' : Vector m) (row : nat) : Matrix m n := + T .+ (as' × get_row T row). + +Definition make_col_val {m n} (T : Matrix m n) (col : nat) (a : C) : Matrix m n := + fun i j => if (j =? col) && (i if (i =? row) && (j if (j =? O) + then T i col + else if (j if (i =? O) + then T row j + else if (i if (j =? rep) + then T i col + else T i j. + +Definition row_replace {m n} (T : Matrix m n) (row rep : nat) : Matrix m n := + fun i j => if (i =? rep) + then T row j + else T i j. + + +(* using previous def's, takes matrix and increases its rank by 1 (assuming c <> 0) *) +Definition pad1 {m n : nat} (A : Matrix m n) (c : C) : Matrix (S m) (S n) := + col_wedge (row_wedge A Zero 0) (c .* e_i 0) 0. + + + + + + +(** * WF lemmas about these new operations *) + +Lemma WF_get_col : forall {m n} (i : nat) (T : Matrix m n), + WF_Matrix T -> WF_Matrix (get_col T i). +Proof. unfold WF_Matrix, get_col in *. + intros. + bdestruct (y =? 0); try lia; try easy. + apply H. + destruct H0. + left; easy. + lia. +Qed. + +Lemma WF_get_row : forall {m n} (i : nat) (T : Matrix m n), + WF_Matrix T -> WF_Matrix (get_row T i). +Proof. unfold WF_Matrix, get_row in *. + intros. + bdestruct (x =? 0); try lia; try easy. + apply H. + destruct H0. + lia. + right; easy. +Qed. + +Lemma WF_reduce_row : forall {m n} (row : nat) (T : Matrix (S m) n), + row < (S m) -> WF_Matrix T -> WF_Matrix (reduce_row T row). +Proof. unfold WF_Matrix, reduce_row. intros. + bdestruct (x b < c -> 1 + a < c). + { lia. } + apply (nibzo x row (S m)) in H2. + simpl in H2. lia. apply H. + + apply H0; auto. + - apply H0. destruct H1. + + left. simpl. lia. + + right. apply H1. +Qed. + +Lemma WF_reduce_col : forall {m n} (col : nat) (T : Matrix m (S n)), + col < (S n) -> WF_Matrix T -> WF_Matrix (reduce_col T col). +Proof. unfold WF_Matrix, reduce_col. intros. + bdestruct (y b < c -> 1 + a < c). + { lia. } + apply (nibzo y col (S n)) in H2. + simpl in H2. lia. apply H. + - apply H0. destruct H1. + + left. apply H1. + + right. simpl. lia. +Qed. + +Lemma rvn_is_rr_n : forall {n : nat} (v : Vector (S n)), + reduce_vecn v = reduce_row v n. +Proof. intros. + prep_matrix_equality. + unfold reduce_row, reduce_vecn. + easy. +Qed. + +Lemma WF_reduce_vecn : forall {n} (v : Vector (S n)), + n <> 0 -> WF_Matrix v -> WF_Matrix (reduce_vecn v). +Proof. intros. + rewrite rvn_is_rr_n. + apply WF_reduce_row; try lia; try easy. +Qed. + +Lemma get_minor_is_redrow_redcol : forall {m n} (A : Matrix (S m) (S n)) (row col : nat), + get_minor A row col = reduce_col (reduce_row A row) col. +Proof. intros. + prep_matrix_equality. + unfold get_minor, reduce_col, reduce_row. + bdestruct (x col < S n -> WF_Matrix A -> WF_Matrix (get_minor A row col). +Proof. intros. + rewrite get_minor_is_redrow_redcol. + apply WF_reduce_col; try easy. + apply WF_reduce_row; try easy. +Qed. + +Lemma WF_col_swap : forall {m n} (T : Matrix m n) (x y : nat), + x < n -> y < n -> WF_Matrix T -> WF_Matrix (col_swap T x y). +Proof. unfold WF_Matrix, col_swap in *. + intros. + bdestruct (y0 =? x); bdestruct (y0 =? y); destruct H2; try lia. + all : apply H1; try (left; apply H2). + auto. +Qed. + +Lemma WF_row_swap : forall {m n} (T : Matrix m n) (x y : nat), + x < m -> y < m -> WF_Matrix T -> WF_Matrix (row_swap T x y). +Proof. unfold WF_Matrix, row_swap in *. + intros. + bdestruct (x0 =? x); bdestruct (x0 =? y); destruct H2; try lia. + all : apply H1; try (right; apply H2). + auto. +Qed. + +Lemma WF_col_scale : forall {m n} (T : Matrix m n) (x : nat) (a : C), + WF_Matrix T -> WF_Matrix (col_scale T x a). +Proof. unfold WF_Matrix, col_scale in *. + intros. + apply H in H0. + rewrite H0. + rewrite Cmult_0_r. + bdestruct (y =? x); easy. +Qed. + +Lemma WF_row_scale : forall {m n} (T : Matrix m n) (x : nat) (a : C), + WF_Matrix T -> WF_Matrix (row_scale T x a). +Proof. unfold WF_Matrix, row_scale in *. + intros. + apply H in H0. + rewrite H0. + rewrite Cmult_0_r. + bdestruct (x0 =? x); easy. +Qed. + +Lemma WF_col_scale_many : forall {m n} (T : Matrix m n) (as' : Matrix m 1), + WF_Matrix T -> WF_Matrix (col_scale_many T as'). +Proof. unfold WF_Matrix, col_scale_many in *. + intros. + apply H in H0. + rewrite H0. + rewrite Cmult_0_r; easy. +Qed. + +Lemma WF_row_scale_many : forall {m n} (T : Matrix m n) (as' : Vector n), + WF_Matrix T -> WF_Matrix (row_scale_many T as'). +Proof. unfold WF_Matrix, row_scale_many in *. + intros. + apply H in H0. + rewrite H0. + rewrite Cmult_0_r; easy. +Qed. + +Lemma WF_col_add : forall {m n} (T : Matrix m n) (x y : nat) (a : C), + x < n -> WF_Matrix T -> WF_Matrix (col_add T x y a). +Proof. unfold WF_Matrix, col_add in *. + intros. + bdestruct (y0 =? x); destruct H1; try lia. + do 2 (rewrite H0; auto). ring. + all : apply H0; auto. +Qed. + +Lemma WF_row_add : forall {m n} (T : Matrix m n) (x y : nat) (a : C), + x < m -> WF_Matrix T -> WF_Matrix (row_add T x y a). +Proof. unfold WF_Matrix, row_add in *. + intros. + bdestruct (x0 =? x); destruct H1; try lia. + do 2 (rewrite H0; auto). ring. + all : apply H0; auto. +Qed. + +Lemma WF_gen_new_col : forall {m n} (T : Matrix m n) (as' : Vector n), + WF_Matrix T -> WF_Matrix (gen_new_col m n T as'). +Proof. intros. + unfold gen_new_col. + apply WF_Msum; intros. + apply WF_scale. + apply WF_get_col. + easy. +Qed. + +Lemma WF_gen_new_row : forall {m n} (T : Matrix m n) (as' : Matrix 1 m), + WF_Matrix T -> WF_Matrix (gen_new_row m n T as'). +Proof. intros. + unfold gen_new_row. + apply WF_Msum; intros. + apply WF_scale. + apply WF_get_row. + easy. +Qed. + +Lemma WF_col_add_many : forall {m n} (T : Matrix m n) (as' : Vector n) (col : nat), + col < n -> WF_Matrix T -> WF_Matrix (col_add_many T as' col). +Proof. unfold WF_Matrix, col_add_many. + intros. + bdestruct (y =? col). + assert (H4 := (WF_gen_new_col T as')). + rewrite H4, H0; try easy. + ring. destruct H2; lia. + rewrite H0; easy. +Qed. + +Lemma WF_row_add_many : forall {m n} (T : Matrix m n) (as' : Matrix 1 m) (row : nat), + row < m -> WF_Matrix T -> WF_Matrix (row_add_many T as' row). +Proof. unfold WF_Matrix, row_add_many. + intros. + bdestruct (x =? row). + assert (H4 := (WF_gen_new_row T as')). + rewrite H4, H0; try easy. + ring. destruct H2; lia. + rewrite H0; easy. +Qed. + +Lemma WF_col_wedge : forall {m n} (T : Matrix m n) (v : Vector m) (spot : nat), + spot <= n -> WF_Matrix T -> WF_Matrix v -> WF_Matrix (col_wedge T v spot). +Proof. unfold WF_Matrix in *. + intros; destruct H2 as [H2 | H2]. + - unfold col_wedge. + rewrite H0, H1; try lia. + rewrite H0; try lia. + bdestruct (y WF_Matrix T -> WF_Matrix v -> WF_Matrix (row_wedge T v spot). +Proof. unfold WF_Matrix in *. + intros; destruct H2 as [H2 | H2]. + - unfold row_wedge. + bdestruct (x WF_Matrix T2 -> WF_Matrix (smash T1 T2). +Proof. unfold WF_Matrix, smash in *. + intros. + bdestruct (y WF_Matrix as' -> WF_Matrix (col_add_each T as' col). +Proof. intros. + unfold col_add_each. + apply WF_plus; try easy; + apply WF_mult; try easy; + apply WF_get_col; easy. +Qed. + +Lemma WF_row_add_each : forall {m n} (row : nat) (as' : Vector m) (T : Matrix m n), + WF_Matrix T -> WF_Matrix as' -> WF_Matrix (row_add_each T as' row). +Proof. intros. + unfold row_add_each. + apply WF_plus; try easy; + apply WF_mult; try easy; + apply WF_get_row; easy. +Qed. + +Lemma WF_make_col_val : forall {m n} (T : Matrix m n) (col : nat) (a : C), + col < n -> + WF_Matrix T -> WF_Matrix (make_col_val T col a). +Proof. unfold make_col_val, WF_Matrix. + intros. + bdestruct_all; simpl; rewrite H0; try easy. +Qed. + +Lemma WF_make_row_val : forall {m n} (T : Matrix m n) (row : nat) (a : C), + row < m -> + WF_Matrix T -> WF_Matrix (make_row_val T row a). +Proof. unfold make_row_val, WF_Matrix. + intros. + bdestruct_all; simpl; rewrite H0; try easy. +Qed. + +Lemma WF_col_to_front : forall {m n} (T : Matrix m n) (col : nat), + col < n -> + WF_Matrix T -> + WF_Matrix (col_to_front T col). +Proof. intros. + unfold WF_Matrix, col_to_front; intros. + bdestruct_all; apply H0; lia. +Qed. + +Lemma WF_row_to_front : forall {m n} (T : Matrix m n) (row : nat), + row < m -> + WF_Matrix T -> + WF_Matrix (row_to_front T row). +Proof. intros. + unfold WF_Matrix, row_to_front; intros. + bdestruct_all; apply H0; lia. +Qed. + +Lemma WF_col_replace : forall {m n} (T : Matrix m n) (col rep : nat), + rep < n -> + WF_Matrix T -> + WF_Matrix (col_replace T col rep). +Proof. intros. + unfold WF_Matrix, col_replace; intros. + bdestruct_all; apply H0; lia. +Qed. + +Lemma WF_row_replace : forall {m n} (T : Matrix m n) (row rep : nat), + rep < m -> + WF_Matrix T -> + WF_Matrix (row_replace T row rep). +Proof. intros. + unfold WF_Matrix, row_replace; intros. + bdestruct_all; apply H0; lia. +Qed. + + + +#[export] Hint Resolve WF_get_col WF_get_row WF_reduce_row WF_reduce_col WF_reduce_vecn WF_get_minor : wf_db. +#[export] Hint Resolve WF_row_append WF_col_append WF_row_wedge WF_col_wedge WF_smash : wf_db. +#[export] Hint Resolve WF_col_swap WF_row_swap WF_col_scale WF_row_scale WF_col_add WF_row_add : wf_db. +#[export] Hint Resolve WF_gen_new_col WF_gen_new_row WF_col_add_many WF_row_add_many : wf_db. +#[export] Hint Resolve WF_col_scale_many WF_row_scale_many WF_col_add_each WF_row_add_each : wf_db. +#[export] Hint Resolve WF_make_col_val WF_make_row_val WF_col_to_front WF_row_to_front + col_replace row_replace: wf_db. + +#[export] Hint Extern 1 (Nat.lt _ _) => lia : wf_db. +#[export] Hint Extern 1 (Nat.le _ _) => lia : wf_db. +#[export] Hint Extern 1 (lt _ _) => lia : wf_db. +#[export] Hint Extern 1 (le _ _) => lia : wf_db. + +Lemma WF_pad1 : forall {m n : nat} (A : Matrix m n) (c : C), + WF_Matrix A -> WF_Matrix (pad1 A c). +Proof. intros. + unfold pad1; auto with wf_db. +Qed. + +Lemma WF_pad1_conv : forall {m n : nat} (A : Matrix m n) (c : C), + WF_Matrix (pad1 A c) -> WF_Matrix A. +Proof. intros. + unfold pad1, WF_Matrix, col_wedge, row_wedge, e_i in *. + intros. + rewrite <- (H (S x) (S y)); try lia. + bdestruct (S y get_col (reduce_col T col) i = get_col T i. +Proof. intros. + prep_matrix_equality. + unfold get_col, reduce_col. + bdestruct (i A = B. +Proof. intros. prep_matrix_equality. + rewrite <- get_col_conv. + rewrite <- (get_col_conv _ _ B). + rewrite H. + reflexivity. +Qed. + +Lemma get_col_reduce_wedge_miss : forall {m n} (T : Matrix m (S n)) (v : Vector m) (i : nat), + i < n -> get_col (col_wedge (reduce_col T n) v n) i = get_col T i. +Proof. intros. + prep_matrix_equality. + unfold get_col, col_wedge, reduce_col. + bdestruct_all; easy. +Qed. + +#[deprecated(note="Use get_col_reduce_wedge_miss instead")] +Notation get_col_reduce_append_miss := get_col_reduce_wedge_miss (only parsing). + +Lemma get_col_reduce_wedge_hit : forall {m n} (T : Matrix m (S n)) (v : Vector m), + WF_Matrix v -> get_col (col_wedge (reduce_col T n) v n) n = v. +Proof. intros. + unfold get_col, col_wedge, reduce_col. + prep_matrix_equality. + bdestruct (y =? 0). + - bdestruct_all; subst; easy. + - rewrite H; try lia; easy. +Qed. + +#[deprecated(note="Use get_col_reduce_wedge_hit instead")] +Notation get_col_reduce_append_hit := get_col_reduce_wedge_hit (only parsing). + + +Lemma get_col_over : forall {m n} (T : Matrix m (S n)) (i : nat), + WF_Matrix T -> i > n -> + get_col T i = Zero. +Proof. intros. + prep_matrix_equality. + unfold get_col. + bdestruct_all; try easy. + rewrite H. easy. + right. lia. +Qed. + +Lemma get_col_col_scale_many : forall {m n} (T : Matrix m n) (as' : Matrix 1 n) (i : nat), + get_col (col_scale_many T as') i = as' O i .* get_col T i. +Proof. intros. + unfold get_col, col_scale_many, scale. + prep_matrix_equality. + bdestruct_all; lca. +Qed. + +Lemma get_row_row_scale_many : forall {m n} (T : Matrix m n) (as' : Vector m) (i : nat), + get_row (row_scale_many T as') i = as' i O .* get_row T i. +Proof. intros. + unfold get_row, row_scale_many, scale. + prep_matrix_equality. + bdestruct_all; lca. +Qed. + + +Lemma col_scale_reduce_col_same : forall {m n} (T : Matrix m (S n)) (y col : nat) (a : C), + y = col -> reduce_col (col_scale T col a) y = reduce_col T y. +Proof. intros. + prep_matrix_equality. + unfold reduce_col, col_scale. + bdestruct (y0 col < (S c2) -> + get_minor (col_swap A (S c1) (S c2)) row col = col_swap (get_minor A row col) c1 c2. +Proof. intros. + prep_matrix_equality. + unfold get_minor, col_swap. + bdestruct (c1 get_minor (col_scale A col a) x y = col_scale (get_minor A x y) (col - 1) a. +Proof. intros. + prep_matrix_equality. + destruct col; try lia. + rewrite Sn_minus_1. + unfold get_minor, col_scale. + bdestruct (x0 get_minor (col_scale A col a) x y = get_minor A x y. +Proof. intros. + prep_matrix_equality. + unfold get_minor, col_scale. + bdestruct (x0 col -> get_minor (col_scale A col a) x y = col_scale (get_minor A x y) col a. +Proof. intros. + prep_matrix_equality. + unfold get_minor, col_scale. + bdestruct (x0 get_minor (row_scale A row a) x y = row_scale (get_minor A x y) (row - 1) a. +Proof. intros. + prep_matrix_equality. + destruct row; try lia. + rewrite Sn_minus_1. + unfold get_minor, row_scale. + bdestruct_all; simpl; easy. +Qed. + +Lemma row_scale_get_minor_same : forall {n : nat} (A : Square (S n)) (x y row : nat) (a : C), + x = row -> get_minor (row_scale A row a) x y = get_minor A x y. +Proof. intros. + prep_matrix_equality. + unfold get_minor, row_scale. + bdestruct_all; simpl; easy. +Qed. + +Lemma row_scale_get_minor_after : forall {n : nat} (A : Square (S n)) (x y row : nat) (a : C), + x > row -> get_minor (row_scale A row a) x y = row_scale (get_minor A x y) row a. +Proof. intros. + prep_matrix_equality. + unfold get_minor, row_scale. + bdestruct_all; simpl; easy. +Qed. + +Lemma mcv_reduce_col_same : forall {m n} (T : Matrix m (S n)) (col : nat) (a : C), + reduce_col (make_col_val T col a) col = reduce_col T col. +Proof. intros. + prep_matrix_equality. + unfold reduce_col, make_col_val. + bdestruct (y + T = Zero. +Proof. intros. + prep_matrix_equality. + unfold col_wedge in H. + apply (f_equal_inv x) in H. + bdestruct (y + T = Zero. +Proof. intros. + prep_matrix_equality. + unfold row_wedge in H. + bdestruct (x x -> i <> y -> + get_col (col_swap T x y) i = get_col T i. +Proof. intros. + prep_matrix_equality. + unfold get_col, col_swap. + bdestruct_all; easy. +Qed. + +Lemma col_swap_three : forall {m n} (T : Matrix m n) (x y z : nat), + x <> z -> y <> z -> col_swap T x z = col_swap (col_swap (col_swap T x y) y z) x y. +Proof. intros. + bdestruct (x =? y). + rewrite H1, col_swap_same, col_swap_same. + easy. + prep_matrix_equality. + unfold col_swap. + bdestruct (y =? y); bdestruct (y =? x); bdestruct (y =? z); try lia. + bdestruct (x =? y); bdestruct (x =? x); bdestruct (x =? z); try lia. + bdestruct (z =? y); bdestruct (z =? x); try lia. + bdestruct (y0 =? y); bdestruct (y0 =? x); bdestruct (y0 =? z); + try lia; try easy. + rewrite H10. + easy. +Qed. + +Lemma col_to_front_swap_col : forall {m n} (T : Matrix m n) (col : nat), + (S col) < n -> + col_to_front T (S col) = col_to_front (col_swap T col (S col)) col. +Proof. intros. + unfold col_to_front, col_swap. + prep_matrix_equality. + bdestruct_all; auto; subst. + replace (S col - 1)%nat with col by lia. + easy. +Qed. + +Lemma row_to_front_swap_row : forall {m n} (T : Matrix m n) (row : nat), + (S row) < m -> + row_to_front T (S row) = row_to_front (row_swap T row (S row)) row. +Proof. intros. + unfold row_to_front, row_swap. + prep_matrix_equality. + bdestruct_all; auto; subst. + replace (S row - 1)%nat with row by lia. + easy. +Qed. + + +Lemma col_to_front_0 : forall {m n} (T : Matrix m n), + col_to_front T 0 = T. +Proof. intros. + unfold col_to_front. + prep_matrix_equality. + bdestruct_all; subst; easy. +Qed. + +Lemma row_to_front_0 : forall {m n} (T : Matrix m n), + row_to_front T 0 = T. +Proof. intros. + unfold row_to_front. + prep_matrix_equality. + bdestruct_all; subst; easy. +Qed. + +Lemma reduce_wedge_split_0 : forall {m n} (T : Matrix m (S n)), + WF_Matrix T -> T = col_wedge (reduce_col T O) (get_col T O) O. +Proof. intros. + prep_matrix_equality. + unfold col_wedge, get_col, reduce_col. + bdestruct_all; subst; try easy. + replace (1 + (y - 1)) with y by lia. + easy. +Qed. + +Lemma reduce_wedge_split_n : forall {m n} (T : Matrix m (S n)), + WF_Matrix T -> T = col_wedge (reduce_col T n) (get_col T n) n. +Proof. intros. + prep_matrix_equality. + unfold col_wedge, get_col, reduce_col. + bdestruct_all; subst; try easy. + do 2 (rewrite H; try lia); easy. +Qed. + +#[deprecated(note="Use reduce_wedge_split_n instead")] + Notation reduce_append_split := reduce_wedge_split_n (only parsing). + +(* the dimensions don't match, so this is a bit weird *) +Lemma smash_zero : forall {m n} (T : Matrix m n) (i : nat), + WF_Matrix T -> smash T (@Zero m i) = T. +Proof. intros. + prep_matrix_equality. + unfold smash, Zero. + bdestruct (y WF_Matrix v -> + col_wedge T v n = smash T v. +Proof. intros. + unfold smash, col_wedge, WF_Matrix in *. + prep_matrix_equality. + bdestruct (y =? n); bdestruct (y + reduce_col (reduce_col T i) (j - 1) = reduce_col (reduce_col T j) i. +Proof. intros. + destruct j; try lia. + replace (S j - 1) with j by lia. + prep_matrix_equality. + unfold reduce_col. + bdestruct_all; easy. +Qed. + +Lemma get_minor_2x_0 : forall {n} (A : Square (S (S n))) (x y : nat), + x <= y -> + (get_minor (get_minor A x 0) y 0) = (get_minor (get_minor A (S y) 0) x 0). +Proof. intros. + prep_matrix_equality. + unfold get_minor. + bdestruct (y0 0 -> i <> j -> col_swap (col_add (col_swap A j 0) 0 i c) j 0 = col_add A j i c. +Proof. intros. + bdestruct (j =? 0). + - rewrite H1. + do 2 rewrite col_swap_same; easy. + - prep_matrix_equality. + unfold col_swap, col_add. + bdestruct (y =? j); bdestruct (j =? j); try lia; simpl. + destruct j; try lia. + bdestruct (i =? S j); bdestruct (i =? 0); try lia. + rewrite H2; easy. + bdestruct (y =? 0); bdestruct (j =? 0); try easy. + rewrite H4; easy. +Qed. + +Lemma col_swap_col_add_0 : forall {n} (A : Square n) (j : nat) (c : C), + j <> 0 -> col_swap (col_add (col_swap A j 0) 0 j c) j 0 = col_add A j 0 c. +Proof. intros. + prep_matrix_equality. + unfold col_swap, col_add. + bdestruct (y =? j); bdestruct (j =? j); bdestruct (0 =? j); try lia; simpl. + rewrite H0; easy. + bdestruct (y =? 0); bdestruct (j =? 0); try easy. + rewrite H3; easy. +Qed. + +Lemma col_swap_end_reduce_col_hit : forall {m n} (T : Matrix n (S (S m))) (i : nat), + i <= m -> col_swap (reduce_col T i) m i = reduce_col (col_swap T (S m) (S i)) i. +Proof. intros. + prep_matrix_equality. + unfold reduce_col, col_swap. + bdestruct (i C0 -> S = col_scale (col_scale S x a) x (/ a). +Proof. intros. + prep_matrix_equality. + unfold col_scale. + bdestruct (y =? x); try easy. + rewrite Cmult_assoc. + rewrite Cinv_l; try lca; easy. +Qed. + +Lemma row_scale_inv : forall {n m : nat} (S : Matrix n m) (x : nat) (a : C), + a <> C0 -> S = row_scale (row_scale S x a) x (/ a). +Proof. intros. + prep_matrix_equality. + unfold row_scale. + bdestruct (x0 =? x); try easy. + rewrite Cmult_assoc. + rewrite Cinv_l; try lca; easy. +Qed. + + +Lemma col_add_double : forall {m n} (T : Matrix m n) (x : nat) (a : C), + col_add T x x a = col_scale T x (C1 + a)%C. +Proof. intros. + prep_matrix_equality. + unfold col_add, col_scale. + bdestruct (y =? x). + - rewrite H; ring. + - easy. +Qed. + +Lemma row_add_double : forall {m n} (T : Matrix m n) (x : nat) (a : C), + row_add T x x a = row_scale T x (C1 + a)%C. +Proof. intros. + prep_matrix_equality. + unfold row_add, row_scale. + bdestruct (x0 =? x). + - rewrite H; ring. + - easy. +Qed. + +Lemma col_add_swap : forall {m n} (T : Matrix m n) (x y : nat) (a : C), + col_swap (col_add T x y a) x y = col_add (col_swap T x y) y x a. +Proof. intros. + prep_matrix_equality. + unfold col_swap, col_add. + bdestruct (y0 =? x); bdestruct (y =? x); + bdestruct (y0 =? y); bdestruct (x =? x); try lia; easy. +Qed. + +Lemma row_add_swap : forall {m n} (T : Matrix m n) (x y : nat) (a : C), + row_swap (row_add T x y a) x y = row_add (row_swap T x y) y x a. +Proof. intros. + prep_matrix_equality. + unfold row_swap, row_add. + bdestruct_all; easy. +Qed. + +Lemma col_add_inv : forall {m n} (T : Matrix m n) (x y : nat) (a : C), + x <> y -> T = col_add (col_add T x y a) x y (-a). +Proof. intros. + prep_matrix_equality. + unfold col_add. + bdestruct (y0 =? x); bdestruct (y =? x); try lia. + ring. easy. +Qed. + +Lemma row_add_inv : forall {m n} (T : Matrix m n) (x y : nat) (a : C), + x <> y -> T = row_add (row_add T x y a) x y (-a). +Proof. intros. + prep_matrix_equality. + unfold row_add. + bdestruct (x0 =? x); bdestruct (y =? x); try lia. + ring. easy. +Qed. + +Lemma col_swap_make_WF : forall {m n} (T : Matrix m n) (x y : nat), + x < n -> y < n -> col_swap (make_WF T) x y = make_WF (col_swap T x y). +Proof. intros. + unfold make_WF, col_swap. + prep_matrix_equality. + bdestruct_all; try easy. +Qed. + +Lemma col_scale_make_WF : forall {m n} (T : Matrix m n) (x : nat) (c : C), + col_scale (make_WF T) x c = make_WF (col_scale T x c). +Proof. intros. + unfold make_WF, col_scale. + prep_matrix_equality. + bdestruct_all; try easy; simpl; ring. +Qed. + +Lemma scalar_make_WF : forall {m n} (T : Matrix m n) (c : C), + c .* (make_WF T) = make_WF (c .* T). +Proof. intros. + unfold scale, make_WF. + prep_matrix_equality. + bdestruct_all; simpl; ring. +Qed. + +Lemma col_add_make_WF : forall {m n} (T : Matrix m n) (x y : nat) (c : C), + x < n -> y < n -> col_add (make_WF T) x y c = make_WF (col_add T x y c). +Proof. intros. + unfold make_WF, col_add. + prep_matrix_equality. + bdestruct_all; try easy; simpl; ring. +Qed. + +Lemma transpose_make_WF : forall {m n} (T : Matrix m n), + (make_WF T) ⊤ = make_WF (T⊤). +Proof. intros. + unfold transpose, make_WF. + prep_matrix_equality. + bdestruct_all; simpl; ring. +Qed. + +Lemma gen_new_vec_0 : forall {m n} (T : Matrix m n) (as' : Vector n), + as' == Zero -> gen_new_col m n T as' = Zero. +Proof. intros. + unfold mat_equiv, gen_new_col in *. + prep_matrix_equality. + rewrite Msum_Csum. + unfold Zero in *. + apply (@big_sum_0_bounded); intros. + rewrite H; try lia. + rewrite Mscale_0_l. + easy. +Qed. + +Lemma gen_new_row_0 : forall {m n} (T : Matrix m n) (as' : Matrix 1 m), + as' == Zero -> gen_new_row m n T as' = Zero. +Proof. intros. + unfold mat_equiv, gen_new_row in *. + prep_matrix_equality. + rewrite Msum_Csum. + unfold Zero in *. + apply (@big_sum_0_bounded); intros. + rewrite H; try lia. + rewrite Mscale_0_l. + easy. +Qed. + +Lemma col_add_many_0 : forall {m n} (T : Matrix m n) (as' : Vector n) (col : nat), + as' == Zero -> T = col_add_many T as' col. +Proof. intros. + unfold col_add_many in *. + prep_matrix_equality. + bdestruct (y =? col); try easy. + rewrite gen_new_vec_0; try easy. + unfold Zero; ring. +Qed. + +Lemma row_add_many_0 : forall {m n} (T : Matrix m n) (as' : Matrix 1 m) (row : nat), + as' == Zero -> T = row_add_many T as' row. +Proof. intros. + unfold row_add_many in *. + prep_matrix_equality. + bdestruct (x =? row); try easy. + rewrite gen_new_row_0; try easy. + unfold Zero; ring. +Qed. + +Lemma gen_new_vec_mat_equiv : forall {m n} (T : Matrix m n) (as' bs : Vector n), + as' == bs -> gen_new_col m n T as' = gen_new_col m n T bs. +Proof. unfold mat_equiv, gen_new_col; intros. + prep_matrix_equality. + do 2 rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + rewrite H; try lia. + easy. +Qed. + +Lemma gen_new_row_mat_equiv : forall {m n} (T : Matrix m n) (as' bs : Matrix 1 m), + as' == bs -> gen_new_row m n T as' = gen_new_row m n T bs. +Proof. unfold mat_equiv, gen_new_row; intros. + prep_matrix_equality. + do 2 rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + rewrite H; try lia. + easy. +Qed. + +Lemma col_add_many_mat_equiv : forall {m n} (T : Matrix m n) (as' bs : Vector n) (col : nat), + as' == bs -> col_add_many T as' col = col_add_many T bs col. +Proof. intros. + unfold col_add_many. + rewrite (gen_new_vec_mat_equiv _ as' bs); easy. +Qed. + +Lemma row_add_many_mat_equiv : forall {m n} (T : Matrix m n) (as' bs : Matrix 1 m) (row : nat), + as' == bs -> row_add_many T as' row = row_add_many T bs row. +Proof. intros. + unfold row_add_many. + rewrite (gen_new_row_mat_equiv _ as' bs); easy. +Qed. + +Lemma col_add_each_0 : forall {m n} (T : Matrix m n) (v : Matrix 1 n) (col : nat), + v = Zero -> T = col_add_each T v col. +Proof. intros. + rewrite H. + unfold col_add_each. + rewrite Mmult_0_r; auto. + erewrite Mplus_0_r; auto. +Qed. + +Lemma row_add_each_0 : forall {m n} (T : Matrix m n) (v : Vector m) (row : nat) , + v = Zero -> T = row_add_each T v row. +Proof. intros. + rewrite H. + unfold row_add_each. + rewrite Mmult_0_l; auto. + erewrite Mplus_0_r; auto. +Qed. + + +(* TODO: this should have just been the origional definition... *) +Lemma gen_new_col_is_mul : forall {m n} (T : Matrix m n) (as' : Vector n), + WF_Matrix as' -> + gen_new_col m n T as' = T × as'. +Proof. intros. + prep_matrix_equality. + unfold Mmult, gen_new_col. + rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + unfold scale, get_col. + bdestruct_all; subst. ring. + rewrite (H x0 y); try ring. + right; try lia. +Qed. + +Lemma gen_new_row_is_mul : forall {m n} (T : Matrix m n) (as' : Matrix 1 m), + WF_Matrix as' -> + gen_new_row m n T as' = as' × T. +Proof. intros. + prep_matrix_equality. + unfold Mmult, gen_new_row. + rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + unfold scale, get_row. + bdestruct_all; subst. ring. + rewrite (H x x0); try ring. + left; try lia. +Qed. + + + +Lemma col_add_many_mul : forall {m n} (T : Matrix m n) (as' : Vector n) (i col : nat), + i < m -> + col < n -> + ((T × as')) i O = + (col_add_many + (col_scale T col (as' col O)) + (make_row_val as' col C0) + col) i col. +Proof. intros. + unfold col_add_many, Mmult, col_scale, make_row_val, gen_new_col. + rewrite Msum_Csum. + bdestruct_all. + destruct n; try lia. + replace (S n) with (col + 1 + (n - col)) by lia. + repeat rewrite big_sum_sum; simpl. + repeat rewrite Cplus_0_l. + rewrite Cplus_assoc, Nat.add_0_r. + rewrite (Cplus_comm _ (T i col * as' col O))%C. + rewrite <- 2 Cplus_assoc. + apply f_equal_gen; try apply f_equal. + ring. + apply f_equal_gen; try apply f_equal; auto. + bdestruct_all; simpl. + unfold scale, make_row_val, scale. + rewrite Cmult_0_l, Cplus_0_r. + apply big_sum_eq_bounded; intros. + unfold get_col; simpl. + bdestruct_all; simpl; ring. + apply big_sum_eq_bounded; intros. + unfold scale, get_col. + bdestruct_all; simpl. + ring. +Qed. + + +(* lemmas about operations w.r.t.involving adjoint *) + +Lemma col_swap_adjoint : forall {m n} (T : Matrix m n) (x y : nat), + col_swap (adjoint T) x y = adjoint (row_swap T x y). +Proof. intros. + unfold adjoint, col_swap, row_swap. + prep_matrix_equality. + bdestruct_all; easy. +Qed. + +Lemma row_swap_adjoint : forall {m n} (T : Matrix m n) (x y : nat), + row_swap (adjoint T) x y = adjoint (col_swap T x y). +Proof. intros. + unfold adjoint, col_swap, row_swap. + prep_matrix_equality. + bdestruct_all; easy. +Qed. + + +(* +(** * building up machinery to undo scaling *) + +Local Open Scope group_scope. + +(* v is thought of as a vector here, but is defined as a matrix so we dont need to use + get_row *) +Fixpoint get_common_multiple (m n : nat) (v : Matrix m n) : F := + match n with + | O => 1 + | S n' => + match (Geq_dec (v O n') 0) with + | left _ => get_common_multiple m n' (reduce_col v n') + | right _ => (v O n') * (get_common_multiple m n' (reduce_col v n')) + end + end. + +Arguments get_common_multiple {m n}. + + +Lemma gcm_simplify_eq_0 : forall {m n} (v : Matrix m (S n)), + v O n = 0 -> + get_common_multiple v = get_common_multiple (reduce_col v n). +Proof. intros. + simpl. + destruct (Geq_dec (v O n) C0); try easy. +Qed. + +Lemma gcm_simplify_neq_0 : forall {m n} (v : Matrix m (S n)), + v O n <> 0 -> + get_common_multiple v = v O n * get_common_multiple (reduce_col v n). +Proof. intros. + simpl. + destruct (Geq_dec (v O n) C0); try easy. +Qed. + + +Lemma gcm_mat_equiv : forall {m n} (v1 v2 : Matrix m n), + get_row v1 O ≡ get_row v2 O -> + get_common_multiple v1 = get_common_multiple v2. +Proof. induction n; intros. + - easy. + - simpl. + assert (H' : forall i, i < S n -> v1 O i = v2 O i). + { intros. + unfold mat_equiv in H. + apply (H O i) in H0; auto. } + rewrite H', (IHn _ (reduce_col v2 n)); try lia; auto. + unfold mat_equiv, get_row, reduce_col in *; intros. + apply (H _ j) in H0; try lia. + bdestruct_all; easy. +Qed. + +Lemma gcm_reduce_col_nonzero : forall {m n} (v : Matrix m (S n)) (i : nat), + i < S n -> v O i <> 0 -> + get_common_multiple v = v O i * get_common_multiple (reduce_col v i). +Proof. induction n; intros. + - destruct i; try lia. + rewrite <- gcm_simplify_neq_0; easy. + - bdestruct (i =? S n); subst. + + rewrite <- gcm_simplify_neq_0; auto. + + destruct (Geq_dec (v O (S n)) 0). + * rewrite gcm_simplify_eq_0; auto. + rewrite (IHn _ i); try lia. + apply f_equal_gen; try apply f_equal. + unfold reduce_col. + bdestruct (i v O i = 0 -> + get_common_multiple v = get_common_multiple (reduce_col v i). +Proof. induction n; intros. + - destruct i; try lia. + rewrite <- gcm_simplify_eq_0; easy. + - bdestruct (i =? S n); subst. + + rewrite <- gcm_simplify_eq_0; auto. + + destruct (Geq_dec (v O (S n)) 0). + * rewrite gcm_simplify_eq_0; auto. + rewrite (IHn _ i); try lia. + rewrite (IHn _ n); try lia. + rewrite <- reduce_col_2x; try lia. + replace (S n - 1)%nat with n by lia. + easy. + all : unfold reduce_col; + bdestruct_all; try lia; simpl; easy. + * rewrite gcm_simplify_neq_0; auto. + rewrite (IHn _ i); try lia. + rewrite gcm_simplify_neq_0. + apply f_equal_gen; try apply f_equal. + unfold reduce_col. + bdestruct_all; simpl; try lia; ring. + rewrite <- reduce_col_2x; try lia. + replace (S n - 1)%nat with n by lia; easy. + all : unfold reduce_col; + bdestruct_all; try lia; simpl; easy. +Qed. + +Lemma gcm_breakdown : forall {m n} (v : Matrix m (S n)) (i : nat), + i < S n -> + get_common_multiple v = + get_common_multiple (get_col v i) * get_common_multiple (reduce_col v i). +Proof. intros. + simpl. + replace (get_col v i O O) with (v O i). + destruct (Geq_dec (v O i) 0). + - rewrite <- (gcm_reduce_col_zero _ i); auto. + simpl; ring. + - rewrite Cmult_1_r, <- (gcm_reduce_col_nonzero _ i); auto. + - unfold get_col; easy. +Qed. + + +Lemma gcm_col_swap_le : forall {m n} (v : Matrix m (S n)) (i j : nat), + i < j -> j < S n -> + get_common_multiple v = get_common_multiple (col_swap v i j). +Proof. intros. + destruct n. + destruct i; destruct j; try lia. + rewrite (gcm_breakdown _ i); try lia. + rewrite (gcm_breakdown (reduce_col v i) (j - 1)); try lia. + rewrite (gcm_breakdown (col_swap v i j) i); try lia. + rewrite (gcm_breakdown (reduce_col (col_swap v i j) i) (j - 1)); try lia. + replace (reduce_col (reduce_col (col_swap v i j) i) (j - 1)) with + (reduce_col (reduce_col v i) (j - 1)). + do 2 rewrite Cmult_assoc. + apply f_equal_gen; try apply f_equal; auto. + rewrite Cmult_comm. + apply f_equal_gen; repeat try apply f_equal. + all : unfold get_col, reduce_col, col_swap; + prep_matrix_equality; + bdestruct_all; auto. + replace (1 + (j - 1))%nat with j by lia. + easy. +Qed. + +Lemma gcm_col_swap : forall {m n} (v : Matrix m (S n)) (i j : nat), + i < S n -> j < S n -> + get_common_multiple v = get_common_multiple (col_swap v i j). +Proof. intros. + bdestruct (i Zero + | S n' => (fun i j => @get_common_multiple 1 n' (reduce_col as' j)) + end. + + +Lemma csm_to_scalar_ver : forall {n} (as' : Matrix 1 n) (i j : nat), + i < n -> j < n -> + as' O i <> 0 -> as' O j <> 0 -> + as' O i * csm_to_scalar as' O i = as' O j * csm_to_scalar as' O j. +Proof. intros. + destruct n; try lia; simpl. + rewrite <- 2 gcm_reduce_col_nonzero; auto. +Qed. + +*) + + +(** * more complicated lemmas/proofs as we begin to show the correspondence of the operations with matrix multiplication *) + + +Lemma col_scale_many_col_scale : forall {m n} (T : Matrix m n) (as' : Matrix 1 n) (e : nat), + col_scale_many T as' = col_scale (col_scale_many T (make_col_val as' e C1)) e (as' 0 e). +Proof. intros. + unfold col_scale_many, col_scale, make_col_val. + prep_matrix_equality. + bdestruct_all; simpl; subst; try ring. +Qed. + + +Lemma col_scale_scalar : forall {m n} (T : Matrix m n) (x : nat) (a : C), + a .* T = col_scale_many (col_scale T x a) (fun i j => if (j =? x) then C1 else a). +Proof. intros. + prep_matrix_equality. + unfold col_scale, col_scale_many, scale. + bdestruct (y =? x); try easy. + ring. +Qed. + +Lemma row_scale_scalar : forall {m n} (T : Matrix m n) (x : nat) (a : C), + a .* T = row_scale_many (row_scale T x a) (fun i j => if (i =? x) then C1 else a). +Proof. intros. + prep_matrix_equality. + unfold row_scale, row_scale_many, scale. + bdestruct (x0 =? x); try easy. + ring. +Qed. + +(* +Lemma col_scale_many_scalar : forall {m n} (T : Matrix m n) (as' : Matrix 1 n), + WF_Matrix T -> + (forall j, j < n -> as' O j <> 0) -> + (as' O O * csm_to_scalar as' O O) .* T = + col_scale_many (col_scale_many T as') (csm_to_scalar as'). +Proof. intros. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + destruct n; try lia. + unfold col_scale_many, scale. + rewrite (csm_to_scalar_ver _ O j); try lia; auto. + ring. + apply H0; lia. +Qed. +*) + +Local Open Scope nat_scope. + + +(* allows for induction on col_add_many *) +Lemma col_add_many_col_add : forall {m n} (T : Matrix m n) (as' : Vector n) (col e : nat), + col <> e -> e < n -> as' col 0 = C0 -> + col_add_many T as' col = + col_add (col_add_many T (make_row_val as' e C0) col) col e (as' e 0). +Proof. intros. + unfold col_add_many, col_add, gen_new_col. + prep_matrix_equality. + bdestruct (y =? col); try easy. + bdestruct (e =? col); try lia. + rewrite <- Cplus_assoc. + apply f_equal_gen; try easy. + assert (H' : n = e + (n - e)). lia. + rewrite H'. + do 2 rewrite Msum_Csum. + rewrite big_sum_sum. + rewrite big_sum_sum. + rewrite <- Cplus_assoc. + apply f_equal_gen; try apply f_equal; auto. + apply big_sum_eq_bounded; intros. + unfold make_row_val. + bdestruct (x0 =? e); try lia; easy. + destruct (n - e); try lia. + do 2 rewrite <- big_sum_extend_l. + unfold make_row_val. + bdestruct (e + 0 =? e); try lia. + unfold scale; simpl. + rewrite Cmult_0_l, Cplus_0_l. + rewrite Cplus_comm. + apply f_equal_gen; try apply f_equal; auto. + apply big_sum_eq_bounded; intros. + bdestruct (e + S x0 =? e); try lia; easy. + unfold get_col. simpl. + rewrite Nat.add_0_r; easy. +Qed. + +(* shows that we can eliminate a column in a matrix using col_add_many *) +Lemma col_add_many_cancel : forall {m n} (T : Matrix m (S n)) (as' : Vector (S n)) (col : nat), + col < (S n) -> as' col O = C0 -> + (reduce_col T col) × (reduce_row as' col) = -C1%C .* (get_col T col) -> + (forall i : nat, (col_add_many T as' col) i col = C0). +Proof. intros. + unfold col_add_many, gen_new_col. + bdestruct (col =? col); try lia. + rewrite Msum_Csum. + assert (H' : (big_sum (fun x : nat => (as' x O .* get_col T x) i O) (S n) = + (Mmult (reduce_col T col) (reduce_row as' col)) i O)%C). + { unfold Mmult. + replace (S n) with (col + (S (n - col))) by lia; rewrite big_sum_sum. + rewrite (le_plus_minus' col n); try lia; rewrite big_sum_sum. + apply f_equal_gen; try apply f_equal; auto. + apply big_sum_eq_bounded; intros. + unfold get_col, scale, reduce_col, reduce_row. + bdestruct (x T = col_add_many (col_add_many T as' col) (-C1%C .* as') col. +Proof. intros. + unfold col_add_many, gen_new_col. + prep_matrix_equality. + bdestruct (y =? col); try easy. + rewrite <- (Cplus_0_r (T x y)). + rewrite <- Cplus_assoc. + apply f_equal_gen; try apply f_equal; auto; try ring. + do 2 rewrite Msum_Csum. + rewrite <- (@big_sum_plus C _ _ C_is_comm_group). + rewrite @big_sum_0_bounded; auto. + intros. + unfold get_col, scale. + bdestruct (0 =? 0); bdestruct (x0 =? col); try lia; try lca. + rewrite Msum_Csum. + bdestruct (0 =? 0); try lia. + rewrite H3, H. + lca. +Qed. + +(* like above, allows for induction on col_add_each *) +Lemma col_add_each_col_add : forall {m n} (T : Matrix m n) (as' : Matrix 1 n) (col e : nat), + col <> e -> (forall x, as' x col = C0) -> + col_add_each T as' col = + col_add (col_add_each T (make_col_val as' e C0) col) e col (as' 0 e). +Proof. intros. + prep_matrix_equality. + unfold col_add_each, col_add, make_col_val, Mmult, Mplus, get_col, big_sum. + bdestruct (y =? col); bdestruct (y =? e); bdestruct (col =? e); + bdestruct (e =? e); bdestruct (0 =? 0); simpl; try lia; try ring. + rewrite H0. + rewrite H2. ring. +Qed. + +Lemma row_add_each_row_add : forall {m n} (T : Matrix m n) (as' : Vector m) (row e : nat), + row <> e -> (forall y, as' row y = C0) -> + row_add_each T as' row = + row_add (row_add_each T (make_row_val as' e C0) row) e row (as' e 0). +Proof. intros. + prep_matrix_equality. + unfold row_add_each, row_add, make_row_val, Mmult, Mplus, get_row, big_sum. + bdestruct (x =? row); bdestruct (x =? e); bdestruct (row =? e); + bdestruct (e =? e); bdestruct (0 =? 0); simpl; try lia; try ring. + rewrite H0. + rewrite H2. ring. +Qed. + +(* must use make_col_zero here instead of just as' col 0 = C0, since def requires stronger hyp *) +Lemma col_add_each_inv : forall {m n} (T : Matrix m n) (as' : Matrix 1 n) (col : nat), + T = col_add_each (col_add_each T (make_col_val as' col C0) col) + (make_col_val (-C1%C .* as') col C0) col. +Proof. intros. + prep_matrix_equality. + unfold col_add_each, make_col_val, Mmult, Mplus, get_col, scale. + simpl. bdestruct (y =? col); bdestruct (col =? col); simpl; try lia; try ring. +Qed. + +Lemma row_add_each_inv : forall {m n} (T : Matrix m n) (as' : Vector m) (row : nat), + T = row_add_each (row_add_each T (make_row_val as' row C0) row) + (make_row_val (-C1%C .* as') row C0) row. + +Proof. intros. + prep_matrix_equality. + unfold row_add_each, make_row_val, Mmult, Mplus, get_row, scale. + simpl. bdestruct (x =? row); bdestruct (row =? row); simpl; try lia; try ring. +Qed. + + +(* we can show that we get from col_XXX to row_XXX via transposing *) +(* helpful, since we can bootstrap many lemmas on cols for rows *) +Lemma get_col_transpose : forall {m n} (A : Matrix m n) (i : nat), + (get_col A i)⊤ = get_row (A⊤) i. +Proof. intros. + prep_matrix_equality. + unfold get_col, get_row, transpose. + easy. +Qed. + +Lemma get_row_transpose : forall {m n} (A : Matrix m n) (i : nat), + (get_row A i)⊤ = get_col (A⊤) i. +Proof. intros. + prep_matrix_equality. + unfold get_col, get_row, transpose. + easy. +Qed. + +Lemma col_swap_transpose : forall {m n} (A : Matrix m n) (x y : nat), + (col_swap A x y)⊤ = row_swap (A⊤) x y. +Proof. intros. + prep_matrix_equality. + unfold row_swap, col_swap, transpose. + easy. +Qed. + +Lemma row_swap_transpose : forall {m n} (A : Matrix m n) (x y : nat), + (row_swap A x y)⊤ = col_swap (A⊤) x y. +Proof. intros. + prep_matrix_equality. + unfold row_swap, col_swap, transpose. + easy. +Qed. + +Lemma col_scale_transpose : forall {m n} (A : Matrix m n) (x : nat) (a : C), + (col_scale A x a)⊤ = row_scale (A⊤) x a. +Proof. intros. + prep_matrix_equality. + unfold row_scale, col_scale, transpose. + easy. +Qed. + +Lemma row_scale_transpose : forall {m n} (A : Matrix m n) (x : nat) (a : C), + (row_scale A x a)⊤ = col_scale (A⊤) x a. +Proof. intros. + prep_matrix_equality. + unfold row_scale, col_scale, transpose. + easy. +Qed. + +Lemma col_scale_many_transpose : forall {m n} (A : Matrix m n) (as' : Matrix 1 n), + (col_scale_many A as')⊤ = row_scale_many (A⊤) (as'⊤). +Proof. intros. + prep_matrix_equality. + unfold row_scale_many, col_scale_many, transpose. + easy. +Qed. + +Lemma row_scale_many_transpose : forall {m n} (A : Matrix m n) (as' : Vector m), + (row_scale_many A as')⊤ = col_scale_many (A⊤) (as'⊤). +Proof. intros. + prep_matrix_equality. + unfold row_scale_many, col_scale_many, transpose. + easy. +Qed. + +Lemma col_add_transpose : forall {m n} (A : Matrix m n) (col to_add : nat) (a : C), + (col_add A col to_add a)⊤ = row_add (A⊤) col to_add a. +Proof. intros. + prep_matrix_equality. + unfold row_add, col_add, transpose. + easy. +Qed. + +Lemma row_add_transpose : forall {m n} (A : Matrix m n) (row to_add : nat) (a : C), + (row_add A row to_add a)⊤ = col_add (A⊤) row to_add a. +Proof. intros. + prep_matrix_equality. + unfold row_add, col_add, transpose. + easy. +Qed. + +Lemma col_add_many_transpose : forall {m n} (A : Matrix m n) (as' : Vector n) (col : nat), + (col_add_many A as' col)⊤ = row_add_many (A⊤) (as'⊤) col. +Proof. intros. + prep_matrix_equality. + unfold row_add_many, col_add_many, transpose. + bdestruct (x =? col); try easy. + apply f_equal_gen; try apply f_equal; auto. + unfold gen_new_col, gen_new_row, get_col, get_row, scale. + do 2 rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + easy. +Qed. + +Lemma row_add_many_transpose : forall {m n} (A : Matrix m n) (as' : Matrix 1 m) (row : nat), + (row_add_many A as' row)⊤ = col_add_many (A⊤) (as'⊤) row. +Proof. intros. + prep_matrix_equality. + unfold row_add_many, col_add_many, transpose. + bdestruct (y =? row); try easy. + apply f_equal_gen; try apply f_equal; auto. + unfold gen_new_col, gen_new_row, get_col, get_row, scale. + do 2 rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + easy. +Qed. + +Lemma col_add_each_transpose : forall {m n} (A : Matrix m n) (as' : Matrix 1 n) (col : nat), + (col_add_each A as' col)⊤ = row_add_each (A⊤) (as'⊤) col. +Proof. intros. + unfold row_add_each, col_add_each. + rewrite Mplus_transpose. + rewrite Mmult_transpose; auto. +Qed. + +Lemma row_add_each_transpose : forall {m n} (A : Matrix m n) (as' : Vector m) (row : nat), + (row_add_each A as' row)⊤ = col_add_each (A⊤) (as'⊤) row. +Proof. intros. + unfold row_add_each, col_add_each. + rewrite Mplus_transpose. + rewrite Mmult_transpose; auto. +Qed. + +Lemma get_minor_transpose : forall {n} (A : Square (S n)) (i j : nat), + (get_minor A i j)⊤ = get_minor (A⊤) j i. +Proof. intros. + prep_matrix_equality. + unfold get_minor, transpose. + bdestruct_all; easy. +Qed. + + +(** the idea is to show that col operations correspond to multiplication by special matrices. *) +(** Thus, we show that the col ops all satisfy various multiplication rules *) +Lemma swap_preserves_mul_lt : forall {m n o} (A : Matrix m n) (B : Matrix n o) (x y : nat), + x < y -> x < n -> y < n -> A × B = (col_swap A x y) × (row_swap B x y). +Proof. intros. + prep_matrix_equality. + unfold Mmult. + bdestruct (x y < n -> A × B = (col_swap A x y) × (row_swap B x y). +Proof. intros. bdestruct (x x < n -> y < n -> A × (row_add B y x a) = (col_add A x y a) × B. +Proof. intros. + prep_matrix_equality. + unfold Mmult. + bdestruct (x y < n -> A × (row_add B y x a) = (col_add A x y a) × B. +Proof. intros. bdestruct (x skip_count skip i. +Proof. intros; unfold skip_count. + bdestruct (i skip_count skip i1 < skip_count skip i2. +Proof. intros; unfold skip_count. + bdestruct (i1 to_add <> col -> + col_add (col_add_many T as' col) col to_add c = + col_add_many (col_add T col to_add c) as' col. +Proof. intros. + prep_matrix_equality. + unfold col_add, col_add_many. + bdestruct (y =? col); try lia; try easy. + repeat rewrite <- Cplus_assoc. + apply f_equal_gen; try apply f_equal; auto. + bdestruct (to_add =? col); try lia. + rewrite Cplus_comm. + apply f_equal_gen; try apply f_equal; auto. + unfold gen_new_col. + do 2 rewrite Msum_Csum. + apply big_sum_eq_bounded; intros. + unfold get_col, scale; simpl. + bdestruct (x0 =? col); try ring. + rewrite H4, H; ring. +Qed. + +Lemma col_add_many_preserves_mul_some : forall (m n o e col : nat) + (A : Matrix m n) (B : Matrix n o) (v : Vector n), + WF_Matrix v -> (skip_count col e) < n -> col < n -> + (forall i : nat, (skip_count col e) < i -> v i 0 = C0) -> v col 0 = C0 -> + A × (row_add_each B v col) = (col_add_many A v col) × B. +Proof. induction e as [| e]. + - intros. + destruct n; try easy. + rewrite (col_add_many_col_add _ _ col (skip_count col 0)); try easy. + rewrite <- (col_add_many_0 A (make_row_val v (skip_count col 0) C0) col). + rewrite (row_add_each_row_add _ _ col (skip_count col 0)); try easy. + rewrite <- (row_add_each_0 B (make_row_val v (skip_count col 0) C0) col). + apply add_preserves_mul; try easy. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + destruct j; try lia. + unfold make_row_val. + bdestruct (i =? skip_count col 0); try lia; try easy. + destruct col; destruct i; try easy. + rewrite H2; try easy. unfold skip_count in *. + bdestruct (0 col < n -> v col 0 = C0 -> + A × (row_add_each B v col) = (col_add_many A v col) × B. +Proof. intros. + destruct n; try easy. + destruct n. + - assert (H' : v = Zero). + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + destruct i; destruct j; destruct col; try lia; easy. + rewrite <- col_add_many_0, <- row_add_each_0; try easy. + rewrite H'; easy. + - apply (col_add_many_preserves_mul_some _ _ _ n col); try easy. + unfold skip_count. + bdestruct (n col < n -> v 0 col = C0 -> + A × (row_add_many B v col) = (col_add_each A v col) × B. +Proof. intros. + assert (H' : ((B⊤) × (row_add_each (A⊤) (v⊤) col))⊤ = + ((col_add_many (B⊤) (v⊤) col) × (A⊤))⊤). + rewrite col_add_many_preserves_mul; auto with wf_db; try easy. + do 2 rewrite Mmult_transpose in H'; auto. + rewrite row_add_each_transpose in H'. + rewrite col_add_many_transpose in H'. + repeat rewrite transpose_involutive in H'. + easy. +Qed. + + + + +(** proving lemmas about (I n) *) + + +(* first, facts about the ops on (I n) *) +Lemma col_row_swap_invr_I : forall (n x y : nat), + x < n -> y < n -> col_swap (I n) x y = row_swap (I n) x y. +Proof. intros. + prep_matrix_equality. + unfold col_swap, row_swap, I. + bdestruct_all; try easy. +Qed. + +Lemma col_row_scale_invr_I : forall (n x : nat) (c : C), + col_scale (I n) x c = row_scale (I n) x c. +Proof. intros. + prep_matrix_equality. + unfold col_scale, row_scale, I. + bdestruct_all; try easy; simpl; ring. +Qed. + +Lemma col_row_scale_many_invr_I : forall (n : nat) (as' : Matrix 1 n), + col_scale_many (I n) as' = row_scale_many (I n) (as'⊤). +Proof. intros. + prep_matrix_equality. + unfold col_scale_many, row_scale_many, transpose, I. + bdestruct_all; try easy; simpl; subst; ring. +Qed. + + +Lemma col_row_add_invr_I : forall (n x y : nat) (c : C), + x < n -> y < n -> col_add (I n) x y c = row_add (I n) y x c. +Proof. intros. + prep_matrix_equality. + unfold col_add, row_add, I. + bdestruct_all; try easy; simpl; ring. +Qed. + +Lemma row_each_col_many_invr_I : forall (n col : nat) (v : Vector n), + WF_Matrix v -> col < n -> v col 0 = C0 -> + row_add_each (I n) v col = col_add_many (I n) v col. +Proof. intros. + rewrite <- (Mmult_1_r), <- col_add_many_preserves_mul, + Mmult_1_l; auto with wf_db. +Qed. + +Lemma row_many_col_each_invr_I : forall (n col : nat) (v : Matrix 1 n), + WF_Matrix v -> col < n -> v 0 col = C0 -> + row_add_many (I n) v col = col_add_each (I n) v col. +Proof. intros. + rewrite <- (Mmult_1_r), <- col_add_each_preserves_mul, + Mmult_1_l; auto with wf_db. +Qed. + + +(* Now to the column/row operations matrices!! *) +Lemma col_swap_mult_r : forall {m n} (A : Matrix m n) (x y : nat), + x < n -> y < n -> WF_Matrix A -> + col_swap A x y = A × (row_swap (I n) x y). +Proof. intros. + assert (H2 := (swap_preserves_mul A (row_swap (I n) x y) x y)). + rewrite <- (Mmult_1_r _ _ (col_swap A x y)); auto with wf_db. + rewrite H2; try easy. + rewrite <- (row_swap_inv (I n) x y). + reflexivity. +Qed. + +Lemma row_swap_mult_l : forall {m n} (A : Matrix m n) (x y : nat), + x < m -> y < m -> WF_Matrix A -> + row_swap A x y = (col_swap (I m) x y) × A. +Proof. intros. + assert (H2 := (swap_preserves_mul (row_swap (I m) x y) A x y)). + rewrite <- (Mmult_1_l _ _ (row_swap A x y)); auto with wf_db. + rewrite col_row_swap_invr_I; auto. + rewrite H2; try easy. + rewrite <- col_row_swap_invr_I; auto. + rewrite <- (col_swap_inv (I m) x y). + reflexivity. +Qed. + +Lemma col_scale_mult_r : forall {m n} (A : Matrix m n) (x : nat) (a : C), + WF_Matrix A -> + col_scale A x a = A × (row_scale (I n) x a). +Proof. intros. + rewrite scale_preserves_mul. + rewrite Mmult_1_r; auto with wf_db. +Qed. + +Lemma col_scale_many_mult_r : forall {m n} (A : Matrix m n) (as' : Matrix 1 n), + WF_Matrix A -> + col_scale_many A as' = A × (row_scale_many (I n) (as'⊤)). +Proof. intros. + rewrite scale_many_preserves_mul. + rewrite Mmult_1_r; auto with wf_db. +Qed. + + +Lemma col_add_mult_r : forall {m n} (A : Matrix m n) (x y : nat) (a : C), + x < n -> y < n -> WF_Matrix A -> + col_add A x y a = A × (row_add (I n) y x a). +Proof. intros. + rewrite add_preserves_mul; auto. + rewrite Mmult_1_r; auto with wf_db. +Qed. + +Lemma col_add_many_mult_r : forall {m n} (A : Matrix m n) (v : Vector n) (col : nat), + WF_Matrix A -> WF_Matrix v -> col < n -> v col 0 = C0 -> + col_add_many A v col = A × (row_add_each (I n) v col). +Proof. intros. + rewrite col_add_many_preserves_mul; try easy. + rewrite Mmult_1_r; auto with wf_db. +Qed. + +Lemma col_add_each_mult_r : forall {m n} (A : Matrix m n) (v : Matrix 1 n) (col : nat), + WF_Matrix A -> WF_Matrix v -> col < n -> v 0 col = C0 -> + col_add_each A v col = A × (row_add_many (I n) v col). +Proof. intros. + rewrite col_add_each_preserves_mul; try easy. + rewrite Mmult_1_r; auto with wf_db. +Qed. + + + + + +(** * lemmas about e_i *) + + +Lemma I_is_eis : forall {n} (i : nat), + get_col (I n) i = e_i i. +Proof. intros. + unfold get_col, e_i, I. + prep_matrix_equality. + bdestruct_all; simpl; auto. +Qed. + + +Lemma get_minor_diag_mul : forall {n} (A : Square (S n)) (v : Vector (S n)) (i : nat), + i < S n -> + get_col A i = e_i i -> + (get_minor A i i) × (reduce_row v i) = reduce_row (A × v) i. +Proof. intros. + prep_matrix_equality. + unfold get_minor, reduce_row, Mmult. + replace n with (i + (n - i)) by lia. + replace (S (i + (n - i))) with (i + 1 + (n - i)) by lia. + do 5 rewrite big_sum_sum; simpl. + bdestruct (x + (col_wedge A v i) × (row_wedge a Zero i) = A × a. +Proof. intros. + prep_matrix_equality. + unfold Mmult. + replace n with (i + (n - i)) by lia. + replace (S (i + (n - i))) with (i + 1 + (n - i)) by lia. + do 3 rewrite big_sum_sum; simpl. + unfold row_wedge, col_wedge, Zero. + bdestruct (i + 0 + get_col T i = T × e_i i. +Proof. intros. + unfold get_col, e_i, Mmult. + prep_matrix_equality. + bdestruct (y =? 0). + - rewrite (big_sum_unique (T x i) _ n); try easy. + exists i. split. + apply H. split. + bdestruct (i =? i); bdestruct (i + get_row T i = (e_i i)† × T. +Proof. intros. + unfold get_row, e_i, Mmult, adjoint. + prep_matrix_equality. + bdestruct (x =? 0). + - rewrite (big_sum_unique (T i y) _ m); try easy. + exists i. split. + apply H. split. + bdestruct (i =? i); bdestruct (i j < n -> + T i j = ((e_i i)† × T × (e_i j)) O O. +Proof. intros. + rewrite <- matrix_by_basis_adjoint, <- matrix_by_basis; auto. +Qed. + + +(** * Lemmas related to 1pad *) + + +Lemma pad1_conv : forall {m n} (T : Matrix m n) (c : C) (i j : nat), + (pad1 T c) (S i) (S j) = T i j. +Proof. intros. + unfold pad1, col_wedge, row_wedge, e_i. + bdestruct (S j j -> T i j = C0) -> + T = pad1 (reduce_col (reduce_row T 0) 0) (T 0 0). +Proof. intros. + prep_matrix_equality. + destruct x; destruct y. + 4 : rewrite pad1_conv. + all : try unfold pad1; unfold col_wedge, row_wedge, e_i, scale; simpl. + ring. + rewrite H; auto. + rewrite H; auto; ring. + unfold reduce_col, reduce_row. + bdestruct_all; easy. +Qed. + +Lemma pad1_get_minor: forall {n : nat} (A : Square (S n)) (c : C), + (forall (i j : nat), (i = 0 \/ j = 0) /\ i <> j -> A i j = C0) -> + A = pad1 (get_minor A O O) (A 0 0). +Proof. intros. + rewrite get_minor_is_redrow_redcol. + rewrite <- pad1_reduce_colrow; + easy. +Qed. + +(* ∃ weakens this lemma, but makes future proofs less messy *) +Lemma pad1ed_matrix : forall {m n} (A : Matrix (S m) (S n)) (c : C), + (forall (i j : nat), (i = 0 \/ j = 0) /\ i <> j -> A i j = C0) -> A 0 0 = c -> + exists a, pad1 a c = A. +Proof. intros. + exists (reduce_col (reduce_row A 0) 0); subst. + rewrite <- pad1_reduce_colrow; auto. +Qed. + + +Lemma pad1_col_swap : forall {m n} (A : Matrix m n) (x y : nat) (c : C), + (pad1 (col_swap A x y) c) = col_swap (pad1 A c) (S x) (S y). +Proof. intros. + unfold pad1, col_wedge, row_wedge, col_swap, e_i, scale. + prep_matrix_equality; simpl. + bdestruct_all; try easy. + all : rewrite Nat.sub_0_r; easy. +Qed. + +Lemma pad1_col_scale : forall {m n} (A : Matrix m n) (x : nat) (c1 c2 : C), + (pad1 (col_scale A x c1) c2) = col_scale (pad1 A c2) (S x) c1. +Proof. intros. + unfold pad1, col_wedge, row_wedge, col_scale, e_i, scale. + prep_matrix_equality; simpl. + bdestruct_all; try easy. + unfold Zero; ring. +Qed. + +Lemma pad1_col_add : forall {m n} (A : Matrix m n) (x y : nat) (c1 c2 : C), + (pad1 (col_add A x y c1) c2) = col_add (pad1 A c2) (S x) (S y) c1. +Proof. intros. + unfold pad1, col_wedge, row_wedge, col_add, e_i, scale. + prep_matrix_equality; simpl. + bdestruct_all; try easy. + all : rewrite Nat.sub_0_r; try easy. + unfold Zero; ring. +Qed. + + + +(** * Some more general matrix lemmas with these new concepts *) + +(* We can now show that matrix_equivalence is decidable *) +Lemma vec_equiv_dec : forall {n : nat} (A B : Vector n), + { A == B } + { ~ (A == B) }. +Proof. induction n as [| n']. + - left; easy. + - intros. destruct (IHn' (reduce_vecn A) (reduce_vecn B)). + + destruct (Geq_dec (A n' 0) (B n' 0)). + * left. + unfold mat_equiv in *. + intros. + bdestruct (i =? n'); bdestruct (n' v n 0 = C0 -> v = reduce_vecn v. +Proof. intros. unfold reduce_vecn. + prep_matrix_equality. + bdestruct (x (v = Zero <-> (reduce_row v x) = Zero /\ v x 0 = C0). +Proof. intros. split. + - intros. rewrite H0. split. + + prep_matrix_equality. unfold reduce_row. + bdestruct (x0 + v <> Zero -> exists x, v x 0 <> C0. +Proof. induction n as [| n']. + - intros. + assert (H' : v = Zero). + { prep_matrix_equality. + unfold Zero. + unfold WF_Matrix in H. + apply H. + left. lia. } + easy. + - intros. + destruct (Geq_dec (v n' 0) C0). + + destruct (vec_equiv_dec (reduce_row v n') Zero). + * assert (H' := H). + apply (zero_reduce _ n') in H'. + destruct H'. + assert (H' : v = Zero). + { apply H2. + split. + apply mat_equiv_eq; auto with wf_db. + easy. } + easy. + * assert (H1 : exists x, (reduce_row v n') x 0 <> C0). + { apply IHn'; auto with wf_db. + unfold not in *. intros. apply n. + rewrite H1. easy. } + destruct H1. + exists x. + rewrite (last_zero_simplification v); try easy. + + exists n'. + apply n. +Qed. + + +(* this function gets the x from above explicitly *) +Fixpoint get_nonzero_entry (n : nat) (v : Vector (S n)) : nat := + match n with + | O => O + | S n' => match (Ceq_dec (v O O) C0) with + | left _ => 1 + (get_nonzero_entry n' (reduce_row v O)) + | right _ => O + end + end. + +Arguments get_nonzero_entry {n}. + + +Lemma get_nonzero_entry_bounds : forall {n} (v : Vector (S n)), + WF_Matrix v -> + get_nonzero_entry v < (S n). +Proof. induction n. + - intros; simpl; auto. + - intros; simpl. + destruct (Ceq_dec (v 0 0) C0); try lia. + apply -> Nat.succ_lt_mono. + apply IHn; auto with wf_db. +Qed. + +Lemma get_nonzero_entry_correct : forall {n} (v : Vector (S n)), + WF_Matrix v -> + v <> Zero -> + v (get_nonzero_entry v) 0 <> C0. +Proof. induction n; intros. + - destruct (Ceq_dec (v O O) C0). + + assert (H' : v = Zero). + { apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + destruct i; destruct j; try lia. + rewrite e; easy. } + easy. + + unfold get_nonzero_entry; auto. + - unfold get_nonzero_entry. + destruct (Ceq_dec (v O O) C0). + + unfold not; intros; apply (IHn (reduce_row v 0)); auto with wf_db. + contradict H0. + apply <- (zero_reduce v O); auto. + + auto. +Qed. + + +Lemma get_nonzero_entry_correct_row : forall {n} (v : Matrix 1 (S n)), + WF_Matrix v -> + v <> Zero -> + v 0 (get_nonzero_entry v⊤) <> C0. +Proof. intros. + unfold not; intros; apply (get_nonzero_entry_correct v⊤); auto with wf_db. + unfold not; intros; apply H0. + apply (f_equal transpose) in H2. + rewrite transpose_involutive in H2. + rewrite H2. + prep_matrix_equality. + unfold Zero, transpose; easy. +Qed. + + +(***********************************************************) +(** * Defining and proving lemmas relating to the determinant *) +(***********************************************************) + + +Fixpoint parity (n : nat) : C := + match n with + | 0 => C1 + | S 0 => -C1 + | S (S n) => parity n + end. + + +Lemma parity_S : forall (n : nat), + (parity (S n) = -C1 * parity n)%C. +Proof. intros. + induction n as [| n']; try (simpl; ring). + rewrite IHn'. + simpl. + ring. +Qed. + +Lemma parity_sqr : forall (n : nat), + (parity n * parity n)%C = C1. +Proof. intros. + induction n. + - simpl; ring. + - rewrite parity_S. + replace (- (C1) * parity n * (- (C1) * parity n))%C with (parity n * parity n)%C by ring. + easy. +Qed. + +Lemma parity_plus : forall (n m : nat), + parity (n + m) = (parity n * parity m)%C. +Proof. intros. + induction n. + - simpl; ring. + - rewrite plus_Sn_m, parity_S, parity_S, IHn. + ring. +Qed. + + + +Fixpoint Determinant (n : nat) (A : Square n) : C := + match n with + | 0 => C1 + | S 0 => A 0 0 + | S n' => (big_sum (fun i => (parity i) * (A i 0) * + (Determinant n' (get_minor A i 0)))%C n) + end. + +Arguments Determinant {n}. + +Lemma Det_simplify : forall {n} (A : Square (S n)), + Determinant A = + (big_sum (fun i => (parity i) * (A i 0) * (Determinant (get_minor A i 0)))%C (S n)). +Proof. intros. + destruct n; try easy. + simpl; ring. +Qed. + +Lemma Det_simplify_fun : forall {n} (A : Square (S (S n))), + (fun i : nat => parity i * A i 0 * Determinant (get_minor A i 0))%C = + (fun i : nat => (big_sum (fun j => + (parity i) * (A i 0) * (parity j) * ((get_minor A i 0) j 0) * + (Determinant (get_minor (get_minor A i 0) j 0)))%C (S n)))%C. +Proof. intros. + apply functional_extensionality; intros. + rewrite Det_simplify. + rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded; intros. + lca. +Qed. + + +Lemma get_minor_I : forall (n : nat), get_minor (I (S n)) 0 0 = I n. +Proof. intros. + apply mat_equiv_eq. + apply WF_get_minor; try lia; auto with wf_db. + apply WF_I. + unfold mat_equiv; intros. + unfold get_minor, I. + bdestruct (i + match (x, y) with + | (0, 0) => C1 + | (0, 1) => (C1+C1)%C + | (1, 0) => (C1+C1+C1+C1)%C + | (1, 1) => (C1+C1+C1+C1+C1)%C + | _ => C0 + end. + + +Lemma Det_M22 : (Determinant M22) = (Copp (C1 + C1 + C1))%C. +Proof. simpl; unfold M22, get_minor; simpl. + ring. +Qed. + + +(** Now, we show the effects of the column operations on determinant *) + +Lemma Determinant_col_scale : forall {n} (A : Square n) (c : C) (col : nat), + col < n -> Determinant (col_scale A col c) = (c * Determinant A)%C. +Proof. induction n. + + intros. easy. + + intros. simpl. + destruct n. + - simpl. unfold col_scale. + bdestruct (0 =? col); try lia; easy. + - rewrite Cmult_plus_distr_l. + apply Cplus_simplify. + * rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded. + intros. + destruct col. + rewrite col_scale_get_minor_same; try lia. + unfold col_scale. bdestruct (0 =? 0); try lia. + lca. + rewrite col_scale_get_minor_before; try lia. + rewrite Sn_minus_1. + rewrite IHn; try lia. + unfold col_scale. + bdestruct (0 =? S col); try lia; lca. + * destruct col. + rewrite col_scale_get_minor_same; try lia. + unfold col_scale. bdestruct (0 =? 0); try lia. + lca. + rewrite col_scale_get_minor_before; try lia. + rewrite Sn_minus_1. + rewrite IHn; try lia. + unfold col_scale. + bdestruct (0 =? S col); try lia; lca. +Qed. + +Lemma Determinant_row_scale : forall {n} (A : Square n) (c : C) (row : nat), + row < n -> Determinant (row_scale A row c) = (c * Determinant A)%C. +Proof. induction n. + - intros. easy. + - intros. + do 2 rewrite Det_simplify. + rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded; intros. + bdestruct (x (big_sum (fun j => ((A i 1) * (A (skip_count i j) O) * (parity i) * (parity j) * + Determinant (get_minor (get_minor A i O) j O))%C ) + (S n))) (S (S n)). +Proof. intros. + rewrite Det_simplify. + rewrite Det_simplify_fun. + apply big_sum_eq_bounded; intros. + apply big_sum_eq_bounded; intros. + replace (col_swap A O 1%nat x O) with (A x 1%nat) by easy. + assert (H' : @get_minor (S n) (S n) (col_swap A O 1%nat) x O x0 O = A (skip_count x x0) O). + { unfold get_minor, col_swap, skip_count. + simpl. bdestruct (x0 (big_sum (fun j => ((A i 0) * (A (skip_count i j) 1) * (parity i) * (parity j) * + Determinant (get_minor (get_minor A i 0) j 0))%C) + (S n))) (S (S n)). +Proof. intros. + rewrite Det_simplify. + rewrite Det_simplify_fun. + apply big_sum_eq_bounded; intros. + apply big_sum_eq_bounded; intros. + apply f_equal_gen; try apply f_equal; try easy. + assert (H' : @get_minor (S n) (S n) A x 0 x0 0 = A (skip_count x x0) 1%nat). + { unfold get_minor, col_swap, skip_count. + simpl. bdestruct (x0 Determinant (col_swap A 0 1) = -C1%C * (Determinant A). +Proof. intros. + destruct n; try lia. + destruct n; try lia. + rewrite Det_diff_1, Det_diff_2. + apply big_sum_rearrange; intros. + - unfold skip_count. + bdestruct (x Determinant (col_swap A i (S i)) = -C1%C * (Determinant A). +Proof. induction n as [| n']. + - easy. + - intros. + destruct i. + + apply Determinant_swap_01; easy. + + simpl. destruct n'; try lia. + do 2 rewrite (@big_sum_extend_r C C_is_monoid). + rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded; intros. + rewrite col_swap_get_minor_before; try lia. + rewrite IHn'; try lia. + replace (col_swap A (S i) (S (S i)) x 0%nat) with (A x 0%nat) by easy. + lca. +Qed. + +(* swapping columns i and i + (S k), use previous lemma to induct *) +Lemma Determinant_swap_ik : forall {n} (k i : nat) (A : Square n), + i + (S k) < n -> Determinant (col_swap A i (i + (S k))) = -C1%C * (Determinant A). +Proof. induction k as [| k']. + - intros. + replace (i + 1)%nat with (S i) by lia. + rewrite Determinant_swap_adj; try lia; ring. + - intros. + rewrite (col_swap_three A i (i + (S k')) (i + (S (S k')))); try lia. + rewrite IHk'; try lia. + replace (i + (S (S k')))%nat with (S (i + (S k')))%nat by lia. + rewrite Determinant_swap_adj; try lia. + rewrite IHk'; try lia. + ring. +Qed. + +(* finally, we can prove Determinant_swap *) +Lemma Determinant_swap : forall {n} (A : Square n) (i j : nat), + i < n -> j < n -> i <> j -> + Determinant (col_swap A i j) = -C1%C * (Determinant A). +Proof. intros. + bdestruct (i + Determinant (col_to_front A col) = (parity col) * Determinant A. +Proof. induction col; intros. + - rewrite col_to_front_0. + simpl; ring. + - rewrite col_to_front_swap_col; auto. + rewrite IHcol; try lia. + rewrite Determinant_swap; try lia. + rewrite parity_S. + ring. +Qed. + +Lemma col_0_Det_0 : forall {n} (A : Square n) (i : nat), + i < n -> + get_col A i = Zero -> + Determinant A = C0. +Proof. intros n A i H H0. + destruct n; try easy. + destruct n. + destruct i; try lia. + replace C0 with (@Zero 1 1 0 0)%C by easy. + rewrite <- H0. easy. + destruct i. + - rewrite Det_simplify. + apply (@big_sum_0_bounded C); intros. + replace (A x 0) with (@Zero (S (S n)) 1 x 0) by (rewrite <- H0; easy). + unfold Zero; lca. + - rewrite (col_swap_inv _ 0 (S i)). + rewrite Determinant_swap; try lia. + rewrite Det_simplify. + rewrite (@big_sum_mult_l C _ _ _ C_is_ring). + apply (@big_sum_0_bounded C); intros. + replace (col_swap A 0 (S i) x 0) with + (@Zero (S (S n)) 1 x 0) by (rewrite <- H0; easy). + unfold Zero; lca. +Qed. + +Lemma row_0_Det_0 : forall {n} (A : Square n) (i : nat), + i < n -> + get_row A i = Zero -> + Determinant A = C0. +Proof. induction n. + - intros; try lia. + - intros; destruct n. + + simpl. + destruct i; try lia. + rewrite <- get_row_conv, H0; easy. + + rewrite Det_simplify. + rewrite big_sum_0_bounded; auto. + intros. + bdestruct (i =? x); bdestruct (i j < n -> i <> j -> + get_col A i = get_col A j -> + Determinant A = C0. +Proof. intros. + apply eq_neg_implies_0. + rewrite <- (Determinant_swap _ i j); try easy. + rewrite (det_by_get_col (col_swap A i j) A); try easy; intros. + prep_matrix_equality. + destruct y; try easy. + bdestruct (i0 =? i); bdestruct (i0 =? j); try lia. + - rewrite H3, col_swap_get_col, H2; easy. + - rewrite H4, col_swap_diff_order, col_swap_get_col, H2; easy. + - unfold col_swap, get_col. simpl. + bdestruct (i0 =? i); bdestruct (i0 =? j); try lia; easy. +Qed. + +Lemma col_scale_same_Det_0 : forall {n} (A : Square n) (i j : nat) (c : C), + i < n -> j < n -> i <> j -> + get_col A i = c .* (get_col A j) -> + Determinant A = C0. +Proof. intros. + destruct (Ceq_dec c C0). + - apply (col_0_Det_0 _ i); auto. + rewrite H2, e. + apply Mscale_0_l. + - rewrite (col_scale_inv A j c); try easy. + rewrite Determinant_col_scale; try easy. + assert (H3 : Determinant (col_scale A j c) = C0). + { apply (col_same_Det_0 _ i j); try easy. + prep_matrix_equality. + unfold get_col, col_scale. + bdestruct (y =? 0); try easy. + bdestruct (i =? j); bdestruct (j =? j); try lia. + rewrite <- get_col_conv. + rewrite H2. + unfold scale. + rewrite get_col_conv. + easy. } + rewrite H3. + lca. +Qed. + + +(* use this to show det_col_add_0i *) +Lemma Det_col_add_comm : forall {n} (T : Matrix (S n) n) (v1 v2 : Vector (S n)), + (Determinant (col_wedge T v1 0) + Determinant (col_wedge T v2 0) = + Determinant (col_wedge T (v1 .+ v2) 0)). +Proof. intros. + destruct n; try easy. + do 3 rewrite Det_simplify. + rewrite <- (@big_sum_plus C _ _ C_is_comm_group). + apply big_sum_eq_bounded; intros. + repeat rewrite get_minor_is_redcol_redrow. + repeat rewrite col_wedge_reduce_col_same. + unfold col_wedge, Mplus. + bdestruct (0 i <> 0 -> Determinant (col_add A 0 i c) = Determinant A. +Proof. intros. + destruct n; try easy. + rewrite col_add_split. + assert (H' := (@Det_col_add_comm n (reduce_col A 0) (get_col A 0) (c .* get_col A i))). + rewrite <- H'. + rewrite <- Cplus_0_r. + apply f_equal_gen; try apply f_equal; auto. + assert (H1 : col_wedge (reduce_col A 0) (get_col A 0) 0 = A). + { prep_matrix_equality. + unfold col_wedge, reduce_col, get_col. + destruct y; try easy; simpl. + replace (y - 0)%nat with y by lia; easy. } + rewrite H1; easy. + apply (col_scale_same_Det_0 _ O i c); try lia; auto. + prep_matrix_equality. + unfold get_col, col_wedge, reduce_col, scale; simpl. + bdestruct (y =? 0); bdestruct (i =? 0%nat); try ring; simpl in *; try lia. + replace (S (i - 1)) with i by lia. + easy. +Qed. + +Lemma Determinant_col_add : forall {n} (A : Square n) (i j : nat) (c : C), + i < n -> j < n -> i <> j -> Determinant (col_add A i j c) = Determinant A. +Proof. intros. + destruct j. + - rewrite <- col_swap_col_add_0. + rewrite Determinant_swap. + rewrite Determinant_col_add0i. + rewrite Determinant_swap. + ring. + all : easy. + - destruct i. + rewrite Determinant_col_add0i; try easy. + rewrite <- col_swap_col_add_Si. + rewrite Determinant_swap. + rewrite Determinant_col_add0i. + rewrite Determinant_swap. + ring. + all : try easy; try lia. +Qed. + +Lemma Determinant_pad1 : forall {n} (A : Square n) (c : C), + Determinant (pad1 A c) = c * Determinant A. +Proof. intros. + rewrite Det_simplify, <- big_sum_extend_l, <- Cplus_0_r. + apply f_equal_gen; try apply f_equal. + rewrite <- get_minor_pad1. + unfold pad1, col_wedge, row_wedge, e_i, scale; simpl; ring. + apply @big_sum_0_bounded; intros. + unfold pad1, col_wedge, row_wedge, e_i, scale; simpl; ring. +Qed. + + +(** Now we prove that A×Adj(A) = det(A) I *) + + +Lemma determinant_along_col : forall {n} (A : Square (S (S n))) (col rep : nat), + rep < S (S n) -> + Determinant (col_replace A col rep) = + big_sum (fun i => (A i col) * ((parity i) * (parity rep) * + (Determinant (get_minor A i rep))))%C (S (S n)). +Proof. intros. + rewrite <- (Cmult_1_l (Determinant (col_replace A col rep))). + rewrite <- (parity_sqr rep), <- Cmult_assoc. + rewrite <- Determinant_col_to_front; auto. + rewrite Det_simplify, (@big_sum_mult_l C _ _ _ C_is_ring). + apply big_sum_eq_bounded; intros. + rewrite get_minor_col_to_front, get_minor_col_replace. + replace (col_to_front (col_replace A col rep) rep x 0) with (A x col). + lca. + unfold col_to_front, col_replace; simpl. + bdestruct (rep =? rep); easy. +Qed. + + +Definition adjugate {n} (A : Square n) : Square n := + match n with + | O => fun i j => C0 + | S n => fun i j => if (i rep < n -> + big_sum (fun y : nat => adjugate A rep y * A y col) n = + Determinant (col_replace A col rep). +Proof. intros. + destruct n; try lia. + destruct n. + - unfold adjugate, col_replace; destruct rep; destruct col; try lia; simpl. + ring. + - rewrite (determinant_along_col _ col rep); auto. + apply big_sum_eq_bounded; intros. + unfold adjugate. + rewrite parity_plus. + bdestruct_all. + simpl; ring. +Qed. + +Theorem mult_by_adjugate_l : forall {n} (A : Square n), + WF_Matrix A -> + (adjugate A) × A = (Determinant A) .* (I n). +Proof. intros. + destruct n. + prep_matrix_equality. + unfold Mmult, scale, I; simpl. + bdestruct_all; try lia; simpl; lca. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + unfold Mmult. + rewrite mult_by_adjugate_single_col; auto. + unfold scale, I. + bdestruct (i =? j); subst. + - replace (col_replace A j j) with A. + bdestruct_all; simpl; ring. + unfold col_replace. + prep_matrix_equality. + bdestruct_all; auto. + - rewrite (col_scale_same_Det_0 _ i j C1); auto. + simpl; ring. + unfold get_col, col_replace, scale. + prep_matrix_equality. + bdestruct_all; simpl; ring. +Qed. + + + +(** Developting machinery for one and two level matrices *) + + + + + +Definition one_level_mat (n : nat) (a : C) (i : nat) : Matrix n n := + fun x y => if (x =? i) && (y =? i) then a else + if (x =? y) && (x if (x =? i) && (y =? i) then U O O else + if (x =? i) && (y =? j) then U O 1%nat else + if (x =? j) && (y =? i) then U 1%nat O else + if (x =? j) && (y =? j) then U 1%nat 1%nat else + if (x =? y) && (x if (x =? 0) then M i y else + if (x =? 1) then M j y else C0. + +Lemma WF_one_level_mat : forall n a i, + i < n -> WF_Matrix (one_level_mat n a i). +Proof. intros. + unfold WF_Matrix, one_level_mat; intros. + bdestruct_all; simpl; try lia; easy. +Qed. + +Lemma WF_two_level_mat : forall n U i j, + i < n -> j < n -> WF_Matrix (two_level_mat n U i j). +Proof. intros. + unfold WF_Matrix, two_level_mat; intros. + bdestruct_all; simpl; try lia; easy. +Qed. + +Lemma WF_get_two_rows : forall {m n} (M : Matrix m n) i j, + WF_Matrix M -> + WF_Matrix (get_two_rows M i j). +Proof. intros. + unfold WF_Matrix, get_two_rows; intros. + destruct H0; + bdestruct_all; simpl; auto. +Qed. + + + +(* in what follows, v should be thought as a vector, but I made the proofs more general *) + + +Lemma mult_by_one_level_mat : forall m n a i (v : Matrix m n), + i < m -> + WF_Matrix v -> + (one_level_mat m a i) × v = row_scale v i a. +Proof. intros. + apply mat_equiv_eq; auto with wf_db. + apply WF_mult; auto. + apply WF_one_level_mat; auto. + unfold mat_equiv; intros. + unfold one_level_mat, Mmult, row_scale. + apply big_sum_unique. + exists i0; split; auto; split. + bdestruct_all; simpl; subst; auto; ring. + intros. + bdestruct_all; simpl; ring. +Qed. + +(* TODO: build better machinery to express these facts *) +Lemma mult_by_two_level_mat_miss : forall m n U i j x y (v : Matrix m n), + i < m -> j < m -> + x <> i -> x <> j -> + WF_Matrix v -> + ((two_level_mat m U i j) × v) x y = v x y. +Proof. intros. + unfold two_level_mat, Mmult. + bdestruct (x j < m -> + WF_Matrix v -> + ((two_level_mat m U i j) × v) i y = (U × (get_two_rows v i j)) O y. +Proof. intros. + unfold two_level_mat, Mmult, get_two_rows. + simpl. + apply big_sum_unique2. + exists i, j; repeat (split; auto). + bdestruct_all; simpl. + ring. + intros. + bdestruct_all; simpl. + ring. +Qed. + +Lemma mult_by_two_level_mat_row2 : forall m n U i j y (v : Matrix m n), + i < j -> j < m -> + WF_Matrix v -> + ((two_level_mat m U i j) × v) j y = (U × (get_two_rows v i j)) 1%nat y. +Proof. intros. + unfold two_level_mat, Mmult, get_two_rows. + simpl. + apply big_sum_unique2. + exists i, j; repeat (split; auto). + bdestruct_all; simpl. + ring. + intros. + bdestruct_all; simpl. + ring. +Qed. + +(* combination of previous two lemmas *) +Lemma mult_by_two_level_mat : forall m n U i j (v : Matrix m n), + i < j -> j < m -> + WF_Matrix U -> + WF_Matrix v -> + get_two_rows ((two_level_mat m U i j) × v) i j = U × (get_two_rows v i j). +Proof. intros. + apply mat_equiv_eq. + apply WF_get_two_rows; apply WF_mult; auto. + apply WF_two_level_mat; try lia. + apply WF_mult; auto. + apply WF_get_two_rows; auto. + unfold mat_equiv; intros. + destruct i0. + rewrite <- mult_by_two_level_mat_row1; try lia; auto. + destruct i0; try lia. + rewrite <- mult_by_two_level_mat_row2; try lia; auto. +Qed. + +(* TODO: a lot of repeated code here. How to do more efficiently? *) +Lemma two_level_mat_mult : forall n U1 U2 i j, + i < j -> j < n -> + WF_Matrix U1 -> + WF_Matrix U2 -> + (two_level_mat n U1 i j) × (two_level_mat n U2 i j) = (two_level_mat n (U1 × U2) i j). +Proof. intros. + apply mat_equiv_eq. + apply WF_mult. + all : try apply (WF_two_level_mat); auto; try lia. + unfold mat_equiv; intros. + unfold two_level_mat, Mmult. + bdestruct (i0 =? i); bdestruct (i0 =? j); try lia; simpl; subst. + - bdestruct (j0 =? i); bdestruct (j0 =? j); try lia; simpl; subst. + + apply big_sum_unique2. + exists i, j; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. + + apply big_sum_unique2. + exists i, j; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. + + apply big_sum_unique. + exists j0; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. + - bdestruct (j0 =? i); bdestruct (j0 =? j); try lia; simpl; subst. + + apply big_sum_unique2. + exists i, j; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. + + apply big_sum_unique2. + exists i, j; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. + + apply big_sum_unique. + exists j0; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. + - apply big_sum_unique. + exists i0; repeat (split; auto). + bdestruct_all; simpl; try ring. + intros. + bdestruct_all; simpl; ring. +Qed. + + + + + +(****) diff --git a/Summation.v b/Summation.v index 6159482..bc6d63c 100644 --- a/Summation.v +++ b/Summation.v @@ -482,6 +482,30 @@ Proof. intros. apply Unique; try easy; lia. Qed. + +Lemma big_sum_unique2 : forall {G} `{Monoid G} k (f : nat -> G) n, + (exists x y, (x < y)%nat /\ (y < n)%nat /\ (f x) + (f y) = k /\ + (forall x', x' < n -> x <> x' -> y <> x' -> f x' = 0)) -> + big_sum f n = k. +Proof. + intros G H k f n [x [y [L1 [L2 [Eq Unique]]]]]. + induction n; try lia. + rewrite <- big_sum_extend_r. + destruct (Nat.eq_dec y n). + - subst. + apply f_equal_gen; auto; apply f_equal. + apply big_sum_unique. + exists x; split; auto; split; auto. + intros. + apply Unique; + lia. + - rewrite Unique; try easy; try lia. + rewrite Gplus_0_r. + apply IHn. + lia. + intros. + apply Unique; try easy; lia. +Qed. Lemma big_sum_sum : forall {G} `{Monoid G} m n f, big_sum f (m + n) = big_sum f m + big_sum (fun x => f (m + x)%nat) n. diff --git a/VecSet.v b/VecSet.v index f4972aa..5c5f2f5 100644 --- a/VecSet.v +++ b/VecSet.v @@ -6,290 +6,12 @@ Require Import Psatz. Require Import Reals. -Require Export Matrix. +Require Export RowColOps. -(************************************) -(** * some preliminary defs and lemmas *) -(************************************) - Local Open Scope nat_scope. -Definition e_i {n : nat} (i : nat) : Vector n := - fun x y => (if (x =? i) && (x 0) *) -Definition pad1 {n m : nat} (A : Matrix n m) (c : C) : Matrix (S n) (S m) := - col_wedge (row_wedge A Zero 0) (c .* e_i 0) 0. - -Lemma WF_pad1 : forall {n m : nat} (A : Matrix n m) (c : C), - WF_Matrix A <-> WF_Matrix (pad1 A c). -Proof. unfold WF_Matrix, pad1. split. - - intros. - unfold col_wedge, row_wedge, e_i, scale. - bdestruct (y (reduce A 0 0) × (reduce_row v 0) = reduce_row (A × v) 0. -Proof. intros. - prep_matrix_equality. - unfold Mmult, reduce, reduce_row. - bdestruct (x (reduce A n n) × (reduce_row v n) = reduce_row (A × v) n. -Proof. intros. - prep_matrix_equality. - unfold Mmult, reduce, reduce_row. - assert (H' : S n - 1 = n). { lia. } - bdestruct (x (reduce A x x) × (reduce_row v x) = reduce_row (A × v) x. -Proof. *) - - -(* similar lemma for append *) -Lemma append_mul : forall {n m} (A : Matrix n m) (v : Vector n) (a : Vector m), - (col_append A v) × (row_append a (@Zero 1 1)) = A × a. -Proof. intros. - prep_matrix_equality. - unfold Mmult. - simpl. - assert (H' : (col_append A v x m * row_append a Zero m y = C0)%C). - { unfold col_append, row_append. - bdestruct (m =? m); try lia; lca. } - rewrite H'. - rewrite Cplus_0_r. - apply big_sum_eq_bounded. - intros. - unfold col_append, row_append. - bdestruct (x0 =? m); try lia; try easy. -Qed. - -Lemma matrix_by_basis : forall {n m} (T : Matrix n m) (i : nat), - i < m -> get_vec i T = T × e_i i. -Proof. intros. unfold get_vec, e_i, Mmult. - prep_matrix_equality. - bdestruct (y =? 0). - - rewrite (big_sum_unique (T x i) _ m); try easy. - exists i. split. - apply H. split. - bdestruct (i =? i); bdestruct (i j -> A i j = C0) -> A 0 0 = c -> - exists a, pad1 a c = A. -Proof. intros. - exists (reduce_col (reduce_row A 0) 0). - unfold pad1, reduce_row, reduce_col, col_wedge, row_wedge, e_i, scale. - prep_matrix_equality. - bdestruct (y Prop) -> Prop := Inductive invr_col_add_many : (forall n m : nat, Matrix n m -> Prop) -> Prop := | invr_add_many : forall (P : (forall n m : nat, Matrix n m -> Prop)), (forall (n m col : nat) (T : Matrix n m) (as' : Vector m), - col < m -> as' col 0 = C0 -> P n m T -> P n m (col_add_many col as' T)) + col < m -> as' col 0 = C0 -> P n m T -> P n m (col_add_many T as' col)) -> invr_col_add_many P. Inductive invr_col_add_each : (forall n m : nat, Matrix n m -> Prop) -> Prop := | invr_add_each : forall (P : (forall n m : nat, Matrix n m -> Prop)), (forall (n m col : nat) (T : Matrix n m) (as' : Matrix 1 m), - col < m -> WF_Matrix as' -> P n m T -> P n m (col_add_each col (make_col_zero col as') T)) + col < m -> WF_Matrix as' -> P n m T -> P n m (col_add_each T (make_col_val as' col C0) col)) -> invr_col_add_each P. Inductive invr_pad1 : (forall n m : nat, Matrix n m -> Prop) -> Prop := @@ -329,12 +51,12 @@ Inductive invr_pad1 : (forall n m : nat, Matrix n m -> Prop) -> Prop := Inductive prop_zero_true : (forall n m : nat, Matrix n m -> Prop) -> Prop := | PZT : forall (P : (forall n m : nat, Matrix n m -> Prop)), - (forall (n m : nat) (T : Matrix n m), (exists i, i < m /\ get_vec i T = Zero) -> P n m T) -> + (forall (n m : nat) (T : Matrix n m), (exists i, i < m /\ get_col T i = Zero) -> P n m T) -> prop_zero_true P. Inductive prop_zero_false : (forall n m : nat, Matrix n m -> Prop) -> Prop := | PZF : forall (P : (forall n m : nat, Matrix n m -> Prop)), - (forall (n m : nat) (T : Matrix n m), (exists i, i < m /\ get_vec i T = Zero) -> ~ (P n m T)) -> + (forall (n m : nat) (T : Matrix n m), (exists i, i < m /\ get_col T i = Zero) -> ~ (P n m T)) -> prop_zero_false P. (* Ltac to help apply these properties of (Mat -> Prop)s *) @@ -347,17 +69,17 @@ Lemma mat_prop_col_add_many_some : forall (e n m col : nat) (P : forall n m : na (skip_count col e) < m -> col < m -> (forall i : nat, (skip_count col e) < i -> as' i 0 = C0) -> as' col 0 = C0 -> invr_col_add P -> - P n m T -> P n m (col_add_many col as' T). + P n m T -> P n m (col_add_many T as' col). Proof. induction e as [| e]. - intros. inversion H3; subst. - rewrite (col_add_many_col_add _ (skip_count col 0)); + rewrite (col_add_many_col_add _ _ _ (skip_count col 0)); try lia; try easy. apply H5; try lia. apply skip_count_not_skip. - assert (H' : (col_add_many col (make_row_zero (skip_count col 0) as') T) = T). + assert (H' : (col_add_many T (make_row_val as' (skip_count col O) C0) col) = T). { prep_matrix_equality. - unfold col_add_many, make_row_zero, skip_count, gen_new_vec, scale in *. + unfold col_add_many, make_row_val, skip_count, gen_new_col, scale in *. bdestruct (y =? col); try lia; try easy. rewrite <- Cplus_0_l. rewrite Cplus_comm. @@ -372,7 +94,7 @@ Proof. induction e as [| e]. apply skip_count_not_skip. - intros. inversion H3; subst. - rewrite (col_add_many_col_add _ (skip_count col (S e))); + rewrite (col_add_many_col_add _ _ _ (skip_count col (S e))); try lia; try easy. apply H5; try lia. apply skip_count_not_skip. @@ -381,7 +103,7 @@ Proof. induction e as [| e]. apply (skip_count_mono col) in H'. lia. intros. - unfold skip_count, make_row_zero in *. + unfold skip_count, make_row_val in *. bdestruct (e (skip_count col e) < m -> col < m -> (forall i : nat, (skip_count col e) < i -> as' 0 i = C0) -> as' 0 col = C0 -> invr_col_add P -> - P n m T -> P n m (col_add_each col as' T). + P n m T -> P n m (col_add_each T as' col). Proof. induction e as [| e]. - intros. inversion H4; subst. - rewrite (col_add_each_col_add _ (skip_count col 0)); try lia. + rewrite (col_add_each_col_add _ _ _ (skip_count col 0)); try lia. apply H6; try lia. assert (H' := skip_count_not_skip col 0). auto. - assert (H' : (make_col_zero (skip_count col 0) as') = Zero). + assert (H' : (make_col_val as' (skip_count col 0) C0) = Zero). { apply mat_equiv_eq; auto with wf_db. unfold mat_equiv; intros. - unfold make_col_zero, skip_count in *. + unfold make_col_val, skip_count in *. destruct i; try lia. destruct col; simpl in *. all : destruct j; try easy; simpl. @@ -461,7 +183,7 @@ Proof. induction e as [| e]. apply H; lia. - intros. inversion H4; subst. - rewrite (col_add_each_col_add _ (skip_count col (S e))); try lia. + rewrite (col_add_each_col_add _ _ _ (skip_count col (S e))); try lia. apply H6; try lia. assert (H' := skip_count_not_skip col (S e)). auto. apply IHe; try lia; try easy; auto with wf_db. @@ -469,7 +191,7 @@ Proof. induction e as [| e]. apply (skip_count_mono col) in H'. lia. intros. - unfold skip_count, make_col_zero in *. + unfold skip_count, make_col_val in *. bdestruct (e col < m -> as' col 0 = C0 -> - P n m (col_add_many col as' T) -> P n m T. + P n m (col_add_many T as' col) -> P n m T. Proof. intros. apply invr_col_add_col_add_many in H. inversion H; subst. - rewrite (col_add_many_inv T col as'); try easy. + rewrite (col_add_many_inv T as' col); try easy. apply H3; try easy. unfold scale; rewrite H1. lca. @@ -573,424 +295,15 @@ Lemma mat_prop_col_add_each_conv : forall {n m} (P : forall n m : nat, Matrix n (T : Matrix n m) (col : nat) (as' : Matrix 1 m), invr_col_add P -> col < m -> WF_Matrix as' -> - P n m (col_add_each col (make_col_zero col as') T) -> P n m T. + P n m (col_add_each T (make_col_val as' col C0) col) -> P n m T. Proof. intros. apply invr_col_add_col_add_each in H. inversion H; subst. - rewrite (col_add_each_inv col as'); try easy. + rewrite (col_add_each_inv _ as' col); try easy. apply H3; try easy. auto with wf_db. Qed. -(***********************************************************) -(** * Defining and proving lemmas relating to the determinant *) -(***********************************************************) - - -Fixpoint parity (n : nat) : C := - match n with - | 0 => C1 - | S 0 => -C1 - | S (S n) => parity n - end. - - -Lemma parity_S : forall (n : nat), - (parity (S n) = -C1 * parity n)%C. -Proof. intros. - induction n as [| n']; try lca. - rewrite IHn'. - simpl. lca. -Qed. - - -Fixpoint Determinant (n : nat) (A : Square n) : C := - match n with - | 0 => C1 - | S 0 => A 0 0 - | S n' => (big_sum (fun i => (parity i) * (A i 0) * (Determinant n' (reduce A i 0)))%C n) - end. - -Arguments Determinant {n}. - -Lemma Det_simplify : forall {n} (A : Square (S (S n))), - Determinant A = - (big_sum (fun i => (parity i) * (A i 0) * (Determinant (reduce A i 0)))%C (S (S n))). -Proof. intros. easy. Qed. - - -Lemma Det_simplify_fun : forall {n} (A : Square (S (S (S n)))), - (fun i : nat => parity i * A i 0 * Determinant (reduce A i 0))%C = - (fun i : nat => (big_sum (fun j => - (parity i) * (A i 0) * (parity j) * ((reduce A i 0) j 0) * - (Determinant (reduce (reduce A i 0) j 0)))%C (S (S n))))%C. -Proof. intros. - apply functional_extensionality; intros. - rewrite Det_simplify. - rewrite (@big_sum_mult_l C _ _ _ C_is_ring). - apply big_sum_eq_bounded; intros. - lca. -Qed. - - -Lemma reduce_I : forall (n : nat), reduce (I (S n)) 0 0 = I n. -Proof. intros. - apply mat_equiv_eq. - apply WF_reduce; try lia; auto with wf_db. - apply WF_I. - unfold mat_equiv; intros. - unfold reduce, I. - bdestruct (i - match (x, y) with - | (0, 0) => 1%R - | (0, 1) => 2%R - | (1, 0) => 4%R - | (1, 1) => 5%R - | _ => C0 - end. - - -Lemma Det_M22 : (Determinant M22) = (Copp (3%R,0%R))%C. -Proof. lca. Qed. - - - -(** Now, we show the effects of the column operations on determinant *) - -Lemma Determinant_scale : forall {n} (A : Square n) (c : C) (col : nat), - col < n -> Determinant (col_scale A col c) = (c * Determinant A)%C. -Proof. induction n. - + intros. easy. - + intros. simpl. - destruct n. - - simpl. unfold col_scale. - bdestruct (0 =? col); try lia; easy. - - rewrite Cmult_plus_distr_l. - apply Cplus_simplify. - * rewrite (@big_sum_mult_l C _ _ _ C_is_ring). - apply big_sum_eq_bounded. - intros. - destruct col. - rewrite col_scale_reduce_same; try lia. - unfold col_scale. bdestruct (0 =? 0); try lia. - lca. - rewrite col_scale_reduce_before; try lia. - rewrite Sn_minus_1. - rewrite IHn; try lia. - unfold col_scale. - bdestruct (0 =? S col); try lia; lca. - * destruct col. - rewrite col_scale_reduce_same; try lia. - unfold col_scale. bdestruct (0 =? 0); try lia. - lca. - rewrite col_scale_reduce_before; try lia. - rewrite Sn_minus_1. - rewrite IHn; try lia. - unfold col_scale. - bdestruct (0 =? S col); try lia; lca. -Qed. - - -(* some helper lemmas, since showing the effect of col_swap is a bit tricky *) -Lemma Det_diff_1 : forall {n} (A : Square (S (S (S n)))), - Determinant (col_swap A 0 1) = - big_sum (fun i => (big_sum (fun j => ((A i 1) * (A (skip_count i j) 0) * (parity i) * (parity j) * - Determinant (reduce (reduce A i 0) j 0))%C) - (S (S n)))) (S (S (S n))). -Proof. intros. - rewrite Det_simplify. - rewrite Det_simplify_fun. - apply big_sum_eq_bounded; intros. - apply big_sum_eq_bounded; intros. - replace (col_swap A 0 1 x 0) with (A x 1) by easy. - assert (H' : @reduce (S (S n)) (col_swap A 0 1) x 0 x0 0 = A (skip_count x x0) 0). - { unfold reduce, col_swap, skip_count. - simpl. bdestruct (x0 (big_sum (fun j => ((A i 0) * (A (skip_count i j) 1) * (parity i) * (parity j) * - Determinant (reduce (reduce A i 0) j 0))%C) - (S (S n)))) (S (S (S n))). -Proof. intros. - rewrite Det_simplify. - rewrite Det_simplify_fun. - apply big_sum_eq_bounded; intros. - apply big_sum_eq_bounded; intros. - apply Cmult_simplify; try easy. - assert (H' : @reduce (S (S n)) A x 0 x0 0 = A (skip_count x x0) 1). - { unfold reduce, col_swap, skip_count. - simpl. bdestruct (x0 Determinant (col_swap A 0 1) = (-C1 * (Determinant A))%C. -Proof. intros. - destruct n; try lia. - destruct n; try lia. - destruct n. - - simpl. unfold col_swap, reduce. lca. - - rewrite Det_diff_1, Det_diff_2. - apply big_sum_rearrange; intros. - + unfold skip_count. - bdestruct (x Determinant (col_swap A i (S i)) = (-C1 * (Determinant A))%C. -Proof. induction n as [| n']. - - easy. - - intros. - destruct i. - + apply Determinant_swap_01; easy. - + simpl. destruct n'; try lia. - do 2 rewrite (@big_sum_extend_r C C_is_monoid). - rewrite (@big_sum_mult_l C _ _ _ C_is_ring). - apply big_sum_eq_bounded; intros. - rewrite col_swap_reduce_before; try lia. - rewrite IHn'; try lia. - replace (col_swap A (S i) (S (S i)) x 0) with (A x 0) by easy. - lca. -Qed. - -(* swapping columns i and i + (S k), use previous lemma to induct *) -Lemma Determinant_swap_ik : forall {n} (k i : nat) (A : Square n), - i + (S k) < n -> Determinant (col_swap A i (i + (S k))) = (-C1 * (Determinant A))%C. -Proof. induction k as [| k']. - - intros. - replace (i + 1) with (S i) by lia. - rewrite Determinant_swap_adj; try lia; lca. - - intros. - rewrite (col_swap_three A i (i + (S k')) (i + (S (S k')))); try lia. - rewrite IHk'; try lia. - replace (i + (S (S k'))) with (S (i + (S k'))) by lia. - rewrite Determinant_swap_adj; try lia. - rewrite IHk'; try lia. - lca. -Qed. - -(* finally, we can prove Determinant_swap *) -Lemma Determinant_swap : forall {n} (A : Square n) (i j : nat), - i < n -> j < n -> i <> j -> - Determinant (col_swap A i j) = (-C1 * (Determinant A))%C. -Proof. intros. - bdestruct (i Determinant A = C0. -Proof. intros n A [i [H H0]]. - destruct n; try easy. - destruct n. - destruct i; try lia. - replace C0 with (@Zero 1 1 0 0) by easy. - rewrite <- H0. easy. - destruct i. - - rewrite Det_simplify. - apply (@big_sum_0_bounded C C_is_monoid); intros. - replace (A x 0) with (@Zero (S (S n)) 1 x 0) by (rewrite <- H0; easy). - unfold Zero; lca. - - rewrite (col_swap_inv _ 0 (S i)). - rewrite Determinant_swap; try lia. - rewrite Det_simplify. - rewrite (@big_sum_mult_l C _ _ _ C_is_ring). - apply (@big_sum_0_bounded C C_is_monoid); intros. - replace (col_swap A 0 (S i) x 0) with - (@Zero (S (S n)) 1 x 0) by (rewrite <- H0; easy). - unfold Zero; lca. -Qed. - -Lemma col_same_Det_0 : forall {n} (A : Square n) (i j : nat), - i < n -> j < n -> i <> j -> - get_vec i A = get_vec j A -> - Determinant A = C0. -Proof. intros. - apply eq_neg_implies_0. - rewrite <- (Determinant_swap _ i j); try easy. - rewrite (det_by_get_vec (col_swap A i j) A); try easy; intros. - prep_matrix_equality. - destruct y; try easy. - bdestruct (i0 =? i); bdestruct (i0 =? j); try lia. - - rewrite H3, <- col_swap_get_vec, H2; easy. - - rewrite H4, col_swap_diff_order, <- col_swap_get_vec, H2; easy. - - unfold col_swap, get_vec. simpl. - bdestruct (i0 =? i); bdestruct (i0 =? j); try lia; easy. -Qed. - -Lemma col_scale_same_Det_0 : forall {n} (A : Square n) (i j : nat) (c : C), - i < n -> j < n -> i <> j -> - get_vec i A = c .* (get_vec j A) -> - Determinant A = C0. -Proof. intros. - destruct (Ceq_dec c C0). - - apply col_0_Det_0. - exists i. - split; try easy. - rewrite H2, e. - apply Mscale_0_l. - - rewrite (col_scale_inv A j c); try easy. - rewrite Determinant_scale; try easy. - assert (H3 : Determinant (col_scale A j c) = C0). - { apply (col_same_Det_0 _ i j); try easy. - prep_matrix_equality. - unfold get_vec, col_scale. - bdestruct (y =? 0); try easy. - bdestruct (i =? j); bdestruct (j =? j); try lia. - rewrite <- get_vec_conv. - rewrite H2. - unfold scale. - rewrite get_vec_conv. - easy. } - rewrite H3. - lca. -Qed. - -(* use this to show det_col_add_0i *) -Lemma Det_col_add_comm : forall {n} (T : Matrix (S n) n) (v1 v2 : Vector (S n)), - (Determinant (col_wedge T v1 0) + Determinant (col_wedge T v2 0) = - Determinant (col_wedge T (v1 .+ v2) 0))%C. -Proof. intros. - destruct n; try easy. - do 3 rewrite Det_simplify. - rewrite <- (@big_sum_plus C _ _ C_is_comm_group). - apply big_sum_eq_bounded; intros. - repeat rewrite reduce_is_redcol_redrow. - repeat rewrite col_wedge_reduce_col_same. - unfold col_wedge, Mplus. - bdestruct (0 i <> 0 -> Determinant (col_add A 0 i c) = Determinant A. -Proof. intros. - destruct n; try easy. - rewrite col_add_split. - assert (H' := (@Det_col_add_comm n (reduce_col A 0) (get_vec 0 A) (c .* get_vec i A))). - rewrite <- H'. - rewrite <- Cplus_0_r. - apply Cplus_simplify. - assert (H1 : col_wedge (reduce_col A 0) (get_vec 0 A) 0 = A). - { prep_matrix_equality. - unfold col_wedge, reduce_col, get_vec. - destruct y; try easy; simpl. - replace (y - 0) with y by lia; easy. } - rewrite H1; easy. - apply (col_scale_same_Det_0 _ 0 i c); try lia. - prep_matrix_equality. - unfold get_vec, col_wedge, reduce_col, scale; simpl. - bdestruct (y =? 0); bdestruct (i =? 0); try lca; try lia. - replace (S (i - 1)) with i by lia. - easy. -Qed. - -Lemma Determinant_col_add : forall {n} (A : Square n) (i j : nat) (c : C), - i < n -> j < n -> i <> j -> Determinant (col_add A i j c) = Determinant A. -Proof. intros. - destruct j. - - rewrite <- col_swap_col_add_0. - rewrite Determinant_swap. - rewrite Determinant_col_add0i. - rewrite Determinant_swap. - lca. - all : easy. - - destruct i. - rewrite Determinant_col_add0i; try easy. - rewrite <- col_swap_col_add_Si. - rewrite Determinant_swap. - rewrite Determinant_col_add0i. - rewrite Determinant_swap. - lca. - all : try easy; try lia. -Qed. (** * We can now define some invariants for Determinant *) @@ -1022,7 +335,7 @@ Proof. apply invr_scale; intros. destruct H0; subst. split; auto. bdestruct (x as' col 0 = C0 -> - Determinant A = Determinant (col_add_many col as' A). + Determinant A = Determinant (col_add_many A as' col). Proof. intros. assert (H' := det_c_add_invr (Determinant A)). apply invr_col_add_col_add_many in H'. @@ -1145,20 +460,20 @@ Qed. Lemma Determinant_col_add_each : forall (n col : nat) (as' : Matrix 1 n) (A : Square n), col < n -> WF_Matrix as' -> as' 0 col = C0 -> - Determinant A = Determinant (col_add_each col as' A). + Determinant A = Determinant (col_add_each A as' col). Proof. intros. assert (H' := det_c_add_invr (Determinant A)). apply invr_col_add_col_add_each in H'. inversion H'; subst. - apply (H2 n n col A as') in H; try easy. - unfold det_eq_c in *. - destruct H; rewrite <- H3. - assert (H4 : (make_col_zero col as') = as'). + assert (H4 : (make_col_val as' col C0) = as'). { apply mat_equiv_eq; auto with wf_db. unfold mat_equiv; intros. - unfold make_col_zero. + unfold make_col_val. destruct i; try lia. bdestruct_all; subst; easy. } + apply (H2 n n col A as') in H; try easy. + unfold det_eq_c in *. + destruct H; rewrite <- H3. rewrite H4; easy. Qed. @@ -1237,45 +552,39 @@ Proof. intros. reflexivity. Qed. -Lemma lin_indep_col_reduce_n : forall {n m} (A : Matrix n (S m)), - linearly_independent A -> linearly_independent (reduce_col A m). +Lemma lin_indep_col_reduce : forall {m n} (A : Matrix m (S n)) (i : nat), + i <= n -> + linearly_independent A -> + linearly_independent (reduce_col A i). Proof. intros. unfold linearly_independent in *. intros. - assert (H' : row_append a Zero = Zero). - { apply H. - apply WF_row_append; try easy. - prep_matrix_equality. - unfold Mmult, row_append, Zero. - rewrite <- big_sum_extend_r. - bdestruct (m =? m); try lia. - autorewrite with C_db. - assert (H' : (reduce_col A m × a) x y = C0). - { rewrite H1; easy. } - rewrite <- H'. - unfold Mmult. - apply big_sum_eq_bounded. - intros. - unfold reduce_col. - bdestruct (x0 =? m); bdestruct (x0 linearly_independent A1. -Proof. induction m2 as [| m2']. +Proof. induction n2 as [| n2']. - intros. unfold linearly_independent in *. - intros. assert (H' : m1 + 0 = m1). lia. + intros. assert (H' : (n1 + 0)%nat = n1). lia. rewrite H' in *. apply H; try easy. rewrite <- H1. @@ -1283,13 +592,13 @@ Proof. induction m2 as [| m2']. prep_matrix_equality. apply big_sum_eq_bounded. intros. - bdestruct (x0 linearly_dependent (col_append A v). +Lemma lin_dep_col_wedge : forall {m n} (A : Matrix m n) (v : Vector m) (i : nat), + i <= n -> + linearly_dependent A -> + linearly_dependent (col_wedge A v i). Proof. intros. unfold linearly_dependent in *. - destruct H as [a [H [H1 H2]]]. - exists (row_append a (@Zero 1 1)). + destruct H0 as [a [H0 [H2 H3]]]. + exists (row_wedge a Zero i). split; auto with wf_db. - split. unfold not; intros; apply H1. - prep_matrix_equality. - assert (H' : row_append a Zero x y = C0). - { rewrite H0. easy. } - unfold row_append in H'. - bdestruct (x =? m). - rewrite H; try easy; lia. - rewrite H'; easy. - rewrite append_mul. - easy. + split. unfold not; intros; apply H2. + apply (row_wedge_zero _ i). + auto. + rewrite wedge_mul; auto. Qed. @@ -1420,7 +725,7 @@ Proof. apply PZF; intros. unfold Mmult, Zero, e_i; simpl. apply (@big_sum_0_bounded C C_is_monoid); intros. bdestruct_all; try lca; - rewrite <- get_vec_conv; subst. + rewrite <- get_col_conv; subst. rewrite H1; lca. } apply H0 in H2; auto with wf_db. assert (H3 : @e_i m i i 0 = C0). @@ -1513,7 +818,7 @@ Lemma lin_dep_gen_elem : forall {m n} (T : Matrix n (S m)), WF_Matrix T -> linearly_dependent T -> (exists i, i < (S m) /\ (exists v : Vector m, WF_Matrix v /\ - @Mmult n m 1 (reduce_col T i) v = (-C1) .* (get_vec i T))). + @Mmult n m 1 (reduce_col T i) v = (-C1) .* (get_col T i))). Proof. intros. unfold linearly_dependent in H. destruct H0 as [a [H1 [H2 H3]]]. @@ -1530,7 +835,7 @@ Proof. intros. unfold mat_equiv; intros. unfold Mmult, scale. assert (H' : (big_sum (fun y : nat => reduce_col T x i y * reduce_row a x y j) m + - (a x 0) * get_vec x T i j = @Zero n 1 i j)%C). + (a x 0) * get_col T x i j = @Zero n 1 i j)%C). { rewrite <- H3. unfold Mmult. assert (H'' : m = x + (m - x)). lia. rewrite H''. @@ -1547,7 +852,7 @@ Proof. intros. bdestruct (x0 reduce_col T x i y * reduce_row a x y j) m + - (a x 0) * get_vec x T i j + (a x 0) * (- (get_vec x T i j)) = - (- (a x 0)) * get_vec x T i j)%C). + (a x 0) * get_col T x i j + (a x 0) * (- (get_col T x i j)) = + (- (a x 0)) * get_col T x i j)%C). { rewrite H'. lca. } rewrite <- Cplus_assoc in H1'. rewrite <- Cmult_plus_distr_l in H1'. @@ -1576,10 +881,10 @@ Qed. Lemma gt_dim_lindep_ind_step1 : forall {n m} (T : Matrix (S n) (S m)) (col : nat), - WF_Matrix T -> col <= m -> get_vec col T = @e_i (S n) 0 -> + WF_Matrix T -> col <= m -> get_col T col = @e_i (S n) 0 -> linearly_dependent (reduce_row (reduce_col T col) 0) -> linearly_dependent T. Proof. intros. - apply (mat_prop_col_add_each_conv _ _ col (-C1 .* (get_row 0 T))); + apply (mat_prop_col_add_each_conv _ _ col (-C1 .* (get_row T 0))); auto with wf_db; try lia. apply lin_dep_add_invr. unfold linearly_dependent in *. @@ -1605,17 +910,17 @@ Proof. intros. apply mat_equiv_eq; auto with wf_db. apply WF_mult; auto with wf_db. unfold mat_equiv; intros. - assert (H' : (get_vec col T) i 0 = @e_i (S n) 0 i 0). + assert (H' : (get_col T col) i 0 = @e_i (S n) 0 i 0). { rewrite H1. easy. } - unfold col_add_each, make_col_zero, get_row, Mmult, Mplus, get_vec, - scale, row_append, row_wedge. + unfold col_add_each, make_col_val, get_row, Mmult, Mplus, get_col, + scale, row_wedge. destruct i. - * unfold get_vec, e_i in H'; simpl in H'. + * unfold get_col, e_i in H'; simpl in H'. rewrite H'. unfold Zero. apply (@big_sum_0_bounded C C_is_monoid). intros; simpl. bdestruct (x =? col); bdestruct (x col < S m -> v col 0 = C0 -> reduce_col (reduce_row T 0) col × (reduce_row v col) = - - C1 .* get_vec col (reduce_row T 0) -> + - C1 .* get_col (reduce_row T 0) col -> linearly_dependent (reduce_row (reduce_col T col) 0) -> linearly_dependent T. Proof. intros. assert (H' := @col_add_many_cancel n m (reduce_row T 0) v col). - assert (H0' : forall i : nat, @col_add_many n (S m) col v (reduce_row T 0) i col = C0). + assert (H0' : forall i : nat, @col_add_many n (S m) (reduce_row T 0) v col i col = C0). { apply H'; try easy. } apply (mat_prop_col_add_many_conv _ _ col v); try easy. apply lin_dep_add_invr. - destruct (Ceq_dec ((col_add_many col v T) 0 col) C0). + destruct (Ceq_dec ((col_add_many T v col) 0 col) C0). - apply_mat_prop (@lin_dep_pzt). apply H5; exists col. split; auto. - prep_matrix_equality. unfold get_vec. + prep_matrix_equality. unfold get_col. destruct y; try easy; simpl. destruct x; try easy. unfold Zero. rewrite <- (H0' x). unfold col_add_many, reduce_row. bdestruct (col =? col); bdestruct (x as' col 0 = C0 -> - op_to_I A -> op_to_I (col_add_many col as' A). + op_to_I A -> op_to_I (col_add_many A as' col). Proof. intros. assert (H' := otI'_add_invr). apply invr_col_add_col_add_many in H'. @@ -1890,18 +1190,18 @@ Qed. Lemma otI_col_add_each : forall (n col : nat) (A : Square n) (as' : Matrix 1 n), col < n -> WF_Matrix as' -> as' 0 col = C0 -> - op_to_I A -> op_to_I (col_add_each col as' A). + op_to_I A -> op_to_I (col_add_each A as' col). Proof. intros. - assert (H' := otI'_add_invr). - apply invr_col_add_col_add_each in H'. - inversion H'; subst. - apply (H3 n n col A as') in H; try easy. - assert (H4 : (make_col_zero col as') = as'). + assert (H4 : (make_col_val as' col C0) = as'). { apply mat_equiv_eq; auto with wf_db. unfold mat_equiv; intros. - unfold make_col_zero. + unfold make_col_val. destruct i; try lia. bdestruct_all; subst; easy. } + assert (H' := otI'_add_invr). + apply invr_col_add_col_add_each in H'. + inversion H'; subst. + apply (H3 n n col A as') in H; try easy. rewrite H4 in *. destruct H; easy. Qed. @@ -1919,7 +1219,7 @@ Lemma mpr_step1_pzf_P : forall {n} (A : Square (S n)) (P : forall m o, Matrix m prop_zero_false P -> WF_Matrix A -> P (S n) (S n) A -> (exists B : Square (S n), op_to_I B /\ P (S n) (S n) (A × B) /\ - (exists i, i < (S n) /\ get_vec i (A × B) = e_i 0)). + (exists i, i < (S n) /\ get_col (A × B) i = e_i 0)). Proof. intros. assert (H4 : WF_Matrix (reduce_row A 0)). { apply WF_reduce_row; try lia; easy. } @@ -1931,22 +1231,22 @@ Proof. intros. destruct H4 as [v [H4 H7]]. apply invr_col_add_col_add_many in H. inversion H; subst. - assert (H9 : P (S n) (S n) (col_add_many i (row_wedge v Zero i) A)). + assert (H9 : P (S n) (S n) (col_add_many A (row_wedge v Zero i) i)). apply H8; auto. unfold row_wedge; bdestruct_all; easy. - destruct (Ceq_dec ((col_add_many i (row_wedge v Zero i) A) 0 i) C0). + destruct (Ceq_dec ((col_add_many A (row_wedge v Zero i) i) 0 i) C0). - assert (H10 : forall i0 : nat, - col_add_many i (row_wedge v Zero i) (reduce_row A 0) i0 i = C0). + col_add_many (reduce_row A 0) (row_wedge v Zero i) i i0 i = C0). apply (col_add_many_cancel (reduce_row A 0) (row_wedge v Zero i) i); try easy. unfold row_wedge. bdestruct (i prop_zero_true P0 -> WF_Matrix A -> P (S n) (S n) A -> (exists B : Square (S n), op_to_I B /\ P (S n) (S n) (A × B) /\ - (exists i, i < (S n) /\ get_vec i (A × B) = e_i 0)) \/ P0 (S n) (S n) A. + (exists i, i < (S n) /\ get_col (A × B) i = e_i 0)) \/ P0 (S n) (S n) A. Proof. intros. assert (H5 : WF_Matrix (reduce_row A 0)). { apply WF_reduce_row; try lia; easy. } @@ -2029,23 +1328,23 @@ Proof. intros. destruct H5 as [v [H5 H8]]. apply invr_col_add_col_add_many in H. inversion H; subst. - assert (H10 : P (S n) (S n) (col_add_many i (row_wedge v Zero i) A)). + assert (H10 : P (S n) (S n) (col_add_many A (row_wedge v Zero i) i)). apply H9; auto. unfold row_wedge; bdestruct_all; easy. - destruct (Ceq_dec ((col_add_many i (row_wedge v Zero i) A) 0 i) C0). + destruct (Ceq_dec ((col_add_many A (row_wedge v Zero i) i) 0 i) C0). - right. assert (H11 : forall i0 : nat, - col_add_many i (row_wedge v Zero i) (reduce_row A 0) i0 i = C0). + col_add_many (reduce_row A 0) (row_wedge v Zero i) i i0 i = C0). apply (col_add_many_cancel (reduce_row A 0) (row_wedge v Zero i) i); try easy. unfold row_wedge. bdestruct (i Prop), invr_col_add P -> invr_col_swap P -> WF_Matrix A -> P (S n) (S n) A -> - (exists i, i < (S n) /\ get_vec i A = e_i 0) -> + (exists i, i < (S n) /\ get_col A i = e_i 0) -> (exists B : Square (S n), op_to_I B /\ P (S n) (S n) (A × B) /\ (exists a : Square n, pad1 a C1 = (A × B))). Proof. intros. @@ -2124,53 +1422,53 @@ Proof. intros. apply invr_col_add_col_add_each in H. inversion H; subst. assert (H3' : 0 < S n). lia. - apply (H6 _ _ 0 (col_swap A 0 i) (-C1 .* (get_row 0 (col_swap A 0 i)))) in H3'; try lia. - exists ((row_swap (I (S n)) 0 i) × (row_add_many 0 - (make_col_zero 0 (-C1 .* (get_row 0 (col_swap A 0 i)))) - (I (S n)))). + apply (H6 _ _ 0 (col_swap A 0 i) (-C1 .* (get_row (col_swap A 0 i) 0))) in H3'; try lia. + exists ((row_swap (I (S n)) 0 i) × (row_add_many (I (S n)) + (make_col_val (-C1 .* (get_row (col_swap A 0 i) 0)) 0 C0) 0)). split. apply otI_Mmult. rewrite <- col_row_swap_invr_I; try lia. apply otI_swap; try lia; apply otI_I. rewrite row_many_col_each_invr_I; try lia; auto. - apply otI_col_add_each; try lia; auto with wf_db. - all : try (apply WF_make_col_zero; apply WF_scale; + apply otI_col_add_each; try lia; auto with wf_db. + all : try (apply WF_make_col_val; apply WF_scale; apply WF_get_row; apply WF_col_swap; try lia; auto). apply otI_I. + apply WF_make_col_val; try lia; auto with wf_db. rewrite <- Mmult_assoc. rewrite <- col_swap_mult_r; try lia; try easy. rewrite <- col_add_each_mult_r; try lia; try easy. split; try easy. apply pad1ed_matrix; intros. - 4 : apply WF_make_col_zero. + 4 : apply WF_make_col_val; try lia. all : try (apply WF_scale; apply WF_get_row). all : try (apply WF_col_swap; try lia; easy). destruct H7 as [H7 H8]. - destruct H7. - + unfold col_add_each, make_col_zero, get_row, col_swap, - Mplus, Mmult, get_vec, scale. + destruct H7; try lia. + + unfold col_add_each, make_col_val, get_row, col_swap, + Mplus, Mmult, get_col, scale. rewrite H7 in *. bdestruct (j =? 0); try lia. - assert (H' : (get_vec i A) 0 0 = C1). + assert (H' : (get_col A i) 0 0 = C1). { rewrite H4. easy. } simpl. bdestruct (j =? i); try lia. - all : unfold get_vec in H'; simpl in H'. + all : unfold get_col in H'; simpl in H'. all : rewrite H'; lca. - + unfold col_add_each, make_col_zero, get_row, col_swap, - Mplus, Mmult, get_vec, scale. + + unfold col_add_each, make_col_val, get_row, col_swap, + Mplus, Mmult, get_col, scale. rewrite H7 in *; simpl. destruct i0; try lia. - assert (H' : (get_vec i A) (S i0) 0 = C0). + assert (H' : (get_col A i) (S i0) 0 = C0). { rewrite H4. easy. } - unfold get_vec in H'; simpl in H'. + unfold get_col in H'; simpl in H'. rewrite H'; lca. - + unfold col_add_each, make_col_zero, get_row, col_swap, - Mplus, Mmult, get_vec, scale; simpl. - assert (H' : (get_vec i A) 0 0 = C1). + + unfold col_add_each, make_col_val, get_row, col_swap, + Mplus, Mmult, get_col, scale; simpl. + assert (H' : (get_col A i) 0 0 = C1). { rewrite H4. easy. } - unfold get_vec in H'; simpl in H'. + unfold get_col in H'; simpl in H'. rewrite H'; lca. - + easy. + + easy. Qed. @@ -2249,7 +1547,7 @@ Proof. induction n as [| n']. all : try apply C1_neq_C0. rewrite <- Mmult_assoc, <- H7. rewrite <- pad1_mult, H10, Cmult_1_l, pad1_I; easy. - apply (WF_pad1 a C1). + apply (WF_pad1_conv a C1). rewrite H7; auto with wf_db. Qed. @@ -2268,13 +1566,41 @@ Qed. (** * Inverses of square matrices *) (*******************************) +(* all this code was written before we just defined the adjugate, which gives a constructive + inverse. hence, this section is a bit redundant. *) + + Definition Minv {n : nat} (A B : Square n) : Prop := A × B = I n /\ B × A = I n. Definition invertible {n : nat} (A : Square n) : Prop := - exists B, Minv A B. + exists B, WF_Matrix B /\ Minv A B. + + +Definition Minverse {n : nat} (A : Square n) : Square n := + / (Determinant A) .* adjugate A. + +Lemma WF_Minverse : forall {n} (A : Square n), + WF_Matrix (Minverse A). +Proof. intros. + unfold Minverse. + apply WF_scale. + apply WF_adjugate. +Qed. +#[export] Hint Resolve WF_Minverse : wf_db. + +Lemma Mmult_Minverse_l : forall {n} (A : Square n), + WF_Matrix A -> + Determinant A <> C0 -> + Minverse A × A = I n. +Proof. intros. + unfold Minverse. + rewrite Mscale_mult_dist_l, mult_by_adjugate_l, Mscale_assoc, Cinv_l; auto. + lma'. +Qed. + Lemma Minv_unique : forall (n : nat) (A B C : Square n), WF_Matrix A -> WF_Matrix B -> WF_Matrix C -> Minv A B -> Minv A C -> B = C. @@ -2308,6 +1634,18 @@ Proof. intros. rewrite H'; easy. Qed. +(* This gives us: (!!!) *) +Lemma Mmult_Minverse_r : forall {n} (A : Square n), + WF_Matrix A -> + Determinant A <> C0 -> + A × Minverse A = I n. +Proof. intros. + apply Minv_flip; auto. + apply WF_Minverse. + apply Mmult_Minverse_l; auto. +Qed. + + Lemma Minv_left : forall (n : nat) (A B : Square n), WF_Matrix A -> WF_Matrix B -> A × B = I n -> Minv A B. @@ -2329,7 +1667,7 @@ Proof. Qed. -Corollary lin_indep_invertible : forall (n : nat) (A : Square n), +Corollary lin_indep_iff_invertible : forall (n : nat) (A : Square n), WF_Matrix A -> (linearly_independent A <-> invertible A). Proof. intros; split. - intros. @@ -2337,12 +1675,14 @@ Proof. intros; split. apply lin_ind_implies_invertible_r in H; try easy. destruct H as [B [H H2]]. unfold invertible. - exists B. unfold Minv. + exists B. split. + auto with wf_db. + unfold Minv. split; try easy. apply Minv_flip in H2; auto with wf_db. - intros. - destruct H0 as [B [H1 H2]]. - apply invertible_l_implies_linind in H2. + destruct H0 as [B [H1 [H2 H3]]]. + apply invertible_l_implies_linind in H3. easy. Qed. @@ -2351,9 +1691,9 @@ Lemma Minv_otI_l : forall (n : nat) (A B : Square n), Minv A B -> op_to_I A. Proof. intros. - assert (H2 := lin_indep_invertible). + assert (H2 := lin_indep_iff_invertible). assert (H3 : invertible B). - { exists A. apply Minv_symm; easy. } + { exists A. split; auto; apply Minv_symm; easy. } apply H2 in H3; auto. apply lin_ind_implies_invertible_r in H3; auto. destruct H3 as [B' [H3 H4]]. @@ -2363,6 +1703,55 @@ Proof. intros. easy. Qed. +Corollary invertible_otI : forall (n : nat) (A : Square n), + WF_Matrix A -> + invertible A -> + op_to_I A. +Proof. intros. + destruct H0 as [B [H0 H1]]. + apply Minv_otI_l in H1; auto. +Qed. + +Corollary invertible_transpose : forall (n : nat) (A : Square n), + invertible A -> + invertible (A⊤). +Proof. intros. + destruct H as [A' [H [H0 H1]]]. + exists (A'⊤). + split; auto with wf_db. + split. + all : rewrite <- Mmult_transpose; auto. + rewrite H1, id_transpose_eq; easy. + rewrite H0, id_transpose_eq; easy. +Qed. + + +Lemma Mmult_cancel_l : forall {m n} (X : Square m) (A B : Matrix m n), + WF_Matrix X -> WF_Matrix A -> WF_Matrix B -> + Determinant X <> C0 -> + X × A = X × B -> + A = B. +Proof. intros. + assert (H' : Minverse X × X × A = Minverse X × X × B). + { rewrite 2 Mmult_assoc, H3. + easy. } + rewrite Mmult_Minverse_l in H'; auto. + rewrite 2 Mmult_1_l in H'; auto. +Qed. + +Lemma Mmult_cancel_r : forall {m n} (X : Square n) (A B : Matrix m n), + WF_Matrix X -> WF_Matrix A -> WF_Matrix B -> + Determinant X <> C0 -> + A × X = B × X-> + A = B. +Proof. intros. + assert (H' : A × X × Minverse X = B × X × Minverse X). + { rewrite H3. + easy. } + rewrite 2 Mmult_assoc in H'. + rewrite Mmult_Minverse_r in H'; auto. + rewrite 2 Mmult_1_r in H'; auto. +Qed. (*********************************************) (** * We finish proving lemmas about invarients *) @@ -2427,6 +1816,24 @@ Proof. intros. split. rewrite Det_I; apply C1_neq_C0. Qed. +Corollary lin_indep_iff_det_neq_0 : forall {n} (A : Square n), + WF_Matrix A -> (linearly_independent A <-> Determinant A <> C0). +Proof. intros; split; intros. + apply lin_indep_det_neq_0 in H0; auto. + destruct H0 as [H0 H1]; easy. + apply lin_indep_det_neq_0; auto. + split; easy. +Qed. + +Corollary invertible_iff_det_neq_0 : forall {n} (A : Square n), + WF_Matrix A -> (invertible A <-> Determinant A <> C0). +Proof. intros; split; intros. + apply lin_indep_iff_det_neq_0; auto. + apply lin_indep_iff_invertible; auto. + apply lin_indep_iff_invertible; auto. + apply lin_indep_iff_det_neq_0; auto. +Qed. + Corollary lin_dep_det_eq_0 : forall {n} (A : Square n), WF_Matrix A -> (linearly_dependent A <-> det_eq_c C0 A). Proof. induction n as [| n']. @@ -2452,13 +1859,13 @@ Proof. induction n as [| n']. assert (H'' : False). apply H'. split; easy. easy. - + apply (mat_prop_reduce_pzt_P0 _ _ (@linearly_dependent)) in H0; + + apply (mat_prop_reduce_pzt_P0 _ _ (@linearly_dependent)) in H0; auto with invr_db. destruct H0; try easy. destruct H0 as [B [H0 [H1 [a H2]]]]. assert (H' : linearly_dependent a). { apply IHn'. - apply <- (@WF_pad1 n' n' a C1). + apply (@WF_pad1_conv n' n' a C1). rewrite H2; auto with wf_db. apply_mat_prop det_0_pad1_invr. apply (H4 n' n' a C1). @@ -2468,16 +1875,16 @@ Proof. induction n as [| n']. destruct H' as [v [H3 [H4 H5]]]. exists (B × (row_wedge v Zero 0)); split. apply WF_mult; auto with wf_db. - apply WF_row_wedge; try lia; auto with wf_db. split. + split. unfold not; intros; apply H4. assert (H7 := H0); apply otI_lin_indep in H7. - apply lin_indep_invertible in H7; auto with wf_db. - destruct H7 as [B0 H7]. - assert (H8 : B0 × (B × row_wedge v Zero 0) = Zero). { rewrite H6, Mmult_0_r; easy. } - destruct H7. - rewrite <- Mmult_assoc, H9, Mmult_1_l in H8. + apply lin_indep_iff_invertible in H7; auto with wf_db. + destruct H7 as [B0 [H7 H8]]. + assert (H9 : B0 × (B × row_wedge v Zero 0) = Zero). { rewrite H6, Mmult_0_r; easy. } + destruct H8. + rewrite <- Mmult_assoc, H10, Mmult_1_l in H9. prep_matrix_equality. - assert (H' : row_wedge v Zero 0 (S x) y = C0). { rewrite H8; easy. } + assert (H' : row_wedge v Zero 0 (S x) y = C0). { rewrite H9; easy. } unfold Zero; rewrite <- H'. unfold row_wedge; bdestruct_all. rewrite Sn_minus_1; easy. @@ -2502,6 +1909,23 @@ Proof. intros. split; easy. Qed. +Corollary det_eq_0_transpose : forall {n} (A : Square n), + WF_Matrix A -> + det_eq_c C0 A -> + det_eq_c C0 (A⊤). +Proof. intros. + apply lin_dep_det_eq_0; auto with wf_db. + destruct (lin_dep_indep_dec (A⊤)); auto with wf_db. + apply lin_indep_iff_invertible in l. + apply invertible_transpose in l. + rewrite transpose_involutive in l. + apply lin_indep_iff_invertible in l. + apply lin_indep_det_neq_0 in l. + destruct H0; destruct l; easy. + all : auto with wf_db. +Qed. + + (*************************************************************************************) (** * we define another set of invariants to help show that Det A × Det B = Det (A × B) *) (*************************************************************************************) @@ -2567,7 +1991,7 @@ Proof. intros. rewrite <- col_scale_mult_r; auto with wf_db. rewrite <- col_row_scale_invr_I; auto. bdestruct (x Det_transpose_comm n n A. +Proof. intros. + unfold Det_transpose_comm. + erewrite transpose_make_WF; try apply R4. + repeat rewrite <- Det_make_WF; try easy. +Qed. + +Lemma Dtc_Mmult : forall {n} (A B : Square n), + Det_transpose_comm n n A -> Det_transpose_comm n n B -> + Det_transpose_comm n n (A × B). +Proof. intros. + destruct H; destruct H0; subst. + split; auto. + rewrite Mmult_transpose; auto. + do 2 rewrite <- Determinant_multiplicative. + rewrite H1, H2; ring. +Qed. + +Lemma Dtc_swap_I : forall (n x y : nat), + x < n -> y < n -> + Det_transpose_comm n n (row_swap (I n) x y). +Proof. intros. + bdestruct (x =? y); subst. + - rewrite row_swap_same. + apply Dtc_I. + - split; auto; intros. + apply f_equal. + rewrite row_swap_transpose, id_transpose_eq. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + unfold row_swap, col_swap, I. + bdestruct_all; simpl; easy. +Qed. + +Lemma Dtc_scale_I : forall (n x : nat) (c : C), + Det_transpose_comm n n (row_scale (I n) x c). +Proof. intros. + split; auto; intros. + bdestruct (x y -> x < n -> y < n -> Det_transpose_comm n n (row_add (I n) x y c). +Proof. intros. + split; auto; intros. + rewrite <- col_row_add_invr_I, col_add_transpose, id_transpose_eq, + <- col_row_add_invr_I; auto. + rewrite Determinant_col_add, Det_I, Determinant_col_add, Det_I; auto. +Qed. + +(* proving Dtc invariants *) +Lemma Dtc_swap_invr : invr_col_swap (Det_transpose_comm). +Proof. apply invr_swap; intros. + bdestruct (x =? y); subst. + - rewrite col_swap_same; easy. + - bdestruct (n =? m); subst; try (destruct H1; try lia; easy). + apply Dtc_make_WF. + rewrite <- col_swap_make_WF; auto. + erewrite col_swap_mult_r; auto with wf_db. + apply Dtc_Mmult. + apply Dtc_make_WF; easy. + apply Dtc_swap_I; auto. +Qed. + +Lemma Dtc_scale_invr : invr_col_scale (Det_transpose_comm). +Proof. apply invr_scale; intros. + bdestruct (n =? m); subst; try (destruct H1; try lia; easy). + apply Dtc_make_WF. + rewrite <- col_scale_make_WF; auto. + rewrite col_scale_mult_r; auto with wf_db. + apply Dtc_Mmult. + apply Dtc_make_WF; easy. + apply Dtc_scale_I; auto. + destruct H0; easy. +Qed. + +Lemma Dtc_add_invr : invr_col_add (Det_transpose_comm). +Proof. apply invr_add; intros. + bdestruct (n =? m); subst; try (destruct H2; try lia; easy). + apply Dtc_make_WF. + rewrite <- col_add_make_WF; auto. + rewrite col_add_mult_r; auto with wf_db. + apply Dtc_Mmult. + apply Dtc_make_WF; easy. + apply Dtc_add_I; auto. +Qed. + +Lemma otI_Dtc : forall {n} (A : Square n), + op_to_I A -> Det_transpose_comm n n A. +Proof. intros n A. + apply invr_P_implies_otI_weak. + apply_mat_prop Dtc_swap_invr. + apply_mat_prop Dtc_scale_invr. + apply_mat_prop Dtc_add_invr. + apply Dtc_I. +Qed. + +Lemma Determinant_transpose_WF : forall {n} (A : Square n), + WF_Matrix A -> + Determinant A = Determinant A⊤. +Proof. intros. + destruct (Ceq_dec (Determinant A) C0). + - assert (H' : det_eq_c C0 (A) ⊤). + { apply det_eq_0_transpose; auto. + split; auto. } + destruct H'. + rewrite e, H1; easy. + - assert (H' : det_neq_0 A). + { split; auto. } + apply lin_indep_det_neq_0 in H'; auto. + apply lin_indep_iff_invertible in H'; auto. + destruct H' as [H' [H'']]. + apply Minv_otI_l in H0; auto. + apply otI_Dtc in H0. + destruct H0; easy. +Qed. + +Theorem Determinant_transpose : forall {n} (A : Square n), + Determinant A = Determinant A⊤. +Proof. intros. + rewrite Det_make_WF, (Det_make_WF _ (A⊤)); auto. + erewrite <- transpose_make_WF; auto. + rewrite Determinant_transpose_WF; auto with wf_db. +Qed. + +(* TODO: move to Matrix.v if this would actually be useful somewhere else *) +Definition Mconj {n} (A : Square n) : Square n := fun i j => (A i j)^*. + +Lemma adjoint_transpose : forall {n} (A : Square n), A† = Mconj (A⊤). +Proof. intros. easy. Qed. + +Lemma Cconj_parity : forall x, parity x = parity x ^*. +Proof. intros. + induction x; try lca. + rewrite parity_S, Cconj_mult_distr, <- IHx. + lca. +Qed. + +Lemma Mconj_det : forall {n} (A : Square n), + Determinant (Mconj A) = (Determinant A)^*. +Proof. induction n; intros. + lca. + do 2 rewrite Det_simplify. + rewrite (@big_sum_func_distr C C _ _ _ C_is_group). + apply big_sum_eq_bounded; intros. + rewrite 2 Cconj_mult_distr. + apply f_equal_gen; try apply f_equal. + apply f_equal_gen; try apply f_equal. + apply Cconj_parity. + easy. + rewrite <- IHn. + apply f_equal_gen; try apply f_equal; auto. + prep_matrix_equality. + unfold get_minor, Mconj. + bdestruct_all; easy. + intros. + lca. +Qed. + +Lemma Mconj_adjugate : forall {n} (A : Square n), + adjugate (Mconj A) = Mconj (adjugate A). +Proof. destruct n; intros. + prep_matrix_equality. + unfold Mconj; simpl; lca. + unfold adjugate, Mconj. + prep_matrix_equality. + bdestruct_all; simpl; try lca. + rewrite Cconj_mult_distr. + apply f_equal_gen; try apply f_equal. + apply Cconj_parity. + rewrite <- Mconj_det. + apply f_equal_gen; auto. + prep_matrix_equality. + unfold get_minor, Mconj. + bdestruct_all; easy. +Qed. + +Corollary Determinant_adjoint : forall {n} (A : Square n), + (Determinant A)^* = (Determinant A†). +Proof. intros. + rewrite adjoint_transpose, Mconj_det, Determinant_transpose. + easy. +Qed. + +(** Now we get some results about the adjugate of a matrix *) + +Lemma adjugate_transpose : forall {n} (A : Square n), + WF_Matrix A -> + adjugate (A⊤) = (adjugate A)⊤. +Proof. intros. + destruct n. + prep_matrix_equality. + unfold transpose; easy. + apply mat_equiv_eq; auto with wf_db. + unfold mat_equiv; intros. + unfold adjugate. + rewrite <- get_minor_transpose, <- Determinant_transpose. + unfold transpose. + bdestruct_all; simpl. + repeat (apply f_equal_gen; try lia); easy. +Qed. + +Lemma adjugate_adjoint : forall {n} (A : Square n), + WF_Matrix A -> + adjugate (A†) = (adjugate A)†. +Proof. intros. + rewrite adjoint_transpose, Mconj_adjugate, adjugate_transpose; auto. +Qed. + +Lemma Minverse_transpose : forall {n} (A : Square n), + WF_Matrix A -> + Minverse (A⊤) = (Minverse A)⊤. +Proof. intros. + unfold Minverse. + rewrite adjugate_transpose, <- Determinant_transpose; auto. +Qed. + +Lemma Minverse_adjoint : forall {n} (A : Square n), + WF_Matrix A -> + Minverse (A†) = (Minverse A)†. +Proof. intros. + unfold Minverse. + rewrite adjugate_adjoint, <- Determinant_adjoint, Mscale_adj; auto. + apply f_equal_gen; try apply f_equal; auto. + remember (Determinant A) as a. + unfold Cconj, Cinv. + apply c_proj_eq; simpl. + replace (- snd a * (- snd a * 1))%R with (snd a * (snd a * 1))%R by lra. + easy. + replace (- snd a * (- snd a * 1))%R with (snd a * (snd a * 1))%R by lra. + rewrite 2 Rdiv_unfold, Ropp_mult_distr_l. + easy. +Qed. + +Theorem mult_by_adjugate_r : forall {n} (A : Square (S n)), + WF_Matrix A -> + A × (adjugate A) = (Determinant A) .* (I (S n)). +Proof. intros. + assert (H0 : adjugate (A⊤) × (A⊤) = Determinant (A⊤) .* I (S n)). + { apply mult_by_adjugate_l; auto with wf_db. } + apply (f_equal transpose) in H0. + rewrite Mmult_transpose, transpose_involutive, <- Determinant_transpose, + Mscale_trans, id_transpose_eq, adjugate_transpose in H0; auto. +Qed. diff --git a/VectorStates.v b/VectorStates.v index 2f9b60e..9ff7f44 100644 --- a/VectorStates.v +++ b/VectorStates.v @@ -1,4 +1,5 @@ Require Export Pad. +Require Export CauchySchwarz. (* This file provides abstractions for describing quantum states as vectors. - f_to_vec describes classical states as boolean functions @@ -1310,7 +1311,6 @@ Lemma WF_vkron : forall n (f : nat -> Vector 2), Proof. intros. induction n; simpl; auto with wf_db. - apply WF_kron; auto. lia. Qed. #[export] Hint Resolve WF_vkron: wf_db. diff --git a/coq-quantumlib.opam b/coq-quantumlib.opam index 139c5dc..4adfcb6 100644 --- a/coq-quantumlib.opam +++ b/coq-quantumlib.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "1.3.0" +version: "1.4.0" synopsis: "Coq library for reasoning about quantum programs" description: """ inQWIRE's QuantumLib is a Coq library for reasoning @@ -31,4 +31,4 @@ build: [ "@doc" {with-doc} ] ] -dev-repo: "git+https://github.com/inQWIRE/QuantumLib.git" +dev-repo: "git+https://github.com/inQWIRE/QuantumLib.git" \ No newline at end of file diff --git a/dune-project b/dune-project index cecdbce..4a8a044 100644 --- a/dune-project +++ b/dune-project @@ -1,6 +1,6 @@ (lang dune 2.8) (name coq-quantumlib) -(version 1.3.0) +(version 1.4.0) (using coq 0.2) (generate_opam_files true)