Section Preduce.
Load "hCoefStructure".
Load "hOrderStructure".
Load "hSpminus".
Inductive inPolySet : list (Term A n) -> list (poly A0 eqA ltM) -> Prop :=
| incons :
forall (a : Term A n) (p : list (Term A n))
(H : canonical A0 eqA ltM (pX a p)) (P : list (poly A0 eqA ltM)),
inPolySet (pX a p)
(exist (fun l0 : list (Term A n) => canonical A0 eqA ltM l0)
(pX a p) H :: P)
| inskip :
forall (a : poly A0 eqA ltM) (p : list (Term A n))
(P : list (poly A0 eqA ltM)), inPolySet p P -> inPolySet p (a :: P).
Hint Resolve incons inskip.
intros p L H'; elim H'; auto.
Qed.
Hint Resolve inPolySet_imp_canonical.
intros Q p H'; elim H'; auto.
intros a p0 H'0 H'1; red in |- *; intros H'2; inversion H'2.
Qed.
intros Q H'; red in |- *; intros H'0.
lapply (not_nil_in_polySet_elm Q (pO A n));
[ intros H'3; apply H'3 || elim H'3 | idtac ]; auto.
Qed.
intros p L H'; elim H'; auto.
intros a p0 H'0 H'1; exists a; exists p0; auto.
Qed.
Inductive reduce (Q : list (poly A0 eqA ltM)) :
list (Term A n) -> list (Term A n) -> Prop :=
| reducetop :
forall (a b : Term A n) (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b)
(p q r : list (Term A n)),
inPolySet (pX b q) Q ->
divP A A0 eqA multA divA n a b ->
eqP A eqA n
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
b nZb p q) r -> reduce Q (pX a p) r
| reduceskip :
forall (a b : Term A n) (p q : list (Term A n)),
reduce Q p q ->
eqTerm (A:=A) eqA (n:=n) a b -> reduce Q (pX a p) (pX b q).
Hint Resolve reduceskip.
intros Q p; red in |- *; intros H'; inversion H'; auto.
Qed.
intros Q p; case p; simpl in |- *; auto.
intros H'; elim (inPolySet_is_pX (pO A n) Q);
[ intros a E; elim E; intros q E0; inversion E0 | idtac ];
auto.
intros a l H'.
cut (canonical A0 eqA ltM (pX a l)); [ intros Op0 | idtac ].
cut (canonical A0 eqA ltM l);
[ intros Op1 | apply canonical_imp_canonical with (a := a) ];
auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a); [ intros Nza | idtac ].
cut
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a a Nza l
l = pO A n).
intros H'0; rewrite <- H'0.
change
(reduce Q (pX a l)
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a a
Nza l l)) in |- *.
apply reducetop with (b := a) (nZb := Nza) (q := l); auto.
apply divP_on_eqT with (1 := cs); auto.
cut
(eqP A eqA n
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a a
Nza l l) (pO A n)).
intros H'0; inversion H'0; auto.
apply
(eqp_trans _ _ _ _ _ _ _ _ _ cs n)
with
(y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec l
(mults (A:=A) multA (n:=n)
(divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a) Nza)
l)); auto.
apply
(eqp_trans _ _ _ _ _ _ _ _ _ cs n)
with
(y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec l
(mults (A:=A) multA (n:=n) (T1 A1 n) l));
auto.
apply
(eqp_trans _ _ _ _ _ _ _ _ _ cs n)
with (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec l l);
auto.
apply minuspf_refl with (1 := cs); auto.
apply (canonical_nzeroP A A0 eqA n ltM) with (p := l); auto.
apply inPolySet_imp_canonical with (L := Q); auto.
Qed.
intros Q p q H'; elim H'; auto.
2: intros a b p0 q0 H'0 H'1 H'2 H'3; apply ltP_tl; auto.
2: apply (eqT_sym A n); apply (eqTerm_imp_eqT A eqA n); auto.
2: apply H'1; try apply canonical_imp_canonical with (a := a); auto.
intros a b nZb p0; case p0; auto.
intros q0 r H'0 H'1 H'2 H'3.
change (ltP (A:=A) (n:=n) ltM r (pX a (pO A n))) in |- *.
apply (canonical_pX_ltP A A0 eqA); auto.
apply
eqp_imp_canonical
with
(1 := cs)
(p := pX a
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
ltM_dec a b nZb (pO A n) q0)); auto.
apply canonical_spminusf_full_t with (1 := cs); auto.
apply inPolySet_imp_canonical with (L := Q); auto.
intros t l q0 r H'0 H'1 H'2 H'3; apply ltP_trans with (y := pX a (pO A n));
auto.
apply (canonical_pX_ltP A A0 eqA); auto.
apply
eqp_imp_canonical
with
(1 := cs)
(p := pX a
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
ltM_dec a b nZb (pX t l) q0)); auto.
apply canonical_spminusf_full_t with (1 := cs); auto.
apply inPolySet_imp_canonical with (L := Q); auto.
change (ltP (A:=A) (n:=n) ltM (pX a (pO A n)) (pX a (pX t l))) in |- *; auto.
Qed.
intros Q p q H'; elim H'; auto.
intros a b nZb p0 q0 r H'0 H'1 H'2 H'3.
apply
eqp_imp_canonical
with
(1 := cs)
(p := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
b nZb p0 q0); auto.
apply canonical_spminusf with (1 := cs); auto.
apply canonical_imp_canonical with (a := a); auto.
apply canonical_imp_canonical with (a := b); auto.
apply inPolySet_imp_canonical with (L := Q); auto.
intros a b p0 q0 H'0 H'1 H'2 H'3.
apply eqp_imp_canonical with (1 := cs) (p := pX a q0); auto.
cut (canonical A0 eqA ltM p0);
[ intros C1 | apply canonical_imp_canonical with (a := a) ];
auto.
apply ltP_pX_canonical; auto.
apply canonical_nzeroP with (ltM := ltM) (p := p0); auto.
apply ltP_trans with (y := p0); auto.
apply ltP_reduce with (Q := Q); auto.
apply (canonical_pX_ltP A A0 eqA); auto.
Qed.
intros Q p q r s H'; generalize r s; clear r s; elim H'; auto.
intros a b nZb p0 q0 r H'0 H'1 H'2 r0 s H'3 H'4 H'5.
inversion_clear H'4.
apply reducetop with (b := b) (nZb := nZb) (q := q0); auto.
apply divP_eqTerm_comp with (1 := cs) (a := a); auto.
apply
(eqp_trans _ _ _ _ _ _ _ _ _ cs n)
with
(y := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
b nZb p0 q0); auto.
cut (canonical A0 eqA ltM p0);
[ intros Cp0 | apply canonical_imp_canonical with (a := a); auto ].
apply eqp_spminusf_com with (1 := cs); auto.
apply eqp_imp_canonical with (1 := cs) (p := p0); auto.
apply canonical_imp_canonical with (a := b); auto.
apply inPolySet_imp_canonical with (L := Q); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply divP_eqTerm_comp with (1 := cs) (a := a); auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (2 := H'5); auto.
intros a b p0 q0 H'0 H'1 H'2 r s H'3 H'4 H'5.
inversion_clear H'4.
inversion_clear H'5.
apply reduceskip; auto.
apply H'1; auto.
apply canonical_imp_canonical with (a := a); auto.
apply (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n) with (y := a); auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n) with (y := b); auto.
Qed.
intros Q a b p q H'; inversion_clear H'; auto.
intros eq Cap.
elim (not_double_canonical A A0 eqA n ltM) with (a := b) (p := q); auto.
apply
eqp_imp_canonical
with
(p := pX b
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
ltM_dec a b0 nZb p q0))
(1 := cs); auto.
apply (canonical_pX_eqT A A0 eqA n ltM) with (a := a); auto.
apply canonical_spminusf_full_t with (1 := cs); auto.
apply inPolySet_imp_canonical with (L := Q); auto.
apply (eqTerm_imp_eqT A eqA n); auto.
apply nzeroP_comp_eqTerm with (1 := cs) (a := a); auto.
apply canonical_nzeroP with (p := p) (ltM := ltM); auto.
Qed.

Theorem reducetop_sp :
forall (Q : list (poly A0 eqA ltM)) (a b : Term A n)
(nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b) (p q : list (Term A n)),
inPolySet (pX b q) Q ->
divP A A0 eqA multA divA n a b ->
reduce Q (pX a p)
(spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b nZb
p q).