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

import Control.Applicative hiding (many)
import Control.Exception (throwIO)
import Control.Monad
import Control.Monad.Writer
import Control.Monad.ST
import Data.Char
import Data.Default.Class
import Data.List
import Data.Maybe
import Data.Scientific (Scientific, floatingOrInteger)
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.Int 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
import Text.Megaparsec hiding (label, skipManyTill, ParseError)
import Text.Megaparsec.Char hiding (string', char')
import qualified Text.Megaparsec.Char.Lexer as P

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

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

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

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

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

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

anyChar :: C e s m => m Char
anyChar :: forall e s (m :: * -> *). C e s m => m Char
anyChar = m Char
m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle

char' :: C e s m => Char -> m Char
char' :: forall e s (m :: * -> *). C e s m => 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 a. 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 -> 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' :: forall e s (m :: * -> *). C e s m => 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 :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m Char
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

comment :: C e s m => m ()
comment :: forall e s (m :: * -> *). C e s m => m ()
comment = do
  Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\\'
  m Char -> m (Tokens s) -> 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 (Tokens s) -> m (Tokens s)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol)

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

ident :: C e s m => m String
ident :: forall e s (m :: * -> *). C e s m => 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
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar m Char -> m Char -> m Char
forall a. m a -> m a -> m a
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
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar m Char -> m Char -> m Char
forall a. m a -> m a -> m a
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 a. a -> m a
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 :: forall e s (m :: * -> *). C e s m => m Var
variable = (String -> Var) -> m String -> m Var
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Var
forall a. IsString a => String -> a
fromString m String
forall e s (m :: * -> *). C e s m => m String
ident

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

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

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

-- | LP file parser
parser :: (MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) => m (MIP.Problem Scientific)
parser :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) =>
m (Problem Scientific)
parser = do
  Maybe Text
name <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ m Text -> m Text
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    m ()
forall e s (m :: * -> *).
(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 -> Text) -> m String -> m Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Text
forall a. IsString a => String -> a
fromString (m String -> m Text) -> m String -> m Text
forall a b. (a -> b) -> a -> b
$ m 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 a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
" *\\" m (Tokens s) -> m (Tokens s) -> m (Tokens s)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol))
  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 a. m a -> m a
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 a. m a -> m a -> m a
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 a. a -> m a
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 a. m a -> m a
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 a. m a -> m a
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 a. a -> m a
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
$
    MIP.Problem
    { name :: Maybe Text
MIP.name              = Maybe Text
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
    , varDomains :: Map Var (VarType, Bounds Scientific)
MIP.varDomains        = [(Var, (VarType, Bounds Scientific))]
-> Map Var (VarType, Bounds Scientific)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
       [ (Var
v, (VarType
t, Bounds Scientific
bs))
       | Var
v <- Set Var -> [Var]
forall a. Set a -> [a]
Set.toAscList Set Var
vs
       , let t :: VarType
t =
               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
       , let bs :: Bounds Scientific
bs = 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
       ]
    }

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

minimize, maximize :: C e s m => m ()
minimize :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maximize :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

end :: C e s m => m ()
end :: forall e s (m :: * -> *). C e s m => 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 :: forall e s (m :: * -> *). C e s m => m [Constraint Scientific]
constraintSection = m ()
forall e s (m :: * -> *). C e s m => m ()
subjectTo m () -> m [Constraint Scientific] -> m [Constraint Scientific]
forall a b. m a -> m b -> m b
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 a. m a -> m a
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 :: forall e s (m :: * -> *). C e s m => m ()
subjectTo = [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 a b. m a -> m b -> m b
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 a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 a b. m a -> m b -> m b
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 a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ]

constraint :: C e s m => Bool -> m (MIP.Constraint Scientific)
constraint :: forall e s (m :: * -> *).
C e s m =>
Bool -> m (Constraint Scientific)
constraint Bool
isLazy = do
  Maybe Text
name <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m Text
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Text
forall e s (m :: * -> *). C e s m => m Text
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 a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (Var, Scientific)
forall e s (m :: * -> *). C e s m => m (Var, Scientific)
indicator

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

  let (Extended Scientific
lb,Extended Scientific
ub) =
        case RelOp
op of
          RelOp
MIP.Le -> (Extended Scientific
forall r. Extended r
MIP.NegInf, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs)
          RelOp
MIP.Ge -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Extended Scientific
forall r. Extended r
MIP.PosInf)
          RelOp
MIP.Eql -> (Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs, Scientific -> Extended Scientific
forall r. r -> Extended r
MIP.Finite Scientific
rhs)

  Constraint Scientific -> m (Constraint Scientific)
forall a. a -> m a
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
$ MIP.Constraint
    { constrLabel :: Maybe Text
MIP.constrLabel     = Maybe Text
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 :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall a. a -> m a
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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall a. a -> m a
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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall a. a -> m a
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RelOp -> m RelOp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RelOp
MIP.Ge
                     , RelOp -> m RelOp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RelOp
MIP.Eql
                     ]
  ]

indicator :: C e s m => m (MIP.Var, Scientific)
indicator :: forall e s (m :: * -> *). C e s m => 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
forall e s (m :: * -> *). C e s m => m Scientific
number  -- numbers other than 0 or 1 should be error?
  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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var, Scientific
val)

lazyConstraintsSection :: C e s m => m [MIP.Constraint Scientific]
lazyConstraintsSection :: forall e s (m :: * -> *). C e s m => 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 a. m a -> m a
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 :: forall e s (m :: * -> *). C e s m => 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 a. m a -> m a
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 :: forall e s (m :: * -> *).
C e s m =>
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 a b. m a -> m b -> m b
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 a. m a -> m a
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 :: forall e s (m :: * -> *).
C e s m =>
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 a. m a -> m a
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 a. m a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 :: forall e s (m :: * -> *). C e s m => 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 a. m a -> m a
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *). C e s m => m ()
inf m () -> m (Extended Scientific) -> m (Extended Scientific)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Extended Scientific -> m (Extended Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Extended Scientific
forall r. Extended r
MIP.PosInf)
  , m (Extended Scientific) -> m (Extended Scientific)
forall a. m a -> m a
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *). C e s m => m ()
inf m () -> m (Extended Scientific) -> m (Extended Scientific)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Extended Scientific -> m (Extended Scientific)
forall a. a -> m a
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 a. a -> m a
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 :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

generalSection :: C e s m => m [MIP.Var]
generalSection :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
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 a. m a -> m a
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 :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"ies"))
  m Var -> m [Var]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Var -> m Var
forall a. m a -> m a
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 :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m ()
forall e s (m :: * -> *). C e s m => String -> m ()
string' String
"s")
  m Var -> m [Var]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Var -> m Var
forall a. m a -> m a
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 :: forall e s (m :: * -> *). C e s m => 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 a. m a -> m a
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 Text
l,SOSType
t) <- m (Maybe Text, SOSType) -> m (Maybe Text, SOSType)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (do{ Text
l <- m Text
forall e s (m :: * -> *). C e s m => m Text
label; SOSType
t <- m SOSType
typ; (Maybe Text, SOSType) -> m (Maybe Text, SOSType)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l, SOSType
t) })
          m (Maybe Text, SOSType)
-> m (Maybe Text, SOSType) -> m (Maybe Text, SOSType)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do{ SOSType
t <- m SOSType
typ; (Maybe Text, SOSType) -> m (Maybe Text, SOSType)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
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 a. m a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
v,Scientific
w)
    SOSConstraint Scientific -> m (SOSConstraint Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SOSConstraint Scientific -> m (SOSConstraint Scientific))
-> SOSConstraint Scientific -> m (SOSConstraint Scientific)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> SOSType -> [(Var, Scientific)] -> SOSConstraint Scientific
forall c. Maybe Text -> SOSType -> [(Var, c)] -> SOSConstraint c
MIP.SOSConstraint Maybe Text
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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SOSType -> m SOSType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
MIP.S1) m SOSType -> m SOSType -> m SOSType
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SOSType -> m SOSType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SOSType
MIP.S2)))
      m (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 a. a -> m a
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 :: forall e s (m :: * -> *). C e s m => m (Expr Scientific)
expr = m (Expr Scientific) -> m (Expr Scientific)
forall a. m a -> m a
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr Scientific -> m (Expr Scientific)
forall a. a -> m a
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 a. a -> m a
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 a b. (a -> b -> b) -> b -> [a] -> b
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 :: forall e s (m :: * -> *) a. (C e s m, Num a) => 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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1) m a -> m a -> m a
forall a. 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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall a. 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 :: forall e s (m :: * -> *). C e s m => 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 a. m a -> m a -> m a
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 a. a -> m a
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 :: forall e s (m :: * -> *). C e s m => m (Expr Scientific)
qexpr = do
  m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'[')
  Term Scientific
t <- Bool -> m (Term Scientific)
forall e s (m :: * -> *). C e s m => Bool -> m (Term Scientific)
qterm Bool
True
  [Term Scientific]
ts <- m (Term Scientific) -> m [Term Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Bool -> m (Term Scientific)
forall e s (m :: * -> *). C e s m => Bool -> m (Term Scientific)
qterm Bool
False)
  let e :: Expr Scientific
e = [Term Scientific] -> Expr Scientific
forall c. [Term c] -> Expr c
MIP.Expr (Term Scientific
tTerm Scientific -> [Term Scientific] -> [Term Scientific]
forall a. a -> [a] -> [a]
:[Term Scientific]
ts)
  m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
']')
  -- Gurobi allows ommiting "/2"
  (do (Char -> m Char) -> String -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (m Char -> m Char
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m Char -> m Char) -> (Char -> m Char) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char) (String
"/2" :: String) -- Explicit type signature is necessary because the type of mapM_ in GHC-7.10 is generalized for arbitrary Foldable
      Expr Scientific -> m (Expr Scientific)
forall a. a -> m a
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr Scientific -> m (Expr Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Scientific
e

qterm :: C e s m => Bool -> m (MIP.Term Scientific)
qterm :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a. a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term Scientific -> m (Term Scientific))
-> Term Scientific -> m (Term Scientific)
forall a b. (a -> b) -> a -> b
$ 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 :: forall e s (m :: * -> *). C e s m => 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 a b. m a -> m b -> m b
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Var] -> m [Var]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Var
v,Var
v]
       , [Var] -> m [Var]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Var
v]
       ]

number :: forall e s m. C e s m => m Scientific
number :: forall e s (m :: * -> *). C e s m => m Scientific
number = m Scientific -> m Scientific
forall e s (m :: * -> *) a. C e s m => m a -> m a
tok (m Scientific -> m Scientific) -> m Scientific -> m Scientific
forall a b. (a -> b) -> a -> b
$ m () -> m Scientific -> m Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
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

skipManyTill :: Alternative m => m a -> m end -> m ()
skipManyTill :: forall (m :: * -> *) a end. Alternative m => 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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m a
p m a -> m () -> m ()
forall a b. m a -> m b -> m b
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 :: forall a. M a -> Text
execM M a
m = Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ M a -> Builder
forall w a. Writer w a -> w
execWriter M a
m

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

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

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

-- | Render a problem into a 'TL.Text' containing LP file data.
render :: MIP.FileOptions -> MIP.Problem Scientific -> Either String TL.Text
render :: FileOptions -> Problem Scientific -> Either String Text
render FileOptions
_ Problem Scientific
mip = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ M () -> Text
forall a. M a -> Text
execM (M () -> Text) -> M () -> Text
forall a b. (a -> b) -> a -> b
$ Problem Scientific -> M ()
render' (Problem Scientific -> M ()) -> Problem Scientific -> M ()
forall a b. (a -> b) -> a -> b
$ Problem Scientific -> Problem Scientific
forall r. (Eq r, Num r) => Problem r -> Problem r
normalize Problem Scientific
mip

writeVar :: MIP.Var -> M ()
writeVar :: Var -> M ()
writeVar (MIP.Var Text
v) = Text -> M ()
writeString Text
v

render' :: MIP.Problem Scientific -> M ()
render' :: Problem Scientific -> M ()
render' Problem Scientific
mip = do
  case Problem Scientific -> Maybe Text
forall c. Problem c -> Maybe Text
MIP.name Problem Scientific
mip of
    Just Text
name -> Text -> M ()
writeString (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ Text
"\\* Problem: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" *\\\n"
    Maybe Text
Nothing -> () -> M ()
forall a. a -> WriterT Builder Identity a
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

  Text -> M ()
writeString (Text -> M ()) -> Text -> 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 -> Text
"MINIMIZE"
      OptDir
OptMax -> Text
"MAXIMIZE"
  Char -> M ()
writeChar Char
'\n'

  Maybe Text -> M ()
renderLabel (ObjectiveFunction Scientific -> Maybe Text
forall c. ObjectiveFunction c -> Maybe Text
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'

  Text -> M ()
writeString Text
"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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint Scientific]
lcs) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeString Text
"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 a. [a] -> 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
    Text -> M ()
writeString Text
"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

  Text -> M ()
writeString Text
"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
      Text -> M ()
writeString Text
" <= "
      Var -> M ()
writeVar Var
v
      Text -> M ()
writeString Text
" <= "
      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
    Text -> M ()
writeString Text
"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
    Text -> M ()
writeString Text
"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
    Text -> M ()
writeString Text
"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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Problem Scientific -> [SOSConstraint Scientific]
forall c. Problem c -> [SOSConstraint c]
MIP.sosConstraints Problem Scientific
mip)) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> M ()
writeString Text
"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 Text
l SOSType
typ [(Var, Scientific)]
xs) -> do
      Maybe Text -> M ()
renderLabel Maybe Text
l
      Text -> M ()
writeString (Text -> M ()) -> Text -> M ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SOSType -> String
forall a. Show a => a -> String
show SOSType
typ
      Text -> M ()
writeString Text
" ::"
      [(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
        Text -> M ()
writeString Text
"  "
        Var -> M ()
writeVar Var
v
        Text -> M ()
writeString Text
" : "
        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'

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

-- FIXME: Gurobi は quadratic term が最後に一つある形式でないとダメっぽい
renderExpr :: Bool -> MIP.Expr Scientific -> M ()
renderExpr :: Bool -> Expr Scientific -> M ()
renderExpr Bool
isObj Expr Scientific
e = Int -> [Text] -> M ()
fill Int
80 ([Text]
ts1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
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 :: [Text]
ts1 = (Term Scientific -> Text) -> [Term Scientific] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Term Scientific -> Text
f [Term Scientific]
ts
    ts2 :: [Text]
ts2
      | [Term Scientific] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Term Scientific]
qts  = []
      | Bool
otherwise =
        -- マイナスで始めるとSCIP 2.1.1 は「cannot have '-' in front of quadratic part ('[')」というエラーを出す
        -- SCIP-3.1.0 does not allow spaces between '/' and '2'.
        [Text
"+ ["] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Term Scientific -> Text) -> [Term Scientific] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Term Scientific -> Text
g [Term Scientific]
qts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [if Bool
isObj then Text
"] /2" else Text
"]"]

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

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

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

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

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

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

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

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 Text -> M ()
renderLabel (Constraint Scientific -> Maybe Text
forall c. Constraint c -> Maybe Text
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 a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Var
v,Scientific
vval) -> do
      Var -> M ()
writeVar Var
v
      Text -> M ()
writeString Text
" = "
      Builder -> M ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> M ()) -> Builder -> M ()
forall a b. (a -> b) -> a -> b
$
        case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
vval of
          Right (Integer
i :: Integer) -> Integer -> Builder
forall a. Integral a => a -> Builder
B.decimal Integer
i
          Left (Double
_ :: Double) -> Scientific -> Builder
B.scientificBuilder Scientific
vval  -- should be error?
      Text -> M ()
writeString Text
" -> "

  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 = Text -> M ()
writeString Text
"-inf"
renderBoundExpr Extended Scientific
MIP.PosInf = Text -> M ()
writeString Text
"+inf"

renderVariableList :: [MIP.Var] -> M ()
renderVariableList :: [Var] -> M ()
renderVariableList [Var]
vs = Int -> [Text] -> M ()
fill Int
80 ((Var -> Text) -> [Var] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Text
MIP.varName [Var]
vs) M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> M ()
writeChar Char
'\n'

fill :: Int -> [T.Text] -> M ()
fill :: Int -> [Text] -> M ()
fill Int
width [Text]
str = [Text] -> Int -> M ()
go [Text]
str Int
0
  where
    go :: [Text] -> Int -> M ()
go [] Int
_ = () -> M ()
forall a. a -> WriterT Builder Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (Text
x:[Text]
xs) Int
0 = Text -> M ()
writeString Text
x M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> Int -> M ()
go [Text]
xs (Text -> Int
T.length Text
x)
    go (Text
x:[Text]
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
+ Text -> Int
T.length Text
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width
        then Char -> M ()
writeChar Char
' ' M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> M ()
writeString Text
x M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> Int -> M ()
go [Text]
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
+ Text -> Int
T.length Text
x)
        else Char -> M ()
writeChar Char
'\n' M () -> M () -> M ()
forall a b.
WriterT Builder Identity a
-> WriterT Builder Identity b -> WriterT Builder Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> Int -> M ()
go (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs) Int
0

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

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

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

normalize :: (Eq r, Num r) => MIP.Problem r -> MIP.Problem r
normalize :: forall r. (Eq r, Num r) => 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 :: forall r. (Eq r, Num r) => 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
forall a. IsString a => String -> a
fromString (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 a. a -> ST s a
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 a. a -> ST s a
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 a. a -> ST s a
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 a. a -> ST s a
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 a. a -> ST s a
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
          { MIP.constrExpr = MIP.constrExpr c - MIP.varExpr v
          , MIP.constrLB = MIP.Finite 0
          , MIP.constrUB = MIP.Finite 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 a. a -> ST s a
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
    { MIP.constraints = cs2
    , MIP.varDomains = MIP.varDomains prob `Map.union` Map.fromList [(v, (MIP.ContinuousVariable, bs)) | (v,bs) <- newvs]
    }

removeEmptyExpr :: Num r => MIP.Problem r -> MIP.Problem r
removeEmptyExpr :: forall r. Num r => Problem r -> Problem r
removeEmptyExpr Problem r
prob =
  Problem r
prob
  { MIP.objectiveFunction = obj{ MIP.objExpr = convertExpr (MIP.objExpr obj) }
  , MIP.constraints = map convertConstr $ MIP.constraints prob
  , MIP.userCuts    = map convertConstr $ MIP.userCuts 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
forall a. IsString a => String -> a
fromString String
"x0"]]
    convertExpr Expr c
e = Expr c
e

    convertConstr :: Constraint c -> Constraint c
convertConstr Constraint c
constr =
      Constraint c
constr
      { MIP.constrExpr = convertExpr $ MIP.constrExpr constr
      }