diff options
Diffstat (limited to 'packages/glpk')
-rw-r--r-- | packages/glpk/examples/simplex2.hs | 5 | ||||
-rw-r--r-- | packages/glpk/hmatrix-glpk.cabal | 2 | ||||
-rw-r--r-- | packages/glpk/src/Numeric/LinearProgramming.hs | 40 |
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 | ||
13 | constr3 = General [ [1#1, 1#1, 1#2] :<=: 10 | ||
14 | , [1#2, 5#3] :<=: 20 | ||
15 | ] | ||
16 | |||
13 | main = do | 17 | main = 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 | ||
24 | library | 24 | library |
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 | ||
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,7 @@ 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 | sparseOfGeneral, | ||
70 | Optimization(..), | 79 | Optimization(..), |
71 | Constraints(..), | 80 | Constraints(..), |
72 | Bounds, | 81 | Bounds, |
@@ -82,13 +91,14 @@ import System.IO.Unsafe(unsafePerformIO) | |||
82 | import Foreign.C.Types | 91 | import Foreign.C.Types |
83 | import Data.List((\\),sortBy,nub) | 92 | import Data.List((\\),sortBy,nub) |
84 | import Data.Function(on) | 93 | import Data.Function(on) |
94 | import 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) |
93 | infixl 5 # | 103 | infixl 5 # |
94 | (#) = (,) | 104 | (#) = (,) |
@@ -108,18 +118,29 @@ data Solution = Undefined | |||
108 | | Unbounded | 118 | | Unbounded |
109 | deriving Show | 119 | deriving Show |
110 | 120 | ||
111 | data Constraints = Dense [ Bound [Double] ] | 121 | data Constraints = Dense [ Bound [Double] ] |
112 | | Sparse [ Bound [(Double,Int)] ] | 122 | | Sparse [ Bound [(Double,Int)] ] |
123 | | General [ Bound [(Double,Int)] ] | ||
113 | 124 | ||
114 | data Optimization = Maximize [Double] | 125 | data Optimization = Maximize [Double] |
115 | | Minimize [Double] | 126 | | Minimize [Double] |
116 | 127 | ||
117 | type Bounds = [Bound Int] | 128 | type Bounds = [Bound Int] |
118 | 129 | ||
130 | -- | Convert a system of General constraints to one with unique coefficients. | ||
131 | sparseOfGeneral :: Constraints -> Constraints | ||
132 | sparseOfGeneral (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 | ||
137 | sparseOfGeneral _ = error "sparseOfGeneral: a general system of constraints was expected" | ||
138 | |||
119 | simplex :: Optimization -> Constraints -> Bounds -> Solution | 139 | simplex :: Optimization -> Constraints -> Bounds -> Solution |
120 | 140 | ||
121 | simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds | 141 | simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds |
122 | simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds | 142 | simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds |
143 | simplex opt (General []) bnds = simplex opt (Sparse [Free [0#1]]) bnds | ||
123 | 144 | ||
124 | simplex opt (Dense constr) bnds = extract sg sol where | 145 | simplex 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 | ||
157 | simplex opt constr@(General _) bnds = simplex opt (sparseOfGeneral constr) bnds | ||
158 | |||
136 | adapt :: Optimization -> (Int, Double, [Double]) | 159 | adapt :: Optimization -> (Int, Double, [Double]) |
137 | adapt opt = case opt of | 160 | adapt 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 | |||
162 | obj (x :==: _) = x | 185 | obj (x :==: _) = x |
163 | obj (Free x) = x | 186 | obj (Free x) = x |
164 | 187 | ||
188 | withObj :: Bound t -> t -> Bound t | ||
189 | withObj (_ :<=: b) x = (x :<=: b) | ||
190 | withObj (_ :>=: b) x = (x :>=: b) | ||
191 | withObj (_ :&: b) x = (x :&: b) | ||
192 | withObj (_ :==: b) x = (x :==: b) | ||
193 | withObj (Free _) x = Free x | ||
194 | |||
165 | tb :: Bound t -> Double | 195 | tb :: Bound t -> Double |
166 | tb (_ :<=: _) = glpUP | 196 | tb (_ :<=: _) = glpUP |
167 | tb (_ :>=: _) = glpLO | 197 | tb (_ :>=: _) = glpLO |