(* fin *)
Definition R2:= 1 + 1.
Fixpoint IPR p {struct p}: R :=
match p with
xH => ring1
| xO xH => 1+1
| xO p1 => R2*(IPR p1)
| xI xH => 1+(1+1)
| xI p1 => 1+(R2*(IPR p1))
end.
Definition IZR1 z :=
match z with Z0 => 0
| Zpos p => IPR p
| Zneg p => -(IPR p)
end.
Fixpoint interpret3 t fv {struct t}: R :=
match t with
| (PEadd t1 t2) =>
let v1  := interpret3 t1 fv in
let v2  := interpret3 t2 fv in (v1 + v2)
| (PEmul t1 t2) =>
let v1  := interpret3 t1 fv in
let v2  := interpret3 t2 fv in (v1 * v2)
| (PEsub t1 t2) =>
let v1  := interpret3 t1 fv in
let v2  := interpret3 t2 fv in (v1 - v2)
| (PEopp t1) =>
let v1  := interpret3 t1 fv in (-v1)
| (PEpow t1 t2) =>
let v1  := interpret3 t1 fv in pow v1 (N.to_nat t2)
| (PEc t1) => (IZR1 t1)
| PEO => 0
| PEI => 1
| (PEX _ n) => List.nth (pred (Pos.to_nat n)) fv 0
end.
End nsatz1.
Ltac equality_to_goal H x y:=
(* eliminate trivial  hypotheses, but it takes time!: let h := fresh "nH" in (assert (h:equality x y); [solve [cring] | clear H; clear h]) || *) try (generalize (@psos_r1 _ _ _ _ _ _ _ _ _ _ _ x y H); clear H) .  Ltac equalities_to_goal := lazymatch goal with |  H: (_ ?x ?y) |- _ => equality_to_goal H x y |  H: (_ _ ?x ?y) |- _ => equality_to_goal H x y |  H: (_ _ _ ?x ?y) |- _ => equality_to_goal H x y |  H: (_ _ _ _ ?x ?y) |- _ => equality_to_goal H x y (* extension possible :-) *)
|  H: (?x == ?y) |- _ => equality_to_goal H x y
end.
(* lp est incluse dans fv. La met en tete. *)
Ltac parametres_en_tete fv lp :=
match fv with
| (@nil _)          => lp
| (@cons _ ?x ?fv1) =>
let res := AddFvTail x lp in
parametres_en_tete fv1 res
end.
Ltac append1 a l :=
match l with
| (@nil _)     => constr:(cons a l)
| (cons ?x ?l) => let l' := append1 a l in constr:(cons x l')
end.
Ltac rev l :=
match l with
|(@nil _)      => l
| (cons ?x ?l) => let l' := rev l in append1 x l'
end.
Ltac nsatz_call_n info nparam p rr lp kont :=
(*  idtac "Trying power: " rr;*)
let ll := constr:(PEc info :: PEc nparam :: PEpow p rr :: lp) in
(*  idtac "calcul...";*)
nsatz_compute ll;
(*  idtac "done";*)
match goal with
| |- (?c::PEpow _ ?r::?lq0)::?lci0 = _ -> _ =>
intros _;
let lci := fresh "lci" in
set (lci:=lci0);
let lq := fresh "lq" in
set (lq:=lq0);
kont c rr lq lci
end.
Ltac nsatz_call radicalmax info nparam p lp kont :=
let rec try_n n :=
lazymatch n with
| 0%N => fail
| _ =>
(let r := eval compute in (N.sub radicalmax (N.pred n)) in
nsatz_call_n info nparam p r lp kont) ||
let n' := eval compute in (N.pred n) in try_n n'
end in
try_n radicalmax.
Ltac lterm_goal g :=
match g with
?b1 == ?b2 => constr:(b1::b2::nil)
| ?b1 == ?b2 -> ?g => let l := lterm_goal g in constr:(b1::b2::l)
end.
Ltac reify_goal l le lb:=
match le with
nil => idtac
| ?e::?le1 =>
match lb with
?b::?lb1 => (* idtac "b="; idtac b;*)
let x := fresh "B" in
set (x:= b) at 1;
change x with (interpret3 e l);
clear x;
reify_goal l le1 lb1
end
end.
Ltac get_lpol g :=
match g with
(interpret3 ?p _) == _ => constr:(p::nil)
| (interpret3 ?p _) == _ -> ?g =>
let l := get_lpol g in constr:(p::l)
end.
(** We only make use of [discrR] if [nsatz] support for reals is loaded.  To do this, we redefine this tactic in Nsatz.v to make use of real discrimination. *)
Ltac nsatz_internal_discrR := idtac.
Ltac nsatz_generic radicalmax info lparam lvar :=
let nparam := eval compute in (Z.of_nat (List.length lparam)) in
match goal with
|- ?g => let lb := lterm_goal g in
match (lazymatch lvar with
|(@nil _) =>
lazymatch lparam with
|(@nil _) =>
let r := list_reifyl0 lb in
r
|_ =>
let reif := list_reifyl0 lb in
match reif with
|(?fv, ?le) =>
let fv := parametres_en_tete fv lparam in
(* we reify a second time, with the good order for variables *)
list_reifyl fv lb
end
end
|_ =>
let fv := parametres_en_tete lvar lparam in
list_reifyl fv lb
end) with
|(?fv, ?le) =>
reify_goal fv le lb ;
match goal with
|- ?g =>
let lp := get_lpol g in
let lpol := eval compute in (List.rev lp) in
intros;
let SplitPolyList kont :=
match lpol with
| ?p2::?lp2 => kont p2 lp2
| _ => idtac "polynomial not in the ideal"
end in
SplitPolyList ltac:(fun p lp =>
let p21 := fresh "p21" in
let lp21 := fresh "lp21" in
set (p21:=p) ;
set (lp21:=lp);
(*    idtac "nparam:"; idtac nparam; idtac "p:"; idtac p; idtac "lp:"; idtac lp; *)
nsatz_call radicalmax info nparam p lp ltac:(fun c r lq lci =>
let q := fresh "q" in
set (q := PEmul c (PEpow p21 r));
let Hg := fresh "Hg" in
assert (Hg:check lp21 q (lci,lq) = true);
[ (vm_compute;reflexivity) || idtac "invalid nsatz certificate"
| let Hg2 := fresh "Hg" in
assert (Hg2: (interpret3 q fv) == 0);
[ (*simpl*) idtac;
generalize (@check_correct _ _ _ _ _ _ _ _ _ _ _ fv lp21 q (lci,lq) Hg);
let cc := fresh "H" in
(*simpl*) idtac; intro cc; apply cc; clear cc; (*simpl*) idtac; repeat (split;[assumption|idtac]); exact I | (*simpl in Hg2;*) (*simpl*) idtac; apply Rintegral_domain_pow with (interpret3 c fv) (N.to_nat r); (*simpl*) idtac; try apply integral_domain_one_zero; try apply integral_domain_minus_one_zero; try trivial; try exact integral_domain_one_zero; try exact integral_domain_minus_one_zero || (solve [simpl; unfold R2, equality, eq_notation, addition, add_notation, one, one_notation, multiplication, mul_notation, zero, zero_notation; nsatz_internal_discrR || lia ]) || ((*simpl*) idtac) || idtac "could not prove discrimination result" ] ] ) ) end end end .  Ltac nsatz_default:= intros; try apply (@psos_r1b _ _ _ _ _ _ _ _ _ _ _); match goal with |- (@equality ?r _ _ _) => repeat equalities_to_goal; nsatz_generic 6%N 1%Z (@nil r) (@nil r) end.  Tactic Notation "nsatz" := nsatz_default.  Tactic Notation "nsatz" "with" "radicalmax" ":=" constr(radicalmax) "strategy" ":=" constr(info) "parameters" ":=" constr(lparam) "variables" ":=" constr(lvar):= intros; try apply (@psos_r1b _ _ _ _ _ _ _ _ _ _ _); match goal with |- (@equality ?r _ _ _) => repeat equalities_to_goal; nsatz_generic radicalmax info lparam lvar end.  (* Rational numbers *)
#[global]
Instance Qops: (@Ring_ops Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq).
Defined.
#[global]
Instance Qri : (Ring (Ro:=Qops)).
constructor.
- apply Q_Setoid.
- apply Qplus_comp.
- apply Qmult_comp.
- apply Qminus_comp.
- apply Qopp_comp.
- exact Qplus_0_l.
- exact Qplus_comm.
- apply Qplus_assoc.
- exact Qmult_1_l.
- exact Qmult_1_r.
- apply Qmult_assoc.
- apply Qmult_plus_distr_l.
- intros. apply Qmult_plus_distr_r.
- reflexivity.
- exact Qplus_opp_r.
Defined.

(* Specifications: *)
Lemma Q_one_zero: not (Qeq 1%Q 0%Q).