{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Base
-- Copyright   :  (c) Masahiro Sakai 2011-2019
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- Mixed-Integer Programming Problems with some commmonly used extensions
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Base
  (
  -- * Mixed-Integer Programming (MIP) problem specification

  -- ** MIP problems
    Problem (..)

  -- *** Set of variables
  , variables
  , continuousVariables
  , integerVariables
  , binaryVariables
  , semiContinuousVariables
  , semiIntegerVariables

  -- *** Variable's attributes
  , varTypes
  , varType
  , getVarType
  , varBounds
  , getBounds

  -- ** Variables
  , Var (Var)
  , varName
  , toVar
  , fromVar

  -- *** Variable types
  , VarType (..)

  -- *** Variable bounds
  , BoundExpr
  , Extended (..)
  , Bounds
  , defaultBounds
  , defaultLB
  , defaultUB

  -- ** Labels
  , Label

  -- ** Expressions
  , Expr (Expr)
  , varExpr
  , constExpr
  , terms
  , Term (..)

  -- ** Objective function
  , OptDir (..)
  , ObjectiveFunction (..)

  -- ** Constraints

  -- *** Linear (or Quadratic or Polynomial) constraints
  , Constraint (..)
  , (.==.)
  , (.<=.)
  , (.>=.)
  , RelOp (..)

  -- *** SOS constraints
  , SOSType (..)
  , SOSConstraint (..)

  -- * Solutions
  , Solution (..)
  , Status (..)
  , meetStatus

  -- * Evaluation
  , Tol (..)
  , zeroTol
  , Eval (..)

  -- * File I/O
  , FileOptions (..)
  , WriteSetting (..)

  -- * Utilities
  , Default (..)
  , Variables (..)
  , intersectBounds
  ) where

#if !MIN_VERSION_lattices(2,0,0)
import Algebra.Lattice
#endif
import Algebra.PartialOrd
import Control.Arrow ((***))
import Control.Monad
import Data.Default.Class
import Data.Foldable (toList)
import Data.Hashable
import Data.List (sortBy)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ord (comparing)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Interned (intern, unintern)
import Data.Interned.Text
import Data.ExtendedReal
import Data.OptDir
import Data.String
import qualified Data.Text as T
import System.IO (TextEncoding)

infix 4 .<=., .>=., .==.

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

-- | A problem instance
data Problem c
  = Problem
  { forall c. Problem c -> Maybe Text
name :: Maybe T.Text
    -- ^ Problem name
  , forall c. Problem c -> ObjectiveFunction c
objectiveFunction :: ObjectiveFunction c
    -- ^ Objective functions of the problem
  , forall c. Problem c -> [Constraint c]
constraints :: [Constraint c]
    -- ^ Constraints of the problem
    --
    -- Indicator constraints and lazy constraints are included in this list.
  , forall c. Problem c -> [SOSConstraint c]
sosConstraints :: [SOSConstraint c]
    -- ^ Special ordered sets
  , forall c. Problem c -> [Constraint c]
userCuts :: [Constraint c]
    -- ^ User cuts
  , forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains :: Map Var (VarType, Bounds c)
    -- ^ Variable types and their bounds
  }
  deriving (Int -> Problem c -> ShowS
[Problem c] -> ShowS
Problem c -> String
(Int -> Problem c -> ShowS)
-> (Problem c -> String)
-> ([Problem c] -> ShowS)
-> Show (Problem c)
forall c. Show c => Int -> Problem c -> ShowS
forall c. Show c => [Problem c] -> ShowS
forall c. Show c => Problem c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Problem c -> ShowS
showsPrec :: Int -> Problem c -> ShowS
$cshow :: forall c. Show c => Problem c -> String
show :: Problem c -> String
$cshowList :: forall c. Show c => [Problem c] -> ShowS
showList :: [Problem c] -> ShowS
Show, Problem c -> Problem c -> Bool
(Problem c -> Problem c -> Bool)
-> (Problem c -> Problem c -> Bool) -> Eq (Problem c)
forall c. Eq c => Problem c -> Problem c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Problem c -> Problem c -> Bool
== :: Problem c -> Problem c -> Bool
$c/= :: forall c. Eq c => Problem c -> Problem c -> Bool
/= :: Problem c -> Problem c -> Bool
Eq, Eq (Problem c)
Eq (Problem c) =>
(Problem c -> Problem c -> Ordering)
-> (Problem c -> Problem c -> Bool)
-> (Problem c -> Problem c -> Bool)
-> (Problem c -> Problem c -> Bool)
-> (Problem c -> Problem c -> Bool)
-> (Problem c -> Problem c -> Problem c)
-> (Problem c -> Problem c -> Problem c)
-> Ord (Problem c)
Problem c -> Problem c -> Bool
Problem c -> Problem c -> Ordering
Problem c -> Problem c -> Problem c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. Ord c => Eq (Problem c)
forall c. Ord c => Problem c -> Problem c -> Bool
forall c. Ord c => Problem c -> Problem c -> Ordering
forall c. Ord c => Problem c -> Problem c -> Problem c
$ccompare :: forall c. Ord c => Problem c -> Problem c -> Ordering
compare :: Problem c -> Problem c -> Ordering
$c< :: forall c. Ord c => Problem c -> Problem c -> Bool
< :: Problem c -> Problem c -> Bool
$c<= :: forall c. Ord c => Problem c -> Problem c -> Bool
<= :: Problem c -> Problem c -> Bool
$c> :: forall c. Ord c => Problem c -> Problem c -> Bool
> :: Problem c -> Problem c -> Bool
$c>= :: forall c. Ord c => Problem c -> Problem c -> Bool
>= :: Problem c -> Problem c -> Bool
$cmax :: forall c. Ord c => Problem c -> Problem c -> Problem c
max :: Problem c -> Problem c -> Problem c
$cmin :: forall c. Ord c => Problem c -> Problem c -> Problem c
min :: Problem c -> Problem c -> Problem c
Ord)

instance Default (Problem c) where
  def :: Problem c
def = Problem
        { name :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing
        , objectiveFunction :: ObjectiveFunction c
objectiveFunction = ObjectiveFunction c
forall a. Default a => a
def
        , constraints :: [Constraint c]
constraints = []
        , sosConstraints :: [SOSConstraint c]
sosConstraints = []
        , userCuts :: [Constraint c]
userCuts = []
        , varDomains :: Map Var (VarType, Bounds c)
varDomains = Map Var (VarType, Bounds c)
forall k a. Map k a
Map.empty
        }

instance Functor Problem where
  fmap :: forall a b. (a -> b) -> Problem a -> Problem b
fmap a -> b
f Problem a
prob =
    Problem a
prob
    { objectiveFunction = fmap f (objectiveFunction prob)
    , constraints       = map (fmap f) (constraints prob)
    , sosConstraints    = map (fmap f) (sosConstraints prob)
    , userCuts          = map (fmap f) (userCuts prob)
    , varDomains        = fmap (id *** (fmap f *** fmap f)) (varDomains prob)
    }

-- | Types of variables
--
-- This is equivalent to:
--
-- @
-- 'fmap' 'fst' . 'varDomains'
-- @
varTypes :: Problem c -> Map Var VarType
varTypes :: forall c. Problem c -> Map Var VarType
varTypes = ((VarType, Bounds c) -> VarType)
-> Map Var (VarType, Bounds c) -> Map Var VarType
forall a b. (a -> b) -> Map Var a -> Map Var b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VarType, Bounds c) -> VarType
forall a b. (a, b) -> a
fst (Map Var (VarType, Bounds c) -> Map Var VarType)
-> (Problem c -> Map Var (VarType, Bounds c))
-> Problem c
-> Map Var VarType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains

{-# DEPRECATED varType "Use varTypes instead" #-}
-- | Types of variables
--
-- Deprecated alias of 'varTypes'.
varType :: Problem c -> Map Var VarType
varType :: forall c. Problem c -> Map Var VarType
varType = Problem c -> Map Var VarType
forall c. Problem c -> Map Var VarType
varTypes

-- | Bounds of variables
--
-- This is equivalent to:
--
-- @
-- 'fmap' 'snd' . 'varDomains'
-- @
varBounds :: Problem c -> Map Var (Bounds c)
varBounds :: forall c. Problem c -> Map Var (Bounds c)
varBounds = ((VarType, Bounds c) -> Bounds c)
-> Map Var (VarType, Bounds c) -> Map Var (Bounds c)
forall a b. (a -> b) -> Map Var a -> Map Var b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VarType, Bounds c) -> Bounds c
forall a b. (a, b) -> b
snd (Map Var (VarType, Bounds c) -> Map Var (Bounds c))
-> (Problem c -> Map Var (VarType, Bounds c))
-> Problem c
-> Map Var (Bounds c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains

-- | Label used for naming various elements of t'Problem'
type Label = T.Text

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

-- | Variables used in problems
newtype Var = Var' InternedText
  deriving Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
/= :: Var -> Var -> Bool
Eq

pattern Var :: T.Text -> Var
pattern $mVar :: forall {r}. Var -> (Text -> r) -> ((# #) -> r) -> r
$bVar :: Text -> Var
Var s <- Var' (unintern -> s) where
  Var Text
s = InternedText -> Var
Var' (Uninterned InternedText -> InternedText
forall t. Interned t => Uninterned t -> t
intern Text
Uninterned InternedText
s)

{-# COMPLETE Var #-}

instance IsString Var where
  fromString :: String -> Var
fromString = InternedText -> Var
Var' (InternedText -> Var) -> (String -> InternedText) -> String -> Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InternedText
forall a. IsString a => String -> a
fromString

instance Ord Var where
  compare :: Var -> Var -> Ordering
compare (Var' InternedText
a) (Var' InternedText
b)
    | InternedText
a InternedText -> InternedText -> Bool
forall a. Eq a => a -> a -> Bool
== InternedText
b = Ordering
EQ
    | Bool
otherwise = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (InternedText -> Uninterned InternedText
forall t. Uninternable t => t -> Uninterned t
unintern InternedText
a) (InternedText -> Uninterned InternedText
forall t. Uninternable t => t -> Uninterned t
unintern InternedText
b)

instance Show Var where
  showsPrec :: Int -> Var -> ShowS
showsPrec Int
d (Var Text
x) = Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Text
x

instance Hashable Var where
#if MIN_VERSION_intern(0,9,3)
  hashWithSalt :: Int -> Var -> Int
hashWithSalt Int
salt (Var' InternedText
x) = Int -> InternedText -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt InternedText
x
#else
  hashWithSalt salt (Var' x) = hashWithSalt salt (internedTextId x)
#endif

-- | Variable's name
varName :: Var -> T.Text
varName :: Var -> Text
varName (Var Text
s) = Text
s

{-# DEPRECATED toVar "Use fromString function or Var pattern instead" #-}
-- | convert a string into a variable
toVar :: String -> Var
toVar :: String -> Var
toVar = String -> Var
forall a. IsString a => String -> a
fromString

{-# DEPRECATED fromVar "Use varName function or Var pattern instead" #-}
-- | convert a variable into a string
fromVar :: Var -> String
fromVar :: Var -> String
fromVar (Var Text
s) = Text -> String
T.unpack Text
s

-- | Type of variables
--
-- Variables can take values depending on their types and their bounds ('Bounds').
data VarType
  = ContinuousVariable     -- ^ can take values from \(\{x \in \mathbb{R} \mid L \le x \le U\}\)
  | IntegerVariable        -- ^ can take values from \(\{x \in \mathbb{Z} \mid L \le x \le U\}\)
  | SemiContinuousVariable -- ^ can take values from \(\{0\} \cup \{x \in \mathbb{R} \mid L \le x \le U\}\)
  | SemiIntegerVariable    -- ^ can take values from \(\{0\} \cup \{x \in \mathbb{Z} \mid L \le x \le U\}\)
  deriving (VarType -> VarType -> Bool
(VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool) -> Eq VarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
/= :: VarType -> VarType -> Bool
Eq, Eq VarType
Eq VarType =>
(VarType -> VarType -> Ordering)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> VarType)
-> (VarType -> VarType -> VarType)
-> Ord VarType
VarType -> VarType -> Bool
VarType -> VarType -> Ordering
VarType -> VarType -> VarType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VarType -> VarType -> Ordering
compare :: VarType -> VarType -> Ordering
$c< :: VarType -> VarType -> Bool
< :: VarType -> VarType -> Bool
$c<= :: VarType -> VarType -> Bool
<= :: VarType -> VarType -> Bool
$c> :: VarType -> VarType -> Bool
> :: VarType -> VarType -> Bool
$c>= :: VarType -> VarType -> Bool
>= :: VarType -> VarType -> Bool
$cmax :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
min :: VarType -> VarType -> VarType
Ord, Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> String
(Int -> VarType -> ShowS)
-> (VarType -> String) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarType -> ShowS
showsPrec :: Int -> VarType -> ShowS
$cshow :: VarType -> String
show :: VarType -> String
$cshowList :: [VarType] -> ShowS
showList :: [VarType] -> ShowS
Show)

instance Default VarType where
  def :: VarType
def = VarType
ContinuousVariable

-- | looking up bounds for a variable
getVarType :: Problem c -> Var -> VarType
getVarType :: forall c. Problem c -> Var -> VarType
getVarType Problem c
mip Var
v =
  case Var -> Map Var (VarType, Bounds c) -> Maybe (VarType, Bounds c)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Var
v (Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip) of
    Just (VarType
vt, Bounds c
_) -> VarType
vt
    Maybe (VarType, Bounds c)
Nothing -> VarType
forall a. Default a => a
def

-- | type for representing lower/upper bound of variables
type BoundExpr c = Extended c

-- | type for representing lower/upper bound of variables
type Bounds c = (BoundExpr c, BoundExpr c)

-- | default bounds
defaultBounds :: Num c => Bounds c
defaultBounds :: forall c. Num c => Bounds c
defaultBounds = (BoundExpr c
forall c. Num c => BoundExpr c
defaultLB, BoundExpr c
forall c. BoundExpr c
defaultUB)

-- | default lower bound (0)
defaultLB :: Num c => BoundExpr c
defaultLB :: forall c. Num c => BoundExpr c
defaultLB = c -> Extended c
forall r. r -> Extended r
Finite c
0

-- | default upper bound (+∞)
defaultUB :: BoundExpr c
defaultUB :: forall c. BoundExpr c
defaultUB = Extended c
forall c. BoundExpr c
PosInf

-- | looking up bounds for a variable
getBounds :: Num c => Problem c -> Var -> Bounds c
getBounds :: forall c. Num c => Problem c -> Var -> Bounds c
getBounds Problem c
mip Var
v =
  case Var -> Map Var (VarType, Bounds c) -> Maybe (VarType, Bounds c)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Var
v (Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip) of
    Just (VarType
_, Bounds c
bs) -> Bounds c
bs
    Maybe (VarType, Bounds c)
Nothing -> Bounds c
forall c. Num c => Bounds c
defaultBounds

-- | Intersection of two 'Bounds'
intersectBounds :: Ord c => Bounds c -> Bounds c -> Bounds c
intersectBounds :: forall c. Ord c => Bounds c -> Bounds c -> Bounds c
intersectBounds (BoundExpr c
lb1,BoundExpr c
ub1) (BoundExpr c
lb2,BoundExpr c
ub2) = (BoundExpr c -> BoundExpr c -> BoundExpr c
forall a. Ord a => a -> a -> a
max BoundExpr c
lb1 BoundExpr c
lb2, BoundExpr c -> BoundExpr c -> BoundExpr c
forall a. Ord a => a -> a -> a
min BoundExpr c
ub1 BoundExpr c
ub2)

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

-- | Arithmetic expressions
--
-- Essentialy an expression is a sequence of t'Term's.
newtype Expr c = Expr' (Seq (Term c))
  deriving (Expr c -> Expr c -> Bool
(Expr c -> Expr c -> Bool)
-> (Expr c -> Expr c -> Bool) -> Eq (Expr c)
forall c. Eq c => Expr c -> Expr c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Expr c -> Expr c -> Bool
== :: Expr c -> Expr c -> Bool
$c/= :: forall c. Eq c => Expr c -> Expr c -> Bool
/= :: Expr c -> Expr c -> Bool
Eq, Eq (Expr c)
Eq (Expr c) =>
(Expr c -> Expr c -> Ordering)
-> (Expr c -> Expr c -> Bool)
-> (Expr c -> Expr c -> Bool)
-> (Expr c -> Expr c -> Bool)
-> (Expr c -> Expr c -> Bool)
-> (Expr c -> Expr c -> Expr c)
-> (Expr c -> Expr c -> Expr c)
-> Ord (Expr c)
Expr c -> Expr c -> Bool
Expr c -> Expr c -> Ordering
Expr c -> Expr c -> Expr c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. Ord c => Eq (Expr c)
forall c. Ord c => Expr c -> Expr c -> Bool
forall c. Ord c => Expr c -> Expr c -> Ordering
forall c. Ord c => Expr c -> Expr c -> Expr c
$ccompare :: forall c. Ord c => Expr c -> Expr c -> Ordering
compare :: Expr c -> Expr c -> Ordering
$c< :: forall c. Ord c => Expr c -> Expr c -> Bool
< :: Expr c -> Expr c -> Bool
$c<= :: forall c. Ord c => Expr c -> Expr c -> Bool
<= :: Expr c -> Expr c -> Bool
$c> :: forall c. Ord c => Expr c -> Expr c -> Bool
> :: Expr c -> Expr c -> Bool
$c>= :: forall c. Ord c => Expr c -> Expr c -> Bool
>= :: Expr c -> Expr c -> Bool
$cmax :: forall c. Ord c => Expr c -> Expr c -> Expr c
max :: Expr c -> Expr c -> Expr c
$cmin :: forall c. Ord c => Expr c -> Expr c -> Expr c
min :: Expr c -> Expr c -> Expr c
Ord)

pattern Expr :: [Term c] -> Expr c
pattern $mExpr :: forall {r} {c}. Expr c -> ([Term c] -> r) -> ((# #) -> r) -> r
$bExpr :: forall c. [Term c] -> Expr c
Expr ts <- Expr' (toList -> ts) where
  Expr [Term c]
ts = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' ([Term c] -> Seq (Term c)
forall a. [a] -> Seq a
Seq.fromList [Term c]
ts)

{-# COMPLETE Expr #-}

instance Show c => Show (Expr c) where
  showsPrec :: Int -> Expr c -> ShowS
showsPrec Int
d (Expr [Term c]
ts) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Expr " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Term c] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Term c]
ts
    where
      app_prec :: Int
app_prec = Int
10

-- | Variable expression
varExpr :: Num c => Var -> Expr c
varExpr :: forall c. Num c => Var -> Expr c
varExpr Var
v = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' (Seq (Term c) -> Expr c) -> Seq (Term c) -> Expr c
forall a b. (a -> b) -> a -> b
$ Term c -> Seq (Term c)
forall a. a -> Seq a
Seq.singleton (Term c -> Seq (Term c)) -> Term c -> Seq (Term c)
forall a b. (a -> b) -> a -> b
$ c -> [Var] -> Term c
forall c. c -> [Var] -> Term c
Term c
1 [Var
v]

-- | Constant expression
constExpr :: (Eq c, Num c) => c -> Expr c
constExpr :: forall c. (Eq c, Num c) => c -> Expr c
constExpr c
0 = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' Seq (Term c)
forall a. Seq a
Seq.empty
constExpr c
c = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' (Seq (Term c) -> Expr c) -> Seq (Term c) -> Expr c
forall a b. (a -> b) -> a -> b
$ Term c -> Seq (Term c)
forall a. a -> Seq a
Seq.singleton (Term c -> Seq (Term c)) -> Term c -> Seq (Term c)
forall a b. (a -> b) -> a -> b
$ c -> [Var] -> Term c
forall c. c -> [Var] -> Term c
Term c
c []

-- | Terms of an expression
terms :: Expr c -> [Term c]
terms :: forall c. Expr c -> [Term c]
terms (Expr [Term c]
ts) = [Term c]
ts

instance Num c => Num (Expr c) where
  Expr' Seq (Term c)
e1 + :: Expr c -> Expr c -> Expr c
+ Expr' Seq (Term c)
e2 = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' (Seq (Term c)
e1 Seq (Term c) -> Seq (Term c) -> Seq (Term c)
forall a. Semigroup a => a -> a -> a
<> Seq (Term c)
e2)
  Expr [Term c]
e1 * :: Expr c -> Expr c -> Expr c
* Expr [Term c]
e2 = [Term c] -> Expr c
forall c. [Term c] -> Expr c
Expr [c -> [Var] -> Term c
forall c. c -> [Var] -> Term c
Term (c
c1c -> c -> c
forall a. Num a => a -> a -> a
*c
c2) ([Var]
vs1 [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
vs2) | Term c
c1 [Var]
vs1 <- [Term c]
e1, Term c
c2 [Var]
vs2 <- [Term c]
e2]
  negate :: Expr c -> Expr c
negate (Expr' Seq (Term c)
e) = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' (Seq (Term c) -> Expr c) -> Seq (Term c) -> Expr c
forall a b. (a -> b) -> a -> b
$ (Term c -> Term c) -> Seq (Term c) -> Seq (Term c)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Term c
c [Var]
vs) -> c -> [Var] -> Term c
forall c. c -> [Var] -> Term c
Term (-c
c) [Var]
vs) Seq (Term c)
e
  abs :: Expr c -> Expr c
abs = Expr c -> Expr c
forall a. a -> a
id
  signum :: Expr c -> Expr c
signum Expr c
_ = Expr c
1
  fromInteger :: Integer -> Expr c
fromInteger Integer
0 = [Term c] -> Expr c
forall c. [Term c] -> Expr c
Expr []
  fromInteger Integer
c = [Term c] -> Expr c
forall c. [Term c] -> Expr c
Expr [c -> [Var] -> Term c
forall c. c -> [Var] -> Term c
Term (Integer -> c
forall a. Num a => Integer -> a
fromInteger Integer
c) []]

instance Functor Expr where
  fmap :: forall a b. (a -> b) -> Expr a -> Expr b
fmap a -> b
f (Expr' Seq (Term a)
ts) = Seq (Term b) -> Expr b
forall c. Seq (Term c) -> Expr c
Expr' (Seq (Term b) -> Expr b) -> Seq (Term b) -> Expr b
forall a b. (a -> b) -> a -> b
$ (Term a -> Term b) -> Seq (Term a) -> Seq (Term b)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Term a -> Term b
forall a b. (a -> b) -> Term a -> Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Seq (Term a)
ts

-- | Split an expression into an expression without constant term and a constant
splitConst :: Num c => Expr c -> (Expr c, c)
splitConst :: forall c. Num c => Expr c -> (Expr c, c)
splitConst (Expr' Seq (Term c)
ts) = (Expr c
e2, c
c2)
  where
    p :: Term c -> Bool
p (Term c
_ (Var
_:[Var]
_)) = Bool
True
    p Term c
_ = Bool
False
    e2 :: Expr c
e2 = Seq (Term c) -> Expr c
forall c. Seq (Term c) -> Expr c
Expr' (Seq (Term c) -> Expr c) -> Seq (Term c) -> Expr c
forall a b. (a -> b) -> a -> b
$ (Term c -> Bool) -> Seq (Term c) -> Seq (Term c)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Term c -> Bool
forall {c}. Term c -> Bool
p Seq (Term c)
ts
    c2 :: c
c2 = [c] -> c
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [c
c | Term c
c [] <- Seq (Term c) -> [Term c]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term c)
ts]

-- | terms
data Term c = Term c [Var]
  deriving (Term c -> Term c -> Bool
(Term c -> Term c -> Bool)
-> (Term c -> Term c -> Bool) -> Eq (Term c)
forall c. Eq c => Term c -> Term c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Term c -> Term c -> Bool
== :: Term c -> Term c -> Bool
$c/= :: forall c. Eq c => Term c -> Term c -> Bool
/= :: Term c -> Term c -> Bool
Eq, Eq (Term c)
Eq (Term c) =>
(Term c -> Term c -> Ordering)
-> (Term c -> Term c -> Bool)
-> (Term c -> Term c -> Bool)
-> (Term c -> Term c -> Bool)
-> (Term c -> Term c -> Bool)
-> (Term c -> Term c -> Term c)
-> (Term c -> Term c -> Term c)
-> Ord (Term c)
Term c -> Term c -> Bool
Term c -> Term c -> Ordering
Term c -> Term c -> Term c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. Ord c => Eq (Term c)
forall c. Ord c => Term c -> Term c -> Bool
forall c. Ord c => Term c -> Term c -> Ordering
forall c. Ord c => Term c -> Term c -> Term c
$ccompare :: forall c. Ord c => Term c -> Term c -> Ordering
compare :: Term c -> Term c -> Ordering
$c< :: forall c. Ord c => Term c -> Term c -> Bool
< :: Term c -> Term c -> Bool
$c<= :: forall c. Ord c => Term c -> Term c -> Bool
<= :: Term c -> Term c -> Bool
$c> :: forall c. Ord c => Term c -> Term c -> Bool
> :: Term c -> Term c -> Bool
$c>= :: forall c. Ord c => Term c -> Term c -> Bool
>= :: Term c -> Term c -> Bool
$cmax :: forall c. Ord c => Term c -> Term c -> Term c
max :: Term c -> Term c -> Term c
$cmin :: forall c. Ord c => Term c -> Term c -> Term c
min :: Term c -> Term c -> Term c
Ord, Int -> Term c -> ShowS
[Term c] -> ShowS
Term c -> String
(Int -> Term c -> ShowS)
-> (Term c -> String) -> ([Term c] -> ShowS) -> Show (Term c)
forall c. Show c => Int -> Term c -> ShowS
forall c. Show c => [Term c] -> ShowS
forall c. Show c => Term c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Term c -> ShowS
showsPrec :: Int -> Term c -> ShowS
$cshow :: forall c. Show c => Term c -> String
show :: Term c -> String
$cshowList :: forall c. Show c => [Term c] -> ShowS
showList :: [Term c] -> ShowS
Show)

instance Functor Term where
  fmap :: forall a b. (a -> b) -> Term a -> Term b
fmap a -> b
f (Term a
c [Var]
vs) = b -> [Var] -> Term b
forall c. c -> [Var] -> Term c
Term (a -> b
f a
c) [Var]
vs

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

-- | objective function
data ObjectiveFunction c
  = ObjectiveFunction
  { forall c. ObjectiveFunction c -> Maybe Text
objLabel :: Maybe Label
  , forall c. ObjectiveFunction c -> OptDir
objDir :: OptDir
  , forall c. ObjectiveFunction c -> Expr c
objExpr :: Expr c
  }
  deriving (ObjectiveFunction c -> ObjectiveFunction c -> Bool
(ObjectiveFunction c -> ObjectiveFunction c -> Bool)
-> (ObjectiveFunction c -> ObjectiveFunction c -> Bool)
-> Eq (ObjectiveFunction c)
forall c.
Eq c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c.
Eq c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
== :: ObjectiveFunction c -> ObjectiveFunction c -> Bool
$c/= :: forall c.
Eq c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
/= :: ObjectiveFunction c -> ObjectiveFunction c -> Bool
Eq, Eq (ObjectiveFunction c)
Eq (ObjectiveFunction c) =>
(ObjectiveFunction c -> ObjectiveFunction c -> Ordering)
-> (ObjectiveFunction c -> ObjectiveFunction c -> Bool)
-> (ObjectiveFunction c -> ObjectiveFunction c -> Bool)
-> (ObjectiveFunction c -> ObjectiveFunction c -> Bool)
-> (ObjectiveFunction c -> ObjectiveFunction c -> Bool)
-> (ObjectiveFunction c
    -> ObjectiveFunction c -> ObjectiveFunction c)
-> (ObjectiveFunction c
    -> ObjectiveFunction c -> ObjectiveFunction c)
-> Ord (ObjectiveFunction c)
ObjectiveFunction c -> ObjectiveFunction c -> Bool
ObjectiveFunction c -> ObjectiveFunction c -> Ordering
ObjectiveFunction c -> ObjectiveFunction c -> ObjectiveFunction c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. Ord c => Eq (ObjectiveFunction c)
forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Ordering
forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> ObjectiveFunction c
$ccompare :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Ordering
compare :: ObjectiveFunction c -> ObjectiveFunction c -> Ordering
$c< :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
< :: ObjectiveFunction c -> ObjectiveFunction c -> Bool
$c<= :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
<= :: ObjectiveFunction c -> ObjectiveFunction c -> Bool
$c> :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
> :: ObjectiveFunction c -> ObjectiveFunction c -> Bool
$c>= :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> Bool
>= :: ObjectiveFunction c -> ObjectiveFunction c -> Bool
$cmax :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> ObjectiveFunction c
max :: ObjectiveFunction c -> ObjectiveFunction c -> ObjectiveFunction c
$cmin :: forall c.
Ord c =>
ObjectiveFunction c -> ObjectiveFunction c -> ObjectiveFunction c
min :: ObjectiveFunction c -> ObjectiveFunction c -> ObjectiveFunction c
Ord, Int -> ObjectiveFunction c -> ShowS
[ObjectiveFunction c] -> ShowS
ObjectiveFunction c -> String
(Int -> ObjectiveFunction c -> ShowS)
-> (ObjectiveFunction c -> String)
-> ([ObjectiveFunction c] -> ShowS)
-> Show (ObjectiveFunction c)
forall c. Show c => Int -> ObjectiveFunction c -> ShowS
forall c. Show c => [ObjectiveFunction c] -> ShowS
forall c. Show c => ObjectiveFunction c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> ObjectiveFunction c -> ShowS
showsPrec :: Int -> ObjectiveFunction c -> ShowS
$cshow :: forall c. Show c => ObjectiveFunction c -> String
show :: ObjectiveFunction c -> String
$cshowList :: forall c. Show c => [ObjectiveFunction c] -> ShowS
showList :: [ObjectiveFunction c] -> ShowS
Show)

instance Default (ObjectiveFunction c) where
  def :: ObjectiveFunction c
def =
    ObjectiveFunction
    { objLabel :: Maybe Text
objLabel = Maybe Text
forall a. Maybe a
Nothing
    , objDir :: OptDir
objDir = OptDir
OptMin
    , objExpr :: Expr c
objExpr = [Term c] -> Expr c
forall c. [Term c] -> Expr c
Expr []
    }

instance Functor ObjectiveFunction where
  fmap :: forall a b. (a -> b) -> ObjectiveFunction a -> ObjectiveFunction b
fmap a -> b
f ObjectiveFunction a
obj = ObjectiveFunction a
obj{ objExpr = fmap f (objExpr obj) }

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

-- | Constraint
--
-- In the most general case, it is of the form @x = v → L ≤ e ≤ U@.
data Constraint c
  = Constraint
  { forall c. Constraint c -> Maybe Text
constrLabel     :: Maybe Label
    -- ^ name of the constraint
  , forall c. Constraint c -> Maybe (Var, c)
constrIndicator :: Maybe (Var, c)
    -- ^ @x = v@ (v is either 0 or 1)
  , forall c. Constraint c -> Expr c
constrExpr      :: Expr c
    -- ^ expression @e@
  , forall c. Constraint c -> BoundExpr c
constrLB        :: BoundExpr c
    -- ^ lower bound @L@
  , forall c. Constraint c -> BoundExpr c
constrUB        :: BoundExpr c
    -- ^ upper bound @U@
  , forall c. Constraint c -> Bool
constrIsLazy    :: Bool
    -- ^ if it is set to @True@, solver can delay adding the constraint until the constraint is violated.
  }
  deriving (Constraint c -> Constraint c -> Bool
(Constraint c -> Constraint c -> Bool)
-> (Constraint c -> Constraint c -> Bool) -> Eq (Constraint c)
forall c. Eq c => Constraint c -> Constraint c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Constraint c -> Constraint c -> Bool
== :: Constraint c -> Constraint c -> Bool
$c/= :: forall c. Eq c => Constraint c -> Constraint c -> Bool
/= :: Constraint c -> Constraint c -> Bool
Eq, Eq (Constraint c)
Eq (Constraint c) =>
(Constraint c -> Constraint c -> Ordering)
-> (Constraint c -> Constraint c -> Bool)
-> (Constraint c -> Constraint c -> Bool)
-> (Constraint c -> Constraint c -> Bool)
-> (Constraint c -> Constraint c -> Bool)
-> (Constraint c -> Constraint c -> Constraint c)
-> (Constraint c -> Constraint c -> Constraint c)
-> Ord (Constraint c)
Constraint c -> Constraint c -> Bool
Constraint c -> Constraint c -> Ordering
Constraint c -> Constraint c -> Constraint c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. Ord c => Eq (Constraint c)
forall c. Ord c => Constraint c -> Constraint c -> Bool
forall c. Ord c => Constraint c -> Constraint c -> Ordering
forall c. Ord c => Constraint c -> Constraint c -> Constraint c
$ccompare :: forall c. Ord c => Constraint c -> Constraint c -> Ordering
compare :: Constraint c -> Constraint c -> Ordering
$c< :: forall c. Ord c => Constraint c -> Constraint c -> Bool
< :: Constraint c -> Constraint c -> Bool
$c<= :: forall c. Ord c => Constraint c -> Constraint c -> Bool
<= :: Constraint c -> Constraint c -> Bool
$c> :: forall c. Ord c => Constraint c -> Constraint c -> Bool
> :: Constraint c -> Constraint c -> Bool
$c>= :: forall c. Ord c => Constraint c -> Constraint c -> Bool
>= :: Constraint c -> Constraint c -> Bool
$cmax :: forall c. Ord c => Constraint c -> Constraint c -> Constraint c
max :: Constraint c -> Constraint c -> Constraint c
$cmin :: forall c. Ord c => Constraint c -> Constraint c -> Constraint c
min :: Constraint c -> Constraint c -> Constraint c
Ord, Int -> Constraint c -> ShowS
[Constraint c] -> ShowS
Constraint c -> String
(Int -> Constraint c -> ShowS)
-> (Constraint c -> String)
-> ([Constraint c] -> ShowS)
-> Show (Constraint c)
forall c. Show c => Int -> Constraint c -> ShowS
forall c. Show c => [Constraint c] -> ShowS
forall c. Show c => Constraint c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Constraint c -> ShowS
showsPrec :: Int -> Constraint c -> ShowS
$cshow :: forall c. Show c => Constraint c -> String
show :: Constraint c -> String
$cshowList :: forall c. Show c => [Constraint c] -> ShowS
showList :: [Constraint c] -> ShowS
Show)

-- | Equality constraint.
(.==.) :: Num c => Expr c -> Expr c -> Constraint c
Expr c
lhs .==. :: forall c. Num c => Expr c -> Expr c -> Constraint c
.==. Expr c
rhs =
  case Expr c -> (Expr c, c)
forall c. Num c => Expr c -> (Expr c, c)
splitConst (Expr c
lhs Expr c -> Expr c -> Expr c
forall a. Num a => a -> a -> a
- Expr c
rhs) of
    (Expr c
e, c
c) -> Constraint c
forall a. Default a => a
def{ constrExpr = e, constrLB = Finite (- c), constrUB = Finite (- c) }

-- | Inequality constraint (≤).
(.<=.) :: Num c => Expr c -> Expr c -> Constraint c
Expr c
lhs .<=. :: forall c. Num c => Expr c -> Expr c -> Constraint c
.<=. Expr c
rhs =
  case Expr c -> (Expr c, c)
forall c. Num c => Expr c -> (Expr c, c)
splitConst (Expr c
lhs Expr c -> Expr c -> Expr c
forall a. Num a => a -> a -> a
- Expr c
rhs) of
    (Expr c
e, c
c) -> Constraint c
forall a. Default a => a
def{ constrExpr = e, constrUB = Finite (- c) }

-- | Inequality constraint (≥).
(.>=.) :: Num c => Expr c -> Expr c -> Constraint c
Expr c
lhs .>=. :: forall c. Num c => Expr c -> Expr c -> Constraint c
.>=. Expr c
rhs =
  case Expr c -> (Expr c, c)
forall c. Num c => Expr c -> (Expr c, c)
splitConst (Expr c
lhs Expr c -> Expr c -> Expr c
forall a. Num a => a -> a -> a
- Expr c
rhs) of
    (Expr c
e, c
c) -> Constraint c
forall a. Default a => a
def{ constrExpr = e, constrLB = Finite (- c) }

instance Default (Constraint c) where
  def :: Constraint c
def = Constraint
        { constrLabel :: Maybe Text
constrLabel = Maybe Text
forall a. Maybe a
Nothing
        , constrIndicator :: Maybe (Var, c)
constrIndicator = Maybe (Var, c)
forall a. Maybe a
Nothing
        , constrExpr :: Expr c
constrExpr = [Term c] -> Expr c
forall c. [Term c] -> Expr c
Expr []
        , constrLB :: BoundExpr c
constrLB = BoundExpr c
forall c. BoundExpr c
NegInf
        , constrUB :: BoundExpr c
constrUB = BoundExpr c
forall c. BoundExpr c
PosInf
        , constrIsLazy :: Bool
constrIsLazy = Bool
False
        }

instance Functor Constraint where
  fmap :: forall a b. (a -> b) -> Constraint a -> Constraint b
fmap a -> b
f Constraint a
c =
    Constraint a
c
    { constrIndicator = fmap (id *** f) (constrIndicator c)
    , constrExpr = fmap f (constrExpr c)
    , constrLB = fmap f (constrLB c)
    , constrUB = fmap f (constrUB c)
    }

-- | relational operators
data RelOp
  = Le  -- ^ (≤)
  | Ge  -- ^ (≥)
  | Eql -- ^ (=)
  deriving (RelOp -> RelOp -> Bool
(RelOp -> RelOp -> Bool) -> (RelOp -> RelOp -> Bool) -> Eq RelOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelOp -> RelOp -> Bool
== :: RelOp -> RelOp -> Bool
$c/= :: RelOp -> RelOp -> Bool
/= :: RelOp -> RelOp -> Bool
Eq, Eq RelOp
Eq RelOp =>
(RelOp -> RelOp -> Ordering)
-> (RelOp -> RelOp -> Bool)
-> (RelOp -> RelOp -> Bool)
-> (RelOp -> RelOp -> Bool)
-> (RelOp -> RelOp -> Bool)
-> (RelOp -> RelOp -> RelOp)
-> (RelOp -> RelOp -> RelOp)
-> Ord RelOp
RelOp -> RelOp -> Bool
RelOp -> RelOp -> Ordering
RelOp -> RelOp -> RelOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RelOp -> RelOp -> Ordering
compare :: RelOp -> RelOp -> Ordering
$c< :: RelOp -> RelOp -> Bool
< :: RelOp -> RelOp -> Bool
$c<= :: RelOp -> RelOp -> Bool
<= :: RelOp -> RelOp -> Bool
$c> :: RelOp -> RelOp -> Bool
> :: RelOp -> RelOp -> Bool
$c>= :: RelOp -> RelOp -> Bool
>= :: RelOp -> RelOp -> Bool
$cmax :: RelOp -> RelOp -> RelOp
max :: RelOp -> RelOp -> RelOp
$cmin :: RelOp -> RelOp -> RelOp
min :: RelOp -> RelOp -> RelOp
Ord, Int -> RelOp
RelOp -> Int
RelOp -> [RelOp]
RelOp -> RelOp
RelOp -> RelOp -> [RelOp]
RelOp -> RelOp -> RelOp -> [RelOp]
(RelOp -> RelOp)
-> (RelOp -> RelOp)
-> (Int -> RelOp)
-> (RelOp -> Int)
-> (RelOp -> [RelOp])
-> (RelOp -> RelOp -> [RelOp])
-> (RelOp -> RelOp -> [RelOp])
-> (RelOp -> RelOp -> RelOp -> [RelOp])
-> Enum RelOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RelOp -> RelOp
succ :: RelOp -> RelOp
$cpred :: RelOp -> RelOp
pred :: RelOp -> RelOp
$ctoEnum :: Int -> RelOp
toEnum :: Int -> RelOp
$cfromEnum :: RelOp -> Int
fromEnum :: RelOp -> Int
$cenumFrom :: RelOp -> [RelOp]
enumFrom :: RelOp -> [RelOp]
$cenumFromThen :: RelOp -> RelOp -> [RelOp]
enumFromThen :: RelOp -> RelOp -> [RelOp]
$cenumFromTo :: RelOp -> RelOp -> [RelOp]
enumFromTo :: RelOp -> RelOp -> [RelOp]
$cenumFromThenTo :: RelOp -> RelOp -> RelOp -> [RelOp]
enumFromThenTo :: RelOp -> RelOp -> RelOp -> [RelOp]
Enum, Int -> RelOp -> ShowS
[RelOp] -> ShowS
RelOp -> String
(Int -> RelOp -> ShowS)
-> (RelOp -> String) -> ([RelOp] -> ShowS) -> Show RelOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelOp -> ShowS
showsPrec :: Int -> RelOp -> ShowS
$cshow :: RelOp -> String
show :: RelOp -> String
$cshowList :: [RelOp] -> ShowS
showList :: [RelOp] -> ShowS
Show)

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

-- | types of SOS (special ordered sets) constraints
data SOSType
  = S1 -- ^ Type 1 SOS constraint
  | S2 -- ^ Type 2 SOS constraint
  deriving (SOSType -> SOSType -> Bool
(SOSType -> SOSType -> Bool)
-> (SOSType -> SOSType -> Bool) -> Eq SOSType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SOSType -> SOSType -> Bool
== :: SOSType -> SOSType -> Bool
$c/= :: SOSType -> SOSType -> Bool
/= :: SOSType -> SOSType -> Bool
Eq, Eq SOSType
Eq SOSType =>
(SOSType -> SOSType -> Ordering)
-> (SOSType -> SOSType -> Bool)
-> (SOSType -> SOSType -> Bool)
-> (SOSType -> SOSType -> Bool)
-> (SOSType -> SOSType -> Bool)
-> (SOSType -> SOSType -> SOSType)
-> (SOSType -> SOSType -> SOSType)
-> Ord SOSType
SOSType -> SOSType -> Bool
SOSType -> SOSType -> Ordering
SOSType -> SOSType -> SOSType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SOSType -> SOSType -> Ordering
compare :: SOSType -> SOSType -> Ordering
$c< :: SOSType -> SOSType -> Bool
< :: SOSType -> SOSType -> Bool
$c<= :: SOSType -> SOSType -> Bool
<= :: SOSType -> SOSType -> Bool
$c> :: SOSType -> SOSType -> Bool
> :: SOSType -> SOSType -> Bool
$c>= :: SOSType -> SOSType -> Bool
>= :: SOSType -> SOSType -> Bool
$cmax :: SOSType -> SOSType -> SOSType
max :: SOSType -> SOSType -> SOSType
$cmin :: SOSType -> SOSType -> SOSType
min :: SOSType -> SOSType -> SOSType
Ord, Int -> SOSType
SOSType -> Int
SOSType -> [SOSType]
SOSType -> SOSType
SOSType -> SOSType -> [SOSType]
SOSType -> SOSType -> SOSType -> [SOSType]
(SOSType -> SOSType)
-> (SOSType -> SOSType)
-> (Int -> SOSType)
-> (SOSType -> Int)
-> (SOSType -> [SOSType])
-> (SOSType -> SOSType -> [SOSType])
-> (SOSType -> SOSType -> [SOSType])
-> (SOSType -> SOSType -> SOSType -> [SOSType])
-> Enum SOSType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SOSType -> SOSType
succ :: SOSType -> SOSType
$cpred :: SOSType -> SOSType
pred :: SOSType -> SOSType
$ctoEnum :: Int -> SOSType
toEnum :: Int -> SOSType
$cfromEnum :: SOSType -> Int
fromEnum :: SOSType -> Int
$cenumFrom :: SOSType -> [SOSType]
enumFrom :: SOSType -> [SOSType]
$cenumFromThen :: SOSType -> SOSType -> [SOSType]
enumFromThen :: SOSType -> SOSType -> [SOSType]
$cenumFromTo :: SOSType -> SOSType -> [SOSType]
enumFromTo :: SOSType -> SOSType -> [SOSType]
$cenumFromThenTo :: SOSType -> SOSType -> SOSType -> [SOSType]
enumFromThenTo :: SOSType -> SOSType -> SOSType -> [SOSType]
Enum, Int -> SOSType -> ShowS
[SOSType] -> ShowS
SOSType -> String
(Int -> SOSType -> ShowS)
-> (SOSType -> String) -> ([SOSType] -> ShowS) -> Show SOSType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SOSType -> ShowS
showsPrec :: Int -> SOSType -> ShowS
$cshow :: SOSType -> String
show :: SOSType -> String
$cshowList :: [SOSType] -> ShowS
showList :: [SOSType] -> ShowS
Show, ReadPrec [SOSType]
ReadPrec SOSType
Int -> ReadS SOSType
ReadS [SOSType]
(Int -> ReadS SOSType)
-> ReadS [SOSType]
-> ReadPrec SOSType
-> ReadPrec [SOSType]
-> Read SOSType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SOSType
readsPrec :: Int -> ReadS SOSType
$creadList :: ReadS [SOSType]
readList :: ReadS [SOSType]
$creadPrec :: ReadPrec SOSType
readPrec :: ReadPrec SOSType
$creadListPrec :: ReadPrec [SOSType]
readListPrec :: ReadPrec [SOSType]
Read)

-- | SOS (special ordered sets) constraints
data SOSConstraint c
  = SOSConstraint
  { forall c. SOSConstraint c -> Maybe Text
sosLabel :: Maybe Label
  , forall c. SOSConstraint c -> SOSType
sosType  :: SOSType
  , forall c. SOSConstraint c -> [(Var, c)]
sosBody  :: [(Var, c)]
  }
  deriving (SOSConstraint c -> SOSConstraint c -> Bool
(SOSConstraint c -> SOSConstraint c -> Bool)
-> (SOSConstraint c -> SOSConstraint c -> Bool)
-> Eq (SOSConstraint c)
forall c. Eq c => SOSConstraint c -> SOSConstraint c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => SOSConstraint c -> SOSConstraint c -> Bool
== :: SOSConstraint c -> SOSConstraint c -> Bool
$c/= :: forall c. Eq c => SOSConstraint c -> SOSConstraint c -> Bool
/= :: SOSConstraint c -> SOSConstraint c -> Bool
Eq, Eq (SOSConstraint c)
Eq (SOSConstraint c) =>
(SOSConstraint c -> SOSConstraint c -> Ordering)
-> (SOSConstraint c -> SOSConstraint c -> Bool)
-> (SOSConstraint c -> SOSConstraint c -> Bool)
-> (SOSConstraint c -> SOSConstraint c -> Bool)
-> (SOSConstraint c -> SOSConstraint c -> Bool)
-> (SOSConstraint c -> SOSConstraint c -> SOSConstraint c)
-> (SOSConstraint c -> SOSConstraint c -> SOSConstraint c)
-> Ord (SOSConstraint c)
SOSConstraint c -> SOSConstraint c -> Bool
SOSConstraint c -> SOSConstraint c -> Ordering
SOSConstraint c -> SOSConstraint c -> SOSConstraint c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. Ord c => Eq (SOSConstraint c)
forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Bool
forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Ordering
forall c.
Ord c =>
SOSConstraint c -> SOSConstraint c -> SOSConstraint c
$ccompare :: forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Ordering
compare :: SOSConstraint c -> SOSConstraint c -> Ordering
$c< :: forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Bool
< :: SOSConstraint c -> SOSConstraint c -> Bool
$c<= :: forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Bool
<= :: SOSConstraint c -> SOSConstraint c -> Bool
$c> :: forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Bool
> :: SOSConstraint c -> SOSConstraint c -> Bool
$c>= :: forall c. Ord c => SOSConstraint c -> SOSConstraint c -> Bool
>= :: SOSConstraint c -> SOSConstraint c -> Bool
$cmax :: forall c.
Ord c =>
SOSConstraint c -> SOSConstraint c -> SOSConstraint c
max :: SOSConstraint c -> SOSConstraint c -> SOSConstraint c
$cmin :: forall c.
Ord c =>
SOSConstraint c -> SOSConstraint c -> SOSConstraint c
min :: SOSConstraint c -> SOSConstraint c -> SOSConstraint c
Ord, Int -> SOSConstraint c -> ShowS
[SOSConstraint c] -> ShowS
SOSConstraint c -> String
(Int -> SOSConstraint c -> ShowS)
-> (SOSConstraint c -> String)
-> ([SOSConstraint c] -> ShowS)
-> Show (SOSConstraint c)
forall c. Show c => Int -> SOSConstraint c -> ShowS
forall c. Show c => [SOSConstraint c] -> ShowS
forall c. Show c => SOSConstraint c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> SOSConstraint c -> ShowS
showsPrec :: Int -> SOSConstraint c -> ShowS
$cshow :: forall c. Show c => SOSConstraint c -> String
show :: SOSConstraint c -> String
$cshowList :: forall c. Show c => [SOSConstraint c] -> ShowS
showList :: [SOSConstraint c] -> ShowS
Show)

instance Functor SOSConstraint where
  fmap :: forall a b. (a -> b) -> SOSConstraint a -> SOSConstraint b
fmap a -> b
f SOSConstraint a
c = SOSConstraint a
c{ sosBody = map (id *** f) (sosBody c) }

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

-- | MIP status with the following partial order:
--
-- <<doc-images/MIP-Status-diagram.png>>
data Status
  = StatusUnknown
  | StatusFeasible
  | StatusOptimal
  | StatusInfeasibleOrUnbounded
  | StatusInfeasible
  | StatusUnbounded
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, Eq Status
Eq Status =>
(Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Status -> Status -> Ordering
compare :: Status -> Status -> Ordering
$c< :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
>= :: Status -> Status -> Bool
$cmax :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
min :: Status -> Status -> Status
Ord, Int -> Status
Status -> Int
Status -> [Status]
Status -> Status
Status -> Status -> [Status]
Status -> Status -> Status -> [Status]
(Status -> Status)
-> (Status -> Status)
-> (Int -> Status)
-> (Status -> Int)
-> (Status -> [Status])
-> (Status -> Status -> [Status])
-> (Status -> Status -> [Status])
-> (Status -> Status -> Status -> [Status])
-> Enum Status
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Status -> Status
succ :: Status -> Status
$cpred :: Status -> Status
pred :: Status -> Status
$ctoEnum :: Int -> Status
toEnum :: Int -> Status
$cfromEnum :: Status -> Int
fromEnum :: Status -> Int
$cenumFrom :: Status -> [Status]
enumFrom :: Status -> [Status]
$cenumFromThen :: Status -> Status -> [Status]
enumFromThen :: Status -> Status -> [Status]
$cenumFromTo :: Status -> Status -> [Status]
enumFromTo :: Status -> Status -> [Status]
$cenumFromThenTo :: Status -> Status -> Status -> [Status]
enumFromThenTo :: Status -> Status -> Status -> [Status]
Enum, Status
Status -> Status -> Bounded Status
forall a. a -> a -> Bounded a
$cminBound :: Status
minBound :: Status
$cmaxBound :: Status
maxBound :: Status
Bounded, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

instance PartialOrd Status where
  leq :: Status -> Status -> Bool
leq Status
a Status
b = (Status
a,Status
b) (Status, Status) -> Set (Status, Status) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Status, Status)
rel
    where
      rel :: Set (Status, Status)
rel = Set (Status, Status)
-> (Set (Status, Status) -> Set (Status, Status))
-> Set (Status, Status)
forall a. Eq a => a -> (a -> a) -> a
unsafeLfpFrom Set (Status, Status)
rel0 ((Set (Status, Status) -> Set (Status, Status))
 -> Set (Status, Status))
-> (Set (Status, Status) -> Set (Status, Status))
-> Set (Status, Status)
forall a b. (a -> b) -> a -> b
$ \Set (Status, Status)
r ->
        Set (Status, Status)
-> Set (Status, Status) -> Set (Status, Status)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Status, Status)
r ([(Status, Status)] -> Set (Status, Status)
forall a. Ord a => [a] -> Set a
Set.fromList [(Status
x,Status
z) | (Status
x,Status
y) <- Set (Status, Status) -> [(Status, Status)]
forall a. Set a -> [a]
Set.toList Set (Status, Status)
r, (Status
y',Status
z) <- Set (Status, Status) -> [(Status, Status)]
forall a. Set a -> [a]
Set.toList Set (Status, Status)
r, Status
y Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
y'])
      rel0 :: Set (Status, Status)
rel0 = [(Status, Status)] -> Set (Status, Status)
forall a. Ord a => [a] -> Set a
Set.fromList ([(Status, Status)] -> Set (Status, Status))
-> [(Status, Status)] -> Set (Status, Status)
forall a b. (a -> b) -> a -> b
$
        [(Status
x,Status
x) | Status
x <- [Status
forall a. Bounded a => a
minBound .. Status
forall a. Bounded a => a
maxBound]] [(Status, Status)] -> [(Status, Status)] -> [(Status, Status)]
forall a. [a] -> [a] -> [a]
++
        [ (Status
StatusUnknown, Status
StatusFeasible)
        , (Status
StatusUnknown, Status
StatusInfeasibleOrUnbounded)
        , (Status
StatusFeasible, Status
StatusOptimal)
        , (Status
StatusFeasible, Status
StatusUnbounded)
        , (Status
StatusInfeasibleOrUnbounded, Status
StatusUnbounded)
        , (Status
StatusInfeasibleOrUnbounded, Status
StatusInfeasible)
        ]

-- | /meet/ (greatest lower bound) operator of the partial order of 'Status' type.
--
-- If the version of @lattices@ is \<2, then @MeetSemiLattice@ instance can also be used.
meetStatus :: Status -> Status -> Status
Status
StatusUnknown meetStatus :: Status -> Status -> Status
`meetStatus` Status
_b = Status
StatusUnknown
Status
StatusFeasible `meetStatus` Status
b
  | Status
StatusFeasible Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
b = Status
StatusFeasible
  | Bool
otherwise = Status
StatusUnknown
Status
StatusOptimal `meetStatus` Status
StatusOptimal = Status
StatusOptimal
Status
StatusOptimal `meetStatus` Status
b
  | Status
StatusFeasible Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
b = Status
StatusFeasible
  | Bool
otherwise = Status
StatusUnknown
Status
StatusInfeasibleOrUnbounded `meetStatus` Status
b
  | Status
StatusInfeasibleOrUnbounded Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
b = Status
StatusInfeasibleOrUnbounded
  | Bool
otherwise = Status
StatusUnknown
Status
StatusInfeasible `meetStatus` Status
StatusInfeasible = Status
StatusInfeasible
Status
StatusInfeasible `meetStatus` Status
b
  | Status
StatusInfeasibleOrUnbounded Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
b = Status
StatusInfeasibleOrUnbounded
  | Bool
otherwise = Status
StatusUnknown
Status
StatusUnbounded `meetStatus` Status
StatusUnbounded = Status
StatusUnbounded
Status
StatusUnbounded `meetStatus` Status
b
  | Status
StatusFeasible Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
b = Status
StatusFeasible
  | Status
StatusInfeasibleOrUnbounded Status -> Status -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` Status
b = Status
StatusInfeasibleOrUnbounded
  | Bool
otherwise = Status
StatusUnknown

#if !MIN_VERSION_lattices(2,0,0)

instance MeetSemiLattice Status where
  meet = meetStatus

#endif


-- | Type for representing a solution of MIP problem.
data Solution r
  = Solution
  { forall r. Solution r -> Status
solStatus :: Status
    -- ^ status
  , forall r. Solution r -> Maybe r
solObjectiveValue :: Maybe r
    -- ^ value of the objective function
  , forall r. Solution r -> Map Var r
solVariables :: Map Var r
    -- ^ variable assignments
  }
  deriving (Solution r -> Solution r -> Bool
(Solution r -> Solution r -> Bool)
-> (Solution r -> Solution r -> Bool) -> Eq (Solution r)
forall r. Eq r => Solution r -> Solution r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => Solution r -> Solution r -> Bool
== :: Solution r -> Solution r -> Bool
$c/= :: forall r. Eq r => Solution r -> Solution r -> Bool
/= :: Solution r -> Solution r -> Bool
Eq, Eq (Solution r)
Eq (Solution r) =>
(Solution r -> Solution r -> Ordering)
-> (Solution r -> Solution r -> Bool)
-> (Solution r -> Solution r -> Bool)
-> (Solution r -> Solution r -> Bool)
-> (Solution r -> Solution r -> Bool)
-> (Solution r -> Solution r -> Solution r)
-> (Solution r -> Solution r -> Solution r)
-> Ord (Solution r)
Solution r -> Solution r -> Bool
Solution r -> Solution r -> Ordering
Solution r -> Solution r -> Solution r
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall r. Ord r => Eq (Solution r)
forall r. Ord r => Solution r -> Solution r -> Bool
forall r. Ord r => Solution r -> Solution r -> Ordering
forall r. Ord r => Solution r -> Solution r -> Solution r
$ccompare :: forall r. Ord r => Solution r -> Solution r -> Ordering
compare :: Solution r -> Solution r -> Ordering
$c< :: forall r. Ord r => Solution r -> Solution r -> Bool
< :: Solution r -> Solution r -> Bool
$c<= :: forall r. Ord r => Solution r -> Solution r -> Bool
<= :: Solution r -> Solution r -> Bool
$c> :: forall r. Ord r => Solution r -> Solution r -> Bool
> :: Solution r -> Solution r -> Bool
$c>= :: forall r. Ord r => Solution r -> Solution r -> Bool
>= :: Solution r -> Solution r -> Bool
$cmax :: forall r. Ord r => Solution r -> Solution r -> Solution r
max :: Solution r -> Solution r -> Solution r
$cmin :: forall r. Ord r => Solution r -> Solution r -> Solution r
min :: Solution r -> Solution r -> Solution r
Ord, Int -> Solution r -> ShowS
[Solution r] -> ShowS
Solution r -> String
(Int -> Solution r -> ShowS)
-> (Solution r -> String)
-> ([Solution r] -> ShowS)
-> Show (Solution r)
forall r. Show r => Int -> Solution r -> ShowS
forall r. Show r => [Solution r] -> ShowS
forall r. Show r => Solution r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> Solution r -> ShowS
showsPrec :: Int -> Solution r -> ShowS
$cshow :: forall r. Show r => Solution r -> String
show :: Solution r -> String
$cshowList :: forall r. Show r => [Solution r] -> ShowS
showList :: [Solution r] -> ShowS
Show)

instance Functor Solution where
  fmap :: forall a b. (a -> b) -> Solution a -> Solution b
fmap a -> b
f (Solution Status
status Maybe a
obj Map Var a
vs) = Status -> Maybe b -> Map Var b -> Solution b
forall r. Status -> Maybe r -> Map Var r -> Solution r
Solution Status
status ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
obj) ((a -> b) -> Map Var a -> Map Var b
forall a b. (a -> b) -> Map Var a -> Map Var b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Map Var a
vs)

instance Default (Solution r) where
  def :: Solution r
def = Solution
        { solStatus :: Status
solStatus = Status
StatusUnknown
        , solObjectiveValue :: Maybe r
solObjectiveValue = Maybe r
forall a. Maybe a
Nothing
        , solVariables :: Map Var r
solVariables = Map Var r
forall k a. Map k a
Map.empty
        }

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

-- | Tolerance for evaluating solutions against t'Problem'.
data Tol r
  = Tol
  { forall r. Tol r -> r
integralityTol :: r
    -- ^ If a value of integer variable is within this amount from its nearest
    -- integer, it is considered feasible.
  , forall r. Tol r -> r
feasibilityTol :: r
    -- ^ If the amount of violation of constraints is within this amount, it is
    -- considered feasible.
  , forall r. Tol r -> r
optimalityTol :: r
    -- ^ Feasiblity tolerance of dual constraints.
  }

-- | Defautl is @1e-6@ for the feasibility and optimality tolerances, and @1e-5@ for the integrality tolerance.
instance Fractional r => Default (Tol r) where
  def :: Tol r
def =
    Tol
    { integralityTol :: r
integralityTol = r
1e-5
    , feasibilityTol :: r
feasibilityTol = r
1e-6
    , optimalityTol :: r
optimalityTol = r
1e-6
    }

-- | t'Tol' value with all tolerances are zero
zeroTol :: Fractional r => Tol r
zeroTol :: forall r. Fractional r => Tol r
zeroTol =
  Tol
  { integralityTol :: r
integralityTol = r
1e-5
  , feasibilityTol :: r
feasibilityTol = r
1e-6
  , optimalityTol :: r
optimalityTol = r
1e-6
  }

-- | Type class for evaluation various elements of t'Problem' under
-- the given variable assignments.
class Eval r a where
  -- | Result type of 'eval'
  type Evaluated r a

  -- | Evaluate a value of type @a@ under given assignments and the tolerance
  eval :: Tol r -> Map Var r -> a -> Evaluated r a

instance Num r => Eval r Var where
  type Evaluated r Var = r
  eval :: Tol r -> Map Var r -> Var -> Evaluated r Var
eval Tol r
_tol Map Var r
sol Var
v =
    case Var -> Map Var r -> Maybe r
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Var
v Map Var r
sol of
      Just r
val -> r
Evaluated r Var
val
      Maybe r
Nothing -> r
Evaluated r Var
0

instance Num r => Eval r (Term r) where
  type Evaluated r (Term r) = r
  eval :: Tol r -> Map Var r -> Term r -> Evaluated r (Term r)
eval Tol r
tol Map Var r
sol (Term r
c [Var]
vs) = [r] -> r
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (r
c r -> [r] -> [r]
forall a. a -> [a] -> [a]
: [Tol r -> Map Var r -> Var -> Evaluated r Var
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol Var
v | Var
v <- [Var]
vs])

instance Num r => Eval r (Expr r) where
  type Evaluated r (Expr r) = r
  eval :: Tol r -> Map Var r -> Expr r -> Evaluated r (Expr r)
eval Tol r
tol Map Var r
sol Expr r
expr = [r] -> r
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Tol r -> Map Var r -> Term r -> Evaluated r (Term r)
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol Term r
t | Term r
t <- Expr r -> [Term r]
forall c. Expr c -> [Term c]
terms Expr r
expr]

instance Num r => Eval r (ObjectiveFunction r) where
  type Evaluated r (ObjectiveFunction r) = r
  eval :: Tol r
-> Map Var r
-> ObjectiveFunction r
-> Evaluated r (ObjectiveFunction r)
eval Tol r
tol Map Var r
sol ObjectiveFunction r
obj = Tol r -> Map Var r -> Expr r -> Evaluated r (Expr r)
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol (ObjectiveFunction r -> Expr r
forall c. ObjectiveFunction c -> Expr c
objExpr ObjectiveFunction r
obj)

instance (Num r, Ord r) => Eval r (Constraint r) where
  type Evaluated r (Constraint r) = Bool
  eval :: Tol r -> Map Var r -> Constraint r -> Evaluated r (Constraint r)
eval Tol r
tol Map Var r
sol Constraint r
constr =
    Bool -> Bool
not (Maybe (Var, r) -> Bool
evalIndicator (Constraint r -> Maybe (Var, r)
forall c. Constraint c -> Maybe (Var, c)
constrIndicator Constraint r
constr)) Bool -> Bool -> Bool
||
    Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol (Constraint r -> BoundExpr r
forall c. Constraint c -> BoundExpr c
constrLB Constraint r
constr, Constraint r -> BoundExpr r
forall c. Constraint c -> BoundExpr c
constrUB Constraint r
constr) (Tol r -> Map Var r -> Expr r -> Evaluated r (Expr r)
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol (Constraint r -> Expr r
forall c. Constraint c -> Expr c
constrExpr Constraint r
constr))
    where
      evalIndicator :: Maybe (Var, r) -> Bool
evalIndicator Maybe (Var, r)
Nothing = Bool
True
      evalIndicator (Just (Var
v, r
val')) = Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol (r -> BoundExpr r
forall r. r -> Extended r
Finite r
val', r -> BoundExpr r
forall r. r -> Extended r
Finite r
val') (Tol r -> Map Var r -> Var -> Evaluated r Var
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol Var
v)

instance (Num r, Ord r) => Eval r (SOSConstraint r) where
  type Evaluated r (SOSConstraint r) = Bool
  eval :: Tol r
-> Map Var r -> SOSConstraint r -> Evaluated r (SOSConstraint r)
eval Tol r
tol Map Var r
sol SOSConstraint r
sos =
    case SOSConstraint r -> SOSType
forall c. SOSConstraint c -> SOSType
sosType SOSConstraint r
sos of
      SOSType
S1 -> [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | Bool
val <- [Bool]
body, Bool
val] Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
      SOSType
S2 -> [Bool] -> Bool
f [Bool]
body
    where
      body :: [Bool]
body = ((Var, r) -> Bool) -> [(Var, r)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool
not (Bool -> Bool) -> ((Var, r) -> Bool) -> (Var, r) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol (BoundExpr r
0, BoundExpr r
0) (r -> Bool) -> ((Var, r) -> r) -> (Var, r) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tol r -> Map Var r -> Var -> Evaluated r Var
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol (Var -> r) -> ((Var, r) -> Var) -> (Var, r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, r) -> Var
forall a b. (a, b) -> a
fst) ([(Var, r)] -> [Bool]) -> [(Var, r)] -> [Bool]
forall a b. (a -> b) -> a -> b
$ ((Var, r) -> (Var, r) -> Ordering) -> [(Var, r)] -> [(Var, r)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Var, r) -> r) -> (Var, r) -> (Var, r) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Var, r) -> r
forall a b. (a, b) -> b
snd) ([(Var, r)] -> [(Var, r)]) -> [(Var, r)] -> [(Var, r)]
forall a b. (a -> b) -> a -> b
$ (SOSConstraint r -> [(Var, r)]
forall c. SOSConstraint c -> [(Var, c)]
sosBody SOSConstraint r
sos)
      f :: [Bool] -> Bool
f [] = Bool
True
      f [Bool
_] = Bool
True
      f (Bool
x1 : Bool
x2 : [Bool]
xs)
        | Bool
x1 = (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
not [Bool]
xs
        | Bool
otherwise = [Bool] -> Bool
f (Bool
x2 Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
xs)

instance (RealFrac r) => Eval r (Problem r) where
  type Evaluated r (Problem r) = Maybe r
  eval :: Tol r -> Map Var r -> Problem r -> Evaluated r (Problem r)
eval Tol r
tol Map Var r
sol Problem r
prob = do
    [(Var, (VarType, Bounds r))]
-> ((Var, (VarType, Bounds r)) -> Maybe ()) -> Maybe ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Var (VarType, Bounds r) -> [(Var, (VarType, Bounds r))]
forall k a. Map k a -> [(k, a)]
Map.toList (Problem r -> Map Var (VarType, Bounds r)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem r
prob)) (((Var, (VarType, Bounds r)) -> Maybe ()) -> Maybe ())
-> ((Var, (VarType, Bounds r)) -> Maybe ()) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \(Var
v, (VarType
vt, Bounds r
bounds)) -> do
      let val :: Evaluated r Var
val = Tol r -> Map Var r -> Var -> Evaluated r Var
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol Var
v
      case VarType
vt of
        VarType
ContinuousVariable -> () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        VarType
SemiContinuousVariable -> () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        VarType
IntegerVariable -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> r -> Bool
forall r. RealFrac r => Tol r -> r -> Bool
isIntegral Tol r
tol r
Evaluated r Var
val
        VarType
SemiIntegerVariable -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> r -> Bool
forall r. RealFrac r => Tol r -> r -> Bool
isIntegral Tol r
tol r
Evaluated r Var
val
      case VarType
vt of
        VarType
ContinuousVariable -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol Bounds r
bounds r
Evaluated r Var
val
        VarType
IntegerVariable -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol Bounds r
bounds r
Evaluated r Var
val
        VarType
SemiIntegerVariable -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol (BoundExpr r
0,BoundExpr r
0) r
Evaluated r Var
val Bool -> Bool -> Bool
|| Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol Bounds r
bounds r
Evaluated r Var
val
        VarType
SemiContinuousVariable -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol (BoundExpr r
0,BoundExpr r
0) r
Evaluated r Var
val Bool -> Bool -> Bool
|| Tol r -> Bounds r -> r -> Bool
forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol Bounds r
bounds r
Evaluated r Var
val
    [Constraint r] -> (Constraint r -> Maybe ()) -> Maybe ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Problem r -> [Constraint r]
forall c. Problem c -> [Constraint c]
constraints Problem r
prob) ((Constraint r -> Maybe ()) -> Maybe ())
-> (Constraint r -> Maybe ()) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Constraint r
constr -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r -> Map Var r -> Constraint r -> Evaluated r (Constraint r)
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol Constraint r
constr
    [SOSConstraint r] -> (SOSConstraint r -> Maybe ()) -> Maybe ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Problem r -> [SOSConstraint r]
forall c. Problem c -> [SOSConstraint c]
sosConstraints Problem r
prob) ((SOSConstraint r -> Maybe ()) -> Maybe ())
-> (SOSConstraint r -> Maybe ()) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \SOSConstraint r
constr -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Tol r
-> Map Var r -> SOSConstraint r -> Evaluated r (SOSConstraint r)
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol SOSConstraint r
constr
    r -> Maybe r
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Maybe r) -> r -> Maybe r
forall a b. (a -> b) -> a -> b
$ Tol r
-> Map Var r
-> ObjectiveFunction r
-> Evaluated r (ObjectiveFunction r)
forall r a. Eval r a => Tol r -> Map Var r -> a -> Evaluated r a
eval Tol r
tol Map Var r
sol (Problem r -> ObjectiveFunction r
forall c. Problem c -> ObjectiveFunction c
objectiveFunction Problem r
prob)

isIntegral :: RealFrac r => Tol r -> r -> Bool
isIntegral :: forall r. RealFrac r => Tol r -> r -> Bool
isIntegral Tol r
tol r
x = r -> r
forall a. Num a => a -> a
abs (r
x r -> r -> r
forall a. Num a => a -> a -> a
- Integer -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral (r -> Integer
forall b. Integral b => r -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (r
x r -> r -> r
forall a. Num a => a -> a -> a
+ r
0.5) :: Integer)) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= Tol r -> r
forall r. Tol r -> r
integralityTol Tol r
tol

isInBounds :: (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds :: forall r. (Num r, Ord r) => Tol r -> Bounds r -> r -> Bool
isInBounds Tol r
tol (BoundExpr r
lb, BoundExpr r
ub) r
x =
  BoundExpr r
lb BoundExpr r -> BoundExpr r -> BoundExpr r
forall a. Num a => a -> a -> a
- r -> BoundExpr r
forall r. r -> Extended r
Finite (Tol r -> r
forall r. Tol r -> r
feasibilityTol Tol r
tol) BoundExpr r -> BoundExpr r -> Bool
forall a. Ord a => a -> a -> Bool
<= r -> BoundExpr r
forall r. r -> Extended r
Finite r
x Bool -> Bool -> Bool
&&
  r -> BoundExpr r
forall r. r -> Extended r
Finite r
x BoundExpr r -> BoundExpr r -> Bool
forall a. Ord a => a -> a -> Bool
<= BoundExpr r
ub BoundExpr r -> BoundExpr r -> BoundExpr r
forall a. Num a => a -> a -> a
+ r -> BoundExpr r
forall r. r -> Extended r
Finite (Tol r -> r
forall r. Tol r -> r
feasibilityTol Tol r
tol)

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

-- | Type class for types that contain variables.
class Variables a where
  vars :: a -> Set Var

instance Variables a => Variables [a] where
  vars :: [a] -> Set Var
vars = [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Var] -> Set Var) -> ([a] -> [Set Var]) -> [a] -> Set Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set Var) -> [a] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map a -> Set Var
forall a. Variables a => a -> Set Var
vars

instance (Variables a, Variables b) => Variables (Either a b) where
  vars :: Either a b -> Set Var
vars (Left a
a)  = a -> Set Var
forall a. Variables a => a -> Set Var
vars a
a
  vars (Right b
b) = b -> Set Var
forall a. Variables a => a -> Set Var
vars b
b

instance Variables (Problem c) where
  vars :: Problem c -> Set Var
vars = Problem c -> Set Var
forall c. Problem c -> Set Var
variables

instance Variables (Expr c) where
  vars :: Expr c -> Set Var
vars (Expr [Term c]
e) = [Term c] -> Set Var
forall a. Variables a => a -> Set Var
vars [Term c]
e

instance Variables (Term c) where
  vars :: Term c -> Set Var
vars (Term c
_ [Var]
xs) = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList [Var]
xs

instance Variables Var where
  vars :: Var -> Set Var
vars Var
v = Var -> Set Var
forall a. a -> Set a
Set.singleton Var
v

instance Variables (ObjectiveFunction c) where
  vars :: ObjectiveFunction c -> Set Var
vars ObjectiveFunction{ objExpr :: forall c. ObjectiveFunction c -> Expr c
objExpr = Expr c
e } = Expr c -> Set Var
forall a. Variables a => a -> Set Var
vars Expr c
e

instance Variables (Constraint c) where
  vars :: Constraint c -> Set Var
vars Constraint{ constrIndicator :: forall c. Constraint c -> Maybe (Var, c)
constrIndicator = Maybe (Var, c)
ind, constrExpr :: forall c. Constraint c -> Expr c
constrExpr = Expr c
e } = Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Expr c -> Set Var
forall a. Variables a => a -> Set Var
vars Expr c
e) Set Var
vs2
    where
      vs2 :: Set Var
vs2 = Set Var -> ((Var, c) -> Set Var) -> Maybe (Var, c) -> Set Var
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Var
forall a. Set a
Set.empty (Var -> Set Var
forall a. a -> Set a
Set.singleton (Var -> Set Var) -> ((Var, c) -> Var) -> (Var, c) -> Set Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, c) -> Var
forall a b. (a, b) -> a
fst) Maybe (Var, c)
ind

instance Variables (SOSConstraint c) where
  vars :: SOSConstraint c -> Set Var
vars SOSConstraint{ sosBody :: forall c. SOSConstraint c -> [(Var, c)]
sosBody = [(Var, c)]
xs } = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
Set.fromList (((Var, c) -> Var) -> [(Var, c)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, c) -> Var
forall a b. (a, b) -> a
fst [(Var, c)]
xs)

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

-- | Set of variables of a t'Problem'
variables :: Problem c -> Set Var
variables :: forall c. Problem c -> Set Var
variables Problem c
mip = Map Var (VarType, Bounds c) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet (Map Var (VarType, Bounds c) -> Set Var)
-> Map Var (VarType, Bounds c) -> Set Var
forall a b. (a -> b) -> a -> b
$ Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip

-- | Set of continuous variables of a t'Problem'
continuousVariables :: Problem c -> Set Var
continuousVariables :: forall c. Problem c -> Set Var
continuousVariables Problem c
mip = Map Var (VarType, Bounds c) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet (Map Var (VarType, Bounds c) -> Set Var)
-> Map Var (VarType, Bounds c) -> Set Var
forall a b. (a -> b) -> a -> b
$ ((VarType, Bounds c) -> Bool)
-> Map Var (VarType, Bounds c) -> Map Var (VarType, Bounds c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((VarType
ContinuousVariable VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
==) (VarType -> Bool)
-> ((VarType, Bounds c) -> VarType) -> (VarType, Bounds c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarType, Bounds c) -> VarType
forall a b. (a, b) -> a
fst) (Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip)

-- | Set of integer variables of a t'Problem'
integerVariables :: Problem c -> Set Var
integerVariables :: forall c. Problem c -> Set Var
integerVariables Problem c
mip = Map Var (VarType, Bounds c) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet (Map Var (VarType, Bounds c) -> Set Var)
-> Map Var (VarType, Bounds c) -> Set Var
forall a b. (a -> b) -> a -> b
$ ((VarType, Bounds c) -> Bool)
-> Map Var (VarType, Bounds c) -> Map Var (VarType, Bounds c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((VarType
IntegerVariable VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
==) (VarType -> Bool)
-> ((VarType, Bounds c) -> VarType) -> (VarType, Bounds c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarType, Bounds c) -> VarType
forall a b. (a, b) -> a
fst) (Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip)

-- | Set of binary variables (integers variables with lower bound 0 and upper bound 1) of a t'Problem'
binaryVariables :: (Num c, Eq c) => Problem c -> Set Var
binaryVariables :: forall c. (Num c, Eq c) => Problem c -> Set Var
binaryVariables Problem c
mip = Map Var (VarType, (Extended c, Extended c)) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet (Map Var (VarType, (Extended c, Extended c)) -> Set Var)
-> Map Var (VarType, (Extended c, Extended c)) -> Set Var
forall a b. (a -> b) -> a -> b
$ ((VarType, (Extended c, Extended c)) -> Bool)
-> Map Var (VarType, (Extended c, Extended c))
-> Map Var (VarType, (Extended c, Extended c))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (VarType, (Extended c, Extended c)) -> Bool
forall {a} {a}.
(Eq a, Eq a, Num a, Num a) =>
(VarType, (Extended a, Extended a)) -> Bool
p (Problem c -> Map Var (VarType, (Extended c, Extended c))
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip)
  where
    p :: (VarType, (Extended a, Extended a)) -> Bool
p (VarType
IntegerVariable, (Finite a
0, Finite a
1)) = Bool
True
    p (VarType
_, (Extended a, Extended a)
_) = Bool
False

-- | Set of semi-continuous variables of a t'Problem'
semiContinuousVariables :: Problem c -> Set Var
semiContinuousVariables :: forall c. Problem c -> Set Var
semiContinuousVariables Problem c
mip = Map Var (VarType, Bounds c) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet (Map Var (VarType, Bounds c) -> Set Var)
-> Map Var (VarType, Bounds c) -> Set Var
forall a b. (a -> b) -> a -> b
$ ((VarType, Bounds c) -> Bool)
-> Map Var (VarType, Bounds c) -> Map Var (VarType, Bounds c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((VarType
SemiContinuousVariable VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
==) (VarType -> Bool)
-> ((VarType, Bounds c) -> VarType) -> (VarType, Bounds c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarType, Bounds c) -> VarType
forall a b. (a, b) -> a
fst) (Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip)

-- | Set of semi-integer variables of a t'Problem'
semiIntegerVariables :: Problem c -> Set Var
semiIntegerVariables :: forall c. Problem c -> Set Var
semiIntegerVariables Problem c
mip = Map Var (VarType, Bounds c) -> Set Var
forall k a. Map k a -> Set k
Map.keysSet (Map Var (VarType, Bounds c) -> Set Var)
-> Map Var (VarType, Bounds c) -> Set Var
forall a b. (a -> b) -> a -> b
$ ((VarType, Bounds c) -> Bool)
-> Map Var (VarType, Bounds c) -> Map Var (VarType, Bounds c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((VarType
SemiIntegerVariable VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
==) (VarType -> Bool)
-> ((VarType, Bounds c) -> VarType) -> (VarType, Bounds c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarType, Bounds c) -> VarType
forall a b. (a, b) -> a
fst) (Problem c -> Map Var (VarType, Bounds c)
forall c. Problem c -> Map Var (VarType, Bounds c)
varDomains Problem c
mip)

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

-- | Options for reading/writing problem files
data FileOptions
  = FileOptions
  { FileOptions -> Maybe TextEncoding
optFileEncoding :: Maybe TextEncoding
    -- ^ Text encoding used for file input/output
  , FileOptions -> WriteSetting
optMPSWriteObjSense :: WriteSetting
    -- ^ @OBJSENSE@ section in MPS file is an extention of MPS file
    -- format for specifying the direction of the objective function
    -- in MPS file. But not all solvers support it (e.g. GLPK-4.48
    -- does not support it).
    --
    -- This option controls whether the @OBJSENSE@ sections is written.
    -- If 'WriteIfNotDefault' is used, @OBJSENSE@ is written when the
    -- objective is maximization and @OBJSENSE@ is not written written
    -- when the objective is minimizing.
    --
    -- (Default: 'WriteIfNotDefault')
  , FileOptions -> Bool
optMPSWriteObjName :: Bool
    -- ^ @OBJNAME@ section is an extention of MPS file format for
    -- selecting an objective function from among the free rows within
    -- a MPS file. Not all solver support it (e.g. GLPK-4.48
    -- does not support @OBJNAME@ it).
    --
    -- This option controls whether the @OBJNAME@ section is written.
    --
    -- (Default: 'True')
  } deriving (Int -> FileOptions -> ShowS
[FileOptions] -> ShowS
FileOptions -> String
(Int -> FileOptions -> ShowS)
-> (FileOptions -> String)
-> ([FileOptions] -> ShowS)
-> Show FileOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileOptions -> ShowS
showsPrec :: Int -> FileOptions -> ShowS
$cshow :: FileOptions -> String
show :: FileOptions -> String
$cshowList :: [FileOptions] -> ShowS
showList :: [FileOptions] -> ShowS
Show)

instance Default FileOptions where
  def :: FileOptions
def =
    FileOptions
    { optFileEncoding :: Maybe TextEncoding
optFileEncoding = Maybe TextEncoding
forall a. Maybe a
Nothing
    , optMPSWriteObjSense :: WriteSetting
optMPSWriteObjSense = WriteSetting
WriteIfNotDefault
    , optMPSWriteObjName :: Bool
optMPSWriteObjName = Bool
True
    }

-- | Options for writing something of not
data WriteSetting
  = WriteAlways
  | WriteIfNotDefault
  | WriteNever
  deriving (WriteSetting -> WriteSetting -> Bool
(WriteSetting -> WriteSetting -> Bool)
-> (WriteSetting -> WriteSetting -> Bool) -> Eq WriteSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriteSetting -> WriteSetting -> Bool
== :: WriteSetting -> WriteSetting -> Bool
$c/= :: WriteSetting -> WriteSetting -> Bool
/= :: WriteSetting -> WriteSetting -> Bool
Eq, Eq WriteSetting
Eq WriteSetting =>
(WriteSetting -> WriteSetting -> Ordering)
-> (WriteSetting -> WriteSetting -> Bool)
-> (WriteSetting -> WriteSetting -> Bool)
-> (WriteSetting -> WriteSetting -> Bool)
-> (WriteSetting -> WriteSetting -> Bool)
-> (WriteSetting -> WriteSetting -> WriteSetting)
-> (WriteSetting -> WriteSetting -> WriteSetting)
-> Ord WriteSetting
WriteSetting -> WriteSetting -> Bool
WriteSetting -> WriteSetting -> Ordering
WriteSetting -> WriteSetting -> WriteSetting
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WriteSetting -> WriteSetting -> Ordering
compare :: WriteSetting -> WriteSetting -> Ordering
$c< :: WriteSetting -> WriteSetting -> Bool
< :: WriteSetting -> WriteSetting -> Bool
$c<= :: WriteSetting -> WriteSetting -> Bool
<= :: WriteSetting -> WriteSetting -> Bool
$c> :: WriteSetting -> WriteSetting -> Bool
> :: WriteSetting -> WriteSetting -> Bool
$c>= :: WriteSetting -> WriteSetting -> Bool
>= :: WriteSetting -> WriteSetting -> Bool
$cmax :: WriteSetting -> WriteSetting -> WriteSetting
max :: WriteSetting -> WriteSetting -> WriteSetting
$cmin :: WriteSetting -> WriteSetting -> WriteSetting
min :: WriteSetting -> WriteSetting -> WriteSetting
Ord, Int -> WriteSetting
WriteSetting -> Int
WriteSetting -> [WriteSetting]
WriteSetting -> WriteSetting
WriteSetting -> WriteSetting -> [WriteSetting]
WriteSetting -> WriteSetting -> WriteSetting -> [WriteSetting]
(WriteSetting -> WriteSetting)
-> (WriteSetting -> WriteSetting)
-> (Int -> WriteSetting)
-> (WriteSetting -> Int)
-> (WriteSetting -> [WriteSetting])
-> (WriteSetting -> WriteSetting -> [WriteSetting])
-> (WriteSetting -> WriteSetting -> [WriteSetting])
-> (WriteSetting -> WriteSetting -> WriteSetting -> [WriteSetting])
-> Enum WriteSetting
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: WriteSetting -> WriteSetting
succ :: WriteSetting -> WriteSetting
$cpred :: WriteSetting -> WriteSetting
pred :: WriteSetting -> WriteSetting
$ctoEnum :: Int -> WriteSetting
toEnum :: Int -> WriteSetting
$cfromEnum :: WriteSetting -> Int
fromEnum :: WriteSetting -> Int
$cenumFrom :: WriteSetting -> [WriteSetting]
enumFrom :: WriteSetting -> [WriteSetting]
$cenumFromThen :: WriteSetting -> WriteSetting -> [WriteSetting]
enumFromThen :: WriteSetting -> WriteSetting -> [WriteSetting]
$cenumFromTo :: WriteSetting -> WriteSetting -> [WriteSetting]
enumFromTo :: WriteSetting -> WriteSetting -> [WriteSetting]
$cenumFromThenTo :: WriteSetting -> WriteSetting -> WriteSetting -> [WriteSetting]
enumFromThenTo :: WriteSetting -> WriteSetting -> WriteSetting -> [WriteSetting]
Enum, WriteSetting
WriteSetting -> WriteSetting -> Bounded WriteSetting
forall a. a -> a -> Bounded a
$cminBound :: WriteSetting
minBound :: WriteSetting
$cmaxBound :: WriteSetting
maxBound :: WriteSetting
Bounded, Int -> WriteSetting -> ShowS
[WriteSetting] -> ShowS
WriteSetting -> String
(Int -> WriteSetting -> ShowS)
-> (WriteSetting -> String)
-> ([WriteSetting] -> ShowS)
-> Show WriteSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteSetting -> ShowS
showsPrec :: Int -> WriteSetting -> ShowS
$cshow :: WriteSetting -> String
show :: WriteSetting -> String
$cshowList :: [WriteSetting] -> ShowS
showList :: [WriteSetting] -> ShowS
Show, ReadPrec [WriteSetting]
ReadPrec WriteSetting
Int -> ReadS WriteSetting
ReadS [WriteSetting]
(Int -> ReadS WriteSetting)
-> ReadS [WriteSetting]
-> ReadPrec WriteSetting
-> ReadPrec [WriteSetting]
-> Read WriteSetting
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WriteSetting
readsPrec :: Int -> ReadS WriteSetting
$creadList :: ReadS [WriteSetting]
readList :: ReadS [WriteSetting]
$creadPrec :: ReadPrec WriteSetting
readPrec :: ReadPrec WriteSetting
$creadListPrec :: ReadPrec [WriteSetting]
readListPrec :: ReadPrec [WriteSetting]
Read)