{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.LPFile
-- Copyright   :  (c) Masahiro Sakai 2011-2014
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- A CPLEX @.lp@ format parser library.
--
-- References:
--
-- * <http://publib.boulder.ibm.com/infocenter/cosinfoc/v12r2/index.jsp?topic=/ilog.odms.cplex.help/Content/Optimization/Documentation/CPLEX/_pubskel/CPLEX880.html>
--
-- * <http://www.gurobi.com/doc/45/refman/node589.html>
--
-- * <http://lpsolve.sourceforge.net/5.5/CPLEX-format.htm>
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.LPFile
  ( parseString
  , parseFile
  , ParseError
  , parser
  , render
  ) where

import Control.Applicative hiding (many)
import Control.Exception (throwIO)
import Control.Monad
import Control.Monad.Writer
import Control.Monad.ST
import Data.Char
import Data.Default.Class
import Data.Interned
import Data.List
import Data.Maybe
#if !MIN_VERSION_base(4,9,0)
import Data.Monoid
#endif
import Data.Scientific (Scientific)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.STRef
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.Builder.Scientific as B
import qualified Data.Text.Lazy.IO as TLIO
import Data.OptDir
import System.IO
#if MIN_VERSION_megaparsec(6,0,0)
import Text.Megaparsec hiding (label, skipManyTill, ParseError)
import Text.Megaparsec.Char hiding (string', char')
import qualified Text.Megaparsec.Char.Lexer as P
#else
import Text.Megaparsec hiding (label, string', char', ParseError)
import qualified Text.Megaparsec.Lexer as P
import Text.Megaparsec.Prim (MonadParsec ())
#endif

import qualified Numeric.Optimization.MIP.Base as MIP
import Numeric.Optimization.MIP.FileUtils (ParseError)
import Numeric.Optimization.MIP.Internal.Util (combineMaybe)

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

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

-- | Parse a string containing LP file data.
-- The source name is only used in error messages and may be the empty string.
#if MIN_VERSION_megaparsec(6,0,0)
parseString :: (Stream s, Token s ~ Char, IsString (Tokens s)) => MIP.FileOptions -> String -> s -> Either (ParseError s) (MIP.Problem Scientific)
#else
parseString :: (Stream s, Token s ~ Char) => MIP.FileOptions -> String -> s -> Either (ParseError s) (MIP.Problem Scientific)
#endif
parseString :: FileOptions
-> String -> s -> Either (ParseError s) (Problem Scientific)
parseString FileOptions
_ = Parsec Void s (Problem Scientific)
-> String -> s -> Either (ParseError s) (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 (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 LP 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 (m :: * -> *) a. Monad m => a -> m a
return ()
    Just TextEncoding
enc -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc
  Either (ParseErrorBundle Text Void) (Problem Scientific)
ret <- Parsec Void Text (Problem Scientific)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (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 (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 (ParseErrorBundle Text Void) (Problem Scientific))
-> IO Text
-> IO (Either (ParseErrorBundle Text Void) (Problem Scientific))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Text
TLIO.hGetContents Handle
h
  case Either (ParseErrorBundle Text Void) (Problem Scientific)
ret of
    Left ParseErrorBundle Text Void
e -> ParseErrorBundle Text Void -> IO (Problem Scientific)
forall e a. Exception e => e -> IO a
throwIO (ParseErrorBundle Text Void
e :: ParseError TL.Text)
    Right Problem Scientific
a -> Problem Scientific -> IO (Problem Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Problem Scientific
a

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

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

char' :: C e s m => Char -> m Char
char' :: Char -> m Char
char' Char
c = (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
c m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (Char -> Char
toUpper Char
c)) m Char -> String -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> Char -> String
forall a. Show a => a -> String
show Char
c

string' :: C e s m => String -> m ()
string' :: String -> m ()
string' String
s = (Char -> m Char) -> String -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> m Char
forall e s (m :: * -> *). C e s m => Char -> m Char
char' String
s m () -> String -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String -> String
forall a. Show a => a -> String
show String
s

sep :: C e s m => m ()
sep :: m ()
sep = m () -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ((m ()
forall e s (m :: * -> *). C e s m => m ()
comment m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

comment :: C e s m => m ()
comment :: m ()
comment = do
  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
'\\'
  m Char -> m Char -> m ()
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m ()
skipManyTill m Char
forall e s (m :: * -> *). C e s m => m Char
anyChar (m Char -> m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)

tok :: C e s m => m a -> m a
tok :: m a -> m a
tok m a
p = do
  a
x <- m a
p
  m ()
forall e s (m :: * -> *). C e s m => m ()
sep
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

ident :: C e s m => m String
ident :: m String
ident = 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
$ do
  Char
x <- m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token s] -> m (Token s)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token s]
syms1
  String
xs <- m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token s] -> m (Token s)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token s]
syms2)
  let s :: String
s = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set String
reserved
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
  where
    syms1 :: String
syms1 = String
"!\"#$%&()/,;?@_`'{}|~"
    syms2 :: String
syms2 = Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
syms1

variable :: C e s m => m MIP.Var
variable :: m Var
variable = (String -> Var) -> m String -> m Var
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Var
MIP.toVar m String
forall e s (m :: * -> *). C e s m => m String
ident

label :: C e s m => m MIP.Label
label :: m Label
label = do
  String
name <- m String
forall e s (m :: * -> *). C e s m => m String
ident
  m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m Char -> m Char) -> m Char -> m Char
forall a b. (a -> b) -> a -> b
$ 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
':'
  Label -> m Label
forall (m :: * -> *) a. Monad m => a -> m a
return (Label -> m Label) -> Label -> m Label
forall a b. (a -> b) -> a -> b
$! String -> Label
T.pack String
name

reserved :: Set String
reserved :: Set String
reserved = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList
  [ String
"bound", String
"bounds"
  , String
"gen", String
"general", String
"generals"
  , String
"bin", String
"binary", String
"binaries"
  , String
"semi", String
"semi-continuous", String
"semis"
  , String
"sos"
  , String
"end"
  , String
"subject"
  ]

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

-- | LP file parser
#if MIN_VERSION_megaparsec(6,0,0)
parser :: (MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) => m (MIP.Problem Scientific)
#else
parser :: (MonadParsec e s m, Token s ~ Char) => m (MIP.Problem Scientific)
#endif
parser :: m (Problem Scientific)
parser = do
  Maybe Label
name <- m Label -> m (Maybe Label)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Label -> m (Maybe Label)) -> m Label -> m (Maybe Label)
forall a b. (a -> b) -> a -> b
$ m Label -> m Label
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Label -> m Label) -> m Label -> m Label
forall a b. (a -> b) -> a -> b
$ do
    m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"\\* Problem: "
    (String -> Label) -> m String -> m Label
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Label
forall a. IsString a => String -> a
fromString (m String -> m Label) -> m String -> m Label
forall a b. (a -> b) -> a -> b
$ 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) -> m (Tokens s)
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
" *\\\n"))
  m ()
forall e s (m :: * -> *). C e s m => m ()
sep
  ObjectiveFunction Scientific
obj <- m (ObjectiveFunction Scientific)
forall e s (m :: * -> *).
C e s m =>
m (ObjectiveFunction Scientific)
problem

  [Either (Constraint Scientific) (Constraint Scientific)]
cs <- ([[Either (Constraint Scientific) (Constraint Scientific)]]
 -> [Either (Constraint Scientific) (Constraint Scientific)])
-> m [[Either (Constraint Scientific) (Constraint Scientific)]]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Either (Constraint Scientific) (Constraint Scientific)]]
-> [Either (Constraint Scientific) (Constraint Scientific)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[Either (Constraint Scientific) (Constraint Scientific)]]
 -> m [Either (Constraint Scientific) (Constraint Scientific)])
-> m [[Either (Constraint Scientific) (Constraint Scientific)]]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall a b. (a -> b) -> a -> b
$ m [Either (Constraint Scientific) (Constraint Scientific)]
-> m [[Either (Constraint Scientific) (Constraint Scientific)]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m [Either (Constraint Scientific) (Constraint Scientific)]
 -> m [[Either (Constraint Scientific) (Constraint Scientific)]])
-> m [Either (Constraint Scientific) (Constraint Scientific)]
-> m [[Either (Constraint Scientific) (Constraint Scientific)]]
forall a b. (a -> b) -> a -> b
$ [m [Either (Constraint Scientific) (Constraint Scientific)]]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([m [Either (Constraint Scientific) (Constraint Scientific)]]
 -> m [Either (Constraint Scientific) (Constraint Scientific)])
-> [m [Either (Constraint Scientific) (Constraint Scientific)]]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall a b. (a -> b) -> a -> b
$
    [ ([Constraint Scientific]
 -> [Either (Constraint Scientific) (Constraint Scientific)])
-> m [Constraint Scientific]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Constraint Scientific
 -> Either (Constraint Scientific) (Constraint Scientific))
-> [Constraint Scientific]
-> [Either (Constraint Scientific) (Constraint Scientific)]
forall a b. (a -> b) -> [a] -> [b]
map Constraint Scientific
-> Either (Constraint Scientific) (Constraint Scientific)
forall a b. a -> Either a b
Left) m [Constraint Scientific]
forall e s (m :: * -> *). C e s m => m [Constraint Scientific]
constraintSection
    , ([Constraint Scientific]
 -> [Either (Constraint Scientific) (Constraint Scientific)])
-> m [Constraint Scientific]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Constraint Scientific
 -> Either (Constraint Scientific) (Constraint Scientific))
-> [Constraint Scientific]
-> [Either (Constraint Scientific) (Constraint Scientific)]
forall a b. (a -> b) -> [a] -> [b]
map Constraint Scientific
-> Either (Constraint Scientific) (Constraint Scientific)
forall a b. a -> Either a b
Left) m [Constraint Scientific]
forall e s (m :: * -> *). C e s m => m [Constraint Scientific]
lazyConstraintsSection
    , ([Constraint Scientific]
 -> [Either (Constraint Scientific) (Constraint Scientific)])
-> m [Constraint Scientific]
-> m [Either (Constraint Scientific) (Constraint Scientific)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Constraint Scientific
 -> Either (Constraint Scientific) (Constraint Scientific))
-> [Constraint Scientific]
-> [Either (Constraint Scientific) (Constraint Scientific)]
forall a b. (a -> b) -> [a] -> [b]
map Constraint Scientific
-> Either (Constraint Scientific) (Constraint Scientific)
forall a b. b -> Either a b
Right) m [Constraint Scientific]
forall e s (m :: * -> *). C e s m => m [Constraint Scientific]
userCutsSection
    ]

  Map Var (Bounds Scientific)
bnds <- Map Var (Bounds Scientific)
-> m (Map Var (Bounds Scientific))
-> m (Map Var (Bounds Scientific))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Map Var (Bounds Scientific)
forall k a. Map k a
Map.empty (m (Map Var (Bounds Scientific)) -> m (Map Var (Bounds Scientific))
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Map Var (Bounds Scientific))
forall e s (m :: * -> *).
C e s m =>
m (Map Var (Bounds Scientific))
boundsSection)
  [Either [Var] [Var]]
exvs <- m (Either [Var] [Var]) -> m [Either [Var] [Var]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (([Var] -> Either [Var] [Var]) -> m [Var] -> m (Either [Var] [Var])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Var] -> Either [Var] [Var]
forall a b. a -> Either a b
Left m [Var]
forall e s (m :: * -> *). C e s m => m [Var]
generalSection m (Either [Var] [Var])
-> m (Either [Var] [Var]) -> m (Either [Var] [Var])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Var] -> Either [Var] [Var]) -> m [Var] -> m (Either [Var] [Var])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Var] -> Either [Var] [Var]
forall a b. b -> Either a b
Right m [Var]
forall e s (m :: * -> *). C e s m => m [Var]
binarySection)
  let ints :: Set Var
ints = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [[Var]] -> [Var]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Var]
x | Left  [Var]
x <- [Either [Var] [Var]]
exvs]
      bins :: Set Var
bins = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [[Var]] -> [Var]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Var]
x | Right [Var]
x <- [Either [Var] [Var]]
exvs]
  Map Var (Bounds Scientific)
bnds2 <- Map Var (Bounds Scientific) -> m (Map Var (Bounds Scientific))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var (Bounds Scientific) -> m (Map Var (Bounds Scientific)))
-> Map Var (Bounds Scientific) -> m (Map Var (Bounds Scientific))
forall a b. (a -> b) -> a -> b
$ (Bounds Scientific -> Bounds Scientific -> Bounds Scientific)
-> Map Var (Bounds Scientific)
-> Map Var (Bounds Scientific)
-> Map Var (Bounds Scientific)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Bounds Scientific -> Bounds Scientific -> Bounds Scientific
forall c. Ord c => Bounds c -> Bounds c -> Bounds c
MIP.intersectBounds
            Map Var (Bounds Scientific)
bnds ([(Var, Bounds Scientific)] -> Map Var (Bounds Scientific)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [(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)) | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
bins])
  Set Var
scs <- ([Var] -> Set Var) -> m [Var] -> m (Set Var)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList (m [Var] -> m (Set Var)) -> m [Var] -> m (Set Var)
forall a b. (a -> b) -> a -> b
$ [Var] -> m [Var] -> m [Var]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (m [Var] -> m [Var]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m [Var]
forall e s (m :: * -> *). C e s m => m [Var]
semiSection)

  [SOSConstraint Scientific]
ss <- [SOSConstraint Scientific]
-> m [SOSConstraint Scientific] -> m [SOSConstraint Scientific]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (m [SOSConstraint Scientific] -> m [SOSConstraint Scientific]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m [SOSConstraint Scientific]
forall e s (m :: * -> *). C e s m => m [SOSConstraint Scientific]
sosSection)
  m ()
forall e s (m :: * -> *). C e s m => m ()
end
  let vs :: Set Var
vs = [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Var] -> Set Var) -> [Set Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ (Either (Constraint Scientific) (Constraint Scientific) -> Set Var)
-> [Either (Constraint Scientific) (Constraint Scientific)]
-> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map Either (Constraint Scientific) (Constraint Scientific) -> Set Var
forall a. Variables a => a -> Set Var
MIP.vars [Either (Constraint Scientific) (Constraint Scientific)]
cs [Set Var] -> [Set Var] -> [Set Var]
forall a. [a] -> [a] -> [a]
++
           [ Map Var (Bounds Scientific) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet Map Var (Bounds Scientific)
bnds2
           , Set Var
ints
           , Set Var
bins
           , Set Var
scs
           , ObjectiveFunction Scientific -> Set Var
forall a. Variables a => a -> Set Var
MIP.vars ObjectiveFunction Scientific
obj
           , [SOSConstraint Scientific] -> Set Var
forall a. Variables a => a -> Set Var
MIP.vars [SOSConstraint Scientific]
ss
           ]
      isInt :: Var -> Bool
isInt Var
v  = Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
ints Bool -> Bool -> Bool
|| Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
bins
      isSemi :: Var -> Bool
isSemi Var
v = Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
scs
  Problem Scientific -> m (Problem Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Problem Scientific -> m (Problem Scientific))
-> Problem Scientific -> m (Problem Scientific)
forall a b. (a -> b) -> a -> b
$
    Problem :: forall c.
Maybe Label
-> ObjectiveFunction c
-> [Constraint c]
-> [SOSConstraint c]
-> [Constraint c]
-> Map Var VarType
-> Map Var (Bounds c)
-> Problem c
MIP.Problem
    { name :: Maybe Label
MIP.name              = Maybe Label
name
    , objectiveFunction :: ObjectiveFunction Scientific
MIP.objectiveFunction = ObjectiveFunction Scientific
obj
    , constraints :: [Constraint Scientific]
MIP.constraints       = [Constraint Scientific
c | Left Constraint Scientific
c <- [Either (Constraint Scientific) (Constraint Scientific)]
cs]
    , userCuts :: [Constraint Scientific]
MIP.userCuts          = [Constraint Scientific
c | Right Constraint Scientific
c <- [Either (Constraint Scientific) (Constraint Scientific)]
cs]
    , sosConstraints :: [SOSConstraint Scientific]
MIP.sosConstraints    = [SOSConstraint Scientific]
ss
    , varType :: Map Var VarType
MIP.varType           = [(Var, VarType)] -> Map Var VarType
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
       [ ( Var
v
         , if Var -> Bool
isInt Var
v then
             if Var -> Bool
isSemi Var
v then VarType
MIP.SemiIntegerVariable
             else VarType
MIP.IntegerVariable
           else
             if Var -> Bool
isSemi Var
v then VarType
MIP.SemiContinuousVariable
             else VarType
MIP.ContinuousVariable
         )
       | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
vs ]
    , varBounds :: Map Var (Bounds Scientific)
MIP.varBounds         = [(Var, Bounds Scientific)] -> Map Var (Bounds Scientific)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (Var
v, Bounds Scientific
-> Var -> Map Var (Bounds Scientific) -> Bounds Scientific
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Bounds Scientific
forall c. Num c => Bounds c
MIP.defaultBounds Var
v Map Var (Bounds Scientific)
bnds2) | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
vs]
    }

problem :: C e s m => m (MIP.ObjectiveFunction Scientific)
problem :: m (ObjectiveFunction Scientific)
problem = do
  OptDir
flag <-  (m () -> m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m ()
forall e s (m :: * -> *). C e s m => m ()
minimize m () -> m OptDir -> m OptDir
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OptDir -> m OptDir
forall (m :: * -> *) a. Monad m => a -> m a
return OptDir
OptMin)
       m OptDir -> m OptDir -> m OptDir
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m () -> m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m ()
forall e s (m :: * -> *). C e s m => m ()
maximize m () -> m OptDir -> m OptDir
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OptDir -> m OptDir
forall (m :: * -> *) a. Monad m => a -> m a
return OptDir
OptMax)
  Maybe Label
name <- m Label -> m (Maybe Label)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Label -> m Label
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Label
forall e s (m :: * -> *). C e s m => m Label
label)
  Expr Scientific
obj <- m (Expr Scientific)
forall e s (m :: * -> *). C e s m => m (Expr Scientific)
expr
  ObjectiveFunction Scientific -> m (ObjectiveFunction Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return ObjectiveFunction Any
forall a. Default a => a
def{ objLabel :: Maybe Label
MIP.objLabel = Maybe Label
name, objDir :: OptDir
MIP.objDir = OptDir
flag, objExpr :: Expr Scientific
MIP.objExpr = Expr Scientific
obj }

minimize, maximize :: C e s m => m ()
minimize :: m ()
minimize = m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"min" m () -> m (Maybe ()) -> m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"imize") m (Maybe ()) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maximize :: m ()
maximize = m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"max" m () -> m (Maybe ()) -> m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"imize") m (Maybe ()) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

end :: C e s m => m ()
end :: m ()
end = m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"end"

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

constraintSection :: C e s m => m [MIP.Constraint Scientific]
constraintSection :: m [Constraint Scientific]
constraintSection = m ()
forall e s (m :: * -> *). C e s m => m ()
subjectTo m () -> m [Constraint Scientific] -> m [Constraint Scientific]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Constraint Scientific) -> m [Constraint Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Constraint Scientific) -> m (Constraint Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Bool -> m (Constraint Scientific)
forall e s (m :: * -> *).
C e s m =>
Bool -> m (Constraint Scientific)
constraint Bool
False))

subjectTo :: C e s m => m ()
subjectTo :: m ()
subjectTo = [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ m () -> m ()
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
$ m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"subject") m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"to")
  , m () -> m ()
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
$ m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"such") m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"that")
  , m () -> m ()
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
$ m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"st")
  , m () -> m ()
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
$ m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"s") m () -> m (Maybe Char) -> m (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'.')) m (Maybe Char) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"t")
        m () -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'.') m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ]

constraint :: C e s m => Bool -> m (MIP.Constraint Scientific)
constraint :: Bool -> m (Constraint Scientific)
constraint Bool
isLazy = do
  Maybe Label
name <- m Label -> m (Maybe Label)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Label -> m Label
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Label
forall e s (m :: * -> *). C e s m => m Label
label)
  Maybe (Var, Scientific)
g <- m (Var, Scientific) -> m (Maybe (Var, Scientific))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m (Var, Scientific) -> m (Maybe (Var, Scientific)))
-> m (Var, Scientific) -> m (Maybe (Var, Scientific))
forall a b. (a -> b) -> a -> b
$ m (Var, Scientific) -> m (Var, Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Var, Scientific)
forall e s (m :: * -> *). C e s m => m (Var, Scientific)
indicator

  -- It seems that CPLEX allows empty lhs, but GLPK rejects it.
  Expr Scientific
e <- m (Expr Scientific)
forall e s (m :: * -> *). C e s m => m (Expr Scientific)
expr
  RelOp
op <- m RelOp
forall e s (m :: * -> *). C e s m => m RelOp
relOp
  Scientific
s <- Scientific -> m Scientific -> m Scientific
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Scientific
1 m Scientific
forall e s (m :: * -> *) a. (C e s m, Num a) => m a
sign
  Scientific
rhs <- (Scientific -> Scientific) -> m Scientific -> m Scientific
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Scientific
sScientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
*) m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number

  let (Extended Scientific
lb,Extended Scientific
ub) =
        case RelOp
op of
          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.Ge -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Extended Scientific
forall r. Extended r
MIP.PosInf)
          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)

  Constraint Scientific -> m (Constraint Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint Scientific -> m (Constraint Scientific))
-> Constraint Scientific -> m (Constraint Scientific)
forall a b. (a -> b) -> a -> b
$ Constraint :: forall c.
Maybe Label
-> Maybe (Var, c)
-> Expr c
-> BoundExpr c
-> BoundExpr c
-> Bool
-> Constraint c
MIP.Constraint
    { constrLabel :: Maybe Label
MIP.constrLabel     = Maybe Label
name
    , constrIndicator :: Maybe (Var, Scientific)
MIP.constrIndicator = Maybe (Var, Scientific)
g
    , constrExpr :: Expr Scientific
MIP.constrExpr      = Expr Scientific
e
    , constrLB :: Extended Scientific
MIP.constrLB        = Extended Scientific
lb
    , constrUB :: Extended Scientific
MIP.constrUB        = Extended Scientific
ub
    , constrIsLazy :: Bool
MIP.constrIsLazy    = Bool
isLazy
    }

relOp :: C e s m => m MIP.RelOp
relOp :: m RelOp
relOp = m RelOp -> m RelOp
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m RelOp -> m RelOp) -> m RelOp -> m RelOp
forall a b. (a -> b) -> a -> b
$ [m RelOp] -> m 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
'<' m Char -> m (Maybe Char) -> m (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
'=') m (Maybe Char) -> m RelOp -> m RelOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall (m :: * -> *) a. Monad m => a -> m a
return 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
'>' m Char -> m (Maybe Char) -> m (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
'=') m (Maybe Char) -> m RelOp -> m RelOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall (m :: * -> *) a. Monad m => a -> m a
return 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
'=' m Char -> m RelOp -> m RelOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [m RelOp] -> m 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
'<' m Char -> m RelOp -> m RelOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall (m :: * -> *) a. Monad m => a -> m a
return 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
'>' m Char -> m RelOp -> m RelOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall (m :: * -> *) a. Monad m => a -> m a
return RelOp
MIP.Ge
                     , RelOp -> m RelOp
forall (m :: * -> *) a. Monad m => a -> m a
return RelOp
MIP.Eql
                     ]
  ]

indicator :: C e s m => m (MIP.Var, Scientific)
indicator :: m (Var, Scientific)
indicator = do
  Var
var <- m Var
forall e s (m :: * -> *). C e s m => m Var
variable
  m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'=')
  Scientific
val <- m Scientific -> m Scientific
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok ((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
'0' m Char -> m Scientific -> m Scientific
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> m Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
0) m Scientific -> m Scientific -> m Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (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
'1' m Char -> m Scientific -> m Scientific
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> m Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
1))
  m (Tokens s) -> m (Tokens s)
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
"->"
  (Var, Scientific) -> m (Var, Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var, Scientific
val)

lazyConstraintsSection :: C e s m => m [MIP.Constraint Scientific]
lazyConstraintsSection :: m [Constraint Scientific]
lazyConstraintsSection = do
  m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"lazy"
  m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"constraints"
  m (Constraint Scientific) -> m [Constraint Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Constraint Scientific) -> m [Constraint Scientific])
-> m (Constraint Scientific) -> m [Constraint Scientific]
forall a b. (a -> b) -> a -> b
$ m (Constraint Scientific) -> m (Constraint Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (Constraint Scientific) -> m (Constraint Scientific))
-> m (Constraint Scientific) -> m (Constraint Scientific)
forall a b. (a -> b) -> a -> b
$ Bool -> m (Constraint Scientific)
forall e s (m :: * -> *).
C e s m =>
Bool -> m (Constraint Scientific)
constraint Bool
True

userCutsSection :: C e s m => m [MIP.Constraint Scientific]
userCutsSection :: m [Constraint Scientific]
userCutsSection = do
  m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"user"
  m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"cuts"
  m (Constraint Scientific) -> m [Constraint Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Constraint Scientific) -> m [Constraint Scientific])
-> m (Constraint Scientific) -> m [Constraint Scientific]
forall a b. (a -> b) -> a -> b
$ m (Constraint Scientific) -> m (Constraint Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (Constraint Scientific) -> m (Constraint Scientific))
-> m (Constraint Scientific) -> m (Constraint Scientific)
forall a b. (a -> b) -> a -> b
$ Bool -> m (Constraint Scientific)
forall e s (m :: * -> *).
C e s m =>
Bool -> m (Constraint Scientific)
constraint Bool
False

type Bounds2 c = (Maybe (MIP.BoundExpr c), Maybe (MIP.BoundExpr c))

boundsSection :: C e s m => m (Map MIP.Var (MIP.Bounds Scientific))
boundsSection :: m (Map Var (Bounds Scientific))
boundsSection = do
  m (Maybe Char) -> m (Maybe Char)
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m (Maybe Char) -> m (Maybe Char))
-> m (Maybe Char) -> m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"bound" m () -> m (Maybe Char) -> m (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> m Char
forall e s (m :: * -> *). C e s m => Char -> m Char
char' Char
's')
  ([(Var,
   (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
 -> Map Var (Bounds Scientific))
-> m [(Var,
       (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
-> m (Map Var (Bounds Scientific))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((Maybe (Extended Scientific), Maybe (Extended Scientific))
 -> Bounds Scientific)
-> Map
     Var (Maybe (Extended Scientific), Maybe (Extended Scientific))
-> Map Var (Bounds Scientific)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Maybe (Extended Scientific), Maybe (Extended Scientific))
-> Bounds Scientific
forall c c.
Num c =>
(Maybe (BoundExpr c), Maybe (BoundExpr c))
-> (BoundExpr c, BoundExpr c)
g (Map Var (Maybe (Extended Scientific), Maybe (Extended Scientific))
 -> Map Var (Bounds Scientific))
-> ([(Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
    -> Map
         Var (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> [(Var,
     (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
-> Map Var (Bounds Scientific)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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.
(Ord a, Ord a) =>
(Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
f) (m [(Var,
     (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
 -> m (Map Var (Bounds Scientific)))
-> m [(Var,
       (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
-> m (Map Var (Bounds Scientific))
forall a b. (a -> b) -> a -> b
$ m (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m [(Var,
       (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall e s (m :: * -> *).
C e s m =>
m (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
bound)
  where
    f :: (Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
f (Maybe a
lb1,Maybe a
ub1) (Maybe a
lb2,Maybe a
ub2) = ((a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall a. (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
combineMaybe a -> a -> a
forall a. Ord a => a -> a -> a
max Maybe a
lb1 Maybe a
lb2, (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall a. (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
combineMaybe a -> a -> a
forall a. Ord a => a -> a -> a
min Maybe a
ub1 Maybe a
ub2)
    g :: (Maybe (BoundExpr c), Maybe (BoundExpr c))
-> (BoundExpr c, BoundExpr c)
g (Maybe (BoundExpr c)
lb, Maybe (BoundExpr c)
ub) = ( BoundExpr c -> Maybe (BoundExpr c) -> BoundExpr c
forall a. a -> Maybe a -> a
fromMaybe BoundExpr c
forall c. Num c => BoundExpr c
MIP.defaultLB Maybe (BoundExpr c)
lb
                 , BoundExpr c -> Maybe (BoundExpr c) -> BoundExpr c
forall a. a -> Maybe a -> a
fromMaybe BoundExpr c
forall r. Extended r
MIP.defaultUB Maybe (BoundExpr c)
ub
                 )

bound :: C e s m => m (MIP.Var, Bounds2 Scientific)
bound :: m (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
bound = [m (Var,
    (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ m (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (Var,
    (Maybe (Extended Scientific), Maybe (Extended Scientific)))
 -> m (Var,
       (Maybe (Extended Scientific), Maybe (Extended Scientific))))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall a b. (a -> b) -> a -> b
$ do
      Var
v <- m Var -> m Var
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Var
forall e s (m :: * -> *). C e s m => m Var
variable
      [m (Var,
    (Maybe (Extended Scientific), Maybe (Extended Scientific)))]
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
        [ do
            RelOp
op <- m RelOp
forall e s (m :: * -> *). C e s m => m RelOp
relOp
            Extended Scientific
b <- m (Extended Scientific)
forall e s (m :: * -> *). C e s m => m (Extended Scientific)
boundExpr
            (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall (m :: * -> *) a. Monad m => a -> m a
return
              ( Var
v
              , case RelOp
op of
                  RelOp
MIP.Le -> (Maybe (Extended Scientific)
forall a. Maybe a
Nothing, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
b)
                  RelOp
MIP.Ge -> (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
b, Maybe (Extended Scientific)
forall a. Maybe a
Nothing)
                  RelOp
MIP.Eql -> (Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
b, Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just Extended Scientific
b)
              )
        , do
            m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"free"
            (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
v, (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))
        ]
  , do
      Maybe (Extended Scientific)
b1 <- (Extended Scientific -> Maybe (Extended Scientific))
-> m (Extended Scientific) -> m (Maybe (Extended Scientific))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just m (Extended Scientific)
forall e s (m :: * -> *). C e s m => m (Extended Scientific)
boundExpr
      RelOp
op1 <- m RelOp
forall e s (m :: * -> *). C e s m => m RelOp
relOp
      Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ RelOp
op1 RelOp -> RelOp -> Bool
forall a. Eq a => a -> a -> Bool
== RelOp
MIP.Le
      Var
v <- m Var
forall e s (m :: * -> *). C e s m => m Var
variable
      Maybe (Extended Scientific)
b2 <- Maybe (Extended Scientific)
-> m (Maybe (Extended Scientific))
-> m (Maybe (Extended Scientific))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Maybe (Extended Scientific)
forall a. Maybe a
Nothing (m (Maybe (Extended Scientific))
 -> m (Maybe (Extended Scientific)))
-> m (Maybe (Extended Scientific))
-> m (Maybe (Extended Scientific))
forall a b. (a -> b) -> a -> b
$ do
        RelOp
op2 <- m RelOp
forall e s (m :: * -> *). C e s m => m RelOp
relOp
        Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ RelOp
op2 RelOp -> RelOp -> Bool
forall a. Eq a => a -> a -> Bool
== RelOp
MIP.Le
        (Extended Scientific -> Maybe (Extended Scientific))
-> m (Extended Scientific) -> m (Maybe (Extended Scientific))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Extended Scientific -> Maybe (Extended Scientific)
forall a. a -> Maybe a
Just m (Extended Scientific)
forall e s (m :: * -> *). C e s m => m (Extended Scientific)
boundExpr
      (Var, (Maybe (Extended Scientific), Maybe (Extended Scientific)))
-> m (Var,
      (Maybe (Extended Scientific), Maybe (Extended Scientific)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
v, (Maybe (Extended Scientific)
b1, Maybe (Extended Scientific)
b2))
  ]

boundExpr :: C e s m => m (MIP.BoundExpr Scientific)
boundExpr :: m (Extended Scientific)
boundExpr = [m (Extended Scientific)] -> m (Extended Scientific)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ m (Extended Scientific) -> m (Extended Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'+') m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *). C e s m => m ()
inf m () -> m (Extended Scientific) -> m (Extended Scientific)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Extended Scientific -> m (Extended Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Extended Scientific
forall r. Extended r
MIP.PosInf)
  , m (Extended Scientific) -> m (Extended Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'-') m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *). C e s m => m ()
inf m () -> m (Extended Scientific) -> m (Extended Scientific)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Extended Scientific -> m (Extended Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Extended Scientific
forall r. Extended r
MIP.NegInf)
  , do
      Scientific
s <- Scientific -> m Scientific -> m Scientific
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Scientific
1 m Scientific
forall e s (m :: * -> *) a. (C e s m, Num a) => m a
sign
      Scientific
x <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      Extended Scientific -> m (Extended Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Extended Scientific -> m (Extended Scientific))
-> Extended Scientific -> m (Extended Scientific)
forall a b. (a -> b) -> a -> b
$ Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite (Scientific
sScientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
*Scientific
x)
  ]

inf :: C e s m => m ()
inf :: m ()
inf = m (Maybe (Tokens s)) -> m (Maybe (Tokens s))
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"inf" m (Tokens s) -> m (Maybe (Tokens s)) -> m (Maybe (Tokens s))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Tokens s) -> m (Maybe (Tokens s))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"inity")) m (Maybe (Tokens s)) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

generalSection :: C e s m => m [MIP.Var]
generalSection :: m [Var]
generalSection = do
  m (Maybe (Maybe ())) -> m (Maybe (Maybe ()))
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m (Maybe (Maybe ())) -> m (Maybe (Maybe ())))
-> m (Maybe (Maybe ())) -> m (Maybe (Maybe ()))
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"gen" m () -> m (Maybe (Maybe ())) -> m (Maybe (Maybe ()))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Maybe ()) -> m (Maybe (Maybe ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"eral" m () -> m (Maybe ()) -> m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"s"))
  m Var -> m [Var]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Var -> m Var
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Var
forall e s (m :: * -> *). C e s m => m Var
variable)

binarySection :: C e s m => m [MIP.Var]
binarySection :: m [Var]
binarySection = do
  m (Maybe ()) -> m (Maybe ())
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m (Maybe ()) -> m (Maybe ())) -> m (Maybe ()) -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"bin" m () -> m (Maybe ()) -> m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"ar" m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"y" m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"ies"))
  m Var -> m [Var]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Var -> m Var
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Var
forall e s (m :: * -> *). C e s m => m Var
variable)

semiSection :: C e s m => m [MIP.Var]
semiSection :: m [Var]
semiSection = do
  m (Maybe ()) -> m (Maybe ())
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m (Maybe ()) -> m (Maybe ())) -> m (Maybe ()) -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"semi" m () -> m (Maybe ()) -> m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"-continuous" m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"s")
  m Var -> m [Var]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Var -> m Var
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Var
forall e s (m :: * -> *). C e s m => m Var
variable)

sosSection :: C e s m => m [MIP.SOSConstraint Scientific]
sosSection :: m [SOSConstraint Scientific]
sosSection = do
  m () -> m ()
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"sos"
  m (SOSConstraint Scientific) -> m [SOSConstraint Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m (SOSConstraint Scientific) -> m [SOSConstraint Scientific])
-> m (SOSConstraint Scientific) -> m [SOSConstraint Scientific]
forall a b. (a -> b) -> a -> b
$ m (SOSConstraint Scientific) -> m (SOSConstraint Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (SOSConstraint Scientific) -> m (SOSConstraint Scientific))
-> m (SOSConstraint Scientific) -> m (SOSConstraint Scientific)
forall a b. (a -> b) -> a -> b
$ do
    (Maybe Label
l,SOSType
t) <- m (Maybe Label, SOSType) -> m (Maybe Label, SOSType)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (do{ Label
l <- m Label
forall e s (m :: * -> *). C e s m => m Label
label; SOSType
t <- m SOSType
typ; (Maybe Label, SOSType) -> m (Maybe Label, SOSType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Label -> Maybe Label
forall a. a -> Maybe a
Just Label
l, SOSType
t) })
          m (Maybe Label, SOSType)
-> m (Maybe Label, SOSType) -> m (Maybe Label, SOSType)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do{ SOSType
t <- m SOSType
typ; (Maybe Label, SOSType) -> m (Maybe Label, SOSType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Label
forall a. Maybe a
Nothing, SOSType
t) })
    [(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)])
-> m (Var, Scientific) -> m [(Var, Scientific)]
forall a b. (a -> b) -> a -> b
$ m (Var, Scientific) -> m (Var, Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (Var, Scientific) -> m (Var, Scientific))
-> m (Var, Scientific) -> m (Var, Scientific)
forall a b. (a -> b) -> a -> b
$ do
      Var
v <- m Var
forall e s (m :: * -> *). C e s m => m Var
variable
      m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m Char -> m Char) -> m Char -> m Char
forall a b. (a -> b) -> a -> b
$ 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
':'
      Scientific
w <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
      (Var, Scientific) -> m (Var, Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
v,Scientific
w)
    SOSConstraint Scientific -> m (SOSConstraint Scientific)
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
$ Maybe Label
-> SOSType -> [(Var, Scientific)] -> SOSConstraint Scientific
forall c. Maybe Label -> SOSType -> [(Var, c)] -> SOSConstraint c
MIP.SOSConstraint Maybe Label
l SOSType
t [(Var, Scientific)]
xs
  where
    typ :: m SOSType
typ = do
      SOSType
t <- m SOSType -> m SOSType
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m SOSType -> m SOSType) -> m SOSType -> m SOSType
forall a b. (a -> b) -> a -> b
$ (Char -> m Char
forall e s (m :: * -> *). C e s m => Char -> m Char
char' Char
's' m Char -> m SOSType -> m SOSType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((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
'1' m Char -> m SOSType -> m SOSType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SOSType -> m SOSType
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
MIP.S1) m SOSType -> m SOSType -> m SOSType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (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
'2' m Char -> m SOSType -> m SOSType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SOSType -> m SOSType
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
MIP.S2)))
      m (Tokens s) -> m (Tokens s)
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"::")
      SOSType -> m SOSType
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
t

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

expr :: forall e s m. C e s m => m (MIP.Expr Scientific)
expr :: m (Expr Scientific)
expr = m (Expr Scientific) -> m (Expr Scientific)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Expr Scientific)
expr1 m (Expr Scientific) -> m (Expr Scientific) -> m (Expr Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr Scientific -> m (Expr Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Scientific
0
  where
    expr1 :: m (MIP.Expr Scientific)
    expr1 :: m (Expr Scientific)
expr1 = do
      Expr Scientific
t <- Bool -> m (Expr Scientific)
forall e s (m :: * -> *). C e s m => Bool -> m (Expr Scientific)
term Bool
True
      [Expr Scientific]
ts <- m (Expr Scientific) -> m [Expr Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Bool -> m (Expr Scientific)
forall e s (m :: * -> *). C e s m => Bool -> m (Expr Scientific)
term Bool
False)
      Expr Scientific -> m (Expr Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Scientific -> m (Expr Scientific))
-> Expr Scientific -> m (Expr Scientific)
forall a b. (a -> b) -> a -> b
$ (Expr Scientific -> Expr Scientific -> Expr Scientific)
-> Expr Scientific -> [Expr Scientific] -> Expr Scientific
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expr Scientific -> Expr Scientific -> Expr Scientific
forall a. Num a => a -> a -> a
(+) Expr Scientific
0 (Expr Scientific
t Expr Scientific -> [Expr Scientific] -> [Expr Scientific]
forall a. a -> [a] -> [a]
: [Expr Scientific]
ts)

sign :: (C e s m, Num a) => m a
sign :: m a
sign = m a -> m a
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok ((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
'+' m Char -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1) m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (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
'-' m Char -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (-a
1)))

term :: C e s m => Bool -> m (MIP.Expr Scientific)
term :: Bool -> m (Expr Scientific)
term Bool
flag = do
  Maybe Scientific
s <- if Bool
flag then m Scientific -> m (Maybe Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Scientific
forall e s (m :: * -> *) a. (C e s m, Num a) => m a
sign else (Scientific -> Maybe Scientific)
-> m Scientific -> m (Maybe Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just m Scientific
forall e s (m :: * -> *) a. (C e s m, Num a) => m a
sign
  Maybe Scientific
c <- m Scientific -> m (Maybe Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
  Expr Scientific
e <- (Var -> Expr Scientific) -> m Var -> m (Expr Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Var -> Expr Scientific
forall c. Num c => Var -> Expr c
MIP.varExpr m Var
forall e s (m :: * -> *). C e s m => m Var
variable m (Expr Scientific) -> m (Expr Scientific) -> m (Expr Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Expr Scientific)
forall e s (m :: * -> *). C e s m => m (Expr Scientific)
qexpr
  Expr Scientific -> m (Expr Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Scientific -> m (Expr Scientific))
-> Expr Scientific -> m (Expr Scientific)
forall a b. (a -> b) -> a -> b
$ case (Scientific -> Scientific -> Scientific)
-> Maybe Scientific -> Maybe Scientific -> Maybe Scientific
forall a. (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
combineMaybe Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*) Maybe Scientific
s Maybe Scientific
c of
    Maybe Scientific
Nothing -> Expr Scientific
e
    Just Scientific
d -> Scientific -> Expr Scientific
forall c. (Eq c, Num c) => c -> Expr c
MIP.constExpr Scientific
d Expr Scientific -> Expr Scientific -> Expr Scientific
forall a. Num a => a -> a -> a
* Expr Scientific
e

qexpr :: C e s m => m (MIP.Expr Scientific)
qexpr :: m (Expr Scientific)
qexpr = do
  m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'[')
  Term Scientific
t <- Bool -> m (Term Scientific)
forall e s (m :: * -> *). C e s m => Bool -> m (Term Scientific)
qterm Bool
True
  [Term Scientific]
ts <- m (Term Scientific) -> m [Term Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Bool -> m (Term Scientific)
forall e s (m :: * -> *). C e s m => Bool -> m (Term Scientific)
qterm Bool
False)
  let e :: Expr Scientific
e = [Term Scientific] -> Expr Scientific
forall c. [Term c] -> Expr c
MIP.Expr (Term Scientific
tTerm Scientific -> [Term Scientific] -> [Term Scientific]
forall a. a -> [a] -> [a]
:[Term Scientific]
ts)
  m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
']')
  -- Gurobi allows ommiting "/2"
  (do (Char -> m Char) -> String -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m Char -> m Char) -> (Char -> m Char) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char) (String
"/2" :: String) -- Explicit type signature is necessary because the type of mapM_ in GHC-7.10 is generalized for arbitrary Foldable
      Expr Scientific -> m (Expr Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Scientific -> m (Expr Scientific))
-> Expr Scientific -> m (Expr Scientific)
forall a b. (a -> b) -> a -> b
$ Scientific -> Expr Scientific
forall c. (Eq c, Num c) => c -> Expr c
MIP.constExpr (Scientific
1Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/Scientific
2) Expr Scientific -> Expr Scientific -> Expr Scientific
forall a. Num a => a -> a -> a
* Expr Scientific
e)
   m (Expr Scientific) -> m (Expr Scientific) -> m (Expr Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr Scientific -> m (Expr Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Scientific
e

qterm :: C e s m => Bool -> m (MIP.Term Scientific)
qterm :: Bool -> m (Term Scientific)
qterm Bool
flag = do
  Maybe Scientific
s <- if Bool
flag then m Scientific -> m (Maybe Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Scientific
forall e s (m :: * -> *) a. (C e s m, Num a) => m a
sign else (Scientific -> Maybe Scientific)
-> m Scientific -> m (Maybe Scientific)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just m Scientific
forall e s (m :: * -> *) a. (C e s m, Num a) => m a
sign
  Maybe Scientific
c <- m Scientific -> m (Maybe Scientific)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
number
  [Var]
es <- do
    [Var]
e <- m [Var]
forall e s (m :: * -> *). C e s m => m [Var]
qfactor
    [[Var]]
es <- m [Var] -> m [[Var]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'*') m Char -> m [Var] -> m [Var]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [Var]
forall e s (m :: * -> *). C e s m => m [Var]
qfactor)
    [Var] -> m [Var]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Var] -> m [Var]) -> [Var] -> m [Var]
forall a b. (a -> b) -> a -> b
$ [Var]
e [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [[Var]] -> [Var]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Var]]
es
  Term Scientific -> m (Term Scientific)
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
$ case (Scientific -> Scientific -> Scientific)
-> Maybe Scientific -> Maybe Scientific -> Maybe Scientific
forall a. (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
combineMaybe Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*) Maybe Scientific
s Maybe Scientific
c of
    Maybe Scientific
Nothing -> Scientific -> [Var] -> Term Scientific
forall c. c -> [Var] -> Term c
MIP.Term Scientific
1 [Var]
es
    Just Scientific
d -> Scientific -> [Var] -> Term Scientific
forall c. c -> [Var] -> Term c
MIP.Term Scientific
d [Var]
es

qfactor :: C e s m => m [MIP.Var]
qfactor :: m [Var]
qfactor = do
  Var
v <- m Var
forall e s (m :: * -> *). C e s m => m Var
variable
  [m [Var]] -> m [Var]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'^') m Char -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (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
'2') m Char -> m [Var] -> m [Var]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Var] -> m [Var]
forall (m :: * -> *) a. Monad m => a -> m a
return [Var
v,Var
v]
       , [Var] -> m [Var]
forall (m :: * -> *) a. Monad m => a -> m a
return [Var
v]
       ]

number :: forall e s m. C e s m => m Scientific
#if MIN_VERSION_megaparsec(6,0,0)
number :: 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
P.signed m ()
forall e s (m :: * -> *). C e s m => m ()
sep m Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
P.scientific
#else
number = tok $ P.signed sep P.number
#endif

skipManyTill :: Alternative m => m a -> m end -> m ()
skipManyTill :: m a -> m end -> m ()
skipManyTill m a
p m end
end' = m ()
scan
  where
    scan :: m ()
scan = (m end
end' m end -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m a
p m a -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
scan)

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

type M a = Writer Builder a

execM :: M a -> TL.Text
execM :: 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

writeString :: T.Text -> M ()
writeString :: Label -> M ()
writeString Label
s = Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Label -> Builder
B.fromText Label
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 LP file data.
render :: MIP.FileOptions -> MIP.Problem Scientific -> Either String TL.Text
render :: FileOptions -> Problem Scientific -> Either String Text
render FileOptions
_ Problem Scientific
mip = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ M () -> Text
forall a. M a -> Text
execM (M () -> Text) -> M () -> Text
forall a b. (a -> b) -> a -> b
$ Problem Scientific -> M ()
render' (Problem Scientific -> M ()) -> Problem Scientific -> M ()
forall a b. (a -> b) -> a -> b
$ Problem Scientific -> Problem Scientific
forall r. (Eq r, Num r) => Problem r -> Problem r
normalize Problem Scientific
mip

writeVar :: MIP.Var -> M ()
writeVar :: Var -> M ()
writeVar Var
v = Label -> M ()
writeString (Label -> M ()) -> Label -> M ()
forall a b. (a -> b) -> a -> b
$ Var -> Uninterned Var
forall t. Uninternable t => t -> Uninterned t
unintern Var
v

render' :: MIP.Problem Scientific -> M ()
render' :: Problem Scientific -> M ()
render' Problem Scientific
mip = do
  case Problem Scientific -> Maybe Label
forall c. Problem c -> Maybe Label
MIP.name Problem Scientific
mip of
    Just Label
name -> Label -> M ()
writeString (Label -> M ()) -> Label -> M ()
forall a b. (a -> b) -> a -> b
$ Label
"\\* Problem: " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
name Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" *\\\n"
    Maybe Label
Nothing -> () -> M ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  let obj :: ObjectiveFunction Scientific
obj = Problem Scientific -> ObjectiveFunction Scientific
forall c. Problem c -> ObjectiveFunction c
MIP.objectiveFunction Problem Scientific
mip

  Label -> M ()
writeString (Label -> M ()) -> Label -> M ()
forall a b. (a -> b) -> a -> b
$
    case ObjectiveFunction Scientific -> OptDir
forall c. ObjectiveFunction c -> OptDir
MIP.objDir ObjectiveFunction Scientific
obj of
      OptDir
OptMin -> Label
"MINIMIZE"
      OptDir
OptMax -> Label
"MAXIMIZE"
  Char -> M ()
writeChar Char
'\n'

  Maybe Label -> M ()
renderLabel (ObjectiveFunction Scientific -> Maybe Label
forall c. ObjectiveFunction c -> Maybe Label
MIP.objLabel ObjectiveFunction Scientific
obj)
  Bool -> Expr Scientific -> M ()
renderExpr Bool
True (ObjectiveFunction Scientific -> Expr Scientific
forall c. ObjectiveFunction c -> Expr c
MIP.objExpr ObjectiveFunction Scientific
obj)
  Char -> M ()
writeChar Char
'\n'

  Label -> M ()
writeString Label
"SUBJECT TO\n"
  [Constraint Scientific] -> (Constraint Scientific -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem Scientific
mip) ((Constraint Scientific -> M ()) -> M ())
-> (Constraint Scientific -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \Constraint Scientific
c -> do
    Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Constraint Scientific -> Bool
forall c. Constraint c -> Bool
MIP.constrIsLazy Constraint Scientific
c) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
      Constraint Scientific -> M ()
renderConstraint Constraint Scientific
c
      Char -> M ()
writeChar Char
'\n'

  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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint Scientific]
lcs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Label -> M ()
writeString Label
"LAZY CONSTRAINTS\n"
    [Constraint Scientific] -> (Constraint Scientific -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Constraint Scientific]
lcs ((Constraint Scientific -> M ()) -> M ())
-> (Constraint Scientific -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \Constraint Scientific
c -> do
      Constraint Scientific -> M ()
renderConstraint Constraint Scientific
c
      Char -> M ()
writeChar Char
'\n'

  let cuts :: [Constraint Scientific]
cuts = [Constraint Scientific
c | Constraint Scientific
c <- Problem Scientific -> [Constraint Scientific]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem Scientific
mip]
  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Constraint Scientific] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint Scientific]
cuts) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Label -> M ()
writeString Label
"USER CUTS\n"
    [Constraint Scientific] -> (Constraint Scientific -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Constraint Scientific]
cuts ((Constraint Scientific -> M ()) -> M ())
-> (Constraint Scientific -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \Constraint Scientific
c -> do
      Constraint Scientific -> M ()
renderConstraint Constraint Scientific
c
      Char -> M ()
writeChar Char
'\n'

  let 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
      (Set Var
bins,Set Var
gens) = (Var -> Bool) -> Set Var -> (Set Var, Set Var)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition (\Var
v -> Problem Scientific -> Var -> Bounds Scientific
forall c. Num c => Problem c -> Var -> Bounds c
MIP.getBounds Problem Scientific
mip Var
v Bounds Scientific -> Bounds Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
0, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
1)) Set Var
ivs
      scs :: Set Var
scs = Problem Scientific -> Set Var
forall c. Problem c -> Set Var
MIP.semiContinuousVariables 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

  Label -> M ()
writeString Label
"BOUNDS\n"
  [(Var, Bounds Scientific)]
-> ((Var, Bounds Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Var (Bounds Scientific) -> [(Var, Bounds Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Problem Scientific -> Map Var (Bounds Scientific)
forall c. Problem c -> Map Var (Bounds c)
MIP.varBounds Problem Scientific
mip)) (((Var, Bounds Scientific) -> M ()) -> M ())
-> ((Var, Bounds Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
v, (Extended Scientific
lb,Extended Scientific
ub)) -> do
    Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
bins) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
      Extended Scientific -> M ()
renderBoundExpr Extended Scientific
lb
      Label -> M ()
writeString Label
" <= "
      Var -> M ()
writeVar Var
v
      Label -> M ()
writeString Label
" <= "
      Extended Scientific -> M ()
renderBoundExpr Extended Scientific
ub
      Char -> M ()
writeChar Char
'\n'

  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Var -> Bool
forall a. Set a -> Bool
Set.null Set Var
gens) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Label -> M ()
writeString Label
"GENERALS\n"
    [Var] -> M ()
renderVariableList ([Var] -> M ()) -> [Var] -> M ()
forall a b. (a -> b) -> a -> b
$ Set Var -> [Var]
forall a. Set a -> [a]
Set.toList Set Var
gens

  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Var -> Bool
forall a. Set a -> Bool
Set.null Set Var
bins) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Label -> M ()
writeString Label
"BINARIES\n"
    [Var] -> M ()
renderVariableList ([Var] -> M ()) -> [Var] -> M ()
forall a b. (a -> b) -> a -> b
$ Set Var -> [Var]
forall a. Set a -> [a]
Set.toList Set Var
bins

  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Var -> Bool
forall a. Set a -> Bool
Set.null Set Var
scs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Label -> M ()
writeString Label
"SEMI-CONTINUOUS\n"
    [Var] -> M ()
renderVariableList ([Var] -> M ()) -> [Var] -> M ()
forall a b. (a -> b) -> a -> b
$ Set Var -> [Var]
forall a. Set a -> [a]
Set.toList Set Var
scs

  Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SOSConstraint Scientific] -> 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
    Label -> M ()
writeString Label
"SOS\n"
    [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
$ \(MIP.SOSConstraint Maybe Label
l SOSType
typ [(Var, Scientific)]
xs) -> do
      Maybe Label -> M ()
renderLabel Maybe Label
l
      Label -> M ()
writeString (Label -> M ()) -> Label -> M ()
forall a b. (a -> b) -> a -> b
$ String -> Label
forall a. IsString a => String -> a
fromString (String -> Label) -> String -> Label
forall a b. (a -> b) -> a -> b
$ SOSType -> String
forall a. Show a => a -> String
show SOSType
typ
      Label -> M ()
writeString Label
" ::"
      [(Var, Scientific)] -> ((Var, Scientific) -> M ()) -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Var, Scientific)]
xs (((Var, Scientific) -> M ()) -> M ())
-> ((Var, Scientific) -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \(Var
v, Scientific
r) -> do
        Label -> M ()
writeString Label
"  "
        Var -> M ()
writeVar Var
v
        Label -> M ()
writeString Label
" : "
        Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Scientific -> Builder
B.scientificBuilder Scientific
r
      Char -> M ()
writeChar Char
'\n'

  Label -> M ()
writeString Label
"END\n"

-- FIXME: Gurobi は quadratic term が最後に一つある形式でないとダメっぽい
renderExpr :: Bool -> MIP.Expr Scientific -> M ()
renderExpr :: Bool -> Expr Scientific -> M ()
renderExpr Bool
isObj Expr Scientific
e = Int -> [Label] -> M ()
fill Int
80 ([Label]
ts1 [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ [Label]
ts2)
  where
    ([Term Scientific]
ts,[Term Scientific]
qts) = (Term Scientific -> Bool)
-> [Term Scientific] -> ([Term Scientific], [Term Scientific])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Term Scientific -> Bool
forall c. Term c -> Bool
isLin (Expr Scientific -> [Term Scientific]
forall c. Expr c -> [Term c]
MIP.terms Expr Scientific
e)
    isLin :: Term c -> Bool
isLin (MIP.Term c
_ [])  = Bool
True
    isLin (MIP.Term c
_ [Var
_]) = Bool
True
    isLin Term c
_ = Bool
False

    ts1 :: [Label]
ts1 = (Term Scientific -> Label) -> [Term Scientific] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Term Scientific -> Label
f [Term Scientific]
ts
    ts2 :: [Label]
ts2
      | [Term Scientific] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Term Scientific]
qts  = []
      | Bool
otherwise =
        -- マイナスで始めるとSCIP 2.1.1 は「cannot have '-' in front of quadratic part ('[')」というエラーを出す
        -- SCIP-3.1.0 does not allow spaces between '/' and '2'.
        [Label
"+ ["] [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ (Term Scientific -> Label) -> [Term Scientific] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Term Scientific -> Label
g [Term Scientific]
qts [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ [if Bool
isObj then Label
"] /2" else Label
"]"]

    f :: MIP.Term Scientific -> T.Text
    f :: Term Scientific -> Label
f (MIP.Term Scientific
c [])  = Scientific -> Label
showConstTerm Scientific
c
    f (MIP.Term Scientific
c [Var
v]) = Scientific -> Label
showCoeff Scientific
c Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> String -> Label
forall a. IsString a => String -> a
fromString (Var -> String
MIP.fromVar Var
v)
    f Term Scientific
_ = String -> Label
forall a. HasCallStack => String -> a
error String
"should not happen"

    g :: MIP.Term Scientific -> T.Text
    g :: Term Scientific -> Label
g (MIP.Term Scientific
c [Var]
vs) =
      (if Bool
isObj then Scientific -> Label
showCoeff (Scientific
2Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
*Scientific
c) else Scientific -> Label
showCoeff Scientific
c) Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<>
      [Label] -> Label
forall a. Monoid a => [a] -> a
mconcat (Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
intersperse Label
" * " ((Var -> Label) -> [Var] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Label
forall a. IsString a => String -> a
fromString (String -> Label) -> (Var -> String) -> Var -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> String
MIP.fromVar) [Var]
vs))

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

showCoeff :: Scientific -> T.Text
showCoeff :: Scientific -> Label
showCoeff Scientific
c =
  if Scientific
c' Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
1
    then Label
s
    else Label
s Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Scientific -> Label
showValue Scientific
c' Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" "
  where
    c' :: Scientific
c' = Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
c
    s :: Label
s = if Scientific
c Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
0 then Label
"+ " else Label
"- "

showConstTerm :: Scientific -> T.Text
showConstTerm :: Scientific -> Label
showConstTerm Scientific
c = Label
s Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Scientific -> Label
showValue (Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
c)
  where
    s :: Label
s = if Scientific
c Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
0 then Label
"+ " else Label
"- "

renderLabel :: Maybe MIP.Label -> M ()
renderLabel :: Maybe Label -> M ()
renderLabel Maybe Label
l =
  case Maybe Label
l of
    Maybe Label
Nothing -> () -> M ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Label
s -> Label -> M ()
writeString Label
s M () -> M () -> M ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Label -> M ()
writeString Label
": "

renderOp :: MIP.RelOp -> M ()
renderOp :: RelOp -> M ()
renderOp RelOp
MIP.Le = Label -> M ()
writeString Label
"<="
renderOp RelOp
MIP.Ge = Label -> M ()
writeString Label
">="
renderOp RelOp
MIP.Eql = Label -> M ()
writeString Label
"="

renderConstraint :: MIP.Constraint Scientific -> M ()
renderConstraint :: Constraint Scientific -> M ()
renderConstraint c :: Constraint Scientific
c@MIP.Constraint{ constrExpr :: forall c. Constraint c -> Expr c
MIP.constrExpr = Expr Scientific
e, constrLB :: forall c. Constraint c -> BoundExpr c
MIP.constrLB = Extended Scientific
lb, constrUB :: forall c. Constraint c -> BoundExpr c
MIP.constrUB = Extended Scientific
ub } = do
  Maybe Label -> M ()
renderLabel (Constraint Scientific -> Maybe Label
forall c. Constraint c -> Maybe Label
MIP.constrLabel Constraint Scientific
c)
  case Constraint Scientific -> Maybe (Var, Scientific)
forall c. Constraint c -> Maybe (Var, c)
MIP.constrIndicator Constraint Scientific
c of
    Maybe (Var, Scientific)
Nothing -> () -> M ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Var
v,Scientific
vval) -> do
      Var -> M ()
writeVar Var
v
      Label -> M ()
writeString Label
" = "
      Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Scientific -> Builder
B.scientificBuilder Scientific
vval
      Label -> M ()
writeString Label
" -> "

  Bool -> Expr Scientific -> M ()
renderExpr Bool
False Expr Scientific
e
  Char -> M ()
writeChar Char
' '
  let (RelOp
op, Scientific
val) =
        case (Extended Scientific
lb, Extended Scientific
ub) of
          (Extended Scientific
MIP.NegInf, MIP.Finite Scientific
x) -> (RelOp
MIP.Le, Scientific
x)
          (MIP.Finite Scientific
x, Extended Scientific
MIP.PosInf) -> (RelOp
MIP.Ge, Scientific
x)
          (MIP.Finite Scientific
x1, MIP.Finite Scientific
x2) | Scientific
x1Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
==Scientific
x2 -> (RelOp
MIP.Eql, Scientific
x1)
          Bounds Scientific
_ -> String -> (RelOp, Scientific)
forall a. HasCallStack => String -> a
error String
"Numeric.Optimization.MIP.LPFile.renderConstraint: should not happen"
  RelOp -> M ()
renderOp RelOp
op
  Char -> M ()
writeChar Char
' '
  Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Scientific -> Builder
B.scientificBuilder Scientific
val

renderBoundExpr :: MIP.BoundExpr Scientific -> M ()
renderBoundExpr :: Extended Scientific -> M ()
renderBoundExpr (MIP.Finite Scientific
r) = Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$ Scientific -> Builder
B.scientificBuilder Scientific
r
renderBoundExpr Extended Scientific
MIP.NegInf = Label -> M ()
writeString Label
"-inf"
renderBoundExpr Extended Scientific
MIP.PosInf = Label -> M ()
writeString Label
"+inf"

renderVariableList :: [MIP.Var] -> M ()
renderVariableList :: [Var] -> M ()
renderVariableList [Var]
vs = Int -> [Label] -> M ()
fill Int
80 ((Var -> Label) -> [Var] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Label
forall t. Uninternable t => t -> Uninterned t
unintern [Var]
vs) M () -> M () -> M ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> M ()
writeChar Char
'\n'

fill :: Int -> [T.Text] -> M ()
fill :: Int -> [Label] -> M ()
fill Int
width [Label]
str = [Label] -> Int -> M ()
go [Label]
str Int
0
  where
    go :: [Label] -> Int -> M ()
go [] Int
_ = () -> M ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (Label
x:[Label]
xs) Int
0 = Label -> M ()
writeString Label
x M () -> M () -> M ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Label] -> Int -> M ()
go [Label]
xs (Label -> Int
T.length Label
x)
    go (Label
x:[Label]
xs) Int
w =
      if Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Label -> Int
T.length Label
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width
        then Char -> M ()
writeChar Char
' ' M () -> M () -> M ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Label -> M ()
writeString Label
x M () -> M () -> M ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Label] -> Int -> M ()
go [Label]
xs (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Label -> Int
T.length Label
x)
        else Char -> M ()
writeChar Char
'\n' M () -> M () -> M ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Label] -> Int -> M ()
go (Label
xLabel -> [Label] -> [Label]
forall a. a -> [a] -> [a]
:[Label]
xs) Int
0

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

{-
compileExpr :: Expr -> Maybe (Map Var Scientific)
compileExpr e = do
  xs <- forM e $ \(Term c vs) ->
    case vs of
      [v] -> return (v, c)
      _ -> mzero
  return (Map.fromList xs)
-}

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

normalize :: (Eq r, Num r) => MIP.Problem r -> MIP.Problem r
normalize :: Problem r -> Problem r
normalize = Problem r -> Problem r
forall r. Num r => Problem r -> Problem r
removeEmptyExpr (Problem r -> Problem r)
-> (Problem r -> Problem r) -> Problem r -> Problem r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Problem r -> Problem r
forall r. (Eq r, Num r) => Problem r -> Problem r
removeRangeConstraints

removeRangeConstraints :: (Eq r, Num r) => MIP.Problem r -> MIP.Problem r
removeRangeConstraints :: Problem r -> Problem r
removeRangeConstraints Problem r
prob = (forall s. ST s (Problem r)) -> Problem r
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Problem r)) -> Problem r)
-> (forall s. ST s (Problem r)) -> Problem r
forall a b. (a -> b) -> a -> b
$ do
  STRef s (Set Var)
vsRef <- Set Var -> ST s (STRef s (Set Var))
forall a s. a -> ST s (STRef s a)
newSTRef (Set Var -> ST s (STRef s (Set Var)))
-> Set Var -> ST s (STRef s (Set Var))
forall a b. (a -> b) -> a -> b
$ Problem r -> Set Var
forall c. Problem c -> Set Var
MIP.variables Problem r
prob
  STRef s Int
cntRef <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int
0::Int)
  STRef s [(Var, (BoundExpr r, BoundExpr r))]
newvsRef <- [(Var, (BoundExpr r, BoundExpr r))]
-> ST s (STRef s [(Var, (BoundExpr r, BoundExpr r))])
forall a s. a -> ST s (STRef s a)
newSTRef []

  let gensym :: ST s Var
gensym = do
        Set Var
vs <- STRef s (Set Var) -> ST s (Set Var)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Set Var)
vsRef
        let loop :: Int -> ST s Var
loop !Int
c = do
              let v :: Var
v = String -> Var
MIP.toVar (String
"~r_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c)
              if Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Var
vs then
                Int -> ST s Var
loop (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              else do
                STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
cntRef (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$! Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                STRef s (Set Var) -> (Set Var -> Set Var) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Set Var)
vsRef (Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
Set.insert Var
v)
                Var -> ST s Var
forall (m :: * -> *) a. Monad m => a -> m a
return Var
v
        Int -> ST s Var
loop (Int -> ST s Var) -> ST s Int -> ST s Var
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
cntRef

  [Constraint r]
cs2 <- [Constraint r]
-> (Constraint r -> ST s (Constraint r)) -> ST s [Constraint r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem r
prob) ((Constraint r -> ST s (Constraint r)) -> ST s [Constraint r])
-> (Constraint r -> ST s (Constraint r)) -> ST s [Constraint r]
forall a b. (a -> b) -> a -> b
$ \Constraint r
c -> do
    case (Constraint r -> BoundExpr r
forall c. Constraint c -> BoundExpr c
MIP.constrLB Constraint r
c, Constraint r -> BoundExpr r
forall c. Constraint c -> BoundExpr c
MIP.constrUB Constraint r
c) of
      (BoundExpr r
MIP.NegInf, MIP.Finite r
_) -> Constraint r -> ST s (Constraint r)
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint r
c
      (MIP.Finite r
_, BoundExpr r
MIP.PosInf) -> Constraint r -> ST s (Constraint r)
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint r
c
      (MIP.Finite r
x1, MIP.Finite r
x2) | r
x1 r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
x2 -> Constraint r -> ST s (Constraint r)
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint r
c
      (BoundExpr r
lb, BoundExpr r
ub) -> do
        Var
v <- ST s Var
gensym
        STRef s [(Var, (BoundExpr r, BoundExpr r))]
-> ([(Var, (BoundExpr r, BoundExpr r))]
    -> [(Var, (BoundExpr r, BoundExpr r))])
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s [(Var, (BoundExpr r, BoundExpr r))]
newvsRef ((Var
v, (BoundExpr r
lb,BoundExpr r
ub)) (Var, (BoundExpr r, BoundExpr r))
-> [(Var, (BoundExpr r, BoundExpr r))]
-> [(Var, (BoundExpr r, BoundExpr r))]
forall a. a -> [a] -> [a]
:)
        Constraint r -> ST s (Constraint r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint r -> ST s (Constraint r))
-> Constraint r -> ST s (Constraint r)
forall a b. (a -> b) -> a -> b
$
          Constraint r
c
          { constrExpr :: Expr r
MIP.constrExpr = Constraint r -> Expr r
forall c. Constraint c -> Expr c
MIP.constrExpr Constraint r
c Expr r -> Expr r -> Expr r
forall a. Num a => a -> a -> a
- Var -> Expr r
forall c. Num c => Var -> Expr c
MIP.varExpr Var
v
          , constrLB :: BoundExpr r
MIP.constrLB = r -> BoundExpr r
forall r. r -> Extended r
MIP.Finite r
0
          , constrUB :: BoundExpr r
MIP.constrUB = r -> BoundExpr r
forall r. r -> Extended r
MIP.Finite r
0
          }

  [(Var, (BoundExpr r, BoundExpr r))]
newvs <- ([(Var, (BoundExpr r, BoundExpr r))]
 -> [(Var, (BoundExpr r, BoundExpr r))])
-> ST s [(Var, (BoundExpr r, BoundExpr r))]
-> ST s [(Var, (BoundExpr r, BoundExpr r))]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Var, (BoundExpr r, BoundExpr r))]
-> [(Var, (BoundExpr r, BoundExpr r))]
forall a. [a] -> [a]
reverse (ST s [(Var, (BoundExpr r, BoundExpr r))]
 -> ST s [(Var, (BoundExpr r, BoundExpr r))])
-> ST s [(Var, (BoundExpr r, BoundExpr r))]
-> ST s [(Var, (BoundExpr r, BoundExpr r))]
forall a b. (a -> b) -> a -> b
$ STRef s [(Var, (BoundExpr r, BoundExpr r))]
-> ST s [(Var, (BoundExpr r, BoundExpr r))]
forall s a. STRef s a -> ST s a
readSTRef STRef s [(Var, (BoundExpr r, BoundExpr r))]
newvsRef
  Problem r -> ST s (Problem r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Problem r -> ST s (Problem r)) -> Problem r -> ST s (Problem r)
forall a b. (a -> b) -> a -> b
$
    Problem r
prob
    { constraints :: [Constraint r]
MIP.constraints = [Constraint r]
cs2
    , varType :: Map Var VarType
MIP.varType = Problem r -> Map Var VarType
forall c. Problem c -> Map Var VarType
MIP.varType Problem r
prob Map Var VarType -> Map Var VarType -> Map Var VarType
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [(Var, VarType)] -> Map Var VarType
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Var
v, VarType
MIP.ContinuousVariable) | (Var
v,(BoundExpr r, BoundExpr r)
_) <- [(Var, (BoundExpr r, BoundExpr r))]
newvs]
    , varBounds :: Map Var (BoundExpr r, BoundExpr r)
MIP.varBounds = Problem r -> Map Var (BoundExpr r, BoundExpr r)
forall c. Problem c -> Map Var (Bounds c)
MIP.varBounds Problem r
prob Map Var (BoundExpr r, BoundExpr r)
-> Map Var (BoundExpr r, BoundExpr r)
-> Map Var (BoundExpr r, BoundExpr r)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ([(Var, (BoundExpr r, BoundExpr r))]
-> Map Var (BoundExpr r, BoundExpr r)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Var, (BoundExpr r, BoundExpr r))]
newvs)
    }

removeEmptyExpr :: Num r => MIP.Problem r -> MIP.Problem r
removeEmptyExpr :: Problem r -> Problem r
removeEmptyExpr Problem r
prob =
  Problem r
prob
  { objectiveFunction :: ObjectiveFunction r
MIP.objectiveFunction = ObjectiveFunction r
obj{ objExpr :: Expr r
MIP.objExpr = Expr r -> Expr r
forall c. Num c => Expr c -> Expr c
convertExpr (ObjectiveFunction r -> Expr r
forall c. ObjectiveFunction c -> Expr c
MIP.objExpr ObjectiveFunction r
obj) }
  , constraints :: [Constraint r]
MIP.constraints = (Constraint r -> Constraint r) -> [Constraint r] -> [Constraint r]
forall a b. (a -> b) -> [a] -> [b]
map Constraint r -> Constraint r
forall c. Num c => Constraint c -> Constraint c
convertConstr ([Constraint r] -> [Constraint r])
-> [Constraint r] -> [Constraint r]
forall a b. (a -> b) -> a -> b
$ Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.constraints Problem r
prob
  , userCuts :: [Constraint r]
MIP.userCuts    = (Constraint r -> Constraint r) -> [Constraint r] -> [Constraint r]
forall a b. (a -> b) -> [a] -> [b]
map Constraint r -> Constraint r
forall c. Num c => Constraint c -> Constraint c
convertConstr ([Constraint r] -> [Constraint r])
-> [Constraint r] -> [Constraint r]
forall a b. (a -> b) -> a -> b
$ Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
MIP.userCuts Problem r
prob
  }
  where
    obj :: ObjectiveFunction r
obj = Problem r -> ObjectiveFunction r
forall c. Problem c -> ObjectiveFunction c
MIP.objectiveFunction Problem r
prob

    convertExpr :: Expr c -> Expr c
convertExpr (MIP.Expr []) = [Term c] -> Expr c
forall c. [Term c] -> Expr c
MIP.Expr [c -> [Var] -> Term c
forall c. c -> [Var] -> Term c
MIP.Term c
0 [String -> Var
MIP.toVar String
"x0"]]
    convertExpr Expr c
e = Expr c
e

    convertConstr :: Constraint c -> Constraint c
convertConstr Constraint c
constr =
      Constraint c
constr
      { constrExpr :: Expr c
MIP.constrExpr = Expr c -> Expr c
forall c. Num c => Expr c -> Expr c
convertExpr (Expr c -> Expr c) -> Expr c -> Expr c
forall a b. (a -> b) -> a -> b
$ Constraint c -> Expr c
forall c. Constraint c -> Expr c
MIP.constrExpr Constraint c
constr
      }