module Lp_certificate = struct (* inequality id, indices of inequalities, coefficients *) type constraint_type = string * int list * int64 list;; type terminal_case = { precision : int; infeasible: bool; constraints : constraint_type list; target_variables : constraint_type list; variable_bounds : constraint_type list; };; (* For testing *) let empty_terminal = { precision = 0; infeasible = false; constraints = []; target_variables = []; variable_bounds = []; };; type split_case = { split_type : string; split_face : int list; };; type lp_certificate_case = Lp_terminal of terminal_case | Lp_split of split_case * lp_certificate_case list;; type lp_certificate = { hypermap_string : string; root_case : lp_certificate_case; };; type lp_certificate_info = { terminals : int; infeasibles: int; precision_table: (int * int)list; split_table: (string * int)list; };; (* Counts the number of terminal cases *) let rec count_terminals lp_case = match lp_case with | Lp_terminal _ -> 1 | Lp_split (_, cs) -> itlist (+) (map count_terminals cs) 0;; let case_info lp_case = let terminals = ref 0 and infs = ref 0 and precision = Hashtbl.create 5 and split = Hashtbl.create 10 in let add_precision p = try let n = Hashtbl.find precision p in Hashtbl.replace precision p (n + 1) with Not_found -> Hashtbl.add precision p 1 in let add_split name = try let n = Hashtbl.find split name in Hashtbl.replace split name (n + 1) with Not_found -> Hashtbl.add split name 1 in let rec count case = match case with | Lp_terminal t -> let _ = terminals := !terminals + 1 in let _ = infs := !infs + if t.infeasible then 1 else 0 in add_precision t.precision | Lp_split (info, cs) -> let _ = add_split info.split_type in let _ = map count cs in () in let _ = count lp_case in { terminals = !terminals; infeasibles = !infs; precision_table = Hashtbl.fold (fun key v list -> (key,v) :: list) precision []; split_table = Hashtbl.fold (fun key v list -> (key,v) :: list) split []; };; let certificate_info cert = case_info cert.root_case;; (* Writes a certificate into a binary file *) let write_lp_certificates fname (certificates : lp_certificate list) = let out = open_out_bin fname in let _ = Marshal.to_channel out certificates [] in close_out out;; (* Reads a certificate from a binary file *) let read_lp_certificates fname = let input = open_in_bin fname in let certificates = (Marshal.from_channel input : lp_certificate list) in let _ = close_in input in certificates;; (******************) (* Test functions *) (******************) type test_split = Dummy | Info of string * int list * (test_split list);; let rec build_test_split case = match case with | Lp_terminal _ -> Dummy | Lp_split (info, cs) -> Info (info.split_type, info.split_face, map build_test_split cs);; end;;