feat(lra): certificate checking for simplex2

This commit is contained in:
Simon Cruanes 2021-02-16 15:18:19 -05:00
parent 284a475197
commit 0bd2770b40
2 changed files with 41 additions and 55 deletions

View file

@ -323,7 +323,7 @@ module Make(A : ARG) : S with module A = A = struct
(* raise conflict from certificate *) (* raise conflict from certificate *)
let fail_with_cert si acts cert : 'a = let fail_with_cert si acts cert : 'a =
(* TODO: check certificate *) Profile.with1 "simplex.check-cert" SimpSolver._check_cert cert;
let confl = let confl =
SimpSolver.Unsat_cert.lits cert SimpSolver.Unsat_cert.lits cert
|> CCList.flat_map (Tag.to_lits si) |> CCList.flat_map (Tag.to_lits si)

View file

@ -114,6 +114,8 @@ module type S = sig
(**/**) (**/**)
val _check_invariants : t -> unit val _check_invariants : t -> unit
(* check internal invariants *) (* check internal invariants *)
val _check_cert : unsat_cert -> unit
(**/**) (**/**)
end end
@ -978,58 +980,42 @@ module Make(Var: VAR)
Sat m Sat m
with E_unsat c -> Unsat c with E_unsat c -> Unsat c
(* TODO let _check_cert (cert:unsat_cert) : unit =
match cert with
(* maybe invert bounds, if [c < 0] *) | E_bounds {x=_; lower; upper} ->
let scale_bounds c (l,u) : bound * bound = (* unsat means [lower > upper] *)
match Q.compare c Q.zero with if not Erat.(lower.b_val > upper.b_val) then (
| 0 -> Error.errorf "invalid simplex cert: %a" Unsat_cert.pp cert
let b = { value = Erat.zero; reason = None; } in );
b, b | E_unsat_basic { x=_; x_bound; le; bounds } ->
| n when n<0 -> (* sum of [bounds], weighted by coefficient from [le] *)
{ u with value = Erat.mul c u.value; }, let is_lower, x_b =
{ l with value = Erat.mul c l.value; } match x_bound with
| _ -> | (Leq | Lt), b -> false, b.b_val
{ l with value = Erat.mul c l.value; }, | (Geq|Gt), b -> true, b.b_val
{ u with value = Erat.mul c u.value; } in
let sum =
List.fold_left
let check_cert (t:t) (c:cert) = (fun sum (c, x) ->
let x = M.get c.cert_var t.var_states |> CCOpt.get_lazy (fun()->assert false) in match V_map.find x bounds with
let { value = low_x; reason = low_x_reason; } = x.l_bound in | exception Not_found ->
let { value = up_x; reason = upp_x_reason; } = x.u_bound in Error.errorf "invalid simplex cert:@ %a@ var %a has no bound"
begin match c.cert_expr with Unsat_cert.pp cert Var.pp x
| [] -> | Op.(Geq | Gt), _ when CCBool.equal is_lower Q.(c > zero) ->
if Erat.compare low_x up_x > 0 Error.errorf
then `Ok (add_to_unsat_core (add_to_unsat_core [] low_x_reason) upp_x_reason) "invalid simplex cert:@ %a@ variable %a has coeff of the wrong sign %a"
else `Bad_bounds (str_of_erat low_x, str_of_erat up_x) Unsat_cert.pp cert Var.pp x Q.pp_print c
| expr -> | Op.(Lt | Leq), _ when CCBool.equal is_lower Q.(c < zero) ->
let e0 = deref_var_ t x (Q.neg Q.one) M.empty in Error.errorf
(* compute bounds for the expression [c.cert_expr], "invalid simplex cert:@ %a@ variable %a has coeff of the wrong sign %a"
and also compute [c.cert_expr - x] to check if it's 0] *) Unsat_cert.pp cert Var.pp x Q.pp_print c
let low, low_unsat_core, up, up_unsat_core, expr_minus_x = | _, b -> Erat.(sum + c * b.b_val))
List.fold_left Erat.zero le
(fun (l, luc, u, uuc, expr_minus_x) (c, y) -> in
let y = M.get y t.var_states |> CCOpt.get_lazy (fun ()->assert false) in (* unsat if lower bound [x_b] is > [sum], which is an upper bound *)
let ly, uy = scale_bounds c (get_bounds y) in let ok = if is_lower then Erat.(x_b > sum) else Erat.(x_b < sum) in
assert (Erat.compare ly.value uy.value <= 0); if not ok then (
let expr_minus_x = deref_var_ t y c expr_minus_x in Error.errorf "invalid simplex cert:@ %a@ sum of linexpr is %a"
let luc = add_to_unsat_core luc ly.reason in Unsat_cert.pp cert Erat.pp sum
let uuc = add_to_unsat_core uuc uy.reason in )
Erat.sum l ly.value, luc, Erat.sum u uy.value, uuc, expr_minus_x)
(Erat.zero, [], Erat.zero, [], e0)
expr
in
(* check that the expanded expression is [x], and that
one of the bounds on [x] is incompatible with bounds of [c.cert_expr] *)
if M.is_empty expr_minus_x then (
if Erat.compare low_x up > 0
then `Ok (add_to_unsat_core up_unsat_core low_x_reason)
else if Erat.compare up_x low < 0
then `Ok (add_to_unsat_core low_unsat_core upp_x_reason)
else `Bad_bounds (str_of_erat low, str_of_erat up)
) else `Diff_not_0 expr_minus_x
end
*)
end end