{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
-- 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

import Control.Exception (throwIO)
import Control.Monad
import Control.Monad.Writer
import Data.Default.Class
import Data.Maybe
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
import Text.Megaparsec hiding  (ParseError)
import Text.Megaparsec.Char hiding (string', eol)
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as Lexer

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)

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

type C e s m = (MonadParsec e s m, Token s ~ Char, IsString (Tokens s))

-- | Parse a string containing MPS file data.
-- The source name is only used in error messages and may be the empty string.
parseString :: (Stream s, Token s ~ Char, IsString (Tokens s)) => MIP.FileOptions -> String -> s -> Either (ParseError s) (MIP.Problem Scientific)
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

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


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

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 (Tokens s) -> 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 (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol
  () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

eol' :: C e s m => m ()
eol' :: forall e s (m :: * -> *). C e s m => m ()
eol' = do
  m ()
forall e s (m :: * -> *). C e s m => m ()
spaces'
  Tokens s
_ <- m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol
  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 (m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol 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 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 Row
row = (Text -> Row) -> m Text -> m Row
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Row
Uninterned Row -> Row
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
MIP.Var (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
'\r', 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 ()
eol'

number :: forall e s m. C e s m => m Scientific
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

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

-- | MPS file parser
parser :: (MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) => m (MIP.Problem Scientific)
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, Row)]
rows <- m [(Maybe RelOp, Row)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
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, Row)]
usercuts <- [(Maybe RelOp, Row)]
-> m [(Maybe RelOp, Row)] -> m [(Maybe RelOp, Row)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [(Maybe RelOp, Row)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
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, Row)]
lazycons <- [(Maybe RelOp, Row)]
-> m [(Maybe RelOp, Row)] -> m [(Maybe RelOp, Row)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [(Maybe RelOp, Row)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
lazyConsSection

  (Map Var (Map Row Scientific)
cols, Set Var
intvs1) <- m (Map Var (Map Row Scientific), Set Var)
forall e s (m :: * -> *).
C e s m =>
m (Map Var (Map Row Scientific), Set Var)
colsSection
  Map Row Scientific
rhss <- m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rhsSection
  Map Row Scientific
rngs <- Map Row Scientific
-> m (Map Row Scientific) -> m (Map Row Scientific)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Map Row Scientific
forall k a. Map k a
Map.empty m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row 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 Row [Term Scientific]
qterms <- ([(Row, [Term Scientific])] -> Map Row [Term Scientific])
-> m [(Row, [Term Scientific])] -> m (Map Row [Term Scientific])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Row, [Term Scientific])] -> Map Row [Term Scientific]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(Row, [Term Scientific])] -> m (Map Row [Term Scientific]))
-> m [(Row, [Term Scientific])] -> m (Map Row [Term Scientific])
forall a b. (a -> b) -> a -> b
$ m (Row, [Term Scientific]) -> m [(Row, [Term Scientific])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Row, [Term Scientific])
forall e s (m :: * -> *). C e s m => m (Row, [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 Row (Var, Scientific)
inds <- Map Row (Var, Scientific)
-> m (Map Row (Var, Scientific)) -> m (Map Row (Var, Scientific))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Map Row (Var, Scientific)
forall k a. Map k a
Map.empty m (Map Row (Var, Scientific))
forall e s (m :: * -> *). C e s m => m (Map Row (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 :: Row
objrow =
        case Maybe Text
objname of
          Maybe Text
Nothing -> [Row] -> Row
forall a. HasCallStack => [a] -> a
head [Row
r | (Maybe RelOp
Nothing, Row
r) <- [(Maybe RelOp, Row)]
rows] -- XXX
          Just Text
r  -> Uninterned Row -> Row
forall t. Interned t => Uninterned t -> t
intern Text
Uninterned Row
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 Row Scientific) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet Map Var (Map Row 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 Row (Map Var Scientific)
rowCoeffs = (Map Var Scientific -> Map Var Scientific -> Map Var Scientific)
-> [(Row, Map Var Scientific)] -> Map Row (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 [(Row
r, Var -> Scientific -> Map Var Scientific
forall k a. k -> a -> Map k a
Map.singleton Var
col Scientific
coeff) | (Var
col,Map Row Scientific
m) <- Map Var (Map Row Scientific) -> [(Var, Map Row Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Var (Map Row Scientific)
cols, (Row
r,Scientific
coeff) <- Map Row Scientific -> [(Row, Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Row Scientific
m]

  let f :: Bool -> (Maybe MIP.RelOp, Row) -> [MIP.Constraint Scientific]
      f :: Bool -> (Maybe RelOp, Row) -> [Constraint Scientific]
f Bool
_isLazy (Maybe RelOp
Nothing, Row
_row) = []
      f Bool
isLazy (Just RelOp
op, Row
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
-> Row -> Map Row (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 Row
r Map Row (Map Var Scientific)
rowCoeffs)]
                  [Term Scientific] -> [Term Scientific] -> [Term Scientific]
forall a. [a] -> [a] -> [a]
++ [Term Scientific]
-> Row -> Map Row [Term Scientific] -> [Term Scientific]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Row
r Map Row [Term Scientific]
qterms
        let rhs :: Scientific
rhs = Scientific -> Row -> Map Row Scientific -> Scientific
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Scientific
0 Row
r Map Row Scientific
rhss
            (Extended Scientific
lb,Extended Scientific
ub) =
              case Row -> Map Row Scientific -> Maybe Scientific
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Row
r Map Row 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
$ Row -> Uninterned Row
forall t. Uninternable t => t -> Uninterned t
unintern Row
r
          , constrIndicator :: Maybe (Var, Scientific)
MIP.constrIndicator = Row -> Map Row (Var, Scientific) -> Maybe (Var, Scientific)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Row
r Map Row (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, Row) -> [Constraint Scientific])
-> [(Maybe RelOp, Row)] -> [Constraint Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Maybe RelOp, Row) -> [Constraint Scientific]
f Bool
False) [(Maybe RelOp, Row)]
rows [Constraint Scientific]
-> [Constraint Scientific] -> [Constraint Scientific]
forall a. [a] -> [a] -> [a]
++ ((Maybe RelOp, Row) -> [Constraint Scientific])
-> [(Maybe RelOp, Row)] -> [Constraint Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Maybe RelOp, Row) -> [Constraint Scientific]
f Bool
True) [(Maybe RelOp, Row)]
lazycons
        , sosConstraints :: [SOSConstraint Scientific]
MIP.sosConstraints        = [SOSConstraint Scientific]
sos
        , userCuts :: [Constraint Scientific]
MIP.userCuts              = ((Maybe RelOp, Row) -> [Constraint Scientific])
-> [(Maybe RelOp, Row)] -> [Constraint Scientific]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Maybe RelOp, Row) -> [Constraint Scientific]
f Bool
False) [(Maybe RelOp, Row)]
usercuts
        , varDomains :: Map Var (VarType, (Extended Scientific, Extended Scientific))
MIP.varDomains            = [(Var, (VarType, (Extended Scientific, Extended Scientific)))]
-> Map Var (VarType, (Extended Scientific, Extended Scientific))
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
            [ (Var
v, (VarType
t, (Extended Scientific, Extended Scientific)
bs))
            | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
vs
            , let t :: VarType
t =
                    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
            , let bs :: (Extended Scientific, Extended Scientific)
bs = (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
            ]
        }

  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 ()
eol'
  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 ()
eol'
  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, Row)]
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, Row)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
rowsBody

userCutsSection :: C e s m => m [(Maybe MIP.RelOp, Row)]
userCutsSection :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
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, Row)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
rowsBody

lazyConsSection :: C e s m => m [(Maybe MIP.RelOp, Row)]
lazyConsSection :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
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, Row)]
forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
rowsBody

rowsBody :: C e s m => m [(Maybe MIP.RelOp, Row)]
rowsBody :: forall e s (m :: * -> *). C e s m => m [(Maybe RelOp, Row)]
rowsBody = m (Maybe RelOp, Row) -> m [(Maybe RelOp, Row)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Maybe RelOp, Row) -> m [(Maybe RelOp, Row)])
-> m (Maybe RelOp, Row) -> m [(Maybe RelOp, Row)]
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'
  Row
name <- m Row
forall e s (m :: * -> *). C e s m => m Row
row
  m ()
forall e s (m :: * -> *). C e s m => m ()
eol'
  (Maybe RelOp, Row) -> m (Maybe RelOp, Row)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RelOp
op, Row
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 Row 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 Row Scientific)
-> Set Var
-> m (Map Var (Map Row Scientific), Set Var)
body Bool
False Map Var (Map Row 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 Row Scientific)
-> Set Var
-> m (Map Var (Map Row Scientific), Set Var)
body Bool
isInt Map Var (Map Row Scientific)
rs Set Var
ivs = [m (Map Var (Map Row Scientific), Set Var)]
-> m (Map Var (Map Row 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 Row Scientific), Set Var)]
-> m (Map Var (Map Row 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 Row Scientific)
-> Set Var
-> m (Map Var (Map Row Scientific), Set Var)
body Bool
isInt' Map Var (Map Row Scientific)
rs Set Var
ivs
             , do (Var
k,Map Row Scientific
v) <- Text -> m (Var, Map Row Scientific)
entry Text
x
                  let rs' :: Map Var (Map Row Scientific)
rs'  = (Map Row Scientific -> Map Row Scientific -> Map Row Scientific)
-> Var
-> Map Row Scientific
-> Map Var (Map Row Scientific)
-> Map Var (Map Row Scientific)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Map Row Scientific -> Map Row Scientific -> Map Row Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Var
k Map Row Scientific
v Map Var (Map Row 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 Row Scientific)
-> m (Map Var (Map Row Scientific), Set Var)
-> m (Map Var (Map Row Scientific), Set Var)
forall a b. a -> b -> b
seq Map Var (Map Row Scientific)
rs' (m (Map Var (Map Row Scientific), Set Var)
 -> m (Map Var (Map Row Scientific), Set Var))
-> m (Map Var (Map Row Scientific), Set Var)
-> m (Map Var (Map Row Scientific), Set Var)
forall a b. (a -> b) -> a -> b
$ Set Var
-> m (Map Var (Map Row Scientific), Set Var)
-> m (Map Var (Map Row Scientific), Set Var)
forall a b. a -> b -> b
seq Set Var
ivs' (m (Map Var (Map Row Scientific), Set Var)
 -> m (Map Var (Map Row Scientific), Set Var))
-> m (Map Var (Map Row Scientific), Set Var)
-> m (Map Var (Map Row Scientific), Set Var)
forall a b. (a -> b) -> a -> b
$ Bool
-> Map Var (Map Row Scientific)
-> Set Var
-> m (Map Var (Map Row Scientific), Set Var)
body Bool
isInt Map Var (Map Row Scientific)
rs' Set Var
ivs'
             ]
      , (Map Var (Map Row Scientific), Set Var)
-> m (Map Var (Map Row Scientific), Set Var)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var (Map Row 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 ()
eol'
      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 Row Scientific)
entry Text
x = do
      let col :: Var
col = Text -> Var
MIP.Var Text
x
      Map Row Scientific
rv1 <- m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rowAndVal
      Maybe (Map Row Scientific)
opt <- m (Map Row Scientific) -> m (Maybe (Map Row Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rowAndVal
      m ()
forall e s (m :: * -> *). C e s m => m ()
eol'
      case Maybe (Map Row Scientific)
opt of
        Maybe (Map Row Scientific)
Nothing -> (Var, Map Row Scientific) -> m (Var, Map Row Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
col, Map Row Scientific
rv1)
        Just Map Row Scientific
rv2 ->  (Var, Map Row Scientific) -> m (Var, Map Row Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
col, Map Row Scientific -> Map Row Scientific -> Map Row Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Row Scientific
rv1 Map Row Scientific
rv2)

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

rhsSection :: C e s m => m (Map Row Scientific)
rhsSection :: forall e s (m :: * -> *). C e s m => m (Map Row 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 Row Scientific] -> Map Row Scientific)
-> m [Map Row Scientific] -> m (Map Row Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Map Row Scientific] -> Map Row Scientific
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (m [Map Row Scientific] -> m (Map Row Scientific))
-> m [Map Row Scientific] -> m (Map Row Scientific)
forall a b. (a -> b) -> a -> b
$ m (Map Row Scientific) -> m [Map Row Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Map Row Scientific)
entry
  where
    entry :: m (Map Row 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 Row Scientific
rv1 <- m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rowAndVal
      Maybe (Map Row Scientific)
opt <- m (Map Row Scientific) -> m (Maybe (Map Row Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rowAndVal
      m ()
forall e s (m :: * -> *). C e s m => m ()
eol'
      case Maybe (Map Row Scientific)
opt of
        Maybe (Map Row Scientific)
Nothing  -> Map Row Scientific -> m (Map Row Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Row Scientific
rv1
        Just Map Row Scientific
rv2 -> Map Row Scientific -> m (Map Row Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Row Scientific -> m (Map Row Scientific))
-> Map Row Scientific -> m (Map Row Scientific)
forall a b. (a -> b) -> a -> b
$ Map Row Scientific -> Map Row Scientific -> Map Row Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Row Scientific
rv1 Map Row Scientific
rv2

rangesSection :: C e s m => m (Map Row Scientific)
rangesSection :: forall e s (m :: * -> *). C e s m => m (Map Row 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 Row Scientific] -> Map Row Scientific)
-> m [Map Row Scientific] -> m (Map Row Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Map Row Scientific] -> Map Row Scientific
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (m [Map Row Scientific] -> m (Map Row Scientific))
-> m [Map Row Scientific] -> m (Map Row Scientific)
forall a b. (a -> b) -> a -> b
$ m (Map Row Scientific) -> m [Map Row Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Map Row Scientific)
entry
  where
    entry :: m (Map Row 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 Row Scientific
rv1 <- m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rowAndVal
      Maybe (Map Row Scientific)
opt <- m (Map Row Scientific) -> m (Maybe (Map Row Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Map Row Scientific)
forall e s (m :: * -> *). C e s m => m (Map Row Scientific)
rowAndVal
      m ()
forall e s (m :: * -> *). C e s m => m ()
eol'
      case Maybe (Map Row Scientific)
opt of
        Maybe (Map Row Scientific)
Nothing  -> Map Row Scientific -> m (Map Row Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Row Scientific
rv1
        Just Map Row Scientific
rv2 -> Map Row Scientific -> m (Map Row Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Row Scientific -> m (Map Row Scientific))
-> Map Row Scientific -> m (Map Row Scientific)
forall a b. (a -> b) -> a -> b
$ Map Row Scientific -> Map Row Scientific -> Map Row Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Row Scientific
rv1 Map Row 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 ()
eol'
      (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 ()
eol'
      [(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 ()
eol'
      (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 ()
eol'
      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 ()
eol'
      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 (Row, [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'
  Row
r <- m Row
forall e s (m :: * -> *). C e s m => m Row
row
  m ()
forall e s (m :: * -> *). C e s m => m ()
eol'
  [Term Scientific]
xs <- m (Term Scientific) -> m [Term Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Term Scientific)
entry
  (Row, [Term Scientific]) -> m (Row, [Term Scientific])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Row
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 ()
eol'
      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 Row (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"
  ([(Row, (Var, Scientific))] -> Map Row (Var, Scientific))
-> m [(Row, (Var, Scientific))] -> m (Map Row (Var, Scientific))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Row, (Var, Scientific))] -> Map Row (Var, Scientific)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(Row, (Var, Scientific))] -> m (Map Row (Var, Scientific)))
-> m [(Row, (Var, Scientific))] -> m (Map Row (Var, Scientific))
forall a b. (a -> b) -> a -> b
$ m (Row, (Var, Scientific)) -> m [(Row, (Var, Scientific))]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Row, (Var, Scientific))
entry
  where
    entry :: m (Row, (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'
      Row
r <- m Row
forall e s (m :: * -> *). C e s m => m Row
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 ()
eol'
      (Row, (Var, Scientific)) -> m (Row, (Var, Scientific))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Row
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
opt 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
$ FileOptions -> Problem Scientific -> M ()
render' FileOptions
opt (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.FileOptions -> MIP.Problem Scientific -> M ()
render' :: FileOptions -> Problem Scientific -> M ()
render' FileOptions
opt 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
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FileOptions -> WriteSetting
MIP.optMPSWriteObjSense FileOptions
opt WriteSetting -> WriteSetting -> Bool
forall a. Eq a => a -> a -> Bool
== WriteSetting
MIP.WriteAlways Bool -> Bool -> Bool
||
        FileOptions -> WriteSetting
MIP.optMPSWriteObjSense FileOptions
opt WriteSetting -> WriteSetting -> Bool
forall a. Eq a => a -> a -> Bool
== WriteSetting
MIP.WriteIfNotDefault Bool -> Bool -> Bool
&& OptDir
dir OptDir -> OptDir -> Bool
forall a. Eq a => a -> a -> Bool
/= OptDir
OptMin) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    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.
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FileOptions -> Bool
MIP.optMPSWriteObjName FileOptions
opt) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeSectionHeader Text
"OBJNAME"
    [Text] -> M ()
writeFields [Text
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 :: Var -> Map Text Scientific -> M ()
f Var
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
"", Var -> Text
MIP.varName Var
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 ()
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 ()
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, (Extended Scientific, Extended Scientific)))]
-> ((Var, (VarType, (Extended Scientific, Extended Scientific)))
    -> M ())
-> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Var (VarType, (Extended Scientific, Extended Scientific))
-> [(Var, (VarType, (Extended Scientific, Extended Scientific)))]
forall k a. Map k a -> [(k, a)]
Map.toList (Problem Scientific
-> Map Var (VarType, (Extended Scientific, Extended Scientific))
forall c. Problem c -> Map Var (VarType, Bounds c)
MIP.varDomains Problem Scientific
mip)) (((Var, (VarType, (Extended Scientific, Extended Scientific)))
  -> M ())
 -> M ())
-> ((Var, (VarType, (Extended Scientific, Extended Scientific)))
    -> M ())
-> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
col, (VarType
vt, (Extended Scientific, Extended Scientific)
_)) -> 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 -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName Var
v1, Var -> Text
MIP.varName 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 -> Text
MIP.varName 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 -> Text
MIP.varName Var
v1, Var -> Text
MIP.varName 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 -> Text
MIP.varName 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

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