Skip to content

Commit f9a8968

Browse files
committed
backport ssralg and poly
1 parent 80b9812 commit f9a8968

File tree

1 file changed

+85
-191
lines changed

1 file changed

+85
-191
lines changed

theories/xmathcomp/various.v

+85-191
Original file line numberDiff line numberDiff line change
@@ -110,28 +110,35 @@ Qed.
110110
(* package algebra *)
111111
(*******************)
112112

113-
Import GRing.Theory.
114-
Local Open Scope ring_scope.
115-
Notation has_char0 L := ([char L] =i pred0).
116-
117113
(**********)
118-
(* ssralg *)
114+
(* ssrint *)
119115
(**********)
120116

121-
Lemma iter_addr (V : zmodType) n x y : iter n (+%R x) y = x *+ n + y :> V.
122-
Proof. by elim: n => [|n ih]; rewrite ?add0r //= ih mulrS addrA. Qed.
123-
124-
Lemma prodrMl {R : comRingType} {I : finType} (A : pred I) (x : R) F :
125-
\prod_(i in A) (x * F i) = x ^+ #|A| * \prod_(i in A) F i.
117+
Lemma dvdz_charf (R : ringType) (p : nat) :
118+
p \in [char R] -> forall n : int, (p %| n)%Z = (n%:~R == 0 :> R).
126119
Proof.
127-
rewrite -sum1_card; elim/big_rec3: _; first by rewrite expr0 mulr1.
128-
by move=> i y p z iA ->; rewrite mulrACA exprS.
120+
move=> charRp [] n; rewrite [LHS](dvdn_charf charRp)//.
121+
by rewrite NegzE abszN rmorphN// oppr_eq0.
129122
Qed.
130123

131-
Lemma expr_sum {R : ringType} {T : Type} (x : R) (F : T -> nat) P s :
132-
x ^+ (\sum_(i <- s | P i) F i) = \prod_(i <- s | P i) x ^+ (F i).
133-
Proof. by apply: big_morph; [exact: exprD | exact: expr0]. Qed.
124+
(********)
125+
(* poly *)
126+
(********)
127+
128+
Local Notation "p ^^ f" := (map_poly f p)
129+
(at level 30, f at level 30, format "p ^^ f").
134130

131+
#[deprecated(since="mathcomp 2.2.0",note="Use polyOverXsubC instead.")]
132+
Lemma poly_XsubC_over {R : ringType} c (S : {pred R}) (addS : subringPred S)
133+
(kS : keyed_pred addS): c \in kS -> 'X - c%:P \is a polyOver kS.
134+
Proof. by move=> cS; rewrite rpredB ?polyOverC ?polyOverX. Qed.
135+
136+
#[deprecated(since="mathcomp 2.2.0",note="Use polyOverXnsubC instead.")]
137+
Lemma poly_XnsubC_over {R : ringType} n c (S : {pred R}) (addS : subringPred S)
138+
(kS : keyed_pred addS): c \in kS -> 'X^n - c%:P \is a polyOver kS.
139+
Proof. by move=> cS; rewrite rpredB ?rpredX ?polyOverX ?polyOverC. Qed.
140+
141+
#[deprecated(since="mathcomp 2.2.0",note="Use prim_root_natf_eq0 instead.")]
135142
Lemma prim_root_natf_neq0 (F : fieldType) n (w : F) :
136143
n.-primitive_root w -> (n%:R != 0 :> F).
137144
Proof.
@@ -150,125 +157,85 @@ rewrite pfactor_dvdn// ltn_geF// -[k]muln1 logn_Gauss ?logn1//.
150157
by rewrite logn_gt0 mem_primes p_prime dvdpn n_gt0.
151158
Qed.
152159

153-
(**********)
154-
(* ssrnum *)
155-
(**********)
156-
157-
Section ssrnum.
158-
Import Num.Theory.
159-
160-
Lemma CrealJ (C : numClosedFieldType) :
161-
{mono (@conjC C) : x / x \is Num.real}.
160+
#[deprecated(since="mathcomp 2.2.0",note="Use prim_root_eq0 instead.")]
161+
Lemma primitive_root_eq0 (F : fieldType) n (w : F) :
162+
n.-primitive_root w -> (w == 0) = (n == 0%N).
162163
Proof.
163-
suff realK : {homo (@conjC C) : x / x \is Num.real}.
164-
by move=> x; apply/idP/idP => /realK//; rewrite conjCK.
165-
by move=> x xreal; rewrite conj_Creal.
164+
move=> wp; apply/eqP/idP => [w0|/eqP p0]; move: wp; rewrite ?w0 ?p0; last first.
165+
by move=> /prim_order_gt0//.
166+
move=> /prim_expr_order/esym/eqP.
167+
by rewrite expr0n; case: (n =P 0%N); rewrite ?oner_eq0.
166168
Qed.
167-
End ssrnum.
168169

169170
(**********)
170-
(* ssrint *)
171+
(* intdiv *)
171172
(**********)
172173

173-
Lemma dvdz_charf (R : ringType) (p : nat) :
174-
p \in [char R] -> forall n : int, (p %| n)%Z = (n%:~R == 0 :> R).
174+
Lemma eisenstein (p : nat) (q : {poly int}) : prime p -> (size q != 1)%N ->
175+
(~~ (p %| lead_coef q))%Z -> (~~ ((p : int) ^+ 2 %| q`_0))%Z ->
176+
(forall i, (i < (size q).-1)%N -> p %| q`_i)%Z ->
177+
irreducible_poly (map_poly (intr : int -> rat) q).
175178
Proof.
176-
move=> charRp [] n; rewrite [LHS](dvdn_charf charRp)//.
177-
by rewrite NegzE abszN rmorphN// oppr_eq0.
179+
move=> p_prime qN1 Ndvd_pql Ndvd_pq0 dvd_pq.
180+
have qN0 : q != 0 by rewrite -lead_coef_eq0; apply: contraNneq Ndvd_pql => ->.
181+
split.
182+
rewrite size_map_poly_id0 ?intr_eq0 ?lead_coef_eq0//.
183+
by rewrite ltn_neqAle eq_sym qN1 size_poly_gt0.
184+
move=> f' +/dvdpP_rat_int[f [d dN0 feq]]; rewrite {f'}feq size_scale// => fN1.
185+
move=> /= [g q_eq]; rewrite q_eq (eqp_trans (eqp_scale _ _))//.
186+
have fN0 : f != 0 by apply: contra_neq qN0; rewrite q_eq => ->; rewrite mul0r.
187+
have gN0 : g != 0 by apply: contra_neq qN0; rewrite q_eq => ->; rewrite mulr0.
188+
rewrite size_map_poly_id0 ?intr_eq0 ?lead_coef_eq0// in fN1.
189+
have [/eqP/size_poly1P[c cN0 ->]|gN1] := eqVneq (size g) 1%N.
190+
by rewrite mulrC mul_polyC map_polyZ/= eqp_sym eqp_scale// intr_eq0.
191+
have c_neq0 : (lead_coef q)%:~R != 0 :> 'F_p
192+
by rewrite -(dvdz_charf (char_Fp _)).
193+
have : map_poly (intr : int -> 'F_p) q = (lead_coef q)%:~R *: 'X^(size q).-1.
194+
apply/val_inj/(@eq_from_nth _ 0) => [|i]; rewrite size_map_poly_id0//.
195+
by rewrite size_scale// size_polyXn -polySpred.
196+
move=> i_small; rewrite coef_poly i_small coefZ coefXn lead_coefE.
197+
move: i_small; rewrite polySpred// ltnS/=.
198+
case: ltngtP => // [i_lt|->]; rewrite (mulr1, mulr0)//= => _.
199+
by apply/eqP; rewrite -(dvdz_charf (char_Fp _))// dvd_pq.
200+
rewrite [in LHS]q_eq rmorphM/=.
201+
set c := (X in X *: _); set n := (_.-1).
202+
set pf := map_poly _ f; set pg := map_poly _ g => pfMpg.
203+
have dvdXn (r : {poly _}) : size r != 1%N -> r %| c *: 'X^n -> r`_0 = 0.
204+
move=> rN1; rewrite (eqp_dvdr _ (eqp_scale _ _))//.
205+
rewrite -['X]subr0; move=> /dvdp_exp_XsubC[k lekn]; rewrite subr0.
206+
move=> /eqpP[u /andP[u1N0 u2N0]]; have [->|k_gt0] := posnP k.
207+
move=> /(congr1 (size \o val))/eqP.
208+
by rewrite /= !size_scale// size_polyXn (negPf rN1).
209+
move=> /(congr1 (fun p : {poly _} => p`_0))/eqP.
210+
by rewrite !coefZ coefXn ltn_eqF// mulr0 mulf_eq0 (negPf u1N0) => /eqP.
211+
suff : ((p : int) ^+ 2 %| q`_0)%Z by rewrite (negPf Ndvd_pq0).
212+
have := c_neq0; rewrite q_eq coefM big_ord1.
213+
rewrite lead_coefM rmorphM mulf_eq0 negb_or => /andP[lpfN0 qfN0].
214+
have pfN1 : size pf != 1%N by rewrite size_map_poly_id0.
215+
have pgN1 : size pg != 1%N by rewrite size_map_poly_id0.
216+
have /(dvdXn _ pgN1) /eqP : pg %| c *: 'X^n by rewrite -pfMpg dvdp_mull.
217+
have /(dvdXn _ pfN1) /eqP : pf %| c *: 'X^n by rewrite -pfMpg dvdp_mulr.
218+
by rewrite !coef_map// -!(dvdz_charf (char_Fp _))//; apply: dvdz_mul.
178219
Qed.
179220

180-
(********)
181-
(* poly *)
182-
(********)
183-
184-
Local Notation "p ^^ f" := (map_poly f p)
185-
(at level 30, f at level 30, format "p ^^ f").
186-
221+
(***********)
222+
(* polydiv *)
223+
(***********)
187224
Lemma irredp_XaddC (F : fieldType) (x : F) : irreducible_poly ('X + x%:P).
188225
Proof. by rewrite -[x]opprK rmorphN; apply: irredp_XsubC. Qed.
189226

190-
Lemma lead_coef_XnsubC {R : ringType} n (c : R) : (0 < n)%N ->
191-
lead_coef ('X^n - c%:P) = 1.
192-
Proof.
193-
move=> gt0_n; rewrite lead_coefDl ?lead_coefXn //.
194-
by rewrite size_opp size_polyC size_polyXn ltnS (leq_trans (leq_b1 _)).
195-
Qed.
196-
197-
Lemma lead_coef_XsubC {R : ringType} (c : R) :
198-
lead_coef ('X - c%:P) = 1.
199-
Proof. by apply: (@lead_coef_XnsubC _ 1%N). Qed.
200-
201-
Lemma monic_XsubC {R : ringType} (c : R) : 'X - c%:P \is monic.
202-
Proof. by rewrite monicE lead_coef_XsubC. Qed.
203-
204-
Lemma monic_XnsubC {R : ringType} n (c : R) : (0 < n)%N -> 'X^n - c%:P \is monic.
205-
Proof. by move=> gt0_n; rewrite monicE lead_coef_XnsubC. Qed.
206-
207-
Lemma size_XnsubC {R : ringType} n (c : R) : (0 < n)%N -> size ('X^n - c%:P) = n.+1.
208-
Proof.
209-
move=> gt0_n; rewrite size_addl ?size_polyXn //.
210-
by rewrite size_opp size_polyC; case: (c =P 0).
211-
Qed.
212-
213-
Lemma map_polyXsubC (aR rR : ringType) (f : {rmorphism aR -> rR}) x :
214-
map_poly f ('X - x%:P) = 'X - (f x)%:P.
215-
Proof. by rewrite rmorphB/= map_polyX map_polyC. Qed.
216-
217-
Lemma poly_XsubC_over {R : ringType} c (S : {pred R}) (addS : subringPred S)
218-
(kS : keyed_pred addS): c \in kS -> 'X - c%:P \is a polyOver kS.
219-
Proof. by move=> cS; rewrite rpredB ?polyOverC ?polyOverX. Qed.
220-
221-
Lemma poly_XnsubC_over {R : ringType} n c (S : {pred R}) (addS : subringPred S)
222-
(kS : keyed_pred addS): c \in kS -> 'X^n - c%:P \is a polyOver kS.
223-
Proof. by move=> cS; rewrite rpredB ?rpredX ?polyOverX ?polyOverC. Qed.
224-
225-
Lemma lead_coef_prod {R : idomainType} (ps : seq {poly R}) :
226-
lead_coef (\prod_(p <- ps) p) = \prod_(p <- ps) lead_coef p.
227-
Proof. by apply/big_morph/lead_coef1; apply: lead_coefM. Qed.
228-
229-
Lemma lead_coef_prod_XsubC {R : idomainType} (cs : seq R) :
230-
lead_coef (\prod_(c <- cs) ('X - c%:P)) = 1.
231-
Proof.
232-
rewrite -(big_map (fun c : R => 'X - c%:P) xpredT idfun) /=.
233-
rewrite lead_coef_prod big_seq (eq_bigr (fun=> 1)) ?big1 //=.
234-
by move=> i /mapP[c _ ->]; apply: lead_coef_XsubC.
235-
Qed.
236-
237-
Lemma coef0M {R : ringType} (p q : {poly R}) : (p * q)`_0 = p`_0 * q`_0.
238-
Proof. by rewrite coefM big_ord1. Qed.
239-
240-
Lemma coef0_prod {R : ringType} {T : Type} (ps : seq T) (F : T -> {poly R}) P :
241-
(\prod_(p <- ps | P p) F p)`_0 = \prod_(p <- ps | P p) (F p)`_0.
242-
Proof.
243-
by apply: (big_morph (fun p : {poly R} => p`_0));
244-
[apply: coef0M | rewrite coefC eqxx].
245-
Qed.
246-
247-
Lemma map_prod_XsubC (aR rR : ringType) (f : {rmorphism aR -> rR}) rs :
248-
map_poly f (\prod_(x <- rs) ('X - x%:P)) =
249-
\prod_(x <- map f rs) ('X - x%:P).
250-
Proof.
251-
by rewrite rmorph_prod big_map; apply/eq_bigr => x /=; rewrite map_polyXsubC.
252-
Qed.
227+
Lemma eqpW (R : idomainType) (p q : {poly R}) : p = q -> p %= q.
228+
Proof. by move->; rewrite eqpxx. Qed.
253229

254-
Lemma eq_in_map_poly_id0 (aR rR : ringType) (f g : aR -> rR)
255-
(S0 : {pred aR}) (addS : addrPred S0) (kS : keyed_pred addS) :
256-
f 0 = 0 -> g 0 = 0 ->
257-
{in kS, f =1 g} -> {in polyOver kS, map_poly f =1 map_poly g}.
230+
Lemma horner_mod (R : fieldType) (p q : {poly R}) x : root q x ->
231+
(p %% q).[x] = p.[x].
258232
Proof.
259-
move=> f0 g0 eq_fg p pP; apply/polyP => i.
260-
by rewrite !coef_map_id0// eq_fg// (polyOverP _).
233+
by move=> /eqP qx0; rewrite [p in RHS](divp_eq p q) !hornerE qx0 mulr0 add0r.
261234
Qed.
262235

263-
Lemma eq_in_map_poly (aR rR : ringType) (f g : {additive aR -> rR})
264-
(S0 : {pred aR}) (addS : addrPred S0) (kS : keyed_pred addS) :
265-
{in kS, f =1 g} -> {in polyOver kS, map_poly f =1 map_poly g}.
266-
Proof. by move=> /eq_in_map_poly_id0; apply; rewrite //?raddf0. Qed.
267-
268-
Lemma mapf_root (F : fieldType) (R : ringType) (f : {rmorphism F -> R})
269-
(p : {poly F}) (x : F) :
270-
root (p ^^ f) (f x) = root p x.
271-
Proof. by rewrite !rootE horner_map fmorph_eq0. Qed.
236+
Lemma root_dvdp (F : idomainType) (p q : {poly F}) (x : F) :
237+
root p x -> p %| q -> root q x.
238+
Proof. rewrite -!dvdp_XsubCl; exact: dvdp_trans. Qed.
272239

273240
Section multiplicity.
274241
Variable (L : fieldType).
@@ -351,15 +318,6 @@ Qed.
351318

352319
End multiplicity.
353320

354-
Lemma primitive_root_eq0 (F : fieldType) n (w : F) :
355-
n.-primitive_root w -> (w == 0) = (n == 0%N).
356-
Proof.
357-
move=> wp; apply/eqP/idP => [w0|/eqP p0]; move: wp; rewrite ?w0 ?p0; last first.
358-
by move=> /prim_order_gt0//.
359-
move=> /prim_expr_order/esym/eqP.
360-
by rewrite expr0n; case: (n =P 0%N); rewrite ?oner_eq0.
361-
Qed.
362-
363321
Lemma dvdp_exp_XsubC (R : idomainType) (p : {poly R}) (c : R) n :
364322
reflect (exists2 k, (k <= n)%N & p %= ('X - c%:P) ^+ k)
365323
(p %| ('X - c%:P) ^+ n).
@@ -380,70 +338,6 @@ move: rNc; rewrite -coprimep_XsubC => /(coprimep_expr n) /coprimepP.
380338
by move=> /(_ _ (dvdpp _)); rewrite -size_poly_eq1 => /(_ _)/eqP.
381339
Qed.
382340

383-
Lemma eisenstein (p : nat) (q : {poly int}) : prime p -> (size q != 1)%N ->
384-
(~~ (p %| lead_coef q))%Z -> (~~ ((p : int) ^+ 2 %| q`_0))%Z ->
385-
(forall i, (i < (size q).-1)%N -> p %| q`_i)%Z ->
386-
irreducible_poly (map_poly (intr : int -> rat) q).
387-
Proof.
388-
move=> p_prime qN1 Ndvd_pql Ndvd_pq0 dvd_pq.
389-
have qN0 : q != 0 by rewrite -lead_coef_eq0; apply: contraNneq Ndvd_pql => ->.
390-
split.
391-
rewrite size_map_poly_id0 ?intr_eq0 ?lead_coef_eq0//.
392-
by rewrite ltn_neqAle eq_sym qN1 size_poly_gt0.
393-
move=> f' +/dvdpP_rat_int[f [d dN0 feq]]; rewrite {f'}feq size_scale// => fN1.
394-
move=> /= [g q_eq]; rewrite q_eq (eqp_trans (eqp_scale _ _))//.
395-
have fN0 : f != 0 by apply: contra_neq qN0; rewrite q_eq => ->; rewrite mul0r.
396-
have gN0 : g != 0 by apply: contra_neq qN0; rewrite q_eq => ->; rewrite mulr0.
397-
rewrite size_map_poly_id0 ?intr_eq0 ?lead_coef_eq0// in fN1.
398-
have [/eqP/size_poly1P[c cN0 ->]|gN1] := eqVneq (size g) 1%N.
399-
by rewrite mulrC mul_polyC map_polyZ/= eqp_sym eqp_scale// intr_eq0.
400-
have c_neq0 : (lead_coef q)%:~R != 0 :> 'F_p
401-
by rewrite -(dvdz_charf (char_Fp _)).
402-
have : map_poly (intr : int -> 'F_p) q = (lead_coef q)%:~R *: 'X^(size q).-1.
403-
apply/val_inj/(@eq_from_nth _ 0) => [|i]; rewrite size_map_poly_id0//.
404-
by rewrite size_scale// size_polyXn -polySpred.
405-
move=> i_small; rewrite coef_poly i_small coefZ coefXn lead_coefE.
406-
move: i_small; rewrite polySpred// ltnS/=.
407-
case: ltngtP => // [i_lt|->]; rewrite (mulr1, mulr0)//= => _.
408-
by apply/eqP; rewrite -(dvdz_charf (char_Fp _))// dvd_pq.
409-
rewrite [in LHS]q_eq rmorphM/=.
410-
set c := (X in X *: _); set n := (_.-1).
411-
set pf := map_poly _ f; set pg := map_poly _ g => pfMpg.
412-
have dvdXn (r : {poly _}) : size r != 1%N -> r %| c *: 'X^n -> r`_0 = 0.
413-
move=> rN1; rewrite (eqp_dvdr _ (eqp_scale _ _))//.
414-
rewrite -['X]subr0; move=> /dvdp_exp_XsubC[k lekn]; rewrite subr0.
415-
move=> /eqpP[u /andP[u1N0 u2N0]]; have [->|k_gt0] := posnP k.
416-
move=> /(congr1 (size \o val))/eqP.
417-
by rewrite /= !size_scale// size_polyXn (negPf rN1).
418-
move=> /(congr1 (fun p : {poly _} => p`_0))/eqP.
419-
by rewrite !coefZ coefXn ltn_eqF// mulr0 mulf_eq0 (negPf u1N0) => /eqP.
420-
suff : ((p : int) ^+ 2 %| q`_0)%Z by rewrite (negPf Ndvd_pq0).
421-
have := c_neq0; rewrite q_eq coefM big_ord1.
422-
rewrite lead_coefM rmorphM mulf_eq0 negb_or => /andP[lpfN0 qfN0].
423-
have pfN1 : size pf != 1%N by rewrite size_map_poly_id0.
424-
have pgN1 : size pg != 1%N by rewrite size_map_poly_id0.
425-
have /(dvdXn _ pgN1) /eqP : pg %| c *: 'X^n by rewrite -pfMpg dvdp_mull.
426-
have /(dvdXn _ pfN1) /eqP : pf %| c *: 'X^n by rewrite -pfMpg dvdp_mulr.
427-
by rewrite !coef_map// -!(dvdz_charf (char_Fp _))//; apply: dvdz_mul.
428-
Qed.
429-
430-
(***********)
431-
(* polydiv *)
432-
(***********)
433-
434-
Lemma eqpW (R : idomainType) (p q : {poly R}) : p = q -> p %= q.
435-
Proof. by move->; rewrite eqpxx. Qed.
436-
437-
Lemma horner_mod (R : fieldType) (p q : {poly R}) x : root q x ->
438-
(p %% q).[x] = p.[x].
439-
Proof.
440-
by move=> /eqP qx0; rewrite [p in RHS](divp_eq p q) !hornerE qx0 mulr0 add0r.
441-
Qed.
442-
443-
Lemma root_dvdp (F : idomainType) (p q : {poly F}) (x : F) :
444-
root p x -> p %| q -> root q x.
445-
Proof. rewrite -!dvdp_XsubCl; exact: dvdp_trans. Qed.
446-
447341
(**********)
448342
(* vector *)
449343
(**********)

0 commit comments

Comments
 (0)