src/HOL/Matrix/CplexMatrixConverter.ML
author webertj
Thu, 28 Oct 2004 19:40:22 +0200
changeset 15269 f856f4f3258f
parent 15178 5f621aa35c25
child 15531 08c8dad8e399
permissions -rw-r--r--
isatool usedir: ML root file can now be specified (previously hard-coded as ROOT.ML)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     1
signature MATRIX_BUILDER =
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     2
sig
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     3
    type vector
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     4
    type matrix
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     5
    
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     6
    val empty_vector : vector
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     7
    val empty_matrix : matrix
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     8
		       
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
     9
    exception Nat_expected of int
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    10
    val set_elem : vector -> int -> string -> vector			
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    11
    val set_vector : matrix -> int -> vector -> matrix
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    12
end;
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    13
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    14
signature CPLEX_MATRIX_CONVERTER = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    15
sig
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    16
    structure cplex : CPLEX
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    17
    structure matrix_builder : MATRIX_BUILDER 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    18
    type vector = matrix_builder.vector
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    19
    type matrix = matrix_builder.matrix
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    20
    type naming = int * (int -> string) * (string -> int)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    21
    
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    22
    exception Converter of string
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    23
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    24
    (* program must fulfill is_normed_cplexProg and must be an element of the image of elim_nonfree_bounds *)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    25
    (* convert_prog maximize c A b naming *)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    26
    val convert_prog : cplex.cplexProg -> bool * vector * matrix * vector * naming
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    27
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    28
    (* results must be optimal, converts_results returns the optimal value as string and the solution as vector *)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    29
    (* convert_results results name2index *)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    30
    val convert_results : cplex.cplexResult -> (string -> int) -> string * vector
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    31
end;
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    32
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    33
functor MAKE_CPLEX_MATRIX_CONVERTER (structure cplex: CPLEX and matrix_builder: MATRIX_BUILDER) : CPLEX_MATRIX_CONVERTER =
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    34
struct
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    35
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    36
structure cplex = cplex
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    37
structure matrix_builder = matrix_builder
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    38
type matrix = matrix_builder.matrix
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    39
type vector = matrix_builder.vector		
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    40
type naming = int * (int -> string) * (string -> int)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    41
		     
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    42
open matrix_builder 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    43
open cplex
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    44
     
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    45
exception Converter of string;
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    46
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    47
structure Inttab = TableFun(type key = int val ord = int_ord);
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    48
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    49
fun neg_term (cplexNeg t) = t
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    50
  | neg_term (cplexSum ts) = cplexSum (map neg_term ts)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    51
  | neg_term t = cplexNeg t 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    52
	      
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    53
fun convert_prog (cplexProg (s, goal, constrs, bounds)) = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    54
    let	
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    55
	fun build_naming index i2s s2i [] = (index, i2s, s2i)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    56
	  | build_naming index i2s s2i (cplexBounds (cplexNeg cplexInf, cplexLeq, cplexVar v, cplexLeq, cplexInf)::bounds)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    57
	    = build_naming (index+1) (Inttab.update ((index, v), i2s)) (Symtab.update_new ((v, index), s2i)) bounds
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    58
	  | build_naming _ _ _ _ = raise (Converter "nonfree bound")
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    59
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    60
	val (varcount, i2s_tab, s2i_tab) = build_naming 0 Inttab.empty Symtab.empty bounds
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    61
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    62
	fun i2s i = case Inttab.lookup (i2s_tab, i) of None => raise (Converter "index not found")
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    63
						     | Some n => n
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    64
	fun s2i s = case Symtab.lookup (s2i_tab, s) of None => raise (Converter ("name not found: "^s))
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    65
						     | Some i => i
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    66
	fun num2str positive (cplexNeg t) = num2str (not positive) t
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    67
	  | num2str positive (cplexNum num) = if positive then num else "-"^num			
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    68
	  | num2str _ _ = raise (Converter "term is not a (possibly signed) number")
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    69
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    70
	fun setprod vec positive (cplexNeg t) = setprod vec (not positive) t  
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    71
	  | setprod vec positive (cplexVar v) = set_elem vec (s2i v) (if positive then "1" else "-1")
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    72
	  | setprod vec positive (cplexProd (cplexNum num, cplexVar v)) = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    73
	    set_elem vec (s2i v) (if positive then num else "-"^num)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    74
	  | setprod _ _ _ = raise (Converter "term is not a normed product")	
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    75
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    76
	fun sum2vec (cplexSum ts) = foldl (fn (vec, t) => setprod vec true t) (empty_vector, ts)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    77
	  | sum2vec t = setprod empty_vector true t						
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    78
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    79
	fun constrs2Ab j A b [] = (A, b)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    80
	  | constrs2Ab j A b ((_, cplexConstr (cplexLeq, (t1,t2)))::cs) = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    81
	    constrs2Ab (j+1) (set_vector A j (sum2vec t1)) (set_elem b j (num2str true t2)) cs
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    82
	  | constrs2Ab j A b ((_, cplexConstr (cplexGeq, (t1,t2)))::cs) = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    83
	    constrs2Ab (j+1) (set_vector A j (sum2vec (neg_term t1))) (set_elem b j (num2str true (neg_term t2))) cs
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    84
	  | constrs2Ab j A b ((_, cplexConstr (cplexEq, (t1,t2)))::cs) =
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    85
	    constrs2Ab j A b ((None, cplexConstr (cplexLeq, (t1,t2)))::
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    86
			      (None, cplexConstr (cplexGeq, (t1, t2)))::cs)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    87
	  | constrs2Ab _ _ _ _ = raise (Converter "no strict constraints allowed")
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    88
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    89
	val (A, b) = constrs2Ab 0 empty_matrix empty_vector constrs
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    90
								 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    91
	val (goal_maximize, goal_term) = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    92
	    case goal of
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    93
		(cplexMaximize t) => (true, t)
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    94
	      | (cplexMinimize t) => (false, t)				     
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    95
    in	  
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    96
	(goal_maximize, sum2vec goal_term, A, b, (varcount, i2s, s2i))
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    97
    end
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    98
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
    99
fun convert_results (cplex.Optimal (opt, entries)) name2index =
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   100
    let
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   101
	fun setv (v, (name, value)) = (matrix_builder.set_elem v (name2index name) value) 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   102
    in
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   103
	(opt, foldl setv (matrix_builder.empty_vector, entries))
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   104
    end
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   105
  | convert_results _ _ = raise (Converter "No optimal result")
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   106
    
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   107
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   108
end;
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   109
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   110
structure SimpleMatrixBuilder : MATRIX_BUILDER = 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   111
struct
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   112
type vector = (int * string) list
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   113
type matrix = (int * vector) list
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   114
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   115
val empty_matrix = []
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   116
val empty_vector = []
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   117
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   118
exception Nat_expected of int;
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   119
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   120
fun set_elem v i s = v @ [(i, s)] 
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   121
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   122
fun set_vector m i v = m @ [(i, v)]
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   123
    
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   124
end;	      
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   125
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   126
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   127
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   128
structure SimpleCplexMatrixConverter = MAKE_CPLEX_MATRIX_CONVERTER(structure cplex = Cplex and matrix_builder = SimpleMatrixBuilder);
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   129
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   130
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   131
5f621aa35c25 Matrix theory, linear programming
obua
parents:
diff changeset
   132