1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
{-# LANGUAGE ForeignFunctionInterface #-}
{- |
Module : Numeric.LinearProgramming
Copyright : (c) Alberto Ruiz 2010
License : GPL
Maintainer : Alberto Ruiz (aruiz at um dot es)
Stability : provisional
This module provides an interface to the standard simplex algorithm.
For example, the following LP problem
@maximize 4 x_1 - 3 x_2 + 2 x_3
subject to
2 x_1 + x_2 <= 10
x_3 + 5 x_4 <= 20
and
x_i >= 0@
can be solved as follows:
@import Numeric.LinearProgramming
prob = Maximize [4, -3, 2]
constr1 = Sparse [ [2#1, 1#2] :<: 10
, [1#2, 5#3] :<: 20
]
\> simplex prob constr1 []
Optimal (28.0,[5.0,0.0,4.0])@
The coefficients of the constraint matrix can also be given in dense format:
@constr2 = Dense [ [2,1,0] :<: 10
, [0,1,5] :<: 20
]@
By default all variables are bounded as @x_i >= 0@, but this can be
changed:
@\> simplex prob constr2 [ 2 :>: 1, 3 :&: (2,7)]
Optimal (22.6,[4.5,1.0,3.8])
\> simplex prob constr2 [Free 2]
Unbounded@
The given bound for a variable completely replaces the default,
so @0 <= x_i <= b@ must be explicitly given as @i :&: (0,b)@.
-}
module Numeric.LinearProgramming(
simplex,
Optimization(..),
Constraints(..),
Bounds,
Bound(..),
(#),
Solution(..)
) where
import Numeric.LinearAlgebra
import Data.Packed.Development
import Foreign(Ptr,unsafePerformIO)
import Foreign.C.Types(CInt)
import Data.List((\\),sortBy)
import Data.Function(on)
--import Debug.Trace
--debug x = trace (show x) x
-----------------------------------------------------
-- | Coefficient of a variable for a sparse representation of constraints.
(#) :: Double -> Int -> (Double,Int)
infixl 5 #
(#) = (,)
data Bound x = x :<: Double
| x :>: Double
| x :&: (Double,Double)
| x :==: Double
| Free x
deriving Show
data Solution = Undefined
| Feasible (Double, [Double])
| Infeasible (Double, [Double])
| NoFeasible
| Optimal (Double, [Double])
| Unbounded
deriving Show
data Constraints = Dense [ Bound [Double] ]
| Sparse [ Bound [(Double,Int)] ]
data Optimization = Maximize [Double]
| Minimize [Double]
type Bounds = [Bound Int]
simplex :: Optimization -> Constraints -> Bounds -> Solution
simplex opt (Dense []) bnds = simplex opt (Sparse [Free [0#1]]) bnds
simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds
simplex opt (Dense constr) bnds = extract sg sol where
sol = simplexDense (mkConstrD sz objfun constr) (mkBounds sz constr bnds)
(sz, sg, objfun) = adapt opt
simplex opt (Sparse constr) bnds = extract sg sol where
sol = simplexSparse m n (mkConstrS sz objfun constr) (mkBounds sz constr bnds)
n = length objfun
m = length constr
(sz, sg, objfun) = adapt opt
adapt :: Optimization -> (Int, Double, [Double])
adapt opt = case opt of
Maximize x -> (size x, 1 ,x)
Minimize x -> (size x, -1, (map negate x))
where size x | null x = error "simplex: objective function with zero variables"
| otherwise = length x
extract :: Double -> Vector Double -> Solution
extract sg sol = r where
z = sg * (sol@>1)
v = toList $ subVector 2 (dim sol -2) sol
r = case round(sol@>0)::Int of
1 -> Undefined
2 -> Feasible (z,v)
3 -> Infeasible (z,v)
4 -> NoFeasible
5 -> Optimal (z,v)
6 -> Unbounded
_ -> error "simplex: solution type unknown"
-----------------------------------------------------
obj :: Bound t -> t
obj (x :<: _) = x
obj (x :>: _) = x
obj (x :&: _) = x
obj (x :==: _) = x
obj (Free x) = x
tb :: Bound t -> Double
tb (_ :<: _) = glpUP
tb (_ :>: _) = glpLO
tb (_ :&: _) = glpDB
tb (_ :==: _) = glpFX
tb (Free _) = glpFR
lb :: Bound t -> Double
lb (_ :<: _) = 0
lb (_ :>: a) = a
lb (_ :&: (a,_)) = a
lb (_ :==: a) = a
lb (Free _) = 0
ub :: Bound t -> Double
ub (_ :<: a) = a
ub (_ :>: _) = 0
ub (_ :&: (_,a)) = a
ub (_ :==: a) = a
ub (Free _) = 0
mkBound1 :: Bound t -> [Double]
mkBound1 b = [tb b, lb b, ub b]
mkBound2 :: Bound t -> (t, [Double])
mkBound2 b = (obj b, mkBound1 b)
mkBounds :: Int -> [Bound [a]] -> [Bound Int] -> Matrix Double
mkBounds n b1 b2 = fromLists (cb++vb) where
gv = map obj b2
rv | null gv || minimum gv >= 0 && maximum gv <= n = [1..n] \\ gv
| otherwise = error $ "simplex: bounds: variables "++show gv++" not in 1.."++show n
vb = map snd $ sortBy (compare `on` fst) $ map (mkBound2 . (:>: 0)) rv ++ map mkBound2 b2
cb = map mkBound1 b1
mkConstrD :: Int -> [Double] -> [Bound [Double]] -> Matrix Double
mkConstrD n f b1 | ok = fromLists (f : cs)
| otherwise = error $ "simplex: dense constraints require "++show n
++" variables, given " ++ show ls
where
cs | null b1 = error $ "simplex: dense: empty constraints"
| otherwise = map obj b1
ls = map length cs
ok = all (==n) ls
mkConstrS :: Int -> [Double] -> [Bound [(Double, Int)]] -> Matrix Double
mkConstrS n objfun b1 = fromLists (ob ++ co) where
ob = map (([0,0]++).return) objfun
co = concat $ zipWith f [1::Int ..] cs
cs | null b1 = error $ "simplex: sparse: empty constraints"
| otherwise = map obj b1
f k = map (g k)
g k (c,v) | v >=1 && v<= n = [fromIntegral k, fromIntegral v,c]
| otherwise = error $ "simplex: sparse constraints: variable "++show v++" not in 1.."++show n
-----------------------------------------------------
foreign import ccall "c_simplex_dense" c_simplex_dense
:: CInt -> CInt -> Ptr Double -- coeffs
-> CInt -> CInt -> Ptr Double -- bounds
-> CInt -> Ptr Double -- result
-> IO CInt -- exit code
simplexDense :: Matrix Double -> Matrix Double -> Vector Double
simplexDense c b = unsafePerformIO $ do
s <- createVector (2+cols c)
app3 c_simplex_dense mat (cmat c) mat (cmat b) vec s "c_simplex_dense"
return s
foreign import ccall "c_simplex_sparse" c_simplex_sparse
:: CInt -> CInt -- rows and cols
-> CInt -> CInt -> Ptr Double -- coeffs
-> CInt -> CInt -> Ptr Double -- bounds
-> CInt -> Ptr Double -- result
-> IO CInt -- exit code
simplexSparse :: Int -> Int -> Matrix Double -> Matrix Double -> Vector Double
simplexSparse m n c b = unsafePerformIO $ do
s <- createVector (2+n)
let fi = fromIntegral
app3 (c_simplex_sparse (fi m) (fi n)) mat (cmat c) mat (cmat b) vec s "c_simplex_sparse"
return s
glpFR, glpLO, glpUP, glpDB, glpFX :: Double
glpFR = 0
glpLO = 1
glpUP = 2
glpDB = 3
glpFX = 4
{- Raw format of coeffs
simplexDense
((3+1) >< 3)
[ 10, 6, 4
, 1, 1, 1
, 10, 4, 5
, 2, 2, 6 :: Double]
simplexSparse
(12><3)
[ 0.0, 0.0, 10.0
, 0.0, 0.0, 6.0
, 0.0, 0.0, 4.0
, 1.0, 1.0, 1.0
, 1.0, 2.0, 1.0
, 1.0, 3.0, 1.0
, 2.0, 1.0, 10.0
, 2.0, 2.0, 4.0
, 2.0, 3.0, 5.0
, 3.0, 1.0, 2.0
, 3.0, 2.0, 2.0
, 3.0, 3.0, 6.0 ]
bounds = (6><3)
[ glpUP,0,100
, glpUP,0,600
, glpUP,0,300
, glpLO,0,0
, glpLO,0,0
, glpLO,0,0 ]
-}
|