| Safe Haskell | None |
|---|
Ipopt
Contents
Description
- var' :: (Monad m, Functor m) => Maybe (Double, Double) -> Maybe String -> String -> NLPT m Ix
- var :: (Monad m, Functor m) => Maybe (Double, Double) -> String -> StateT NLPState m (AnyRF Identity)
- varFresh' :: (Monad m, Functor m) => Maybe (Double, Double) -> String -> NLPT m Ix
- varFresh :: (Monad m, Functor m) => Maybe (Double, Double) -> String -> StateT NLPState m (AnyRF Identity)
- data AnyRF cb = AnyRF (forall a. AnyRFCxt a => Vector a -> cb a)
- newtype Identity a = Identity {
- runIdentity :: a
- addG :: Monad m => Maybe String -> (Double, Double) -> AnyRF Identity -> NLPT m ()
- addF :: Monad m => Maybe String -> AnyRF Identity -> NLPT m ()
- ppSoln :: (Monad m, Functor m, PrintfArg (IxValue (v Double)), Vector v Double, Ixed (v Double), ~ * (Index (v Double)) Int) => NLPState -> StateT NLPState m (IpOptSolved v) -> m (IpOptSolved v, Doc)
- type NLPT = StateT NLPState
- nlpstate0 :: NLPState
- module Control.Monad.State
- solveNLP' :: (Vector v Double, MonadIO m) => (IpProblem -> IO ()) -> NLPT m (IpOptSolved v)
- ipopts :: QuasiQuoter
- setIpoptProblemScaling :: IpProblem -> Double -> Vec -> Vec -> IO Bool
- openIpoptOutputFile :: IpProblem -> String -> Int -> IO Bool
- data IpOptSolved v = IpOptSolved {}
- data ApplicationReturnStatus
- = SolveSucceeded
- | SolvedToAcceptableLevel
- | InfeasibleProblemDetected
- | SearchDirectionBecomesTooSmall
- | DivergingIterates
- | UserRequestedStop
- | FeasiblePointFound
- | MaximumIterationsExceeded
- | RestorationFailed
- | ErrorInStepComputation
- | MaximumCputimeExceeded
- | NotEnoughDegreesOfFreedom
- | InvalidProblemDefinition
- | InvalidOption
- | InvalidNumberDetected
- | UnrecoverableException
- | NonipoptExceptionThrown
- | InsufficientMemory
- | InternalError
- type Vec = IOVector Double
- type IpNumber = CDouble
high-level
variables
Arguments
| :: (Monad m, Functor m) | |
| => Maybe (Double, Double) | bounds |
| -> Maybe String | optional longer description |
| -> String | variable name (namespace from the |
| -> 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, Functor m) => Maybe (Double, Double) -> String -> StateT NLPState m (AnyRF Identity)Source
varFresh' :: (Monad m, Functor m) => Maybe (Double, Double) -> String -> NLPT m IxSource
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).
varFresh :: (Monad m, Functor m) => Maybe (Double, Double) -> String -> StateT NLPState m (AnyRF Identity)Source
see varFresh'
newtype Identity a
Identity functor and monad.
Constructors
| Identity | |
Fields
| |
Instances
| Monad Identity | |
| Functor Identity | |
| MonadFix Identity | |
| Applicative Identity | |
| Foldable Identity | |
| Traversable Identity | |
| Comonad Identity | |
| ComonadApply Identity | |
| Distributive Identity | |
| Effective Identity r (Const r) | |
| Eq (AnyRF Identity) | |
| Floating (AnyRF Identity) | |
| Fractional (AnyRF Identity) | |
| Num (AnyRF Identity) | |
| Ord (AnyRF Identity) | |
| Real (AnyRF Identity) | |
| RealFloat (AnyRF Identity) | |
| RealFrac (AnyRF Identity) | |
| 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 |
functions
Arguments
| :: Monad m | |
| => Maybe String | optional description |
| -> (Double, Double) | bounds |
| -> AnyRF Identity | g_i(x) |
| -> NLPT m () |
add a constraint
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
ppSoln :: (Monad m, Functor m, PrintfArg (IxValue (v Double)), Vector v Double, Ixed (v Double), ~ * (Index (v Double)) Int) => NLPState -> StateT NLPState m (IpOptSolved v) -> m (IpOptSolved v, Doc)Source
the initial state to use when you actually have to get to IO with the solution
module Control.Monad.State
Arguments
| :: (Vector v Double, MonadIO m) | |
| => (IpProblem -> IO ()) | set ipopt options (using functions from Ipopt.Raw) |
| -> NLPT m (IpOptSolved v) |
calls createIpoptProblemAD and ipoptSolve. To be used at the
end of a do-block.
solver options
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 ff :: 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")],[])
low-level bits still needed
data ApplicationReturnStatus Source
Constructors