(* OCaml code *) (* http://ocaml.org/ *) (** Preliminaries **) let print_bool b = if b then print_string "true" else print_string "false" (* Time Measure *) (* computation time for f x *) let time f x = let start = Sys.time () in let r = f x in let stop = Sys.time () in (r, stop -. start) (* computes f x and writes computation time *) let print_time f x = let start = Sys.time () in let result = f x in let stop = Sys.time () in print_string ("Time: "^(string_of_float (stop -. start))^" s"); result (* Counters *) let counter = ref 0 let reset_counter () = counter := 0 let step_counter () = counter := 1 + !counter let show_counter () = print_int !counter (* count formulas *) (* let tick () = () *) let init_tick () = reset_counter () let tick () = step_counter () let repeat_tick n = for i = 1 to n do tick () done let val_tick () = !counter let print_tick () = show_counter () open List let rec seq_string_of_map_list f = function | [] -> "" | [a] -> f a | h::t -> f h ^ "; " ^ seq_string_of_map_list f t (** Formulas and Sequents **) (* formulas *) type form = A of int (* atoms *) | C of int (* co-atoms *) | T (* top *) | B (* bottom *) | W of form * form (* wedge *) | V of form * form (* vee *) let rec string_of_form = function | A n -> "X"^string_of_int n | C n -> "X'"^string_of_int n | T -> "T" | B -> "F" | W (a, b) -> "("^(string_of_form a)^" & "^(string_of_form b)^")" | V (a, b) -> "("^(string_of_form a)^" + "^(string_of_form b)^")" let print_form a = print_string (string_of_form a) let rec size_form = function | A _ | C _ | T | B -> 1 | W (a, b) | V (a, b) -> 1 + (size_form a) + (size_form b) (* random formula with at most v variables and size 2n *) let rec frandom v = function | 0 -> (match Random.int 4 with | 0 -> B | 1 -> T | 2 -> A (Random.int v) | _ -> C (Random.int v)) | n -> let k = Random.int n in (match Random.int 2 with | 0 -> V (frandom v k,frandom v (n-k-1)) | _ -> W (frandom v k,frandom v (n-k-1))) (* comparison of formulas based on size first *) let cmp_form a b = let la = size_form a in let lb = size_form b in if la < lb then -1 else if la > lb then 1 else compare a b (* negation of formula *) let rec neg = function | A n -> C n | C n -> A n | T -> B | B -> T | W (a, b) -> V (neg a, neg b) | V (a, b) -> W (neg a, neg b) (* test if synchronous *) let sync = function | A _ | B | V _ -> true | _ -> false (* test if asynchronous *) let async a = not (sync a) module FormOrd = struct type t = form let compare = cmp_form end module FormSet = Set.Make(FormOrd) let string_of_formlist l = "[" ^ seq_string_of_map_list string_of_form l ^ "]" let string_of_formset s = string_of_formlist (FormSet.elements s) let print_formset s = print_string (string_of_formset s) module FormSetSet = Set.Make(FormSet) let listsetset_union l = fold_right FormSetSet.union l FormSetSet.empty (* product order on pairs of formulas *) let cmp_biform (a1, a2) (b1, b2) = let c1 = cmp_form a1 b1 in if c1 < 0 then -1 else if c1 > 0 then 1 else cmp_form a2 b2 module BiFormOrd = struct type t = form * form let compare = cmp_biform end (* sets of pairs of formulas *) module BiFormSet = Set.Make(BiFormOrd) let string_of_biform (a, b) = "(" ^ string_of_form a ^ ", " ^ string_of_form b ^ ")" let string_of_biformlist l = "[" ^ seq_string_of_map_list string_of_biform l ^ "]" let string_of_biformset s = string_of_biformlist (BiFormSet.elements s) let print_biformset s = print_string (string_of_biformset s) module BiBiFormOrd = struct type t = (form * form) * (form * form) let compare (a1, a2) (b1, b2) = let c1 = cmp_biform a1 b1 in if c1 < 0 then -1 else if c1 > 0 then 1 else cmp_biform a2 b2 end (* sets of pairs of pairs of formulas *) module BiBiFormSet = Set.Make(BiBiFormOrd) let listbibiformset_union l = fold_right BiBiFormSet.union l BiBiFormSet.empty module FormSetBiOrd = struct type t = FormSet.t * FormSet.t let compare (a1, a2) (b1, b2) = let c1 = FormSet.compare a1 b1 in if c1 < 0 then -1 else if c1 > 0 then 1 else FormSet.compare a2 b2 end (* sets of pairs of sets of formulas *) module FormSetBiSet = Set.Make(FormSetBiOrd) let listformsetbiset_union l = fold_right FormSetBiSet.union l FormSetBiSet.empty (* set of all sub-formulas *) let rec subform = function | (A _ as c) | (C _ as c) | (T as c) | (B as c) -> FormSet.singleton c | (W (a, b) as c) | (V (a, b) as c) -> FormSet.add c (FormSet.union (subform a) (subform b)) (* set of all vee-starting sub-formulas *) let rec vsubform = function | A _ | C _ | T | B -> FormSet.empty | W (a, b) -> FormSet.union (vsubform a) (vsubform b) | V (a, b) as c -> FormSet.add c (FormSet.union (vsubform a) (vsubform b)) (* set of sub-formulas just below a vee *) let rec svsubform = function | A _ | C _ | T | B -> FormSet.empty | W (a, b) -> FormSet.union (svsubform a) (svsubform b) | V (a, b) -> FormSet.add a (FormSet.add b (FormSet.union (svsubform a) (svsubform b))) (* set of sub-formulas just below a wedge *) let rec swsubform = function | A _ | C _ | T | B -> FormSet.empty | W (a, b) -> FormSet.add a (FormSet.add b (FormSet.union (swsubform a) (swsubform b))) | V (a, b) -> FormSet.union (swsubform a) (swsubform b) (* set of sub-formulas below wedges only (including 0) *) let rec swwsubform = function | (A _ as c) | (C _ as c) | (T as c) | (B as c) -> FormSet.singleton c | W (a, b) as c -> FormSet.add c (FormSet.union (swwsubform a) (swwsubform b)) | V _ as c -> FormSet.singleton c (* set of proper vee-starting sub-formulas *) let pvsubform = function | V (a, b) -> FormSet.union (vsubform a) (vsubform b) | a -> vsubform a (* set of synchronous sub-formulas *) let rec ssubform = function | (A _ as c) | (B as c) -> FormSet.singleton c | C _ | T -> FormSet.empty | W (a, b) -> FormSet.union (ssubform a) (ssubform b) | V (a, b) as c -> FormSet.add c (FormSet.union (ssubform a) (ssubform b)) (* set of synchronous sub-formulas and negation of variables *) let rec snsubform = function | (A _ as c) | (C _ as c) | (B as c) -> FormSet.singleton c | T -> FormSet.empty | W (a, b) -> FormSet.union (snsubform a) (snsubform b) | V (a, b) as c -> FormSet.add c (FormSet.union (snsubform a) (snsubform b)) (* set of duals of asynchronous sub-formulas *) let rec consubform = function | A _ | B -> FormSet.empty | C n -> FormSet.singleton (A n) | T -> FormSet.singleton B | W (a, b) -> FormSet.add (V (neg a,neg b)) (FormSet.union (consubform a) (consubform b)) | V (a, b) -> FormSet.union (consubform a) (consubform b) (* set of both sub-formulas and dual of sub-formulas *) let bisubform f = FormSet.inter (ssubform f) (consubform f) (* set of variables in sub-formulas *) let rec atsubform = function | A _ as c -> FormSet.singleton c | C _ | T | B -> FormSet.empty | W (a, b) | V (a, b) -> FormSet.union (atsubform a) (atsubform b) (* set of variables with dual in sub-formulas *) let rec cosubform = function | A _ | T | B -> FormSet.empty | C n -> FormSet.singleton (A n) | W (a, b) | V (a, b) -> FormSet.union (cosubform a) (cosubform b) (* set of variables both sub-formulas and dual of sub-formulas *) let atbisubform f = FormSet.inter (atsubform f) (cosubform f) (* sequent types *) type sequent = RR | RV | FC (* Memoization *) let memo = Hashtbl.create 251 let add_memo t a b v = Hashtbl.add memo (t,(a, b)) v ; v let val_memo t a b = Hashtbl.find memo (t,(a, b)) let is_memo t a b = Hashtbl.mem memo (t,(a, b)) let reset_memo () = Hashtbl.clear memo (* no memo to test without memoization: let is_memo t a b = false *) (** Proof Search Procedures **) (* Implementation of OLf with Memoization *) let rec molf_rr c = tick (); function | W (a, b) -> (molf_rr c a) && (molf_rr c b) | T -> true | V _ as a -> (molf_rv a c) || (molf_fc a a) | a -> molf_rv a c and molf_rv c d = tick (); if is_memo RV c d then val_memo RV c d else if (match d with | W (a, b) -> (molf_rv c a) && (molf_rv c b) | T -> true | V _ -> (molf_fc d c) || (molf_fc c d) || (molf_fc d d) | A _ when sync c -> (molf_fc d c) || (molf_fc c d) | A _ -> molf_fc c d | C _ | B when sync c -> molf_fc d c | _ -> false) then add_memo RV c d true else add_memo RV c d false and molf_fc c d = tick (); if is_memo FC c d then val_memo FC c d else if (match d with | A n -> c = C n | V (a, b) -> (molf_fc c a) || (molf_fc c b) | B -> false | _ -> molf_rv c d) then add_memo FC c d true else add_memo FC c d false let molf a b = reset_memo (); molf_rr a b (* Egly-Tompits *) (* contraction-free mono-sided set-based proofs *) let rec sprove_cfs r ff = tick (); if FormSetSet.mem ff r then true else let max = FormSet.max_elt ff in let min = FormSet.min_elt ff in match max with | A n -> min = C n | C n -> min = A n | T -> true | B -> min = T | W (a, b) -> let mins = FormSet.singleton min in (sprove_cfs r (FormSet.add a mins)) && (sprove_cfs r (FormSet.add b mins)) | V (a, b) -> let mins = FormSet.singleton min in (sprove_cfs r (FormSet.add a mins)) || (sprove_cfs r (FormSet.add b mins)) || match min with | W (a, b) -> let maxs = FormSet.singleton max in (sprove_cfs r (FormSet.add a maxs)) && (sprove_cfs r (FormSet.add b maxs)) | V (a, b) -> let maxs = FormSet.singleton max in (sprove_cfs r (FormSet.add a maxs)) || (sprove_cfs r (FormSet.add b maxs)) | _ -> false let prove_cfs a f = sprove_cfs a (FormSet.singleton f) exception Break (* mono-sided prove-cf algorithm *) let prove_cf f = let sf = subform f in let r = ref FormSetSet.empty in let s = ref (FormSet.elements (pvsubform f)) in let phi = ref (prove_cfs !r f) in try while not !phi do match !s with | [] -> raise Break | h::t -> s := t; if prove_cfs !r h then let hh = FormSet.singleton h in ( r := FormSet.fold (fun m e -> FormSetSet.add (FormSet.add m hh) e) sf !r; phi := prove_cfs !r f ) else () done; true with Break -> false (* Forward Search a la Egly-Tompits *) (* cartesian product of FormSetSet s1 and s2 *) let setbiset_prod s1 s2 = (* maps FormSetSet {a1, ..., an} to {(x, a1), ..., (x, an)} *) let formbiset_prod_l x s = FormSetSet.fold (fun y -> FormSetBiSet.add (x,y)) s FormSetBiSet.empty in FormSetSet.fold (fun x -> FormSetBiSet.union (formbiset_prod_l x s2)) s1 FormSetBiSet.empty let is_vee_of a = function | V (x, y) when x = a || y = a -> true | _ -> false exception ExitOK let fprove f = let sf = subform f in let bs = bisubform f in let init = (* nullary rules *) let log_ax a = tick (); FormSetSet.add (FormSet.add (neg a) (FormSet.singleton a)) in let top_ax x = tick (); FormSetSet.add (FormSet.add x (FormSet.singleton T)) in FormSetSet.union (FormSet.fold log_ax bs FormSetSet.empty) (if FormSet.mem T sf then FormSet.fold top_ax sf FormSetSet.empty else FormSetSet.empty) in let step_1 p = (* unary rules *) if FormSet.cardinal p = 1 then let a = FormSet.choose p in (* p = {a} *) listsetset_union [ (* single-formula vee rules *) FormSet.fold (fun x -> tick (); FormSetSet.add (FormSet.singleton x)) (FormSet.filter (is_vee_of a) sf) FormSetSet.empty ; (* weakening *) FormSet.fold (fun x -> tick (); FormSetSet.add (FormSet.add x p)) sf FormSetSet.empty ] else let a = FormSet.min_elt p in let b = FormSet.max_elt p in (* p = {a,b} *) listsetset_union [ (* two-formulas vee rules on min formula *) FormSet.fold (fun x -> tick (); FormSetSet.add (FormSet.add x (FormSet.singleton b))) (FormSet.filter (is_vee_of a) sf) FormSetSet.empty ; (* two-formulas vee rules on max formula *) FormSet.fold (fun x -> tick (); FormSetSet.add (FormSet.add x (FormSet.singleton a))) (FormSet.filter (is_vee_of b) sf) FormSetSet.empty ] in let step_2 p q = (* binary rules *) if FormSet.cardinal p = 1 then let a = FormSet.choose p in (* p = {a} *) if FormSet.cardinal q = 1 then (* single-formula wedge rules*) let c = FormSet.choose q in (* q = {c} *) if FormSet.mem (W (a, c)) sf then FormSetSet.singleton (FormSet.singleton (W (a, c))) else FormSetSet.empty else (* one-two-formulas wedge rules *) let c = FormSet.min_elt q in let d = FormSet.max_elt q in (* q = {c,d} *) let res = ref FormSetSet.empty in (if FormSet.mem (W (a, c)) sf then res := (tick (); FormSetSet.add (FormSet.add d (FormSet.singleton (W (a, c)))) !res)); (if FormSet.mem (W (a, d)) sf then res := (tick (); FormSetSet.add (FormSet.add c (FormSet.singleton (W (a, d)))) !res)); !res else let a = FormSet.min_elt p in let b = FormSet.max_elt p in (* p = {a,b} *) if FormSet.cardinal q = 1 then (* two-one-formula wedge rules*) let c = FormSet.choose q in (* q = {c} *) let res = ref FormSetSet.empty in (if FormSet.mem (W (a, c)) sf then res := (tick (); FormSetSet.add (FormSet.add b (FormSet.singleton (W (a, c)))) !res)); (if FormSet.mem (W (b, c)) sf then res := (tick (); FormSetSet.add (FormSet.add a (FormSet.singleton (W (b, c)))) !res)); !res else (* two-two-formulas wedge rules *) let c = FormSet.min_elt q in let d = FormSet.max_elt q in (* q = {c,d} *) let res = ref FormSetSet.empty in (if (b = d && FormSet.mem (W (a, c)) sf) then res := (tick (); FormSetSet.add (FormSet.add b (FormSet.singleton (W (a, c)))) !res)); (if (b = c && FormSet.mem (W (a, d)) sf) then res := (tick (); FormSetSet.add (FormSet.add b (FormSet.singleton (W (a, d)))) !res)); (if (a = d && FormSet.mem (W (b, c)) sf) then res := (tick (); FormSetSet.add (FormSet.add a (FormSet.singleton (W (b, c)))) !res)); (if (a = c && FormSet.mem (W (b, d)) sf) then res := (tick (); FormSetSet.add (FormSet.add a (FormSet.singleton (W (b, d)))) !res)); !res in (* b : pairs of sequents to be treated m : singletons of sequents to be treated r : reached sequents *) let b = ref (setbiset_prod init init) in let m = ref init in let r = ref init in if FormSetSet.mem (FormSet.singleton f) init then true else try while not (FormSetBiSet.is_empty !b && FormSetSet.is_empty !m) do let s = ref FormSetSet.empty in while FormSetSet.is_empty !s && not (FormSetBiSet.is_empty !b) do let (p, q) = FormSetBiSet.choose !b in b := FormSetBiSet.remove (p, q) !b; s := FormSetSet.diff (step_2 p q) !r done; (if not (FormSetSet.is_empty !s) then (if FormSetSet.mem (FormSet.singleton f) !s then raise ExitOK); b := listformsetbiset_union [!b; setbiset_prod !s !r; setbiset_prod !r !s; setbiset_prod !s !s]; m := FormSetSet.union !m !s; r := FormSetSet.union !r !s; s := FormSetSet.empty); while FormSetSet.is_empty !s && not (FormSetSet.is_empty !m) do let p = FormSetSet.choose !m in m := FormSetSet.remove p !m; s := FormSetSet.diff (step_1 p) !r done; (if not (FormSetSet.is_empty !s) then (if FormSetSet.mem (FormSet.singleton f) !s then raise ExitOK); b := listformsetbiset_union [!b; setbiset_prod !s !r; setbiset_prod !r !s; setbiset_prod !s !s]; m := FormSetSet.union !m !s; r := FormSetSet.union !r !s); done ; false with ExitOK -> true (* Forward search based on OLf *) (* maps FormSet {a1, ..., an} to {(x, a1), ..., (x, an)} *) let formset_prod_l x s = FormSet.fold (fun y -> BiFormSet.add (x, y)) s BiFormSet.empty (* maps FormSet {a1, ..., an} to {(a1, x), ..., (an, x)} *) let formset_prod_r x s = FormSet.fold (fun y -> BiFormSet.add (y,x)) s BiFormSet.empty (* cartesian product of FormSet s1 and s2 *) let bisetset_prod s1 s2 = let biformset_prod_l x s = BiFormSet.fold (fun y -> BiBiFormSet.add (x,y)) s BiBiFormSet.empty in BiFormSet.fold (fun x -> BiBiFormSet.union (biformset_prod_l x s2)) s1 BiBiFormSet.empty let rec is_vee = function | V _ -> true | _ -> false let listbiset_union l = fold_right BiFormSet.union l BiFormSet.empty (* Diagonal Pre-Cooking *) let rec diag = function | A _ | C _ | B -> None | T -> Some [] | V (a,b) -> Some [V (a,b)] | W (a,b) -> match (diag a,diag b) with | Some l1, Some l2 -> Some (l1@l2) | _ -> None let diag_olf f = match diag f with | None -> false | Some l -> for_all (fun x -> molf x x) l let fprove_olf f = let sf = subform f in let svsf = svsubform f in let swsf = swsubform f in let swwsf = swwsubform f in let sns = snsubform f in let llsf = FormSet.filter (fun x -> async x || x = f || FormSet.mem x swsf) sns in let init_fc = (* ax_v rule *) FormSet.fold (fun a -> tick (); BiFormSet.add (neg a, a)) (atbisubform f) BiFormSet.empty in let init_rv = (* top_up rule *) if FormSet.mem T sf then (repeat_tick (FormSet.cardinal llsf); formset_prod_r T llsf) else BiFormSet.empty in let step_fc2rv_1 (c, a) = listbiset_union [ (* D_2 rule *) if sync a && ((a = f && FormSet.mem c swwsf) || FormSet.mem a swsf) then (tick (); BiFormSet.singleton (c, a)) else BiFormSet.empty ; (* D_1 rule *) if sync a && (a = f || FormSet.mem a swsf) && (async c || (c = f && FormSet.mem a swwsf) || FormSet.mem c swsf) then (tick (); BiFormSet.singleton (a, c)) else BiFormSet.empty ; (* cw_up rule *) if a = c && is_vee a then (if a = f then (let intersf = FormSet.inter swwsf llsf in repeat_tick (FormSet.cardinal intersf); formset_prod_r a intersf) else (repeat_tick (FormSet.cardinal llsf); formset_prod_r a llsf)) else BiFormSet.empty ] in let step_rv2rv_2 (c1, a) (c2, b) = (* wedge_up rule *) if c1 = c2 && (W (a, b) <> f || FormSet.mem c1 swwsf) && FormSet.mem (W (a, b)) sf then BiFormSet.singleton (c1, W (a, b)) else BiFormSet.empty in let step_rv2fc_1 (c, a) = (* R_dn rule *) if async a && FormSet.mem a svsf then (tick (); BiFormSet.singleton (c, a)) else BiFormSet.empty in let step_fc2fc_1 (c, a) = (* vee_i rules *) let veesf = FormSet.filter (is_vee_of a) sf in repeat_tick (FormSet.cardinal veesf); formset_prod_l c veesf in (* b_xx : pairs of sequents to be treated m_xx : singletons of sequents to be treated r_xx : reached sequents *) let b_rv = ref (bisetset_prod init_rv init_rv) in let m_fc = ref init_fc in let m_rv = ref init_rv in let r_fc = ref init_fc in let r_rv = ref init_rv in try while not (BiBiFormSet.is_empty !b_rv && BiFormSet.is_empty !m_fc && BiFormSet.is_empty !m_rv) do let s_rv = ref BiFormSet.empty in let s_fc = ref BiFormSet.empty in while BiFormSet.is_empty !s_rv && not (BiBiFormSet.is_empty !b_rv) do let (p, q) = BiBiFormSet.choose !b_rv in b_rv := BiBiFormSet.remove (p, q) !b_rv; s_rv := BiFormSet.diff (step_rv2rv_2 p q) !r_rv done; (if not (BiFormSet.is_empty !s_rv) then b_rv := listbibiformset_union [!b_rv; bisetset_prod !s_rv !r_rv; bisetset_prod !r_rv !s_rv; bisetset_prod !s_rv !s_rv]; m_rv := BiFormSet.union !m_rv !s_rv; r_rv := BiFormSet.union !r_rv !s_rv; s_rv := BiFormSet.empty); while BiFormSet.is_empty !s_rv && BiFormSet.is_empty !s_fc && not (BiFormSet.is_empty !m_fc) do let p = BiFormSet.choose !m_fc in m_fc := BiFormSet.remove p !m_fc; s_rv := BiFormSet.diff (step_fc2rv_1 p) !r_rv; s_fc := BiFormSet.diff (step_fc2fc_1 p) !r_fc; (if BiFormSet.mem (f, f) !s_fc then raise ExitOK) done; (if not (BiFormSet.is_empty !s_rv) then b_rv := listbibiformset_union [!b_rv; bisetset_prod !s_rv !r_rv; bisetset_prod !r_rv !s_rv; bisetset_prod !s_rv !s_rv]; m_rv := BiFormSet.union !m_rv !s_rv; r_rv := BiFormSet.union !r_rv !s_rv; s_rv := BiFormSet.empty); (if not (BiFormSet.is_empty !s_fc) then m_fc := BiFormSet.union !m_fc !s_fc; r_fc := BiFormSet.union !r_fc !s_fc; s_fc := BiFormSet.empty); while BiFormSet.is_empty !s_fc && not (BiFormSet.is_empty !m_rv) do let p = BiFormSet.choose !m_rv in m_rv := BiFormSet.remove p !m_rv; s_fc := BiFormSet.diff (step_rv2fc_1 p) !r_fc; (if BiFormSet.mem (f, f) !s_fc then raise ExitOK) done; (if not (BiFormSet.is_empty !s_fc) then m_fc := BiFormSet.union !m_fc !s_fc; r_fc := BiFormSet.union !r_fc !s_fc) done ; false with ExitOK -> true let diag_fprove_olf f = match diag f with | None -> false | Some l -> for_all fprove_olf l (** Examples **) (* Benchmark Definition *) let ex1 = V (A 0, C 0) (* excluded middle *) let ex1b = V (C 0, A 0) (* reversed excluded middle *) let ex2 = W (A 0, C 0) (* not provable *) (* contradiction principle *) let ex3 = V (W (A 0, A 1), C 0) let ex4 = V (ex3, C 1) let ex5 = V ((W (V (A 1, C 1), A 0)), C 0) let exe1 = (* not provable *) (* E1 in McCune *) V (neg (V (W (A 0, C 1), C 0)), V (W (A 0, C 1), V ( W (C 0, W (V (A 0, C 1), V (A 0, A 1))), W (C 0, neg (W (V (A 0, C 1), V (A 0, A 1)))) ))) let exe2 = (* E2 in McCune *) V (A 0, V ( W (C 0, W (V (A 0, C 1),V (A 0, A 1))), W (C 0, V (W (C 0, A 1),W (C 0, C 1))) )) let exe3 = (* E3 in McCune *) V (neg (V (V (W (C 0, A 1), W (C 0, C 1)), W (A 0, V (C 0, A 1)))), V (C 0,A 1)) let rec ex6 = (* example f_n in Section 4.1 of Egly-Tompits *) function | 0 -> V (A 0, C 0) | n -> V (W (W (A (3*n), A (3*n-1)), W (A (3*n), A (3*n-2))), V (V (W (C (3*n), ex6 (n-1)), C (3*n-1)), C (3*n-2))) let rec ex7_1 = (* example A_n in Section 4.2 of Egly-Tompits *) function | 0 -> T | n -> W (ex7_1 (n-1), A (2*n)) let rec ex7_2 = (* example B_n in Section 4.2 of Egly-Tompits *) function | 0 -> B | n -> V (ex7_2 (n-1), A (2*n+1)) let ex7_3 n = (* example L_n in Section 4.2 of Egly-Tompits *) W (V (A 0, W (A 1, ex7_2 n)), ex7_1 n) let ex7_4 n = (* example R_n in Section 4.2 of Egly-Tompits *) V (W (A 1, V (A 0, ex7_1 n)), ex7_2 n) let ex7_5 n = V (neg (ex7_3 n), ex7_4 n) (* coming from example L_n |- R_n in Section 4.2 of Egly-Tompits *) let _ = size_form ex1 let _ = size_form ex1b let _ = size_form ex2 let _ = size_form ex3 let _ = size_form ex4 let _ = size_form ex5 let _ = size_form exe1 let _ = size_form exe2 let _ = size_form exe3 let _ = size_form (ex6 5) let _ = size_form (ex6 10) let _ = size_form (ex6 20) let _ = size_form (ex7_5 5) let _ = size_form (ex7_5 10) let _ = size_form (ex7_5 20) let _ = size_form (ex7_5 100) let _ = size_form (ex7_5 1000) (* Tests *) let test_prove f a = init_tick () ; let result = print_time f a in print_string " / Ticks: "; print_tick () ; print_newline (); result let all_test_prove a = let show_result s f = (print_string s; print_string " = " ; init_tick () ; let _ = print_time f a in print_string " / Ticks: "; print_tick (); print_newline ()) in show_result "F: fprove olf" diag_fprove_olf; show_result "F: fprove " fprove; show_result "B: memo olf " diag_olf; show_result "B: cf " prove_cf let test_fun = diag_olf (* diag_olf *) (* prove_cf *) (* fprove *) (* diag_fprove_olf *) let _ = test_prove test_fun ex1 = true let _ = test_prove test_fun ex1b = true let _ = test_prove test_fun ex2 = false let _ = test_prove test_fun ex3 = false let _ = test_prove test_fun ex4 = true let _ = test_prove test_fun ex5 = true let _ = test_prove test_fun exe1 = false let _ = test_prove test_fun exe2 = true let _ = test_prove test_fun exe3 = true let _ = test_prove test_fun (ex6 5) = true let _ = test_prove test_fun (ex7_5 5) = false (* let _ = test_prove test_fun (ex6 10) = true let _ = test_prove test_fun (ex7_5 10) = false let _ = test_prove test_fun (ex6 20) = true let _ = test_prove test_fun (ex7_5 20) = false let _ = test_prove test_fun (ex7_5 100) = false let _ = test_prove test_fun (ex7_5 1000) = false *) (* let _ = all_test_prove ex1 let _ = all_test_prove ex1b let _ = all_test_prove ex2 let _ = all_test_prove ex3 let _ = all_test_prove ex4 let _ = all_test_prove ex5 let _ = all_test_prove exe1 let _ = all_test_prove exe2 let _ = all_test_prove exe3 let _ = all_test_prove (ex6 5) let _ = all_test_prove (ex6 10) let _ = all_test_prove (ex6 20) let _ = all_test_prove (ex7_5 5) let _ = all_test_prove (ex7_5 10) let _ = all_test_prove (ex7_5 20) let _ = all_test_prove (ex7_5 100) *) (* Random Benchmark *) let average l = let len = length l in (fold_right (fun x s -> x + s) l 0) / len let fl_average l = let len = length l in (fold_right (fun x s -> x +. s) l 0.) /. (float_of_int len) (* list of n random formulas, v variables and size 2s *) let rec nfrandom v s = function | 0 -> [] | n -> (frandom v s)::(nfrandom v s (n-1)) let testforms_time t ff = let test p f = let result = init_tick () ; time p f in print_bool (fst result) ; print_newline (); (snd result, val_tick ()) in map (fun f -> test t f) ff let testforms t ff = let test p f = let result = init_tick () ; p f in (result, val_tick ()) in map (fun f -> test t f) ff let forms = nfrandom 10 50 10 let _ = let r0 = testforms prove_cf forms in let r1 = testforms diag_olf forms in let r2 = testforms fprove forms in let r3 = testforms diag_fprove_olf forms in [average (map snd r0); average (map snd r1); average (map snd r2); average (map snd r3)] (* Measures *) (* ex1 F: fprove olf = Time: 0. s / Ticks: 5 F: fprove = Time: 0. s / Ticks: 4 B: memo olf = Time: 0. s / Ticks: 8 B: cf = Time: 0. s / Ticks: 4 ex1b F: fprove olf = Time: 0. s / Ticks: 5 F: fprove = Time: 0. s / Ticks: 4 B: memo olf = Time: 0. s / Ticks: 9 B: cf = Time: 0. s / Ticks: 4 ex2 F: fprove olf = Time: 0. s / Ticks: 0 F: fprove = Time: 0. s / Ticks: 1 B: memo olf = Time: 0. s / Ticks: 0 B: cf = Time: 0. s / Ticks: 3 ex3 F: fprove olf = Time: 0. s / Ticks: 6 F: fprove = Time: 0. s / Ticks: 2 B: memo olf = Time: 0. s / Ticks: 40 B: cf = Time: 0. s / Ticks: 41 ex4 F: fprove olf = Time: 0. s / Ticks: 16 F: fprove = Time: 0. s / Ticks: 8 B: memo olf = Time: 0. s / Ticks: 31 B: cf = Time: 0. s / Ticks: 76 ex5 F: fprove olf = Time: 0. s / Ticks: 25 F: fprove = Time: 0. s / Ticks: 11 B: memo olf = Time: 0. s / Ticks: 57 B: cf = Time: 0. s / Ticks: 105 exe1 F: fprove olf = Time: 0.028002 s / Ticks: 64 F: fprove = Time: 0.036002 s / Ticks: 47 B: memo olf = Time: 0. s / Ticks: 132 B: cf = Time: 0.004 s / Ticks: 2305 exe2 F: fprove olf = Time: 0.012001 s / Ticks: 49 F: fprove = Time: 0.020001 s / Ticks: 33 B: memo olf = Time: 0. s / Ticks: 104 B: cf = Time: 0. s / Ticks: 210 exe3 F: fprove olf = Time: 0.016001 s / Ticks: 49 F: fprove = Time: 0.024001 s / Ticks: 47 B: memo olf = Time: 0. s / Ticks: 144 B: cf = Time: 0. s / Ticks: 42 ex6 5 F: fprove olf = Time: 3.560223 s / Ticks: 338 F: fprove = Time: 14.996937 s / Ticks: 724 B: memo olf = Time: 0. s / Ticks: 384 B: cf = Time: 0.072004 s / Ticks: 6094 ex6 10 F: fprove olf = Time: 88.597537 s / Ticks: 1023 F: fprove = Time: 368.855052 s / Ticks: 2639 B: memo olf = Time: 0. s / Ticks: 774 B: cf = Time: 0.344022 s / Ticks: 12 344 ex7_5 5 F: fprove olf = Time: 0.132008 s / Ticks: 123 F: fprove = Time: 1.43209 s / Ticks: 343 B: memo olf = Time: 0. s / Ticks: 308 B: cf = Time: 0.224014 s / Ticks: 244 055 ex7_5 10 F: fprove olf = Time: 0.736046 s / Ticks: 273 F: fprove = Time: 11.99675 s / Ticks: 773 B: memo olf = Time: 0. s / Ticks: 823 B: cf = Time: 171.634726 s / Ticks: 195 694 997 ex7_5 20 F: fprove olf = Time: 4.924308 s / Ticks: 723 F: fprove = Time: 161.842114 s / Ticks: 2083 B: memo olf = Time: 0.00400099999979 s / Ticks: 2603 B: cf = OUT ex7_5 100 F: fprove olf = Time: 634.823674 s / Ticks: 11523 F: fprove = OUT B: memo olf = Time: 0.144009 s / Ticks: 52843 B: cf = OUT ex7_5 1000 F: fprove olf = OUT F: fprove = OUT B: memo olf = Time: 110.950934 s / Ticks: 5 028 043 B: cf = OUT *) (* Random packs let forms = nfrandom 10 10 100 - : (float * int) list = [(0.00260016000000177876, 971); (4.00000000081490701e-05, 28); (0.110806929999998832, 163); (0.00764048000000912, 29)] let forms = nfrandom 10 50 10 Pack 1 - : (float * int) list = [(1.67850490000000718, 253273); (0.000400100000115344279, 259); (55.4174633999999, 2835); (4.2718668999999867, 714)] - : int list = [253273; 259; 2835; 714] Pack 2 - : int list = [106350; 247; 3059; 527] Pack 3 - : int list = [42998; 161; 2426; 694] Pack 4 - : int list = [115648; 252; 2668; 953] Pack 5 - : int list = [128870; 401; 2779; 783] *)