From e60c072870ee428720dce1f22890f1ce075325e4 Mon Sep 17 00:00:00 2001
From: Justin Bedo <cu@cua0.org>
Date: Fri, 24 Oct 2014 20:00:05 +1100
Subject: Added timout option for lp_solve

---
 Math/LinProg/LPSolve.hs     | 20 ++++++++++++--------
 Math/LinProg/LPSolve/FFI.hs |  5 +++++
 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)
-- 
cgit v1.2.3