{-# OPTIONS_GHC -Wall #-}
module ToySolver.Arith.Simplex.Simple
( Model
, OptDir (..)
, OptResult (..)
, check
, optimize
) where
import Control.Monad
import Control.Monad.ST
import Data.Default.Class
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
import qualified ToySolver.Data.LA as LA
import ToySolver.Data.IntVar hiding (Model)
import qualified ToySolver.Arith.Simplex as Simplex
import ToySolver.Arith.Simplex hiding (check, optimize)
check :: VarSet -> [LA.Atom Rational] -> Maybe Model
check vs as = runST $ do
solver <- Simplex.newSolver
s <- liftM IntMap.fromAscList $ forM (IntSet.toAscList vs) $ \v -> do
v2 <- Simplex.newVar solver
return (v, v2)
let s' = fmap LA.var s
mtrans m = fmap (m IntMap.!) s
forM_ as $ \a -> do
Simplex.assertAtomEx solver (fmap (LA.applySubst s') a)
ret <- Simplex.check solver
if ret then do
m <- Simplex.getModel solver
return $ Just $ mtrans m
else
return Nothing
optimize :: VarSet -> OptDir -> LA.Expr Rational -> [LA.Atom Rational] -> (OptResult, Maybe Model)
optimize vs dir obj as = runST $ do
solver <- Simplex.newSolver
s <- liftM IntMap.fromAscList $ forM (IntSet.toAscList vs) $ \v -> do
v2 <- Simplex.newVar solver
return (v, v2)
let s' = fmap LA.var s
mtrans m = fmap (m IntMap.!) s
forM_ as $ \a -> do
assertAtom solver (fmap (LA.applySubst s') a)
Simplex.setOptDir solver dir
Simplex.setObj solver obj
ret <- Simplex.optimize solver def
case ret of
Optimum -> do
m <- Simplex.getModel solver
return $ (ret, Just (mtrans m))
Unsat -> do
return $ (ret, Nothing)
Unbounded -> do
m <- Simplex.getModel solver
return $ (ret, Just (mtrans m))
ObjLimit -> do
error "should not happen"