{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Solver.Glpsol
-- Copyright   :  (c) Masahiro Sakai 2017
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Solver.Glpsol
  ( Glpsol (..)
  , glpsol
  ) where

import Algebra.PartialOrd
import Data.Default.Class
import Data.IORef
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.GLPK as GLPKSol
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)

data Glpsol
  = Glpsol
  { Glpsol -> String
glpsolPath :: String
  }

instance Default Glpsol where
  def :: Glpsol
def = Glpsol
glpsol

glpsol :: Glpsol
glpsol :: Glpsol
glpsol = String -> Glpsol
Glpsol String
"glpsol"

instance IsSolver Glpsol IO where
  solve :: Glpsol
-> SolveOptions -> Problem Scientific -> IO (Solution Scientific)
solve Glpsol
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 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
"glpsol.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
"glpsol.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
            IORef Bool
isUnboundedRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
            IORef Bool
isInfeasibleRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
            let args :: [String]
args = [String
"--lp", String
fname1, String
"-o", String
fname2] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                       (case SolveOptions -> Maybe Double
solveTimeLimit SolveOptions
opt of
                          Maybe Double
Nothing -> []
                          Just Double
sec -> [String
"--tmlim", Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
sec) :: Int)])
                onGetLine :: String -> IO ()
onGetLine String
s = do
                  case String
s of
                    String
"LP HAS UNBOUNDED PRIMAL SOLUTION" ->
                      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isUnboundedRef Bool
True
                    String
"PROBLEM HAS UNBOUNDED SOLUTION" ->
                      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isUnboundedRef Bool
True
                    String
"PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION" ->
                      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isInfeasibleRef Bool
True
                    String
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  SolveOptions -> String -> IO ()
solveLogger SolveOptions
opt String
s
                onGetErrorLine :: String -> IO ()
onGetErrorLine = SolveOptions -> String -> IO ()
solveErrorLogger SolveOptions
opt
            ExitCode
exitcode <- String
-> [String]
-> String
-> (String -> IO ())
-> (String -> IO ())
-> IO ExitCode
runProcessWithOutputCallback (Glpsol -> String
glpsolPath Glpsol
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)
GLPKSol.readFile String
fname2
                Bool
isUnbounded <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
isUnboundedRef
                Bool
isInfeasible <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
isInfeasibleRef
                if Bool
isUnbounded Bool -> Bool -> Bool
&& Solution Scientific -> Status
forall r. Solution r -> Status
MIP.solStatus Solution Scientific
sol Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
MIP.StatusInfeasibleOrUnbounded 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{ solStatus :: Status
MIP.solStatus = Status
MIP.StatusInfeasibleOrUnbounded }
                else if Bool
isInfeasible Bool -> Bool -> Bool
&& Solution Scientific -> Status
forall r. Solution r -> Status
MIP.solStatus Solution Scientific
sol Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
MIP.StatusInfeasible 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{ solStatus :: Status
MIP.solStatus = Status
MIP.StatusInfeasible }
                else
                  Solution Scientific -> IO (Solution Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Solution Scientific
sol