module ToySolver.Data.MIP.Solver.LPSolve
( LPSolve (..)
, lpSolve
) where
import Control.Monad
import Data.Default.Class
import Data.IORef
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Data.String
import qualified Data.Text.Lazy.IO as TLIO
import System.Exit
import System.IO
import System.IO.Temp
import qualified ToySolver.Data.MIP.Base as MIP
import qualified ToySolver.Data.MIP.MPSFile as MPSFile
import ToySolver.Data.MIP.Solver.Base
import ToySolver.Internal.ProcessUtil (runProcessWithOutputCallback)
data LPSolve
= LPSolve
{ lpSolvePath :: String
}
instance Default LPSolve where
def = lpSolve
lpSolve :: LPSolve
lpSolve = LPSolve "lp_solve"
instance IsSolver LPSolve IO where
solve solver opt prob = do
case MPSFile.render def prob of
Left err -> ioError $ userError err
Right lp -> do
withSystemTempFile "lp_solve.mps" $ \fname1 h1 -> do
TLIO.hPutStr h1 lp
hClose h1
objRef <- newIORef Nothing
solRef <- newIORef []
flagRef <- newIORef False
let args = (case solveTimeLimit opt of
Nothing -> []
Just sec -> ["-timeout", show sec])
++ ["-fmps", fname1]
onGetLine s = do
case s of
"Actual values of the variables:" -> writeIORef flagRef True
_ | Just v <- stripPrefix "Value of objective function: " s -> do
writeIORef objRef (Just (read v))
_ -> do
flag <- readIORef flagRef
when flag $ do
case words s of
[var,val] -> modifyIORef solRef ((fromString var, read val) :)
_ -> return ()
return ()
solveLogger opt s
onGetErrorLine = solveErrorLogger opt
exitcode <- runProcessWithOutputCallback (lpSolvePath solver) args "" onGetLine onGetErrorLine
status <-
case exitcode of
ExitSuccess -> return MIP.StatusOptimal
ExitFailure (2) -> return MIP.StatusUnknown
ExitFailure 1 -> return MIP.StatusFeasible
ExitFailure 2 -> return MIP.StatusInfeasible
ExitFailure 3 -> return MIP.StatusInfeasibleOrUnbounded
ExitFailure 4 -> return MIP.StatusUnknown
ExitFailure 5 -> return MIP.StatusUnknown
ExitFailure 6 -> return MIP.StatusUnknown
ExitFailure 7 -> return MIP.StatusUnknown
ExitFailure 9 -> return MIP.StatusOptimal
ExitFailure 25 -> return MIP.StatusUnknown
ExitFailure n -> ioError $ userError $ "unknown exit code: " ++ show n
obj <- readIORef objRef
sol <- readIORef solRef
return $
MIP.Solution
{ MIP.solStatus = status
, MIP.solObjectiveValue = obj
, MIP.solVariables = Map.fromList sol
}