Library Coq.micromega.ZMicromega
Require Import OrderedRing.
Require Import RingMicromega.
Require Import ZCoeff.
Require Import Refl.
Require Import ZArith.
Require Import List.
Require Import Bool.
Ltac flatten_bool :=
repeat match goal with
[ id : (_ && _)%bool = true |- _ ] => destruct (andb_prop _ _ id); clear id
| [ id : (_ || _)%bool = true |- _ ] => destruct (orb_prop _ _ id); clear id
end.
Ltac inv H := inversion H ; try subst ; clear H.
Require Import EnvRing.
Open Scope Z_scope.
Lemma Zsor : SOR 0 1 Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt.
Lemma ZSORaddon :
SORaddon 0 1 Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le
0%Z 1%Z Z.add Z.mul Z.sub Z.opp
Zeq_bool Z.leb
(fun x => x) (fun x => x) (pow_N 1 Z.mul).
Fixpoint Zeval_expr (env : PolEnv Z) (e: PExpr Z) : Z :=
match e with
| PEc c => c
| PEX _ x => env x
| PEadd e1 e2 => Zeval_expr env e1 + Zeval_expr env e2
| PEmul e1 e2 => Zeval_expr env e1 * Zeval_expr env e2
| PEpow e1 n => Z.pow (Zeval_expr env e1) (Z.of_N n)
| PEsub e1 e2 => (Zeval_expr env e1) - (Zeval_expr env e2)
| PEopp e => Z.opp (Zeval_expr env e)
end.
Definition eval_expr := eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => x) (pow_N 1 Z.mul).
Lemma ZNpower : forall r n, r ^ Z.of_N n = pow_N 1 Z.mul r n.
Lemma Zeval_expr_compat : forall env e, Zeval_expr env e = eval_expr env e.
Definition Zeval_op2 (o : Op2) : Z -> Z -> Prop :=
match o with
| OpEq => @eq Z
| OpNEq => fun x y => ~ x = y
| OpLe => Z.le
| OpGe => Z.ge
| OpLt => Z.lt
| OpGt => Z.gt
end.
Definition Zeval_formula (env : PolEnv Z) (f : Formula Z):=
let (lhs, op, rhs) := f in
(Zeval_op2 op) (Zeval_expr env lhs) (Zeval_expr env rhs).
Definition Zeval_formula' :=
eval_formula Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt (fun x => x) (fun x => x) (pow_N 1 Z.mul).
Lemma Zeval_formula_compat : forall env f, Zeval_formula env f <-> Zeval_formula' env f.
Definition eval_nformula :=
eval_nformula 0 Z.add Z.mul (@eq Z) Z.le Z.lt (fun x => x) .
Definition Zeval_op1 (o : Op1) : Z -> Prop :=
match o with
| Equal => fun x : Z => x = 0
| NonEqual => fun x : Z => x <> 0
| Strict => fun x : Z => 0 < x
| NonStrict => fun x : Z => 0 <= x
end.
Lemma Zeval_nformula_dec : forall env d, (eval_nformula env d) \/ ~ (eval_nformula env d).
Definition ZWitness := Psatz Z.
Definition ZWeakChecker := check_normalised_formulas 0 1 Z.add Z.mul Zeq_bool Z.leb.
Lemma ZWeakChecker_sound : forall (l : list (NFormula Z)) (cm : ZWitness),
ZWeakChecker l cm = true ->
forall env, make_impl (eval_nformula env) l False.
Definition psub := psub Z0 Z.add Z.sub Z.opp Zeq_bool.
Definition padd := padd Z0 Z.add Zeq_bool.
Definition norm := norm 0 1 Z.add Z.mul Z.sub Z.opp Zeq_bool.
Definition eval_pol := eval_pol Z.add Z.mul (fun x => x).
Lemma eval_pol_sub : forall env lhs rhs, eval_pol env (psub lhs rhs) = eval_pol env lhs - eval_pol env rhs.
Lemma eval_pol_add : forall env lhs rhs, eval_pol env (padd lhs rhs) = eval_pol env lhs + eval_pol env rhs.
Lemma eval_pol_norm : forall env e, eval_expr env e = eval_pol env (norm e) .
Definition xnormalise (t:Formula Z) : list (NFormula Z) :=
let (lhs,o,rhs) := t in
let lhs := norm lhs in
let rhs := norm rhs in
match o with
| OpEq =>
((psub lhs (padd rhs (Pc 1))),NonStrict)::((psub rhs (padd lhs (Pc 1))),NonStrict)::nil
| OpNEq => (psub lhs rhs,Equal) :: nil
| OpGt => (psub rhs lhs,NonStrict) :: nil
| OpLt => (psub lhs rhs,NonStrict) :: nil
| OpGe => (psub rhs (padd lhs (Pc 1)),NonStrict) :: nil
| OpLe => (psub lhs (padd rhs (Pc 1)),NonStrict) :: nil
end.
Require Import Coq.micromega.Tauto BinNums.
Definition normalise (t:Formula Z) : cnf (NFormula Z) :=
List.map (fun x => x::nil) (xnormalise t).
Lemma normalise_correct : forall env t, eval_cnf eval_nformula env (normalise t) <-> Zeval_formula env t.
Definition xnegate (t:RingMicromega.Formula Z) : list (NFormula Z) :=
let (lhs,o,rhs) := t in
let lhs := norm lhs in
let rhs := norm rhs in
match o with
| OpEq => (psub lhs rhs,Equal) :: nil
| OpNEq => ((psub lhs (padd rhs (Pc 1))),NonStrict)::((psub rhs (padd lhs (Pc 1))),NonStrict)::nil
| OpGt => (psub lhs (padd rhs (Pc 1)),NonStrict) :: nil
| OpLt => (psub rhs (padd lhs (Pc 1)),NonStrict) :: nil
| OpGe => (psub lhs rhs,NonStrict) :: nil
| OpLe => (psub rhs lhs,NonStrict) :: nil
end.
Definition negate (t:RingMicromega.Formula Z) : cnf (NFormula Z) :=
List.map (fun x => x::nil) (xnegate t).
Lemma negate_correct : forall env t, eval_cnf eval_nformula env (negate t) <-> ~ Zeval_formula env t.
Opaque padd.
Transparent padd.
Definition Zunsat := check_inconsistent 0 Zeq_bool Z.leb.
Definition Zdeduce := nformula_plus_nformula 0 Z.add Zeq_bool.
Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z)) : bool :=
@tauto_checker (Formula Z) (NFormula Z) Zunsat Zdeduce normalise negate ZWitness ZWeakChecker f w.
Require Import Zdiv.
Open Scope Z_scope.
Definition ceiling (a b:Z) : Z :=
let (q,r) := Z.div_eucl a b in
match r with
| Z0 => q
| _ => q + 1
end.
Require Import Znumtheory.
Lemma Zdivide_ceiling : forall a b, (b | a) -> ceiling a b = Z.div a b.
Lemma narrow_interval_lower_bound a b x :
a > 0 -> a * x >= b -> x >= ceiling b a.
NB: narrow_interval_upper_bound is Zdiv.Zdiv_le_lower_bound
Require Import QArith.
Inductive ZArithProof :=
| DoneProof
| RatProof : ZWitness -> ZArithProof -> ZArithProof
| CutProof : ZWitness -> ZArithProof -> ZArithProof
| EnumProof : ZWitness -> ZWitness -> list ZArithProof -> ZArithProof
.
Require Import Znumtheory.
Definition isZ0 (x:Z) :=
match x with
| Z0 => true
| _ => false
end.
Lemma isZ0_0 : forall x, isZ0 x = true <-> x = 0.
Lemma isZ0_n0 : forall x, isZ0 x = false <-> x <> 0.
Definition ZgcdM (x y : Z) := Z.max (Z.gcd x y) 1.
Fixpoint Zgcd_pol (p : PolC Z) : (Z * Z) :=
match p with
| Pc c => (0,c)
| Pinj _ p => Zgcd_pol p
| PX p _ q =>
let (g1,c1) := Zgcd_pol p in
let (g2,c2) := Zgcd_pol q in
(ZgcdM (ZgcdM g1 c1) g2 , c2)
end.
Fixpoint Zdiv_pol (p:PolC Z) (x:Z) : PolC Z :=
match p with
| Pc c => Pc (Z.div c x)
| Pinj j p => Pinj j (Zdiv_pol p x)
| PX p j q => PX (Zdiv_pol p x) j (Zdiv_pol q x)
end.
Inductive Zdivide_pol (x:Z): PolC Z -> Prop :=
| Zdiv_Pc : forall c, (x | c) -> Zdivide_pol x (Pc c)
| Zdiv_Pinj : forall p, Zdivide_pol x p -> forall j, Zdivide_pol x (Pinj j p)
| Zdiv_PX : forall p q, Zdivide_pol x p -> Zdivide_pol x q -> forall j, Zdivide_pol x (PX p j q).
Lemma Zdiv_pol_correct : forall a p, 0 < a -> Zdivide_pol a p ->
forall env, eval_pol env p = a * eval_pol env (Zdiv_pol p a).
Lemma Zgcd_pol_ge : forall p, fst (Zgcd_pol p) >= 0.
Lemma Zdivide_pol_Zdivide : forall p x y, Zdivide_pol x p -> (y | x) -> Zdivide_pol y p.
Lemma Zdivide_pol_one : forall p, Zdivide_pol 1 p.
Lemma Zgcd_minus : forall a b c, (a | c - b ) -> (Z.gcd a b | c).
Lemma Zdivide_pol_sub : forall p a b,
0 < Z.gcd a b ->
Zdivide_pol a (PsubC Z.sub p b) ->
Zdivide_pol (Z.gcd a b) p.
Lemma Zdivide_pol_sub_0 : forall p a,
Zdivide_pol a (PsubC Z.sub p 0) ->
Zdivide_pol a p.
Lemma Zgcd_pol_div : forall p g c,
Zgcd_pol p = (g, c) -> Zdivide_pol g (PsubC Z.sub p c).
Lemma Zgcd_pol_correct_lt : forall p env g c, Zgcd_pol p = (g,c) -> 0 < g -> eval_pol env p = g * (eval_pol env (Zdiv_pol (PsubC Z.sub p c) g)) + c.
Definition makeCuttingPlane (p : PolC Z) : PolC Z * Z :=
let (g,c) := Zgcd_pol p in
if Z.gtb g Z0
then (Zdiv_pol (PsubC Z.sub p c) g , Z.opp (ceiling (Z.opp c) g))
else (p,Z0).
Definition genCuttingPlane (f : NFormula Z) : option (PolC Z * Z * Op1) :=
let (e,op) := f in
match op with
| Equal => let (g,c) := Zgcd_pol e in
if andb (Z.gtb g Z0) (andb (negb (Zeq_bool c Z0)) (negb (Zeq_bool (Z.gcd g c) g)))
then None
else
let (p,c) := makeCuttingPlane e in
Some (p,c,Equal)
| NonEqual => Some (e,Z0,op)
| Strict => let (p,c) := makeCuttingPlane (PsubC Z.sub e 1) in
Some (p,c,NonStrict)
| NonStrict => let (p,c) := makeCuttingPlane e in
Some (p,c,NonStrict)
end.
Definition nformula_of_cutting_plane (t : PolC Z * Z * Op1) : NFormula Z :=
let (e_z, o) := t in
let (e,z) := e_z in
(padd e (Pc z) , o).
Definition is_pol_Z0 (p : PolC Z) : bool :=
match p with
| Pc Z0 => true
| _ => false
end.
Lemma is_pol_Z0_eval_pol : forall p, is_pol_Z0 p = true -> forall env, eval_pol env p = 0.
Definition eval_Psatz : list (NFormula Z) -> ZWitness -> option (NFormula Z) :=
eval_Psatz 0 1 Z.add Z.mul Zeq_bool Z.leb.
Definition valid_cut_sign (op:Op1) :=
match op with
| Equal => true
| NonStrict => true
| _ => false
end.
Fixpoint ZChecker (l:list (NFormula Z)) (pf : ZArithProof) {struct pf} : bool :=
match pf with
| DoneProof => false
| RatProof w pf =>
match eval_Psatz l w with
| None => false
| Some f =>
if Zunsat f then true
else ZChecker (f::l) pf
end
| CutProof w pf =>
match eval_Psatz l w with
| None => false
| Some f =>
match genCuttingPlane f with
| None => true
| Some cp => ZChecker (nformula_of_cutting_plane cp::l) pf
end
end
| EnumProof w1 w2 pf =>
match eval_Psatz l w1 , eval_Psatz l w2 with
| Some f1 , Some f2 =>
match genCuttingPlane f1 , genCuttingPlane f2 with
|Some (e1,z1,op1) , Some (e2,z2,op2) =>
if (valid_cut_sign op1 && valid_cut_sign op2 && is_pol_Z0 (padd e1 e2))
then
(fix label (pfs:list ZArithProof) :=
fun lb ub =>
match pfs with
| nil => if Z.gtb lb ub then true else false
| pf::rsr => andb (ZChecker ((psub e1 (Pc lb), Equal) :: l) pf) (label rsr (Z.add lb 1%Z) ub)
end) pf (Z.opp z1) z2
else false
| _ , _ => true
end
| _ , _ => false
end
end.
Fixpoint bdepth (pf : ZArithProof) : nat :=
match pf with
| DoneProof => O
| RatProof _ p => S (bdepth p)
| CutProof _ p => S (bdepth p)
| EnumProof _ _ l => S (List.fold_right (fun pf x => Max.max (bdepth pf) x) O l)
end.
Require Import Wf_nat.
Lemma in_bdepth : forall l a b y, In y l -> ltof ZArithProof bdepth y (EnumProof a b l).
Lemma eval_Psatz_sound : forall env w l f',
make_conj (eval_nformula env) l ->
eval_Psatz l w = Some f' -> eval_nformula env f'.
Lemma makeCuttingPlane_ns_sound : forall env e e' c,
eval_nformula env (e, NonStrict) ->
makeCuttingPlane e = (e',c) ->
eval_nformula env (nformula_of_cutting_plane (e', c, NonStrict)).
Lemma cutting_plane_sound : forall env f p,
eval_nformula env f ->
genCuttingPlane f = Some p ->
eval_nformula env (nformula_of_cutting_plane p).
Lemma genCuttingPlaneNone : forall env f,
genCuttingPlane f = None ->
eval_nformula env f -> False.
Lemma ZChecker_sound : forall w l, ZChecker l w = true -> forall env, make_impl (eval_nformula env) l False.
Definition ZTautoChecker (f : BFormula (Formula Z)) (w: list ZArithProof): bool :=
@tauto_checker (Formula Z) (NFormula Z) Zunsat Zdeduce normalise negate ZArithProof ZChecker f w.
Lemma ZTautoChecker_sound : forall f w, ZTautoChecker f w = true -> forall env, eval_f (Zeval_formula env) f.
Fixpoint xhyps_of_pt (base:nat) (acc : list nat) (pt:ZArithProof) : list nat :=
match pt with
| DoneProof => acc
| RatProof c pt => xhyps_of_pt (S base ) (xhyps_of_psatz base acc c) pt
| CutProof c pt => xhyps_of_pt (S base ) (xhyps_of_psatz base acc c) pt
| EnumProof c1 c2 l =>
let acc := xhyps_of_psatz base (xhyps_of_psatz base acc c2) c1 in
List.fold_left (xhyps_of_pt (S base)) l acc
end.
Definition hyps_of_pt (pt : ZArithProof) : list nat := xhyps_of_pt 0 nil pt.
Open Scope Z_scope.
To ease bindings from ml code
Definition make_impl := Refl.make_impl.
Definition make_conj := Refl.make_conj.
Require VarMap.
Definition env := PolEnv Z.
Definition node := @VarMap.Node Z.
Definition empty := @VarMap.Empty Z.
Definition leaf := @VarMap.Leaf Z.
Definition coneMember := ZWitness.
Definition eval := eval_formula.
Definition prod_pos_nat := prod positive nat.
Notation n_of_Z := Z.to_N (only parsing).
Definition make_conj := Refl.make_conj.
Require VarMap.
Definition env := PolEnv Z.
Definition node := @VarMap.Node Z.
Definition empty := @VarMap.Empty Z.
Definition leaf := @VarMap.Leaf Z.
Definition coneMember := ZWitness.
Definition eval := eval_formula.
Definition prod_pos_nat := prod positive nat.
Notation n_of_Z := Z.to_N (only parsing).