{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Solution.CBC
-- Copyright   :  (c) Masahiro Sakai 2017
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Solution.CBC
  ( 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
l1:[Text]
ls) = do
  (Status
status, Scientific
obj) <-
    case (Char -> Bool) -> Text -> (Text, Text)
TL.break (Char
'-'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l1 of
      (Text
s1,Text
s2) ->
        case Text -> Text -> Maybe Text
TL.stripPrefix Text
"- objective value " Text
s2 of
          Maybe Text
Nothing -> String -> Either String (Status, Scientific)
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"fail to parse header"
          Just Text
s3 -> do
            let s1' :: Text
s1' = Text -> Text
TL.toStrict (Text -> Text
TL.strip Text
s1)
            (Status, Scientific) -> Either String (Status, Scientific)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return
              ( case Text -> Map Text Status -> Maybe Status
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
s1' Map Text Status
statusTable of
                  Just Status
st -> Status
st
                  Maybe Status
Nothing ->
                    if Text -> Text -> Bool
T.isPrefixOf Text
"Stopped on " Text
s1'
                    then Status
MIP.StatusUnknown
                    else Status
MIP.StatusUnknown
              , String -> Scientific
forall a. Read a => String -> a
read (Text -> String
TL.unpack Text
s3)
              )
  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
"**":Text
_no:Text
var:Text
val:[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
var), String -> Scientific
forall a. Read a => String -> a
read (Text -> String
TL.unpack Text
val)) (Var, Scientific) -> [(Var, Scientific)] -> [(Var, Scientific)]
forall a. a -> [a] -> [a]
: [(Var, Scientific)]
vs
          (Text
_no:Text
var:Text
val:[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
var), String -> Scientific
forall a. Read a => String -> a
read (Text -> String
TL.unpack Text
val)) (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.CBC: 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]
ls
  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 >=1 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
"Optimal", Status
MIP.StatusOptimal)
  , (Text
"Unbounded", Status
MIP.StatusInfeasibleOrUnbounded)
  , (Text
"Integer infeasible", Status
MIP.StatusInfeasible)
  , (Text
"Infeasible", Status
MIP.StatusInfeasible)
  ]

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