{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances #-}
module Numeric.NLOPT (
Objective
, ObjectiveD
, Preconditioner
, Bounds(..)
, ScalarConstraint
, ScalarConstraintD
, VectorConstraint
, VectorConstraintD
, Constraint(..)
, EqualityConstraint(..)
, InequalityConstraint(..)
, EqualityConstraints
, EqualityConstraintsD
, InequalityConstraints
, InequalityConstraintsD
, StoppingCondition(..)
, NonEmpty(..)
, RandomSeed(..)
, Population(..)
, VectorStorage(..)
, InitialStep(..)
, LocalAlgorithm(..)
, LocalProblem(..)
, minimizeLocal
, GlobalAlgorithm(..)
, GlobalProblem(..)
, minimizeGlobal
, AugLagAlgorithm(..)
, AugLagProblem(..)
, minimizeAugLag
, Solution(..)
, N.Result(..)
) where
import Numeric.LinearAlgebra as HM
import qualified Numeric.Optimization.NLOPT.Bindings as N
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Vector.Storable as V
import Control.Exception ( Exception )
import qualified Control.Exception as Ex
import Data.Typeable ( Typeable )
import Data.Foldable ( traverse_ )
import System.IO.Unsafe ( unsafePerformIO )
wrapScalarFunction :: (Vector Double -> Double) -> N.ScalarFunction ()
wrapScalarFunction :: 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)
type Objective
= Vector Double
-> Double
type ObjectiveD
= Vector Double
-> (Double, Vector Double)
type Preconditioner
= Vector Double
-> Vector Double
-> Vector Double
data ObjectiveFunction f
= MinimumObjective f
| PreconditionedMinimumObjective Preconditioner f
applyObjective :: N.Opt -> ObjectiveFunction Objective -> IO N.Result
applyObjective :: Opt -> 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) ()
type ScalarConstraint
= Vector Double
-> Double
type ScalarConstraintD
= Vector Double
-> (Double, Vector Double)
type VectorConstraint
= Vector Double
-> Word
-> Vector Double
type VectorConstraintD
= Vector Double
-> Word
-> (Vector Double, Matrix Double)
data Constraint s v
= Scalar s
| Vector Word v
| Preconditioned Preconditioner s
data EqualityConstraint s v = EqualityConstraint
{ forall s v. EqualityConstraint s v -> Constraint s v
eqConstraintFunctions :: Constraint s v
, forall s v. EqualityConstraint s v -> Double
eqConstraintTolerance :: Double
}
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
}
type EqualityConstraints =
[EqualityConstraint ScalarConstraint VectorConstraint]
type InequalityConstraints =
[InequalityConstraint ScalarConstraint VectorConstraint]
type EqualityConstraintsD = [EqualityConstraint ScalarConstraintD VectorConstraintD]
type InequalityConstraintsD = [InequalityConstraint ScalarConstraintD VectorConstraintD]
class ApplyConstraint constraint where
applyConstraint :: N.Opt -> constraint -> IO N.Result
instance ApplyConstraint (EqualityConstraint ScalarConstraint VectorConstraint) where
applyConstraint :: Opt
-> EqualityConstraint 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
data Bounds
= LowerBounds (Vector Double)
| 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
data StoppingCondition
= MinimumValue Double
| ObjectiveRelativeTolerance Double
| ObjectiveAbsoluteTolerance Double
| ParameterRelativeTolerance Double
| ParameterAbsoluteTolerance (Vector Double)
| MaximumEvaluations Word
| 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)
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
data RandomSeed
= SeedValue Word
| SeedFromTime
| 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
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
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
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
data GlobalProblem = GlobalProblem
{ GlobalProblem -> Vector Double
lowerBounds :: Vector Double
, GlobalProblem -> Vector Double
upperBounds :: Vector Double
, GlobalProblem -> NonEmpty StoppingCondition
gstop :: NonEmpty StoppingCondition
, GlobalProblem -> GlobalAlgorithm
galgorithm :: GlobalAlgorithm
}
data GlobalAlgorithm
= DIRECT Objective
| DIRECT_L Objective
| DIRECT_L_RAND Objective RandomSeed
| DIRECT_NOSCAL Objective
| DIRECT_L_NOSCAL Objective
| DIRECT_L_RAND_NOSCAL Objective RandomSeed
| ORIG_DIRECT Objective InequalityConstraints
| ORIG_DIRECT_L Objective InequalityConstraints
| STOGO ObjectiveD
| STOGO_RAND ObjectiveD RandomSeed
| CRS2_LM Objective RandomSeed (Maybe Population)
| ISRES Objective InequalityConstraints EqualityConstraints RandomSeed (Maybe Population)
| ESCH Objective
| MLSL Objective LocalProblem (Maybe Population)
| MLSL_LDS Objective LocalProblem (Maybe Population)
algorithmEnumOfGlobal :: GlobalAlgorithm -> N.Algorithm
(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
minimizeGlobal :: GlobalProblem
-> Vector Double
-> Either N.Result Solution
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
, LocalProblem -> NonEmpty StoppingCondition
lstop :: NonEmpty StoppingCondition
, LocalProblem -> LocalAlgorithm
lalgorithm :: LocalAlgorithm
}
data LocalAlgorithm
= LBFGS_NOCEDAL ObjectiveD (Maybe VectorStorage)
| LBFGS ObjectiveD (Maybe VectorStorage)
| VAR2 ObjectiveD (Maybe VectorStorage)
| VAR1 ObjectiveD (Maybe VectorStorage)
| TNEWTON ObjectiveD (Maybe VectorStorage)
| TNEWTON_RESTART ObjectiveD (Maybe VectorStorage)
| TNEWTON_PRECOND ObjectiveD (Maybe VectorStorage)
| TNEWTON_PRECOND_RESTART ObjectiveD (Maybe VectorStorage)
| MMA ObjectiveD InequalityConstraintsD
| SLSQP ObjectiveD [Bounds] InequalityConstraintsD EqualityConstraintsD
| CCSAQ ObjectiveD Preconditioner
| PRAXIS Objective [Bounds] (Maybe InitialStep)
| COBYLA Objective [Bounds] InequalityConstraints EqualityConstraints
(Maybe InitialStep)
| NEWUOA Objective (Maybe InitialStep)
| NEWUOA_BOUND Objective [Bounds] (Maybe InitialStep)
| NELDERMEAD Objective [Bounds] (Maybe InitialStep)
| SBPLX Objective [Bounds] (Maybe InitialStep)
| BOBYQA Objective [Bounds] (Maybe InitialStep)
algorithmEnumOfLocal :: LocalAlgorithm -> N.Algorithm
(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
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
data AugLagProblem = AugLagProblem
{ AugLagProblem -> EqualityConstraints
alEquality :: EqualityConstraints
, AugLagProblem -> EqualityConstraintsD
alEqualityD :: EqualityConstraintsD
, AugLagProblem -> AugLagAlgorithm
alalgorithm :: AugLagAlgorithm
}
data AugLagAlgorithm
= AUGLAG_LOCAL LocalProblem InequalityConstraints InequalityConstraintsD
| AUGLAG_EQ_LOCAL LocalProblem
| AUGLAG_GLOBAL GlobalProblem InequalityConstraints InequalityConstraintsD
| AUGLAG_EQ_GLOBAL GlobalProblem
algorithmEnumOfAugLag :: AugLagAlgorithm -> N.Algorithm
(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
data Solution = Solution
{ Solution -> Double
solutionCost :: Double
, Solution -> Vector Double
solutionParams :: Vector Double
, Solution -> Result
solutionResult :: N.Result
} 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)
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
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