From 9ef9a9a1c2e2319358fb164bc18a8a0efb23893b Mon Sep 17 00:00:00 2001 From: CJ East Date: Mon, 12 Jan 2015 23:53:51 +1100 Subject: Minor fixes for examples --- packages/glpk/examples/simplex1.hs | 6 +++--- packages/glpk/examples/simplex2.hs | 2 +- packages/glpk/examples/simplex3.hs | 2 +- packages/glpk/examples/simplex4.hs | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) (limited to 'packages/glpk/examples') diff --git a/packages/glpk/examples/simplex1.hs b/packages/glpk/examples/simplex1.hs index e7aeaa9..a326555 100644 --- a/packages/glpk/examples/simplex1.hs +++ b/packages/glpk/examples/simplex1.hs @@ -9,9 +9,9 @@ constr = Dense [ [1,1,1] :<=: 100 , [2,2,6] :<=: 300 ] -- default bounds -bnds = [ 1 :=>: 0 - , 2 :=>: 0 - , 3 :=>: 0 ] +bnds = [ 1 :>=: 0 + , 2 :>=: 0 + , 3 :>=: 0 ] main = do print $ simplex objFun constr [] diff --git a/packages/glpk/examples/simplex2.hs b/packages/glpk/examples/simplex2.hs index f4e27fd..e9e8859 100644 --- a/packages/glpk/examples/simplex2.hs +++ b/packages/glpk/examples/simplex2.hs @@ -13,6 +13,6 @@ constr2 = Dense [ [2,1,0] :<=: 10 main = do print $ simplex prob constr1 [] print $ simplex prob constr2 [] - print $ simplex prob constr2 [ 2 :=>: 1, 3 :&: (2,7)] + print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)] print $ simplex prob constr2 [ Free 2 ] diff --git a/packages/glpk/examples/simplex3.hs b/packages/glpk/examples/simplex3.hs index e093124..0997320 100644 --- a/packages/glpk/examples/simplex3.hs +++ b/packages/glpk/examples/simplex3.hs @@ -11,7 +11,7 @@ constr = Dense , [0.03, 0.05, 0.08, 0.02, 0.06, 0.01, 0] :<=: 100 , [0.02, 0.04, 0.01, 0.02, 0.02, 0, 0] :<=: 40 , [0.02, 0.03, 0, 0, 0.01, 0, 0] :<=: 30 - , [0.7, 0.75, 0.8, 0.75, 0.8, 0.97, 0] :=>: 1500 + , [0.7, 0.75, 0.8, 0.75, 0.8, 0.97, 0] :>=: 1500 , [0.02, 0.06, 0.08, 0.12, 0.02, 0.01, 0.97] :&: (250,300) ] diff --git a/packages/glpk/examples/simplex4.hs b/packages/glpk/examples/simplex4.hs index 9a205ad..22b131c 100644 --- a/packages/glpk/examples/simplex4.hs +++ b/packages/glpk/examples/simplex4.hs @@ -11,7 +11,7 @@ constr = Sparse , [0.03#1, 0.05#2, 0.08#3, 0.02#4, 0.06#5, 0.01#6] :<=: 100 , [0.02#1, 0.04#2, 0.01#3, 0.02#4, 0.02#5] :<=: 40 , [0.02#1, 0.03#2, 0.01#5] :<=: 30 - , [0.7#1, 0.75#2, 0.8#3, 0.75#4, 0.8#5, 0.97#6] :=>: 1500 + , [0.7#1, 0.75#2, 0.8#3, 0.75#4, 0.8#5, 0.97#6] :>=: 1500 , [0.02#1, 0.06#2, 0.08#3, 0.12#4, 0.02#5, 0.01#6, 0.97#7] :&: (250,300) ] -- cgit v1.2.3 From e57907c22e8a16d2a9b62b70dd04ffcfd0d96b6a Mon Sep 17 00:00:00 2001 From: Piotr Mardziel Date: Sun, 22 Feb 2015 22:58:30 -0500 Subject: added handling of general sparse constraints --- packages/glpk/examples/simplex2.hs | 5 ++++ packages/glpk/hmatrix-glpk.cabal | 2 +- packages/glpk/src/Numeric/LinearProgramming.hs | 40 ++++++++++++++++++++++---- 3 files changed, 41 insertions(+), 6 deletions(-) (limited to 'packages/glpk/examples') 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 , [0,1,5] :<=: 20 ] +constr3 = General [ [1#1, 1#1, 1#2] :<=: 10 + , [1#2, 5#3] :<=: 20 + ] + main = do print $ simplex prob constr1 [] print $ simplex prob constr2 [] + print $ simplex prob constr3 [] print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)] print $ simplex prob constr2 [ Free 2 ] 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 examples/simplex4.hs library - Build-Depends: base <5, hmatrix >= 0.16 + Build-Depends: base <5, hmatrix >= 0.16, containers >= 0.5.4.0 hs-source-dirs: src 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 ] @ +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. + +@ +constr3 = General [ [1\#1, 1\#1, 1\#2] :<=: 10 + , [1\#2, 5\#3] :<=: 20 + ] +@ + By default all variables are bounded as @x_i >= 0@, but this can be changed: @@ -67,6 +75,7 @@ Multiple bounds for a variable are not allowed, instead of module Numeric.LinearProgramming( simplex, + sparseOfGeneral, Optimization(..), Constraints(..), Bounds, @@ -82,13 +91,14 @@ import System.IO.Unsafe(unsafePerformIO) import Foreign.C.Types import Data.List((\\),sortBy,nub) import Data.Function(on) +import qualified Data.Map.Strict as Map --import Debug.Trace --debug x = trace (show x) x ----------------------------------------------------- --- | Coefficient of a variable for a sparse representation of constraints. +-- | Coefficient of a variable for a sparse and general representations of constraints. (#) :: Double -> Int -> (Double,Int) infixl 5 # (#) = (,) @@ -108,18 +118,29 @@ data Solution = Undefined | Unbounded deriving Show -data Constraints = Dense [ Bound [Double] ] - | Sparse [ Bound [(Double,Int)] ] +data Constraints = Dense [ Bound [Double] ] + | Sparse [ Bound [(Double,Int)] ] + | General [ Bound [(Double,Int)] ] data Optimization = Maximize [Double] | Minimize [Double] type Bounds = [Bound Int] +-- | Convert a system of General constraints to one with unique coefficients. +sparseOfGeneral :: Constraints -> Constraints +sparseOfGeneral (General cs) = + Sparse $ map (\bl -> + let cl = obj bl in + let m = foldr (\(c,t) m -> Map.insertWith (+) t c m) Map.empty cl in + withObj bl (Map.foldrWithKey' (\t c l -> (c#t) : l) [] m)) cs +sparseOfGeneral _ = error "sparseOfGeneral: a general system of constraints was expected" + simplex :: Optimization -> Constraints -> Bounds -> Solution -simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds -simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds +simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds +simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds +simplex opt (General []) bnds = simplex opt (Sparse [Free [0#1]]) bnds simplex opt (Dense constr) bnds = extract sg sol where 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 m = length constr (sz, sg, objfun) = adapt opt +simplex opt constr@(General _) bnds = simplex opt (sparseOfGeneral constr) bnds + adapt :: Optimization -> (Int, Double, [Double]) adapt opt = case opt of Maximize x -> (size x, 1 ,x) @@ -162,6 +185,13 @@ obj (x :&: _) = x obj (x :==: _) = x obj (Free x) = x +withObj :: Bound t -> t -> Bound t +withObj (_ :<=: b) x = (x :<=: b) +withObj (_ :>=: b) x = (x :>=: b) +withObj (_ :&: b) x = (x :&: b) +withObj (_ :==: b) x = (x :==: b) +withObj (Free _) x = Free x + tb :: Bound t -> Double tb (_ :<=: _) = glpUP tb (_ :>=: _) = glpLO -- cgit v1.2.3 From 012144b1e6ce75515bf3eea5dd2f0f4ddd0d3cae Mon Sep 17 00:00:00 2001 From: Piotr Mardziel Date: Mon, 23 Feb 2015 17:40:31 -0500 Subject: added support for glp_exact --- packages/glpk/examples/simplex5.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 packages/glpk/examples/simplex5.hs (limited to 'packages/glpk/examples') diff --git a/packages/glpk/examples/simplex5.hs b/packages/glpk/examples/simplex5.hs new file mode 100644 index 0000000..ecbcdaa --- /dev/null +++ b/packages/glpk/examples/simplex5.hs @@ -0,0 +1,27 @@ +import Numeric.LinearProgramming + +-- This is a linear program from the paper "Picking vs. Guessing Secrets: A Game-theoretic Analysis" + +gamma = 100000 :: Double +sigma = 1 :: Double +n = 64 :: Int +cost_fun :: Int -> Double +cost_fun i = (fromIntegral i) / (fromIntegral n) +size_fun :: Int -> Double +size_fun i = 2^(fromIntegral i) + +prob = Minimize $ map cost_fun [1..n] +bnds = [i :&: (0,1) | i <- [1..n]] + +constr1 = [[1 # i | i <- [1..n]] :==: 1] ++ + [[1/(size_fun i) # i, + -1/(size_fun (i+1)) # i+1] :>=: 0 | i <- [1..n-1]] ++ + [( + [gamma#i | i <- [1..k]] ++ + (concat [[sigma*(size_fun i) # j | j <- [1..i-1]] | i <- [1..k]]) ++ + [((size_fun i) - 1)/2 # i | i <- [1..k]]) + :<=: (sigma * (foldr (+) 0 (map size_fun [1..k]))) | k <- [1..n]] + +main = do + print $ simplex prob (General constr1) bnds -- NoFeasible + print $ exact prob (General constr1) bnds -- solution found -- cgit v1.2.3