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

import Prelude hiding (readFile, writeFile)
import Data.Default.Class
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
import qualified Data.Map as Map
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 -> Text
MIP.varName 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 :: [Char] -> Solution Scientific -> IO ()
writeFile [Char]
fname Solution Scientific
sol = do
  [Char] -> Text -> IO ()
TLIO.writeFile [Char]
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 b a. (b -> a -> b) -> b -> [a] -> b
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{ MIP.solStatus = MIP.StatusFeasible
         , MIP.solObjectiveValue = obj
         , MIP.solVariables = Map.fromList 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 -> [Char]
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, (Text -> Var
MIP.Var (Text -> Text
TL.toStrict Text
w1), [Char] -> Scientific
forall a. Read a => [Char] -> a
read (Text -> [Char]
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]
_ -> [Char] -> (Maybe Scientific, [(Var, Scientific)])
forall a. HasCallStack => [Char] -> a
error ([Char]
"Numeric.Optimization.MIP.Solution.Gurobi: invalid line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
l)

readFile :: FilePath -> IO (MIP.Solution Scientific)
readFile :: [Char] -> IO (Solution Scientific)
readFile [Char]
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
<$> [Char] -> IO Text
TLIO.readFile [Char]
fname