Safe Haskell | None |
---|---|
Language | Haskell2010 |
- var' :: (Monad m, Functor m) => Maybe (Double, Double) -> Maybe String -> String -> NLPT m Ix
- var :: Monad 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 => 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, 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
- setIntermediateCallback :: IpProblem -> IntermediateCB -> IO Bool
- type IntermediateCB = CInt -> CInt -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> CInt -> Ptr () -> IO IpBool
- data IpOptSolved v = IpOptSolved {}
- data ApplicationReturnStatus
- = InternalError
- | InsufficientMemory
- | NonipoptExceptionThrown
- | UnrecoverableException
- | InvalidNumberDetected
- | InvalidOption
- | InvalidProblemDefinition
- | NotEnoughDegreesOfFreedom
- | MaximumCputimeExceeded
- | ErrorInStepComputation
- | RestorationFailed
- | MaximumIterationsExceeded
- | SolveSucceeded
- | SolvedToAcceptableLevel
- | InfeasibleProblemDetected
- | SearchDirectionBecomesTooSmall
- | DivergingIterates
- | UserRequestedStop
- | FeasiblePointFound
- type Vec = IOVector Double
- type IpNumber = CDouble
high-level
variables
:: (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
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).
varFresh :: Monad m => Maybe (Double, Double) -> String -> StateT NLPState m (AnyRF Identity) Source
see varFresh'
AnyRF cb
is a function that uses variables from the nonlinear
program in a way supported by AnyRFCxt
. The cb
is
usually Identity
Eq (AnyRF Identity) Source | |
Floating (AnyRF Identity) Source | |
Fractional (AnyRF Identity) Source | |
Num (AnyRF Identity) Source | |
Ord (AnyRF Identity) Source | |
Real (AnyRF Identity) Source | |
RealFloat (AnyRF Identity) Source | |
RealFrac (AnyRF Identity) Source | |
Monoid (AnyRF Seq) Source | |
VectorSpace (AnyRF Identity) Source | |
AdditiveGroup (AnyRF Identity) Source | |
type Scalar (AnyRF Identity) = Double Source |
newtype Identity a :: * -> *
Identity functor and monad. (a non-strict monad)
Since: 4.8.0.0
Identity | |
|
functions
:: 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, 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
:: (Vector v Double, MonadIO m) | |
=> (IpProblem -> IO ()) | set ipopt options (using functions from Ipopt.Raw) or the |
-> 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 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
low-level bits still needed
data IpOptSolved v Source
lenses are in Ipopt.PP
data ApplicationReturnStatus Source