{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Numeric.Optimization.MIP.Solution.Gurobi
( Solution (..)
, render
, writeFile
, parse
, readFile
) where
import Prelude hiding (readFile, writeFile)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Default.Class
import Data.Interned (intern, unintern)
import Data.List (foldl')
import qualified Data.Map as Map
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
import Data.Scientific (Scientific)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Scientific as B
import qualified Data.Text.Lazy.IO as TLIO
import Numeric.Optimization.MIP (Solution)
import qualified Numeric.Optimization.MIP as MIP
render :: MIP.Solution Scientific -> TL.Text
render :: Solution Scientific -> Text
render Solution Scientific
sol = Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
ls1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
ls2
where
ls1 :: Builder
ls1 = case Solution Scientific -> Maybe Scientific
forall r. Solution r -> Maybe r
MIP.solObjectiveValue Solution Scientific
sol of
Maybe Scientific
Nothing -> Builder
forall a. Monoid a => a
mempty
Just Scientific
val -> Builder
"# Objective value = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Scientific -> Builder
B.scientificBuilder Scientific
val Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton Char
'\n'
ls2 :: [Builder]
ls2 = [ Text -> Builder
B.fromText (Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
name) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Scientific -> Builder
B.scientificBuilder Scientific
val Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton Char
'\n'
| (Var
name,Scientific
val) <- Map Var Scientific -> [(Var, Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList (Solution Scientific -> Map Var Scientific
forall r. Solution r -> Map Var r
MIP.solVariables Solution Scientific
sol)
]
writeFile :: FilePath -> MIP.Solution Scientific -> IO ()
writeFile :: FilePath -> Solution Scientific -> IO ()
writeFile FilePath
fname Solution Scientific
sol = do
FilePath -> Text -> IO ()
TLIO.writeFile FilePath
fname (Solution Scientific -> Text
render Solution Scientific
sol)
parse :: TL.Text -> MIP.Solution Scientific
parse :: Text -> Solution Scientific
parse Text
t =
case ((Maybe Scientific, [(Var, Scientific)])
-> Text -> (Maybe Scientific, [(Var, Scientific)]))
-> (Maybe Scientific, [(Var, Scientific)])
-> [Text]
-> (Maybe Scientific, [(Var, Scientific)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Maybe Scientific, [(Var, Scientific)])
-> Text -> (Maybe Scientific, [(Var, Scientific)])
f (Maybe Scientific
forall a. Maybe a
Nothing,[]) ([Text] -> (Maybe Scientific, [(Var, Scientific)]))
-> [Text] -> (Maybe Scientific, [(Var, Scientific)])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
TL.lines Text
t of
(Maybe Scientific
obj, [(Var, Scientific)]
vs) ->
Solution Any
forall a. Default a => a
def{ solStatus :: Status
MIP.solStatus = Status
MIP.StatusFeasible
, solObjectiveValue :: Maybe Scientific
MIP.solObjectiveValue = Maybe 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
}
where
f :: (Maybe Scientific, [(MIP.Var, Scientific)]) -> TL.Text -> (Maybe Scientific, [(MIP.Var, Scientific)])
f :: (Maybe Scientific, [(Var, Scientific)])
-> Text -> (Maybe Scientific, [(Var, Scientific)])
f (Maybe Scientific
obj,[(Var, Scientific)]
vs) Text
l
| Just Text
l2 <- Text -> Text -> Maybe Text
TL.stripPrefix Text
"# " Text
l
, Just Text
l3 <- Text -> Text -> Maybe Text
TL.stripPrefix Text
"objective value = " (Text -> Text
TL.toLower Text
l2)
, (Scientific
r:[Scientific]
_) <- [Scientific
r | (Scientific
r,[]) <- ReadS Scientific
forall a. Read a => ReadS a
reads (Text -> FilePath
TL.unpack Text
l3)] =
(Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
r, [(Var, Scientific)]
vs)
| Bool
otherwise =
case Text -> [Text]
TL.words ((Char -> Bool) -> Text -> Text
TL.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') Text
l) of
[Text
w1, Text
w2] -> (Maybe Scientific
obj, (Uninterned Var -> Var
forall t. Interned t => Uninterned t -> t
intern (Text -> Text
TL.toStrict Text
w1), FilePath -> Scientific
forall a. Read a => FilePath -> a
read (Text -> FilePath
TL.unpack Text
w2)) (Var, Scientific) -> [(Var, Scientific)] -> [(Var, Scientific)]
forall a. a -> [a] -> [a]
: [(Var, Scientific)]
vs)
[] -> (Maybe Scientific
obj, [(Var, Scientific)]
vs)
[Text]
_ -> FilePath -> (Maybe Scientific, [(Var, Scientific)])
forall a. HasCallStack => FilePath -> a
error (FilePath
"Numeric.Optimization.MIP.Solution.Gurobi: invalid line " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
l)
readFile :: FilePath -> IO (MIP.Solution Scientific)
readFile :: FilePath -> IO (Solution Scientific)
readFile FilePath
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
<$> FilePath -> IO Text
TLIO.readFile FilePath
fname