From bc58d879f3c37f25effe5df3dc0ec6030672c6f5 Mon Sep 17 00:00:00 2001 From: Alex Gryzlov Date: Wed, 7 Dec 2022 13:10:54 +0100 Subject: [PATCH] refactor proofs in theory --- README.md | 4 +- meta.yml | 6 +- theory/atomic_operations.v | 85 ++++------ theory/bareiss.v | 77 ++++------ theory/bareiss_dvdring.v | 128 ++++++--------- theory/binetcauchy.v | 132 +++++++--------- theory/closed_poly.v | 99 ++++++------ theory/coherent.v | 115 +++++++------- theory/companion.v | 56 +++---- theory/dvdring.v | 308 +++++++++++++++++-------------------- theory/edr.v | 24 +-- theory/fpmod.v | 20 +-- theory/frobenius_form.v | 226 +++++++++++++-------------- theory/gauss.v | 2 +- theory/jordan.v | 138 ++++++++--------- theory/kaplansky.v | 40 +++-- theory/karatsuba.v | 35 ++--- theory/minor.v | 67 ++++---- theory/mxstructure.v | 80 +++++----- theory/perm_eq_image.v | 10 +- theory/polydvd.v | 171 ++++++++++---------- theory/rank.v | 40 +++-- theory/similar.v | 185 +++++++++++----------- theory/smith.v | 66 ++++---- theory/smith_complements.v | 160 +++++++++---------- theory/smithpid.v | 40 ++--- theory/ssrcomplements.v | 16 +- theory/strassen.v | 10 +- theory/stronglydiscrete.v | 28 ++-- theory/toomcook.v | 23 ++- 30 files changed, 1109 insertions(+), 1282 deletions(-) diff --git a/README.md b/README.md index ea6a564..b325c69 100644 --- a/README.md +++ b/README.md @@ -105,8 +105,8 @@ The theory directory has the following content: - `companion`, `frobenius_form`, `jordan`, `perm_eq_image`, `smith_complements`: Results on normal forms of matrices. -- `bareiss_dvdring`, `bareiss`, `gauss`, `karatsuba`, `rank` - `strassen` `toomcook`, `smithpid`, `smith`: Various efficient +- `bareiss_dvdring`, `bareiss`, `gauss`, `karatsuba`, `rank`, + `strassen`, `toomcook`, `smithpid`, `smith`: Various efficient algorithms for computing operations on polynomials or matrices. ## Refinements diff --git a/meta.yml b/meta.yml index 4656a04..eb66881 100644 --- a/meta.yml +++ b/meta.yml @@ -168,8 +168,8 @@ documentation: |- - `companion`, `frobenius_form`, `jordan`, `perm_eq_image`, `smith_complements`: Results on normal forms of matrices. - - `bareiss_dvdring`, `bareiss`, `gauss`, `karatsuba`, `rank` - `strassen` `toomcook`, `smithpid`, `smith`: Various efficient + - `bareiss_dvdring`, `bareiss`, `gauss`, `karatsuba`, `rank`, + `strassen`, `toomcook`, `smithpid`, `smith`: Various efficient algorithms for computing operations on polynomials or matrices. ## Refinements @@ -201,7 +201,7 @@ documentation: |- - `seqmatrix` and `seqmx_complements`: Refinement of MathComp matrices (`M[R]_(m,n)`) to lists of lists (`seq (seq R)`). - + - `seqpoly`: Refinement of MathComp polynomials (`{poly R}`) to lists (`seq R`). - `multipoly`: Refinement of diff --git a/theory/atomic_operations.v b/theory/atomic_operations.v index 7266293..8197dcc 100644 --- a/theory/atomic_operations.v +++ b/theory/atomic_operations.v @@ -44,16 +44,14 @@ Lemma lines_scale_row m n a (M: 'M[R]_(m,n)): Proof. move => s. elim : s n M => [ | hd tl hi] //= n M /andP [h1 h2]. -split => i. -- rewrite in_cons => /orP [] hin. - + rewrite (eqP hin) {i hin}. - case: (hi _ (line_scale hd a M) h2) => _ hr. +split => i; rewrite in_cons. +- move/orP => [/eqP{i}-> | hin]. + + case: (hi _ (line_scale hd a M) h2) => _ hr. by rewrite hr // line_scale_row_eq. - case: (hi _ (line_scale hd a M) h2) => hl _. - rewrite hl // line_scale_row_neq //. - apply/negP => /eqP heq. - by move: h1; rewrite heq hin. -rewrite in_cons negb_or => /andP [hl hr]. + case: (hi _ (line_scale hd a M) h2) => -> // _. + rewrite line_scale_row_neq //. + by apply: contraNneq h1 => ->. +rewrite negb_or => /andP[hl hr]. case: (hi _ (line_scale hd a M) h2) => _ hR. by rewrite hR // line_scale_row_neq // eq_sym. Qed. @@ -79,7 +77,7 @@ Lemma det_line_scale_mx : forall n k a (M: 'M[R]_n), Proof. rewrite /line_scale_mx => n k a M. rewrite det_mulmx det_diag (bigD1 k) //= big1 /=; - first by rewrite !mxE mulr1 eqxx /=. + first by rewrite !mxE mulr1 eqxx. by move => i /negbTE h; rewrite !mxE h. Qed. @@ -130,17 +128,14 @@ Proof. move => s. elim : s M => [ | hd tl hi] //= M /andP [h1 h2]. rewrite in_cons negb_or => /andP [hl1 hl2]. -split => i. -- rewrite in_cons => /orP [] hin. - + rewrite (eqP hin) {i hin}. - case: (hi (line_comb hd l a M) h2 hl2) => _ hr. +split => i; rewrite in_cons. +- move/orP => [/eqP{i}-> | hin]. + + case: (hi (line_comb hd l a M) h2 hl2) => _ hr. by rewrite hr // line_comb_row_eq. - case: (hi (line_comb hd l a M) h2 hl2) => hl _. - rewrite hl // !line_comb_row_neq //. - + by rewrite eq_sym. - apply/negP => /eqP heq. - by move: h1; rewrite heq hin. -rewrite in_cons negb_or => /andP [hl hr]. + case: (hi (line_comb hd l a M) h2 hl2) => -> // _. + rewrite !line_comb_row_neq // eq_sym // eq_sym. + by apply: contraNneq h1 => ->. +rewrite negb_or => /andP [hl hr]. case: (hi (line_comb hd l a M) h2 hl2) => _ hR. by rewrite hR // !line_comb_row_neq // eq_sym. Qed. @@ -157,17 +152,14 @@ Proof. move => s. elim : s M => [ | hd tl hi] //= M /andP [h1 h2]. rewrite in_cons negb_or => /andP [hl1 hl2]. -split => i. -- rewrite in_cons => /orP [] hin. - + rewrite (eqP hin) {i hin}. - case: (hi (line_comb hd l (a hd) M) h2 hl2) => _ hr. +split => i; rewrite in_cons. +- move/orP => [/eqP{i}-> | hin]. + + case: (hi (line_comb hd l (a hd) M) h2 hl2) => _ hr. by rewrite hr // line_comb_row_eq. - case: (hi (line_comb hd l (a hd) M) h2 hl2) => hl _. - rewrite hl // !line_comb_row_neq //. - + by rewrite eq_sym. - apply/negP => /eqP heq. - by move: h1; rewrite heq hin. -rewrite in_cons negb_or => /andP [hl hr]. + case: (hi (line_comb hd l (a hd) M) h2 hl2) => -> // _. + rewrite !line_comb_row_neq // eq_sym // eq_sym. + by apply: contraNneq h1 => ->. +rewrite negb_or => /andP [hl hr]. case: (hi (line_comb hd l (a hd) M) h2 hl2) => _ hR. by rewrite hR // !line_comb_row_neq // eq_sym. Qed. @@ -179,24 +171,13 @@ Proof. move => n k l a M hkl. have h : row k (line_comb k l a M) = 1 *: row k M + a *: row k (\matrix_(i < n) if i == k then row l M else row i M). -- rewrite /line_comb scale1r. - by apply/rowP => i; rewrite !mxE eqxx !mxE. + by rewrite scale1r; apply/rowP => i; rewrite !mxE eqxx !mxE. rewrite (determinant_multilinear h). - rewrite mul1r [X in a * X](determinant_alternate hkl). + by rewrite mulr0 addr0. - move => x; rewrite !mxE eqxx eq_sym. - move: hkl. - by case hlk : (k == l). -- rewrite /line_comb; apply/matrixP => i j; rewrite !mxE. - case heq: (lift k i == k). - + move/negP : (neq_lift k i). - by rewrite (eqP heq) eqxx. - by rewrite !mxE. -- rewrite /line_comb; apply/matrixP => i j; rewrite !mxE. - case heq: (lift k i == k). - + move/negP : (neq_lift k i). - by rewrite (eqP heq) eqxx. - by rewrite !mxE. + by move => x; rewrite !mxE eqxx eq_sym (negbTE hkl). +- by apply/matrixP => i j; rewrite !mxE eq_sym (negbTE (neq_lift k i)) !mxE. +by apply/matrixP => i j; rewrite !mxE eq_sym (negbTE (neq_lift k i)) !mxE. Qed. Lemma det_lines_comb m a l (M: 'M[R]_m) s: @@ -226,17 +207,11 @@ move => n k l a M /eqP ->; clear k. have h : row l (line_comb l l a M) = 1 *: row l M + a *: row l M. - rewrite /line_scale. by apply/rowP => i; rewrite !mxE eqxx !mxE mul1r. -rewrite (determinant_multilinear h) ?mulrDl => //. +rewrite (determinant_multilinear h) ?mulrDl //. rewrite /line_scale; apply/matrixP => i j; rewrite !mxE. - case heq: (lift l i == l). - + move/negP : (neq_lift l i). - by rewrite (eqP heq) eqxx. - by rewrite !mxE. + by rewrite eq_sym (negbTE (neq_lift l i)) !mxE. rewrite /line_scale; apply/matrixP => i j; rewrite !mxE. -case heq: (lift l i == l). -- move/negP : (neq_lift l i). - by rewrite (eqP heq) eqxx. -by rewrite !mxE. +by rewrite eq_sym (negbTE (neq_lift l i)) !mxE. Qed. -End atomic_operations. \ No newline at end of file +End atomic_operations. diff --git a/theory/bareiss.v b/theory/bareiss.v index f695a2b..bb48943 100644 --- a/theory/bareiss.v +++ b/theory/bareiss.v @@ -62,25 +62,24 @@ Variable R : comRingType. Fixpoint bareiss_rec m (a : {poly R}) : 'M[{poly R}]_(1 + m, 1 + m) -> {poly R} := - match m with - | S p => fun M => + if m is p.+1 then + fun M => let d := M 0 0 in let l := ursubmx M in let c := dlsubmx M in let N := drsubmx M in - let M' := (d *: N - c *m l) in + let M' := d *: N - c *m l in let M'' := map_mx (fun x => rdivp x a) M' in - bareiss_rec d M'' - | _ => fun M => M 0 0 - end. + bareiss_rec d M'' + else fun M => M 0 0. -Definition bareiss n (M : 'M_(1 + n, 1 + n)) : {poly R} := bareiss_rec 1 M. +Definition bareiss n (M : 'M_(1 + n, 1 + n)) : {poly R} := bareiss_rec 1 M. Definition bareiss_char_poly n (M : 'M_(1 + n, 1 + n)) : {poly R} := bareiss (char_poly_mx M). (* The actual determinant function based on Bareiss *) -Definition bdet n (M : 'M_(1 + n, 1 + n)) : R := +Definition bdet n (M : 'M_(1 + n, 1 + n)) : R := (bareiss_char_poly (- M))`_0. End bareiss. @@ -91,8 +90,8 @@ Variable R : comRingType. Lemma bareiss_recE : forall m a (M : 'M[{poly R}]_(1 + m)), a \is monic -> - (forall p (h h' : p < 1 + m), pminor h h' M \is monic) -> - (forall k (f g : 'I_k.+1 -> 'I_m.+1), rdvdp (a ^+ k) (minor f g M)) -> + (forall p (h h' : p < 1 + m), pminor h h' M \is monic) -> + (forall k (f g : 'I_k.+1 -> 'I_m.+1), rdvdp (a ^+ k) (minor f g M)) -> a ^+ m * (bareiss_rec a M) = \det M. Proof. elim=> [a M _ _ _|m ih a M am hpm hdvd] /=. @@ -101,12 +100,12 @@ have ak_monic k : a ^+ k \is monic by apply/monic_exp. set d := M 0 0; set M' := (_ - _); set M'' := map_mx _ _; rewrite /= in M' M'' *. have d_monic : d \is monic. have -> // : d = pminor (ltn0Sn _) (ltn0Sn _) M. - have h : widen_ord (ltn0Sn m.+1) =1 (fun _ => 0) + have h : widen_ord (ltn0Sn m.+1) =1 (fun=> 0) by move=> x; apply/ord_inj; rewrite [x]ord1. by rewrite /pminor (minor_eq h h) minor1. have dk_monic : forall k, d ^+ k \is monic by move=> k; apply/monic_exp. have hM' : M' = a *: M''. - pose f := fun m (i : 'I_m) (x : 'I_2) => if x == 0 then 0 else (lift 0 i). + pose f := fun m (i : 'I_m) (x : 'I_2) => if x == 0 then 0 else lift 0 i. apply/matrixP => i j. rewrite !mxE big_ord1 !rshift1 [a * _]mulrC rdivpK ?(eqP am,expr1n,mulr1) //. move: (hdvd 1%nat (f _ i) (f _ j)). @@ -122,7 +121,7 @@ case/rdvdpP: (hdvd _ (lift_pred f) (lift_pred g)) => // x hx. apply/rdvdpP => //; exists x. apply/(@lregX _ _ k.+1 (monic_lreg am))/(monic_lreg d_monic). rewrite -detZ -submatrix_scale -hM' bareiss_block_key_lemma_sub. -by rewrite mulrA [x * _]mulrC mulrACA -exprS [_ * x]mulrC -hx. +by rewrite mulrA [x * _]mulrC mulrACA -exprS [_ * x]mulrC -hx. Qed. Lemma bareissE n (M : 'M[{poly R}]_(1 + n)) @@ -166,9 +165,7 @@ Proof. rewrite /dvd_step => n a M hj. rewrite -detZ; f_equal. apply/matrixP => i j; rewrite !mxE. -case: odivrP. -- move => d /=; by rewrite mulrC. -move => h. +case: odivrP=>[d|h] /=; first by rewrite mulrC. case/dvdrP: (hj i j) => d hd. by move: (h d); rewrite hd eqxx. Qed. @@ -200,8 +197,7 @@ Proof. rewrite !mxE. case: splitP => x //; rewrite [x]ord1 {x} !mxE => _. case: splitP => x; first by rewrite [x]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h. -by have -> : i = x by apply/ord_inj. +by rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. Qed. Lemma blockEi0 m n d (l: 'rV[R]_n) (c: 'cV[R]_m) (M: 'M[R]_(m,n)) i: @@ -209,8 +205,7 @@ Lemma blockEi0 m n d (l: 'rV[R]_n) (c: 'cV[R]_m) (M: 'M[R]_(m,n)) i: Proof. rewrite !mxE. case: splitP => x; first by rewrite [x]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h. -have -> : i = x by apply/ord_inj. +rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. rewrite !mxE. by case: splitP => y //; rewrite [y]ord1 {y} => _. Qed. @@ -220,12 +215,10 @@ Lemma blockEij m n d (l: 'rV[R]_n) (c: 'cV[R]_m) (M: 'M[R]_(m,n)) i j: Proof. rewrite !mxE. case: splitP => x; first by rewrite [x]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h. -have -> : i = x by apply/ord_inj. +rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. rewrite !mxE. case: splitP => y; first by rewrite [y]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h'. -by have -> : j = y by apply/ord_inj. +by rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. Qed. (* @@ -275,10 +268,8 @@ have h4 : forall i j, a %| M' i j. *) have h6 : forall i j, M' i j = a * M'' i j. - move => i j; rewrite [(dvd_step _ _) i j]mxE. - case: odivrP. - + move => dv /=; by rewrite mulrC. - move => h. - case/dvdrP: (h4 i j ) => dv hdv. + case: odivrP => [dv|h] /=; first by rewrite mulrC. + case/dvdrP: (h4 i j) => dv hdv. by move: (h dv); rewrite hdv eqxx. have h6' : M' = a *: M'' by apply/matrixP => i j; rewrite h6 !mxE. (* @@ -308,10 +299,7 @@ have h10 : forall k (f1: 'I_k.+1 -> 'I_m) (f2: 'I_k.+1 -> 'I_n), have hMk : d^+ k.+1 != 0 by apply/lregP/lregX. rewrite -(@dvdr_mul2l _ d) // mulrA h8 //. by rewrite mulrAC -exprS dvdr_mul2l //. -split. -- exact : h2. -- exact : h10. -- exact : h6'. +split=> //. rewrite -/M'' => p h h'. apply/(@lregMl _ (a ^+ p.+1)). rewrite -h7. @@ -330,17 +318,16 @@ Qed. formal definition of bareiss algorithm *) Fixpoint bareiss_rec m a : 'M[R]_(1 + m) -> R := - match m return 'M[R]_(1 + m) -> R with - | S p => fun (M: 'M[R]_(1 + _)) => - let d := M 0 0 in - let l := ursubmx M in - let c := dlsubmx M in - let N := drsubmx M in - let: M' := d *: N - c *m l in - let: M'' := dvd_step a M' in - bareiss_rec d M'' - | _ => fun M => M 0 0 - end. + if m is p.+1 return 'M[R]_(1 + m) -> R then + fun (M: 'M[R]_(1 + _)) => + let d := M 0 0 in + let l := ursubmx M in + let c := dlsubmx M in + let N := drsubmx M in + let M' := d *: N - c *m l in + let M'' := dvd_step a M' in + bareiss_rec d M'' + else fun M => M 0 0. (* from sketch, we can express the properties of bareiss @@ -444,9 +431,7 @@ Lemma char_poly_altE : forall n (M: 'M[R]_(1 + n)), char_poly_alt M = char_poly M. Proof. rewrite /char_poly_alt /char_poly => n M. -rewrite bareissE //. -move => p h h'; apply/monic_lreg. -apply pminor_char_poly_mx_monic. +by rewrite bareissE // => p h h'; exact/monic_lreg/pminor_char_poly_mx_monic. Qed. (* The actual determinant function based on bareiss *) diff --git a/theory/bareiss_dvdring.v b/theory/bareiss_dvdring.v index 93a4730..9dfde9a 100644 --- a/theory/bareiss_dvdring.v +++ b/theory/bareiss_dvdring.v @@ -23,12 +23,9 @@ Lemma L1 m (a d: R) (l: 'rV[R]_m) (c: 'cV[R]_m) (M: 'M[R]_m): Proof. set X := block_mx d%:M l c M. have huniq : uniq (map (lift 0) (enum 'I_m)). -- rewrite map_inj_in_uniq ?enum_uniq //. - move => i j hi hj /=. - by apply/lift_inj. -have htool : forall s, 0 \in (map (lift 0) s) -> False. -- move => n /=. - by elim => [ | hd tl hi]. +- rewrite map_inj_in_uniq; first exact: enum_uniq. + by move => i j hi hj /= /lift_inj. +have htool : forall s, 0 \notin map (lift 0) s by move => n /=; elim. have -> : block_mx d%:M l (a *: c) (a *: M) = foldl (fun N i => line_scale i a N) X (map (lift 0) (enum 'I_m)). - apply/row_matrixP => i. @@ -36,13 +33,13 @@ have -> : block_mx d%:M l (a *: c) (a *: M) = move: (hl i) (hr i) => {hl hr}. case: (splitP i) => j. + rewrite [j]ord1 {j} => hi. - have -> : i = 0 by apply/ord_inj. - move => _ {hi} /= ->. - * apply/rowP => j; rewrite !mxE. - by case: splitP. - by apply/negP/htool. + have {i hi}-> : i = 0 by apply/ord_inj. + move => _ /= ->; last exact: htool. + apply/rowP => j; rewrite !mxE. + by case: splitP. + move => hi. - have -> : i = lift 0 j by apply/ord_inj. + have {i hi}-> : i = lift 0 j by apply/ord_inj. move => -> /=. + move => _. apply/rowP => k; rewrite !mxE. @@ -55,23 +52,16 @@ by rewrite det_lines_scale size_map size_enum_ord /=. Qed. Definition L3tool m (c: 'cV[R]_m) (d: R) (i: 'I_(1 + m)) := - match split i with - | inl _ => d - | inr j => c j 0 - end. + if split i is inr j then c j 0 else d. Lemma L3toolE0 m (c: 'cV[R]_m) d : L3tool c d 0 = d. -Proof. -rewrite /L3tool. -by case: splitP. -Qed. +Proof. by rewrite /L3tool; case: splitP. Qed. Lemma L3toolES m (c: 'cV[R]_m) d (i: 'I_m) : L3tool c d (lift 0 i) = c i 0. Proof. rewrite /L3tool. case: splitP => x /=; first by rewrite [x]ord1. -rewrite /bump leq0n => /eqP; rewrite eqSS => /eqP h. -by have -> : i = x by apply/ord_inj. +by rewrite /bump leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. Qed. Lemma L3 m (d: R) (l: 'rV[R]_m) (c c0: 'cV[R]_m) (M: 'M[R]_m): @@ -83,33 +73,29 @@ have huniq : uniq (map (lift 0) (enum 'I_m)). - rewrite map_inj_in_uniq ?enum_uniq //. move => i j hi hj /=. by apply/lift_inj. -have htool : forall s, 0 \in (map (lift 0) s) -> False. -- move => n /=. - by elim => [ | hd tl hi]. -have htool2 : 0 \notin (map (lift 0) (enum 'I_m)). -- by apply/negP/htool. +have htool : forall s, 0 \notin map (lift 0) s by move => n /=; elim. +have {}htool := htool _ (enum 'I_m). have -> : block_mx d%:M l (c -d *: c0) (M - c0 *m l) = foldl (fun N i => line_comb i 0 (-(L3tool c0 d i)) N) X (map (lift 0) (enum 'I_m)). - apply/row_matrixP => i. - case: (lines_comb_row_dep (fun i => - (L3tool c0 d i)) X huniq htool2) + case: (lines_comb_row_dep (fun i => - (L3tool c0 d i)) X huniq htool) => hl hr. move: (hl i) (hr i) => {hl hr}. case: (splitP i) => j. + rewrite [j]ord1 {j} => hi. - have -> : i = 0 by apply/ord_inj. - move => _ {hi i} /= -> //. + have {hi i}-> : i = 0 by apply/ord_inj. + move => _ -> //=. apply/rowP => j; rewrite !mxE. by case: splitP. move => hi. - have -> : i = lift 0 j by apply/ord_inj. - move => -> /= {i hi}. + have {i hi}-> : i = lift 0 j by apply/ord_inj. + move => -> /=. + rewrite L3toolES => _. apply/rowP => k; rewrite !mxE. case: splitP => x /= ; first by rewrite [x]ord1. - rewrite /bump leq0n => /eqP; rewrite eqSS => /eqP hjx. - have -> : j = x by apply/ord_inj. - case: splitP => z // {j hjx}; rewrite [z]ord1 {z} !mxE => _. + rewrite /bump leq0n => /eqP; rewrite eqSS => /eqP/ord_inj{j}->. + case: splitP => z //; rewrite [z]ord1 {z} !mxE => _. case: splitP => y; rewrite !mxE. * rewrite [y]ord1 {y} => _. by rewrite mulrC mulr1n mulNr. @@ -159,9 +145,7 @@ Proof. rewrite /dvd_step => n a M hj. rewrite -detZ; f_equal. apply/matrixP => i j; rewrite !mxE. -case: odivrP. -- move => d /=; by rewrite mulrC. -move => h. +case: odivrP => [d|h] /=; first by rewrite mulrC. case/dvdrP: (hj i j) => d hd. by move: (h d); rewrite hd eqxx. Qed. @@ -193,8 +177,7 @@ Proof. rewrite !mxE. case: splitP => x //; rewrite [x]ord1 {x} !mxE => _. case: splitP => x; first by rewrite [x]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h. -by have -> : i = x by apply/ord_inj. +by rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. Qed. Lemma blockEi0 m n d (l: 'rV[R]_n) (c: 'cV[R]_m) (M: 'M[R]_(m,n)) i: @@ -202,8 +185,7 @@ Lemma blockEi0 m n d (l: 'rV[R]_n) (c: 'cV[R]_m) (M: 'M[R]_(m,n)) i: Proof. rewrite !mxE. case: splitP => x; first by rewrite [x]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h. -have -> : i = x by apply/ord_inj. +rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. rewrite !mxE. by case: splitP => y //; rewrite [y]ord1 {y} => _. Qed. @@ -213,12 +195,10 @@ Lemma blockEij m n d (l: 'rV[R]_n) (c: 'cV[R]_m) (M: 'M[R]_(m,n)) i j: Proof. rewrite !mxE. case: splitP => x; first by rewrite [x]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h. -have -> : i = x by apply/ord_inj. +rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. rewrite !mxE. case: splitP => y; first by rewrite [y]ord1. -rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP h'. -by have -> : j = y by apply/ord_inj. +by rewrite /= /bump /leq0n => /eqP; rewrite eqSS => /eqP/ord_inj->. Qed. (* @@ -243,7 +223,7 @@ rewrite /pminor => ha hM hN. set M0 := block_mx d%:M l c M. (* d is the 1x1 principal minor of M0 *) have hh : d = minor (widen_ord (ltn0Sn _)) (widen_ord (ltn0Sn _)) M0. -- rewrite (@minor_eq _ _ _ _ _ (fun _ => 0) _ (fun _ => 0)) ?minor1 //. +- rewrite (@minor_eq _ _ _ _ _ (fun=> 0) _ (fun=> 0)) ?minor1 //. + by rewrite /M0 blockE00. + by move => x; rewrite ord1; apply: val_inj. + by move => x; rewrite ord1; apply: val_inj. @@ -253,7 +233,7 @@ have h2 : lreg d. set M' := d *: M - c *m l. set M'' := dvd_step a M'. set f : forall m, 'I_m -> 'I_2 -> 'I_(1 + m) := - fun m (i: 'I_m) (x: 'I_2) => if x == 0 then 0 else (lift 0 i). + fun m (i: 'I_m) (x: 'I_2) => if x == 0 then 0 else lift 0 i. (* all elements of M' can be expressed as 2x2 minors of M, so a divide all these @@ -268,10 +248,8 @@ have h4 : forall i j, a %| M' i j. *) have h6 : forall i j, M' i j = a * M'' i j. - move => i j; rewrite [(dvd_step _ _) i j]mxE. - case: odivrP. - + move => dv /=; by rewrite mulrC. - move => h. - case/dvdrP: (h4 i j ) => dv hdv. + case: odivrP => [dv|h] /=; first by rewrite mulrC. + case/dvdrP: (h4 i j) => dv hdv. by move: (h dv); rewrite hdv eqxx. have h6' : M' = a *: M'' by apply/matrixP => i j; rewrite h6 !mxE. (* @@ -301,10 +279,7 @@ have h10 : forall k (f1: 'I_k.+1 -> 'I_m) (f2: 'I_k.+1 -> 'I_n), have hMk : d^+ k.+1 != 0 by apply/lregP/lregX. rewrite -(@dvdr_mul2l _ d) // mulrA h8 //. by rewrite mulrAC -exprS dvdr_mul2l //. -split. -- exact : h2. -- exact : h10. -- exact : h6'. +split => //. rewrite -/M'' => p h h'. apply/(@lregMl _ (a ^+ p.+1)). rewrite -h7. @@ -323,27 +298,26 @@ Qed. formal definition of Bareiss algorithm *) Fixpoint Bareiss_rec m a : 'M[R]_(1 + m) -> R := - match m return 'M[R]_(1 + m) -> R with - | S p => fun (M: 'M[R]_(1 + _)) => - let d := M 0 0 in - let l := ursubmx M in - let c := dlsubmx M in - let N := drsubmx M in - let: M' := d *: N - c *m l in - let: M'' := dvd_step a M' in - Bareiss_rec d M'' - | _ => fun M => M 0 0 - end. + if m is p.+1 return 'M[R]_(1 + m) -> R then + fun (M: 'M[R]_(1 + _)) => + let d := M 0 0 in + let l := ursubmx M in + let c := dlsubmx M in + let N := drsubmx M in + let M' := d *: N - c *m l in + let M'' := dvd_step a M' in + Bareiss_rec d M'' + else fun M => M 0 0. (* from sketch, we can express the properties of Bareiss *) Lemma Bareiss_recE : forall m a (M: 'M[R]_(1 + m)), - lreg a -> - (forall (k:nat) (f1 f2: 'I_k.+1 -> 'I_m.+1), a ^+ k %| minor f1 f2 M) -> - (forall p (h h' :p.+1 <= 1 + m), + lreg a -> + (forall (k:nat) (f1 f2: 'I_k.+1 -> 'I_m.+1), a ^+ k %| minor f1 f2 M) -> + (forall p (h h' :p.+1 <= 1 + m), lreg (minor (widen_ord h) (widen_ord h') M)) -> - a ^+ m * (Bareiss_rec a M) = \det M. + a ^+ m * (Bareiss_rec a M) = \det M. Proof. elim => [ | m hi] //=. - move => a M ha h1 h2. @@ -361,25 +335,23 @@ rewrite -{1 2}heq => hM hm. have : forall p (h h': p.+1 <= 1 + (1 + m)), lreg (minor (widen_ord h) (widen_ord h') M). - rewrite -heq => p h h'. - rewrite (@minor_eq _ _ _ _ _ (widen_ord h) _ (widen_ord h)) ?hm//. + rewrite (@minor_eq _ _ _ _ _ (widen_ord h) _ (widen_ord h)) ?hm //. by move => x; apply/ord_inj. case: (@sketch _ _ a (M 0 0) (ursubmx M) (dlsubmx M) (drsubmx M) ha hM hm) => hM00 h1 h2 h3 hlreg. have h3' : forall p (h h': p < 1 + m), lreg (pminor h h' (dvd_step a (d *: N - c *m l))) - by move => p h h'; apply/h3. + by move => p h h'; apply/h3. move: (hi d (dvd_step a (d *: N - c *m l)) hM00 h1 h3'). set r := Bareiss_rec _ _ => hh. have : a ^+ m.+1 *( d ^+m * r) = a ^+ m.+1 * \det (dvd_step a (d *: N - c *m l)) by rewrite hh. -rewrite det_dvd_step //; last by - move => i j; apply (det_dvd_step_tool h2). +rewrite det_dvd_step //; last by move => i j; exact: (det_dvd_step_tool h2). move => heq2. have hX : lreg (M 0 0 ^+ (1 + m)) by apply/lregX. apply/hX. rewrite -{3}heq key_lemma -heq2 [M 0 0 ^+ (1 + m)]exprS -mulrA. -congr(_ * _). -by rewrite mulrCA. +by congr (_ * _); rewrite mulrCA. Qed. (* @@ -442,7 +414,7 @@ Proof. rewrite /char_poly_alt /char_poly => n M. rewrite BareissE //. move => p h h'; apply/monic_lreg. -apply pminor_char_poly_mx_monic. +exact: pminor_char_poly_mx_monic. Qed. (* The actual determinant function based on Bareiss *) diff --git a/theory/binetcauchy.v b/theory/binetcauchy.v index be19908..6eeafdf 100644 --- a/theory/binetcauchy.v +++ b/theory/binetcauchy.v @@ -47,8 +47,7 @@ Lemma split_sumZ_sf (P : Z -> R) (C : pred {ffun 'I_k -> 'I_l}): \sum_(s: 'S_k) (\sum_(f: {ffun 'I_k -> 'I_l} | C f) (P (f,s))). Proof. rewrite exchange_big pair_big /=. -apply/eq_big; first by case => [f s]; rewrite andbT. -by case. +by apply/eq_big; case=> //= [f s]; rewrite andbT. Qed. Lemma split_sumZ_fs (P : Z -> R) (C : pred {ffun 'I_k -> 'I_l}): @@ -56,8 +55,7 @@ Lemma split_sumZ_fs (P : Z -> R) (C : pred {ffun 'I_k -> 'I_l}): \sum_(f: {ffun 'I_k -> 'I_l} | C f) (\sum_(s: 'S_k) (P (f,s))). Proof. rewrite pair_big /=. -apply/eq_big ; first by case => [f s]; rewrite andbT. -by case. +by apply/eq_big; case=>//= [f s]; rewrite andbT. Qed. Lemma detAB_weight : \det (A *m B) = \sum_(fz : Z) (weight fz.1 fz.2). @@ -66,7 +64,7 @@ rewrite /determinant /weight. rewrite (split_sumZ_sf _ xpredT) /=. apply/eq_big => // s _. rewrite -big_distrr /=; congr (_ * _). -set F := fun n m => A n m * B m (s n). +set F := fun n m => A n m * B m (s n). rewrite -(bigA_distr_bigA F) /=. apply/eq_big => // i _. by rewrite !mxE. @@ -101,7 +99,7 @@ Lemma reindex_with_tilt (P: 'S_k -> R) (i j: 'I_k) : i != j -> Proof. move => hij. rewrite (bigID (fun z:'S_k => odd_perm z)) big_split /=; congr (_ + _). -pose C := fun z => ~~ (odd_perm z). +pose C := fun z => ~~ odd_perm z. pose D := fun z => odd_perm z. pose D' := fun z => C _ (tilt i j z). have hD : D _ =1 D' by move=> p; rewrite /D /D' /C sig_tilt. @@ -146,7 +144,7 @@ by rewrite (eqP (hfy x)) heq ltnn. Qed. Lemma inj_strictf_ffun (p q : nat) (f: {ffun 'I_p -> 'I_q}) : - strictf f -> injective f. + strictf f -> injective f. Proof. by move=> h; apply: inj_strictf. Qed. Remark trans_ltn : ssrbool.transitive ltn. @@ -163,7 +161,7 @@ Lemma path_drop : forall (s: seq nat) (i j d x : nat), path ltn x s -> i < j -> path ltn (nth d (x :: s) i) (drop i.+1 (x :: s)). Proof. elim => [ | hd tl hi] //= [ | i] j d x /andP [hx hp] hij /=. -- by apply/andP. +- by rewrite hx. by apply: (hi _ j.-1 _ hd) => //; move: hij; case: j. Qed. @@ -173,7 +171,7 @@ Lemma path_ordered_nth (i j d d' x : nat) (s: seq nat): path ltn x s -> Proof. move => hp hij h1 h2. have hin : nth d' (x :: s) j \in (drop i.+1 (x :: s)). -- clear hp => /=. +- move=> {hp}/=. elim : s x d' i j hij h1 h2 => [ | hd tl hi] x d' [ | i] [ | j] hij //=. + rewrite -[j.+1]add1n -[(size tl).+1]add1n ltn_add2l => _ h. by rewrite mem_nth. @@ -204,13 +202,11 @@ Lemma sorted_ordered_nth_gen (i j d d' x : nat) (s: seq nat): i < size s -> j < size s -> nth d s i < nth d' s j -> i < j. Proof. move => h hi hj hltn. -case: (ltngtP i j) => //. -- move => hji. - have hgtn := (sorted_ordered_nth d d' h hji hj hi). +case: (ltngtP i j) => // [hji|heq]. +- have hgtn := sorted_ordered_nth d d' h hji hj hi. rewrite -(ltnn (nth d s i)). - apply (ltn_trans hltn). + apply: (ltn_trans hltn). by rewrite (nth_change_default d' d hj) (nth_change_default d d' hi). -move => heq. by move: hltn; rewrite heq (nth_change_default d' d hj) ltnn. Qed. @@ -219,13 +215,11 @@ Lemma tool_nth : forall (s: seq 'I_l) (n:nat) (x: 'I_n) (d: 'I_l), Proof. elim => [ | hd tl hi] //= n x d. - by rewrite !nth_nil. -case: n x => [ | n ]; first by case. +case: n x => [[] // | n]. rewrite [n.+1]/(1 + n)%nat => x. -case: (splitP x) => [ j | j hj]. -- rewrite [j]ord1 => hx. - by have -> /= : x = 0 by apply/ord_inj. -have -> /= : x = lift 0 j by apply/ord_inj. -by apply: hi. +case: (splitP x) => [j | j -> /=]. +- by rewrite [j]ord1 => ->. +exact: hi. Qed. Lemma cast0 (f: {ffun 'I_k -> 'I_l}) : size (enum (codom f)) = #|codom f|. @@ -234,7 +228,7 @@ Proof. by rewrite cardE. Qed. Lemma cast1 (f: {ffun 'I_k -> 'I_l}) : injective f -> k = #|codom f|. Proof. move => hf. -by rewrite (card_codom hf) cardT /= size_enum_ord. +by rewrite (card_codom hf) cardT /= size_enum_ord. Qed. Lemma step_weight (g f: {ffun 'I_k -> 'I_l}) (pi: 'S_k) (hf : injective f) @@ -267,7 +261,7 @@ Definition same_codom m n (f g: {ffun 'I_m -> 'I_n}) := Lemma same_codomP m n (f g : {ffun 'I_m -> 'I_n}) : reflect (same_codom f g) (same_codomb f g). Proof. -apply: (iffP forallP) => [ h x | h x]. +apply: (iffP forallP) => h x. - by rewrite (eqP (h x)). by rewrite (h x). Qed. @@ -278,29 +272,25 @@ Definition good (g: {ffun 'I_k -> 'I_l}) : pred {ffun 'I_k -> 'I_l} := Lemma goodP (g f: {ffun 'I_k -> 'I_l}) : reflect (injective f /\ same_codom f g) (good g f). Proof. -apply: (iffP idP). -- case/andP => /injectiveP h1 /forallP h2. +(* TODO: `andPP` is only available in Coq 8.15+ *) +(* by apply: andPP; [exact: injectiveP | exact: same_codomP]. *) +apply: (iffP andP). +- case => /injectiveP h1 /forallP h2. split => // x. by rewrite (eqP (h2 x)). case => h1 h2. -apply/andP. split; first by apply/injectiveP. by apply/forallP => x; rewrite (h2 x). Qed. Lemma mem_same_codom (f g: {ffun 'I_k -> 'I_l}) : - same_codom f g -> forall x, (f x) \in codom g. -Proof. -move => h x. -by rewrite -h codom_f. -Qed. + same_codom f g -> forall x, f x \in codom g. +Proof. by move => h x; rewrite -h codom_f. Qed. (* g^-1 (f x) *) Definition inv_g_of_fx (g f: {ffun 'I_k -> 'I_l}) := - match (same_codomP f g) with - | ReflectT b => finfun (fun x => iinv (mem_same_codom b x)) - | ReflectF _ => finfun id - end. + if same_codomP f g isn't ReflectT b then finfun id + else finfun (fun x => iinv (mem_same_codom b x)). Lemma inv_g_of_fxE (g f: {ffun 'I_k -> 'I_l}) : same_codom f g -> @@ -316,8 +306,8 @@ Lemma inv_g_of_fx_inj (g f: {ffun 'I_k -> 'I_l}): injective f -> same_codom f g -> injectiveb (inv_g_of_fx g f). Proof. move => hf hc. -apply/injectiveP => x y heq. -apply hf. +apply/injectiveP => x y heq. +apply: hf. by rewrite -!(inv_g_of_fxE hc) heq. Qed. @@ -327,19 +317,16 @@ Qed. we build this p from g and f *) Definition perm_f (g f: {ffun 'I_k -> 'I_l}) := - match goodP g f with - | ReflectT b => Perm (inv_g_of_fx_inj (proj1 b) (proj2 b)) - | ReflectF _ => 1%g - end. + if goodP g f isn't ReflectT b then 1%g + else Perm (inv_g_of_fx_inj (proj1 b) (proj2 b)). Lemma perm_fE (g f: {ffun 'I_k -> 'I_l}) : injective f -> same_codom f g -> forall x, f x = g ((perm_f g f) x). Proof. move => hf hc /= x. rewrite /perm_f PermDef.fun_of_permE /=. -case: goodP => h. -- by rewrite inv_g_of_fxE. -by case: h. +case: goodP => [/= _|[]] //. +by rewrite inv_g_of_fxE. Qed. Lemma codom_perm (g: {ffun 'I_k -> 'I_l}) (p: 'S_k) : @@ -365,23 +352,20 @@ rewrite (reindex_onto (fun p:'S_k => finfun (g \o p)) (perm_f g)) /=. + have htemp : injective (g \o p) by apply: inj_comp => //; apply: perm_inj. move => x y; rewrite !ffunE => heq. - by apply htemp. + exact: htemp. have hcodom : forall x, (x \in codom (finfun (g \o p))) = (x \in codom g) by move => x; rewrite codom_perm. apply/andP; split. - + apply/andP; split. - by apply/injectiveP. - + apply/forallP => x; by rewrite hcodom. + + apply/andP; split; first exact/injectiveP. + apply/forallP => x; by rewrite hcodom. apply/eqP/permP => x. - have := (perm_fE hinj hcodom x). - rewrite ffunE. - by move/hg ->. + have := perm_fE hinj hcodom x. + by rewrite ffunE => /hg ->. move => /= f. case/goodP => h1 h2. apply/ffunP => /= x. -rewrite ffunE. -by rewrite (perm_fE h1 h2). +by rewrite ffunE (perm_fE h1 h2). Qed. Lemma one_step (g : {ffun 'I_k -> 'I_l}) : injective g -> @@ -403,13 +387,13 @@ transitivity (\sum_(phi: 'S_k) \sum_(pi : 'S_k) + have htemp : injective (g \o phi) by apply: inj_comp => //; apply: perm_inj. move => x y; rewrite !ffunE => heq. - by apply htemp. + by apply: htemp. rewrite (@step_weight g (finfun (g \o phi)) pi hinj phi) //. by move => x; rewrite ffunE. transitivity( \sum_(phi: 'S_k) ((-1) ^+ phi * \big[*%R/1]_i A i (g (phi i)) * ( \big[+%R/0]_pi - ((-1) ^+ sigma phi pi * \big[*%R/1]_i B (g i) ((sigma phi pi) i))))); + ((-1) ^+ sigma phi pi * \big[*%R/1]_i B (g i) ((sigma phi pi) i))))); last first. - apply/eq_big => // phi _. by rewrite -big_distrr /=. @@ -447,8 +431,8 @@ Qed. Definition strict_from (f: {ffun 'I_k -> 'I_l}) (hf: injective f) := finfun (fun x => @enum_val _ (mem (codom f)) (cast_ord (cast1 hf) x)). -Lemma strict_fromP (f: {ffun 'I_k -> 'I_l}) (hf: injective f): - strictf (strict_from hf) /\ same_codom f (strict_from hf). +Lemma strict_fromP (f: {ffun 'I_k -> 'I_l}) (hf: injective f): + strictf (strict_from hf) /\ same_codom f (strict_from hf). Proof. split. - apply/forallP => x. @@ -458,17 +442,17 @@ split. apply/eqP. rewrite !ffunE /enum_val -!tool_nth. apply/idP/idP => [ hxy | ]. - + apply sorted_ordered_nth => //. + + apply: sorted_ordered_nth => //. * by rewrite size_map cast0 ltn_ord. by rewrite size_map cast0 ltn_ord. - apply sorted_ordered_nth_gen => //. + apply: sorted_ordered_nth_gen => //=. + by rewrite size_map cast0 -(cast1 hf) ltn_ord. by rewrite size_map cast0 -(cast1 hf) ltn_ord. have h1 : enum (codom f) =i codom f by move => y; rewrite mem_enum. move => y. apply/imageP/imageP. - case => x hx hy. - have hy' : (y \in (enum (codom f))) + have hy' : y \in (enum (codom f)) by rewrite h1 hy codom_f. have hi : index y (enum (codom f)) < #|codom f| by rewrite -cast0 index_mem. @@ -502,8 +486,7 @@ Lemma strictf_uniq : forall m n (f g: {ffun 'I_m -> 'I_n}), strictf f -> strictf g -> same_codom f g -> f = g. Proof. clear A B Z R k l. -elim => [ | m hi] n f g hf hg hsame; apply/ffunP. -- by case. +elim => [ | m hi] n f g hf hg hsame; apply/ffunP; first by case. move/forallP : (hf) => hf1. move/forallP : (hg) => hg1. rewrite [m.+1]/(1 + m)%nat => x. @@ -520,10 +503,10 @@ case: (ltngtP (f 0) (g 0)) => h. by rewrite -(eqP (hf' 0)) ltn0. case: (splitP x) => y. - rewrite [y]ord1 => hy. - have -> : x = 0 by apply/ord_inj. + have {x hy}-> : x = 0 by apply/ord_inj. by apply/ord_inj. move => hy. -have -> : x = lift 0 y by apply/ord_inj. +have {x hy}-> : x = lift 0 y by apply/ord_inj. set f' := finfun (fun x => f (lift 0 x)). set g' := finfun (fun x => g (lift 0 x)). have hsame' : forall x, (x \in codom f') = (x \in codom g'). @@ -534,13 +517,13 @@ have hsame' : forall x, (x \in codom f') = (x \in codom g'). case/imageP; rewrite [m.+1]/(1 + m)%nat => x' _. case: (splitP x') => j. * rewrite [j]ord1 => hx'. - have -> : x' = 0 by apply/ord_inj. + have {x' hx'}-> : x' = 0 by apply/ord_inj. move => h'. have : f (lift 0 a) = f 0 by apply/ord_inj; rewrite -hz h h'. by move/(inj_strictf hf). move => hx'. - have -> : x' = lift 0 j by apply/ord_inj. + have {x' hx'}-> : x' = lift 0 j by apply/ord_inj. move => hz'. by exists j => //; rewrite ffunE. case => /= a _; rewrite ffunE => hz. @@ -548,13 +531,13 @@ have hsame' : forall x, (x \in codom f') = (x \in codom g'). case/imageP; rewrite [m.+1]/(1 + m)%nat => x' _. case: (splitP x') => j. * rewrite [j]ord1 => hx'. - have -> : x' = 0 by apply/ord_inj. + have {x' hx'}-> : x' = 0 by apply/ord_inj. move => h'. have : g (lift 0 a) = g 0 by apply/ord_inj; rewrite -hz -h h'. by move/(inj_strictf hg). move => hx'. - have -> : x' = lift 0 j by apply/ord_inj. + have {x' hx'}-> : x' = lift 0 j by apply/ord_inj. move => hz'. by exists j => //; rewrite ffunE. move/ffunP : (hi n f' g' (strictf_lift hf) (strictf_lift hg) hsame') @@ -563,18 +546,14 @@ by move: (heq y); rewrite !ffunE => ->. Qed. Definition strict_from_f (fz :Z) := - match injectiveP fz.1 with - | ReflectT h => strict_from h - | ReflectF _ => fz.1 - end. + if injectiveP fz.1 is ReflectT h then strict_from h else fz.1. Lemma strict_from_fP (fz : Z) : injective fz.1 -> - strictf (strict_from_f fz) /\ same_codom fz.1 (strict_from_f fz). + strictf (strict_from_f fz) /\ same_codom fz.1 (strict_from_f fz). Proof. move => hf. rewrite /strict_from_f. -case: injectiveP => hinj; first by apply strict_fromP. -by case: hinj. +case: injectiveP => [hinj | []] //; exact: strict_fromP. Qed. Lemma BinetCauchy: @@ -589,9 +568,8 @@ rewrite -gather_by_strictness (partition_big strict_from_f ffstrictf) /=. apply/congr_big => //. case => f pi; rewrite /cond /good /=. apply/andP/andP; case => /injectiveP h1. - + rewrite /strict_from_f. - case: injectiveP; last by case. - move => /= hinj. + + rewrite /strict_from_f /=. + case: injectiveP => [hinj | []] //. move/eqP => heq; split => //. case: (strict_fromP hinj) => hlt hrt. apply/forallP => x. diff --git a/theory/closed_poly.v b/theory/closed_poly.v index 5d19b26..498f5df 100644 --- a/theory/closed_poly.v +++ b/theory/closed_poly.v @@ -23,14 +23,14 @@ From CoqEAL Require Import ssrcomplements. (* [:: (X - r1)^+a1; ... ; (X - rn)^+an]) *) (* *) (******************************************************************************) - + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section poly_closedFieldType. -Variable F : closedFieldType. +Variable F : closedFieldType. Import GRing.Theory. Local Open Scope ring_scope. @@ -49,11 +49,11 @@ Lemma root_root_seq (p : {poly F}) x : p != 0 -> x \in root_seq p = root p x. Proof. rewrite /root_seq; set loop := fix loop p n := if n is _.+1 then _ else _. elim: size {-2 5}p (erefl (size p))=> /= {p} [|n ihn] p /=. - by move/eqP; rewrite size_poly_eq0=> /eqP->; rewrite eqxx. + by move/eqP; rewrite size_poly_eq0 => /eqP->; rewrite eqxx. case: eqP=> /= [sp_neq1 sp_eqn|/negP]; last first. rewrite negbK=> /size_poly1P [c c_neq0 ->] _ _. by rewrite rootC (negPf c_neq0). -case: sigW=> z /= rpz p_neq0. +case: sigW => z /= rpz p_neq0. rewrite in_cons; have [->|neq_xz] //= := altP eqP. move: rpz sp_eqn => /factor_theorem [q ->]. rewrite mulpK ?polyXsubC_eq0 // rootM root_XsubC (negPf neq_xz) orbF. @@ -62,38 +62,37 @@ rewrite size_mul ?polyXsubC_eq0 // size_XsubC addn2. by case=> /ihn /(_ q_neq0). Qed. -Lemma root_seq_cons (p : {poly F}) x s : root_seq p = x :: s -> +Lemma root_seq_cons (p : {poly F}) x s : root_seq p = x :: s -> s = root_seq (p %/ ('X - x%:P)). Proof. rewrite /root_seq; set loop := fix loop p n := if n is _.+1 then _ else _. case H: (size p)=> [|n] //=; case: eqP=> // Hp. move/eqP; rewrite eqseq_cons; case/andP=> /eqP {1}<- /eqP <-. -suff ->: n = size (p %/ ('X - x%:P))=> //. +suff ->: n = size (p %/ ('X - x%:P))=> //. by rewrite size_divp ?polyXsubC_eq0 // size_XsubC subn1 H. Qed. -Lemma root_seq_eq (p : {poly F}) : +Lemma root_seq_eq (p : {poly F}) : p = lead_coef p *: \prod_(x <- root_seq p) ('X - x%:P). Proof. move: {2}(root_seq p) (erefl (root_seq p))=> s. -elim: s p=> [p | x s IHp p]. +elim: s p=> [p | x s IHp p H]. rewrite /root_seq; set loop := fix loop p n := if n is _.+1 then _ else _. case H: (size p)=> [|n]. - move/eqP: H; rewrite size_poly_eq0=> /eqP ->. + move/eqP: H; rewrite size_poly_eq0=> /eqP ->. by rewrite lead_coef0 scale0r. - case: n H=> [H | n H] /=; case: eqP=> //. + case: n H => [H | n H] /=; case: eqP => //. move=> _ _; rewrite big_nil. move/eqP: H => /size_poly1P [c H] ->. by rewrite lead_coefC alg_polyC. by move/negP; rewrite negbK H. -move=> H; rewrite H big_cons (root_seq_cons H) mulrC scalerAl. +rewrite H big_cons (root_seq_cons H) mulrC scalerAl. have Hfp : p = p %/ ('X - x%:P) * ('X - x%:P). apply/eqP; rewrite -dvdp_eq dvdp_XsubCl -root_root_seq. by rewrite H mem_head. move: H; rewrite /root_seq. set loop := fix loop p n := if n is _.+1 then _ else _. - case Hp: (p != 0)=> //. - by move/negbT: Hp; rewrite negbK -size_poly_eq0 => /eqP ->. + by apply: contraPneq => ->; rewrite size_poly0. suff -> : lead_coef p = lead_coef (p %/ ('X - x%:P)). by rewrite -IHp ?(root_seq_cons H). by rewrite {1}Hfp lead_coef_Mmonic // monicXsubC. @@ -103,12 +102,11 @@ Lemma root_seq0 : root_seq 0 = [::]. Proof. by rewrite /root_seq size_poly0. Qed. Lemma size_root_seq p : size (root_seq p) = (size p).-1. -Proof. -case Hp: (p == 0). - by rewrite (eqP Hp) root_seq0 size_poly0. -rewrite {2}[p]root_seq_eq size_scale ?lead_coef_eq0 ?Hp //. +Proof. +have [-> | p0] := eqVneq p 0; first by rewrite root_seq0 size_poly0. +rewrite {2}[p]root_seq_eq size_scale ?lead_coef_eq0 //. rewrite (big_nth 0) big_mkord size_prod. - rewrite (eq_bigr (fun i => (1 + 1)%N)). + rewrite (eq_bigr (fun=> (1 + 1)%N)). by rewrite big_split sum1_card /= subSKn addnK card_ord. by move=> i _; rewrite size_XsubC. by move=> i _; rewrite polyXsubC_eq0. @@ -118,29 +116,29 @@ Lemma root_seq_nil (p : {poly F}) : (size p <= 1)%N = ((root_seq p) == [::]). Proof. by rewrite -subn_eq0 subn1 -size_root_seq size_eq0. Qed. -Lemma sub_root_div (p q : {poly F}) (Hq : q != 0) : +Lemma sub_root_div (p q : {poly F}) (Hq : q != 0) : p %| q -> {subset (root_seq p) <= (root_seq q)} . Proof. -case: (altP ((@eqP _ p 0)))=> [->|Hp]; first by rewrite root_seq0. -by case/dvdpP=> x Hx y; rewrite !root_root_seq // Hx rootM orbC=> ->. +case: (eqVneq p 0) => [->|p0]; first by rewrite root_seq0. +by case/dvdpP => x Hx y; rewrite !root_root_seq // Hx rootM orbC=> ->. Qed. -Definition root_seq_uniq p := undup (root_seq p). +Definition root_seq_uniq p := undup (root_seq p). -Lemma prod_XsubC_count (p : {poly F}): - p = (lead_coef p) *: - \prod_(x <- root_seq_uniq p) ('X - x%:P)^+ (count (pred1 x) (root_seq p)). +Lemma prod_XsubC_count (p : {poly F}): + p = (lead_coef p) *: + \prod_(x <- root_seq_uniq p) ('X - x%:P)^+ (count_mem x (root_seq p)). Proof. by rewrite {1}[p]root_seq_eq (prod_seq_count (root_seq p)). Qed. -Lemma count_root_seq p x : count (pred1 x) (root_seq p) = \mu_x p. +Lemma count_root_seq p x : count_mem x (root_seq p) = \mu_x p. Proof. -case: (altP (p =P 0))=> Hp; first by rewrite Hp root_seq0 mu0. +have [-> | Hp] := eqVneq p 0; first by rewrite root_seq0 mu0. apply/eqP; rewrite -muP //. -case H: (x \in root_seq p). - rewrite -mem_undup in H. - have:= (prod_XsubC_count p). +case/boolP: (x \in root_seq p) => [|H]. + rewrite -mem_undup => H. + move: (prod_XsubC_count p). rewrite (bigD1_seq x) //= ?undup_uniq //. set b:= \big[_/_]_(_ <- _ | _) _ => Hpq. apply/andP; split; apply/dvdpP. @@ -148,22 +146,21 @@ case H: (x \in root_seq p). case=> q Hq. have H1: ~~ (('X - x%:P) %| b). rewrite dvdp_XsubCl; apply/rootP. - rewrite horner_prod; apply/eqP. - rewrite (big_nth 0) big_mkord. + rewrite horner_prod; apply/eqP. + rewrite (big_nth 0) big_mkord. apply/prodf_neq0=> i Hix. by rewrite horner_exp hornerXsubC expf_neq0 // subr_eq0 eq_sym. have H2: (('X - x%:P) %| b). apply/dvdpP; exists ((lead_coef p)^-1 *: q). apply: (@scalerI _ _ (lead_coef p)); first by rewrite lead_coef_eq0. - rewrite -scalerAl scalerA mulrV ?unitfE ?lead_coef_eq0 // scale1r. - have HX: (('X - x%:P)^+ (count (pred1 x) (root_seq p))) != 0. + rewrite -scalerAl scalerA mulrV ?unitfE ?lead_coef_eq0 // scale1r. + have HX: (('X - x%:P)^+ (count_mem x (root_seq p))) != 0. by apply: expf_neq0; rewrite -size_poly_eq0 size_XsubC. rewrite -(mulpK (_ *: b) HX) -(mulpK (q * _) HX). by rewrite -scalerAl mulrC -Hpq -mulrA -exprS -Hq. by rewrite H2 in H1. -have->: count (xpred1 x) (root_seq p) = 0%N. - by apply/eqP; rewrite -leqn0 leqNgt -has_count has_pred1 H. -by rewrite dvd1p dvdp_XsubCl -root_root_seq // H. +have->: count_mem x (root_seq p) = 0%N by apply/count_memPn. +by rewrite dvd1p /= dvdp_XsubCl -root_root_seq. Qed. Definition root_mu_seq p := [seq (x,(\mu_x p)) | x <- (root_seq_uniq p)]. @@ -174,13 +171,13 @@ move=> Hp H. have Hr: size (root_seq_uniq p) = size (root_mu_seq p) by rewrite size_map. have Hs: (index x (root_mu_seq p) < size (root_seq_uniq p))%N. by rewrite Hr index_mem. -rewrite -(nth_index (0,0%N) H) // (nth_map 0) // mu_gt0 //. +rewrite -(nth_index (0,0%N) H) // (nth_map 0) // mu_gt0 //. by rewrite -root_root_seq // -mem_undup mem_nth. Qed. Definition root_seq_poly (s : seq {poly F}) := flatten (map root_mu_seq s). -Lemma root_seq_poly_pos x s : (forall p , p \in s -> p !=0) -> +Lemma root_seq_poly_pos x s : (forall p , p \in s -> p !=0) -> x \in root_seq_poly s -> (0 < x.2)%N. Proof. elim : s=> [|p l IHl H]; first by rewrite in_nil. @@ -192,7 +189,7 @@ Qed. Definition linear_factor_seq p := [seq ('X - x.1%:P)^+x.2 | x <- (root_mu_seq p)]. -Lemma monic_linear_factor_seq p : forall q, q \in linear_factor_seq p -> +Lemma monic_linear_factor_seq p : forall q, q \in linear_factor_seq p -> q \is monic. Proof. move=> q Hq; rewrite -(nth_index 0 Hq) (nth_map (0,0%N)). @@ -203,14 +200,14 @@ Qed. Lemma size_linear_factor_leq1 p : forall q, q \in linear_factor_seq p -> (1 < size q)%N. Proof. -move=> q; case: (altP (@eqP _ p 0))=> [Hp|Hp Hq]. - rewrite Hp /linear_factor_seq /root_mu_seq. +move=> q; have [-> | Hp Hq] := eqVneq p 0. + rewrite /linear_factor_seq /root_mu_seq. by rewrite /root_seq_uniq /root_seq size_poly0. rewrite -(nth_index 0 Hq) (nth_map (0,0%N)); last first. by rewrite -index_mem size_map in Hq. rewrite size_exp_XsubC (nth_map 0); last first. by rewrite -index_mem !size_map in Hq. -rewrite -(@prednK (\mu_ _ _)) // mu_gt0 // -root_root_seq //. +rewrite -(@prednK (\mu_ _ _)) // mu_gt0 // -root_root_seq //. rewrite -mem_undup mem_nth //. by rewrite -index_mem !size_map in Hq. Qed. @@ -220,13 +217,13 @@ Lemma coprimep_linear_factor_seq p : i != j -> coprimep (linear_factor_seq p)`_i (linear_factor_seq p)`_j. Proof. -move=> [i Hi] [j Hj]; move: Hi Hj; rewrite !size_map=> Hi Hj Hij. +move=> [i +] [j +]; rewrite !size_map=> Hi Hj Hij. rewrite !(nth_map (0,0%N)) ?size_map //. apply/coprimep_expl/coprimep_expr/coprimep_factor. by rewrite unitfE subr_eq0 !(nth_map 0) //= nth_uniq // ?undup_uniq // eq_sym. Qed. -Lemma prod_XsubC_mu (p : {poly F}): +Lemma prod_XsubC_mu (p : {poly F}): p = (lead_coef p) *: \prod_(x <- root_seq_uniq p) ('X - x%:P)^+(\mu_x p). Proof. rewrite {1}[p]prod_XsubC_count. @@ -239,7 +236,7 @@ Proof. by move/monicP=> H; rewrite {1}[p]prod_XsubC_mu H scale1r. Qed. -Lemma prod_factor (p : {poly F}): +Lemma prod_factor (p : {poly F}): p = (lead_coef p) *: \prod_(x <- linear_factor_seq p) x. Proof. by rewrite !big_map {1}[p]prod_XsubC_mu. @@ -251,7 +248,7 @@ Proof. by move/monicP=> H; rewrite {1}[p]prod_factor H scale1r. Qed. -Lemma uniq_root_mu_seq (p : {poly F}) : uniq (root_seq p) -> +Lemma uniq_root_mu_seq (p : {poly F}) : uniq (root_seq p) -> forall x, x \in root_mu_seq p -> x.2 = 1%N. Proof. move=> H x /(nthP (0,0%N)) [] i; rewrite size_map=> Hi. @@ -265,12 +262,12 @@ Lemma uniq_root_dvdp p q : q != 0 -> Proof. move=> Hq Hq2 Hpq. apply: count_mem_uniq=> x. -have Hc:= (count_uniq_mem x Hq2). -have Hle: (count (pred1 x) (root_seq p) <= count (pred1 x) (root_seq q))%N. +have Hc:= count_uniq_mem x Hq2. +have Hle: (count_mem x (root_seq p) <= count_mem x (root_seq q))%N. rewrite !count_root_seq; case/dvdpP: Hpq => r Hr. by rewrite Hr mu_mul -?Hr // leq_addl. -have: (count (pred1 x) (root_seq p) <= 1)%N. - by rewrite (leq_trans Hle) // Hc; case: (x \in root_seq q). +have: (count_mem x (root_seq p) <= 1)%N. + by rewrite (leq_trans Hle) // Hc; case: (x \in root_seq q). rewrite leq_eqVlt ltnS leqn0. case Hp: (x \in root_seq p). rewrite -has_pred1 has_count in Hp. diff --git a/theory/coherent.v b/theory/coherent.v index a6ed8ba..5861343 100644 --- a/theory/coherent.v +++ b/theory/coherent.v @@ -122,10 +122,10 @@ Proof. by rewrite -kerK mulmx1. Qed. Lemma kerP m n k (M : 'M[R]_(m,n)) (X : 'M_(k, m)) : reflect (exists Y : 'M_(k, dim_ker M), X = Y *m ker M) (X *m M == 0). Proof. -apply: (iffP idP); last first. - case=> [Y ->]; apply/eqP; apply/row_matrixP => i. +apply: (iffP eqP); last first. + case=> [Y ->]; apply/row_matrixP => i. by rewrite !row_mul row0 kerAK. -move=> /eqP XM0; have XM0_ i : row i X *m M == 0 by rewrite -row_mul XM0 row0. +move=> XM0; have XM0_ i : row i X *m M == 0 by rewrite -row_mul XM0 row0. exists (\matrix_(i, j) (projT1 (sig_eqW (kerP_subproof _ _ (XM0_ i)))) 0 j). by apply/row_matrixP => i; rewrite row_mul rowK; case: sig_eqW. Qed. @@ -133,14 +133,14 @@ Qed. (** As everything is based on strongly discrete rings we can solve q systems of the kind XM = B *) Fixpoint divmx m n l : 'M_(l, n) -> 'M[R]_(m, n) -> 'M_(l, m) := - match n return 'M_(l, n) -> 'M_(m, n) -> 'M_(l, m) with - | p.+1 => fun (B: 'M_(_, 1 + _)) (M : 'M_(_, 1 + _)) => - let K := ker (lsubmx M) in let W := divid (lsubmx B) (lsubmx M) in - divmx (rsubmx B - W *m rsubmx M) (K *m rsubmx M) *m K + W - | _ => fun _ _ => 0 - end. + if n is p.+1 return 'M_(l, n) -> 'M_(m, n) -> 'M_(l, m) then + fun (B: 'M_(_, 1 + _)) (M : 'M_(_, 1 + _)) => + let K := ker (lsubmx M) in let W := divid (lsubmx B) (lsubmx M) in + divmx (rsubmx B - W *m rsubmx M) (K *m rsubmx M) *m K + W + else fun _ _ => 0. + Definition dvdmx m n k (M : 'M[R]_(m,n)) (N : 'M_(k, n)) := - (divmx N M *m M == N). + divmx N M *m M == N. Local Notation "M %| B" := (dvdmx M B) : mxpresentation_scope. @@ -200,7 +200,7 @@ Lemma dvdmxMr (m0 m1 m2 m3 : nat) (K : 'M_(m2, m0)) (M : 'M[R]_(m1, m2)) (N : 'M_(m3, m2)) : (M %| N) -> (M *m K %| N *m K). Proof. -by move=> /dvdmxP [X hX]; apply/dvdmxP; exists X; rewrite mulmxA hX. +by case/dvdmxP=>X hX; apply/dvdmxP; exists X; rewrite mulmxA hX. Qed. Lemma dvdmxD m0 m1 m2 (M : 'M[R]_(m0,m1)) (N K : 'M[R]_(m2,m1)) : @@ -256,7 +256,7 @@ apply/dvdmxP/dvdmxP. move=> [Y ->]; exists (- (Y *m lsubmx (ker (col_mx M N)))). apply/eqP; rewrite mulNmx -addr_eq0 addrC -!mulmxA -mulmxDr -mul_row_col. by rewrite hsubmxK kerK mulmx0. -move=> [Y /eqP]; rewrite eq_sym -subr_eq0 -mulNmx -mul_row_col. +case=> [Y /eqP]; rewrite eq_sym -subr_eq0 -mulNmx -mul_row_col. move=> /kerP [Z /(congr1 rsubmx)]; rewrite row_mxKr -mulmx_rsub => HZ. by exists (-Z); rewrite mulNmx -HZ opprK. Qed. @@ -330,18 +330,17 @@ Hypothesis ker_colP : forall m (M : 'cV_m) (X : 'rV_m), reflect (exists Y , X = Y *m ker_col M) (X *m M == 0). Fixpoint dim_ker_c m n : 'M[R]_(m,n) -> nat := - match n return 'M[R]_(m,n) -> nat with - | S p => fun (M: 'M[R]_(m,1 + _)) => - dim_ker_c (ker_col (lsubmx M) *m rsubmx M) - | _ => fun _ => m -end. - -Fixpoint ker_c m n : forall (M : 'M_(m,n)), 'M_(dim_ker_c M,m) := match n with - | S p => fun (M : 'M_(m,1 + _)) => - let G1 := ker_col (lsubmx M) in - ker_c (G1 *m rsubmx M) *m G1 - | _ => fun _ => 1%:M - end. + if n is p.+1 then + fun (M: 'M[R]_(m,1 + _)) => + dim_ker_c (ker_col (lsubmx M) *m rsubmx M) + else fun => m. + +Fixpoint ker_c m n : forall (M : 'M_(m,n)), 'M_(dim_ker_c M,m) := + if n is p.+1 then + fun (M : 'M_(m,1 + _)) => + let G1 := ker_col (lsubmx M) in + ker_c (G1 *m rsubmx M) *m G1 + else fun => 1%:M. Lemma ker_cP : forall m n (M : 'M[R]_(m,n)) (X : 'rV_m), reflect (exists Y, X = Y *m ker_c M) (X *m M == 0). @@ -388,13 +387,13 @@ Variable cap : Hypothesis cap_spec : forall n m (I : 'cV[R]_n) (J : 'cV[R]_m), int_spec (cap I J). -Fixpoint dim_int n : 'cV[R]_n -> nat := match n with - | 0 => fun _ => 0%N - | S p => fun (V : 'cV[R]_(1 + p)) => - let v := usubmx V in - let vs := dsubmx V : 'cV[R]_p in - ((dim_cap v (-vs)).+1 + dim_int vs)%N -end. +Fixpoint dim_int n : 'cV[R]_n -> nat := + if n is p.+1 then + fun (V : 'cV[R]_(1 + p)) => + let v := usubmx V in + let vs := dsubmx V : 'cV[R]_p in + ((dim_cap v (-vs)).+1 + dim_int vs)%N + else fun => 0%N. Definition cap_wl n m (I : 'cV_n) (J : 'cV_m) := divid (cap I J) I. @@ -407,17 +406,16 @@ Lemma wr n m (I : 'cV_n) (J : 'cV_m) : cap_wr I J *m J = cap I J. Proof. by apply: dividK; case: cap_spec. Qed. Fixpoint ker_c_int m : forall (V : 'cV_m),'M_(dim_int V,m) := - match m return forall V : 'cV_m, 'M_(dim_int V,m) with - | 0 => fun _ => 0 - | S p => fun (V' : 'cV_(1 + p)) => - let v := usubmx V' in - let vs := dsubmx V' in - let m0 := ker_c_int vs in - let wv := cap_wl v (-vs) in - let wvs := cap_wr v (-vs) in - block_mx (if v == 0 then delta_mx 0 0 else wv) (if v == 0 then 0 else wvs) - 0 m0 - end. + if m is p.+1 return forall V : 'cV_m, 'M_(dim_int V,m) then + fun (V' : 'cV_(1 + p)) => + let v := usubmx V' in + let vs := dsubmx V' in + let m0 := ker_c_int vs in + let wv := cap_wl v (-vs) in + let wvs := cap_wr v (-vs) in + block_mx (if v == 0 then delta_mx 0 0 else wv) (if v == 0 then 0 else wvs) + 0 m0 + else fun => 0. (* TODO: Move to ssrcomplements *) Lemma colE m n (i : 'I_n) (M : 'M[R]_(m, n)) : @@ -428,9 +426,8 @@ Lemma ker_c_intP : forall m (V : 'cV_m) (X : 'rV_m), reflect (exists Y, X = Y *m ker_c_int V) (X *m V == 0). Proof. elim => [V X | n IH] /=. - rewrite thinmx0 flatmx0 /ker_c_int mulmx0. - apply: (iffP idP) => //= _. - by exists 0; rewrite mulmx0. + rewrite thinmx0 flatmx0 /ker_c_int mulmx0 eqxx. + by constructor; exists 0; rewrite mulmx0. rewrite [n.+1]/(1 + n)%nat => V X. set v := usubmx V. set vs := dsubmx V. @@ -442,15 +439,15 @@ set wvs := cap_wr v (-vs). move: (wl v (-vs)); rewrite -/wv => Hwv. move: (wr v (-vs)); rewrite -/wvs => Hwvs. rewrite -[V]vsubmxK -[X]hsubmxK. -case v0 : (v == 0). +case: (eqVneq v 0) => v0. apply: (iffP idP) => /= [|[W ->]]. - rewrite (@mul_row_col _ _ 1) -/v (eqP v0) mulmx0 add0r => vs0. + rewrite (@mul_row_col _ _ 1) -/v v0 mulmx0 add0r => vs0. case: (IH vs xs) => [[A HA]|[]]; last by apply/IH. exists (row_mx (const_mx (x 0 0)) A). rewrite (@mul_row_block _ _ _ _ 1) -/xs !mulmx0 add0r addr0 -colE col_const HA. by f_equal; apply/rowP => i; rewrite !mxE /= !ord1. rewrite -mulmxA (@mul_block_col _ _ _ 1) -/v !mul0mx addr0 add0r. - rewrite -[W]hsubmxK mul_row_col {6}(eqP v0) !mulmx0 add0r mulmxA. + rewrite -[W]hsubmxK mul_row_col {6}v0 !mulmx0 add0r mulmxA. by apply/IH; exists (rsubmx W). apply: (iffP idP) => /= [|[W ->]]. rewrite (@mul_row_col _ _ 1) => hwx. @@ -468,8 +465,8 @@ apply: (iffP idP) => /= [|[W ->]]. rewrite (@mul_row_block _ _ _ _ 1) mulmx0 addr0 -HA addrCA subrr addr0. f_equal; apply/(@scalemx_inj _ _ _ (v 0 0)). (* The proof breaks down here if strongly discrete rings are not idomains! *) - apply/negP => v00; case/negP: v0; apply/eqP. - by apply/rowP => i; rewrite !ord1 /= (eqP v00) !mxE. + apply: contra_neq v0 => v00. + by apply/rowP => i; rewrite !ord1 /= v00 !mxE. by rewrite -!mul_mx_scalar -mx11_scalar -mulmxA Hwv -hW -/x vx00. by apply/IH; rewrite mulmxDl mulNmx addrC -mulmxN -mulmxA Hwvs -hW vx00. rewrite -[W]hsubmxK (@mul_row_block _ _ _ _ 1) mulmx0 addr0 (@mul_row_col _ _ 1). @@ -508,11 +505,11 @@ Proof. rewrite /bcap_wl /bcap -mulmxA principal_w1_correct mul_scalar_mx. apply/rowP => i; rewrite !mxE !ord1 {i} /= !mulr1n. set a := principal_gen _; set b := principal_gen _. -case b0 : (b == 0); first by rewrite (eqP b0) lcm0r mulr0. -case a0 : (a == 0). - by rewrite (eqP a0) lcmr0 odiv0r /= ?mul0r // gcdr_eq0 b0. +have [-> | b0] := eqVneq b 0; first by rewrite lcm0r mulr0. +have [-> | a0] := eqVneq a 0. + by rewrite lcmr0 odiv0r /= ?mul0r // gcdr_eq0 negb_and b0. case: odivrP => /= => [x Hx | H]. - apply/(@mulIf _ (gcdr b a)); first by rewrite gcdr_eq0 a0 b0. + apply/(@mulIf _ (gcdr b a)); first by rewrite gcdr_eq0 negb_and b0. by rewrite mulr_lcm_gcd -mulrA mulrCA -Hx. case/dvdrP: (dvdr_gcdr b a) => x /eqP Hx. by move: (H x); rewrite Hx. @@ -528,11 +525,11 @@ Proof. rewrite /bcap_wl /bcap -mulmxA principal_w1_correct mul_scalar_mx. apply/rowP => i; rewrite !mxE !ord1 {i} /= !mulr1n. set b := principal_gen _; set a := principal_gen _. -case a0 : (a == 0); first by rewrite (eqP a0) lcmr0 mulr0. -case b0 : (b == 0). - by rewrite (eqP b0) lcm0r odiv0r /= ?mul0r // gcdr_eq0 a0 eqxx. +have [-> | a0] := eqVneq a 0; first by rewrite lcmr0 mulr0. +have [-> | b0] := eqVneq b 0. + by rewrite lcm0r odiv0r /= ?mul0r // gcdr_eq0 negb_and eqxx. case: odivrP => /= => [x Hx | H]. - apply/(@mulIf _ (gcdr b a)); first by rewrite gcdr_eq0 a0 b0. + apply/(@mulIf _ (gcdr b a)); first by rewrite gcdr_eq0 negb_and b0. by rewrite -mulrA mulrCA -Hx mulr_lcm_gcd mulrC. case/dvdrP: (dvdr_gcdl b a) => x /eqP Hx. by move: (H x); rewrite Hx. @@ -553,7 +550,7 @@ have div1 : (a %| x 0 0)%R. exists ((I' *m principal_w2 I) 0 0). move: HI'. rewrite -{1}Ha => <-. - by rewrite mulrC mul_mx_scalar -scalemxAr !mxE. + by rewrite mulrC mul_mx_scalar -scalemxAr !mxE. have div2 : (b %| x 0 0)%R. apply/dvdrP. exists ((J' *m principal_w2 J) 0 0). diff --git a/theory/companion.v b/theory/companion.v index 04383c1..8641898 100644 --- a/theory/companion.v +++ b/theory/companion.v @@ -27,30 +27,30 @@ Definition companion_mxn n (p : {poly R}) := Definition companion_mx (p : {poly R}) := companion_mxn (size p).-2.+1 p. -Lemma comp_char_polyK : forall (p : {poly R}), p \is monic -> +Lemma comp_char_polyK : forall (p : {poly R}), p \is monic -> (1 < size p)%N -> char_poly (companion_mx p) = p. Proof. apply: poly_ind=> [|p c IHp]; first by move/monic_neq0/eqP. -case: (p == 0) /eqP => [-> H |/eqP H Hm Hs]. - by rewrite mul0r add0r {1}size_polyC; case: (c != 0). +have [-> H | p0 Hm Hs] := eqVneq p 0. + by rewrite mul0r add0r {1}size_polyC; case: eqP. have Hcst1 : (size (p * 'X + c%:P)).-1 = (size p).-1.+1. - by rewrite size_MXaddC (negbTE H) -polySpred. + by rewrite size_MXaddC (negbTE p0) -polySpred. have Hmp : p \is monic. - rewrite monicE -lead_coefMX -(@lead_coefDl _ _ (c%:P)) -?monicE //. + rewrite monicE -lead_coefMX -(@lead_coefDl _ _ (c%:P)) -?monicE //. by rewrite size_polyC size_mulX // polySpred //; case:(c != 0). case: (ltnP 1 (size p))=> Hpt; last first. have Hp1: p = 1%:P by rewrite -(monicP Hmp) [p]size1_polyC // lead_coefC. - rewrite /companion_mx !Hcst1 Hp1 mul1r /char_poly size_polyC oner_eq0. - set M := char_poly_mx _. + rewrite /companion_mx !Hcst1 Hp1 mul1r /char_poly size_polyC oner_eq0. + set M := char_poly_mx _. rewrite [M]mx11_scalar det_scalar1 !mxE coefD coefC coefX. - by rewrite !add0r polyCN opprK size_XaddC. + by rewrite !add0r polyCN opprK size_XaddC. rewrite /char_poly /companion_mx Hcst1. rewrite (expand_det_row _ ord0) big_ord_recl !mxE. rewrite mulr1n !mulr0n add0r /cofactor !addn0 expr0 mul1r. set d1 := \det _. -case Hnp: (size p) (Hpt)=> [|n] //; case: n Hnp=> // n Hnp _. +case Hnp: (size p) (Hpt)=> [|n] //; case: n Hnp=> // n Hnp _. rewrite big_ord_recr big1; last first. - move=> i _; rewrite !mxE !sub0r size_MXaddC (negbTE H) andFb. + move=> i _; rewrite !mxE !sub0r size_MXaddC (negbTE p0) andFb. have:= (neq_ltn n (widen_ord (leqnSn n) i)). rewrite Hnp (ltn_ord i) orbT lift0 eqSS. by move/negbTE ->; rewrite polyCN opprK mul0r. @@ -59,22 +59,22 @@ have HM: upper_triangular_mx M. apply/upper_triangular_mxP=> i j Hij. rewrite !mxE -(inj_eq (@ord_inj _)) /= /bump !leq0n leqNgt (ltn_ord j). rewrite add1n eqn_leq leqNgt ltnS ltnW // sub0r eqSS eqn_leq leqNgt Hij. - rewrite sub0r eqn_leq size_MXaddC (negbTE H) andFb Hnp. + rewrite sub0r eqn_leq size_MXaddC (negbTE p0) andFb Hnp. by rewrite (leqNgt n.+1) (ltn_ord j) polyCN opprK. have->: \det M = (-1)^+n.+1. rewrite (det_triangular_mx HM) -{7}[n.+1]card_ord -prodr_const. apply: eq_bigr=> i _; rewrite !mxE -(inj_eq (@ord_inj _)) !lift0 !lift_max. - rewrite eqxx !eqn_leq ltnn size_MXaddC (negbTE H) andFb Hnp. + rewrite eqxx !eqn_leq ltnn size_MXaddC (negbTE p0) andFb Hnp. by rewrite (leqNgt _ i) (ltn_ord i) sub0r subr0. rewrite !mxE -exprD -signr_odd addnn odd_double mulr1 polyCN opprK. -rewrite size_MXaddC (negbTE H) andFb Hnp addr0 !sub0r. +rewrite size_MXaddC (negbTE p0) andFb Hnp addr0 !sub0r. rewrite -{1}cons_poly_def coef_cons polyCN opprK !eqxx -(IHp Hmp Hpt) mulrC. suff ->: d1 = char_poly (companion_mx p)=> //. rewrite /companion_mx. have ->: (size p).-2.+1 = (size p).-1.+1.-1.+1.-1 by rewrite Hnp. congr (\det _); rewrite row'_col'_char_poly_mx; congr char_poly_mx. apply/matrixP=> i j; rewrite !mxE !eqSS -cons_poly_def coef_cons size_cons_poly. -rewrite nil_poly (negbTE H). +rewrite nil_poly (negbTE p0). by rewrite !lift0 /= {4 9}Hnp. Qed. @@ -95,34 +95,34 @@ suff Hn: forall q, horner_mx A q = 0 -> (q == 0) || ((size p).-2 < (size q).-1)%N. have Hm0: (mxminpoly A == 0) = false. by apply: negbTE; rewrite monic_neq0 // mxminpoly_monic. - have:= (Hn (mxminpoly A) (mx_root_minpoly A)); rewrite Hm0 /= => Hmn. + have:= Hn (mxminpoly A) (mx_root_minpoly A); rewrite Hm0 /= => Hmn. have Hsm : size (mxminpoly A) == size (char_poly A). - rewrite eqn_leq dvdp_leq ?mxminpoly_dvd_char ?monic_neq0 ?char_poly_monic //. - by rewrite size_char_poly -(addn1 _.-2) addnC -ltn_subRL subn1. + rewrite eqn_leq dvdp_leq ?mxminpoly_dvd_char ?monic_neq0 ?char_poly_monic //. + by rewrite size_char_poly -(addn1 _.-2) addnC -ltn_subRL subn1. apply/eqP; rewrite -eqp_monic // ?mxminpoly_monic //. by rewrite -{2}(comp_char_polyK Hp) // -dvdp_size_eqp // mxminpoly_dvd_char. move=> q; case: (ltnP (size p).-2 (size q).-1); first by rewrite orbT. -have H (i : 'I_(size p).-2): - A *m col (widen_ord (leqnSn (size p).-2) i) 1%:M = col (lift ord0 i) 1%:M. +have H (i : 'I_(size p).-2): + A *m col (widen_ord (leqnSn (size p).-2) i) 1%:M = col (lift ord0 i) 1%:M. rewrite col_id_mulmx; apply/matrixP=> j k; rewrite !mxE. rewrite -(inj_eq (@ord_inj _)) lift0. by rewrite (eqn_leq _ i) (leqNgt _ i) (ltn_ord i) subr0. have H2: forall i : 'I_(size p).-2.+1, (A ^+ i) *m col ord0 1%:M = col i 1%:M. - case; elim=> [Hi|i IH Hi] /=. - by rewrite expr0 mul1mx; congr col; apply: ord_inj. + case; elim=> [Hi|i IH Hi] /=. + by rewrite expr0 mul1mx; congr col; apply: ord_inj. rewrite exprS -mulmxA (IH (ltnW Hi)). - have Ho: (i < (size p).-2)%N by rewrite -ltnS. + have Ho: (i < (size p).-2)%N by rewrite -ltnS. have ->: (Ordinal (ltnW Hi)) = (widen_ord (leqnSn (size p).-2) (Ordinal Ho)). by apply: ord_inj. by rewrite H; congr col; apply: ord_inj; rewrite lift0. case Hq: (q == 0)=> //. have Hsq: (0 < size q)%N by rewrite size_poly_gt0 Hq. -rewrite /horner_mx /horner_morph horner_coef. +rewrite /horner_mx /horner_morph horner_coef. rewrite size_map_poly_id0 ?fmorph_eq0 ?lead_coef_eq0 ?Hq // => H1 Hb. have Hw: (size q <= (size p).-2.+1)%N by rewrite -(prednK Hsq). suff : q == 0 by rewrite Hq. have: \sum_(i < size q) q`_i *: (A ^+ i *m col ord0 1%:M) = 0. - rewrite (eq_bigr (fun i : 'I_(size q) => + rewrite (eq_bigr (fun i : 'I_(size q) => ((map_poly scalar_mx q)`_i * A ^+ i) *m col ord0 1%:M)). by rewrite -mulmx_suml ?Hb ?mul0mx //. by move=> i _; rewrite coef_map scalemxAl -mul_scalar_mx. @@ -133,12 +133,12 @@ have <-: \col_(i < (size p).-2.+1) q`_i = b. rewrite (bigD1 (Ordinal Hi)) //= H2 !mxE eqxx mulr1 big1 ?addr0 //. move=> k Hk; rewrite (H2 (widen_ord Hw k)) !mxE. move/negbTE: Hk; rewrite -!(inj_eq (@ord_inj _)) /= eq_sym=> ->. - by rewrite mulr0. - rewrite nth_default // big1 // => k _. + by rewrite mulr0. + rewrite nth_default // big1 // => k _. rewrite (H2 (widen_ord Hw k)) !mxE -(inj_eq (@ord_inj _)) /= eqn_leq. - by rewrite leqNgt (leq_trans (ltn_ord k) Hi) andFb mulr0. + by rewrite leqNgt (leq_trans (ltn_ord k) Hi) andFb mulr0. move/matrixP=> Hc. -apply/eqP/size_poly_leq0P/leq_sizeP=> j _. +apply/eqP/size_poly_leq0P/leq_sizeP=> j _. case: (ltnP j (size p).-2.+1)=> Hj. by move: (Hc (Ordinal Hj) ord0); rewrite !mxE. by rewrite nth_default //; apply: leq_trans Hj. diff --git a/theory/dvdring.v b/theory/dvdring.v index 09dbb70..6cdad3d 100644 --- a/theory/dvdring.v +++ b/theory/dvdring.v @@ -1,11 +1,10 @@ (** This file is part of CoqEAL, the Coq Effective Algebra Library. (c) Copyright INRIA and University of Gothenburg, see LICENSE *) -From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq path. -From mathcomp Require Import ssralg fintype perm tuple choice. +From Coq Require Import ssreflect ssrfun ssrbool Arith.Wf_nat. +From mathcomp Require Import eqtype ssrnat div seq path. +From mathcomp Require Import ssralg fintype perm tuple choice generic_quotient. From mathcomp Require Import matrix bigop zmodp mxalgebra poly. -(* Require Import generic_quotient. (* testing *) *) - Import GRing.Theory. Set Implicit Arguments. @@ -18,29 +17,18 @@ Local Open Scope ring_scope. Scheme acc_dep := Induction for Acc Sort Type. -(* vsiles: maybe we can reuse lt_wf but I didn't managed to do it *) -Lemma lt_wf2 : well_founded (fun x y => x < y). -Proof. -red in |- *. -have: (forall (n:nat) (a:nat), a < n -> Acc (fun x y => x < y) a). -- elim => [ | n hi] a; first done. - move => ltaSn. apply: Acc_intro. - move => b ltba. apply : hi. - apply : (leq_trans ltba ltaSn). -move => h a. -by apply: (h (a.+1)). -Defined. +Lemma ssr_lt_wf : well_founded (fun x y => x < y). +Proof. by apply: (well_founded_lt_compat _ id)=>x y /ltP. Defined. Section GUARD. Variable A: Type. Variable P : A -> A -> Prop. -Fixpoint guarded (n:nat) (Wf : well_founded P) : well_founded P := - match n with - | O => Wf - | S n => fun x => - (@Acc_intro _ _ x (fun y _ => guarded n (guarded n Wf) y)) -end. +Fixpoint guarded (n: nat) (Wf: well_founded P) : well_founded P := + if n is m.+1 then + fun x => + @Acc_intro _ _ x (fun y _ => guarded m (guarded m Wf) y) + else Wf. End GUARD. @@ -155,32 +143,32 @@ Proof. by case: R=> [? [? []]] /=. Qed. Lemma odiv0r a : a != 0 -> 0 %/? a = Some 0. Proof. -case: odivrP=> [x|H _]; last by by move: (H 0); rewrite mul0r eq_refl. -by move/eqP; rewrite eq_sym mulf_eq0; case/orP; move/eqP->; rewrite // eq_refl. +case: odivrP=> [x|H _]; last by move: (H 0); rewrite mul0r eqxx. +by move/eqP; rewrite eq_sym mulf_eq0 orbC; case: eqP => //= _ /eqP->. Qed. Lemma odivr0 a : a != 0 -> a %/? 0 = None. Proof. -by case: odivrP=> // x; rewrite mulr0=> ->; rewrite eq_refl. +by case: odivrP=> // x; rewrite mulr0=> ->; rewrite eqxx. Qed. Lemma odivr1 a : a %/? 1 = Some a. Proof. case: odivrP=> [x|H]; first by rewrite mulr1=> ->. -by move: (H a); rewrite mulr1 eq_refl. +by move: (H a); rewrite mulr1 eqxx. Qed. Lemma odivrr a : a != 0 -> a %/? a = Some 1. Proof. move=> a0; case: odivrP=> [x|H]. by rewrite -{1}[a]mul1r; move/(mulIf a0) <-. -by move: (H 1); rewrite mul1r eq_refl. +by move: (H 1); rewrite mul1r eqxx. Qed. Lemma odivr_mulrK a b : a != 0 -> b * a %/? a = Some b. Proof. move=> a0; case: odivrP=> [x|H]; first by move/(mulIf a0) ->. -by move: (H b); rewrite eq_refl. +by move: (H b); rewrite eqxx. Qed. Lemma odivr_mulKr a b : a != 0 -> a * b %/? a = Some b. @@ -193,8 +181,8 @@ case c0: (c == 0); first by rewrite (eqP c0) mulr0 !odivr0 // mulf_neq0. case: odivrP=> [x|H]. rewrite mulrCA; move/(mulfI a0). case: (odivrP b c)=> [x' ->|H]; first by move/(mulIf (negbT c0)) ->. - by move=> Hbxc; move: (H x); rewrite Hbxc eq_refl. -by case: odivrP=> //x Hbxc; move: (H x); rewrite mulrCA Hbxc eq_refl. + by move=> Hbxc; move: (H x); rewrite Hbxc eqxx. +by case: odivrP=> //x Hbxc; move: (H x); rewrite mulrCA Hbxc eqxx. Qed. Lemma odivr_mul2r a b c : a != 0 -> b != 0 -> b * a %/? (c * a) = (b %/? c). @@ -208,23 +196,23 @@ Proof. by case: odivrP=>// x -> [<-]; rewrite mulrC. Qed. Lemma dvdrP a b : reflect (exists x, b = x * a) (a %| b). Proof. rewrite /dvdr; case: odivrP=> //= [x|] hx; constructor; first by exists x. -by case=> x; move/eqP; apply: negP (hx _). +by case=> x /eqP; apply: negP. Qed. (****) Lemma eqdP a b : reflect (exists2 c12 : R, (c12 \is a GRing.unit) & c12 * a = b) (a %= b). Proof. -apply: (iffP idP). - case/andP=> /dvdrP [x Hx] /dvdrP [y Hy]. - case: (altP (@eqP _ b 0))=> Hb. +apply: (iffP andP). + case=> /dvdrP [x Hx] /dvdrP [y Hy]. + case: (eqVneq b 0) => Hb. rewrite Hb mulr0 in Hy. by exists 1; rewrite ?unitr1 // Hy mulr0 Hb. exists x; last by rewrite Hx. apply/GRing.unitrPr; exists y. rewrite Hy mulrA in Hx. by apply: (mulIf Hb); rewrite -Hx mul1r. -case=> c Hc H; apply/andP; split; apply/dvdrP. +case=> c Hc H; split; apply/dvdrP. by exists c; rewrite H. exists (c^-1); apply: (@mulfI _ c). by apply/eqP=> Habs; rewrite Habs unitr0 in Hc. @@ -327,8 +315,8 @@ Proof. by elim: s a=> //= a s ih a'; rewrite /nth => -> ->. Qed. Lemma sorted_nth0 (s : seq R) : sorted %|%R s -> forall i, s`_0 %| s`_i. Proof. -case: s=> [_|a s hi] [|i] /=; do? by rewrite /= dvdrr. -have [his|hsi] := (ltnP i (size s)); last by rewrite nth_default // dvdr0. +case: s=> [_|a s hi] [|i] /=; do? by rewrite dvdrr. +have [his|hsi] := ltnP i (size s); last by rewrite nth_default // dvdr0. by move/(order_path_min dvdr_trans)/(all_nthP 0): hi => ->. Qed. @@ -440,21 +428,6 @@ Proof. exact: eqd_dvd. Qed. Lemma eqd_dvdl b a c : a %= b -> (a %| c) = (b %| c). Proof. by move/eqd_dvd; apply. Qed. -(* TODO: remove once generic_quotient compile on 8.5 *) -Section EquivRel. - -Variable T : Type. - -Lemma left_trans (e : rel T) : - symmetric e -> transitive e -> left_transitive e. -Proof. by move=> s t ? * ?; apply/idP/idP; apply: t; rewrite // s. Qed. - -Lemma right_trans (e : rel T) : - symmetric e -> transitive e -> right_transitive e. -Proof. by move=> s t ? * x; rewrite ![e x _]s; apply: left_trans. Qed. - -End EquivRel. - Lemma eqd_ltrans : left_transitive (@eqd R). Proof. exact: (left_trans eqd_sym eqd_trans). Qed. @@ -474,9 +447,8 @@ Proof. by rewrite /eqd dvd1r andbT. Qed. Lemma unitd1 a : (a \is a GRing.unit) = (a %= 1). Proof. -rewrite -dvdr1. apply/unitrP/dvdrP=> [[x [Hxa1 _]]|[x H]]; exists x. - by rewrite Hxa1. -by rewrite [a * x]mulrC !H. +rewrite -dvdr1; apply/unitrP/dvdrP => [[x [Hxa1 _]]|[x H]]; exists x => //. +by split=> //; rewrite mulrC. Qed. Lemma eqd1 a : a \in GRing.unit -> a %= 1. @@ -637,20 +609,20 @@ Proof. by move=> hM i j; rewrite !mxE. Qed. (* TODO: Prove other direction *) Lemma dvdr_col_mx m n p x (M : 'M[R]_(m,n)) (N : 'M[R]_(p,n)) : - ((forall i j, x %| M i j) /\ (forall i j, x %| N i j)) -> - (forall i j, x %| (col_mx M N) i j). + (forall i j, x %| M i j) /\ (forall i j, x %| N i j) -> + forall i j, x %| (col_mx M N) i j. Proof. -case=> h1 h2 i j; rewrite !mxE; case: splitP=> k _. +case=> h1 h2 i j; rewrite !mxE; case: splitP=> k {i}_. exact: (h1 k j). exact: (h2 k j). Qed. (* TODO: Prove other direction *) Lemma dvdr_row_mx m n p x (M : 'M[R]_(m,n)) (N : 'M[R]_(m,p)) : - ((forall i j, x %| M i j) /\ (forall i j, x %| N i j)) -> - (forall i j, x %| (row_mx M N) i j). + (forall i j, x %| M i j) /\ (forall i j, x %| N i j) -> + forall i j, x %| (row_mx M N) i j. Proof. -case=> h1 h2 i j; rewrite !mxE; case: splitP=> k _. +case=> h1 h2 i j; rewrite !mxE; case: splitP=> k {j}_. exact: (h1 i k). exact: (h2 i k). Qed. @@ -965,9 +937,9 @@ Proof. by rewrite dvdr_mull. Qed. Lemma mulr_lcm_gcd a b : lcmr a b * gcdr a b = a * b. Proof. rewrite /lcmr /=; move: (dvdr_gcd_mul a b). -case a0: (a == 0); first by rewrite /= (eqP a0) !mul0r. -case b0: (b == 0); first by rewrite /= (eqP b0) !(mulr0, mul0r). -by rewrite /dvdr; case: odivrP=> // x. +have [-> | a0] := eqVneq a 0; first by rewrite !mul0r. +have [-> | b0] := eqVneq b 0; first by rewrite !(mulr0, mul0r). +by rewrite /dvdr; case: odivrP => // x. Qed. Lemma lcmr0 a : lcmr a 0 = 0. @@ -978,15 +950,15 @@ Proof. by rewrite /lcmr eqxx. Qed. Lemma dvdr_lcm a b c : (lcmr a b %| c) = (a %| c) && (b %| c) :> bool. Proof. -case a0: (a == 0). - rewrite (eqP a0) lcm0r dvd0r. - by case c0: (c == 0); rewrite // (eqP c0) dvdr0. -case b0: (b == 0). - rewrite (eqP b0) lcmr0 dvd0r. - by case c0: (c == 0); rewrite ?andbF // (eqP c0) dvdr0. -rewrite -(@dvdr_mul2r _ (gcdr a b)); last by rewrite gcdr_eq0 a0 b0. +have [-> | a0] := eqVneq a 0. + rewrite lcm0r dvd0r. + by case: eqP => //= ->; rewrite dvdr0. +have [-> | b0] := eqVneq b 0. + rewrite lcmr0 dvd0r andbC. + by case: eqP => //= ->; rewrite dvdr0. +rewrite -(@dvdr_mul2r _ (gcdr a b)); last by rewrite gcdr_eq0 negb_and a0. rewrite mulr_lcm_gcd (eqd_dvd (eqdd _) (mulr_gcdr _ _ _)) dvdr_gcd {1}mulrC. -by rewrite !dvdr_mul2r ?a0 ?b0 // andbC. +by rewrite !dvdr_mul2r // andbC. Qed. Lemma dvdr_lcml a b : a %| lcmr a b. @@ -1010,9 +982,9 @@ Proof. by rewrite /eqd dvdr_lcm dvdr_lcml dvdrr dvd1r !andbT. Qed. Lemma lcmrC a b : lcmr a b %= lcmr b a. Proof. -case H0: (gcdr b a == 0). - by move: H0; rewrite gcdr_eq0; case/andP=> ha; rewrite (eqP ha) lcmr0 lcm0r. -rewrite -(@eqd_mul2r _ (gcdr b a)) ?H0 //. +case/boolP: (gcdr b a == 0) => [|H0]. + by rewrite gcdr_eq0; case/andP => /eqP-> _; rewrite lcmr0 lcm0r. +rewrite -(@eqd_mul2r _ (gcdr b a)) //. by rewrite (eqd_trans (eqd_mul (eqdd _) (gcdrC b a))) // !mulr_lcm_gcd mulrC. Qed. @@ -1051,11 +1023,11 @@ Qed. Lemma mulr_lcmr a b c : a * lcmr b c %= lcmr (a * b) (a * c). Proof. -case H0: ((a * b == 0) && (a * c == 0)). - case/andP: H0; rewrite mulf_eq0; case/orP; move/eqP->. +case/boolP: ((a * b == 0) && (a * c == 0)) => [/andP[] | H0]. + rewrite mulf_eq0; case/orP => /eqP->. by rewrite !mul0r lcm0r. by rewrite mulr0 !lcm0r mulr0. -rewrite -(@eqd_mul2r _ (gcdr (a * b) (a * c))) ?gcdr_eq0 ?H0 // mulr_lcm_gcd. +rewrite -(@eqd_mul2r _ (gcdr (a * b) (a * c))) ?gcdr_eq0 // mulr_lcm_gcd. rewrite eqd_sym (eqd_trans _ (eqd_mul (eqdd _) (mulr_gcdr a b c))) //. by rewrite -!mulrA [lcmr b c * _]mulrCA mulr_lcm_gcd [b * _]mulrCA. Qed. @@ -1071,8 +1043,8 @@ Proof. by rewrite ![c * _]mulrC lcmr_mul2r. Qed. Lemma lcmr_mull a b : lcmr a (a * b) %= a * b. Proof. -case a0: (a == 0); first by rewrite (eqP a0) mul0r /eqd !lcm0r dvdr0. -rewrite -{1}[a]mulr1 (eqd_trans (lcmr_mul2l 1 b a)) // eqd_mul2l ?a0 //. +have [-> | a0] := eqVneq a 0; first by rewrite mul0r /eqd !lcm0r dvdr0. +rewrite -{1}[a]mulr1 (eqd_trans (lcmr_mul2l 1 b a)) // eqd_mul2l //. exact: (lcm1r b). Qed. @@ -1146,9 +1118,9 @@ Proof. by move=> cab; rewrite mulrC euclid_gcdr. Qed. Lemma coprimer_mulr a b c : coprimer a (b * c) = coprimer a b && coprimer a c. Proof. -case co_pm: (coprimer a b) => /=. +case/boolP: (coprimer a b) => co_pm /=. by rewrite /coprimer; apply: congr_eqd; rewrite // euclid_gcdl. -apply: negbTE; move/negP: co_pm; move/negP; apply: contra=> cabc. +apply: contraNF co_pm=> cabc. apply: gcdr_def; rewrite ?dvd1r // => x xa xb. by rewrite -(eqd_dvd (eqdd _) cabc) dvdr_gcd xa dvdr_mulr. Qed. @@ -1201,25 +1173,24 @@ Qed. (** Irreducible and prime elements *) Definition primer a := ((a == 0 = false) - * (a %= 1 = false) - * (forall b c, a %| (b * c) = (a %| b) || (a %| c) :> bool)%R)%type. + * (a %= 1 = false) + * (forall b c, a %| (b * c) = (a %| b) || (a %| c) :> bool)%R)%type. Definition irredr a := ((a == 0 = false) - * (a %= 1 = false) - * (forall b c, a %= b * c - -> (b %= 1) || (c %= 1))%R)%type. + * (a %= 1 = false) + * (forall b c, a %= b * c -> (b %= 1) || (c %= 1))%R)%type. Lemma irredrP : forall a, irredr a -> forall b c, a %= b * c -> b %= 1 \/ c %= 1. Proof. by move=> ? [ha ia] *; apply/orP; rewrite ia. Qed. -Lemma irredr_dvd : forall a b, irredr a -> a %| b = ~~(coprimer a b) :> bool. +Lemma irredr_dvd : forall a b, irredr a -> a %| b = ~~(coprimer a b) :> bool. Proof. rewrite /coprimer=> a b ia; case g1: (_ %= 1)=> /=. - apply/negP=> hab; suff: a %= 1 by rewrite ia. - by rewrite -dvdr1 (@dvdr_trans _ (gcdr a b)) ?dvdr_gcd ?dvdrr // dvdr1. + apply/negP=> hab; suff: a %= 1 by rewrite ia. + by rewrite -dvdr1 (@dvdr_trans _ (gcdr a b)) ?dvdr_gcd ?dvdrr // dvdr1. case: (dvdrP _ _ (dvdr_gcdl a b))=> x hx; rewrite hx. -move/eq_eqd: hx; case/irredrP=> //; last by rewrite g1. +move/eq_eqd: hx; case/irredrP => //; last by rewrite g1. move=> hx; rewrite (eqd_dvd (eqd_mul hx (eqdd _)) (eqdd _)). by rewrite mul1r dvdr_gcdr. Qed. @@ -1233,12 +1204,12 @@ move=> a; split=> ia; rewrite /primer /irredr !ia; do ![split]=> b c. apply/idP/idP; last by case/orP=> ha; [rewrite dvdr_mulr|rewrite dvdr_mull]. rewrite [_ %| b]irredr_dvd //; case cab: (coprimer _ _)=> //=. by rewrite mulrC euclid. -case b0: (b == 0); first by rewrite (eqP b0) mul0r eqdr0 ia. -case c0: (c == 0); first by rewrite (eqP c0) mulr0 eqdr0 ia. +have [-> | b0] := eqVneq b 0; first by rewrite mul0r eqdr0 ia. +have [-> | c0] := eqVneq c 0; first by rewrite mulr0 eqdr0 ia. rewrite eqd_def ia andb_orl. case/orP; case/andP; move/(dvdr_trans _)=> h; move/h. - by rewrite dvdr_mull_l ?b0 // => ->; rewrite orbT. -by rewrite dvdr_mulr_l ?c0 // => ->. + by rewrite dvdr_mull_l // => ->; rewrite orbT. +by rewrite dvdr_mulr_l // => ->. Qed. (** bigop **) @@ -1247,7 +1218,7 @@ Lemma big_dvdr_gcdr (I : finType) (F : I -> R) : forall i, \big[(@gcdr R)/0]_i F i %| F i. Proof. move=> i; elim: (index_enum I) (mem_index_enum i)=> // a l IHl. -rewrite in_cons big_cons; case/orP=> [/eqP ->|H]. +rewrite in_cons big_cons =>/orP [/eqP ->|H]. by rewrite dvdr_gcdl. exact: (dvdr_trans (dvdr_gcdr _ _) (IHl H)). Qed. @@ -1365,10 +1336,11 @@ Proof. by case: R=> [? [? []]]. Qed. Definition egcdr a b := let: (u, v) := bezout a b in - let g := u * a + v * b in - let a1 := odflt 0 (a %/? g) in - let b1 := odflt 0 (b %/? g) in - if g == 0 then (0,1,0,1,0) else (g, u, v, a1, b1). + let g := u * a + v * b in + if g == 0 then (0,1,0,1,0) else + let a1 := odflt 0 (a %/? g) in + let b1 := odflt 0 (b %/? g) in + (g, u, v, a1, b1). Variant egcdr_spec a b : R * R * R * R * R -> Type := EgcdrSpec g u v a1 b1 of u * a1 + v * b1 = 1 @@ -1394,19 +1366,19 @@ case: odivrP=> //= b1 Hb _. - apply/(mulIf g_neq0). by rewrite mulrDl mul1r -!mulrA -Ha -Hb. - by rewrite eqd_sym. -- by move : hb; rewrite /dvdr; case: odivrP. -by move: ha; rewrite /dvdr; case: odivrP. +- by move: hb; rewrite /dvdr; case: odivrP. +by move: ha; rewrite /dvdr; case: odivrP. Qed. (* Proof that any finitely generated ideal is principal *) (* This could use gcdsr if it would be expressed using bigops... *) -Fixpoint principal_gen n : 'cV[R]_n -> R := match n with - | 0 => fun _ => 0 - | S p => fun (I : 'cV[R]_(1 + p)) => - let x := I 0 0 in - let y := principal_gen (dsubmx I) in - let: (g,_,_,_,_) := egcdr x y in g -end. +Fixpoint principal_gen n : 'cV[R]_n -> R := + if n is p.+1 then + fun I : 'cV[R]_(1 + p) => + let x := I 0 0 in + let y := principal_gen (dsubmx I) in + let: (g,_,_,_,_) := egcdr x y in g + else fun => 0. (* Fixpoint principal_gen n (r : 'rV[R]_n) : R := \big[(fun x y => (egcdr x y).1.1.1.1) /0]_(i < n) (r 0 i). *) @@ -1431,14 +1403,14 @@ Qed. Definition principal n (I : 'cV[R]_n) : 'M[R]_1 := (principal_gen I)%:M. (* (x) \subset (x1...xn) iff exists (v1...vn) such that (x1...xn)(v1...vn)^T = (x) *) -Fixpoint principal_w1 n : 'cV[R]_n -> 'rV[R]_n := match n with - | 0 => fun _ => 0 - | S p => fun (I : 'cV[R]_(1 + p)) => - let g := principal_gen (dsubmx I) in - let us := principal_w1 (dsubmx I) in - let: (g',u,v,a1,b1) := egcdr (I 0 0) g in - row_mx u%:M (v *: us) -end. +Fixpoint principal_w1 n : 'cV[R]_n -> 'rV[R]_n := + if n is p.+1 then + fun (I : 'cV[R]_(1 + p)) => + let g := principal_gen (dsubmx I) in + let us := principal_w1 (dsubmx I) in + let: (g',u,v,a1,b1) := egcdr (I 0 0) g in + row_mx u%:M (v *: us) + else fun => 0. Lemma principal_w1_correct : forall n (I : 'cV[R]_n), principal_w1 I *m I = principal I. @@ -1466,8 +1438,8 @@ Proof. move=> n I. rewrite mul_mx_scalar. apply/matrixP => i j; rewrite !mxE !ord1 /= {j}. -case: n I i => [I i | n I i]; first by rewrite !flatmx0 /= mul0r !mxE. -case: odivrP => [ x -> | H]; first by rewrite mulrC. +case: n I i => [|n] I i; first by rewrite !flatmx0 /= mul0r !mxE. +case: odivrP => [x -> | H]; first by rewrite mulrC. case/dvdrP: (principal_gen_dvd I i)=> x Hx. move: (H x). by rewrite Hx eqxx. @@ -1566,9 +1538,9 @@ Lemma sdvd_Bezout_step (m n : nat) (M : 'M_(1 + m,1 + n)) (k : 'I_m) : ~~ (M 0 0 %| M (lift 0 k) 0) -> (Bezout_step (M 0 0) (M (lift 0 k) 0) M k) 0 0 %<| M 0 0. Proof. -move=> H; rewrite /sdvdr (eqd_dvd (Bezout_step_mx00 _) (eqdd _)) dvdr_gcdl. -rewrite (eqd_dvd (eqdd _ ) (Bezout_step_mx00 _)). -by apply/negP=> H'; rewrite (dvdr_trans H' (dvdr_gcdr _ _)) in H. +move=> H; rewrite /sdvdr (eqd_dvd (Bezout_step_mx00 _) (eqdd _)) dvdr_gcdl /=. +rewrite (eqd_dvd (eqdd _ ) (Bezout_step_mx00 _)); apply: contra H => H'. +exact: (dvdr_trans H' (dvdr_gcdr _ _)). Qed. Lemma unit_Bezout_mx m a b (k : 'I_m) : Bezout_mx a b k \in unitmx. @@ -1742,23 +1714,24 @@ move=> a a0; case: (edivP a a)=> q r ha; rewrite a0 /= => hr. apply: leq_trans (hr); rewrite ltnS; apply: contraLR hr. move/eqP: ha; rewrite addrC -(can2_eq (@addrNK _ _) (@addrK _ _)). rewrite -{1}[a]mul1r -mulrBl eq_sym -leqNgt. -case q1: (1 - q == 0); rewrite ?(eqP q1) ?mul0r; move/eqP->; rewrite ?leqnn //. -by move=> _; rewrite norm_mul // q1. +have [-> | q1] := eqVneq (1 - q) 0; rewrite ?mul0r => /eqP->; rewrite ?leqnn //. +by move=> _; rewrite norm_mul. Qed. -Definition odiv a b := let (q, r) := ediv a b in +Definition odiv a b := + let (q, r) := ediv a b in if r == 0 then Some (if b == 0 then 0 else q) else None. Lemma odivP a b : DvdRing.div_spec a b (odiv a b). Proof. rewrite /odiv; case: edivP=> q r -> hr. -case r0: (r == 0)=> //=; constructor. - by rewrite (eqP r0) addr0; case: ifP=> //; move/eqP->; rewrite !mulr0. -move=> x; case b0: (b == 0) hr=> /= hr. - by rewrite (eqP b0) !mulr0 add0r r0. +have [-> | r0] := eqVneq r 0; constructor. + by rewrite addr0; case: ifP => // /eqP->; rewrite !mulr0. +move=> x; case: (eqVneq b 0) hr => /= [-> _|b0 hr]. + by rewrite !mulr0 add0r. rewrite addrC (can2_eq (@addrK _ _) (@addrNK _ _)) -mulrBl. -case xq : (x - q == 0); first by rewrite (eqP xq) mul0r r0. -by apply: contraL hr; rewrite -leqNgt; move/eqP->; rewrite norm_mul ?xq. +have [-> | xq] := eqVneq (x - q) 0; first by rewrite mul0r. +by apply: contraL hr; rewrite -leqNgt => /eqP->; exact: norm_mul. Qed. Lemma odiv_def a b : odiv a b = if a %% b == 0 then Some (a %/ b) else None. @@ -1787,7 +1760,7 @@ Local Notation norm0_lt := (Dvd.norm0_lt mR). Lemma leq_norm : forall a b, b != 0 -> a %| b -> norm a <= norm b. Proof. -move=> a b b0; move/dvdrP=> [x hx]; rewrite hx norm_mul //. +move=> a b b0; move/dvdrP => [x hx]; rewrite hx norm_mul //. by apply: contra b0; rewrite hx; move/eqP->; rewrite mul0r. Qed. @@ -1795,7 +1768,7 @@ Lemma ltn_norm : forall a b, b != 0 -> a %<| b -> norm a < norm b. Proof. move=> a b b0; case/andP=> ab. case: (edivP a b)=> q r; rewrite b0 /= => ha nrb; rewrite {1}ha. -case r0: (r == 0); first by rewrite (eqP r0) addr0 dvdr_mull. +have [-> | r0] := eqVneq r 0; first by rewrite addr0 dvdr_mull. rewrite dvdr_addr ?dvdr_mull // (leq_trans _ nrb) // ltnS leq_norm ?r0 //. by move: (dvdrr a); rewrite {2}ha dvdr_addr ?dvdr_mull. Qed. @@ -1803,13 +1776,13 @@ Qed. Lemma sdvdr_wf : well_founded (@sdvdr [dvdRingType of R]). Proof. move=> a; wlog: a / a != 0=> [ha|]. - case a0: (a == 0); last by apply: ha; rewrite a0. - rewrite (eqP a0); constructor=> b; rewrite sdvdr0; apply: ha. + have [-> | a0] := eqVneq a 0; last by apply: ha; rewrite a0. + constructor=> b; rewrite sdvdr0; apply: ha. elim: (norm a) {-2}a (leqnn (norm a))=> [|n ihn] {}a ha a0. by constructor=> x; move/(ltn_norm a0); rewrite ltnNge (leq_trans ha) ?leq0n. -constructor=> x hx; move/(ltn_norm a0):(hx)=> hn; apply ihn. +constructor=> x hx; move/(ltn_norm a0):(hx)=> hn; apply: ihn. by rewrite -ltnS (leq_trans hn). -by apply: contra a0; move/eqP=> x0; move/sdvdrW:hx; rewrite x0 dvd0r. +by apply: contra a0 => /eqP x0; move/sdvdrW:hx; rewrite x0 dvd0r. Qed. Definition EuclidPID := PIDMixin sdvdr_wf. @@ -1817,19 +1790,18 @@ Definition EuclidPID := PIDMixin sdvdr_wf. Lemma mod_eq0 a b : (a %% b == 0) = (b %| a). Proof. case: (edivP a b)=> q r -> /=. -case b0: (b == 0)=> /=; first by rewrite (eqP b0) mulr0 dvd0r add0r. -move=> nrb; apply/eqP/idP=> [->| ]. +have [-> | /= b0] := eqVneq b 0; first by rewrite mulr0 dvd0r add0r. +move=> nrb; apply/eqP/idP=> [->|]. by apply/dvdrP; exists q; rewrite addr0. rewrite dvdr_addr ?dvdr_mull //. -case r0: (r == 0); first by rewrite (eqP r0). -by move/leq_norm; rewrite r0 leqNgt nrb; move/(_ isT). +have [-> // | r0] := eqVneq r 0. +by move/leq_norm; rewrite leqNgt r0 nrb => /(_ isT). Qed. Lemma norm_eq0 a : norm a = 0%N -> a = 0. Proof. -move/eqP=> na0; apply/eqP. -apply: contraLR na0; rewrite -lt0n=> a0. -by rewrite (leq_trans _ (norm0_lt a0)) // ltnS. +apply: contra_eq; rewrite -lt0n => a0. +exact/leq_trans/(norm0_lt a0). Qed. Lemma mod_spec: forall a b, b != 0 -> norm (a %% b) < (norm b). @@ -1840,11 +1812,11 @@ Proof. by case: edivP=> q r; rewrite mulr0 add0r=> ->. Qed. Lemma mod0r a : 0 %% a = 0. Proof. -case a0: (a == 0); first by rewrite (eqP a0) modr0. -case: edivP=> q r; rewrite a0 /=; move/eqP. -rewrite eq_sym (can2_eq (@addKr _ _) (@addNKr _ _)) addr0; move/eqP->. -rewrite -mulNr=> nra; apply/eqP; apply: contraLR nra; rewrite -leqNgt. -by move/leq_norm=> -> //; rewrite dvdr_mull. +have [-> | a0] := eqVneq a 0; first by rewrite modr0. +case: edivP=> q r; rewrite a0 /= => /eqP. +rewrite eq_sym (can2_eq (@addKr _ _) (@addNKr _ _)) addr0 => /eqP->. +rewrite -mulNr; apply: contraTeq; rewrite -leqNgt. +by move/leq_norm; apply; exact: dvdr_mull. Qed. Lemma dvd_mod a b g : (g %| a) && (g %| b) = (g %| b) && (g %| a %% b). @@ -1865,13 +1837,13 @@ Qed. Definition acc_gcd (n:nat) (hn: Acc (fun x y => x < y) n) : forall (a b:R), n = norm b -> R. -elim hn using acc_dep. clear n hn. -move => n hn hi a b heq. -move : (@tool a b). -case :(b == 0). +elim hn using acc_dep. +move => {}n {}hn hi a b heq. +move: (@tool a b). +case: (b == 0). - move => _; exact a. set r := (a %% b). -case : (r == 0). +case: (r == 0). - move => _; exact b. move/implyP => h. apply: (hi (norm r) _ b r (refl_equal (norm r))). @@ -1879,19 +1851,18 @@ rewrite heq. by apply: h. Defined. - Lemma acc_gcdP : forall (n:nat) (hn: Acc (fun x y => x < y) n) (a b: R) (hb: n = norm b) (g :R), g %| (acc_gcd hn a hb) = (g %| a) && (g %| b). Proof. move => n hn. -elim hn using acc_dep. clear n hn. -move => n hn hi a b heq g /=. +elim hn using acc_dep. +move => {}n {}hn hi a b heq g /=. move: (@tool a b). -case b0 : (b == 0). +case b0: (b == 0). - move => _. by rewrite (eqP b0) (dvdr0) andbT. -case r0 : ( a %% b == 0). +case r0: ( a %% b == 0). - move => _. by rewrite dvd_mod (eqP r0) dvdr0 andbT. move => h2. @@ -1900,7 +1871,7 @@ by rewrite -{1}dvd_mod. Qed. Definition GCD (a b:R) : R := - acc_gcd (guarded 100 lt_wf2 (norm b)) a (refl_equal (norm b)). + acc_gcd (guarded 100 ssr_lt_wf (norm b)) a (refl_equal (norm b)). Lemma GCDP : forall d a b, d %| GCD a b = (d %| a) && (d %| b). Proof. by rewrite /GCD => d a b; apply: acc_gcdP. Qed. @@ -1916,26 +1887,25 @@ Definition gcd a b := Lemma gcdP : forall d a b, d %| gcd a b = (d %| a) && (d %| b). Proof. -move=> d a b. rewrite /gcd. +move=> d a b; rewrite /gcd. wlog nba: a b / norm b <= norm a=>[hwlog|]. case: ltnP=> nab. by move/hwlog:(ltnW nab); rewrite ltnNge (ltnW nab) /= andbC. by move/hwlog:(nab); rewrite ltnNge nab. rewrite ltnNge nba /=. -case a0 : (a == 0). - by rewrite (eqP a0) dvdr0. +have [-> | a0] := eqVneq a 0; first by rewrite dvdr0. move: (norm a) {-1 3}a nba a0=> n {}a hn a0. -elim: n {-2}n (leqnn n) a b hn a0=> [|k ihk] n hk a b hn a0. +elim: n {-2}n (leqnn n) a b hn a0 => [|k ihk] n hk a b hn a0. move: hk hn; rewrite leqn0; move/eqP->; rewrite leqn0. - by move/eqP; move/norm_eq0->; rewrite modr0 a0 dvdr0 andbT. + by move/eqP/norm_eq0->; rewrite modr0 (negbTE a0) dvdr0 andbT. move: hk hn; rewrite leq_eqVlt; case/orP; last first. by rewrite ltnS=> hnk nb; rewrite ihk. move/eqP->; rewrite dvd_mod. -case r0: (_ == _); first by rewrite (eqP r0) dvdr0 andbT. -case b0: (b == 0). - rewrite (eqP b0) /= !modr0 dvdr0 /=. +case: eqP => [->|_]; first by rewrite dvdr0 andbT. +have [-> | b0] := eqVneq b 0. + rewrite !modr0 dvdr0 /=. by case: k {ihk}=> [|k]; rewrite mod0r eqxx. -by move=> nb; rewrite ihk // -ltnS (leq_trans (mod_spec _ _)) ?b0. +by move=> nb; rewrite ihk // -ltnS (leq_trans (mod_spec _ _)). Qed. Definition AccMixin := GcdDomainMixin GCDP. diff --git a/theory/edr.v b/theory/edr.v index 8d8202e..e68ffaa 100644 --- a/theory/edr.v +++ b/theory/edr.v @@ -141,7 +141,7 @@ Canonical gcdType := Eval hnf in GcdDomainType R gcdMixin. the the ring is a Bézout domain *) Definition bezout_edr a b : R * R := let: (P,d,Q) := smith (row_mx a%:M b%:M : 'rV_2) - in (P 0 0 * Q 0 0,P 0 0 * Q (rshift 1 0) 0). + in (P 0 0 * Q 0 0, P 0 0 * Q (rshift 1 0) 0). Lemma bezout_edrP a b : BezoutDomain.bezout_spec a b (bezout_edr a b). Proof. @@ -267,8 +267,8 @@ Qed. Lemma kermxP m n (M : 'M[R]_(m,n)) (X : 'rV_m) : reflect (exists Y : 'rV_m, X = Y *m kermx M) (X *m M == 0). Proof. -apply: (iffP idP)=> [|[Y ->]]; last by rewrite -mulmxA mul_kermx mulmx0. -by move/eqP/mulmxKV_kermx=> hX; exists (X *m col_ebase M). +apply: (iffP eqP)=> [|[Y ->]]; last by rewrite -mulmxA mul_kermx mulmx0. +by move/mulmxKV_kermx=> hX; exists (X *m col_ebase M). Qed. Definition coherentMixin := CoherentRing.Mixin kermxP. @@ -384,10 +384,10 @@ case: (injectiveb g) /injectiveP=> Hinjg; last first. have Hmin k1 i m1 n1 (h : 'I_k1 -> 'I_m1) : minn m1 n1 <= h i -> n1 <= h i. move=> Hhi; have := (leq_ltn_trans Hhi (ltn_ord (h i))). by rewrite gtn_min ltnn=> /ltnW/minn_idPr <-. -case: (altP (@forallP _ (fun i => f i < minn m n)))=>[Hwf|]; last first. +case/altP: (@forallP _ (fun i => f i < minn m n)) => [Hwf|]; last first. rewrite negb_forall=> /existsP [x]; rewrite -leqNgt=> /Hmin Hx. by rewrite (minor_eq0l _ _ Hx) dvdr0. -case: (altP (@forallP _ (fun i => g i < minn m n)))=>[Hwg|]; last first. +case/altP: (@forallP _ (fun i => g i < minn m n)) => [Hwg|]; last first. rewrite negb_forall=> /existsP [x]; rewrite -leqNgt minnC=> /Hmin Hx. by rewrite (minor_eq0r _ _ Hx) dvdr0. pose f1 i := Ordinal (Hwf i). @@ -399,7 +399,7 @@ have Hinjg1 : injective g1. case Hcfg: (codom f1 \subset codom g1); last first. move/negbT: Hcfg=> /subsetPn [x] /codomP [y Hy] /negP Habs. rewrite /minor (expand_det_row _ y). - rewrite [\sum_(_ <_) _](big1 _ xpredT) ?dvdr0 //. + rewrite [\sum_(_ <_) _](big1 _ xpredT) ?dvdr0 //. move=> j _; rewrite !mxE. have ->: (g j = g1 j :> nat) by []. have ->: (f y = f1 y :> nat) by []. @@ -422,21 +422,21 @@ have [l Hl]: {j | max = g j} by apply: eq_bigmax; rewrite card_ord. pose p := tperm l ord_max. set B := \prod_(_ < _) _. rewrite (reindex_inj (@perm_inj _ p)) /= big_ord_recr /= dvdr_mul //. - pose f := (g \o p \o (widen_ord (leqnSn j))). + pose f := (g \o p \o (widen_ord (leqnSn j))). have Hf: injective f. apply: inj_comp=> [|x y /eqP]. by apply: inj_comp=> //; exact: perm_inj. by rewrite -(inj_eq (@ord_inj _)) /= => H; apply/ord_inj/eqP. - have Hi: injective [ffun x => f x]. + have Hi: injective (finfun f). by move=> x e; rewrite !ffunE; exact: Hf. set C := \prod_(_ < _) _. have:= (IHj _ Hi). - have ->: C = \prod_i s`_([ffun x => f x] i). + have ->: C = \prod_i s`_(finfun f i). by apply: eq_bigr=> i _; rewrite ffunE. by apply. move: (sorted_nth0 (sorted_drop j Hs) (g (p ord_max) - j)). rewrite !nth_drop addn0 subnKC //= tpermR; case/orP: (leq_total j (g l))=> //. -rewrite leq_eqVlt; case/orP=> [|Hgm]; first by move/eqP=> ->; rewrite leqnn. +rewrite leq_eqVlt => /orP [|Hgm]; first by move/eqP=> ->; rewrite leqnn. have Habs: forall i, g i < j. move=> i; apply: (leq_ltn_trans _ Hgm). by rewrite -Hl /k; exact: (leq_bigmax i). @@ -455,8 +455,8 @@ Lemma Smith_gcdr_spec : (\big[(@gcdr gcdType)/0]_(g : {ffun 'I_k -> 'I_n}) minor f g A) . Proof. rewrite (eqd_ltrans eqd_seq_gcdr). -have [ _ _ [M [N [_ _ Heqs]]]]:= HAs. -have [ _ _ [P [Q [_ _ Hseq]]]]:= (equiv_sym HAs). +have [ _ _ [M [N [_ _ Heqs]]]] := HAs. +have [ _ _ [P [Q [_ _ Hseq]]]] := equiv_sym HAs. rewrite conform_mx_id in Heqs. rewrite conform_mx_id in Hseq. have HdivmA p q k1 (B C : 'M[R]_(p,q)) (M1 : 'M_p) (N1 : 'M_q) : diff --git a/theory/fpmod.v b/theory/fpmod.v index 0ffc61d..81d7e3e 100644 --- a/theory/fpmod.v +++ b/theory/fpmod.v @@ -346,7 +346,7 @@ rewrite /is_epi /eqmor subr0. move=> /dvd_col_mxP [X /dvdmxP [Z Z_def]] P psi. rewrite !subr0 => /= /dvdmxP [Y] /(congr1 (mulmx X)). rewrite !mulmxA -[X *m phi](addrNK 1%:M) mulmxDl mul1mx. -move=> /(canRL (addKr _)) ->. +move/(canRL (addKr _)) ->. rewrite -mulNmx opprB Z_def -mulmxA dvdmxD //; last first. by rewrite mulmxA dvdmxMl. by rewrite -mulmxA dvdmxMl // dvdmx_morphism. @@ -355,14 +355,14 @@ Qed. Lemma rinv_inj (psi : 'Mor(N, M)) : phi ** psi %= idm -> kernel phi %= 0. Proof. -move=> /(eqmorMl (kernel phi)); rewrite mulmorA mulmor1. +move/(eqmorMl (kernel phi)); rewrite mulmorA mulmor1. by rewrite (eqmor_ltrans (eqmorMr _ (mulkmor _))) mul0mor eqmor_sym. Qed. Lemma linv_surj (psi : 'Mor(N, M)) : psi ** phi %= idm -> coker phi %= 0. Proof. -move=> /(eqmorMr (coker phi)); rewrite -mulmorA mul1mor. +move/(eqmorMr (coker phi)); rewrite -mulmorA mul1mor. by rewrite (eqmor_ltrans (eqmorMl _ (mulmorc _))) mulmor0 eqmor_sym. Qed. @@ -371,9 +371,9 @@ Definition isomorphisms (psi : 'Mor(N, M)) := Lemma isoP : reflect (exists psi, isomorphisms psi) (isom phi). Proof. -rewrite /isom /injm /surjm; apply: (iffP idP) => [|[psi]]; last first. +rewrite /isom /injm /surjm; apply: (iffP andP) => [[]|[psi]]; last first. by move=> /andP [/rinv_inj -> /linv_surj ->]. -case/andP; rewrite /eqmor !subr0. +rewrite /eqmor !subr0. move=> phi_inj /dvd_col_mxP /sig_eqW [X /= hX]. have Xmor : pres M %| pres N *m X. rewrite (dvdmx_trans phi_inj) // dvd_ker -mulmxA -[X *m _](subrK 1%:M). @@ -524,7 +524,7 @@ Lemma mulepi_eq0 (L : {fpmod R}) (phi : 'Epi(M,N)) (Y : 'Mor(N, L)) : (phi ** Y %= 0) = (Y %= 0). Proof. apply/idP/idP; first by move/epi. -by move=> /eqmorMl /eqmor_ltrans ->; rewrite mulmor0. +by move/eqmorMl/eqmor_ltrans ->; rewrite mulmor0. Qed. End Epi1. @@ -610,7 +610,7 @@ Lemma kernelP (M N : {fpmod R}) (phi : 'Mor(M,N)) : Proof. split; first by rewrite mulkmor. move=> L X; apply: (iffP idP) => [|[Y]]; last first. - move=> /eqmorMr /eqmor_ltrans <-; rewrite -mulmorA. + move/eqmorMr/eqmor_ltrans <-; rewrite -mulmorA. by rewrite (eqmor_ltrans (eqmorMl _ (mulkmor _))) mulmor0. rewrite /eqmor; rewrite subr0 -dvd_ker => /dvdmxP [Y Yeq]. have Ymor : pres (source (kernel phi)) %| pres L *m Y. @@ -690,7 +690,7 @@ Lemma cokerP (M N : {fpmod R}) (phi : 'Mor(M,N)) : is_coker phi (coker phi). Proof. split; first by rewrite mulmorc. move=> L X; apply: (iffP idP) => [phiX|[Y]]; last first. - move=> /eqmorMl /eqmor_ltrans <-; rewrite mulmorA. + move/eqmorMl/eqmor_ltrans <-; rewrite mulmorA. by rewrite (eqmor_ltrans (eqmorMr _ (mulmorc _))) mul0mor. by exists (lift phi X); rewrite mul_lift. Qed. @@ -700,7 +700,7 @@ Lemma factor_proof (M N P : {fpmod R}) (phi : 'Mono(N,P)) (psi : 'Mor(M,P)) : reflect (exists kapa, kapa ** phi %= psi) (psi ** coker phi %= 0). Proof. apply: (iffP idP) => [|[c]]; last first. - move=> /eqmorMr /eqmor_ltrans <-; rewrite -mulmorA. + move/eqmorMr/eqmor_ltrans <-; rewrite -mulmorA. by rewrite (eqmor_ltrans (eqmorMl _ (mulmorc _))) mulmor0. rewrite /eqmor /= subr0 mulmx1 => /dvd_col_mxP [X Xdef]. suff Xmor : pres N %| pres M *m X. @@ -738,7 +738,7 @@ split; first by rewrite mulkmor. move=> L psi; apply: (iffP idP); last first. move=> [Y /eqmorMl /eqmor_ltrans <-]; rewrite mulmorA. by rewrite (eqmor_ltrans (eqmorMr _ (mulkmor _))) mul0mor. -move=> /mul_lift; have /mul_lift := mulkmor phi. +move/mul_lift; have /mul_lift := mulkmor phi. set phi' := lift _ phi; set psi' := lift _ psi. move=> phi'E psi'E. have phi'_mono : is_mono phi' by apply: lift_mono. diff --git a/theory/frobenius_form.v b/theory/frobenius_form.v index 978a4e4..96f2748 100644 --- a/theory/frobenius_form.v +++ b/theory/frobenius_form.v @@ -10,8 +10,8 @@ From CoqEAL Require Import similar perm_eq_image companion closed_poly smith_com proved here is the similarity between a matrix and its Frobenius normal form. - Frobenius_seq M == The same as the sequence Smith_seq (XI - M) where - each polynomial has been divded by their + Frobenius_seq M == The same as the sequence Smith_seq (XI - M) where + each polynomial has been divded by their lead coefficient (Hence each polynomial is monic). invariant_factors M == The sequence of non-constant polynomials of Frobenius_seq M. @@ -44,18 +44,17 @@ Lemma sorted_Frobenius_seq n (A : 'M[F]_n) : Proof. case: n A=> // n A. have Hp: forall (p : E), ((lead_coef p)^-1 *: p %= p)%P. - move=> p; case Hp0: (p == 0). - by rewrite (eqP Hp0) scaler0 eqpxx. + move=> p; have [-> | p0] := eqVneq p 0; first by rewrite scaler0 eqpxx. apply/eqpP; exists ((lead_coef p),1). - by rewrite !lead_coef_eq0 (negbT Hp0) oner_neq0. + by rewrite oner_neq0 andbT lead_coef_eq0. rewrite scalerA mulrV ?scale1r //. - by rewrite unitfE lead_coef_eq0 (negbT Hp0). + by rewrite unitfE lead_coef_eq0. suff : sorted (@dvdr _) (Frobenius_seq A). by apply: sorted_trans=> x y _ _; rewrite dvdr_dvdp=> ->. have /mono_sorted it - : {mono (fun p : {poly F} => (lead_coef p)^-1 *: p) : x y / + : {mono (fun p : {poly F} => (lead_coef p)^-1 *: p) : x y / x %| y}. - by move=> x y; rewrite !dvdr_dvdp (eqp_dvdl _ (Hp x)) (eqp_dvdr _ (Hp y)). + by move=> x y; rewrite !dvdr_dvdp (eqp_dvdl _ (Hp x)) (eqp_dvdr _ (Hp y)). rewrite it. set s := Smith_seq _. apply/(sorted_take (@dvdr_trans _))/sorted_Smith. @@ -63,23 +62,23 @@ Qed. Lemma size_Frobenius_seq n (A : 'M[F]_n) : size (Frobenius_seq A) = n. Proof. -by rewrite size_map size_Smith_seq // -size_poly_eq0 size_char_poly. +by rewrite size_map size_Smith_seq // -size_poly_eq0 size_char_poly. Qed. Lemma Frobenius_seq_char_poly n (A : 'M[F]_n) : \prod_(p <- Frobenius_seq A) p = char_poly A. Proof. -rewrite big_map scaler_prod prodfV. +rewrite big_map scaler_prod prodfV. have Hs m (B : 'M[F]_m): size (take m (Smith_seq (char_poly_mx B))) = m. by move: (size_Frobenius_seq B); rewrite size_map. -have Hp1: \prod_(i <- (take n (Smith_seq (char_poly_mx A)))) i = char_poly A. +have Hp1: \prod_(i <- (take n (Smith_seq (char_poly_mx A)))) i = char_poly A. case: n A => [A| n A]; first by rewrite big_nil /char_poly det_mx00. rewrite -(det_diag_mx_seq (Hs _ A)). by rewrite diag_mx_seq_takel det_Smith. have ->: \prod_(i <- (take n (Smith_seq (char_poly_mx A)))) lead_coef i = 1. rewrite lead_coef_prod Hp1. by apply/monicP/char_poly_monic. -by rewrite Hp1 invr1 scale1r. +by rewrite Hp1 invr1 scale1r. Qed. Lemma Frobenius_seq_neq0 n (A : 'M[F]_n) p : @@ -111,15 +110,14 @@ Proof. rewrite -diag_mx_seq_takel. apply: eqd_equiv=> // [|i]; first by rewrite size_map. set s := take _ _. -case Hi: (i < (size s))%N; last first. - by rewrite !nth_default ?eqdd // ?size_map leqNgt Hi. +case: (ltnP i (size s)) => Hi; last by rewrite !nth_default // size_map. rewrite (nth_map 0) //; apply/eqdP. exists ((lead_coef s`_i)^-1%:P). - have Hin: (Frobenius_seq A)`_i \in (Frobenius_seq A). + have Hin: (Frobenius_seq A)`_i \in Frobenius_seq A. by rewrite mem_nth // size_map. - have:= Frobenius_seq_neq0 Hin. + have:= Frobenius_seq_neq0 Hin. rewrite (nth_map 0) // scaler_eq0 negb_or=> /andP [Hl _]. - by rewrite rmorph_unit // unitfE. + by rewrite rmorph_unit // unitfE. by rewrite mul_polyC. Qed. @@ -145,7 +143,7 @@ Import GRing.Theory. Import PolyPriField. Variable T : fieldType. -Definition dvdpm (p q : {poly T}) := +Definition dvdpm (p q : {poly T}) := (p \is monic) && (q \is monic) && (dvdp p q). Lemma dvdpm_trans : transitive dvdpm. @@ -174,7 +172,7 @@ Lemma Frobenius_seqE n (A : 'M[F]_n) : Frobenius_seq A = nseq (n - size (invariant_factors A)) 1 ++ invariant_factors A. Proof. set m := subn _ _. -have HfA:= (size_Frobenius_seq A). +have HfA:= (size_Frobenius_seq A). have Hfrob: sorted (@dvdpm F) (Frobenius_seq A). have Hdvd: {in (Frobenius_seq A) &, forall p q, dvdp p q -> dvdpm p q}. move=> p q /= /monic_Frobenius_seq Hp /monic_Frobenius_seq Hq H. @@ -206,15 +204,15 @@ have Hfn: nseq m 1 = filter a (Frobenius_seq A). have: (filter a (Frobenius_seq A))`_i \in (filter a (Frobenius_seq A)). by rewrite mem_nth // -Hm. rewrite mem_filter=> /andP [Ha1 Ha2]. - have := (monicP (monic_Frobenius_seq Ha2)). + move: (monicP (monic_Frobenius_seq Ha2)). by rewrite (size1_polyC Ha1) lead_coefC => ->. by rewrite perm_sym Hfn Hfi; apply/permPl/perm_filterC. Qed. -Lemma invf_char_poly n (A : 'M[F]_n) : +Lemma invf_char_poly n (A : 'M[F]_n) : \prod_(p <- invariant_factors A) p = char_poly A. Proof. -rewrite -Frobenius_seq_char_poly Frobenius_seqE. +rewrite -Frobenius_seq_char_poly Frobenius_seqE. rewrite big_cat /= (big1_seq (nseq _ _)) ?mul1r // => i. case/andP=> _ /(nthP 0) [j]. by rewrite size_nseq=> Hj; rewrite nth_nseq Hj=> ->. @@ -224,7 +222,7 @@ Lemma dvdp_invf_char_poly m (A : 'M[F]_m) (p : {poly F}) : p \in (invariant_factors A) -> dvdp p (char_poly A). Proof. move=> Hp. -rewrite -invf_char_poly prod_seq_count. +rewrite -invf_char_poly prod_seq_count. have Hi: p \in undup (invariant_factors A) by rewrite mem_undup. rewrite (bigD1_seq _ Hi) ?undup_uniq //= dvdp_mulr // dvdp_exp //. by rewrite -has_count has_pred1. @@ -258,9 +256,8 @@ Qed. Lemma nnil_inv_factors n (A : 'M_n.+1) : invariant_factors A != [::]. Proof. -case H: (invariant_factors A)=> //. -have:= (sum_size_inv_factors A). -by rewrite H big_nil. +apply: contraPneq (sum_size_inv_factors A) => ->. +by rewrite big_nil. Qed. Let Smith_block_cpmx n (A : 'M[F]_n) := @@ -273,13 +270,14 @@ Let Smith_seq_cpmx n (A : 'M[F]_n) := let sp := invariant_factors A in let m := size_sum [seq (size p).-2 | p : E <- sp] in diag_mx_seq m.+1 m.+1 (Frobenius_seq A). - -Lemma cast_inv n (A : 'M[F]_n.+1) : size (Frobenius_seq A) = -(size_sum [seq (size p).-2 | p : E <- (invariant_factors A)]).+1. + +Lemma cast_inv n (A : 'M[F]_n.+1) : + size (Frobenius_seq A) = + (size_sum [seq (size p).-2 | p : E <- invariant_factors A]).+1. Proof. rewrite size_Frobenius_seq -{1}(sum_size_inv_factors A). -have Hni:= (nnil_inv_factors A). -rewrite size_sum_big -?size_eq0 ?size_map ?size_eq0 //. +rewrite size_sum_big; last first. + by rewrite -size_eq0 size_map size_eq0 nnil_inv_factors. rewrite !big_map /=; apply: eq_big_seq=> i. rewrite mem_filter=> /andP [Hi _]. by rewrite prednK // -subn1 subn_gt0. @@ -314,11 +312,11 @@ have Hltk : (size l < k)%N. rewrite /k (eq_big_seq (fun p : E => (size p).-2 + 1)%N). rewrite big_split /= addnC (big_nth 0) sum_nat_const_nat. by rewrite subn0 muln1 leq_addr. - by move=> i Hi /=; rewrite addn1 prednK // IHp. -apply/similar_equiv/similar_diag_mx_seq=> //. + by move=> i Hi /=; rewrite addn1 prednK // IHp. +apply/similar_equiv/similar_diag_mx_seq=> //. by rewrite !size_cat size_rcons !size_nseq subnK // Hk. apply/seq.permP=> x /=. -rewrite -cats1 !count_cat /= !count_nseq. +rewrite -cats1 !count_cat /= !count_nseq. rewrite !addnA addn0 (addnAC _ (x a)) -mulnDr; congr (_ * _ + _ + _ + _)%N. by rewrite /m big_cons (subnS _ (size l).+1) -{2}(prednK Ha) -addnBA //. Qed. @@ -335,7 +333,7 @@ have Hs1: (size p).-2.+1 = size s. have Hs2: (size p).-2.+1 = size (rcons (nseq (size p).-2 1) p). by rewrite size_rcons size_nseq. apply: eqd_equiv=> //; first by rewrite -Hs1 -Hs2. -have := (leqnSn (size p).-2). +have := leqnSn (size p).-2. rewrite -[X in (_ <= X)%N]minnn=> Hop. have Hsort: sorted %|%R s. by apply/(sorted_take (@dvdr_trans _))/sorted_Smith. @@ -345,13 +343,13 @@ have {Hop Hsort Hsm} := (Smith_gcdr_spec Hop Hsort Hsm). set d := \big[_/_]_(_<_) _=> H. have {H} Hd1: d %= 1. apply/(eqd_trans H)/andP; split; last by rewrite dvd1r. - apply: big_gcdr_def; exists ([ffun x => (lift ord0 x)]). - apply: big_gcdr_def; exists ([ffun x => (lift ord_max x)]). + apply: big_gcdr_def; exists (finfun (lift ord0)). + apply: big_gcdr_def; exists (finfun (lift ord_max)). rewrite /minor.minor /minor.submatrix /=. set M := \matrix_(_,_) _. have Hut: upper_triangular_mx M. apply/upper_triangular_mxP => i j Hij. - rewrite !mxE !ffunE -(inj_eq (@ord_inj _)) lift0 lift_max. + rewrite !mxE !ffunE -(inj_eq (@ord_inj _)) lift0 lift_max. rewrite !eqn_leq !(leqNgt _ j) ltn_ord subr0. by rewrite ltnW // ltnNge Hij !andFb subr0. rewrite (det_triangular_mx Hut). @@ -367,16 +365,16 @@ have Hip: s`_(size p).-2 %= p. rewrite det_diag_mx_seq // eqd_sym (big_nth 0) big_mkord. by rewrite -Hs1 big_ord_recr /=. move/eqd_big_mul1: Hd1 => H i. -have [Hi|Hi|/eqP Hi] := (ltngtP i (size p).-2). - by rewrite nth_rcons size_nseq Hi nth_nseq Hi (H (Ordinal Hi)). - by rewrite !nth_default // -?Hs1 // size_rcons size_nseq. -by rewrite nth_rcons size_nseq Hi (eqP Hi) ltnn. +case: (ltngtP i (size p).-2) => Hi. +- by rewrite nth_rcons size_nseq Hi nth_nseq Hi (H (Ordinal Hi)). +- by rewrite !nth_default // -?Hs1 // size_rcons size_nseq. +by rewrite nth_rcons size_nseq Hi eqxx ltnn. Qed. Definition Frobenius_form n (A : 'M[F]_n) := let sp := invariant_factors A in - let size := [seq (size p).-2 | p : E <- sp] in - let blocks n i := [seq companion_mxn n.+1 p | p <- sp]`_i in + let size := [seq (size p).-2 | p : E <- sp] in + let blocks n i := [seq companion_mxn n.+1 p | p <- sp]`_i in diag_block_mx size blocks. Lemma Frobenius n (A : 'M[F]_n.+1) : @@ -387,41 +385,40 @@ apply/similar_fundamental; rewrite char_diag_block_mx; last first. apply: (equiv_trans (equiv_Smith (char_poly_mx A))). rewrite /Smith_form. apply/(equiv_trans (equiv_Frobenius_seq A))/equiv_sym. -have Hn:= (size_Frobenius_seq A). +have Hn := size_Frobenius_seq A. rewrite /equivalent -{2 4 37 38 43 44}Hn cast_inv. apply: (equiv_trans _ (equiv_sbc_ssc A)). apply: equiv_diag_block=>[|i]; first by rewrite !size_map. rewrite size_map=> Hi. -rewrite !(nth_map 0) //. +rewrite !(nth_map 0) //. set C := char_poly_mx _. apply: (equiv_trans (equiv_Smith C)). apply: Smith_companion; move: (mem_nth 0 Hi). by rewrite mem_filter=> /andP []. exact: monic_invariant_factors. Qed. - -Lemma Frobenius_unicity n m (A : 'M[F]_n) (B : 'M_m) : similar A B <-> + +Lemma Frobenius_unicity n m (A : 'M[F]_n) (B : 'M_m) : similar A B <-> invariant_factors A = invariant_factors B. Proof. -split=> [[Hmn H]|H]; rewrite /invariant_factors. +split=> [[Hmn H]|H]; rewrite /invariant_factors. congr filter; apply: (@eq_from_nth _ 0)=>[|i Hi]. by rewrite !size_Frobenius_seq. - have/Frobenius_seq_neq0 := (mem_nth 0 Hi). + have/Frobenius_seq_neq0 := mem_nth 0 Hi. rewrite size_Frobenius_seq in Hi. rewrite !(nth_map 0) ?size_Smith_seq -?Hmn -?size_poly_eq0 ?size_char_poly //. rewrite size_poly_eq0 scaler_eq0 negb_or invr_eq0=> /andP [Hl0 _]. apply: (scalerI Hl0); rewrite !scalerA mulrV ?unitfE // scale1r. apply: eqpfP; rewrite /eqp -!dvdr_dvdp [X in take X]Hmn. rewrite Hmn in Hi; rewrite !nth_take //. - apply: Smith_unicity=> //. - exact: sorted_Smith. - set D := char_poly_mx A. + apply: Smith_unicity => //; first exact: sorted_Smith. + set D := char_poly_mx A. rewrite -{3 4 6 7}Hmn. apply: (equiv_trans _ (equiv_Smith D)). by apply/similar_fundamental/similar_sym. -have := (sum_size_inv_factors B). -rewrite -H sum_size_inv_factors=> /eqP Hmn. -case: n A H Hmn=> [A|n A]; case: m B=> [B|m B] H Hmn //. +have/eqP: n = m. +- by rewrite -(sum_size_inv_factors A) -(sum_size_inv_factors B) H. +case: n A H => [A|n A]; case: m B=> [B|m B] H Hmn //. exact: similar0. apply/(similar_trans (Frobenius A))/similar_sym/(similar_trans (Frobenius B)). rewrite /Frobenius_form H. @@ -431,40 +428,40 @@ Qed. Lemma mxminpoly_inv_factors n (A : 'M[F]_n.+1) : last 0 (Frobenius_seq A) = mxminpoly A. Proof. -have Hif: (0 < (size (invariant_factors A)))%N. +have Hif: (0 < size (invariant_factors A))%N. by rewrite lt0n size_eq0 nnil_inv_factors. have Hfn: [seq (size p).-2 | p : E <- invariant_factors A] != [::]. by rewrite -size_eq0 size_map size_eq0 nnil_inv_factors. apply: mxminpolyP=> [||q HA]. - apply: (@monic_Frobenius_seq _ A). - by rewrite -nth_last mem_nth // size_Frobenius_seq. - apply: (similar_horner (similar_sym (Frobenius A))). +- apply: (@monic_Frobenius_seq _ A). + by rewrite -nth_last mem_nth // size_Frobenius_seq. +- apply: (similar_horner (similar_sym (Frobenius A))). rewrite horner_mx_diag_block //. - apply/diag_block_mx0=> i; rewrite size_map=> Hi. - rewrite !(nth_map 0) // Frobenius_seqE last_cat -nth_last. + apply/diag_block_mx0=> i; rewrite size_map=> Hi. + rewrite !(nth_map 0) // Frobenius_seqE last_cat -nth_last. rewrite (set_nth_default 0) ?prednK // ?Hif //. set p := nth _ _ _. apply: (@horner_mx_dvdp _ _ p). - apply: sorted_leq_nth=> //. - -exact: dvdp_trans. - +exact: sorted_invf. - -by rewrite inE prednK. + apply: sorted_leq_nth=> //. + - exact: dvdp_trans. + - exact: sorted_invf. + - by rewrite inE prednK. by rewrite -ltnS prednK. rewrite -{5}[p]comp_mxminpolyK. - exact: mx_root_minpoly. - exact: (monic_invariant_factors (mem_nth 0 Hi)). - have:= (mem_nth 0 Hi). + - exact: mx_root_minpoly. + - exact: (monic_invariant_factors (mem_nth 0 Hi)). + move: (mem_nth 0 Hi). by rewrite mem_filter -subn_gt0 subn1; case/andP. -have:= (similar_horner (Frobenius A) HA). +move: (similar_horner (Frobenius A) HA). rewrite horner_mx_diag_block // => /diag_block_mx0=> H. rewrite Frobenius_seqE last_cat -nth_last (set_nth_default 0) ?prednK //. -have:= (H (size (invariant_factors A)).-1). +move: (H (size (invariant_factors A)).-1). rewrite size_map !(nth_map 0) ?prednK //. set p := nth _ _ _=> Hp. -have Hm:= (@mem_nth _ 0 (invariant_factors A) (size (invariant_factors A)).-1). +have Hm:= @mem_nth _ 0 (invariant_factors A) (size (invariant_factors A)).-1. rewrite -[p]comp_mxminpolyK ?dvdr_dvdp. - exact: (mxminpoly_min (Hp (leqnn _))). - apply/(@monic_invariant_factors _ A)/Hm. +- exact: (mxminpoly_min (Hp (leqnn _))). +- apply/(@monic_invariant_factors _ A)/Hm. by rewrite prednK // mem_filter -subn_gt0 subn1. move: Hm; rewrite prednK // mem_filter -subn_gt0 subn1=> h. by case/andP: (h (leqnn _)). @@ -479,18 +476,18 @@ Import GRing.Theory. Import PolyPriField. Variable R : closedFieldType. - + Lemma similar_poly_inv (p : {poly R}) : - let sp := linear_factor_seq p in - let size_seq := [seq (size p).-2 | p : {poly R} <- sp] in - let blocks n i := companion_mxn n.+1 sp`_i in - (1 < (size p))%N -> p \is monic -> - similar (companion_mx p) (diag_block_mx size_seq blocks). + let sp := linear_factor_seq p in + let size_seq := [seq (size p).-2 | p : {poly R} <- sp] in + let blocks n i := companion_mxn n.+1 sp`_i in + (1 < (size p))%N -> p \is monic -> + similar (companion_mx p) (diag_block_mx size_seq blocks). Proof. move=> /= Hp1 Hmp. -have:= (@coprimep_linear_factor_seq _ p). -have:= (@monic_linear_factor_seq _ p). -have:= (@size_linear_factor_leq1 _ p). +move: (@coprimep_linear_factor_seq _ p). +move: (@monic_linear_factor_seq _ p). +move: (@size_linear_factor_leq1 _ p). move: Hmp Hp1 (monic_prod_factor Hmp). elim: (linear_factor_seq p) {1 2 3 14 16}p. move=> p0 Hmp0 Hsp0; rewrite big_nil=> H. @@ -545,8 +542,8 @@ have {Hp2 Hml Hsl Hcp Hicp IHl} Hcap: coprimep a p2. by rewrite coprimepMr=> -> ->. rewrite Hp2 big_seq. apply: (big_ind (fun p => coprimep a p)). - + by apply: coprimep1. - + by move=> x y; rewrite coprimepMr => -> ->. + + by apply: coprimep1. + + by move=> x y; rewrite coprimepMr => -> ->. move=> i iin; move/(nth_index 0): (iin)=> iid. move: (iin); rewrite -index_mem -ltnS=> ii_prf. set j := Ordinal ii_prf. @@ -577,23 +574,23 @@ have Hcast: sap = (sa + sp)%N. by rewrite -subn1 subn_gt0. by move/monicP: Hma; move/monicP: Hmp2=> -> ->; rewrite mulr1 oner_eq0. have HdetM: \det M = p1. - rewrite det_diag_mx_seq ?size_cat ?size_rcons ?size_nseq //. + rewrite det_diag_mx_seq ?size_cat ?size_rcons ?size_nseq //. rewrite -!cats1 !big_cat /= !big_cons !big_nil. rewrite !big1_seq=> [|i|i]; try by rewrite mem_nseq => /= /andP[] _ /eqP. by rewrite !mul1r !mulr1 -Hp12. have Ho: (sa.-1 < (sa + sp).-1)%N by rewrite prednK // addnS leq_addr. -have HM1: row' (Ordinal Ho) (col' (Ordinal Ho) +have HM1: row' (Ordinal Ho) (col' (Ordinal Ho) (row' ord_max (col' ord_max M))) = 1%:M. apply/matrixP=> j k; rewrite !mxE !lift_max. rewrite nth_cat size_rcons size_nseq. case: ifP; rewrite nth_rcons size_nseq. - rewrite ltnS leq_eqVlt eq_sym (negbTE (neq_bump _ _)) /= => Hb. + rewrite ltnS leq_eqVlt eq_sym (negbTE (neq_bump _ _)) /= => Hb. by rewrite Hb nth_nseq Hb eqn_leq !leq_bump2 -eqn_leq. move/negbT;rewrite -leqNgt=> Hb. have Hb2: (bump (size a).-2 j - (size a).-2.+1 < (size p2).-2)%N. rewrite -(ltn_add2r sa _ _.-2) subnK //. - by rewrite (leq_trans (ltn_ord (lift (Ordinal Ho) j))) // addnC addSn. - by rewrite Hb2 nth_nseq Hb2 eqn_leq !leq_bump2 -eqn_leq. + by rewrite (leq_trans (ltn_ord (lift (Ordinal Ho) j))) // addnC addSn. + by rewrite Hb2 nth_nseq Hb2 eqn_leq !leq_bump2 -eqn_leq. apply/equiv_sym/(equiv_trans (equiv_Smith M)). rewrite /Smith_form -diag_mx_seq_takel. set s := take _ _. @@ -612,31 +609,31 @@ have {H2} Hd2: d2 %= 1. apply/(eqd_trans H2); rewrite /eqd !dvdr_dvdp. apply: (coprimepP _ _ Hcap); rewrite -dvdr_dvdp. +apply: big_gcdr_def; rewrite Hcast prednK ?addnS ?addSn //. - exists [ffun x => lift (@ord_max (sa + sp).-1) x]. + exists (finfun (lift (@ord_max (sa + sp).-1))). apply: big_gcdr_def. - exists [ffun x => lift (@ord_max (sa + sp).-1) x]. + exists (finfun (lift (@ord_max (sa + sp).-1))). rewrite /minor.minor /minor.submatrix /=. rewrite (expand_det_row _ (Ordinal Ho)) (bigD1 (Ordinal Ho)) //=. rewrite !mxE !ffunE big1 ?addr0. - rewrite nth_cat size_rcons size_nseq lift_max /=. + rewrite nth_cat size_rcons size_nseq lift_max /=. rewrite ltnS leqnn nth_rcons size_nseq ltnn eqxx. rewrite /cofactor exprD -expr2 sqrr_sign mul1r. - set N:= row' _ _. - have ->: N = 1%:M. + set N:= row' _ _. + have ->: N = 1%:M. by rewrite -HM1; apply/matrixP=> j k; rewrite !mxE !ffunE !lift_max. by rewrite det1 mulr1. move=> j /negbTE Hj; rewrite !mxE !ffunE. by rewrite (inj_eq (@ord_inj _)) (inj_eq (@lift_inj _ _)) eq_sym Hj mul0r. - have Ho2: (sa .-1 < sa + sp)%N by rewrite prednK // leq_addr. + have Ho2: (sa .-1 < sa + sp)%N by rewrite prednK // leq_addr. apply: big_gcdr_def; rewrite Hcast prednK ?addnS ?addSn //. - exists [ffun x => lift (Ordinal Ho2) x]. + exists (finfun (lift (Ordinal Ho2))). apply: big_gcdr_def. - exists [ffun x => lift (Ordinal Ho2) x]. + exists (finfun (lift (Ordinal Ho2))). rewrite /minor.minor /minor.submatrix /=. - have Hom: ((size a).-2 + (size p2).-2 < (size a).-2 + sp)%N by rewrite addnS. + have Hom: ((size a).-2 + (size p2).-2 < (size a).-2 + sp)%N by rewrite addnS. have Hlom k : lift (Ordinal Hom) k = widen_ord (leq_pred _) k. apply: ord_inj=> /=; rewrite /bump leqNgt. - by rewrite (leq_trans (ltn_ord k)) // addnS leqnn. + by rewrite (leq_trans (ltn_ord k)) // addnS leqnn. rewrite (expand_det_row _ (Ordinal Hom)). rewrite (bigD1 (Ordinal Hom)) //= big1 ?addr0. rewrite !mxE !ffunE /= -[X in bump X _]addn0 bumpDl /bump leq0n /=. @@ -644,8 +641,8 @@ have {H2} Hd2: d2 %= 1. rewrite ltnNge leq_addr /= nth_rcons size_nseq. rewrite {1 3}addnS !subSS !addKn !ltnn !eqxx. rewrite /cofactor exprD -expr2 sqrr_sign mul1r. - set N:= row' _ _. - have ->: N = 1%:M. + set N:= row' _ _. + have ->: N = 1%:M. rewrite -HM1; apply/matrixP=> j k. by rewrite !mxE !ffunE !lift_max !Hlom /=. by rewrite det1 mulr1. @@ -656,22 +653,22 @@ have Hsp: s`_sap.-1 %= p1. rewrite -(mul1r s`_sap.-1) (eqd_ltrans (eqd_mulr _ Hd2)). rewrite -HdetM -det_Smith /Smith_form -diag_mx_seq_takel det_diag_mx_seq. rewrite (big_nth 0) big_mkord Hs1 big_ord_recr /=. - by apply: eqd_mul=> //; rewrite /d2 prednK // Hcast addnS addSn. + by apply: eqd_mul=> //; rewrite /d2 prednK // Hcast addnS addSn. by rewrite Hs1 Hcast. move/eqd_big_mul1: Hd2=> H. have [Hi|Hi|/eqP Hi] := (ltngtP i sap.-1). +have Hi2: (i < sap.-2.+1)%N by rewrite prednK // Hcast addnS addSn. rewrite nth_rcons size_nseq Hi nth_nseq Hi. exact: (H (Ordinal Hi2)). - by rewrite !nth_default // ?Hs1 // size_rcons size_nseq. + by rewrite !nth_default // ?Hs1 // size_rcons size_nseq. by rewrite nth_rcons size_nseq Hi (eqP Hi) ltnn -Hp12. Qed. Definition Frobenius_form_CF n (A : 'M[R]_n) := - let fm f s := flatten (map f s) in + let fm f s := flatten (map f s) in let sp := invariant_factors A in let l p := linear_factor_seq p in - let sc p := [seq (size q).-2 | q : {poly R} <- l p] in + let sc p := [seq (size q).-2 | q : {poly R} <- l p] in let size := flatten (map sc sp) in let blocks m i := companion_mxn m.+1 (fm l sp)`_i in diag_block_mx size blocks. @@ -680,7 +677,7 @@ Lemma similar_Frobenius n (A : 'M[R]_n.+1) : similar (Frobenius_form A) (Frobenius_form_CF A). Proof. rewrite /Frobenius_form /Frobenius_form_CF. -have := (@monic_invariant_factors _ _ A). +move: (@monic_invariant_factors _ _ A). have: forall p, p \in (invariant_factors A) -> (1 < size p)%N. by move=> p; rewrite mem_filter; case/andP. case: (invariant_factors A)=>[_ _|a l]; first exact: similar_refl. @@ -691,17 +688,16 @@ elim: l a=> /= [a Hsa Hma |b l IHl a Hs Hm]. have IHs: forall p : {poly R}, p \in b :: l -> (1 < size p)%N. by move=> p Hp; apply: Hs; rewrite mem_behead. have IHm: forall p : {poly R}, p \in b :: l -> p \is monic. - by move=> p HP; apply: Hm; rewrite mem_behead. + by move=> p HP; apply: Hm; rewrite mem_behead. have Hsa: (1 < size a)%N by rewrite Hs // mem_head. have Hma: a \is monic by rewrite Hm // mem_head. set M := companion_mxn _ _. apply: (similar_trans (similar_drblockmx M (IHl b IHs IHm))). -apply: (similar_trans (similar_ulblockmx _ (similar_poly_inv Hsa Hma))). +apply: (similar_trans (similar_ulblockmx _ (similar_poly_inv Hsa Hma))). have Hnv: forall p, p \in [:: a, b & l] -> linear_factor_seq p != [::]. move=> p Hp; rewrite /linear_factor_seq -size_eq0 !size_map size_eq0. - rewrite /root_seq_uniq. - apply/negP=> /eqP/undup_nil/eqP; apply/negP; rewrite -root_seq_nil. - by rewrite -ltnNge Hs. + rewrite /root_seq_uniq; apply: contra_neq; first exact: undup_nil. + by rewrite -root_seq_nil -ltnNge; apply: Hs. set s1 := _ ++ _. set s2 := linear_factor_seq _ ++ _. have: (linear_factor_seq a) != [::] by rewrite Hnv // mem_head. @@ -719,9 +715,9 @@ set M := companion_mxn _ _. apply: similar_sym. apply: (similar_trans (similar_drblockmx M (similar_sym (IHs c)))). rewrite /GRing.zero /= -row_mx_const -col_mx_const block_mxA. -apply/similar_sym/similar_cast. -rewrite col_mx_const row_mx_const. -exact: similar_refl. +apply/similar_sym/similar_cast. +rewrite col_mx_const row_mx_const. +exact: similar_refl. Qed. End Polynomial. diff --git a/theory/gauss.v b/theory/gauss.v index a5b9393..45f145a 100644 --- a/theory/gauss.v +++ b/theory/gauss.v @@ -17,7 +17,7 @@ Local Open Scope ring_scope. Variable F : fieldType. Definition find_pivot m n (A : 'M[F]_(m,n.+1)) : option 'I_m := - [pick k | A k 0 != 0]. + [pick k | A k 0 != 0]. Fixpoint cormen_lup {m n} := match m, n return 'M_(m.+1,n.+1) -> 'S_m.+1 * 'M_(m.+1,m.+1) * 'M_(m.+1,n.+1) with diff --git a/theory/jordan.v b/theory/jordan.v index b23b69b..1f7ea14 100644 --- a/theory/jordan.v +++ b/theory/jordan.v @@ -6,7 +6,7 @@ From CoqEAL Require Import binetcauchy ssrcomplements mxstructure minor. From CoqEAL Require Import smith dvdring polydvd. From CoqEAL Require Import similar perm_eq_image companion closed_poly smith_complements. From CoqEAL Require Import frobenius_form. - + (** The main result of this file is the theorem of Jordan decomposition. A direct consequence of this theorem is the diagonalization theorem. @@ -19,7 +19,7 @@ From CoqEAL Require Import frobenius_form. *) - + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -30,7 +30,7 @@ Variable R : ringType. Import GRing.Theory. Local Open Scope ring_scope. -Definition Jordan_block lam n : 'M[R]_n := +Definition Jordan_block lam n : 'M[R]_n := \matrix_(i,j) (lam *+ (i == j :> nat) + (i.+1 == j)%:R). Lemma Jordan_block0 : Jordan_block 0 1 = 0. @@ -58,40 +58,40 @@ Lemma det_Jordan_block (lam : R) n : \det (Jordan_block lam n) = lam ^+ n. Proof. rewrite det_triangular_mx; last by apply: upt_Jordan_block. rewrite -{8}[n]card_ord -prodr_const. -by apply:eq_bigr=> i _; rewrite mxE eqxx eqn_leq ltnn addr0. +by apply: eq_bigr=> i _; rewrite mxE eqxx eqn_leq ltnn addr0. Qed. -Lemma Jordan_expn (lam : R) n k : - (Jordan_block lam n.+1)^+ k = - \matrix_(i,j) (('C(k,j - i)%:R * (lam^+ (k - (j - i)))) *+ (i <= j)). +Lemma Jordan_expn (lam : R) n k : + (Jordan_block lam n.+1)^+ k = + \matrix_(i,j) (('C(k,j - i)%:R * (lam^+ (k - (j - i)))) *+ (i <= j)). Proof. elim: k =>[|k IHk]. apply/matrixP=> i j; rewrite !mxE bin0n subn_eq0 sub0n mulr1 [RHS]mulrb. by rewrite -(inj_eq (@ord_inj _)) eqn_leq /andb; case: ifP. rewrite exprS IHk. apply/matrixP=> i j; rewrite !mxE. -case: (altP (i =P ord_max))=> Hi. -rewrite (bigD1 i) //= !mxE big1 ?addr0=>[|l /negbTE Hl]. - rewrite eqxx eqn_leq ltnn addr0. - have ->: (j - i)%N = 0%N by apply/eqP; rewrite subn_eq0 Hi -ltnS. +case: (eqVneq i ord_max) => Hi. +- rewrite (bigD1 i) //= !mxE big1 ?addr0=>[|l /negbTE Hl]. + - rewrite eqxx eqn_leq ltnn addr0. + have ->: (j - i)%N = 0%N by apply/eqP; rewrite subn_eq0 Hi -ltnS. by rewrite !bin0 !mul1r !subn0 mulrnAr exprS. rewrite !mxE eq_sym [(_ == _ :> nat)]Hl Hi eqn_leq. by rewrite ltnNge -ltnS ltn_ord addr0 mul0r. have Ho: (i.+1 < n.+1)%N by rewrite ltn_neqAle Hi ltn_ord. rewrite (bigD1 i) //= (bigD1 (Ordinal Ho)); last first. by rewrite -(inj_eq (@ord_inj _)) eqn_leq ltnn. -rewrite !mxE eqxx (@eq_sym nat_eqType i) !eqn_leq !ltnn addr0 add0r. +rewrite !mxE eqxx (@eq_sym nat_eqType i) !eqn_leq !ltnn addr0 add0r. rewrite !leqnn mul1r subnS /= big1 ?addr0; last first. move=> l /andP [] /negbTE Hil /negbTE Hl. by rewrite !mxE eq_sym [_ == _ :>nat]Hil eq_sym [_ == _ :>nat]Hl addr0 mul0r. case: (ltngtP i j)=> Hij; last first. - (*******************cas i = j***********************************) - by rewrite Hij subnn !subn0 addr0 !bin0 !mul1r exprS. + (*******************cas i = j***********************************) +- by rewrite Hij subnn !subn0 addr0 !bin0 !mul1r exprS. (****************** cas j < i ****************************************) - by rewrite addr0 mulr0. +- by rewrite addr0 mulr0. (************* cas i <= j***************************) rewrite !mulr1n mulrC -mulrA -exprSr -{2}subn1. -have H1ij: (1 <= j - i)%N by rewrite subn_gt0. +have H1ij: (1 <= j - i)%N by rewrite subn_gt0. rewrite (subnBA _ H1ij) addn1. case: (leqP (j-i) k)=> Hijk. by rewrite (subSn Hijk) -mulrDl -{1}(prednK H1ij) -natrD -binS prednK. @@ -102,16 +102,16 @@ case/orP: Hijk=> Hijk. rewrite (eqP Hijk) binn. rewrite -(prednK H1ij) eqSS in Hijk. by rewrite (eqP Hijk) binn. -by rewrite !bin_small // -ltnS prednK. +by rewrite !bin_small // -ltnS prednK. Qed. -Lemma char_poly_Jordan_block (lam : R) n : +Lemma char_poly_Jordan_block (lam : R) n : char_poly (Jordan_block lam n) = ('X - lam%:P) ^+n. Proof. rewrite char_poly_triangular_mx; last by apply: upt_Jordan_block. rewrite (eq_bigr (fun _ => ('X - lam%:P))) ?prodr_const ?card_ord //. -by move=> i; rewrite mxE eqxx eqn_leq ltnn addr0. +by move=> i; rewrite mxE eqxx eqn_leq ltnn addr0. Qed. End trigonal. @@ -124,8 +124,8 @@ Import PolyPriField. Local Open Scope ring_scope. -Lemma similar_cj n (lam : R) : - similar (companion_mx (('X - lam%:P)^+ n.+1)) (Jordan_block lam n.+1). +Lemma similar_cj n (lam : R) : + similar (companion_mx (('X - lam%:P)^+ n.+1)) (Jordan_block lam n.+1). Proof. set p := _^+n.+1. have Hmp: p \is monic by rewrite monic_exp // monicXsubC. @@ -137,21 +137,21 @@ set M := char_poly_mx _. apply/equiv_sym/(equiv_trans (equiv_Smith M)). rewrite /Smith_form -diag_mx_seq_takel. set s := take _ _. -have Hs1: size s = n.+1. +have Hs1: size s = n.+1. rewrite size_Smith_seq // -/(char_poly _) char_poly_Jordan_block. by rewrite -size_poly_eq0 size_exp_XsubC. -apply: eqd_equiv; rewrite ?size_exp_XsubC // ?size_rcons ?size_nseq //. +apply: eqd_equiv; rewrite ?size_exp_XsubC // ?size_rcons ?size_nseq //=. have Hsort: sorted (@dvdr _) s. - by apply/(sorted_take (@dvdr_trans _))/sorted_Smith. -have:= (equiv_Smith M). + by apply/(sorted_take (@dvdr_trans _))/sorted_Smith. +move: (equiv_Smith M). rewrite /Smith_form -diag_mx_seq_takel => Hequiv. have Hlemin: (n <= minn n.+1 n.+1)%N by rewrite minnn. -have:= Smith_gcdr_spec Hlemin Hsort Hequiv. +move: (Smith_gcdr_spec Hlemin Hsort Hequiv). set d := \big[_/_]_(_<_) _=> H. have {H} Hd1: d %= 1. apply/(eqd_trans H)/andP; split; last by rewrite dvd1r. - apply: big_gcdr_def; exists [ffun x => (lift ord_max x)]. - apply: big_gcdr_def; exists [ffun x => (lift ord0 x)]. + apply: big_gcdr_def; exists (finfun (lift ord_max)). + apply: big_gcdr_def; exists (finfun (lift ord0)). rewrite /minor.minor /minor.submatrix /=. set N := \matrix_(_,_) _. have Hut: upper_triangular_mx N^T. @@ -168,13 +168,13 @@ have Hip: s`_n %= p. rewrite eqd_sym in Hd1. rewrite -(mul1r s`_n) (eqd_ltrans (eqd_mulr _ Hd1)). rewrite /p -char_poly_Jordan_block /char_poly -det_Smith. - rewrite /Smith_form -diag_mx_seq_takel det_diag_mx_seq //. + rewrite /Smith_form -diag_mx_seq_takel det_diag_mx_seq //. by rewrite (big_nth 0) big_mkord Hs1 big_ord_recr. move/eqd_big_mul1: Hd1 => H i. -have [Hi|Hi|/eqP Hi] := (ltngtP i n). - by rewrite nth_rcons size_nseq Hi nth_nseq Hi (H (Ordinal Hi)). - by rewrite !nth_default // ?Hs1 // size_rcons size_nseq. -by rewrite nth_rcons size_nseq (eqP Hi) ltnn eqxx. +case: (ltngtP i n) => Hi. +- by rewrite nth_rcons size_nseq Hi nth_nseq Hi (H (Ordinal Hi)). +- by rewrite !nth_default // ?Hs1 // size_rcons size_nseq. +by rewrite nth_rcons size_nseq Hi ltnn eqxx. Qed. End similar. @@ -190,11 +190,11 @@ Local Open Scope ring_scope. Definition Jordan_form m (A : 'M[R]_m.+1) := let sp := root_seq_poly (invariant_factors A) in - let sizes := [seq (x.2).-1 | x <- sp] in - let blocks n i := Jordan_block (nth (0,0%N) sp i).1 n.+1 in + let sizes := [seq (x.2).-1 | x <- sp] in + let blocks n i := Jordan_block (nth (0,0%N) sp i).1 n.+1 in diag_block_mx sizes blocks. - -Lemma upt_Jordan n (A : 'M[R]_n.+1) : + +Lemma upt_Jordan n (A : 'M[R]_n.+1) : upper_triangular_mx (Jordan_form A). Proof. apply: upper_triangular_diag_block=> j. @@ -203,8 +203,8 @@ Qed. Lemma Jordan n (A : 'M[R]_n.+1) : similar A (Jordan_form A). Proof. -apply:(similar_trans (Frobenius _)). -apply:(similar_trans (similar_Frobenius _)). +apply: (similar_trans (Frobenius _)). +apply: (similar_trans (similar_Frobenius _)). rewrite /Frobenius_form_CF /Jordan_form /root_seq_poly /linear_factor_seq. set s1 := flatten _. set s2 := map _ _. @@ -214,10 +214,10 @@ have Hs: size s1 = size s2. apply: similar_diag_block=> // i; rewrite /s1. (do 2! rewrite map_comp -map_flatten size_map) => Hi. rewrite !(nth_map 0) ?size_map //. -rewrite !(nth_map (0,0%N)) ?size_map //. +rewrite !(nth_map (0,0%N)) ?size_map //. set x := nth _ _ _. rewrite -(@prednK x.2); first exact: similar_cj. -have/flattenP [s Hfs Hx] := (mem_nth (0,0%N) Hi); move: Hfs. +have/flattenP [s Hfs Hx] := mem_nth (0,0%N) Hi; move: Hfs. case/(nthP nil)=> m; rewrite !size_map=> Hm Heq. move: Heq Hx; rewrite (nth_map 0) // => <-. apply: root_mu_seq_pos. @@ -232,41 +232,41 @@ rewrite (similar_char_poly (Jordan A)). exact: (char_poly_triangular_mx (upt_Jordan A)). Qed. -Lemma eigen_diag n (A : 'M_n.+1) : +Lemma eigen_diag n (A : 'M_n.+1) : let sp := root_seq_poly (invariant_factors A) in - let sizes := [seq (x.2).-1 | x <- sp] in - perm_eq [seq (Jordan_form A) i i | i <- enum 'I_(size_sum sizes).+1] - (root_seq (char_poly A)). + let sizes := [seq (x.2).-1 | x <- sp] in + perm_eq [seq (Jordan_form A) i i | i <- enum 'I_(size_sum sizes).+1] + (root_seq (char_poly A)). Proof. have Hinj: injective (fun (c : R) => 'X - c%:P). by move=> x y /= H; apply/polyC_inj/oppr_inj/(addrI 'X). apply: (perm_map_inj Hinj). apply: (@unicity_decomposition _ _ _ (char_poly A)). - +move=> r /(nthP 0) []i; rewrite !size_map=> Hi. - rewrite (nth_map 0) ?size_map // => <-. - exact: irredp_XsubC. - -move=> r /(nthP 0) []i; rewrite !size_map=> Hi. - rewrite (nth_map 0) ?size_map // => <-. - exact: irredp_XsubC. - +move=> r /(nthP 0) []i; rewrite !size_map=> Hi. - rewrite (nth_map 0) ?size_map // => <-. - exact: monicXsubC. - -move=> r /(nthP 0) []i; rewrite !size_map=> Hi. - rewrite (nth_map 0) ?size_map // => <-. - exact: monicXsubC. - +by rewrite !big_map; exact: Jordan_char_poly. - -rewrite big_map {1}[char_poly A]root_seq_eq . - by rewrite (monicP (char_poly_monic A)) scale1r. ++ move=> r /(nthP 0) []i; rewrite !size_map=> Hi. + rewrite (nth_map 0) ?size_map // => <-. + exact: irredp_XsubC. +- move=> r /(nthP 0) []i; rewrite !size_map=> Hi. + rewrite (nth_map 0) ?size_map // => <-. + exact: irredp_XsubC. ++ move=> r /(nthP 0) []i; rewrite !size_map=> Hi. + rewrite (nth_map 0) ?size_map // => <-. + exact: monicXsubC. +- move=> r /(nthP 0) []i; rewrite !size_map=> Hi. + rewrite (nth_map 0) ?size_map // => <-. + exact: monicXsubC. ++ by rewrite !big_map; exact: Jordan_char_poly. +rewrite big_map {1}[char_poly A]root_seq_eq. +by rewrite (monicP (char_poly_monic A)) scale1r. Qed. Lemma diagonalization n (A : 'M[R]_n.+1) : uniq (root_seq (mxminpoly A)) -> similar A (diag_mx_seq n.+1 n.+1 (root_seq (char_poly A))). Proof. move=> H. -have [Heq _]:= (Jordan A). -pose s := [seq (x.2).-1 | x <- root_seq_poly (invariant_factors A)]. +have [Heq _]:= Jordan A. +pose s := [seq (x.2).-1 | x <- root_seq_poly (invariant_factors A)]. have Hs: size ([seq (Jordan_form A) i i | i <- enum 'I_(size_sum s).+1]) = n.+1. - by rewrite size_map size_enum_ord. + by rewrite size_map size_enum_ord. have Hn i: nth 0%N s i = 0%N. case: (ltnP i (size (root_seq_poly (invariant_factors A))))=> Hi. rewrite (nth_map (0,0%N)) //. @@ -283,19 +283,19 @@ have Hn i: nth 0%N s i = 0%N. apply: sorted_leq_nth=> //. -exact: dvdp_trans. -exact: sorted_invf. - -by rewrite inE prednK. + -by rewrite inE prednK. by rewrite -ltnS prednK. by rewrite nth_default // size_map. -apply: (similar_trans (Jordan A)). +apply: (similar_trans (Jordan A)). apply: (similar_trans _ (similar_diag_mx_seq (erefl n.+1) Hs (eigen_diag A))). rewrite /Jordan_form diag_block_mx_seq //. rewrite size_map size_enum_ord in Hs. rewrite Hs. -set s1 := mkseq _ _. +set s1 := mkseq _ _. set s2 := map _ _. have ->: s2 = s1. apply: (@eq_from_nth _ 0). - rewrite size_map size_enum_ord Heq size_mkseq. + rewrite size_map size_enum_ord Heq size_mkseq. rewrite size_sum_big. rewrite (eq_big_seq (fun _ => 1%N)). by rewrite (big_nth 0%N) sum_nat_const_nat subn0 muln1. @@ -311,8 +311,8 @@ have ->: s2 = s1. by rewrite mem_filter; case/andP=> ->. move=> i; rewrite size_map size_enum_ord=> Hi. rewrite (nth_map 0) ?size_enum_ord //. - by rewrite (nth_ord_enum 0 (Ordinal Hi)) !mxE eqxx. -exact: similar_refl. + by rewrite (nth_ord_enum 0 (Ordinal Hi)) !mxE eqxx. +exact: similar_refl. Qed. Lemma ex_diagonalization n (A : 'M[R]_n.+1) : uniq (root_seq (mxminpoly A)) -> diff --git a/theory/kaplansky.v b/theory/kaplansky.v index c98d019..7d2346b 100644 --- a/theory/kaplansky.v +++ b/theory/kaplansky.v @@ -20,14 +20,12 @@ Variable R : dvdRingType. Variable smith2x2 : 'M[R]_2 -> 'M[R]_2 * seq R * 'M[R]_2. Definition smith1xn n (smith2xn : 'M[R]_(2,n.+2) -> 'M[R]_2 * seq R * 'M[R]_n.+2) - (M : 'M[R]_(1,n.+2)) : 'M[R]_1 * seq R * 'M[R]_n.+2 := + (M : 'M[R]_(1,n.+2)) : 'M[R]_1 * seq R * 'M[R]_n.+2 := let: (L,d,R) := smith2xn (col_mx M 0) in if d`_0 == 0 then (1%:M,[::],1%:M) else ((L 0 0)%:M, [:: d`_0], R). Fixpoint smith2xn n : 'M[R]_(2,1 + (1 + n)) -> 'M[R]_2 * seq R * 'M[R]_n.+2 := - match n with - | 0 => fun A => smith2x2 A - | n.+1 => fun A : 'M[R]_(2,1 + _) => + if n is p.+1 then fun A : 'M[R]_(2,1 + _) => let: A1 := lsubmx A in let: A2 := rsubmx A in let: (P1,d1,Q1) := smith2xn A2 in let: C := row_mx (P1 *m A1) (P1 *m A2 *m Q1) : 'M[R]_(2,1 + (1 + _)) in @@ -43,7 +41,7 @@ Fixpoint smith2xn n : 'M[R]_(2,1 + (1 + n)) -> 'M[R]_2 * seq R * 'M[R]_n.+2 := (lift0_mx L1 *m P2 *m P1, y :: d, lift0_mx Q1 *m block_mx Q2 0 0 1%:M *m block_mx 1%:M (- r' *m R1') 0 R1') - end. + else fun A => smith2x2 A. Fixpoint smithmxn_rec m n : 'M[R]_(1 + (1 + m),1 + (1 + n)) -> 'M[R]_(1 + (1 + m)) * seq R * 'M[R]_(1 + (1 + n)) := match m,n with @@ -118,7 +116,7 @@ have [d0|d_neq0] := (boolP (d`_0 == 0)). move/(canRL (mulmxK hQ))/(canRL (mulKmx hP))/matrixP: h_eq. rewrite diag_mx_seq0; last by rewrite sorted_dvd0r // sorted_cons // dvd0r. rewrite mul0mx mulmx0 ord1 {i} diag_mx_seq_nil. - by move=> /(_ (widen_ord (lt0n 2) 0) j); rewrite !mxE split1; case: unliftP. + by move/(_ (widen_ord (lt0n 2) 0) j); rewrite !mxE split1; case: unliftP. move/matrixP: h_eq; rewrite -mulmxA [col_mx M 0 *m _]mul_col_mx mul0mx=> h_eq. have hP00 : ((P 0 0)%:M : 'M_1) \in unitmx. rewrite unitmxE det_scalar expr1; apply/unitrPr; exists ((invmx P) 0 0). @@ -157,16 +155,16 @@ have dvd_d20_d0 : d2`_0 %| d1`_0. apply: dvdr_mulmxl=> i j; apply: dvdr_mulmxr=> {}i {}j. by rewrite !mxE; case: (i == j :> nat); rewrite ?sorted_nth0 ?mulr0n. have hx0 i j : d1`_0 %| d1`_i *+ (i == j). - by case: (i == j :> nat); rewrite ?sorted_nth0 // mulr0n dvdr0. + by case: eqP => _; rewrite ?sorted_nth0 // mulr0n dvdr0. have Hdvd i j : d2`_0 %| H i j. rewrite -[(1 + (1 + _))%N]/(2 + _)%N /H H1 dvdr_row_mx //; split=> {}i {}j. by rewrite !mxE; case: (i == j :> nat); rewrite ?sorted_nth0 ?mulr0n. apply: dvdr_mulmxl=> {}i {}j; rewrite /E row_mxKr h1 !mxE. move: (dvdr_trans dvd_d20_d0 (hx0 i (rshift 1 j))). - by case: (i == _ :> nat); rewrite ?(mulr0n,dvdr0,mulr1n). + by case: eqP => _; rewrite ?(mulr0n,dvdr0,mulr1n). constructor; rewrite ?unitmx_mul; last first. - rewrite !unitmxE ?(det_lblock,det_ublock,det_lblock Q2,det1,mulr1,mul1r). - by rewrite-!unitmxE hQ1 hQ2 hR1. + by rewrite -!unitmxE hQ1 hQ2 hR1. - by rewrite hP2 hP1 unitmxE (@det_ublock _ 1) det1 mul1r -unitmxE hL1. - apply: sorted_cons=> //; move/matrixP: hLdR => /(_ 0 0). rewrite [RHS]mxE mulr1n => <-. @@ -357,10 +355,10 @@ Qed. Definition egcdr3 (a b c : R) := let: (g',u1,v1,b1,c1) := egcdr b c in - let: (g,u,v,a1,g1) := egcdr a g' in - (g, u, v * u1, v * v1, a1,b1 * g1,c1 * g1). + let: (g, u, v, a1,g1) := egcdr a g' in + (g, u, v * u1, v * v1, a1, b1 * g1, c1 * g1). -Variant egcdr3_spec a b c : R * R * R * R * R * R * R-> Type := +Variant egcdr3_spec a b c : R * R * R * R * R * R * R -> Type := EgcdrSpec g x y z a1 b1 c1 of x * a1 + y * b1 + z * c1 = 1 & g %= gcdr a (gcdr b c) & a = a1 * g & b = b1 * g & c = c1 * g : egcdr3_spec a b c (g,x,y,z,a1,b1,c1). @@ -421,7 +419,7 @@ constructor. by rewrite hermite10. rewrite -scalemxAl -!scalemxAr -diag_mx_seq_scale; congr (_ *: _). rewrite /M1 /M2 /mx2 !(@mulmx_block _ 1) -[0%:M]scalemx1 scale0r !mul0mx. - rewrite !add0r -?(scalar_mxM,raddfD) /= mulrC [_ * y1]mulrC. + rewrite !add0r -?(scalar_mxM,raddfD) /= mulrC [_ * y1]mulrC. rewrite !diag_mx_seq_cons diag_mx_seq_nil. f_equal. - by rewrite mulrC Hxy. @@ -468,9 +466,9 @@ suff : (D 0 0) \is a GRing.unit. rewrite unitd1 -dvdr1; apply/(dvdr_trans _ Hgcd). have Hij : forall i j, D 0 0 %| (mx2 a b 0 c) i j. rewrite (canRL (mulKmx P_unitmx) (canRL (mulmxK Q_unitmx) heq)). - apply: dvdr_mulmxl; apply: dvdr_mulmxr=> i j; rewrite !mxE. - case: (i == j :> nat); last by rewrite mulr0n dvdr0. - rewrite !mulr1n; exact: sorted_nth0. + apply: dvdr_mulmxl; apply: dvdr_mulmxr=> i j; rewrite !mxE eqxx /=. + case: eqP => _ /=; last by rewrite mulr0n dvdr0. + by rewrite !mulr1n; exact: sorted_nth0. rewrite !dvdr_gcd; move: (Hij 0 0) (Hij 0 1) (Hij 1 1). by rewrite mx2_E00 mx2_E01 mx2_E11=> -> -> ->. Qed. @@ -548,12 +546,12 @@ rewrite /gdco_kap /=. have [g /= x y z a1 b1 c1] := egcdr3P a b c. move=> Habc1 /eqd_ltrans <- Ha Hb Hc g_eq1. move: Habc1 g_eq1 => /(congr1 ( *%R^~ g)); rewrite !mulrDl mul1r. -rewrite -!mulrA -Ha -Hb -Hc {Ha Hb Hc} => <- Habc {g a1 b1 c1}. -move: Habc; have [->|an0 Habc] := altP eqP. +rewrite -!mulrA -Ha -Hb -Hc {Ha Hb Hc} => <- {g a1 b1 c1}. +have [-> | an0 Habc] := eqVneq a 0. rewrite /coprimer !mulr0 add0r => Hbc. by rewrite (eqd_ltrans (gcd0r _)). -case: egcdrP => g u v a' b' Hab' Hg Hc Hr. -move: Hab' Hg => /(congr1 ( *%R^~ g)); rewrite mulrDl mul1r. +case: egcdrP => /= g u v a' b' Hab' Hg Hc Hr. +move: Hab' Hg => /(congr1 ( *%R^~ g)); rewrite mulrDl mul1r. rewrite -!mulrA -Hc -Hr {Hc Hr} => <- {a' b' g}. rewrite (eqd_rtrans (coprimer_gdco c an0)) => Hu. have: 1 %| 1 - b by rewrite dvd1r. @@ -601,7 +599,7 @@ Lemma krull1_factor a b : Proof. wlog suff: / exists n b1 b2, [&& 0 < n, b %= b1 * b2, coprimer b1 a & b2 %| a ^+ n]. - move=> [n [b1 [b2 /and4P [Hn Hb Hb1 Hb2]]]]. + case=> n [b1 [b2 /and4P [Hn Hb Hb1 Hb2]]]. have [b2_eq0|b2_neq0] := eqVneq b2 0. exists n, b1, b2; move: Hn Hb Hb1 Hb2. by rewrite b2_eq0 mulr0 eqdr0 => -> -> -> ->. diff --git a/theory/karatsuba.v b/theory/karatsuba.v index 3b02fcd..03d03d2 100644 --- a/theory/karatsuba.v +++ b/theory/karatsuba.v @@ -19,24 +19,23 @@ Definition split_poly n (p : {poly R}) := (rdivp p 'X^n, rmodp p 'X^n). Definition shift_poly n : {poly R} -> {poly R} := *%R^~ 'X^n. Definition normalize (p : {poly R}) := p. -Fixpoint karatsuba_rec (n : nat) (p q : {poly R}) := match n with - | 0%N => p * q - | n'.+1 => - let np := normalize p in let nq := normalize q in - let sp := size p in let sq := size q in - if (sp <= 2) || (sq <= 2) then p * q else - let m := minn sp./2 sq./2 in - let (p1,p2) := split_poly m p in - let (q1,q2) := split_poly m q in - let p1q1 := karatsuba_rec n' p1 q1 in - let p2q2 := karatsuba_rec n' p2 q2 in - let p12 := p1 + p2 in - let q12 := q1 + q2 in - let p12q12 := karatsuba_rec n' p12 q12 in - shift_poly (2 * m)%N p1q1 + - shift_poly m (p12q12 - p1q1 - p2q2) + - p2q2 - end. +Fixpoint karatsuba_rec (n : nat) (p q : {poly R}) := + if n is n'.+1 then + let np := normalize p in let nq := normalize q in + let sp := size p in let sq := size q in + if (sp <= 2) || (sq <= 2) then p * q else + let m := minn sp./2 sq./2 in + let (p1,p2) := split_poly m p in + let (q1,q2) := split_poly m q in + let p1q1 := karatsuba_rec n' p1 q1 in + let p2q2 := karatsuba_rec n' p2 q2 in + let p12 := p1 + p2 in + let q12 := q1 + q2 in + let p12q12 := karatsuba_rec n' p12 q12 in + shift_poly (2 * m)%N p1q1 + + shift_poly m (p12q12 - p1q1 - p2q2) + + p2q2 + else p * q. Definition karatsuba (p q : {poly R}) := karatsuba_rec (maxn (size p) (size q)) p q. diff --git a/theory/minor.v b/theory/minor.v index 48f8464..5c15b22 100644 --- a/theory/minor.v +++ b/theory/minor.v @@ -15,11 +15,11 @@ Section submatrix_def. Variable A B : Type. -Definition submatrix T m n p q (f : 'I_p -> 'I_m) (g : 'I_q -> 'I_n) +Definition submatrix T m n p q (f : 'I_p -> 'I_m) (g : 'I_q -> 'I_n) (M : 'M[T]_(m,n)) := \matrix_(i < p, j < q) M (f i) (g j). -Lemma sub_submatrix k k' l l' m n (M : 'M[A]_(m,n)) (f' : 'I_k -> 'I_m) - (f : 'I_k' -> 'I_k) (g' : 'I_l -> 'I_n) (g : 'I_l' -> 'I_l) : +Lemma sub_submatrix k k' l l' m n (M : 'M[A]_(m,n)) (f' : 'I_k -> 'I_m) + (f : 'I_k' -> 'I_k) (g' : 'I_l -> 'I_n) (g : 'I_l' -> 'I_l) : submatrix f g (submatrix f' g' M) = submatrix (f' \o f) (g' \o g) M. Proof. by rewrite /submatrix; apply/matrixP=> i j; rewrite !mxE. Qed. @@ -36,12 +36,9 @@ Lemma widen_ord_eq (m n : nat) (h h' : n <= m) : widen_ord h =1 widen_ord h'. Proof. by move=> x; apply/ord_inj. Qed. (* transform [a .. b] into [0, a+1, .., b+1] *) -Definition lift_pred m n (f : 'I_n -> 'I_m) : 'I_n.+1 -> 'I_m.+1 := - fun (x : 'I_(1 + n)) => - match split x with - | inl _ => 0 - | inr j => lift 0 (f j) - end. +Definition lift_pred m n (f : 'I_n -> 'I_m) : 'I_n.+1 -> 'I_m.+1 := + fun (x : 'I_(1 + n)) => + if split x is inr j then lift 0 (f j) else 0. Lemma size_tool n k : k <= n -> k < n.+1. Proof. by rewrite ltnS. Qed. @@ -57,7 +54,7 @@ Qed. Lemma lift_pred0 n k (f: 'I_k -> 'I_n) : lift_pred f 0 = 0. Proof. by rewrite /lift_pred; case: splitP. Qed. -Lemma lift_predS n k (f : 'I_k -> 'I_n) (x : 'I_k) : +Lemma lift_predS n k (f : 'I_k -> 'I_n) (x : 'I_k) : lift_pred f (lift 0 x) = lift 0 (f x). Proof. by rewrite /lift_pred split1 liftK. Qed. @@ -87,13 +84,13 @@ Section submatrix_theory. Variable R : ringType. -Lemma submatrix_eq m n p q (f1 g1 : 'I_p -> 'I_m) (f2 g2 : 'I_q -> 'I_n) - (M : 'M[R]_(m,n)) (h1 : f1 =1 g1) (h2 : f2 =1 g2) : +Lemma submatrix_eq m n p q (f1 g1 : 'I_p -> 'I_m) (f2 g2 : 'I_q -> 'I_n) + (M : 'M[R]_(m,n)) (h1 : f1 =1 g1) (h2 : f2 =1 g2) : submatrix f1 f2 M = submatrix g1 g2 M. Proof. by apply/matrixP => i j; rewrite !mxE (h1 i) (h2 j). Qed. -Lemma submatrix_lift_block m n p q (f1 : 'I_p -> 'I_m) (f2 : 'I_q -> 'I_n) - a (M: 'M[R]_(m,n)) (c : 'cV[R]_m) (l : 'rV[R]_n) : +Lemma submatrix_lift_block m n p q (f1 : 'I_p -> 'I_m) (f2 : 'I_q -> 'I_n) + a (M: 'M[R]_(m,n)) (c : 'cV[R]_m) (l : 'rV[R]_n) : submatrix (lift_pred f1) (lift_pred f2) (block_mx a%:M l c M) = block_mx a%:M (submatrix id f2 l) (submatrix f1 id c) (submatrix f1 f2 M). Proof. @@ -111,7 +108,7 @@ Lemma submatrix0 n m p q (f1 : 'I_p -> 'I_m) (f2 : 'I_q -> 'I_n) : submatrix f1 f2 0 = 0 :> 'M[R]__. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. -Lemma submatrix_scale m n p k (A : 'M[R]_(m,n)) +Lemma submatrix_scale m n p k (A : 'M[R]_(m,n)) (f : 'I_p -> 'I_m) (g : 'I_k -> 'I_n) a : submatrix f g (a *: A) = a *: submatrix f g A. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. @@ -154,7 +151,7 @@ Section submatrix_char_poly_mx. Variable R : ringType. -Lemma submatrix_char_poly_mx m p (M : 'M[R]_m) +Lemma submatrix_char_poly_mx m p (M : 'M[R]_m) (f : 'I_p -> 'I_m) (hf : injective f) : submatrix f f (char_poly_mx M) = char_poly_mx (submatrix f f M). Proof. @@ -168,11 +165,11 @@ Section minor_def. Variable R : ringType. -Definition minor (m n p : nat) (f : 'I_p -> 'I_m) (g : 'I_p -> 'I_n) +Definition minor (m n p : nat) (f : 'I_p -> 'I_m) (g : 'I_p -> 'I_n) (A : 'M[R]_(m,n)) := \det (submatrix f g A). (* Principal minor *) -Definition pminor (m n p : nat) (h : p < m) (h' : p < n) (A : 'M[R]_(m,n)) := +Definition pminor (m n p : nat) (h : p < m) (h' : p < n) (A : 'M[R]_(m,n)) := minor (widen_ord h) (widen_ord h') A. End minor_def. @@ -201,29 +198,29 @@ by rewrite !mxE !mulNr mul1r mulrN; do ?f_equal; apply/ord_inj. Qed. (* Sanity check of the definiton *) -Lemma minor2 m n (A : 'M[R]_(m,n)) (f : 'I_2 -> 'I_m) (g : 'I_2 -> 'I_n) : +Lemma minor2 m n (A : 'M[R]_(m,n)) (f : 'I_2 -> 'I_m) (g : 'I_2 -> 'I_n) : minor f g A = A (f 0) (g 0) * A (f 1) (g 1) - A (f 1) (g 0) * A (f 0) (g 1). Proof. by rewrite /minor det2 !mxE. Qed. -Lemma minor_ltn_eq0l k m1 m2 n1 n2 x (f : 'I_k -> 'I_(m1 + m2)) g - (M : 'M[R]_(m1,n1)) (N : 'M_(m1,n2)) (H : m1 < f x) : - minor f g (block_mx M N 0 0) = 0. +Lemma minor_ltn_eq0l k m1 m2 n1 n2 x (f : 'I_k -> 'I_(m1 + m2)) g + (M : 'M[R]_(m1,n1)) (N : 'M_(m1,n2)) (H : m1 < f x) : + minor f g (block_mx M N 0 0) = 0. Proof. -rewrite /minor (expand_det_row _ x) big1 // => i _; rewrite !mxE. +rewrite /minor (expand_det_row _ x) big1 // => i _; rewrite !mxE. case: splitP H => [j ->|j Hj]; first by rewrite ltnNge ltnW. by rewrite row_mx0 mxE mul0r. Qed. -Lemma minor_ltn_eq0r k m1 m2 n1 n2 x f (g : 'I_k -> 'I_(n1 + n2)) - (M : 'M[R]_(m1,n1)) (N : 'M_(m2,n1)) (H : n1 < g x) : - minor f g (block_mx M 0 N 0) = 0. +Lemma minor_ltn_eq0r k m1 m2 n1 n2 x f (g : 'I_k -> 'I_(n1 + n2)) + (M : 'M[R]_(m1,n1)) (N : 'M_(m2,n1)) (H : n1 < g x) : + minor f g (block_mx M 0 N 0) = 0. Proof. -rewrite /minor (expand_det_col _ x) big1 // => i _; rewrite !mxE. +rewrite /minor (expand_det_col _ x) big1 // => i _; rewrite !mxE. by case: splitP=> j Hj; rewrite mxE; case: splitP H=> [l ->|l]; - rewrite ?ltnNge ?mxE ?mul0r // ltnW. + rewrite ?ltnNge ?mxE ?mul0r // ltnW. Qed. -Lemma minor_alternate_f m n p (f : 'I_p -> 'I_m) g (M : 'M[R]_(m,n)) : +Lemma minor_alternate_f m n p (f : 'I_p -> 'I_m) g (M : 'M[R]_(m,n)) : (exists x y, (x != y) /\ (f x == f y)) -> minor f g M = 0. Proof. rewrite /minor => [[x [y [hxy /eqP hf]]]]. @@ -241,29 +238,29 @@ Lemma minor_f_not_injective m n p (f : 'I_p -> 'I_m) g (M: 'M[R]_(m,n)) : ~ injective f -> minor f g M = 0. Proof. move/injectiveP/injectivePn => [x [y hxy hf]]; apply minor_alternate_f. -by exists x; exists y; rewrite hf. +by exists x, y; rewrite hf. Qed. Lemma minor_g_not_injective m n p (f : 'I_p -> 'I_m) g (M: 'M[R]_(m,n)) : ~ injective g -> minor f g M = 0. Proof. move/injectiveP/injectivePn => [x [y hxy hg]]; apply minor_alternate_g. -by exists x; exists y; rewrite hg. +by exists x, y; rewrite hg. Qed. -Lemma minor_eq m n p (f1 g1 : 'I_p -> 'I_m) (f2 g2 : 'I_p -> 'I_n) +Lemma minor_eq m n p (f1 g1 : 'I_p -> 'I_m) (f2 g2 : 'I_p -> 'I_n) (h1 : f1 =1 g1) (h2 : f2 =1 g2) (M : 'M[R]_(m,n)) : minor f1 f2 M = minor g1 g2 M. Proof. by rewrite /minor (submatrix_eq M h1 h2). Qed. -Lemma minor_lift_block m n p (f1 : 'I_p -> 'I_m) (f2 : 'I_p -> 'I_n) - a (M : 'M[R]_(m,n)) (l : 'rV[R]_n) : +Lemma minor_lift_block m n p (f1 : 'I_p -> 'I_m) (f2 : 'I_p -> 'I_n) + a (M : 'M[R]_(m,n)) (l : 'rV[R]_n) : minor (lift_pred f1) (lift_pred f2) (block_mx a%:M l 0 M) = a * minor f1 f2 M. Proof. by rewrite /minor submatrix_lift_block submatrix0 (@det_ublock _ 1) det_scalar1. Qed. -End minor_theory. +End minor_theory. Section minor_char_poly_mx. diff --git a/theory/mxstructure.v b/theory/mxstructure.v index f855842..34e5ad9 100644 --- a/theory/mxstructure.v +++ b/theory/mxstructure.v @@ -56,12 +56,11 @@ Lemma upper_triangular_mxP m n {M : 'M_(m,n)} : reflect (forall (i : 'I_m) (j : 'I_n), j < i -> M i j = 0) (upper_triangular_mx M). Proof. -apply/(iffP idP)=> [H i j Hij|H]. +apply/(iffP eqP)=> [H i j Hij|H]. rewrite /upper_triangular_mx in H. - by move/eqP: H=> ->; rewrite mxE leqNgt Hij. -apply/eqP/matrixP=> i j; rewrite mxE leqNgt. -have:= (H i j). -by case:(j < i)=> // ->. + by rewrite H mxE leqNgt Hij. +apply/matrixP => i j; rewrite mxE leqNgt. +by case/boolP: (j < i) => // /H ->. Qed. Definition lower_triangular_mx m n (M : 'M[R]_(m,n)) := M == lower_part_mx M. @@ -78,8 +77,8 @@ Proof. rewrite /lower_triangular_mx /upper_triangular_mx. rewrite /lower_part_mx /upper_part_mx. split=> [/eqP ->|/eqP H]; apply/eqP. - by apply/matrixP=> i j; rewrite !mxE; case: (i <= j). -by rewrite -[M]trmxK H; apply/matrixP=> i j; rewrite !mxE; case: (j <= i). + by apply/matrixP=> i j; rewrite !mxE; case: leqP. +by rewrite -[M]trmxK H; apply/matrixP=> i j; rewrite !mxE; case: leqP. Qed. End Triangular. @@ -110,7 +109,7 @@ Lemma upper_triangular_block_mxdr : Proof. move=> /upper_triangular_mxP HA Hn1; apply/upper_triangular_mxP=> i j Hij. rewrite -(HA (rshift m1 i) (rshift n1 j)) ?block_mxEdr // -addnS. -exact:leq_add. +exact: leq_add. Qed. Lemma upper_triangular_block_mxul : @@ -156,13 +155,9 @@ Lemma char_poly_mx_triangular_mx n (M : 'M[R]_n) : upper_triangular_mx M -> upper_triangular_mx (char_poly_mx M). Proof. move/upper_triangular_mxP=> HM; apply/upper_triangular_mxP=>i j Hij. -rewrite !mxE . -have ->:(i == j) = false. - apply/eqP=> Habs. - rewrite Habs in Hij. - suff: false => //. - by rewrite -(ltnn j). -by rewrite (HM i j Hij) GRing.subr0. +rewrite !mxE. +suff /negbTE->/=: i != j by rewrite (HM i j Hij) GRing.subr0. +by move: Hij; rewrite ltn_neqAle eq_sym; case/andP. Qed. Lemma row'_col'_triangular_mx n (M : 'M[R]_n) i: @@ -170,7 +165,7 @@ Lemma row'_col'_triangular_mx n (M : 'M[R]_n) i: Proof. move/upper_triangular_mxP=> HM; apply/upper_triangular_mxP=> j k Hij. rewrite !mxE HM // /lift /= /bump /ltn -addn1 -addnA addn1. -apply: leq_add=> //; case H: (i <= k)=> //. +apply: leq_add=> //; case H: (i <= k)=> //=. by rewrite (ltnW (leq_ltn_trans H Hij)). Qed. @@ -396,14 +391,14 @@ Proof. case: s=> // a l _ H. have Ha: (F a 0%N) \in unitmx by exact: (H 0%N). elim: l a F Ha H=> //= b l IHl a F Ha H. -rewrite unitmxE (det_ublock (F a 0%N)) unitrM -!unitmxE Ha. +rewrite unitmxE (det_ublock (F a 0%N)) unitrM -!unitmxE Ha /=. apply: IHl=> [|i]; first exact: (H 1%N). exact: (H i.+1). Qed. Lemma invmx_diag_block s (F : forall n, nat -> 'M[R]_n.+1) : - (diag_block_mx s F) \in unitmx -> -(diag_block_mx s F)^-1 = diag_block_mx s (fun n i => (F n i)^-1). + (diag_block_mx s F) \in unitmx -> + (diag_block_mx s F)^-1 = diag_block_mx s (fun n i => (F n i)^-1). Proof. case: s=> [|a l]; first by rewrite unitr0. elim: l a F => //= b l IHl a F H. @@ -422,7 +417,7 @@ Local Open Scope ring_scope. Import GRing.Theory. Definition diag_mx_seq m n (s : seq R) := - \matrix_(i < m, j < n) (s`_i *+ (i == j :> nat)). + \matrix_(i < m, j < n) (s`_i *+ (i == j :> nat)). Lemma diag_mx_seq_nil m n : diag_mx_seq m n [::] = 0. Proof. @@ -455,13 +450,13 @@ Lemma diag_mx_seq_block_mx m m' n n' s : Proof. move=> H; apply/matrixP=> i j; rewrite !mxE. case: (splitP _)=> k Hk; rewrite mxE; case: (splitP _)=> l Hl; rewrite mxE Hk Hl //. -+ case: (altP (k =P (n + l)%N :> nat))=> // ->. ++ case: eqP => //= ->. rewrite nth_default ?mul0rn // (leq_trans H) //. - by rewrite (leq_trans (geq_minr m n)) // leq_addr. + by rewrite geq_min leq_addr orbT. + rewrite nth_default ?mul0rn // (leq_trans H) //. - by rewrite (leq_trans (geq_minl m n)) // leq_addr. -+ rewrite nth_default ?mul0rn // (leq_trans H) //. - by rewrite (leq_trans (geq_minl m n)) // leq_addr. + by rewrite geq_min leq_addr. +rewrite nth_default ?mul0rn // (leq_trans H) //. +by rewrite geq_min leq_addr. Qed. Lemma diag_mx_seq_block s : @@ -472,7 +467,7 @@ Lemma diag_mx_seq_block s : Proof. case: s=> /= [|a l]; first by rewrite diag_mx_seq_nil. have Ha: forall a, diag_mx_seq 1 1 [:: a] = a%:M. - by move=> b; apply/matrixP=> i j; rewrite !mxE ord1. + by move=> b; apply/matrixP=> i j; rewrite !mxE ord1. elim: l a=> //= b l IHl a. by rewrite -IHl -cat1s (@diag_mx_seq_cat 1 _ 1) // Ha. Qed. @@ -499,9 +494,8 @@ Lemma diag_mx_seq_deltal m n (i : 'I_m) (j : 'I_n) (s : seq R) : delta_mx i j *m diag_mx_seq n n s = s`_j *: delta_mx i j. Proof. apply/matrixP=> k l; rewrite !mxE (bigD1 l) //= big1 ?addr0. - rewrite !mxE eqxx; case Hjl: (l == j); last by rewrite andbF mulr0 mul0r. - rewrite (eqP Hjl); case: (k == i); last by rewrite mulr0 mul0r. - by rewrite mulr1 mul1r. + rewrite !mxE eqxx; case: (eqVneq l j)=>[->/=|_]; last by rewrite andbF mulr0 mul0r. + by rewrite andbT; case: eqP=> _; [rewrite mulr1 mul1r | rewrite mulr0 mul0r]. move=> p; rewrite !mxE=> /negbTE; rewrite (inj_eq (@ord_inj _))=> ->. by rewrite mulr0. Qed. @@ -510,9 +504,8 @@ Lemma diag_mx_seq_deltar m n (i : 'I_m) (j : 'I_n) (s : seq R) : diag_mx_seq m m s *m delta_mx i j = s`_i *: delta_mx i j. Proof. apply/matrixP=> k l; rewrite !mxE (bigD1 k) //= big1 ?addr0. - rewrite !mxE eqxx; case Hjl: (k == i); last by rewrite !mulr0. - rewrite (eqP Hjl); case: (l == j); last by rewrite andbF !mulr0. - by rewrite !mulr1. + rewrite !mxE eqxx; case: (eqVneq k i)=>[->/=|_]; last by rewrite !mulr0. + by case: eqP. move=> p; rewrite !mxE=> /negbTE; rewrite (inj_eq (@ord_inj _)) eq_sym=> ->. by rewrite mul0r. Qed. @@ -525,7 +518,7 @@ Lemma diag_mx_seq_taker m n (s : seq R) : diag_mx_seq m n (take n s) = diag_mx_seq m n s. Proof. apply/matrixP=> i j; rewrite !mxE. -by have [-> | //] := altP (i =P j :> nat); rewrite nth_take. +by case: eqP => //=->; rewrite nth_take. Qed. Lemma diag_mx_seq_take_min m n (s : seq R) : @@ -535,7 +528,7 @@ Proof. by case: leqP; rewrite (diag_mx_seq_takel, diag_mx_seq_taker). Qed. Lemma tr_diag_mx_seq m n s : (diag_mx_seq m n s)^T = diag_mx_seq n m s. Proof. apply/matrixP=> i j; rewrite !mxE eq_sym. -by have [-> | //] := altP (i =P j :> nat). +by case: eqP => //=->. Qed. Lemma mul_pid_mx_diag m n p r s : @@ -562,8 +555,8 @@ Proof. elim: s m n=> [m n _|a s ih m n] /=; first by rewrite diag_mx_seq_nil. case/andP=> /eqP -> hA. case: m n=> [n|m [|n]]; [by apply/matrixP=> [[]]|by apply/matrixP=> i []|]. -rewrite diag_mx_seq_cons ih //; apply/matrixP=> i j. -by do 2!(rewrite !mxE split1; case: unliftP=> * /=); rewrite mxE. +rewrite diag_mx_seq_cons ih //; apply/matrixP=> i j. +by do 2!(rewrite !mxE split1; case: unliftP=> * /=); rewrite mxE. Qed. Lemma diag_mx_seq_eq0 m n s : size s <= minn m n -> diag_mx_seq m n s = 0 -> all (eq_op^~ 0) s. @@ -578,7 +571,7 @@ Lemma diag_mx_seq_scale m n s (d : R) : d *: diag_mx_seq m n s = diag_mx_seq m n [seq d * x | x <- s]. Proof. apply/matrixP=> i j; rewrite !mxE. -case: (i == j :> nat); last by rewrite !mulr0n mulr0. +case: eqP => _ /=; last by rewrite !mulr0n mulr0. have [hi|hl] := (ltnP i (size s)); first by rewrite (@nth_map _ 0). by rewrite ?nth_default ?mulr0 // size_map. Qed. @@ -604,12 +597,11 @@ Lemma mul_diag_mx_copid m n r s : diag_mx_seq m n s *m @copid_mx R n r = 0. Proof. move=> le_s_r; apply/matrixP=> i j; rewrite !mxE big1 // => k _; rewrite !mxE. -have [eq_i_k|] := altP (i =P k :> nat); last by rewrite mul0r. +case: eqP => /= [eq_i_k|]; last by rewrite mul0r. have [le_s_k|lt_k_s] := leqP (size s) k. by rewrite eq_i_k nth_default // mul0rn mul0r. -have -> : k < r. - by apply: (leq_trans _ le_s_r); rewrite !leq_min lt_k_s -{1}eq_i_k !ltn_ord. -by rewrite eqE /=; case H: (k == j :> nat); rewrite subrr mulr0. +suff ->/= : k < r by rewrite andbT eqE /= subrr mulr0. +by apply: (leq_trans _ le_s_r); rewrite !leq_min lt_k_s -{1}eq_i_k !ltn_ord. Qed. End diag_mx_seq2. @@ -681,8 +673,8 @@ have detBl0: \det (lsubmx B) = 0. by rewrite -row_mul AdBl0 row0. have: \det (diag_mx_seq r r (take r s)) = 0. by rewrite -AuBld det_mulmx detBl0 mulr0. -rewrite det_diag_mx_seq ?size_take ?lt_r_s //; move/eqP; rewrite prodf_seq_eq0. -apply/negP; move:neq0_s; rewrite -{1}[s](cat_take_drop r) all_cat all_predC. +rewrite det_diag_mx_seq ?size_take ?lt_r_s // => /eqP; rewrite prodf_seq_eq0 /=. +apply/negP; move: neq0_s; rewrite -{1}[s](cat_take_drop r) all_cat -all_predC. by case/andP. Qed. @@ -719,7 +711,7 @@ Lemma diag_mx_seq_filter0 m n (s : seq R) : sorted %|%R s -> diag_mx_seq m n [seq x <- s | x != 0] = diag_mx_seq m n s. Proof. elim: s m n=> // a s ih m n h_sorted. -have h_s /= := (subseq_sorted (@dvdr_trans R) (subseq_cons s a) h_sorted). +have h_s /= := subseq_sorted (@dvdr_trans R) (subseq_cons s a) h_sorted. move: h_sorted; have [-> hs |an0 _] /= := eqP. by rewrite ih // !diag_mx_seq0 //= ?eqxx /=; apply/sorted_dvd0r. case: m n=> [n|m [|n]]; [by apply/matrixP=> [[]]|by apply/matrixP=> i []|]. diff --git a/theory/perm_eq_image.v b/theory/perm_eq_image.v index 5623a51..cbb4fe8 100644 --- a/theory/perm_eq_image.v +++ b/theory/perm_eq_image.v @@ -134,7 +134,7 @@ Variable R : ringType. Lemma char_block_mx m n (A : 'M[R]_m) (D : 'M[R]_n) B C : char_poly_mx (block_mx A B C D) = - block_mx (char_poly_mx A) (map_mx polyC (-B)) + block_mx (char_poly_mx A) (map_mx polyC (-B)) (map_mx polyC (-C)) (char_poly_mx D). Proof. apply/matrixP=> i j; rewrite !mxE. @@ -165,10 +165,10 @@ Proof. move=> neqdpq [szpgt1 Heqdp] [szqgt1 Heqdq]. have gcdvp:= (dvdp_gcdl p q). have gcdvq:= (dvdp_gcdr p q). -case: (altP (size (gcdp p q) =P 1%N))=> [/eqP //|neqsz1]. -have:= (Heqdp _ neqsz1 gcdvp); rewrite eqp_sym /eqp dvdp_gcd. +rewrite /coprimep; apply: contraT => neqsz1. +move: (Heqdp _ neqsz1 gcdvp); rewrite eqp_sym /eqp dvdp_gcd. case/andP=> [/andP [ _ pdvq]] _. -have:= (Heqdq _ neqsz1 gcdvq); rewrite eqp_sym /eqp dvdp_gcd. +move: (Heqdq _ neqsz1 gcdvq); rewrite eqp_sym /eqp dvdp_gcd. case/andP=> [/andP [qdvp _]] _. by rewrite /eqp pdvq qdvp in neqdpq. Qed. @@ -186,7 +186,7 @@ elim: s r => [r pdvr _ _|a l IHl r pdvr Irr mon]. rewrite eqr1 dvdp1 /irreducible_poly=> /eqP ->. by rewrite ltnn; case. rewrite big_cons=> eqrM; move: pdvr; rewrite eqrM=> pdvM. -case: (altP (@idP (eqp p a)))=>[|neqdpa]. +case/boolP: (eqp p a)=>[|neqdpa]. have am: a \is monic by apply: mon; rewrite mem_head. by rewrite eqp_monic // => /eqP ->; rewrite mem_head. have Hia: irreducible_poly a by apply: Irr; rewrite mem_head. diff --git a/theory/polydvd.v b/theory/polydvd.v index cb5e794..48345ed 100644 --- a/theory/polydvd.v +++ b/theory/polydvd.v @@ -38,13 +38,12 @@ Definition odivp_rec q := fix loop (n : nat) (r p : {poly R}) {struct n} := if p == 0 then Some r else if size p < sq then None else - match odivr (lead_coef p) lq with - | Some x => let m := x%:P * 'X^(size p - sq) in - let r1 := r + m in - let p1 := p - m * q in - if n is n1.+1 then loop n1 r1 p1 else None - | None => None - end. + if odivr (lead_coef p) lq is Some x then + let m := x%:P * 'X^(size p - sq) in + let r1 := r + m in + let p1 := p - m * q in + if n is n1.+1 then loop n1 r1 p1 else None + else None. Definition odivp p q : option {poly R} := if p == 0 then Some 0 else odivp_rec q (size p) 0 p. @@ -53,18 +52,18 @@ Lemma odivp_recP : forall q n p r, size p <= n -> DvdRing.div_spec p q (omap (fun x => x - r) (odivp_rec q n r p)). Proof. move=> q; elim=> [|n ihn] p r hn /=. - case: ifP=> p0 /=; first by constructor; rewrite subrr mul0r (eqP p0). - by rewrite leqn0 size_poly_eq0 p0 in hn. -case: ifP=> p0 /=; first by constructor; rewrite subrr mul0r (eqP p0). -case: ifP=> spq. + move: hn; rewrite leqn0 size_poly_eq0 => /eqP->. + by rewrite eqxx /= subrr; constructor; rewrite mul0r. +have [-> | p0] := eqVneq p 0; first by constructor; rewrite subrr mul0r. +case: ifP => /= spq. constructor=> s. apply/negP => /eqP hp. rewrite hp in spq. - move/negP: p0 => /negP; rewrite hp mulf_eq0 negb_or; case/andP=> s0 q0. + move: p0; rewrite hp mulf_eq0 negb_or; case/andP=> s0 q0. move: spq; rewrite (@size_proper_mul _ s q). rewrite prednK; last by rewrite addn_gt0 lt0n size_poly_eq0 s0. - rewrite leqNgt // ltn_neqAle leq_addl. - by rewrite (eqn_add2r _ 0) eq_sym size_poly_eq0 s0. + apply/negP; rewrite -ltnNge -{1}(add0n (size q)) ltn_add2r lt0n. + by rewrite size_poly_eq0. by rewrite mulf_neq0 // lead_coef_eq0 (s0, q0). case: odivrP=> /= [x hx|hpq]; last first. constructor=> s; apply: contra (hpq (lead_coef s)) => /eqP ->. @@ -77,11 +76,11 @@ move: (erefl om); rewrite /om /d; case: {2}_ / ihn. move: hx. rewrite -{2}[q]coefK -{2}[p]coefK !lead_coefE !poly_def. case hsp: (size p) spq => [|sp] spq. - by move/eqP: hsp; rewrite size_poly_eq0 p0. + by move/eqP: hsp; rewrite size_poly_eq0 (negbTE p0). case hsq: (size q) spq => [|sq] spq. move/eqP: hsq; rewrite size_poly_eq0 => /eqP->. rewrite coef0 mulr0 => /eqP. - by rewrite -hsp -lead_coefE lead_coef_eq0 p0. + by rewrite -hsp -lead_coefE lead_coef_eq0 (negbTE p0). move: spq; rewrite ltnS ltnNge => /negPn spq. rewrite ![_.-1]/= !big_ord_recr [_ - _]/= -!poly_def=> ->. rewrite [m * _]mulrC /m hsp hsq subSS mulrDl opprD. @@ -91,19 +90,19 @@ move: (erefl om); rewrite /om /d; case: {2}_ / ihn. rewrite ltnS (leq_trans (size_add _ _)) //. rewrite geq_max (leq_trans (size_poly _ _)) //. rewrite size_opp (leq_trans (size_mul_leq _ _)) //. - case x0: (x == 0). - rewrite (eqP x0) polyC0 mul0r size_poly0 addn0. + have [-> | x0] := eqVneq x 0. + rewrite polyC0 mul0r size_poly0 addn0. rewrite -subn1 leq_subLR (leq_trans (size_poly _ _)) //. by rewrite add1n (leq_trans spq) // leqnSn. - rewrite size_proper_mul ?lead_coefC ?lead_coefXn ?mulr1 ?x0 //. + rewrite size_proper_mul ?lead_coefC ?lead_coefXn ?mulr1 //. rewrite size_polyC x0 size_polyXn /= addnS /=. by rewrite addnBA // leq_subLR leq_add2r size_poly. * move=> s hs; case hpq: (odivp_rec _ _ _ _)=> [r'|] //=. case=> hm; constructor; move: hm; rewrite opprD addrA. - move/eqP; rewrite (can2_eq (@addrNK _ _) (@addrK _ _)); move/eqP->. + move/eqP; rewrite (can2_eq (@addrNK _ _) (@addrK _ _)) => /eqP->. by rewrite mulrDl -hs addrNK. * move=> hpq; case hpq': (odivp_rec _ _ _ _)=> [r'|] //= _. - constructor=> s; apply: contra (hpq (s - m)); move/eqP->. + constructor=> s; apply: contra (hpq (s - m)) => /eqP->. by rewrite mulrBl. Qed. @@ -143,7 +142,7 @@ Lemma poly_ind2 : forall P : {poly R} -> {poly R} -> Type, (forall c p d q, P p (q * 'X + d%:P) -> P (p * 'X + c%:P) q -> P (p * 'X + c%:P) (q * 'X + d%:P)) -> - (forall p q, P p q). + forall p q, P p q. Proof. move=> P H01 H02 H. apply: (@poly_ind _)=> // p c IH1. @@ -151,10 +150,10 @@ apply: (@poly_ind _)=> // q d IH2. apply: (@H c p d q)=> //. Qed. -Lemma elim_poly : forall p, exists p', exists c, p = p' * 'X + c%:P. +Lemma elim_poly : forall p, exists p' c, p = p' * 'X + c%:P. Proof. -elim/poly_ind; first by exists 0; exists 0; rewrite mul0r add0r. -by move=> p c [_ [_]] _; exists p; exists c. +elim/poly_ind; first by exists 0, 0; rewrite mul0r add0r. +by move=> p c [_ [_]] _; exists p, c. Qed. Lemma polyC_inj_dvdr : forall a b, (a %| b)%R -> a%:P %| b %:P. @@ -186,15 +185,15 @@ Qed. Lemma gcdsr_gcdl : forall p c, gcdsr (p * 'X + c%:P) = gcdr c (gcdsr p). Proof. move=> p c. -case p0: (p == 0). - rewrite (eqP p0) mul0r add0r gcdsr0 /gcdsr polyseqC. - by case c0: (c == 0)=> //=; apply/eqP; rewrite eq_sym (eqP c0) gcdr_eq0 eqxx. +have [-> | p0] := eqVneq p 0. + rewrite mul0r add0r gcdsr0 /gcdsr polyseqC. + by case: eqP => //= ->; apply/eqP; rewrite eq_sym gcdr_eq0 eqxx. by rewrite -cons_poly_def polyseq_cons /nilp size_poly_eq0 p0. Qed. Lemma gcdsr_eq0 : forall p, (gcdsr p == 0) = (p == 0). Proof. -elim/poly_ind=> [|p c IH]; first by rewrite gcdsr0 !eq_refl. +elim/poly_ind=> [|p c IH]; first by rewrite gcdsr0 !eqxx. rewrite gcdsr_gcdl gcdr_eq0 IH -[p * 'X + c%:P == 0]size_poly_eq0 size_MXaddC. rewrite andbC. by apply/idP/idP => [->|] //; case: ifP. @@ -254,9 +253,8 @@ Definition primitive p := gcdsr p %= 1. Lemma primitive0 : forall p, primitive p -> p != 0. Proof. -rewrite /primitive=> p pp; apply/negP=> p0; move: pp. -rewrite (eqP p0) gcdsr0 eqd_def dvd0r; case/andP=> H _. -by move: (oner_neq0 R); rewrite H. +rewrite /primitive=> p; apply: contraL => /eqP->. +by rewrite gcdsr0 eqd_def dvd0r negb_and oner_neq0. Qed. (* Another key lemma *) @@ -264,11 +262,11 @@ Lemma gcdsr_primitive : forall p, exists q, p = (gcdsr p)%:P * q /\ primitive q. Proof. move=> p; rewrite /primitive. suff H: exists q, p = (gcdsr p)%:P * q. - case p0: (p == 0); first by exists 1; rewrite (eqP p0) gcdsr0 mulr1 gcdsr1. + have [-> | p0] := eqVneq p 0; first by exists 1; rewrite gcdsr0 mulr1 gcdsr1. case: H=> x H; exists x; split=> //. rewrite -(@eqd_mul2l _ (gcdsr p)). by rewrite mulr1 {2}H (eqd_trans _ (mulr_gcdsr _ x)). - by apply/negP; move/eqP=> c0; move: H; rewrite c0 mul0r; move/eqP: p0. + by apply: contraPneq H => ->; apply/eqP; rewrite mul0r. elim/poly_ind: p=> /= [|p c [q IH]]; first by exists 1; rewrite gcdsr0 mul0r. case/dvdrP: (dvdr_gcdr c (gcdsr p))=> wr Hr; rewrite mulrC in Hr. case/dvdrP: (dvdr_gcdl c (gcdsr p))=> wl Hl; rewrite mulrC in Hl. @@ -288,7 +286,7 @@ Proof. move=> p p0; case: (gcdsr_primitive p)=> x [Hp primx]. exists x; split=> //. rewrite {1}Hp odivr_mulKr //. -by apply/negP=> H; move: Hp p0; rewrite (eqP H) mul0r=> ->; rewrite eq_refl. +by apply: contraPneq Hp => ->; apply/eqP; rewrite mul0r. Qed. Lemma prim_mulX : forall p, primitive p -> primitive (p * 'X). @@ -313,7 +311,7 @@ case: (elim_poly q')=> q1' [q0'] Hq'. case H0p0 : (p0 == 0). rewrite /p (eqP H0p0) addr0 -mulrA ['X * _]mulrC mulrA. rewrite (eqd_trans (gcdsr_mulX _)) // (eqd_trans IH1) //. - by rewrite eqd_sym (eqd_mul (gcdsr_mulX _)). + by rewrite eqd_sym (eqd_mul (gcdsr_mulX _)). case H0q0 : (q0 == 0). rewrite /q (eqP H0q0) addr0 mulrA (eqd_trans (gcdsr_mulX _)) //. by rewrite (eqd_trans IH2) // eqd_sym (eqd_mul _ (gcdsr_mulX _)). @@ -377,27 +375,24 @@ Qed. Lemma gcdsr_inj_eqd : forall p q, p %= q -> gcdsr p %= gcdsr q. Proof. -move=> p q; case/andP=> pq qp; apply/andP. -by rewrite (gcdsr_inj_dvdr pq) (gcdsr_inj_dvdr qp). +move=> p q; case/andP=> pq qp. +by rewrite eqd_def (gcdsr_inj_dvdr pq) (gcdsr_inj_dvdr qp). Qed. (* Primitive part, pp *) -Definition pp p := match p %/? (gcdsr p)%:P with - | Some x => x - | None => 1 - end. +Definition pp p := odflt 1 (p %/? (gcdsr p)%:P). Lemma pp0 : pp 0 = 0. -Proof. by rewrite /pp /odivr gcdsr0 /= /odivp eq_refl. Qed. +Proof. by rewrite /pp /odivr gcdsr0 /= /odivp eqxx. Qed. Lemma ppP : forall p, p = (gcdsr p)%:P * pp p. Proof. move=> p. -case p0: (p == 0); first by rewrite (eqP p0) pp0 mulr0. -have g0 : (gcdsr p)%:P != 0 by apply/eqP; move/eqP; rewrite polyC_eq0 gcdsr_eq0 p0. -case: (gcdsr_odivp (negbT p0))=> x [hx px]. +have [-> | p0] := eqVneq p 0; first by rewrite pp0 mulr0. +have g0 : (gcdsr p)%:P != 0 by rewrite polyC_eq0 gcdsr_eq0. +case: (gcdsr_odivp p0) => x [hx px]. by rewrite /pp hx; move: (odivr_some hx)=> {1}->. Qed. @@ -407,7 +402,7 @@ move=> p. rewrite {2}(ppP p) mulf_eq0. apply/idP/idP; first by move->; rewrite orbT. case/orP=> //. -by rewrite polyC_eq0 gcdsr_eq0; move/eqP->; rewrite pp0. +by rewrite polyC_eq0 gcdsr_eq0 => /eqP->; rewrite pp0. Qed. Lemma ppC : forall c, c != 0 -> pp c%:P %= 1. @@ -415,8 +410,8 @@ Proof. move=> c c0. move: (eqd_trans (polyC_inj_eqd (gcdsrC c)) (eq_eqd (ppP c%:P))). rewrite -{1}[(gcdsr c%:P)%:P]mulr1. -have g0: ((gcdsr c%:P)%:P != 0). - by apply/negP; rewrite polyC_eq0 gcdsr_eq0 polyC_eq0=> H; rewrite H in c0. +have g0: (gcdsr c%:P)%:P != 0. + by rewrite polyC_eq0 gcdsr_eq0 polyC_eq0. by rewrite (eqd_mul2l _ _ g0) eqd_sym. Qed. @@ -443,22 +438,22 @@ Proof. by move=> p; apply/dvdrP; exists (gcdsr p)%:P; exact: ppP. Qed. Lemma pp_mul : forall p q, pp (p * q) %= pp p * pp q. Proof. move=> p q. -case p0: (p == 0); first by rewrite (eqP p0) mul0r !pp0 mul0r. -case q0: (q == 0); first by rewrite (eqP q0) mulr0 !pp0 mulr0. +have [-> | p0] := eqVneq p 0; first by rewrite mul0r !pp0 mul0r. +have [-> | q0] := eqVneq q 0; first by rewrite mulr0 !pp0 mulr0. have h0: (gcdsr (p * q))%:P != 0. - by rewrite polyC_eq0 gcdsr_eq0 mulf_eq0 p0 q0. + by rewrite polyC_eq0 gcdsr_eq0 mulf_eq0 negb_or p0. have h1: pp p * pp q != 0. - by apply/negP; rewrite mulf_eq0 !pp_eq0 p0 q0. + by rewrite mulf_eq0 !pp_eq0 negb_or p0. rewrite -(eqd_mul2l _ _ h0) -ppP. move: (polyC_inj_eqd (gauss_lemma p q)). -rewrite -(eqd_mul2r _ _ h1)=> H; rewrite eqd_sym (eqd_trans H); first by done. +rewrite -(eqd_mul2r _ _ h1)=> H; rewrite eqd_sym (eqd_trans H) //. by rewrite polyCM mulrCA -mulrA -ppP mulrCA mulrA -ppP. Qed. Lemma pp_mull : forall a p, a != 0 -> pp (a%:P * p) %= pp p. Proof. move=> a p a0. -rewrite (eqd_trans (pp_mul a%:P p)) //. +apply: (eqd_trans (pp_mul a%:P p)). by rewrite -{2}[pp p]mul1r eqd_mul ?ppC ?(eqP a0). Qed. @@ -468,23 +463,21 @@ Proof. by move=> p; rewrite (eqd_trans (pp_mul _ _)) // eqd_mul // ppX. Qed. Lemma pp_inj_dvdr : forall p q, p %| q -> pp p %| pp q. Proof. move=> p q; case/dvdrP=> x ->. -move: (pp_mul x p). -by case/andP=> _ H; rewrite (dvdr_trans _ H) ?dvdr_mull //. +by case/andP: (pp_mul x p)=>_; apply/dvdr_trans/dvdr_mull. Qed. Lemma pp_inj_eqd : forall p q, p %= q -> pp p %= pp q. Proof. -move=> p q. -by case/andP=> pq qp; apply/andP; rewrite (pp_inj_dvdr pq) (pp_inj_dvdr qp). +move=> p q; case/andP => pq qp. +by rewrite eqd_def (pp_inj_dvdr pq) (pp_inj_dvdr qp). Qed. Lemma size_pp : forall p, size p = size (pp p). Proof. move=> p. -case p0: (p == 0); first by rewrite (eqP p0) pp0. -have gp0: (gcdsr p != 0) by rewrite gcdsr_eq0 (negbT p0). -apply/eqP; rewrite eqn_leq. -apply/andP; split. +have [-> | p0] := eqVneq p 0; first by rewrite pp0. +have gp0: (gcdsr p != 0) by rewrite gcdsr_eq0. +apply/eqP; rewrite eqn_leq; apply/andP; split. move: (size_mul_leq (gcdsr p)%:P (pp p)). by rewrite {5}(ppP p) size_polyC gp0. rewrite {2}(ppP p). @@ -521,7 +514,7 @@ by apply/andP; rewrite (dvdr_trans gp2 gp1) dvd1r. Qed. Lemma dvdrp_prim_mull : forall a p q, - a != 0 -> primitive q -> p %| a%:P * q = (gcdsr p %| a) && (pp p %| q). + a != 0 -> primitive q -> p %| a%:P * q = (gcdsr p %| a) && (pp p %| q). Proof. move=> a p q a0 pq; case/andP: (pq)=> pq1 pq2. rewrite dvdrp_spec. @@ -550,7 +543,7 @@ Qed. Lemma dvdrp_primr : forall p q, p %| q -> primitive q -> primitive p. Proof. move=> p q. -case p0: (p == 0); first by rewrite (eqP p0) dvd0r; move/eqP->. +have [-> | p0] := eqVneq p 0; first by rewrite dvd0r => /eqP->. rewrite /primitive /eqd=> pq ppq; rewrite dvd1r andbT; apply/dvdrP. move: (pp_inj_dvdr pq)=> pppq; rewrite dvdrp_spec in pq. case/andP: pq; case/dvdrP=> x Hx; case/dvdrP=> y Hy. @@ -571,25 +564,25 @@ Qed. Fixpoint gcdp_rec (n : nat) (p q : {poly R}) := let r := rmodp p q in if r == 0 then q - else if n is n'.+1 then gcdp_rec n' q (pp r) else pp r. + else if n is n'.+1 then gcdp_rec n' q (pp r) else pp r. Definition gcdp p q := let (p1,q1) := if size p < size q then (q,p) else (p,q) in - let d := (gcdr (gcdsr p1) (gcdsr q1))%:P in + let d := (gcdr (gcdsr p1) (gcdsr q1))%:P in d * gcdp_rec (size (pp p1)) (pp p1) (pp q1). Lemma gcdp_rec0r : forall p n, gcdp_rec n 0 p = p. Proof. -by move=> p n; rewrite /gcdp_rec; case: n; rewrite rmod0p eq_refl. +by move=> p n; rewrite /gcdp_rec; case: n; rewrite rmod0p eqxx. Qed. Lemma gcdp_recr0 : forall p n, primitive p -> gcdp_rec n p 0 %= p. Proof. move=> p n pp. -have p0 : (p == 0) = false by apply/negP; move/negP: (primitive0 pp). +have p0 := primitive0 pp. have Hppp : PolyGcdDomain.pp p %= p by rewrite {2}(ppP p) -{1}[PolyGcdDomain.pp p]mul1r eqd_mul // eqd_sym polyC_inj_eqd. -by case: n=> /= [|n]; rewrite rmodp0 p0 ?gcdp_rec0r Hppp. +by case: n=> /= [|n]; rewrite rmodp0 (negbTE p0) ?gcdp_rec0r Hppp. Qed. (* Show that gcdp_rec return a primitive polynomial that is the gcd of p and q *) @@ -605,8 +598,7 @@ have hcomm : GRing.comm q (lead_coef q)%:P by rewrite /GRing.comm mulrC. move: (rdivp_eq hcomm p); rewrite mulrC. set lx := lead_coef q ^+ rscalp p q => Hdiv. have H0: lx != 0. - apply/negP; rewrite expf_eq0 lead_coef_eq0; case/andP=> _ H0. - by move: q0; rewrite H0. + by rewrite expf_eq0 lead_coef_eq0 negb_and q0 orbT. case: ifP=>[pq0|npq0]. split=> //; apply/idP/idP; last by case/andP. @@ -658,12 +650,12 @@ wlog sqp : p q / size q <= size p=> [H|]. rewrite ltnNge sqp /=. (* Cases when either input is zero *) -case p0: (p == 0). - have q0: (q == 0) by rewrite (eqP p0) size_poly0 leqn0 size_poly_eq0 in sqp. - by rewrite (eqP p0) (eqP q0) !pp0 size_poly0 gcdp_rec0r mulr0 andbb. -case q0: (q == 0). - rewrite (eqP q0) dvdr0 andbT gcdsr0 pp0 /=. - case/andP: (gcdp_recr0 (size (pp p)) (prim_pp (negbT p0)))=> Hg Hpp. +have [p0 | p0] := eqVneq p 0. + have /eqP q0: (q == 0) by rewrite p0 size_poly0 leqn0 size_poly_eq0 in sqp. + by rewrite p0 q0 !pp0 size_poly0 gcdp_rec0r mulr0 andbb. +have [-> | q0] := eqVneq q 0. + rewrite dvdr0 andbT gcdsr0 pp0 /=. + case/andP: (gcdp_recr0 (size (pp p)) (prim_pp p0))=> Hg Hpp. apply/idP/idP=> [H|]. rewrite (ppP p); case/andP: (gcdr0 (gcdsr p))=> H0 _. exact: (dvdr_trans H (dvdr_mul (polyC_inj_dvdr H0) Hg)). @@ -671,10 +663,10 @@ case q0: (q == 0). case/andP: (gcdr0 (gcdsr p))=> _ H0. exact: (dvdr_mul (polyC_inj_dvdr (dvdr_trans Hgp H0)) (dvdr_trans Hppgp Hpp)). -have ppq0 : pp q != 0 by rewrite pp_eq0 (negbT q0). +have ppq0 : pp q != 0 by rewrite pp_eq0. have spp: (size (pp q) <= size (pp p)) by rewrite -!size_pp. -case: (gcdp_recP (pp p) (pp g) spp ppq0 (prim_pp (negbT q0)))=> H prim. +case: (gcdp_recP (pp p) (pp g) spp ppq0 (prim_pp q0))=> H prim. apply/idP/idP; last first. (* The easier case: @@ -687,8 +679,8 @@ apply/idP/idP; last first. (* The harder case: q | gcd (cont p) (cont q) * gcdp_rec (pp p) (pp q) -> g | p /\ g | q *) -have g0 : (gcdr (gcdsr p) (gcdsr q)) != 0 - by apply/negP; rewrite gcdr_eq0 !gcdsr_eq0 p0 q0. +have g0 : (gcdr (gcdsr p) (gcdsr q)) != 0. + by rewrite gcdr_eq0 negb_and !gcdsr_eq0 p0. rewrite (dvdrp_prim_mull _ g0 prim); case/andP=> gdvd ppgdvd. @@ -768,8 +760,8 @@ case: {1}_ / h=> //. rewrite ltnS (leq_trans (size_add _ _)) //. rewrite geq_max (leq_trans (size_poly _ _)) //. rewrite size_opp (leq_trans (size_mul_leq _ _)) //. - case x0: ((p`_sp / q`_sq) == 0). - rewrite (eqP x0) polyC0 mul0r size_poly0 addn0. + have [-> | x0] := eqVneq (p`_sp / q`_sq) 0. + rewrite polyC0 mul0r size_poly0 addn0. rewrite -subn1 leq_subLR (leq_trans (size_poly _ _)) //. by rewrite add1n (leq_trans spq) // leqnSn. rewrite size_proper_mul ?lead_coefC ?lead_coefXn ?mulr1 ?x0 //. @@ -787,19 +779,18 @@ Lemma edivP : forall p q, EuclideanDomain.edivr_spec (size : {poly F} -> nat) p q (ediv p q). Proof. move=> p q; rewrite /ediv. -case q0: (q == 0). +case: (eqVneq q 0) => q0. constructor; first by rewrite mul0r add0r. - by rewrite (eqP q0); apply/implyP; move/eqP. -have := (@ediv_recP q (size p) p 0 (negbT q0) (leqnn _)). + by rewrite q0 eqxx. +have := (@ediv_recP q (size p) p 0 q0 (leqnn _)). by case: ediv_rec=> a b; rewrite subr0. Qed. Lemma poly_size_mull : forall p q, p != (0 : {poly F}) -> (size q <= size (p * q)%R)%N. Proof. move=> p q p0. -case q0: (q == 0); first by rewrite (eqP q0) mulr0 size_poly0 leqnn. -rewrite size_mul=> //; last by rewrite q0. -rewrite -ltnS prednK; first by rewrite -subn_gt0 addnK lt0n size_poly_eq0. +case: (eqVneq q 0)=>[->|q0]; first by rewrite mulr0 size_poly0 leqnn. +rewrite size_mul // -ltnS prednK; first by rewrite -subn_gt0 addnK lt0n size_poly_eq0. by rewrite addn_gt0 lt0n size_poly_eq0 p0. Qed. diff --git a/theory/rank.v b/theory/rank.v index e0ee03e..17eb94d 100644 --- a/theory/rank.v +++ b/theory/rank.v @@ -17,18 +17,17 @@ Variable F : fieldType. Local Open Scope ring_scope. Fixpoint rank_elim {m n : nat} : 'M[F]_(m, n) -> nat := - match n return 'M_(m, n) -> nat with - | p.+1 => fun (M : 'M_(m, 1 + p)) => - if find_pivot M is Some k then - let a := fun_of_matrix M k 0 in - let u := rsubmx (row k M) in - let R := row' k M in - let v := a^-1 *: lsubmx R in - let R := rsubmx R - v *m u in - (1 + rank_elim R)%N - else rank_elim (rsubmx M) - | _ => fun _ => 0%N - end. + if n is p.+1 then + fun (M : 'M_(m, 1 + p)) => + if find_pivot M is Some k then + let a := fun_of_matrix M k 0 in + let u := rsubmx (row k M) in + let R := row' k M in + let v := a^-1 *: lsubmx R in + let R := rsubmx R - v *m u in + (1 + rank_elim R)%N + else rank_elim (rsubmx M) + else fun => 0%N. Lemma rank_row0mx (m n p : nat) (M : 'M[F]_(m,n)) : \rank (row_mx (0: 'M[F]_(m,p)) M) = \rank M. @@ -41,12 +40,12 @@ move=> nz_a. rewrite /block_mx -addsmxE mxrank_disjoint_sum. rewrite rank_row0mx rank_rV. have->//: row_mx a%:M Aur != 0. - apply/eqP; move/matrixP/(_ 0 0); rewrite !mxE. + apply/eqP => /matrixP/(_ 0 0); rewrite !mxE. by case: splitP => // j _; rewrite ord1 !mxE; move/eqP: nz_a. - apply/eqP/rowV0P=> v0; rewrite sub_capmx; case/andP=> /sub_rVP [k Hv0k]. - rewrite Hv0k; case/submxP=> D; move/matrixP/(_ 0 0); rewrite !mxE. - case: splitP=> // j _; rewrite ord1 mxE mulr1n big1. - by move/eqP; rewrite mulf_eq0 (negbTE nz_a) orbF; move/eqP ->; rewrite scale0r. +apply/eqP/rowV0P => v0; rewrite sub_capmx; case/andP=> /sub_rVP [k Hv0k]. +rewrite Hv0k; case/submxP => D /matrixP/(_ 0 0); rewrite !mxE. +case: splitP => // j _; rewrite ord1 mxE mulr1n big1. +by move/eqP; rewrite mulf_eq0 (negbTE nz_a) orbF => /eqP ->; rewrite scale0r. by move=> i _; rewrite !mxE; case: splitP=> // l _; rewrite mxE mulr0. Qed. @@ -69,10 +68,9 @@ rewrite -[n.+1]/(1 + n)%N => M /=. rewrite /find_pivot. have [|nz_Mk0] /= := pickP; last first. rewrite -{2}[M]hsubmxK. - have->: lsubmx M = 0. - apply/matrixP => i j; rewrite !mxE ord1 lshift0. - by have /(_ i)/negbFE/eqP -> := nz_Mk0. - by rewrite rank_row0mx. + suff->: lsubmx M = 0 by rewrite rank_row0mx. + apply/matrixP => i j; rewrite !mxE ord1 lshift0. + by have /(_ i)/negbFE/eqP -> := nz_Mk0. case: m M => [M []|m] //. rewrite -[m.+1]/(1 + m)%N => M k /= nz_Mk0; rewrite IHn. pose P : 'M[F]_(1 + m) := perm_mx (lift_perm 0 k 1%g). diff --git a/theory/similar.v b/theory/similar.v index ab26947..92aca18 100644 --- a/theory/similar.v +++ b/theory/similar.v @@ -61,7 +61,7 @@ Definition phi (p : {poly R}^c) := map_poly id_converse p. Fact phi_is_rmorphism : rmorphism phi. Proof. -split=> //; first exact:raddfB. +split=> //; first exact: raddfB. split=> [p q|]; apply/polyP=> i; last by rewrite coef_map !coef1. by rewrite coefMr coef_map coefM; apply: eq_bigr => j _; rewrite !coef_map. Qed. @@ -121,7 +121,7 @@ Lemma rdivp_l_eq p : p = d * (rdivp_l p d) + (rmodp_l p d). Proof. have mon_phi_d: phi d \is monic by rewrite monic_map_inj. -apply:(can_inj (@phiK R)); rewrite {1}[phi p](rdivp_eq mon_phi_d) rmorphD. +apply: (can_inj (@phiK R)); rewrite {1}[phi p](rdivp_eq mon_phi_d) rmorphD. rewrite rmorphM /rdivp_l /rmodp_l /redivp_l /rdivp /rmodp. by case: (redivp _ _)=> [[k q'] r'] /=; rewrite !phi_invK. Qed. @@ -141,27 +141,28 @@ End RPdiv. Section SimilarDef. - + Local Open Scope ring_scope. Import GRing.Theory. Variable R : comUnitRingType. -Definition similar m n (A : 'M[R]_m) (B : 'M[R]_n) := - m = n /\ exists P, P \in unitmx /\ P *m A = (conform_mx P B) *m P. +Definition similar m n (A : 'M[R]_m) (B : 'M[R]_n) := + m = n /\ exists2 P, P \in unitmx & P *m A = (conform_mx P B) *m P. Lemma similar0 m (A : 'M[R]_0) (B : 'M[R]_m) : (0 = m)%N -> similar A B. Proof. move=> H; split=> //. -by exists 1%:M; rewrite unitmx1; split=> //; apply/matrixP; case. +exists 1%:M; first exact: unitmx1. +by apply/matrixP; case. Qed. -Lemma similar_sym m : forall n (A : 'M[R]_m) (B : 'M[R]_n), +Lemma similar_sym m : forall n (A : 'M[R]_m) (B : 'M[R]_n), similar A B -> similar B A. Proof. case=> [A B [H1 H2]|n A B [Hmn]]. by apply: similar0; rewrite H1. -move: A; rewrite Hmn=> A [P [HP HPA]]. -split=> //; exists P^-1; split; first by rewrite unitmx_inv. +move: A; rewrite Hmn => A [P HP HPA]. +split=> //; exists P^-1; first by rewrite unitmx_inv. rewrite !conform_mx_id -1?[A *m _]mul1mx -?(mulVmx HP) in HPA *. by rewrite mulmxA -(mulmxA P^-1) HPA -!mulmxA mulmxV // mulmx1. Qed. @@ -170,86 +171,86 @@ Lemma similar_trans m n p (B : 'M[R]_n) (A : 'M[R]_m) (C : 'M[R]_p) : similar A B -> similar B C -> similar A C. Proof. case=> [Hmn HAB] [Hnp]. -move: Hmn Hnp A B C HAB=> -> -> A B C [P [HP HAB]] [Q [HQ HBC]]. -split=> //; exists (Q *m P); split; first by rewrite unitmx_mul HP HQ. +move: Hmn Hnp A B C HAB=> -> -> A B C [P HP HAB] [Q HQ HBC]. +split=> //; exists (Q *m P); first by rewrite unitmx_mul HP HQ. by rewrite -mulmxA HAB !conform_mx_id !mulmxA HBC conform_mx_id. Qed. Lemma similar_refl n (A : 'M[R]_n) : similar A A. Proof. -split=> //; exists 1%:M; split; first by rewrite unitmx1. +split=> //; exists 1%:M; first by rewrite unitmx1. by rewrite conform_mx_id mulmx1 mul1mx. Qed. -Lemma similar_det m n (A : 'M[R]_m) (B : 'M[R]_n) : +Lemma similar_det m n (A : 'M[R]_m) (B : 'M[R]_n) : similar A B -> \det A = \det B. Proof. -case=> [Hmn]; move: Hmn A B=> -> A B [P [HP HAB]]. +case=> [Hmn]; move: Hmn A B=> -> A B [P HP HAB]. apply: (@mulrI _ (\det P)); first by rewrite -unitmxE. by rewrite -det_mulmx mulrC -det_mulmx HAB conform_mx_id. Qed. Lemma similar_cast n m p (eq1 : m = p) (eq2 : m = p) - (A : 'M[R]_n) (B : 'M[R]_m) : + (A : 'M[R]_n) (B : 'M[R]_m) : similar A (castmx (eq1,eq2) B) <-> similar A B. Proof. by case: _ /eq1 eq2=> eq2; rewrite castmx_id. Qed. Lemma similar_diag_mx_seq m n s1 s2 : - m = n -> size s1 = m -> perm_eq s1 s2 -> + m = n -> size s1 = m -> perm_eq s1 s2 -> similar (diag_mx_seq m m s1) (diag_mx_seq n n s2). Proof. move=> eq Hms Hp. -have Hs12:= (perm_size Hp). -have Hs2: size s2 == n by rewrite -Hs12 Hms eq. +have Hs12:= perm_size Hp. +have Hs2: size s2 == n by rewrite -Hs12 Hms eq. pose t:= Tuple Hs2. have HE: s2 = t by []. move: Hp; rewrite HE. case/tuple_permP=> p Hp. split=> //; rewrite eq. -exists (perm_mx p)^T; split; first by rewrite unitmx_tr unitmx_perm. +exists (perm_mx p)^T; first by rewrite unitmx_tr unitmx_perm. apply/matrixP=> i j; rewrite conform_mx_id !mxE (bigD1 j) //= big1 ?addr0. rewrite (bigD1 i) //= big1 ?addr0. rewrite !mxE Hp -tnth_nth tnth_mktuple (tnth_nth 0) HE !eqxx. case: (p j == i) /eqP => Hij; first by rewrite Hij mulr1 mul1r. by rewrite mulr0 mul0r. by move=> k /negbTE Hk; rewrite !mxE eq_sym (inj_eq (@ord_inj _)) Hk mul0r. -by move=> k /negbTE Hk; rewrite !mxE (inj_eq (@ord_inj _)) Hk mulr0. +by move=> k /negbTE Hk; rewrite !mxE (inj_eq (@ord_inj _)) Hk mulr0. Qed. -Lemma similar_ulblockmx n1 n2 n3 (Aul : 'M[R]_n1) (Adr : 'M[R]_n3) +Lemma similar_ulblockmx n1 n2 n3 (Aul : 'M[R]_n1) (Adr : 'M[R]_n3) (Bul : 'M[R]_n2) : - similar Aul Bul -> + similar Aul Bul -> similar (block_mx Aul 0 0 Adr) (block_mx Bul 0 0 Adr). Proof. -case=> Hn1 [P [HP HAB]]. +case=> Hn1 [P HP HAB]. have Hu : (block_mx P 0 0 1%:M) \in unitmx. by move=> n; rewrite unitmxE det_ublock det1 mulr1 -unitmxE. split; first by rewrite Hn1. move: Aul P HP HAB Hu; rewrite Hn1=> Aul P HP; rewrite conform_mx_id=> HAB Hu. -exists (block_mx P 0 0 1%:M); split; first exact: Hu. +exists (block_mx P 0 0 1%:M); first exact: Hu. rewrite conform_mx_id !mulmx_block !mul0mx !mulmx0. by rewrite !add0r !addr0 mulmx1 mul1mx HAB. Qed. - + Lemma similar_drblockmx n1 n2 n3(Aul : 'M[R]_n1) (Adr : 'M[R]_n2) - (Bdr : 'M[R]_n3) : - similar Adr Bdr -> + (Bdr : 'M[R]_n3) : + similar Adr Bdr -> similar (block_mx Aul 0 0 Adr) (block_mx Aul 0 0 Bdr). Proof. -case=> Hn2 [P [HP HAB]]. +case=> Hn2 [P HP HAB]. have Hu : (block_mx 1%:M 0 0 P) \in unitmx. by move=> n; rewrite unitmxE det_ublock det1 mul1r -unitmxE. split; first by rewrite Hn2. move: Adr P HP HAB Hu; rewrite Hn2=> Adr P HP; rewrite conform_mx_id=> HAB Hu. -exists (block_mx 1%:M 0 0 P); split; first exact: Hu. +exists (block_mx 1%:M 0 0 P); first exact: Hu. rewrite conform_mx_id !mulmx_block !mul0mx !mulmx0. by rewrite !add0r !addr0 mulmx1 mul1mx HAB. Qed. Lemma similar_dgblockmx n1 n2 n3 n4 (Aul : 'M[R]_n1) (Adr : 'M[R]_n2) (Bul : 'M[R]_n3) (Bdr : 'M[R]_n4) : - similar Aul Bul -> similar Adr Bdr -> + similar Aul Bul -> similar Adr Bdr -> similar (block_mx Aul 0 0 Adr) (block_mx Bul 0 0 Bdr). Proof. move=> HABu HABd; apply: (similar_trans (B:= (block_mx Bul 0 0 Adr))). @@ -260,20 +261,20 @@ Qed. Lemma similar_exp m n (A : 'M[R]_m.+1) (B : 'M_n.+1) k: similar A B -> similar (A ^+ k) (B ^+ k). Proof. -case=> /eqP; rewrite eqSS=> /eqP eq [P [HP]]; move: B. +case=> /eqP; rewrite eqSS=> /eqP eq [P HP]; move: B. rewrite /similar -eq=> B; rewrite conform_mx_id=> HAB. -split=> //; exists P; rewrite conform_mx_id; split=> //. +split=> //; exists P => //; rewrite conform_mx_id. elim: k=> [|k IHk]. by rewrite !expr0 mulmx1 mul1mx. by rewrite exprSr mulmxA IHk -mulmxA HAB exprSr mulmxA. Qed. -Lemma similar_poly m n (A : 'M[R]_m.+1) (B : 'M_n.+1) p: +Lemma similar_poly m n (A : 'M[R]_m.+1) (B : 'M_n.+1) p: similar A B -> similar (horner_mx A p) (horner_mx B p). Proof. -case=> /eqP; rewrite eqSS=> /eqP eq [P [HP]]; move: B. +case=> /eqP; rewrite eqSS=> /eqP eq [P HP]; move: B. rewrite /similar -eq=> B; rewrite conform_mx_id=> HAB. -split=> //; exists P; rewrite conform_mx_id; split=> //. +split=> //; exists P => //; rewrite conform_mx_id. elim/poly_ind: p=>[|p c IHp]. by rewrite !rmorph0 mulmx0 mul0mx. rewrite !rmorphD !rmorphM /= !horner_mx_X !horner_mx_C. @@ -284,7 +285,7 @@ Lemma similar_horner n m (A : 'M[R]_n.+1) (B : 'M_m.+1) p : similar A B -> horner_mx A p = 0 -> horner_mx B p = 0. Proof. move/(similar_poly p)=> HAB HhA; move: HAB; rewrite HhA. -case=> /eqP; rewrite eqSS=> /eqP eq [P [HP]]. +case=> /eqP; rewrite eqSS=> /eqP eq [P HP]. rewrite -eq in B *; rewrite conform_mx_id mulmx0=> H. by apply: (mulIr HP); rewrite mul0r. Qed. @@ -315,39 +316,41 @@ Local Open Scope ring_scope. Import GRing.Theory. Definition equivalent m1 n1 m2 n2 (A : 'M[R]_(m1,n1)) (B : 'M[R]_(m2,n2)) := - [/\ m1 = m2, n1 = n2 & exists M, exists N, - [/\ M \in unitmx , N \in unitmx & M *m A *m N = conform_mx A B]]. + [/\ m1 = m2, n1 = n2 & exists M N, + [/\ M \in unitmx, N \in unitmx & M *m A *m N = conform_mx A B]]. -Lemma equiv0l n m p (A : 'M[R]_(0,n)) (B : 'M[R]_(m,p)) : +Lemma equiv0l n m p (A : 'M[R]_(0,n)) (B : 'M[R]_(m,p)) : (0 = m)%N -> (n = p)%N -> equivalent A B. Proof. move=> eq1 eq2; split=> //. -by exists 1%:M; exists 1%:M; split; rewrite ?unitmx1 //; apply/matrixP; case. +exists 1%:M, 1%:M; split; try exact: unitmx1. +by apply/matrixP; case. Qed. -Lemma equiv0r n m p (A : 'M[R]_(n,0)) (B : 'M[R]_(m,p)) : +Lemma equiv0r n m p (A : 'M[R]_(n,0)) (B : 'M[R]_(m,p)) : (n = m)%N -> (0 = p)%N -> equivalent A B. Proof. -move=> eq1 eq2; split=> //; exists 1%:M; exists 1%:M. -by split; rewrite ?unitmx1 //; apply/matrixP=> i; case. +move=> eq1 eq2; split=> //. +exists 1%:M, 1%:M; split; try exact: unitmx1. +by apply/matrixP=> i; case. Qed. Lemma similar_equiv m n (A : 'M_m) (B : 'M_n) : similar A B -> equivalent A B. Proof. -case; case: m A B; case: n=> //; first by move=> A B _ _; apply: equiv0r. -move=> m n A B eq [P [HP HAB]]. -split=> //; exists P; exists P^-1; split; rewrite ?unitmx_inv //. -rewrite HAB -mulmxA mulmxV //; clear -eq; move: B. +case; case: m A B; case: n => //; first by move=> A B _ _; apply: equiv0r. +move=> m n A B eq [P HP HAB]. +split=> //; exists P, P^-1; split=> //; first by rewrite unitmx_inv. +rewrite {}HAB -mulmxA mulmxV //; move: B. by rewrite -eq=> B; rewrite !conform_mx_id mulmx1. Qed. Lemma equiv_refl m n (A : 'M[R]_(m,n)) : equivalent A A. Proof. -split=> //; exists 1%:M; exists 1%:M. +split=> //; exists 1%:M, 1%:M. by split; rewrite ?unitmx1 // conform_mx_id mulmx1 mul1mx. Qed. -Lemma equiv_sym m1 n1 m2 n2 (A : 'M[R]_(m1,n1)) (B : 'M[R]_(m2,n2)) : +Lemma equiv_sym m1 n1 m2 n2 (A : 'M[R]_(m1,n1)) (B : 'M[R]_(m2,n2)) : equivalent A B -> equivalent B A. Proof. case: m2 A B=> [A B [eq1 eq2 _]|]; first by apply/equiv0l/esym. @@ -356,12 +359,12 @@ case: m1=> [m2 n2 A B []|] //. case: n1=> [m1 m2 n2 A B []|n1 m1 n2 m2 A B [eq1 eq2 [M [N [HM HN HAB]]]]] //. split; try exact: esym. move: B HAB; rewrite -eq1 -eq2=> B; rewrite !conform_mx_id=> HAB. -exists M^-1; exists N^-1; split; rewrite ?unitmx_inv //. +exists M^-1, N^-1; split; rewrite ?unitmx_inv //. by rewrite -HAB !mulmxA mulVmx // mul1mx -mulmxA mulmxV // mulmx1. Qed. -Lemma equiv_trans m1 n1 m2 n2 m3 n3 (B : 'M[R]_(m2,n2)) - (A : 'M[R]_(m1,n1)) (C : 'M[R]_(m3,n3)) : +Lemma equiv_trans m1 n1 m2 n2 m3 n3 (B : 'M[R]_(m2,n2)) + (A : 'M[R]_(m1,n1)) (C : 'M[R]_(m3,n3)) : equivalent A B -> equivalent B C -> equivalent A C. Proof. case=> eqm12 eqn12 [M1 [N1 [HM1 HN1 HAB]]]. @@ -369,27 +372,26 @@ case=> eqm23 eqn23 [M2 [N2 [HM2 HN2 HBC]]]. split; [exact: (etrans eqm12) | exact: (etrans eqn12)|]. move: A B M1 N1 M2 N2 HM1 HN1 HM2 HN2 HAB HBC. rewrite eqm12 eqn12 eqm23 eqn23=> A B M1 N1 M2 N2 HM1 HN1 HM2 HN2. -rewrite !conform_mx_id=> HAB HBC. -exists (M2 *m M1); exists (N1 *m N2). -split; rewrite ?unitmx_mul //; try by apply/andP. +rewrite !conform_mx_id=> HAB HBC. +exists (M2 *m M1), (N1 *m N2); split; try by rewrite unitmx_mul; apply/andP. by rewrite -!(mulmxA M2) (mulmxA (_ *m A)) HAB mulmxA. -Qed. +Qed. -Lemma equiv_ulblockmx m1 n1 m2 n2 m3 n3 (Aul : 'M[R]_(m1,n1)) - (Adr : 'M[R]_(m2,n2)) (Bul : 'M[R]_(m3,n3)) : - equivalent Aul Bul -> +Lemma equiv_ulblockmx m1 n1 m2 n2 m3 n3 (Aul : 'M[R]_(m1,n1)) + (Adr : 'M[R]_(m2,n2)) (Bul : 'M[R]_(m3,n3)) : + equivalent Aul Bul -> equivalent (block_mx Aul 0 0 Adr) (block_mx Bul 0 0 Adr). Proof. case=> eqm eqn [M [N [HM HN HAB]]]. split; rewrite ?eqm ?eqn //. move: Aul M N HM HN HAB; rewrite eqm eqn => Aul M N HM HN. rewrite !conform_mx_id=> HAB. -exists (block_mx M 0 0 1%:M); exists (block_mx N 0 0 1%:M). +exists (block_mx M 0 0 1%:M), (block_mx N 0 0 1%:M). split; try by rewrite unitmxE det_ublock det1 mulr1 -unitmxE. by rewrite !mulmx_block !mulmx0 !mul0mx !addr0 !mul0mx !add0r mulmx1 mul1mx HAB. Qed. -Lemma equiv_drblockmx m1 n1 m2 n2 m3 n3 (Aul : 'M[R]_(m1,n1)) +Lemma equiv_drblockmx m1 n1 m2 n2 m3 n3 (Aul : 'M[R]_(m1,n1)) (Adr : 'M[R]_(m2,n2)) (Bdr : 'M[R]_(m3,n3)) : equivalent Adr Bdr -> equivalent (block_mx Aul 0 0 Adr) (block_mx Aul 0 0 Bdr). @@ -398,15 +400,15 @@ case=> eqm eqn [M [N [HM HN HAB]]]. split; rewrite ?eqm ?eqn //. move: Adr M N HM HN HAB; rewrite eqm eqn=> Adr M N HM HN. rewrite !conform_mx_id=> HAB. -exists (block_mx 1%:M 0 0 M); exists (block_mx 1%:M 0 0 N). +exists (block_mx 1%:M 0 0 M), (block_mx 1%:M 0 0 N). split; try by rewrite unitmxE det_ublock det1 mul1r -unitmxE. by rewrite !mulmx_block !mulmx0 !mul0mx !addr0 !mul0mx !add0r mulmx1 mul1mx HAB. Qed. -Lemma equiv_dgblockmx m1 n1 m2 n2 m3 n3 m4 n4 +Lemma equiv_dgblockmx m1 n1 m2 n2 m3 n3 m4 n4 (Aul : 'M[R]_(m1,n1)) (Adr : 'M[R]_(m2,n2)) (Bul : 'M[R]_(m3,n3)) (Bdr : 'M[R]_(m4,n4)) : - equivalent Aul Bul -> equivalent Adr Bdr -> + equivalent Aul Bul -> equivalent Adr Bdr -> equivalent (block_mx Aul 0 0 Adr) (block_mx Bul 0 0 Bdr). Proof. move=> HABu HABd; apply: (equiv_trans (B:=(block_mx Bul 0 0 Adr))). @@ -414,11 +416,11 @@ move=> HABu HABd; apply: (equiv_trans (B:=(block_mx Bul 0 0 Adr))). exact: equiv_drblockmx. Qed. -Lemma equiv_cast m1 n1 m2 n2 m3 n3 (eqm : m2 = m3) (eqn : n2 = n3) - (A : 'M[R]_(m1,n1)) (B : 'M[R]_(m2,n2)) : +Lemma equiv_cast m1 n1 m2 n2 m3 n3 (eqm : m2 = m3) (eqn : n2 = n3) + (A : 'M[R]_(m1,n1)) (B : 'M[R]_(m2,n2)) : equivalent A (castmx (eqm,eqn) B) <-> equivalent A B. Proof. by split; case: m3 / eqm A; case: n3 / eqn B. Qed. - + Lemma equiv_diag_block : forall l1 l2, size l1 = size l2 -> forall (F1 F2 : forall n : nat, nat -> 'M_n.+1), (forall i, i < size l1-> @@ -437,7 +439,7 @@ exact: (H i.+1). Qed. End EquivalentDef. - + Section Field. @@ -456,14 +458,13 @@ Theorem similar_fundamental (A: 'M[R]_m) (B : 'M[R]_n) : Proof. constructor. case: n B=> [B [eq _]|n' B]; first by apply/equiv_sym/equiv0l/esym. - case: m A=> [A [eq _]|m' A]; first exact: equiv0l. - case=> eq [P [HP HPA]]; split=> //. + case: m A=> [A [eq _]|m' A]; first exact: equiv0l. + case=> eq [P HP HPA]; split=> //. move: A P HP HPA; rewrite eq=> A P HP; rewrite !conform_mx_id=> HPA. pose M := (map_mx (polyC_rmorphism _) P). pose N := (map_mx (polyC_rmorphism _) P^-1). - exists M ; exists N. have HM: M \in unitmx by rewrite map_unitmx. - split=> //; first by rewrite map_unitmx unitmx_inv. + exists M, N; split=> //; first by rewrite map_unitmx unitmx_inv. rewrite mulmxBr mulmxBl mul_mx_scalar -scalemxAl /M /N map_mx_inv. rewrite (mulmxV HM) scalemx1 -map_mxM HPA -map_mx_inv -map_mxM. by rewrite -mulmxA (mulmxV HP) mulmx1. @@ -500,29 +501,29 @@ have {}H: M0 * ('X - A%:P) * N0 = (1 - ('X - B%:P) * R1) * ('X - B%:P). by rewrite opprD opprK addrA addrN add0r. have HM0: size M0 <= 1. by rewrite -ltnS -(size_XsubC B) ltn_rmodp_l polyXsubC_eq0. -have HN0 : size N0 <= 1. +have HN0: size N0 <= 1. by rewrite -ltnS -(size_XsubC B) ltn_rmodp polyXsubC_eq0. -case HR1:(R1 == 0); last first. +case: (eqVneq R1 0) => HR1; last first. have: size ((1 - ('X - B%:P) * R1) * ('X - B%:P)) <= 2. rewrite -H; apply:(leq_trans (size_mul_leq _ _)). rewrite (size1_polyC HN0) size_polyC -subn1 leq_subLR addnC. apply/(leq_add (leq_b1 _))/(leq_trans (size_mul_leq _ _)). by rewrite (size1_polyC HM0) size_polyC size_XsubC addnC; exact:leq_b1. have Hsize: size (1 - ('X - B%:P) * R1) = (size R1).+1. - rewrite addrC size_addl size_opp (size_monicM (monicXsubC B) (negbT HR1)). + rewrite addrC size_addl size_opp (size_monicM (monicXsubC B) HR1). by rewrite {1}size_XsubC. rewrite size_polyC oner_neq0 size_XsubC. - by move:(size_poly_eq0 R1); case:(size R1)=> //; rewrite HR1. + by move:(size_poly_eq0 R1); case:(size R1)=> //; rewrite (negbTE HR1). rewrite size_Mmonic. - + by rewrite Hsize size_XsubC addnC !ltnS leqn0 size_poly_eq0 HR1. + + by rewrite Hsize size_XsubC addnC !ltnS leqn0 size_poly_eq0 (negbTE HR1). + by rewrite -size_poly_eq0 Hsize. - exact:monicXsubC. -move:H; rewrite (eqP HR1) mulr0 subr0 mul1r (size1_polyC HM0). + exact: monicXsubC. +move:H; rewrite HR1 mulr0 subr0 mul1r (size1_polyC HM0). rewrite (size1_polyC HN0)=> /polyP H; move:(H 1%N); move:(H 0%N). rewrite !coefMC !coefCM !coefD !coefN !coefC !coefX !eqxx !sub0r subr0 mulr1. rewrite mulrN mulNr; move/eqP; rewrite eqr_opp=> /eqP HM0N0 HM0N0I. case:(mulmx1_unit HM0N0I)=> HM00 HN00. -exists (M0`_0); split=> //; rewrite conform_mx_id -HM0N0 mulmxE -(divr1 N0`_0). +exists (M0`_0) => //; rewrite conform_mx_id -HM0N0 mulmxE -(divr1 N0`_0). by rewrite -[1]HM0N0I invrM // mulrA divrr // mul1r -!mulrA mulVr // mulr1. Qed. @@ -530,26 +531,26 @@ Lemma similar_mxminpoly m' n' (A : 'M[R]_m'.+1) (B : 'M[R]_n'.+1) : similar A B -> mxminpoly A = mxminpoly B. Proof. move=> HAB; apply/eqP; rewrite -eqp_monic //; try exact: mxminpoly_monic. -apply/andP; split; apply: mxminpoly_min. +apply/andP; split; apply: mxminpoly_min. by apply/(similar_horner (similar_sym HAB))/mx_root_minpoly. by apply/(similar_horner HAB)/mx_root_minpoly. Qed. - + Lemma similar_char_poly m' n' (A : 'M[R]_m') (B : 'M[R]_n') : similar A B -> char_poly A = char_poly B. Proof. -case=> eq [P [HP HAB]]; rewrite /char_poly /char_poly_mx. +case=> eq [P HP HAB]; rewrite /char_poly /char_poly_mx. have H: map_mx polyC P \in unitmx by rewrite map_unitmx. apply: similar_det; split=> //. -rewrite -eq in B HAB *; rewrite conform_mx_id in HAB. -exists (map_mx polyC P); split=> //; rewrite conform_mx_id. -by rewrite mulmxDr mulmxDl scalar_mxC mulmxN mulNmx -!map_mxM HAB. +rewrite -eq in B HAB *; rewrite conform_mx_id in HAB. +exists (map_mx polyC P) => //; rewrite conform_mx_id. +by rewrite mulmxDr mulmxDl scalar_mxC mulmxN mulNmx -!map_mxM HAB. Qed. End Field. Section DvdRing. - + Local Open Scope ring_scope. Import GRing.Theory. Variable R : dvdRingType. @@ -563,7 +564,7 @@ case: n=> [_ _|n]; first exact: equiv0l. case: m=> [_ _|m Hs]; first exact: equiv0r. move: Hs n m. pose P := (fun (s1 s2 : seq R) => forall n m, - (forall i, nth 0 s1 i %= nth 0 s2 i) -> + (forall i, nth 0 s1 i %= nth 0 s2 i) -> equivalent (diag_mx_seq n.+1 m.+1 s1) (diag_mx_seq n.+1 m.+1 s2)). apply: (seq2_ind (P:=P))=> /= [n m _ | x1 x2 s0 s3 IH n m Hi]. by rewrite !diag_mx_seq_nil; apply: equiv_refl. @@ -574,10 +575,10 @@ have Hxp : x1 %= x2 by move: (Hi 0%N); rewrite nth0. have Hx12: (@equivalent _ 1 1 1 1 x1%:M x2%:M). split=> //; case/eqdP: Hxp=> c Hc Hcx. rewrite conform_mx_id. - exists c%:M; exists 1%:M; split. - +by rewrite -scalemx1 unitmxZ // unitmx1. - +by rewrite unitmx1. - by rewrite mul_scalar_mx scale_scalar_mx mulmx1 Hcx. + exists c%:M, 1%:M; split. + + by rewrite -scalemx1 unitmxZ // unitmx1. + + by rewrite unitmx1. + by rewrite mul_scalar_mx scale_scalar_mx mulmx1 Hcx. apply: (equiv_dgblockmx Hx12). case: n=> [|n]; first exact: equiv0l. case: m=> [|m]; first exact: equiv0r. diff --git a/theory/smith.v b/theory/smith.v index d3f26e2..4c3d9b9 100644 --- a/theory/smith.v +++ b/theory/smith.v @@ -50,30 +50,28 @@ Hypothesis find_pivotP : forall m n (E : 'M[E]_(1 + m,1 + n)), Fixpoint improve_pivot_rec k {m n} : 'M[E]_(1 + m) -> 'M[E]_(1 + m, 1 + n) -> 'M[E]_(1 + n) -> 'M[E]_(1 + m) * 'M[E]_(1 + m, 1 + n) * 'M[E]_(1 + n) := - match k with - | 0 => fun P M Q => (P,M,Q) - | p.+1 => fun P M Q => - let a := M 0 0 in - if find1 M a is Some i then - let Mi0 := M (lift 0 i) 0 in - let P := Bezout_step a Mi0 P i in - let M := Bezout_step a Mi0 M i in - improve_pivot_rec p P M Q - else - let u := dlsubmx M in let vM := ursubmx M in let vP := usubmx P in - let u' := map_mx (fun x => 1 - odflt 0 (x %/? a)) u in - let P := col_mx (usubmx P) (u' *m vP + dsubmx P) in - let M := block_mx (a%:M) vM - (const_mx a) (u' *m vM + drsubmx M) in - if find2 M a is Some (i,j) then - let M := xrow 0 i M in let P := xrow 0 i P in - let a := fun_of_matrix M 0 0 in - let M0ij := fun_of_matrix M 0 (lift 0 j) in - let Q := (Bezout_step a M0ij Q^T j)^T in - let M := (Bezout_step a M0ij M^T j)^T in - improve_pivot_rec p P M Q - else (P, M, Q) - end. + if k is p.+1 then fun P M Q => + let a := M 0 0 in + if find1 M a is Some i then + let Mi0 := M (lift 0 i) 0 in + let P := Bezout_step a Mi0 P i in + let M := Bezout_step a Mi0 M i in + improve_pivot_rec p P M Q + else + let u := dlsubmx M in let vM := ursubmx M in let vP := usubmx P in + let u' := map_mx (fun x => 1 - odflt 0 (x %/? a)) u in + let P := col_mx (usubmx P) (u' *m vP + dsubmx P) in + let M := block_mx (a%:M) vM + (const_mx a) (u' *m vM + drsubmx M) in + if find2 M a is Some (i,j) then + let M := xrow 0 i M in let P := xrow 0 i P in + let a := fun_of_matrix M 0 0 in + let M0ij := fun_of_matrix M 0 (lift 0 j) in + let Q := (Bezout_step a M0ij Q^T j)^T in + let M := (Bezout_step a M0ij M^T j)^T in + improve_pivot_rec p P M Q + else (P, M, Q) + else fun P M Q => (P,M,Q). Definition improve_pivot k m n (M : 'M[E]_(1 + m, 1 + n)) := improve_pivot_rec k 1 M 1. @@ -172,12 +170,12 @@ constructor=> //; first by rewrite -HblockL -Hblock invrM // mulmxA mulmxKV. + rewrite -[m.+1]/(1 + m)%N -[n.+1]/(1 + n)%N => i j. rewrite -{3}(lshift0 m 0) -{3}(lshift0 n 0) block_mxEul mxE eqxx !mxE. (* Why do we have to specify all these arguments? *) - case: splitP=> i' Hi'; rewrite mxE; case: splitP=> j' Hj'; rewrite ?mxE ?ord1 //. + case: splitP=> i' Hi'; rewrite mxE; case: splitP=> j' Hj'; rewrite ?mxE ?ord1 //=. by move: (negbFE (Hij (lshift m 0,j'))); rewrite -rshift1 block_mxEur !mxE. by move: (negbFE (Hij (lift 0 i',j'))); rewrite -!rshift1 block_mxEdr !mxE. + rewrite -[m.+1]/(1 + m)%N => i. - rewrite -{5}(lshift0 m 0) -{3 6}(lshift0 n 0) (block_mxEul (M 0 0)%:M _) !mxE. - by case: splitP=> i' _; rewrite row_mxEl !mxE ?ord1. + rewrite -{5}(lshift0 m 0) -{3 6}(lshift0 n 0) (block_mxEul (M 0 0)%:M _) !mxE eqxx /=. + by case: splitP=> i' _; rewrite row_mxEl !mxE // ord1. + rewrite -{3}(lshift0 m 0) -{3}(lshift0 n 0). by rewrite (block_mxEul (M 0 0)%:M (matrix.ursubmx M)) mxE dvdrr. by rewrite -HblockL unitmx_mul unitmxE (det_lblock 1 P) !det1 mulr1 unitr1. @@ -207,11 +205,11 @@ Lemma SmithP : forall (m n : nat) (M : 'M_(m,n)), smith_spec M (Smith M). Proof. elim=> [n M|m IHn]; first constructor; rewrite ?unitmx1 //. - rewrite [M]flatmx0 mulmx1 mul1mx; apply/matrixP=> i j; rewrite !mxE nth_nil. - by case: (i == j :> nat). + rewrite [M]flatmx0 mulmx1 mul1mx; apply/matrixP=> i j. + by rewrite !mxE nth_nil mul0rn. case=> [M|n M /=]; first constructor; rewrite ?sorted_nil ?mxE ?unitmx1 //. - rewrite [M]thinmx0 mulmx1 mul1mx; apply/matrixP=> i j; rewrite !mxE nth_nil. - by case: (i == j :> nat). + rewrite [M]thinmx0 mulmx1 mul1mx; apply/matrixP=> i j. + by rewrite !mxE nth_nil mul0rn. case: find_pivotP =>[[i j] HMij | H]. case: improve_pivotP; rewrite ?mxE ?tpermR ?leqnn //. rewrite -[m.+1]/(1 + m)%N -[n.+1]/(1 + n)%N => L A R0 HA Hdiv HAi0 HA00. @@ -248,8 +246,8 @@ case: find_pivotP =>[[i j] HMij | H]. by case/dvdrP:(Hdiv' k l)=> q /eqP; rewrite (negbTE (H q)). by rewrite mulmxA. rewrite Hd; apply/matrixP=> k l; rewrite !mxE. - case: (k == l :> nat); last by rewrite mulr0. - have [Hk|Hk] := (ltnP k (size d)). + case: eqP => /=; last by rewrite mulr0. + case: (ltnP k (size d)) => Hk. by rewrite (nth_map 0 _ _ Hk) mulrC. by rewrite !nth_default ?size_map ?Hk // mulr0. * have {}HA00: A 0 0 != 0. @@ -268,7 +266,7 @@ by case: (i == j :> nat); rewrite ?nth_nseq ?if_same nth_nil. Qed. (* Why is this so slow??? *) Lemma size_Smith m n (A : 'M_(m,n)) : - let: (_, d, _) := (Smith A) in (size d <= minn m n)%N. + let: (_, d, _) := Smith A in (size d <= minn m n)%N. Proof. elim: m n A=>[n'|m' Ih n']; first by rewrite min0n. case: n'=>[|n' A /=]; first by rewrite minn0. diff --git a/theory/smith_complements.v b/theory/smith_complements.v index 190f553..2663bcc 100644 --- a/theory/smith_complements.v +++ b/theory/smith_complements.v @@ -79,15 +79,15 @@ rewrite !diag_mx_seq_cons (@mulmx_block _ 1 _ 1 _ 1). by rewrite !mulmx0 !mul0mx !add0r addr0 mul1mx -scalar_mxM. Qed. -Lemma sorted_Smith n m (M: 'M[E]_(n,m)): +Lemma sorted_Smith n m (M: 'M[E]_(n,m)): sorted (@dvdr E) (Smith_seq M). -Proof. +Proof. rewrite /Smith_seq. case: (SmithP find1P find2P find_pivotP) => L0 d R0 _ H HL0 HR0. -case: d H=> // a l /= H. -have/allP Ha: all (%|%R a) l by exact: (order_path_min (@dvdr_trans _)). +case: d H=> //= a l H. +have/allP Ha: all (%|%R a) l by exact: (order_path_min (@dvdr_trans _)). rewrite path_min_sorted; [exact: (path_sorted H) | apply/allP=> x Hx]. -apply/(dvdr_trans _ (Ha x Hx))/dvdrP; exists (\det R0 * \det L0). +apply/(dvdr_trans _ (Ha x Hx))/dvdrP; exists (\det R0 * \det L0). by rewrite -invrM ?mulVKr // unitrM -!unitmxE HR0. Qed. @@ -106,15 +106,12 @@ rewrite -mulrA mulrC -(mulrA (\det M)) (mulrC (\det L0)) mulrV ?mulr1 //. by rewrite unitrM -!unitmxE HR0. Qed. -Lemma size_Smith_seq n (M: 'M[E]_n) : -\det M != 0 -> size (take n (Smith_seq M)) = n. +Lemma size_Smith_seq n (M: 'M[E]_n) : + \det M != 0 -> size (take n (Smith_seq M)) = n. Proof. -move/negbTE=> HdM0; rewrite size_take; case: ifP=> //. -move/negbT; rewrite -leqNgt leq_eqVlt; case/orP=> [/eqP -> //|]. -rewrite ltnNge=> /negbTE H. -have:= (det_Smith M). -rewrite /Smith_form det_diag_mx_seq_truncated H=> /eqP. -by rewrite eq_sym HdM0. +move=> HdM0; rewrite size_take; apply: minn_idPl. +apply: contra_neqT HdM0=>/negbTE H. +by rewrite -det_Smith /Smith_form det_diag_mx_seq_truncated H. Qed. End Specification. @@ -125,7 +122,7 @@ Import GRing.Theory. Import PolyPriField. Variable E : euclidDomainType. -Variables (s : seq E) (m n k : nat) (A : 'M[E]_(m,n)). +Variables (s : seq E) (m n k : nat) (A : 'M[E]_(m,n)). Hypothesis (Hk : (k <= minn m n)%N) (Hs: sorted %|%R s). Hypothesis (HAs : equivalent A (diag_mx_seq m n s)). @@ -134,7 +131,7 @@ Let widen_minl i := widen_ord (geq_minl m n) i. Let widen_minr i := widen_ord (geq_minr m n) i. Lemma minor_diag_mx_seq : - let l := minn m n in + let l := minn m n in forall (f g : 'I_k -> 'I_l), let f' i := widen_minl (f i) in let g' i := widen_minr (g i) in @@ -159,12 +156,12 @@ rewrite (expand_det_row _ ((p^-1)%g ord0)) big_ord_recl big1=>[|i _]. pose f2 x := f (lift ((p^-1)%g ord0) x). pose g2 x := g (lift ord0 x). have Hf2: injective f2. - by apply/(inj_comp Hf)/lift_inj. + by apply/(inj_comp Hf)/lift_inj. have Hg2: injective g2. - by apply/(inj_comp Hg)/lift_inj. + by apply/(inj_comp Hg)/lift_inj. pose f' i := widen_ord (geq_minl m n) (f2 i). pose g' i := widen_ord (geq_minr m n) (g2 i). - have ->: M = submatrix f' g' B. + have ->: M = submatrix f' g' B. by apply/matrixP=> r t; rewrite !mxE. have Hfg2: {subset codom f2 <= codom g2}. move=> x /codomP [y ->]. @@ -176,32 +173,32 @@ rewrite (expand_det_row _ ((p^-1)%g ord0)) big_ord_recl big1=>[|i _]. rewrite addr0 (bigD1 ((p^-1)%g ord0)) //= -Hfg0 permKV eqxx eqd_mull //. rewrite -[X in _ %= X]mul1r eqd_mul ?eqd1 ?unitrX ?unitrN ?unitr1 //. rewrite (eq_bigl (fun i => (p^-1)%g ord0 != i)) ?big_lift_ord /=; last first. - by move=> i /=; rewrite eq_sym. + by move=> i /=; rewrite eq_sym. exact: (IHj _ _ Hf2 Hg2 Hfg2). rewrite !mxE /= (inj_eq (@ord_inj _)) -Hfg0 (inj_eq Hg) permKV. by rewrite (negbTE (neq_lift _ _)) mul0r. Qed. -Lemma prod_minor_seq : - \prod_(i < k) s`_i = +Lemma prod_minor_seq : + \prod_(i < k) s`_i = minor [ffun x : 'I_k => widen_minl (widen_ord Hk x)] - [ffun x : 'I_k => widen_minr (widen_ord Hk x)] (diag_mx_seq m n s). + [ffun x : 'I_k => widen_minr (widen_ord Hk x)] (diag_mx_seq m n s). Proof. rewrite /minor /submatrix. elim: k Hk=>[H|j /= IHj Hj]; first by rewrite det_mx00 big_ord0. -have IH:= (ltnW Hj). +have IH:= ltnW Hj. apply: esym; rewrite (expand_det_row _ ord_max) big_ord_recr /= big1 ?add0r. rewrite /cofactor /col' /row' !mxE !ffunE !matrix_comp. rewrite eqxx exprD -expr2 sqrr_sign mul1r. set M := matrix_of_fun _ _. - have ->: M = + have ->: M = (\matrix_(i, j) (diag_mx_seq m n s) ([ffun x => widen_minl (widen_ord IH x)] i) ([ffun x => widen_minr (widen_ord IH x)] j)). apply/matrixP=> i l; rewrite !mxE !ffunE. have Hr: forall p, widen_ord Hj (lift ord_max p) = widen_ord IH p. by move=> p; apply: ord_inj=> /=; rewrite /bump leqNgt (ltn_ord p) add0n. - by rewrite !Hr. + by rewrite !Hr. by rewrite -(IHj IH) big_ord_recr /= mulrC. move=> i _; rewrite !mxE !ffunE /=. by rewrite eqn_leq leqNgt (ltn_ord i) andFb mul0r. @@ -225,19 +222,19 @@ rewrite /minor (expand_det_col _ x) big1 // => i _. by rewrite !mxE ltn_eqF ?mul0r // (leq_trans _ H). Qed. -Lemma eqd_seq_gcdr : - \prod_(i < k) s`_i %= - \big[(@gcdr E)/0]_(f : {ffun 'I_k -> 'I_m}) +Lemma eqd_seq_gcdr : + \prod_(i < k) s`_i %= + \big[(@gcdr E)/0]_(f : {ffun 'I_k -> 'I_m}) (\big[(@gcdr E)/0]_(g : {ffun 'I_k -> 'I_n}) minor f g (diag_mx_seq m n s)). Proof. apply/andP; split; last first. rewrite prod_minor_seq; set j := [ffun _ => _]. - by apply/(dvdr_trans (big_dvdr_gcdr _ j))/big_dvdr_gcdr. + by apply/(dvdr_trans (big_dvdr_gcdr _ j))/big_dvdr_gcdr. apply: big_gcdrP=> f; apply: big_gcdrP=> g. case: (injectiveb f) /injectiveP=> Hinjf; last first. by rewrite (minor_f_not_injective _ _ Hinjf) dvdr0. case: (injectiveb g) /injectiveP=> Hinjg; last first. - by rewrite (minor_g_not_injective _ _ Hinjg) dvdr0. + by rewrite (minor_g_not_injective _ _ Hinjg) dvdr0. have Hmin k1 i m1 n1 (h : 'I_k1 -> 'I_m1) : (minn m1 n1 <= h i -> n1 <= h i)%N. move=> Hhi; have := (leq_ltn_trans Hhi (ltn_ord (h i))). by rewrite gtn_min ltnn=> /ltnW/minn_idPr <-. @@ -249,48 +246,44 @@ case: (altP (@forallP _ (fun i => g i < minn m n)%N))=>[Hwg|]; last first. by rewrite (minor_eq0r _ _ Hx) dvdr0. pose f1 i := Ordinal (Hwf i). pose g1 i := Ordinal (Hwg i). -have Hinjf1 : injective f1. - by move=> x y /eqP; rewrite -(inj_eq (@ord_inj _)) /= => /eqP/ord_inj/Hinjf. -have Hinjg1 : injective g1. - by move=> x y /eqP; rewrite -(inj_eq (@ord_inj _)) /= => /eqP/ord_inj/Hinjg. -case Hcfg: (codom f1 \subset codom g1); last first. - move/negbT: Hcfg=> /subsetPn [x] /codomP [y Hy] /negP Habs. +have Hinjf1 : injective f1. + by move=> x y /eqP; rewrite -(inj_eq (@ord_inj _)) /= => /eqP/ord_inj/Hinjf. +have Hinjg1 : injective g1. + by move=> x y /eqP; rewrite -(inj_eq (@ord_inj _)) /= => /eqP/ord_inj/Hinjg. +case/boolP: (codom f1 \subset codom g1); last first. + case/subsetPn => x /codomP [y Hy] Habs. rewrite /minor (expand_det_row _ y). rewrite [\sum_(_ <_) _](big1 _ xpredT) ?dvdr0 // => j _. rewrite !mxE -[(g j : nat)]/(g1 j : nat) -[(f y : nat)]/(f1 y : nat). - have ->: (f1 y == g1 j :> nat) = false. - by apply/negbTE/eqP=> /ord_inj=> H; apply: Habs; rewrite Hy H codom_f. - by rewrite mul0r. -move/subsetP: Hcfg=> Hcfg. + suff /negbTE->: (f1 y != g1 j :> nat) by rewrite mul0r. + by apply: contraNneq Habs =>/ord_inj H; rewrite Hy H codom_f. +move/subsetP => Hcfg. pose f' i := widen_minl (f1 i). pose g' i := widen_minr (g1 i). have ->: minor f g (diag_mx_seq m n s) = minor f' g' (diag_mx_seq m n s). by apply: minor_eq=> i; apply: ord_inj. -rewrite (eqd_dvdr _ (minor_diag_mx_seq Hinjf1 Hinjg1 Hcfg)) //. +rewrite (eqd_dvdr _ (minor_diag_mx_seq Hinjf1 Hinjg1 Hcfg)) //. move: Hinjf1; clear -Hs; move: f1; clear -Hs. elim: k =>[?|j /= IHj g Hg]; first by rewrite big_ord0 dvd1r. rewrite big_ord_recr /=. -pose max:= \max_i (g i). +pose max:= \max_i (g i). have [l Hl]: {j | max = g j} by apply: eq_bigmax; rewrite card_ord. -pose p := tperm l ord_max. -set B := \prod_(_ < _) _. +pose p := tperm l ord_max. +set B := \prod_(_ < _) _. rewrite (reindex_inj (@perm_inj _ p)) /= big_ord_recr /= dvdr_mul //. - pose f := (g \o p \o (widen_ord (leqnSn j))). + pose f := g \o p \o (widen_ord (leqnSn j)). have Hf: injective f. apply: inj_comp=> [|x y /eqP]. - by apply: inj_comp=> //; exact: perm_inj. + by apply: inj_comp=> //; exact: perm_inj. by rewrite -(inj_eq (@ord_inj _)) /= => H; apply/ord_inj/eqP. - have Hi: injective [ffun x => f x]. + have Hi: injective (finfun f). by move=> x e; rewrite !ffunE; exact: Hf. set C := \prod_(_ < _) _. - have:= (IHj _ Hi). - have ->: C = \prod_i s`_([ffun x => f x] i). - by apply: eq_bigr=> i _; rewrite ffunE. - by apply. + suff ->: C = \prod_i s`_(finfun f i) by apply: IHj. + by apply: eq_bigr=> i _; rewrite ffunE. have jleg : (j <= g (p ord_max))%N. - rewrite /= tpermR; case/orP: (leq_total j (g l))=> //. - rewrite leq_eqVlt; case/orP=> [|Hgm]; first by move/eqP=> ->; rewrite leqnn. + rewrite /= tpermR; case: ltngtP => // Hgm. have Habs: forall i, (g i < j)%N. move=> i; apply: (leq_ltn_trans _ Hgm). by rewrite -Hl /k; exact: (leq_bigmax i). @@ -301,20 +294,15 @@ have jleg : (j <= g (p ord_max))%N. have: (#|'I_j.+1| <= #|'I_j|)%N. by rewrite -(card_codom Hf); exact: max_card. by rewrite !card_ord ltnn. -have [glts | ] := boolP (g (p ord_max) < size s)%N; last first. - by rewrite -leqNgt => it; rewrite (nth_default 0 it) dvdr0. -apply: sorted_leq_nth. - + exact: dvdr_trans. - + exact: dvdrr. - + exact: Hs. - + by rewrite inE (leq_ltn_trans _ glts). - + by rewrite inE. - + by []. +have [glts | sleg] := ltnP (g (p ord_max)) (size s); last first. + by rewrite (nth_default 0 sleg); exact: dvdr0. +apply: sorted_leq_nth=>//; first exact: dvdr_trans. +by rewrite inE; apply/leq_ltn_trans/glts. Qed. -Lemma Smith_gcdr_spec : - \prod_(i < k) s`_i %= - \big[(@gcdr E)/0]_(f : {ffun 'I_k -> 'I_m}) +Lemma Smith_gcdr_spec : + \prod_(i < k) s`_i %= + \big[(@gcdr E)/0]_(f : {ffun 'I_k -> 'I_m}) (\big[(@gcdr E)/0]_(g : {ffun 'I_k -> 'I_n}) minor f g A) . Proof. rewrite (eqd_ltrans eqd_seq_gcdr). @@ -325,10 +313,10 @@ rewrite conform_mx_id in Hseq. have HdivmA p q k1 (B C : 'M[E]_(p,q)) (M1 : 'M_p) (N1 : 'M_q) : forall (H : M1 *m C *m N1 = B), forall (f : 'I_k1 -> 'I_p) (g : 'I_k1 -> 'I_q), - \big[(@gcdr E)/0]_(f0 : {ffun 'I_k1 -> _}) + \big[(@gcdr E)/0]_(f0 : {ffun 'I_k1 -> _}) \big[(@gcdr E)/0]_(g0 : {ffun 'I_k1 -> _}) minor f0 g0 C %| minor f g B. - move=> H f g. + move=> H f g. have HBC: minor f g B = \sum_(f0 : {ffun _ -> _ } | strictf f0) ((\sum_(g0 : {ffun _ -> _ } | strictf g0) (minor id g0 (submatrix f id M1) * minor g0 f0 C)) * @@ -339,7 +327,7 @@ have HdivmA p q k1 (B C : 'M[E]_(p,q)) (M1 : 'M_p) (N1 : 'M_q) : by apply: eq_bigr=> j _; rewrite /minor !sub_submatrix. rewrite HBC; apply: big_dvdr=> h; rewrite dvdr_mulr //. apply: big_dvdr=> j; rewrite dvdr_mull //. - by apply: (dvdr_trans (big_dvdr_gcdr _ j)); apply: big_dvdr_gcdr. + by apply: (dvdr_trans (big_dvdr_gcdr _ j)); apply: big_dvdr_gcdr. apply/andP; split; apply: big_gcdrP=> f; apply: big_gcdrP=> g. exact: (HdivmA _ _ _ _ _ _ _ Hseq). exact: (HdivmA _ _ _ _ _ _ _ Heqs). @@ -357,49 +345,47 @@ Lemma Smith_unicity n (A : 'M[E]_n) (s : seq E) : sorted %|%R s -> equivalent A (diag_mx_seq n n s) -> forall i, (i < n)%N -> s`_i %= (Smith_seq A)`_i. Proof. -move=> Hs HAs i. +move=> Hs HAs i. have Hsmt := sorted_Smith A. have HAsmt := equiv_Smith A. elim: i {-2}i (leqnn i)=>[i|i IHi j Hji]. rewrite leqn0 -[X in (i < X)%N]minnn=> /eqP -> Hi. - have:= (Smith_gcdr_spec Hi Hs HAs). - have:= (Smith_gcdr_spec Hi Hsmt HAsmt). + move: (Smith_gcdr_spec Hi Hs HAs). + move: (Smith_gcdr_spec Hi Hsmt HAsmt). rewrite !big_ord_recl !big_ord0 !mulr1 eqd_sym => H1 H2. exact: (eqd_trans H2 H1). rewrite -[X in (j < X)%N]minnn=> Hj. -have:= (Smith_gcdr_spec Hj Hs HAs). -have:= (Smith_gcdr_spec Hj Hsmt HAsmt). +move: (Smith_gcdr_spec Hj Hs HAs). +move: (Smith_gcdr_spec Hj Hsmt HAsmt). rewrite !big_ord_recr /= eqd_sym => H1 H2. -have {H1 H2} H3:= (eqd_trans H2 H1). +have {H1 H2} H3:= eqd_trans H2 H1. have H1: \prod_(i < j) s`_i %= \prod_(i < j) (Smith_seq A)`_i. rewrite minnn in Hj. apply: eqd_big_mul=> k _; apply: IHi. exact: (leq_trans (ltn_ord k) Hji). exact: (ltn_trans _ Hj). -case: (altP (\prod_(i < j) s`_i =P 0))=> H0; last first. +case: (eqVneq (\prod_(i < j) s`_i) 0) => H0; last first. by rewrite -(eqd_mul2l _ _ H0) (eqd_rtrans (eqd_mulr _ H1)). have/prodf_eq0 [k _ /eqP Hk]: (\prod_(i < j) (Smith_seq A)`_i == 0). by rewrite H0 eqd0r in H1. case/eqP/prodf_eq0: H0 => l _ /eqP Hl. have sj0 : s`_j == 0. - have [ jlts | ] := boolP(j < size s)%N; last first. - by rewrite -leqNgt => it; rewrite (nth_default 0 it). + have [ jlts | slej ] := ltnP j (size s); last first. + by rewrite (nth_default 0 slej). rewrite -dvd0r -{1}Hl. apply: sorted_leq_nth => //. - + exact: dvdr_trans. - + by rewrite inE (ltn_trans _ jlts) //; case: l. - + by case: l {Hl}=> l llt /=; rewrite ltnW. + + exact: dvdr_trans. + + by rewrite inE (ltn_trans _ jlts). + + exact: ltnW. have smsj0 : (Smith_seq A)`_j == 0. - have [ jlts | ] := boolP(j < size (Smith_seq A))%N; last first. - by rewrite -leqNgt => it; rewrite (nth_default 0 it). + have [ jlts | slej ] := ltnP j (size (Smith_seq A)); last first. + by rewrite (nth_default 0 slej). rewrite -dvd0r -{1}Hk. apply: sorted_leq_nth => //. - + exact: dvdr_trans. - + by rewrite inE (ltn_trans _ jlts) //; case: l. - + by case: l {Hl}=> l llt /=; rewrite ltnW. + + exact: dvdr_trans. + + by rewrite inE (ltn_trans _ jlts). + + exact: ltnW. by rewrite (eqP sj0) (eqP smsj0). Qed. End Unicity. - - diff --git a/theory/smithpid.v b/theory/smithpid.v index 0bc394f..f56fea2 100644 --- a/theory/smithpid.v +++ b/theory/smithpid.v @@ -234,12 +234,14 @@ Qed. Lemma SmithP : forall (m n : nat) (M : 'M_(m,n)), smith_spec M (Smith M). Proof. -elim=> [n M|m IHn]; first constructor; rewrite ?unitmx1 //. - rewrite [M]flatmx0 mulmx1 mul1mx; apply/matrixP=> i j; rewrite !mxE nth_nil. - by case: (i == j :> nat). -case=> [M|n M /=]; first constructor; rewrite ?sorted_nil ?mxE ?unitmx1 //. - rewrite [M]thinmx0 mulmx1 mul1mx; apply/matrixP=> i j; rewrite !mxE nth_nil. - by case: (i == j :> nat). +elim=> [n M|m IHn]. + constructor=> //; try by exact: unitmx1. + rewrite [M]flatmx0 mulmx1 mul1mx; apply/matrixP => i j. + by rewrite !mxE nth_nil mul0rn. +case=> [M|n M /=]. + constructor=> //; try by exact: unitmx1. + rewrite [M]thinmx0 mulmx1 mul1mx; apply/matrixP => i j. + by rewrite !mxE nth_nil mul0rn. case: find_pivotP =>[[i j] HMij | H]. case: improve_pivotP; rewrite ?mxE ?tpermR ?leqnn //. rewrite -[m.+1]/(1 + m)%N -[n.+1]/(1 + n)%N => L B Q0 HB Hdiv HAi0 HA00. @@ -267,19 +269,19 @@ case: find_pivotP =>[[i j] HMij | H]. (* down-right submatrix *) + rewrite mulmxN !mulNmx -mulmxA Hu addNr mul0mx add0r addrC -mulmxA -mulmxBr. transitivity (B 0 0 *: (L' *m A' *m Q')). - rewrite -[_ *m A' *m _]mulmxA scalemxAr scalemxAl. - have Hdiv' : forall i j, B 0 0 %| (matrix.drsubmx B - matrix.const_mx 1 *m matrix.ursubmx B) i j. - by move=> k l; rewrite !mxE big_ord1 !mxE mul1r dvdr_sub ?Hdiv. - have -> : B 0 0 *: A' = matrix.drsubmx B - matrix.const_mx 1 *m matrix.ursubmx B. - apply/matrixP=> k l; rewrite 2!mxE. - case: odivrP=>[x ->|H]; first by rewrite mulrC. - by case/dvdrP:(Hdiv' k l)=> q /eqP; rewrite (negbTE (H q)). - by rewrite mulmxA. - rewrite Hd; apply/matrixP=> k l; rewrite !mxE. - case: (k == l :> nat); last by rewrite mulr0. - have [Hk|Hk] := (ltnP k (size d)). - by rewrite (nth_map 0 _ _ Hk) mulrC. - by rewrite !nth_default ?size_map ?Hk // mulr0. + rewrite -[_ *m A' *m _]mulmxA scalemxAr scalemxAl. + have Hdiv' : forall i j, B 0 0 %| (matrix.drsubmx B - matrix.const_mx 1 *m matrix.ursubmx B) i j. + by move=> k l; rewrite !mxE big_ord1 !mxE mul1r dvdr_sub ?Hdiv. + have -> : B 0 0 *: A' = matrix.drsubmx B - matrix.const_mx 1 *m matrix.ursubmx B. + apply/matrixP => k l; rewrite 2!mxE. + case: odivrP => [x ->|H]; first by rewrite mulrC. + by case/dvdrP:(Hdiv' k l)=> q /eqP; rewrite (negbTE (H q)). + by rewrite mulmxA. + rewrite Hd; apply/matrixP=> k l; rewrite !mxE. + case: eqP => /=; last by rewrite mulr0. + case: (ltnP k (size d)) => /= Hk. + by rewrite (nth_map 0 _ _ Hk) mulrC. + by rewrite !nth_default ?size_map ?Hk // mulr0. * have {}HA00: B 0 0 != 0. by apply/eqP=> H; move:HA00; rewrite H dvd0r (negbTE HMij). rewrite /= path_min_sorted; diff --git a/theory/ssrcomplements.v b/theory/ssrcomplements.v index 1caf00e..632ca5e 100644 --- a/theory/ssrcomplements.v +++ b/theory/ssrcomplements.v @@ -84,7 +84,7 @@ Variable T : eqType. Open Scope ring_scope. -(*** This lemma is usefull to prove that \mu_x p = count (xpred1 x) s where +(*** This lemma is usefull to prove that \mu_x p = count_mem x s where s is the sequence of roots of polynomial p ***) Lemma prod_seq_count (s : seq T) (F : T -> R) : \prod_(i <- s) F i = @@ -103,8 +103,8 @@ have ->: \big[*%R/1]_(i <- r) (F i) ^+ (a == i) = F a. rewrite (bigD1_seq _ aundl (undup_uniq l)) /= eqxx big1 ?mulr1 //. by move=> i /negbTE neqai; rewrite eq_sym neqai. rewrite big_cons eqxx big1_seq ?mulr1 // => i /= iundl. - case eqai: (a == i)=> //. - by rewrite (eqP eqai) -mem_undup iundl in notal. + case: (eqVneq a i) => //= eqai. + by rewrite eqai -mem_undup iundl in notal. rewrite /r; case: ifP=> // /negbT notal. rewrite big_cons. have->: count (xpred1 a) l = 0%N. @@ -223,7 +223,7 @@ move=> Hu. have Hu2: (block_mx Aul 0 0 Adr) \is a GRing.unit by []. rewrite unitmxE det_ublock unitrM in Hu. case/andP: Hu; rewrite -!unitmxE => HAul HAur. -have H: block_mx Aul 0 0 Adr * block_mx Aul^-1 0 0 Adr^-1 = 1. +have H: block_mx Aul 0 0 Adr * block_mx Aul^-1 0 0 Adr^-1 = 1. rewrite /GRing.mul /= (mulmx_block Aul _ _ _ Aul^-1) !mulmxV //. by rewrite !mul0mx !mulmx0 !add0r addr0 -scalar_mx_block. by apply: (mulrI Hu2); rewrite H mulrV. @@ -244,7 +244,7 @@ Lemma coprimep_factor (a b : R) : (b - a)%R \is a GRing.unit -> coprimep ('X - a%:P) ('X - b%:P). Proof. move=> Hab; apply/Bezout_coprimepP. -exists ((b - a)^-1%:P , -(b - a) ^-1%:P). +exists ((b - a)^-1%:P, -(b - a) ^-1%:P). rewrite /= !mulrBr !mulNr opprK -!addrA (addrC (- _)) !addrA addrN. by rewrite add0r -mulrBr -rmorphB -rmorphM mulVr // eqpxx. Qed. @@ -309,12 +309,12 @@ by rewrite -eq_f11 inj_eq. Qed. Definition redivp_l (p q : {poly R}) : nat * {poly R} * {poly R} := - let:(d,q,p) := (redivp (phi p) (phi q)) in + let:(d,q,p) := redivp (phi p) (phi q) in (d, phi_inv q, phi_inv p). -Definition rdivp_l p q := ((redivp_l p q).1).2. +Definition rdivp_l p q := (redivp_l p q).1.2. Definition rmodp_l p q := (redivp_l p q).2. -Definition rscalp_l p q := ((redivp_l p q).1).1. +Definition rscalp_l p q := (redivp_l p q).1.1. Definition rdvdp_l p q := rmodp_l q p == 0. Definition rmultp_l := [rel m d | rdvdp_l d m]. diff --git a/theory/strassen.v b/theory/strassen.v index 575f546..956701f 100644 --- a/theory/strassen.v +++ b/theory/strassen.v @@ -81,7 +81,7 @@ Definition Strassen_xO {p : positive} Strassen_p := let A := castmx (addpp p,addpp p) A in let B := castmx (addpp p,addpp p) B in castmx (esym (addpp p), esym (addpp p)) (Strassen_step A B Strassen_p). - + Definition Strassen_xI {p : positive} Strassen_p := fun M N => if p <= K then M *m N else @@ -101,9 +101,9 @@ Definition Strassen_xI {p : positive} Strassen_p := let R22 := (M21 *m N12) + (Strassen_step M22 N22 Strassen_p) in castmx (esym (add1pp p), esym (add1pp p)) (block_mx R11 R12 R21 R22). -Definition Strassen := - (positive_rect (fun p => ('M_(p, p) -> 'M_(p, p) -> 'M_(p, p))) - (@Strassen_xI) (@Strassen_xO) (fun M N => M *m N)). +Definition Strassen := + positive_rect (fun p => ('M_(p, p) -> 'M_(p, p) -> 'M_(p, p))) + (@Strassen_xI) (@Strassen_xO) (fun M N => M *m N). Lemma Strassen_stepP (p : positive) (A B : 'M[R]_(p + p)) f : @@ -117,7 +117,7 @@ Qed. Lemma mulmx_cast {R' : ringType} {m n p m' n' p'} {M:'M[R']_(m,p)} {N:'M_(p,n)} {eqm : m = m'} (eqp : p = p') {eqn : n = n'} : matrix.castmx (eqm,eqn) (M *m N) = matrix.castmx (eqm,eqp) M *m matrix.castmx (eqp,eqn) N. -Proof. by case eqm ; case eqn ; case eqp. Qed. +Proof. by case eqm; case eqn; case eqp. Qed. Lemma StrassenP p : mulmx =2 (Strassen (p := p)). Proof. diff --git a/theory/stronglydiscrete.v b/theory/stronglydiscrete.v index 68f2d6c..32c4b84 100644 --- a/theory/stronglydiscrete.v +++ b/theory/stronglydiscrete.v @@ -109,9 +109,8 @@ Proof. by case: R => [? [? []]]. Qed. Lemma memberP n (x : R) (I : 'cV[R]_n) : reflect (exists J, x%:M = J *m I) (member x I). Proof. -case: member_specP=> /= [J ->|h]; first by apply: ReflectT; exists J. -apply: ReflectF=> [[J hJ]]. -by move: (h J); rewrite hJ eqxx. +case: member_specP => /= [J ->|h]; constructor; first by exists J. +by case=> J hJ; move: (h J); rewrite hJ eqxx. Qed. (** Ideal theory of strongly discrete rings *) @@ -209,7 +208,7 @@ Remark subid_memberP m n (I : 'cV[R]_m) (J : 'cV[R]_n) : Proof. apply: (iffP idP); first by move=> leIJ i; rewrite !memberE => /subid_trans ->. move=> HIJ; apply/subid_colP => i. -by have := (HIJ (I i 0)); rewrite !memberE; apply. +by move: (HIJ (I i 0)); rewrite !memberE; apply. Qed. (** Theory of subid and eqid *) @@ -464,17 +463,17 @@ case: splitP => j hj. case/enum_rank_inj => -> ->. by rewrite mxE mxvecE !mxE big_ord_recl big_ord0 addr0 !mxE. case/mxvec_indexP : ij hij => a b /= hab. - have : ~ (enum_rank (i,j) < (m * n)%nat) - by rewrite hab -{2}[(m * n)%nat]addn0 ltn_add2l ltn0. - case. + have : m * n <= enum_rank (i, j). + by rewrite hab -{1}[(m * n)%nat]addn0 leq_add2l. + rewrite leqNgt => /negP; case. by apply (leq_trans (ltn_ord _)); rewrite /= eq_card_prod // !card_ord. exists (rshift (m*n)%nat (mxvec_index i j)). rewrite !mxE. case: splitP => ij /= hij. case/mxvec_indexP : ij hij => a b /= hab. - have : ~ (enum_rank (a,b) < (m * n)%nat) - by rewrite -hab -{2}[(m * n)%nat]addn0 ltn_add2l ltn0. - case. + have : m * n <= enum_rank (a, b) + by rewrite -hab -{1}[(m * n)%nat]addn0 leq_add2l. + rewrite leqNgt => /negP; case. by apply (leq_trans (ltn_ord _)); rewrite /= eq_card_prod // !card_ord. case/mxvec_indexP : ij hij => a b /= hab. have : enum_rank (i,j) = enum_rank (a,b). @@ -682,10 +681,8 @@ Section BezoutStronglyDiscrete. Variable R : bezoutDomainType. -Definition bmember n (x : R) (I : 'cV[R]_n) := match x %/? principal_gen I with - | Some a => Some (a %:M *m principal_w1 I) - | None => None -end. +Definition bmember n (x : R) (I : 'cV[R]_n) := + omap (fun a => a %:M *m principal_w1 I) (x %/? principal_gen I). Lemma bmember_correct : forall n (x : R) (I : 'cV[R]_n), member_spec x I (bmember x I). @@ -695,8 +692,7 @@ case: odivrP => [a | ] Ha /=; constructor. by rewrite -mulmxA principal_w1_correct Ha scalar_mxM. move => J. rewrite -(principal_w2_correct I) /principal mulmxA scalar_mxC. -move: (Ha ((J *m principal_w2 I) 0 0)). -apply/contra. +apply: contra (Ha ((J *m principal_w2 I) 0 0)). rewrite {1}[J *m principal_w2 I]mx11_scalar -scalar_mxM. move/eqP/matrixP => /(_ 0 0). rewrite !mxE /= !mulr1n => ->. diff --git a/theory/toomcook.v b/theory/toomcook.v index 75f7176..051bf99 100644 --- a/theory/toomcook.v +++ b/theory/toomcook.v @@ -17,7 +17,7 @@ Variable R : ringType. Implicit Types p : {poly R}. (* Split a polynomial into n pieces of size b *) -Definition split_poly n b p := +Definition split_poly n b p := \poly_(i < n) \poly_(j < b) p`_(i * b + j). Lemma recompose_split : forall n b p, size p <= b * n -> @@ -25,7 +25,7 @@ Lemma recompose_split : forall n b p, size p <= b * n -> Proof. rewrite /split_poly => [[b p|n b p hs]]; rewrite horner_poly ?big_ord_recr /=. by rewrite muln0 leqn0 size_poly_eq0 => /eqP ->; rewrite big_ord0. -suff -> : \big[+%R/0]_(i < n) (\poly_(j < b) p`_(i * b + j) * 'X^b ^+ i) = +suff -> : \big[+%R/0]_(i < n) (\poly_(j < b) p`_(i * b + j) * 'X^b ^+ i) = \poly_(i < n * b) p`_i. apply/polyP=> i; rewrite -exprM coefD coefMXn coef_poly mulnC. have [_|hbni] := ltnP; rewrite ?addr0 // add0r coef_poly. @@ -33,7 +33,7 @@ suff -> : \big[+%R/0]_(i < n) (\poly_(j < b) p`_(i * b + j) * 'X^b ^+ i) = rewrite -ltnS -subSn // ltn_subRL ltnS addnC -mulnS in hsub. exact: (leq_trans hs hsub). elim: n {hs} => [|n ih]; first by rewrite mul0n poly_def !big_ord0. -apply/polyP=> i. +apply/polyP=> i. rewrite big_ord_recr /= ih -exprM coefD !coef_poly coefMXn mulSn mulnC. have [h1|hbni] := ltnP; first by rewrite addr0 (ltn_addl b h1). by rewrite add0r coef_poly subnKC // -(ltn_add2r (b * n)) subnK. @@ -62,7 +62,7 @@ Definition vandmx m : 'M[{poly R}]_(m,d) := Definition evaluate p := poly_rV p *m vandmx (size p). Lemma evaluateE p : evaluate p = \row_(i < d) p.[points`_i]. -Proof. +Proof. apply/rowP => i; rewrite !mxE horner_coef /=. by apply: eq_big => // j _; rewrite !mxE. Qed. @@ -73,17 +73,16 @@ Definition interpolate (p : 'rV[{poly R}]_d) := rVpoly (p *m invmx (vandmx d)). (* TODO: Express using determinant? *) Hypothesis hU : vandmx d \in unitmx. -Lemma interpolateE (p : {poly {poly R}}) : size p <= d -> +Lemma interpolateE (p : {poly {poly R}}) : size p <= d -> interpolate (\row_i p.[points`_i]) = p. Proof. rewrite /interpolate => hsp; rewrite -[RHS](poly_rV_K hsp); congr rVpoly. -apply/(canLR (mulmxK hU))/rowP=> i; rewrite !mxE (horner_coef_wide _ hsp). +apply/(canLR (mulmxK hU))/rowP=> i; rewrite !mxE (horner_coef_wide _ hsp). by apply: eq_bigr=> j _ ; rewrite !mxE. Qed. -Fixpoint toom_rec m p q : {poly R} := match m with - | 0 => p * q - | m'.+1 => (* if (size p <= 2) || (size q <= 2) then p * q else *) +Fixpoint toom_rec m p q : {poly R} := + if m is m'.+1 then (* if (size p <= 2) || (size q <= 2) then p * q else *) let: b := (maxn (divn (size p) n) (divn (size q) n)).+1 in let: sp := split_poly n b p in let: sq := split_poly n b q in @@ -92,15 +91,15 @@ Fixpoint toom_rec m p q : {poly R} := match m with let: r := \row_i (toom_rec m' (ep 0 i) (eq 0 i)) in let: w := interpolate r in w.['X^b] - end. + else p * q. Definition toom_cook (p q : {poly R}) := if 0 < n then toom_rec (maxn (size p) (size q)) p q else p * q. -Lemma basisE (p q : {poly R}) : 0 < n -> +Lemma basisE (p q : {poly R}) : 0 < n -> size p <= (maxn (size p %/ n) (size q %/ n)).+1 * n. Proof. -move=> Hn0; move: (leq_maxl (size p %/ n).+1 (size q %/ n).+1). +move=> Hn0; move: (leq_maxl (size p %/ n).+1 (size q %/ n).+1). by rewrite -(leq_pmul2r Hn0) maxnSS; apply/leq_trans/ltnW; rewrite ltn_ceil. Qed.