{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module ToySolver.Arith.Simplex.Textbook.MIPSolver.Simple
( module Data.OptDir
, OptResult (..)
, minimize
, maximize
, optimize
) where
import Control.Exception
import Control.Monad.State
import Data.Default.Class
import Data.Ord
import Data.Maybe
import Data.List (maximumBy)
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.OptDir
import Data.VectorSpace
import ToySolver.Data.OrdRel
import ToySolver.Data.IntVar
import qualified ToySolver.Data.LA as LA
import qualified ToySolver.Arith.Simplex.Textbook as Simplex
import qualified ToySolver.Arith.Simplex.Textbook.LPSolver as LPSolver
import ToySolver.Arith.Simplex.Textbook.LPSolver hiding (OptResult (..))
import ToySolver.Arith.Simplex.Textbook.LPSolver.Simple (OptResult (..))
import qualified ToySolver.Arith.OmegaTest as OmegaTest
import ToySolver.Internal.Util (isInteger, fracPart)
data Node r
= Node
{ forall r. Node r -> Solver r
ndSolver :: LPSolver.Solver r
, forall r. Node r -> Int
ndDepth :: {-# UNPACK #-} !Int
}
ndTableau :: Node r -> Simplex.Tableau r
ndTableau :: forall r. Node r -> Tableau r
ndTableau Node r
node = forall s a. State s a -> s -> a
evalState forall r. LP r (Tableau r)
getTableau (forall r. Node r -> Solver r
ndSolver Node r
node)
ndLowerBound :: Node r -> r
ndLowerBound :: forall r. Node r -> r
ndLowerBound Node r
node = forall s a. State s a -> s -> a
evalState (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall r. Tableau r -> r
Simplex.currentObjValue forall r. LP r (Tableau r)
getTableau) (forall r. Node r -> Solver r
ndSolver Node r
node)
data Err = ErrUnbounded | ErrUnsat deriving (Eq Err
Err -> Err -> Bool
Err -> Err -> Ordering
Err -> Err -> Err
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
min :: Err -> Err -> Err
$cmin :: Err -> Err -> Err
max :: Err -> Err -> Err
$cmax :: Err -> Err -> Err
>= :: Err -> Err -> Bool
$c>= :: Err -> Err -> Bool
> :: Err -> Err -> Bool
$c> :: Err -> Err -> Bool
<= :: Err -> Err -> Bool
$c<= :: Err -> Err -> Bool
< :: Err -> Err -> Bool
$c< :: Err -> Err -> Bool
compare :: Err -> Err -> Ordering
$ccompare :: Err -> Err -> Ordering
Ord, Err -> Err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Err -> Err -> Bool
$c/= :: Err -> Err -> Bool
== :: Err -> Err -> Bool
$c== :: Err -> Err -> Bool
Eq, Int -> Err -> ShowS
[Err] -> ShowS
Err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Err] -> ShowS
$cshowList :: [Err] -> ShowS
show :: Err -> String
$cshow :: Err -> String
showsPrec :: Int -> Err -> ShowS
$cshowsPrec :: Int -> Err -> ShowS
Show, Int -> Err
Err -> Int
Err -> [Err]
Err -> Err
Err -> Err -> [Err]
Err -> Err -> Err -> [Err]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Err -> Err -> Err -> [Err]
$cenumFromThenTo :: Err -> Err -> Err -> [Err]
enumFromTo :: Err -> Err -> [Err]
$cenumFromTo :: Err -> Err -> [Err]
enumFromThen :: Err -> Err -> [Err]
$cenumFromThen :: Err -> Err -> [Err]
enumFrom :: Err -> [Err]
$cenumFrom :: Err -> [Err]
fromEnum :: Err -> Int
$cfromEnum :: Err -> Int
toEnum :: Int -> Err
$ctoEnum :: Int -> Err
pred :: Err -> Err
$cpred :: Err -> Err
succ :: Err -> Err
$csucc :: Err -> Err
Enum, Err
forall a. a -> a -> Bounded a
maxBound :: Err
$cmaxBound :: Err
minBound :: Err
$cminBound :: Err
Bounded)
maximize :: RealFrac r => LA.Expr r -> [LA.Atom r] -> VarSet -> OptResult r
maximize :: forall r. RealFrac r => Expr r -> [Atom r] -> VarSet -> OptResult r
maximize = forall r.
RealFrac r =>
OptDir -> Expr r -> [Atom r] -> VarSet -> OptResult r
optimize OptDir
OptMax
minimize :: RealFrac r => LA.Expr r -> [LA.Atom r] -> VarSet -> OptResult r
minimize :: forall r. RealFrac r => Expr r -> [Atom r] -> VarSet -> OptResult r
minimize = forall r.
RealFrac r =>
OptDir -> Expr r -> [Atom r] -> VarSet -> OptResult r
optimize OptDir
OptMin
optimize :: RealFrac r => OptDir -> LA.Expr r -> [LA.Atom r] -> VarSet -> OptResult r
optimize :: forall r.
RealFrac r =>
OptDir -> Expr r -> [Atom r] -> VarSet -> OptResult r
optimize OptDir
optdir Expr r
obj [Atom r]
cs VarSet
ivs =
case forall r.
RealFrac r =>
OptDir
-> Expr r -> [Atom r] -> VarSet -> Either Err (Node r, VarSet)
mkInitialNode OptDir
optdir Expr r
obj [Atom r]
cs VarSet
ivs of
Left Err
err ->
case Err
err of
Err
ErrUnsat -> forall r. OptResult r
OptUnsat
Err
ErrUnbounded ->
if VarSet -> Bool
IS.null VarSet
ivs
then forall r. OptResult r
Unbounded
else
case Options
-> VarSet -> [Atom Rational] -> VarSet -> Maybe (Model Rational)
OmegaTest.solveQFLIRAConj forall a. Default a => a
def (forall a. Variables a => a -> VarSet
vars [Atom r]
cs VarSet -> VarSet -> VarSet
`IS.union` VarSet
ivs) (forall a b. (a -> b) -> [a] -> [b]
map forall r. RealFrac r => Atom r -> Atom Rational
conv [Atom r]
cs) VarSet
ivs of
Maybe (Model Rational)
Nothing -> forall r. OptResult r
OptUnsat
Just Model Rational
_ -> forall r. OptResult r
Unbounded
Right (Node r
node0, VarSet
ivs2) ->
case forall r.
RealFrac r =>
OptDir -> Expr r -> VarSet -> Node r -> Either Err (Node r)
traverseBBTree OptDir
optdir Expr r
obj VarSet
ivs2 Node r
node0 of
Left Err
ErrUnbounded -> forall a. HasCallStack => String -> a
error String
"shoud not happen"
Left Err
ErrUnsat -> forall r. OptResult r
OptUnsat
Right Node r
node -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState (forall r. Node r -> Solver r
ndSolver Node r
node) forall a b. (a -> b) -> a -> b
$ do
Tableau r
tbl <- forall r. LP r (Tableau r)
getTableau
Model r
model <- forall r. Fractional r => VarSet -> LP r (Model r)
getModel VarSet
vs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall r. r -> Model r -> OptResult r
Optimum (forall r. Tableau r -> r
Simplex.currentObjValue Tableau r
tbl) Model r
model
where
vs :: VarSet
vs = forall a. Variables a => a -> VarSet
vars [Atom r]
cs VarSet -> VarSet -> VarSet
`IS.union` forall a. Variables a => a -> VarSet
vars Expr r
obj
tableau' :: (RealFrac r) => [LA.Atom r] -> VarSet -> LP r VarSet
tableau' :: forall r. RealFrac r => [Atom r] -> VarSet -> LP r VarSet
tableau' [Atom r]
cs VarSet
ivs = do
let (VarSet
nonnegVars, [Atom r]
cs') = forall r. RealFrac r => [Atom r] -> VarSet -> (VarSet, [Atom r])
collectNonnegVars [Atom r]
cs VarSet
ivs
fvs :: VarSet
fvs = forall a. Variables a => a -> VarSet
vars [Atom r]
cs VarSet -> VarSet -> VarSet
`IS.difference` VarSet
nonnegVars
VarSet
ivs2 <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *). Foldable f => f VarSet -> VarSet
IS.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (VarSet -> [Int]
IS.toList VarSet
fvs) forall a b. (a -> b) -> a -> b
$ \Int
v -> do
Int
v1 <- forall r. LP r Int
newVar
Int
v2 <- forall r. LP r Int
newVar
forall r. Int -> Expr r -> LP r ()
define Int
v (forall r. Num r => Int -> Expr r
LA.var Int
v1 forall v. AdditiveGroup v => v -> v -> v
^-^ forall r. Num r => Int -> Expr r
LA.var Int
v2)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
v Int -> VarSet -> Bool
`IS.member` VarSet
ivs then [Int] -> VarSet
IS.fromList [Int
v1,Int
v2] else VarSet
IS.empty
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall r. Real r => Atom r -> LP r ()
addConstraint [Atom r]
cs'
forall (m :: * -> *) a. Monad m => a -> m a
return VarSet
ivs2
conv :: RealFrac r => LA.Atom r -> LA.Atom Rational
conv :: forall r. RealFrac r => Atom r -> Atom Rational
conv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. (Num b, Eq b) => (a -> b) -> Expr a -> Expr b
LA.mapCoeff forall a. Real a => a -> Rational
toRational)
mkInitialNode :: RealFrac r => OptDir -> LA.Expr r -> [LA.Atom r] -> VarSet -> Either Err (Node r, VarSet)
mkInitialNode :: forall r.
RealFrac r =>
OptDir
-> Expr r -> [Atom r] -> VarSet -> Either Err (Node r, VarSet)
mkInitialNode OptDir
optdir Expr r
obj [Atom r]
cs VarSet
ivs =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState (forall r. VarSet -> Solver r
emptySolver VarSet
vs) forall a b. (a -> b) -> a -> b
$ do
VarSet
ivs2 <- forall r. RealFrac r => [Atom r] -> VarSet -> LP r VarSet
tableau' [Atom r]
cs VarSet
ivs
OptResult
ret <- forall r.
(Fractional r, Real r) =>
OptDir -> Expr r -> LP r OptResult
LPSolver.twoPhaseSimplex OptDir
optdir Expr r
obj
case OptResult
ret of
OptResult
LPSolver.Unsat -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Err
ErrUnsat)
OptResult
LPSolver.Unbounded -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Err
ErrUnbounded)
OptResult
LPSolver.Optimum -> do
Solver r
solver <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
( Node{ ndSolver :: Solver r
ndSolver = Solver r
solver
, ndDepth :: Int
ndDepth = Int
0
}
, VarSet
ivs VarSet -> VarSet -> VarSet
`IS.union` VarSet
ivs2
)
where
vs :: VarSet
vs = forall a. Variables a => a -> VarSet
vars [Atom r]
cs VarSet -> VarSet -> VarSet
`IS.union` forall a. Variables a => a -> VarSet
vars Expr r
obj
isStrictlyBetter :: RealFrac r => OptDir -> r -> r -> Bool
isStrictlyBetter :: forall r. RealFrac r => OptDir -> r -> r -> Bool
isStrictlyBetter OptDir
optdir = if OptDir
optdirforall a. Eq a => a -> a -> Bool
==OptDir
OptMin then forall a. Ord a => a -> a -> Bool
(<) else forall a. Ord a => a -> a -> Bool
(>)
traverseBBTree :: forall r. RealFrac r => OptDir -> LA.Expr r -> VarSet -> Node r -> Either Err (Node r)
traverseBBTree :: forall r.
RealFrac r =>
OptDir -> Expr r -> VarSet -> Node r -> Either Err (Node r)
traverseBBTree OptDir
optdir Expr r
obj VarSet
ivs Node r
node0 = [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop [Node r
node0] forall a. Maybe a
Nothing
where
loop :: [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop :: [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop [] (Just Node r
best) = forall a b. b -> Either a b
Right Node r
best
loop [] Maybe (Node r)
Nothing = forall a b. a -> Either a b
Left Err
ErrUnsat
loop (Node r
n:[Node r]
ns) Maybe (Node r)
Nothing =
case Node r -> Maybe [Node r]
children Node r
n of
Maybe [Node r]
Nothing -> [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop [Node r]
ns (forall a. a -> Maybe a
Just Node r
n)
Just [Node r]
cs -> [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop ([Node r]
csforall a. [a] -> [a] -> [a]
++[Node r]
ns) forall a. Maybe a
Nothing
loop (Node r
n:[Node r]
ns) (Just Node r
best)
| forall r. RealFrac r => OptDir -> r -> r -> Bool
isStrictlyBetter OptDir
optdir (forall r. Node r -> r
ndLowerBound Node r
n) (forall r. Node r -> r
ndLowerBound Node r
best) =
case Node r -> Maybe [Node r]
children Node r
n of
Maybe [Node r]
Nothing -> [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop [Node r]
ns (forall a. a -> Maybe a
Just Node r
n)
Just [Node r]
cs -> [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop ([Node r]
csforall a. [a] -> [a] -> [a]
++[Node r]
ns) (forall a. a -> Maybe a
Just Node r
best)
| Bool
otherwise = [Node r] -> Maybe (Node r) -> Either Err (Node r)
loop [Node r]
ns (forall a. a -> Maybe a
Just Node r
best)
reopt :: Solver r -> Maybe (Solver r)
reopt :: Solver r -> Maybe (Solver r)
reopt Solver r
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Solver r
s forall a b. (a -> b) -> a -> b
$ do
Bool
ret <- forall r. (Fractional r, Real r) => OptDir -> Expr r -> LP r Bool
dualSimplex OptDir
optdir Expr r
obj
if Bool
ret
then forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just forall s (m :: * -> *). MonadState s m => m s
get
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
children :: Node r -> Maybe [Node r]
children :: Node r -> Maybe [Node r]
children Node r
node
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, VarMap r, r)]
xs = forall a. Maybe a
Nothing
| forall r. Node r -> Int
ndDepth Node r
node forall a. Integral a => a -> a -> a
`mod` Int
100 forall a. Eq a => a -> a -> Bool
== Int
0 =
let
(r
f0, VarMap r
m0) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) [(forall a. RealFrac a => a -> a
fracPart r
val, VarMap r
m) | (Int
_,VarMap r
m,r
val) <- [(Int, VarMap r, r)]
xs]
sv :: Solver r
sv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState (forall r. Node r -> Solver r
ndSolver Node r
node) forall a b. (a -> b) -> a -> b
$ do
Int
s <- forall r. LP r Int
newVar
let g :: Int -> r -> r
g Int
j r
x = forall a. HasCallStack => Bool -> a -> a
assert (r
a forall a. Ord a => a -> a -> Bool
>= r
0) r
a
where
a :: r
a | Int
j Int -> VarSet -> Bool
`IS.member` VarSet
ivs =
if forall a. RealFrac a => a -> a
fracPart r
x forall a. Ord a => a -> a -> Bool
<= r
f0
then forall a. RealFrac a => a -> a
fracPart r
x
else (r
f0 forall a. Fractional a => a -> a -> a
/ (r
f0 forall a. Num a => a -> a -> a
- r
1)) forall a. Num a => a -> a -> a
* (forall a. RealFrac a => a -> a
fracPart r
x forall a. Num a => a -> a -> a
- r
1)
| Bool
otherwise =
if r
x forall a. Ord a => a -> a -> Bool
>= r
0
then r
x
else (r
f0 forall a. Fractional a => a -> a -> a
/ (r
f0 forall a. Num a => a -> a -> a
- r
1)) forall a. Num a => a -> a -> a
* r
x
forall r. Tableau r -> LP r ()
putTableau forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
s (forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
j r
x -> forall a. Num a => a -> a
negate (Int -> r -> r
g Int
j r
x)) VarMap r
m0, forall a. Num a => a -> a
negate r
f0) Tableau r
tbl
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Node r
node{ ndSolver :: Solver r
ndSolver = Solver r
sv2, ndDepth :: Int
ndDepth = forall r. Node r -> Int
ndDepth Node r
node forall a. Num a => a -> a -> a
+ Int
1 } | Solver r
sv2 <- forall a. Maybe a -> [a]
maybeToList (Solver r -> Maybe (Solver r)
reopt Solver r
sv)]
| Bool
otherwise =
let (Int
v0, r
val0) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) [(forall a. RealFrac a => a -> a
fracPart r
val, (Int
v, r
val)) | (Int
v,VarMap r
_,r
val) <- [(Int, VarMap r, r)]
xs]
cs :: [OrdRel (Expr r)]
cs = [ forall r. Num r => Int -> Expr r
LA.var Int
v0 forall e r. IsOrdRel e r => e -> e -> r
.>=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
ceiling r
val0 :: Integer))
, forall r. Num r => Int -> Expr r
LA.var Int
v0 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
floor r
val0 :: Integer))
]
svs :: [Solver r]
svs = [forall s a. State s a -> s -> s
execState (forall r. Real r => Atom r -> LP r ()
addConstraint OrdRel (Expr r)
c) (forall r. Node r -> Solver r
ndSolver Node r
node) | OrdRel (Expr r)
c <- [OrdRel (Expr r)]
cs]
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Node r
node{ ndSolver :: Solver r
ndSolver = Solver r
sv, ndDepth :: Int
ndDepth = forall r. Node r -> Int
ndDepth Node r
node forall a. Num a => a -> a -> a
+ Int
1 } | Just Solver r
sv <- forall a b. (a -> b) -> [a] -> [b]
map Solver r -> Maybe (Solver r)
reopt [Solver r]
svs]
where
tbl :: Simplex.Tableau r
tbl :: Tableau r
tbl = forall r. Node r -> Tableau r
ndTableau Node r
node
xs :: [(Var, VarMap r, r)]
xs :: [(Int, VarMap r, r)]
xs = [ (Int
v, VarMap r
m, r
val)
| Int
v <- VarSet -> [Int]
IS.toList VarSet
ivs
, Just (VarMap r
m, r
val) <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
v Tableau r
tbl)
, Bool -> Bool
not (forall a. RealFrac a => a -> Bool
isInteger r
val)
]
example1 :: (Fractional r, Eq r) => (OptDir, LA.Expr r, [LA.Atom r], VarSet)
example1 :: forall r.
(Fractional r, Eq r) =>
(OptDir, Expr r, [Atom r], VarSet)
example1 = (OptDir
optdir, Expr r
obj, [Atom r]
cs, VarSet
ivs)
where
optdir :: OptDir
optdir = OptDir
OptMax
x1 :: Expr r
x1 = forall r. Num r => Int -> Expr r
LA.var Int
1
x2 :: Expr r
x2 = forall r. Num r => Int -> Expr r
LA.var Int
2
x3 :: Expr r
x3 = forall r. Num r => Int -> Expr r
LA.var Int
3
x4 :: Expr r
x4 = forall r. Num r => Int -> Expr r
LA.var Int
4
obj :: Expr r
obj = Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^+^ r
2 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^+^ r
3 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x3 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x4
cs :: [Atom r]
cs =
[ (-r
1) forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x3 forall v. AdditiveGroup v => v -> v -> v
^+^ r
10forall v. VectorSpace v => Scalar v -> v -> v
*^Expr r
x4 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
20
, Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^-^ r
3 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x3 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
30
, Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^-^ r
3.5 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x4 forall e r. IsEqRel e r => e -> e -> r
.==. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x1
, Expr r
x1 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
40
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x2
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x3
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
2 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x4
, Expr r
x4 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
3
]
ivs :: VarSet
ivs = Int -> VarSet
IS.singleton Int
4
_test1 :: Bool
_test1 :: Bool
_test1 = OptResult Rational
resultforall a. Eq a => a -> a -> Bool
==OptResult Rational
expected
where
(OptDir
optdir, Expr Rational
obj, [Atom Rational]
cs, VarSet
ivs) = forall r.
(Fractional r, Eq r) =>
(OptDir, Expr r, [Atom r], VarSet)
example1
result, expected :: OptResult Rational
result :: OptResult Rational
result = forall r.
RealFrac r =>
OptDir -> Expr r -> [Atom r] -> VarSet -> OptResult r
optimize OptDir
optdir Expr Rational
obj [Atom Rational]
cs VarSet
ivs
expected :: OptResult Rational
expected = forall r. r -> Model r -> OptResult r
Optimum (Rational
245forall a. Fractional a => a -> a -> a
/Rational
2) (forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
1,Rational
40),(Int
2,Rational
21forall a. Fractional a => a -> a -> a
/Rational
2),(Int
3,Rational
39forall a. Fractional a => a -> a -> a
/Rational
2),(Int
4,Rational
3)])
_test1' :: Bool
_test1' :: Bool
_test1' = OptResult Rational
resultforall a. Eq a => a -> a -> Bool
==OptResult Rational
expected
where
(OptDir
optdir, Expr Rational
obj, [Atom Rational]
cs, VarSet
ivs) = forall r.
(Fractional r, Eq r) =>
(OptDir, Expr r, [Atom r], VarSet)
example1
f :: OptDir -> OptDir
f OptDir
OptMin = OptDir
OptMax
f OptDir
OptMax = OptDir
OptMin
result, expected :: OptResult Rational
result :: OptResult Rational
result = forall r.
RealFrac r =>
OptDir -> Expr r -> [Atom r] -> VarSet -> OptResult r
optimize (OptDir -> OptDir
f OptDir
optdir) (forall v. AdditiveGroup v => v -> v
negateV Expr Rational
obj) [Atom Rational]
cs VarSet
ivs
expected :: OptResult Rational
expected = forall r. r -> Model r -> OptResult r
Optimum (-Rational
245forall a. Fractional a => a -> a -> a
/Rational
2) (forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
1,Rational
40),(Int
2,Rational
21forall a. Fractional a => a -> a -> a
/Rational
2),(Int
3,Rational
39forall a. Fractional a => a -> a -> a
/Rational
2),(Int
4,Rational
3)])
example2 :: (Fractional r, Eq r) => (OptDir, LA.Expr r, [LA.Atom r], VarSet)
example2 :: forall r.
(Fractional r, Eq r) =>
(OptDir, Expr r, [Atom r], VarSet)
example2 = (OptDir
optdir, Expr r
obj, [Atom r]
cs, VarSet
ivs)
where
optdir :: OptDir
optdir = OptDir
OptMin
[Expr r
x1,Expr r
x2,Expr r
x3] = forall a b. (a -> b) -> [a] -> [b]
map forall r. Num r => Int -> Expr r
LA.var [Int
1..Int
3]
obj :: Expr r
obj = (-r
1) forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^-^ r
3 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^-^ r
5 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x3
cs :: [Atom r]
cs =
[ r
3 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^+^ r
4 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x2 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
10
, r
2 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x3 forall e r. IsOrdRel e r => e -> e -> r
.<=. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
7
, r
3forall v. VectorSpace v => Scalar v -> v -> v
*^Expr r
x1 forall v. AdditiveGroup v => v -> v -> v
^+^ Expr r
x2 forall v. AdditiveGroup v => v -> v -> v
^+^ r
4 forall v. VectorSpace v => Scalar v -> v -> v
*^ Expr r
x3 forall e r. IsEqRel e r => e -> e -> r
.==. forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
12
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x1
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x2
, forall r. (Num r, Eq r) => r -> Expr r
LA.constant r
0 forall e r. IsOrdRel e r => e -> e -> r
.<=. Expr r
x3
]
ivs :: VarSet
ivs = [Int] -> VarSet
IS.fromList [Int
1,Int
2]
_test2 :: Bool
_test2 :: Bool
_test2 = OptResult Rational
result forall a. Eq a => a -> a -> Bool
== OptResult Rational
expected
where
result, expected :: OptResult Rational
result :: OptResult Rational
result = forall r.
RealFrac r =>
OptDir -> Expr r -> [Atom r] -> VarSet -> OptResult r
optimize OptDir
optdir Expr Rational
obj [Atom Rational]
cs VarSet
ivs
expected :: OptResult Rational
expected = forall r. r -> Model r -> OptResult r
Optimum (-Rational
37forall a. Fractional a => a -> a -> a
/Rational
2) (forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
1,Rational
0),(Int
2,Rational
2),(Int
3,Rational
5forall a. Fractional a => a -> a -> a
/Rational
2)])
(OptDir
optdir, Expr Rational
obj, [Atom Rational]
cs, VarSet
ivs) = forall r.
(Fractional r, Eq r) =>
(OptDir, Expr r, [Atom r], VarSet)
example2