ipopt-hs-0.5.1.0: haskell binding to ipopt and nlopt including automatic differentiation

Safe HaskellNone
LanguageHaskell2010

Ipopt

Contents

Description

This module exports most things you should need. Also take a look at Ipopt.NLP and Ipopt.Raw and examples/

Synopsis

high-level

variables

var' Source

Arguments

:: (Monad m, Functor m) 
=> Maybe (Double, Double)

bounds (xl,xu) to request that xl <= x <= xu. if Nothing, you get whatever is in defaultBounds

-> Maybe String

optional longer description

-> String

variable name (namespace from the pushEnv / popEnv can make an "x" you request here different from one you previously requested

-> NLPT m Ix

the index (into the rawvector of variables that the solver sees)

add a variable, or get a reference to the the same variable if it has already been used

var :: Monad m => Maybe (Double, Double) -> String -> StateT NLPState m (AnyRF Identity) Source

a combination of var' and ixToVar

varFresh' :: (Monad m, Functor m) => Maybe (Double, Double) -> String -> NLPT m Ix Source

var, except this causes the solver to get a new variable, so that you can use:

[a,b,c,d,e] <- replicateM 5 (varFresh (Just (0, 10)) "x")

and the different letters can take different values (between 0 and 10) in the optimal solution (depending on what you do with a and similar in the objective function and other constraints).

data AnyRF cb Source

AnyRF cb is a function that uses variables from the nonlinear program in a way supported by AnyRFCxt. The cb is usually Identity

Constructors

AnyRF (forall a. AnyRFCxt a => Vector a -> cb a) 

newtype Identity a :: * -> *

Identity functor and monad. (a non-strict monad)

Since: 4.8.0.0

Constructors

Identity 

Fields

runIdentity :: a
 

Instances

Monad Identity 
Functor Identity 
MonadFix Identity 
Applicative Identity 
Foldable Identity 
Traversable Identity 
Generic1 Identity 
Representable Identity 
MonadZip Identity 
Comonad Identity 
ComonadApply Identity 
Eq1 Identity 
Ord1 Identity 
Read1 Identity 
Show1 Identity 
Sieve ReifiedGetter Identity 
Cosieve ReifiedGetter Identity 
Eq a => Eq (Identity a) 
Eq (AnyRF Identity) 
Floating (AnyRF Identity) 
Fractional (AnyRF Identity) 
Data a => Data (Identity a) 
Num (AnyRF Identity) 
Ord a => Ord (Identity a) 
Ord (AnyRF Identity) 
Read a => Read (Identity a)

This instance would be equivalent to the derived instances of the Identity newtype if the runIdentity field were removed

Real (AnyRF Identity) 
RealFloat (AnyRF Identity) 
RealFrac (AnyRF Identity) 
Show a => Show (Identity a)

This instance would be equivalent to the derived instances of the Identity newtype if the runIdentity field were removed

Generic (Identity a) 
Ixed (Identity a) 
Wrapped (Identity a) 
VectorSpace (AnyRF Identity) 
AdditiveGroup (AnyRF Identity) 
(~) * t (Identity b) => Rewrapped (Identity a) t 
Field1 (Identity a) (Identity b) a b 
type Rep1 Identity = D1 D1Identity (C1 C1_0Identity (S1 S1_0_0Identity Par1)) 
type Rep Identity = () 
type Rep (Identity a) = D1 D1Identity (C1 C1_0Identity (S1 S1_0_0Identity (Rec0 a))) 
type Index (Identity a) = () 
type IxValue (Identity a) = a 
type Unwrapped (Identity a) = a 
type Scalar (AnyRF Identity) = Double 

functions

addG Source

Arguments

:: Monad m 
=> Maybe String

optional description

-> (Double, Double)

bounds (gl,gu) for the single inequality gl_i <= g_i(x) <= gu_i

-> AnyRF Identity
g_i(x)
-> NLPT m () 

add a constraint

addF Source

Arguments

:: Monad m 
=> Maybe String

description

-> AnyRF Identity

`f_i(x)`

-> NLPT m () 

add a piece of the objective function, which is added in the form `f_1 + f_2 + ...`, to make it easier to understand (at some point) which components are responsible for the majority of the cost, and which are irrelevant.

running the solver

nlpstate0 :: NLPState Source

the initial state to use when you actually have to get to IO with the solution

solveNLP' Source

Arguments

:: (Vector v Double, MonadIO m) 
=> (IpProblem -> IO ())

set ipopt options (using functions from Ipopt.Raw) or the ipopts quasiquoter

-> NLPT m (IpOptSolved v) 

calls createIpoptProblemAD and ipoptSolve. To be used at the end of a do-block.

solver options

ipopts :: QuasiQuoter Source

an expression-only quasiquote intended to be the second argument for solveNLP' (so solveNLP [ipopts| tol = 1e-3 |]). This is a shortcut for calling addIpoptNumOption addIpoptStrOption or addIpoptIntOption.

Refer to ipopt's options reference, the syntax is like option_name = value;option2 = value2. The semicolons are optional and whitespace alone can separate the option name from the value. A few examples of the parser:

>>> :set -XQuasiQuotes
>>> let f = [ipopts| tol = 1e-3; print_level = 0 |]
>>> :t f
f :: IpProblem -> IO ()
>>> let p x = uuParseTest parseOpts x
>>> p "tol = 3"
([("tol",ANum 3.0)],[])
>>> p "tol = 3 tol = 4" -- the last one wins. No warnings done (yet).
([("tol",ANum 3.0),("tol",ANum 4.0)],[])
>>> p "tol = 3\n\ntol = 4"
([("tol",ANum 3.0),("tol",ANum 4.0)],[])
>>> p "acceptable_iter = 25; output_file = foobar" -- quotation marks optional
([("acceptable_iter",AInt 25),("output_file",AStr "foobar")],[])
>>> p "output_file = \"foo bar\"" -- but needed here
([("output_file",AStr "foo bar")],[])
>>> putStrLn $ (++"...") $ take 100 $ show $ p "atol = 1.8" -- typo gets corrected
([("tol",ANum 1.8)],[--    Deleted   'a' at position LineColPos 0 0 0 expecting one of [Whitespace, ...
>>> p "tol = $xY" -- interpolating haskell variables
([("tol",AVar OptionNum "xY")],[])

type IntermediateCB Source

Arguments

 = CInt

alg_mod (0 regular, 1 is resto)

-> CInt

iter count

-> Double

obj value

-> Double

inf_pr

-> Double

inf_du

-> Double

mu

-> Double

d_norm

-> Double

regularization_size

-> Double

alpha_du

-> Double

alpha_pr

-> CInt

ls_trials

-> Ptr ()

user_data (usually null)

-> IO IpBool 

low-level bits still needed

types

type Vec = IOVector Double Source

Vector of numbers