aboutsummaryrefslogtreecommitdiff
path: root/Math
diff options
context:
space:
mode:
authorJustin Bedo <cu@cua0.org>2014-10-24 20:00:05 +1100
committerJustin Bedo <cu@cua0.org>2014-10-24 20:00:05 +1100
commite60c072870ee428720dce1f22890f1ce075325e4 (patch)
tree9014102c3c300d24006f1add4757fe9c0dc26ed2 /Math
parentac50e991e7b0c2c00d9ac169a5ddcb06821df172 (diff)
Added timout option for lp_solve
Diffstat (limited to 'Math')
-rw-r--r--Math/LinProg/LPSolve.hs20
-rw-r--r--Math/LinProg/LPSolve/FFI.hs5
2 files changed, 17 insertions, 8 deletions
diff --git a/Math/LinProg/LPSolve.hs b/Math/LinProg/LPSolve.hs
index beff157..2031e0a 100644
--- a/Math/LinProg/LPSolve.hs
+++ b/Math/LinProg/LPSolve.hs
@@ -14,6 +14,7 @@ maximise instead.
-}
module Math.LinProg.LPSolve (
solve
+ ,solveWithTimeout
,ResultCode(..)
) where
@@ -29,12 +30,17 @@ import qualified Data.Map as M
import Prelude hiding (EQ)
-- | Solves an LP using lp_solve.
-solve :: (Eq v, Ord v) => LinProg Double v () -> IO (Either (Maybe ResultCode) [(v, Double)])
-solve (compile -> lp) = do
+solve :: (Eq v, Ord v) => LinProg Double v () -> IO (Maybe ResultCode, [(v, Double)])
+solve = solveWithTimeout 0
+
+-- | Solves an LP using lp_solve.
+solveWithTimeout :: (Eq v, Ord v) => Integer -> LinProg Double v () -> IO (Maybe ResultCode, [(v, Double)])
+solveWithTimeout t (compile -> lp) = do
model <- makeLP nconstr nvars
case model of
- Nothing -> return (Left Nothing)
+ Nothing -> return (Nothing, [])
Just m' -> with m' $ \m -> do
+ setTimeout m t
-- Eqs
forM_ (zip [1..] $ lp ^. equals) $ \(i, eq) ->
@@ -64,11 +70,9 @@ solve (compile -> lp) = do
when (w /= 0) $ void $ setMat m 0 (varLUT M.! v) w
res <- F.solve m
- case res of
- Optimal -> do
- sol <- snd <$> getSol nvars m
- return $ Right (zip (M.keys varLUT) sol)
- _ -> return $ Left (Just res)
+ sol <- snd <$> getSol nvars m
+ let vars = zip (M.keys varLUT) sol
+ return (Just res, vars)
where
nconstr = length allConstr
nvars = M.size varLUT
diff --git a/Math/LinProg/LPSolve/FFI.hs b/Math/LinProg/LPSolve/FFI.hs
index 45b0a30..ddc7798 100644
--- a/Math/LinProg/LPSolve/FFI.hs
+++ b/Math/LinProg/LPSolve/FFI.hs
@@ -4,6 +4,7 @@ module Math.LinProg.LPSolve.FFI (
,ConstraintType(..)
,LPRec
,setConstrType
+ ,setTimeout
,makeLP
,freeLP
,setMat
@@ -50,6 +51,10 @@ foreign import ccall "set_rh" c_set_rh :: LPRec -> CInt -> CDouble -> IO CChar
foreign import ccall "solve" c_solve :: LPRec -> IO CInt
foreign import ccall "get_variables" c_get_variables :: LPRec -> Ptr CDouble -> IO CChar
foreign import ccall "set_constr_type" c_set_constr_type :: LPRec -> CInt -> CInt -> IO CChar
+foreign import ccall "set_timeout" c_set_timeout :: LPRec -> CLong -> IO ()
+
+setTimeout :: LPRec -> Integer -> IO ()
+setTimeout lp x = c_set_timeout lp (fromIntegral x)
setConstrType :: LPRec -> Int -> ConstraintType -> IO Word8
setConstrType lp i t = fromIntegral <$> c_set_constr_type lp (fromIntegral i) (fromIntegral $ fromEnum t)