{-# 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
( 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
#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)
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 ()
= 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"
]
#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
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
']')
(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)
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 :: 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"
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 =
[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
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
}