Skip to content

Commit 9c6f54e

Browse files
committed
backport ssralg and poly
1 parent b05880e commit 9c6f54e

File tree

1 file changed

+85
-191
lines changed

1 file changed

+85
-191
lines changed

theories/xmathcomp/various.v

Lines changed: 85 additions & 191 deletions
Original file line numberDiff line numberDiff line change
@@ -108,28 +108,35 @@ Qed.
108108
(* package algebra *)
109109
(*******************)
110110

111-
Import GRing.Theory.
112-
Local Open Scope ring_scope.
113-
Notation has_char0 L := ([char L] =i pred0).
114-
115111
(**********)
116-
(* ssralg *)
112+
(* ssrint *)
117113
(**********)
118114

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

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

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

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

167168
(**********)
168-
(* ssrint *)
169+
(* intdiv *)
169170
(**********)
170171

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

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

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

252-
Lemma eq_in_map_poly_id0 (aR rR : ringType) (f g : aR -> rR)
253-
(S : addrClosed aR) :
254-
f 0 = 0 -> g 0 = 0 ->
255-
{in S, f =1 g} -> {in polyOver S, map_poly f =1 map_poly g}.
228+
Lemma horner_mod (R : fieldType) (p q : {poly R}) x : root q x ->
229+
(p %% q).[x] = p.[x].
256230
Proof.
257-
move=> f0 g0 eq_fg p pP; apply/polyP => i.
258-
by rewrite !coef_map_id0// eq_fg// (polyOverP _).
231+
by move=> /eqP qx0; rewrite [p in RHS](divp_eq p q) !hornerE qx0 mulr0 add0r.
259232
Qed.
260233

261-
Lemma eq_in_map_poly (aR rR : ringType) (f g : {additive aR -> rR})
262-
(S : addrClosed aR) :
263-
{in S, f =1 g} -> {in polyOver S, map_poly f =1 map_poly g}.
264-
Proof. by move=> /eq_in_map_poly_id0; apply; rewrite //?raddf0. Qed.
265-
266-
Lemma mapf_root (F : fieldType) (R : ringType) (f : {rmorphism F -> R})
267-
(p : {poly F}) (x : F) :
268-
root (p ^^ f) (f x) = root p x.
269-
Proof. by rewrite !rootE horner_map fmorph_eq0. Qed.
234+
Lemma root_dvdp (F : idomainType) (p q : {poly F}) (x : F) :
235+
root p x -> p %| q -> root q x.
236+
Proof. rewrite -!dvdp_XsubCl; exact: dvdp_trans. Qed.
270237

271238
Section multiplicity.
272239
Variable (L : fieldType).
@@ -349,15 +316,6 @@ Qed.
349316

350317
End multiplicity.
351318

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

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

0 commit comments

Comments
 (0)