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;;