summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--packages/glpk/examples/simplex2.hs5
-rw-r--r--packages/glpk/hmatrix-glpk.cabal2
-rw-r--r--packages/glpk/src/Numeric/LinearProgramming.hs40
3 files changed, 41 insertions, 6 deletions
diff --git a/packages/glpk/examples/simplex2.hs b/packages/glpk/examples/simplex2.hs
index e9e8859..0d83ca9 100644
--- a/packages/glpk/examples/simplex2.hs
+++ b/packages/glpk/examples/simplex2.hs
@@ -10,9 +10,14 @@ constr2 = Dense [ [2,1,0] :<=: 10
10 , [0,1,5] :<=: 20 10 , [0,1,5] :<=: 20
11 ] 11 ]
12 12
13constr3 = General [ [1#1, 1#1, 1#2] :<=: 10
14 , [1#2, 5#3] :<=: 20
15 ]
16
13main = do 17main = do
14 print $ simplex prob constr1 [] 18 print $ simplex prob constr1 []
15 print $ simplex prob constr2 [] 19 print $ simplex prob constr2 []
20 print $ simplex prob constr3 []
16 print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)] 21 print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)]
17 print $ simplex prob constr2 [ Free 2 ] 22 print $ simplex prob constr2 [ Free 2 ]
18 23
diff --git a/packages/glpk/hmatrix-glpk.cabal b/packages/glpk/hmatrix-glpk.cabal
index cd761e0..229197f 100644
--- a/packages/glpk/hmatrix-glpk.cabal
+++ b/packages/glpk/hmatrix-glpk.cabal
@@ -22,7 +22,7 @@ extra-source-files: examples/simplex1.hs
22 examples/simplex4.hs 22 examples/simplex4.hs
23 23
24library 24library
25 Build-Depends: base <5, hmatrix >= 0.16 25 Build-Depends: base <5, hmatrix >= 0.16, containers >= 0.5.4.0
26 26
27 hs-source-dirs: src 27 hs-source-dirs: src
28 28
diff --git a/packages/glpk/src/Numeric/LinearProgramming.hs b/packages/glpk/src/Numeric/LinearProgramming.hs
index b0537cc..a54eb59 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
52Note 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@
55constr3 = General [ [1\#1, 1\#1, 1\#2] :<=: 10
56 , [1\#2, 5\#3] :<=: 20
57 ]
58@
59
52By default all variables are bounded as @x_i >= 0@, but this can be 60By default all variables are bounded as @x_i >= 0@, but this can be
53changed: 61changed:
54 62
@@ -67,6 +75,7 @@ Multiple bounds for a variable are not allowed, instead of
67 75
68module Numeric.LinearProgramming( 76module Numeric.LinearProgramming(
69 simplex, 77 simplex,
78 sparseOfGeneral,
70 Optimization(..), 79 Optimization(..),
71 Constraints(..), 80 Constraints(..),
72 Bounds, 81 Bounds,
@@ -82,13 +91,14 @@ import System.IO.Unsafe(unsafePerformIO)
82import Foreign.C.Types 91import Foreign.C.Types
83import Data.List((\\),sortBy,nub) 92import Data.List((\\),sortBy,nub)
84import Data.Function(on) 93import Data.Function(on)
94import qualified Data.Map.Strict as Map
85 95
86--import Debug.Trace 96--import Debug.Trace
87--debug x = trace (show x) x 97--debug x = trace (show x) x
88 98
89----------------------------------------------------- 99-----------------------------------------------------
90 100
91-- | Coefficient of a variable for a sparse representation of constraints. 101-- | Coefficient of a variable for a sparse and general representations of constraints.
92(#) :: Double -> Int -> (Double,Int) 102(#) :: Double -> Int -> (Double,Int)
93infixl 5 # 103infixl 5 #
94(#) = (,) 104(#) = (,)
@@ -108,18 +118,29 @@ data Solution = Undefined
108 | Unbounded 118 | Unbounded
109 deriving Show 119 deriving Show
110 120
111data Constraints = Dense [ Bound [Double] ] 121data Constraints = Dense [ Bound [Double] ]
112 | Sparse [ Bound [(Double,Int)] ] 122 | Sparse [ Bound [(Double,Int)] ]
123 | General [ Bound [(Double,Int)] ]
113 124
114data Optimization = Maximize [Double] 125data Optimization = Maximize [Double]
115 | Minimize [Double] 126 | Minimize [Double]
116 127
117type Bounds = [Bound Int] 128type Bounds = [Bound Int]
118 129
130-- | Convert a system of General constraints to one with unique coefficients.
131sparseOfGeneral :: Constraints -> Constraints
132sparseOfGeneral (General cs) =
133 Sparse $ map (\bl ->
134 let cl = obj bl in
135 let m = foldr (\(c,t) m -> Map.insertWith (+) t c m) Map.empty cl in
136 withObj bl (Map.foldrWithKey' (\t c l -> (c#t) : l) [] m)) cs
137sparseOfGeneral _ = error "sparseOfGeneral: a general system of constraints was expected"
138
119simplex :: Optimization -> Constraints -> Bounds -> Solution 139simplex :: Optimization -> Constraints -> Bounds -> Solution
120 140
121simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds 141simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds
122simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds 142simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds
143simplex opt (General []) bnds = simplex opt (Sparse [Free [0#1]]) bnds
123 144
124simplex opt (Dense constr) bnds = extract sg sol where 145simplex opt (Dense constr) bnds = extract sg sol where
125 sol = simplexSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds) 146 sol = simplexSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds)
@@ -133,6 +154,8 @@ simplex opt (Sparse constr) bnds = extract sg sol where
133 m = length constr 154 m = length constr
134 (sz, sg, objfun) = adapt opt 155 (sz, sg, objfun) = adapt opt
135 156
157simplex opt constr@(General _) bnds = simplex opt (sparseOfGeneral constr) bnds
158
136adapt :: Optimization -> (Int, Double, [Double]) 159adapt :: Optimization -> (Int, Double, [Double])
137adapt opt = case opt of 160adapt opt = case opt of
138 Maximize x -> (size x, 1 ,x) 161 Maximize x -> (size x, 1 ,x)
@@ -162,6 +185,13 @@ obj (x :&: _) = x
162obj (x :==: _) = x 185obj (x :==: _) = x
163obj (Free x) = x 186obj (Free x) = x
164 187
188withObj :: Bound t -> t -> Bound t
189withObj (_ :<=: b) x = (x :<=: b)
190withObj (_ :>=: b) x = (x :>=: b)
191withObj (_ :&: b) x = (x :&: b)
192withObj (_ :==: b) x = (x :==: b)
193withObj (Free _) x = Free x
194
165tb :: Bound t -> Double 195tb :: Bound t -> Double
166tb (_ :<=: _) = glpUP 196tb (_ :<=: _) = glpUP
167tb (_ :>=: _) = glpLO 197tb (_ :>=: _) = glpLO