{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Numeric.Optimization.MIP.Solver.CBC
( CBC (..)
, cbc
) where
import Data.Default.Class
import qualified Data.Text.Lazy.IO as TLIO
import System.Exit
import System.IO
import System.IO.Temp
import qualified Numeric.Optimization.MIP.Base as MIP
import qualified Numeric.Optimization.MIP.LPFile as LPFile
import Numeric.Optimization.MIP.Solver.Base
import qualified Numeric.Optimization.MIP.Solution.CBC as CBCSol
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)
data CBC
= CBC
{ CBC -> String
cbcPath :: String
}
instance Default CBC where
def :: CBC
def = CBC
cbc
cbc :: CBC
cbc :: CBC
cbc = String -> CBC
CBC String
"cbc"
instance IsSolver CBC IO where
solve :: CBC
-> SolveOptions -> Problem Scientific -> IO (Solution Scientific)
solve CBC
solver SolveOptions
opt Problem Scientific
prob = do
case FileOptions -> Problem Scientific -> Either String Text
LPFile.render FileOptions
forall a. Default a => a
def Problem Scientific
prob{ objectiveFunction :: ObjectiveFunction Scientific
MIP.objectiveFunction = ObjectiveFunction Scientific
obj' } of
Left String
err -> IOError -> IO (Solution Scientific)
forall a. IOError -> IO a
ioError (IOError -> IO (Solution Scientific))
-> IOError -> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
err
Right Text
lp -> do
String
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"cbc.lp" ((String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific))
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ \String
fname1 Handle
h1 -> do
Handle -> Text -> IO ()
TLIO.hPutStr Handle
h1 Text
lp
Handle -> IO ()
hClose Handle
h1
String
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"cbc.sol" ((String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific))
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ \String
fname2 Handle
h2 -> do
Handle -> IO ()
hClose Handle
h2
let args :: [String]
args = [String
fname1]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (case SolveOptions -> Maybe Double
solveTimeLimit SolveOptions
opt of
Maybe Double
Nothing -> []
Just Double
sec -> [String
"sec", Double -> String
forall a. Show a => a -> String
show Double
sec])
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"solve", String
"solu", String
fname2]
onGetLine :: String -> IO ()
onGetLine = SolveOptions -> String -> IO ()
solveLogger SolveOptions
opt
onGetErrorLine :: String -> IO ()
onGetErrorLine = SolveOptions -> String -> IO ()
solveErrorLogger SolveOptions
opt
ExitCode
exitcode <- String
-> [String]
-> String
-> (String -> IO ())
-> (String -> IO ())
-> IO ExitCode
runProcessWithOutputCallback (CBC -> String
cbcPath CBC
solver) [String]
args String
"" String -> IO ()
onGetLine String -> IO ()
onGetErrorLine
case ExitCode
exitcode of
ExitFailure Int
n -> IOError -> IO (Solution Scientific)
forall a. IOError -> IO a
ioError (IOError -> IO (Solution Scientific))
-> IOError -> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"exit with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
ExitCode
ExitSuccess -> do
Solution Scientific
sol <- String -> IO (Solution Scientific)
CBCSol.readFile String
fname2
if Bool
isMax then
Solution Scientific -> IO (Solution Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Solution Scientific -> IO (Solution Scientific))
-> Solution Scientific -> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ Solution Scientific
sol{ solObjectiveValue :: Maybe Scientific
MIP.solObjectiveValue = (Scientific -> Scientific) -> Maybe Scientific -> Maybe Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scientific -> Scientific
forall a. Num a => a -> a
negate (Solution Scientific -> Maybe Scientific
forall r. Solution r -> Maybe r
MIP.solObjectiveValue Solution Scientific
sol) }
else
Solution Scientific -> IO (Solution Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Solution Scientific
sol
where
obj :: ObjectiveFunction Scientific
obj = Problem Scientific -> ObjectiveFunction Scientific
forall c. Problem c -> ObjectiveFunction c
MIP.objectiveFunction Problem Scientific
prob
isMax :: Bool
isMax = ObjectiveFunction Scientific -> OptDir
forall c. ObjectiveFunction c -> OptDir
MIP.objDir ObjectiveFunction Scientific
obj OptDir -> OptDir -> Bool
forall a. Eq a => a -> a -> Bool
== OptDir
MIP.OptMax
obj' :: ObjectiveFunction Scientific
obj' = if Bool
isMax then ObjectiveFunction Scientific
obj{ objDir :: OptDir
MIP.objDir = OptDir
MIP.OptMin, objExpr :: Expr Scientific
MIP.objExpr = - ObjectiveFunction Scientific -> Expr Scientific
forall c. ObjectiveFunction c -> Expr c
MIP.objExpr ObjectiveFunction Scientific
obj } else ObjectiveFunction Scientific
obj