{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances #-}

{- |
Module      :  Numeric.NLOPT
Copyright   :  (c) Matthew Peddie 2017
License     :  BSD3
Maintainer  :  Matthew Peddie <mpeddie@gmail.com>
Stability   :  provisional
Portability :  GHC

This module provides a high-level, @hmatrix@-compatible interface to
the <http://ab-initio.mit.edu/wiki/index.php/NLopt NLOPT> library by
Steven G. Johnson.

= Documentation

Most non-numerical details are documented, but for specific
information on what the optimization methods do, how constraints are
handled, etc., you should consult:

  * The <http://ab-initio.mit.edu/wiki/index.php/NLopt_Introduction NLOPT introduction>

  * The <http://ab-initio.mit.edu/wiki/index.php/NLopt_Reference NLOPT reference manual>

  * The <http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms NLOPT algorithm manual>

= Example program

The following interactive session example uses the Nelder-Mead simplex
algorithm, a derivative-free local optimizer, to minimize a trivial
function with a minimum of 22.0 at @(0, 0)@.

>>> import Numeric.LinearAlgebra ( dot, fromList )
>>> let objf x = x `dot` x + 22                         -- define objective
>>> let stop = ObjectiveRelativeTolerance 1e-6 :| []    -- define stopping criterion
>>> let algorithm = NELDERMEAD objf [] Nothing          -- specify algorithm
>>> let problem = LocalProblem 2 stop algorithm         -- specify problem
>>> let x0 = fromList [5, 10]                           -- specify initial guess
>>> minimizeLocal problem x0
Right (Solution {solutionCost = 22.0, solutionParams = [0.0,0.0], solutionResult = FTOL_REACHED})

-}

module Numeric.NLOPT (
  -- * Specifying the objective function
  Objective
  , ObjectiveD
  , Preconditioner
  -- * Specifying the constraints
  -- ** Bound constraints
  , Bounds(..)
  -- ** Nonlinear constraints
  --
  -- $nonlinearconstraints

  -- *** Constraint functions
  , ScalarConstraint
  , ScalarConstraintD
  , VectorConstraint
  , VectorConstraintD
  -- *** Constraint types
  , Constraint(..)
  , EqualityConstraint(..)
  , InequalityConstraint(..)
  -- *** Collections of constraints
  , EqualityConstraints
  , EqualityConstraintsD
  , InequalityConstraints
  , InequalityConstraintsD
  -- * Stopping conditions
  --
  -- $nonempty
  , StoppingCondition(..)
  , NonEmpty(..)
  -- * Additional configuration
  , RandomSeed(..)
  , Population(..)
  , VectorStorage(..)
  , InitialStep(..)
  -- * Minimization problems
  -- ** Local minimization
  , LocalAlgorithm(..)
  , LocalProblem(..)
  , minimizeLocal
  -- ** Global minimization
  , GlobalAlgorithm(..)
  , GlobalProblem(..)
  , minimizeGlobal
  -- ** Minimization by augmented Lagrangian
  , AugLagAlgorithm(..)
  , AugLagProblem(..)
  , minimizeAugLag
  -- ** Results
  , Solution(..)
  , N.Result(..)
  ) where

import Numeric.LinearAlgebra as HM
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 )

{- Function wrapping for the immutable HMatrix interface -}
wrapScalarFunction :: (Vector Double -> Double) -> N.ScalarFunction ()
wrapScalarFunction :: ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
f Vector Double
params Maybe (IOVector Double)
_ ()
_ = Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double) -> Double -> IO Double
forall a b. (a -> b) -> a -> b
$ ScalarConstraint
f Vector Double
params

wrapScalarFunctionD :: (Vector Double -> (Double, Vector Double))
                    -> N.ScalarFunction ()
wrapScalarFunctionD :: ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
f Vector Double
params Maybe (IOVector Double)
grad ()
_ = do
  case Maybe (IOVector Double)
grad of
    Maybe (IOVector Double)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just IOVector Double
g  -> MVector (PrimState IO) Double -> Vector Double -> IO ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
V.copy IOVector Double
MVector (PrimState IO) Double
g Vector Double
usergrad
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result
  where
    (Double
result, Vector Double
usergrad) = ScalarConstraintD
f Vector Double
params

wrapVectorFunction :: (Vector Double -> Word -> Vector Double)
                   -> Word -> N.VectorFunction ()
wrapVectorFunction :: VectorConstraint -> Word -> VectorFunction ()
wrapVectorFunction VectorConstraint
f Word
n Vector Double
params IOVector Double
vout Maybe (IOVector Double)
_ ()
_ = MVector (PrimState IO) Double -> Vector Double -> IO ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
V.copy IOVector Double
MVector (PrimState IO) Double
vout (Vector Double -> IO ()) -> Vector Double -> IO ()
forall a b. (a -> b) -> a -> b
$ VectorConstraint
f Vector Double
params Word
n

wrapVectorFunctionD :: (Vector Double -> Word -> (Vector Double, Matrix Double))
                    -> Word -> N.VectorFunction ()
wrapVectorFunctionD :: VectorConstraintD -> Word -> VectorFunction ()
wrapVectorFunctionD VectorConstraintD
f Word
n Vector Double
params IOVector Double
vout Maybe (IOVector Double)
jac ()
_ = do
  MVector (PrimState IO) Double -> Vector Double -> IO ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
V.copy IOVector Double
MVector (PrimState IO) Double
vout Vector Double
result
  case Maybe (IOVector Double)
jac of
    Maybe (IOVector Double)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just IOVector Double
j -> MVector (PrimState IO) Double -> Vector Double -> IO ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
V.copy IOVector Double
MVector (PrimState IO) Double
j (Matrix Double -> Vector Double
forall t. Element t => Matrix t -> Vector t
HM.flatten Matrix Double
userjac)
  where
    (Vector Double
result, Matrix Double
userjac) = VectorConstraintD
f Vector Double
params Word
n

wrapPreconditionerFunction :: (Vector Double -> Vector Double -> Vector Double)
                           -> N.PreconditionerFunction ()
wrapPreconditionerFunction :: (Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
f Vector Double
params Vector Double
v IOVector Double
vpre ()
_ = MVector (PrimState IO) Double -> Vector Double -> IO ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
V.copy IOVector Double
MVector (PrimState IO) Double
vpre (Vector Double -> Vector Double -> Vector Double
f Vector Double
params Vector Double
v)

{- Objective functions -}
-- | An objective function that calculates the objective value at the
-- given parameter vector.
type Objective
  = Vector Double  -- ^ Parameter vector
 -> Double  -- ^ Objective function value

-- | An objective function that calculates both the objective value
-- and the gradient of the objective with respect to the input
-- parameter vector, at the given parameter vector.
type ObjectiveD
  = Vector Double -- ^ Parameter vector
 -> (Double, Vector Double)  -- ^ (Objective function value, gradient)

-- | A preconditioner function, which computes @vpre = H(x) v@, where
-- @H@ is the Hessian matrix: the positive semi-definite second
-- derivative at the given parameter vector @x@, or an approximation
-- thereof.
type Preconditioner
  = Vector Double  -- ^ Parameter vector @x@
 -> Vector Double  -- ^ Vector @v@ to precondition at @x@
 -> Vector Double  -- ^ Preconditioned vector @vpre@

data ObjectiveFunction f
 = MinimumObjective f
 | PreconditionedMinimumObjective Preconditioner f

applyObjective :: N.Opt -> ObjectiveFunction Objective -> IO N.Result
applyObjective :: Opt -> ObjectiveFunction ScalarConstraint -> IO Result
applyObjective Opt
opt (MinimumObjective ScalarConstraint
f) =
  Opt -> ScalarFunction () -> () -> IO Result
forall a. Opt -> ScalarFunction a -> a -> IO Result
N.set_min_objective Opt
opt (ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
f) ()
applyObjective Opt
opt (PreconditionedMinimumObjective Vector Double -> Vector Double -> Vector Double
p ScalarConstraint
f) =
  Opt
-> ScalarFunction ()
-> PreconditionerFunction ()
-> ()
-> IO Result
forall a.
Opt
-> ScalarFunction a -> PreconditionerFunction a -> a -> IO Result
N.set_precond_min_objective Opt
opt (ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
f)
  ((Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
p) ()

applyObjectiveD :: N.Opt -> ObjectiveFunction ObjectiveD -> IO N.Result
applyObjectiveD :: Opt -> ObjectiveFunction ScalarConstraintD -> IO Result
applyObjectiveD Opt
opt (MinimumObjective ScalarConstraintD
f) =
  Opt -> ScalarFunction () -> () -> IO Result
forall a. Opt -> ScalarFunction a -> a -> IO Result
N.set_min_objective Opt
opt (ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
f) ()
applyObjectiveD Opt
opt (PreconditionedMinimumObjective Vector Double -> Vector Double -> Vector Double
p ScalarConstraintD
f) =
  Opt
-> ScalarFunction ()
-> PreconditionerFunction ()
-> ()
-> IO Result
forall a.
Opt
-> ScalarFunction a -> PreconditionerFunction a -> a -> IO Result
N.set_precond_min_objective Opt
opt (ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
f)
  ((Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
p) ()

{- Constraint functions -}
-- | A constraint function which returns @c(x)@ given the parameter
-- vector @x@.  The constraint will enforce that @c(x) == 0@ (equality
-- constraint) or @c(x) <= 0@ (inequality constraint).
type ScalarConstraint
  = Vector Double  -- ^ Parameter vector @x@
 -> Double  -- ^ Constraint violation (deviation from 0)

-- | A constraint function which returns @c(x)@ given the parameter
-- vector @x@ along with the gradient of @c(x)@ with respect to @x@ at
-- that point.  The constraint will enforce that @c(x) == 0@ (equality
-- constraint) or @c(x) <= 0@ (inequality constraint).
type ScalarConstraintD
  = Vector Double  -- ^ Parameter vector
 -> (Double, Vector Double)  -- ^ (Constraint violation, constraint gradient)

-- | A constraint function which returns a vector @c(x)@ given the
-- parameter vector @x@.  The constraint will enforce that @c(x) == 0@
-- (equality constraint) or @c(x) <= 0@ (inequality constraint).
type VectorConstraint
  = Vector Double  -- ^ Parameter vector
  -> Word           -- ^ Constraint vector size
  -> Vector Double  -- ^ Constraint violation vector

-- | A constraint function which returns @c(x)@ given the parameter
-- vector @x@ along with the Jacobian (first derivative) matrix of
-- @c(x)@ with respect to @x@ at that point.  The constraint will
-- enforce that @c(x) == 0@ (equality constraint) or @c(x) <= 0@
-- (inequality constraint).
type VectorConstraintD
  = Vector Double  -- ^ Parameter vector
  -> Word  -- ^ Constraint vector size
  -> (Vector Double, Matrix Double)  -- ^ (Constraint violation vector,
                                     -- constraint Jacobian)

-- $nonlinearconstraints
--
-- Note that most NLOPT algorithms do not support nonlinear
-- constraints natively; if you need to enforce nonlinear constraints,
-- you may want to use the 'AugLagAlgorithm' family of solvers, which
-- can add nonlinear constraints to some algorithm that does not
-- support them by a principled modification of the objective
-- function.
--
-- == Example program
--
-- The following interactive session example enforces a scalar
-- constraint on the problem given in the beginning of the module: the
-- parameters must always sum to 1.  The minimizer finds a constrained
-- minimum of 22.5 at @(0.5, 0.5)@.
--
-- >>> import Numeric.LinearAlgebra ( dot, fromList, toList )
-- >>> let objf x = x `dot` x + 22
-- >>> let stop = ObjectiveRelativeTolerance 1e-9 :| []
-- >>>          -- define constraint function:
-- >>> let constraintf x = sum (toList x) - 1.0
-- >>>          -- define constraint object to pass to the algorithm:
-- >>> let constraint = EqualityConstraint (Scalar constraintf) 1e-6
-- >>> let algorithm = COBYLA objf [] [] [constraint] Nothing
-- >>> let problem = LocalProblem 2 stop algorithm
-- >>> let x0 = fromList [5, 10]
-- >>> minimizeLocal problem x0
-- Right (Solution {solutionCost = 22.500000000013028, solutionParams = [0.5000025521533521,0.49999744784664796], solutionResult = FTOL_REACHED})


data Constraint s v
  -- | A scalar constraint.
  = Scalar s
  -- | A vector constraint.
  | Vector Word v
  -- | A scalar constraint with an attached preconditioning function.
  | Preconditioned Preconditioner s

-- | An equality constraint, comprised of both the constraint function
-- (or functions, if a preconditioner is used) along with the desired
-- tolerance.
data EqualityConstraint s v = EqualityConstraint
  { forall s v. EqualityConstraint s v -> Constraint s v
eqConstraintFunctions :: Constraint s v
  , forall s v. EqualityConstraint s v -> Double
eqConstraintTolerance :: Double
  }

-- | An inequality constraint, comprised of both the constraint
-- function (or functions, if a preconditioner is used) along with the
-- desired tolerance.
data InequalityConstraint s v = InequalityConstraint
  { forall s v. InequalityConstraint s v -> Constraint s v
ineqConstraintFunctions :: Constraint s v
  , forall s v. InequalityConstraint s v -> Double
ineqConstraintTolerance :: Double
  }

-- | A collection of equality constraints that do not supply
-- constraint derivatives.
type EqualityConstraints =
  [EqualityConstraint ScalarConstraint VectorConstraint]

-- | A collection of inequality constraints that do not supply
-- constraint derivatives.
type InequalityConstraints =
  [InequalityConstraint ScalarConstraint VectorConstraint]

-- | A collection of equality constraints that supply constraint
-- derivatives.
type EqualityConstraintsD = [EqualityConstraint ScalarConstraintD VectorConstraintD]

-- | A collection of inequality constraints that supply constraint
-- derivatives.
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 ScalarConstraint VectorConstraint
-> IO Result
applyConstraint Opt
opt (EqualityConstraint Constraint ScalarConstraint VectorConstraint
ty Double
tol) = case Constraint ScalarConstraint VectorConstraint
ty of
    Scalar ScalarConstraint
s           ->
      Opt -> ScalarFunction () -> () -> Double -> IO Result
forall a. Opt -> ScalarFunction a -> a -> Double -> IO Result
N.add_equality_constraint Opt
opt (ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
s) () Double
tol
    Vector Word
n VectorConstraint
v         ->
      Opt -> Word -> VectorFunction () -> () -> Double -> IO Result
forall a.
Opt -> Word -> VectorFunction a -> a -> Double -> IO Result
N.add_equality_mconstraint Opt
opt Word
n (VectorConstraint -> Word -> VectorFunction ()
wrapVectorFunction VectorConstraint
v Word
n) () Double
tol
    Preconditioned Vector Double -> Vector Double -> Vector Double
p ScalarConstraint
s ->
      Opt
-> ScalarFunction ()
-> PreconditionerFunction ()
-> ()
-> Double
-> IO Result
forall a.
Opt
-> ScalarFunction a
-> PreconditionerFunction a
-> a
-> Double
-> IO Result
N.add_precond_equality_constraint Opt
opt (ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
s)
      ((Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
p) () Double
tol

instance ApplyConstraint (InequalityConstraint ScalarConstraint VectorConstraint) where
  applyConstraint :: Opt
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO Result
applyConstraint Opt
opt (InequalityConstraint Constraint ScalarConstraint VectorConstraint
ty Double
tol) = case Constraint ScalarConstraint VectorConstraint
ty of
    Scalar ScalarConstraint
s           ->
      Opt -> ScalarFunction () -> () -> Double -> IO Result
forall a. Opt -> ScalarFunction a -> a -> Double -> IO Result
N.add_inequality_constraint Opt
opt (ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
s) () Double
tol
    Vector Word
n VectorConstraint
v         ->
      Opt -> Word -> VectorFunction () -> () -> Double -> IO Result
forall a.
Opt -> Word -> VectorFunction a -> a -> Double -> IO Result
N.add_inequality_mconstraint Opt
opt Word
n (VectorConstraint -> Word -> VectorFunction ()
wrapVectorFunction VectorConstraint
v Word
n) () Double
tol
    Preconditioned Vector Double -> Vector Double -> Vector Double
p ScalarConstraint
s ->
      Opt
-> ScalarFunction ()
-> PreconditionerFunction ()
-> ()
-> Double
-> IO Result
forall a.
Opt
-> ScalarFunction a
-> PreconditionerFunction a
-> a
-> Double
-> IO Result
N.add_precond_inequality_constraint Opt
opt (ScalarConstraint -> ScalarFunction ()
wrapScalarFunction ScalarConstraint
s)
      ((Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
p) () Double
tol

instance ApplyConstraint (EqualityConstraint ScalarConstraintD VectorConstraintD) where
  applyConstraint :: Opt
-> EqualityConstraint ScalarConstraintD VectorConstraintD
-> IO Result
applyConstraint Opt
opt (EqualityConstraint Constraint ScalarConstraintD VectorConstraintD
ty Double
tol) = case Constraint ScalarConstraintD VectorConstraintD
ty of
    Scalar ScalarConstraintD
s           ->
      Opt -> ScalarFunction () -> () -> Double -> IO Result
forall a. Opt -> ScalarFunction a -> a -> Double -> IO Result
N.add_equality_constraint Opt
opt (ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
s) () Double
tol
    Vector Word
n VectorConstraintD
v         ->
      Opt -> Word -> VectorFunction () -> () -> Double -> IO Result
forall a.
Opt -> Word -> VectorFunction a -> a -> Double -> IO Result
N.add_equality_mconstraint Opt
opt Word
n (VectorConstraintD -> Word -> VectorFunction ()
wrapVectorFunctionD VectorConstraintD
v Word
n) () Double
tol
    Preconditioned Vector Double -> Vector Double -> Vector Double
p ScalarConstraintD
s ->
      Opt
-> ScalarFunction ()
-> PreconditionerFunction ()
-> ()
-> Double
-> IO Result
forall a.
Opt
-> ScalarFunction a
-> PreconditionerFunction a
-> a
-> Double
-> IO Result
N.add_precond_equality_constraint Opt
opt (ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
s)
      ((Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
p) () Double
tol

instance ApplyConstraint (InequalityConstraint ScalarConstraintD VectorConstraintD) where
  applyConstraint :: Opt
-> InequalityConstraint ScalarConstraintD VectorConstraintD
-> IO Result
applyConstraint Opt
opt (InequalityConstraint Constraint ScalarConstraintD VectorConstraintD
ty Double
tol) = case Constraint ScalarConstraintD VectorConstraintD
ty of
    Scalar ScalarConstraintD
s           ->
      Opt -> ScalarFunction () -> () -> Double -> IO Result
forall a. Opt -> ScalarFunction a -> a -> Double -> IO Result
N.add_inequality_constraint Opt
opt (ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
s) () Double
tol
    Vector Word
n VectorConstraintD
v         ->
      Opt -> Word -> VectorFunction () -> () -> Double -> IO Result
forall a.
Opt -> Word -> VectorFunction a -> a -> Double -> IO Result
N.add_inequality_mconstraint Opt
opt Word
n (VectorConstraintD -> Word -> VectorFunction ()
wrapVectorFunctionD VectorConstraintD
v Word
n) () Double
tol
    Preconditioned Vector Double -> Vector Double -> Vector Double
p ScalarConstraintD
s ->
      Opt
-> ScalarFunction ()
-> PreconditionerFunction ()
-> ()
-> Double
-> IO Result
forall a.
Opt
-> ScalarFunction a
-> PreconditionerFunction a
-> a
-> Double
-> IO Result
N.add_precond_inequality_constraint Opt
opt (ScalarConstraintD -> ScalarFunction ()
wrapScalarFunctionD ScalarConstraintD
s)
      ((Vector Double -> Vector Double -> Vector Double)
-> PreconditionerFunction ()
wrapPreconditionerFunction Vector Double -> Vector Double -> Vector Double
p) () Double
tol

{- Bounds -}

-- | Bound constraints are specified by vectors of the same dimension
-- as the parameter space.
--
-- == Example program
--
-- The following interactive session example enforces lower bounds on
-- the example from the beginning of the module.  This prevents the
-- optimizer from locating the true minimum at @(0, 0)@; a slightly
-- higher constrained minimum at @(1, 1)@ is found.  Note that the
-- optimizer returns 'N.XTOL_REACHED' rather than 'N.FTOL_REACHED',
-- because the bound constraint is active at the final minimum.
--
-- >>> import Numeric.LinearAlgebra ( dot, fromList )
-- >>> let objf x = x `dot` x + 22                           -- define objective
-- >>> let stop = ObjectiveRelativeTolerance 1e-6 :| []      -- define stopping criterion
-- >>> let lowerbound = LowerBounds $ fromList [1, 1]        -- specify bounds
-- >>> let algorithm = NELDERMEAD objf [lowerbound] Nothing  -- specify algorithm
-- >>> let problem = LocalProblem 2 stop algorithm           -- specify problem
-- >>> let x0 = fromList [5, 10]                             -- specify initial guess
-- >>> minimizeLocal problem x0
-- Right (Solution {solutionCost = 24.0, solutionParams = [1.0,1.0], solutionResult = XTOL_REACHED})
data Bounds
  -- | Lower bound vector @v@ means we want @x >= v@.
 = LowerBounds (Vector Double)
 -- | Upper bound vector @u@ means we want @x <= u@.
 | UpperBounds (Vector Double)
 deriving (Bounds -> Bounds -> Bool
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c== :: Bounds -> Bounds -> Bool
Eq, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bounds] -> ShowS
$cshowList :: [Bounds] -> ShowS
show :: Bounds -> String
$cshow :: Bounds -> String
showsPrec :: Int -> Bounds -> ShowS
$cshowsPrec :: Int -> Bounds -> ShowS
Show, ReadPrec [Bounds]
ReadPrec Bounds
Int -> ReadS Bounds
ReadS [Bounds]
(Int -> ReadS Bounds)
-> ReadS [Bounds]
-> ReadPrec Bounds
-> ReadPrec [Bounds]
-> Read Bounds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bounds]
$creadListPrec :: ReadPrec [Bounds]
readPrec :: ReadPrec Bounds
$creadPrec :: ReadPrec Bounds
readList :: ReadS [Bounds]
$creadList :: ReadS [Bounds]
readsPrec :: Int -> ReadS Bounds
$creadsPrec :: Int -> ReadS Bounds
Read)

applyBounds :: N.Opt -> Bounds -> IO N.Result
applyBounds :: Opt -> Bounds -> IO Result
applyBounds Opt
opt (LowerBounds Vector Double
lbvec) = Opt -> Vector Double -> IO Result
N.set_lower_bounds Opt
opt Vector Double
lbvec
applyBounds Opt
opt (UpperBounds Vector Double
ubvec) = Opt -> Vector Double -> IO Result
N.set_upper_bounds Opt
opt Vector Double
ubvec

{- Stopping conditions -}

-- | A 'StoppingCondition' tells NLOPT when to stop working on a
-- minimization problem.  When multiple 'StoppingCondition's are
-- provided, the problem will stop when any one condition is met.
data StoppingCondition
  -- | Stop minimizing when an objective value @J@ less than or equal
  -- to the provided value is found.
  = MinimumValue Double
  -- | Stop minimizing when an optimization step changes the objective
  -- value @J@ by less than the provided tolerance multiplied by @|J|@.
  | ObjectiveRelativeTolerance Double
  -- | Stop minimizing when an optimization step changes the objective
  -- value by less than the provided tolerance.
  | ObjectiveAbsoluteTolerance Double
  -- | Stop when an optimization step changes /every element/ of the
  -- parameter vector @x@ by less than @x@ scaled by the provided
  -- tolerance.
  | ParameterRelativeTolerance Double
  -- | Stop when an optimization step changes /every element/ of the
  -- parameter vector @x@ by less than the corresponding element in
  -- the provided vector of tolerances values.
  | ParameterAbsoluteTolerance (Vector Double)
  -- | Stop when the number of evaluations of the objective function
  -- exceeds the provided count.
  | MaximumEvaluations Word
  -- | Stop when the optimization time exceeds the provided time (in
  -- seconds).  This is not a precise limit.
  | MaximumTime Double
  deriving (StoppingCondition -> StoppingCondition -> Bool
(StoppingCondition -> StoppingCondition -> Bool)
-> (StoppingCondition -> StoppingCondition -> Bool)
-> Eq StoppingCondition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoppingCondition -> StoppingCondition -> Bool
$c/= :: StoppingCondition -> StoppingCondition -> Bool
== :: StoppingCondition -> StoppingCondition -> Bool
$c== :: StoppingCondition -> StoppingCondition -> Bool
Eq, Int -> StoppingCondition -> ShowS
[StoppingCondition] -> ShowS
StoppingCondition -> String
(Int -> StoppingCondition -> ShowS)
-> (StoppingCondition -> String)
-> ([StoppingCondition] -> ShowS)
-> Show StoppingCondition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoppingCondition] -> ShowS
$cshowList :: [StoppingCondition] -> ShowS
show :: StoppingCondition -> String
$cshow :: StoppingCondition -> String
showsPrec :: Int -> StoppingCondition -> ShowS
$cshowsPrec :: Int -> StoppingCondition -> ShowS
Show, ReadPrec [StoppingCondition]
ReadPrec StoppingCondition
Int -> ReadS StoppingCondition
ReadS [StoppingCondition]
(Int -> ReadS StoppingCondition)
-> ReadS [StoppingCondition]
-> ReadPrec StoppingCondition
-> ReadPrec [StoppingCondition]
-> Read StoppingCondition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StoppingCondition]
$creadListPrec :: ReadPrec [StoppingCondition]
readPrec :: ReadPrec StoppingCondition
$creadPrec :: ReadPrec StoppingCondition
readList :: ReadS [StoppingCondition]
$creadList :: ReadS [StoppingCondition]
readsPrec :: Int -> ReadS StoppingCondition
$creadsPrec :: Int -> ReadS StoppingCondition
Read)

-- $nonempty
--
-- The 'NonEmpty' data type from 'Data.List.NonEmpty' is re-exported
-- here, because it is used to ensure that you always specify at least
-- one stopping condition.

applyStoppingCondition :: N.Opt -> StoppingCondition -> IO N.Result
applyStoppingCondition :: Opt -> StoppingCondition -> IO Result
applyStoppingCondition Opt
opt (MinimumValue Double
x) = Opt -> Double -> IO Result
N.set_stopval Opt
opt Double
x
applyStoppingCondition Opt
opt (ObjectiveRelativeTolerance Double
x) = Opt -> Double -> IO Result
N.set_ftol_rel Opt
opt Double
x
applyStoppingCondition Opt
opt (ObjectiveAbsoluteTolerance Double
x) = Opt -> Double -> IO Result
N.set_ftol_abs Opt
opt Double
x
applyStoppingCondition Opt
opt (ParameterRelativeTolerance Double
x) = Opt -> Double -> IO Result
N.set_xtol_rel Opt
opt Double
x
applyStoppingCondition Opt
opt (ParameterAbsoluteTolerance Vector Double
v) = Opt -> Vector Double -> IO Result
N.set_xtol_abs Opt
opt Vector Double
v
applyStoppingCondition Opt
opt (MaximumEvaluations Word
n) = Opt -> Word -> IO Result
N.set_maxeval Opt
opt Word
n
applyStoppingCondition Opt
opt (MaximumTime Double
deltat) = Opt -> Double -> IO Result
N.set_maxtime Opt
opt Double
deltat

{- Random seed control -}

-- | This specifies how to initialize the random number generator for
-- stochastic algorithms.
data RandomSeed
  -- | Seed the RNG with the provided value.
  = SeedValue Word
  -- | Seed the RNG using the system clock.
  | SeedFromTime
  -- | Don't perform any explicit initialization of the RNG.
  | Don'tSeed
  deriving (RandomSeed -> RandomSeed -> Bool
(RandomSeed -> RandomSeed -> Bool)
-> (RandomSeed -> RandomSeed -> Bool) -> Eq RandomSeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RandomSeed -> RandomSeed -> Bool
$c/= :: RandomSeed -> RandomSeed -> Bool
== :: RandomSeed -> RandomSeed -> Bool
$c== :: RandomSeed -> RandomSeed -> Bool
Eq, Int -> RandomSeed -> ShowS
[RandomSeed] -> ShowS
RandomSeed -> String
(Int -> RandomSeed -> ShowS)
-> (RandomSeed -> String)
-> ([RandomSeed] -> ShowS)
-> Show RandomSeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RandomSeed] -> ShowS
$cshowList :: [RandomSeed] -> ShowS
show :: RandomSeed -> String
$cshow :: RandomSeed -> String
showsPrec :: Int -> RandomSeed -> ShowS
$cshowsPrec :: Int -> RandomSeed -> ShowS
Show, ReadPrec [RandomSeed]
ReadPrec RandomSeed
Int -> ReadS RandomSeed
ReadS [RandomSeed]
(Int -> ReadS RandomSeed)
-> ReadS [RandomSeed]
-> ReadPrec RandomSeed
-> ReadPrec [RandomSeed]
-> Read RandomSeed
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RandomSeed]
$creadListPrec :: ReadPrec [RandomSeed]
readPrec :: ReadPrec RandomSeed
$creadPrec :: ReadPrec RandomSeed
readList :: ReadS [RandomSeed]
$creadList :: ReadS [RandomSeed]
readsPrec :: Int -> ReadS RandomSeed
$creadsPrec :: Int -> ReadS RandomSeed
Read)

applyRandomSeed :: RandomSeed -> IO ()
applyRandomSeed :: RandomSeed -> IO ()
applyRandomSeed RandomSeed
Don'tSeed = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
applyRandomSeed (SeedValue Word
n) = Word -> IO ()
forall a. Integral a => a -> IO ()
N.srand Word
n
applyRandomSeed RandomSeed
SeedFromTime = IO ()
N.srand_time

{- Random stuff -}

-- | This specifies the population size for algorithms that use a pool
-- of solutions.
newtype Population = Population Word deriving (Population -> Population -> Bool
(Population -> Population -> Bool)
-> (Population -> Population -> Bool) -> Eq Population
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Population -> Population -> Bool
$c/= :: Population -> Population -> Bool
== :: Population -> Population -> Bool
$c== :: Population -> Population -> Bool
Eq, Int -> Population -> ShowS
[Population] -> ShowS
Population -> String
(Int -> Population -> ShowS)
-> (Population -> String)
-> ([Population] -> ShowS)
-> Show Population
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Population] -> ShowS
$cshowList :: [Population] -> ShowS
show :: Population -> String
$cshow :: Population -> String
showsPrec :: Int -> Population -> ShowS
$cshowsPrec :: Int -> Population -> ShowS
Show, ReadPrec [Population]
ReadPrec Population
Int -> ReadS Population
ReadS [Population]
(Int -> ReadS Population)
-> ReadS [Population]
-> ReadPrec Population
-> ReadPrec [Population]
-> Read Population
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Population]
$creadListPrec :: ReadPrec [Population]
readPrec :: ReadPrec Population
$creadPrec :: ReadPrec Population
readList :: ReadS [Population]
$creadList :: ReadS [Population]
readsPrec :: Int -> ReadS Population
$creadsPrec :: Int -> ReadS Population
Read)

applyPopulation :: N.Opt -> Population -> IO N.Result
applyPopulation :: Opt -> Population -> IO Result
applyPopulation Opt
opt (Population Word
n) = Opt -> Word -> IO Result
N.set_population Opt
opt Word
n

-- | This specifies the memory size to be used by algorithms like
-- 'LBFGS' which store approximate Hessian or Jacobian matrices.
newtype VectorStorage = VectorStorage Word deriving (VectorStorage -> VectorStorage -> Bool
(VectorStorage -> VectorStorage -> Bool)
-> (VectorStorage -> VectorStorage -> Bool) -> Eq VectorStorage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VectorStorage -> VectorStorage -> Bool
$c/= :: VectorStorage -> VectorStorage -> Bool
== :: VectorStorage -> VectorStorage -> Bool
$c== :: VectorStorage -> VectorStorage -> Bool
Eq, Int -> VectorStorage -> ShowS
[VectorStorage] -> ShowS
VectorStorage -> String
(Int -> VectorStorage -> ShowS)
-> (VectorStorage -> String)
-> ([VectorStorage] -> ShowS)
-> Show VectorStorage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VectorStorage] -> ShowS
$cshowList :: [VectorStorage] -> ShowS
show :: VectorStorage -> String
$cshow :: VectorStorage -> String
showsPrec :: Int -> VectorStorage -> ShowS
$cshowsPrec :: Int -> VectorStorage -> ShowS
Show, ReadPrec [VectorStorage]
ReadPrec VectorStorage
Int -> ReadS VectorStorage
ReadS [VectorStorage]
(Int -> ReadS VectorStorage)
-> ReadS [VectorStorage]
-> ReadPrec VectorStorage
-> ReadPrec [VectorStorage]
-> Read VectorStorage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VectorStorage]
$creadListPrec :: ReadPrec [VectorStorage]
readPrec :: ReadPrec VectorStorage
$creadPrec :: ReadPrec VectorStorage
readList :: ReadS [VectorStorage]
$creadList :: ReadS [VectorStorage]
readsPrec :: Int -> ReadS VectorStorage
$creadsPrec :: Int -> ReadS VectorStorage
Read)

applyVectorStorage :: N.Opt -> VectorStorage -> IO N.Result
applyVectorStorage :: Opt -> VectorStorage -> IO Result
applyVectorStorage Opt
opt (VectorStorage Word
n) = Opt -> Word -> IO Result
N.set_vector_storage Opt
opt Word
n

-- | This vector with the same dimension as the parameter vector @x@
-- specifies the initial step for the optimizer to take.  (This
-- applies to local gradient-free algorithms, which cannot use
-- gradients to estimate how big a step to take.)
newtype InitialStep = InitialStep (Vector Double) deriving (InitialStep -> InitialStep -> Bool
(InitialStep -> InitialStep -> Bool)
-> (InitialStep -> InitialStep -> Bool) -> Eq InitialStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitialStep -> InitialStep -> Bool
$c/= :: InitialStep -> InitialStep -> Bool
== :: InitialStep -> InitialStep -> Bool
$c== :: InitialStep -> InitialStep -> Bool
Eq, Int -> InitialStep -> ShowS
[InitialStep] -> ShowS
InitialStep -> String
(Int -> InitialStep -> ShowS)
-> (InitialStep -> String)
-> ([InitialStep] -> ShowS)
-> Show InitialStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialStep] -> ShowS
$cshowList :: [InitialStep] -> ShowS
show :: InitialStep -> String
$cshow :: InitialStep -> String
showsPrec :: Int -> InitialStep -> ShowS
$cshowsPrec :: Int -> InitialStep -> ShowS
Show, ReadPrec [InitialStep]
ReadPrec InitialStep
Int -> ReadS InitialStep
ReadS [InitialStep]
(Int -> ReadS InitialStep)
-> ReadS [InitialStep]
-> ReadPrec InitialStep
-> ReadPrec [InitialStep]
-> Read InitialStep
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitialStep]
$creadListPrec :: ReadPrec [InitialStep]
readPrec :: ReadPrec InitialStep
$creadPrec :: ReadPrec InitialStep
readList :: ReadS [InitialStep]
$creadList :: ReadS [InitialStep]
readsPrec :: Int -> ReadS InitialStep
$creadsPrec :: Int -> ReadS InitialStep
Read)

applyInitialStep :: N.Opt -> InitialStep -> IO N.Result
applyInitialStep :: Opt -> InitialStep -> IO Result
applyInitialStep Opt
opt (InitialStep Vector Double
v) = Opt -> Vector Double -> IO Result
N.set_initial_step Opt
opt Vector Double
v

{- Algorithms -}

data GlobalProblem = GlobalProblem
  { GlobalProblem -> Vector Double
lowerBounds :: Vector Double        -- ^ Lower bounds for @x@
  , GlobalProblem -> Vector Double
upperBounds :: Vector Double        -- ^ Upper bounds for @x@
  , GlobalProblem -> NonEmpty StoppingCondition
gstop :: NonEmpty StoppingCondition -- ^ At least one stopping
                                        -- condition
  , GlobalProblem -> GlobalAlgorithm
galgorithm :: GlobalAlgorithm       -- ^ Algorithm specification
  }

-- | These are the global minimization algorithms provided by NLOPT.  Please see
-- <http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms the NLOPT algorithm manual>
-- for more details on how the methods work and how they relate to one another.
--
-- Optional parameters are wrapped in a 'Maybe'; for example, if you
-- see 'Maybe' 'Population', you can simply specify 'Nothing' to use
-- the default behavior.
data GlobalAlgorithm
    -- | DIviding RECTangles
  = DIRECT Objective
    -- | DIviding RECTangles, locally-biased variant
  | DIRECT_L Objective
    -- | DIviding RECTangles, "slightly randomized"
  | DIRECT_L_RAND Objective RandomSeed
    -- | DIviding RECTangles, unscaled version
  | DIRECT_NOSCAL Objective
    -- | DIviding RECTangles, locally-biased and unscaled
  | DIRECT_L_NOSCAL Objective
    -- | DIviding RECTangles, locally-biased, unscaled and "slightly
    -- randomized"
  | DIRECT_L_RAND_NOSCAL Objective RandomSeed
    -- | DIviding RECTangles, original FORTRAN implementation
  | ORIG_DIRECT Objective InequalityConstraints
    -- | DIviding RECTangles, locally-biased, original FORTRAN
    -- implementation
  | ORIG_DIRECT_L Objective InequalityConstraints
    -- | Stochastic Global Optimization.
    -- __This algorithm is only available if you have linked with @libnlopt_cxx@.__
  | STOGO ObjectiveD
    -- | Stochastic Global Optimization, randomized variant.
    -- __This algorithm is only available if you have linked with @libnlopt_cxx@.__
  | STOGO_RAND ObjectiveD RandomSeed
    -- | Controlled Random Search with Local Mutation
  | CRS2_LM Objective RandomSeed (Maybe Population)
    -- | Improved Stochastic Ranking Evolution Strategy
  | ISRES Objective InequalityConstraints EqualityConstraints RandomSeed (Maybe Population)
    -- | Evolutionary Algorithm
  | ESCH Objective
    -- | Original Multi-Level Single-Linkage
  | MLSL Objective LocalProblem (Maybe Population)
    -- | Multi-Level Single-Linkage with Sobol Low-Discrepancy
    -- Sequence for starting points
  | MLSL_LDS Objective LocalProblem (Maybe Population)

algorithmEnumOfGlobal :: GlobalAlgorithm -> N.Algorithm
algorithmEnumOfGlobal :: GlobalAlgorithm -> Algorithm
algorithmEnumOfGlobal (DIRECT ScalarConstraint
_)                 = Algorithm
N.GN_DIRECT
algorithmEnumOfGlobal (DIRECT_L ScalarConstraint
_)               = Algorithm
N.GN_DIRECT_L
algorithmEnumOfGlobal (DIRECT_L_RAND ScalarConstraint
_ RandomSeed
_)        = Algorithm
N.GN_DIRECT_L_RAND
algorithmEnumOfGlobal (DIRECT_NOSCAL ScalarConstraint
_)          = Algorithm
N.GN_DIRECT_NOSCAL
algorithmEnumOfGlobal (DIRECT_L_NOSCAL ScalarConstraint
_)        = Algorithm
N.GN_DIRECT_L_NOSCAL
algorithmEnumOfGlobal (DIRECT_L_RAND_NOSCAL ScalarConstraint
_ RandomSeed
_) = Algorithm
N.GN_DIRECT_L_RAND_NOSCAL
algorithmEnumOfGlobal (ORIG_DIRECT ScalarConstraint
_ InequalityConstraints
_)          = Algorithm
N.GN_ORIG_DIRECT
algorithmEnumOfGlobal (ORIG_DIRECT_L ScalarConstraint
_ InequalityConstraints
_)        = Algorithm
N.GN_ORIG_DIRECT_L
algorithmEnumOfGlobal (STOGO ScalarConstraintD
_)                  = Algorithm
N.GD_STOGO
algorithmEnumOfGlobal (STOGO_RAND ScalarConstraintD
_ RandomSeed
_)           = Algorithm
N.GD_STOGO_RAND
algorithmEnumOfGlobal (CRS2_LM ScalarConstraint
_ RandomSeed
_ Maybe Population
_)            = Algorithm
N.GN_CRS2_LM
algorithmEnumOfGlobal (ISRES ScalarConstraint
_ InequalityConstraints
_ EqualityConstraints
_ RandomSeed
_ Maybe Population
_)          = Algorithm
N.GN_ISRES
algorithmEnumOfGlobal (ESCH ScalarConstraint
_)                   = Algorithm
N.GN_ESCH
algorithmEnumOfGlobal (MLSL ScalarConstraint
_ LocalProblem
_ Maybe Population
_)               = Algorithm
N.G_MLSL
algorithmEnumOfGlobal (MLSL_LDS ScalarConstraint
_ LocalProblem
_ Maybe Population
_)           = Algorithm
N.G_MLSL_LDS

applyGlobalObjective :: N.Opt -> GlobalAlgorithm -> IO ()
applyGlobalObjective :: Opt -> GlobalAlgorithm -> IO ()
applyGlobalObjective Opt
opt GlobalAlgorithm
alg = GlobalAlgorithm -> IO ()
go GlobalAlgorithm
alg
  where
    obj :: ScalarConstraint -> IO ()
obj = IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (ScalarConstraint -> IO Result) -> ScalarConstraint -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> ObjectiveFunction ScalarConstraint -> IO Result
applyObjective Opt
opt (ObjectiveFunction ScalarConstraint -> IO Result)
-> (ScalarConstraint -> ObjectiveFunction ScalarConstraint)
-> ScalarConstraint
-> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarConstraint -> ObjectiveFunction ScalarConstraint
forall f. f -> ObjectiveFunction f
MinimumObjective
    objD :: ScalarConstraintD -> IO ()
objD = IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (ScalarConstraintD -> IO Result) -> ScalarConstraintD -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> ObjectiveFunction ScalarConstraintD -> IO Result
applyObjectiveD Opt
opt (ObjectiveFunction ScalarConstraintD -> IO Result)
-> (ScalarConstraintD -> ObjectiveFunction ScalarConstraintD)
-> ScalarConstraintD
-> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarConstraintD -> ObjectiveFunction ScalarConstraintD
forall f. f -> ObjectiveFunction f
MinimumObjective

    go :: GlobalAlgorithm -> IO ()
go (DIRECT ScalarConstraint
o)                 = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (DIRECT_L ScalarConstraint
o)               = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (DIRECT_NOSCAL ScalarConstraint
o)          = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (DIRECT_L_NOSCAL ScalarConstraint
o)        = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (ESCH ScalarConstraint
o)                   = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (STOGO ScalarConstraintD
o)                  = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (DIRECT_L_RAND ScalarConstraint
o RandomSeed
_)        = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (DIRECT_L_RAND_NOSCAL ScalarConstraint
o RandomSeed
_) = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (ORIG_DIRECT ScalarConstraint
o InequalityConstraints
_)          = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (ORIG_DIRECT_L ScalarConstraint
o InequalityConstraints
_)        = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (STOGO_RAND ScalarConstraintD
o RandomSeed
_)           = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (CRS2_LM ScalarConstraint
o RandomSeed
_ Maybe Population
_)            = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (ISRES ScalarConstraint
o InequalityConstraints
_ EqualityConstraints
_ RandomSeed
_ Maybe Population
_)          = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (MLSL ScalarConstraint
o LocalProblem
_ Maybe Population
_)               = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (MLSL_LDS ScalarConstraint
o LocalProblem
_ Maybe Population
_)           = ScalarConstraint -> IO ()
obj ScalarConstraint
o

applyGlobalAlgorithm :: N.Opt -> GlobalAlgorithm -> IO ()
applyGlobalAlgorithm :: Opt -> GlobalAlgorithm -> IO ()
applyGlobalAlgorithm Opt
opt GlobalAlgorithm
alg = do
  Opt -> GlobalAlgorithm -> IO ()
applyGlobalObjective Opt
opt GlobalAlgorithm
alg
  GlobalAlgorithm -> IO ()
go GlobalAlgorithm
alg
  where
    seed :: RandomSeed -> IO ()
seed = RandomSeed -> IO ()
applyRandomSeed
    pop :: Maybe Population -> IO ()
pop = IO () -> (Population -> IO ()) -> Maybe Population -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (Population -> IO Result) -> Population -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> Population -> IO Result
applyPopulation Opt
opt)
    ic :: InequalityConstraints -> IO ()
ic = (InequalityConstraint ScalarConstraint VectorConstraint -> IO ())
-> InequalityConstraints -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (InequalityConstraint ScalarConstraint VectorConstraint
    -> IO Result)
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    ec :: EqualityConstraints -> IO ()
ec = (EqualityConstraint ScalarConstraint VectorConstraint -> IO ())
-> EqualityConstraints -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (EqualityConstraint ScalarConstraint VectorConstraint
    -> IO Result)
-> EqualityConstraint ScalarConstraint VectorConstraint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> EqualityConstraint ScalarConstraint VectorConstraint
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)

    local :: LocalProblem -> IO Result
local LocalProblem
lp = LocalProblem -> IO Opt
setupLocalProblem LocalProblem
lp IO Opt -> (Opt -> IO Result) -> IO Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Opt -> Opt -> IO Result
N.set_local_optimizer Opt
opt

    go :: GlobalAlgorithm -> IO ()
go (DIRECT_L_RAND ScalarConstraint
_ RandomSeed
s)        = RandomSeed -> IO ()
seed RandomSeed
s
    go (DIRECT_L_RAND_NOSCAL ScalarConstraint
_ RandomSeed
s) = RandomSeed -> IO ()
seed RandomSeed
s
    go (ORIG_DIRECT ScalarConstraint
_ InequalityConstraints
ineq)       = InequalityConstraints -> IO ()
ic InequalityConstraints
ineq
    go (ORIG_DIRECT_L ScalarConstraint
_ InequalityConstraints
ineq)     = InequalityConstraints -> IO ()
ic InequalityConstraints
ineq
    go (STOGO_RAND ScalarConstraintD
_ RandomSeed
s)           = RandomSeed -> IO ()
seed RandomSeed
s
    go (CRS2_LM ScalarConstraint
_ RandomSeed
s Maybe Population
p)            = RandomSeed -> IO ()
seed RandomSeed
s IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Population -> IO ()
pop Maybe Population
p
    go (ISRES ScalarConstraint
_ InequalityConstraints
ineq EqualityConstraints
eq RandomSeed
s Maybe Population
p)      = InequalityConstraints -> IO ()
ic InequalityConstraints
ineq IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> EqualityConstraints -> IO ()
ec EqualityConstraints
eq IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RandomSeed -> IO ()
seed RandomSeed
s IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Population -> IO ()
pop Maybe Population
p
    go (MLSL ScalarConstraint
_ LocalProblem
lp Maybe Population
p)              = LocalProblem -> IO Result
local LocalProblem
lp IO Result -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Population -> IO ()
pop Maybe Population
p
    go (MLSL_LDS ScalarConstraint
_ LocalProblem
lp Maybe Population
p)          = LocalProblem -> IO Result
local LocalProblem
lp IO Result -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Population -> IO ()
pop Maybe Population
p
    go GlobalAlgorithm
_                          = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tryTo :: IO N.Result -> IO ()
tryTo :: IO Result -> IO ()
tryTo IO Result
act = do
  Result
result <- IO Result
act
  if (Result -> Bool
N.isSuccess Result
result)
    then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else NloptException -> IO ()
forall a e. Exception e => e -> a
Ex.throw (NloptException -> IO ()) -> NloptException -> IO ()
forall a b. (a -> b) -> a -> b
$ Result -> NloptException
NloptException Result
result

data NloptException = NloptException N.Result deriving (Int -> NloptException -> ShowS
[NloptException] -> ShowS
NloptException -> String
(Int -> NloptException -> ShowS)
-> (NloptException -> String)
-> ([NloptException] -> ShowS)
-> Show NloptException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NloptException] -> ShowS
$cshowList :: [NloptException] -> ShowS
show :: NloptException -> String
$cshow :: NloptException -> String
showsPrec :: Int -> NloptException -> ShowS
$cshowsPrec :: Int -> NloptException -> ShowS
Show, Typeable)
instance Exception NloptException

-- | Solve the specified global optimization problem.
--
-- = Example program
--
-- The following interactive session example uses the 'ISRES'
-- algorithm, a stochastic, derivative-free global optimizer, to
-- minimize a trivial function with a minimum of 22.0 at @(0, 0)@.
-- The search is conducted within a box from -10 to 10 in each
-- dimension.
--
-- >>> import Numeric.LinearAlgebra ( dot, fromList )
-- >>> let objf x = x `dot` x + 22                              -- define objective
-- >>> let stop = ObjectiveRelativeTolerance 1e-12 :| []        -- define stopping criterion
-- >>> let algorithm = ISRES objf [] [] (SeedValue 22) Nothing  -- specify algorithm
-- >>> let lowerbounds = fromList [-10, -10]                    -- specify bounds
-- >>> let upperbounds = fromList [10, 10]                      -- specify bounds
-- >>> let problem = GlobalProblem lowerbounds upperbounds stop algorithm
-- >>> let x0 = fromList [5, 8]                                 -- specify initial guess
-- >>> minimizeGlobal problem x0
-- Right (Solution {solutionCost = 22.000000000002807, solutionParams = [-1.660591102367038e-6,2.2407062393213684e-7], solutionResult = FTOL_REACHED})
minimizeGlobal :: GlobalProblem  -- ^ Problem specification
               -> Vector Double  -- ^ Initial parameter guess
               -> Either N.Result Solution  -- ^ Optimization results
minimizeGlobal :: GlobalProblem -> Vector Double -> Either Result Solution
minimizeGlobal GlobalProblem
prob Vector Double
x0 =
  IO (Either Result Solution) -> Either Result Solution
forall a. IO a -> a
unsafePerformIO (IO (Either Result Solution) -> Either Result Solution)
-> IO (Either Result Solution) -> Either Result Solution
forall a b. (a -> b) -> a -> b
$ (Solution -> Either Result Solution
forall a b. b -> Either a b
Right (Solution -> Either Result Solution)
-> IO Solution -> IO (Either Result Solution)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GlobalProblem -> Vector Double -> IO Solution
minimizeGlobal' GlobalProblem
prob Vector Double
x0) IO (Either Result Solution)
-> (NloptException -> IO (Either Result Solution))
-> IO (Either Result Solution)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Ex.catch` NloptException -> IO (Either Result Solution)
forall a. NloptException -> IO (Either Result a)
handler
  where
    handler :: NloptException -> IO (Either N.Result a)
    handler :: forall a. NloptException -> IO (Either Result a)
handler (NloptException Result
retcode) = Either Result a -> IO (Either Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Result a -> IO (Either Result a))
-> Either Result a -> IO (Either Result a)
forall a b. (a -> b) -> a -> b
$ Result -> Either Result a
forall a b. a -> Either a b
Left Result
retcode

applyGlobalProblem :: N.Opt -> GlobalProblem -> IO ()
applyGlobalProblem :: Opt -> GlobalProblem -> IO ()
applyGlobalProblem Opt
opt (GlobalProblem Vector Double
lb Vector Double
ub NonEmpty StoppingCondition
stop GlobalAlgorithm
alg) = do
  IO Result -> IO ()
tryTo (IO Result -> IO ()) -> IO Result -> IO ()
forall a b. (a -> b) -> a -> b
$ Opt -> Bounds -> IO Result
applyBounds Opt
opt (Vector Double -> Bounds
LowerBounds Vector Double
lb)
  IO Result -> IO ()
tryTo (IO Result -> IO ()) -> IO Result -> IO ()
forall a b. (a -> b) -> a -> b
$ Opt -> Bounds -> IO Result
applyBounds Opt
opt (Vector Double -> Bounds
UpperBounds Vector Double
ub)
  (StoppingCondition -> IO ()) -> NonEmpty StoppingCondition -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (StoppingCondition -> IO Result) -> StoppingCondition -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> StoppingCondition -> IO Result
applyStoppingCondition Opt
opt) NonEmpty StoppingCondition
stop
  Opt -> GlobalAlgorithm -> IO ()
applyGlobalAlgorithm Opt
opt GlobalAlgorithm
alg

newOpt :: N.Algorithm -> Word -> IO N.Opt
newOpt :: Algorithm -> Word -> IO Opt
newOpt Algorithm
alg Word
sz = do
  Maybe Opt
opt' <- Algorithm -> Word -> IO (Maybe Opt)
N.create Algorithm
alg Word
sz
  case Maybe Opt
opt' of
    Maybe Opt
Nothing -> NloptException -> IO Opt
forall a e. Exception e => e -> a
Ex.throw (NloptException -> IO Opt) -> NloptException -> IO Opt
forall a b. (a -> b) -> a -> b
$ Result -> NloptException
NloptException Result
N.FAILURE
    Just Opt
opt -> Opt -> IO Opt
forall (m :: * -> *) a. Monad m => a -> m a
return Opt
opt

setupGlobalProblem :: GlobalProblem -> IO N.Opt
setupGlobalProblem :: GlobalProblem -> IO Opt
setupGlobalProblem gp :: GlobalProblem
gp@(GlobalProblem Vector Double
_ Vector Double
_ NonEmpty StoppingCondition
_ GlobalAlgorithm
alg) = do
  Opt
opt <- Algorithm -> Word -> IO Opt
newOpt (GlobalAlgorithm -> Algorithm
algorithmEnumOfGlobal GlobalAlgorithm
alg) (GlobalProblem -> Word
forall c. ProblemSize c => c -> Word
problemSize GlobalProblem
gp)
  Opt -> GlobalProblem -> IO ()
applyGlobalProblem Opt
opt GlobalProblem
gp
  Opt -> IO Opt
forall (m :: * -> *) a. Monad m => a -> m a
return Opt
opt

solveProblem :: N.Opt -> Vector Double -> IO Solution
solveProblem :: Opt -> Vector Double -> IO Solution
solveProblem Opt
opt Vector Double
x0 = do
  (N.Output Result
outret Double
outcost Vector Double
outx) <- Opt -> Vector Double -> IO Output
N.optimize Opt
opt Vector Double
x0
  if (Result -> Bool
N.isSuccess Result
outret)
    then Solution -> IO Solution
forall (m :: * -> *) a. Monad m => a -> m a
return (Solution -> IO Solution) -> Solution -> IO Solution
forall a b. (a -> b) -> a -> b
$ Double -> Vector Double -> Result -> Solution
Solution Double
outcost Vector Double
outx Result
outret
    else NloptException -> IO Solution
forall a e. Exception e => e -> a
Ex.throw (NloptException -> IO Solution) -> NloptException -> IO Solution
forall a b. (a -> b) -> a -> b
$ Result -> NloptException
NloptException Result
outret

minimizeGlobal' :: GlobalProblem -> Vector Double -> IO Solution
minimizeGlobal' :: GlobalProblem -> Vector Double -> IO Solution
minimizeGlobal' GlobalProblem
gp Vector Double
x0 = do
  Opt
opt <- GlobalProblem -> IO Opt
setupGlobalProblem GlobalProblem
gp
  Opt -> Vector Double -> IO Solution
solveProblem Opt
opt Vector Double
x0

data LocalProblem = LocalProblem
  { LocalProblem -> Word
lsize :: Word                       -- ^ The dimension of the
                                        -- parameter vector.
  , LocalProblem -> NonEmpty StoppingCondition
lstop :: NonEmpty StoppingCondition -- ^ At least one stopping
                                        -- condition
  , LocalProblem -> LocalAlgorithm
lalgorithm :: LocalAlgorithm        -- ^ Algorithm specification
  }

-- | These are the local minimization algorithms provided by NLOPT.  Please see
-- <http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms the NLOPT algorithm manual>
-- for more details on how the methods work and how they relate to one
-- another.  Note that some local methods require you provide
-- derivatives (gradients or Jacobians) for your objective function
-- and constraint functions.
--
-- Optional parameters are wrapped in a 'Maybe'; for example, if you
-- see 'Maybe' 'VectorStorage', you can simply specify 'Nothing' to
-- use the default behavior.
data LocalAlgorithm
    -- | Limited-memory BFGS
  = LBFGS_NOCEDAL ObjectiveD (Maybe VectorStorage)
    -- | Limited-memory BFGS
  | LBFGS ObjectiveD (Maybe VectorStorage)
    -- | Shifted limited-memory variable-metric, rank-2
  | VAR2 ObjectiveD (Maybe VectorStorage)
    -- | Shifted limited-memory variable-metric, rank-1
  | VAR1 ObjectiveD (Maybe VectorStorage)
    -- | Truncated Newton's method
  | TNEWTON ObjectiveD (Maybe VectorStorage)
    -- | Truncated Newton's method with automatic restarting
  | TNEWTON_RESTART ObjectiveD (Maybe VectorStorage)
    -- | Preconditioned truncated Newton's method
  | TNEWTON_PRECOND ObjectiveD (Maybe VectorStorage)
    -- | Preconditioned truncated Newton's method with automatic
    -- restarting
  | TNEWTON_PRECOND_RESTART ObjectiveD (Maybe VectorStorage)
    -- | Method of moving averages
  | MMA ObjectiveD InequalityConstraintsD
    -- | Sequential Least-Squares Quadratic Programming
  | SLSQP ObjectiveD [Bounds] InequalityConstraintsD EqualityConstraintsD
    -- | Conservative Convex Separable Approximation
  | CCSAQ ObjectiveD Preconditioner
    -- | PRincipal AXIS gradient-free local optimization
  | PRAXIS Objective [Bounds] (Maybe InitialStep)
    -- | Constrained Optimization BY Linear Approximations
  | COBYLA Objective [Bounds] InequalityConstraints EqualityConstraints
    (Maybe InitialStep)
    -- | Powell's NEWUOA algorithm
  | NEWUOA Objective (Maybe InitialStep)
    -- | Powell's NEWUOA algorithm with bounds by SGJ
  | NEWUOA_BOUND Objective [Bounds] (Maybe InitialStep)
    -- | Nelder-Mead Simplex gradient-free method
  | NELDERMEAD Objective [Bounds] (Maybe InitialStep)
    -- | NLOPT implementation of Rowan's Subplex algorithm
  | SBPLX Objective [Bounds] (Maybe InitialStep)
    -- | Bounded Optimization BY Quadratic Approximations
  | BOBYQA Objective [Bounds] (Maybe InitialStep)

algorithmEnumOfLocal :: LocalAlgorithm -> N.Algorithm
algorithmEnumOfLocal :: LocalAlgorithm -> Algorithm
algorithmEnumOfLocal (LBFGS_NOCEDAL ScalarConstraintD
_ Maybe VectorStorage
_)           = Algorithm
N.LD_LBFGS_NOCEDAL
algorithmEnumOfLocal (LBFGS ScalarConstraintD
_ Maybe VectorStorage
_)                   = Algorithm
N.LD_LBFGS
algorithmEnumOfLocal (VAR2 ScalarConstraintD
_ Maybe VectorStorage
_)                    = Algorithm
N.LD_VAR2
algorithmEnumOfLocal (VAR1 ScalarConstraintD
_ Maybe VectorStorage
_)                    = Algorithm
N.LD_VAR1
algorithmEnumOfLocal (TNEWTON ScalarConstraintD
_ Maybe VectorStorage
_)                 = Algorithm
N.LD_TNEWTON
algorithmEnumOfLocal (TNEWTON_RESTART ScalarConstraintD
_ Maybe VectorStorage
_)         = Algorithm
N.LD_TNEWTON_RESTART
algorithmEnumOfLocal (TNEWTON_PRECOND ScalarConstraintD
_ Maybe VectorStorage
_)         = Algorithm
N.LD_TNEWTON_PRECOND
algorithmEnumOfLocal (TNEWTON_PRECOND_RESTART ScalarConstraintD
_ Maybe VectorStorage
_) = Algorithm
N.LD_TNEWTON_PRECOND_RESTART
algorithmEnumOfLocal (MMA ScalarConstraintD
_ InequalityConstraintsD
_)                     = Algorithm
N.LD_MMA
algorithmEnumOfLocal (SLSQP ScalarConstraintD
_ [Bounds]
_ InequalityConstraintsD
_ EqualityConstraintsD
_)               = Algorithm
N.LD_SLSQP
algorithmEnumOfLocal (CCSAQ ScalarConstraintD
_ Vector Double -> Vector Double -> Vector Double
_)                   = Algorithm
N.LD_CCSAQ
algorithmEnumOfLocal (PRAXIS ScalarConstraint
_ [Bounds]
_ Maybe InitialStep
_)                = Algorithm
N.LN_PRAXIS
algorithmEnumOfLocal (COBYLA ScalarConstraint
_ [Bounds]
_ InequalityConstraints
_ EqualityConstraints
_ Maybe InitialStep
_)            = Algorithm
N.LN_COBYLA
algorithmEnumOfLocal (NEWUOA ScalarConstraint
_ Maybe InitialStep
_)                  = Algorithm
N.LN_NEWUOA
algorithmEnumOfLocal (NEWUOA_BOUND ScalarConstraint
_ [Bounds]
_ Maybe InitialStep
_)          = Algorithm
N.LN_NEWUOA
algorithmEnumOfLocal (NELDERMEAD ScalarConstraint
_ [Bounds]
_ Maybe InitialStep
_)            = Algorithm
N.LN_NELDERMEAD
algorithmEnumOfLocal (SBPLX ScalarConstraint
_ [Bounds]
_ Maybe InitialStep
_)                 = Algorithm
N.LN_SBPLX
algorithmEnumOfLocal (BOBYQA ScalarConstraint
_ [Bounds]
_ Maybe InitialStep
_)                = Algorithm
N.LN_BOBYQA

applyLocalObjective :: N.Opt -> LocalAlgorithm -> IO ()
applyLocalObjective :: Opt -> LocalAlgorithm -> IO ()
applyLocalObjective Opt
opt LocalAlgorithm
alg = LocalAlgorithm -> IO ()
go LocalAlgorithm
alg
  where
    obj :: ScalarConstraint -> IO ()
obj = IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (ScalarConstraint -> IO Result) -> ScalarConstraint -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> ObjectiveFunction ScalarConstraint -> IO Result
applyObjective Opt
opt (ObjectiveFunction ScalarConstraint -> IO Result)
-> (ScalarConstraint -> ObjectiveFunction ScalarConstraint)
-> ScalarConstraint
-> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarConstraint -> ObjectiveFunction ScalarConstraint
forall f. f -> ObjectiveFunction f
MinimumObjective
    objD :: ScalarConstraintD -> IO ()
objD = IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (ScalarConstraintD -> IO Result) -> ScalarConstraintD -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> ObjectiveFunction ScalarConstraintD -> IO Result
applyObjectiveD Opt
opt (ObjectiveFunction ScalarConstraintD -> IO Result)
-> (ScalarConstraintD -> ObjectiveFunction ScalarConstraintD)
-> ScalarConstraintD
-> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarConstraintD -> ObjectiveFunction ScalarConstraintD
forall f. f -> ObjectiveFunction f
MinimumObjective
    precond :: (Vector Double -> Vector Double -> Vector Double)
-> ScalarConstraintD -> IO ()
precond Vector Double -> Vector Double -> Vector Double
p = IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (ScalarConstraintD -> IO Result) -> ScalarConstraintD -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> ObjectiveFunction ScalarConstraintD -> IO Result
applyObjectiveD Opt
opt (ObjectiveFunction ScalarConstraintD -> IO Result)
-> (ScalarConstraintD -> ObjectiveFunction ScalarConstraintD)
-> ScalarConstraintD
-> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Double -> Vector Double -> Vector Double)
-> ScalarConstraintD -> ObjectiveFunction ScalarConstraintD
forall f.
(Vector Double -> Vector Double -> Vector Double)
-> f -> ObjectiveFunction f
PreconditionedMinimumObjective Vector Double -> Vector Double -> Vector Double
p

    go :: LocalAlgorithm -> IO ()
go (LBFGS_NOCEDAL ScalarConstraintD
o Maybe VectorStorage
_)           = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (LBFGS ScalarConstraintD
o Maybe VectorStorage
_)                   = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (VAR2 ScalarConstraintD
o Maybe VectorStorage
_)                    = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (VAR1 ScalarConstraintD
o Maybe VectorStorage
_)                    = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (TNEWTON ScalarConstraintD
o Maybe VectorStorage
_)                 = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (TNEWTON_RESTART ScalarConstraintD
o Maybe VectorStorage
_)         = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (TNEWTON_PRECOND ScalarConstraintD
o Maybe VectorStorage
_)         = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (TNEWTON_PRECOND_RESTART ScalarConstraintD
o Maybe VectorStorage
_) = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (MMA ScalarConstraintD
o InequalityConstraintsD
_)                     = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (SLSQP ScalarConstraintD
o [Bounds]
_ InequalityConstraintsD
_ EqualityConstraintsD
_)               = ScalarConstraintD -> IO ()
objD ScalarConstraintD
o
    go (CCSAQ ScalarConstraintD
o Vector Double -> Vector Double -> Vector Double
prec)                = (Vector Double -> Vector Double -> Vector Double)
-> ScalarConstraintD -> IO ()
precond Vector Double -> Vector Double -> Vector Double
prec ScalarConstraintD
o
    go (PRAXIS ScalarConstraint
o [Bounds]
_ Maybe InitialStep
_)                = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (COBYLA ScalarConstraint
o [Bounds]
_ InequalityConstraints
_ EqualityConstraints
_ Maybe InitialStep
_)            = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (NEWUOA ScalarConstraint
o Maybe InitialStep
_)                  = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (NEWUOA_BOUND ScalarConstraint
o [Bounds]
_ Maybe InitialStep
_)          = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (NELDERMEAD ScalarConstraint
o [Bounds]
_ Maybe InitialStep
_)            = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (SBPLX ScalarConstraint
o [Bounds]
_ Maybe InitialStep
_)                 = ScalarConstraint -> IO ()
obj ScalarConstraint
o
    go (BOBYQA ScalarConstraint
o [Bounds]
_ Maybe InitialStep
_)                = ScalarConstraint -> IO ()
obj ScalarConstraint
o

applyLocalAlgorithm :: N.Opt -> LocalAlgorithm -> IO ()
applyLocalAlgorithm :: Opt -> LocalAlgorithm -> IO ()
applyLocalAlgorithm Opt
opt LocalAlgorithm
alg = do
  Opt -> LocalAlgorithm -> IO ()
applyLocalObjective Opt
opt LocalAlgorithm
alg
  LocalAlgorithm -> IO ()
go LocalAlgorithm
alg
  where
    ic :: InequalityConstraints -> IO ()
ic = (InequalityConstraint ScalarConstraint VectorConstraint -> IO ())
-> InequalityConstraints -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (InequalityConstraint ScalarConstraint VectorConstraint
    -> IO Result)
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    icd :: InequalityConstraintsD -> IO ()
icd = (InequalityConstraint ScalarConstraintD VectorConstraintD -> IO ())
-> InequalityConstraintsD -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (InequalityConstraint ScalarConstraintD VectorConstraintD
    -> IO Result)
-> InequalityConstraint ScalarConstraintD VectorConstraintD
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> InequalityConstraint ScalarConstraintD VectorConstraintD
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    ec :: EqualityConstraints -> IO ()
ec = (EqualityConstraint ScalarConstraint VectorConstraint -> IO ())
-> EqualityConstraints -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (EqualityConstraint ScalarConstraint VectorConstraint
    -> IO Result)
-> EqualityConstraint ScalarConstraint VectorConstraint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> EqualityConstraint ScalarConstraint VectorConstraint
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    ecd :: EqualityConstraintsD -> IO ()
ecd = (EqualityConstraint ScalarConstraintD VectorConstraintD -> IO ())
-> EqualityConstraintsD -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (EqualityConstraint ScalarConstraintD VectorConstraintD
    -> IO Result)
-> EqualityConstraint ScalarConstraintD VectorConstraintD
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> EqualityConstraint ScalarConstraintD VectorConstraintD
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    store :: Maybe VectorStorage -> IO ()
store = IO () -> (VectorStorage -> IO ()) -> Maybe VectorStorage -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (VectorStorage -> IO Result) -> VectorStorage -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> VectorStorage -> IO Result
applyVectorStorage Opt
opt)
    bound :: [Bounds] -> IO ()
bound = (Bounds -> IO ()) -> [Bounds] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ()) -> (Bounds -> IO Result) -> Bounds -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> Bounds -> IO Result
applyBounds Opt
opt)
    step0 :: Maybe InitialStep -> IO ()
step0 = IO () -> (InitialStep -> IO ()) -> Maybe InitialStep -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (InitialStep -> IO Result) -> InitialStep -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> InitialStep -> IO Result
applyInitialStep Opt
opt)

    go :: LocalAlgorithm -> IO ()
go (LBFGS_NOCEDAL ScalarConstraintD
_ Maybe VectorStorage
vs)           = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (LBFGS ScalarConstraintD
_ Maybe VectorStorage
vs)                   = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (VAR2 ScalarConstraintD
_ Maybe VectorStorage
vs)                    = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (VAR1 ScalarConstraintD
_ Maybe VectorStorage
vs)                    = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (TNEWTON ScalarConstraintD
_ Maybe VectorStorage
vs)                 = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (TNEWTON_RESTART ScalarConstraintD
_ Maybe VectorStorage
vs)         = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (TNEWTON_PRECOND ScalarConstraintD
_ Maybe VectorStorage
vs)         = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (TNEWTON_PRECOND_RESTART ScalarConstraintD
_ Maybe VectorStorage
vs) = Maybe VectorStorage -> IO ()
store Maybe VectorStorage
vs
    go (MMA ScalarConstraintD
_ InequalityConstraintsD
ineqd)                  = InequalityConstraintsD -> IO ()
icd InequalityConstraintsD
ineqd
    go (SLSQP ScalarConstraintD
_ [Bounds]
b InequalityConstraintsD
ineqd EqualityConstraintsD
eqd)          =
      [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InequalityConstraintsD -> IO ()
icd InequalityConstraintsD
ineqd IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> EqualityConstraintsD -> IO ()
ecd EqualityConstraintsD
eqd
    go (CCSAQ ScalarConstraintD
_ Vector Double -> Vector Double -> Vector Double
_   )                 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (PRAXIS ScalarConstraint
_ [Bounds]
b Maybe InitialStep
s)                 = [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s
    go (COBYLA ScalarConstraint
_ [Bounds]
b InequalityConstraints
ineq EqualityConstraints
eq Maybe InitialStep
s)         =
      [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InequalityConstraints -> IO ()
ic InequalityConstraints
ineq IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> EqualityConstraints -> IO ()
ec EqualityConstraints
eq IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s
    go (NEWUOA ScalarConstraint
_ Maybe InitialStep
s)                   = Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s
    go (NEWUOA_BOUND ScalarConstraint
_ [Bounds]
b Maybe InitialStep
s)           = [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s
    go (NELDERMEAD ScalarConstraint
_ [Bounds]
b Maybe InitialStep
s)             = [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s
    go (SBPLX ScalarConstraint
_ [Bounds]
b Maybe InitialStep
s)                  = [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s
    go (BOBYQA ScalarConstraint
_ [Bounds]
b Maybe InitialStep
s)                 = [Bounds] -> IO ()
bound [Bounds]
b IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe InitialStep -> IO ()
step0 Maybe InitialStep
s

applyLocalProblem :: N.Opt -> LocalProblem -> IO ()
applyLocalProblem :: Opt -> LocalProblem -> IO ()
applyLocalProblem Opt
opt (LocalProblem Word
_ NonEmpty StoppingCondition
stop LocalAlgorithm
alg) = do
  (StoppingCondition -> IO ()) -> NonEmpty StoppingCondition -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (StoppingCondition -> IO Result) -> StoppingCondition -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt -> StoppingCondition -> IO Result
applyStoppingCondition Opt
opt) NonEmpty StoppingCondition
stop
  Opt -> LocalAlgorithm -> IO ()
applyLocalAlgorithm Opt
opt LocalAlgorithm
alg

setupLocalProblem :: LocalProblem -> IO N.Opt
setupLocalProblem :: LocalProblem -> IO Opt
setupLocalProblem lp :: LocalProblem
lp@(LocalProblem Word
sz NonEmpty StoppingCondition
_ LocalAlgorithm
alg) = do
  Opt
opt <- Algorithm -> Word -> IO Opt
newOpt (LocalAlgorithm -> Algorithm
algorithmEnumOfLocal LocalAlgorithm
alg) Word
sz
  Opt -> LocalProblem -> IO ()
applyLocalProblem Opt
opt LocalProblem
lp
  Opt -> IO Opt
forall (m :: * -> *) a. Monad m => a -> m a
return Opt
opt

minimizeLocal' :: LocalProblem -> Vector Double -> IO Solution
minimizeLocal' :: LocalProblem -> Vector Double -> IO Solution
minimizeLocal' LocalProblem
lp Vector Double
x0 = do
  Opt
opt <- LocalProblem -> IO Opt
setupLocalProblem LocalProblem
lp
  Opt -> Vector Double -> IO Solution
solveProblem Opt
opt Vector Double
x0

-- |
-- == Example program
--
-- The following interactive session example enforces the same scalar
-- constraint as the nonlinear constraint example, but this time it
-- uses the SLSQP solver to find the minimum.
--
-- >>> import Numeric.LinearAlgebra ( dot, fromList, toList, scale )
-- >>> let objf x = (x `dot` x + 22, 2 `scale` x)
-- >>> let stop = ObjectiveRelativeTolerance 1e-9 :| []
-- >>> let constraintf x = (sum (toList x) - 1.0, fromList [1, 1])
-- >>> let constraint = EqualityConstraint (Scalar constraintf) 1e-6
-- >>> let algorithm = SLSQP objf [] [] [constraint]
-- >>> let problem = LocalProblem 2 stop algorithm
-- >>> let x0 = fromList [5, 10]
-- >>> minimizeLocal problem x0
-- Right (Solution {solutionCost = 22.5, solutionParams = [0.4999999999999998,0.5000000000000002], solutionResult = FTOL_REACHED})
minimizeLocal :: LocalProblem -> Vector Double -> Either N.Result Solution
minimizeLocal :: LocalProblem -> Vector Double -> Either Result Solution
minimizeLocal LocalProblem
prob Vector Double
x0 =
  IO (Either Result Solution) -> Either Result Solution
forall a. IO a -> a
unsafePerformIO (IO (Either Result Solution) -> Either Result Solution)
-> IO (Either Result Solution) -> Either Result Solution
forall a b. (a -> b) -> a -> b
$ (Solution -> Either Result Solution
forall a b. b -> Either a b
Right (Solution -> Either Result Solution)
-> IO Solution -> IO (Either Result Solution)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalProblem -> Vector Double -> IO Solution
minimizeLocal' LocalProblem
prob Vector Double
x0) IO (Either Result Solution)
-> (NloptException -> IO (Either Result Solution))
-> IO (Either Result Solution)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Ex.catch` NloptException -> IO (Either Result Solution)
forall a. NloptException -> IO (Either Result a)
handler
  where
    handler :: NloptException -> IO (Either N.Result a)
    handler :: forall a. NloptException -> IO (Either Result a)
handler (NloptException Result
retcode) = Either Result a -> IO (Either Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Result a -> IO (Either Result a))
-> Either Result a -> IO (Either Result a)
forall a b. (a -> b) -> a -> b
$ Result -> Either Result a
forall a b. a -> Either a b
Left Result
retcode

class ProblemSize c where
  problemSize :: c -> Word

instance ProblemSize LocalProblem where
  problemSize :: LocalProblem -> Word
problemSize = LocalProblem -> Word
lsize

instance ProblemSize GlobalProblem where
  problemSize :: GlobalProblem -> Word
problemSize = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (GlobalProblem -> Int) -> GlobalProblem -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Int
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
HM.size (Vector Double -> Int)
-> (GlobalProblem -> Vector Double) -> GlobalProblem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalProblem -> Vector Double
lowerBounds

instance ProblemSize AugLagProblem where
  problemSize :: AugLagProblem -> Word
problemSize (AugLagProblem EqualityConstraints
_ EqualityConstraintsD
_ AugLagAlgorithm
alg) = case AugLagAlgorithm
alg of
    AUGLAG_LOCAL LocalProblem
lp InequalityConstraints
_ InequalityConstraintsD
_  -> LocalProblem -> Word
forall c. ProblemSize c => c -> Word
problemSize LocalProblem
lp
    AUGLAG_EQ_LOCAL LocalProblem
lp   -> LocalProblem -> Word
forall c. ProblemSize c => c -> Word
problemSize LocalProblem
lp
    AUGLAG_GLOBAL GlobalProblem
gp InequalityConstraints
_ InequalityConstraintsD
_ -> GlobalProblem -> Word
forall c. ProblemSize c => c -> Word
problemSize GlobalProblem
gp
    AUGLAG_EQ_GLOBAL GlobalProblem
gp  -> GlobalProblem -> Word
forall c. ProblemSize c => c -> Word
problemSize GlobalProblem
gp


-- | __IMPORTANT NOTE__
--
-- For augmented lagrangian problems, you, the user, are responsible
-- for providing the appropriate type of constraint.  If the
-- subsidiary problem requires an `ObjectiveD`, then you should
-- provide constraint functions with derivatives.  If the subsidiary
-- problem requires an `Objective`, you should provide constraint
-- functions without derivatives.  If you don't do this, you may get a
-- runtime error.
data AugLagProblem = AugLagProblem
  { AugLagProblem -> EqualityConstraints
alEquality :: EqualityConstraints   -- ^ Possibly empty set of
                                        -- equality constraints
  , AugLagProblem -> EqualityConstraintsD
alEqualityD :: EqualityConstraintsD -- ^ Possibly empty set of
                                        -- equality constraints with
                                        -- derivatives
  , AugLagProblem -> AugLagAlgorithm
alalgorithm :: AugLagAlgorithm      -- ^ Algorithm specification.
  }

-- | The Augmented Lagrangian solvers allow you to enforce nonlinear
-- constraints while using local or global algorithms that don't
-- natively support them.  The subsidiary problem is used to do the
-- minimization, but the @AUGLAG@ methods modify the objective to
-- enforce the constraints.  Please see
-- <http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms the NLOPT algorithm manual>
-- for more details on how the methods work and how they relate to one another.
--
-- See the documentation for 'AugLagProblem' for an important note
-- about the constraint functions.
data AugLagAlgorithm
    -- | AUGmented LAGrangian with a local subsidiary method
  = AUGLAG_LOCAL LocalProblem InequalityConstraints InequalityConstraintsD
    -- | AUGmented LAGrangian with a local subsidiary method and with
    -- penalty functions only for equality constraints
  | AUGLAG_EQ_LOCAL LocalProblem
    -- | AUGmented LAGrangian with a global subsidiary method
  | AUGLAG_GLOBAL GlobalProblem InequalityConstraints InequalityConstraintsD
    -- | AUGmented LAGrangian with a global subsidiary method and with
    -- penalty functions only for equality constraints.
  | AUGLAG_EQ_GLOBAL GlobalProblem

algorithmEnumOfAugLag :: AugLagAlgorithm -> N.Algorithm
algorithmEnumOfAugLag :: AugLagAlgorithm -> Algorithm
algorithmEnumOfAugLag (AUGLAG_LOCAL LocalProblem
_ InequalityConstraints
_ InequalityConstraintsD
_) = Algorithm
N.AUGLAG
algorithmEnumOfAugLag (AUGLAG_EQ_LOCAL LocalProblem
_) = Algorithm
N.AUGLAG_EQ
algorithmEnumOfAugLag (AUGLAG_GLOBAL GlobalProblem
_ InequalityConstraints
_ InequalityConstraintsD
_) = Algorithm
N.AUGLAG
algorithmEnumOfAugLag (AUGLAG_EQ_GLOBAL GlobalProblem
_) = Algorithm
N.AUGLAG_EQ

-- | This structure is returned in the event of a successful
-- optimization.
data Solution = Solution
  { Solution -> Double
solutionCost :: Double          -- ^ The objective function value
                                    -- at the minimum
  , Solution -> Vector Double
solutionParams :: Vector Double -- ^ The parameter vector which
                                    -- minimizes the objective
  , Solution -> Result
solutionResult :: N.Result      -- ^ Why the optimizer stopped
  } deriving (Solution -> Solution -> Bool
(Solution -> Solution -> Bool)
-> (Solution -> Solution -> Bool) -> Eq Solution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Solution -> Solution -> Bool
$c/= :: Solution -> Solution -> Bool
== :: Solution -> Solution -> Bool
$c== :: Solution -> Solution -> Bool
Eq, Int -> Solution -> ShowS
[Solution] -> ShowS
Solution -> String
(Int -> Solution -> ShowS)
-> (Solution -> String) -> ([Solution] -> ShowS) -> Show Solution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Solution] -> ShowS
$cshowList :: [Solution] -> ShowS
show :: Solution -> String
$cshow :: Solution -> String
showsPrec :: Int -> Solution -> ShowS
$cshowsPrec :: Int -> Solution -> ShowS
Show, ReadPrec [Solution]
ReadPrec Solution
Int -> ReadS Solution
ReadS [Solution]
(Int -> ReadS Solution)
-> ReadS [Solution]
-> ReadPrec Solution
-> ReadPrec [Solution]
-> Read Solution
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Solution]
$creadListPrec :: ReadPrec [Solution]
readPrec :: ReadPrec Solution
$creadPrec :: ReadPrec Solution
readList :: ReadS [Solution]
$creadList :: ReadS [Solution]
readsPrec :: Int -> ReadS Solution
$creadsPrec :: Int -> ReadS Solution
Read)

applyAugLagAlgorithm :: N.Opt -> AugLagAlgorithm -> IO ()
applyAugLagAlgorithm :: Opt -> AugLagAlgorithm -> IO ()
applyAugLagAlgorithm Opt
opt AugLagAlgorithm
alg = AugLagAlgorithm -> IO ()
go AugLagAlgorithm
alg
  where
    ic :: InequalityConstraints -> IO ()
ic = (InequalityConstraint ScalarConstraint VectorConstraint -> IO ())
-> InequalityConstraints -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (InequalityConstraint ScalarConstraint VectorConstraint
    -> IO Result)
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> InequalityConstraint ScalarConstraint VectorConstraint
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    icd :: InequalityConstraintsD -> IO ()
icd = (InequalityConstraint ScalarConstraintD VectorConstraintD -> IO ())
-> InequalityConstraintsD -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (InequalityConstraint ScalarConstraintD VectorConstraintD
    -> IO Result)
-> InequalityConstraint ScalarConstraintD VectorConstraintD
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> InequalityConstraint ScalarConstraintD VectorConstraintD
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt)
    -- AUGLAG won't work at all if you don't pass it the same
    -- objective as the subproblem -- here we pull out the subproblem
    -- objectives from the algorithm spec and set the same objective
    -- function so the user can't mess it up.
    local :: LocalProblem -> IO ()
local LocalProblem
lp = IO Result -> IO ()
tryTo (IO Result -> IO ()) -> IO Result -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Opt
localopt <- LocalProblem -> IO Opt
setupLocalProblem LocalProblem
lp
      Opt -> LocalAlgorithm -> IO ()
applyLocalObjective Opt
opt (LocalProblem -> LocalAlgorithm
lalgorithm LocalProblem
lp)
      Opt -> Opt -> IO Result
N.set_local_optimizer Opt
opt Opt
localopt
    global :: GlobalProblem -> IO ()
global GlobalProblem
gp = do
      IO Result -> IO ()
tryTo (IO Result -> IO ()) -> IO Result -> IO ()
forall a b. (a -> b) -> a -> b
$ GlobalProblem -> IO Opt
setupGlobalProblem GlobalProblem
gp IO Opt -> (Opt -> IO Result) -> IO Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Opt -> Opt -> IO Result
N.set_local_optimizer Opt
opt
      Opt -> GlobalAlgorithm -> IO ()
applyGlobalObjective Opt
opt (GlobalProblem -> GlobalAlgorithm
galgorithm GlobalProblem
gp)

    go :: AugLagAlgorithm -> IO ()
go (AUGLAG_LOCAL LocalProblem
lp InequalityConstraints
ineq InequalityConstraintsD
ineqd)  = LocalProblem -> IO ()
local LocalProblem
lp IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InequalityConstraints -> IO ()
ic InequalityConstraints
ineq IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InequalityConstraintsD -> IO ()
icd InequalityConstraintsD
ineqd
    go (AUGLAG_EQ_LOCAL LocalProblem
lp)          = LocalProblem -> IO ()
local LocalProblem
lp
    go (AUGLAG_GLOBAL GlobalProblem
gp InequalityConstraints
ineq InequalityConstraintsD
ineqd) = GlobalProblem -> IO ()
global GlobalProblem
gp IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InequalityConstraints -> IO ()
ic InequalityConstraints
ineq IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InequalityConstraintsD -> IO ()
icd InequalityConstraintsD
ineqd
    go (AUGLAG_EQ_GLOBAL GlobalProblem
gp)         = GlobalProblem -> IO ()
global GlobalProblem
gp

applyAugLagProblem :: N.Opt -> AugLagProblem -> IO ()
applyAugLagProblem :: Opt -> AugLagProblem -> IO ()
applyAugLagProblem Opt
opt (AugLagProblem EqualityConstraints
eq EqualityConstraintsD
eqd AugLagAlgorithm
alg) = do
  (EqualityConstraint ScalarConstraint VectorConstraint -> IO ())
-> EqualityConstraints -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (EqualityConstraint ScalarConstraint VectorConstraint
    -> IO Result)
-> EqualityConstraint ScalarConstraint VectorConstraint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> EqualityConstraint ScalarConstraint VectorConstraint
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt) EqualityConstraints
eq
  (EqualityConstraint ScalarConstraintD VectorConstraintD -> IO ())
-> EqualityConstraintsD -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO Result -> IO ()
tryTo (IO Result -> IO ())
-> (EqualityConstraint ScalarConstraintD VectorConstraintD
    -> IO Result)
-> EqualityConstraint ScalarConstraintD VectorConstraintD
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt
-> EqualityConstraint ScalarConstraintD VectorConstraintD
-> IO Result
forall constraint.
ApplyConstraint constraint =>
Opt -> constraint -> IO Result
applyConstraint Opt
opt) EqualityConstraintsD
eqd
  Opt -> AugLagAlgorithm -> IO ()
applyAugLagAlgorithm Opt
opt AugLagAlgorithm
alg

minimizeAugLag' :: AugLagProblem -> Vector Double -> IO Solution
minimizeAugLag' :: AugLagProblem -> Vector Double -> IO Solution
minimizeAugLag' ap :: AugLagProblem
ap@(AugLagProblem EqualityConstraints
_ EqualityConstraintsD
_ AugLagAlgorithm
alg) Vector Double
x0 = do
  Opt
opt <- Algorithm -> Word -> IO Opt
newOpt (AugLagAlgorithm -> Algorithm
algorithmEnumOfAugLag AugLagAlgorithm
alg) (AugLagProblem -> Word
forall c. ProblemSize c => c -> Word
problemSize AugLagProblem
ap)
  Opt -> AugLagProblem -> IO ()
applyAugLagProblem Opt
opt AugLagProblem
ap
  Opt -> Vector Double -> IO Solution
solveProblem Opt
opt Vector Double
x0

-- |
-- == Example program
--
-- The following interactive session example enforces the same scalar
-- constraint as the nonlinear constraint example, but this time it
-- uses the augmented Lagrangian method to enforce the constraint and
-- the 'SBPLX' algorithm, which does not support nonlinear constraints
-- itself, to perform the minimization.  As before, the parameters
-- must always sum to 1, and the minimizer finds the same constrained
-- minimum of 22.5 at @(0.5, 0.5)@.
--
-- >>> import Numeric.LinearAlgebra ( dot, fromList, toList )
-- >>> let objf x = x `dot` x + 22
-- >>> let stop = ObjectiveRelativeTolerance 1e-9 :| []
-- >>> let algorithm = SBPLX objf [] Nothing
-- >>> let subproblem = LocalProblem 2 stop algorithm
-- >>> let x0 = fromList [5, 10]
-- >>> minimizeLocal subproblem x0
-- Right (Solution {solutionCost = 22.0, solutionParams = [0.0,0.0], solutionResult = FTOL_REACHED})
-- >>>          -- define constraint function:
-- >>> let constraintf x = sum (toList x) - 1.0
-- >>>          -- define constraint object to pass to the algorithm:
-- >>> let constraint = EqualityConstraint (Scalar constraintf) 1e-6
-- >>> let problem = AugLagProblem [constraint] [] (AUGLAG_EQ_LOCAL subproblem)
-- >>> minimizeAugLag problem x0
-- Right (Solution {solutionCost = 22.500000015505844, solutionParams = [0.5000880506776678,0.4999119493223323], solutionResult = FTOL_REACHED})

minimizeAugLag :: AugLagProblem -> Vector Double -> Either N.Result Solution
minimizeAugLag :: AugLagProblem -> Vector Double -> Either Result Solution
minimizeAugLag AugLagProblem
prob Vector Double
x0 =
  IO (Either Result Solution) -> Either Result Solution
forall a. IO a -> a
unsafePerformIO (IO (Either Result Solution) -> Either Result Solution)
-> IO (Either Result Solution) -> Either Result Solution
forall a b. (a -> b) -> a -> b
$ (Solution -> Either Result Solution
forall a b. b -> Either a b
Right (Solution -> Either Result Solution)
-> IO Solution -> IO (Either Result Solution)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AugLagProblem -> Vector Double -> IO Solution
minimizeAugLag' AugLagProblem
prob Vector Double
x0) IO (Either Result Solution)
-> (NloptException -> IO (Either Result Solution))
-> IO (Either Result Solution)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Ex.catch` NloptException -> IO (Either Result Solution)
forall a. NloptException -> IO (Either Result a)
handler
  where
    handler :: NloptException -> IO (Either N.Result a)
    handler :: forall a. NloptException -> IO (Either Result a)
handler (NloptException Result
retcode) = Either Result a -> IO (Either Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Result a -> IO (Either Result a))
-> Either Result a -> IO (Either Result a)
forall a b. (a -> b) -> a -> b
$ Result -> Either Result a
forall a b. a -> Either a b
Left Result
retcode