formal_lp/glpk/lp_binary_certificate.hl

   1 needs "../formal_lp/hypermap/main/lp_certificate.hl";;
   2
   3 module Lp_binary_certificate = struct
   4
   5 open Lp_certificate;;
   6
   7 let read_string in_channel =
   8   let n = input_byte in_channel in
   9   let str = String.create n in
  10   let _ = really_input in_channel str 0 n in
  11     str;;
  12
  13 let read_int16 in_channel =
  14   let b1 = input_byte in_channel in
  15   let b2 = input_byte in_channel in
  16     (b2 lsl 8) lor b1;;
  17
  18 let read_int32 in_channel =
  19   let w1 = read_int16 in_channel in
  20   let w2 = read_int16 in_channel in
  21     (w2 lsl 16) lor w1;;
  22
  23
  24 let read_int64 in_channel =
  25   let w1 = Int64.of_int (read_int16 in_channel) in
  26   let w2 = Int64.shift_left (Int64.of_int (read_int16 in_channel)) 16 in
  27   let w3 = Int64.shift_left (Int64.of_int (read_int16 in_channel)) 32 in
  28   let w4 = Int64.shift_left (Int64.of_int (read_int16 in_channel)) 48 in
  29     Int64.logor w1 (Int64.logor w2 (Int64.logor w3 w4));;
  30
  31
  32 let read_constraint in_channel =
  33   let name = read_string in_channel in
  34   let n_els = read_int32 in_channel in
  35   let indices = map (fun _ -> read_int16 in_channel) (1--n_els) in
  36   let coefficients = map (fun _ -> read_int64 in_channel) (1--n_els) in
  37     name, indices, coefficients;;
  38
  39
  40 let read_constraint_list in_channel =
  41   let count = read_int32 in_channel in
  42     map (fun _ -> read_constraint in_channel) (1--count);;
  43
  44
  45 let read_binary_terminal fname =
  46   let in_channel = open_in_bin fname in
  47     try
  48       let precision = input_byte in_channel in
  49       let infeasible = if (input_byte in_channel <> 0) then true else false in
  50       let constraints = read_constraint_list in_channel in
  51       let target_vars = read_constraint_list in_channel in
  52       let vars = read_constraint_list in_channel in
  53       let _ = close_in in_channel in
  54         {
  55           precision = precision;
  56           infeasible = infeasible;
  57           constraints = constraints;
  58           target_variables = target_vars;
  59           variable_bounds = vars;
  60         }
  61     with _ ->
  62       let _ = close_in in_channel in
  63         failwith "read_binary_terminal: failed";;
  64
  65 end;;