Section Buch.
Load "hCoefStructure".
Load "hOrderStructure".
Load "hWfRO".
Inductive stable :
list (poly A0 eqA ltM) -> list (poly A0 eqA ltM) -> Prop :=
stable0 :
forall P Q : list (poly A0 eqA ltM),
(forall a : poly A0 eqA ltM,
Cb A A0 eqA plusA multA eqA_dec n ltM ltM_dec a P ->
Cb A A0 eqA plusA multA eqA_dec n ltM ltM_dec a Q) ->
(forall a : poly A0 eqA ltM,
Cb A A0 eqA plusA multA eqA_dec n ltM ltM_dec a Q ->
Cb A A0 eqA plusA multA eqA_dec n ltM ltM_dec a P) ->
stable P Q.
Hint Resolve stable0.
auto.
Qed.
intros Q y R H' H'0; inversion H'; inversion H'0; auto.
Qed.
intros Q R H'; elim H'; auto.
Qed.
Hint Resolve (Cb_in _ _ _ _ _ _ _ _ _ cs eqA_dec _ _ ltM_dec os).
intros a Q H'0; apply stable0; auto.
intros a0 H'1.
apply Cb_trans with (b := a) (1 := cs); auto.
Qed.
auto.
Qed.
Inductive reds :
poly A0 eqA ltM -> poly A0 eqA ltM -> list (poly A0 eqA ltM) -> Prop :=
| reds0 :
forall (P : list (poly A0 eqA ltM)) (a b : poly A0 eqA ltM),
red A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
(spolyp A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os a b) P -> reds a b P
| reds1 :
forall (P : list (poly A0 eqA ltM)) (a b c : poly A0 eqA ltM),
In c P ->
reds a c P ->
reds c b P ->
divp A A0 eqA multA divA n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a b) c ->
reds a b P.
intros P a b H'; elim H'; simpl in |- *; auto.
intros P0 a0 b0 H'0.
apply reds0; auto.
apply red_com; auto.
intros P0 a0 b0 c H'0 H'1 H'2 H'3 H'4 H'5.
apply reds1 with (c := c); auto.
apply divp_ppc; auto.
Qed.
(* Now we are ready!! We start with the definition of genCpC *)
Inductive cpRes : Set :=
| Keep : forall P : list (poly A0 eqA ltM), cpRes
| DontKeep : forall P : list (poly A0 eqA ltM), cpRes.
Definition getRes : cpRes -> list (poly A0 eqA ltM).
intros H'; case H'; auto.
Defined.
Definition addRes : poly A0 eqA ltM -> cpRes -> cpRes.
intros i H'; case H'.
intros H'0; exact (Keep (i :: H'0)).
intros H'0; exact (DontKeep (i :: H'0)).
Defined.
Definition slice :
poly A0 eqA ltM -> poly A0 eqA ltM -> list (poly A0 eqA ltM) -> cpRes.
intros i a q; elim q; clear q.
case (foreigner_dec A A0 A1 eqA multA n ltM i a).
intros H; exact (DontKeep nil).
intros H; exact (Keep nil).
intros b q1 Rec.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i a) b).
intros divp10; exact (DontKeep (b :: q1)).
intros divp10.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i b) a).
intros divp11; exact Rec.
intros divp11; exact (addRes b Rec).
Defined.
Definition slicef :
poly A0 eqA ltM ->
poly A0 eqA ltM -> list (poly A0 eqA ltM) -> list (poly A0 eqA ltM).
intros i a q; case (slice i a q); auto.
Defined.
intros a b P; elim P; simpl in |- *; auto.
unfold slicef in |- *; simpl in |- *; auto.
case (foreigner_dec A A0 A1 eqA multA n ltM a b); intros H; apply incl_refl;
auto with datatypes.
intros c; unfold slicef in |- *; simpl in |- *.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a b) c);
auto with datatypes.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a c) b);
auto with datatypes.
intros H' H'0 l; case (slice a b l); simpl in |- *; auto with datatypes.
Qed.
intros a b P; elim P; simpl in |- *; auto.
intros c H'; elim H'.
intros p aP1;
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a b) p);
simpl in |- *; auto.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a p) b);
auto.
intros H' H'0 H'1 c H'2; elim H'2;
[ intros H'3; rewrite <- H'3; clear H'2 | intros H'3; clear H'2 ];
auto.
case (slice a b aP1); simpl in |- *; auto.
intros P0 H' H'0 H'1 c H'2; elim H'2;
[ intros H'3; rewrite <- H'3; clear H'2 | intros H'3; clear H'2 ];
auto.
elim (H'1 c); [ intros H'5; try exact H'5 | intros H'5 | idtac ]; auto.
intros P0 H' H'0 H'1 c H'2; elim H'2;
[ intros H'3; rewrite <- H'3; clear H'2 | intros H'3; clear H'2 ];
auto.
elim (H'1 c); [ intros H'5; try exact H'5 | intros H'5 | idtac ]; auto.
Qed.
intros i a aP; elim aP.
simpl in |- *; case (foreigner_dec A A0 A1 eqA multA n ltM i a); auto.
intros H' Q H'0; inversion H'0.
intros a0 l H' Q; simpl in |- *.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i a) a0);
auto.
intros H'0 H'1; inversion H'1; auto.
left; exists a0; split; simpl in |- *; auto.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i a0) a);
auto.
generalize H'; clear H'; case (slice i a l); simpl in |- *; auto.
intros P H' H'0 H'1 H'2; inversion H'2.
intros P H' H'0 H'1 H'2; inversion H'2.
elim (H' P);
[ intros H'5; elim H'5; intros c E; elim E; intros H'6 H'7; clear E H'5
| intros H'5
| idtac ]; auto.
left; exists c; split; simpl in |- *; auto.
Qed.
Definition Tl : list (poly A0 eqA ltM) -> list (poly A0 eqA ltM) -> Prop.
exact (fun x y : list (poly A0 eqA ltM) => length x < length y).
Defined.
apply (wf_inverse_image _ _ lt (length (A:=poly A0 eqA ltM))); auto.
generalize lt_wf; auto.
Qed.
Scheme Sdep := Induction for prod Sort Prop.
intros a b P; elim P; simpl in |- *; auto.
unfold slicef in |- *; simpl in |- *; auto.
case (foreigner_dec A A0 A1 eqA multA n ltM a b); unfold Tl in |- *;
simpl in |- *; auto.
intros c l.
unfold slicef in |- *; simpl in |- *; auto.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a b) c);
auto.
unfold Tl in |- *; simpl in |- *; auto.
case
(divp_dec _ _ _ _ _ _ _ _ _ cs n ltM
(ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM a c) b);
auto.
intros H' H'0; case (slice a b l); simpl in |- *; auto.
unfold Tl in |- *; simpl in |- *; auto.
unfold Tl in |- *; simpl in |- *; auto.
unfold Tl in |- *; intros H' H'0; case (slice a b l); simpl in |- *;
auto with arith.
Qed.
Inductive genPcP :
poly A0 eqA ltM ->
list (poly A0 eqA ltM) ->
list (poly A0 eqA ltM) -> list (poly A0 eqA ltM) -> Prop :=
| genPcP0 :
forall (i : poly A0 eqA ltM) (L : list (poly A0 eqA ltM)),
genPcP i nil L L
| genPcP1 :
forall (L L1 L2 L3 : list _) (a i : poly A0 eqA ltM),
slice i a L1 = Keep L2 ->
genPcP i L2 L L3 ->
genPcP i (a :: L1) L
(addEnd A A0 eqA n ltM
(spolyp A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os i a) L3)
| genPcP2 :
forall (L L1 L2 L3 : list _) (a i : poly A0 eqA ltM),
slice i a L1 = DontKeep L2 ->
genPcP i L2 L L3 -> genPcP i (a :: L1) L L3.
Hint Resolve genPcP0.
intros i L L1 L2 H'; elim H'; clear H'; simpl in |- *; auto.
intros L0 L3 L4 L5 a i0 H' H'0 H'1 a0 H'2.
case (addEnd_cons A A0 eqA n ltM) with (1 := H'2); auto; intros H'7.
rewrite H'7; auto.
left; exists a; split; simpl in |- *; auto.
elim (H'1 a0); auto.
intros H'3; case H'3; intros b E; case E; intros H'4 H'5; rewrite H'5;
clear E H'3.
left; exists b; split; auto.
right; try assumption.
generalize (slicef_incl i0 a L3); unfold slicef in |- *; rewrite H'; auto.
intros L0 L3 L4 L5 a i0 H' H'0 H'1 a0 H'2.
elim (H'1 a0);
[ intros H'5; elim H'5; intros b E; elim E; intros H'6 H'7; rewrite H'7;
clear E H'5
| intros H'5
| idtac ]; auto.
left; exists b; split; [ right | idtac ]; auto.
generalize (slicef_incl i0 a L3); unfold slicef in |- *; rewrite H'; auto.
Qed.
Hint Resolve (addEnd_id2 A A0 eqA n ltM).
Hint Resolve (addEnd_id1 A A0 eqA n ltM).
intros i L L1 L2 H'; elim H'; simpl in |- *; auto with datatypes.
intros L0 L3 L4 L5 a i0 H'0 H'1 H'2.
unfold incl in |- *; simpl in |- *; auto.
Qed.
intros aP R Q i H'; elim H'; clear H' i aP R Q; simpl in |- *; auto.
intros i L H' b H'0; elim H'0.
intros L L1 L2 L3 a i H' H'0 H'1 H'2 b H'3 H'4.
cut (incl L2 L1);
[ intros incl0
| generalize (slicef_incl i a L1); unfold slicef in |- *; rewrite H' ];
auto.
elim H'3; [ intros H'5; rewrite <- H'5; clear H'3 | intros H'5; clear H'3 ];
auto.
exists a; split; [ idtac | split; [ left | idtac ] ]; auto.
rewrite H'5; auto.
apply zerop_ddivp_ppc; auto.
elim (slice_inv i a L1 b); [ intros H'10 | intros H'10 | idtac ]; auto.
rewrite H' in H'10; simpl in H'10; auto.
lapply H'1;
[ intros H'3; elim (H'3 b);
[ intros c E; elim E; intros H'9 H'11; elim H'11; intros H'12 H'13;
elim H'12;
[ intros H'14; clear H'12 H'11 E H'1
| intros H'14; clear H'12 H'11 E H'1 ]
| clear H'1
| clear H'1 ]
| clear H'1 ]; auto.
exists c; split; [ right | idtac ]; auto.
exists c; split; [ idtac | split; [ right | idtac ] ]; auto.
exists a; split; [ idtac | split ]; auto.
intros L L1 L2 L3 a i H' H'0 H'1 H'2 b H'3 H'4.
cut (incl L2 L1);
[ intros incl0
| generalize (slicef_incl i a L1); unfold slicef in |- *; rewrite H' ];
auto.
elim H'3; [ intros H'5; rewrite <- H'5; clear H'3 | intros H'5; clear H'3 ];
auto.
elim (slice_cons i a L1 L2);
[ intros H'8; elim H'8; intros c E; elim E; intros H'9 H'10; clear E H'8
| intros H'8
| idtac ]; auto.
lapply H'1;
[ intros H'3; elim (H'3 c);
[ intros c0 E; elim E; intros H'11 H'12; elim H'12; intros H'13 H'14;
elim H'13;
[ intros H'15; clear H'13 H'12 E H'1
| intros H'15; clear H'13 H'12 E H'1 ]
| clear H'1
| clear H'1 ]
| clear H'1 ]; auto.
exists c0; split; [ idtac | split; [ left | idtac ] ]; auto.
apply
(divp_trans _ _ _ _ _ _ _ _ _ cs n ltM)
with (y := ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i c);
auto.
apply divP_ppc; auto.
apply divp_ppc; auto.
apply zerop_ddivp_ppc; auto.
rewrite H'5; auto.
exists c0; split; [ idtac | split; [ right | idtac ] ]; auto.
apply
(divp_trans _ _ _ _ _ _ _ _ _ cs n ltM)
with (y := ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i c);
auto.
rewrite H'5; auto.
apply divP_ppc; auto.
apply divp_ppc; auto.
apply zerop_ddivp_ppc; auto.
rewrite <- H'5; auto.
apply divp_nzeropr with (1 := H'10); auto.
exists a; split; [ idtac | split; [ right | idtac ] ]; auto.
rewrite H'5; auto.
apply zerop_ddivp_ppc; auto.
elim (slice_inv i a L1 b); [ intros H'10 | intros H'10 | idtac ]; auto.
rewrite H' in H'10; simpl in H'10; auto.
lapply H'1;
[ intros H'3; elim (H'3 b);
[ intros c E; elim E; intros H'9 H'11; elim H'11; intros H'12 H'13;
elim H'12;
[ intros H'14; clear H'12 H'11 E H'1
| intros H'14; clear H'12 H'11 E H'1 ]
| clear H'1
| clear H'1 ]
| clear H'1 ]; auto.
exists c; split; [ right | idtac ]; auto.
exists c; split; [ idtac | split; [ right | idtac ] ]; auto.
elim (slice_cons i a L1 L2);
[ intros H'8; elim H'8; intros c E; elim E; intros H'9 H'11; clear E H'8
| intros H'8
| idtac ]; auto.
lapply H'1;
[ intros H'3; elim (H'3 c);
[ intros c0 E; elim E; intros H'12 H'13; elim H'13; intros H'14 H'15;
elim H'14;
[ intros H'16; clear H'14 H'13 E H'1
| intros H'16; clear H'14 H'13 E H'1 ]
| clear H'1
| clear H'1 ]
| clear H'1 ]; auto.
exists c0; split; [ idtac | split; [ left | idtac ] ]; auto.
apply
(divp_trans _ _ _ _ _ _ _ _ _ cs n ltM)
with (y := ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i c);
auto.
apply
(divp_trans _ _ _ _ _ _ _ _ _ cs n ltM)
with (y := ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i a);
auto.
apply divP_ppc; auto.
apply divp_ppc; auto.
apply zerop_ddivp_ppc; auto.
apply divP_ppc; auto.
apply divp_ppc; auto.
apply zerop_ddivp_ppc; auto.
apply divp_nzeropr with (1 := H'10); auto.
exists c0; split; [ idtac | split; [ right | idtac ] ]; auto.
apply
(divp_trans _ _ _ _ _ _ _ _ _ cs n ltM)
with (y := ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i a);
auto.
apply divP_ppc; auto.
apply divp_ppc; auto.
apply zerop_ddivp_ppc; auto.
apply
(divp_trans _ _ _ _ _ _ _ _ _ cs n ltM)
with (y := ppcp A A0 A1 eqA plusA invA minusA multA divA cs n ltM i c);
auto.
apply divP_ppc; auto.
apply divp_ppc; auto.
apply zerop_ddivp_ppc; auto.
apply divp_nzeropr with (1 := H'10); auto.
apply divp_nzeropr with (1 := H'11); auto.
exists a; split; [ idtac | split; [ right | idtac ] ]; auto.
Qed.
intros aP R Q i H' H'0 b H'1 H'2.
lapply (spolyp_cons_genPcP0 aP R Q i);
[ intros H'7; lapply H'7;
[ intros H'8; elim (H'8 b);
[ intros c E; elim E; intros H'12 H'13; elim H'13; intros H'14 H'15;
elim H'14;
[ intros H'16; clear H'14 H'13 E H'7
| intros H'16; clear H'14 H'13 E H'7 ]
| clear H'7
| clear H'7 ]
| clear H'7 ]
| idtac ]; auto.
exists c; split; [ idtac | split; [ left | idtac ] ]; auto.
exists c; split; [ idtac | split; [ right | idtac ] ]; auto.
apply foreigner_red; auto.
Qed.
intros i P Q R S H'; elim H'; simpl in |- *; auto.
intros L L1 L2 L3 a i0 H'0 H'1 H'2 H'3 H'4 H'5 a0 H'6.
case (addEnd_cons A A0 eqA n ltM) with (1 := H'6); auto; intros H'7.
rewrite H'7; auto.
apply Cb_sp; auto.
apply H'2; auto.
intros a1 H'8.
apply H'4; auto.
right.
generalize (slicef_incl i0 a L1); unfold slicef in |- *; rewrite H'0; auto.
intros L L1 L2 L3 a i0 H'0 H'1 H'2 H'3 H'4 H'5 a0 H'6; auto.
apply H'2; auto.
intros a1 H'7.
apply H'4; auto.
generalize (slicef_incl i0 a L1); unfold slicef in |- *; rewrite H'0; auto.
Qed.
Definition genPcPf0 :
forall (i : poly A0 eqA ltM) (aP R : list (poly A0 eqA ltM)),
{Q : list (poly A0 eqA ltM) | genPcP i aP R Q}.
intros i aP; pattern aP in |- *.
apply well_founded_induction with (A := list (poly A0 eqA ltM)) (R := Tl);
clear aP; auto.
try exact wf_Tl.
intros aP; case aP.
intros H' R; exists R; auto.
intros a L1 Rec L; generalize (refl_equal (slice i a L1));
pattern (slice i a L1) at 2 in |- *; case (slice i a L1).
intros L2 H'.
lapply (Rec L2); [ intros H'1; elim (H'1 L); intros L3 E | idtac ]; auto.
exists
(addEnd A A0 eqA n ltM
(spolyp A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM ltM_dec
os i a) L3); auto.
apply genPcP1 with (L2 := L2); auto.
generalize (slice_Tl i a L1); unfold slicef in |- *; rewrite H';
simpl in |- *; auto.
intros L2 H'.
lapply (Rec L2); [ intros H'1; elim (H'1 L); intros L3 E | idtac ]; auto.
exists L3; auto.
apply genPcP2 with (L2 := L2); auto.
generalize (slice_Tl i a L1); unfold slicef in |- *; rewrite H';
simpl in |- *; auto.
Qed.
Definition genPcPf :
poly A0 eqA ltM ->
list (poly A0 eqA ltM) -> list (poly A0 eqA ltM) -> list (poly A0 eqA ltM).
intros i aP Q; case (genPcPf0 i aP Q).
intros x H'; exact x.
Defined.
(* The proof will carry on if we have the following 3 properties for the function genPcPf *)
intros b P Q R; unfold genPcPf in |- *; case (genPcPf0 b P Q).
intros x H' H'0 H'1 H'2 a H'3.
apply Cb_genPcP with (i := b) (P := P) (Q := x) (R := Q); auto.
Qed.
intros a aL Q; unfold genPcPf in |- *; case (genPcPf0 a aL Q).
intros x H'.
apply genPcP_incl with (i := a) (L1 := aL); auto.
Qed.
Hint Resolve genPcPf_incl.
intros aP H' Q a b H'0 H'1 H'2.
unfold genPcPf in |- *.
case (genPcPf0 a aP Q).
intros x H'3.
apply spolyp_cons_genPcP with (R := Q); auto.
Qed.
(* Now we can define the optimized version of Buchberger *)
Definition genOCPf : list (poly A0 eqA ltM) -> list (poly A0 eqA ltM).
intros H'; elim H'.
exact (nil (A:=poly A0 eqA ltM)).
intros a l rec; exact (genPcPf a l rec).
Defined.
(* Now we can define the optimized version of Buchberger *)
intros a P; generalize a; elim P; clear a P; simpl in |- *; auto.
intros a H; elim H.
intros a l H' a0 H'0.
apply Cb_genPcPf with (b := a) (P := l) (Q := genOCPf l); auto with datatypes.
apply Cb_id with (1 := cs); auto with datatypes.
intros; apply Cb_in1 with (1 := cs); auto.
apply Cb_id with (1 := cs); auto with datatypes.
intros; apply Cb_in1 with (1 := cs); auto.
Qed.
Inductive OBuch :
list (poly A0 eqA ltM) ->
list (poly A0 eqA ltM) -> list (poly A0 eqA ltM) -> Prop :=
| OBuch0 : forall aL : list (poly A0 eqA ltM), OBuch aL nil aL
| OBuch1 :
forall (a : poly A0 eqA ltM) (aP Q R : list (poly A0 eqA ltM)),
OBuch
(addEnd A A0 eqA n ltM
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os a aP) aP)
(genPcPf
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os a aP) aP Q) R ->
~
BuchAux.zerop A A0 eqA n ltM
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM ltM_dec
os a aP) -> OBuch aP (a :: Q) R
| OBuch2 :
forall (a : poly A0 eqA ltM) (aP Q R : list (poly A0 eqA ltM)),
OBuch aP Q R ->
BuchAux.zerop A A0 eqA n ltM
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM ltM_dec
os a aP) -> OBuch aP (a :: Q) R.
Hint Resolve OBuch0 OBuch2.
Hint Resolve incl_refl incl_tl.
unfold incl in |- *; simpl in |- *; auto.
intros a L1 L2 H' a0 H'0; case H'0;
[ intros H'1; rewrite <- H'1; clear H'0 | intros H'1; clear H'0 ];
auto.
Qed.
intros aP R Q H'; elim H'; simpl in |- *; auto.
intros a aP0 Q0 R0 H'0 H'1 H'2; try assumption.
apply
incl_tran
with
(m := nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os a aP0 :: aP0); simpl in |- *;
auto.
apply incl_addEnd1; auto.
Qed.
intros aP R Q H'; elim H'; simpl in |- *; auto.
intros; apply red_cons with (1 := cs); auto.
Qed.
intros aP R Q H'; elim H'; simpl in |- *; auto.
intros aL a H'0; elim H'0.
intros a aP0 Q0 R0 H'0 H'1 H'2 a0 H'3; elim H'3;
[ intros H'4; rewrite <- H'4; clear H'3 | intros H'4; clear H'3 ];
auto.
apply
red_incl
with
(1 := cs)
(p := addEnd A A0 eqA n ltM
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os a aP0) aP0); auto.
apply
ObuchPincl
with
(Q := genPcPf
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM
ltM_dec os a aP0) aP0 Q0); auto.
apply nf_red with (cs := cs) (os := os) (aP := aP0); simpl in |- *; auto.
unfold incl in |- *; auto.
apply red_cons with (1 := cs); auto.
apply H'1; auto.
apply
(genPcPf_incl
(nf A A0 A1 eqA plusA invA minusA multA divA cs eqA_dec n ltM ltM_dec os
a aP0) aP0 Q0); auto.
intros a aP0 Q0 R0 H'0 H'1 H'2 a0 H'3; elim H'3;
[ intros H'4; rewrite <- H'4; clear H'3 | intros H'4; clear H'3 ];
auto.
apply red_incl with (1 := cs) (p := aP0); auto.
apply ObuchPincl with (Q := Q0); auto.
apply zerop_red with (cs := cs) (os := os); auto.
Qed.

Theorem OBuch_Stable :
forall P Q R : list (poly A0 eqA ltM),
OBuch P Q R ->
(forall a : poly A0 eqA ltM,
In a Q -> Cb A A0 eqA plusA multA eqA_dec n ltM ltM_dec a P) ->
stable P R.