aboutsummaryrefslogtreecommitdiff
path: root/mathcomp/attic/multinom.v
diff options
context:
space:
mode:
authorEnrico Tassi2018-04-20 14:17:38 +0200
committerEnrico Tassi2018-04-20 14:17:38 +0200
commitdcc7917ac5d66472f751ebbd31b7b63db5465303 (patch)
tree22228fc984fdf119291e0e4601a6c3e028107408 /mathcomp/attic/multinom.v
parente418a8b26b66ce88e22cff5978823e25aab03d94 (diff)
remove the attic/ directory
Diffstat (limited to 'mathcomp/attic/multinom.v')
-rw-r--r--mathcomp/attic/multinom.v442
1 files changed, 0 insertions, 442 deletions
diff --git a/mathcomp/attic/multinom.v b/mathcomp/attic/multinom.v
deleted file mode 100644
index 96a8071..0000000
--- a/mathcomp/attic/multinom.v
+++ /dev/null
@@ -1,442 +0,0 @@
-(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *)
-(* Distributed under the terms of CeCILL-B. *)
-Require Import mathcomp.ssreflect.ssreflect.
-From mathcomp
-Require Import ssrfun ssrbool eqtype ssrnat seq choice fintype.
-From mathcomp
-Require Import tuple finfun bigop ssralg poly generic_quotient bigenough.
-
-(* We build the ring of multinomials with an arbitrary (countable) *)
-(* number of indeterminates. We show it is a ring when the base field *)
-(* is a ring, and a commutative ring when the base field is commutative *)
-
-(* TODO:
- - when the base field is an integral domain, so are multinomials (WIP)
- - replace the countable type of indeterminates by an arbitrary choice type
- - do the theory of symmetric polynomials
-*)
-
-
-
-Set Implicit Arguments.
-Unset Strict Implicit.
-Unset Printing Implicit Defensive.
-
-Local Open Scope ring_scope.
-Local Open Scope quotient_scope.
-
-Import GRing.Theory BigEnough.
-
-Module Multinomial.
-
-Section Multinomial.
-
-Variable X : countType.
-
-Section MultinomialRing.
-
-Variable R : ringType.
-
-(* Definining the free algebra of multinomial terms *)
-Inductive multi_term :=
-| Coef of R
-| Var of X
-| Oper of bool & multi_term & multi_term.
-
-Notation Sum := (Oper false).
-Notation Prod := (Oper true).
-
-(* Encoding to a tree structure in order to recover equality and choice *)
-Fixpoint to_tree m : GenTree.tree (X + R) :=
-match m with
-| Coef x => GenTree.Node 0 [:: GenTree.Leaf (inr _ x)]
-| Var x => GenTree.Node 0 [:: GenTree.Leaf (inl _ x)]
-| Oper b m1 m2 => GenTree.Node (b.+1) [:: to_tree m1; to_tree m2]
-end.
-
-Fixpoint from_tree t :=
-match t with
-| GenTree.Node 0 [:: GenTree.Leaf (inr x)] => Some (Coef x)
-| GenTree.Node 0 [:: GenTree.Leaf (inl x)] => Some (Var x)
-| GenTree.Node n.+1 [:: t1; t2] =>
- if (from_tree t1, from_tree t2) is (Some m1, Some m2)
- then Some (Oper (n == 1)%N m1 m2) else None
-| _ => None
-end.
-
-Lemma to_treeK : pcancel to_tree from_tree.
-Proof. by elim=> //=; case=> ? -> ? ->. Qed.
-
-Definition multi_term_eqMixin := PcanEqMixin to_treeK.
-Canonical multi_term_eqType := EqType multi_term multi_term_eqMixin.
-Definition multi_term_choiceMixin := PcanChoiceMixin to_treeK.
-Canonical multi_term_choiceType := ChoiceType multi_term multi_term_choiceMixin.
-
-(* counting the variables, in order to know how to interpret multi_term *)
-Fixpoint nbvar_term t :=
- match t with
- | Coef _ => 0%N
- | Var x => (pickle x).+1
- | Sum u v => maxn (nbvar_term u) (nbvar_term v)
- | Prod u v => maxn (nbvar_term u) (nbvar_term v)
- end.
-
-(* Iterated polynomials over a ring *)
-Fixpoint multi n := if n is n.+1 then [ringType of {poly multi n}] else R.
-
-Fixpoint inject n m (p : multi n) {struct m} : multi (m + n) :=
- if m is m'.+1 return multi (m + n) then (inject m' p)%:P else p.
-
-Lemma inject_inj : forall i m, injective (@inject i m).
-Proof. by move=> i; elim=> //= m IHm p q; move/polyC_inj; move/IHm. Qed.
-
-Lemma inject0 : forall i m, @inject i m 0 = 0.
-Proof. by move=> i; elim=> //= m ->. Qed.
-
-Lemma inject_eq0 : forall i m p, (@inject i m p == 0) = (p == 0).
-Proof. by move=> i m p; rewrite -(inj_eq (@inject_inj i m)) inject0. Qed.
-
-Lemma size_inject : forall i m p, size (@inject i m.+1 p) = (p != 0 : nat).
-Proof. by move=> i m p; rewrite size_polyC inject_eq0. Qed.
-
-Definition cast_multi i m n Emn : multi i -> multi n :=
- let: erefl in _ = n' := Emn return _ -> multi n' in inject m.
-
-Definition multi_var n (i : 'I_n) := cast_multi (subnK (valP i)) 'X.
-
-Notation "'X_ i" := (multi_var i).
-
-Lemma inject_is_rmorphism : forall m n, rmorphism (@inject n m).
-Proof.
-elim=> // m ihm n /=; have ->: inject m = RMorphism (ihm n) by [].
-by rewrite -/(_ \o _); apply: rmorphismP.
-Qed.
-Canonical inject_rmorphism m n := RMorphism (inject_is_rmorphism m n).
-Canonical inject_additive m n := Additive (inject_is_rmorphism m n).
-
-Lemma cast_multi_is_rmorphism i m n Enm : rmorphism (@cast_multi i m n Enm).
-Proof. by case: n / Enm; apply: rmorphismP. Qed.
-Canonical cast_multi_rmorphism i m n e :=
- RMorphism (@cast_multi_is_rmorphism i m n e).
-Canonical cast_multi_additive i m n e :=
- Additive (@cast_multi_is_rmorphism i m n e).
-
-Definition multiC n : R -> multi n := cast_multi (addn0 n).
-Lemma multiC_is_rmorphism n : rmorphism (multiC n).
-Proof. by rewrite /multiC -[R]/(multi 0); apply: rmorphismP. Qed.
-Canonical multiC_rmorphism n := RMorphism (multiC_is_rmorphism n).
-Canonical multiC_additive n := Additive (multiC_is_rmorphism n).
-
-Lemma cast_multi_inj n i i' n' (m1 m2 : multi n)
- (p1: (i + n)%N=n') (p2: (i' + n)%N=n') :
- cast_multi p1 m1 == cast_multi p2 m2 = (m1 == m2).
-Proof.
-have := p2; rewrite -{1}[n']p1; move/eqP; rewrite eqn_add2r.
-move=> /eqP /= Eii; move: p2; rewrite Eii=> p2 {Eii}.
-have <-: p1 = p2; first exact: nat_irrelevance.
-apply/idP/idP; last by move/eqP->.
-move=> Hm {p2}.
-have : inject i m1 = inject i m2; last first.
- by move/eqP; rewrite (inj_eq (@inject_inj _ _)).
-move: Hm; move: (p1); rewrite -p1 => p2.
-rewrite (_ : p2 = erefl (i+n)%N); last exact: nat_irrelevance.
-by move/eqP.
-Qed.
-
-Lemma Emj_Enk i j k m n :
- forall (Emj : (m + i)%N = j) (Enk : (n + j)%N = k), (n + m + i)%N = k.
-Proof. by move<-; rewrite addnA. Qed.
-
-Lemma cast_multi_id n (e : (0 + n)%N = n) m : cast_multi e m = m.
-Proof. by rewrite (_ : e = erefl _) //; apply: nat_irrelevance. Qed.
-
-Lemma cast_multiS n i n' (m : multi n)
- (p: (i + n)%N = n') (pS: ((i.+1) + n)%N = n'.+1) :
- (cast_multi pS m) = (cast_multi p m)%:P.
-Proof. by case: _ / p in pS *; rewrite [pS](nat_irrelevance _ (erefl _)). Qed.
-
-Lemma injectnm_cast_multi i m n p :
- inject (n + m)%N p =
- ((@cast_multi (m + i)%N n ((n + m) + i)%N (addnA _ _ _)) \o (inject m)) p.
-Proof.
-elim: n => [|n /= -> /=].
- by rewrite [addnA 0%N m i](nat_irrelevance _ (erefl _)).
-by rewrite cast_multiS; congr (cast_multi _ _)%:P; apply: nat_irrelevance.
-Qed.
-
-Lemma cast_multi_add i j k m n Emj Enk p :
- @cast_multi j n k Enk (@cast_multi i m j Emj p) =
- @cast_multi i (n + m)%N k (Emj_Enk Emj Enk) p.
-Proof.
-move: (Emj) (Enk) (Emj_Enk Emj Enk); rewrite -Enk -Emj.
-change (addn_rec n (addn_rec m i)) with (n+m+i)%N.
-rewrite {-1}[(n+(m+i))%N]addnA=> Emj0 Enk0 Enmi.
-have ->: (Emj0 = erefl (m+i)%N); first exact: nat_irrelevance.
-have ->: (Enmi = erefl (n+m+i)%N); first exact: nat_irrelevance.
-rewrite /= injectnm_cast_multi /=.
-by apply/eqP; rewrite cast_multi_inj.
-Qed.
-
-(* Interpretation of a multi_term in iterated polynomials,
- for a given number of variables n *)
-Fixpoint interp n m : multi n :=
- match m with
- | Coef x => multiC n x
- | Var x => let i := pickle x in
- (if i < n as b return (i < n) = b -> multi n
- then fun iltn => cast_multi (subnK iltn) 'X_(Ordinal (leqnn i.+1))
- else fun _ => 0) (refl_equal (i < n))
- | Sum p q => interp n p + interp n q
- | Prod p q => interp n p * interp n q
-end.
-
-Lemma interp_cast_multi n n' m (nltn' : n <= n') :
- nbvar_term m <= n -> interp n' m = cast_multi (subnK nltn') (interp n m).
-Proof.
-move=> dmltn; have dmltn' := (leq_trans dmltn nltn').
-elim: m nltn' dmltn dmltn'.
-+ move=> a /= nltn' dmltn dmltn'.
- apply/eqP; rewrite /multiC.
- by rewrite cast_multi_add /= cast_multi_inj.
-+ move=> N /= nltn' dmltn dmltn'.
- move: (refl_equal (_ N < n')) (refl_equal (_ N < n)).
- rewrite {2 3}[_ N < n]dmltn {2 3}[_ N < n']dmltn' => Nn' Nn.
- by apply/eqP; rewrite cast_multi_add cast_multi_inj.
-move=> [] m1 Hm1 m2 Hm2 nltn' /=;
-rewrite !geq_max => /andP [dm1n dm1n'] /andP [dm2n dm2n'];
-by rewrite (Hm1 nltn') // (Hm2 nltn') // (rmorphM, rmorphD).
-Qed.
-
-(* identification of to multi_terms modulo equality of iterated polynomials *)
-Definition equivm m1 m2 := let n := maxn (nbvar_term m1) (nbvar_term m2) in
- interp n m1 == interp n m2.
-
-(* it works even for a bigger n *)
-Lemma interp_gtn n m1 m2 : maxn (nbvar_term m1) (nbvar_term m2) <= n ->
- equivm m1 m2 = (interp n m1 == interp n m2).
-Proof.
-move=> hn; rewrite !(interp_cast_multi hn) ?leq_max ?leqnn ?orbT //.
-by rewrite cast_multi_inj.
-Qed.
-
-Lemma equivm_refl : reflexive equivm. Proof. by move=> x; rewrite /equivm. Qed.
-
-Lemma equivm_sym : symmetric equivm.
-Proof. by move=> x y; rewrite /equivm eq_sym maxnC. Qed.
-
-Lemma equivm_trans : transitive equivm.
-Proof.
-move=> x y z; pose_big_enough n.
- by rewrite !(@interp_gtn n) => // /eqP-> /eqP->.
-by close.
-Qed.
-
-(* equivm is an equivalence *)
-Canonical equivm_equivRel := EquivRel equivm
- equivm_refl equivm_sym equivm_trans.
-
-(* we quotient by the equivalence *)
-Definition multinom := {eq_quot equivm}.
-Definition multinom_of of phant X & phant R := multinom.
-
-Local Notation "{ 'multinom' R }" := (multinom_of (Phant X) (Phant R))
- (at level 0, format "{ 'multinom' R }").
-(* We recover a lot of structure *)
-Canonical multinom_quotType := [quotType of multinom].
-Canonical multinom_eqType := [eqType of multinom].
-Canonical multinom_eqQuotType := [eqQuotType equivm of multinom].
-Canonical multinom_choiceType := [choiceType of multinom].
-Canonical multinom_of_quotType := [quotType of {multinom R}].
-Canonical multinom_of_eqType := [eqType of {multinom R}].
-Canonical multinom_of_eqQuotType := [eqQuotType equivm of {multinom R}].
-Canonical multinom_of_choiceType := [choiceType of {multinom R}].
-
-Lemma eqm_interp n m1 m2 : maxn (nbvar_term m1) (nbvar_term m2) <= n ->
- (interp n m1 == interp n m2) = (m1 == m2 %[mod {multinom R}]).
-Proof. by move=> hn; rewrite eqmodE /= -interp_gtn. Qed.
-
-Definition cstm := lift_embed {multinom R} Coef.
-Notation "c %:M" := (cstm c) (at level 2, format "c %:M").
-Canonical pi_cstm_morph := PiEmbed cstm.
-
-Definition varm := lift_embed {multinom R} Var.
-Notation "n %:X" := (varm n) (at level 2, format "n %:X").
-Canonical pi_varm_morph := PiEmbed varm.
-
-(* addition is defined by lifting Sum *)
-Definition addm := lift_op2 {multinom R} Sum.
-Lemma pi_addm : {morph \pi : x y / Sum x y >-> addm x y}.
-Proof.
-move=> x y /=; unlock addm; apply/eqmodP => /=.
-pose_big_enough n.
- rewrite (@interp_gtn n) //=; apply/eqP; congr (_ + _);
- by apply/eqP; rewrite eqm_interp // reprK.
-by close.
-Qed.
-Canonical pi_addm_morph := PiMorph2 pi_addm.
-
-Definition Opp := Prod (Coef (-1)).
-Definition oppm := lift_op1 {multinom R} Opp.
-Lemma pi_oppm : {morph \pi : x / Opp x >-> oppm x}.
-Proof.
-move=> x; unlock oppm; apply/eqmodP => /=.
-rewrite /equivm /= !max0n; apply/eqP; congr (_ * _).
-by apply/eqP; rewrite eqm_interp ?reprK.
-Qed.
-Canonical pi_oppm_morph := PiMorph1 pi_oppm.
-
-(* addition is defined by lifting Prod *)
-Definition mulm := lift_op2 {multinom R} Prod.
-Lemma pi_mulm : {morph \pi : x y / Prod x y >-> mulm x y}.
-Proof.
-move=> x y; unlock mulm; apply/eqP; set x' := repr _; set y' := repr _.
-rewrite -(@eqm_interp (nbvar_term (Sum (Sum x y) (Sum x' y')))) /=.
- apply/eqP; congr (_ * _); apply/eqP;
- by rewrite eqm_interp ?reprK // !(geq_max, leq_max, leqnn, orbT).
-by rewrite maxnC.
-Qed.
-Canonical pi_mulm_morph := PiMorph2 pi_mulm.
-
-(* Ring properties are obtained from iterated polynomials *)
-Lemma addmA : associative addm.
-Proof.
-elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; apply/eqP.
-by rewrite !piE /equivm /= addrA.
-Qed.
-
-Lemma addmC : commutative addm.
-Proof.
-by elim/quotW=> x; elim/quotW=> y; apply/eqP; rewrite !piE /equivm /= addrC.
-Qed.
-
-Lemma add0m : left_id 0%:M addm.
-Proof. by elim/quotW=> x; apply/eqP; rewrite piE /equivm /= rmorph0 add0r. Qed.
-
-Lemma addmN : left_inverse 0%:M oppm addm.
-Proof.
-elim/quotW=> x; apply/eqP; rewrite piE /equivm /=.
-by rewrite !rmorph0 rmorphN rmorph1 mulN1r addNr.
-Qed.
-
-Definition multinom_zmodMixin := ZmodMixin addmA addmC add0m addmN.
-Canonical multinom_zmodType := ZmodType multinom multinom_zmodMixin.
-Canonical multinom_of_zmodType := ZmodType {multinom R} multinom_zmodMixin.
-
-Lemma mulmA : associative mulm.
-Proof.
-elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; apply/eqP.
-by rewrite piE /equivm /= mulrA.
-Qed.
-
-Lemma mul1m : left_id 1%:M mulm.
-Proof. by elim/quotW=> x; apply/eqP; rewrite piE /equivm /= rmorph1 mul1r. Qed.
-
-Lemma mulm1 : right_id 1%:M mulm.
-Proof.
-elim/quotW=> x; rewrite !piE /=; apply/eqmodP; rewrite /= /equivm /=.
-by rewrite rmorph1 mulr1.
-Qed.
-
-Lemma mulm_addl : left_distributive mulm addm.
-Proof.
-elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; apply/eqP.
-by rewrite !piE /equivm /= mulrDl.
-Qed.
-
-Lemma mulm_addr : right_distributive mulm addm.
-Proof.
-elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; apply/eqP.
-by rewrite !piE /equivm /= mulrDr.
-Qed.
-
-Lemma nonzero1m : 1%:M != 0%:M.
-Proof. by rewrite piE /equivm /= rmorph1 rmorph0 oner_neq0. Qed.
-
-Definition multinom_ringMixin := RingMixin mulmA mul1m mulm1 mulm_addl mulm_addr nonzero1m.
-Canonical multinom_ringType := RingType multinom multinom_ringMixin.
-Canonical multinom_of_ringType := RingType {multinom R} multinom_ringMixin.
-
-End MultinomialRing.
-
-Notation "{ 'multinom' R }" := (@multinom_of _ (Phant X) (Phant R))
- (at level 0, format "{ 'multinom' R }").
-
-Notation "c %:M" := (cstm c) (at level 2, format "c %:M").
-Notation "n %:X" := (varm n) (at level 2, format "n %:X").
-
-Section MultinomialComRing.
-
-Variable R : comRingType.
-
-Lemma mul_multiC n : commutative (@GRing.mul (multi R n)).
-Proof.
-suff [M IH_CR] : {CR : comRingType | [ringType of CR] = multi R n}.
- by case: _ / IH_CR => x y; rewrite mulrC.
-elim: n => [|n [CR IH_CR]] //=; first by exists R.
-by exists [comRingType of {poly CR}]; rewrite -IH_CR.
-Qed.
-
-Lemma mulmC : commutative (@mulm R).
-Proof.
-elim/quotW=> x; elim/quotW=> y; apply/eqP.
-by rewrite piE /equivm /= mul_multiC.
-Qed.
-
-(* if R is commutative, so is {multinom R} *)
-Canonical multinom_comRing := Eval hnf in ComRingType (@multinom R) mulmC.
-Canonical multinom_of_comRing := Eval hnf in ComRingType {multinom R} mulmC.
-
-End MultinomialComRing.
-
-Section MultinomialIdomain.
-
-Variable R : idomainType.
-
-(* if R is an integral domain, {multinom R} should also be one,
- but the developpment is unfinished *)
-Lemma multi_unitClass n : GRing.UnitRing.class_of (multi R n).
-Proof.
-suff [D IH_D] : {D : idomainType | [ringType of D] = multi R n}.
- by case: _ / IH_D; case: D => [sort [[[rc /= _ um _ _]]]]; exists rc.
-elim: n => [|n [D IH_D]] //=; first by exists R.
-by exists [idomainType of {poly D}]; case: _ / IH_D.
-Qed.
-
-Canonical multi_unitRing n := GRing.UnitRing.Pack
- (multi_unitClass n) (multi R n).
-
-(* Definition Unit (m : multi_term R) := *)
-(* let n := nbvar_term m in interp n m \in GRing.unit. *)
-(* Definition unitm := lift_fun1 {multinom R} Unit. *)
-(* Lemma pi_unitm : {mono \pi : x / Unit x >-> unitm x}. *)
-(* Proof. *)
-(* move=> x; unlock unitm; rewrite /Unit /=. *)
-(* Admitted. *)
-(* Canonical pi_unitm_morph := PiMono1 pi_unitm. *)
-
-Lemma multi_idomain n : GRing.IntegralDomain.axiom (multi R n).
-Proof.
-suff [D IH_D] : {D : idomainType | [ringType of D] = multi R n}.
- by case: _ / IH_D => x y /eqP; rewrite mulf_eq0.
-elim: n => [|n [D IH_D]] //=; first by exists R.
-by exists [idomainType of {poly D}]; rewrite -IH_D.
-Qed.
-
-Lemma multinom_idomain : GRing.IntegralDomain.axiom [ringType of multinom R].
-Proof.
-elim/quotW=> x; elim/quotW=> y /eqP; rewrite -[_ * _]pi_mulm !piE.
-pose_big_enough n.
- by rewrite !(@interp_gtn _ n) //= !rmorph0 => /eqP /multi_idomain.
-by close.
-Qed.
-
-(* Work in progress *)
-
-End MultinomialIdomain.
-
-End Multinomial.
-End Multinomial.
-
-
-
-