module Numeric.NLOPT (
Objective
, ObjectiveD
, Preconditioner
, Bounds(..)
, ScalarConstraint
, ScalarConstraintD
, VectorConstraint
, VectorConstraintD
, Constraint(..)
, EqualityConstraint(..)
, InequalityConstraint(..)
, EqualityConstraints
, EqualityConstraintsD
, InequalityConstraints
, InequalityConstraintsD
, StoppingCondition(..)
, NonEmpty(..)
, RandomSeed(..)
, Population(..)
, VectorStorage(..)
, InitialStep(..)
, LocalAlgorithm(..)
, LocalProblem(..)
, minimizeLocal
, GlobalAlgorithm(..)
, GlobalProblem(..)
, minimizeGlobal
, AugLagAlgorithm(..)
, AugLagProblem(..)
, minimizeAugLag
, Solution(..)
, N.Result(..)
) where
import Numeric.LinearAlgebra as HM
import Numeric.LinearAlgebra (Vector, Matrix)
import qualified Numeric.Optimization.NLOPT.Bindings as N
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Vector.Storable as V
import Control.Exception ( Exception )
import qualified Control.Exception as Ex
import Data.Typeable ( Typeable )
import Data.Foldable ( traverse_ )
import System.IO.Unsafe ( unsafePerformIO )
wrapScalarFunction :: (Vector Double -> Double) -> N.ScalarFunction ()
wrapScalarFunction f params _ _ = return $ f params
wrapScalarFunctionD :: (Vector Double -> (Double, Vector Double))
-> N.ScalarFunction ()
wrapScalarFunctionD f params grad _ = do
case grad of
Nothing -> return ()
Just g -> V.copy g usergrad
return result
where
(result, usergrad) = f params
wrapVectorFunction :: (Vector Double -> Word -> Vector Double)
-> Word -> N.VectorFunction ()
wrapVectorFunction f n params vout _ _ = V.copy vout $ f params n
wrapVectorFunctionD :: (Vector Double -> Word -> (Vector Double, Matrix Double))
-> Word -> N.VectorFunction ()
wrapVectorFunctionD f n params vout jac _ = do
V.copy vout result
case jac of
Nothing -> return ()
Just j -> V.copy j (HM.flatten userjac)
where
(result, userjac) = f params n
wrapPreconditionerFunction :: (Vector Double -> Vector Double -> Vector Double)
-> N.PreconditionerFunction ()
wrapPreconditionerFunction f params v vpre _ = V.copy vpre (f params v)
type Objective
= Vector Double
-> Double
type ObjectiveD
= Vector Double
-> (Double, Vector Double)
type Preconditioner
= Vector Double
-> Vector Double
-> Vector Double
data ObjectiveFunction f
= MinimumObjective f
| PreconditionedMinimumObjective Preconditioner f
applyObjective :: N.Opt -> ObjectiveFunction Objective -> IO N.Result
applyObjective opt (MinimumObjective f) =
N.set_min_objective opt (wrapScalarFunction f) ()
applyObjective opt (PreconditionedMinimumObjective p f) =
N.set_precond_min_objective opt (wrapScalarFunction f)
(wrapPreconditionerFunction p) ()
applyObjectiveD :: N.Opt -> ObjectiveFunction ObjectiveD -> IO N.Result
applyObjectiveD opt (MinimumObjective f) =
N.set_min_objective opt (wrapScalarFunctionD f) ()
applyObjectiveD opt (PreconditionedMinimumObjective p f) =
N.set_precond_min_objective opt (wrapScalarFunctionD f)
(wrapPreconditionerFunction p) ()
type ScalarConstraint
= Vector Double
-> Double
type ScalarConstraintD
= Vector Double
-> (Double, Vector Double)
type VectorConstraint
= Vector Double
-> Word
-> Vector Double
type VectorConstraintD
= Vector Double
-> Word
-> (Vector Double, Matrix Double)
data Constraint s v
= Scalar s
| Vector Word v
| Preconditioned Preconditioner s
data EqualityConstraint s v = EqualityConstraint
{ eqConstraintFunctions :: Constraint s v
, eqConstraintTolerance :: Double
}
data InequalityConstraint s v = InequalityConstraint
{ ineqConstraintFunctions :: Constraint s v
, ineqConstraintTolerance :: Double
}
type EqualityConstraints =
[EqualityConstraint ScalarConstraint VectorConstraint]
type InequalityConstraints =
[InequalityConstraint ScalarConstraint VectorConstraint]
type EqualityConstraintsD = [EqualityConstraint ScalarConstraintD VectorConstraintD]
type InequalityConstraintsD = [InequalityConstraint ScalarConstraintD VectorConstraintD]
class ApplyConstraint constraint where
applyConstraint :: N.Opt -> constraint -> IO N.Result
instance ApplyConstraint (EqualityConstraint ScalarConstraint VectorConstraint) where
applyConstraint opt (EqualityConstraint ty tol) = case ty of
Scalar s ->
N.add_equality_constraint opt (wrapScalarFunction s) () tol
Vector n v ->
N.add_equality_mconstraint opt n (wrapVectorFunction v n) () tol
Preconditioned p s ->
N.add_precond_equality_constraint opt (wrapScalarFunction s)
(wrapPreconditionerFunction p) () tol
instance ApplyConstraint (InequalityConstraint ScalarConstraint VectorConstraint) where
applyConstraint opt (InequalityConstraint ty tol) = case ty of
Scalar s ->
N.add_inequality_constraint opt (wrapScalarFunction s) () tol
Vector n v ->
N.add_inequality_mconstraint opt n (wrapVectorFunction v n) () tol
Preconditioned p s ->
N.add_precond_inequality_constraint opt (wrapScalarFunction s)
(wrapPreconditionerFunction p) () tol
instance ApplyConstraint (EqualityConstraint ScalarConstraintD VectorConstraintD) where
applyConstraint opt (EqualityConstraint ty tol) = case ty of
Scalar s ->
N.add_equality_constraint opt (wrapScalarFunctionD s) () tol
Vector n v ->
N.add_equality_mconstraint opt n (wrapVectorFunctionD v n) () tol
Preconditioned p s ->
N.add_precond_equality_constraint opt (wrapScalarFunctionD s)
(wrapPreconditionerFunction p) () tol
instance ApplyConstraint (InequalityConstraint ScalarConstraintD VectorConstraintD) where
applyConstraint opt (InequalityConstraint ty tol) = case ty of
Scalar s ->
N.add_inequality_constraint opt (wrapScalarFunctionD s) () tol
Vector n v ->
N.add_inequality_mconstraint opt n (wrapVectorFunctionD v n) () tol
Preconditioned p s ->
N.add_precond_inequality_constraint opt (wrapScalarFunctionD s)
(wrapPreconditionerFunction p) () tol
data Bounds
= LowerBounds (Vector Double)
| UpperBounds (Vector Double)
deriving (Eq, Show, Read)
applyBounds :: N.Opt -> Bounds -> IO N.Result
applyBounds opt (LowerBounds lbvec) = N.set_lower_bounds opt lbvec
applyBounds opt (UpperBounds ubvec) = N.set_upper_bounds opt ubvec
data StoppingCondition
= MinimumValue Double
| ObjectiveRelativeTolerance Double
| ObjectiveAbsoluteTolerance Double
| ParameterRelativeTolerance Double
| ParameterAbsoluteTolerance (Vector Double)
| MaximumEvaluations Word
| MaximumTime Double
deriving (Eq, Show, Read)
applyStoppingCondition :: N.Opt -> StoppingCondition -> IO N.Result
applyStoppingCondition opt (MinimumValue x) = N.set_stopval opt x
applyStoppingCondition opt (ObjectiveRelativeTolerance x) = N.set_ftol_rel opt x
applyStoppingCondition opt (ObjectiveAbsoluteTolerance x) = N.set_ftol_abs opt x
applyStoppingCondition opt (ParameterRelativeTolerance x) = N.set_xtol_rel opt x
applyStoppingCondition opt (ParameterAbsoluteTolerance v) = N.set_xtol_abs opt v
applyStoppingCondition opt (MaximumEvaluations n) = N.set_maxeval opt n
applyStoppingCondition opt (MaximumTime deltat) = N.set_maxtime opt deltat
data RandomSeed
= SeedValue Word
| SeedFromTime
| Don'tSeed
deriving (Eq, Show, Read)
applyRandomSeed :: RandomSeed -> IO ()
applyRandomSeed Don'tSeed = return ()
applyRandomSeed (SeedValue n) = N.srand n
applyRandomSeed SeedFromTime = N.srand_time
newtype Population = Population Word deriving (Eq, Show, Read)
applyPopulation :: N.Opt -> Population -> IO N.Result
applyPopulation opt (Population n) = N.set_population opt n
newtype VectorStorage = VectorStorage Word deriving (Eq, Show, Read)
applyVectorStorage :: N.Opt -> VectorStorage -> IO N.Result
applyVectorStorage opt (VectorStorage n) = N.set_vector_storage opt n
newtype InitialStep = InitialStep (Vector Double) deriving (Eq, Show, Read)
applyInitialStep :: N.Opt -> InitialStep -> IO N.Result
applyInitialStep opt (InitialStep v) = N.set_initial_step opt v
data GlobalProblem = GlobalProblem
{ lowerBounds :: Vector Double
, upperBounds :: Vector Double
, gstop :: NonEmpty StoppingCondition
, galgorithm :: GlobalAlgorithm
}
data GlobalAlgorithm
= DIRECT Objective
| DIRECT_L Objective
| DIRECT_L_RAND Objective RandomSeed
| DIRECT_NOSCAL Objective
| DIRECT_L_NOSCAL Objective
| DIRECT_L_RAND_NOSCAL Objective RandomSeed
| ORIG_DIRECT Objective InequalityConstraints
| ORIG_DIRECT_L Objective InequalityConstraints
| STOGO ObjectiveD
| STOGO_RAND ObjectiveD RandomSeed
| CRS2_LM Objective RandomSeed (Maybe Population)
| ISRES Objective InequalityConstraints EqualityConstraints RandomSeed
| ESCH Objective
| MLSL Objective LocalProblem (Maybe Population)
| MLSL_LDS Objective LocalProblem (Maybe Population)
algorithmEnumOfGlobal :: GlobalAlgorithm -> N.Algorithm
algorithmEnumOfGlobal (DIRECT _) = N.GN_DIRECT
algorithmEnumOfGlobal (DIRECT_L _) = N.GN_DIRECT_L
algorithmEnumOfGlobal (DIRECT_L_RAND _ _) = N.GN_DIRECT_L_RAND
algorithmEnumOfGlobal (DIRECT_NOSCAL _) = N.GN_DIRECT_NOSCAL
algorithmEnumOfGlobal (DIRECT_L_NOSCAL _) = N.GN_DIRECT_L_NOSCAL
algorithmEnumOfGlobal (DIRECT_L_RAND_NOSCAL _ _) = N.GN_DIRECT_L_RAND_NOSCAL
algorithmEnumOfGlobal (ORIG_DIRECT _ _) = N.GN_ORIG_DIRECT
algorithmEnumOfGlobal (ORIG_DIRECT_L _ _) = N.GN_ORIG_DIRECT_L
algorithmEnumOfGlobal (STOGO _) = N.GD_STOGO
algorithmEnumOfGlobal (STOGO_RAND _ _) = N.GD_STOGO_RAND
algorithmEnumOfGlobal (CRS2_LM _ _ _) = N.GN_CRS2_LM
algorithmEnumOfGlobal (ISRES _ _ _ _) = N.GN_ISRES
algorithmEnumOfGlobal (ESCH _) = N.GN_ESCH
algorithmEnumOfGlobal (MLSL _ _ _) = N.G_MLSL
algorithmEnumOfGlobal (MLSL_LDS _ _ _) = N.G_MLSL_LDS
applyGlobalObjective :: N.Opt -> GlobalAlgorithm -> IO ()
applyGlobalObjective opt alg = go alg
where
obj = tryTo . applyObjective opt . MinimumObjective
objD = tryTo . applyObjectiveD opt . MinimumObjective
go (DIRECT o) = obj o
go (DIRECT_L o) = obj o
go (DIRECT_NOSCAL o) = obj o
go (DIRECT_L_NOSCAL o) = obj o
go (ESCH o) = obj o
go (STOGO o) = objD o
go (DIRECT_L_RAND o _) = obj o
go (DIRECT_L_RAND_NOSCAL o _) = obj o
go (ORIG_DIRECT o _) = obj o
go (ORIG_DIRECT_L o _) = obj o
go (STOGO_RAND o _) = objD o
go (CRS2_LM o _ _) = obj o
go (ISRES o _ _ _) = obj o
go (MLSL o _ _) = obj o
go (MLSL_LDS o _ _) = obj o
applyGlobalAlgorithm :: N.Opt -> GlobalAlgorithm -> IO ()
applyGlobalAlgorithm opt alg = do
applyGlobalObjective opt alg
go alg
where
seed = applyRandomSeed
pop = maybe (return ()) (tryTo . applyPopulation opt)
ic = traverse_ (tryTo . applyConstraint opt)
ec = traverse_ (tryTo . applyConstraint opt)
local lp = setupLocalProblem lp >>= N.set_local_optimizer opt
go (DIRECT_L_RAND _ s) = seed s
go (DIRECT_L_RAND_NOSCAL _ s) = seed s
go (ORIG_DIRECT _ ineq) = ic ineq
go (ORIG_DIRECT_L _ ineq) = ic ineq
go (STOGO_RAND _ s) = seed s
go (CRS2_LM _ s p) = seed s *> pop p
go (ISRES _ ineq eq s) = ic ineq *> ec eq *> seed s
go (MLSL _ lp p) = local lp *> pop p
go (MLSL_LDS _ lp p) = local lp *> pop p
go _ = return ()
tryTo :: IO N.Result -> IO ()
tryTo act = do
result <- act
if (N.isSuccess result)
then return ()
else Ex.throw $ NloptException result
data NloptException = NloptException N.Result deriving (Show, Typeable)
instance Exception NloptException
minimizeGlobal :: GlobalProblem
-> Vector Double
-> Either N.Result Solution
minimizeGlobal prob x0 =
unsafePerformIO $ (Right <$> minimizeGlobal' prob x0) `Ex.catch` handler
where
handler :: NloptException -> IO (Either N.Result a)
handler (NloptException retcode) = return $ Left retcode
applyGlobalProblem :: N.Opt -> GlobalProblem -> IO ()
applyGlobalProblem opt (GlobalProblem lb ub stop alg) = do
tryTo $ applyBounds opt (LowerBounds lb)
tryTo $ applyBounds opt (UpperBounds ub)
traverse_ (tryTo . applyStoppingCondition opt) stop
applyGlobalAlgorithm opt alg
newOpt :: N.Algorithm -> Word -> IO N.Opt
newOpt alg sz = do
opt' <- N.create alg sz
case opt' of
Nothing -> Ex.throw $ NloptException N.FAILURE
Just opt -> return opt
setupGlobalProblem :: GlobalProblem -> IO N.Opt
setupGlobalProblem gp@(GlobalProblem _ _ _ alg) = do
opt <- newOpt (algorithmEnumOfGlobal alg) (problemSize gp)
applyGlobalProblem opt gp
return opt
solveProblem :: N.Opt -> Vector Double -> IO Solution
solveProblem opt x0 = do
(N.Output outret outcost outx) <- N.optimize opt x0
if (N.isSuccess outret)
then return $ Solution outcost outx outret
else Ex.throw $ NloptException outret
minimizeGlobal' :: GlobalProblem -> Vector Double -> IO Solution
minimizeGlobal' gp x0 = do
opt <- setupGlobalProblem gp
solveProblem opt x0
data LocalProblem = LocalProblem
{ lsize :: Word
, lstop :: NonEmpty StoppingCondition
, lalgorithm :: LocalAlgorithm
}
data LocalAlgorithm
= LBFGS_NOCEDAL ObjectiveD (Maybe VectorStorage)
| LBFGS ObjectiveD (Maybe VectorStorage)
| VAR2 ObjectiveD (Maybe VectorStorage)
| VAR1 ObjectiveD (Maybe VectorStorage)
| TNEWTON ObjectiveD (Maybe VectorStorage)
| TNEWTON_RESTART ObjectiveD (Maybe VectorStorage)
| TNEWTON_PRECOND ObjectiveD (Maybe VectorStorage)
| TNEWTON_PRECOND_RESTART ObjectiveD (Maybe VectorStorage)
| MMA ObjectiveD InequalityConstraintsD
| SLSQP ObjectiveD [Bounds] InequalityConstraintsD EqualityConstraintsD
| CCSAQ ObjectiveD Preconditioner
| PRAXIS Objective [Bounds] (Maybe InitialStep)
| COBYLA Objective [Bounds] InequalityConstraints EqualityConstraints
(Maybe InitialStep)
| NEWUOA Objective (Maybe InitialStep)
| NEWUOA_BOUND Objective [Bounds] (Maybe InitialStep)
| NELDERMEAD Objective [Bounds] (Maybe InitialStep)
| SBPLX Objective [Bounds] (Maybe InitialStep)
| BOBYQA Objective [Bounds] (Maybe InitialStep)
algorithmEnumOfLocal :: LocalAlgorithm -> N.Algorithm
algorithmEnumOfLocal (LBFGS_NOCEDAL _ _) = N.LD_LBFGS_NOCEDAL
algorithmEnumOfLocal (LBFGS _ _) = N.LD_LBFGS
algorithmEnumOfLocal (VAR2 _ _) = N.LD_VAR2
algorithmEnumOfLocal (VAR1 _ _) = N.LD_VAR1
algorithmEnumOfLocal (TNEWTON _ _) = N.LD_TNEWTON
algorithmEnumOfLocal (TNEWTON_RESTART _ _) = N.LD_TNEWTON_RESTART
algorithmEnumOfLocal (TNEWTON_PRECOND _ _) = N.LD_TNEWTON_PRECOND
algorithmEnumOfLocal (TNEWTON_PRECOND_RESTART _ _) = N.LD_TNEWTON_PRECOND_RESTART
algorithmEnumOfLocal (MMA _ _) = N.LD_MMA
algorithmEnumOfLocal (SLSQP _ _ _ _) = N.LD_SLSQP
algorithmEnumOfLocal (CCSAQ _ _) = N.LD_CCSAQ
algorithmEnumOfLocal (PRAXIS _ _ _) = N.LN_PRAXIS
algorithmEnumOfLocal (COBYLA _ _ _ _ _) = N.LN_COBYLA
algorithmEnumOfLocal (NEWUOA _ _) = N.LN_NEWUOA
algorithmEnumOfLocal (NEWUOA_BOUND _ _ _) = N.LN_NEWUOA
algorithmEnumOfLocal (NELDERMEAD _ _ _) = N.LN_NELDERMEAD
algorithmEnumOfLocal (SBPLX _ _ _) = N.LN_SBPLX
algorithmEnumOfLocal (BOBYQA _ _ _) = N.LN_BOBYQA
applyLocalObjective :: N.Opt -> LocalAlgorithm -> IO ()
applyLocalObjective opt alg = go alg
where
obj = tryTo . applyObjective opt . MinimumObjective
objD = tryTo . applyObjectiveD opt . MinimumObjective
precond p = tryTo . applyObjectiveD opt . PreconditionedMinimumObjective p
go (LBFGS_NOCEDAL o _) = objD o
go (LBFGS o _) = objD o
go (VAR2 o _) = objD o
go (VAR1 o _) = objD o
go (TNEWTON o _) = objD o
go (TNEWTON_RESTART o _) = objD o
go (TNEWTON_PRECOND o _) = objD o
go (TNEWTON_PRECOND_RESTART o _) = objD o
go (MMA o _) = objD o
go (SLSQP o _ _ _) = objD o
go (CCSAQ o prec) = precond prec o
go (PRAXIS o _ _) = obj o
go (COBYLA o _ _ _ _) = obj o
go (NEWUOA o _) = obj o
go (NEWUOA_BOUND o _ _) = obj o
go (NELDERMEAD o _ _) = obj o
go (SBPLX o _ _) = obj o
go (BOBYQA o _ _) = obj o
applyLocalAlgorithm :: N.Opt -> LocalAlgorithm -> IO ()
applyLocalAlgorithm opt alg = do
applyLocalObjective opt alg
go alg
where
ic = traverse_ (tryTo . applyConstraint opt)
icd = traverse_ (tryTo . applyConstraint opt)
ec = traverse_ (tryTo . applyConstraint opt)
ecd = traverse_ (tryTo . applyConstraint opt)
store = maybe (return ()) (tryTo . applyVectorStorage opt)
bound = traverse_ (tryTo . applyBounds opt)
step0 = maybe (return ()) (tryTo . applyInitialStep opt)
go (LBFGS_NOCEDAL _ vs) = store vs
go (LBFGS _ vs) = store vs
go (VAR2 _ vs) = store vs
go (VAR1 _ vs) = store vs
go (TNEWTON _ vs) = store vs
go (TNEWTON_RESTART _ vs) = store vs
go (TNEWTON_PRECOND _ vs) = store vs
go (TNEWTON_PRECOND_RESTART _ vs) = store vs
go (MMA _ ineqd) = icd ineqd
go (SLSQP _ b ineqd eqd) =
bound b *> icd ineqd *> ecd eqd
go (CCSAQ _ _ ) = return ()
go (PRAXIS _ b s) = bound b *> step0 s
go (COBYLA _ b ineq eq s) =
bound b *> ic ineq *> ec eq *> step0 s
go (NEWUOA _ s) = step0 s
go (NEWUOA_BOUND _ b s) = bound b *> step0 s
go (NELDERMEAD _ b s) = bound b *> step0 s
go (SBPLX _ b s) = bound b *> step0 s
go (BOBYQA _ b s) = bound b *> step0 s
applyLocalProblem :: N.Opt -> LocalProblem -> IO ()
applyLocalProblem opt (LocalProblem _ stop alg) = do
traverse_ (tryTo . applyStoppingCondition opt) stop
applyLocalAlgorithm opt alg
setupLocalProblem :: LocalProblem -> IO N.Opt
setupLocalProblem lp@(LocalProblem sz _ alg) = do
opt <- newOpt (algorithmEnumOfLocal alg) sz
applyLocalProblem opt lp
return opt
minimizeLocal' :: LocalProblem -> Vector Double -> IO Solution
minimizeLocal' lp x0 = do
opt <- setupLocalProblem lp
solveProblem opt x0
minimizeLocal :: LocalProblem -> Vector Double -> Either N.Result Solution
minimizeLocal prob x0 =
unsafePerformIO $ (Right <$> minimizeLocal' prob x0) `Ex.catch` handler
where
handler :: NloptException -> IO (Either N.Result a)
handler (NloptException retcode) = return $ Left retcode
class ProblemSize c where
problemSize :: c -> Word
instance ProblemSize LocalProblem where
problemSize = lsize
instance ProblemSize GlobalProblem where
problemSize = fromIntegral . HM.size . lowerBounds
instance ProblemSize AugLagProblem where
problemSize (AugLagProblem _ _ alg) = case alg of
AUGLAG_LOCAL lp _ _ -> problemSize lp
AUGLAG_EQ_LOCAL lp -> problemSize lp
AUGLAG_GLOBAL gp _ _ -> problemSize gp
AUGLAG_EQ_GLOBAL gp -> problemSize gp
data AugLagProblem = AugLagProblem
{ alEquality :: EqualityConstraints
, alEqualityD :: EqualityConstraintsD
, alalgorithm :: AugLagAlgorithm
}
data AugLagAlgorithm
= AUGLAG_LOCAL LocalProblem InequalityConstraints InequalityConstraintsD
| AUGLAG_EQ_LOCAL LocalProblem
| AUGLAG_GLOBAL GlobalProblem InequalityConstraints InequalityConstraintsD
| AUGLAG_EQ_GLOBAL GlobalProblem
algorithmEnumOfAugLag :: AugLagAlgorithm -> N.Algorithm
algorithmEnumOfAugLag (AUGLAG_LOCAL _ _ _) = N.AUGLAG
algorithmEnumOfAugLag (AUGLAG_EQ_LOCAL _) = N.AUGLAG_EQ
algorithmEnumOfAugLag (AUGLAG_GLOBAL _ _ _) = N.AUGLAG
algorithmEnumOfAugLag (AUGLAG_EQ_GLOBAL _) = N.AUGLAG_EQ
data Solution = Solution
{ solutionCost :: Double
, solutionParams :: Vector Double
, solutionResult :: N.Result
} deriving (Eq, Show, Read)
applyAugLagAlgorithm :: N.Opt -> AugLagAlgorithm -> IO ()
applyAugLagAlgorithm opt alg = go alg
where
ic = traverse_ (tryTo . applyConstraint opt)
icd = traverse_ (tryTo . applyConstraint opt)
local lp = tryTo $ do
localopt <- setupLocalProblem lp
applyLocalObjective opt (lalgorithm lp)
N.set_local_optimizer opt localopt
global gp = do
tryTo $ setupGlobalProblem gp >>= N.set_local_optimizer opt
applyGlobalObjective opt (galgorithm gp)
go (AUGLAG_LOCAL lp ineq ineqd) = local lp *> ic ineq *> icd ineqd
go (AUGLAG_EQ_LOCAL lp) = local lp
go (AUGLAG_GLOBAL gp ineq ineqd) = global gp *> ic ineq *> icd ineqd
go (AUGLAG_EQ_GLOBAL gp) = global gp
applyAugLagProblem :: N.Opt -> AugLagProblem -> IO ()
applyAugLagProblem opt (AugLagProblem eq eqd alg) = do
traverse_ (tryTo . applyConstraint opt) eq
traverse_ (tryTo . applyConstraint opt) eqd
applyAugLagAlgorithm opt alg
minimizeAugLag' :: AugLagProblem -> Vector Double -> IO Solution
minimizeAugLag' ap@(AugLagProblem _ _ alg) x0 = do
opt <- newOpt (algorithmEnumOfAugLag alg) (problemSize ap)
applyAugLagProblem opt ap
solveProblem opt x0
minimizeAugLag :: AugLagProblem -> Vector Double -> Either N.Result Solution
minimizeAugLag prob x0 =
unsafePerformIO $ (Right <$> minimizeAugLag' prob x0) `Ex.catch` handler
where
handler :: NloptException -> IO (Either N.Result a)
handler (NloptException retcode) = return $ Left retcode