Section Monomials.
Inductive mon : nat -> Set :=
| n_0 : mon 0
| c_n : forall d : nat, nat -> mon d -> mon (S d).
Definition pmon1 : forall d : nat, mon d -> nat.
(* Realizer [d: nat][m:(mon d)](Cases  m of n_0 => O | (c_n _ n _) => n end). *)
intros d m; case m.
exact 0.
intros d' n p; exact n.
Defined.
Definition pmon2 : forall d : nat, mon d -> mon (pred d).
(* Realizer [d:nat] [m:mon](<mon>Case m of n_0 [a:nat] [b:nat] [m':mon]m' end). *)
intros d m; case m.
exact n_0.
intros d' n p; exact p.
Defined.
Definition recomp : forall d : nat, d <> 0 -> mon d -> mon d.
intros d; case d.
intros H'; apply False_rec; case H'; auto.
intros d' H m; exact (c_n d' (pmon1 (S d') m) (pmon2 (S d') m)).
(*Realizer [d:nat] [m:mon] (<mon>Case d of (False_rec mon) [d':nat](c_n d' (pmon1 (S d') m) (pmon2 (S d') m)) end). Program_all. *)
Defined.
intros d h m.
generalize h; clear h.
elim m.
intros h; elim h; auto.
intros; simpl in |- *; unfold recomp in |- *; auto.
Qed.
intros d m; cut (S d <> 0); auto.
intros H; cut (recomp (S d) H m = m); auto.
apply recomp_ok; auto.
Qed.
(*Generator *)
Definition gen_mon : forall d : nat, nat -> mon d.
intros d; elim d.
intros n; exact n_0.
intros n H' n'; case n'.
exact (c_n n 1 (H' n)).
intros n''; exact (c_n n 0 (H' n'')).
Defined.
(* Multiplication of monomials. *)
Definition mult_mon : forall d : nat, mon d -> mon d -> mon d.
intros d; elim d.
intros H' H'0; exact n_0.
intros n Rec S1 S2.
exact
(c_n n (pmon1 (S n) S1 + pmon1 (S n) S2)
(Rec (pmon2 (S n) S1) (pmon2 (S n) S2))).
Defined.
intros d; elim d; simpl in |- *; auto.
intros n H' a b.
rewrite (H' (pmon2 (S n) a) (pmon2 (S n) b)); auto.
rewrite (plus_comm (pmon1 (S n) a) (pmon1 (S n) b)); auto.
Qed.
intros d; elim d; simpl in |- *; auto.
intros n H' a b c.
rewrite (H' (pmon2 (S n) a) (pmon2 (S n) b) (pmon2 (S n) c)); auto.
rewrite (plus_assoc (pmon1 (S n) a) (pmon1 (S n) b) (pmon1 (S n) c)); auto.
Qed.
(* Zero *)
Definition zero_mon : forall d : nat, mon d.
intros d; elim d.
exact n_0.
intros n Rec; exact (c_n n 0 Rec).
Defined.
intros d a; elim a; auto.
simpl in |- *.
intros d0 n m H'; rewrite H'; auto.
rewrite (plus_comm n 0); auto.
Qed.
intros d a; elim a; auto.
simpl in |- *.
intros d0 n m H'; rewrite H'; auto.
Qed.
(* Division of monomials. *)
Inductive mdiv : forall d : nat, mon d -> mon d -> Prop :=
| mdiv_nil : mdiv 0 n_0 n_0
| mdiv_cons :
forall (d : nat) (v v' : mon d) (n n' : nat),
n <= n' -> mdiv d v v' -> mdiv (S d) (c_n d n v) (c_n d n' v').
Hint Resolve mdiv_nil mdiv_cons.
intros d m m' H' H'0; rewrite <- (proj_ok d m); rewrite <- (proj_ok d m');
auto.
Qed.
(* Division is transitive. *)
intros d; elim d; unfold transitive in |- *; auto.
intros x y z mdiv_xy; inversion mdiv_xy.
intros mdiv_yz; inversion mdiv_yz; auto.
rewrite <- (inj_pair2 nat (fun x : nat => mon x) 0 n_0 z); auto.
rewrite <- (inj_pair2 nat (fun x : nat => mon x) 0 n_0 x); auto.
intros n Rec x y z mdiv_xy; inversion mdiv_xy.
rewrite <- (inj_pair2 nat (fun x : nat => mon x) (S n) (c_n n n' v') y); auto.
rewrite <- (inj_pair2 nat (fun x : nat => mon x) (S n) (c_n n n0 v) x); auto.
intros mdiv_yz; inversion mdiv_yz; auto.
rewrite <- (inj_pair2 nat (fun x : nat => mon x) (S n) (c_n n n'0 v'0) z);
auto.
apply mdiv_cons; auto.
apply le_trans with (m := n'); auto.
apply Rec with (y := v0); auto.
rewrite (inj_pair2 nat (fun x : nat => mon x) n v0 v'); auto.
Qed.
(*Division  of monomials (total function!). *)
Definition div_mon : forall d : nat, mon d -> mon d -> mon d.
intros d; elim d.
intros H' H'0; exact n_0.
intros n Rec S1 S2.
exact
(c_n n (pmon1 (S n) S1 - pmon1 (S n) S2)
(Rec (pmon2 (S n) S1) (pmon2 (S n) S2))).
Defined.
intros d a b H'; elim H'; simpl in |- *; auto.
intros d0 v v' n n' H'0 H'1 H'2.
rewrite (plus_comm (n' - n) n).
rewrite <- (le_plus_minus n n'); auto.
rewrite H'2; auto.
Qed.
(*Division  of monomials (total function!). *)
Definition div_mon_clean : forall d : nat, mon d -> mon d -> mon d * bool.
intros d; elim d.
intros H' H'0; exact (n_0, true).
intros n Rec S1 S2.
case (le_lt_dec (pmon1 (S n) S2) (pmon1 (S n) S1)).
case (Rec (pmon2 (S n) S1) (pmon2 (S n) S2)).
intros res b H'1; exact (c_n n (pmon1 (S n) S1 - pmon1 (S n) S2) res, b).
intros H'; exact (S1, false).
Defined.
Definition is_nil : forall d : nat, mon d -> mon d.
intros d; case d.
intros H'; exact n_0.
intros n H'; exact H'.
Defined.
intros d a; elim a; simpl in |- *; auto.
Qed.
intros a; generalize (is_nil_id 0 a); simpl in |- *; auto.
Qed.
Hint Resolve mon_0.
intros d; elim d; auto.
intros x y; left.
rewrite (mon_0 x); rewrite (mon_0 y); auto.
intros n H' x y.
elim (eq_nat_dec (pmon1 (S n) x) (pmon1 (S n) y)); intros H'2.
elim (H' (pmon2 (S n) x) (pmon2 (S n) y)); intros H'3.
left.
rewrite <- (proj_ok n x).
rewrite <- (proj_ok n y).
rewrite H'3; rewrite H'2; auto.
right; rewrite <- (proj_ok n x); rewrite <- (proj_ok n y); red in |- *;
intros H'0.
apply H'3.
change
(pmon2 (S n) (c_n n (pmon1 (S n) x) (pmon2 (S n) x)) =
pmon2 (S n) (c_n n (pmon1 (S n) y) (pmon2 (S n) y)) :>
mon n) in |- *.
rewrite H'0; auto.
right; red in |- *; rewrite <- (proj_ok n x); rewrite <- (proj_ok n y);
intros H'0; apply H'2; injection H'0; auto.
Qed.
intros d; elim d; simpl in |- *; auto.
intros n H' a b.
rewrite (H' (pmon2 (S n) a) (pmon2 (S n) b)); auto.
rewrite (plus_comm (pmon1 (S n) a) (pmon1 (S n) b)).
rewrite (minus_plus (pmon1 (S n) b) (pmon1 (S n) a)); auto.
apply proj_ok; auto.
Qed.

Theorem mult_div_id :
forall (d : nat) (a : mon d), div_mon d a a = zero_mon d.