diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-04-09 12:48:57 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-04-09 12:48:57 +0200 |
commit | c10f27ac40ff74612a6c773baa572573f3186506 (patch) | |
tree | efe9bf1b62e20c1163eed98753c4bef2afca6d06 /packages/glpk/src/Numeric/LinearProgramming.hs | |
parent | 5eba1bc309d7845366e8d00849d85426bf8f666d (diff) | |
parent | 8d7c921bdff0d57a4579d3de71cd5ba3bf5276a1 (diff) |
merge recent changes
Diffstat (limited to 'packages/glpk/src/Numeric/LinearProgramming.hs')
-rw-r--r-- | packages/glpk/src/Numeric/LinearProgramming.hs | 75 |
1 files changed, 70 insertions, 5 deletions
diff --git a/packages/glpk/src/Numeric/LinearProgramming.hs b/packages/glpk/src/Numeric/LinearProgramming.hs index d2e9f3c..7bf4279 100644 --- a/packages/glpk/src/Numeric/LinearProgramming.hs +++ b/packages/glpk/src/Numeric/LinearProgramming.hs | |||
@@ -49,6 +49,14 @@ constr2 = Dense [ [2,1,0] :<=: 10 | |||
49 | ] | 49 | ] |
50 | @ | 50 | @ |
51 | 51 | ||
52 | Note that when using sparse constraints, coefficients cannot appear more than once in each constraint. You can alternatively use General which will automatically sum any duplicate coefficients when necessary. | ||
53 | |||
54 | @ | ||
55 | constr3 = General [ [1\#1, 1\#1, 1\#2] :<=: 10 | ||
56 | , [1\#2, 5\#3] :<=: 20 | ||
57 | ] | ||
58 | @ | ||
59 | |||
52 | By default all variables are bounded as @x_i >= 0@, but this can be | 60 | By default all variables are bounded as @x_i >= 0@, but this can be |
53 | changed: | 61 | changed: |
54 | 62 | ||
@@ -67,6 +75,8 @@ Multiple bounds for a variable are not allowed, instead of | |||
67 | 75 | ||
68 | module Numeric.LinearProgramming( | 76 | module Numeric.LinearProgramming( |
69 | simplex, | 77 | simplex, |
78 | exact, | ||
79 | sparseOfGeneral, | ||
70 | Optimization(..), | 80 | Optimization(..), |
71 | Constraints(..), | 81 | Constraints(..), |
72 | Bounds, | 82 | Bounds, |
@@ -82,13 +92,14 @@ import System.IO.Unsafe(unsafePerformIO) | |||
82 | import Foreign.C.Types | 92 | import Foreign.C.Types |
83 | import Data.List((\\),sortBy,nub) | 93 | import Data.List((\\),sortBy,nub) |
84 | import Data.Function(on) | 94 | import Data.Function(on) |
95 | import qualified Data.Map.Strict as Map | ||
85 | 96 | ||
86 | --import Debug.Trace | 97 | --import Debug.Trace |
87 | --debug x = trace (show x) x | 98 | --debug x = trace (show x) x |
88 | 99 | ||
89 | ----------------------------------------------------- | 100 | ----------------------------------------------------- |
90 | 101 | ||
91 | -- | Coefficient of a variable for a sparse representation of constraints. | 102 | -- | Coefficient of a variable for a sparse and general representations of constraints. |
92 | (#) :: Double -> Int -> (Double,Int) | 103 | (#) :: Double -> Int -> (Double,Int) |
93 | infixl 5 # | 104 | infixl 5 # |
94 | (#) = (,) | 105 | (#) = (,) |
@@ -108,18 +119,29 @@ data Solution = Undefined | |||
108 | | Unbounded | 119 | | Unbounded |
109 | deriving Show | 120 | deriving Show |
110 | 121 | ||
111 | data Constraints = Dense [ Bound [Double] ] | 122 | data Constraints = Dense [ Bound [Double] ] |
112 | | Sparse [ Bound [(Double,Int)] ] | 123 | | Sparse [ Bound [(Double,Int)] ] |
124 | | General [ Bound [(Double,Int)] ] | ||
113 | 125 | ||
114 | data Optimization = Maximize [Double] | 126 | data Optimization = Maximize [Double] |
115 | | Minimize [Double] | 127 | | Minimize [Double] |
116 | 128 | ||
117 | type Bounds = [Bound Int] | 129 | type Bounds = [Bound Int] |
118 | 130 | ||
131 | -- | Convert a system of General constraints to one with unique coefficients. | ||
132 | sparseOfGeneral :: Constraints -> Constraints | ||
133 | sparseOfGeneral (General cs) = | ||
134 | Sparse $ map (\bl -> | ||
135 | let cl = obj bl in | ||
136 | let cl_unique = foldr (\(c,t) m -> Map.insertWith (+) t c m) Map.empty cl in | ||
137 | withObj bl (Map.foldrWithKey' (\t c l -> (c#t) : l) [] cl_unique)) cs | ||
138 | sparseOfGeneral _ = error "sparseOfGeneral: a general system of constraints was expected" | ||
139 | |||
119 | simplex :: Optimization -> Constraints -> Bounds -> Solution | 140 | simplex :: Optimization -> Constraints -> Bounds -> Solution |
120 | 141 | ||
121 | simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds | 142 | simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds |
122 | simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds | 143 | simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds |
144 | simplex opt (General []) bnds = simplex opt (Sparse [Free [0#1]]) bnds | ||
123 | 145 | ||
124 | simplex opt (Dense constr) bnds = extract sg sol where | 146 | simplex opt (Dense constr) bnds = extract sg sol where |
125 | sol = simplexSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds) | 147 | sol = simplexSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds) |
@@ -133,6 +155,29 @@ simplex opt (Sparse constr) bnds = extract sg sol where | |||
133 | m = length constr | 155 | m = length constr |
134 | (sz, sg, objfun) = adapt opt | 156 | (sz, sg, objfun) = adapt opt |
135 | 157 | ||
158 | simplex opt constr@(General _) bnds = simplex opt (sparseOfGeneral constr) bnds | ||
159 | |||
160 | -- | Simplex method with exact internal arithmetic. See glp_exact in glpk documentation for more information. | ||
161 | exact :: Optimization -> Constraints -> Bounds -> Solution | ||
162 | |||
163 | exact opt (Dense []) bnds = exact opt (Sparse []) bnds | ||
164 | exact opt (Sparse []) bnds = exact opt (Sparse [Free [0#1]]) bnds | ||
165 | exact opt (General []) bnds = exact opt (Sparse [Free [0#1]]) bnds | ||
166 | |||
167 | exact opt (Dense constr) bnds = extract sg sol where | ||
168 | sol = exactSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds) | ||
169 | n = length objfun | ||
170 | m = length constr | ||
171 | (sz, sg, objfun) = adapt opt | ||
172 | |||
173 | exact opt (Sparse constr) bnds = extract sg sol where | ||
174 | sol = exactSparse m n (mkConstrS sz objfun constr) (mkBounds sz constr bnds) | ||
175 | n = length objfun | ||
176 | m = length constr | ||
177 | (sz, sg, objfun) = adapt opt | ||
178 | |||
179 | exact opt constr@(General _) bnds = exact opt (sparseOfGeneral constr) bnds | ||
180 | |||
136 | adapt :: Optimization -> (Int, Double, [Double]) | 181 | adapt :: Optimization -> (Int, Double, [Double]) |
137 | adapt opt = case opt of | 182 | adapt opt = case opt of |
138 | Maximize x -> (sz x, 1 ,x) | 183 | Maximize x -> (sz x, 1 ,x) |
@@ -163,6 +208,13 @@ obj (x :&: _) = x | |||
163 | obj (x :==: _) = x | 208 | obj (x :==: _) = x |
164 | obj (Free x) = x | 209 | obj (Free x) = x |
165 | 210 | ||
211 | withObj :: Bound t -> t -> Bound t | ||
212 | withObj (_ :<=: b) x = (x :<=: b) | ||
213 | withObj (_ :>=: b) x = (x :>=: b) | ||
214 | withObj (_ :&: b) x = (x :&: b) | ||
215 | withObj (_ :==: b) x = (x :==: b) | ||
216 | withObj (Free _) x = Free x | ||
217 | |||
166 | tb :: Bound t -> Double | 218 | tb :: Bound t -> Double |
167 | tb (_ :<=: _) = glpUP | 219 | tb (_ :<=: _) = glpUP |
168 | tb (_ :>=: _) = glpLO | 220 | tb (_ :>=: _) = glpLO |
@@ -236,6 +288,19 @@ simplexSparse m n c b = unsafePerformIO $ do | |||
236 | app3 (c_simplex_sparse (fi m) (fi n)) mat (cmat c) mat (cmat b) vec s "c_simplex_sparse" | 288 | app3 (c_simplex_sparse (fi m) (fi n)) mat (cmat c) mat (cmat b) vec s "c_simplex_sparse" |
237 | return s | 289 | return s |
238 | 290 | ||
291 | foreign import ccall unsafe "c_exact_sparse" c_exact_sparse | ||
292 | :: CInt -> CInt -- rows and cols | ||
293 | -> CInt -> CInt -> Ptr Double -- coeffs | ||
294 | -> CInt -> CInt -> Ptr Double -- bounds | ||
295 | -> CInt -> Ptr Double -- result | ||
296 | -> IO CInt -- exit code | ||
297 | |||
298 | exactSparse :: Int -> Int -> Matrix Double -> Matrix Double -> Vector Double | ||
299 | exactSparse m n c b = unsafePerformIO $ do | ||
300 | s <- createVector (2+n) | ||
301 | app3 (c_exact_sparse (fi m) (fi n)) mat (cmat c) mat (cmat b) vec s "c_exact_sparse" | ||
302 | return s | ||
303 | |||
239 | glpFR, glpLO, glpUP, glpDB, glpFX :: Double | 304 | glpFR, glpLO, glpUP, glpDB, glpFX :: Double |
240 | glpFR = 0 | 305 | glpFR = 0 |
241 | glpLO = 1 | 306 | glpLO = 1 |