nlopt-haskell (empty) → 0.1.0.0
raw patch · 6 files changed
+1228/−0 lines, 6 filesdep +basedep +nlopt-haskelldep +vectorsetup-changed
Dependencies added: base, nlopt-haskell, vector
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- nlopt-haskell.cabal +48/−0
- src/Numeric/Optimization/NLOPT/Bindings.hs +1065/−0
- tests/example.hs +78/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for haskell-nlopt++## 0.1.0.0 -- 2017-27-03++* First version, for NLOPT 2.4.2. The entire API is brought out.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Matthew Peddie++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Matthew Peddie nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ nlopt-haskell.cabal view
@@ -0,0 +1,48 @@+name: nlopt-haskell+version: 0.1.0.0+synopsis: Low-level bindings to the NLOPT optimization library+description: This library provides low-level bindings to+ <http://ab-initio.mit.edu/wiki/index.php/NLopt the NLOPT optimization library>.+ You will need the NLOPT library and development headers installed.++homepage: https://github.com/peddie/nlopt-haskell+license: BSD3+license-file: LICENSE+author: Matthew Peddie <mpeddie@gmail.com>+maintainer: Matthew Peddie <mpeddie@gmail.com>+copyright: 2017 Matthew Peddie+category: Numeric+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10+bug-reports: https://github.com/peddie/nlopt-haskell/issues++source-repository head+ type: git+ location: https://github.com/peddie/nlopt-haskell++flag link-nlopt-cxx+ description: Link with @-lnlopt_cxx@ instead of @-lnlopt@+ default: False+ manual: True++library+ exposed-modules: Numeric.Optimization.NLOPT.Bindings+ build-depends: base >=4.9 && <4.10+ , vector >= 0.10+ hs-source-dirs: src+ default-language: Haskell2010+ if flag(link-nlopt-cxx)+ extra-libraries: nlopt_cxx+ else+ extra-libraries: nlopt+++test-suite example+ type: exitcode-stdio-1.0+ main-is: example.hs+ hs-source-dirs: tests+ default-language: Haskell2010+ build-depends: base >= 4.9 && < 4.10+ , nlopt-haskell+ , vector >= 0.10
+ src/Numeric/Optimization/NLOPT/Bindings.hs view
@@ -0,0 +1,1065 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++{- |+Module : Numeric.Optimization.NLOPT.Bindings+Copyright : (c) Matthew Peddie 2017+License : BSD3+Maintainer : Matthew Peddie <mpeddie@gmail.com>+Stability : provisional+Portability : GHC++Low-level interface to the NLOPT library. Please see+<http://ab-initio.mit.edu/wiki/index.php/NLopt_Reference the NLOPT reference manual>+for detailed information; the Haskell functions in this module closely+follow the interface to the C library in @nlopt.h@.++Differences between this module and the C interface are documented+here; functions with identical interfaces are not. In general:++ ['Opt'] corresponds to an @nlopt_opt@ object++ ['Result'] corresponds to @nlopt_result@++ ['V.Vector' 'Double'] corresponds to a @const double *@ input or a+ @double *@ output++ ['ScalarFunction'] corresponds to @nlopt_func@++ ['VectorFunction'] corresponds to @nlopt_mfunc@++ ['PreconditionerFunction'] corresponds to @nlopt_precond@++User data that is handled by @void *@ in the C bindings can be any+Haskell value.++-}++module Numeric.Optimization.NLOPT.Bindings (+ -- * C enums+ Algorithm(..)+ , algorithm_name+ , Result(..)+ , isSuccess+ -- * Optimizer object+ , Opt+ , create+ , destroy+ , copy+ -- * Random number generator seeding+ , srand+ , srand_time+ -- * Metadata+ , Version(..)+ , version+ , get_algorithm+ , get_dimension+ -- * Callbacks+ , ScalarFunction+ , VectorFunction+ , PreconditionerFunction+ -- * Running the optimizer+ , Output(..)+ , optimize+ -- * Objective function configuration+ , set_min_objective+ , set_max_objective+ , set_precond_min_objective+ , set_precond_max_objective+ -- * Bound configuration+ , set_lower_bounds+ , set_lower_bounds1+ , get_lower_bounds+ , set_upper_bounds+ , set_upper_bounds1+ , get_upper_bounds+ -- * Constraint configuration+ , remove_inequality_constraints+ , add_inequality_constraint+ , add_precond_inequality_constraint+ , add_inequality_mconstraint+ , remove_equality_constraints+ , add_equality_constraint+ , add_precond_equality_constraint+ , add_equality_mconstraint+ -- * Stopping criterion configuration+ , set_stopval+ , get_stopval+ , set_ftol_rel+ , get_ftol_rel+ , set_ftol_abs+ , get_ftol_abs+ , set_xtol_rel+ , get_xtol_rel+ , set_xtol_abs1+ , set_xtol_abs+ , get_xtol_abs+ , set_maxeval+ , get_maxeval+ , set_maxtime+ , get_maxtime+ , force_stop+ , set_force_stop+ , get_force_stop+ -- * Algorithm-specific configuration+ , set_local_optimizer+ , set_population+ , get_population+ , set_vector_storage+ , get_vector_storage+ , set_default_initial_step+ , set_initial_step+ , set_initial_step1+ , get_initial_step+ ) where++import Foreign hiding (void)+import Foreign.C.String+import Foreign.C.Types+import qualified Foreign.Concurrent as CFP++import qualified Data.Vector.Storable.Mutable as MV+import qualified Data.Vector.Storable as V++{- C enums -}++-- | The NLOPT algorithm names, apart from the names of the actual+-- optimization methods, follow this scheme:+--+-- [@G@] means a global method+-- [@L@] means a local method+-- [@D@] means a method that requires the derivative+-- [@N@] means a method that does not require the derivative+-- [@*_RAND@] means the algorithm involves some randomization.+-- [@*_NOSCAL@] means the algorithm is *not* scaled to a unit+-- hypercube (i.e. it is sensitive to the units of x)+data Algorithm+ = GN_DIRECT -- ^ DIviding RECTangles+ | GN_DIRECT_L -- ^ DIviding RECTangles,+ -- locally-biased variant+ | GN_DIRECT_L_RAND -- ^ DIviding RECTangles, "slightly+ -- randomized"+ | GN_DIRECT_NOSCAL -- ^ DIviding RECTangles, unscaled version+ | GN_DIRECT_L_NOSCAL -- ^ DIviding RECTangles,+ -- locally-biased and unscaled+ | GN_DIRECT_L_RAND_NOSCAL -- ^ DIviding RECTangles, locally-biased,+ -- unscaled and "slightly randomized"+ | GN_ORIG_DIRECT -- ^ DIviding RECTangles, original FORTRAN+ -- implementation+ | GN_ORIG_DIRECT_L -- ^ DIviding RECTangles,+ -- locally-biased, original FORTRAN+ -- implementation+ | GD_STOGO -- ^ Stochastic Global Optimization+ | GD_STOGO_RAND -- ^ Stochastic Global Optimization,+ -- randomized variant+ | LD_LBFGS_NOCEDAL -- ^ Limited-memory BFGS+ | LD_LBFGS -- ^ Limited-memory BFGS+ | LN_PRAXIS -- ^ PRincipal AXIS gradient-free local+ -- optimization+ | LD_VAR2 -- ^ Shifted limited-memory+ -- variable-metric, rank-2+ | LD_VAR1 -- ^ Shifted limited-memory+ -- variable-metric, rank-1+ | LD_TNEWTON -- ^ Truncated Newton's method+ | LD_TNEWTON_RESTART -- ^ Truncated Newton's method with+ -- automatic restarting+ | LD_TNEWTON_PRECOND -- ^ Preconditioned truncated Newton's+ -- method+ | LD_TNEWTON_PRECOND_RESTART -- ^ Preconditioned truncated Newton's+ -- method with automatic restarting+ | GN_CRS2_LM -- ^ Controlled Random Search with+ -- Local Mutation+ | GN_MLSL -- ^ Original Multi-Level+ -- Single-Linkage+ | GD_MLSL -- ^ Original Multi-Level+ -- Single-Linkage, user-provided+ -- derivative+ | GN_MLSL_LDS -- ^ Multi-Level Single-Linkage with+ -- Sobol Low-Discrepancy Sequence for+ -- starting points+ | GD_MLSL_LDS -- ^ Multi-Level Single-Linkage with+ -- Sobol Low-Discrepancy Sequence for+ -- starting points, user-provided+ -- derivative+ | LD_MMA -- ^ Method of moving averages+ | LN_COBYLA -- ^ Constrained Optimization BY Linear+ -- Approximations+ | LN_NEWUOA -- ^ Powell's NEWUOA algorithm+ | LN_NEWUOA_BOUND -- ^ Powell's NEWUOA algorithm with+ -- bounds by SGJ+ | LN_NELDERMEAD -- ^ Nelder-Mead Simplex gradient-free+ -- method+ | LN_SBPLX -- ^ NLOPT implementation of Rowan's+ -- Subplex algorithm+ | LN_AUGLAG -- ^ AUGmented LAGrangian+ | LD_AUGLAG -- ^ AUGmented LAGrangian,+ -- user-provided derivative+ | LN_AUGLAG_EQ -- ^ AUGmented LAGrangian with penalty+ -- functions only for equality+ -- constraints+ | LD_AUGLAG_EQ -- ^ AUGmented LAGrangian with+ -- penalty functions only for equality+ -- constraints, user-provided+ -- derivative+ | LN_BOBYQA -- ^ Bounded Optimization BY Quadratic+ -- Approximations+ | GN_ISRES -- ^ Improved Stochastic Ranking+ -- Evolution Strategy++ | AUGLAG -- ^ AUGmented LAGrangian, requires+ -- local_optimizer to be set+ | AUGLAG_EQ -- ^ AUGmented LAGrangian with penalty+ -- functions only for equality+ -- constraints, requires+ -- local_optimizer to be set+ | G_MLSL -- ^ Original Multi-Level+ -- Single-Linkage, user-provided+ -- derivative, requires local_optimizer+ -- to be set+ | G_MLSL_LDS -- ^ Multi-Level Single-Linkage with+ -- Sobol Low-Discrepancy Sequence for+ -- starting points, requires+ -- local_optimizer to be set+ | LD_SLSQP -- ^ Sequential Least-SQuares Programming+ | LD_CCSAQ -- ^ Conservative Convex Separable+ -- Approximation+ | GN_ESCH -- ^ Evolutionary Algorithm+ deriving (Eq, Show, Read, Bounded)++instance Enum Algorithm where+ fromEnum GN_DIRECT = 0+ fromEnum GN_DIRECT_L = 1+ fromEnum GN_DIRECT_L_RAND = 2+ fromEnum GN_DIRECT_NOSCAL = 3+ fromEnum GN_DIRECT_L_NOSCAL = 4+ fromEnum GN_DIRECT_L_RAND_NOSCAL = 5+ fromEnum GN_ORIG_DIRECT = 6+ fromEnum GN_ORIG_DIRECT_L = 7+ fromEnum GD_STOGO = 8+ fromEnum GD_STOGO_RAND = 9+ fromEnum LD_LBFGS_NOCEDAL = 10+ fromEnum LD_LBFGS = 11+ fromEnum LN_PRAXIS = 12+ fromEnum LD_VAR2 = 13+ fromEnum LD_VAR1 = 14+ fromEnum LD_TNEWTON = 15+ fromEnum LD_TNEWTON_RESTART = 16+ fromEnum LD_TNEWTON_PRECOND = 17+ fromEnum LD_TNEWTON_PRECOND_RESTART = 18+ fromEnum GN_CRS2_LM = 19+ fromEnum GN_MLSL = 20+ fromEnum GD_MLSL = 21+ fromEnum GN_MLSL_LDS = 22+ fromEnum GD_MLSL_LDS = 23+ fromEnum LD_MMA = 24+ fromEnum LN_COBYLA = 25+ fromEnum LN_NEWUOA = 26+ fromEnum LN_NEWUOA_BOUND = 27+ fromEnum LN_NELDERMEAD = 28+ fromEnum LN_SBPLX = 29+ fromEnum LN_AUGLAG = 30+ fromEnum LD_AUGLAG = 31+ fromEnum LN_AUGLAG_EQ = 32+ fromEnum LD_AUGLAG_EQ = 33+ fromEnum LN_BOBYQA = 34+ fromEnum GN_ISRES = 35+ fromEnum AUGLAG = 36+ fromEnum AUGLAG_EQ = 37+ fromEnum G_MLSL = 38+ fromEnum G_MLSL_LDS = 39+ fromEnum LD_SLSQP = 40+ fromEnum LD_CCSAQ = 41+ fromEnum GN_ESCH = 42+ toEnum 0 = GN_DIRECT+ toEnum 1 = GN_DIRECT_L+ toEnum 2 = GN_DIRECT_L_RAND+ toEnum 3 = GN_DIRECT_NOSCAL+ toEnum 4 = GN_DIRECT_L_NOSCAL+ toEnum 5 = GN_DIRECT_L_RAND_NOSCAL+ toEnum 6 = GN_ORIG_DIRECT+ toEnum 7 = GN_ORIG_DIRECT_L+ toEnum 8 = GD_STOGO+ toEnum 9 = GD_STOGO_RAND+ toEnum 10 = LD_LBFGS_NOCEDAL+ toEnum 11 = LD_LBFGS+ toEnum 12 = LN_PRAXIS+ toEnum 13 = LD_VAR2+ toEnum 14 = LD_VAR1+ toEnum 15 = LD_TNEWTON+ toEnum 16 = LD_TNEWTON_RESTART+ toEnum 17 = LD_TNEWTON_PRECOND+ toEnum 18 = LD_TNEWTON_PRECOND_RESTART+ toEnum 19 = GN_CRS2_LM+ toEnum 20 = GN_MLSL+ toEnum 21 = GD_MLSL+ toEnum 22 = GN_MLSL_LDS+ toEnum 23 = GD_MLSL_LDS+ toEnum 24 = LD_MMA+ toEnum 25 = LN_COBYLA+ toEnum 26 = LN_NEWUOA+ toEnum 27 = LN_NEWUOA_BOUND+ toEnum 28 = LN_NELDERMEAD+ toEnum 29 = LN_SBPLX+ toEnum 30 = LN_AUGLAG+ toEnum 31 = LD_AUGLAG+ toEnum 32 = LN_AUGLAG_EQ+ toEnum 33 = LD_AUGLAG_EQ+ toEnum 34 = LN_BOBYQA+ toEnum 35 = GN_ISRES+ toEnum 36 = AUGLAG+ toEnum 37 = AUGLAG_EQ+ toEnum 38 = G_MLSL+ toEnum 39 = G_MLSL_LDS+ toEnum 40 = LD_SLSQP+ toEnum 41 = LD_CCSAQ+ toEnum 42 = GN_ESCH+ toEnum e = error $+ "Algorithm.toEnum: invalid C value '" ++ show e ++ "' received."++foreign import ccall "nlopt.h nlopt_algorithm_name"+ nlopt_algorithm_name :: CInt -> CString++algorithm_name :: Algorithm -> IO String+algorithm_name = peekCString . nlopt_algorithm_name . fromIntegral . fromEnum++-- | Mostly self-explanatory.+data Result+ = FAILURE -- ^ Generic failure code+ | INVALID_ARGS+ | OUT_OF_MEMORY+ | ROUNDOFF_LIMITED+ | FORCED_STOP+ | SUCCESS -- ^ Generic success code+ | STOPVAL_REACHED+ | FTOL_REACHED+ | XTOL_REACHED+ | MAXEVAL_REACHED+ | MAXTIME_REACHED+ deriving (Eq, Read, Show, Bounded)++instance Enum Result where+ fromEnum FAILURE = -1+ fromEnum INVALID_ARGS = -2+ fromEnum OUT_OF_MEMORY = -3+ fromEnum ROUNDOFF_LIMITED = -4+ fromEnum FORCED_STOP = -5+ fromEnum SUCCESS = 1+ fromEnum STOPVAL_REACHED = 2+ fromEnum FTOL_REACHED = 3+ fromEnum XTOL_REACHED = 4+ fromEnum MAXEVAL_REACHED = 5+ fromEnum MAXTIME_REACHED = 6+ toEnum (-1) = FAILURE+ toEnum (-2) = INVALID_ARGS+ toEnum (-3) = OUT_OF_MEMORY+ toEnum (-4) = ROUNDOFF_LIMITED+ toEnum (-5) = FORCED_STOP+ toEnum 1 = SUCCESS+ toEnum 2 = STOPVAL_REACHED+ toEnum 3 = FTOL_REACHED+ toEnum 4 = XTOL_REACHED+ toEnum 5 = MAXEVAL_REACHED+ toEnum 6 = MAXTIME_REACHED+ toEnum e = error $+ "Result.toEnum: invalid C value '" ++ show e ++ "' received."++isSuccess :: Result -> Bool+isSuccess SUCCESS = True+isSuccess STOPVAL_REACHED = True+isSuccess FTOL_REACHED = True+isSuccess XTOL_REACHED = True+isSuccess MAXEVAL_REACHED = True+isSuccess MAXTIME_REACHED = True+isSuccess _ = False++parseEnum :: (Integral a, Enum b) => a -> b+parseEnum = toEnum . fromIntegral++{- NLOPT optimizer object -}++type NloptOpt = Ptr ()++-- | An optimizer object which must be created, configured and then+-- passed to 'optimize' to solve a problem+newtype Opt = Opt { pointerFromOpt :: ForeignPtr () }++withOpt :: Opt -> (NloptOpt -> IO a) -> IO a+withOpt (Opt p) f = do+ ret <- withForeignPtr p f+ touchForeignPtr p -- This is critical! Otherwise the GC might+ -- think it's done with everything in the middle+ -- of the problem.+ return ret++useOpt :: (NloptOpt -> IO a) -> Opt -> IO a+useOpt = flip withOpt++-- Every time we make a "wrapper" call, the runtime allocates a new+-- function pointer and won't release it until we explicitly tell it+-- to. This doesn't mesh well with NLOPT's "object-oriented" design,+-- wherein we have to allocate an object and make a bunch of setup+-- calls before we run the problem, so what we do is add a finalizer+-- to the 'Opt' object's 'ForeignPtr' every time we need to create a+-- function pointer for C to use.+addFunPtrFinalizer :: Opt -> FunPtr a -> IO ()+addFunPtrFinalizer (Opt p) funptr =+ CFP.addForeignPtrFinalizer p (freeHaskellFunPtr funptr)++foreign import ccall "nlopt.h nlopt_create"+ nlopt_create :: CInt -> CUInt -> IO (NloptOpt)++-- | Create a new 'Opt' object+create :: Algorithm -- ^ Choice of algorithm+ -> Word -- ^ Parameter vector dimension+ -> IO (Maybe Opt) -- ^ Optimizer object+create alg dimension = do+ outp <- nlopt_create (fromIntegral $ fromEnum alg) (fromIntegral dimension)+ if (outp == nullPtr)+ then return Nothing+ else Just . Opt <$> CFP.newForeignPtr outp (nlopt_destroy outp)++foreign import ccall "nlopt.h nlopt_destroy"+ nlopt_destroy :: NloptOpt -> IO ()++-- It shouldn't be strictly necessary to call this by hand since we've+-- already put a call to 'nlopt_destroy' into the 'ForeignPtr', but+-- it's available in the C interface.+destroy :: Opt -> IO ()+destroy = finalizeForeignPtr . pointerFromOpt++foreign import ccall "nlopt.h nlopt_copy"+ nlopt_copy :: NloptOpt -> IO (NloptOpt)++copy :: Opt -> IO Opt+copy = useOpt $ \inp -> do+ outp <- nlopt_copy inp+ Opt <$> CFP.newForeignPtr outp (nlopt_destroy outp)++{- Random seeding functions -}++foreign import ccall "nlopt.h nlopt_srand"+ nlopt_srand :: CUInt -> IO ()++srand :: Integral a => a -> IO ()+srand = nlopt_srand . fromIntegral++foreign import ccall "nlopt.h nlopt_srand_time"+ nlopt_srand_time :: IO ()++srand_time :: IO ()+srand_time = nlopt_srand_time++{- Metadata -}++foreign import ccall "nlopt.h nlopt_version"+ nlopt_version :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()++-- | NLOPT library version, e.g. @2.4.2@+data Version = Version+ { major :: Int+ , minor :: Int+ , bugfix :: Int+ } deriving (Eq, Ord, Read, Show)++version :: IO Version+version =+ alloca $ \majptr ->+ alloca $ \minptr ->+ alloca $ \bfptr -> do+ nlopt_version majptr minptr bfptr+ Version <$> pk majptr <*> pk minptr <*> pk bfptr+ where+ pk = fmap fromIntegral . peek++foreign import ccall "nlopt.h nlopt_get_algorithm"+ nlopt_get_algorithm :: NloptOpt -> IO CInt++get_algorithm :: Opt -> IO Algorithm+get_algorithm = useOpt $ fmap parseEnum . nlopt_get_algorithm++foreign import ccall "nlopt.h nlopt_get_dimension"+ nlopt_get_dimension :: NloptOpt -> IO CUInt++get_dimension :: Opt -> IO Word+get_dimension = useOpt $ fmap fromIntegral . nlopt_get_dimension++{- Callback functions -}++asMVector :: CUInt -> Ptr CDouble -> IO (MV.IOVector Double)+asMVector dim ptr =+ MV.unsafeCast . flip MV.unsafeFromForeignPtr0 (fromIntegral dim) <$>+ newForeignPtr_ ptr++asVector :: CUInt -> Ptr CDouble -> IO (V.Vector Double)+asVector dim ptr =+ V.unsafeCast . flip V.unsafeFromForeignPtr0 (fromIntegral dim) <$>+ newForeignPtr_ ptr++type CFunc a = CUInt -> Ptr CDouble -> Ptr CDouble -> StablePtr a -> IO CDouble++-- | This function type corresponds to @nlopt_func@ in C and is used+-- for scalar functions of the parameter vector. You may pass data of+-- any type @a@ to the functions in this module that take a+-- 'ScalarFunction' as an argument; this data will be supplied to your+-- your function when it is called.+type ScalarFunction a+ = V.Vector Double -- ^ Parameter vector+ -> Maybe (MV.IOVector Double) -- ^ Gradient vector to be filled in+ -> a -- ^ User data+ -> IO Double -- ^ Scalar result++-- | This function type corresponds to @nlopt_mfunc@ in C and is used+-- for vector functions of the parameter vector. You may pass data of+-- any type @a@ to the functions in this module that take a+-- 'VectorFunction' as an argument; this data will be supplied to your+-- function when it is called.+type VectorFunction a+ = V.Vector Double -- ^ Parameter vector+ -> MV.IOVector Double -- ^ Output vector to be filled in+ -> Maybe (MV.IOVector Double) -- ^ Gradient vector to be filled in+ -> a -- ^ User data+ -> IO ()++-- | This function type corresponds to @nlopt_precond@ in C and is+-- used for functions that precondition a vector at a given point in+-- the parameter space. You may pass data of any type @a@ to the+-- functions in this module that take a 'PreconditionerFunction' as an+-- argument; this data will be supplied to your function when it is+-- called.+type PreconditionerFunction a+ = V.Vector Double -- ^ Parameter vector+ -> V.Vector Double -- ^ Vector @v@ to precondition+ -> MV.IOVector Double -- ^ Output vector @vpre@ to be filled in+ -> a -- ^ User data+ -> IO ()++wrapCFunction :: ScalarFunction a -> CFunc a+wrapCFunction cfunc dim stateptr gradientptr userptr = do+ nloptgradient <- asMVector dim gradientptr+ statevec <- asVector dim stateptr+ userdata <- deRefStablePtr userptr+ let+ gradptr = if gradientptr /= nullPtr+ then Just nloptgradient+ else Nothing+ realToFrac <$> cfunc statevec gradptr userdata++foreign import ccall safe "wrapper"+ mkCFunction :: CFunc a -> IO (FunPtr (CFunc a))++type CMFunc a = CUInt -> Ptr CDouble -> CUInt -> Ptr CDouble+ -> Ptr CDouble -> StablePtr a -> IO ()++wrapMFunction :: VectorFunction a -> CMFunc a+wrapMFunction mfunc constrdim constrptr dim stateptr gradientptr userptr+ = do+ nloptgradient <- asMVector (dim * constrdim) gradientptr+ nloptconstraint <- asMVector constrdim constrptr+ statevec <- asVector dim stateptr+ userdata <- deRefStablePtr userptr+ let+ gradptr = if gradientptr /= nullPtr+ then Just nloptgradient+ else Nothing+ mfunc statevec nloptconstraint gradptr userdata++foreign import ccall safe "wrapper"+ mkMFunction :: CMFunc a -> IO (FunPtr (CMFunc a))++type CPrecond a = CUInt -> Ptr CDouble -> Ptr CDouble+ -> Ptr CDouble -> StablePtr a -> IO ()++wrapPreconditioner :: PreconditionerFunction a -> CPrecond a+wrapPreconditioner prec dim stateptr vptr preptr userptr = do+ nloptpre <- asMVector dim preptr+ statevec <- asVector dim stateptr+ vvec <- asVector dim vptr+ userdata <- deRefStablePtr userptr+ prec statevec vvec nloptpre userdata++foreign import ccall safe "wrapper"+ mkPreconditionerFunction :: CPrecond a -> IO (FunPtr (CPrecond a))++-- We have to do the same silly dance with our user-data 'StablePtr's+-- as we do with function pointer wrappers: because NLOPT expects+-- these pointers before the actual optimization run, we have to+-- attach finalizers for them to the 'Opt' object so that they get+-- cleaned up properly.+addStablePtrFinalizer :: Opt -> StablePtr a -> IO ()+addStablePtrFinalizer (Opt p) sp =+ CFP.addForeignPtrFinalizer p (freeStablePtr sp)++getStablePtr :: Opt -> a -> IO (StablePtr a)+getStablePtr opt a = do+ aptr <- newStablePtr a+ addStablePtrFinalizer opt aptr+ return aptr++exportFunPtr :: (t1 -> IO (FunPtr a)) -> (t -> t1) -> t -> Opt -> IO (FunPtr a)+exportFunPtr mk wrap fun opt = do+ funptr <- mk $ wrap fun+ addFunPtrFinalizer opt funptr+ return funptr++{- Invoking the optimizer -}++-- | The output of an NLOPT optimizer run.+data Output = Output+ { resultCode :: Result -- ^ Return code+ , resultCost :: Double -- ^ Minimum of the objective+ -- function if optimization+ -- succeeded+ , resultParameters :: V.Vector Double -- ^ Parameters corresponding+ -- to the minimum if+ -- optimization succeeded+ }++foreign import ccall "nlopt.h nlopt_optimize"+ nlopt_optimize :: NloptOpt -> Ptr CDouble -> Ptr CDouble -> IO CInt++-- | This function is very similar to the C function @nlopt_optimize@,+-- but it does not use mutable vectors and returns an 'Output'+-- structure.+optimize :: Opt -- ^ Optimizer object set up to solve the problem+ -> V.Vector Double -- ^ Initial-guess parameter vector+ -> IO Output -- ^ Results of the optimization run+optimize optimizer x0 = withOpt optimizer $ \opt -> do+ vmut <- V.thaw $ V.unsafeCast x0+ alloca $ \costPtr -> do+ result <- MV.unsafeWith vmut $ \xptr ->+ parseEnum <$> nlopt_optimize opt xptr costPtr+ outputCost <- peek . castPtr $ costPtr+ iceout <- V.unsafeFreeze (MV.unsafeCast vmut)+ return $ Output result outputCost iceout++{- Objective function setup -}++foreign import ccall "nlopt.h nlopt_set_min_objective"+ nlopt_set_min_objective :: NloptOpt -> FunPtr (CFunc a)+ -> StablePtr a -> IO CInt++foreign import ccall "nlopt.h nlopt_set_max_objective"+ nlopt_set_max_objective :: NloptOpt -> FunPtr (CFunc a)+ -> StablePtr a -> IO CInt++set_min_objective :: Opt -> ScalarFunction a -> a -> IO Result+set_min_objective opt objf userdata = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objf opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_set_min_objective o objfunptr userptr++set_max_objective :: Opt -> ScalarFunction a -> a -> IO Result+set_max_objective opt objf userdata = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objf opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$> nlopt_set_max_objective o objfunptr userptr++foreign import ccall "nlopt.h nlopt_set_precond_min_objective"+ nlopt_set_precond_min_objective :: NloptOpt+ -> FunPtr (CFunc a)+ -> FunPtr (CPrecond a)+ -> StablePtr a+ -> IO CInt++foreign import ccall "nlopt.h nlopt_set_precond_max_objective"+ nlopt_set_precond_max_objective :: NloptOpt+ -> FunPtr (CFunc a)+ -> FunPtr (CPrecond a)+ -> StablePtr a+ -> IO CInt++set_precond_min_objective :: Opt+ -> ScalarFunction a+ -> PreconditionerFunction a+ -> a+ -> IO Result+set_precond_min_objective opt objf pref userdata = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objf opt+ prefunptr <- exportFunPtr mkPreconditionerFunction wrapPreconditioner pref opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o -> parseEnum <$>+ nlopt_set_precond_min_objective o objfunptr prefunptr userptr++set_precond_max_objective :: Opt+ -> ScalarFunction a+ -> PreconditionerFunction a+ -> a+ -> IO Result+set_precond_max_objective opt objf pref userdata = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objf opt+ prefunptr <- exportFunPtr mkPreconditionerFunction wrapPreconditioner pref opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o -> parseEnum <$>+ nlopt_set_precond_max_objective o objfunptr prefunptr userptr++{- Working with bounds -}++foreign import ccall "nlopt.h nlopt_set_lower_bounds"+ nlopt_set_lower_bounds :: NloptOpt -> Ptr CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_set_lower_bounds1"+ nlopt_set_lower_bounds1 :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_lower_bounds"+ nlopt_get_lower_bounds :: NloptOpt -> Ptr CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_set_upper_bounds"+ nlopt_set_upper_bounds :: NloptOpt -> Ptr CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_set_upper_bounds1"+ nlopt_set_upper_bounds1 :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_upper_bounds"+ nlopt_get_upper_bounds :: NloptOpt -> Ptr CDouble -> IO CInt++set_lower_bounds :: Opt -> V.Vector Double -> IO Result+set_lower_bounds opt bounds =+ withForeignPtr (fst . V.unsafeToForeignPtr0 . V.unsafeCast $ bounds) $+ \bptr -> withOpt opt $ \o ->+ parseEnum <$> nlopt_set_lower_bounds o bptr++set_lower_bounds1 :: Opt -> Double -> IO Result+set_lower_bounds1 opt bound =+ withOpt opt $ \o ->+ parseEnum <$> nlopt_set_lower_bounds1 o (realToFrac bound)++get_lower_bounds :: Opt -> IO (V.Vector Double, Result)+get_lower_bounds opt = do+ v <- get_dimension opt >>= MV.new . fromIntegral+ MV.unsafeWith (MV.unsafeCast v) $ \vptr -> withOpt opt $ \o -> do+ result <- parseEnum <$> nlopt_get_lower_bounds o vptr+ retv <- V.unsafeFreeze v+ return (retv, result)++set_upper_bounds :: Opt -> V.Vector Double -> IO Result+set_upper_bounds opt bounds =+ withForeignPtr (fst . V.unsafeToForeignPtr0 . V.unsafeCast $ bounds) $+ \bptr -> withOpt opt $ \o ->+ parseEnum <$> nlopt_set_upper_bounds o bptr++set_upper_bounds1 :: Opt -> Double -> IO Result+set_upper_bounds1 opt bound =+ withOpt opt $ \o ->+ parseEnum <$> nlopt_set_upper_bounds1 o (realToFrac bound)++get_upper_bounds :: Opt -> IO (V.Vector Double, Result)+get_upper_bounds opt = do+ v <- get_dimension opt >>= MV.new . fromIntegral+ MV.unsafeWith (MV.unsafeCast v) $ \vptr -> withOpt opt $ \o -> do+ result <- parseEnum <$> nlopt_get_upper_bounds o vptr+ retv <- V.unsafeFreeze v+ return (retv, result)++{- Working with constraints -}++foreign import ccall "nlopt.h nlopt_remove_inequality_constraints"+ nlopt_remove_inequality_constraints :: NloptOpt -> IO CInt++foreign import ccall "nlopt.h nlopt_add_inequality_constraint"+ nlopt_add_inequality_constraint :: NloptOpt -> FunPtr (CFunc a)+ -> StablePtr a -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_add_precond_inequality_constraint"+ nlopt_add_precond_inequality_constraint :: NloptOpt -> FunPtr (CFunc a)+ -> FunPtr (CPrecond a) -> StablePtr a+ -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_add_inequality_mconstraint"+ nlopt_add_inequality_mconstraint :: NloptOpt -> CUInt -> FunPtr (CMFunc a)+ -> StablePtr a -> CDouble -> IO CInt++remove_inequality_constraints :: Opt -> IO Result+remove_inequality_constraints =+ useOpt $ fmap parseEnum . nlopt_remove_inequality_constraints++add_inequality_constraint :: Opt -> ScalarFunction a+ -> a -> Double -> IO Result+add_inequality_constraint opt objfun userdata tol = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objfun opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_add_inequality_constraint o objfunptr userptr (realToFrac tol)++add_precond_inequality_constraint :: Opt -> ScalarFunction a+ -> PreconditionerFunction a -> a -> Double+ -> IO Result+add_precond_inequality_constraint opt objfun precfun userdata tol = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objfun opt+ precfunptr <-+ exportFunPtr mkPreconditionerFunction wrapPreconditioner precfun opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_add_precond_inequality_constraint o objfunptr+ precfunptr userptr (realToFrac tol)++add_inequality_mconstraint :: Opt -> Word -> VectorFunction a -> a+ -> Double -> IO Result+add_inequality_mconstraint opt constraintsize constrfun userdata tol = do+ constrfunptr <- exportFunPtr mkMFunction wrapMFunction constrfun opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_add_inequality_mconstraint o (fromIntegral constraintsize)+ constrfunptr userptr (realToFrac tol)++foreign import ccall "nlopt.h nlopt_remove_equality_constraints"+ nlopt_remove_equality_constraints :: NloptOpt -> IO CInt++foreign import ccall "nlopt.h nlopt_add_equality_constraint"+ nlopt_add_equality_constraint :: NloptOpt -> FunPtr (CFunc a)+ -> StablePtr a -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_add_precond_equality_constraint"+ nlopt_add_precond_equality_constraint :: NloptOpt -> FunPtr (CFunc a)+ -> FunPtr (CPrecond a) -> StablePtr a+ -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_add_equality_mconstraint"+ nlopt_add_equality_mconstraint :: NloptOpt -> CUInt -> FunPtr (CMFunc a)+ -> StablePtr a -> CDouble -> IO CInt++remove_equality_constraints :: Opt -> IO Result+remove_equality_constraints =+ useOpt $ fmap parseEnum . nlopt_remove_equality_constraints++add_equality_constraint :: Opt -> ScalarFunction a+ -> a -> Double -> IO Result+add_equality_constraint opt objfun userdata tol = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objfun opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_add_equality_constraint o objfunptr userptr (realToFrac tol)++add_precond_equality_constraint :: Opt -> ScalarFunction a+ -> PreconditionerFunction a -> a -> Double+ -> IO Result+add_precond_equality_constraint opt objfun precfun userdata tol = do+ objfunptr <- exportFunPtr mkCFunction wrapCFunction objfun opt+ precfunptr <-+ exportFunPtr mkPreconditionerFunction wrapPreconditioner precfun opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_add_precond_equality_constraint o objfunptr+ precfunptr userptr (realToFrac tol)++add_equality_mconstraint :: Opt -> Word -> VectorFunction a -> a+ -> Double -> IO Result+add_equality_mconstraint opt constraintsize constrfun userdata tol = do+ constrfunptr <- exportFunPtr mkMFunction wrapMFunction constrfun opt+ userptr <- getStablePtr opt userdata+ withOpt opt $ \o ->+ parseEnum <$>+ nlopt_add_equality_mconstraint o (fromIntegral constraintsize)+ constrfunptr userptr (realToFrac tol)++{- Stopping criteria -}++withInputVector :: (Storable c, Storable a)+ => V.Vector c -> (Ptr a -> IO b) -> IO b+withInputVector = withForeignPtr . fst . V.unsafeToForeignPtr0 . V.unsafeCast+withOutputVector :: (Storable c, Storable a)+ => V.MVector s c -> (Ptr a -> IO b) -> IO b+withOutputVector = withForeignPtr . fst . MV.unsafeToForeignPtr0 . MV.unsafeCast++setScalar :: (Enum a, Integral b) => (NloptOpt -> t1 -> IO b)+ -> (t -> t1) -> Opt -> t -> IO a+setScalar setter conv opt val = withOpt opt $ \o ->+ parseEnum <$> setter o (conv val)++getScalar :: (NloptOpt -> IO b) -> (b -> a) -> Opt -> IO a+getScalar getter conv = useOpt $ fmap conv . getter++foreign import ccall "nlopt.h nlopt_set_stopval"+ nlopt_set_stopval :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_stopval"+ nlopt_get_stopval :: NloptOpt -> IO CDouble++set_stopval :: Opt -> Double -> IO Result+set_stopval = setScalar nlopt_set_stopval realToFrac++get_stopval :: Opt -> IO Double+get_stopval = getScalar nlopt_get_stopval realToFrac++foreign import ccall "nlopt.h nlopt_set_ftol_rel"+ nlopt_set_ftol_rel :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_ftol_rel"+ nlopt_get_ftol_rel :: NloptOpt -> IO CDouble++set_ftol_rel :: Opt -> Double -> IO Result+set_ftol_rel = setScalar nlopt_set_ftol_rel realToFrac++get_ftol_rel :: Opt -> IO Double+get_ftol_rel = getScalar nlopt_get_ftol_rel realToFrac++foreign import ccall "nlopt.h nlopt_set_ftol_abs"+ nlopt_set_ftol_abs :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_ftol_abs"+ nlopt_get_ftol_abs :: NloptOpt -> IO CDouble++set_ftol_abs :: Opt -> Double -> IO Result+set_ftol_abs = setScalar nlopt_set_ftol_abs realToFrac++get_ftol_abs :: Opt -> IO Double+get_ftol_abs = getScalar nlopt_get_ftol_abs realToFrac++foreign import ccall "nlopt.h nlopt_set_xtol_rel"+ nlopt_set_xtol_rel :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_xtol_rel"+ nlopt_get_xtol_rel :: NloptOpt -> IO CDouble++set_xtol_rel :: Opt -> Double -> IO Result+set_xtol_rel = setScalar nlopt_set_xtol_rel realToFrac++get_xtol_rel :: Opt -> IO Double+get_xtol_rel = getScalar nlopt_get_xtol_rel realToFrac++foreign import ccall "nlopt.h nlopt_set_xtol_abs1"+ nlopt_set_xtol_abs1 :: NloptOpt -> CDouble -> IO CInt++set_xtol_abs1 :: Opt -> Double -> IO Result+set_xtol_abs1 = setScalar nlopt_set_xtol_abs1 realToFrac++foreign import ccall "nlopt.h nlopt_set_xtol_abs"+ nlopt_set_xtol_abs :: NloptOpt -> Ptr CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_xtol_abs"+ nlopt_get_xtol_abs :: NloptOpt -> Ptr CDouble -> IO CInt++set_xtol_abs :: Opt -> V.Vector Double -> IO Result+set_xtol_abs opt tolvec =+ withInputVector tolvec $ \tolptr ->+ withOpt opt $ \o -> parseEnum <$> nlopt_set_xtol_abs o tolptr++get_xtol_abs :: Opt -> IO (Result, V.Vector Double)+get_xtol_abs opt = do+ mutv <- get_dimension opt >>= MV.new . fromIntegral+ withOutputVector mutv $ \vecptr ->+ withOpt opt $ \o -> do+ result <- parseEnum <$> nlopt_get_xtol_abs o vecptr+ outvec <- V.unsafeFreeze mutv+ return (result, outvec)++foreign import ccall "nlopt.h nlopt_set_maxeval"+ nlopt_set_maxeval :: NloptOpt -> CInt -> IO CInt++foreign import ccall "nlopt.h nlopt_get_maxeval"+ nlopt_get_maxeval :: NloptOpt -> IO CInt++set_maxeval :: Opt -> Word -> IO Result+set_maxeval = setScalar nlopt_set_maxeval fromIntegral++get_maxeval :: Opt -> IO Word+get_maxeval = getScalar nlopt_get_maxeval fromIntegral++foreign import ccall "nlopt.h nlopt_set_maxtime"+ nlopt_set_maxtime :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_maxtime"+ nlopt_get_maxtime :: NloptOpt -> IO CDouble++set_maxtime :: Opt -> Double -> IO Result+set_maxtime = setScalar nlopt_set_maxtime realToFrac++get_maxtime :: Opt -> IO Double+get_maxtime = getScalar nlopt_get_maxtime realToFrac++foreign import ccall "nlopt.h nlopt_force_stop"+ nlopt_force_stop :: NloptOpt -> IO CInt++force_stop :: Opt -> IO Result+force_stop = useOpt $ fmap parseEnum . nlopt_force_stop++foreign import ccall "nlopt.h nlopt_set_force_stop"+ nlopt_set_force_stop :: NloptOpt -> CInt -> IO CInt++foreign import ccall "nlopt.h nlopt_get_force_stop"+ nlopt_get_force_stop :: NloptOpt -> IO CInt++set_force_stop :: Opt -> Word -> IO Result+set_force_stop = setScalar nlopt_set_force_stop fromIntegral++get_force_stop :: Opt -> IO Word+get_force_stop = getScalar nlopt_get_force_stop fromIntegral++{- Algorithm-specific configuration -}++foreign import ccall "nlopt.h nlopt_set_local_optimizer"+ nlopt_set_local_optimizer :: NloptOpt -> NloptOpt -> IO CInt++set_local_optimizer :: Opt -- ^ Primary optimizer+ -> Opt -- ^ Subsidiary (local) optimizer+ -> IO Result+set_local_optimizer p s =+ withOpt p $ \primary -> withOpt s $ \secondary ->+ parseEnum <$> nlopt_set_local_optimizer primary secondary++foreign import ccall "nlopt.h nlopt_set_population"+ nlopt_set_population :: NloptOpt -> Word -> IO CInt++foreign import ccall "nlopt.h nlopt_get_population"+ nlopt_get_population :: NloptOpt -> IO Word++set_population :: Opt -> Word -> IO Result+set_population = setScalar nlopt_set_population fromIntegral++get_population :: Opt -> IO Word+get_population = getScalar nlopt_get_population fromIntegral++foreign import ccall "nlopt.h nlopt_set_vector_storage"+ nlopt_set_vector_storage :: NloptOpt -> Word -> IO CInt++foreign import ccall "nlopt.h nlopt_get_vector_storage"+ nlopt_get_vector_storage :: NloptOpt -> IO Word++set_vector_storage :: Opt -> Word -> IO Result+set_vector_storage = setScalar nlopt_set_vector_storage fromIntegral++get_vector_storage :: Opt -> IO Word+get_vector_storage = getScalar nlopt_get_vector_storage fromIntegral++foreign import ccall "nlopt.h nlopt_set_default_initial_step"+ nlopt_set_default_initial_step :: NloptOpt -> Ptr CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_set_initial_step"+ nlopt_set_initial_step :: NloptOpt -> Ptr CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_set_initial_step1"+ nlopt_set_initial_step1 :: NloptOpt -> CDouble -> IO CInt++foreign import ccall "nlopt.h nlopt_get_initial_step"+ nlopt_get_initial_step :: NloptOpt -> Ptr CDouble -> Ptr CDouble -> IO CInt++set_default_initial_step :: Opt -> V.Vector Double -> IO Result+set_default_initial_step opt stepvec =+ withInputVector stepvec $ \stepptr ->+ withOpt opt $ \o -> parseEnum <$> nlopt_set_default_initial_step o stepptr++set_initial_step :: Opt -> V.Vector Double -> IO Result+set_initial_step opt stepvec =+ withInputVector stepvec $ \stepptr ->+ withOpt opt $ \o -> parseEnum <$> nlopt_set_initial_step o stepptr++set_initial_step1 :: Opt -> Double -> IO Result+set_initial_step1 = setScalar nlopt_set_initial_step1 realToFrac++get_initial_step :: Opt -> V.Vector Double -> IO (Result, V.Vector Double)+get_initial_step opt xvec = do+ mutv <- get_dimension opt >>= MV.new . fromIntegral+ withOutputVector mutv $ \outptr ->+ withInputVector xvec $ \inptr ->+ withOpt opt $ \o -> do+ result <- parseEnum <$> nlopt_get_initial_step o inptr outptr+ outvec <- V.unsafeFreeze mutv+ return (result, outvec)
+ tests/example.hs view
@@ -0,0 +1,78 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -Wall #-}++module Main where++import Numeric.Optimization.NLOPT.Bindings+import qualified Data.Vector.Storable as V+import qualified System.Exit as E+import Control.Monad (when)++objective :: ScalarFunction ()+objective params g _ = do+ case g of+ Just grad -> V.copy grad $ V.fromList [0.0, 0.5]+ Nothing -> return ()+ return $ sqrt $ params V.! 1++constraint :: ScalarFunction (Double, Double)+constraint params g (a, b) = do+ case g of+ Just grad -> V.copy grad $ V.fromList [3 * a * t * t, -1.0]+ Nothing -> return ()+ return f+ where+ [x0, x1] = V.toList params+ t = (a * x0 + b)+ f = t * t * t - x1++lowerBounds :: V.Vector Double+lowerBounds = V.fromList [-1e222, 0.0]++checkReturn :: Result -> IO ()+checkReturn c = when (not $ isSuccess c) $ do+ putStrLn $ "NLOPT error '" ++ show c ++ "'!"+ E.exitFailure++xinit :: V.Vector Double+xinit = V.fromList [1.234, 5.678]++expectedParams :: V.Vector Double+expectedParams = V.fromList [0.33333337491594595,0.2962962707981303]++expectedMinimum :: Double+expectedMinimum = 0.5443310305302559++main :: IO ()+main = do+ Just opt <- create LD_MMA 2+ putStrLn "Got optimizer."+ bnd <- set_lower_bounds opt lowerBounds+ checkReturn bnd+ putStrLn "Set lower bounds."+ obj <- set_min_objective opt objective ()+ checkReturn obj+ putStrLn "Set min objective."+ cnst1 <- add_inequality_constraint opt constraint (2, 0) 1e-8+ checkReturn cnst1+ putStrLn "Added inequality constraint #1."+ cnst2 <- add_inequality_constraint opt constraint (-1, 1) 1e-8+ checkReturn cnst2+ putStrLn "Added inequality constraint #2."+ tol <- set_xtol_rel opt 1e-4+ checkReturn tol+ putStrLn "Set param tolerance."+ Output result cost params <- optimize opt xinit+ checkReturn result+ let+ verr = V.sum . V.map (abs) $ V.zipWith (-) params expectedParams+ ferr = abs $ cost - expectedMinimum+ if verr > 1e-12 || ferr > 1e-12+ then do+ putStrLn "Solution error!"+ putStrLn $ "Expected minimum of " ++ show expectedMinimum +++ " and got " ++ show cost+ putStrLn $ "Expected " ++ show expectedParams ++ " and got " ++ show params+ E.exitFailure+ else+ putStrLn $ "Found minimum at f" ++ show params ++ " = " ++ show cost