{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module contains the full definitions backing the simplified API
-- exposed in 'Math.Programming.Glpk'.
module Math.Programming.Glpk.Internal where

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Data.Functor
import qualified Data.Text as T
import Data.Typeable
import Data.Void
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Math.Programming
import Math.Programming.Glpk.Header
import UnliftIO
import UnliftIO.Concurrent

-- | A reference to a GLPK variable.
type GlpkVariable = GlpkPtr Column

-- | A reference to a GLPK constraint.
type GlpkConstraint = GlpkPtr Row

-- | A placeholder for an objective.
--
-- GLPK supports only single-objective problems, and so no indices
-- need to be stored.
newtype GlpkObjective = GlpkObjective ()

class (MonadLP GlpkVariable GlpkConstraint GlpkObjective m, MonadIP GlpkVariable GlpkConstraint GlpkObjective m) => MonadGlpk m where
  writeFormulation :: FilePath -> m ()

-- | An interface to the low-level GLPK API.
--
-- High-level solver settings can be modified by altering the
-- 'SimplexMethodControlParameters' and 'MIPControlParameters' values
-- for LP and IP solves, respectively.
data GlpkEnv = GlpkEnv
  { -- | A pointer to the Problem object. Most GLPK routines take this
    -- as the first argument.
    GlpkEnv -> Ptr Problem
_glpkEnvProblem :: Ptr Problem,
    -- | The variables in the model
    GlpkEnv -> IORef [GlpkVariable]
_glpkVariables :: IORef [GlpkVariable],
    -- | The next unique ID to assign to a variable.
    GlpkEnv -> IORef Integer
_glpkNextVariableId :: IORef Integer,
    -- | The constraints in the model
    GlpkEnv -> IORef [GlpkConstraint]
_glpkConstraints :: IORef [GlpkConstraint],
    -- | The next unique ID to assign to a variable.
    GlpkEnv -> IORef Integer
_glpkNextConstraintId :: IORef Integer,
    -- | The control parameters for the simplex method
    GlpkEnv -> IORef SimplexMethodControlParameters
_glpkSimplexControl :: IORef SimplexMethodControlParameters,
    -- | The control parameters for the MIP solver
    GlpkEnv -> IORef (MIPControlParameters Void)
_glpkMIPControl :: IORef (MIPControlParameters Void),
    -- | The type of the last solve. This is needed to know whether to
    -- retrieve simplex, interior point, or MIP solutions.
    GlpkEnv -> IORef (Maybe SolveType)
_glpkLastSolveType :: IORef (Maybe SolveType)
  }

-- | A pointer to a GLPK row or column.
--
-- We assign an immutable unique value to each 'GlpkPtr' we create.
--
-- Internally, GLPK refers to variables and constraints by their
-- column and row indices, respectively. These indices can change when
-- rows and columns are deleted, so we update this value as necessary.
data GlpkPtr a = GlpkPtr
  { -- | An immutable, unique value associated with this pointer.
    forall a. GlpkPtr a -> Integer
_glpkPtrId :: Integer,
    -- | The referenced object.
    forall a. GlpkPtr a -> IORef a
_glpkPtrRef :: IORef a,
    -- | Whether this reference has been deleted from the problem.
    forall a. GlpkPtr a -> IORef Bool
_glpkPtrDeleted :: IORef Bool
  }

instance Eq (GlpkPtr a) where
  (GlpkPtr Integer
x IORef a
_ IORef Bool
_) == :: GlpkPtr a -> GlpkPtr a -> Bool
== (GlpkPtr Integer
y IORef a
_ IORef Bool
_) = Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y

instance Ord (GlpkPtr a) where
  compare :: GlpkPtr a -> GlpkPtr a -> Ordering
compare (GlpkPtr Integer
x IORef a
_ IORef Bool
_) (GlpkPtr Integer
y IORef a
_ IORef Bool
_) = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
x Integer
y

-- | An error that GLPK can encounter.
data GlpkException
  = UnknownVariable
  | UnknownCode T.Text CInt
  | GlpkFailure T.Text
  deriving
    ( Int -> GlpkException -> ShowS
[GlpkException] -> ShowS
GlpkException -> String
(Int -> GlpkException -> ShowS)
-> (GlpkException -> String)
-> ([GlpkException] -> ShowS)
-> Show GlpkException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlpkException] -> ShowS
$cshowList :: [GlpkException] -> ShowS
show :: GlpkException -> String
$cshow :: GlpkException -> String
showsPrec :: Int -> GlpkException -> ShowS
$cshowsPrec :: Int -> GlpkException -> ShowS
Show,
      Typeable
    )

instance Exception GlpkException

-- | An environment to solve math programs using GLPK.
newtype GlpkT m a = GlpkT {forall (m :: * -> *) a. GlpkT m a -> ReaderT GlpkEnv m a
_runGlpk :: ReaderT GlpkEnv m a}
  deriving
    ( (forall a b. (a -> b) -> GlpkT m a -> GlpkT m b)
-> (forall a b. a -> GlpkT m b -> GlpkT m a) -> Functor (GlpkT m)
forall a b. a -> GlpkT m b -> GlpkT m a
forall a b. (a -> b) -> GlpkT m a -> GlpkT m b
forall (m :: * -> *) a b. Functor m => a -> GlpkT m b -> GlpkT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GlpkT m a -> GlpkT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GlpkT m b -> GlpkT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> GlpkT m b -> GlpkT m a
fmap :: forall a b. (a -> b) -> GlpkT m a -> GlpkT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GlpkT m a -> GlpkT m b
Functor,
      Functor (GlpkT m)
Functor (GlpkT m)
-> (forall a. a -> GlpkT m a)
-> (forall a b. GlpkT m (a -> b) -> GlpkT m a -> GlpkT m b)
-> (forall a b c.
    (a -> b -> c) -> GlpkT m a -> GlpkT m b -> GlpkT m c)
-> (forall a b. GlpkT m a -> GlpkT m b -> GlpkT m b)
-> (forall a b. GlpkT m a -> GlpkT m b -> GlpkT m a)
-> Applicative (GlpkT m)
forall a. a -> GlpkT m a
forall a b. GlpkT m a -> GlpkT m b -> GlpkT m a
forall a b. GlpkT m a -> GlpkT m b -> GlpkT m b
forall a b. GlpkT m (a -> b) -> GlpkT m a -> GlpkT m b
forall a b c. (a -> b -> c) -> GlpkT m a -> GlpkT m b -> GlpkT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (GlpkT m)
forall (m :: * -> *) a. Applicative m => a -> GlpkT m a
forall (m :: * -> *) a b.
Applicative m =>
GlpkT m a -> GlpkT m b -> GlpkT m a
forall (m :: * -> *) a b.
Applicative m =>
GlpkT m a -> GlpkT m b -> GlpkT m b
forall (m :: * -> *) a b.
Applicative m =>
GlpkT m (a -> b) -> GlpkT m a -> GlpkT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> GlpkT m a -> GlpkT m b -> GlpkT m c
<* :: forall a b. GlpkT m a -> GlpkT m b -> GlpkT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
GlpkT m a -> GlpkT m b -> GlpkT m a
*> :: forall a b. GlpkT m a -> GlpkT m b -> GlpkT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
GlpkT m a -> GlpkT m b -> GlpkT m b
liftA2 :: forall a b c. (a -> b -> c) -> GlpkT m a -> GlpkT m b -> GlpkT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> GlpkT m a -> GlpkT m b -> GlpkT m c
<*> :: forall a b. GlpkT m (a -> b) -> GlpkT m a -> GlpkT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
GlpkT m (a -> b) -> GlpkT m a -> GlpkT m b
pure :: forall a. a -> GlpkT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> GlpkT m a
Applicative,
      Applicative (GlpkT m)
Applicative (GlpkT m)
-> (forall a b. GlpkT m a -> (a -> GlpkT m b) -> GlpkT m b)
-> (forall a b. GlpkT m a -> GlpkT m b -> GlpkT m b)
-> (forall a. a -> GlpkT m a)
-> Monad (GlpkT m)
forall a. a -> GlpkT m a
forall a b. GlpkT m a -> GlpkT m b -> GlpkT m b
forall a b. GlpkT m a -> (a -> GlpkT m b) -> GlpkT m b
forall {m :: * -> *}. Monad m => Applicative (GlpkT m)
forall (m :: * -> *) a. Monad m => a -> GlpkT m a
forall (m :: * -> *) a b.
Monad m =>
GlpkT m a -> GlpkT m b -> GlpkT m b
forall (m :: * -> *) a b.
Monad m =>
GlpkT m a -> (a -> GlpkT m b) -> GlpkT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> GlpkT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GlpkT m a
>> :: forall a b. GlpkT m a -> GlpkT m b -> GlpkT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GlpkT m a -> GlpkT m b -> GlpkT m b
>>= :: forall a b. GlpkT m a -> (a -> GlpkT m b) -> GlpkT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GlpkT m a -> (a -> GlpkT m b) -> GlpkT m b
Monad,
      Monad (GlpkT m)
Monad (GlpkT m)
-> (forall a. IO a -> GlpkT m a) -> MonadIO (GlpkT m)
forall a. IO a -> GlpkT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (GlpkT m)
forall (m :: * -> *) a. MonadIO m => IO a -> GlpkT m a
liftIO :: forall a. IO a -> GlpkT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GlpkT m a
MonadIO,
      MonadIO (GlpkT m)
MonadIO (GlpkT m)
-> (forall b. ((forall a. GlpkT m a -> IO a) -> IO b) -> GlpkT m b)
-> MonadUnliftIO (GlpkT m)
forall b. ((forall a. GlpkT m a -> IO a) -> IO b) -> GlpkT m b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
forall {m :: * -> *}. MonadUnliftIO m => MonadIO (GlpkT m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. GlpkT m a -> IO a) -> IO b) -> GlpkT m b
withRunInIO :: forall b. ((forall a. GlpkT m a -> IO a) -> IO b) -> GlpkT m b
$cwithRunInIO :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. GlpkT m a -> IO a) -> IO b) -> GlpkT m b
MonadUnliftIO,
      (forall (m :: * -> *) a. Monad m => m a -> GlpkT m a)
-> MonadTrans GlpkT
forall (m :: * -> *) a. Monad m => m a -> GlpkT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> GlpkT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> GlpkT m a
MonadTrans
    )

type Glpk = GlpkT IO

instance MonadLP GlpkVariable GlpkConstraint GlpkObjective Glpk where
  addVariable :: Glpk GlpkVariable
addVariable = Glpk GlpkVariable
addVariable'
  deleteVariable :: GlpkVariable -> Glpk ()
deleteVariable = GlpkVariable -> Glpk ()
deleteVariable'
  getVariableName :: GlpkVariable -> Glpk Text
getVariableName = GlpkVariable -> Glpk Text
getVariableName'
  setVariableName :: GlpkVariable -> Text -> Glpk ()
setVariableName = GlpkVariable -> Text -> Glpk ()
setVariableName'
  getVariableValue :: GlpkVariable -> Glpk Double
getVariableValue = GlpkVariable -> Glpk Double
getVariableValue'
  getVariableBounds :: GlpkVariable -> Glpk Bounds
getVariableBounds = GlpkVariable -> Glpk Bounds
getVariableBounds'
  setVariableBounds :: GlpkVariable -> Bounds -> Glpk ()
setVariableBounds = GlpkVariable -> Bounds -> Glpk ()
setVariableBounds'

  addConstraint :: Inequality (Expr GlpkVariable) -> Glpk GlpkConstraint
addConstraint = Inequality (Expr GlpkVariable) -> Glpk GlpkConstraint
addConstraint'
  deleteConstraint :: GlpkConstraint -> Glpk ()
deleteConstraint = GlpkConstraint -> Glpk ()
deleteConstraint'
  getConstraintName :: GlpkConstraint -> Glpk Text
getConstraintName = GlpkConstraint -> Glpk Text
getConstraintName'
  setConstraintName :: GlpkConstraint -> Text -> Glpk ()
setConstraintName = GlpkConstraint -> Text -> Glpk ()
setConstraintName'
  getConstraintValue :: GlpkConstraint -> Glpk Double
getConstraintValue = GlpkConstraint -> Glpk Double
getDualValue

  addObjective :: Expr GlpkVariable -> Glpk GlpkObjective
addObjective = Expr GlpkVariable -> Glpk GlpkObjective
addObjective'
  deleteObjective :: GlpkObjective -> Glpk ()
deleteObjective = GlpkObjective -> Glpk ()
deleteObjective'
  getObjectiveName :: GlpkObjective -> Glpk Text
getObjectiveName = GlpkObjective -> Glpk Text
getObjectiveName'
  setObjectiveName :: GlpkObjective -> Text -> Glpk ()
setObjectiveName = GlpkObjective -> Text -> Glpk ()
setObjectiveName'
  getObjectiveValue :: GlpkObjective -> Glpk Double
getObjectiveValue = GlpkObjective -> Glpk Double
getObjectiveValue'
  getObjectiveSense :: GlpkObjective -> Glpk Sense
getObjectiveSense = GlpkObjective -> Glpk Sense
getSense'
  setObjectiveSense :: GlpkObjective -> Sense -> Glpk ()
setObjectiveSense = GlpkObjective -> Sense -> Glpk ()
setSense'

  getTimeout :: Glpk Double
getTimeout = Glpk Double
forall a. RealFrac a => Glpk a
getTimeout'
  setTimeout :: Double -> Glpk ()
setTimeout = Double -> Glpk ()
forall a. RealFrac a => a -> Glpk ()
setTimeout'
  optimizeLP :: Glpk SolutionStatus
optimizeLP = Glpk SolutionStatus
optimizeLP'

instance MonadIP GlpkVariable GlpkConstraint GlpkObjective Glpk where
  getVariableDomain :: GlpkVariable -> Glpk Domain
getVariableDomain = GlpkVariable -> Glpk Domain
getVariableDomain'
  setVariableDomain :: GlpkVariable -> Domain -> Glpk ()
setVariableDomain = GlpkVariable -> Domain -> Glpk ()
setVariableDomain'
  getRelativeMIPGap :: Glpk Double
getRelativeMIPGap = Glpk Double
forall a. RealFrac a => Glpk a
getRelativeMIPGap'
  setRelativeMIPGap :: Double -> Glpk ()
setRelativeMIPGap = Double -> Glpk ()
forall a. RealFrac a => a -> Glpk ()
setRelativeMIPGap'
  optimizeIP :: Glpk SolutionStatus
optimizeIP = Glpk SolutionStatus
optimizeIP'

instance MonadGlpk Glpk where
  writeFormulation :: String -> Glpk ()
writeFormulation = String -> Glpk ()
writeFormulation'

instance MonadGlpk m => MonadGlpk (ReaderT r m) where
  writeFormulation :: String -> ReaderT r m ()
writeFormulation = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (String -> m ()) -> String -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *). MonadGlpk m => String -> m ()
writeFormulation

instance MonadGlpk m => MonadGlpk (StateT s m) where
  writeFormulation :: String -> StateT s m ()
writeFormulation = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (String -> m ()) -> String -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *). MonadGlpk m => String -> m ()
writeFormulation

withGlpkErrorHook :: (Ptr a -> IO CInt) -> Ptr a -> IO b -> IO b
withGlpkErrorHook :: forall a b. (Ptr a -> IO CInt) -> Ptr a -> IO b -> IO b
withGlpkErrorHook Ptr a -> IO CInt
hook Ptr a
ptr IO b
actions =
  IO (FunPtr (Ptr a -> IO CInt))
-> (FunPtr (Ptr a -> IO CInt) -> IO ())
-> (FunPtr (Ptr a -> IO CInt) -> IO b)
-> IO b
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ((Ptr a -> IO CInt) -> IO (FunPtr (Ptr a -> IO CInt))
forall a. (Ptr a -> IO CInt) -> IO (FunPtr (Ptr a -> IO CInt))
mkHaskellErrorHook Ptr a -> IO CInt
hook) FunPtr (Ptr a -> IO CInt) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (Ptr a -> IO CInt) -> IO b) -> IO b)
-> (FunPtr (Ptr a -> IO CInt) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr a -> IO CInt)
hookPtr -> do
    FunPtr (Ptr a -> IO CInt) -> Ptr a -> IO ()
forall a. FunPtr (Ptr a -> IO CInt) -> Ptr a -> IO ()
glp_error_hook FunPtr (Ptr a -> IO CInt)
hookPtr Ptr a
ptr
    IO b
actions

removeGlpkErrorHook :: IO ()
removeGlpkErrorHook :: IO ()
removeGlpkErrorHook = FunPtr (Ptr Any -> IO CInt) -> Ptr Any -> IO ()
forall a. FunPtr (Ptr a -> IO CInt) -> Ptr a -> IO ()
glp_error_hook FunPtr (Ptr Any -> IO CInt)
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr

runGlpk :: Glpk a -> IO a
runGlpk :: forall a. Glpk a -> IO a
runGlpk Glpk a
program =
  let withGlpkEnv :: IO c -> IO c
withGlpkEnv IO c
actions =
        IO CInt -> (CInt -> IO CInt) -> (CInt -> IO c) -> IO c
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO CInt
glp_init_env (IO CInt -> CInt -> IO CInt
forall a b. a -> b -> a
const IO CInt
glp_free_env) ((CInt -> IO c) -> IO c) -> (CInt -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \case
          CInt
0 -> IO c
actions
          CInt
1 -> GlpkException -> IO c
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Text -> GlpkException
GlpkFailure Text
"GLPK already initialized")
          CInt
2 -> GlpkException -> IO c
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Text -> GlpkException
GlpkFailure Text
"GLPK failed to initialize; not enough memory")
          CInt
3 -> GlpkException -> IO c
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Text -> GlpkException
GlpkFailure Text
"GLPK failed to initialize; unsupported programming model")
          CInt
r -> GlpkException -> IO c
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Text -> GlpkException
GlpkFailure (Text
"GLPK failed to initialize; unknown status code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CInt -> String
forall a. Show a => a -> String
show CInt
r)))
   in IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m a
runInBoundThread (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
        IO a -> IO a
forall {c}. IO c -> IO c
withGlpkEnv (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
          (IO a -> IO () -> IO a) -> IO () -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> IO () -> IO a
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally IO ()
removeGlpkErrorHook (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
            (Ptr Any -> IO CInt) -> Ptr Any -> IO a -> IO a
forall a b. (Ptr a -> IO CInt) -> Ptr a -> IO b -> IO b
withGlpkErrorHook (IO CInt -> Ptr Any -> IO CInt
forall a b. a -> b -> a
const IO CInt
glp_free_env) Ptr Any
forall a. Ptr a
nullPtr (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
              Glpk a -> IO a
forall a. Glpk a -> IO a
runGlpk' Glpk a
program

getDefaultSimplexControlParameters :: IO SimplexMethodControlParameters
getDefaultSimplexControlParameters :: IO SimplexMethodControlParameters
getDefaultSimplexControlParameters = do
  SimplexMethodControlParameters
params <- (Ptr SimplexMethodControlParameters
 -> IO SimplexMethodControlParameters)
-> IO SimplexMethodControlParameters
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr SimplexMethodControlParameters
  -> IO SimplexMethodControlParameters)
 -> IO SimplexMethodControlParameters)
-> (Ptr SimplexMethodControlParameters
    -> IO SimplexMethodControlParameters)
-> IO SimplexMethodControlParameters
forall a b. (a -> b) -> a -> b
$ \Ptr SimplexMethodControlParameters
simplexControlPtr -> do
    Ptr SimplexMethodControlParameters -> IO ()
glp_init_smcp Ptr SimplexMethodControlParameters
simplexControlPtr
    Ptr SimplexMethodControlParameters
-> IO SimplexMethodControlParameters
forall a. Storable a => Ptr a -> IO a
peek Ptr SimplexMethodControlParameters
simplexControlPtr

  -- Turn on presolve. Users can simply turn this off before the first
  -- optimization call if they desire.
  SimplexMethodControlParameters -> IO SimplexMethodControlParameters
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimplexMethodControlParameters
params {smcpPresolve :: GlpkPresolve
smcpPresolve = GlpkPresolve
glpkPresolveOn})

getDefaultMIPControlParameters :: IO (MIPControlParameters Void)
getDefaultMIPControlParameters :: IO (MIPControlParameters Void)
getDefaultMIPControlParameters = do
  MIPControlParameters Void
params <- (Ptr (MIPControlParameters Void) -> IO (MIPControlParameters Void))
-> IO (MIPControlParameters Void)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (MIPControlParameters Void)
  -> IO (MIPControlParameters Void))
 -> IO (MIPControlParameters Void))
-> (Ptr (MIPControlParameters Void)
    -> IO (MIPControlParameters Void))
-> IO (MIPControlParameters Void)
forall a b. (a -> b) -> a -> b
$ \Ptr (MIPControlParameters Void)
mipControlPtr -> do
    Ptr (MIPControlParameters Void) -> IO ()
forall a. Ptr (MIPControlParameters a) -> IO ()
glp_init_iocp Ptr (MIPControlParameters Void)
mipControlPtr
    Ptr (MIPControlParameters Void) -> IO (MIPControlParameters Void)
forall a. Storable a => Ptr a -> IO a
peek Ptr (MIPControlParameters Void)
mipControlPtr

  -- Turn on presolve. Users can simply turn this off before the first
  -- optimization call if they desire.
  MIPControlParameters Void -> IO (MIPControlParameters Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MIPControlParameters Void
params {iocpPresolve :: GlpkPresolve
iocpPresolve = GlpkPresolve
glpkPresolveOn})

runGlpk' :: Glpk a -> IO a
runGlpk' :: forall a. Glpk a -> IO a
runGlpk' Glpk a
glpk = do
  -- Turn off terminal output. If we don't, users won't be able to
  -- inhibit terminal output generated from our setup.
  GlpkControl
_ <- GlpkControl -> IO GlpkControl
glp_term_out GlpkControl
glpkOff

  IO (Ptr Problem)
-> (Ptr Problem -> IO ()) -> (Ptr Problem -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO (Ptr Problem)
glp_create_prob Ptr Problem -> IO ()
glp_delete_prob ((Ptr Problem -> IO a) -> IO a) -> (Ptr Problem -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Problem
problem -> do
    GlpkEnv
env <-
      Ptr Problem
-> IORef [GlpkVariable]
-> IORef Integer
-> IORef [GlpkConstraint]
-> IORef Integer
-> IORef SimplexMethodControlParameters
-> IORef (MIPControlParameters Void)
-> IORef (Maybe SolveType)
-> GlpkEnv
GlpkEnv Ptr Problem
problem
        (IORef [GlpkVariable]
 -> IORef Integer
 -> IORef [GlpkConstraint]
 -> IORef Integer
 -> IORef SimplexMethodControlParameters
 -> IORef (MIPControlParameters Void)
 -> IORef (Maybe SolveType)
 -> GlpkEnv)
-> IO (IORef [GlpkVariable])
-> IO
     (IORef Integer
      -> IORef [GlpkConstraint]
      -> IORef Integer
      -> IORef SimplexMethodControlParameters
      -> IORef (MIPControlParameters Void)
      -> IORef (Maybe SolveType)
      -> GlpkEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlpkVariable] -> IO (IORef [GlpkVariable])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
        IO
  (IORef Integer
   -> IORef [GlpkConstraint]
   -> IORef Integer
   -> IORef SimplexMethodControlParameters
   -> IORef (MIPControlParameters Void)
   -> IORef (Maybe SolveType)
   -> GlpkEnv)
-> IO (IORef Integer)
-> IO
     (IORef [GlpkConstraint]
      -> IORef Integer
      -> IORef SimplexMethodControlParameters
      -> IORef (MIPControlParameters Void)
      -> IORef (Maybe SolveType)
      -> GlpkEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> IO (IORef Integer)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Integer
0
        IO
  (IORef [GlpkConstraint]
   -> IORef Integer
   -> IORef SimplexMethodControlParameters
   -> IORef (MIPControlParameters Void)
   -> IORef (Maybe SolveType)
   -> GlpkEnv)
-> IO (IORef [GlpkConstraint])
-> IO
     (IORef Integer
      -> IORef SimplexMethodControlParameters
      -> IORef (MIPControlParameters Void)
      -> IORef (Maybe SolveType)
      -> GlpkEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [GlpkConstraint] -> IO (IORef [GlpkConstraint])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
        IO
  (IORef Integer
   -> IORef SimplexMethodControlParameters
   -> IORef (MIPControlParameters Void)
   -> IORef (Maybe SolveType)
   -> GlpkEnv)
-> IO (IORef Integer)
-> IO
     (IORef SimplexMethodControlParameters
      -> IORef (MIPControlParameters Void)
      -> IORef (Maybe SolveType)
      -> GlpkEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> IO (IORef Integer)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Integer
0
        IO
  (IORef SimplexMethodControlParameters
   -> IORef (MIPControlParameters Void)
   -> IORef (Maybe SolveType)
   -> GlpkEnv)
-> IO (IORef SimplexMethodControlParameters)
-> IO
     (IORef (MIPControlParameters Void)
      -> IORef (Maybe SolveType) -> GlpkEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO SimplexMethodControlParameters
getDefaultSimplexControlParameters IO SimplexMethodControlParameters
-> (SimplexMethodControlParameters
    -> IO (IORef SimplexMethodControlParameters))
-> IO (IORef SimplexMethodControlParameters)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SimplexMethodControlParameters
-> IO (IORef SimplexMethodControlParameters)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef)
        IO
  (IORef (MIPControlParameters Void)
   -> IORef (Maybe SolveType) -> GlpkEnv)
-> IO (IORef (MIPControlParameters Void))
-> IO (IORef (Maybe SolveType) -> GlpkEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (MIPControlParameters Void)
getDefaultMIPControlParameters IO (MIPControlParameters Void)
-> (MIPControlParameters Void
    -> IO (IORef (MIPControlParameters Void)))
-> IO (IORef (MIPControlParameters Void))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MIPControlParameters Void -> IO (IORef (MIPControlParameters Void))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef)
        IO (IORef (Maybe SolveType) -> GlpkEnv)
-> IO (IORef (Maybe SolveType)) -> IO GlpkEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SolveType -> IO (IORef (Maybe SolveType))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe SolveType
forall a. Maybe a
Nothing

    ReaderT GlpkEnv IO a -> GlpkEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Glpk a -> ReaderT GlpkEnv IO a
forall (m :: * -> *) a. GlpkT m a -> ReaderT GlpkEnv m a
_runGlpk Glpk a
glpk) GlpkEnv
env

data SolveType = LP | MIP | InteriorPoint

-- | Retrieve a component of the Glpk context
askGlpk :: Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk :: forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk = ((GlpkEnv -> a) -> GlpkT m GlpkEnv -> GlpkT m a)
-> GlpkT m GlpkEnv -> (GlpkEnv -> a) -> GlpkT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GlpkEnv -> a) -> GlpkT m GlpkEnv -> GlpkT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReaderT GlpkEnv m GlpkEnv -> GlpkT m GlpkEnv
forall (m :: * -> *) a. ReaderT GlpkEnv m a -> GlpkT m a
GlpkT ReaderT GlpkEnv m GlpkEnv
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask)

-- | The underlying Glpk problem pointer
askProblem :: Monad m => GlpkT m (Ptr Problem)
askProblem :: forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem = (GlpkEnv -> Ptr Problem) -> GlpkT m (Ptr Problem)
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> Ptr Problem
_glpkEnvProblem

-- | All registered variables
askVariablesRef :: Glpk (IORef [GlpkVariable])
askVariablesRef :: Glpk (IORef [GlpkVariable])
askVariablesRef = (GlpkEnv -> IORef [GlpkVariable]) -> Glpk (IORef [GlpkVariable])
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef [GlpkVariable]
_glpkVariables

-- | All registered constraints
askConstraintsRef :: Glpk (IORef [GlpkConstraint])
askConstraintsRef :: Glpk (IORef [GlpkConstraint])
askConstraintsRef = (GlpkEnv -> IORef [GlpkConstraint])
-> Glpk (IORef [GlpkConstraint])
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef [GlpkConstraint]
_glpkConstraints

-- | Note that a new row or column has been added to the to the problem.
register :: GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
register :: forall a. GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
register GlpkPtr a
newPtr IORef [GlpkPtr a]
ptrRefs = do
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ IORef [GlpkPtr a] -> ([GlpkPtr a] -> [GlpkPtr a]) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef [GlpkPtr a]
ptrRefs (GlpkPtr a
newPtr GlpkPtr a -> [GlpkPtr a] -> [GlpkPtr a]
forall a. a -> [a] -> [a]
:)

-- | Note that a row or column has been deleted from the problem, and
-- update row or column indices accordingly.
unregister :: Integral a => GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
unregister :: forall a. Integral a => GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
unregister GlpkPtr a
deletedPtr IORef [GlpkPtr a]
ptrsRef =
  let update :: a -> GlpkPtr a -> m ()
update a
removed (GlpkPtr Integer
_ IORef a
ptr IORef Bool
_) = do
        a
z <- IORef a -> m a
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef a
ptr
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
removed) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          IORef a -> (a -> a) -> m ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef a
ptr a -> a
forall a. Enum a => a -> a
pred
   in IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ do
        -- If the reference was already deleted, do nothing
        Bool
deleted <- IORef Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (GlpkPtr a -> IORef Bool
forall a. GlpkPtr a -> IORef Bool
_glpkPtrDeleted GlpkPtr a
deletedPtr)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
deleted (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          -- Mark deletion
          IORef Bool -> Bool -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef (GlpkPtr a -> IORef Bool
forall a. GlpkPtr a -> IORef Bool
_glpkPtrDeleted GlpkPtr a
deletedPtr) Bool
True

          -- Remove the element to be unregistered
          IORef [GlpkPtr a] -> ([GlpkPtr a] -> [GlpkPtr a]) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef [GlpkPtr a]
ptrsRef ((GlpkPtr a -> Bool) -> [GlpkPtr a] -> [GlpkPtr a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= GlpkPtr a -> Integer
forall a. GlpkPtr a -> Integer
_glpkPtrId GlpkPtr a
deletedPtr) (Integer -> Bool) -> (GlpkPtr a -> Integer) -> GlpkPtr a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlpkPtr a -> Integer
forall a. GlpkPtr a -> Integer
_glpkPtrId))

          -- Modify the referenced values that were greater than the
          -- referenced element.
          a
deletedId <- IORef a -> IO a
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (GlpkPtr a -> IORef a
forall a. GlpkPtr a -> IORef a
_glpkPtrRef GlpkPtr a
deletedPtr)
          [GlpkPtr a]
ptrs <- IORef [GlpkPtr a] -> IO [GlpkPtr a]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [GlpkPtr a]
ptrsRef
          (GlpkPtr a -> IO ()) -> [GlpkPtr a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a -> GlpkPtr a -> IO ()
forall {m :: * -> *} {a}.
(MonadIO m, Ord a, Enum a) =>
a -> GlpkPtr a -> m ()
update a
deletedId) [GlpkPtr a]
ptrs

readColumn :: GlpkVariable -> Glpk Column
readColumn :: GlpkVariable -> Glpk Column
readColumn = IO Column -> Glpk Column
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Column -> Glpk Column)
-> (GlpkVariable -> IO Column) -> GlpkVariable -> Glpk Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Column -> IO Column
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (IORef Column -> IO Column)
-> (GlpkVariable -> IORef Column) -> GlpkVariable -> IO Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlpkVariable -> IORef Column
forall a. GlpkPtr a -> IORef a
_glpkPtrRef

readRow :: GlpkConstraint -> Glpk Row
readRow :: GlpkConstraint -> Glpk Row
readRow = IO Row -> Glpk Row
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Row -> Glpk Row)
-> (GlpkConstraint -> IO Row) -> GlpkConstraint -> Glpk Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Row -> IO Row
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (IORef Row -> IO Row)
-> (GlpkConstraint -> IORef Row) -> GlpkConstraint -> IO Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlpkConstraint -> IORef Row
forall a. GlpkPtr a -> IORef a
_glpkPtrRef

addVariable' :: Glpk GlpkVariable
addVariable' :: Glpk GlpkVariable
addVariable' = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  GlpkVariable
variable <- IO GlpkVariable -> Glpk GlpkVariable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlpkVariable -> Glpk GlpkVariable)
-> IO GlpkVariable -> Glpk GlpkVariable
forall a b. (a -> b) -> a -> b
$ do
    Column
column <- Ptr Problem -> CInt -> IO Column
glp_add_cols Ptr Problem
problem CInt
1
    Ptr Problem
-> Column -> GlpkConstraintType -> CDouble -> CDouble -> IO ()
glp_set_col_bnds Ptr Problem
problem Column
column GlpkConstraintType
glpkFree CDouble
0 CDouble
0
    Integer -> IORef Column -> IORef Bool -> GlpkVariable
forall a. Integer -> IORef a -> IORef Bool -> GlpkPtr a
GlpkPtr (Column -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Column
column)
      (IORef Column -> IORef Bool -> GlpkVariable)
-> IO (IORef Column) -> IO (IORef Bool -> GlpkVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Column -> IO (IORef Column)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Column
column
      IO (IORef Bool -> GlpkVariable)
-> IO (IORef Bool) -> IO GlpkVariable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Bool
False

  Glpk (IORef [GlpkVariable])
askVariablesRef Glpk (IORef [GlpkVariable])
-> (IORef [GlpkVariable] -> Glpk ()) -> Glpk ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlpkVariable -> IORef [GlpkVariable] -> Glpk ()
forall a. GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
register GlpkVariable
variable
  GlpkVariable -> Text -> Glpk ()
setVariableName' GlpkVariable
variable (GlpkVariable -> Text
defaultVariableName GlpkVariable
variable)
  GlpkVariable -> Glpk GlpkVariable
forall (f :: * -> *) a. Applicative f => a -> f a
pure GlpkVariable
variable

defaultVariableName :: GlpkVariable -> T.Text
defaultVariableName :: GlpkVariable -> Text
defaultVariableName (GlpkPtr Integer
x IORef Column
_ IORef Bool
_) = Text
"x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
x)

defaultConstraintName :: GlpkConstraint -> T.Text
defaultConstraintName :: GlpkConstraint -> Text
defaultConstraintName (GlpkPtr Integer
x IORef Row
_ IORef Bool
_) = Text
"c" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
x)

setVariableName' :: GlpkVariable -> T.Text -> Glpk ()
setVariableName' :: GlpkVariable -> Text -> Glpk ()
setVariableName' GlpkVariable
variable Text
name = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
withCText Text
name (Ptr Problem -> Column -> CString -> IO ()
glp_set_col_name Ptr Problem
problem Column
column)

getVariableName' :: GlpkVariable -> Glpk T.Text
getVariableName' :: GlpkVariable -> Glpk Text
getVariableName' GlpkVariable
variable = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
  String
name <- IO String -> GlpkT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> GlpkT IO String) -> IO String -> GlpkT IO String
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> Column -> IO CString
glp_get_col_name Ptr Problem
problem Column
column IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
  Text -> Glpk Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name)

deleteVariable' :: GlpkVariable -> Glpk ()
deleteVariable' :: GlpkVariable -> Glpk ()
deleteVariable' GlpkVariable
variable = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ [Column] -> (GlpkArray Column -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (GlpkArray a -> IO b) -> IO b
allocaGlpkArray [Column
column] (Ptr Problem -> CInt -> GlpkArray Column -> IO ()
glp_del_cols Ptr Problem
problem CInt
1)
  Glpk (IORef [GlpkVariable])
askVariablesRef Glpk (IORef [GlpkVariable])
-> (IORef [GlpkVariable] -> Glpk ()) -> Glpk ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlpkVariable -> IORef [GlpkVariable] -> Glpk ()
forall a. Integral a => GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
unregister GlpkVariable
variable

addConstraint' :: Inequality (Expr GlpkVariable) -> Glpk GlpkConstraint
addConstraint' :: Inequality (Expr GlpkVariable) -> Glpk GlpkConstraint
addConstraint' (Inequality Ordering
ordering Expr GlpkVariable
lhs Expr GlpkVariable
rhs) =
  let LinExpr [(Double, GlpkVariable)]
terms Double
constant = Expr GlpkVariable -> Expr GlpkVariable
forall a b. (Num a, Ord b) => LinExpr a b -> LinExpr a b
simplify (Expr GlpkVariable
lhs Expr GlpkVariable -> Expr GlpkVariable -> Expr GlpkVariable
forall a b. Num a => LinExpr a b -> LinExpr a b -> LinExpr a b
.-. Expr GlpkVariable
rhs) :: Expr GlpkVariable

      constraintType :: GlpkConstraintType
      constraintType :: GlpkConstraintType
constraintType = case Ordering
ordering of
        Ordering
LT -> GlpkConstraintType
glpkLT
        Ordering
GT -> GlpkConstraintType
glpkGT
        Ordering
EQ -> GlpkConstraintType
glpkFixed

      constraintRhs :: CDouble
      constraintRhs :: CDouble
constraintRhs = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double
forall a. Num a => a -> a
negate Double
constant)

      numVars :: CInt
      numVars :: CInt
numVars = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Double, GlpkVariable)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Double, GlpkVariable)]
terms)

      variables :: [GlpkVariable]
      variables :: [GlpkVariable]
variables = ((Double, GlpkVariable) -> GlpkVariable)
-> [(Double, GlpkVariable)] -> [GlpkVariable]
forall a b. (a -> b) -> [a] -> [b]
map (Double, GlpkVariable) -> GlpkVariable
forall a b. (a, b) -> b
snd [(Double, GlpkVariable)]
terms

      coefficients :: [CDouble]
      coefficients :: [CDouble]
coefficients = ((Double, GlpkVariable) -> CDouble)
-> [(Double, GlpkVariable)] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> ((Double, GlpkVariable) -> Double)
-> (Double, GlpkVariable)
-> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, GlpkVariable) -> Double
forall a b. (a, b) -> a
fst) [(Double, GlpkVariable)]
terms
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
        [Column]
columns <- (GlpkVariable -> Glpk Column)
-> [GlpkVariable] -> GlpkT IO [Column]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GlpkVariable -> Glpk Column
readColumn [GlpkVariable]
variables
        GlpkConstraint
constraintPtr <- IO GlpkConstraint -> Glpk GlpkConstraint
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlpkConstraint -> Glpk GlpkConstraint)
-> IO GlpkConstraint -> Glpk GlpkConstraint
forall a b. (a -> b) -> a -> b
$ do
          Row
row <- Ptr Problem -> CInt -> IO Row
glp_add_rows Ptr Problem
problem CInt
1
          [Column] -> (GlpkArray Column -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (GlpkArray a -> IO b) -> IO b
allocaGlpkArray [Column]
columns ((GlpkArray Column -> IO ()) -> IO ())
-> (GlpkArray Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GlpkArray Column
columnArr ->
            [CDouble] -> (GlpkArray CDouble -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (GlpkArray a -> IO b) -> IO b
allocaGlpkArray [CDouble]
coefficients ((GlpkArray CDouble -> IO ()) -> IO ())
-> (GlpkArray CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GlpkArray CDouble
coefficientArr -> do
              Ptr Problem
-> Row -> GlpkConstraintType -> CDouble -> CDouble -> IO ()
glp_set_row_bnds Ptr Problem
problem Row
row GlpkConstraintType
constraintType CDouble
constraintRhs CDouble
constraintRhs
              Ptr Problem
-> Row -> CInt -> GlpkArray Column -> GlpkArray CDouble -> IO ()
glp_set_mat_row Ptr Problem
problem Row
row CInt
numVars GlpkArray Column
columnArr GlpkArray CDouble
coefficientArr

          Integer -> IORef Row -> IORef Bool -> GlpkConstraint
forall a. Integer -> IORef a -> IORef Bool -> GlpkPtr a
GlpkPtr (Row -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Row
row)
            (IORef Row -> IORef Bool -> GlpkConstraint)
-> IO (IORef Row) -> IO (IORef Bool -> GlpkConstraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row -> IO (IORef Row)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Row
row
            IO (IORef Bool -> GlpkConstraint)
-> IO (IORef Bool) -> IO GlpkConstraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Bool
False

        Glpk (IORef [GlpkConstraint])
askConstraintsRef Glpk (IORef [GlpkConstraint])
-> (IORef [GlpkConstraint] -> Glpk ()) -> Glpk ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlpkConstraint -> IORef [GlpkConstraint] -> Glpk ()
forall a. GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
register GlpkConstraint
constraintPtr
        GlpkConstraint -> Text -> Glpk ()
setConstraintName' GlpkConstraint
constraintPtr (GlpkConstraint -> Text
defaultConstraintName GlpkConstraint
constraintPtr)
        GlpkConstraint -> Glpk GlpkConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure GlpkConstraint
constraintPtr

setConstraintName' :: GlpkConstraint -> T.Text -> Glpk ()
setConstraintName' :: GlpkConstraint -> Text -> Glpk ()
setConstraintName' GlpkConstraint
constraintId Text
name = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Row
row <- GlpkConstraint -> Glpk Row
readRow GlpkConstraint
constraintId
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
withCText Text
name (Ptr Problem -> Row -> CString -> IO ()
glp_set_row_name Ptr Problem
problem Row
row)

getConstraintName' :: GlpkConstraint -> Glpk T.Text
getConstraintName' :: GlpkConstraint -> Glpk Text
getConstraintName' GlpkConstraint
constraint = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Row
row <- GlpkConstraint -> Glpk Row
readRow GlpkConstraint
constraint
  String
name <- IO String -> GlpkT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> GlpkT IO String) -> IO String -> GlpkT IO String
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> Row -> IO CString
glp_get_row_name Ptr Problem
problem Row
row IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
  Text -> Glpk Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name)

getDualValue :: GlpkConstraint -> Glpk Double
getDualValue :: GlpkConstraint -> Glpk Double
getDualValue GlpkConstraint
constraint = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Row
row <- GlpkConstraint -> Glpk Row
readRow GlpkConstraint
constraint
  (CDouble -> Double) -> GlpkT IO CDouble -> Glpk Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (GlpkT IO CDouble -> Glpk Double)
-> (IO CDouble -> GlpkT IO CDouble) -> IO CDouble -> Glpk Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CDouble -> GlpkT IO CDouble
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CDouble -> Glpk Double) -> IO CDouble -> Glpk Double
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> Row -> IO CDouble
glp_get_row_dual Ptr Problem
problem Row
row

deleteConstraint' :: GlpkConstraint -> Glpk ()
deleteConstraint' :: GlpkConstraint -> Glpk ()
deleteConstraint' GlpkConstraint
constraint = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Row
row <- GlpkConstraint -> Glpk Row
readRow GlpkConstraint
constraint
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ [Row] -> (GlpkArray Row -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (GlpkArray a -> IO b) -> IO b
allocaGlpkArray [Row
row] (Ptr Problem -> CInt -> GlpkArray Row -> IO ()
glp_del_rows Ptr Problem
problem CInt
1)
  Glpk (IORef [GlpkConstraint])
askConstraintsRef Glpk (IORef [GlpkConstraint])
-> (IORef [GlpkConstraint] -> Glpk ()) -> Glpk ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlpkConstraint -> IORef [GlpkConstraint] -> Glpk ()
forall a. Integral a => GlpkPtr a -> IORef [GlpkPtr a] -> Glpk ()
unregister GlpkConstraint
constraint

addObjective' :: Expr GlpkVariable -> Glpk GlpkObjective
addObjective' :: Expr GlpkVariable -> Glpk GlpkObjective
addObjective' Expr GlpkVariable
expr =
  let LinExpr [(Double, GlpkVariable)]
terms Double
constant = Expr GlpkVariable -> Expr GlpkVariable
forall a b. (Num a, Ord b) => LinExpr a b -> LinExpr a b
simplify Expr GlpkVariable
expr
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem

        -- Set the constant term
        IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> Column -> CDouble -> IO ()
glp_set_obj_coef Ptr Problem
problem (CInt -> Column
forall a. CInt -> GlpkInt a
GlpkInt CInt
0) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
constant)

        -- Set the variable terms
        [(Double, GlpkVariable)]
-> ((Double, GlpkVariable) -> Glpk ()) -> Glpk ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Double, GlpkVariable)]
terms (((Double, GlpkVariable) -> Glpk ()) -> Glpk ())
-> ((Double, GlpkVariable) -> Glpk ()) -> Glpk ()
forall a b. (a -> b) -> a -> b
$ \(Double
coef, GlpkVariable
variable) -> do
          Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
          IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> Column -> CDouble -> IO ()
glp_set_obj_coef Ptr Problem
problem Column
column (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
coef)

        GlpkObjective -> Glpk GlpkObjective
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> GlpkObjective
GlpkObjective ())

-- | Delete an objective
--
-- There is nothing to actually delete, so we just set a zero objective
deleteObjective' :: GlpkObjective -> Glpk ()
deleteObjective' :: GlpkObjective -> Glpk ()
deleteObjective' GlpkObjective
_ = Glpk GlpkObjective -> Glpk ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Expr GlpkVariable -> Glpk GlpkObjective
addObjective' Expr GlpkVariable
forall a. Monoid a => a
mempty)

getObjectiveName' :: GlpkObjective -> Glpk T.Text
getObjectiveName' :: GlpkObjective -> Glpk Text
getObjectiveName' GlpkObjective
_ = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  String
name <- IO String -> GlpkT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> GlpkT IO String) -> IO String -> GlpkT IO String
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> IO CString
glp_get_obj_name Ptr Problem
problem IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
  Text -> Glpk Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name)

setObjectiveName' :: GlpkObjective -> T.Text -> Glpk ()
setObjectiveName' :: GlpkObjective -> Text -> Glpk ()
setObjectiveName' GlpkObjective
_ Text
name = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
withCText Text
name (Ptr Problem -> CString -> IO ()
glp_set_obj_name Ptr Problem
problem)

getSense' :: GlpkObjective -> Glpk Sense
getSense' :: GlpkObjective -> Glpk Sense
getSense' GlpkObjective
_ = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  GlpkDirection
direction <- IO GlpkDirection -> GlpkT IO GlpkDirection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlpkDirection -> GlpkT IO GlpkDirection)
-> IO GlpkDirection -> GlpkT IO GlpkDirection
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> IO GlpkDirection
glp_get_obj_dir Ptr Problem
problem
  if GlpkDirection
direction GlpkDirection -> GlpkDirection -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkDirection
glpkMin
    then Sense -> Glpk Sense
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sense
Minimization
    else Sense -> Glpk Sense
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sense
Maximization

setSense' :: GlpkObjective -> Sense -> Glpk ()
setSense' :: GlpkObjective -> Sense -> Glpk ()
setSense' GlpkObjective
_ Sense
sense =
  let direction :: GlpkDirection
direction = case Sense
sense of
        Sense
Minimization -> GlpkDirection
glpkMin
        Sense
Maximization -> GlpkDirection
glpkMax
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
        IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> GlpkDirection -> IO ()
glp_set_obj_dir Ptr Problem
problem GlpkDirection
direction

getObjectiveValue' :: GlpkObjective -> Glpk Double
getObjectiveValue' :: GlpkObjective -> Glpk Double
getObjectiveValue' GlpkObjective
_ = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  IORef (Maybe SolveType)
lastSolveRef <- (GlpkEnv -> IORef (Maybe SolveType))
-> GlpkT IO (IORef (Maybe SolveType))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (Maybe SolveType)
_glpkLastSolveType
  Maybe SolveType
lastSolve <- (IO (Maybe SolveType) -> GlpkT IO (Maybe SolveType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SolveType) -> GlpkT IO (Maybe SolveType))
-> (IORef (Maybe SolveType) -> IO (Maybe SolveType))
-> IORef (Maybe SolveType)
-> GlpkT IO (Maybe SolveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Maybe SolveType) -> IO (Maybe SolveType)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef) IORef (Maybe SolveType)
lastSolveRef
  (CDouble -> Double) -> GlpkT IO CDouble -> Glpk Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (GlpkT IO CDouble -> Glpk Double)
-> (IO CDouble -> GlpkT IO CDouble) -> IO CDouble -> Glpk Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CDouble -> GlpkT IO CDouble
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CDouble -> Glpk Double) -> IO CDouble -> Glpk Double
forall a b. (a -> b) -> a -> b
$ case Maybe SolveType
lastSolve of
    Just SolveType
MIP -> Ptr Problem -> IO CDouble
glp_mip_obj_val Ptr Problem
problem
    Just SolveType
LP -> Ptr Problem -> IO CDouble
glp_get_obj_val Ptr Problem
problem
    Just SolveType
InteriorPoint -> Ptr Problem -> IO CDouble
glp_ipt_obj_val Ptr Problem
problem
    Maybe SolveType
Nothing -> Ptr Problem -> IO CDouble
glp_get_obj_val Ptr Problem
problem -- There's been no solve, so who cares

optimizeLP' :: Glpk SolutionStatus
optimizeLP' :: Glpk SolutionStatus
optimizeLP' = do
  -- Note that we've run an LP solve
  IORef (Maybe SolveType)
solveTypeRef <- (GlpkEnv -> IORef (Maybe SolveType))
-> GlpkT IO (IORef (Maybe SolveType))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (Maybe SolveType)
_glpkLastSolveType
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe SolveType) -> Maybe SolveType -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe SolveType)
solveTypeRef (SolveType -> Maybe SolveType
forall a. a -> Maybe a
Just SolveType
LP)

  -- Run Simplex
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  IORef SimplexMethodControlParameters
controlRef <- (GlpkEnv -> IORef SimplexMethodControlParameters)
-> GlpkT IO (IORef SimplexMethodControlParameters)
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef SimplexMethodControlParameters
_glpkSimplexControl
  IO SolutionStatus -> Glpk SolutionStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SolutionStatus -> Glpk SolutionStatus)
-> IO SolutionStatus -> Glpk SolutionStatus
forall a b. (a -> b) -> a -> b
$ do
    SimplexMethodControlParameters
control <- IORef SimplexMethodControlParameters
-> IO SimplexMethodControlParameters
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef SimplexMethodControlParameters
controlRef
    (Ptr SimplexMethodControlParameters -> IO SolutionStatus)
-> IO SolutionStatus
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr SimplexMethodControlParameters -> IO SolutionStatus)
 -> IO SolutionStatus)
-> (Ptr SimplexMethodControlParameters -> IO SolutionStatus)
-> IO SolutionStatus
forall a b. (a -> b) -> a -> b
$ \Ptr SimplexMethodControlParameters
controlPtr -> do
      Ptr SimplexMethodControlParameters
-> SimplexMethodControlParameters -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SimplexMethodControlParameters
controlPtr SimplexMethodControlParameters
control
      GlpkSimplexStatus
_ <- Ptr Problem
-> Ptr SimplexMethodControlParameters -> IO GlpkSimplexStatus
glp_simplex Ptr Problem
problem Ptr SimplexMethodControlParameters
controlPtr
      Ptr Problem -> IO GlpkSolutionStatus
glp_get_status Ptr Problem
problem IO GlpkSolutionStatus
-> (GlpkSolutionStatus -> SolutionStatus) -> IO SolutionStatus
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Data.Functor.<&> GlpkSolutionStatus -> SolutionStatus
solutionStatus

optimizeIP' :: Glpk SolutionStatus
optimizeIP' :: Glpk SolutionStatus
optimizeIP' = do
  -- Note that we've run a MIP solve
  IORef (Maybe SolveType)
solveTypeRef <- (GlpkEnv -> IORef (Maybe SolveType))
-> GlpkT IO (IORef (Maybe SolveType))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (Maybe SolveType)
_glpkLastSolveType
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe SolveType) -> Maybe SolveType -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe SolveType)
solveTypeRef (SolveType -> Maybe SolveType
forall a. a -> Maybe a
Just SolveType
MIP)

  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  IORef (MIPControlParameters Void)
controlRef <- (GlpkEnv -> IORef (MIPControlParameters Void))
-> GlpkT IO (IORef (MIPControlParameters Void))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (MIPControlParameters Void)
_glpkMIPControl
  IO SolutionStatus -> Glpk SolutionStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SolutionStatus -> Glpk SolutionStatus)
-> IO SolutionStatus -> Glpk SolutionStatus
forall a b. (a -> b) -> a -> b
$ do
    MIPControlParameters Void
control <- IORef (MIPControlParameters Void) -> IO (MIPControlParameters Void)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (MIPControlParameters Void)
controlRef
    (Ptr (MIPControlParameters Void) -> IO SolutionStatus)
-> IO SolutionStatus
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (MIPControlParameters Void) -> IO SolutionStatus)
 -> IO SolutionStatus)
-> (Ptr (MIPControlParameters Void) -> IO SolutionStatus)
-> IO SolutionStatus
forall a b. (a -> b) -> a -> b
$ \Ptr (MIPControlParameters Void)
controlPtr -> do
      Ptr (MIPControlParameters Void)
-> MIPControlParameters Void -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (MIPControlParameters Void)
controlPtr MIPControlParameters Void
control
      GlpkMIPStatus
_ <- Ptr Problem -> Ptr (MIPControlParameters Void) -> IO GlpkMIPStatus
forall a.
Ptr Problem -> Ptr (MIPControlParameters a) -> IO GlpkMIPStatus
glp_intopt Ptr Problem
problem Ptr (MIPControlParameters Void)
controlPtr
      Ptr Problem -> IO GlpkSolutionStatus
glp_mip_status Ptr Problem
problem IO GlpkSolutionStatus
-> (GlpkSolutionStatus -> SolutionStatus) -> IO SolutionStatus
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Data.Functor.<&> GlpkSolutionStatus -> SolutionStatus
solutionStatus

setVariableBounds' :: GlpkVariable -> Bounds -> Glpk ()
setVariableBounds' :: GlpkVariable -> Bounds -> Glpk ()
setVariableBounds' GlpkVariable
variable Bounds
bounds =
  let (GlpkConstraintType
boundType, CDouble
cLow, CDouble
cHigh) = case Bounds
bounds of
        Bounds
Free -> (GlpkConstraintType
glpkFree, CDouble
0, CDouble
0)
        Bounds
NonNegativeReals -> (GlpkConstraintType
glpkGT, CDouble
0, CDouble
0)
        Bounds
NonPositiveReals -> (GlpkConstraintType
glpkLT, CDouble
0, CDouble
0)
        Interval Double
low Double
high -> (GlpkConstraintType
glpkBounded, Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
low, Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
high)
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
        Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
        IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Ptr Problem
-> Column -> GlpkConstraintType -> CDouble -> CDouble -> IO ()
glp_set_col_bnds Ptr Problem
problem Column
column GlpkConstraintType
boundType CDouble
cLow CDouble
cHigh

getVariableBounds' :: GlpkVariable -> Glpk Bounds
getVariableBounds' :: GlpkVariable -> Glpk Bounds
getVariableBounds' GlpkVariable
variable =
  let boundsFor :: CDouble -> CDouble -> Bounds
boundsFor CDouble
lb CDouble
ub
        | CDouble
lb CDouble -> CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== - CDouble
maxCDouble Bool -> Bool -> Bool
&& CDouble
ub CDouble -> CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== CDouble
maxCDouble = Bounds
Free
        | CDouble
lb CDouble -> CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== - CDouble
maxCDouble Bool -> Bool -> Bool
&& CDouble
ub CDouble -> CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== CDouble
0.0 = Bounds
NonPositiveReals
        | CDouble
lb CDouble -> CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== CDouble
0.0 Bool -> Bool -> Bool
&& CDouble
ub CDouble -> CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== CDouble
maxCDouble = Bounds
NonNegativeReals
        | Bool
otherwise = Double -> Double -> Bounds
Interval Double
lb' Double
ub'
        where
          lb' :: Double
lb' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
lb
          ub' :: Double
ub' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
ub
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
        Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
        CDouble
lb <- IO CDouble -> GlpkT IO CDouble
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Problem -> Column -> IO CDouble
glp_get_col_lb Ptr Problem
problem Column
column)
        CDouble
ub <- IO CDouble -> GlpkT IO CDouble
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Problem -> Column -> IO CDouble
glp_get_col_ub Ptr Problem
problem Column
column)
        Bounds -> Glpk Bounds
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> CDouble -> Bounds
boundsFor CDouble
lb CDouble
ub)

setVariableDomain' :: GlpkVariable -> Domain -> Glpk ()
setVariableDomain' :: GlpkVariable -> Domain -> Glpk ()
setVariableDomain' GlpkVariable
variable Domain
domain =
  let vType :: GlpkVariableType
vType = case Domain
domain of
        Domain
Continuous -> GlpkVariableType
glpkContinuous
        Domain
Integer -> GlpkVariableType
glpkInteger
        Domain
Binary -> GlpkVariableType
glpkBinary
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
        Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
        IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Glpk ()) -> IO () -> Glpk ()
forall a b. (a -> b) -> a -> b
$ Ptr Problem -> Column -> GlpkVariableType -> IO ()
glp_set_col_kind Ptr Problem
problem Column
column GlpkVariableType
vType

getVariableDomain' :: GlpkVariable -> Glpk Domain
getVariableDomain' :: GlpkVariable -> Glpk Domain
getVariableDomain' GlpkVariable
variable =
  let getDomain' :: GlpkVariableType -> Glpk Domain
      getDomain' :: GlpkVariableType -> Glpk Domain
getDomain' GlpkVariableType
vType | GlpkVariableType
vType GlpkVariableType -> GlpkVariableType -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkVariableType
glpkContinuous = Domain -> Glpk Domain
forall (m :: * -> *) a. Monad m => a -> m a
return Domain
Continuous
      getDomain' GlpkVariableType
vType | GlpkVariableType
vType GlpkVariableType -> GlpkVariableType -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkVariableType
glpkInteger = Domain -> Glpk Domain
forall (m :: * -> *) a. Monad m => a -> m a
return Domain
Integer
      getDomain' GlpkVariableType
vType
        | GlpkVariableType
vType GlpkVariableType -> GlpkVariableType -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkVariableType
glpkBinary = Domain -> Glpk Domain
forall (m :: * -> *) a. Monad m => a -> m a
return Domain
Binary
        | Bool
otherwise = GlpkException -> Glpk Domain
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO GlpkException
unknownCode
        where
          typeName :: Text
typeName = String -> Text
T.pack (String -> Text)
-> (GlpkVariableType -> String) -> GlpkVariableType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String)
-> (GlpkVariableType -> TypeRep) -> GlpkVariableType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlpkVariableType -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (GlpkVariableType -> Text) -> GlpkVariableType -> Text
forall a b. (a -> b) -> a -> b
$ GlpkVariableType
vType
          GlpkVariableType CInt
code = GlpkVariableType
vType
          unknownCode :: GlpkException
unknownCode = Text -> CInt -> GlpkException
UnknownCode Text
typeName CInt
code
   in do
        Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
        Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
        GlpkVariableType -> Glpk Domain
getDomain' (GlpkVariableType -> Glpk Domain)
-> GlpkT IO GlpkVariableType -> Glpk Domain
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO GlpkVariableType -> GlpkT IO GlpkVariableType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr Problem -> Column -> IO GlpkVariableType
glp_get_col_kind Ptr Problem
problem Column
column)

getVariableValue' :: GlpkVariable -> Glpk Double
getVariableValue' :: GlpkVariable -> Glpk Double
getVariableValue' GlpkVariable
variable = do
  IORef (Maybe SolveType)
lastSolveRef <- (GlpkEnv -> IORef (Maybe SolveType))
-> GlpkT IO (IORef (Maybe SolveType))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (Maybe SolveType)
_glpkLastSolveType
  Maybe SolveType
lastSolve <- (IO (Maybe SolveType) -> GlpkT IO (Maybe SolveType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SolveType) -> GlpkT IO (Maybe SolveType))
-> (IORef (Maybe SolveType) -> IO (Maybe SolveType))
-> IORef (Maybe SolveType)
-> GlpkT IO (Maybe SolveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Maybe SolveType) -> IO (Maybe SolveType)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef) IORef (Maybe SolveType)
lastSolveRef

  let method :: Ptr Problem -> Column -> IO CDouble
method = case Maybe SolveType
lastSolve of
        Maybe SolveType
Nothing -> Ptr Problem -> Column -> IO CDouble
glp_get_col_prim
        Just SolveType
LP -> Ptr Problem -> Column -> IO CDouble
glp_get_col_prim
        Just SolveType
MIP -> Ptr Problem -> Column -> IO CDouble
glp_mip_col_val
        Just SolveType
InteriorPoint -> Ptr Problem -> Column -> IO CDouble
glp_ipt_col_prim

  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  Column
column <- GlpkVariable -> Glpk Column
readColumn GlpkVariable
variable
  IO Double -> Glpk Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Glpk Double) -> IO Double -> Glpk Double
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Problem -> Column -> IO CDouble
method Ptr Problem
problem Column
column

getTimeout' :: RealFrac a => Glpk a
getTimeout' :: forall a. RealFrac a => Glpk a
getTimeout' =
  let fromMillis :: RealFrac a => CInt -> a
      fromMillis :: forall a. RealFrac a => CInt -> a
fromMillis CInt
millis = CInt -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac CInt
millis a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000
   in do
        IORef SimplexMethodControlParameters
controlRef <- (GlpkEnv -> IORef SimplexMethodControlParameters)
-> GlpkT IO (IORef SimplexMethodControlParameters)
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef SimplexMethodControlParameters
_glpkSimplexControl
        SimplexMethodControlParameters
control <- IO SimplexMethodControlParameters
-> GlpkT IO SimplexMethodControlParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef SimplexMethodControlParameters
-> IO SimplexMethodControlParameters
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef SimplexMethodControlParameters
controlRef)
        a -> Glpk a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Glpk a) -> a -> Glpk a
forall a b. (a -> b) -> a -> b
$ CInt -> a
forall a. RealFrac a => CInt -> a
fromMillis (SimplexMethodControlParameters -> CInt
smcpTimeLimitMillis SimplexMethodControlParameters
control)

setTimeout' :: RealFrac a => a -> Glpk ()
setTimeout' :: forall a. RealFrac a => a -> Glpk ()
setTimeout' a
seconds =
  let millis :: Integer
      millis :: Integer
millis = a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a
seconds a -> a -> a
forall a. Num a => a -> a -> a
* a
1000)
   in do
        IORef SimplexMethodControlParameters
controlRef <- (GlpkEnv -> IORef SimplexMethodControlParameters)
-> GlpkT IO (IORef SimplexMethodControlParameters)
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef SimplexMethodControlParameters
_glpkSimplexControl
        SimplexMethodControlParameters
control <- IO SimplexMethodControlParameters
-> GlpkT IO SimplexMethodControlParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef SimplexMethodControlParameters
-> IO SimplexMethodControlParameters
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef SimplexMethodControlParameters
controlRef)
        let control' :: SimplexMethodControlParameters
control' = SimplexMethodControlParameters
control {smcpTimeLimitMillis :: CInt
smcpTimeLimitMillis = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
millis}
        IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef SimplexMethodControlParameters
-> SimplexMethodControlParameters -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef SimplexMethodControlParameters
controlRef SimplexMethodControlParameters
control')

setRelativeMIPGap' :: RealFrac a => a -> Glpk ()
setRelativeMIPGap' :: forall a. RealFrac a => a -> Glpk ()
setRelativeMIPGap' a
gap = do
  IORef (MIPControlParameters Void)
controlRef <- (GlpkEnv -> IORef (MIPControlParameters Void))
-> GlpkT IO (IORef (MIPControlParameters Void))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (MIPControlParameters Void)
_glpkMIPControl
  MIPControlParameters Void
control <- IO (MIPControlParameters Void)
-> GlpkT IO (MIPControlParameters Void)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (MIPControlParameters Void) -> IO (MIPControlParameters Void)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (MIPControlParameters Void)
controlRef)
  let control' :: MIPControlParameters Void
control' = MIPControlParameters Void
control {iocpRelativeMIPGap :: CDouble
iocpRelativeMIPGap = a -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
gap}
  IO () -> Glpk ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (MIPControlParameters Void)
-> MIPControlParameters Void -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (MIPControlParameters Void)
controlRef MIPControlParameters Void
control')

getRelativeMIPGap' :: RealFrac a => Glpk a
getRelativeMIPGap' :: forall a. RealFrac a => Glpk a
getRelativeMIPGap' = do
  IORef (MIPControlParameters Void)
controlRef <- (GlpkEnv -> IORef (MIPControlParameters Void))
-> GlpkT IO (IORef (MIPControlParameters Void))
forall (m :: * -> *) a. Monad m => (GlpkEnv -> a) -> GlpkT m a
askGlpk GlpkEnv -> IORef (MIPControlParameters Void)
_glpkMIPControl
  MIPControlParameters Void
control <- IO (MIPControlParameters Void)
-> GlpkT IO (MIPControlParameters Void)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (MIPControlParameters Void) -> IO (MIPControlParameters Void)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (MIPControlParameters Void)
controlRef)
  a -> Glpk a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Glpk a) -> a -> Glpk a
forall a b. (a -> b) -> a -> b
$ CDouble -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (MIPControlParameters Void -> CDouble
forall a. MIPControlParameters a -> CDouble
iocpRelativeMIPGap MIPControlParameters Void
control)

solutionStatus :: GlpkSolutionStatus -> SolutionStatus
solutionStatus :: GlpkSolutionStatus -> SolutionStatus
solutionStatus GlpkSolutionStatus
status
  | GlpkSolutionStatus
status GlpkSolutionStatus -> GlpkSolutionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkSolutionStatus
glpkOptimal = SolutionStatus
Optimal
  | GlpkSolutionStatus
status GlpkSolutionStatus -> GlpkSolutionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkSolutionStatus
glpkFeasible = SolutionStatus
Feasible
  | GlpkSolutionStatus
status GlpkSolutionStatus -> GlpkSolutionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkSolutionStatus
glpkInfeasible = SolutionStatus
Infeasible
  | GlpkSolutionStatus
status GlpkSolutionStatus -> GlpkSolutionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkSolutionStatus
glpkNoFeasible = SolutionStatus
Infeasible
  | GlpkSolutionStatus
status GlpkSolutionStatus -> GlpkSolutionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkSolutionStatus
glpkUnbounded = SolutionStatus
Unbounded
  | GlpkSolutionStatus
status GlpkSolutionStatus -> GlpkSolutionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GlpkSolutionStatus
glpkUndefined = SolutionStatus
Infeasible
  | Bool
otherwise = SolutionStatus
Error

-- | Write out the current formulation to a file.
writeFormulation' :: FilePath -> Glpk ()
writeFormulation' :: String -> Glpk ()
writeFormulation' String
fileName = do
  Ptr Problem
problem <- GlpkT IO (Ptr Problem)
forall (m :: * -> *). Monad m => GlpkT m (Ptr Problem)
askProblem
  CInt
_ <- IO CInt -> GlpkT IO CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> GlpkT IO CInt) -> IO CInt -> GlpkT IO CInt
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (Ptr Problem
-> Ptr CplexLPFormatControlParameters -> CString -> IO CInt
glp_write_lp Ptr Problem
problem Ptr CplexLPFormatControlParameters
forall a. Ptr a
nullPtr)
  () -> Glpk ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

maxCDouble :: CDouble
maxCDouble :: CDouble
maxCDouble = Integer -> Int -> CDouble
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
significand' Int
exponent'
  where
    base :: Integer
base = CDouble -> Integer
forall a. RealFloat a => a -> Integer
floatRadix (CDouble
forall a. HasCallStack => a
undefined :: CDouble)
    precision :: Int
precision = CDouble -> Int
forall a. RealFloat a => a -> Int
floatDigits (CDouble
forall a. HasCallStack => a
undefined :: CDouble)
    (Int
_, Int
maxExponent) = CDouble -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange (CDouble
forall a. HasCallStack => a
undefined :: CDouble)
    significand' :: Integer
significand' = Integer
base Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
precision Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    exponent' :: Int
exponent' = Int
maxExponent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
precision

withCText :: T.Text -> (CString -> IO a) -> IO a
withCText :: forall a. Text -> (CString -> IO a) -> IO a
withCText = String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (String -> (CString -> IO a) -> IO a)
-> (Text -> String) -> Text -> (CString -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack