[WIP] replace the infrastructure of mpoly with monalg

src/monalg.v

@@ -11,7 +11,7 @@
 From mathcomp Require Import tuple bigop ssralg ssrint ssrnum.
 Unset SsrOldRewriteGoalsOrder.  (* remove the line when requiring MathComp >= 2.6 *)
 
 Require Import xfinmap.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -45,7 +45,7 @@
 Reserved Notation "g @_ k"
   (at level 3, k at level 2, left associativity, format "g @_ k").
 Reserved Notation "c %:MP" (format "c %:MP").
-Reserved Notation "''X_{1..' n '}'".
+Reserved Notation "''X_{1..' n '}'" (n at level 2).
 Reserved Notation "'U_(' n )" (format "'U_(' n )").
 Reserved Notation "x ^[ f , g ]" (at level 1, format "x ^[ f , g ]").
 
@@ -273,12 +273,17 @@
 #[deprecated(since="multinomials 2.5.0", use=Malg)]
 Definition mkmalg : {fsfun K -> G with 0} -> {malg G[K]} := @Malg K G.
 
-Definition mkmalgU (k : K) (x : G) := [malg y in [fset k] => x].
-
 Definition msupp (g : {malg G[K]}) : {fset K} := finsupp (malg_val g).
 
 End MalgBaseOp.
 
+HB.lock Definition mkmalgU (K : choiceType) (G : nmodType) (k : K) (x : G) :=
+  [malg y in [fset k] => x].
+
+(* FIXME *)
+Definition mkmalgU' (K : choiceType) (G : nmodType) (x : G) (k : K) :=
+  mkmalgU k x.
+
 Arguments mcoeff  {K G} x%_monom_scope g%_ring_scope.
 #[warning="-deprecated-reference"]
 Arguments mkmalg  {K G} _.
@@ -379,7 +384,7 @@
 Lemma mcoeffMn  k n : {morph mcoeff k: x / x *+ n} . Proof. exact: raddfMn. Qed.
 
 Lemma mcoeffU k x k' : << x *g k >>@_k' = x *+ (k == k').
-Proof. by rewrite [LHS]fsfunE inE mulrb eq_sym. Qed.
+Proof. by rewrite unlock [LHS]fsfunE inE mulrb eq_sym. Qed.
 
 Lemma mcoeffUU k x : << x *g k >>@_k = x.
 Proof. by rewrite mcoeffU eqxx. Qed.
@@ -932,6 +937,12 @@
   GRing.isMultiplicative.Build R {malg R[K]} (@malgC K R)
     malgC_is_multiplicative.
 
+Fact mkmalgU'_is_mmorphism : mmorphism (@mkmalgU' K R 1).
+Proof. by split => // x y; rewrite [RHS]fgmulUU mul1r. Qed.
+
+HB.instance Definition _ :=
+  isMultiplicative.Build _ _ (@mkmalgU' K R 1) mkmalgU'_is_mmorphism.
+
 Lemma mpolyC1E : 1%:MP = 1 :> {malg R[K]}.
 Proof. exact: rmorph1. Qed.
 
@@ -1327,28 +1338,30 @@
 Arguments monalgOver_pred _ _ _ _ /.
 
 (* -------------------------------------------------------------------- *)
-HB.mixin Record isMeasure (M : monomType) (mf : M -> nat) := {
-  mf0 : mf 1%M = 0%N;
+HB.mixin Record isWeakMeasure (M : monomType) (mf : M -> nat) := {
   mfM : {morph mf : m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N};
-  mf_eq0I : forall m, mf m = 0%N -> m = 1%M
 }.
 
-#[short(type="measure")]
-HB.structure Definition Measure (M : monomType) := {mf of isMeasure M mf}.
-
-#[deprecated(since="multinomials 2.5.0", note="Use Measure.clone instead.")]
-Notation "[ 'measure' 'of' f ]" := (Measure.clone _ f _)
-  (at level 0, only parsing) : form_scope.
+#[short(type="weakMeasure")]
+HB.structure Definition WeakMeasure (M : monomType) :=
+  {mf of isWeakMeasure M mf}.
 
 (* -------------------------------------------------------------------- *)
-Section MMeasure.
+Section WeakMeasure.
 
-Context (M : monomType) (G : nmodType) (mf : measure M).
+Context (M : monomType) (G : nmodType) (mf : weakMeasure M).
 
 Implicit Types (g : {malg G[M]}).
 
-Lemma mf_eq0 m : (mf m == 0%N) = (m == 1%M).
-Proof. by apply/eqP/eqP=> [|->]; rewrite ?mf0 // => /mf_eq0I. Qed.
+Lemma mf1 : mf 1%M = 0%N.
+Proof. by apply/(@addIn (mf 1%M)); rewrite add0n -mfM mul1m. Qed.
+
+Lemma mfX m n : mf (expmn m n) = (n * mf m)%N.
+Proof. by elim: n => [|n IHn]; rewrite ?mf1// expmnS mfM IHn. Qed.
+
+Lemma mf_prod (T : Type) (r : seq T) P (F : T -> M) :
+  mf (\prod_(x <- r | P x) F x)%M = (\sum_(x <- r | P x) mf (F x))%N.
+Proof. exact/big_morph/mf1/mfM. Qed.
 
 Definition mmeasure g := (\max_(m <- msupp g) (mf m).+1)%N.
 
@@ -1370,7 +1383,7 @@
 Lemma mmeasureC c : mmeasure c%:MP = (c != 0%R) :> nat.
 Proof.
 rewrite mmeasureE msuppC; case: (_ == 0)=> /=.
-by rewrite big_nil. by rewrite big_seq_fset1 mf0.
+by rewrite big_nil. by rewrite big_seq_fset1 mf1.
 Qed.
 
 Lemma mmeasureD_le g1 g2 :
@@ -1403,12 +1416,47 @@
 Lemma mmeasure_msupp0 g : (mmeasure g == 0%N) = (msupp g == fset0).
 Proof. by rewrite mmeasure_eq0 msupp_eq0. Qed.
 
-End MMeasure.
+End WeakMeasure.
 
-Lemma mmeasureN M (G : zmodType) (mf : measure M) (g : {malg G[M]}) :
+Lemma mmeasureN M (G : zmodType) (mf : weakMeasure M) (g : {malg G[M]}) :
   mmeasure mf (- g) = mmeasure mf g.
 Proof. by rewrite mmeasureE msuppN. Qed.
 
+(* -------------------------------------------------------------------- *)
+HB.mixin Record WeakMeasure_isMeasure (M : monomType) (mf : M -> nat) := {
+  mf_eq0I : forall m, mf m = 0%N -> m = 1%M
+}.
+
+#[short(type="measure")]
+HB.structure Definition Measure (M : monomType) :=
+  {mf of WeakMeasure M mf & WeakMeasure_isMeasure M mf}.
+
+HB.factory Record isMeasure (M : monomType) (mf : M -> nat) := {
+  mfM : {morph mf : m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N};
+  mf_eq0I : forall m, mf m = 0%N -> m = 1%M
+}.
+
+HB.builders Context M mf & isMeasure M mf.
+HB.instance Definition _ := isWeakMeasure.Build M mf mfM.
+HB.instance Definition _ := WeakMeasure_isMeasure.Build M mf mf_eq0I.
+HB.end.
+
+#[deprecated(since="multinomials 2.5.0", note="Use Measure.clone instead.")]
+Notation "[ 'measure' 'of' f ]" := (Measure.clone _ f _)
+  (at level 0, only parsing) : form_scope.
+
+(* -------------------------------------------------------------------- *)
+Section Measure.
+
+Context (M : monomType) (G : nmodType) (mf : measure M).
+
+Implicit Types (g : {malg G[M]}).
+
+Lemma mf_eq0 m : (mf m == 0%N) = (m == 1%M).
+Proof. by apply/eqP/eqP=> [|->]; rewrite ?mf1 // => /mf_eq0I. Qed.
+
+End Measure.
+
 (* -------------------------------------------------------------------- *)
 Section CmonomDef.
 
@@ -1418,6 +1466,8 @@
 
 Coercion cmonom_val : cmonom >-> fsfun.
 
+Definition exp_of_cmonom (i : I) (m : cmonom) : nat := cmonom_val m i.
+
 Fact cmonom_key : unit. Proof. by []. Qed.
 
 #[deprecated(since="multinomials 2.5.0", use=CMonom)]
@@ -1514,6 +1564,9 @@
 #[deprecated(since="multinomials 2.5.0", use=expmn)]
 Definition expcmn m n : cmonom I := expmn m n.
 
+HB.instance Definition _ i :=
+  isWeakMeasure.Build _ (exp_of_cmonom i) (fun m1 m2 => mulcmE m1 m2 i).
+
 End CmonomCanonicals.
 
 HB.instance Definition _ (I : countType) := [Countable of cmonom I by <:].
@@ -1547,6 +1600,9 @@
 Lemma cmM i m1 m2 : (m1 * m2)%M i = (m1 i + m2 i)%N.
 Proof. exact/mulcmE. Qed.
 
+Lemma cmX i m n : expmn m n i = (n * m i)%N.
+Proof. exact: (mfX (exp_of_cmonom _)). Qed.
+
 Lemma cmE_eq0 m i : (m i == 0%N) = (i \notin finsupp m).
 Proof. by rewrite memNfinsupp. Qed.
 
@@ -1581,13 +1637,10 @@
 by move=> i i_in_d; rewrite -cmE_neq0 negbK => /eqP.
 Qed.
 
-Lemma mdeg1 : mdeg 1%M = 0%N.
-Proof. by rewrite mdegE mdom1 big_seq_fset0. Qed.
-
 Lemma mdegU k : mdeg U_(k)%M = 1%N.
 Proof. by rewrite mdegE mdomU big_seq_fset1 cmUU. Qed.
 
-Lemma mdegM : {morph mdeg: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N }.
+Fact mdegM : {morph mdeg: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N }.
 Proof.
 move=> m1 m2 /=; rewrite mdegE mdomD.
 rewrite
@@ -1596,20 +1649,22 @@
 by rewrite -big_split /=; apply/eq_bigr=> /= i _; rewrite cmM.
 Qed.
 
-Lemma mdeg_prod (T : Type) r P (F : T -> cmonom I) :
-    mdeg (\big[mmul/1%M]_(x <- r | P x) (F x))
-  = (\sum_(x <- r | P x) (mdeg (F x)))%N.
-Proof. exact/big_morph/mdeg1/mdegM. Qed.
-
-Lemma mdeg_eq0I m : mdeg m = 0%N -> m = 1%M.
+Fact mdeg_eq0I m : mdeg m = 0%N -> m = 1%M.
 Proof.
 move=> h; apply/eqP/cmP=> i; move: h; rewrite mdegE cm1.
 by case: mdomP=> // ki /eqP; rewrite (big_fsetD1 i) //= addn_eq0 => /andP[/eqP].
 Qed.
 
-(* -------------------------------------------------------------------- *)
 #[hnf] HB.instance Definition _ := isMeasure.Build (cmonom I)
-  mdeg mdeg1 mdegM mdeg_eq0I.
+  mdeg mdegM mdeg_eq0I.
+
+#[deprecated(since="multinomials 2.6.0", use=mf_prod)]
+Lemma mdeg_prod (T : Type) r P (F : T -> cmonom I) :
+  mdeg (\prod_(x <- r | P x) (F x)) = (\sum_(x <- r | P x) (mdeg (F x)))%N.
+Proof. exact: mf_prod. Qed.
+
+#[deprecated(since="multinomials 2.6.0", use=mf1)]
+Lemma mdeg1 : mdeg 1%M = 0%N. Proof. exact: mf1. Qed.
 
 Lemma mdeg_eq0 m : (mdeg m == 0%N) = (m == 1%M).
 Proof. exact/mf_eq0. Qed.
@@ -1621,6 +1676,21 @@
 Lemma cm1_eq1 i : (U_(i) == 1)%M = false.
 Proof. by rewrite -mdeg_eq0 mdegU. Qed.
 
+Lemma cm_prodEw m (d : {fset I}) : finsupp m `<=` d ->
+  m = (\prod_(i <- d) expmn U_(i) (m i))%M.
+Proof.
+move=> le; apply/eqP/cmP => i; rewrite [RHS](mf_prod (exp_of_cmonom _)).
+case: mdomP=> im; last first.
+  apply/esym/big1_fset => /= j jd _; rewrite [LHS]cmX cmU mulnC.
+  by case: eqP im => // <-; case: mdomP.
+rewrite (big_fsetD1 i) /=; first exact: (fsubsetP le).
+rewrite /exp_of_cmonom cmX cmUU muln1 big1_fset; last by rewrite addn0.
+by move=> j; rewrite !inE => /andP[ji jd] _; rewrite cmX mulnC cmU (negbTE ji).
+Qed.
+
+Lemma cm_prodE m : m = (\prod_(i <- finsupp m) expmn U_(i) (m i))%M.
+Proof. exact/cm_prodEw. Qed.
+
 End CmonomTheory.
 
 (* -------------------------------------------------------------------- *)
@@ -1636,34 +1706,32 @@
 Lemma mnmwgtE m : mnmwgt m = (\sum_i m i * i.+1)%N.
 Proof. by []. Qed.
 
-Lemma mnmwgt1 : mnmwgt 1%M = 0%N.
-Proof. by rewrite mnmwgtE big1 // => /= i _; rewrite cm1. Qed.
-
 Lemma mnmwgtU i : mnmwgt U_(i) = i.+1.
 Proof.
 rewrite mnmwgtE (bigD1 i) //= cmUU mul1n big1 ?addn0 //.
 by move=> j ne_ij; rewrite cmU eq_sym (negbTE ne_ij).
 Qed.
 
-Lemma mnmwgtM : {morph mnmwgt: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N}.
+Fact mnmwgtM : {morph mnmwgt: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N}.
 Proof.
 move=> m1 m2 /=; rewrite !mnmwgtE -big_split /=.
 by apply/eq_bigr=> i _; rewrite cmM mulnDl.
 Qed.
 
-Lemma mnmwgt_eq0I m : mnmwgt m = 0%N -> m = 1%M.
+Fact mnmwgt_eq0I m : mnmwgt m = 0%N -> m = 1%M.
 Proof.
 move=> h; apply/eqP/cmP=> /= i; move: h; rewrite mnmwgtE cm1 => /eqP.
 rewrite sum_nat_eq0 => /forallP /(_ i) /implyP.
 by rewrite muln_eq0 orbF => z_mi; apply/eqP/z_mi.
 Qed.
 
-(* -------------------------------------------------------------------- *)
 #[hnf] HB.instance Definition _ := isMeasure.Build 'X_{1..n}
-  mnmwgt mnmwgt1 mnmwgtM mnmwgt_eq0I.
+  mnmwgt mnmwgtM mnmwgt_eq0I.
 
-Lemma mnmwgt_eq0 m : (mnmwgt m == 0%N) = (m == 1%M).
-Proof. exact/mf_eq0. Qed.
+#[deprecated(since="multinomials 2.6.0", use=mf1)]
+Lemma mnmwgt1 : mnmwgt 1%M = 0%N. Proof. exact/mf1. Qed.
+
+Lemma mnmwgt_eq0 m : (mnmwgt m == 0%N) = (m == 1%M). Proof. exact/mf_eq0. Qed.
 
 End MWeight.
 
@@ -1700,6 +1768,33 @@
 Definition msizeN (I : choiceType) (G : zmodType) :=
   @mmeasureN (cmonom I) G mdeg.
 
+Section CMMap.
+
+Definition cmmap
+  {I : choiceType} {R : pzSemiRingType} (f : I -> R) (m : cmonom I) :=
+  \prod_(k <- finsupp m) f k ^+ m k.
+
+Context (I : choiceType) (R : comPzSemiRingType) (f : I -> R).
+
+Lemma cmmapw (d : {fset I}) (m : {cmonom I}) :
+  finsupp m `<=` d -> cmmap f m = \prod_(k <- d) f k ^+ m k.
+Proof.
+by move=> md; apply: big_fset_incl md _ => x xd; rewrite -cmE_eq0 => /eqP->.
+Qed.
+
+Fact cmmap_is_mmorphism : mmorphism (cmmap f).
+Proof.
+split=> [|x y]; first by rewrite /cmmap mdom1 big_seq_fset0.
+rewrite [cmmap f x](cmmapw (fsubsetUl _ (finsupp y))).
+rewrite [cmmap f y](cmmapw (fsubsetUr (finsupp x) _)).
+by rewrite -big_split/= /cmmap mdomD; apply/eq_bigr => i _; rewrite cmM exprD.
+Qed.
+
+HB.instance Definition _ :=
+  isMultiplicative.Build _ _ (cmmap f) cmmap_is_mmorphism.
+
+End CMMap.
+
 (* -------------------------------------------------------------------- *)
 Section FmonomDef.
 
@@ -1802,29 +1897,28 @@
 Lemma fdegE m : fdeg m = size m.
 Proof. by []. Qed.
 
-Lemma fdeg1 : fdeg 1%M = 0%N.
-Proof. by rewrite fdegE fm1. Qed.
-
 Lemma fdegU k : fdeg U_(k) = 1%N.
 Proof. by rewrite fdegE fmU. Qed.
 
-Lemma fdegM : {morph fdeg: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N }.
+Fact fdegM : {morph fdeg: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N }.
 Proof. by move=> m1 m2; rewrite !fdegE fmM size_cat. Qed.
 
-Lemma fdeg_prod (T : Type) r P (F : T -> fmonom I) :
-    fdeg (\big[mmul/1%M]_(x <- r | P x) (F x))
-  = (\sum_(x <- r | P x) (fdeg (F x)))%N.
-Proof. by apply/big_morph; [apply/fdegM|apply/fdeg1]. Qed.
-
-Lemma fdeg_eq0I m : fdeg m = 0%N -> m = 1%M.
+Fact fdeg_eq0I m : fdeg m = 0%N -> m = 1%M.
 Proof.
 rewrite fdegE => /size0nil z_m; apply/eqP.
 by rewrite -val_eqE /= z_m fm1.
 Qed.
 
-(* -------------------------------------------------------------------- *)
-#[hnf] HB.instance Definition _ := isMeasure.Build (fmonom I)
-  fdeg fdeg1 fdegM fdeg_eq0I.
+#[hnf] HB.instance Definition _ :=
+  isMeasure.Build (fmonom I) fdeg fdegM fdeg_eq0I.
+
+#[deprecated(since="multinomials 2.6.0", use=mf1)]
+Lemma fdeg1 : fdeg 1%M = 0%N. Proof. exact: mf1. Qed.
+
+#[deprecated(since="multinomials 2.6.0", use=mf_prod)]
+Lemma fdeg_prod (T : Type) r P (F : T -> fmonom I) :
+  fdeg (\prod_(x <- r | P x) (F x)) = (\sum_(x <- r | P x) (fdeg (F x)))%N.
+Proof. exact: mf_prod. Qed.
 
 Lemma fdeg_eq0 m : (fdeg m == 0%N) = (m == 1%M).
 Proof. exact/mf_eq0. Qed.
@@ -1837,3 +1931,19 @@
 Proof. by rewrite -fdeg_eq0 fdegU. Qed.
 
 End FmonomTheory.
+
+Section FMMap.
+
+Context (I : choiceType) (R : pzSemiRingType) (f : I -> R).
+
+Definition fmmap (m : fmonom I) := \prod_(k <- m) f k.
+
+Fact fmmap_is_mmorphism : mmorphism fmmap.
+Proof.
+split=> [|x y]; first by rewrite /fmmap [1%M]fmoneE/= big_nil.
+by rewrite /fmmap [(x * y)%M]fmmulE/= big_cat/=.
+Qed.
+
+HB.instance Definition _ := isMultiplicative.Build _ _ fmmap fmmap_is_mmorphism.
+
+End FMMap.