-let infer env sign current active =
- let rec infer_negative current = function
- | [] -> [], []
- | (Negative, _)::tl -> infer_negative current tl
- | (Positive, equality)::tl ->
- let res = superposition_left env current equality in
- let neg, pos = infer_negative current tl in
- res @ neg, pos
-
- and infer_positive current = function
- | [] -> [], []
- | (Negative, equality)::tl ->
- let res = superposition_left env equality current in
- let neg, pos = infer_positive current tl in
- res @ neg, pos
- | (Positive, equality)::tl ->
- let maxm, res = superposition_right !maxmeta env current equality in
- let maxm, res' = superposition_right maxm env equality current in
+
+let size_of_active (active_list, _) =
+ List.length active_list
+;;
+
+
+let prune_passive howmany (active, _) passive =
+ let (nl, ns), (pl, ps), tbl = passive in
+ let howmany = float_of_int howmany
+ and ratio = float_of_int !weight_age_ratio in
+ let in_weight = int_of_float (howmany *. ratio /. (ratio +. 1.))
+ and in_age = int_of_float (howmany /. (ratio +. 1.)) in
+ Printf.printf "in_weight: %d, in_age: %d\n" in_weight in_age;
+ let symbols, card =
+ match active with
+ | (Negative, e)::_ ->
+ let symbols = symbols_of_equality e in
+ let card = TermMap.fold (fun k v res -> res + v) symbols 0 in
+ Some symbols, card
+ | _ -> None, 0
+ in
+ let counter = ref !symbols_ratio in
+ let rec pickw w ns ps =
+ if w > 0 then
+ if not (EqualitySet.is_empty ns) then
+ let e = EqualitySet.min_elt ns in
+ let ns', ps = pickw (w-1) (EqualitySet.remove e ns) ps in
+ EqualitySet.add e ns', ps
+ else if !counter > 0 then
+ let _ =
+ counter := !counter - 1;
+ if !counter = 0 then counter := !symbols_ratio
+ in
+ match symbols with
+ | None ->
+ let e = EqualitySet.min_elt ps in
+ let ns, ps' = pickw (w-1) ns (EqualitySet.remove e ps) in
+ ns, EqualitySet.add e ps'
+ | Some symbols ->
+ let foldfun k v (r1, r2) =
+ if TermMap.mem k symbols then
+ let c = TermMap.find k symbols in
+ let c1 = abs (c - v) in
+ let c2 = v - c1 in
+ r1 + c2, r2 + c1
+ else
+ r1, r2 + v
+ in
+ let f equality (i, e) =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality equality) (0, 0)
+ in
+ let c = others + (abs (common - card)) in
+ if c < i then (c, equality)
+ else (i, e)
+ in
+ let e1 = EqualitySet.min_elt ps in
+ let initial =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality e1) (0, 0)
+ in
+ (others + (abs (common - card))), e1
+ in
+ let _, e = EqualitySet.fold f ps initial in
+ let ns, ps' = pickw (w-1) ns (EqualitySet.remove e ps) in
+ ns, EqualitySet.add e ps'
+ else
+ let e = EqualitySet.min_elt ps in
+ let ns, ps' = pickw (w-1) ns (EqualitySet.remove e ps) in
+ ns, EqualitySet.add e ps'
+ else
+ EqualitySet.empty, EqualitySet.empty
+ in
+(* let in_weight, ns = pickw in_weight ns in *)
+(* let _, ps = pickw in_weight ps in *)
+ let ns, ps = pickw in_weight ns ps in
+ let rec picka w s l =
+ if w > 0 then
+ match l with
+ | [] -> w, s, []
+ | hd::tl when not (EqualitySet.mem hd s) ->
+ let w, s, l = picka (w-1) s tl in
+ w, EqualitySet.add hd s, hd::l
+ | hd::tl ->
+ let w, s, l = picka w s tl in
+ w, s, hd::l
+ else
+ 0, s, l
+ in
+ let in_age, ns, nl = picka in_age ns nl in
+ let _, ps, pl = picka in_age ps pl in
+ if not (EqualitySet.is_empty ps) then
+(* maximal_weight := Some (weight_of_equality (EqualitySet.max_elt ps)); *)
+ maximal_retained_equality := Some (EqualitySet.max_elt ps);
+ let tbl =
+ EqualitySet.fold
+ (fun e tbl -> Indexing.index tbl e) ps (Indexing.empty_table ())
+(* if !use_fullred then *)
+(* EqualitySet.fold *)
+(* (fun e tbl -> Indexing.index tbl e) ps (Indexing.empty_table ()) *)
+(* else *)
+(* tbl *)
+ in
+ (nl, ns), (pl, ps), tbl
+;;
+
+
+let infer env sign current (active_list, active_table) =
+ let new_neg, new_pos =
+ match sign with
+ | Negative ->
+ Indexing.superposition_left env active_table current, []
+ | Positive ->
+ let maxm, res =
+ Indexing.superposition_right !maxmeta env active_table current in