{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Arith.Simplex.Textbook.MIPSolver.Simple
-- Copyright   :  (c) Masahiro Sakai 2011
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- References:
--
-- * [Gomory1960]
--   Ralph E. Gomory.
--   An Algorithm for the Mixed Integer Problem, Technical Report
--   RM-2597, 1960, The Rand Corporation, Santa Monica, CA.
--   <http://www.rand.org/pubs/research_memoranda/RM2597.html>
--
-- * [Gomory1958]
--   Ralph E. Gomory.
--   Outline of an algorithm for integer solutions to linear programs.
--   Bull. Amer. Math. Soc., Vol. 64, No. 5. (1958), pp. 275-278.
--   <http://projecteuclid.org/euclid.bams/1183522679>
-----------------------------------------------------------------------------

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
--  , ndCutSlackVariables :: VarSet
  }

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
            {-
               Fallback to Fourier-Motzkin + OmegaTest
               * In general, original problem may have optimal
                 solution even though LP relaxiation is unbounded.
               * But if restricted to rational numbers, the
                 original problem is unbounded or unsatisfiable
                 when LP relaxation is unbounded.
            -}
            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
--                , ndCutSlackVariables = IS.empty
                }
          , 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 -- no violation
      | 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 = -- cut
          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)
                                     -- [Gomory1960] では (f0 / (1 - f0)) * (fracPart x - 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 = -- branch
          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)])

-- 『数理計画法の基礎』(坂和 正敏) p.109 例 3.8
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

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