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

import Prelude hiding (readFile, writeFile)
import Control.Monad (foldM)
import Control.Monad.Except
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Scientific (Scientific)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TLIO
import Numeric.Optimization.MIP (Solution)
import qualified Numeric.Optimization.MIP as MIP

parse :: TL.Text -> MIP.Solution Scientific
parse :: Text -> Solution Scientific
parse Text
t =
  case [Text] -> Either String (Solution Scientific)
parse' ([Text] -> Either String (Solution Scientific))
-> [Text] -> Either String (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
TL.lines Text
t of
    Left String
e -> String -> Solution Scientific
forall a. HasCallStack => String -> a
error String
e
    Right Solution Scientific
x -> Solution Scientific
x

parse' :: [TL.Text] -> Either String (MIP.Solution Scientific)
parse' :: [Text] -> Either String (Solution Scientific)
parse' (Text
t1:Text
t2:[Text]
ts) = do
  Status
status <-
    case Text -> Text -> Maybe Text
TL.stripPrefix Text
"solution status:" Text
t1 of
      Maybe Text
Nothing -> String -> Either String Status
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"first line must start with \"solution status:\""
      Just Text
s -> Status -> Either String Status
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Either String Status) -> Status -> Either String Status
forall a b. (a -> b) -> a -> b
$ Status -> Text -> Map Text Status -> Status
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Status
MIP.StatusUnknown (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.strip Text
s) Map Text Status
statusTable
  if Text
t2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"no solution available" then do
    Solution Scientific -> Either String (Solution Scientific)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Solution Scientific -> Either String (Solution Scientific))
-> Solution Scientific -> Either String (Solution Scientific)
forall a b. (a -> b) -> a -> b
$
      MIP.Solution
      { solStatus :: Status
MIP.solStatus = Status
status
      , solObjectiveValue :: Maybe Scientific
MIP.solObjectiveValue = Maybe Scientific
forall a. Maybe a
Nothing
      , solVariables :: Map Var Scientific
MIP.solVariables = Map Var Scientific
forall k a. Map k a
Map.empty
      }
  else do
    Scientific
obj <-
      case Text -> Text -> Maybe Text
TL.stripPrefix Text
"objective value:" Text
t2 of
        Maybe Text
Nothing -> String -> Either String Scientific
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"second line must start with \"objective value:\""
        Just Text
s -> Scientific -> Either String Scientific
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Either String Scientific)
-> Scientific -> Either String Scientific
forall a b. (a -> b) -> a -> b
$ String -> Scientific
forall a. Read a => String -> a
read (String -> Scientific) -> String -> Scientific
forall a b. (a -> b) -> a -> b
$ Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.strip Text
s
    let f :: [(MIP.Var, Scientific)] -> TL.Text -> Either String [(MIP.Var, Scientific)]
        f :: [(Var, Scientific)] -> Text -> Either String [(Var, Scientific)]
f [(Var, Scientific)]
vs Text
t =
          case Text -> [Text]
TL.words Text
t of
            (Text
w1:Text
w2:[Text]
_) -> [(Var, Scientific)] -> Either String [(Var, Scientific)]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Var, Scientific)] -> Either String [(Var, Scientific)])
-> [(Var, Scientific)] -> Either String [(Var, Scientific)]
forall a b. (a -> b) -> a -> b
$ (Text -> Var
MIP.Var (Text -> Text
TL.toStrict Text
w1), String -> Scientific
forall a. Read a => String -> a
read (Text -> String
TL.unpack Text
w2)) (Var, Scientific) -> [(Var, Scientific)] -> [(Var, Scientific)]
forall a. a -> [a] -> [a]
: [(Var, Scientific)]
vs
            [] -> [(Var, Scientific)] -> Either String [(Var, Scientific)]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Var, Scientific)] -> Either String [(Var, Scientific)])
-> [(Var, Scientific)] -> Either String [(Var, Scientific)]
forall a b. (a -> b) -> a -> b
$ [(Var, Scientific)]
vs
            [Text]
_ -> String -> Either String [(Var, Scientific)]
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Numeric.Optimization.MIP.Solution.SCIP: invalid line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
    [(Var, Scientific)]
vs <- ([(Var, Scientific)] -> Text -> Either String [(Var, Scientific)])
-> [(Var, Scientific)]
-> [Text]
-> Either String [(Var, Scientific)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [(Var, Scientific)] -> Text -> Either String [(Var, Scientific)]
f [] [Text]
ts
    Solution Scientific -> Either String (Solution Scientific)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Solution Scientific -> Either String (Solution Scientific))
-> Solution Scientific -> Either String (Solution Scientific)
forall a b. (a -> b) -> a -> b
$
      MIP.Solution
      { solStatus :: Status
MIP.solStatus = Status
status
      , solObjectiveValue :: Maybe Scientific
MIP.solObjectiveValue = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
obj
      , solVariables :: Map Var Scientific
MIP.solVariables = [(Var, Scientific)] -> Map Var Scientific
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Var, Scientific)]
vs
      }
parse' [Text]
_ = String -> Either String (Solution Scientific)
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"must have >=2 lines"

statusTable :: Map T.Text MIP.Status
statusTable :: Map Text Status
statusTable = [(Text, Status)] -> Map Text Status
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (Text
"user interrupt", Status
MIP.StatusUnknown)
  , (Text
"node limit reached", Status
MIP.StatusUnknown)
  , (Text
"total node limit reached", Status
MIP.StatusUnknown)
  , (Text
"stall node limit reached", Status
MIP.StatusUnknown)
  , (Text
"time limit reached", Status
MIP.StatusUnknown)
  , (Text
"memory limit reached", Status
MIP.StatusUnknown)
  , (Text
"gap limit reached", Status
MIP.StatusUnknown)
  , (Text
"solution limit reached", Status
MIP.StatusUnknown)
  , (Text
"solution improvement limit reached", Status
MIP.StatusUnknown)
  , (Text
"optimal solution found", Status
MIP.StatusOptimal)
  , (Text
"infeasible", Status
MIP.StatusInfeasible)
  , (Text
"unbounded", Status
MIP.StatusUnbounded)
  , (Text
"infeasible or unbounded", Status
MIP.StatusInfeasibleOrUnbounded)
  -- , ("unknown", )
  ]

readFile :: FilePath -> IO (MIP.Solution Scientific)
readFile :: String -> IO (Solution Scientific)
readFile String
fname = Text -> Solution Scientific
parse (Text -> Solution Scientific)
-> IO Text -> IO (Solution Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
TLIO.readFile String
fname