{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.MPSFile
-- Copyright   :  (c) Masahiro Sakai 2012-2014
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- A @.mps@ format parser library.
--
-- References:
--
-- * <http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_synopsis.html>
--
-- * <http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_synopsis.html>
--
-- * <http://www.gurobi.com/documentation/5.0/reference-manual/node744>
--
-- * <http://en.wikipedia.org/wiki/MPS_(format)>
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.MPSFile
  ( parseString
  , parseFile
  , ParseError
  , parser
  , render
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*))
#endif
import Control.Exception (throwIO)
import Control.Monad
import Control.Monad.Writer
import Data.Default.Class
import Data.Maybe
#if !MIN_VERSION_base(4,9,0)
import Data.Monoid
#endif
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Scientific
import Data.Interned
import Data.Interned.Text
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.IO as TLIO
import System.IO
#if MIN_VERSION_megaparsec(6,0,0)
import Text.Megaparsec hiding  (ParseError)
import Text.Megaparsec.Char hiding (string', newline)
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as Lexer
#else
import qualified Text.Megaparsec as P
import Text.Megaparsec hiding (string', newline, ParseError)
import qualified Text.Megaparsec.Lexer as Lexer
import Text.Megaparsec.Prim (MonadParsec ())
#endif

import Data.OptDir
import qualified Numeric.Optimization.MIP.Base as MIP
import Numeric.Optimization.MIP.FileUtils (ParseError)

type Column = MIP.Var
type Row = InternedText

data BoundType
  = LO  -- lower bound
  | UP  -- upper bound
  | FX  -- variable is fixed at the specified value
  | FR  -- free variable (no lower or upper bound)
  | MI  -- infinite lower bound
  | PL  -- infinite upper bound
  | BV  -- variable is binary (equal 0 or 1)
  | LI  -- lower bound for integer variable
  | UI  -- upper bound for integer variable
  | SC  -- upper bound for semi-continuous variable
  | SI  -- upper bound for semi-integer variable
  deriving (BoundType -> BoundType -> Bool
(BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool) -> Eq BoundType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundType -> BoundType -> Bool
== :: BoundType -> BoundType -> Bool
$c/= :: BoundType -> BoundType -> Bool
/= :: BoundType -> BoundType -> Bool
Eq, Eq BoundType
Eq BoundType =>
(BoundType -> BoundType -> Ordering)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> BoundType)
-> (BoundType -> BoundType -> BoundType)
-> Ord BoundType
BoundType -> BoundType -> Bool
BoundType -> BoundType -> Ordering
BoundType -> BoundType -> BoundType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BoundType -> BoundType -> Ordering
compare :: BoundType -> BoundType -> Ordering
$c< :: BoundType -> BoundType -> Bool
< :: BoundType -> BoundType -> Bool
$c<= :: BoundType -> BoundType -> Bool
<= :: BoundType -> BoundType -> Bool
$c> :: BoundType -> BoundType -> Bool
> :: BoundType -> BoundType -> Bool
$c>= :: BoundType -> BoundType -> Bool
>= :: BoundType -> BoundType -> Bool
$cmax :: BoundType -> BoundType -> BoundType
max :: BoundType -> BoundType -> BoundType
$cmin :: BoundType -> BoundType -> BoundType
min :: BoundType -> BoundType -> BoundType
Ord, Int -> BoundType -> ShowS
[BoundType] -> ShowS
BoundType -> String
(Int -> BoundType -> ShowS)
-> (BoundType -> String)
-> ([BoundType] -> ShowS)
-> Show BoundType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundType -> ShowS
showsPrec :: Int -> BoundType -> ShowS
$cshow :: BoundType -> String
show :: BoundType -> String
$cshowList :: [BoundType] -> ShowS
showList :: [BoundType] -> ShowS
Show, ReadPrec [BoundType]
ReadPrec BoundType
Int -> ReadS BoundType
ReadS [BoundType]
(Int -> ReadS BoundType)
-> ReadS [BoundType]
-> ReadPrec BoundType
-> ReadPrec [BoundType]
-> Read BoundType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BoundType
readsPrec :: Int -> ReadS BoundType
$creadList :: ReadS [BoundType]
readList :: ReadS [BoundType]
$creadPrec :: ReadPrec BoundType
readPrec :: ReadPrec BoundType
$creadListPrec :: ReadPrec [BoundType]
readListPrec :: ReadPrec [BoundType]
Read, Int -> BoundType
BoundType -> Int
BoundType -> [BoundType]
BoundType -> BoundType
BoundType -> BoundType -> [BoundType]
BoundType -> BoundType -> BoundType -> [BoundType]
(BoundType -> BoundType)
-> (BoundType -> BoundType)
-> (Int -> BoundType)
-> (BoundType -> Int)
-> (BoundType -> [BoundType])
-> (BoundType -> BoundType -> [BoundType])
-> (BoundType -> BoundType -> [BoundType])
-> (BoundType -> BoundType -> BoundType -> [BoundType])
-> Enum BoundType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BoundType -> BoundType
succ :: BoundType -> BoundType
$cpred :: BoundType -> BoundType
pred :: BoundType -> BoundType
$ctoEnum :: Int -> BoundType
toEnum :: Int -> BoundType
$cfromEnum :: BoundType -> Int
fromEnum :: BoundType -> Int
$cenumFrom :: BoundType -> [BoundType]
enumFrom :: BoundType -> [BoundType]
$cenumFromThen :: BoundType -> BoundType -> [BoundType]
enumFromThen :: BoundType -> BoundType -> [BoundType]
$cenumFromTo :: BoundType -> BoundType -> [BoundType]
enumFromTo :: BoundType -> BoundType -> [BoundType]
$cenumFromThenTo :: BoundType -> BoundType -> BoundType -> [BoundType]
enumFromThenTo :: BoundType -> BoundType -> BoundType -> [BoundType]
Enum, BoundType
BoundType -> BoundType -> Bounded BoundType
forall a. a -> a -> Bounded a
$cminBound :: BoundType
minBound :: BoundType
$cmaxBound :: BoundType
maxBound :: BoundType
Bounded)

-- ---------------------------------------------------------------------------

#if MIN_VERSION_megaparsec(6,0,0)
type C e s m = (MonadParsec e s m, Token s ~ Char, IsString (Tokens s))
#else
type C e s m = (MonadParsec e s m, Token s ~ Char)
#endif

-- | Parse a string containing MPS file data.
-- The source name is only used in error messages and may be the empty string.
#if MIN_VERSION_megaparsec(6,0,0)
parseString :: (Stream s, Token s ~ Char, IsString (Tokens s)) => MIP.FileOptions -> String -> s -> Either (ParseError s) (MIP.Problem Scientific)
#else
parseString :: (Stream s, Token s ~ Char) => MIP.FileOptions -> String -> s -> Either (ParseError s) (MIP.Problem Scientific)
#endif
parseString :: forall s.
(Stream s, Token s ~ Char, IsString (Tokens s)) =>
FileOptions
-> String -> s -> Either (ParseError s) (Problem Scientific)
parseString FileOptions
_ = Parsec Void s (Problem Scientific)
-> String
-> s
-> Either (ParseErrorBundle s Void) (Problem Scientific)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void s (Problem Scientific)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) =>
m (Problem Scientific)
parser Parsec Void s (Problem Scientific)
-> ParsecT Void s Identity () -> Parsec Void s (Problem Scientific)
forall a b.
ParsecT Void s Identity a
-> ParsecT Void s Identity b -> ParsecT Void s Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void s Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

-- | Parse a file containing MPS file data.
parseFile :: MIP.FileOptions -> FilePath -> IO (MIP.Problem Scientific)
parseFile :: FileOptions -> String -> IO (Problem Scientific)
parseFile FileOptions
opt String
fname = do
  Handle
h <- String -> IOMode -> IO Handle
openFile String
fname IOMode
ReadMode
  case FileOptions -> Maybe TextEncoding
MIP.optFileEncoding FileOptions
opt of
    Maybe TextEncoding
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just TextEncoding
enc -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc
  Either (ParseError Text) (Problem Scientific)
ret <- Parsec Void Text (Problem Scientific)
-> String -> Text -> Either (ParseError Text) (Problem Scientific)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text (Problem Scientific)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) =>
m (Problem Scientific)
parser Parsec Void Text (Problem Scientific)
-> ParsecT Void Text Identity ()
-> Parsec Void Text (Problem Scientific)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
fname (Text -> Either (ParseError Text) (Problem Scientific))
-> IO Text -> IO (Either (ParseError Text) (Problem Scientific))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Text
TLIO.hGetContents Handle
h
  case Either (ParseError Text) (Problem Scientific)
ret of
    Left ParseError Text
e -> ParseError Text -> IO (Problem Scientific)
forall e a. Exception e => e -> IO a
throwIO (ParseError Text
e :: ParseError TL.Text)
    Right Problem Scientific
a -> Problem Scientific -> IO (Problem Scientific)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Problem Scientific
a

-- ---------------------------------------------------------------------------


#if MIN_VERSION_megaparsec(7,0,0)
anyChar :: C e s m => m Char
anyChar :: forall e s (m :: * -> *). C e s m => m Char
anyChar = m Char
m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
#endif

space' :: C e s m => m Char
space' :: forall e s (m :: * -> *). C e s m => m Char
space' = [Token s] -> m (Token s)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
' ', Char
'\t']

spaces' :: C e s m => m ()
spaces' :: forall e s (m :: * -> *). C e s m => m ()
spaces' = m Char -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany m Char
forall e s (m :: * -> *). C e s m => m Char
space'

spaces1' :: C e s m => m ()
spaces1' :: forall e s (m :: * -> *). C e s m => m ()
spaces1' = m Char -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome m Char
forall e s (m :: * -> *). C e s m => m Char
space'

commentline :: C e s m => m ()
commentline :: forall e s (m :: * -> *). C e s m => m ()
commentline = do
  Char
_ <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'*'
  String
_ <- m Char -> m Char -> m String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Char
forall e s (m :: * -> *). C e s m => m Char
anyChar m Char
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline
  () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

newline' :: C e s m => m ()
newline' :: forall e s (m :: * -> *). C e s m => m ()
newline' = do
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces'
  Char
_ <- m Char
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline
  m () -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany m ()
forall e s (m :: * -> *). C e s m => m ()
commentline
  () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tok :: C e s m => m a -> m a
tok :: forall e s (m :: * -> *) a. C e s m => m a -> m a
tok m a
p = do
  a
x <- m a
p
  [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof, m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\n' m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()), m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1']
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

row :: C e s m => m Row
row :: forall e s (m :: * -> *). C e s m => m Var
row = (Text -> Var) -> m Text -> m Var
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Var
Uninterned Var -> Var
forall t. Interned t => Uninterned t -> t
intern m Text
forall e s (m :: * -> *). C e s m => m Text
ident

column :: C e s m => m Column
column :: forall e s (m :: * -> *). C e s m => m Var
column = (Text -> Var) -> m Text -> m Var
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Var
Uninterned Var -> Var
forall t. Interned t => Uninterned t -> t
intern (m Text -> m Var) -> m Text -> m Var
forall a b. (a -> b) -> a -> b
$ m Text
forall e s (m :: * -> *). C e s m => m Text
ident

ident :: C e s m => m T.Text
ident :: forall e s (m :: * -> *). C e s m => m Text
ident = (String -> Text) -> m String -> m Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Text
forall a. IsString a => String -> a
fromString (m String -> m Text) -> m String -> m Text
forall a b. (a -> b) -> a -> b
$ m String -> m String
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m String -> m String) -> m String -> m String
forall a b. (a -> b) -> a -> b
$ m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (m Char -> m String) -> m Char -> m String
forall a b. (a -> b) -> a -> b
$ [Token s] -> m (Token s)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
' ', Char
'\t', Char
'\n']

stringLn :: C e s m => String -> m ()
stringLn :: forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
s = Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (String -> Tokens s
forall a. IsString a => String -> a
fromString String
s) m (Tokens s) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *). C e s m => m ()
newline'

number :: forall e s m. C e s m => m Scientific
#if MIN_VERSION_megaparsec(6,0,0)
number :: forall e s (m :: * -> *). C e s m => m Scientific
number = m Scientific -> m Scientific
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m Scientific -> m Scientific) -> m Scientific -> m Scientific
forall a b. (a -> b) -> a -> b
$ m () -> m Scientific -> m Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
Lexer.scientific
#else
number = tok $ Lexer.signed (return ()) Lexer.number
#endif

-- ---------------------------------------------------------------------------

-- | MPS file parser
#if MIN_VERSION_megaparsec(6,0,0)
parser :: (MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) => m (MIP.Problem Scientific)
#else
parser :: (MonadParsec e s m, Token s ~ Char) => m (MIP.Problem Scientific)
#endif
parser :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) =>
m (Problem Scientific)
parser = do
  m () -> m [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m ()
forall e s (m :: * -> *). C e s m => m ()
commentline

  Maybe Text
name <- m (Maybe Text)
forall e s (m :: * -> *). C e s m => m (Maybe Text)
nameSection

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_objsen.html
  -- CPLEX extends the MPS standard by allowing two additional sections: OBJSEN and OBJNAME.
  -- If these options are used, they must appear in order and as the first and second sections after the NAME section.
  Maybe OptDir
objsense <- m OptDir -> m (Maybe OptDir)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m OptDir -> m (Maybe OptDir)) -> m OptDir -> m (Maybe OptDir)
forall a b. (a -> b) -> a -> b
$ m OptDir
forall e s (m :: * -> *). C e s m => m OptDir
objSenseSection
  Maybe Text
objname  <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ m Text
forall e s (m :: * -> *). C e s m => m Text
objNameSection

  [(Maybe RelOp, Var)]
rows <- m [(Maybe RelOp, Var)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
rowsSection

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_usercuts.html
  -- The order of sections must be ROWS USERCUTS.
  [(Maybe RelOp, Var)]
usercuts <- [(Maybe RelOp, Var)]
-> m [(Maybe RelOp, Var)] -> m [(Maybe RelOp, Var)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [(Maybe RelOp, Var)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
userCutsSection

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_lazycons.html
  -- The order of sections must be ROWS USERCUTS LAZYCONS.
  [(Maybe RelOp, Var)]
lazycons <- [(Maybe RelOp, Var)]
-> m [(Maybe RelOp, Var)] -> m [(Maybe RelOp, Var)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [(Maybe RelOp, Var)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
lazyConsSection

  (Map Var (Map Var Scientific)
cols, Set Var
intvs1) <- m (Map Var (Map Var Scientific), Set Var)
forall e s (m :: * -> *).
C e s m =>
m (Map Var (Map Var Scientific), Set Var)
colsSection
  Map Var Scientific
rhss <- m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rhsSection
  Map Var Scientific
rngs <- Map Var Scientific
-> m (Map Var Scientific) -> m (Map Var Scientific)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Map Var Scientific
forall k a. Map k a
Map.empty m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rangesSection
  [(BoundType, Var, Scientific)]
bnds <- [(BoundType, Var, Scientific)]
-> m [(BoundType, Var, Scientific)]
-> m [(BoundType, Var, Scientific)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [(BoundType, Var, Scientific)]
forall e s (m :: * -> *).
C e s m =>
m [(BoundType, Var, Scientific)]
boundsSection

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_quadobj.html
  -- Following the BOUNDS section, a QMATRIX section may be specified.
  [Term Scientific]
qobj <- [m [Term Scientific]] -> m [Term Scientific]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [m [Term Scientific]
forall e s (m :: * -> *). C e s m => m [Term Scientific]
quadObjSection, m [Term Scientific]
forall e s (m :: * -> *). C e s m => m [Term Scientific]
qMatrixSection, [Term Scientific] -> m [Term Scientific]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []]

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_sos.html
  -- Note that in an MPS file, the SOS section must follow the BOUNDS section.
  [SOSConstraint Scientific]
sos <- [SOSConstraint Scientific]
-> m [SOSConstraint Scientific] -> m [SOSConstraint Scientific]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [SOSConstraint Scientific]
forall e s (m :: * -> *). C e s m => m [SOSConstraint Scientific]
sosSection

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_qcmatrix.html
  -- QCMATRIX sections appear after the optional SOS section.
  Map Var [Term Scientific]
qterms <- ([(Var, [Term Scientific])] -> Map Var [Term Scientific])
-> m [(Var, [Term Scientific])] -> m (Map Var [Term Scientific])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Var, [Term Scientific])] -> Map Var [Term Scientific]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(Var, [Term Scientific])] -> m (Map Var [Term Scientific]))
-> m [(Var, [Term Scientific])] -> m (Map Var [Term Scientific])
forall a b. (a -> b) -> a -> b
$ m (Var, [Term Scientific]) -> m [(Var, [Term Scientific])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Var, [Term Scientific])
forall e s (m :: * -> *). C e s m => m (Var, [Term Scientific])
qcMatrixSection

  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_indicators.html
  -- The INDICATORS section follows any quadratic constraint section and any quadratic objective section.
  Map Var (Var, Scientific)
inds <- Map Var (Var, Scientific)
-> m (Map Var (Var, Scientific)) -> m (Map Var (Var, Scientific))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Map Var (Var, Scientific)
forall k a. Map k a
Map.empty m (Map Var (Var, Scientific))
forall e s (m :: * -> *). C e s m => m (Map Var (Var, Scientific))
indicatorsSection

  Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"ENDATA"
  m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space

  let objrow :: Var
objrow =
        case Maybe Text
objname of
          Maybe Text
Nothing -> [Var] -> Var
forall a. HasCallStack => [a] -> a
head [Var
r | (Maybe RelOp
Nothing, Var
r) <- [(Maybe RelOp, Var)]
rows] -- XXX
          Just Text
r  -> Uninterned Var -> Var
forall t. Interned t => Uninterned t -> t
intern Text
Uninterned Var
r
      objdir :: OptDir
objdir =
        case Maybe OptDir
objsense of
          Maybe OptDir
Nothing -> OptDir
OptMin
          Just OptDir
d  -> OptDir
d
      vs :: Set Var
vs     = Map Var (Map Var Scientific) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet Map Var (Map Var Scientific)
cols Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList [Var
col | (BoundType
_,Var
col,Scientific
_) <- [(BoundType, Var, Scientific)]
bnds]
      intvs2 :: Set Var
intvs2 = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList [Var
col | (BoundType
t,Var
col,Scientific
_) <- [(BoundType, Var, Scientific)]
bnds, BoundType
t BoundType -> [BoundType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BoundType
BV,BoundType
LI,BoundType
UI]]
      scvs :: Set Var
scvs   = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList [Var
col | (BoundType
SC,Var
col,Scientific
_) <- [(BoundType, Var, Scientific)]
bnds]
      sivs :: Set Var
sivs   = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList [Var
col | (BoundType
SI,Var
col,Scientific
_) <- [(BoundType, Var, Scientific)]
bnds]

  let explicitBounds :: Map Var (Maybe (Extended Scientific), Maybe (Extended Scientific))
explicitBounds = ((Maybe (Extended Scientific), Maybe (Extended Scientific))
 -> (Maybe (Extended Scientific), Maybe (Extended Scientific))
 -> (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> [(Var,
     (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
-> Map
     Var (Maybe (Extended Scientific), Maybe (Extended Scientific))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (Maybe (Extended Scientific), Maybe (Extended Scientific))
-> (Maybe (Extended Scientific), Maybe (Extended Scientific))
-> (Maybe (Extended Scientific), Maybe (Extended Scientific))
forall {a} {a}.
(Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
f
        [ case BoundType
typ of
            BoundType
LO -> (Var
col, (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val), Maybe (Extended Scientific)
forall a. Maybe a
Nothing))
            BoundType
UP -> (Var
col, (Maybe (Extended Scientific)
forall a. Maybe a
Nothing, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val)))
            BoundType
FX -> (Var
col, (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val), Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val)))
            BoundType
FR -> (Var
col, (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
forall r. Extended r
MIP.NegInf, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
forall r. Extended r
MIP.PosInf))
            BoundType
MI -> (Var
col, (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
forall r. Extended r
MIP.NegInf, Maybe (Extended Scientific)
forall a. Maybe a
Nothing))
            BoundType
PL -> (Var
col, (Maybe (Extended Scientific)
forall a. Maybe a
Nothing, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
forall r. Extended r
MIP.PosInf))
            BoundType
BV -> (Var
col, (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
0), Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
1)))
            BoundType
LI -> (Var
col, (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val), Maybe (Extended Scientific)
forall a. Maybe a
Nothing))
            BoundType
UI -> (Var
col, (Maybe (Extended Scientific)
forall a. Maybe a
Nothing, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val)))
            BoundType
SC -> (Var
col, (Maybe (Extended Scientific)
forall a. Maybe a
Nothing, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val)))
            BoundType
SI -> (Var
col, (Maybe (Extended Scientific)
forall a. Maybe a
Nothing, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
val)))
        | (BoundType
typ,Var
col,Scientific
val) <- [(BoundType, Var, Scientific)]
bnds ]
        where
          f :: (Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
f (Maybe a
a1,Maybe a
b1) (Maybe a
a2,Maybe a
b2) = (Maybe a -> Maybe a -> Maybe a
forall {a}. Maybe a -> Maybe a -> Maybe a
g Maybe a
a1 Maybe a
a2, Maybe a -> Maybe a -> Maybe a
forall {a}. Maybe a -> Maybe a -> Maybe a
g Maybe a
b1 Maybe a
b2)
          g :: Maybe a -> Maybe a -> Maybe a
g Maybe a
_ (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
          g Maybe a
x Maybe a
Nothing  = Maybe a
x

  let bounds :: Map Var (Extended Scientific, Extended Scientific)
bounds = [(Var, (Extended Scientific, Extended Scientific))]
-> Map Var (Extended Scientific, Extended Scientific)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ case Var
-> Map
     Var (Maybe (Extended Scientific), Maybe (Extended Scientific))
-> Maybe (Maybe (Extended Scientific), Maybe (Extended Scientific))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Var
v Map Var (Maybe (Extended Scientific), Maybe (Extended Scientific))
explicitBounds of
            Maybe (Maybe (Extended Scientific), Maybe (Extended Scientific))
Nothing ->
              if Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
intvs1
              then
                -- http://eaton.math.rpi.edu/cplex90html/reffileformatscplex/reffileformatscplex9.html
                -- If no bounds are specified for the variables within markers, bounds of 0 (zero) and 1 (one) are assumed.
                (Var
v, (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
0, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
1))
              else
                (Var
v, (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
0, Extended Scientific
forall r. Extended r
MIP.PosInf))
            Just (Maybe (Extended Scientific)
Nothing, Just (MIP.Finite Scientific
ub)) | Scientific
ub Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0 ->
              {-
                http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_records.html
                If no bounds are specified, CPLEX assumes a lower
                bound of 0 (zero) and an upper bound of +∞. If only a
                single bound is specified, the unspecified bound
                remains at 0 or +∞, whichever applies, with one
                exception. If an upper bound of less than 0 is
                specified and no other bound is specified, the lower
                bound is automatically set to -∞. CPLEX deviates
                slightly from a convention used by some MPS readers
                when it encounters an upper bound of 0 (zero). Rather
                than automatically set this variable’s lower bound to
                -∞, CPLEX accepts both a lower and upper bound of 0,
                effectively fixing that variable at 0. CPLEX resets
                the lower bound to -∞ only if the upper bound is less
                than 0. A warning message is issued when this
                exception is encountered.
              -}
              (Var
v, (Extended Scientific
forall r. Extended r
MIP.NegInf, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
ub))
            {-
              lp_solve uses 1 as default lower bound for semi-continuous variable.
              <http://lpsolve.sourceforge.net/5.5/mps-format.htm>
              But Gurobi Optimizer uses 0 as default lower bound for semi-continuous variable.
              Here we adopt Gurobi's way.
            -}
{-
            Just (Nothing, ub) | v `Set.member` scvs ->
              (v, (MIP.Finite 1, fromMaybe MIP.PosInf ub))
-}
            Just (Maybe (Extended Scientific)
lb,Maybe (Extended Scientific)
ub) ->
              (Var
v, (Extended Scientific
-> Maybe (Extended Scientific) -> Extended Scientific
forall a. a -> Maybe a -> a
fromMaybe (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
0) Maybe (Extended Scientific)
lb, Extended Scientific
-> Maybe (Extended Scientific) -> Extended Scientific
forall a. a -> Maybe a -> a
fromMaybe Extended Scientific
forall r. Extended r
MIP.PosInf Maybe (Extended Scientific)
ub))
        | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toList Set Var
vs ]

  let rowCoeffs :: Map Row (Map Column Scientific)
      rowCoeffs :: Map Var (Map Var Scientific)
rowCoeffs = (Map Var Scientific -> Map Var Scientific -> Map Var Scientific)
-> [(Var, Map Var Scientific)] -> Map Var (Map Var Scientific)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map Var Scientific -> Map Var Scientific -> Map Var Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union [(Var
r, Var -> Scientific -> Map Var Scientific
forall k a. k -> a -> Map k a
Map.singleton Var
col Scientific
coeff) | (Var
col,Map Var Scientific
m) <- Map Var (Map Var Scientific) -> [(Var, Map Var Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Var (Map Var Scientific)
cols, (Var
r,Scientific
coeff) <- Map Var Scientific -> [(Var, Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Var Scientific
m]

  let f :: Bool -> (Maybe MIP.RelOp, Row) -> [MIP.Constraint Scientific]
      f :: Bool -> (Maybe RelOp, Var) -> [Constraint Scientific]
f Bool
_isLazy (Maybe RelOp
Nothing, Var
_row) = []
      f Bool
isLazy (Just RelOp
op, Var
r) = do
        let lhs :: [Term Scientific]
lhs = [Scientific -> [Var] -> Term Scientific
forall c. c -> [Var] -> Term c
MIP.Term Scientific
c [Var
col] | (Var
col,Scientific
c) <- Map Var Scientific -> [(Var, Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Var Scientific
-> Var -> Map Var (Map Var Scientific) -> Map Var Scientific
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map Var Scientific
forall k a. Map k a
Map.empty Var
r Map Var (Map Var Scientific)
rowCoeffs)]
                  [Term Scientific] -> [Term Scientific] -> [Term Scientific]
forall a. [a] -> [a] -> [a]
++ [Term Scientific]
-> Var -> Map Var [Term Scientific] -> [Term Scientific]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Var
r Map Var [Term Scientific]
qterms
        let rhs :: Scientific
rhs = Scientific -> Var -> Map Var Scientific -> Scientific
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Scientific
0 Var
r Map Var Scientific
rhss
            (Extended Scientific
lb,Extended Scientific
ub) =
              case Var -> Map Var Scientific -> Maybe Scientific
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Var
r Map Var Scientific
rngs of
                Maybe Scientific
Nothing  ->
                  case RelOp
op of
                    RelOp
MIP.Ge  -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Extended Scientific
forall r. Extended r
MIP.PosInf)
                    RelOp
MIP.Le  -> (Extended Scientific
forall r. Extended r
MIP.NegInf, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs)
                    RelOp
MIP.Eql -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs)
                Just Scientific
rng ->
                  case RelOp
op of
                    RelOp
MIP.Ge  -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite (Scientific
rhs Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
rng))
                    RelOp
MIP.Le  -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite (Scientific
rhs Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
- Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
rng), Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs)
                    RelOp
MIP.Eql ->
                      if Scientific
rng Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0
                      then (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite (Scientific
rhs Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
rng), Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs)
                      else (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite (Scientific
rhs Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
rng))
        Constraint Scientific -> [Constraint Scientific]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint Scientific -> [Constraint Scientific])
-> Constraint Scientific -> [Constraint Scientific]
forall a b. (a -> b) -> a -> b
$
          MIP.Constraint
          { constrLabel :: Maybe Text
MIP.constrLabel     = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
r
          , constrIndicator :: Maybe (Var, Scientific)
MIP.constrIndicator = Var -> Map Var (Var, Scientific) -> Maybe (Var, Scientific)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Var
r Map Var (Var, Scientific)
inds
          , constrIsLazy :: Bool
MIP.constrIsLazy    = Bool
isLazy
          , constrExpr :: Expr Scientific
MIP.constrExpr      = [Term Scientific] -> Expr Scientific
forall c. [Term c] -> Expr c
MIP.Expr [Term Scientific]
lhs
          , constrLB :: Extended Scientific
MIP.constrLB        = Extended Scientific
lb
          , constrUB :: Extended Scientific
MIP.constrUB        = Extended Scientific
ub
          }

  let mip :: Problem Scientific
mip =
        MIP.Problem
        { name :: Maybe Text
MIP.name                  = Maybe Text
name
        , objectiveFunction :: ObjectiveFunction Scientific
MIP.objectiveFunction     = ObjectiveFunction Any
forall a. Default a => a
def
            { MIP.objDir = objdir
            , MIP.objLabel = Just (unintern objrow)
            , MIP.objExpr = MIP.Expr $ [MIP.Term c [col] | (col,m) <- Map.toList cols, c <- maybeToList (Map.lookup objrow m)] ++ qobj
            }
        , constraints :: [Constraint Scientific]
MIP.constraints           = ((Maybe RelOp, Var) -> [Constraint Scientific])
-> [(Maybe RelOp, Var)] -> [Constraint Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Maybe RelOp, Var) -> [Constraint Scientific]
f Bool
False) [(Maybe RelOp, Var)]
rows [Constraint Scientific]
-> [Constraint Scientific] -> [Constraint Scientific]
forall a. [a] -> [a] -> [a]
++ ((Maybe RelOp, Var) -> [Constraint Scientific])
-> [(Maybe RelOp, Var)] -> [Constraint Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Maybe RelOp, Var) -> [Constraint Scientific]
f Bool
True) [(Maybe RelOp, Var)]
lazycons
        , sosConstraints :: [SOSConstraint Scientific]
MIP.sosConstraints        = [SOSConstraint Scientific]
sos
        , userCuts :: [Constraint Scientific]
MIP.userCuts              = ((Maybe RelOp, Var) -> [Constraint Scientific])
-> [(Maybe RelOp, Var)] -> [Constraint Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Maybe RelOp, Var) -> [Constraint Scientific]
f Bool
False) [(Maybe RelOp, Var)]
usercuts
        , varType :: Map Var VarType
MIP.varType               = [(Var, VarType)] -> Map Var VarType
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
            [ ( Var
v
              , if Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
sivs then
                  VarType
MIP.SemiIntegerVariable
                else if Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
intvs1 Bool -> Bool -> Bool
&& Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
scvs then
                  VarType
MIP.SemiIntegerVariable
                else if Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
intvs1 Bool -> Bool -> Bool
|| Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
intvs2 then
                  VarType
MIP.IntegerVariable
                else if Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
scvs then
                  VarType
MIP.SemiContinuousVariable
                else
                  VarType
MIP.ContinuousVariable
              )
            | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
vs ]
        , varBounds :: Map Var (Extended Scientific, Extended Scientific)
MIP.varBounds             = [(Var, (Extended Scientific, Extended Scientific))]
-> Map Var (Extended Scientific, Extended Scientific)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [(Var
v, (Extended Scientific, Extended Scientific)
-> Var
-> Map Var (Extended Scientific, Extended Scientific)
-> (Extended Scientific, Extended Scientific)
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Extended Scientific, Extended Scientific)
forall c. Num c => Bounds c
MIP.defaultBounds Var
v Map Var (Extended Scientific, Extended Scientific)
bounds) | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
vs]
        }

  Problem Scientific -> m (Problem Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Problem Scientific
mip

nameSection :: C e s m => m (Maybe T.Text)
nameSection :: forall e s (m :: * -> *). C e s m => m (Maybe Text)
nameSection = do
  Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"NAME"
  Maybe Text
n <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ m Text -> m Text
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
    m Text
forall e s (m :: * -> *). C e s m => m Text
ident
  m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
  Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
n

objSenseSection :: C e s m => m OptDir
objSenseSection :: forall e s (m :: * -> *). C e s m => m OptDir
objSenseSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"OBJSENSE"
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
  OptDir
d <-  (m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"MAX") m () -> m OptDir -> m OptDir
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OptDir -> m OptDir
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OptDir
OptMax)
    m OptDir -> m OptDir -> m OptDir
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"MIN" m () -> m OptDir -> m OptDir
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OptDir -> m OptDir
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OptDir
OptMin)
  OptDir -> m OptDir
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OptDir
d

objNameSection :: C e s m => m T.Text
objNameSection :: forall e s (m :: * -> *). C e s m => m Text
objNameSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"OBJNAME"
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
  Text
name <- m Text
forall e s (m :: * -> *). C e s m => m Text
ident
  m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
  Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
name

rowsSection :: C e s m => m [(Maybe MIP.RelOp, Row)]
rowsSection :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
rowsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"ROWS"
  m [(Maybe RelOp, Var)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
rowsBody

userCutsSection :: C e s m => m [(Maybe MIP.RelOp, Row)]
userCutsSection :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
userCutsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"USERCUTS"
  m [(Maybe RelOp, Var)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
rowsBody

lazyConsSection :: C e s m => m [(Maybe MIP.RelOp, Row)]
lazyConsSection :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
lazyConsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"LAZYCONS"
  m [(Maybe RelOp, Var)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
rowsBody

rowsBody :: C e s m => m [(Maybe MIP.RelOp, Row)]
rowsBody :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Var)]
rowsBody = m (Maybe RelOp, Var) -> m [(Maybe RelOp, Var)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Maybe RelOp, Var) -> m [(Maybe RelOp, Var)])
-> m (Maybe RelOp, Var) -> m [(Maybe RelOp, Var)]
forall a b. (a -> b) -> a -> b
$ do
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
  Maybe RelOp
op <- [m (Maybe RelOp)] -> m (Maybe RelOp)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
        [ Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'N' m Char -> m (Maybe RelOp) -> m (Maybe RelOp)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RelOp -> m (Maybe RelOp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RelOp
forall a. Maybe a
Nothing
        , Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'G' m Char -> m (Maybe RelOp) -> m (Maybe RelOp)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RelOp -> m (Maybe RelOp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelOp -> Maybe RelOp
forall a. a -> Maybe a
Just RelOp
MIP.Ge)
        , Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'L' m Char -> m (Maybe RelOp) -> m (Maybe RelOp)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RelOp -> m (Maybe RelOp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelOp -> Maybe RelOp
forall a. a -> Maybe a
Just RelOp
MIP.Le)
        , Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'E' m Char -> m (Maybe RelOp) -> m (Maybe RelOp)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RelOp -> m (Maybe RelOp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelOp -> Maybe RelOp
forall a. a -> Maybe a
Just RelOp
MIP.Eql)
        ]
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
  Var
name <- m Var
forall e s (m :: * -> *). C e s m => m Var
row
  m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
  (Maybe RelOp, Var) -> m (Maybe RelOp, Var)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RelOp
op, Var
name)

colsSection :: forall e s m. C e s m => m (Map Column (Map Row Scientific), Set Column)
colsSection :: forall e s (m :: * -> *).
C e s m =>
m (Map Var (Map Var Scientific), Set Var)
colsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"COLUMNS"
  Bool
-> Map Var (Map Var Scientific)
-> Set Var
-> m (Map Var (Map Var Scientific), Set Var)
body Bool
False Map Var (Map Var Scientific)
forall k a. Map k a
Map.empty Set Var
forall a. Set a
Set.empty
  where
    body :: Bool -> Map Column (Map Row Scientific) -> Set Column -> m (Map Column (Map Row Scientific), Set Column)
    body :: Bool
-> Map Var (Map Var Scientific)
-> Set Var
-> m (Map Var (Map Var Scientific), Set Var)
body Bool
isInt Map Var (Map Var Scientific)
rs Set Var
ivs = [m (Map Var (Map Var Scientific), Set Var)]
-> m (Map Var (Map Var Scientific), Set Var)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
      [ do ()
_ <- m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
           Text
x <- m Text
forall e s (m :: * -> *). C e s m => m Text
ident
           [m (Map Var (Map Var Scientific), Set Var)]
-> m (Map Var (Map Var Scientific), Set Var)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
             [ do Bool
isInt' <- m Bool -> m Bool
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Bool
intMarker
                  Bool
-> Map Var (Map Var Scientific)
-> Set Var
-> m (Map Var (Map Var Scientific), Set Var)
body Bool
isInt' Map Var (Map Var Scientific)
rs Set Var
ivs
             , do (Var
k,Map Var Scientific
v) <- Text -> m (Var, Map Var Scientific)
entry Text
x
                  let rs' :: Map Var (Map Var Scientific)
rs'  = (Map Var Scientific -> Map Var Scientific -> Map Var Scientific)
-> Var
-> Map Var Scientific
-> Map Var (Map Var Scientific)
-> Map Var (Map Var Scientific)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Map Var Scientific -> Map Var Scientific -> Map Var Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Var
k Map Var Scientific
v Map Var (Map Var Scientific)
rs
                      ivs' :: Set Var
ivs' = if Bool
isInt then Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
Set.insert Var
k Set Var
ivs else Set Var
ivs
                  Map Var (Map Var Scientific)
-> m (Map Var (Map Var Scientific), Set Var)
-> m (Map Var (Map Var Scientific), Set Var)
forall a b. a -> b -> b
seq Map Var (Map Var Scientific)
rs' (m (Map Var (Map Var Scientific), Set Var)
 -> m (Map Var (Map Var Scientific), Set Var))
-> m (Map Var (Map Var Scientific), Set Var)
-> m (Map Var (Map Var Scientific), Set Var)
forall a b. (a -> b) -> a -> b
$ Set Var
-> m (Map Var (Map Var Scientific), Set Var)
-> m (Map Var (Map Var Scientific), Set Var)
forall a b. a -> b -> b
seq Set Var
ivs' (m (Map Var (Map Var Scientific), Set Var)
 -> m (Map Var (Map Var Scientific), Set Var))
-> m (Map Var (Map Var Scientific), Set Var)
-> m (Map Var (Map Var Scientific), Set Var)
forall a b. (a -> b) -> a -> b
$ Bool
-> Map Var (Map Var Scientific)
-> Set Var
-> m (Map Var (Map Var Scientific), Set Var)
body Bool
isInt Map Var (Map Var Scientific)
rs' Set Var
ivs'
             ]
      , (Map Var (Map Var Scientific), Set Var)
-> m (Map Var (Map Var Scientific), Set Var)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var (Map Var Scientific)
rs, Set Var
ivs)
      ]

    intMarker :: m Bool
    intMarker :: m Bool
intMarker = do
      Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"'MARKER'"
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Bool
b <-  (m (Tokens s) -> m (Tokens s)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"'INTORG'") m (Tokens s) -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
        m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"'INTEND'" m (Tokens s) -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b

    entry :: T.Text -> m (Column, Map Row Scientific)
    entry :: Text -> m (Var, Map Var Scientific)
entry Text
x = do
      let col :: Var
col = Uninterned Var -> Var
forall t. Interned t => Uninterned t -> t
intern Text
Uninterned Var
x
      Map Var Scientific
rv1 <- m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal
      Maybe (Map Var Scientific)
opt <- m (Map Var Scientific) -> m (Maybe (Map Var Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      case Maybe (Map Var Scientific)
opt of
        Maybe (Map Var Scientific)
Nothing -> (Var, Map Var Scientific) -> m (Var, Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
col, Map Var Scientific
rv1)
        Just Map Var Scientific
rv2 ->  (Var, Map Var Scientific) -> m (Var, Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
col, Map Var Scientific -> Map Var Scientific -> Map Var Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Var Scientific
rv1 Map Var Scientific
rv2)

rowAndVal :: C e s m => m (Map Row Scientific)
rowAndVal :: forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal = do
  Var
r <- m Var
forall e s (m :: * -> *). C e s m => m Var
row
  Scientific
val <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
  Map Var Scientific -> m (Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var Scientific -> m (Map Var Scientific))
-> Map Var Scientific -> m (Map Var Scientific)
forall a b. (a -> b) -> a -> b
$ Var -> Scientific -> Map Var Scientific
forall k a. k -> a -> Map k a
Map.singleton Var
r Scientific
val

rhsSection :: C e s m => m (Map Row Scientific)
rhsSection :: forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rhsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"RHS"
  ([Map Var Scientific] -> Map Var Scientific)
-> m [Map Var Scientific] -> m (Map Var Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Map Var Scientific] -> Map Var Scientific
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (m [Map Var Scientific] -> m (Map Var Scientific))
-> m [Map Var Scientific] -> m (Map Var Scientific)
forall a b. (a -> b) -> a -> b
$ m (Map Var Scientific) -> m [Map Var Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Map Var Scientific)
entry
  where
    entry :: m (Map Var Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Text
_name <- m Text
forall e s (m :: * -> *). C e s m => m Text
ident
      Map Var Scientific
rv1 <- m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal
      Maybe (Map Var Scientific)
opt <- m (Map Var Scientific) -> m (Maybe (Map Var Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      case Maybe (Map Var Scientific)
opt of
        Maybe (Map Var Scientific)
Nothing  -> Map Var Scientific -> m (Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Var Scientific
rv1
        Just Map Var Scientific
rv2 -> Map Var Scientific -> m (Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var Scientific -> m (Map Var Scientific))
-> Map Var Scientific -> m (Map Var Scientific)
forall a b. (a -> b) -> a -> b
$ Map Var Scientific -> Map Var Scientific -> Map Var Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Var Scientific
rv1 Map Var Scientific
rv2

rangesSection :: C e s m => m (Map Row Scientific)
rangesSection :: forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rangesSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"RANGES"
  ([Map Var Scientific] -> Map Var Scientific)
-> m [Map Var Scientific] -> m (Map Var Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Map Var Scientific] -> Map Var Scientific
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (m [Map Var Scientific] -> m (Map Var Scientific))
-> m [Map Var Scientific] -> m (Map Var Scientific)
forall a b. (a -> b) -> a -> b
$ m (Map Var Scientific) -> m [Map Var Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Map Var Scientific)
entry
  where
    entry :: m (Map Var Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Text
_name <- m Text
forall e s (m :: * -> *). C e s m => m Text
ident
      Map Var Scientific
rv1 <- m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal
      Maybe (Map Var Scientific)
opt <- m (Map Var Scientific) -> m (Maybe (Map Var Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Map Var Scientific)
forall e s (m :: * -> *). C e s m => m (Map Var Scientific)
rowAndVal
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      case Maybe (Map Var Scientific)
opt of
        Maybe (Map Var Scientific)
Nothing  -> Map Var Scientific -> m (Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Var Scientific
rv1
        Just Map Var Scientific
rv2 -> Map Var Scientific -> m (Map Var Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var Scientific -> m (Map Var Scientific))
-> Map Var Scientific -> m (Map Var Scientific)
forall a b. (a -> b) -> a -> b
$ Map Var Scientific -> Map Var Scientific -> Map Var Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Var Scientific
rv1 Map Var Scientific
rv2

boundsSection :: C e s m => m [(BoundType, Column, Scientific)]
boundsSection :: forall e s (m :: * -> *).
C e s m =>
m [(BoundType, Var, Scientific)]
boundsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"BOUNDS"
  m (BoundType, Var, Scientific) -> m [(BoundType, Var, Scientific)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (BoundType, Var, Scientific)
entry
  where
    entry :: m (BoundType, Var, Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      BoundType
typ   <- m BoundType
forall e s (m :: * -> *). C e s m => m BoundType
boundType
      Text
_name <- m Text
forall e s (m :: * -> *). C e s m => m Text
ident
      Var
col   <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Scientific
val   <- if BoundType
typ BoundType -> [BoundType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BoundType
FR, BoundType
BV, BoundType
MI, BoundType
PL]
               then Scientific -> m Scientific
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
0
               else m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      (BoundType, Var, Scientific) -> m (BoundType, Var, Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoundType
typ, Var
col, Scientific
val)

boundType :: C e s m => m BoundType
boundType :: forall e s (m :: * -> *). C e s m => m BoundType
boundType = m BoundType -> m BoundType
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m BoundType -> m BoundType) -> m BoundType -> m BoundType
forall a b. (a -> b) -> a -> b
$ do
  [m BoundType] -> m BoundType
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [m (Tokens s) -> m (Tokens s)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (String -> Tokens s
forall a. IsString a => String -> a
fromString (BoundType -> String
forall a. Show a => a -> String
show BoundType
k))) m (Tokens s) -> m BoundType -> m BoundType
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoundType -> m BoundType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BoundType
k | BoundType
k <- [BoundType
forall a. Bounded a => a
minBound..BoundType
forall a. Bounded a => a
maxBound]]

sosSection :: forall e s m. C e s m => m [MIP.SOSConstraint Scientific]
sosSection :: forall e s (m :: * -> *). C e s m => m [SOSConstraint Scientific]
sosSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"SOS"
  m (SOSConstraint Scientific) -> m [SOSConstraint Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (SOSConstraint Scientific)
entry
  where
    entry :: m (SOSConstraint Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      SOSType
typ <-  (m (Tokens s) -> m (Tokens s)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"S1") m (Tokens s) -> m SOSType -> m SOSType
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SOSType -> m SOSType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
MIP.S1)
          m SOSType -> m SOSType -> m SOSType
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"S2" m (Tokens s) -> m SOSType -> m SOSType
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SOSType -> m SOSType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
MIP.S2)
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Text
name <- m Text
forall e s (m :: * -> *). C e s m => m Text
ident
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      [(Var, Scientific)]
xs <- m (Var, Scientific) -> m [(Var, Scientific)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Var, Scientific) -> m (Var, Scientific)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Var, Scientific)
identAndVal)
      SOSConstraint Scientific -> m (SOSConstraint Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SOSConstraint Scientific -> m (SOSConstraint Scientific))
-> SOSConstraint Scientific -> m (SOSConstraint Scientific)
forall a b. (a -> b) -> a -> b
$ MIP.SOSConstraint{ sosLabel :: Maybe Text
MIP.sosLabel = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name, sosType :: SOSType
MIP.sosType = SOSType
typ, sosBody :: [(Var, Scientific)]
MIP.sosBody = [(Var, Scientific)]
xs }

    identAndVal :: m (Column, Scientific)
    identAndVal :: m (Var, Scientific)
identAndVal = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Var
col <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Scientific
val <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      (Var, Scientific) -> m (Var, Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
col, Scientific
val)

quadObjSection :: C e s m => m [MIP.Term Scientific]
quadObjSection :: forall e s (m :: * -> *). C e s m => m [Term Scientific]
quadObjSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"QUADOBJ"
  m (Term Scientific) -> m [Term Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Term Scientific)
entry
  where
    entry :: m (Term Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Var
col1 <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Var
col2 <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Scientific
val  <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      Term Scientific -> m (Term Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term Scientific -> m (Term Scientific))
-> Term Scientific -> m (Term Scientific)
forall a b. (a -> b) -> a -> b
$ Scientific -> [Var] -> Term Scientific
forall c. c -> [Var] -> Term c
MIP.Term (if Var
col1 Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
/= Var
col2 then Scientific
val else Scientific
val Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/ Scientific
2) [Var
col1, Var
col2]

qMatrixSection :: C e s m => m [MIP.Term Scientific]
qMatrixSection :: forall e s (m :: * -> *). C e s m => m [Term Scientific]
qMatrixSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"QMATRIX"
  m (Term Scientific) -> m [Term Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Term Scientific)
entry
  where
    entry :: m (Term Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Var
col1 <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Var
col2 <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Scientific
val  <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      Term Scientific -> m (Term Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term Scientific -> m (Term Scientific))
-> Term Scientific -> m (Term Scientific)
forall a b. (a -> b) -> a -> b
$ Scientific -> [Var] -> Term Scientific
forall c. c -> [Var] -> Term c
MIP.Term (Scientific
val Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/ Scientific
2) [Var
col1, Var
col2]

qcMatrixSection :: C e s m => m (Row, [MIP.Term Scientific])
qcMatrixSection :: forall e s (m :: * -> *). C e s m => m (Var, [Term Scientific])
qcMatrixSection = do
  m (Tokens s) -> m (Tokens s)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (Tokens s) -> m (Tokens s)) -> m (Tokens s) -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$ Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"QCMATRIX"
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
  Var
r <- m Var
forall e s (m :: * -> *). C e s m => m Var
row
  m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
  [Term Scientific]
xs <- m (Term Scientific) -> m [Term Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Term Scientific)
entry
  (Var, [Term Scientific]) -> m (Var, [Term Scientific])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
r, [Term Scientific]
xs)
  where
    entry :: m (Term Scientific)
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Var
col1 <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Var
col2 <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Scientific
val  <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      Term Scientific -> m (Term Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term Scientific -> m (Term Scientific))
-> Term Scientific -> m (Term Scientific)
forall a b. (a -> b) -> a -> b
$ Scientific -> [Var] -> Term Scientific
forall c. c -> [Var] -> Term c
MIP.Term Scientific
val [Var
col1, Var
col2]

indicatorsSection :: C e s m => m (Map Row (Column, Scientific))
indicatorsSection :: forall e s (m :: * -> *). C e s m => m (Map Var (Var, Scientific))
indicatorsSection = do
  m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
stringLn String
"INDICATORS"
  ([(Var, (Var, Scientific))] -> Map Var (Var, Scientific))
-> m [(Var, (Var, Scientific))] -> m (Map Var (Var, Scientific))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Var, (Var, Scientific))] -> Map Var (Var, Scientific)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(Var, (Var, Scientific))] -> m (Map Var (Var, Scientific)))
-> m [(Var, (Var, Scientific))] -> m (Map Var (Var, Scientific))
forall a b. (a -> b) -> a -> b
$ m (Var, (Var, Scientific)) -> m [(Var, (Var, Scientific))]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Var, (Var, Scientific))
entry
  where
    entry :: m (Var, (Var, Scientific))
entry = do
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"IF"
      m ()
forall e s (m :: * -> *). C e s m => m ()
spaces1'
      Var
r <- m Var
forall e s (m :: * -> *). C e s m => m Var
row
      Var
var <- m Var
forall e s (m :: * -> *). C e s m => m Var
column
      Scientific
val <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      m ()
forall e s (m :: * -> *). C e s m => m ()
newline'
      (Var, (Var, Scientific)) -> m (Var, (Var, Scientific))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
r, (Var
var, Scientific
val))

-- ---------------------------------------------------------------------------

type M a = Writer Builder a

execM :: M a -> TL.Text
execM :: forall a. M a -> Text
execM M a
m = Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ M a -> Builder
forall w a. Writer w a -> w
execWriter M a
m

writeText :: T.Text -> M ()
writeText :: Text -> M ()
writeText Text
s = Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder
B.fromText Text
s

writeChar :: Char -> M ()
writeChar :: Char -> M ()
writeChar Char
c = Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Char -> Builder
B.singleton Char
c

-- ---------------------------------------------------------------------------

-- | Render a problem into a 'TL.Text' containing MPS file data.
render :: MIP.FileOptions -> MIP.Problem Scientific -> Either String TL.Text
render :: FileOptions -> Problem Scientific -> Either String Text
render FileOptions
_ Problem Scientific
mip | Bool -> Bool
not (Problem Scientific -> Bool
forall r. Problem r -> Bool
checkAtMostQuadratic Problem Scientific
mip) = String -> Either String Text
forall a b. a -> Either a b
Left String
"Expression must be atmost quadratic"
render FileOptions
_ Problem Scientific
mip = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ M () -> Text
forall a. M a -> Text
execM (M () -> Text) -> M () -> Text
forall a b. (a -> b) -> a -> b
$ Problem Scientific -> M ()
render' (Problem Scientific -> M ()) -> Problem Scientific -> M ()
forall a b. (a -> b) -> a -> b
$ Problem Scientific -> Problem Scientific
forall r. Problem r -> Problem r
nameRows Problem Scientific
mip

render' :: MIP.Problem Scientific -> M ()
render' :: Problem Scientific -> M ()
render' Problem Scientific
mip = do
  let probName :: Text
probName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Problem Scientific -> Maybe Text
forall c. Problem c -> Maybe Text
MIP.name Problem Scientific
mip)

  -- NAME section
  -- The name starts in column 15 in fixed formats.
  Text -> M ()
writeSectionHeader (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Text
"NAME" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
10 Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
probName

  let MIP.ObjectiveFunction
       { objLabel :: forall c. ObjectiveFunction c -> Maybe Text
MIP.objLabel = Just Text
objName
       , objDir :: forall c. ObjectiveFunction c -> OptDir
MIP.objDir = OptDir
dir
       , objExpr :: forall c. ObjectiveFunction c -> Expr c
MIP.objExpr = Expr Scientific
obj
       } = Problem Scientific -> ObjectiveFunction Scientific
forall c. Problem c -> ObjectiveFunction c
MIP.objectiveFunction Problem Scientific
mip

  -- OBJSENSE section
  -- Note: GLPK-4.48 does not support this section.
  Text -> M ()
writeSectionHeader Text
"OBJSENSE"
  case OptDir
dir of
    OptDir
OptMin -> [Text] -> M ()
writeFields [Text
"MIN"]
    OptDir
OptMax -> [Text] -> M ()
writeFields [Text
"MAX"]

{-
  -- OBJNAME section
  -- Note: GLPK-4.48 does not support this section.
  writeSectionHeader "OBJNAME"
  writeFields [objName]
-}

  let splitRange :: Constraint a -> ((RelOp, a), Maybe a)
splitRange Constraint a
c =
        case (Constraint a -> BoundExpr a
forall c. Constraint c -> BoundExpr c
MIP.constrLB Constraint a
c, Constraint a -> BoundExpr a
forall c. Constraint c -> BoundExpr c
MIP.constrUB Constraint a
c) of
          (MIP.Finite a
x, BoundExpr a
MIP.PosInf) -> ((RelOp
MIP.Ge, a
x), Maybe a
forall a. Maybe a
Nothing)
          (BoundExpr a
MIP.NegInf, MIP.Finite a
x) -> ((RelOp
MIP.Le, a
x), Maybe a
forall a. Maybe a
Nothing)
          (MIP.Finite a
x1, MIP.Finite a
x2)
            | a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 -> ((RelOp
MIP.Eql, a
x1), Maybe a
forall a. Maybe a
Nothing)
            | a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x2  -> ((RelOp
MIP.Eql, a
x1), a -> Maybe a
forall a. a -> Maybe a
Just (a
x2 a -> a -> a
forall a. Num a => a -> a -> a
- a
x1))
          (BoundExpr a, BoundExpr a)
_ -> String -> ((RelOp, a), Maybe a)
forall a. HasCallStack => String -> a
error String
"invalid constraint bound"

  let renderRows :: t (Constraint c) -> M ()
renderRows t (Constraint c)
cs = do
        t (Constraint c) -> (Constraint c -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (Constraint c)
cs ((Constraint c -> M ()) -> M ()) -> (Constraint c -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \Constraint c
c -> do
          let ((RelOp
op,c
_), Maybe c
_) = Constraint c -> ((RelOp, c), Maybe c)
forall {a}. (Ord a, Num a) => Constraint a -> ((RelOp, a), Maybe a)
splitRange Constraint c
c
          let s :: Text
s = case RelOp
op of
                    RelOp
MIP.Le  -> Text
"L"
                    RelOp
MIP.Ge  -> Text
"G"
                    RelOp
MIP.Eql -> Text
"E"
          [Text] -> M ()
writeFields [Text
s, Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Constraint c -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint c
c]

  -- ROWS section
  Text -> M ()
writeSectionHeader Text
"ROWS"
  [Text] -> M ()
writeFields [Text
"N", Text
objName]
  [Constraint Scientific] -> M ()
forall {t :: * -> *} {c}.
(Foldable t, Ord c, Num c) =>
t (Constraint c) -> M ()
renderRows [Constraint Scientific
c | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip, Bool -> Bool
not (Constraint Scientific -> Bool
forall c. Constraint c -> Bool
MIP.constrIsLazy Constraint Scientific
c)]

  -- USERCUTS section
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Constraint Scientific] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip)) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeSectionHeader Text
"USERCUTS"
    [Constraint Scientific] -> M ()
forall {t :: * -> *} {c}.
(Foldable t, Ord c, Num c) =>
t (Constraint c) -> M ()
renderRows (Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip)

  -- LAZYCONS section
  let lcs :: [Constraint Scientific]
lcs = [Constraint Scientific
c | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip, Constraint Scientific -> Bool
forall c. Constraint c -> Bool
MIP.constrIsLazy Constraint Scientific
c]
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Constraint Scientific] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint Scientific]
lcs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeSectionHeader Text
"LAZYCONS"
    [Constraint Scientific] -> M ()
forall {t :: * -> *} {c}.
(Foldable t, Ord c, Num c) =>
t (Constraint c) -> M ()
renderRows [Constraint Scientific]
lcs

  -- COLUMNS section
  Text -> M ()
writeSectionHeader Text
"COLUMNS"
  let cols :: Map Column (Map T.Text Scientific)
      cols :: Map Var (Map Text Scientific)
cols = (Map Text Scientific -> Map Text Scientific -> Map Text Scientific)
-> [(Var, Map Text Scientific)] -> Map Var (Map Text Scientific)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map Text Scientific -> Map Text Scientific -> Map Text Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
             [ (Var
v, Text -> Scientific -> Map Text Scientific
forall k a. k -> a -> Map k a
Map.singleton Text
l Scientific
d)
             | (Just Text
l, Expr Scientific
xs) <-
                 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
objName, Expr Scientific
obj) (Maybe Text, Expr Scientific)
-> [(Maybe Text, Expr Scientific)]
-> [(Maybe Text, Expr Scientific)]
forall a. a -> [a] -> [a]
:
                 [(Constraint Scientific -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint Scientific
c, Expr Scientific
lhs) | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip [Constraint Scientific]
-> [Constraint Scientific] -> [Constraint Scientific]
forall a. [a] -> [a] -> [a]
++ Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip, let lhs :: Expr Scientific
lhs = Constraint Scientific -> Expr Scientific
forall c. Constraint c -> Expr c
MIP.constrExpr Constraint Scientific
c]
             , MIP.Term Scientific
d [Var
v] <- Expr Scientific -> [Term Scientific]
forall c. Expr c -> [Term c]
MIP.terms Expr Scientific
xs
             ]
      f :: t -> Map Text Scientific -> M ()
f t
col Map Text Scientific
xs =
        [(Text, Scientific)] -> ((Text, Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Text Scientific -> [(Text, Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Scientific
xs) (((Text, Scientific) -> M ()) -> M ())
-> ((Text, Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Text
r, Scientific
d) -> do
          [Text] -> M ()
writeFields [Text
"", t -> Uninterned t
forall t. Uninternable t => t -> Uninterned t
unintern t
col, Text
r, Scientific -> Text
showValue Scientific
d]
      ivs :: Set Var
ivs = Problem Scientific -> Set Var
forall c. Problem c -> Set Var
MIP.integerVariables Problem Scientific
mip Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Problem Scientific -> Set Var
forall c. Problem c -> Set Var
MIP.semiIntegerVariables Problem Scientific
mip
  [(Var, Map Text Scientific)]
-> ((Var, Map Text Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Var (Map Text Scientific) -> [(Var, Map Text Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList ((Var -> Map Text Scientific -> Bool)
-> Map Var (Map Text Scientific) -> Map Var (Map Text Scientific)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Var
col Map Text Scientific
_ -> Var
col Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Var
ivs) Map Var (Map Text Scientific)
cols)) (((Var, Map Text Scientific) -> M ()) -> M ())
-> ((Var, Map Text Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
col, Map Text Scientific
xs) -> Var -> Map Text Scientific -> M ()
forall {t}.
(Uninterned t ~ Text, Uninternable t) =>
t -> Map Text Scientific -> M ()
f Var
col Map Text Scientific
xs
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Var -> Bool
forall a. Set a -> Bool
Set.null Set Var
ivs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    [Text] -> M ()
writeFields [Text
"", Text
"MARK0000", Text
"'MARKER'", Text
"", Text
"'INTORG'"]
    [(Var, Map Text Scientific)]
-> ((Var, Map Text Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Var (Map Text Scientific) -> [(Var, Map Text Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList ((Var -> Map Text Scientific -> Bool)
-> Map Var (Map Text Scientific) -> Map Var (Map Text Scientific)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Var
col Map Text Scientific
_ -> Var
col Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
ivs) Map Var (Map Text Scientific)
cols)) (((Var, Map Text Scientific) -> M ()) -> M ())
-> ((Var, Map Text Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
col, Map Text Scientific
xs) -> Var -> Map Text Scientific -> M ()
forall {t}.
(Uninterned t ~ Text, Uninternable t) =>
t -> Map Text Scientific -> M ()
f Var
col Map Text Scientific
xs
    [Text] -> M ()
writeFields [Text
"", Text
"MARK0001", Text
"'MARKER'", Text
"", Text
"'INTEND'"]

  -- RHS section
  let rs :: [(Text, Scientific)]
rs = [(Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Constraint Scientific -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint Scientific
c, Scientific
rhs) | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip [Constraint Scientific]
-> [Constraint Scientific] -> [Constraint Scientific]
forall a. [a] -> [a] -> [a]
++ Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip, let ((RelOp
_,Scientific
rhs),Maybe Scientific
_) = Constraint Scientific -> ((RelOp, Scientific), Maybe Scientific)
forall {a}. (Ord a, Num a) => Constraint a -> ((RelOp, a), Maybe a)
splitRange Constraint Scientific
c, Scientific
rhs Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
/= Scientific
0]
  Text -> M ()
writeSectionHeader Text
"RHS"
  [(Text, Scientific)] -> ((Text, Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Scientific)]
rs (((Text, Scientific) -> M ()) -> M ())
-> ((Text, Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Text
name, Scientific
val) -> do
    [Text] -> M ()
writeFields [Text
"", Text
"rhs", Text
name, Scientific -> Text
showValue Scientific
val]

  -- RANGES section
  let rngs :: [(Text, Scientific)]
rngs = [(Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Constraint Scientific -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint Scientific
c, Maybe Scientific -> Scientific
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Scientific
rng) | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip [Constraint Scientific]
-> [Constraint Scientific] -> [Constraint Scientific]
forall a. [a] -> [a] -> [a]
++ Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip, let ((RelOp
_,Scientific
_), Maybe Scientific
rng) = Constraint Scientific -> ((RelOp, Scientific), Maybe Scientific)
forall {a}. (Ord a, Num a) => Constraint a -> ((RelOp, a), Maybe a)
splitRange Constraint Scientific
c, Maybe Scientific -> Bool
forall a. Maybe a -> Bool
isJust Maybe Scientific
rng]
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Text, Scientific)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Scientific)]
rngs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeSectionHeader Text
"RANGES"
    [(Text, Scientific)] -> ((Text, Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Scientific)]
rngs (((Text, Scientific) -> M ()) -> M ())
-> ((Text, Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Text
name, Scientific
val) -> do
      [Text] -> M ()
writeFields [Text
"", Text
"rhs", Text
name, Scientific -> Text
showValue Scientific
val]

  -- BOUNDS section
  Text -> M ()
writeSectionHeader Text
"BOUNDS"
  [(Var, VarType)] -> ((Var, VarType) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Var VarType -> [(Var, VarType)]
forall k a. Map k a -> [(k, a)]
Map.toList (Problem Scientific -> Map Var VarType
forall c. Problem c -> Map Var VarType
MIP.varType Problem Scientific
mip)) (((Var, VarType) -> M ()) -> M ())
-> ((Var, VarType) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
col, VarType
vt) -> do
    let (Extended Scientific
lb,Extended Scientific
ub) = Problem Scientific
-> Var -> (Extended Scientific, Extended Scientific)
forall c. Num c => Problem c -> Var -> Bounds c
MIP.getBounds Problem Scientific
mip Var
col
    case (Extended Scientific
lb,Extended Scientific
ub)  of
      (Extended Scientific
MIP.NegInf, Extended Scientific
MIP.PosInf) -> do
        -- free variable (no lower or upper bound)
        [Text] -> M ()
writeFields [Text
"FR", Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col]

      (MIP.Finite Scientific
0, MIP.Finite Scientific
1) | VarType
vt VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
== VarType
MIP.IntegerVariable -> do
        -- variable is binary (equal 0 or 1)
        [Text] -> M ()
writeFields [Text
"BV", Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col]

      (MIP.Finite Scientific
a, MIP.Finite Scientific
b) | Scientific
a Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
b -> do
        -- variable is fixed at the specified value
        [Text] -> M ()
writeFields [Text
"FX", Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col, Scientific -> Text
showValue Scientific
a]

      (Extended Scientific, Extended Scientific)
_ -> do
        case Extended Scientific
lb of
          Extended Scientific
MIP.PosInf -> String -> M ()
forall a. HasCallStack => String -> a
error String
"should not happen"
          Extended Scientific
MIP.NegInf -> do
            -- Minus infinity
            [Text] -> M ()
writeFields [Text
"MI", Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col]
          MIP.Finite Scientific
0 | VarType
vt VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
== VarType
MIP.ContinuousVariable -> () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          MIP.Finite Scientific
a -> do
            let t :: Text
t = case VarType
vt of
                      VarType
MIP.IntegerVariable -> Text
"LI" -- lower bound for integer variable
                      VarType
_ -> Text
"LO" -- Lower bound
            [Text] -> M ()
writeFields [Text
t, Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col, Scientific -> Text
showValue Scientific
a]

        case Extended Scientific
ub of
          Extended Scientific
MIP.NegInf -> String -> M ()
forall a. HasCallStack => String -> a
error String
"should not happen"
          Extended Scientific
MIP.PosInf | VarType
vt VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
== VarType
MIP.ContinuousVariable -> () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Extended Scientific
MIP.PosInf -> do
            Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VarType
vt VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
== VarType
MIP.SemiContinuousVariable Bool -> Bool -> Bool
|| VarType
vt VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
== VarType
MIP.SemiIntegerVariable) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$
              String -> M ()
forall a. HasCallStack => String -> a
error String
"cannot express +inf upper bound of semi-continuous or semi-integer variable"
            [Text] -> M ()
writeFields [Text
"PL", Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col] -- Plus infinity
          MIP.Finite Scientific
a -> do
            let t :: Text
t = case VarType
vt of
                      VarType
MIP.SemiContinuousVariable -> Text
"SC" -- Upper bound for semi-continuous variable
                      VarType
MIP.SemiIntegerVariable ->
                        -- Gurobi uses "SC" while lpsolve uses "SI" for upper bound of semi-integer variable
                        Text
"SC"
                      VarType
MIP.IntegerVariable -> Text
"UI" -- Upper bound for integer variable
                      VarType
_ -> Text
"UP" -- Upper bound
            [Text] -> M ()
writeFields [Text
t, Text
"bound", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
col, Scientific -> Text
showValue Scientific
a]

  -- QMATRIX section
  -- Gurobiは対称行列になっていないと "qmatrix isn't symmetric" というエラーを発生させる
  do let qm :: Map (Var, Var) Scientific
qm = (Scientific -> Scientific)
-> Map (Var, Var) Scientific -> Map (Var, Var) Scientific
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Scientific
2Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
*) (Map (Var, Var) Scientific -> Map (Var, Var) Scientific)
-> Map (Var, Var) Scientific -> Map (Var, Var) Scientific
forall a b. (a -> b) -> a -> b
$ Expr Scientific -> Map (Var, Var) Scientific
forall r. Fractional r => Expr r -> Map (Var, Var) r
quadMatrix Expr Scientific
obj
     Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map (Var, Var) Scientific -> Bool
forall k a. Map k a -> Bool
Map.null Map (Var, Var) Scientific
qm) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
       Text -> M ()
writeSectionHeader Text
"QMATRIX"
       [((Var, Var), Scientific)]
-> (((Var, Var), Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Var, Var) Scientific -> [((Var, Var), Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Var, Var) Scientific
qm) ((((Var, Var), Scientific) -> M ()) -> M ())
-> (((Var, Var), Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(((Var
v1,Var
v2), Scientific
val)) -> do
         [Text] -> M ()
writeFields [Text
"", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
v1, Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
v2, Scientific -> Text
showValue Scientific
val]

  -- SOS section
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SOSConstraint Scientific] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Problem Scientific -> [SOSConstraint Scientific]
forall c. Problem c -> [SOSConstraint c]
MIP.sosConstraints Problem Scientific
mip)) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeSectionHeader Text
"SOS"
    [SOSConstraint Scientific]
-> (SOSConstraint Scientific -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Problem Scientific -> [SOSConstraint Scientific]
forall c. Problem c -> [SOSConstraint c]
MIP.sosConstraints Problem Scientific
mip) ((SOSConstraint Scientific -> M ()) -> M ())
-> (SOSConstraint Scientific -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \SOSConstraint Scientific
sos -> do
      let t :: Text
t = case SOSConstraint Scientific -> SOSType
forall c. SOSConstraint c -> SOSType
MIP.sosType SOSConstraint Scientific
sos of
                SOSType
MIP.S1 -> Text
"S1"
                SOSType
MIP.S2 -> Text
"S2"
      [Text] -> M ()
writeFields ([Text] -> M ()) -> [Text] -> M ()
forall a b. (a -> b) -> a -> b
$ Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (SOSConstraint Scientific -> Maybe Text
forall c. SOSConstraint c -> Maybe Text
MIP.sosLabel SOSConstraint Scientific
sos)
      [(Var, Scientific)] -> ((Var, Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SOSConstraint Scientific -> [(Var, Scientific)]
forall c. SOSConstraint c -> [(Var, c)]
MIP.sosBody SOSConstraint Scientific
sos) (((Var, Scientific) -> M ()) -> M ())
-> ((Var, Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
var,Scientific
val) -> do
        [Text] -> M ()
writeFields [Text
"", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
var, Scientific -> Text
showValue Scientific
val]

  -- QCMATRIX section
  let xs :: [(Text, Map (Var, Var) Scientific)]
xs = [ (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Constraint Scientific -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint Scientific
c, Map (Var, Var) Scientific
qm)
           | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip [Constraint Scientific]
-> [Constraint Scientific] -> [Constraint Scientific]
forall a. [a] -> [a] -> [a]
++ Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip
           , let lhs :: Expr Scientific
lhs = Constraint Scientific -> Expr Scientific
forall c. Constraint c -> Expr c
MIP.constrExpr Constraint Scientific
c
           , let qm :: Map (Var, Var) Scientific
qm = Expr Scientific -> Map (Var, Var) Scientific
forall r. Fractional r => Expr r -> Map (Var, Var) r
quadMatrix Expr Scientific
lhs
           , Bool -> Bool
not (Map (Var, Var) Scientific -> Bool
forall k a. Map k a -> Bool
Map.null Map (Var, Var) Scientific
qm) ]
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Text, Map (Var, Var) Scientific)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Map (Var, Var) Scientific)]
xs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    [(Text, Map (Var, Var) Scientific)]
-> ((Text, Map (Var, Var) Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Map (Var, Var) Scientific)]
xs (((Text, Map (Var, Var) Scientific) -> M ()) -> M ())
-> ((Text, Map (Var, Var) Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Text
r, Map (Var, Var) Scientific
qm) -> do
      -- The name starts in column 12 in fixed formats.
      Text -> M ()
writeSectionHeader (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Text
"QCMATRIX" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
3 Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r
      [((Var, Var), Scientific)]
-> (((Var, Var), Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Var, Var) Scientific -> [((Var, Var), Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Var, Var) Scientific
qm) ((((Var, Var), Scientific) -> M ()) -> M ())
-> (((Var, Var), Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \((Var
v1,Var
v2), Scientific
val) -> do
        [Text] -> M ()
writeFields [Text
"", Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
v1, Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
v2, Scientific -> Text
showValue Scientific
val]

  -- INDICATORS section
  -- Note: Gurobi-5.6.3 does not support this section.
  let ics :: [Constraint Scientific]
ics = [Constraint Scientific
c | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip, Maybe (Var, Scientific) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Var, Scientific) -> Bool)
-> Maybe (Var, Scientific) -> Bool
forall a b. (a -> b) -> a -> b
$ Constraint Scientific -> Maybe (Var, Scientific)
forall c. Constraint c -> Maybe (Var, c)
MIP.constrIndicator Constraint Scientific
c]
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Constraint Scientific] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint Scientific]
ics) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeSectionHeader Text
"INDICATORS"
    [Constraint Scientific] -> (Constraint Scientific -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Constraint Scientific]
ics ((Constraint Scientific -> M ()) -> M ())
-> (Constraint Scientific -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \Constraint Scientific
c -> do
      let Just (Var
var,Scientific
val) = Constraint Scientific -> Maybe (Var, Scientific)
forall c. Constraint c -> Maybe (Var, c)
MIP.constrIndicator Constraint Scientific
c
      [Text] -> M ()
writeFields [Text
"IF", Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Constraint Scientific -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint Scientific
c), Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
var, Scientific -> Text
showValue Scientific
val]

  -- ENDATA section
  Text -> M ()
writeSectionHeader Text
"ENDATA"

writeSectionHeader :: T.Text -> M ()
writeSectionHeader :: Text -> M ()
writeSectionHeader Text
s = Text -> M ()
writeText Text
s M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> M ()
writeChar Char
'\n'

-- Fields start in column 2, 5, 15, 25, 40 and 50
writeFields :: [T.Text] -> M ()
writeFields :: [Text] -> M ()
writeFields [Text]
xs0 = [Text] -> M ()
f1 [Text]
xs0 M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> M ()
writeChar Char
'\n'
  where
    -- columns 1-4
    f1 :: [Text] -> M ()
f1 [] = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f1 [Text
x] = Char -> M ()
writeChar Char
' ' M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> M ()
writeText Text
x
    f1 (Text
x:[Text]
xs) = do
      Char -> M ()
writeChar Char
' '
      Text -> M ()
writeText Text
x
      let len :: Int
len = Text -> Int
T.length Text
x
      Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
writeText (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
" "
      Char -> M ()
writeChar Char
' '
      [Text] -> M ()
f2 [Text]
xs

    -- columns 5-14
    f2 :: [Text] -> M ()
f2 [] = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f2 [Text
x] = Text -> M ()
writeText Text
x
    f2 (Text
x:[Text]
xs) = do
      Text -> M ()
writeText Text
x
      let len :: Int
len = Text -> Int
T.length Text
x
      Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
writeText (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
" "
      Char -> M ()
writeChar Char
' '
      [Text] -> M ()
f3 [Text]
xs

    -- columns 15-24
    f3 :: [Text] -> M ()
f3 [] = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f3 [Text
x] = Text -> M ()
writeText Text
x
    f3 (Text
x:[Text]
xs) = do
      Text -> M ()
writeText Text
x
      let len :: Int
len = Text -> Int
T.length Text
x
      Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
writeText (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
" "
      Char -> M ()
writeChar Char
' '
      [Text] -> M ()
f4 [Text]
xs

    -- columns 25-39
    f4 :: [Text] -> M ()
f4 [] = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f4 [Text
x] = Text -> M ()
writeText Text
x
    f4 (Text
x:[Text]
xs) = do
      Text -> M ()
writeText Text
x
      let len :: Int
len = Text -> Int
T.length Text
x
      Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
14) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
writeText (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
14 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
" "
      Char -> M ()
writeChar Char
' '
      [Text] -> M ()
f5 [Text]
xs

    -- columns 40-49
    f5 :: [Text] -> M ()
f5 [] = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f5 [Text
x] = Text -> M ()
writeText Text
x
    f5 (Text
x:[Text]
xs) = do
      Text -> M ()
writeText Text
x
      let len :: Int
len = Text -> Int
T.length Text
x
      Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
19) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
writeText (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
19 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
" "
      Char -> M ()
writeChar Char
' '
      [Text] -> M ()
f6 [Text]
xs

    -- columns 50-
    f6 :: [Text] -> M ()
f6 [] = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    f6 [Text
x] = Text -> M ()
writeText Text
x
    f6 [Text]
_ = String -> M ()
forall a. HasCallStack => String -> a
error String
"MPSFile: >6 fields (this should not happen)"

showValue :: Scientific -> T.Text
showValue :: Scientific -> Text
showValue = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
forall a. Show a => a -> String
show

nameRows :: MIP.Problem r -> MIP.Problem r
nameRows :: forall r. Problem r -> Problem r
nameRows Problem r
mip
  = Problem r
mip
  { MIP.objectiveFunction = (MIP.objectiveFunction mip){ MIP.objLabel = Just objName' }
  , MIP.constraints = f (MIP.constraints mip) [T.pack $ "row" ++ show n | n <- [(1::Int)..]]
  , MIP.userCuts = f (MIP.userCuts mip) [T.pack $ "usercut" ++ show n | n <- [(1::Int)..]]
  , MIP.sosConstraints = g (MIP.sosConstraints mip) [T.pack $ "sos" ++ show n | n <- [(1::Int)..]]
  }
  where
    objName :: Maybe Text
objName = ObjectiveFunction r -> Maybe Text
forall c. ObjectiveFunction c -> Maybe Text
MIP.objLabel (ObjectiveFunction r -> Maybe Text)
-> ObjectiveFunction r -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Problem r -> ObjectiveFunction r
forall c. Problem c -> ObjectiveFunction c
MIP.objectiveFunction Problem r
mip
    used :: Set Text
used = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe Text
objName Maybe Text -> [Maybe Text] -> [Maybe Text]
forall a. a -> [a] -> [a]
: [Constraint r -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint r
c | Constraint r
c <- Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem r
mip [Constraint r] -> [Constraint r] -> [Constraint r]
forall a. [a] -> [a] -> [a]
++ Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem r
mip] [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. [a] -> [a] -> [a]
++ [SOSConstraint r -> Maybe Text
forall c. SOSConstraint c -> Maybe Text
MIP.sosLabel SOSConstraint r
c | SOSConstraint r
c <- Problem r -> [SOSConstraint r]
forall c. Problem c -> [SOSConstraint c]
MIP.sosConstraints Problem r
mip]
    objName' :: Text
objName' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text
name | Int
n <- [(Int
1::Int)..], let name :: Text
name = String -> Text
T.pack (String
"obj" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n), Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
used]) Maybe Text
objName

    f :: [Constraint r] -> [Text] -> [Constraint r]
f [] [Text]
_ = []
    f (Constraint r
c:[Constraint r]
cs) (Text
name:[Text]
names)
      | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Constraint r -> Maybe Text
forall c. Constraint c -> Maybe Text
MIP.constrLabel Constraint r
c) = Constraint r
c Constraint r -> [Constraint r] -> [Constraint r]
forall a. a -> [a] -> [a]
: [Constraint r] -> [Text] -> [Constraint r]
f [Constraint r]
cs (Text
nameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
names)
      | Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
used = Constraint r
c{ MIP.constrLabel = Just name } Constraint r -> [Constraint r] -> [Constraint r]
forall a. a -> [a] -> [a]
: [Constraint r] -> [Text] -> [Constraint r]
f [Constraint r]
cs [Text]
names
      | Bool
otherwise = [Constraint r] -> [Text] -> [Constraint r]
f (Constraint r
cConstraint r -> [Constraint r] -> [Constraint r]
forall a. a -> [a] -> [a]
:[Constraint r]
cs) [Text]
names
    f [Constraint r]
_ [] = String -> [Constraint r]
forall a. HasCallStack => String -> a
error String
"should not happen"

    g :: [SOSConstraint r] -> [Text] -> [SOSConstraint r]
g [] [Text]
_ = []
    g (SOSConstraint r
c:[SOSConstraint r]
cs) (Text
name:[Text]
names)
      | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (SOSConstraint r -> Maybe Text
forall c. SOSConstraint c -> Maybe Text
MIP.sosLabel SOSConstraint r
c) = SOSConstraint r
c SOSConstraint r -> [SOSConstraint r] -> [SOSConstraint r]
forall a. a -> [a] -> [a]
: [SOSConstraint r] -> [Text] -> [SOSConstraint r]
g [SOSConstraint r]
cs (Text
nameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
names)
      | Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
used = SOSConstraint r
c{ MIP.sosLabel = Just name } SOSConstraint r -> [SOSConstraint r] -> [SOSConstraint r]
forall a. a -> [a] -> [a]
: [SOSConstraint r] -> [Text] -> [SOSConstraint r]
g [SOSConstraint r]
cs [Text]
names
      | Bool
otherwise = [SOSConstraint r] -> [Text] -> [SOSConstraint r]
g (SOSConstraint r
cSOSConstraint r -> [SOSConstraint r] -> [SOSConstraint r]
forall a. a -> [a] -> [a]
:[SOSConstraint r]
cs) [Text]
names
    g [SOSConstraint r]
_ [] = String -> [SOSConstraint r]
forall a. HasCallStack => String -> a
error String
"should not happen"

quadMatrix :: Fractional r => MIP.Expr r -> Map (MIP.Var, MIP.Var) r
quadMatrix :: forall r. Fractional r => Expr r -> Map (Var, Var) r
quadMatrix Expr r
e = [((Var, Var), r)] -> Map (Var, Var) r
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Var, Var), r)] -> Map (Var, Var) r)
-> [((Var, Var), r)] -> Map (Var, Var) r
forall a b. (a -> b) -> a -> b
$ do
  let m :: Map (Var, Var) r
m = (r -> r -> r) -> [((Var, Var), r)] -> Map (Var, Var) r
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith r -> r -> r
forall a. Num a => a -> a -> a
(+) [(if Var
v1Var -> Var -> Bool
forall a. Ord a => a -> a -> Bool
<=Var
v2 then (Var
v1,Var
v2) else (Var
v2,Var
v1), r
c) | MIP.Term r
c [Var
v1,Var
v2] <- Expr r -> [Term r]
forall c. Expr c -> [Term c]
MIP.terms Expr r
e]
  ((Var
v1,Var
v2),r
c) <- Map (Var, Var) r -> [((Var, Var), r)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Var, Var) r
m
  if Var
v1Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
==Var
v2 then
    [((Var
v1,Var
v2), r
c)]
  else
    [((Var
v1,Var
v2), r
cr -> r -> r
forall a. Fractional a => a -> a -> a
/r
2), ((Var
v2,Var
v1), r
cr -> r -> r
forall a. Fractional a => a -> a -> a
/r
2)]

checkAtMostQuadratic :: forall r. MIP.Problem r -> Bool
checkAtMostQuadratic :: forall r. Problem r -> Bool
checkAtMostQuadratic Problem r
mip =  (Expr r -> Bool) -> [Expr r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Term r -> Bool) -> [Term r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Term r -> Bool
f ([Term r] -> Bool) -> (Expr r -> [Term r]) -> Expr r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr r -> [Term r]
forall c. Expr c -> [Term c]
MIP.terms) [Expr r]
es
  where
    es :: [Expr r]
es = ObjectiveFunction r -> Expr r
forall c. ObjectiveFunction c -> Expr c
MIP.objExpr (Problem r -> ObjectiveFunction r
forall c. Problem c -> ObjectiveFunction c
MIP.objectiveFunction Problem r
mip) Expr r -> [Expr r] -> [Expr r]
forall a. a -> [a] -> [a]
:
         [Expr r
lhs | Constraint r
c <- Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem r
mip [Constraint r] -> [Constraint r] -> [Constraint r]
forall a. [a] -> [a] -> [a]
++ Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem r
mip, let lhs :: Expr r
lhs = Constraint r -> Expr r
forall c. Constraint c -> Expr c
MIP.constrExpr Constraint r
c]
    f :: MIP.Term r -> Bool
    f :: Term r -> Bool
f (MIP.Term r
_ [Var
_]) = Bool
True
    f (MIP.Term r
_ [Var
_,Var
_]) = Bool
True
    f Term r
_ = Bool
False

-- ---------------------------------------------------------------------------