Section Pminus.
Load "hCoefStructure".
Load "hOrderStructure".
Load "hMults".
Inductive minusP :
list (Term A n) -> list (Term A n) -> list (Term A n) -> Prop :=
| mnillu1 :
forall l1 : list (Term A n),
minusP (pO A n) l1
(mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) l1)
| mnillu2 : forall l1 : list (Term A n), minusP l1 (pO A n) l1
| mmainu1 :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
ltT ltM a2 a1 ->
minusP l1 (pX a2 l2) l3 -> minusP (pX a1 l1) (pX a2 l2) (pX a1 l3)
| mmainu2a :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
minusP l1 l2 l3 ->
eqT a1 a2 ->
zeroP (A:=A) A0 eqA (n:=n) (minusTerm (A:=A) minusA (n:=n) a1 a2) ->
minusP (pX a1 l1) (pX a2 l2) l3
| mmainu2b :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
minusP l1 l2 l3 ->
eqT a1 a2 ->
~ zeroP (A:=A) A0 eqA (n:=n) (minusTerm (A:=A) minusA (n:=n) a1 a2) ->
minusP (pX a1 l1) (pX a2 l2)
(pX (minusTerm (A:=A) minusA (n:=n) a1 a2) l3)
| mmainu3 :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
ltT ltM a1 a2 ->
minusP (pX a1 l1) l2 l3 ->
minusP (pX a1 l1) (pX a2 l2) (pX (invTerm (A:=A) invA (n:=n) a2) l3).
Hint Resolve mnillu1 mnillu2 mmainu1 mmainu2a mmainu2b mmainu3.
Definition minuspp :
forall l : list (Term A n) * list (Term A n),
{a : list (Term A n) | minusP (fst l) (snd l) a}.
intros l; pattern l in |- *.
apply
well_founded_induction
with (A := (list (Term A n) * list (Term A n))%type) (R := lessP A n);
auto.
apply wf_lessP; auto.
intros x; case x; intros l1 l2; simpl in |- *.
case l1.
intros H';
exists (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) l2);
auto.
intros a1 m1; case l2.
intros H'; exists (pX a1 m1); auto.
intros a2 m2 H'; case (ltT_dec A n ltM ltM_dec a1 a2);
[ intros P; case P; clear P | idtac ]; intros H1.
lapply (H' (pX a1 m1, m2)); simpl in |- *;
[ intros Rec; case Rec; clear Rec; intros Orec Prec | idtac ].
exists (pX (invTerm (A:=A) invA (n:=n) a2) Orec); auto.
change
(minusP (pX a1 m1) (pX a2 m2) (pX (invTerm (A:=A) invA (n:=n) a2) Orec))
in |- *; auto.
red in |- *; red in |- *; simpl in |- *; rewrite <- plus_n_Sm; auto.
lapply (H' (m1, pX a2 m2)); simpl in |- *;
[ intros Rec; case Rec; clear Rec; intros Orec Prec | idtac ].
exists (pX a1 Orec); auto.
change (minusP (pX a1 m1) (pX a2 m2) (pX a1 Orec)) in |- *; auto.
red in |- *; red in |- *; simpl in |- *; rewrite <- plus_n_Sm; auto.
lapply (H' (m1, m2)); simpl in |- *;
[ intros Rec; case Rec; clear Rec; intros Orec Prec | idtac ].
apply LetP with (A := Term A n) (h := minusTerm (A:=A) minusA (n:=n) a1 a2).
intros u H'0; case (zeroP_dec A A0 eqA eqA_dec n u); intros Z0.
exists Orec; auto.
rewrite H'0 in Z0; auto.
change (minusP (pX a1 m1) (pX a2 m2) Orec) in |- *; auto.
exists (pX u Orec); auto.
rewrite H'0 in Z0; auto.
rewrite H'0; auto.
change
(minusP (pX a1 m1) (pX a2 m2)
(pX (minusTerm (A:=A) minusA (n:=n) a1 a2) Orec))
in |- *; auto.
red in |- *; red in |- *; simpl in |- *; rewrite <- plus_n_Sm; auto.
Defined.
Definition minuspf (l1 l2 : list (Term A n)) :=
projsig1 (list (Term A n)) _ (minuspp (l1, l2)).
intros a b H' H'0.
cut (eqT a (invTerm (A:=A) invA (n:=n) b)); [ intros eq1 | idtac ].
cut (eqT a (plusTerm (A:=A) plusA (n:=n) b (invTerm (A:=A) invA (n:=n) b)));
[ intros eq2 | idtac ].
apply
(eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
with
(y := plusTerm (A:=A) plusA (n:=n) a
(plusTerm (A:=A) plusA (n:=n) b (invTerm (A:=A) invA (n:=n) b)));
auto.
apply zeroP_plusTermr with (1 := cs); auto.
apply plusTerm_invTerm_zeroP with (1 := cs); auto.
apply
(eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
with
(y := plusTerm (A:=A) plusA (n:=n) a
(plusTerm (A:=A) plusA (n:=n) (invTerm (A:=A) invA (n:=n) b) b));
auto.
apply plusTerm_comp_r with (1 := cs); auto.
apply (eqT_trans A n) with (plusTerm plusA b (invTerm invA b)); auto.
apply (eqTerm_imp_eqT A eqA); auto.
apply plusTerm_com with (1 := cs); auto.
apply plusTerm_com with (1 := cs); auto.
apply
(eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
with
(y := plusTerm (A:=A) plusA (n:=n)
(plusTerm (A:=A) plusA (n:=n) a (invTerm (A:=A) invA (n:=n) b)) b);
auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n);
apply plusTerm_assoc with (1 := cs); auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n);
apply zeroP_plusTerml with (1 := cs); auto.
apply (eqT_trans A n) with (invTerm invA b); auto.
apply plusTerm_eqT2; auto.
apply (eqT_sym A n); apply invTerm_eqT; auto.
apply zeroP_comp_eqTerm with (1 := cs) (2 := H'0).
apply eqTerm_minusTerm_plusTerm_invTerm with (1 := cs); auto.
apply (eqT_trans A n) with (1 := eq1); auto.
apply (eqT_sym A n); apply plusTerm_eqT2; auto.
apply (eqT_trans A n) with (1 := H'); auto.
Qed.
Hint Unfold minuspf.
intros a b H' H0;
apply
(eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
with (y := plusTerm (A:=A) plusA (n:=n) a (invTerm (A:=A) invA (n:=n) b));
auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n);
apply zeroP_plusTerml with (1 := cs); auto.
apply (eqT_trans A n) with (y := b); auto.
Qed.
intros a b H' H'0.
apply
(eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
with (y := plusTerm (A:=A) plusA (n:=n) a (invTerm (A:=A) invA (n:=n) b));
auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply zeroP_plusTermr with (1 := cs); auto.
apply (eqT_trans A n) with (y := b); auto.
apply zeroP_invTerm_zeroP with (1 := cs); auto.
Qed.
Hint Resolve minusTerm_zeroP minusTerm_zeroP_r.
intros p q r H'; elim H'; auto.
intros l1; case l1; simpl in |- *; auto.
intros t l H; inversion H.
intros a1 a2 l1 l2 l3 H H0 H1 H2; inversion H2.
intros a1 a2 l1 l2 l3 H H0 H1 H2 H3.
apply eqpP1; auto.
apply zerop_is_eqTerm; auto.
intros a1 a2 l1 l2 l3 H H0 H1 H2 H3; inversion H3.
intros a1 a2 l1 l2 l3 H H0 H1 H2; inversion H2.
Qed.
intros p q l a b H'; simple inversion H'.
discriminate H.
discriminate H0.
rewrite <- H3; rewrite (pX_invl A n a2 b l2 q H2);
rewrite (pX_invr A n l2 q a2 b H2); rewrite (pX_invl A n a1 a l1 p H1);
rewrite (pX_invr A n l1 p a1 a H1).
intros H'0 H'1; exists l3; left; split; [ idtac | split ]; auto.
rewrite <- H4.
intros H'0 H'1 H'2; exists l3; right; right.
rewrite <- (pX_invl A n a2 b l2 q); try rewrite <- (pX_invl A n a1 a l1 p);
auto.
rewrite <- (pX_invr A n l2 q a2 b); try rewrite <- (pX_invr A n l1 p a1 a);
auto.
intros H'0 H'1 H'2; exists l3; right; right.
rewrite <- H4.
rewrite <- (pX_invl A n a2 b l2 q); try rewrite <- (pX_invl A n a1 a l1 p);
auto.
rewrite <- (pX_invr A n l2 q a2 b); try rewrite <- (pX_invr A n l1 p a1 a);
auto.
intros H'0 H'1; exists l3; right; left.
rewrite <- (pX_invl A n a2 b l2 q); try rewrite <- (pX_invl A n a1 a l1 p);
auto.
rewrite <- (pX_invr A n l2 q a2 b); try rewrite <- (pX_invr A n l1 p a1 a);
auto.
Qed.

Theorem uniq_minusp :
forall (l : list (Term A n) * list (Term A n)) (l3 l4 : list (Term A n)),
minusP (fst l) (snd l) l3 -> minusP (fst l) (snd l) l4 -> l3 = l4.