glpk-hs 0.2.3 → 0.2.4

raw patch · 12 files changed

+449/−423 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Monad/LPMonad.hs +98/−0
• Control/Monad/LPMonad/Internal.hs +241/−0
• Control/Monad/LPMonad/Supply.hs +44/−0
• Control/Monad/LPMonad/Supply/Class.hs +52/−0
• Data/LinearProgram.hs +3/−3
• Data/LinearProgram/GLPK/IO/Internal.hs +1/−1
• Data/LinearProgram/LPMonad.hs +0/−96
• Data/LinearProgram/LPMonad/Internal.hs +0/−241
• Data/LinearProgram/LPMonad/VarSource.hs +0/−74
• LICENSE +1/−1
• glpk-hs.cabal +8/−7
• glpk/glpk.c +1/−0

@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleContexts #-}++-- | A collection of operations that can be used to specify linear programming in a+-- simple, monadic way.  It is not too difficult to construct 'LP' values explicitly,+-- but this module may help simplify and modularize the construction of the linear program,+-- for example separating different families of constraints in the problem specification.+-- +-- Many of these functions should be executed in either the @'LPM' v c@ or the @'LPT' v c 'IO'@ monad.+-- If you wish to generate new variables on an ad-hoc basis, rather than supplying your own variable type, use the+-- 'VSupply' or 'VSupplyT' monads in your transformer stack, as in @'LPT' 'Var' c 'VSupply'@ or+-- @'LPT' 'Var' c ('VSupplyT' 'IO')@.  To generate new variables, use 'supplyNew' or 'supplyN'.+module Control.Monad.LPMonad (+	module Control.Monad.LPMonad.Internal,+	-- * Generation of new variables+	module Control.Monad.LPMonad.Supply,+	-- * Solvers+	quickSolveMIP,+	quickSolveLP,+	glpSolve,+	quickSolveMIP',+	quickSolveLP',+	glpSolve',+	-- * File I/O+	writeLPToFile,+	readLPFromFile,+	readLPFromFile') where++import Control.Monad ((<=<))+import Control.Monad.State.Class (MonadState(..))+import Control.Monad.Trans (MonadIO (..))++import Data.Map (Map)++import Data.LinearProgram.Common+import Control.Monad.LPMonad.Internal+import Control.Monad.LPMonad.Supply++import Data.LinearProgram.GLPK.Solver+import Data.LinearProgram.GLPK.IO++{-# SPECIALIZE quickSolveLP :: (Ord v, Real c) => +	LPT v c IO (ReturnCode, Maybe (Double, Map v Double)) #-}+{-# SPECIALIZE quickSolveMIP :: (Ord v, Real c) => +	LPT v c IO (ReturnCode, Maybe (Double, Map v Double)) #-}+-- | Solves the linear program with the default settings in GLPK.  Returns the return code,+-- and if the solver was successful, the objective function value and the settings of each variable.+quickSolveLP, quickSolveMIP :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => +	m (ReturnCode, Maybe (Double, Map v Double))+quickSolveLP = glpSolve simplexDefaults+quickSolveMIP = glpSolve mipDefaults++{-# SPECIALIZE glpSolve :: (Ord v, Real c) => GLPOpts -> LPT v c IO (ReturnCode, Maybe (Double, Map v Double)) #-}+-- | Solves the linear program with the specified options in GLPK.  Returns the return code,+-- and if the solver was successful, the objective function value and the settings of each variable.+glpSolve :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => GLPOpts -> m (ReturnCode, Maybe (Double, Map v Double))+glpSolve opts = get >>= liftIO . glpSolveVars opts++{-# SPECIALIZE quickSolveLP' :: (Ord v, Real c) => LPT v c IO (ReturnCode, Maybe (Double, Map v Double, [RowValue v c])) #-}+{-# SPECIALIZE quickSolveMIP' :: (Ord v, Real c) => LPT v c IO (ReturnCode, Maybe (Double, Map v Double, [RowValue v c])) #-}+-- | Solves the linear program with the default settings in GLPK.  Returns the return code,+-- and if the solver was successful, the objective function value, the settings of each variable, and the+-- value of each constraint/row.+quickSolveLP', quickSolveMIP' :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => +	m (ReturnCode, Maybe (Double, Map v Double, [RowValue v c]))+quickSolveLP' = glpSolve' simplexDefaults+quickSolveMIP' = glpSolve' mipDefaults++{-# SPECIALIZE glpSolve' :: (Ord v, Real c) => GLPOpts -> LPT v c IO (ReturnCode, Maybe (Double, Map v Double, [RowValue v c])) #-}+-- | Solves the linear program with the specified options in GLPK.  Returns the return code,+-- and if the solver was successful, the objective function value, the settings of each variable, and+-- the value of each constraint/row.+glpSolve' :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => +	GLPOpts -> m (ReturnCode, Maybe (Double, Map v Double, [RowValue v c]))+glpSolve' opts = get >>= liftIO . glpSolveAll opts++{-# SPECIALIZE writeLPToFile :: (Ord v, Show v, Real c) => FilePath -> LPT v c IO () #-}+-- | Writes the current linear program to the specified file in CPLEX LP format. +-- (This is a binding to GLPK, not a Haskell implementation of CPLEX.)+writeLPToFile :: (Ord v, Show v, Real c, MonadState (LP v c) m, MonadIO m) =>+	FilePath -> m ()+writeLPToFile file = get >>= liftIO . writeLP file ++{-# SPECIALIZE readLPFromFile :: (Ord v, Read v, Fractional c) => FilePath -> LPT v c IO () #-}+-- | Reads a linear program from the specified file in CPLEX LP format, overwriting+-- the current linear program.  Uses 'read' and 'realToFrac' to translate to the specified type.+-- Warning: this may not work on all files written using 'writeLPToFile', since variable names+-- may be changed.+-- (This is a binding to GLPK, not a Haskell implementation of CPLEX.)+readLPFromFile :: (Ord v, Read v, Fractional c, MonadState (LP v c) m, MonadIO m) =>+	FilePath -> m ()+readLPFromFile = put <=< liftIO . readLP++{-# SPECIALIZE readLPFromFile :: FilePath -> LPT String Double IO () #-}+-- | Reads a linear program from the specified file in CPLEX LP format, overwriting+-- the current linear program.  (This is a binding to GLPK, not a Haskell implementation of CPLEX.)+readLPFromFile' :: (MonadState (LP String Double) m, MonadIO m) =>+	FilePath -> m ()+readLPFromFile' = put <=< liftIO . readLP'

@@ -0,0 +1,241 @@+{-# LANGUAGE BangPatterns, FlexibleContexts, RecordWildCards #-}++module Control.Monad.LPMonad.Internal (+-- 	module Data.LinearProgram.Common,+	-- * Monad definitions+	LPM,+	LPT,+	runLPM,+	runLPT,+	execLPM,+	execLPT,+	evalLPM,+	evalLPT,+	-- * Constructing the LP+	-- ** Objective configuration+	setDirection,+	setObjective,+	addObjective,+	addWeightedObjective,+	-- ** Two-function constraints+	leq,+	equal,+	geq,+	leq',+	equal',+	geq',+	-- ** One-function constraints+	leqTo,+	equalTo,+	geqTo,+	constrain,+	leqTo',+	equalTo',+	geqTo',+	constrain',+	-- ** Variable constraints+	varLeq,+	varEq,+	varGeq,+	varBds,+	setVarBounds,+	setVarKind,+	newVariables,+	newVariables') where++import Control.Monad.State.Strict+import Control.Monad.Identity++import Data.Map+import Data.Monoid++import Data.LinearProgram.Common++-- | A simple monad for constructing linear programs.  This library is intended to be able to link to +-- a variety of different linear programming implementations.+type LPM v c = LPT v c Identity++-- | A simple monad transformer for constructing linear programs in an arbitrary monad.+type LPT v c = StateT (LP v c)++runLPM :: (Ord v, Group c) => LPM v c a -> (a, LP v c)+runLPM = runIdentity . runLPT++runLPT :: (Ord v, Group c) => LPT v c m a -> m (a, LP v c)+runLPT m = runStateT m (LP Max zero [] mempty mempty)++-- | Constructs a linear programming problem.+execLPM :: (Ord v, Group c) => LPM v c a -> LP v c+execLPM = runIdentity . execLPT++-- | Constructs a linear programming problem in the specified monad.+execLPT :: (Ord v, Group c, Monad m) => LPT v c m a -> m (LP v c)+execLPT = liftM snd . runLPT++-- | Runs the specified operation in the linear programming monad.+evalLPM :: (Ord v, Group c) => LPM v c a -> a+evalLPM = runIdentity . evalLPT++-- | Runs the specified operation in the linear programming monad transformer.+evalLPT :: (Ord v, Group c, Monad m) => LPT v c m a -> m a+evalLPT = liftM fst . runLPT++-- | Sets the optimization direction of the linear program: maximization or minimization.+{-# SPECIALIZE setDirection :: Direction -> LPM v c (), Monad m => Direction -> LPT v c m () #-}+setDirection :: (MonadState (LP v c) m) => Direction -> m ()+setDirection dir = modify (\ lp -> lp{direction = dir})++{-# SPECIALIZE equal :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-}+{-# SPECIALIZE leq :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-}+{-# SPECIALIZE geq :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-}+-- | Specifies the relationship between two functions in the variables.+equal, leq, geq :: (Ord v, Group c, MonadState (LP v c) m) => LinFunc v c -> LinFunc v c -> m ()+equal f g = equalTo (f ^-^ g) zero+leq f g = leqTo (f ^-^ g) zero+geq = flip leq++{-# SPECIALIZE equal' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-}+{-# SPECIALIZE geq' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-}+{-# SPECIALIZE leq' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-}+-- | Specifies the relationship between two functions in the variables, with a label on the constraint.+equal', leq', geq' :: (Ord v, Group c, MonadState (LP v c) m) => String -> LinFunc v c -> LinFunc v c -> m ()+equal' lab f g = equalTo' lab (f ^-^ g) zero+leq' lab f g = leqTo' lab (f ^-^ g) zero+geq' = flip . leq'++{-# SPECIALIZE equalTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}+{-# SPECIALIZE geqTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}+{-# SPECIALIZE leqTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}+-- | Sets a constraint on a linear function in the variables.+equalTo, leqTo, geqTo :: MonadState (LP v c) m => LinFunc v c -> c -> m ()+equalTo f v = constrain f (Equ v)+leqTo f v = constrain f (UBound v)+geqTo f v = constrain f (LBound v)++{-# SPECIALIZE equalTo' :: String -> LinFunc v c -> c -> LPM v c (),+	Monad m => String -> LinFunc v c -> c -> LPT v c m () #-}+{-# SPECIALIZE geqTo' :: String -> LinFunc v c -> c -> LPM v c (),+	Monad m => String -> LinFunc v c -> c -> LPT v c m () #-}+{-# SPECIALIZE leqTo' :: String -> LinFunc v c -> c -> LPM v c (),+	Monad m => String -> LinFunc v c -> c -> LPT v c m () #-}+-- | Sets a labeled constraint on a linear function in the variables.+equalTo', leqTo', geqTo' :: MonadState (LP v c) m => String -> LinFunc v c -> c -> m ()+equalTo' lab f v = constrain' lab f (Equ v)+leqTo' lab f v = constrain' lab f (UBound v)+geqTo' lab f v = constrain' lab f (LBound v)++{-# SPECIALIZE newVariables :: (Ord v, Enum v) => Int -> LPM v c [v],+	(Ord v, Enum v, Monad m) => Int -> LPT v c m [v] #-}+-- | Returns a list of @k@ unused variables.  If the program is currently empty,+-- starts at @'toEnum' 0@.  Otherwise, if @v@ is the biggest variable currently in use+-- (by the 'Ord' ordering), then this returns @take k (tail [v..])@, which uses the 'Enum'+-- implementation.  Note that if the 'Enum' instance doesn't play well with 'Ord',+-- bad things can happen.+newVariables :: (MonadState (LP v c) m, Ord v, Enum v) => Int -> m [v]+newVariables !k = do	LP{..} <- get+			let allVars0 = fmap (const ()) objective `union`+				unions [fmap (const ()) f | Constr _ f _ <- constraints] `union`+				fmap (const ()) varBounds `union` fmap (const ()) varTypes+			case minViewWithKey allVars0 of+				Nothing	-> return $ take k [toEnum 0..]+				Just ((start, _), _)+					-> return $ take k $ tail [start..]+					+{-# SPECIALIZE newVariables' :: (Ord v, Enum v) => LPM v c [v],+	(Ord v, Enum v, Monad m) => LPT v c m [v] #-}+-- | Returns an infinite list of unused variables.  If the program is currently empty,+-- starts at @'toEnum' 0@.  Otherwise, if @v@ is the biggest variable currently in use+-- (by the 'Ord' ordering), then this returns @tail [v..]@, which uses the 'Enum'+-- implementation.  Note that if the 'Enum' instance doesn't play well with 'Ord',+-- bad things can happen.+newVariables' :: (MonadState (LP v c) m, Ord v, Enum v) => m [v]+newVariables' = do	LP{..} <- get+			let allVars0 = fmap (const ()) objective `union`+				unions [fmap (const ()) f | Constr _ f _ <- constraints] `union`+				fmap (const ()) varBounds `union` fmap (const ()) varTypes+			case minViewWithKey allVars0 of+				Nothing	-> return [toEnum 0..]+				Just ((start, _), _)+					-> return $ tail [start..]++{-# SPECIALIZE varEq :: (Ord v, Ord c) => v -> c -> LPM v c (),+	(Ord v, Ord c, Monad m) => v -> c -> LPT v c m () #-}+{-# SPECIALIZE varLeq :: (Ord v, Ord c) => v -> c -> LPM v c (),+	(Ord v, Ord c, Monad m) => v -> c -> LPT v c m () #-}+{-# SPECIALIZE varGeq :: (Ord v, Ord c) => v -> c -> LPM v c (),+	(Ord v, Ord c, Monad m) => v -> c -> LPT v c m () #-}+-- | Sets a constraint on the value of a variable.  If you constrain a variable more than once,+-- the constraints will be combined.  If the constraints are mutually contradictory,+-- an error will be generated.  This is more efficient than adding an equivalent function constraint.+varEq, varLeq, varGeq :: (Ord v, Ord c, MonadState (LP v c) m) => v -> c -> m ()+varEq v c = setVarBounds v (Equ c)+varLeq v c = setVarBounds v (UBound c)+varGeq v c = setVarBounds v (LBound c)++{-# SPECIALIZE varBds :: (Ord v, Ord c) => v -> c -> c -> LPM v c (),+	(Ord v, Ord c, Monad m) => v -> c -> c -> LPT v c m () #-}+-- | Bounds the value of a variable on both sides.  If you constrain a variable more than once,+-- the constraints will be combined.  If the constraints are mutually contradictory,+-- an error will be generated.  This is more efficient than adding an equivalent function constraint.+varBds :: (Ord v, Ord c, MonadState (LP v c) m) => v -> c -> c -> m ()+varBds v l u = setVarBounds v (Bound l u)++{-# SPECIALIZE constrain :: LinFunc v c -> Bounds c -> LPM v c (),+	Monad m => LinFunc v c -> Bounds c -> LPT v c m () #-}+-- | The most general form of an unlabeled constraint.+constrain :: MonadState (LP v c) m => LinFunc v c -> Bounds c -> m ()+constrain f bds = modify addConstr where+	addConstr lp@LP{..}+		= lp{constraints = Constr Nothing f bds:constraints}++{-# SPECIALIZE constrain' :: String -> LinFunc v c -> Bounds c -> LPM v c (),+	Monad m => String -> LinFunc v c -> Bounds c -> LPT v c m () #-}+-- | The most general form of a labeled constraint.+constrain' :: MonadState (LP v c) m => String -> LinFunc v c -> Bounds c -> m ()+constrain' lab f bds = modify addConstr where+	addConstr lp@LP{..}+		= lp{constraints = Constr (Just lab) f bds:constraints}++{-# SPECIALIZE setObjective :: LinFunc v c -> LPM v c (),+	Monad m => LinFunc v c -> LPT v c m () #-}+-- | Sets the objective function, overwriting the previous objective function.+setObjective :: MonadState (LP v c) m => LinFunc v c -> m ()+setObjective obj = modify setObj where+	setObj lp = lp{objective = obj}++{-# SPECIALIZE addObjective :: (Ord v, Group c) => LinFunc v c -> LPM v c (),+	(Ord v, Group c, Monad m) => LinFunc v c -> LPT v c m () #-}+-- | Adds this function to the objective function.+addObjective :: (Ord v, Group c, MonadState (LP v c) m) => LinFunc v c -> m ()+addObjective obj = modify addObj where+	addObj lp@LP{..} = lp {objective = obj ^+^ objective}+		+{-# SPECIALIZE addWeightedObjective :: (Ord v, Module r c) => r -> LinFunc v c -> LPM v c (),+	(Ord v, Module r c, Monad m) => r -> LinFunc v c -> LPT v c m () #-}+-- | Adds this function to the objective function, with the specified weight.  Equivalent to+-- @'addObjective' (wt '*^' obj)@.+addWeightedObjective :: (Ord v, Module r c, MonadState (LP v c) m) => r -> LinFunc v c -> m ()+addWeightedObjective wt obj = addObjective (wt *^ obj)++{-# SPECIALIZE setVarBounds :: (Ord v, Ord c) => v -> Bounds c -> LPM v c (),+	(Ord v, Ord c, Monad m) => v -> Bounds c -> LPT v c m () #-}+-- | The most general way to set constraints on a variable.+-- If you constrain a variable more than once, the constraints will be combined.+-- If you combine mutually contradictory constraints, an error will be generated.+-- This is more efficient than creating an equivalent function constraint.+setVarBounds :: (Ord v, Ord c, MonadState (LP v c) m) => v -> Bounds c -> m ()+setVarBounds var bds = modify addBds where+	addBds lp@LP{..} = lp{varBounds = insertWith mappend var bds varBounds}++{-# SPECIALIZE setVarKind :: Ord v => v -> VarKind -> LPM v c (),+	(Ord v, Monad m) => v -> VarKind -> LPT v c m () #-}+-- | Sets the kind ('type') of a variable.  See 'VarKind'.+setVarKind :: (Ord v, MonadState (LP v c) m) => v -> VarKind -> m ()+setVarKind v k = modify setK where+	setK lp@LP{..} = lp{varTypes = insertWith mappend v k varTypes}

@@ -0,0 +1,44 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}++module Control.Monad.LPMonad.Supply (module Control.Monad.LPMonad.Supply.Class, Var(..), VSupply, VSupplyT) where++import Control.Monad.Identity+import Control.Monad.Trans+import Control.Monad.State.Strict+import Control.Monad.RWS.Class+import Control.Monad.Cont.Class+import Control.Monad.Error.Class++import Control.Monad.LPMonad.Supply.Class++-- | A type suitable for use as a linear program variable.+newtype Var = Var {varId :: Int} deriving (Eq, Ord, Enum)++-- | A monad capable of supplying unique variables.+type VSupply = VSupplyT Identity++runVSupply :: VSupply a -> a+runVSupply = runIdentity . runVSupplyT++-- | A monad transformer capable of supplying unique variables.+newtype VSupplyT m a = VSupplyT (StateT Var m a) deriving (Functor, Monad, MonadPlus, MonadTrans, MonadReader r, MonadWriter w, MonadCont,+	MonadIO, MonadFix, MonadError e)++runVSupplyT :: Monad m => VSupplyT m a -> m a+runVSupplyT (VSupplyT m) = evalStateT m (Var 0)++instance Show Var where+	show (Var x) = "x_" ++ show x++instance Read Var where+	readsPrec _ ('x':'_':xs) = [(Var x, s') | (x, s') <- reads xs]+	readsPrec _ _ = []++instance MonadState s m => MonadState s (VSupplyT m) where+	get = lift get+	put = lift . put++instance Monad m => MonadSupply Var (VSupplyT m) where+	{-# SPECIALIZE instance MonadSupply Var VSupply #-}+	supplyNew = VSupplyT $ StateT $ \ v -> return (v, succ v)+	supplyN n = VSupplyT $ StateT $ \ (Var x) -> return (map Var [x..x+n-1], Var (x + n))

@@ -0,0 +1,52 @@+{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}+module Control.Monad.LPMonad.Supply.Class where++import Control.Monad++import Control.Monad.State.Strict+import Control.Monad.Reader+import Control.Monad.Error+import qualified Control.Monad.Writer.Lazy as WL+import qualified Control.Monad.Writer.Strict as WS+import qualified Control.Monad.State.Lazy as SL+import Control.Monad.Cont++import Data.Monoid++-- | A class implemented by monads that can supply values of type @s@.  Minimal implementation: 'supplyNew' or 'supplyN'.+class Monad m => MonadSupply s m | m -> s where+	-- | Supply a new value of type @s@.+	supplyNew :: m s+	-- | Supply @n@ values of type @s@.+	supplyN :: Int -> m [s]+	+	supplyNew = liftM head (supplyN 1)+	supplyN n = replicateM n supplyNew++instance MonadSupply x m => MonadSupply x (StateT s m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN++instance MonadSupply x m => MonadSupply x (ReaderT r m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN++instance (Error e, MonadSupply x m) => MonadSupply x (ErrorT e m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN++instance (MonadSupply x m, Monoid w) => MonadSupply x (WL.WriterT w m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN++instance (MonadSupply x m, Monoid w) => MonadSupply x (WS.WriterT w m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN++instance MonadSupply x m => MonadSupply x (ContT r m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN++instance MonadSupply x m => MonadSupply x (SL.StateT s m) where+	supplyNew = lift supplyNew+	supplyN = lift . supplyN

@@ -1,8 +1,8 @@ module Data.LinearProgram ( 	module Data.LinearProgram.Common,-	module Data.LinearProgram.LPMonad,-	module Data.LinearProgram.GLPK) where+	module Data.LinearProgram.GLPK,+	module Control.Monad.LPMonad) where  import Data.LinearProgram.GLPK-import Data.LinearProgram.LPMonad import Data.LinearProgram.Common+import Control.Monad.LPMonad

@@ -9,7 +9,7 @@  import Data.LinearProgram.Common import Data.LinearProgram.GLPK.Common-import Data.LinearProgram.LPMonad.Internal+import Control.Monad.LPMonad.Internal  foreign import ccall unsafe "c_glp_write_lp" glpWriteLP :: Ptr GlpProb -> CString -> IO () foreign import ccall unsafe "c_glp_read_lp" glpReadLP :: Ptr GlpProb -> CString -> IO ()

@@ -1,96 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- | A collection of operations that can be used to specify linear programming in a--- simple, monadic way.  It is not too difficult to construct 'LP' values explicitly,--- but this module may help simplify and modularize the construction of the linear program,--- for example separating different families of constraints in the problem specification.--- --- Many of these functions should be executed in either the @'LPM' v c@ or the @'LPT' v c 'IO'@ monad.--- If you wish to generate new variables on an ad-hoc basis, rather than supplying your own variable type, use the--- 'VarSource' or 'VarSourceT' monads in your transformer stack.-module Data.LinearProgram.LPMonad (-	module Data.LinearProgram.LPMonad.Internal,-	module Data.LinearProgram.LPMonad.VarSource,-	-- * Solvers-	quickSolveMIP,-	quickSolveLP,-	glpSolve,-	quickSolveMIP',-	quickSolveLP',-	glpSolve',-	-- * File I/O-	writeLPToFile,-	readLPFromFile,-	readLPFromFile') where--import Control.Monad ((<=<))-import Control.Monad.State.Class (MonadState(..))-import Control.Monad.Trans (MonadIO (..))--import Data.Map (Map)--import Data.LinearProgram.Common-import Data.LinearProgram.LPMonad.Internal-import Data.LinearProgram.LPMonad.VarSource--import Data.LinearProgram.GLPK.Solver-import Data.LinearProgram.GLPK.IO--{-# SPECIALIZE quickSolveLP :: (Ord v, Real c) => -	LPT v c IO (ReturnCode, Maybe (Double, Map v Double)) #-}-{-# SPECIALIZE quickSolveMIP :: (Ord v, Real c) => -	LPT v c IO (ReturnCode, Maybe (Double, Map v Double)) #-}--- | Solves the linear program with the default settings in GLPK.  Returns the return code,--- and if the solver was successful, the objective function value and the settings of each variable.-quickSolveLP, quickSolveMIP :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => -	m (ReturnCode, Maybe (Double, Map v Double))-quickSolveLP = glpSolve simplexDefaults-quickSolveMIP = glpSolve mipDefaults--{-# SPECIALIZE glpSolve :: (Ord v, Real c) => GLPOpts -> LPT v c IO (ReturnCode, Maybe (Double, Map v Double)) #-}--- | Solves the linear program with the specified options in GLPK.  Returns the return code,--- and if the solver was successful, the objective function value and the settings of each variable.-glpSolve :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => GLPOpts -> m (ReturnCode, Maybe (Double, Map v Double))-glpSolve opts = get >>= liftIO . glpSolveVars opts--{-# SPECIALIZE quickSolveLP' :: (Ord v, Real c) => LPT v c IO (ReturnCode, Maybe (Double, Map v Double, [RowValue v c])) #-}-{-# SPECIALIZE quickSolveMIP' :: (Ord v, Real c) => LPT v c IO (ReturnCode, Maybe (Double, Map v Double, [RowValue v c])) #-}--- | Solves the linear program with the default settings in GLPK.  Returns the return code,--- and if the solver was successful, the objective function value, the settings of each variable, and the--- value of each constraint/row.-quickSolveLP', quickSolveMIP' :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => -	m (ReturnCode, Maybe (Double, Map v Double, [RowValue v c]))-quickSolveLP' = glpSolve' simplexDefaults-quickSolveMIP' = glpSolve' mipDefaults--{-# SPECIALIZE glpSolve' :: (Ord v, Real c) => GLPOpts -> LPT v c IO (ReturnCode, Maybe (Double, Map v Double, [RowValue v c])) #-}--- | Solves the linear program with the specified options in GLPK.  Returns the return code,--- and if the solver was successful, the objective function value, the settings of each variable, and--- the value of each constraint/row.-glpSolve' :: (Ord v, Real c, MonadState (LP v c) m, MonadIO m) => -	GLPOpts -> m (ReturnCode, Maybe (Double, Map v Double, [RowValue v c]))-glpSolve' opts = get >>= liftIO . glpSolveAll opts--{-# SPECIALIZE writeLPToFile :: (Ord v, Show v, Real c) => FilePath -> LPT v c IO () #-}--- | Writes the current linear program to the specified file in CPLEX LP format. --- (This is a binding to GLPK, not a Haskell implementation of CPLEX.)-writeLPToFile :: (Ord v, Show v, Real c, MonadState (LP v c) m, MonadIO m) =>-	FilePath -> m ()-writeLPToFile file = get >>= liftIO . writeLP file --{-# SPECIALIZE readLPFromFile :: (Ord v, Read v, Fractional c) => FilePath -> LPT v c IO () #-}--- | Reads a linear program from the specified file in CPLEX LP format, overwriting--- the current linear program.  Uses 'read' and 'realToFrac' to translate to the specified type.--- Warning: this may not work on all files written using 'writeLPToFile', since variable names--- may be changed.--- (This is a binding to GLPK, not a Haskell implementation of CPLEX.)-readLPFromFile :: (Ord v, Read v, Fractional c, MonadState (LP v c) m, MonadIO m) =>-	FilePath -> m ()-readLPFromFile = put <=< liftIO . readLP--{-# SPECIALIZE readLPFromFile :: FilePath -> LPT String Double IO () #-}--- | Reads a linear program from the specified file in CPLEX LP format, overwriting--- the current linear program.  (This is a binding to GLPK, not a Haskell implementation of CPLEX.)-readLPFromFile' :: (MonadState (LP String Double) m, MonadIO m) =>-	FilePath -> m ()-readLPFromFile' = put <=< liftIO . readLP'

@@ -1,241 +0,0 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, RecordWildCards #-}--module Data.LinearProgram.LPMonad.Internal (--- 	module Data.LinearProgram.Common,-	-- * Monad definitions-	LPM,-	LPT,-	runLPM,-	runLPT,-	execLPM,-	execLPT,-	evalLPM,-	evalLPT,-	-- * Constructing the LP-	-- ** Objective configuration-	setDirection,-	setObjective,-	addObjective,-	addWeightedObjective,-	-- ** Two-function constraints-	leq,-	equal,-	geq,-	leq',-	equal',-	geq',-	-- ** One-function constraints-	leqTo,-	equalTo,-	geqTo,-	constrain,-	leqTo',-	equalTo',-	geqTo',-	constrain',-	-- ** Variable constraints-	varLeq,-	varEq,-	varGeq,-	varBds,-	setVarBounds,-	setVarKind,-	newVariables,-	newVariables') where--import Control.Monad.State.Strict-import Control.Monad.Identity--import Data.Map-import Data.Monoid--import Data.LinearProgram.Common---- | A simple monad for constructing linear programs.  This library is intended to be able to link to --- a variety of different linear programming implementations.-type LPM v c = LPT v c Identity---- | A simple monad transformer for constructing linear programs in an arbitrary monad.-type LPT v c = StateT (LP v c)--runLPM :: (Ord v, Group c) => LPM v c a -> (a, LP v c)-runLPM = runIdentity . runLPT--runLPT :: (Ord v, Group c) => LPT v c m a -> m (a, LP v c)-runLPT m = runStateT m (LP Max zero [] mempty mempty)---- | Constructs a linear programming problem.-execLPM :: (Ord v, Group c) => LPM v c a -> LP v c-execLPM = runIdentity . execLPT---- | Constructs a linear programming problem in the specified monad.-execLPT :: (Ord v, Group c, Monad m) => LPT v c m a -> m (LP v c)-execLPT = liftM snd . runLPT---- | Runs the specified operation in the linear programming monad.-evalLPM :: (Ord v, Group c) => LPM v c a -> a-evalLPM = runIdentity . evalLPT---- | Runs the specified operation in the linear programming monad transformer.-evalLPT :: (Ord v, Group c, Monad m) => LPT v c m a -> m a-evalLPT = liftM fst . runLPT---- | Sets the optimization direction of the linear program: maximization or minimization.-{-# SPECIALIZE setDirection :: Direction -> LPM v c (), Monad m => Direction -> LPT v c m () #-}-setDirection :: (MonadState (LP v c) m) => Direction -> m ()-setDirection dir = modify (\ lp -> lp{direction = dir})--{-# SPECIALIZE equal :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-}-{-# SPECIALIZE leq :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-}-{-# SPECIALIZE geq :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-}--- | Specifies the relationship between two functions in the variables.-equal, leq, geq :: (Ord v, Group c, MonadState (LP v c) m) => LinFunc v c -> LinFunc v c -> m ()-equal f g = equalTo (f ^-^ g) zero-leq f g = leqTo (f ^-^ g) zero-geq = flip leq--{-# SPECIALIZE equal' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-}-{-# SPECIALIZE geq' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-}-{-# SPECIALIZE leq' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-}--- | Specifies the relationship between two functions in the variables, with a label on the constraint.-equal', leq', geq' :: (Ord v, Group c, MonadState (LP v c) m) => String -> LinFunc v c -> LinFunc v c -> m ()-equal' lab f g = equalTo' lab (f ^-^ g) zero-leq' lab f g = leqTo' lab (f ^-^ g) zero-geq' = flip . leq'--{-# SPECIALIZE equalTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}-{-# SPECIALIZE geqTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}-{-# SPECIALIZE leqTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}--- | Sets a constraint on a linear function in the variables.-equalTo, leqTo, geqTo :: MonadState (LP v c) m => LinFunc v c -> c -> m ()-equalTo f v = constrain f (Equ v)-leqTo f v = constrain f (UBound v)-geqTo f v = constrain f (LBound v)--{-# SPECIALIZE equalTo' :: String -> LinFunc v c -> c -> LPM v c (),-	Monad m => String -> LinFunc v c -> c -> LPT v c m () #-}-{-# SPECIALIZE geqTo' :: String -> LinFunc v c -> c -> LPM v c (),-	Monad m => String -> LinFunc v c -> c -> LPT v c m () #-}-{-# SPECIALIZE leqTo' :: String -> LinFunc v c -> c -> LPM v c (),-	Monad m => String -> LinFunc v c -> c -> LPT v c m () #-}--- | Sets a labeled constraint on a linear function in the variables.-equalTo', leqTo', geqTo' :: MonadState (LP v c) m => String -> LinFunc v c -> c -> m ()-equalTo' lab f v = constrain' lab f (Equ v)-leqTo' lab f v = constrain' lab f (UBound v)-geqTo' lab f v = constrain' lab f (LBound v)--{-# SPECIALIZE newVariables :: (Ord v, Enum v) => Int -> LPM v c [v],-	(Ord v, Enum v, Monad m) => Int -> LPT v c m [v] #-}--- | Returns a list of @k@ unused variables.  If the program is currently empty,--- starts at @'toEnum' 0@.  Otherwise, if @v@ is the biggest variable currently in use--- (by the 'Ord' ordering), then this returns @take k (tail [v..])@, which uses the 'Enum'--- implementation.  Note that if the 'Enum' instance doesn't play well with 'Ord',--- bad things can happen.-newVariables :: (MonadState (LP v c) m, Ord v, Enum v) => Int -> m [v]-newVariables !k = do	LP{..} <- get-			let allVars0 = fmap (const ()) objective `union`-				unions [fmap (const ()) f | Constr _ f _ <- constraints] `union`-				fmap (const ()) varBounds `union` fmap (const ()) varTypes-			case minViewWithKey allVars0 of-				Nothing	-> return $ take k [toEnum 0..]-				Just ((start, _), _)-					-> return $ take k $ tail [start..]-					-{-# SPECIALIZE newVariables' :: (Ord v, Enum v) => LPM v c [v],-	(Ord v, Enum v, Monad m) => LPT v c m [v] #-}--- | Returns an infinite list of unused variables.  If the program is currently empty,--- starts at @'toEnum' 0@.  Otherwise, if @v@ is the biggest variable currently in use--- (by the 'Ord' ordering), then this returns @tail [v..]@, which uses the 'Enum'--- implementation.  Note that if the 'Enum' instance doesn't play well with 'Ord',--- bad things can happen.-newVariables' :: (MonadState (LP v c) m, Ord v, Enum v) => m [v]-newVariables' = do	LP{..} <- get-			let allVars0 = fmap (const ()) objective `union`-				unions [fmap (const ()) f | Constr _ f _ <- constraints] `union`-				fmap (const ()) varBounds `union` fmap (const ()) varTypes-			case minViewWithKey allVars0 of-				Nothing	-> return [toEnum 0..]-				Just ((start, _), _)-					-> return $ tail [start..]--{-# SPECIALIZE varEq :: (Ord v, Ord c) => v -> c -> LPM v c (),-	(Ord v, Ord c, Monad m) => v -> c -> LPT v c m () #-}-{-# SPECIALIZE varLeq :: (Ord v, Ord c) => v -> c -> LPM v c (),-	(Ord v, Ord c, Monad m) => v -> c -> LPT v c m () #-}-{-# SPECIALIZE varGeq :: (Ord v, Ord c) => v -> c -> LPM v c (),-	(Ord v, Ord c, Monad m) => v -> c -> LPT v c m () #-}--- | Sets a constraint on the value of a variable.  If you constrain a variable more than once,--- the constraints will be combined.  If the constraints are mutually contradictory,--- an error will be generated.  This is more efficient than adding an equivalent function constraint.-varEq, varLeq, varGeq :: (Ord v, Ord c, MonadState (LP v c) m) => v -> c -> m ()-varEq v c = setVarBounds v (Equ c)-varLeq v c = setVarBounds v (UBound c)-varGeq v c = setVarBounds v (LBound c)--{-# SPECIALIZE varBds :: (Ord v, Ord c) => v -> c -> c -> LPM v c (),-	(Ord v, Ord c, Monad m) => v -> c -> c -> LPT v c m () #-}--- | Bounds the value of a variable on both sides.  If you constrain a variable more than once,--- the constraints will be combined.  If the constraints are mutually contradictory,--- an error will be generated.  This is more efficient than adding an equivalent function constraint.-varBds :: (Ord v, Ord c, MonadState (LP v c) m) => v -> c -> c -> m ()-varBds v l u = setVarBounds v (Bound l u)--{-# SPECIALIZE constrain :: LinFunc v c -> Bounds c -> LPM v c (),-	Monad m => LinFunc v c -> Bounds c -> LPT v c m () #-}--- | The most general form of an unlabeled constraint.-constrain :: MonadState (LP v c) m => LinFunc v c -> Bounds c -> m ()-constrain f bds = modify addConstr where-	addConstr lp@LP{..}-		= lp{constraints = Constr Nothing f bds:constraints}--{-# SPECIALIZE constrain' :: String -> LinFunc v c -> Bounds c -> LPM v c (),-	Monad m => String -> LinFunc v c -> Bounds c -> LPT v c m () #-}--- | The most general form of a labeled constraint.-constrain' :: MonadState (LP v c) m => String -> LinFunc v c -> Bounds c -> m ()-constrain' lab f bds = modify addConstr where-	addConstr lp@LP{..}-		= lp{constraints = Constr (Just lab) f bds:constraints}--{-# SPECIALIZE setObjective :: LinFunc v c -> LPM v c (),-	Monad m => LinFunc v c -> LPT v c m () #-}--- | Sets the objective function, overwriting the previous objective function.-setObjective :: MonadState (LP v c) m => LinFunc v c -> m ()-setObjective obj = modify setObj where-	setObj lp = lp{objective = obj}--{-# SPECIALIZE addObjective :: (Ord v, Group c) => LinFunc v c -> LPM v c (),-	(Ord v, Group c, Monad m) => LinFunc v c -> LPT v c m () #-}--- | Adds this function to the objective function.-addObjective :: (Ord v, Group c, MonadState (LP v c) m) => LinFunc v c -> m ()-addObjective obj = modify addObj where-	addObj lp@LP{..} = lp {objective = obj ^+^ objective}-		-{-# SPECIALIZE addWeightedObjective :: (Ord v, Module r c) => r -> LinFunc v c -> LPM v c (),-	(Ord v, Module r c, Monad m) => r -> LinFunc v c -> LPT v c m () #-}--- | Adds this function to the objective function, with the specified weight.  Equivalent to--- @'addObjective' (wt '*^' obj)@.-addWeightedObjective :: (Ord v, Module r c, MonadState (LP v c) m) => r -> LinFunc v c -> m ()-addWeightedObjective wt obj = addObjective (wt *^ obj)--{-# SPECIALIZE setVarBounds :: (Ord v, Ord c) => v -> Bounds c -> LPM v c (),-	(Ord v, Ord c, Monad m) => v -> Bounds c -> LPT v c m () #-}--- | The most general way to set constraints on a variable.--- If you constrain a variable more than once, the constraints will be combined.--- If you combine mutually contradictory constraints, an error will be generated.--- This is more efficient than creating an equivalent function constraint.-setVarBounds :: (Ord v, Ord c, MonadState (LP v c) m) => v -> Bounds c -> m ()-setVarBounds var bds = modify addBds where-	addBds lp@LP{..} = lp{varBounds = insertWith mappend var bds varBounds}--{-# SPECIALIZE setVarKind :: Ord v => v -> VarKind -> LPM v c (),-	(Ord v, Monad m) => v -> VarKind -> LPT v c m () #-}--- | Sets the kind ('type') of a variable.  See 'VarKind'.-setVarKind :: (Ord v, MonadState (LP v c) m) => v -> VarKind -> m ()-setVarKind v k = modify setK where-	setK lp@LP{..} = lp{varTypes = insertWith mappend v k varTypes}

@@ -1,74 +0,0 @@-{-# LANGUAGE UndecidableInstances, FlexibleInstances, GeneralizedNewtypeDeriving, FunctionalDependencies, MultiParamTypeClasses #-}-module Data.LinearProgram.LPMonad.VarSource (-	-- * Variable generation monad-	VarSource, evalVarSource, VarSourceT, evalVarSourceT, Var(..),-	MonadSource(..)) where--import Control.Monad-import Control.Monad.State.Strict-import Control.Monad.Reader-import qualified Control.Monad.Writer.Lazy as WL-import qualified Control.Monad.Writer.Strict as WS-import qualified Control.Monad.State.Lazy as SL-import Control.Monad.Cont--- import Control.Monad-import Control.Monad.Identity-import Control.Monad.Trans-import Control.Monad.RWS.Class--import Data.Monoid---- | A type suitable for use as a variable in linear programs.-newtype Var = Var Int deriving (Eq, Ord, Enum)--- | A monad capable of generating unique variables. -type VarSource = VarSourceT Identity--- | A monad transformer capable of generating unique variables.  To generate variables while constructing a linear program in the 'LPT' monad, work in the monad @'LPT' 'Var' c 'VarSource'@ or @'LPT' 'Var' c ('VarSourceT' m)@.-newtype VarSourceT m a = VarSourceT {runVarSourceT :: StateT Var m a} deriving (Monad, MonadReader r, MonadWriter w, MonadIO, MonadFix,-	MonadTrans, MonadCont)--evalVarSource :: VarSource a -> a-evalVarSource = runIdentity . evalVarSourceT--evalVarSourceT :: Monad m => VarSourceT m a -> m a-evalVarSourceT m = evalStateT (runVarSourceT m) (Var 0)--instance Show Var where-	show (Var x) = "x_" ++ show x--instance Read Var where-	readsPrec _ ('x':'_':xs) = [(Var x, s') | (x, s') <- readsPrec 0 xs]-	readsPrec _ _ = []--instance MonadState s m => MonadState s (VarSourceT m) where-	put x = VarSourceT (lift (put x))-	get = VarSourceT (lift get)---- instance MonadTrans VarSource where--- 	lift ---- | A type class for monads capable of repeatedly generating unique elements of a specified type.-class Monad m => MonadSource x m | m -> x where-	makeNew :: m x--instance Monad m => MonadSource Var (VarSourceT m) where-	makeNew = VarSourceT $ do	v <- get-					put (succ v)-					return v--instance MonadSource x m => MonadSource x (StateT s m) where-	makeNew = lift makeNew--instance MonadSource x m => MonadSource x (ReaderT r m) where-	makeNew = lift makeNew--instance (MonadSource x m, Monoid w) => MonadSource x (WL.WriterT w m) where-	makeNew = lift makeNew--instance (MonadSource x m, Monoid w) => MonadSource x (WS.WriterT w m) where-	makeNew = lift makeNew--instance MonadSource x m => MonadSource x (ContT r m) where-	makeNew = lift makeNew--instance MonadSource x m => MonadSource x (SL.StateT s m) where-	makeNew = lift makeNew

@@ -1,2 +1,2 @@ Copyright Louis Wasserman 2010-GPL license+BSD license

@@ -1,7 +1,7 @@ Name:           glpk-hs-Version:        0.2.3+Version:        0.2.4 Author:         Louis Wasserman-License:        GPL+License:        BSD3 License-file:   LICENSE Maintainer:     Louis Wasserman <wasserman.louis@gmail.com> Stability:      experimental@@ -17,7 +17,7 @@     of options available.  Category:      Math-+cabal-version: >= 1.4 cabal-version:  >= 1.2 build-type:     Simple @@ -29,14 +29,15 @@                   Data.LinearProgram.GLPK,                   Data.LinearProgram.GLPK.Solver,                   Data.LinearProgram.GLPK.IO,-                  Data.LinearProgram.LPMonad,-                  Data.Algebra+                  Data.Algebra,+                  Control.Monad.LPMonad,+                  Control.Monad.LPMonad.Supply,+                  Control.Monad.LPMonad.Supply.Class Other-modules:    Data.LinearProgram.GLPK.Internal,	                   Data.LinearProgram.GLPK.Types,                   Data.LinearProgram.GLPK.Common,                   Data.LinearProgram.GLPK.IO.Internal,-                  Data.LinearProgram.LPMonad.Internal,-                  Data.LinearProgram.LPMonad.VarSource+                  Control.Monad.LPMonad.Internal,                   Data.LinearProgram.Spec,                   Data.LinearProgram.Types,                   Data.Algebra.Group,

@@ -105,6 +105,7 @@ int c_glp_mip_solve(glp_prob *lp, int msg_lev, int br_tech, int bt_tech, int pp_tech, 		     	int fp_heur, int tm_lim, int cuts, double mip_gap, int presolve){   	glp_iocp iocp;+	glp_mem_limit(750); // 	printf ("%d %d %d time\n", msg_lev, br_tech, tm_lim); 	glp_init_iocp(&iocp); 	iocp.msg_lev = msg_lev;