glpk-hs 0.0.1 → 0.0.2

raw patch · 3 files changed

+63/−49 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/LinearProgram/GLPK.hs +48/−43
• Data/LinearProgram/GLPK/Internal.hs +14/−5
• glpk-hs.cabal +1/−1

@@ -1,10 +1,11 @@ {-# OPTIONS -funbox-strict-fields #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections, RecordWildCards #-}  module Data.LinearProgram.GLPK (GLPOpts(..), MsgLev(..), BranchingTechnique(..),-	BacktrackTechnique(..), Preprocessing(..), Cuts(..), +	BacktrackTechnique(..), Preprocessing(..), Cuts(..), ReturnCode(..),  	simplexDefaults, mipDefaults, glpSolveVars, glpSolveAll) where +import Control.Monad import Control.Monad.Trans  -- import Debug.Trace@@ -36,58 +37,62 @@  -- | Solves the linear or mixed integer programming problem.  Returns -- the value of the objective function, and the values of the variables.-glpSolveVars :: (Ord v, Show v, Real c) => GLPOpts -> LP v c -> IO (Double, Map v Double)+glpSolveVars :: (Ord v, Show v, Real c) => GLPOpts -> LP v c -> IO (ReturnCode, Maybe (Double, Map v Double)) glpSolveVars opts@SimplexOpts{} lp = runGLPK $ do-	Just vars <- doGLP opts lp-	obj <- getObjVal-	vals <- sequence [do-		val <- getColPrim i-		return (v, val)-			| (v, i) <- assocs vars]-	return (obj, fromDistinctAscList vals)+	(code, vars) <- doGLP opts lp+	liftM (code, ) $ maybe (return Nothing) ( \ vars -> do+		obj <- getObjVal+		vals <- sequence [do+			val <- getColPrim i+			return (v, val)+				| (v, i) <- assocs vars]+		return (Just (obj, fromDistinctAscList vals))) vars glpSolveVars opts@MipOpts{} lp = runGLPK $ do-	Just vars <- doGLP opts lp-	obj <- mipObjVal-	vals <- sequence [do-		val <- mipColVal i-		return (v, val)-			| (v, i) <- assocs vars]-	return (obj, fromDistinctAscList vals)+	(code, vars) <- doGLP opts lp+	liftM (code, ) $ maybe (return Nothing) (\ vars -> do+		obj <- mipObjVal+		vals <- sequence [do+			val <- mipColVal i+			return (v, val)+				| (v, i) <- assocs vars]+		return (Just (obj, fromDistinctAscList vals))) vars  -- | Solves the linear or mixed integer programming problem.  Returns -- the value of the objective function, the values of the variables, -- and the values of any labeled rows.-glpSolveAll :: (Ord v, Show v, Real c) => GLPOpts -> LP v c -> IO (Double, Map v Double, Map String Double)+glpSolveAll :: (Ord v, Show v, Real c) => GLPOpts -> LP v c -> IO (ReturnCode, Maybe (Double, Map v Double, Map String Double)) glpSolveAll opts@SimplexOpts{} lp@LP{..} = runGLPK $ do-	Just vars <- doGLP opts lp-	obj <- getObjVal-	vals <- sequence [do-		val <- getColPrim i-		return (v, val)-			| (v, i) <- assocs vars]-	rows <- sequence [maybe (return Nothing) (\ nam -> do-				val <- getRowPrim i-				return (Just (nam, val))) nam-				| (i, Constr nam _ _) <- zip [0..] constraints]-	return (obj, fromDistinctAscList vals, fromDistinctAscList (catMaybes rows))+	(code, vars) <- doGLP opts lp+	liftM (code, ) $ maybe (return Nothing) (\ vars -> do+		obj <- getObjVal+		vals <- sequence [do+			val <- getColPrim i+			return (v, val)+				| (v, i) <- assocs vars]+		rows <- sequence [maybe (return Nothing) (\ nam -> do+					val <- getRowPrim i+					return (Just (nam, val))) nam+					| (i, Constr nam _ _) <- zip [0..] constraints]+		return (Just (obj, fromDistinctAscList vals, fromDistinctAscList (catMaybes rows)))) vars glpSolveAll opts@MipOpts{} lp@LP{..} = runGLPK $ do-	Just vars <- doGLP opts lp-	obj <- mipObjVal-	vals <- sequence [do-		val <- mipColVal i-		return (v, val)-			| (v, i) <- assocs vars]-	rows <- sequence [maybe (return Nothing) (\ nam -> do-				val <- mipRowVal i-				return (Just (nam, val))) nam-				| (i, Constr nam _ _) <- zip [0..] constraints]-	return (obj, fromDistinctAscList vals, fromDistinctAscList (catMaybes rows))+	(code, vars) <- doGLP opts lp+	liftM (code, ) $ maybe (return Nothing) (\ vars -> do+		obj <- mipObjVal+		vals <- sequence [do+			val <- mipColVal i+			return (v, val)+				| (v, i) <- assocs vars]+		rows <- sequence [maybe (return Nothing) (\ nam -> do+					val <- mipRowVal i+					return (Just (nam, val))) nam+					| (i, Constr nam _ _) <- zip [0..] constraints]+		return (Just (obj, fromDistinctAscList vals, fromDistinctAscList (catMaybes rows)))) vars -doGLP :: (Ord v, Show v, Real c) => GLPOpts -> LP v c -> GLPK (Maybe (Map v Int))+doGLP :: (Ord v, Show v, Real c) => GLPOpts -> LP v c -> GLPK (ReturnCode, Maybe (Map v Int)) doGLP SimplexOpts{..} lp = do 	vars <- writeProblem lp 	success <- solveSimplex msgLev tmLim presolve-	return (Just vars)+	return (success, guard (gaveAnswer success) >> Just vars) doGLP MipOpts{..} lp = do 	vars <- writeProblem lp -- 	time <- getTime@@ -95,7 +100,7 @@ -- 	time' <- getTime 	let tmLim' = tmLim  --- round (toRational (time' `diffUTCTime` time)) 	success <- mipSolve msgLev brTech btTech ppTech fpHeur cuts mipGap (fromIntegral tmLim') presolve-	return (Just vars) --(if success then Just vars else Nothing)+	return (success, guard (gaveAnswer success) >> Just vars) --(if success then Just vars else Nothing) -- 	where	getTime = liftIO getCurrentTime  writeProblem :: (Ord v, Show v, Real c) => LP v c -> GLPK (Map v Int)

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, EmptyDataDecls, ForeignFunctionInterface #-} module Data.LinearProgram.GLPK.Internal (GLPK, MsgLev (..), Preprocessing (..), Direction(..), BacktrackTechnique(..),-	BranchingTechnique(..), Cuts(..), runGLPK, writeLP, addCols,+	BranchingTechnique(..), Cuts(..), ReturnCode(..), gaveAnswer, runGLPK, writeLP, addCols, 	addRows, createIndex, findCol, findRow, getColPrim, getRowPrim, getObjVal, 	mipColVal, mipRowVal, mipObjVal, mipSolve, setColBounds, setColKind, setColName, setMatRow, 	setObjCoef, setObjectiveDirection, setRowBounds, setRowName, solveSimplex) where@@ -21,6 +21,15 @@  data GlpProb +data ReturnCode = Success | InvalidBasis | SingularMatrix | IllConditionedMatrix | +	InvalidBounds | SolverFailed | ObjLowerLimReached | ObjUpperLimReached | +	IterLimReached | TimeLimReached | NoPrimalFeasible | NoDualFeasible | RootLPOptMissing |+	SearchTerminated | MipGapTolReached | NoPrimDualFeasSolution | NoConvergence |+	NumericalInstability | InvalidData | ResultOutOfRange deriving (Eq, Show, Enum)++gaveAnswer :: ReturnCode -> Bool+gaveAnswer = flip elem [Success, IterLimReached, TimeLimReached, SearchTerminated, MipGapTolReached]+ foreign import ccall unsafe "c_glp_create_prob" glpCreateProb :: IO (Ptr GlpProb) -- foreign import ccall "c_glp_set_obj_name" glpSetObjName :: Ptr GlpProb -> CString -> IO () foreign import ccall unsafe "c_glp_set_obj_dir" glpSetObjDir :: Ptr GlpProb -> CInt -> IO ()@@ -120,8 +129,8 @@  data MsgLev = MsgOff | MsgErr | MsgOn | MsgAll -solveSimplex :: MsgLev -> Int -> Bool -> GLPK Bool-solveSimplex msglev tmLim presolve = GLP $ \ lp -> liftM (== 0) $ glpSolveSimplex lp+solveSimplex :: MsgLev -> Int -> Bool -> GLPK ReturnCode+solveSimplex msglev tmLim presolve = GLP $ \ lp -> liftM (toEnum . fromIntegral) $ glpSolveSimplex lp 	(getMsgLev msglev) 	tmLim' 	(if presolve then 1 else 0)@@ -155,9 +164,9 @@ data Cuts = GMI | MIR | Cov | Clq deriving (Eq)  mipSolve :: MsgLev -> BranchingTechnique -> BacktrackTechnique -> Preprocessing -> Bool ->-	[Cuts] -> Double -> Int -> Bool -> GLPK Bool+	[Cuts] -> Double -> Int -> Bool -> GLPK ReturnCode mipSolve msglev brt btt pp fp cuts mipgap tmlim presol =-		liftM (== 0) $ GLP $ \ lp -> glpMipSolve lp msglev'+		liftM (toEnum . fromIntegral) $ GLP $ \ lp -> glpMipSolve lp msglev' 						brt' btt' pp' fp' tmlim' cuts' mipgap' presol' 	where	!msglev' = getMsgLev msglev 		!brt' = case brt of

@@ -1,5 +1,5 @@ Name:           glpk-hs-Version:        0.0.1+Version:        0.0.2 Author:         Louis Wasserman License:        GPL License-file:   LICENSE