(* --------------------------------------------------------------------
 * (c) Copyright 2011--2012 Microsoft Corporation and Inria.
 * (c) Copyright 2012--2014 Inria.
 * (c) Copyright 2012--2015 IMDEA Software Institute.
 *
 * You may distribute this file under the terms of the CeCILL-B license
 * -------------------------------------------------------------------- *)

(***********************************************************************)
(* {freeg K / G} = the free abelian group generated by a finite set of *)
(*                  elements of keys K and the group G.                *)
(*                                                                     *)
(* In the following, assume that g is of the form \sum_k a_k * k       *)
(*                                                                     *)
(*      dom g = the support of g   (i.e. [seq k | a_k != 0])           *)
(*  [freeg S] = builds an element of {freeg K / G}                     *)
(*              from a sequence seq (G * K)                            *)
(* fglift f g = applies f to the keys (i.e. \sum_k a_k * f k)          *)
(*  coeff k g = the coefficient of k in g (i.e. a_k)                   *)
(* <<a *g k>> = [freeg [:: a, p]] (the element a * k)                  *)
(*      <<k>> = [freeg [:: 1, p]] (the element k)                      *)
(*      deg g = \sum a_k (provided that a_k : int)                     *)
(***********************************************************************)

(* -------------------------------------------------------------------- *)
From HB Require Import structures.
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice.
From mathcomp Require Import fintype bigop order generic_quotient.
From mathcomp Require Import ssralg ssrnum ssrint.

Import Order.Theory GRing.Theory Num.Theory.

Local Open Scope ring_scope.
Local Open Scope quotient_scope.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(* -------------------------------------------------------------------- *)
Local Notation simpm := Monoid.simpm.

(* -------------------------------------------------------------------- *)
Reserved Notation "{ 'freeg' K / G }" (at level 0, K, G at level 2, format "{ 'freeg'  K  /  G }").
Reserved Notation "{ 'freeg' K }" (at level 0, K at level 2, format "{ 'freeg'  K }").
Reserved Notation "[ 'freeg' S ]" (at level 0, S at level 2, format "[ 'freeg'  S ]").
Reserved Notation "<< z *p k >>"  (at level 0, format "<< z *p k >>").
Reserved Notation "<< k >>"  (at level 0, format "<< k >>").

(* -------------------------------------------------------------------- *)
Module FreegDefs.
  Section Defs.
    Context (G : zmodType) (K : choiceType).

    Definition reduced (D : seq (G * K)) :=
      uniq [seq zx.2 | zx <- D] && all [pred zx | zx.1 != 0] D.

    Lemma reduced_uniq D : reduced D -> uniq [seq zx.2 | zx <- D].
    Proof. by case/andP. Qed.

    Record prefreeg : Type := mkPrefreeg {
      seq_of_prefreeg : seq (G * K);
      _ : reduced seq_of_prefreeg
    }.

    Local Coercion seq_of_prefreeg : prefreeg >-> seq.

    Lemma prefreeg_reduced (D : prefreeg) : reduced D.
    Proof. by case: D. Qed.

    Lemma prefreeg_uniq (D : prefreeg) : uniq [seq zx.2 | zx <- D].
    Proof. exact/reduced_uniq/prefreeg_reduced. Qed.

    #[export] HB.instance Definition _ := [isSub for seq_of_prefreeg].
    #[export] HB.instance Definition _ := [Choice of prefreeg by <:].
  End Defs.

  Arguments mkPrefreeg [G K].

  Section Quotient.
    Context (G : zmodType) (K : choiceType).

    Local Coercion seq_of_prefreeg : prefreeg >-> seq.

    Definition equiv (D1 D2 : prefreeg G K) := perm_eq D1 D2.

    Lemma equiv_refl : reflexive equiv. Proof. exact: perm_refl. Qed.
    Lemma equiv_sym : symmetric equiv. Proof. exact: perm_sym. Qed.
    Lemma equiv_trans : transitive equiv. Proof. exact: perm_trans. Qed.

    Canonical prefreeg_equiv := EquivRel equiv equiv_refl equiv_sym equiv_trans.
    Canonical prefreeg_equiv_direct := defaultEncModRel equiv.

    Definition type := {eq_quot equiv}.
    Definition type_of of phant G & phant K := type.

    Notation "{ 'freeg' K / G }" := (type_of (Phant G) (Phant K)).

    #[export] HB.instance Definition _ := Quotient.on type.
    #[export] HB.instance Definition _ := Choice.on type.
    #[export] HB.instance Definition _ : EqQuotient _ equiv type :=
      EqQuotient.on type.

    #[export] HB.instance Definition _ := Quotient.on {freeg K / G}.
    #[export] HB.instance Definition _ := Choice.on {freeg K / G}.
    #[export] HB.instance Definition _ : EqQuotient _ equiv {freeg K / G} :=
      EqQuotient.on {freeg K / G}.
  End Quotient.

  Module Exports.
    Coercion seq_of_prefreeg : prefreeg >-> seq.

    Canonical prefreeg_equiv.
    Canonical prefreeg_equiv_direct.

    HB.reexport.

    Notation prefreeg   := prefreeg.
    Notation fgequiv    := equiv.
    Notation mkPrefreeg := mkPrefreeg.

    Notation reduced := reduced.

    Notation "{ 'freeg' T / G }" := (type_of (Phant G) (Phant T)).
    Notation "{ 'freeg' T  }" := (type_of (Phant int) (Phant T)).

    Identity Coercion type_freeg_of : type_of >-> type.
  End Exports.
End FreegDefs.

Export FreegDefs.Exports.

(* -------------------------------------------------------------------- *)
Section FreegTheory.
  Section MkFreeg.
  Context (G : zmodType) (K : choiceType).
  Implicit Types (rD : prefreeg G K) (D : {freeg K / G}) (s : seq (G * K)).
  Implicit Types (z k : G) (x y : K).

  Local Notation freeg := {freeg K / G}.

  Lemma perm_eq_fgrepr rD : perm_eq (repr (\pi_freeg rD)) rD.
  Proof. by rewrite -/(fgequiv _ _); apply/eqmodP; rewrite reprK. Qed.

  Lemma reduced_uniq s : reduced s -> uniq [seq zx.2 | zx <- s].
  Proof. by case/andP. Qed.

  Lemma prefreeg_reduced rD : reduced rD.
  Proof. by case: rD. Qed.

  Lemma prefreeg_uniq rD : uniq [seq zx.2 | zx <- rD].
  Proof. exact/reduced_uniq/prefreeg_reduced. Qed.

  Fixpoint augment s z x :=
    if   s is ((z', x') as d) :: s
    then if x == x' then (z + z', x) :: s else d :: augment s z x
    else [:: (z, x)].

  Definition reduce s :=
    filter
      [pred zx | zx.1 != 0]
      (foldr (fun zx s => augment s zx.1 zx.2) [::] s).

  Definition predom s: seq K := [seq v.2 | v <- s].

  Definition dom D := [seq zx.2 | zx <- repr D].

  Lemma uniq_dom D : uniq (dom D).
  Proof. by rewrite /dom; case: repr => /= {}D /andP[]. Qed.

  Lemma reduced_cons zx s :
    reduced (zx :: s) = [&& zx.1 != 0, zx.2 \notin predom s & reduced s].
  Proof. by rewrite /reduced /= andbACA [RHS]andbCA [RHS]andbA. Qed.

  Lemma mem_augment s z x y :
    x != y -> y \notin (predom s) -> y \notin predom (augment s z x).
  Proof.
    move=> neq_xy; elim: s => [_|[z' x'] s IHs] /=.
      by rewrite mem_seq1 eq_sym.
    rewrite in_cons => /norP[neq_yx' Hys].
    have [->|neq_xx'] /= := eqVneq x x'.
      by rewrite in_cons negb_or neq_yx'.
    by rewrite in_cons negb_or neq_yx' IHs.
  Qed.

  Lemma uniq_predom_augment s z x :
    uniq (predom s) -> uniq (predom (augment s z x)).
  Proof.
    elim: s => [|[z' x'] s IHs] //=.
    by case: eqVneq => [->|neq_xx'] //= /andP [/mem_augment ->].
  Qed.

  Lemma uniq_predom_reduce s : uniq (predom (reduce s)).
  Proof.
    rewrite /reduce; set s' := (foldr _ _ _).
    apply: (subseq_uniq (s2 := predom s')).
      exact/map_subseq/filter_subseq.
    by rewrite {}/s'; elim: s=> [|[z x] s IHs] //=; exact: uniq_predom_augment.
  Qed.

  Lemma reduced_reduce s : reduced (reduce s).
  Proof.
    rewrite /reduced uniq_predom_reduce /=.
    by apply/allP=> zx; rewrite mem_filter=> /andP [].
  Qed.

  Lemma outdom_augmentE s k x :
    x \notin predom s -> augment s k x = rcons s (k, x).
  Proof.
    elim: s=> [//|[k' x'] s IHs] /=; rewrite in_cons.
    by case/norP=> /negbTE -> /IHs ->.
  Qed.

  Lemma reduce_reduced s : reduced s -> reduce s = rev s.
  Proof.
    move=> rs; rewrite /reduce; set S := foldr _ _ _.
    have ->: S = rev s; rewrite {}/S.
      elim: s rs => [//|[k x] s IHs]; rewrite reduced_cons /=.
      case/and3P=> nz_k x_notin_s rs; rewrite IHs //.
      rewrite rev_cons outdom_augmentE //; move: x_notin_s.
      by rewrite /predom map_rev mem_rev.
    rewrite (eq_in_filter (a2 := predT)) ?filter_predT //.
    by move=> kx; rewrite mem_rev /=; case/andP: rs => _ /allP /(_ kx).
  Qed.

  Lemma reduceK s : reduced s -> perm_eq (reduce s) s.
  Proof. by move/reduce_reduced=> ->; rewrite perm_rev. Qed.

  Definition Prefreeg s := mkPrefreeg (reduce s) (reduced_reduce s).

  Lemma PrefreegK rD : Prefreeg rD = rD %[mod_eq (@fgequiv G K)].
  Proof. exact/eqmodP/reduceK/prefreeg_reduced. Qed.

  Definition Freeg := lift_embed {freeg K / G} Prefreeg.
  Canonical to_freeg_pi_morph := PiEmbed Freeg.

  End MkFreeg.

  Local Notation "[ 'freeg' S ]" := (Freeg S).

  Local Notation "<< z *g p >>" := [freeg [:: (z, p)]].
  Local Notation "<< p >>"      := [freeg [:: (1, p)]].

  (* ------------------------------------------------------------------ *)
  Section ZLift.
  Context (R : ringType) (M : lmodType R) (K : choiceType) (f : K -> M).
  Implicit Types (rD : prefreeg R K) (D : {freeg K / R}) (s : seq (R * K)).
  Implicit Types (z k : R) (x y : K).

  Definition prelift s : M := \sum_(x <- s) x.1 *: f x.2.

  Definition prefreeg_opp s := [seq (-xz.1, xz.2) | xz <- s].

  Lemma prelift_nil : prelift [::] = 0. Proof. exact: big_nil. Qed.

  Lemma prelift_cons s k x : prelift ((k, x) :: s) = k *: f x + prelift s.
  Proof. exact: big_cons. Qed.

  Lemma prelift_cat s1 s2 : prelift (s1 ++ s2) = prelift s1 + prelift s2.
  Proof. exact: big_cat. Qed.

  Lemma prelift_opp s : prelift (prefreeg_opp s) = - prelift s.
  Proof.
    by rewrite [LHS]big_map -sumrN; apply: eq_bigr => i _; rewrite scaleNr.
  Qed.

  Lemma prelift_seq1 k x : prelift [:: (k, x)] = k *: f x.
  Proof. exact: big_seq1. Qed.

  Lemma prelift_perm_eq s1 s2 : perm_eq s1 s2 -> prelift s1 = prelift s2.
  Proof. exact: perm_big. Qed.

  Lemma prelift_augment s k x : prelift (augment s k x) = k *: f x + prelift s.
  Proof.
    elim: s => [|[k' x'] s IHs] //=.
      by rewrite prelift_seq1 prelift_nil addr0.
    have [->|ne_xx'] := eqVneq x x'.
      by rewrite !prelift_cons scalerDl addrA.
      by rewrite !prelift_cons IHs addrCA.
  Qed.

  Lemma prelift_reduce s : prelift (reduce s) = prelift s.
  Proof.
    rewrite /reduce; set S := foldr _ _ _; set rD := filter _ _.
    have ->: prelift rD = prelift S; rewrite {}/rD.
      elim: S => [//|[k x] S IHS] /=; have [->|nz_k] := eqVneq k 0.
        by rewrite /= prelift_cons scale0r add0r.
      by rewrite !prelift_cons IHS.
    rewrite {}/S; elim: s => [//|[k x] s IHs].
    by rewrite prelift_cons /= prelift_augment IHs.
  Qed.

  Lemma prelift_repr rD : prelift (repr (\pi_{freeg K / R} rD)) = prelift rD.
  Proof. by rewrite (prelift_perm_eq (perm_eq_fgrepr _)). Qed.

  Definition lift (rD : prefreeg _ _) := prelift rD.
  Definition fglift := lift_fun1 {freeg K / R} lift.

  Lemma pi_fglift : {mono \pi_{freeg K / R} : D / lift D >-> fglift D}.
  Proof.
    by case=> [s reds]; unlock fglift; exact/prelift_perm_eq/perm_eq_fgrepr.
  Qed.

  Canonical pi_fglift_morph := PiMono1 pi_fglift.

  Lemma fglift_Freeg s : fglift [freeg s] = prelift s.
  Proof.
    unlock Freeg; unlock fglift; rewrite ?piE /lift.
    rewrite (prelift_perm_eq (perm_eq_fgrepr _)) /=.
    exact: prelift_reduce.
  Qed.

  Lemma liftU k x : fglift << k *g x >> = k *: f x.
  Proof. by rewrite fglift_Freeg prelift_seq1. Qed.

  End ZLift.

  (* -------------------------------------------------------------------- *)
  Context (R : ringType) (K : choiceType).
  Implicit Types (rD : prefreeg R K) (D : {freeg K / R}) (s : seq (R * K)).
  Implicit Types (z k : R) (x y : K).

  Definition coeff x D : R := fglift (fun y => (y == x)%:R : R^o) D.

  Lemma coeffU k x y : coeff y << k *g x >> = k * (x == y)%:R.
  Proof. by rewrite /coeff liftU. Qed.

  Definition precoeff x s : R := \sum_(kx <- s | kx.2 == x) kx.1.

  Lemma precoeffE x : precoeff x =1 prelift (fun y => (y == x)%:R : R^o).
  Proof.
    move=> s; rewrite [RHS](bigID [pred kx | kx.2 == x]) /= addrC big1.
      by rewrite add0r; apply: eq_bigr => i /eqP ->; rewrite eqxx [_ *: _]mulr1.
    by move=> i /negbTE ->; rewrite scaler0.
  Qed.

  Lemma precoeff_nil x : precoeff x [::] = 0.
  Proof. exact: big_nil. Qed.

  Lemma precoeff_cons x s y k :
    precoeff x ((k, y) :: s) = (y == x)%:R * k + precoeff x s.
  Proof. by rewrite [LHS]big_cons /=; case: eqP; rewrite !simpm. Qed.

  Lemma precoeff_cat x s1 s2 :
    precoeff x (s1 ++ s2) = precoeff x s1 + precoeff x s2.
  Proof. by rewrite !precoeffE prelift_cat. Qed.

  Lemma precoeff_opp x s : precoeff x (prefreeg_opp s) = - precoeff x s.
  Proof. by rewrite !precoeffE prelift_opp. Qed.

  Lemma precoeff_perm_eq x s1 s2 :
    perm_eq s1 s2 -> precoeff x s1 = precoeff x s2.
  Proof. by rewrite !precoeffE => /prelift_perm_eq ->. Qed.

  Lemma precoeff_repr x rD :
    precoeff x (repr (\pi_{freeg K / R} rD)) = precoeff x rD.
  Proof. by rewrite !precoeffE prelift_repr. Qed.

  Lemma precoeff_reduce x s : precoeff x (reduce s) = precoeff x s.
  Proof. by rewrite !precoeffE prelift_reduce. Qed.

  Lemma precoeff_outdom x s : x \notin predom s -> precoeff x s = 0.
  Proof.
    move=> x_notin_s; rewrite /precoeff big_seq_cond big_pred0 //; case => k z.
    by apply/contraNF: x_notin_s => /andP[+ /eqP<-]; apply: map_f.
  Qed.

  Lemma reduced_mem s k x :
    reduced s -> ((k, x) \in s) = (precoeff x s == k) && (k != 0).
  Proof.
    elim: s => [|[k' x'] s IHs] /=.
      by rewrite in_nil precoeff_nil eq_sym andbN.
    rewrite reduced_cons in_cons precoeff_cons.
    case/and3P=> [/= nz_k' x'Ns /IHs ->]; rewrite eqE /=.
    case: (eqVneq x' x) x'Ns => [-> xNs|nz_x's].
      rewrite andbT mul1r precoeff_outdom // addr0.
      by have [->|_] //= := eqVneq k k'; case: eqVneq.
    by rewrite andbF mul0r add0r.
  Qed.

  Lemma coeff_Freeg x s : coeff x [freeg s] = precoeff x s.
  Proof. by rewrite /coeff fglift_Freeg precoeffE. Qed.

  Lemma freegequivP s1 s2 (hs1 : reduced s1) (hs2 : reduced s2) :
    reflect
      (precoeff^~ s1 =1 precoeff^~ s2)
      (fgequiv (mkPrefreeg s1 hs1) (mkPrefreeg s2 hs2)).
  Proof.
    apply: (iffP idP); rewrite /fgequiv /=.
      by move=> H k; apply: precoeff_perm_eq.
    move=> H; apply: uniq_perm.
    - by move/reduced_uniq/map_uniq: hs1.
    - by move/reduced_uniq/map_uniq: hs2.
    by move=> [z k]; rewrite !reduced_mem // H.
  Qed.

  Lemma fgequivP rD1 rD2 :
    reflect (precoeff^~ rD1 =1 precoeff^~ rD2) (fgequiv rD1 rD2).
  Proof. by case: rD1 rD2 => [s1 HD1] [s2 HD2]; apply/freegequivP. Qed.

  Lemma freeg_eqP D1 D2 : reflect (coeff^~ D1 =1 coeff^~ D2) (D1 == D2).
  Proof.
    apply: (iffP idP) => [/eqP -> //|].
    elim/quotW: D1 => D1; elim/quotW: D2 => D2.
    move=> eqc; rewrite eqmodE; apply/fgequivP=> k.
    by move: (eqc k); rewrite /coeff !piE !precoeffE.
  Qed.

  Lemma perm_eq_Freeg s1 s2 : perm_eq s1 s2 -> [freeg s1] = [freeg s2].
  Proof.
    move=> peq; apply/eqP/freeg_eqP=> k.
    by rewrite !coeff_Freeg; apply: precoeff_perm_eq.
  Qed.

  Lemma freeg_repr D : [freeg (repr D)] = D.
  Proof.
    apply/eqP/freeg_eqP=> k.
    by rewrite coeff_Freeg precoeffE /coeff; unlock fglift.
  Qed.

  Lemma Freeg_dom D : [freeg [seq (coeff x D, x) | x <- dom D]] = D.
  Proof.
    apply/esym/eqP/freeg_eqP=> k.
    rewrite -{1 2}[D]freeg_repr !coeff_Freeg /dom.
    case: (repr D)=> {}D rD /=; rewrite -map_comp map_id_in //.
    move=> [z x]; rewrite reduced_mem // => /andP [/eqP <- _].
    by rewrite /= coeff_Freeg.
  Qed.

  (* -------------------------------------------------------------------- *)
  Lemma precoeff_uniqE s x :
    uniq (predom s) -> precoeff x s = [seq v.1 | v <- s]`_(index x (predom s)).
  Proof.
    elim: s => [|[z y s ih]]; first by rewrite precoeff_nil nth_nil.
    rewrite precoeff_cons /= => /andP [x_notin_s /ih ->].
    have [->|ne_yx] := eqVneq x y; last by rewrite mul0r add0r.
    by rewrite mul1r /= nth_default ?addr0 // memNindex //= !size_map.
  Qed.

  Lemma precoeff_mem_uniqE s kz :
     uniq (predom s) -> kz \in s -> precoeff kz.2 s = kz.1.
  Proof.
    move=> uniq_dom_s kz_in_s; have uniq_s := map_uniq uniq_dom_s.
    rewrite precoeff_uniqE // (nth_map kz); last first.
      by rewrite -(size_map (@snd _ _)) index_mem map_f.
    rewrite nth_index_map // => {kz kz_in_s} kz1 kz2 kz1_in_s kz2_in_s eq.
    apply/eqP.
    rewrite -[kz1](nth_index kz1 (s := s)) // -[kz2](nth_index kz1 (s := s)) //.
    rewrite nth_uniq ?index_mem // -(nth_uniq kz1.2 (s := predom s)) //;
      try by rewrite size_map index_mem.
    by rewrite !(nth_map kz1) ?index_mem // !nth_index // eq eqxx.
  Qed.

  Lemma mem_dom D x : (x \in dom D) = (coeff x D != 0).
  Proof.
    elim/quotW: D; case=> D rD.
    rewrite /dom (perm_mem (perm_map _ (perm_eq_fgrepr _))) /=.
    unlock coeff; rewrite !piE /lift /= -precoeffE.
    case/andP: rD => uniqD /allP /= rD; rewrite precoeff_uniqE //.
    apply/idP/idP; last apply: contra_neqT; move=> x_in_D; last first.
      by rewrite nth_default // memNindex // !size_map.
    rewrite (nth_map (0, x)); last first.
      by rewrite -(size_map (@snd _ _)) index_mem x_in_D.
    by apply/rD/mem_nth; rewrite -(size_map (@snd _ _)) index_mem.
  Qed.

  Lemma coeff_outdom D x : x \notin dom D -> coeff x D = 0.
  Proof. by rewrite mem_dom negbK => /eqP. Qed.
End FreegTheory.

Notation "[ 'freeg' S ]" := (Freeg S).

Notation "<< z *g p >>" := [freeg [:: (z, p)]].
Notation "<< p >>"      := [freeg [:: (1, p)]].

(* -------------------------------------------------------------------- *)
Module FreegZmodType.
  Section Defs.
    Context (R : ringType) (K : choiceType).
    Implicit Types (rD : prefreeg R K) (D : {freeg K / R}) (s : seq (R * K)).
    Implicit Types (z k : R) (x y : K).

    Local Notation zero := [freeg [::]].

    Lemma reprfg0 : repr zero = Prefreeg [::] :> prefreeg R K.
    Proof.
      by apply/eqP; rewrite !piE eqE; apply/eqP/perm_small_eq/perm_eq_fgrepr.
    Qed.

    Definition fgadd_r rD1 rD2 := Prefreeg (rD1 ++ rD2).

    Definition fgadd := lift_op2 {freeg K / R} fgadd_r.

    Lemma pi_fgadd : {morph \pi : D1 D2 / fgadd_r D1 D2 >-> fgadd D1 D2}.
    Proof.
      case=> [D1 redD1] [D2 redD2]; unlock fgadd; rewrite ?piE.
      apply/eqmodP/freegequivP => k /=.
      by rewrite !precoeff_reduce !precoeff_cat !precoeff_repr.
    Qed.

    Canonical pi_fgadd_morph := PiMorph2 pi_fgadd.

    Definition fgopp_r rD := Prefreeg (prefreeg_opp rD).

    Definition fgopp := lift_op1 {freeg K / R} fgopp_r.

    Lemma pi_fgopp : {morph \pi : D / fgopp_r D >-> fgopp D}.
    Proof.
      case=> [D redD]; unlock fgopp; rewrite ?piE.
      apply/eqmodP/freegequivP => k /=.
      by rewrite !precoeff_reduce !precoeff_opp !precoeff_repr.
    Qed.

    Canonical pi_fgopp_morph := PiMorph1 pi_fgopp.

    Lemma addmA : associative fgadd.
    Proof.
      elim/quotW=> [D1]; elim/quotW=> [D2]; elim/quotW=> [D3].
      unlock fgadd; rewrite ?piE; apply/eqmodP/freegequivP => k /=.
      by rewrite !(precoeff_reduce, precoeff_cat, precoeff_repr) addrA.
    Qed.

    Lemma addmC : commutative fgadd.
    Proof.
      elim/quotW=> [D1]; elim/quotW=> [D2].
      unlock fgadd; rewrite ?piE; apply/eqmodP/freegequivP => k /=.
      by rewrite !(precoeff_reduce, precoeff_cat, precoeff_repr) addrC.
    Qed.

    Lemma addm0 : left_id zero fgadd.
    Proof.
      elim/quotW=> [[D redD]]; unlock fgadd; rewrite !(reprfg0, piE).
      apply/eqmodP/freegequivP=> /= k.
      by rewrite precoeff_reduce precoeff_repr.
    Qed.

    Lemma addmN : left_inverse zero fgopp fgadd.
    Proof.
      elim/quotW=> [[D redD]]; unlock fgadd fgopp; rewrite !(reprfg0, piE).
      apply/eqmodP/freegequivP=> /= k.
      set rw := (precoeff_reduce, precoeff_repr,
                 precoeff_cat   , precoeff_opp ,
                 precoeff_repr  , precoeff_nil ).
      by rewrite !rw /= addrC subrr.
    Qed.

    #[export] HB.instance Definition _ := GRing.isZmodule.Build {freeg K / R}
      addmA addmC addm0 addmN.
  End Defs.

  Module Exports.
    Canonical pi_fgadd_morph.
    Canonical pi_fgopp_morph.
    HB.reexport.
  End Exports.
End FreegZmodType.

Import FreegZmodType.
Export FreegZmodType.Exports.

(* -------------------------------------------------------------------- *)
Section FreegZmodTypeTheory.
  Context (R : ringType) (K : choiceType).
  Implicit Types (x y z : K) (k : R) (D: {freeg K / R}).

  Local Notation coeff := (@coeff R K).

  (* -------------------------------------------------------------------- *)
  Section Lift.
    Context (M : lmodType R) (f : K -> M).

    Lemma lift_is_additive : additive (fglift f).
    Proof.
      elim/quotW=> [[D1 /= H1]]; elim/quotW=> [[D2 /= H2]].
      unlock fglift; rewrite ?piE [_ + _]piE /lift /=.
      rewrite !prelift_repr /fgadd_r /fgopp_r /=.
      by rewrite !(prelift_reduce, prelift_cat, prelift_opp).
    Qed.
  End Lift.

  (* -------------------------------------------------------------------- *)
  Lemma coeff_is_additive x : additive (coeff x).
  Proof. exact: lift_is_additive R^o _. Qed.

  #[export] HB.instance Definition _ x :=
    GRing.isAdditive.Build {freeg K / R} R (coeff x)
      (coeff_is_additive x).

  Lemma coeff0   z   : coeff z 0 = 0               . Proof. exact: raddf0. Qed.
  Lemma coeffN   z   : {morph coeff z: x / - x}    . Proof. exact: raddfN. Qed.
  Lemma coeffD   z   : {morph coeff z: x y / x + y}. Proof. exact: raddfD. Qed.
  Lemma coeffB   z   : {morph coeff z: x y / x - y}. Proof. exact: raddfB. Qed.
  Lemma coeffMn  z n : {morph coeff z: x / x *+ n} . Proof. exact: raddfMn. Qed.
  Lemma coeffMNn z n : {morph coeff z: x / x *- n} . Proof. exact: raddfMNn. Qed.

  (* ------------------------------------------------------------------ *)
  Lemma dom0 : dom (0 : {freeg K / R}) = [::] :> seq K.
  Proof.
    apply/perm_small_eq/uniq_perm => //; first exact: uniq_dom.
    by move=> z; rewrite mem_dom coeff0 eqxx.
  Qed.

  (* ------------------------------------------------------------------ *)
  Lemma dom_eq0 (D : {freeg K / R}) : (dom D == [::]) = (D == 0).
  Proof.
    apply/eqP/idP => [z_domD|/eqP ->]; last exact: dom0.
    by apply/freeg_eqP => z; rewrite coeff0 coeff_outdom // z_domD in_nil.
  Qed.

  (* ------------------------------------------------------------------ *)
  Lemma domU (c : R) (x : K) : c != 0 -> dom << c *g x >> = [:: x].
  Proof.
    move=> nz_c; apply/perm_small_eq/uniq_perm => //; first exact: uniq_dom.
    move=> y; rewrite mem_dom coeffU mem_seq1.
    by case: (eqVneq x); rewrite /= ?(mulr0, mulr1, eqxx).
  Qed.

  (* -------------------------------------------------------------------*)
  Lemma domU1 z : dom (<< z >> : {freeg K / R}) = [:: z].
  Proof. by rewrite domU ?oner_eq0. Qed.

  (* -------------------------------------------------------------------*)
  Lemma domN D : dom (-D) =i dom D.
  Proof. by move=> z; rewrite !mem_dom coeffN oppr_eq0. Qed.

  Lemma domN_perm_eq D : perm_eq (dom (- D)) (dom D).
  Proof. by apply: uniq_perm; rewrite ?uniq_dom //; apply: domN. Qed.

  (* ------------------------------------------------------------------ *)
  Lemma domD_perm_eq D1 D2 :
       [predI (dom D1) & (dom D2)] =1 pred0
    -> perm_eq (dom (D1 + D2)) (dom D1 ++ dom D2).
  Proof.
    move=> D12_nI; apply/uniq_perm; first exact: uniq_dom.
      rewrite cat_uniq !uniq_dom andbT; apply/hasPn => p p_in_D2.
      by move: (D12_nI p); rewrite /= p_in_D2 andbT => /negbT.
    move=> p; move: (D12_nI p); rewrite /= mem_cat !mem_dom coeffD.
    have [->|nz_D1p] /= := eqVneq (coeff p D1) 0; first by rewrite add0r.
    by move=> /negbFE /eqP ->; rewrite addr0.
  Qed.

  Lemma domD D1 D2 x :
       [predI (dom D1) & (dom D2)] =1 pred0
    -> (x \in dom (D1 + D2)) = (x \in dom D1) || (x \in dom D2).
  Proof. by move/domD_perm_eq/perm_mem/(_ x); rewrite mem_cat. Qed.

  (* ------------------------------------------------------------------ *)
  Lemma domD_subset D1 D2 : {subset dom (D1 + D2) <= dom D1 ++ dom D2}.
  Proof.
    move=> z; rewrite mem_cat !mem_dom coeffD.
    have nz_sum (x1 x2 : R): x1 + x2 != 0 -> (x1 != 0) || (x2 != 0).
      by have [->|] := eqVneq x1 0; first by rewrite add0r.
    by move=> /nz_sum /orP [] ->; rewrite ?orbT.
  Qed.

  (* ------------------------------------------------------------------ *)
  Lemma dom_sum_subset (I : Type) (r : seq I) (F : I -> {freeg K / R}) (P : pred I) :
    {subset dom (\sum_(i <- r | P i) F i) <= flatten [seq dom (F i) | i <- r & P i]}.
  Proof.
    move=> p; elim: r => [|r rs IH]; first by rewrite big_nil dom0.
    rewrite big_cons; case Pr: (P r); last by move/IH=> /=; rewrite Pr.
    move/domD_subset; rewrite mem_cat /= Pr => /orP[|/IH].
    + by rewrite map_cons /= mem_cat=> ->.
    + by rewrite map_cons /= mem_cat=> ->; rewrite orbT.
  Qed.

  (* ------------------------------------------------------------------ *)
  Lemma domB D1 D2 : {subset dom (D1 - D2) <= (dom D1) ++ (dom D2)}.
  Proof. by move=> z /domD_subset; rewrite !mem_cat domN. Qed.

  (* ------------------------------------------------------------------ *)
  Lemma freegUD k1 k2 x : << k1 *g x >> + << k2 *g x >> = << (k1 + k2) *g x >>.
  Proof. by apply/eqP/freeg_eqP=> z; rewrite coeffD !coeffU -mulrDl. Qed.

  Lemma freegUN k x : - << k *g x >> = << -k *g x >>.
  Proof. by apply/eqP/freeg_eqP=> z; rewrite coeffN !coeffU mulNr. Qed.

  Lemma freegUB k1 k2 x : << k1 *g x >> - << k2 *g x >> = << (k1-k2) *g x >>.
  Proof. by rewrite freegUN freegUD. Qed.

  Lemma freegU0 x : << 0 *g x >> = 0 :> {freeg K / R}.
  Proof. by apply/eqP/freeg_eqP=> y; rewrite coeffU coeff0 mul0r. Qed.

  Lemma freegU_eq0 k x : (<< k *g x >> == 0) = (k == 0).
  Proof.
    apply/eqP/eqP => [/(congr1 (coeff x))|->]; last by rewrite freegU0.
    by rewrite coeff0 coeffU eqxx mulr1.
  Qed.

  (* -------------------------------------------------------------------- *)
  Lemma freeg_muln k n (S : K) : << k *g S >> *+ n = << (k *+ n) *g S >>.
  Proof.
    elim: n => [|n ih].
    + by rewrite !mulr0n freegU0.
    + by rewrite !mulrS ih freegUD.
  Qed.

  Lemma freegU_muln n (S : K) : << S >> *+ n = << n%:R *g S >> :> {freeg K / R}.
  Proof. by rewrite freeg_muln. Qed.

  Lemma freeg_mulz k (m : int) (S : K) : << k *g S >> *~ m = << k *~ m *g S >>.
  Proof.
    case: m=> [n|n].
    + by rewrite -pmulrn freeg_muln.
    + by rewrite NegzE -nmulrn freeg_muln mulrNz freegUN.
  Qed.

  Lemma freegU_mulz (m : int) (S : K) :
    << S >> *~ m = << m%:~R *g S >> :> {freeg K / R}.
  Proof. by rewrite freeg_mulz. Qed.

  (* -------------------------------------------------------------------- *)
  Lemma freeg_nil : [freeg [::]] = 0 :> {freeg K / R}.
  Proof. exact/eqP/freeg_eqP. Qed.

  Lemma freeg_cat (s1 s2 : seq (R * K)) :
    [freeg s1 ++ s2] = [freeg s1] + [freeg s2].
  Proof.
    by apply/eqP/freeg_eqP => k; rewrite coeffD !coeff_Freeg precoeff_cat.
  Qed.

  (* -------------------------------------------------------------------- *)
  Definition fgenum D : seq (R * K) := repr D.

  Lemma Freeg_enum D : Freeg (fgenum D) = D.
  Proof.
    elim/quotW: D; case=> D rD /=; unlock Freeg.
    exact/eqmodP/perm_trans/perm_eq_fgrepr/reduceK/prefreeg_reduced.
  Qed.

  Lemma perm_eq_fgenum (s : seq (R * K)) (rD : reduced s) :
    perm_eq (fgenum (\pi_{freeg K / R} (mkPrefreeg s rD))) s.
  Proof. exact: perm_eq_fgrepr. Qed.

  (* -------------------------------------------------------------------- *)
  Lemma freeg_sumE D : \sum_(z <- dom D) << (coeff z D) *g z >> = D.
  Proof.
    apply/eqP/freeg_eqP=> x /=; rewrite raddf_sum /=.
    case x_in_dom: (x \in dom D); last rewrite coeff_outdom ?x_in_dom //.
    + rewrite (bigD1_seq x) ?uniq_dom //= big1 ?addr0.
      * by rewrite coeffU eqxx mulr1.
      * by move=> z ne_z_x; rewrite coeffU (negbTE ne_z_x) mulr0.
    + rewrite big_seq big1 // => z z_notin_dom; rewrite coeffU.
      have ->: (z == x)%:R = 0 :> R; last by rewrite mulr0.
      by case: (z =P x)=> //= eq_zx; rewrite eq_zx x_in_dom in z_notin_dom.
  Qed.
End FreegZmodTypeTheory.

(* -------------------------------------------------------------------- *)
Section FreeglModType.
  Context (R : ringType) (K : choiceType).
  Implicit Types (x y z : K) (c k : R) (D: {freeg K / R}).

  Local Notation coeff := (@coeff R K).

  Definition fgscale c D := \sum_(x <- dom D) << c * (coeff x D) *g x >>.

  Local Notation "c *:F D" := (fgscale c D)
    (at level 40, left associativity).

  Lemma coeff_fgscale c D x : coeff x (c *:F D) = c * (coeff x D).
  Proof.
    rewrite -{2}[D]freeg_sumE /fgscale !raddf_sum /=.
    by rewrite mulr_sumr; apply/eq_bigr=> i _; rewrite !coeffU mulrA.
  Qed.

  Lemma fgscaleA c1 c2 D : c1 *:F (c2 *:F D) = (c1 * c2) *:F D.
  Proof. by apply/eqP/freeg_eqP=> x; rewrite !coeff_fgscale mulrA. Qed.

  Lemma fgscale1r D : 1 *:F D = D.
  Proof. by apply/eqP/freeg_eqP=> x; rewrite !coeff_fgscale mul1r. Qed.

  Lemma fgscaleDr c D1 D2 : c *:F (D1 + D2) = c *:F D1 + c *:F D2.
  Proof.
    by apply/eqP/freeg_eqP=> x; rewrite !(coeffD, coeff_fgscale) mulrDr.
  Qed.

  Lemma fgscaleDl D c1 c2 : (c1 + c2) *:F D = c1 *:F D + c2 *:F D.
  Proof.
    by apply/eqP/freeg_eqP=> x; rewrite !(coeffD, coeff_fgscale) mulrDl.
  Qed.

  HB.instance Definition _ := GRing.Zmodule_isLmodule.Build R {freeg K / R}
    fgscaleA fgscale1r fgscaleDr fgscaleDl.
End FreeglModType.

(* -------------------------------------------------------------------- *)
Section FreeglModTheory.
  Context (R : ringType) (K : choiceType).
  Implicit Types (x y z : K) (c k : R) (D : {freeg K / R}).

  Local Notation coeff := (@coeff R K).

  Lemma coeffZ c D x : coeff x (c *: D) = c * coeff x D.
  Proof. by rewrite coeff_fgscale. Qed.

  Lemma domZ_subset c D : {subset dom (c *: D) <= dom D}.
  Proof.
    move=> x; rewrite !mem_dom coeffZ.
    by case: (coeff _ _ =P 0)=> // ->; rewrite mulr0 eqxx.
  Qed.
End FreeglModTheory.

(* -------------------------------------------------------------------- *)
Section FreeglModTheoryId.
  Context (R : idomainType) (K : choiceType).
  Implicit Types (x y z : K) (c k : R) (D: {freeg K / R}).

  Local Notation coeff := (@coeff R K).

  Lemma domZ c D : c != 0 -> dom (c *: D) =i dom D.
  Proof. by move=> nz_c x; rewrite !mem_dom coeffZ mulf_eq0 negb_or nz_c. Qed.
End FreeglModTheoryId.

(* -------------------------------------------------------------------- *)
Section Deg.
  Context (K : choiceType).

  (* -------------------------------------------------------------------- *)
  Definition deg (D : {freeg K / int}) : int :=
    fglift (fun _ => (1%:Z : int^o)) D.

  Lemma degU k z : deg << k *g z >> = k.
  Proof. by rewrite /deg liftU /GRing.scale /= mulr1. Qed.

  Definition predeg (D : seq (int * K)) := \sum_(kx <- D) kx.1.

  Lemma deg_is_additive: additive deg.
  Proof. exact: (@lift_is_additive _ K int^o). Qed.

  #[export] HB.instance Definition _ :=
    GRing.isAdditive.Build {freeg K / int} int deg
      deg_is_additive.

  Lemma deg0     : deg 0 = 0               . Proof. exact: raddf0. Qed.
  Lemma degN     : {morph deg: x / - x}    . Proof. exact: raddfN. Qed.
  Lemma degD     : {morph deg: x y / x + y}. Proof. exact: raddfD. Qed.
  Lemma degB     : {morph deg: x y / x - y}. Proof. exact: raddfB. Qed.
  Lemma degMn  n : {morph deg: x / x *+ n} . Proof. exact: raddfMn. Qed.
  Lemma degMNn n : {morph deg: x / x *- n} . Proof. exact: raddfMNn. Qed.

  Lemma predegE : predeg =1 prelift (fun _ => 1%:Z : int^o).
  Proof.
    move=> D; rewrite /predeg /prelift; apply: eq_bigr.
    by move=> i _; rewrite /GRing.scale /= mulr1.
  Qed.

  Lemma predeg_nil : predeg [::] = 0.
  Proof. by rewrite /predeg big_nil. Qed.

  Lemma predeg_cons D k x : predeg ((k, x) :: D) = k + predeg D.
  Proof. by rewrite /predeg big_cons. Qed.

  Lemma predeg_cat D1 D2 : predeg (D1 ++ D2) = predeg D1 + predeg D2.
  Proof. by rewrite !predegE prelift_cat. Qed.

  Lemma predeg_opp D : predeg (prefreeg_opp D) = - predeg D.
  Proof. by rewrite !predegE prelift_opp. Qed.

  Lemma predeg_perm_eq D1 D2 : perm_eq D1 D2 -> predeg D1 = predeg D2.
  Proof. by rewrite !predegE => /prelift_perm_eq ->. Qed.

  Lemma predeg_repr D : predeg (repr (\pi_{freeg K / int} D)) = predeg D.
  Proof. by rewrite !predegE prelift_repr. Qed.

  Lemma predeg_reduce D : predeg (reduce D) = predeg D.
  Proof. by rewrite !predegE prelift_reduce. Qed.
End Deg.

(* -------------------------------------------------------------------- *)
Reserved Notation "D1 <=g D2" (at level 50, no associativity).

Section FreegCmp.
  Context (G : numDomainType) (K : choiceType).

  Definition fgle (D1 D2 : {freeg K / G}) :=
    all [pred z | coeff z D1 <= coeff z D2] (dom D1 ++ dom D2).

  Local Notation "D1 <=g D2" := (fgle D1 D2).

  Lemma fgleP D1 D2 : reflect (forall z, coeff z D1 <= coeff z D2) (D1 <=g D2).
  Proof.
    apply: (iffP allP); last by move=> H z _; apply: H.
    move=> lec z; case z_in_dom: (z \in (dom D1 ++ dom D2)).
      exact: lec.
    move: z_in_dom; rewrite mem_cat; case/norP=> zD1 zD2.
    by rewrite !coeff_outdom // lexx.
  Qed.

  Lemma fgposP D : reflect (forall z, 0 <= coeff z D) (0 <=g D).
  Proof.
    apply: (iffP idP).
    + by move=> posD z; move/fgleP/(_ z): posD; rewrite coeff0.
    + by move=> posD; apply/fgleP=> z; rewrite coeff0.
  Qed.

  Lemma fgledd D : D <=g D.
  Proof. by apply/fgleP=> z; rewrite lexx. Qed.

  Lemma fgle_trans : transitive fgle.
  Proof.
    move=> D2 D1 D3 le12 le23; apply/fgleP=> z.
    by rewrite (@le_trans _ _ (coeff z D2)) //; apply/fgleP.
  Qed.
End FreegCmp.

Local Notation "D1 <=g D2" := (fgle D1 D2).

(* -------------------------------------------------------------------- *)
Section FreegCmpDom.
  Context (K : choiceType).

  Lemma dompDl (D1 D2 : {freeg K}) :
    0 <=g D1 -> 0 <=g D2 -> dom (D1 + D2) =i dom D1 ++ dom D2.
  Proof.
    move=> pos_D1 pos_D2 z; rewrite mem_cat !mem_dom coeffD.
    by rewrite paddr_eq0; first 1 [rewrite negb_and] || apply/fgposP.
  Qed.
End FreegCmpDom.

(* -------------------------------------------------------------------- *)
Section FreegMap.
  Context (G : ringType) (K : choiceType) (P : pred K) (f : G -> G).
  Implicit Types (D : {freeg K / G}).

  Definition fgmap D := \sum_(z <- dom D | P z) << f (coeff z D) *g z >>.

  Lemma fgmap_coeffE (D : {freeg K / G}) z :
    z \in dom D -> coeff z (fgmap D) = f (coeff z D) *+ P z.
  Proof.
    move=> zD; rewrite /fgmap raddf_sum /= -big_filter; case Pz: (P z).
    + rewrite (bigD1_seq z) ?(filter_uniq, uniq_dom) //=; last first.
        by rewrite mem_filter Pz.
      rewrite coeffU eqxx mulr1 big1 ?addr0 //.
      by move=> z' ne_z'z; rewrite coeffU (negbTE ne_z'z) mulr0.
    + rewrite big_seq big1 ?mulr0 //.
      move=> z' z'PD; rewrite coeffU; have/negbTE->: z' != z.
        apply/eqP=> /(congr1 (fun x => x \in filter P (dom D))).
        by rewrite z'PD mem_filter Pz.
      by rewrite mulr0.
  Qed.

  Lemma fgmap_dom D : {subset dom (fgmap D) <= filter P (dom D)}.
  Proof.
    move=> z; rewrite mem_dom mem_filter andbC.
    case zD: (z \in (dom D)) => /=.
    + rewrite fgmap_coeffE //; case: (P _)=> //=.
      by rewrite mulr0n eqxx.
    + rewrite /fgmap raddf_sum /= big_seq_cond big1 ?eqxx //.
      move=> z' /andP [z'D _]; rewrite coeffU.
      have/negbTE->: z' != z; last by rewrite mulr0.
      apply/eqP=> /(congr1 (fun x => x \in dom D)).
      by rewrite  zD z'D.
  Qed.

  Lemma fgmap_f0_coeffE (D : {freeg K / G}) z :
    f 0 = 0 -> coeff z (fgmap D) = f (coeff z D) *+ P z.
  Proof.
    move=> z_f0; case zD: (z \in dom D).
      by rewrite fgmap_coeffE.
    rewrite !coeff_outdom ?z_f0 ?zD ?mul0rn //.
    by apply/negP=> /fgmap_dom; rewrite mem_filter zD andbF.
  Qed.
End FreegMap.

(* -------------------------------------------------------------------- *)
Section FreegNorm.
  Variable (G : numDomainType) (K : choiceType).
  Implicit Types (D : {freeg K / G}).

  Definition fgnorm D : {freeg K / G} := fgmap xpredT Num.norm D.

  Lemma fgnormE D : fgnorm D = \sum_(z <- dom D) << `|coeff z D| *g z >>.
  Proof. by []. Qed.

  Lemma coeff_fgnormE D z : coeff z (fgnorm D) = `|coeff z D|.
  Proof. by rewrite fgmap_f0_coeffE ?mulr1n // normr0. Qed.
End FreegNorm.

(* -------------------------------------------------------------------- *)
Section FreegPosDecomp.
  Variable (G : realDomainType) (K : choiceType).
  Implicit Types (D : {freeg K / G}).

  Definition fgpos D: {freeg K / G} :=
    fgmap [pred z | coeff z D >= 0] Num.norm D.

  Definition fgneg D: {freeg K / G} :=
    fgmap [pred z | coeff z D <= 0] Num.norm D.

  Lemma fgposE D :
    fgpos D = \sum_(z <- dom D | coeff z D >= 0) << `|coeff z D| *g z >>.
  Proof. by []. Qed.

  Lemma fgnegE D :
    fgneg D = \sum_(z <- dom D | coeff z D <= 0) << `|coeff z D| *g z >>.
  Proof. by []. Qed.

  Lemma fgposN D : fgpos (- D) = fgneg D.
  Proof.
    apply/eqP/freeg_eqP=> z.
    by rewrite !fgmap_f0_coeffE ?normr0 //= !coeffN oppr_ge0 normrN.
  Qed.

  Lemma fgpos_le0 D : 0 <=g fgpos D.
  Proof.
    by apply/fgleP=> z; rewrite coeff0 fgmap_f0_coeffE ?normr0 // mulrn_wge0.
  Qed.

  Lemma fgneg_le0 D : 0 <=g fgneg D.
  Proof. by rewrite -fgposN fgpos_le0. Qed.

  Lemma coeff_fgposE D k : coeff k (fgpos D) = Num.max 0 (coeff k D).
  Proof. by rewrite fgmap_f0_coeffE ?normr0 //=; case: ger0P. Qed.

  Lemma coeff_fgnegE D k : coeff k (fgneg D) = - Num.min 0 (coeff k D).
  Proof. by rewrite -fgposN coeff_fgposE coeffN -{1}[0]oppr0 -oppr_min. Qed.

  Lemma fgpos_dom D : {subset dom (fgpos D) <= dom D}.
  Proof. by move=> x /fgmap_dom; rewrite mem_filter => /andP []. Qed.

  Lemma fgneg_dom D : {subset dom (fgneg D) <= dom D}.
  Proof. by move=> k; rewrite -fgposN => /fgpos_dom; rewrite domN. Qed.

  Lemma fg_decomp D : D = fgpos D - fgneg D.
  Proof.
    apply/eqP/freeg_eqP=> k; rewrite coeffB.
    by rewrite coeff_fgposE coeff_fgnegE opprK addr_max_min add0r.
  Qed.

  Lemma fgnorm_decomp D : fgnorm D = fgpos D + fgneg D.
  Proof.
    apply/eqP/freeg_eqP=> k.
    rewrite coeffD coeff_fgnormE coeff_fgposE coeff_fgnegE.
    by case: ger0P; rewrite (sub0r, subr0).
  Qed.
End FreegPosDecomp.

(* -------------------------------------------------------------------- *)
Section PosFreegDeg.
  Context (K : choiceType).

  Lemma fgpos_eq0P (D : {freeg K}) : 0 <=g D -> deg D = 0 -> D = 0.
  Proof.
    move=> posD; rewrite -{1}[D]freeg_sumE raddf_sum /=.
    rewrite (eq_bigr (fun z => coeff z D)); last first.
      by move=> i _; rewrite degU.
    move/eqP; rewrite psumr_eq0; last by move=> i _; apply/fgposP.
    move/allP=> zD; apply/eqP; apply/freeg_eqP=> z; rewrite coeff0.
    case z_in_D: (z \in dom D); last first.
      by rewrite coeff_outdom // z_in_D.
    exact/eqP/zD.
  Qed.

  Lemma fgneg_eq0P (D : {freeg K}) : D <=g 0 -> deg D = 0 -> D = 0.
  Proof.
    move=> negD deg_eq0; apply/eqP; rewrite -oppr_eq0; apply/eqP.
    apply/fgpos_eq0P; last by apply/eqP; rewrite degN oppr_eq0 deg_eq0.
    apply/fgposP=> z; rewrite coeffN oppr_ge0.
    by move/fgleP: negD => /(_ z); rewrite coeff0.
  Qed.

  Lemma deg1pos (D : {freeg K}) : 0 <=g D -> deg D = 1 -> exists x, D = << x >>.
  Proof.
    move=> D_ge0 degD_eq1; have: D != 0.
      by case: (D =P 0) degD_eq1 => [->|//]; rewrite deg0.
    rewrite -dom_eq0; case DE: (dom D) => [//|p ps] _.
    rewrite -[D]addr0 -(subrr <<p>>) addrA addrAC.
    have: coeff p D != 0.
      by move: (mem_dom D p); rewrite DE in_cons eqxx.
    rewrite neq_lt ltNge; have/fgposP/(_ p) := D_ge0 => ->/=.
    move=> coeffpD_gt0; have: 0 <=g (D - <<p>>).
      apply/fgposP=> q; rewrite coeffB coeffU mul1r.
      case: (p =P q) =>[<-/=|]; last first.
        by move=> _; rewrite subr0; apply/fgposP.
      by rewrite subr_ge0.
    move/fgpos_eq0P=> ->; first by rewrite add0r; exists p.
    by rewrite degB degU degD_eq1 subrr.
  Qed.

  Lemma deg1neg (D : {freeg K}) :
    D <=g 0 -> deg D = -1 -> exists x, D = - << x >>.
  Proof.
    move=> D_le0 degD_eqN1; case: (@deg1pos (-D)).
    + apply/fgleP=> p; rewrite coeffN coeff0 oppr_ge0.
      by move/fgleP/(_ p): D_le0; rewrite coeff0.
    + by rewrite degN degD_eqN1 opprK.
    + by move=> p /eqP; rewrite eqr_oppLR => /eqP->; exists p.
  Qed.
End PosFreegDeg.

(* -------------------------------------------------------------------- *)
Section FreegIndDom.
  Context (R : ringType) (K : choiceType) (F : pred K).
  Context (P : {freeg K / R} -> Type).
  Implicit Types (D : {freeg K / R}).

  Context (H0 : forall D, [predI dom D & [predC F]] =1 pred0 -> P D).
  Context (HS : forall k x D, x \notin dom D -> k != 0 -> ~~ (F x) ->
                              P D -> P (<< k *g x >> + D)).

  Lemma freeg_rect_dom D: P D.
  Proof.
    rewrite -[D]freeg_sumE (bigID F) /=; set DR := \sum_(_ <- _ | _) _.
    have: [predI dom DR & [predC F]] =1 pred0.
      move=> p /=; rewrite !inE; apply/negP=> /andP [].
      rewrite /DR => /dom_sum_subset /flattenP.
      case=> [ps /mapP [q]]; rewrite mem_filter => /andP [].
      move=> Rq q_in_D ->; rewrite domU ?mem_seq1; last first.
        by rewrite -(mem_dom D q).
      by move/eqP=> ->; move: Rq; rewrite /in_mem /= => ->.
    move: DR => DR domDR; rewrite addrC -big_filter.
    set ps := [seq _ <- _ | _]; move: (perm_refl ps).
    rewrite {1}/ps; move: ps (D) => {D}; elim => [|p ps IH] D.
    + by move=> _; rewrite big_nil add0r; apply: H0.
    + move=> DE; move: (perm_mem DE p); rewrite !inE eqxx /=.
      have /=: uniq (p :: ps).
        by move/perm_uniq: DE; rewrite filter_uniq // uniq_dom.
      case/andP=> p_notin_ps uniq_ps; rewrite mem_filter=> /andP [NRp p_in_D].
      rewrite big_cons -addrA; apply: HS => //; first 1 last.
      * by move: p_in_D; rewrite mem_dom.
      * pose D' := D - << coeff p D *g p >>.
        have coeffD' q: coeff q D' = coeff q D * (p != q)%:R.
          rewrite {}/D' coeffB coeffU; case: (p =P q).
          - by move=> ->; rewrite !(mulr1, mulr0) subrr.
          - by move/eqP=> ne_pq; rewrite !(mulr1, mulr0) subr0.
        have: perm_eq (dom D) (p :: dom D').
          apply: uniq_perm; rewrite /= ?uniq_dom ?andbT //.
          - by rewrite mem_dom coeffD' eqxx mulr0 eqxx.
          move=> q; rewrite in_cons !mem_dom coeffD' [q == _]eq_sym.
          case: (p =P q); rewrite !(mulr0, mulr1) //=.
          by move=> <-; move: p_in_D; rewrite mem_dom.
        move/perm_filter=> /(_ [pred q | ~~ (F q)]) /=.
        rewrite NRp; rewrite perm_sym; move/perm_trans => /(_ _ DE).
        rewrite perm_cons => domD'; rewrite big_seq.
        rewrite (eq_bigr (fun q => << coeff q D' *g q >>)); last first.
          move=> q q_in_ps; rewrite /D' coeffB coeffU; case: (p =P q).
          - by move=> eq_pq; move: p_notin_ps; rewrite eq_pq q_in_ps.
          - by move=> _; rewrite mulr0 subr0.
        by rewrite -big_seq; apply: IH.
      * apply/negP=> /domD_subset; rewrite mem_cat; case/orP; last first.
          by move=> p_in_DR; move/(_ p): domDR; rewrite !inE NRp p_in_DR.
        move/dom_sum_subset; rewrite filter_predT => /flattenP [qs].
        move/mapP => [q q_in_ps ->]; rewrite domU; last first.
          move/perm_mem/(_ q): DE; rewrite !inE q_in_ps orbT.
          by rewrite mem_filter => /andP [_]; rewrite mem_dom.
        rewrite mem_seq1 => /eqP pq_eq; move: p_notin_ps.
        by rewrite pq_eq q_in_ps.
  Qed.
End FreegIndDom.

Lemma freeg_ind_dom  (R : ringType) (K : choiceType) (F : pred K):
     forall (P : {freeg K / R} -> Prop),
     (forall D : {freeg K / R},
       [predI dom (G:=R) (K:=K) D & [predC F]] =1 pred0 -> P D)
  -> (forall (k : R) (x : K) (D : {freeg K / R}),
        x \notin dom (G:=R) (K:=K) D -> k != 0 -> ~~ F x ->
          P D -> P (<< k *g x >> + D))
  -> forall D : {freeg K / R}, P D.
Proof. by move=> P; apply/(@freeg_rect_dom R K F P). Qed.

(* -------------------------------------------------------------------- *)
Section FreegIndDom0.
  Context (R : ringType) (K : choiceType) (P : {freeg K / R} -> Type).
  Context (H0 : P 0).
  Context (HS : forall k x D, x \notin dom D -> k != 0 ->
                              P D -> P (<< k *g x >> + D)).

  Lemma freeg_rect_dom0 D: P D.
  Proof.
    apply: (@freeg_rect_dom _ _ xpred0) => [{}D|k x {}D].
      move=> domD; congr P: H0; apply/esym/eqP; rewrite -dom_eq0.
      by case: (dom D) domD => [//|p ps] /(_ p); rewrite !inE eqxx.
    by move=> ? ? _; apply: HS.
  Qed.
End FreegIndDom0.

Lemma freeg_ind_dom0 (R : ringType) (K : choiceType):
  forall (P : {freeg K / R} -> Prop),
       P 0
    -> (forall (k : R) (x : K) (D : {freeg K / R}),
          x \notin dom (G:=R) (K:=K) D -> k != 0 -> P D ->
            P (<< k *g x >> + D))
    -> forall D : {freeg K / R}, P D.
Proof. by move=> P; apply/(@freeg_rect_dom0 R K P). Qed.
