mpfit.pro0000644000244500024450000043162112717414567012236 0ustar craigmcraigm;+ ; NAME: ; MPFIT ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Perform Levenberg-Marquardt least-squares minimization (MINPACK-1) ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; parms = MPFIT(MYFUNCT, start_parms, FUNCTARGS=fcnargs, NFEV=nfev, ; MAXITER=maxiter, ERRMSG=errmsg, NPRINT=nprint, QUIET=quiet, ; FTOL=ftol, XTOL=xtol, GTOL=gtol, NITER=niter, ; STATUS=status, ITERPROC=iterproc, ITERARGS=iterargs, ; COVAR=covar, PERROR=perror, BESTNORM=bestnorm, ; PARINFO=parinfo) ; ; DESCRIPTION: ; ; MPFIT uses the Levenberg-Marquardt technique to solve the ; least-squares problem. In its typical use, MPFIT will be used to ; fit a user-supplied function (the "model") to user-supplied data ; points (the "data") by adjusting a set of parameters. MPFIT is ; based upon MINPACK-1 (LMDIF.F) by More' and collaborators. ; ; For example, a researcher may think that a set of observed data ; points is best modelled with a Gaussian curve. A Gaussian curve is ; parameterized by its mean, standard deviation and normalization. ; MPFIT will, within certain constraints, find the set of parameters ; which best fits the data. The fit is "best" in the least-squares ; sense; that is, the sum of the weighted squared differences between ; the model and data is minimized. ; ; The Levenberg-Marquardt technique is a particular strategy for ; iteratively searching for the best fit. This particular ; implementation is drawn from MINPACK-1 (see NETLIB), and seems to ; be more robust than routines provided with IDL. This version ; allows upper and lower bounding constraints to be placed on each ; parameter, or the parameter can be held fixed. ; ; The IDL user-supplied function should return an array of weighted ; deviations between model and data. In a typical scientific problem ; the residuals should be weighted so that each deviate has a ; gaussian sigma of 1.0. If X represents values of the independent ; variable, Y represents a measurement for each value of X, and ERR ; represents the error in the measurements, then the deviates could ; be calculated as follows: ; ; DEVIATES = (Y - F(X)) / ERR ; ; where F is the function representing the model. You are ; recommended to use the convenience functions MPFITFUN and ; MPFITEXPR, which are driver functions that calculate the deviates ; for you. If ERR are the 1-sigma uncertainties in Y, then ; ; TOTAL( DEVIATES^2 ) ; ; will be the total chi-squared value. MPFIT will minimize the ; chi-square value. The values of X, Y and ERR are passed through ; MPFIT to the user-supplied function via the FUNCTARGS keyword. ; ; Simple constraints can be placed on parameter values by using the ; PARINFO keyword to MPFIT. See below for a description of this ; keyword. ; ; MPFIT does not perform more general optimization tasks. See TNMIN ; instead. MPFIT is customized, based on MINPACK-1, to the ; least-squares minimization problem. ; ; USER FUNCTION ; ; The user must define a function which returns the appropriate ; values as specified above. The function should return the weighted ; deviations between the model and the data. For applications which ; use finite-difference derivatives -- the default -- the user ; function should be declared in the following way: ; ; FUNCTION MYFUNCT, p, X=x, Y=y, ERR=err ; ; Parameter values are passed in "p" ; model = F(x, p) ; return, (y-model)/err ; END ; ; See below for applications with explicit derivatives. ; ; The keyword parameters X, Y, and ERR in the example above are ; suggestive but not required. Any parameters can be passed to ; MYFUNCT by using the FUNCTARGS keyword to MPFIT. Use MPFITFUN and ; MPFITEXPR if you need ideas on how to do that. The function *must* ; accept a parameter list, P. ; ; In general there are no restrictions on the number of dimensions in ; X, Y or ERR. However the deviates *must* be returned in a ; one-dimensional array, and must have the same type (float or ; double) as the input arrays. ; ; See below for error reporting mechanisms. ; ; ; CHECKING STATUS AND HANNDLING ERRORS ; ; Upon return, MPFIT will report the status of the fitting operation ; in the STATUS and ERRMSG keywords. The STATUS keyword will contain ; a numerical code which indicates the success or failure status. ; Generally speaking, any value 1 or greater indicates success, while ; a value of 0 or less indicates a possible failure. The ERRMSG ; keyword will contain a text string which should describe the error ; condition more fully. ; ; By default, MPFIT will trap fatal errors and report them to the ; caller gracefully. However, during the debugging process, it is ; often useful to halt execution where the error occurred. When you ; set the NOCATCH keyword, MPFIT will not do any special error ; trapping, and execution will stop whereever the error occurred. ; ; MPFIT does not explicitly change the !ERROR_STATE variable ; (although it may be changed implicitly if MPFIT calls MESSAGE). It ; is the caller's responsibility to call MESSAGE, /RESET to ensure ; that the error state is initialized before calling MPFIT. ; ; User functions may also indicate non-fatal error conditions using ; the ERROR_CODE common block variable, as described below under the ; MPFIT_ERROR common block definition (by setting ERROR_CODE to a ; number between -15 and -1). When the user function sets an error ; condition via ERROR_CODE, MPFIT will gracefully exit immediately ; and report this condition to the caller. The ERROR_CODE is ; returned in the STATUS keyword in that case. ; ; ; EXPLICIT DERIVATIVES ; ; In the search for the best-fit solution, MPFIT by default ; calculates derivatives numerically via a finite difference ; approximation. The user-supplied function need not calculate the ; derivatives explicitly. However, the user function *may* calculate ; the derivatives if desired, but only if the model function is ; declared with an additional position parameter, DP, as described ; below. If the user function does not accept this additional ; parameter, MPFIT will report an error. As a practical matter, it ; is often sufficient and even faster to allow MPFIT to calculate the ; derivatives numerically, but this option is available for users who ; wish more control over the fitting process. ; ; There are two ways to enable explicit derivatives. First, the user ; can set the keyword AUTODERIVATIVE=0, which is a global switch for ; all parameters. In this case, MPFIT will request explicit ; derivatives for every free parameter. ; ; Second, the user may request explicit derivatives for specifically ; selected parameters using the PARINFO.MPSIDE=3 (see "CONSTRAINING ; PARAMETER VALUES WITH THE PARINFO KEYWORD" below). In this ; strategy, the user picks and chooses which parameter derivatives ; are computed explicitly versus numerically. When PARINFO[i].MPSIDE ; EQ 3, then the ith parameter derivative is computed explicitly. ; ; The keyword setting AUTODERIVATIVE=0 always globally overrides the ; individual values of PARINFO.MPSIDE. Setting AUTODERIVATIVE=0 is ; equivalent to resetting PARINFO.MPSIDE=3 for all parameters. ; ; Even if the user requests explicit derivatives for some or all ; parameters, MPFIT will not always request explicit derivatives on ; every user function call. ; ; EXPLICIT DERIVATIVES - CALLING INTERFACE ; ; When AUTODERIVATIVE=0, the user function is responsible for ; calculating the derivatives of the *residuals* with respect to each ; parameter. The user function should be declared as follows: ; ; ; ; ; MYFUNCT - example user function ; ; P - input parameter values (N-element array) ; ; DP - upon input, an N-vector indicating which parameters ; ; to compute derivatives for; ; ; upon output, the user function must return ; ; an ARRAY(M,N) of derivatives in this keyword ; ; (keywords) - any other keywords specified by FUNCTARGS ; ; RETURNS - residual values ; ; ; FUNCTION MYFUNCT, p, dp, X=x, Y=y, ERR=err ; model = F(x, p) ;; Model function ; resid = (y - model)/err ;; Residual calculation (for example) ; ; if n_params() GT 1 then begin ; ; Create derivative and compute derivative array ; requested = dp ; Save original value of DP ; dp = make_array(n_elements(x), n_elements(p), value=x[0]*0) ; ; ; Compute derivative if requested by caller ; for i = 0, n_elements(p)-1 do if requested(i) NE 0 then $ ; dp(*,i) = FGRAD(x, p, i) / err ; endif ; ; return, resid ; END ; ; where FGRAD(x, p, i) is a model function which computes the ; derivative of the model F(x,p) with respect to parameter P(i) at X. ; ; A quirk in the implementation leaves a stray negative sign in the ; definition of DP. The derivative of the *residual* should be ; "-FGRAD(x,p,i) / err" because of how the residual is defined ; ("resid = (data - model) / err"). **HOWEVER** because of the ; implementation quirk, MPFIT expects FGRAD(x,p,i)/err instead, ; i.e. the opposite sign of the gradient of RESID. ; ; Derivatives should be returned in the DP array. DP should be an ; ARRAY(m,n) array, where m is the number of data points and n is the ; number of parameters. -DP[i,j] is the derivative of the ith ; residual with respect to the jth parameter (note the minus sign ; due to the quirk described above). ; ; As noted above, MPFIT may not always request derivatives from the ; user function. In those cases, the parameter DP is not passed. ; Therefore functions can use N_PARAMS() to indicate whether they ; must compute the derivatives or not. ; ; The derivatives with respect to fixed parameters are ignored; zero ; is an appropriate value to insert for those derivatives. Upon ; input to the user function, DP is set to a vector with the same ; length as P, with a value of 1 for a parameter which is free, and a ; value of zero for a parameter which is fixed (and hence no ; derivative needs to be calculated). This input vector may be ; overwritten as needed. In the example above, the original DP ; vector is saved to a variable called REQUESTED, and used as a mask ; to calculate only those derivatives that are required. ; ; If the data is higher than one dimensional, then the *last* ; dimension should be the parameter dimension. Example: fitting a ; 50x50 image, "dp" should be 50x50xNPAR. ; ; EXPLICIT DERIVATIVES - TESTING and DEBUGGING ; ; For reasonably complicated user functions, the calculation of ; explicit derivatives of the correct sign and magnitude can be ; difficult to get right. A simple sign error can cause MPFIT to be ; confused. MPFIT has a derivative debugging mode which will compute ; the derivatives *both* numerically and explicitly, and compare the ; results. ; ; It is expected that during production usage, derivative debugging ; should be disabled for all parameters. ; ; In order to enable derivative debugging mode, set the following ; PARINFO members for the ith parameter. ; PARINFO[i].MPSIDE = 3 ; Enable explicit derivatives ; PARINFO[i].MPDERIV_DEBUG = 1 ; Enable derivative debugging mode ; PARINFO[i].MPDERIV_RELTOL = ?? ; Relative tolerance for comparison ; PARINFO[i].MPDERIV_ABSTOL = ?? ; Absolute tolerance for comparison ; Note that these settings are maintained on a parameter-by-parameter ; basis using PARINFO, so the user can choose which parameters ; derivatives will be tested. ; ; When .MPDERIV_DEBUG is set, then MPFIT first computes the ; derivative explicitly by requesting them from the user function. ; Then, it computes the derivatives numerically via finite ; differencing, and compares the two values. If the difference ; exceeds a tolerance threshold, then the values are printed out to ; alert the user. The tolerance level threshold contains both a ; relative and an absolute component, and is expressed as, ; ; ABS(DERIV_U - DERIV_N) GE (ABSTOL + RELTOL*ABS(DERIV_U)) ; ; where DERIV_U and DERIV_N are the derivatives computed explicitly ; and numerically, respectively. Appropriate values ; for most users will be: ; ; PARINFO[i].MPDERIV_RELTOL = 1d-3 ;; Suggested relative tolerance ; PARINFO[i].MPDERIV_ABSTOL = 1d-7 ;; Suggested absolute tolerance ; ; although these thresholds may have to be adjusted for a particular ; problem. When the threshold is exceeded, users can expect to see a ; tabular report like this one: ; ; FJAC DEBUG BEGIN ; # IPNT FUNC DERIV_U DERIV_N DIFF_ABS DIFF_REL ; FJAC PARM 2 ; 80 -0.7308 0.04233 0.04233 -5.543E-07 -1.309E-05 ; 99 1.370 0.01417 0.01417 -5.518E-07 -3.895E-05 ; 118 0.07187 -0.01400 -0.01400 -5.566E-07 3.977E-05 ; 137 1.844 -0.04216 -0.04216 -5.589E-07 1.326E-05 ; FJAC DEBUG END ; ; The report will be bracketed by FJAC DEBUG BEGIN/END statements. ; Each parameter will be delimited by the statement FJAC PARM n, ; where n is the parameter number. The columns are, ; ; IPNT - data point number (0 ... M-1) ; FUNC - function value at that point ; DERIV_U - explicit derivative value at that point ; DERIV_N - numerical derivative estimate at that point ; DIFF_ABS - absolute difference = (DERIV_U - DERIV_N) ; DIFF_REL - relative difference = (DIFF_ABS)/(DERIV_U) ; ; When prints appear in this report, it is most important to check ; that the derivatives computed in two different ways have the same ; numerical sign and the same order of magnitude, since these are the ; most common programming mistakes. ; ; A line of this form may also appear ; ; # FJAC_MASK = 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 ; ; This line indicates for which parameters explicit derivatives are ; expected. A list of all-1s indicates all explicit derivatives for ; all parameters are requested from the user function. ; ; ; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD ; ; The behavior of MPFIT can be modified with respect to each ; parameter to be fitted. A parameter value can be fixed; simple ; boundary constraints can be imposed; limitations on the parameter ; changes can be imposed; properties of the automatic derivative can ; be modified; and parameters can be tied to one another. ; ; These properties are governed by the PARINFO structure, which is ; passed as a keyword parameter to MPFIT. ; ; PARINFO should be an array of structures, one for each parameter. ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; .VALUE - the starting parameter value (but see the START_PARAMS ; parameter for more information). ; ; .FIXED - a boolean value, whether the parameter is to be held ; fixed or not. Fixed parameters are not varied by ; MPFIT, but are passed on to MYFUNCT for evaluation. ; ; .LIMITED - a two-element boolean array. If the first/second ; element is set, then the parameter is bounded on the ; lower/upper side. A parameter can be bounded on both ; sides. Both LIMITED and LIMITS must be given ; together. ; ; .LIMITS - a two-element float or double array. Gives the ; parameter limits on the lower and upper sides, ; respectively. Zero, one or two of these values can be ; set, depending on the values of LIMITED. Both LIMITED ; and LIMITS must be given together. ; ; .PARNAME - a string, giving the name of the parameter. The ; fitting code of MPFIT does not use this tag in any ; way. However, the default ITERPROC will print the ; parameter name if available. ; ; .STEP - the step size to be used in calculating the numerical ; derivatives. If set to zero, then the step size is ; computed automatically. Ignored when AUTODERIVATIVE=0. ; This value is superceded by the RELSTEP value. ; ; .RELSTEP - the *relative* step size to be used in calculating ; the numerical derivatives. This number is the ; fractional size of the step, compared to the ; parameter value. This value supercedes the STEP ; setting. If the parameter is zero, then a default ; step size is chosen. ; ; .MPSIDE - selector for type of derivative calculation. This ; field can take one of five possible values: ; ; 0 - one-sided derivative computed automatically ; 1 - one-sided derivative (f(x+h) - f(x) )/h ; -1 - one-sided derivative (f(x) - f(x-h))/h ; 2 - two-sided derivative (f(x+h) - f(x-h))/(2*h) ; 3 - explicit derivative used for this parameter ; ; In the first four cases, the derivative is approximated ; numerically by finite difference, with step size ; H=STEP, where the STEP parameter is defined above. The ; last case, MPSIDE=3, indicates to allow the user ; function to compute the derivative explicitly (see ; section on "EXPLICIT DERIVATIVES"). AUTODERIVATIVE=0 ; overrides this setting for all parameters, and is ; equivalent to MPSIDE=3 for all parameters. For ; MPSIDE=0, the "automatic" one-sided derivative method ; will chose a direction for the finite difference which ; does not violate any constraints. The other methods ; (MPSIDE=-1 or MPSIDE=1) do not perform this check. The ; two-sided method is in principle more precise, but ; requires twice as many function evaluations. Default: ; 0. ; ; .MPDERIV_DEBUG - set this value to 1 to enable debugging of ; user-supplied explicit derivatives (see "TESTING and ; DEBUGGING" section above). In addition, the ; user must enable calculation of explicit derivatives by ; either setting AUTODERIVATIVE=0, or MPSIDE=3 for the ; desired parameters. When this option is enabled, a ; report may be printed to the console, depending on the ; MPDERIV_ABSTOL and MPDERIV_RELTOL settings. ; Default: 0 (no debugging) ; ; ; .MPDERIV_ABSTOL, .MPDERIV_RELTOL - tolerance settings for ; print-out of debugging information, for each parameter ; where debugging is enabled. See "TESTING and ; DEBUGGING" section above for the meanings of these two ; fields. ; ; ; .MPMAXSTEP - the maximum change to be made in the parameter ; value. During the fitting process, the parameter ; will never be changed by more than this value in ; one iteration. ; ; A value of 0 indicates no maximum. Default: 0. ; ; .TIED - a string expression which "ties" the parameter to other ; free or fixed parameters as an equality constraint. Any ; expression involving constants and the parameter array P ; are permitted. ; Example: if parameter 2 is always to be twice parameter ; 1 then use the following: parinfo[2].tied = '2 * P[1]'. ; Since they are totally constrained, tied parameters are ; considered to be fixed; no errors are computed for them, ; and any LIMITS are not obeyed. ; [ NOTE: the PARNAME can't be used in a TIED expression. ] ; ; .MPPRINT - if set to 1, then the default ITERPROC will print the ; parameter value. If set to 0, the parameter value ; will not be printed. This tag can be used to ; selectively print only a few parameter values out of ; many. Default: 1 (all parameters printed) ; ; .MPFORMAT - IDL format string to print the parameter within ; ITERPROC. Default: '(G20.6)' (An empty string will ; also use the default.) ; ; Future modifications to the PARINFO structure, if any, will involve ; adding structure tags beginning with the two letters "MP". ; Therefore programmers are urged to avoid using tags starting with ; "MP", but otherwise they are free to include their own fields ; within the PARINFO structure, which will be ignored by MPFIT. ; ; PARINFO Example: ; parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $ ; limits:[0.D,0]}, 5) ; parinfo[0].fixed = 1 ; parinfo[4].limited[0] = 1 ; parinfo[4].limits[0] = 50.D ; parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.] ; ; A total of 5 parameters, with starting values of 5.7, ; 2.2, 500, 1.5, and 2000 are given. The first parameter ; is fixed at a value of 5.7, and the last parameter is ; constrained to be above 50. ; ; ; RECURSION ; ; Generally, recursion is not allowed. As of version 1.77, MPFIT has ; recursion protection which does not allow a model function to ; itself call MPFIT. Users who wish to perform multi-level ; optimization should investigate the 'EXTERNAL' function evaluation ; methods described below for hard-to-evaluate functions. That ; method places more control in the user's hands. The user can ; design a "recursive" application by taking care. ; ; In most cases the recursion protection should be well-behaved. ; However, if the user is doing debugging, it is possible for the ; protection system to get "stuck." In order to reset it, run the ; procedure: ; MPFIT_RESET_RECURSION ; and the protection system should get "unstuck." It is save to call ; this procedure at any time. ; ; ; COMPATIBILITY ; ; This function is designed to work with IDL 5.0 or greater. ; ; Because TIED parameters and the "(EXTERNAL)" user-model feature use ; the EXECUTE() function, they cannot be used with the free version ; of the IDL Virtual Machine. ; ; ; DETERMINING THE VERSION OF MPFIT ; ; MPFIT is a changing library. Users of MPFIT may also depend on a ; specific version of the library being present. As of version 1.70 ; of MPFIT, a VERSION keyword has been added which allows the user to ; query which version is present. The keyword works like this: ; ; RESULT = MPFIT(/query, VERSION=version) ; ; This call uses the /QUERY keyword to query the version number ; without performing any computations. Users of MPFIT can call this ; method to determine which version is in the IDL path before ; actually using MPFIT to do any numerical work. Upon return, the ; VERSION keyword contains the version number of MPFIT, expressed as ; a string of the form 'X.Y' where X and Y are integers. ; ; Users can perform their own version checking, or use the built-in ; error checking of MPFIT. The MIN_VERSION keyword enforces the ; requested minimum version number. For example, ; ; RESULT = MPFIT(/query, VERSION=version, MIN_VERSION='1.70') ; ; will check whether the accessed version is 1.70 or greater, without ; performing any numerical processing. ; ; The VERSION and MIN_VERSION keywords were added in MPFIT ; version 1.70 and later. If the caller attempts to use the VERSION ; or MIN_VERSION keywords, and an *older* version of the code is ; present in the caller's path, then IDL will throw an 'unknown ; keyword' error. Therefore, in order to be robust, the caller, must ; use exception handling. Here is an example demanding at least ; version 1.70. ; ; MPFIT_OK = 0 & VERSION = '' ; CATCH, CATCHERR ; IF CATCHERR EQ 0 THEN MPFIT_OK = MPFIT(/query, VERSION=version, $ ; MIN_VERSION='1.70') ; CATCH, /CANCEL ; ; IF NOT MPFIT_OK THEN $ ; MESSAGE, 'ERROR: you must have MPFIT version 1.70 or higher in '+$ ; 'your path (found version '+version+')' ; ; Of course, the caller can also do its own version number ; requirements checking. ; ; ; HARD-TO-COMPUTE FUNCTIONS: "EXTERNAL" EVALUATION ; ; The normal mode of operation for MPFIT is for the user to pass a ; function name, and MPFIT will call the user function multiple times ; as it iterates toward a solution. ; ; Some user functions are particularly hard to compute using the ; standard model of MPFIT. Usually these are functions that depend ; on a large amount of external data, and so it is not feasible, or ; at least highly impractical, to have MPFIT call it. In those cases ; it may be possible to use the "(EXTERNAL)" evaluation option. ; ; In this case the user is responsible for making all function *and ; derivative* evaluations. The function and Jacobian data are passed ; in through the EXTERNAL_FVEC and EXTERNAL_FJAC keywords, ; respectively. The user indicates the selection of this option by ; specifying a function name (MYFUNCT) of "(EXTERNAL)". No ; user-function calls are made when EXTERNAL evaluation is being ; used. ; ; ** SPECIAL NOTE ** For the "(EXTERNAL)" case, the quirk noted above ; does not apply. The gradient matrix, EXTERNAL_FJAC, should be ; comparable to "-FGRAD(x,p)/err", which is the *opposite* sign of ; the DP matrix described above. In other words, EXTERNAL_FJAC ; has the same sign as the derivative of EXTERNAL_FVEC, and the ; opposite sign of FGRAD. ; ; At the end of each iteration, control returns to the user, who must ; reevaluate the function at its new parameter values. Users should ; check the return value of the STATUS keyword, where a value of 9 ; indicates the user should supply more data for the next iteration, ; and re-call MPFIT. The user may refrain from calling MPFIT ; further; as usual, STATUS will indicate when the solution has ; converged and no more iterations are required. ; ; Because MPFIT must maintain its own data structures between calls, ; the user must also pass a named variable to the EXTERNAL_STATE ; keyword. This variable must be maintained by the user, but not ; changed, throughout the fitting process. When no more iterations ; are desired, the named variable may be discarded. ; ; ; INPUTS: ; MYFUNCT - a string variable containing the name of the function to ; be minimized. The function should return the weighted ; deviations between the model and the data, as described ; above. ; ; For EXTERNAL evaluation of functions, this parameter ; should be set to a value of "(EXTERNAL)". ; ; START_PARAMS - An one-dimensional array of starting values for each of the ; parameters of the model. The number of parameters ; should be fewer than the number of measurements. ; Also, the parameters should have the same data type ; as the measurements (double is preferred). ; ; This parameter is optional if the PARINFO keyword ; is used (but see PARINFO). The PARINFO keyword ; provides a mechanism to fix or constrain individual ; parameters. If both START_PARAMS and PARINFO are ; passed, then the starting *value* is taken from ; START_PARAMS, but the *constraints* are taken from ; PARINFO. ; ; RETURNS: ; ; Returns the array of best-fit parameters. ; Exceptions: ; * if /QUERY is set (see QUERY). ; ; ; KEYWORD PARAMETERS: ; ; AUTODERIVATIVE - If this is set, derivatives of the function will ; be computed automatically via a finite ; differencing procedure. If not set, then MYFUNCT ; must provide the explicit derivatives. ; Default: set (=1) ; NOTE: to supply your own explicit derivatives, ; explicitly pass AUTODERIVATIVE=0 ; ; BESTNORM - upon return, the value of the summed squared weighted ; residuals for the returned parameter values, ; i.e. TOTAL(DEVIATES^2). ; ; BEST_FJAC - upon return, BEST_FJAC contains the Jacobian, or ; partial derivative, matrix for the best-fit model. ; The values are an array, ; ARRAY(N_ELEMENTS(DEVIATES),NFREE) where NFREE is the ; number of free parameters. This array is only ; computed if /CALC_FJAC is set, otherwise BEST_FJAC is ; undefined. ; ; The returned array is such that BEST_FJAC[I,J] is the ; partial derivative of DEVIATES[I] with respect to ; parameter PARMS[PFREE_INDEX[J]]. Note that since ; deviates are (data-model)*weight, the Jacobian of the ; *deviates* will have the opposite sign from the ; Jacobian of the *model*, and may be scaled by a ; factor. ; ; BEST_RESID - upon return, an array of best-fit deviates. ; ; CALC_FJAC - if set, then calculate the Jacobian and return it in ; BEST_FJAC. If not set, then the return value of ; BEST_FJAC is undefined. ; ; COVAR - the covariance matrix for the set of parameters returned ; by MPFIT. The matrix is NxN where N is the number of ; parameters. The square root of the diagonal elements ; gives the formal 1-sigma statistical errors on the ; parameters IF errors were treated "properly" in MYFUNC. ; Parameter errors are also returned in PERROR. ; ; To compute the correlation matrix, PCOR, use this example: ; PCOR = COV * 0 ; FOR i = 0, n-1 DO FOR j = 0, n-1 DO $ ; PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j]) ; or equivalently, in vector notation, ; PCOR = COV / (PERROR # PERROR) ; ; If NOCOVAR is set or MPFIT terminated abnormally, then ; COVAR is set to a scalar with value !VALUES.D_NAN. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). It also does not account for data points which ; are assigned zero weight by the user function. ; ; ERRMSG - a string error or warning message is returned. ; ; EXTERNAL_FVEC - upon input, the function values, evaluated at ; START_PARAMS. This should be an M-vector, where M ; is the number of data points. ; ; EXTERNAL_FJAC - upon input, the Jacobian array of partial ; derivative values. This should be a M x N array, ; where M is the number of data points and N is the ; number of parameters. NOTE: that all FIXED or ; TIED parameters must *not* be included in this ; array. ; ; EXTERNAL_STATE - a named variable to store MPFIT-related state ; information between iterations (used in input and ; output to MPFIT). The user must not manipulate ; or discard this data until the final iteration is ; performed. ; ; FASTNORM - set this keyword to select a faster algorithm to ; compute sum-of-square values internally. For systems ; with large numbers of data points, the standard ; algorithm can become prohibitively slow because it ; cannot be vectorized well. By setting this keyword, ; MPFIT will run faster, but it will be more prone to ; floating point overflows and underflows. Thus, setting ; this keyword may sacrifice some stability in the ; fitting process. ; ; FTOL - a nonnegative input variable. Termination occurs when both ; the actual and predicted relative reductions in the sum of ; squares are at most FTOL (and STATUS is accordingly set to ; 1 or 3). Therefore, FTOL measures the relative error ; desired in the sum of squares. Default: 1D-10 ; ; FUNCTARGS - A structure which contains the parameters to be passed ; to the user-supplied function specified by MYFUNCT via ; the _EXTRA mechanism. This is the way you can pass ; additional data to your user-supplied function without ; using common blocks. ; ; Consider the following example: ; if FUNCTARGS = { XVAL:[1.D,2,3], YVAL:[1.D,4,9], ; ERRVAL:[1.D,1,1] } ; then the user supplied function should be declared ; like this: ; FUNCTION MYFUNCT, P, XVAL=x, YVAL=y, ERRVAL=err ; ; By default, no extra parameters are passed to the ; user-supplied function, but your function should ; accept *at least* one keyword parameter. [ This is to ; accomodate a limitation in IDL's _EXTRA ; parameter-passing mechanism. ] ; ; GTOL - a nonnegative input variable. Termination occurs when the ; cosine of the angle between fvec and any column of the ; jacobian is at most GTOL in absolute value (and STATUS is ; accordingly set to 4). Therefore, GTOL measures the ; orthogonality desired between the function vector and the ; columns of the jacobian. Default: 1D-10 ; ; ITERARGS - The keyword arguments to be passed to ITERPROC via the ; _EXTRA mechanism. This should be a structure, and is ; similar in operation to FUNCTARGS. ; Default: no arguments are passed. ; ; ITERPRINT - The name of an IDL procedure, equivalent to PRINT, ; that ITERPROC will use to render output. ITERPRINT ; should be able to accept at least four positional ; arguments. In addition, it should be able to accept ; the standard FORMAT keyword for output formatting; and ; the UNIT keyword, to redirect output to a logical file ; unit (default should be UNIT=1, standard output). ; These keywords are passed using the ITERARGS keyword ; above. The ITERPRINT procedure must accept the _EXTRA ; keyword. ; NOTE: that much formatting can be handled with the ; MPPRINT and MPFORMAT tags. ; Default: 'MPFIT_DEFPRINT' (default internal formatter) ; ; ITERPROC - The name of a procedure to be called upon each NPRINT ; iteration of the MPFIT routine. ITERPROC is always ; called in the final iteration. It should be declared ; in the following way: ; ; PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $ ; PARINFO=parinfo, QUIET=quiet, DOF=dof, PFORMAT=pformat, $ ; UNIT=unit, ... ; ; perform custom iteration update ; END ; ; ITERPROC must either accept all three keyword ; parameters (FUNCTARGS, PARINFO and QUIET), or at least ; accept them via the _EXTRA keyword. ; ; MYFUNCT is the user-supplied function to be minimized, ; P is the current set of model parameters, ITER is the ; iteration number, and FUNCTARGS are the arguments to be ; passed to MYFUNCT. FNORM should be the chi-squared ; value. QUIET is set when no textual output should be ; printed. DOF is the number of degrees of freedom, ; normally the number of points less the number of free ; parameters. See below for documentation of PARINFO. ; PFORMAT is the default parameter value format. UNIT is ; passed on to the ITERPRINT procedure, and should ; indicate the file unit where log output will be sent ; (default: standard output). ; ; In implementation, ITERPROC can perform updates to the ; terminal or graphical user interface, to provide ; feedback while the fit proceeds. If the fit is to be ; stopped for any reason, then ITERPROC should set the ; common block variable ERROR_CODE to negative value ; between -15 and -1 (see MPFIT_ERROR common block ; below). In principle, ITERPROC should probably not ; modify the parameter values, because it may interfere ; with the algorithm's stability. In practice it is ; allowed. ; ; Default: an internal routine is used to print the ; parameter values. ; ; ITERSTOP - Set this keyword if you wish to be able to stop the ; fitting by hitting the predefined ITERKEYSTOP key on ; the keyboard. This only works if you use the default ; ITERPROC. ; ; ITERKEYSTOP - A keyboard key which will halt the fit (and if ; ITERSTOP is set and the default ITERPROC is used). ; ITERSTOPKEY may either be a one-character string ; with the desired key, or a scalar integer giving the ; ASCII code of the desired key. ; Default: 7b (control-g) ; ; NOTE: the default value of ASCI 7 (control-G) cannot ; be read in some windowing environments, so you must ; change to a printable character like 'q'. ; ; MAXITER - The maximum number of iterations to perform. If the ; number of calculation iterations exceeds MAXITER, then ; the STATUS value is set to 5 and MPFIT returns. ; ; If MAXITER EQ 0, then MPFIT does not iterate to adjust ; parameter values; however, the user function is evaluated ; and parameter errors/covariance/Jacobian are estimated ; before returning. ; Default: 200 iterations ; ; MIN_VERSION - The minimum requested version number. This must be ; a scalar string of the form returned by the VERSION ; keyword. If the current version of MPFIT does not ; satisfy the minimum requested version number, then, ; MPFIT(/query, min_version='...') returns 0 ; MPFIT(...) returns NAN ; Default: no version number check ; NOTE: MIN_VERSION was added in MPFIT version 1.70 ; ; NFEV - the number of MYFUNCT function evaluations performed. ; ; NFREE - the number of free parameters in the fit. This includes ; parameters which are not FIXED and not TIED, but it does ; include parameters which are pegged at LIMITS. ; ; NITER - the number of iterations completed. ; ; NOCATCH - if set, then MPFIT will not perform any error trapping. ; By default (not set), MPFIT will trap errors and report ; them to the caller. This keyword will typically be used ; for debugging. ; ; NOCOVAR - set this keyword to prevent the calculation of the ; covariance matrix before returning (see COVAR) ; ; NPEGGED - the number of free parameters which are pegged at a ; LIMIT. ; ; NPRINT - The frequency with which ITERPROC is called. A value of ; 1 indicates that ITERPROC is called with every iteration, ; while 2 indicates every other iteration, etc. Be aware ; that several Levenberg-Marquardt attempts can be made in ; a single iteration. Also, the ITERPROC is *always* ; called for the final iteration, regardless of the ; iteration number. ; Default value: 1 ; ; PARINFO - A one-dimensional array of structures. ; Provides a mechanism for more sophisticated constraints ; to be placed on parameter values. When PARINFO is not ; passed, then it is assumed that all parameters are free ; and unconstrained. Values in PARINFO are never ; modified during a call to MPFIT. ; ; See description above for the structure of PARINFO. ; ; Default value: all parameters are free and unconstrained. ; ; PERROR - The formal 1-sigma errors in each parameter, computed ; from the covariance matrix. If a parameter is held ; fixed, or if it touches a boundary, then the error is ; reported as zero. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. ; ; *If* you can assume that the true reduced chi-squared ; value is unity -- meaning that the fit is implicitly ; assumed to be of good quality -- then the estimated ; parameter uncertainties can be computed by scaling PERROR ; by the measured chi-squared value. ; ; DOF = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom ; PCERROR = PERROR * SQRT(BESTNORM / DOF) ; scaled uncertainties ; ; PFREE_INDEX - upon return, PFREE_INDEX contains an index array ; which indicates which parameter were allowed to ; vary. I.e. of all the parameters PARMS, only ; PARMS[PFREE_INDEX] were varied. ; ; QUERY - if set, then MPFIT() will return immediately with one of ; the following values: ; 1 - if MIN_VERSION is not set ; 1 - if MIN_VERSION is set and MPFIT satisfies the minimum ; 0 - if MIN_VERSION is set and MPFIT does not satisfy it ; The VERSION output keyword is always set upon return. ; Default: not set. ; ; QUIET - set this keyword when no textual output should be printed ; by MPFIT ; ; RESDAMP - a scalar number, indicating the cut-off value of ; residuals where "damping" will occur. Residuals with ; magnitudes greater than this number will be replaced by ; their logarithm. This partially mitigates the so-called ; large residual problem inherent in least-squares solvers ; (as for the test problem CURVI, http://www.maxthis.com/- ; curviex.htm). A value of 0 indicates no damping. ; Default: 0 ; ; Note: RESDAMP doesn't work with AUTODERIV=0 ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). It can have one of the ; following values: ; ; -18 a fatal execution error has occurred. More information ; may be available in the ERRMSG string. ; ; -16 a parameter or function value has become infinite or an ; undefined number. This is usually a consequence of ; numerical overflow in the user's model function, which ; must be avoided. ; ; -15 to -1 ; these are error codes that either MYFUNCT or ITERPROC ; may return to terminate the fitting process (see ; description of MPFIT_ERROR common below). If either ; MYFUNCT or ITERPROC set ERROR_CODE to a negative number, ; then that number is returned in STATUS. Values from -15 ; to -1 are reserved for the user functions and will not ; clash with MPFIT. ; ; 0 improper input parameters. ; ; 1 both actual and predicted relative reductions ; in the sum of squares are at most FTOL. ; ; 2 relative error between two consecutive iterates ; is at most XTOL ; ; 3 conditions for STATUS = 1 and STATUS = 2 both hold. ; ; 4 the cosine of the angle between fvec and any ; column of the jacobian is at most GTOL in ; absolute value. ; ; 5 the maximum number of iterations has been reached ; ; 6 FTOL is too small. no further reduction in ; the sum of squares is possible. ; ; 7 XTOL is too small. no further improvement in ; the approximate solution x is possible. ; ; 8 GTOL is too small. fvec is orthogonal to the ; columns of the jacobian to machine precision. ; ; 9 A successful single iteration has been completed, and ; the user must supply another "EXTERNAL" evaluation of ; the function and its derivatives. This status indicator ; is neither an error nor a convergence indicator. ; ; VERSION - upon return, VERSION will be set to the MPFIT internal ; version number. The version number will be a string of ; the form "X.Y" where X is a major revision number and Y ; is a minor revision number. ; NOTE: the VERSION keyword was not present before ; MPFIT version number 1.70, therefore, callers must ; use exception handling when using this keyword. ; ; XTOL - a nonnegative input variable. Termination occurs when the ; relative error between two consecutive iterates is at most ; XTOL (and STATUS is accordingly set to 2 or 3). Therefore, ; XTOL measures the relative error desired in the approximate ; solution. Default: 1D-10 ; ; ; EXAMPLE: ; ; p0 = [5.7D, 2.2, 500., 1.5, 2000.] ; fa = {X:x, Y:y, ERR:err} ; p = mpfit('MYFUNCT', p0, functargs=fa) ; ; Minimizes sum of squares of MYFUNCT. MYFUNCT is called with the X, ; Y, and ERR keyword parameters that are given by FUNCTARGS. The ; resulting parameter values are returned in p. ; ; ; COMMON BLOCKS: ; ; COMMON MPFIT_ERROR, ERROR_CODE ; ; User routines may stop the fitting process at any time by ; setting an error condition. This condition may be set in either ; the user's model computation routine (MYFUNCT), or in the ; iteration procedure (ITERPROC). ; ; To stop the fitting, the above common block must be declared, ; and ERROR_CODE must be set to a negative number. After the user ; procedure or function returns, MPFIT checks the value of this ; common block variable and exits immediately if the error ; condition has been set. This value is also returned in the ; STATUS keyword: values of -1 through -15 are reserved error ; codes for the user routines. By default the value of ERROR_CODE ; is zero, indicating a successful function/procedure call. ; ; COMMON MPFIT_PROFILE ; COMMON MPFIT_MACHAR ; COMMON MPFIT_CONFIG ; ; These are undocumented common blocks are used internally by ; MPFIT and may change in future implementations. ; ; THEORY OF OPERATION: ; ; There are many specific strategies for function minimization. One ; very popular technique is to use function gradient information to ; realize the local structure of the function. Near a local minimum ; the function value can be taylor expanded about x0 as follows: ; ; f(x) = f(x0) + f'(x0) . (x-x0) + (1/2) (x-x0) . f''(x0) . (x-x0) ; ----- --------------- ------------------------------- (1) ; Order 0th 1st 2nd ; ; Here f'(x) is the gradient vector of f at x, and f''(x) is the ; Hessian matrix of second derivatives of f at x. The vector x is ; the set of function parameters, not the measured data vector. One ; can find the minimum of f, f(xm) using Newton's method, and ; arrives at the following linear equation: ; ; f''(x0) . (xm-x0) = - f'(x0) (2) ; ; If an inverse can be found for f''(x0) then one can solve for ; (xm-x0), the step vector from the current position x0 to the new ; projected minimum. Here the problem has been linearized (ie, the ; gradient information is known to first order). f''(x0) is ; symmetric n x n matrix, and should be positive definite. ; ; The Levenberg - Marquardt technique is a variation on this theme. ; It adds an additional diagonal term to the equation which may aid the ; convergence properties: ; ; (f''(x0) + nu I) . (xm-x0) = -f'(x0) (2a) ; ; where I is the identity matrix. When nu is large, the overall ; matrix is diagonally dominant, and the iterations follow steepest ; descent. When nu is small, the iterations are quadratically ; convergent. ; ; In principle, if f''(x0) and f'(x0) are known then xm-x0 can be ; determined. However the Hessian matrix is often difficult or ; impossible to compute. The gradient f'(x0) may be easier to ; compute, if even by finite difference techniques. So-called ; quasi-Newton techniques attempt to successively estimate f''(x0) ; by building up gradient information as the iterations proceed. ; ; In the least squares problem there are further simplifications ; which assist in solving eqn (2). The function to be minimized is ; a sum of squares: ; ; f = Sum(hi^2) (3) ; ; where hi is the ith residual out of m residuals as described ; above. This can be substituted back into eqn (2) after computing ; the derivatives: ; ; f' = 2 Sum(hi hi') ; f'' = 2 Sum(hi' hj') + 2 Sum(hi hi'') (4) ; ; If one assumes that the parameters are already close enough to a ; minimum, then one typically finds that the second term in f'' is ; negligible [or, in any case, is too difficult to compute]. Thus, ; equation (2) can be solved, at least approximately, using only ; gradient information. ; ; In matrix notation, the combination of eqns (2) and (4) becomes: ; ; hT' . h' . dx = - hT' . h (5) ; ; Where h is the residual vector (length m), hT is its transpose, h' ; is the Jacobian matrix (dimensions n x m), and dx is (xm-x0). The ; user function supplies the residual vector h, and in some cases h' ; when it is not found by finite differences (see MPFIT_FDJAC2, ; which finds h and hT'). Even if dx is not the best absolute step ; to take, it does provide a good estimate of the best *direction*, ; so often a line minimization will occur along the dx vector ; direction. ; ; The method of solution employed by MINPACK is to form the Q . R ; factorization of h', where Q is an orthogonal matrix such that QT . ; Q = I, and R is upper right triangular. Using h' = Q . R and the ; ortogonality of Q, eqn (5) becomes ; ; (RT . QT) . (Q . R) . dx = - (RT . QT) . h ; RT . R . dx = - RT . QT . h (6) ; R . dx = - QT . h ; ; where the last statement follows because R is upper triangular. ; Here, R, QT and h are known so this is a matter of solving for dx. ; The routine MPFIT_QRFAC provides the QR factorization of h, with ; pivoting, and MPFIT_QRSOL;V provides the solution for dx. ; ; REFERENCES: ; ; Markwardt, C. B. 2008, "Non-Linear Least Squares Fitting in IDL ; with MPFIT," in proc. Astronomical Data Analysis Software and ; Systems XVIII, Quebec, Canada, ASP Conference Series, Vol. XXX, eds. ; D. Bohlender, P. Dowler & D. Durand (Astronomical Society of the ; Pacific: San Francisco), p. 251-254 (ISBN: 978-1-58381-702-5) ; http://arxiv.org/abs/0902.2850 ; Link to NASA ADS: http://adsabs.harvard.edu/abs/2009ASPC..411..251M ; Link to ASP: http://aspbooks.org/a/volumes/table_of_contents/411 ; ; Refer to the MPFIT website as: ; http://purl.com/net/mpfit ; ; MINPACK-1 software, by Jorge More' et al, available from netlib. ; http://www.netlib.org/ ; ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; (ISBN: 978-0-898713-22-0) ; ; More', J. 1978, "The Levenberg-Marquardt Algorithm: Implementation ; and Theory," in Numerical Analysis, vol. 630, ed. G. A. Watson ; (Springer-Verlag: Berlin), p. 105 (DOI: 10.1007/BFb0067690 ) ; ; MODIFICATION HISTORY: ; Translated from MINPACK-1 in FORTRAN, Apr-Jul 1998, CM ; Fixed bug in parameter limits (x vs xnew), 04 Aug 1998, CM ; Added PERROR keyword, 04 Aug 1998, CM ; Added COVAR keyword, 20 Aug 1998, CM ; Added NITER output keyword, 05 Oct 1998 ; D.L Windt, Bell Labs, windt@bell-labs.com; ; Made each PARINFO component optional, 05 Oct 1998 CM ; Analytical derivatives allowed via AUTODERIVATIVE keyword, 09 Nov 1998 ; Parameter values can be tied to others, 09 Nov 1998 ; Fixed small bugs (Wayne Landsman), 24 Nov 1998 ; Added better exception error reporting, 24 Nov 1998 CM ; Cosmetic documentation changes, 02 Jan 1999 CM ; Changed definition of ITERPROC to be consistent with TNMIN, 19 Jan 1999 CM ; Fixed bug when AUTDERIVATIVE=0. Incorrect sign, 02 Feb 1999 CM ; Added keyboard stop to MPFIT_DEFITER, 28 Feb 1999 CM ; Cosmetic documentation changes, 14 May 1999 CM ; IDL optimizations for speed & FASTNORM keyword, 15 May 1999 CM ; Tried a faster version of mpfit_enorm, 30 May 1999 CM ; Changed web address to cow.physics.wisc.edu, 14 Jun 1999 CM ; Found malformation of FDJAC in MPFIT for 1 parm, 03 Aug 1999 CM ; Factored out user-function call into MPFIT_CALL. It is possible, ; but currently disabled, to call procedures. The calling format ; is similar to CURVEFIT, 25 Sep 1999, CM ; Slightly changed mpfit_tie to be less intrusive, 25 Sep 1999, CM ; Fixed some bugs associated with tied parameters in mpfit_fdjac, 25 ; Sep 1999, CM ; Reordered documentation; now alphabetical, 02 Oct 1999, CM ; Added QUERY keyword for more robust error detection in drivers, 29 ; Oct 1999, CM ; Documented PERROR for unweighted fits, 03 Nov 1999, CM ; Split out MPFIT_RESETPROF to aid in profiling, 03 Nov 1999, CM ; Some profiling and speed optimization, 03 Nov 1999, CM ; Worst offenders, in order: fdjac2, qrfac, qrsolv, enorm. ; fdjac2 depends on user function, qrfac and enorm seem to be ; fully optimized. qrsolv probably could be tweaked a little, but ; is still <10% of total compute time. ; Made sure that !err was set to 0 in MPFIT_DEFITER, 10 Jan 2000, CM ; Fixed small inconsistency in setting of QANYLIM, 28 Jan 2000, CM ; Added PARINFO field RELSTEP, 28 Jan 2000, CM ; Converted to MPFIT_ERROR common block for indicating error ; conditions, 28 Jan 2000, CM ; Corrected scope of MPFIT_ERROR common block, CM, 07 Mar 2000 ; Minor speed improvement in MPFIT_ENORM, CM 26 Mar 2000 ; Corrected case where ITERPROC changed parameter values and ; parameter values were TIED, CM 26 Mar 2000 ; Changed MPFIT_CALL to modify NFEV automatically, and to support ; user procedures more, CM 26 Mar 2000 ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Catch zero value of zero a(j,lj) in MPFIT_QRFAC, 20 Jul 2000, CM ; (thanks to David Schlegel ) ; MPFIT_SETMACHAR is called only once at init; only one common block ; is created (MPFIT_MACHAR); it is now a structure; removed almost ; all CHECK_MATH calls for compatibility with IDL5 and !EXCEPT; ; profiling data is now in a structure too; noted some ; mathematical discrepancies in Linux IDL5.0, 17 Nov 2000, CM ; Some significant changes. New PARINFO fields: MPSIDE, MPMINSTEP, ; MPMAXSTEP. Improved documentation. Now PTIED constraints are ; maintained in the MPCONFIG common block. A new procedure to ; parse PARINFO fields. FDJAC2 now computes a larger variety of ; one-sided and two-sided finite difference derivatives. NFEV is ; stored in the MPCONFIG common now. 17 Dec 2000, CM ; Added check that PARINFO and XALL have same size, 29 Dec 2000 CM ; Don't call function in TERMINATE when there is an error, 05 Jan ; 2000 ; Check for float vs. double discrepancies; corrected implementation ; of MIN/MAXSTEP, which I still am not sure of, but now at least ; the correct behavior occurs *without* it, CM 08 Jan 2001 ; Added SCALE_FCN keyword, to allow for scaling, as for the CASH ; statistic; added documentation about the theory of operation, ; and under the QR factorization; slowly I'm beginning to ; understand the bowels of this algorithm, CM 10 Jan 2001 ; Remove MPMINSTEP field of PARINFO, for now at least, CM 11 Jan ; 2001 ; Added RESDAMP keyword, CM, 14 Jan 2001 ; Tried to improve the DAMP handling a little, CM, 13 Mar 2001 ; Corrected .PARNAME behavior in _DEFITER, CM, 19 Mar 2001 ; Added checks for parameter and function overflow; a new STATUS ; value to reflect this; STATUS values of -15 to -1 are reserved ; for user function errors, CM, 03 Apr 2001 ; DAMP keyword is now a TANH, CM, 03 Apr 2001 ; Added more error checking of float vs. double, CM, 07 Apr 2001 ; Fixed bug in handling of parameter lower limits; moved overflow ; checking to end of loop, CM, 20 Apr 2001 ; Failure using GOTO, TERMINATE more graceful if FNORM1 not defined, ; CM, 13 Aug 2001 ; Add MPPRINT tag to PARINFO, CM, 19 Nov 2001 ; Add DOF keyword to DEFITER procedure, and print degrees of ; freedom, CM, 28 Nov 2001 ; Add check to be sure MYFUNCT is a scalar string, CM, 14 Jan 2002 ; Addition of EXTERNAL_FJAC, EXTERNAL_FVEC keywords; ability to save ; fitter's state from one call to the next; allow '(EXTERNAL)' ; function name, which implies that user will supply function and ; Jacobian at each iteration, CM, 10 Mar 2002 ; Documented EXTERNAL evaluation code, CM, 10 Mar 2002 ; Corrected signficant bug in the way that the STEP parameter, and ; FIXED parameters interacted (Thanks Andrew Steffl), CM, 02 Apr ; 2002 ; Allow COVAR and PERROR keywords to be computed, even in case of ; '(EXTERNAL)' function, 26 May 2002 ; Add NFREE and NPEGGED keywords; compute NPEGGED; compute DOF using ; NFREE instead of n_elements(X), thanks to Kristian Kjaer, CM 11 ; Sep 2002 ; Hopefully PERROR is all positive now, CM 13 Sep 2002 ; Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002 ; Error checking to detect missing start pars, CM 12 Apr 2003 ; Add DOF keyword to return degrees of freedom, CM, 30 June 2003 ; Always call ITERPROC in the final iteration; add ITERKEYSTOP ; keyword, CM, 30 June 2003 ; Correct bug in MPFIT_LMPAR of singularity handling, which might ; likely be fatal for one-parameter fits, CM, 21 Nov 2003 ; (with thanks to Peter Tuthill for the proper test case) ; Minor documentation adjustment, 03 Feb 2004, CM ; Correct small error in QR factorization when pivoting; document ; the return values of QRFAC when pivoting, 21 May 2004, CM ; Add MPFORMAT field to PARINFO, and correct behavior of interaction ; between MPPRINT and PARNAME in MPFIT_DEFITERPROC (thanks to Tim ; Robishaw), 23 May 2004, CM ; Add the ITERPRINT keyword to allow redirecting output, 26 Sep ; 2004, CM ; Correct MAXSTEP behavior in case of a negative parameter, 26 Sep ; 2004, CM ; Fix bug in the parsing of MINSTEP/MAXSTEP, 10 Apr 2005, CM ; Fix bug in the handling of upper/lower limits when the limit was ; negative (the fitting code would never "stick" to the lower ; limit), 29 Jun 2005, CM ; Small documentation update for the TIED field, 05 Sep 2005, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; If MAXITER equals zero, then do the basic parameter checking and ; uncertainty analysis, but do not adjust the parameters, 15 Aug ; 2006, CM ; Added documentation, 18 Sep 2006, CM ; A few more IDL 5 array syntax changes, 25 Sep 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Bug fix for case of MPMAXSTEP and fixed parameters, thanks ; to Huib Intema (who found it from the Python translation!), 05 Feb 2007 ; Similar fix for MPFIT_FDJAC2 and the MPSIDE sidedness of ; derivatives, also thanks to Huib Intema, 07 Feb 2007 ; Clarify documentation on user-function, derivatives, and PARINFO, ; 27 May 2007 ; Change the wording of "Analytic Derivatives" to "Explicit ; Derivatives" in the documentation, CM, 03 Sep 2007 ; Further documentation tweaks, CM, 13 Dec 2007 ; Add COMPATIBILITY section and add credits to copyright, CM, 13 Dec ; 2007 ; Document and enforce that START_PARMS and PARINFO are 1-d arrays, ; CM, 29 Mar 2008 ; Previous change for 1-D arrays wasn't correct for ; PARINFO.LIMITED/.LIMITS; now fixed, CM, 03 May 2008 ; Documentation adjustments, CM, 20 Aug 2008 ; Change some minor FOR-loop variables to type-long, CM, 03 Sep 2008 ; Change error handling slightly, document NOCATCH keyword, ; document error handling in general, CM, 01 Oct 2008 ; Special case: when either LIMITS is zero, and a parameter pushes ; against that limit, the coded that 'pegged' it there would not ; work since it was a relative condition; now zero is handled ; properly, CM, 08 Nov 2008 ; Documentation of how TIED interacts with LIMITS, CM, 21 Dec 2008 ; Better documentation of references, CM, 27 Feb 2009 ; If MAXITER=0, then be sure to set STATUS=5, which permits the ; the covariance matrix to be computed, CM, 14 Apr 2009 ; Avoid numerical underflow while solving for the LM parameter, ; (thanks to Sergey Koposov) CM, 14 Apr 2009 ; Use individual functions for all possible MPFIT_CALL permutations, ; (and make sure the syntax is right) CM, 01 Sep 2009 ; Correct behavior of MPMAXSTEP when some parameters are frozen, ; thanks to Josh Destree, CM, 22 Nov 2009 ; Update the references section, CM, 22 Nov 2009 ; 1.70 - Add the VERSION and MIN_VERSION keywords, CM, 22 Nov 2009 ; 1.71 - Store pre-calculated revision in common, CM, 23 Nov 2009 ; 1.72-1.74 - Documented alternate method to compute correlation matrix, ; CM, 05 Feb 2010 ; 1.75 - Enforce TIED constraints when preparing to terminate the ; routine, CM, 2010-06-22 ; 1.76 - Documented input keywords now are not modified upon output, ; CM, 2010-07-13 ; 1.77 - Upon user request (/CALC_FJAC), compute Jacobian matrix and ; return in BEST_FJAC; also return best residuals in ; BEST_RESID; also return an index list of free parameters as ; PFREE_INDEX; add a fencepost to prevent recursion ; CM, 2010-10-27 ; 1.79 - Documentation corrections. CM, 2011-08-26 ; 1.81 - Fix bug in interaction of AUTODERIVATIVE=0 and .MPSIDE=3; ; Document FJAC_MASK. CM, 2012-05-08 ; 1.83 - Trap more overflow conditions (ref. Nirmal Iyer), CM 2013-12-23 ; 1.84 - More robust handling of FNORM, CM 2016-05-19 ; ; $Id: mpfit.pro,v 1.84 2016/05/19 16:07:44 cmarkwar Exp $ ;- ; Original MINPACK by More' Garbow and Hillstrom, translated with permission ; Modifications and enhancements are: ; Copyright (C) 1997-2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- pro mpfit_dummy ;; Enclose in a procedure so these are not defined in the main level COMPILE_OPT strictarr FORWARD_FUNCTION mpfit_fdjac2, mpfit_enorm, mpfit_lmpar, mpfit_covar, $ mpfit, mpfit_call COMMON mpfit_error, error_code ;; For error passing to user function COMMON mpfit_config, mpconfig ;; For internal error configrations end ;; Reset profiling registers for another run. By default, and when ;; uncommented, the profiling registers simply accumulate. pro mpfit_resetprof COMPILE_OPT strictarr common mpfit_profile, mpfit_profile_vals mpfit_profile_vals = { status: 1L, fdjac2: 0D, lmpar: 0D, mpfit: 0D, $ qrfac: 0D, qrsolv: 0D, enorm: 0D} return end ;; Following are machine constants that can be loaded once. I have ;; found that bizarre underflow messages can be produced in each call ;; to MACHAR(), so this structure minimizes the number of calls to ;; one. pro mpfit_setmachar, double=isdouble COMPILE_OPT strictarr common mpfit_profile, profvals if n_elements(profvals) EQ 0 then mpfit_resetprof common mpfit_machar, mpfit_machar_vals ;; In earlier versions of IDL, MACHAR itself could produce a load of ;; error messages. We try to mask some of that out here. if (!version.release) LT 5 then dummy = check_math(1, 1) mch = 0. mch = machar(double=keyword_set(isdouble)) dmachep = mch.eps dmaxnum = mch.xmax dminnum = mch.xmin dmaxlog = alog(mch.xmax) dminlog = alog(mch.xmin) if keyword_set(isdouble) then $ dmaxgam = 171.624376956302725D $ else $ dmaxgam = 171.624376956302725 drdwarf = sqrt(dminnum*1.5) * 10 drgiant = sqrt(dmaxnum) * 0.1 mpfit_machar_vals = {machep: dmachep, maxnum: dmaxnum, minnum: dminnum, $ maxlog: dmaxlog, minlog: dminlog, maxgam: dmaxgam, $ rdwarf: drdwarf, rgiant: drgiant} if (!version.release) LT 5 then dummy = check_math(0, 0) return end ; Call user function with no _EXTRA parameters function mpfit_call_func_noextra, fcn, x, fjac, _EXTRA=extra if n_params() EQ 2 then begin return, call_function(fcn, x) endif else begin return, call_function(fcn, x, fjac) endelse end ; Call user function with _EXTRA parameters function mpfit_call_func_extra, fcn, x, fjac, _EXTRA=extra if n_params() EQ 2 then begin return, call_function(fcn, x, _EXTRA=extra) endif else begin return, call_function(fcn, x, fjac, _EXTRA=extra) endelse end ; Call user procedure with no _EXTRA parameters function mpfit_call_pro_noextra, fcn, x, fjac, _EXTRA=extra if n_params() EQ 2 then begin call_procedure, fcn, x, f endif else begin call_procedure, fcn, x, f, fjac endelse return, f end ; Call user procedure with _EXTRA parameters function mpfit_call_pro_extra, fcn, x, fjac, _EXTRA=extra if n_params() EQ 2 then begin call_procedure, fcn, x, f, _EXTRA=extra endif else begin call_procedure, fcn, x, f, fjac, _EXTRA=extra endelse return, f end ;; Call user function or procedure, with _EXTRA or not, with ;; derivatives or not. function mpfit_call, fcn, x, fjac, _EXTRA=extra COMPILE_OPT strictarr common mpfit_config, mpconfig if keyword_set(mpconfig.qanytied) then mpfit_tie, x, mpconfig.ptied ;; Decide whether we are calling a procedure or function, and ;; with/without FUNCTARGS proname = 'MPFIT_CALL' proname = proname + ((mpconfig.proc) ? '_PRO' : '_FUNC') proname = proname + ((n_elements(extra) GT 0) ? '_EXTRA' : '_NOEXTRA') if n_params() EQ 2 then begin f = call_function(proname, fcn, x, _EXTRA=extra) endif else begin f = call_function(proname, fcn, x, fjac, _EXTRA=extra) endelse mpconfig.nfev = mpconfig.nfev + 1 if n_params() EQ 2 AND mpconfig.damp GT 0 then begin damp = mpconfig.damp[0] ;; Apply the damping if requested. This replaces the residuals ;; with their hyperbolic tangent. Thus residuals larger than ;; DAMP are essentially clipped. f = tanh(f/damp) endif return, f end function mpfit_fdjac2, fcn, x, fvec, step, ulimited, ulimit, dside, $ iflag=iflag, epsfcn=epsfcn, autoderiv=autoderiv, $ FUNCTARGS=fcnargs, xall=xall, ifree=ifree, dstep=dstep, $ deriv_debug=ddebug, deriv_reltol=ddrtol, deriv_abstol=ddatol COMPILE_OPT strictarr common mpfit_machar, machvals common mpfit_profile, profvals common mpfit_error, mperr ; prof_start = systime(1) MACHEP0 = machvals.machep DWARF = machvals.minnum if n_elements(epsfcn) EQ 0 then epsfcn = MACHEP0 if n_elements(xall) EQ 0 then xall = x if n_elements(ifree) EQ 0 then ifree = lindgen(n_elements(xall)) if n_elements(step) EQ 0 then step = x * 0. if n_elements(ddebug) EQ 0 then ddebug = intarr(n_elements(xall)) if n_elements(ddrtol) EQ 0 then ddrtol = x * 0. if n_elements(ddatol) EQ 0 then ddatol = x * 0. has_debug_deriv = max(ddebug) if keyword_set(has_debug_deriv) then begin ;; Header for debugging print, 'FJAC DEBUG BEGIN' print, "IPNT", "FUNC", "DERIV_U", "DERIV_N", "DIFF_ABS", "DIFF_REL", $ format='("# ",A10," ",A10," ",A10," ",A10," ",A10," ",A10)' endif nall = n_elements(xall) eps = sqrt(max([epsfcn, MACHEP0])); m = n_elements(fvec) n = n_elements(x) ;; Compute analytical derivative if requested ;; Two ways to enable computation of explicit derivatives: ;; 1. AUTODERIVATIVE=0 ;; 2. AUTODERIVATIVE=1, but P[i].MPSIDE EQ 3 if keyword_set(autoderiv) EQ 0 OR max(dside[ifree] EQ 3) EQ 1 then begin fjac_mask = intarr(nall) ;; Specify which parameters need derivatives ;; ---- Case 2 ------ ----- Case 1 ----- fjac_mask[ifree] = (dside[ifree] EQ 3) OR (keyword_set(autoderiv) EQ 0) if has_debug_deriv then $ print, fjac_mask, format='("# FJAC_MASK = ",100000(I0," ",:))' fjac = fjac_mask ;; Pass the mask to the calling function as FJAC mperr = 0 fp = mpfit_call(fcn, xall, fjac, _EXTRA=fcnargs) iflag = mperr if n_elements(fjac) NE m*nall then begin message, /cont, 'ERROR: Derivative matrix was not computed properly.' iflag = 1 ; profvals.fdjac2 = profvals.fdjac2 + (systime(1) - prof_start) return, 0 endif ;; This definition is consistent with CURVEFIT (WRONG, see below) ;; Sign error found (thanks Jesus Fernandez ) ;; ... and now I regret doing this sign flip since it's not ;; strictly correct. The definition should be RESID = ;; (Y-F)/SIGMA, so d(RESID)/dP should be -dF/dP. My response to ;; Fernandez was unfounded because he was trying to supply ;; dF/dP. Sigh. (CM 31 Aug 2007) fjac = reform(-temporary(fjac), m, nall, /overwrite) ;; Select only the free parameters if n_elements(ifree) LT nall then $ fjac = reform(fjac[*,ifree], m, n, /overwrite) ;; Are we done computing derivatives? The answer is, YES, if we ;; computed explicit derivatives for all free parameters, EXCEPT ;; when we are going on to compute debugging derivatives. if min(fjac_mask[ifree]) EQ 1 AND NOT has_debug_deriv then begin return, fjac endif endif ;; Final output array, if it was not already created above if n_elements(fjac) EQ 0 then begin fjac = make_array(m, n, value=fvec[0]*0.) fjac = reform(fjac, m, n, /overwrite) endif h = eps * abs(x) ;; if STEP is given, use that ;; STEP includes the fixed parameters if n_elements(step) GT 0 then begin stepi = step[ifree] wh = where(stepi GT 0, ct) if ct GT 0 then h[wh] = stepi[wh] endif ;; if relative step is given, use that ;; DSTEP includes the fixed parameters if n_elements(dstep) GT 0 then begin dstepi = dstep[ifree] wh = where(dstepi GT 0, ct) if ct GT 0 then h[wh] = abs(dstepi[wh]*x[wh]) endif ;; In case any of the step values are zero wh = where(h EQ 0, ct) if ct GT 0 then h[wh] = eps ;; Reverse the sign of the step if we are up against the parameter ;; limit, or if the user requested it. ;; DSIDE includes the fixed parameters (ULIMITED/ULIMIT have only ;; varying ones) mask = dside[ifree] EQ -1 if n_elements(ulimited) GT 0 AND n_elements(ulimit) GT 0 then $ mask = mask OR (ulimited AND (x GT ulimit-h)) wh = where(mask, ct) if ct GT 0 then h[wh] = -h[wh] ;; Loop through parameters, computing the derivative for each for j=0L, n-1 do begin dsidej = dside[ifree[j]] ddebugj = ddebug[ifree[j]] ;; Skip this parameter if we already computed its derivative ;; explicitly, and we are not debugging. if (dsidej EQ 3) AND (ddebugj EQ 0) then continue if (dsidej EQ 3) AND (ddebugj EQ 1) then $ print, ifree[j], format='("FJAC PARM ",I0)' xp = xall xp[ifree[j]] = xp[ifree[j]] + h[j] mperr = 0 fp = mpfit_call(fcn, xp, _EXTRA=fcnargs) iflag = mperr if iflag LT 0 then return, !values.d_nan if ((dsidej GE -1) AND (dsidej LE 1)) OR (dsidej EQ 3) then begin ;; COMPUTE THE ONE-SIDED DERIVATIVE ;; Note optimization fjac(0:*,j) fjacj = (fp-fvec)/h[j] endif else begin ;; COMPUTE THE TWO-SIDED DERIVATIVE xp[ifree[j]] = xall[ifree[j]] - h[j] mperr = 0 fm = mpfit_call(fcn, xp, _EXTRA=fcnargs) iflag = mperr if iflag LT 0 then return, !values.d_nan ;; Note optimization fjac(0:*,j) fjacj = (fp-fm)/(2*h[j]) endelse ;; Debugging of explicit derivatives if (dsidej EQ 3) AND (ddebugj EQ 1) then begin ;; Relative and absolute tolerances dr = ddrtol[ifree[j]] & da = ddatol[ifree[j]] ;; Explicitly calculated fjaco = fjac[*,j] ;; If tolerances are zero, then any value for deriv triggers print... if (da EQ 0 AND dr EQ 0) then $ diffj = (fjaco NE 0 OR fjacj NE 0) ;; ... otherwise the difference must be a greater than tolerance if (da NE 0 OR dr NE 0) then $ diffj = (abs(fjaco-fjacj) GT (da+abs(fjaco)*dr)) for k = 0L, m-1 do if diffj[k] then begin print, k, fvec[k], fjaco[k], fjacj[k], fjaco[k]-fjacj[k], $ (fjaco[k] EQ 0)?(0):((fjaco[k]-fjacj[k])/fjaco[k]), $ format='(" ",I10," ",G10.4," ",G10.4," ",G10.4," ",G10.4," ",G10.4)' endif endif ;; Store final results in output array fjac[0,j] = fjacj endfor if has_debug_deriv then print, 'FJAC DEBUG END' ; profvals.fdjac2 = profvals.fdjac2 + (systime(1) - prof_start) return, fjac end function mpfit_enorm, vec COMPILE_OPT strictarr ;; NOTE: it turns out that, for systems that have a lot of data ;; points, this routine is a big computing bottleneck. The extended ;; computations that need to be done cannot be effectively ;; vectorized. The introduction of the FASTNORM configuration ;; parameter allows the user to select a faster routine, which is ;; based on TOTAL() alone. common mpfit_profile, profvals ; prof_start = systime(1) common mpfit_config, mpconfig ; Very simple-minded sum-of-squares if n_elements(mpconfig) GT 0 then if mpconfig.fastnorm then begin ans = sqrt(total(vec^2)) goto, TERMINATE endif common mpfit_machar, machvals agiant = machvals.rgiant / n_elements(vec) adwarf = machvals.rdwarf * n_elements(vec) ;; This is hopefully a compromise between speed and robustness. ;; Need to do this because of the possibility of over- or underflow. mx = max(vec, min=mn) mx = max(abs([mx,mn])) if mx EQ 0 then return, vec[0]*0. if mx GT agiant OR mx LT adwarf then ans = mx * sqrt(total((vec/mx)^2))$ else ans = sqrt( total(vec^2) ) TERMINATE: ; profvals.enorm = profvals.enorm + (systime(1) - prof_start) return, ans end ; ********** ; ; subroutine qrfac ; ; this subroutine uses householder transformations with column ; pivoting (optional) to compute a qr factorization of the ; m by n matrix a. that is, qrfac determines an orthogonal ; matrix q, a permutation matrix p, and an upper trapezoidal ; matrix r with diagonal elements of nonincreasing magnitude, ; such that a*p = q*r. the householder transformation for ; column k, k = 1,2,...,min(m,n), is of the form ; ; t ; i - (1/u(k))*u*u ; ; where u has zeros in the first k-1 positions. the form of ; this transformation and the method of pivoting first ; appeared in the corresponding linpack subroutine. ; ; the subroutine statement is ; ; subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) ; ; where ; ; m is a positive integer input variable set to the number ; of rows of a. ; ; n is a positive integer input variable set to the number ; of columns of a. ; ; a is an m by n array. on input a contains the matrix for ; which the qr factorization is to be computed. on output ; the strict upper trapezoidal part of a contains the strict ; upper trapezoidal part of r, and the lower trapezoidal ; part of a contains a factored form of q (the non-trivial ; elements of the u vectors described above). ; ; lda is a positive integer input variable not less than m ; which specifies the leading dimension of the array a. ; ; pivot is a logical input variable. if pivot is set true, ; then column pivoting is enforced. if pivot is set false, ; then no column pivoting is done. ; ; ipvt is an integer output array of length lipvt. ipvt ; defines the permutation matrix p such that a*p = q*r. ; column j of p is column ipvt(j) of the identity matrix. ; if pivot is false, ipvt is not referenced. ; ; lipvt is a positive integer input variable. if pivot is false, ; then lipvt may be as small as 1. if pivot is true, then ; lipvt must be at least n. ; ; rdiag is an output array of length n which contains the ; diagonal elements of r. ; ; acnorm is an output array of length n which contains the ; norms of the corresponding columns of the input matrix a. ; if this information is not needed, then acnorm can coincide ; with rdiag. ; ; wa is a work array of length n. if pivot is false, then wa ; can coincide with rdiag. ; ; subprograms called ; ; minpack-supplied ... dpmpar,enorm ; ; fortran-supplied ... dmax1,dsqrt,min0 ; ; argonne national laboratory. minpack project. march 1980. ; burton s. garbow, kenneth e. hillstrom, jorge j. more ; ; ********** ; ; PIVOTING / PERMUTING: ; ; Upon return, A(*,*) is in standard parameter order, A(*,IPVT) is in ; permuted order. ; ; RDIAG is in permuted order. ; ; ACNORM is in standard parameter order. ; ; NOTE: in IDL the factors appear slightly differently than described ; above. The matrix A is still m x n where m >= n. ; ; The "upper" triangular matrix R is actually stored in the strict ; lower left triangle of A under the standard notation of IDL. ; ; The reflectors that generate Q are in the upper trapezoid of A upon ; output. ; ; EXAMPLE: decompose the matrix [[9.,2.,6.],[4.,8.,7.]] ; aa = [[9.,2.,6.],[4.,8.,7.]] ; mpfit_qrfac, aa, aapvt, rdiag, aanorm ; IDL> print, aa ; 1.81818* 0.181818* 0.545455* ; -8.54545+ 1.90160* 0.432573* ; IDL> print, rdiag ; -11.0000+ -7.48166+ ; ; The components marked with a * are the components of the ; reflectors, and those marked with a + are components of R. ; ; To reconstruct Q and R we proceed as follows. First R. ; r = fltarr(m, n) ; for i = 0, n-1 do r(0:i,i) = aa(0:i,i) ; fill in lower diag ; r(lindgen(n)*(m+1)) = rdiag ; ; Next, Q, which are composed from the reflectors. Each reflector v ; is taken from the upper trapezoid of aa, and converted to a matrix ; via (I - 2 vT . v / (v . vT)). ; ; hh = ident ;; identity matrix ; for i = 0, n-1 do begin ; v = aa(*,i) & if i GT 0 then v(0:i-1) = 0 ;; extract reflector ; hh = hh ## (ident - 2*(v # v)/total(v * v)) ;; generate matrix ; endfor ; ; Test the result: ; IDL> print, hh ## transpose(r) ; 9.00000 4.00000 ; 2.00000 8.00000 ; 6.00000 7.00000 ; ; Note that it is usually never necessary to form the Q matrix ; explicitly, and MPFIT does not. pro mpfit_qrfac, a, ipvt, rdiag, acnorm, pivot=pivot COMPILE_OPT strictarr sz = size(a) m = sz[1] n = sz[2] common mpfit_machar, machvals common mpfit_profile, profvals ; prof_start = systime(1) MACHEP0 = machvals.machep DWARF = machvals.minnum ;; Compute the initial column norms and initialize arrays acnorm = make_array(n, value=a[0]*0.) for j = 0L, n-1 do $ acnorm[j] = mpfit_enorm(a[*,j]) rdiag = acnorm wa = rdiag ipvt = lindgen(n) ;; Reduce a to r with householder transformations minmn = min([m,n]) for j = 0L, minmn-1 do begin if NOT keyword_set(pivot) then goto, HOUSE1 ;; Bring the column of largest norm into the pivot position rmax = max(rdiag[j:*]) kmax = where(rdiag[j:*] EQ rmax, ct) + j if ct LE 0 then goto, HOUSE1 kmax = kmax[0] ;; Exchange rows via the pivot only. Avoid actually exchanging ;; the rows, in case there is lots of memory transfer. The ;; exchange occurs later, within the body of MPFIT, after the ;; extraneous columns of the matrix have been shed. if kmax NE j then begin temp = ipvt[j] & ipvt[j] = ipvt[kmax] & ipvt[kmax] = temp rdiag[kmax] = rdiag[j] wa[kmax] = wa[j] endif HOUSE1: ;; Compute the householder transformation to reduce the jth ;; column of A to a multiple of the jth unit vector lj = ipvt[j] ajj = a[j:*,lj] ajnorm = mpfit_enorm(ajj) if ajnorm EQ 0 then goto, NEXT_ROW if a[j,lj] LT 0 then ajnorm = -ajnorm ajj = ajj / ajnorm ajj[0] = ajj[0] + 1 ;; *** Note optimization a(j:*,j) a[j,lj] = ajj ;; Apply the transformation to the remaining columns ;; and update the norms ;; NOTE to SELF: tried to optimize this by removing the loop, ;; but it actually got slower. Reverted to "for" loop to keep ;; it simple. if j+1 LT n then begin for k=j+1, n-1 do begin lk = ipvt[k] ajk = a[j:*,lk] ;; *** Note optimization a(j:*,lk) ;; (corrected 20 Jul 2000) if a[j,lj] NE 0 then $ a[j,lk] = ajk - ajj * total(ajk*ajj)/a[j,lj] if keyword_set(pivot) AND rdiag[k] NE 0 then begin temp = a[j,lk]/rdiag[k] rdiag[k] = rdiag[k] * sqrt((1.-temp^2) > 0) temp = rdiag[k]/wa[k] if 0.05D*temp*temp LE MACHEP0 then begin rdiag[k] = mpfit_enorm(a[j+1:*,lk]) wa[k] = rdiag[k] endif endif endfor endif NEXT_ROW: rdiag[j] = -ajnorm endfor ; profvals.qrfac = profvals.qrfac + (systime(1) - prof_start) return end ; ********** ; ; subroutine qrsolv ; ; given an m by n matrix a, an n by n diagonal matrix d, ; and an m-vector b, the problem is to determine an x which ; solves the system ; ; a*x = b , d*x = 0 , ; ; in the least squares sense. ; ; this subroutine completes the solution of the problem ; if it is provided with the necessary information from the ; qr factorization, with column pivoting, of a. that is, if ; a*p = q*r, where p is a permutation matrix, q has orthogonal ; columns, and r is an upper triangular matrix with diagonal ; elements of nonincreasing magnitude, then qrsolv expects ; the full upper triangle of r, the permutation matrix p, ; and the first n components of (q transpose)*b. the system ; a*x = b, d*x = 0, is then equivalent to ; ; t t ; r*z = q *b , p *d*p*z = 0 , ; ; where x = p*z. if this system does not have full rank, ; then a least squares solution is obtained. on output qrsolv ; also provides an upper triangular matrix s such that ; ; t t t ; p *(a *a + d*d)*p = s *s . ; ; s is computed within qrsolv and may be of separate interest. ; ; the subroutine statement is ; ; subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) ; ; where ; ; n is a positive integer input variable set to the order of r. ; ; r is an n by n array. on input the full upper triangle ; must contain the full upper triangle of the matrix r. ; on output the full upper triangle is unaltered, and the ; strict lower triangle contains the strict upper triangle ; (transposed) of the upper triangular matrix s. ; ; ldr is a positive integer input variable not less than n ; which specifies the leading dimension of the array r. ; ; ipvt is an integer input array of length n which defines the ; permutation matrix p such that a*p = q*r. column j of p ; is column ipvt(j) of the identity matrix. ; ; diag is an input array of length n which must contain the ; diagonal elements of the matrix d. ; ; qtb is an input array of length n which must contain the first ; n elements of the vector (q transpose)*b. ; ; x is an output array of length n which contains the least ; squares solution of the system a*x = b, d*x = 0. ; ; sdiag is an output array of length n which contains the ; diagonal elements of the upper triangular matrix s. ; ; wa is a work array of length n. ; ; subprograms called ; ; fortran-supplied ... dabs,dsqrt ; ; argonne national laboratory. minpack project. march 1980. ; burton s. garbow, kenneth e. hillstrom, jorge j. more ; pro mpfit_qrsolv, r, ipvt, diag, qtb, x, sdiag COMPILE_OPT strictarr sz = size(r) m = sz[1] n = sz[2] delm = lindgen(n) * (m+1) ;; Diagonal elements of r common mpfit_profile, profvals ; prof_start = systime(1) ;; copy r and (q transpose)*b to preserve input and initialize s. ;; in particular, save the diagonal elements of r in x. for j = 0L, n-1 do $ r[j:n-1,j] = r[j,j:n-1] x = r[delm] wa = qtb ;; Below may look strange, but it's so we can keep the right precision zero = qtb[0]*0. half = zero + 0.5 quart = zero + 0.25 ;; Eliminate the diagonal matrix d using a givens rotation for j = 0L, n-1 do begin l = ipvt[j] if diag[l] EQ 0 then goto, STORE_RESTORE sdiag[j:*] = 0 sdiag[j] = diag[l] ;; The transformations to eliminate the row of d modify only a ;; single element of (q transpose)*b beyond the first n, which ;; is initially zero. qtbpj = zero for k = j, n-1 do begin if sdiag[k] EQ 0 then goto, ELIM_NEXT_LOOP if abs(r[k,k]) LT abs(sdiag[k]) then begin cotan = r[k,k]/sdiag[k] sine = half/sqrt(quart + quart*cotan*cotan) cosine = sine*cotan endif else begin tang = sdiag[k]/r[k,k] cosine = half/sqrt(quart + quart*tang*tang) sine = cosine*tang endelse ;; Compute the modified diagonal element of r and the ;; modified element of ((q transpose)*b,0). r[k,k] = cosine*r[k,k] + sine*sdiag[k] temp = cosine*wa[k] + sine*qtbpj qtbpj = -sine*wa[k] + cosine*qtbpj wa[k] = temp ;; Accumulate the transformation in the row of s if n GT k+1 then begin temp = cosine*r[k+1:n-1,k] + sine*sdiag[k+1:n-1] sdiag[k+1:n-1] = -sine*r[k+1:n-1,k] + cosine*sdiag[k+1:n-1] r[k+1:n-1,k] = temp endif ELIM_NEXT_LOOP: endfor STORE_RESTORE: sdiag[j] = r[j,j] r[j,j] = x[j] endfor ;; Solve the triangular system for z. If the system is singular ;; then obtain a least squares solution nsing = n wh = where(sdiag EQ 0, ct) if ct GT 0 then begin nsing = wh[0] wa[nsing:*] = 0 endif if nsing GE 1 then begin wa[nsing-1] = wa[nsing-1]/sdiag[nsing-1] ;; Degenerate case ;; *** Reverse loop *** for j=nsing-2,0,-1 do begin sum = total(r[j+1:nsing-1,j]*wa[j+1:nsing-1]) wa[j] = (wa[j]-sum)/sdiag[j] endfor endif ;; Permute the components of z back to components of x x[ipvt] = wa ; profvals.qrsolv = profvals.qrsolv + (systime(1) - prof_start) return end ; ; subroutine lmpar ; ; given an m by n matrix a, an n by n nonsingular diagonal ; matrix d, an m-vector b, and a positive number delta, ; the problem is to determine a value for the parameter ; par such that if x solves the system ; ; a*x = b , sqrt(par)*d*x = 0 , ; ; in the least squares sense, and dxnorm is the euclidean ; norm of d*x, then either par is zero and ; ; (dxnorm-delta) .le. 0.1*delta , ; ; or par is positive and ; ; abs(dxnorm-delta) .le. 0.1*delta . ; ; this subroutine completes the solution of the problem ; if it is provided with the necessary information from the ; qr factorization, with column pivoting, of a. that is, if ; a*p = q*r, where p is a permutation matrix, q has orthogonal ; columns, and r is an upper triangular matrix with diagonal ; elements of nonincreasing magnitude, then lmpar expects ; the full upper triangle of r, the permutation matrix p, ; and the first n components of (q transpose)*b. on output ; lmpar also provides an upper triangular matrix s such that ; ; t t t ; p *(a *a + par*d*d)*p = s *s . ; ; s is employed within lmpar and may be of separate interest. ; ; only a few iterations are generally needed for convergence ; of the algorithm. if, however, the limit of 10 iterations ; is reached, then the output par will contain the best ; value obtained so far. ; ; the subroutine statement is ; ; subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag, ; wa1,wa2) ; ; where ; ; n is a positive integer input variable set to the order of r. ; ; r is an n by n array. on input the full upper triangle ; must contain the full upper triangle of the matrix r. ; on output the full upper triangle is unaltered, and the ; strict lower triangle contains the strict upper triangle ; (transposed) of the upper triangular matrix s. ; ; ldr is a positive integer input variable not less than n ; which specifies the leading dimension of the array r. ; ; ipvt is an integer input array of length n which defines the ; permutation matrix p such that a*p = q*r. column j of p ; is column ipvt(j) of the identity matrix. ; ; diag is an input array of length n which must contain the ; diagonal elements of the matrix d. ; ; qtb is an input array of length n which must contain the first ; n elements of the vector (q transpose)*b. ; ; delta is a positive input variable which specifies an upper ; bound on the euclidean norm of d*x. ; ; par is a nonnegative variable. on input par contains an ; initial estimate of the levenberg-marquardt parameter. ; on output par contains the final estimate. ; ; x is an output array of length n which contains the least ; squares solution of the system a*x = b, sqrt(par)*d*x = 0, ; for the output par. ; ; sdiag is an output array of length n which contains the ; diagonal elements of the upper triangular matrix s. ; ; wa1 and wa2 are work arrays of length n. ; ; subprograms called ; ; minpack-supplied ... dpmpar,enorm,qrsolv ; ; fortran-supplied ... dabs,dmax1,dmin1,dsqrt ; ; argonne national laboratory. minpack project. march 1980. ; burton s. garbow, kenneth e. hillstrom, jorge j. more ; function mpfit_lmpar, r, ipvt, diag, qtb, delta, x, sdiag, par=par COMPILE_OPT strictarr common mpfit_machar, machvals common mpfit_profile, profvals ; prof_start = systime(1) MACHEP0 = machvals.machep DWARF = machvals.minnum sz = size(r) m = sz[1] n = sz[2] delm = lindgen(n) * (m+1) ;; Diagonal elements of r ;; Compute and store in x the gauss-newton direction. If the ;; jacobian is rank-deficient, obtain a least-squares solution nsing = n wa1 = qtb rthresh = max(abs(r[delm]))*MACHEP0 wh = where(abs(r[delm]) LT rthresh, ct) if ct GT 0 then begin nsing = wh[0] wa1[wh[0]:*] = 0 endif if nsing GE 1 then begin ;; *** Reverse loop *** for j=nsing-1,0,-1 do begin wa1[j] = wa1[j]/r[j,j] if (j-1 GE 0) then $ wa1[0:(j-1)] = wa1[0:(j-1)] - r[0:(j-1),j]*wa1[j] endfor endif ;; Note: ipvt here is a permutation array x[ipvt] = wa1 ;; Initialize the iteration counter. Evaluate the function at the ;; origin, and test for acceptance of the gauss-newton direction iter = 0L wa2 = diag * x dxnorm = mpfit_enorm(wa2) fp = dxnorm - delta if fp LE 0.1*delta then goto, TERMINATE ;; If the jacobian is not rank deficient, the newton step provides a ;; lower bound, parl, for the zero of the function. Otherwise set ;; this bound to zero. zero = wa2[0]*0. parl = zero if nsing GE n then begin wa1 = diag[ipvt]*wa2[ipvt]/dxnorm wa1[0] = wa1[0] / r[0,0] ;; Degenerate case for j=1L, n-1 do begin ;; Note "1" here, not zero sum = total(r[0:(j-1),j]*wa1[0:(j-1)]) wa1[j] = (wa1[j] - sum)/r[j,j] endfor temp = mpfit_enorm(wa1) parl = ((fp/delta)/temp)/temp endif ;; Calculate an upper bound, paru, for the zero of the function for j=0L, n-1 do begin sum = total(r[0:j,j]*qtb[0:j]) wa1[j] = sum/diag[ipvt[j]] endfor gnorm = mpfit_enorm(wa1) paru = gnorm/delta if paru EQ 0 then paru = DWARF/min([delta,0.1]) ;; If the input par lies outside of the interval (parl,paru), set ;; par to the closer endpoint par = max([par,parl]) par = min([par,paru]) if par EQ 0 then par = gnorm/dxnorm ;; Beginning of an interation ITERATION: iter = iter + 1 ;; Evaluate the function at the current value of par if par EQ 0 then par = max([DWARF, paru*0.001]) temp = sqrt(par) wa1 = temp * diag mpfit_qrsolv, r, ipvt, wa1, qtb, x, sdiag wa2 = diag*x dxnorm = mpfit_enorm(wa2) temp = fp fp = dxnorm - delta if (abs(fp) LE 0.1D*delta) $ OR ((parl EQ 0) AND (fp LE temp) AND (temp LT 0)) $ OR (iter EQ 10) then goto, TERMINATE ;; Compute the newton correction wa1 = diag[ipvt]*wa2[ipvt]/dxnorm for j=0L,n-2 do begin wa1[j] = wa1[j]/sdiag[j] wa1[j+1:n-1] = wa1[j+1:n-1] - r[j+1:n-1,j]*wa1[j] endfor wa1[n-1] = wa1[n-1]/sdiag[n-1] ;; Degenerate case temp = mpfit_enorm(wa1) parc = ((fp/delta)/temp)/temp ;; Depending on the sign of the function, update parl or paru if fp GT 0 then parl = max([parl,par]) if fp LT 0 then paru = min([paru,par]) ;; Compute an improved estimate for par par = max([parl, par+parc]) ;; End of an iteration goto, ITERATION TERMINATE: ;; Termination ; profvals.lmpar = profvals.lmpar + (systime(1) - prof_start) if iter EQ 0 then return, par[0]*0. return, par end ;; Procedure to tie one parameter to another. pro mpfit_tie, p, _ptied COMPILE_OPT strictarr if n_elements(_ptied) EQ 0 then return if n_elements(_ptied) EQ 1 then if _ptied[0] EQ '' then return for _i = 0L, n_elements(_ptied)-1 do begin if _ptied[_i] EQ '' then goto, NEXT_TIE _cmd = 'p['+strtrim(_i,2)+'] = '+_ptied[_i] _err = execute(_cmd) if _err EQ 0 then begin message, 'ERROR: Tied expression "'+_cmd+'" failed.' return endif NEXT_TIE: endfor end ;; Default print procedure pro mpfit_defprint, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, $ p11, p12, p13, p14, p15, p16, p17, p18, $ format=format, unit=unit0, _EXTRA=extra COMPILE_OPT strictarr if n_elements(unit0) EQ 0 then unit = -1 else unit = round(unit0[0]) if n_params() EQ 0 then printf, unit, '' $ else if n_params() EQ 1 then printf, unit, p1, format=format $ else if n_params() EQ 2 then printf, unit, p1, p2, format=format $ else if n_params() EQ 3 then printf, unit, p1, p2, p3, format=format $ else if n_params() EQ 4 then printf, unit, p1, p2, p4, format=format return end ;; Default procedure to be called every iteration. It simply prints ;; the parameter values. pro mpfit_defiter, fcn, x, iter, fnorm, FUNCTARGS=fcnargs, $ quiet=quiet, iterstop=iterstop, iterkeybyte=iterkeybyte, $ parinfo=parinfo, iterprint=iterprint0, $ format=fmt, pformat=pformat, dof=dof0, _EXTRA=iterargs COMPILE_OPT strictarr common mpfit_error, mperr mperr = 0 if keyword_set(quiet) then goto, DO_ITERSTOP if n_params() EQ 3 then begin fvec = mpfit_call(fcn, x, _EXTRA=fcnargs) fnorm = mpfit_enorm(fvec)^2 endif ;; Determine which parameters to print nprint = n_elements(x) iprint = lindgen(nprint) if n_elements(iterprint0) EQ 0 then iterprint = 'MPFIT_DEFPRINT' $ else iterprint = strtrim(iterprint0[0],2) if n_elements(dof0) EQ 0 then dof = 1L else dof = floor(dof0[0]) call_procedure, iterprint, iter, fnorm, dof, $ format='("Iter ",I6," CHI-SQUARE = ",G15.8," DOF = ",I0)', $ _EXTRA=iterargs if n_elements(fmt) GT 0 then begin call_procedure, iterprint, x, format=fmt, _EXTRA=iterargs endif else begin if n_elements(pformat) EQ 0 then pformat = '(G20.6)' parname = 'P('+strtrim(iprint,2)+')' pformats = strarr(nprint) + pformat if n_elements(parinfo) GT 0 then begin parinfo_tags = tag_names(parinfo) wh = where(parinfo_tags EQ 'PARNAME', ct) if ct EQ 1 then begin wh = where(parinfo.parname NE '', ct) if ct GT 0 then $ parname[wh] = strmid(parinfo[wh].parname,0,25) endif wh = where(parinfo_tags EQ 'MPPRINT', ct) if ct EQ 1 then begin iprint = where(parinfo.mpprint EQ 1, nprint) if nprint EQ 0 then goto, DO_ITERSTOP endif wh = where(parinfo_tags EQ 'MPFORMAT', ct) if ct EQ 1 then begin wh = where(parinfo.mpformat NE '', ct) if ct GT 0 then pformats[wh] = parinfo[wh].mpformat endif endif for i = 0L, nprint-1 do begin call_procedure, iterprint, parname[iprint[i]], x[iprint[i]], $ format='(" ",A0," = ",'+pformats[iprint[i]]+')', $ _EXTRA=iterargs endfor endelse DO_ITERSTOP: if n_elements(iterkeybyte) EQ 0 then iterkeybyte = 7b if keyword_set(iterstop) then begin k = get_kbrd(0) if k EQ string(iterkeybyte[0]) then begin message, 'WARNING: minimization not complete', /info print, 'Do you want to terminate this procedure? (y/n)', $ format='(A,$)' k = '' read, k if strupcase(strmid(k,0,1)) EQ 'Y' then begin message, 'WARNING: Procedure is terminating.', /info mperr = -1 endif endif endif return end ;; Procedure to parse the parameter values in PARINFO pro mpfit_parinfo, parinfo, tnames, tag, values, default=def, status=status, $ n_param=n COMPILE_OPT strictarr status = 0 if n_elements(n) EQ 0 then n = n_elements(parinfo) if n EQ 0 then begin if n_elements(def) EQ 0 then return values = def status = 1 return endif if n_elements(parinfo) EQ 0 then goto, DO_DEFAULT if n_elements(tnames) EQ 0 then tnames = tag_names(parinfo) wh = where(tnames EQ tag, ct) if ct EQ 0 then begin DO_DEFAULT: if n_elements(def) EQ 0 then return values = make_array(n, value=def[0]) values[0] = def endif else begin values = parinfo.(wh[0]) np = n_elements(parinfo) nv = n_elements(values) values = reform(values[*], nv/np, np) endelse status = 1 return end ; ********** ; ; subroutine covar ; ; given an m by n matrix a, the problem is to determine ; the covariance matrix corresponding to a, defined as ; ; t ; inverse(a *a) . ; ; this subroutine completes the solution of the problem ; if it is provided with the necessary information from the ; qr factorization, with column pivoting, of a. that is, if ; a*p = q*r, where p is a permutation matrix, q has orthogonal ; columns, and r is an upper triangular matrix with diagonal ; elements of nonincreasing magnitude, then covar expects ; the full upper triangle of r and the permutation matrix p. ; the covariance matrix is then computed as ; ; t t ; p*inverse(r *r)*p . ; ; if a is nearly rank deficient, it may be desirable to compute ; the covariance matrix corresponding to the linearly independent ; columns of a. to define the numerical rank of a, covar uses ; the tolerance tol. if l is the largest integer such that ; ; abs(r(l,l)) .gt. tol*abs(r(1,1)) , ; ; then covar computes the covariance matrix corresponding to ; the first l columns of r. for k greater than l, column ; and row ipvt(k) of the covariance matrix are set to zero. ; ; the subroutine statement is ; ; subroutine covar(n,r,ldr,ipvt,tol,wa) ; ; where ; ; n is a positive integer input variable set to the order of r. ; ; r is an n by n array. on input the full upper triangle must ; contain the full upper triangle of the matrix r. on output ; r contains the square symmetric covariance matrix. ; ; ldr is a positive integer input variable not less than n ; which specifies the leading dimension of the array r. ; ; ipvt is an integer input array of length n which defines the ; permutation matrix p such that a*p = q*r. column j of p ; is column ipvt(j) of the identity matrix. ; ; tol is a nonnegative input variable used to define the ; numerical rank of a in the manner described above. ; ; wa is a work array of length n. ; ; subprograms called ; ; fortran-supplied ... dabs ; ; argonne national laboratory. minpack project. august 1980. ; burton s. garbow, kenneth e. hillstrom, jorge j. more ; ; ********** function mpfit_covar, rr, ipvt, tol=tol COMPILE_OPT strictarr sz = size(rr) if sz[0] NE 2 then begin message, 'ERROR: r must be a two-dimensional matrix' return, -1L endif n = sz[1] if n NE sz[2] then begin message, 'ERROR: r must be a square matrix' return, -1L endif zero = rr[0] * 0. one = zero + 1. if n_elements(ipvt) EQ 0 then ipvt = lindgen(n) r = rr r = reform(rr, n, n, /overwrite) ;; Form the inverse of r in the full upper triangle of r l = -1L if n_elements(tol) EQ 0 then tol = one*1.E-14 tolr = tol * abs(r[0,0]) for k = 0L, n-1 do begin if abs(r[k,k]) LE tolr then goto, INV_END_LOOP r[k,k] = one/r[k,k] for j = 0L, k-1 do begin temp = r[k,k] * r[j,k] r[j,k] = zero r[0,k] = r[0:j,k] - temp*r[0:j,j] endfor l = k endfor INV_END_LOOP: ;; Form the full upper triangle of the inverse of (r transpose)*r ;; in the full upper triangle of r if l GE 0 then $ for k = 0L, l do begin for j = 0L, k-1 do begin temp = r[j,k] r[0,j] = r[0:j,j] + temp*r[0:j,k] endfor temp = r[k,k] r[0,k] = temp * r[0:k,k] endfor ;; Form the full lower triangle of the covariance matrix ;; in the strict lower triangle of r and in wa wa = replicate(r[0,0], n) for j = 0L, n-1 do begin jj = ipvt[j] sing = j GT l for i = 0L, j do begin if sing then r[i,j] = zero ii = ipvt[i] if ii GT jj then r[ii,jj] = r[i,j] if ii LT jj then r[jj,ii] = r[i,j] endfor wa[jj] = r[j,j] endfor ;; Symmetrize the covariance matrix in r for j = 0L, n-1 do begin r[0:j,j] = r[j,0:j] r[j,j] = wa[j] endfor return, r end ;; Parse the RCSID revision number function mpfit_revision ;; NOTE: this string is changed every time an RCS check-in occurs revision = '$Revision: 1.84 $' ;; Parse just the version number portion revision = stregex(revision,'\$'+'Revision: *([0-9.]+) *'+'\$',/extract,/sub) revision = revision[1] return, revision end ;; Parse version numbers of the form 'X.Y' function mpfit_parse_version, version sz = size(version) if sz[sz[0]+1] NE 7 then return, 0 s = stregex(version[0], '^([0-9]+)\.([0-9]+)$', /extract,/sub) if s[0] NE version[0] then return, 0 return, long(s[1:2]) end ;; Enforce a minimum version number function mpfit_min_version, version, min_version mv = mpfit_parse_version(min_version) if mv[0] EQ 0 then return, 0 v = mpfit_parse_version(version) ;; Compare version components if v[0] LT mv[0] then return, 0 if v[1] LT mv[1] then return, 0 return, 1 end ; Manually reset recursion fencepost if the user gets in trouble pro mpfit_reset_recursion common mpfit_fencepost, mpfit_fencepost_active mpfit_fencepost_active = 0 end ; ********** ; ; subroutine lmdif ; ; the purpose of lmdif is to minimize the sum of the squares of ; m nonlinear functions in n variables by a modification of ; the levenberg-marquardt algorithm. the user must provide a ; subroutine which calculates the functions. the jacobian is ; then calculated by a forward-difference approximation. ; ; the subroutine statement is ; ; subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn, ; diag,mode,factor,nprint,info,nfev,fjac, ; ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) ; ; where ; ; fcn is the name of the user-supplied subroutine which ; calculates the functions. fcn must be declared ; in an external statement in the user calling ; program, and should be written as follows. ; ; subroutine fcn(m,n,x,fvec,iflag) ; integer m,n,iflag ; double precision x(n),fvec(m) ; ---------- ; calculate the functions at x and ; return this vector in fvec. ; ---------- ; return ; end ; ; the value of iflag should not be changed by fcn unless ; the user wants to terminate execution of lmdif. ; in this case set iflag to a negative integer. ; ; m is a positive integer input variable set to the number ; of functions. ; ; n is a positive integer input variable set to the number ; of variables. n must not exceed m. ; ; x is an array of length n. on input x must contain ; an initial estimate of the solution vector. on output x ; contains the final estimate of the solution vector. ; ; fvec is an output array of length m which contains ; the functions evaluated at the output x. ; ; ftol is a nonnegative input variable. termination ; occurs when both the actual and predicted relative ; reductions in the sum of squares are at most ftol. ; therefore, ftol measures the relative error desired ; in the sum of squares. ; ; xtol is a nonnegative input variable. termination ; occurs when the relative error between two consecutive ; iterates is at most xtol. therefore, xtol measures the ; relative error desired in the approximate solution. ; ; gtol is a nonnegative input variable. termination ; occurs when the cosine of the angle between fvec and ; any column of the jacobian is at most gtol in absolute ; value. therefore, gtol measures the orthogonality ; desired between the function vector and the columns ; of the jacobian. ; ; maxfev is a positive integer input variable. termination ; occurs when the number of calls to fcn is at least ; maxfev by the end of an iteration. ; ; epsfcn is an input variable used in determining a suitable ; step length for the forward-difference approximation. this ; approximation assumes that the relative errors in the ; functions are of the order of epsfcn. if epsfcn is less ; than the machine precision, it is assumed that the relative ; errors in the functions are of the order of the machine ; precision. ; ; diag is an array of length n. if mode = 1 (see ; below), diag is internally set. if mode = 2, diag ; must contain positive entries that serve as ; multiplicative scale factors for the variables. ; ; mode is an integer input variable. if mode = 1, the ; variables will be scaled internally. if mode = 2, ; the scaling is specified by the input diag. other ; values of mode are equivalent to mode = 1. ; ; factor is a positive input variable used in determining the ; initial step bound. this bound is set to the product of ; factor and the euclidean norm of diag*x if nonzero, or else ; to factor itself. in most cases factor should lie in the ; interval (.1,100.). 100. is a generally recommended value. ; ; nprint is an integer input variable that enables controlled ; printing of iterates if it is positive. in this case, ; fcn is called with iflag = 0 at the beginning of the first ; iteration and every nprint iterations thereafter and ; immediately prior to return, with x and fvec available ; for printing. if nprint is not positive, no special calls ; of fcn with iflag = 0 are made. ; ; info is an integer output variable. if the user has ; terminated execution, info is set to the (negative) ; value of iflag. see description of fcn. otherwise, ; info is set as follows. ; ; info = 0 improper input parameters. ; ; info = 1 both actual and predicted relative reductions ; in the sum of squares are at most ftol. ; ; info = 2 relative error between two consecutive iterates ; is at most xtol. ; ; info = 3 conditions for info = 1 and info = 2 both hold. ; ; info = 4 the cosine of the angle between fvec and any ; column of the jacobian is at most gtol in ; absolute value. ; ; info = 5 number of calls to fcn has reached or ; exceeded maxfev. ; ; info = 6 ftol is too small. no further reduction in ; the sum of squares is possible. ; ; info = 7 xtol is too small. no further improvement in ; the approximate solution x is possible. ; ; info = 8 gtol is too small. fvec is orthogonal to the ; columns of the jacobian to machine precision. ; ; nfev is an integer output variable set to the number of ; calls to fcn. ; ; fjac is an output m by n array. the upper n by n submatrix ; of fjac contains an upper triangular matrix r with ; diagonal elements of nonincreasing magnitude such that ; ; t t t ; p *(jac *jac)*p = r *r, ; ; where p is a permutation matrix and jac is the final ; calculated jacobian. column j of p is column ipvt(j) ; (see below) of the identity matrix. the lower trapezoidal ; part of fjac contains information generated during ; the computation of r. ; ; ldfjac is a positive integer input variable not less than m ; which specifies the leading dimension of the array fjac. ; ; ipvt is an integer output array of length n. ipvt ; defines a permutation matrix p such that jac*p = q*r, ; where jac is the final calculated jacobian, q is ; orthogonal (not stored), and r is upper triangular ; with diagonal elements of nonincreasing magnitude. ; column j of p is column ipvt(j) of the identity matrix. ; ; qtf is an output array of length n which contains ; the first n elements of the vector (q transpose)*fvec. ; ; wa1, wa2, and wa3 are work arrays of length n. ; ; wa4 is a work array of length m. ; ; subprograms called ; ; user-supplied ...... fcn ; ; minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac ; ; fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod ; ; argonne national laboratory. minpack project. march 1980. ; burton s. garbow, kenneth e. hillstrom, jorge j. more ; ; ********** function mpfit, fcn, xall, FUNCTARGS=fcnargs, SCALE_FCN=scalfcn, $ ftol=ftol0, xtol=xtol0, gtol=gtol0, epsfcn=epsfcn, $ resdamp=damp0, $ nfev=nfev, maxiter=maxiter, errmsg=errmsg, $ factor=factor0, nprint=nprint0, STATUS=info, $ iterproc=iterproc0, iterargs=iterargs, iterstop=ss,$ iterkeystop=iterkeystop, $ niter=iter, nfree=nfree, npegged=npegged, dof=dof, $ diag=diag, rescale=rescale, autoderivative=autoderiv0, $ pfree_index=ifree, $ perror=perror, covar=covar, nocovar=nocovar, $ bestnorm=fnorm, best_resid=fvec, $ best_fjac=output_fjac, calc_fjac=calc_fjac, $ parinfo=parinfo, quiet=quiet, nocatch=nocatch, $ fastnorm=fastnorm0, proc=proc, query=query, $ external_state=state, external_init=extinit, $ external_fvec=efvec, external_fjac=efjac, $ version=version, min_version=min_version0 COMPILE_OPT strictarr info = 0L errmsg = '' ;; Compute the revision number, to be returned in the VERSION and ;; QUERY keywords. common mpfit_revision_common, mpfit_revision_str if n_elements(mpfit_revision_str) EQ 0 then $ mpfit_revision_str = mpfit_revision() version = mpfit_revision_str if keyword_set(query) then begin if n_elements(min_version0) GT 0 then $ if mpfit_min_version(version, min_version0[0]) EQ 0 then $ return, 0 return, 1 endif if n_elements(min_version0) GT 0 then $ if mpfit_min_version(version, min_version0[0]) EQ 0 then begin message, 'ERROR: minimum required version '+min_version0[0]+' not satisfied', /info return, !values.d_nan endif if n_params() EQ 0 then begin message, "USAGE: PARMS = MPFIT('MYFUNCT', START_PARAMS, ... )", /info return, !values.d_nan endif ;; Use of double here not a problem since f/x/gtol are all only used ;; in comparisons if n_elements(ftol0) EQ 0 then ftol = 1.D-10 else ftol = ftol0[0] if n_elements(xtol0) EQ 0 then xtol = 1.D-10 else xtol = xtol0[0] if n_elements(gtol0) EQ 0 then gtol = 1.D-10 else gtol = gtol0[0] if n_elements(factor0) EQ 0 then factor = 100. else factor = factor0[0] if n_elements(nprint0) EQ 0 then nprint = 1 else nprint = nprint0[0] if n_elements(iterproc0) EQ 0 then iterproc = 'MPFIT_DEFITER' else iterproc = iterproc0[0] if n_elements(autoderiv0) EQ 0 then autoderiv = 1 else autoderiv = autoderiv0[0] if n_elements(fastnorm0) EQ 0 then fastnorm = 0 else fastnorm = fastnorm0[0] if n_elements(damp0) EQ 0 then damp = 0 else damp = damp0[0] ;; These are special configuration parameters that can't be easily ;; passed by MPFIT directly. ;; FASTNORM - decide on which sum-of-squares technique to use (1) ;; is fast, (0) is slower ;; PROC - user routine is a procedure (1) or function (0) ;; QANYTIED - set to 1 if any parameters are TIED, zero if none ;; PTIED - array of strings, one for each parameter common mpfit_config, mpconfig mpconfig = {fastnorm: keyword_set(fastnorm), proc: 0, nfev: 0L, damp: damp} common mpfit_machar, machvals iflag = 0L catch_msg = 'in MPFIT' nfree = 0L npegged = 0L dof = 0L output_fjac = 0L ;; Set up a persistent fencepost that prevents recursive calls common mpfit_fencepost, mpfit_fencepost_active if n_elements(mpfit_fencepost_active) EQ 0 then mpfit_fencepost_active = 0 if mpfit_fencepost_active then begin errmsg = 'ERROR: recursion detected; you cannot run MPFIT recursively' goto, TERMINATE endif ;; Only activate the fencepost if we are not in debugging mode if NOT keyword_set(nocatch) then mpfit_fencepost_active = 1 ;; Parameter damping doesn't work when user is providing their own ;; gradients. if damp NE 0 AND NOT keyword_set(autoderiv) then begin errmsg = 'ERROR: keywords DAMP and AUTODERIV are mutually exclusive' goto, TERMINATE endif ;; Process the ITERSTOP and ITERKEYSTOP keywords, and turn this into ;; a set of keywords to pass to MPFIT_DEFITER. if strupcase(iterproc) EQ 'MPFIT_DEFITER' AND n_elements(iterargs) EQ 0 $ AND keyword_set(ss) then begin if n_elements(iterkeystop) GT 0 then begin sz = size(iterkeystop) tp = sz[sz[0]+1] if tp EQ 7 then begin ;; String - convert first char to byte iterkeybyte = (byte(iterkeystop[0]))[0] endif if (tp GE 1 AND tp LE 3) OR (tp GE 12 AND tp LE 15) then begin ;; Integer - convert to byte iterkeybyte = byte(iterkeystop[0]) endif if n_elements(iterkeybyte) EQ 0 then begin errmsg = 'ERROR: ITERKEYSTOP must be either a BYTE or STRING' goto, TERMINATE endif iterargs = {iterstop: 1, iterkeybyte: iterkeybyte} endif else begin iterargs = {iterstop: 1, iterkeybyte: 7b} endelse endif ;; Handle error conditions gracefully if NOT keyword_set(nocatch) then begin catch, catcherror if catcherror NE 0 then begin ;; An error occurred!!! catch, /cancel mpfit_fencepost_active = 0 err_string = ''+!error_state.msg message, /cont, 'Error detected while '+catch_msg+':' message, /cont, err_string message, /cont, 'Error condition detected. Returning to MAIN level.' if errmsg EQ '' then $ errmsg = 'Error detected while '+catch_msg+': '+err_string if info EQ 0 then info = -18 return, !values.d_nan endif endif mpconfig = create_struct(mpconfig, 'NOCATCH', keyword_set(nocatch)) ;; Parse FCN function name - be sure it is a scalar string sz = size(fcn) if sz[0] NE 0 then begin FCN_NAME: errmsg = 'ERROR: MYFUNCT must be a scalar string' goto, TERMINATE endif if sz[sz[0]+1] NE 7 then goto, FCN_NAME isext = 0 if fcn EQ '(EXTERNAL)' then begin if n_elements(efvec) EQ 0 OR n_elements(efjac) EQ 0 then begin errmsg = 'ERROR: when using EXTERNAL function, EXTERNAL_FVEC '+$ 'and EXTERNAL_FJAC must be defined' goto, TERMINATE endif nv = n_elements(efvec) nj = n_elements(efjac) if (nj MOD nv) NE 0 then begin errmsg = 'ERROR: the number of values in EXTERNAL_FJAC must be '+ $ 'a multiple of the number of values in EXTERNAL_FVEC' goto, TERMINATE endif isext = 1 endif ;; Parinfo: ;; --------------- STARTING/CONFIG INFO (passed in to routine, not changed) ;; .value - starting value for parameter ;; .fixed - parameter is fixed ;; .limited - a two-element array, if parameter is bounded on ;; lower/upper side ;; .limits - a two-element array, lower/upper parameter bounds, if ;; limited vale is set ;; .step - step size in Jacobian calc, if greater than zero catch_msg = 'parsing input parameters' ;; Parameters can either be stored in parinfo, or x. Parinfo takes ;; precedence if it exists. if n_elements(xall) EQ 0 AND n_elements(parinfo) EQ 0 then begin errmsg = 'ERROR: must pass parameters in P or PARINFO' goto, TERMINATE endif ;; Be sure that PARINFO is of the right type if n_elements(parinfo) GT 0 then begin ;; Make sure the array is 1-D parinfo = parinfo[*] parinfo_size = size(parinfo) if parinfo_size[parinfo_size[0]+1] NE 8 then begin errmsg = 'ERROR: PARINFO must be a structure.' goto, TERMINATE endif if n_elements(xall) GT 0 AND n_elements(xall) NE n_elements(parinfo) $ then begin errmsg = 'ERROR: number of elements in PARINFO and P must agree' goto, TERMINATE endif endif ;; If the parameters were not specified at the command line, then ;; extract them from PARINFO if n_elements(xall) EQ 0 then begin mpfit_parinfo, parinfo, tagnames, 'VALUE', xall, status=status if status EQ 0 then begin errmsg = 'ERROR: either P or PARINFO[*].VALUE must be supplied.' goto, TERMINATE endif sz = size(xall) ;; Convert to double if parameters are not float or double if sz[sz[0]+1] NE 4 AND sz[sz[0]+1] NE 5 then $ xall = double(xall) endif xall = xall[*] ;; Make sure the array is 1-D npar = n_elements(xall) zero = xall[0] * 0. one = zero + 1. fnorm = -one fnorm1 = -one ;; TIED parameters? mpfit_parinfo, parinfo, tagnames, 'TIED', ptied, default='', n=npar ptied = strtrim(ptied, 2) wh = where(ptied NE '', qanytied) qanytied = qanytied GT 0 mpconfig = create_struct(mpconfig, 'QANYTIED', qanytied, 'PTIED', ptied) ;; FIXED parameters ? mpfit_parinfo, parinfo, tagnames, 'FIXED', pfixed, default=0, n=npar pfixed = pfixed EQ 1 pfixed = pfixed OR (ptied NE '');; Tied parameters are also effectively fixed ;; Finite differencing step, absolute and relative, and sidedness of deriv. mpfit_parinfo, parinfo, tagnames, 'STEP', step, default=zero, n=npar mpfit_parinfo, parinfo, tagnames, 'RELSTEP', dstep, default=zero, n=npar mpfit_parinfo, parinfo, tagnames, 'MPSIDE', dside, default=0, n=npar ;; Debugging parameters mpfit_parinfo, parinfo, tagnames, 'MPDERIV_DEBUG', ddebug, default=0, n=npar mpfit_parinfo, parinfo, tagnames, 'MPDERIV_RELTOL', ddrtol, default=zero, n=npar mpfit_parinfo, parinfo, tagnames, 'MPDERIV_ABSTOL', ddatol, default=zero, n=npar ;; Maximum and minimum steps allowed to be taken in one iteration mpfit_parinfo, parinfo, tagnames, 'MPMAXSTEP', maxstep, default=zero, n=npar mpfit_parinfo, parinfo, tagnames, 'MPMINSTEP', minstep, default=zero, n=npar qmin = minstep * 0 ;; Remove minstep for now!! qmax = maxstep NE 0 wh = where(qmin AND qmax AND maxstep LT minstep, ct) if ct GT 0 then begin errmsg = 'ERROR: MPMINSTEP is greater than MPMAXSTEP' goto, TERMINATE endif ;; Finish up the free parameters ifree = where(pfixed NE 1, nfree) if nfree EQ 0 then begin errmsg = 'ERROR: no free parameters' goto, TERMINATE endif ;; An external Jacobian must be checked against the number of ;; parameters if isext then begin if (nj/nv) NE nfree then begin errmsg = string(nv, nfree, nfree, $ format=('("ERROR: EXTERNAL_FJAC must be a ",I0," x ",I0,' + $ '" array, where ",I0," is the number of free parameters")')) goto, TERMINATE endif endif ;; Compose only VARYING parameters xnew = xall ;; xnew is the set of parameters to be returned x = xnew[ifree] ;; x is the set of free parameters ; Same for min/max step diagnostics qmin = qmin[ifree] & minstep = minstep[ifree] qmax = qmax[ifree] & maxstep = maxstep[ifree] wh = where(qmin OR qmax, ct) qminmax = ct GT 0 ;; LIMITED parameters ? mpfit_parinfo, parinfo, tagnames, 'LIMITED', limited, status=st1 mpfit_parinfo, parinfo, tagnames, 'LIMITS', limits, status=st2 if st1 EQ 1 AND st2 EQ 1 then begin ;; Error checking on limits in parinfo wh = where((limited[0,*] AND xall LT limits[0,*]) OR $ (limited[1,*] AND xall GT limits[1,*]), ct) if ct GT 0 then begin errmsg = 'ERROR: parameters are not within PARINFO limits' goto, TERMINATE endif wh = where(limited[0,*] AND limited[1,*] AND $ limits[0,*] GE limits[1,*] AND $ pfixed EQ 0, ct) if ct GT 0 then begin errmsg = 'ERROR: PARINFO parameter limits are not consistent' goto, TERMINATE endif ;; Transfer structure values to local variables qulim = limited[1, ifree] ulim = limits [1, ifree] qllim = limited[0, ifree] llim = limits [0, ifree] wh = where(qulim OR qllim, ct) if ct GT 0 then qanylim = 1 else qanylim = 0 endif else begin ;; Fill in local variables with dummy values qulim = lonarr(nfree) ulim = x * 0. qllim = qulim llim = x * 0. qanylim = 0 endelse ;; Initialize the number of parameters pegged at a hard limit value wh = where((qulim AND (x EQ ulim)) OR (qllim AND (x EQ llim)), npegged) n = n_elements(x) if n_elements(maxiter) EQ 0 then maxiter = 200L ;; Check input parameters for errors if (n LE 0) OR (ftol LE 0) OR (xtol LE 0) OR (gtol LE 0) $ OR (maxiter LT 0) OR (factor LE 0) then begin errmsg = 'ERROR: input keywords are inconsistent' goto, TERMINATE endif if keyword_set(rescale) then begin errmsg = 'ERROR: DIAG parameter scales are inconsistent' if n_elements(diag) LT n then goto, TERMINATE wh = where(diag LE 0, ct) if ct GT 0 then goto, TERMINATE errmsg = '' endif if n_elements(state) NE 0 AND NOT keyword_set(extinit) then begin szst = size(state) if szst[szst[0]+1] NE 8 then begin errmsg = 'EXTERNAL_STATE keyword was not preserved' status = 0 goto, TERMINATE endif if nfree NE n_elements(state.ifree) then begin BAD_IFREE: errmsg = 'Number of free parameters must not change from one '+$ 'external iteration to the next' status = 0 goto, TERMINATE endif wh = where(ifree NE state.ifree, ct) if ct GT 0 then goto, BAD_IFREE tnames = tag_names(state) for i = 0L, n_elements(tnames)-1 do begin dummy = execute(tnames[i]+' = state.'+tnames[i]) endfor wa4 = reform(efvec, n_elements(efvec)) goto, RESUME_FIT endif common mpfit_error, mperr if NOT isext then begin mperr = 0 catch_msg = 'calling '+fcn fvec = mpfit_call(fcn, xnew, _EXTRA=fcnargs) iflag = mperr if iflag LT 0 then begin errmsg = 'ERROR: first call to "'+fcn+'" failed' goto, TERMINATE endif endif else begin fvec = reform(efvec, n_elements(efvec)) endelse catch_msg = 'calling MPFIT_SETMACHAR' sz = size(fvec[0]) isdouble = (sz[sz[0]+1] EQ 5) mpfit_setmachar, double=isdouble common mpfit_profile, profvals ; prof_start = systime(1) MACHEP0 = machvals.machep DWARF = machvals.minnum szx = size(x) ;; The parameters and the squared deviations should have the same ;; type. Otherwise the MACHAR-based evaluation will fail. catch_msg = 'checking parameter data' tp = szx[szx[0]+1] if tp NE 4 AND tp NE 5 then begin if NOT keyword_set(quiet) then begin message, 'WARNING: input parameters must be at least FLOAT', /info message, ' (converting parameters to FLOAT)', /info endif x = float(x) xnew = float(x) szx = size(x) endif if isdouble AND tp NE 5 then begin if NOT keyword_set(quiet) then begin message, 'WARNING: data is DOUBLE but parameters are FLOAT', /info message, ' (converting parameters to DOUBLE)', /info endif x = double(x) xnew = double(xnew) endif m = n_elements(fvec) if (m LT n) then begin errmsg = 'ERROR: number of parameters must not exceed data' goto, TERMINATE endif fnorm = mpfit_enorm(fvec) if finite(fnorm) EQ 0 then goto, FAIL_OVERFLOW ;; Initialize Levelberg-Marquardt parameter and iteration counter par = zero iter = 1L qtf = x * 0. ;; Beginning of the outer loop OUTER_LOOP: ;; If requested, call fcn to enable printing of iterates xnew[ifree] = x if qanytied then mpfit_tie, xnew, ptied dof = (n_elements(fvec) - nfree) > 1L if nprint GT 0 AND iterproc NE '' then begin catch_msg = 'calling '+iterproc iflag = 0L if (iter-1) MOD nprint EQ 0 then begin mperr = 0 xnew0 = xnew call_procedure, iterproc, fcn, xnew, iter, fnorm^2, $ FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $ dof=dof, _EXTRA=iterargs iflag = mperr ;; Check for user termination if iflag LT 0 then begin errmsg = 'WARNING: premature termination by "'+iterproc+'"' goto, TERMINATE endif ;; If parameters were changed (grrr..) then re-tie if max(abs(xnew0-xnew)) GT 0 then begin if qanytied then mpfit_tie, xnew, ptied x = xnew[ifree] endif endif endif ;; Calculate the jacobian matrix iflag = 2 if NOT isext then begin catch_msg = 'calling MPFIT_FDJAC2' ;; NOTE! If you change this call then change the one during ;; clean-up as well! fjac = mpfit_fdjac2(fcn, x, fvec, step, qulim, ulim, dside, $ iflag=iflag, epsfcn=epsfcn, $ autoderiv=autoderiv, dstep=dstep, $ FUNCTARGS=fcnargs, ifree=ifree, xall=xnew, $ deriv_debug=ddebug, deriv_reltol=ddrtol, deriv_abstol=ddatol) if iflag LT 0 then begin errmsg = 'WARNING: premature termination by FDJAC2' goto, TERMINATE endif endif else begin fjac = reform(efjac,n_elements(fvec),npar, /overwrite) endelse ;; Rescale the residuals and gradient, for use with "alternative" ;; statistics such as the Cash statistic. catch_msg = 'prescaling residuals and gradient' if n_elements(scalfcn) GT 0 then begin call_procedure, strtrim(scalfcn[0],2), fvec, fjac endif ;; Determine if any of the parameters are pegged at the limits npegged = 0L if qanylim then begin catch_msg = 'zeroing derivatives of pegged parameters' whlpeg = where(qllim AND (x EQ llim), nlpeg) whupeg = where(qulim AND (x EQ ulim), nupeg) npegged = nlpeg + nupeg ;; See if any "pegged" values should keep their derivatives if (nlpeg GT 0) then begin ;; Total derivative of sum wrt lower pegged parameters ;; Note: total(fvec*fjac[*,i]) is d(CHI^2)/dX[i] for i = 0L, nlpeg-1 do begin sum = total(fvec * fjac[*,whlpeg[i]]) if sum GT 0 then fjac[*,whlpeg[i]] = 0 endfor endif if (nupeg GT 0) then begin ;; Total derivative of sum wrt upper pegged parameters for i = 0L, nupeg-1 do begin sum = total(fvec * fjac[*,whupeg[i]]) if sum LT 0 then fjac[*,whupeg[i]] = 0 endfor endif endif ;; Save a copy of the Jacobian if the user requests it... if keyword_set(calc_fjac) then output_fjac = fjac ;; ===================== ;; Compute the QR factorization of the jacobian catch_msg = 'calling MPFIT_QRFAC' ;; IN: Jacobian ;; OUT: Hh Vects Permutation RDIAG ACNORM mpfit_qrfac, fjac, ipvt, wa1, wa2, /pivot ;; Jacobian - jacobian matrix computed by mpfit_fdjac2 ;; Hh vects - house holder vectors from QR factorization & R matrix ;; Permutation - permutation vector for pivoting ;; RDIAG - diagonal elements of R matrix ;; ACNORM - norms of input Jacobian matrix before factoring ;; ===================== ;; On the first iteration if "diag" is unspecified, scale ;; according to the norms of the columns of the initial jacobian catch_msg = 'rescaling diagonal elements' if (iter EQ 1) then begin ;; Input: WA2 = root sum of squares of original Jacobian matrix ;; DIAG = user-requested diagonal (not documented!) ;; FACTOR = user-requested norm factor (not documented!) ;; Output: DIAG = Diagonal scaling values ;; XNORM = sum of squared scaled residuals ;; DELTA = rescaled XNORM if NOT keyword_set(rescale) OR (n_elements(diag) LT n) then begin diag = wa2 ;; Calculated from original Jacobian wh = where (diag EQ 0, ct) ;; Handle zero values if ct GT 0 then diag[wh] = one endif ;; On the first iteration, calculate the norm of the scaled x ;; and initialize the step bound delta wa3 = diag * x ;; WA3 is temp variable xnorm = mpfit_enorm(wa3) delta = factor*xnorm if delta EQ zero then delta = zero + factor endif ;; Form (q transpose)*fvec and store the first n components in qtf catch_msg = 'forming (q transpose)*fvec' wa4 = fvec for j=0L, n-1 do begin lj = ipvt[j] temp3 = fjac[j,lj] if temp3 NE 0 then begin fj = fjac[j:*,lj] wj = wa4[j:*] ;; *** optimization wa4(j:*) wa4[j] = wj - fj * total(fj*wj) / temp3 endif fjac[j,lj] = wa1[j] qtf[j] = wa4[j] endfor ;; From this point on, only the square matrix, consisting of the ;; triangle of R, is needed. fjac = fjac[0:n-1, 0:n-1] fjac = reform(fjac, n, n, /overwrite) fjac = fjac[*, ipvt] ;; Convert to permuted order fjac = reform(fjac, n, n, /overwrite) ;; Check for overflow. This should be a cheap test here since FJAC ;; has been reduced to a (small) square matrix, and the test is ;; O(N^2). wh = where(finite(fjac) EQ 0, ct) if ct GT 0 then goto, FAIL_OVERFLOW ;; Compute the norm of the scaled gradient catch_msg = 'computing the scaled gradient' gnorm = zero if fnorm NE 0 then begin for j=0L, n-1 do begin l = ipvt[j] if wa2[l] NE 0 then begin sum = total(fjac[0:j,j]*qtf[0:j])/fnorm gnorm = max([gnorm,abs(sum/wa2[l])]) endif endfor endif ;; Test for convergence of the gradient norm if gnorm LE gtol then info = 4 if info NE 0 then goto, TERMINATE if maxiter EQ 0 then begin info = 5 goto, TERMINATE endif ;; Rescale if necessary if NOT keyword_set(rescale) then $ diag = diag > wa2 ;; Beginning of the inner loop INNER_LOOP: ;; Determine the levenberg-marquardt parameter catch_msg = 'calculating LM parameter (MPFIT_LMPAR)' par = mpfit_lmpar(fjac, ipvt, diag, qtf, delta, wa1, wa2, par=par) ;; Store the direction p and x+p. Calculate the norm of p wa1 = -wa1 if qanylim EQ 0 AND qminmax EQ 0 then begin ;; No parameter limits, so just move to new position WA2 alpha = one wa2 = x + wa1 endif else begin ;; Respect the limits. If a step were to go out of bounds, then ;; we should take a step in the same direction but shorter distance. ;; The step should take us right to the limit in that case. alpha = one if qanylim EQ 1 then begin ;; Do not allow any steps out of bounds catch_msg = 'checking for a step out of bounds' if nlpeg GT 0 then wa1[whlpeg] = wa1[whlpeg] > 0 if nupeg GT 0 then wa1[whupeg] = wa1[whupeg] < 0 dwa1 = abs(wa1) GT MACHEP0 whl = where(dwa1 AND qllim AND (x + wa1 LT llim), lct) if lct GT 0 then $ alpha = min([alpha, (llim[whl]-x[whl])/wa1[whl]]) whu = where(dwa1 AND qulim AND (x + wa1 GT ulim), uct) if uct GT 0 then $ alpha = min([alpha, (ulim[whu]-x[whu])/wa1[whu]]) endif ;; Obey any max step values. if qminmax EQ 1 then begin nwa1 = wa1 * alpha whmax = where(qmax AND maxstep GT 0, ct) if ct GT 0 then begin mrat = max(abs(nwa1[whmax])/abs(maxstep[whmax])) if mrat GT 1 then alpha = alpha / mrat endif endif ;; Scale the resulting vector wa1 = wa1 * alpha wa2 = x + wa1 ;; Adjust the final output values. If the step put us exactly ;; on a boundary, make sure we peg it there. sgnu = (ulim GE 0)*2d - 1d sgnl = (llim GE 0)*2d - 1d ;; Handles case of ;; ... nonzero *LIM ... ... zero *LIM ... ulim1 = ulim*(1-sgnu*MACHEP0) - (ulim EQ 0)*MACHEP0 llim1 = llim*(1+sgnl*MACHEP0) + (llim EQ 0)*MACHEP0 wh = where(qulim AND (wa2 GE ulim1), ct) if ct GT 0 then wa2[wh] = ulim[wh] wh = where(qllim AND (wa2 LE llim1), ct) if ct GT 0 then wa2[wh] = llim[wh] endelse wa3 = diag * wa1 pnorm = mpfit_enorm(wa3) ;; On the first iteration, adjust the initial step bound if iter EQ 1 then delta = min([delta,pnorm]) xnew[ifree] = wa2 if isext then goto, SAVE_STATE ;; Evaluate the function at x+p and calculate its norm mperr = 0 catch_msg = 'calling '+fcn wa4 = mpfit_call(fcn, xnew, _EXTRA=fcnargs) iflag = mperr if iflag LT 0 then begin errmsg = 'WARNING: premature termination by "'+fcn+'"' goto, TERMINATE endif RESUME_FIT: fnorm1 = mpfit_enorm(wa4) if finite(fnorm1) EQ 0 then goto, FAIL_OVERFLOW ;; Compute the scaled actual reduction catch_msg = 'computing convergence criteria' actred = -one if 0.1D * fnorm1 LT fnorm then actred = - (fnorm1/fnorm)^2 + 1. ;; Compute the scaled predicted reduction and the scaled directional ;; derivative for j = 0L, n-1 do begin wa3[j] = 0 wa3[0:j] = wa3[0:j] + fjac[0:j,j]*wa1[ipvt[j]] endfor ;; Remember, alpha is the fraction of the full LM step actually ;; taken temp1 = mpfit_enorm(alpha*wa3)/fnorm temp2 = (sqrt(alpha*par)*pnorm)/fnorm half = zero + 0.5 prered = temp1*temp1 + (temp2*temp2)/half dirder = -(temp1*temp1 + temp2*temp2) ;; Compute the ratio of the actual to the predicted reduction. ratio = zero tenth = zero + 0.1 if prered NE 0 then ratio = actred/prered ;; Update the step bound if ratio LE 0.25D then begin if actred GE 0 then temp = half $ else temp = half*dirder/(dirder + half*actred) if ((0.1D*fnorm1) GE fnorm) OR (temp LT 0.1D) then temp = tenth delta = temp*min([delta,pnorm/tenth]) par = par/temp endif else begin if (par EQ 0) OR (ratio GE 0.75) then begin delta = pnorm/half par = half*par endif endelse ;; Test for successful iteration if ratio GE 0.0001 then begin ;; Successful iteration. Update x, fvec, and their norms x = wa2 wa2 = diag * x fvec = wa4 xnorm = mpfit_enorm(wa2) fnorm = fnorm1 iter = iter + 1 endif ;; Tests for convergence if (abs(actred) LE ftol) AND (prered LE ftol) $ AND (0.5D * ratio LE 1) then info = 1 if delta LE xtol*xnorm then info = 2 if (abs(actred) LE ftol) AND (prered LE ftol) $ AND (0.5D * ratio LE 1) AND (info EQ 2) then info = 3 if info NE 0 then goto, TERMINATE ;; Tests for termination and stringent tolerances if iter GE maxiter then info = 5 if (abs(actred) LE MACHEP0) AND (prered LE MACHEP0) $ AND (0.5*ratio LE 1) then info = 6 if delta LE MACHEP0*xnorm then info = 7 if gnorm LE MACHEP0 then info = 8 if info NE 0 then goto, TERMINATE ;; End of inner loop. Repeat if iteration unsuccessful if ratio LT 0.0001 then begin goto, INNER_LOOP endif ;; Check for over/underflow wh = where(finite(wa1) EQ 0 OR finite(wa2) EQ 0 OR finite(x) EQ 0, ct) if ct GT 0 OR finite(ratio) EQ 0 then begin FAIL_OVERFLOW: errmsg = ('ERROR: parameter or function value(s) have become '+$ 'infinite; check model function for over- '+$ 'and underflow') info = -16 goto, TERMINATE endif ;; End of outer loop. goto, OUTER_LOOP TERMINATE: catch_msg = 'in the termination phase' ;; Termination, either normal or user imposed. if iflag LT 0 then info = iflag iflag = 0 if n_elements(xnew) EQ 0 then goto, FINAL_RETURN if nfree EQ 0 then xnew = xall else xnew[ifree] = x if n_elements(qanytied) GT 0 then if qanytied then mpfit_tie, xnew, ptied dof = n_elements(fvec) - nfree ;; Call the ITERPROC at the end of the fit, if the fit status is ;; okay. Don't call it if the fit failed for some reason. if info GT 0 then begin mperr = 0 xnew0 = xnew call_procedure, iterproc, fcn, xnew, iter, fnorm^2, $ FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $ dof=dof, _EXTRA=iterargs iflag = mperr if iflag LT 0 then begin errmsg = 'WARNING: premature termination by "'+iterproc+'"' endif else begin ;; If parameters were changed (grrr..) then re-tie if max(abs(xnew0-xnew)) GT 0 then begin if qanytied then mpfit_tie, xnew, ptied x = xnew[ifree] endif endelse endif ;; Initialize the number of parameters pegged at a hard limit value npegged = 0L if n_elements(qanylim) GT 0 then if qanylim then begin wh = where((qulim AND (x EQ ulim)) OR $ (qllim AND (x EQ llim)), npegged) endif ;; Calculate final function value (FNORM) and residuals (FVEC) if isext EQ 0 AND nprint GT 0 AND info GT 0 then begin catch_msg = 'calling '+fcn fvec = mpfit_call(fcn, xnew, _EXTRA=fcnargs) catch_msg = 'in the termination phase' fnorm = mpfit_enorm(fvec) endif if n_elements(fnorm) EQ 0 AND n_elements(fnorm1) GT 0 then fnorm = fnorm1 if n_elements(fnorm) GT 0 then fnorm = fnorm^2. covar = !values.d_nan ;; (very carefully) set the covariance matrix COVAR if info GT 0 AND NOT keyword_set(nocovar) $ AND n_elements(n) GT 0 $ AND n_elements(fjac) GT 0 AND n_elements(ipvt) GT 0 then begin sz = size(fjac) if n GT 0 AND sz[0] GT 1 AND sz[1] GE n AND sz[2] GE n $ AND n_elements(ipvt) GE n then begin catch_msg = 'computing the covariance matrix' if n EQ 1 then $ cv = mpfit_covar(reform([fjac[0,0]],1,1), ipvt[0]) $ else $ cv = mpfit_covar(fjac[0:n-1,0:n-1], ipvt[0:n-1]) cv = reform(cv, n, n, /overwrite) nn = n_elements(xall) ;; Fill in actual covariance matrix, accounting for fixed ;; parameters. covar = replicate(zero, nn, nn) for i = 0L, n-1 do begin covar[ifree, ifree[i]] = cv[*,i] end ;; Compute errors in parameters catch_msg = 'computing parameter errors' i = lindgen(nn) perror = replicate(abs(covar[0])*0., nn) wh = where(covar[i,i] GE 0, ct) if ct GT 0 then $ perror[wh] = sqrt(covar[wh, wh]) endif endif ; catch_msg = 'returning the result' ; profvals.mpfit = profvals.mpfit + (systime(1) - prof_start) FINAL_RETURN: mpfit_fencepost_active = 0 nfev = mpconfig.nfev if n_elements(xnew) EQ 0 then return, !values.d_nan return, xnew ;; ------------------------------------------------------------------ ;; Alternate ending if the user supplies the function and gradients ;; externally ;; ------------------------------------------------------------------ SAVE_STATE: catch_msg = 'saving MPFIT state' ;; Names of variables to save varlist = ['alpha', 'delta', 'diag', 'dwarf', 'factor', 'fnorm', $ 'fjac', 'gnorm', 'nfree', 'ifree', 'ipvt', 'iter', $ 'm', 'n', 'machvals', 'machep0', 'npegged', $ 'whlpeg', 'whupeg', 'nlpeg', 'nupeg', $ 'mpconfig', 'par', 'pnorm', 'qtf', $ 'wa1', 'wa2', 'wa3', 'xnorm', 'x', 'xnew'] cmd = '' ;; Construct an expression that will save them for i = 0L, n_elements(varlist)-1 do begin ival = 0 dummy = execute('ival = n_elements('+varlist[i]+')') if ival GT 0 then begin cmd = cmd + ',' + varlist[i]+':'+varlist[i] endif endfor cmd = 'state = create_struct({'+strmid(cmd,1)+'})' state = 0 if execute(cmd) NE 1 then $ message, 'ERROR: could not save MPFIT state' ;; Set STATUS keyword to prepare for next iteration, and reset init ;; so we do not init the next time info = 9 extinit = 0 return, xnew end mpfitfun.pro0000644000244500024450000011037712032562272012734 0ustar craigmcraigm;+ ; NAME: ; MPFITFUN ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Perform Levenberg-Marquardt least-squares fit to IDL function ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; parms = MPFITFUN(MYFUNCT, X, Y, ERR, start_params, ...) ; ; DESCRIPTION: ; ; MPFITFUN fits a user-supplied model -- in the form of an IDL ; function -- to a set of user-supplied data. MPFITFUN calls ; MPFIT, the MINPACK-1 least-squares minimizer, to do the main ; work. ; ; Given the data and their uncertainties, MPFITFUN finds the best set ; of model parameters which match the data (in a least-squares ; sense) and returns them in an array. ; ; The user must supply the following items: ; - An array of independent variable values ("X"). ; - An array of "measured" *dependent* variable values ("Y"). ; - An array of "measured" 1-sigma uncertainty values ("ERR"). ; - The name of an IDL function which computes Y given X ("MYFUNCT"). ; - Starting guesses for all of the parameters ("START_PARAMS"). ; ; There are very few restrictions placed on X, Y or MYFUNCT. Simply ; put, MYFUNCT must map the "X" values into "Y" values given the ; model parameters. The "X" values may represent any independent ; variable (not just Cartesian X), and indeed may be multidimensional ; themselves. For example, in the application of image fitting, X ; may be a 2xN array of image positions. ; ; Data values of NaN or Infinity for "Y", "ERR" or "WEIGHTS" will be ; ignored as missing data if the NAN keyword is set. Otherwise, they ; may cause the fitting loop to halt with an error message. Note ; that the fit will still halt if the model function, or its ; derivatives, produces infinite or NaN values. ; ; MPFITFUN carefully avoids passing large arrays where possible to ; improve performance. ; ; See below for an example of usage. ; ; USER FUNCTION ; ; The user must define a function which returns the model value. For ; applications which use finite-difference derivatives -- the default ; -- the user function should be declared in the following way: ; ; FUNCTION MYFUNCT, X, P ; ; The independent variable is X ; ; Parameter values are passed in "P" ; YMOD = ... computed model values at X ... ; return, YMOD ; END ; ; The returned array YMOD must have the same dimensions and type as ; the "measured" Y values. ; ; User functions may also indicate a fatal error condition ; using the ERROR_CODE common block variable, as described ; below under the MPFIT_ERROR common block definition. ; ; MPFIT by default calculates derivatives numerically via a finite ; difference approximation. However, the user function *may* ; calculate the derivatives if desired, but only if the model ; function is declared with an additional position parameter, DP, as ; described below. ; ; To enable explicit derivatives for all parameters, set ; AUTODERIVATIVE=0. ; ; When AUTODERIVATIVE=0, the user function is responsible for ; calculating the derivatives of the user function with respect to ; each parameter. The user function should be declared as follows: ; ; ; ; ; MYFUNCT - example user function ; ; P - input parameter values (N-element array) ; ; DP - upon input, an N-vector indicating which parameters ; ; to compute derivatives for; ; ; upon output, the user function must return ; ; an ARRAY(M,N) of derivatives in this keyword ; ; (keywords) - any other keywords specified by FUNCTARGS ; ; RETURNS - function values ; ; ; FUNCTION MYFUNCT, x, p, dp [, (additional keywords if desired)] ; model = F(x, p) ;; Model function ; ; if n_params() GT 2 then begin ; ; Create derivative and compute derivative array ; requested = dp ; Save original value of DP ; dp = make_array(n_elements(x), n_elements(p), value=x[0]*0) ; ; ; Compute derivative if requested by caller ; for i = 0, n_elements(p)-1 do if requested(i) NE 0 then $ ; dp(*,i) = FGRAD(x, p, i) ; endif ; ; return, resid ; END ; ; where FGRAD(x, p, i) is a model function which computes the ; derivative of the model F(x,p) with respect to parameter P(i) at X. ; ; Derivatives should be returned in the DP array. DP should be an ; ARRAY(m,n) array, where m is the number of data points and n is the ; number of parameters. DP[i,j] is the derivative of the ith ; function value with respect to the jth parameter. ; ; MPFIT may not always request derivatives from the user function. ; In those cases, the parameter DP is not passed. Therefore ; functions can use N_PARAMS() to indicate whether they must compute ; the derivatives or not. ; ; For additional information about explicit derivatives, including ; additional settings and debugging options, see the discussion under ; "EXPLICIT DERIVATIVES" and AUTODERIVATIVE in MPFIT.PRO. ; ; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD ; ; The behavior of MPFIT can be modified with respect to each ; parameter to be fitted. A parameter value can be fixed; simple ; boundary constraints can be imposed; limitations on the parameter ; changes can be imposed; properties of the automatic derivative can ; be modified; and parameters can be tied to one another. ; ; These properties are governed by the PARINFO structure, which is ; passed as a keyword parameter to MPFIT. ; ; PARINFO should be an array of structures, one for each parameter. ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; .VALUE - the starting parameter value (but see the START_PARAMS ; parameter for more information). ; ; .FIXED - a boolean value, whether the parameter is to be held ; fixed or not. Fixed parameters are not varied by ; MPFIT, but are passed on to MYFUNCT for evaluation. ; ; .LIMITED - a two-element boolean array. If the first/second ; element is set, then the parameter is bounded on the ; lower/upper side. A parameter can be bounded on both ; sides. Both LIMITED and LIMITS must be given ; together. ; ; .LIMITS - a two-element float or double array. Gives the ; parameter limits on the lower and upper sides, ; respectively. Zero, one or two of these values can be ; set, depending on the values of LIMITED. Both LIMITED ; and LIMITS must be given together. ; ; .PARNAME - a string, giving the name of the parameter. The ; fitting code of MPFIT does not use this tag in any ; way. However, the default ITERPROC will print the ; parameter name if available. ; ; .STEP - the step size to be used in calculating the numerical ; derivatives. If set to zero, then the step size is ; computed automatically. Ignored when AUTODERIVATIVE=0. ; This value is superceded by the RELSTEP value. ; ; .RELSTEP - the *relative* step size to be used in calculating ; the numerical derivatives. This number is the ; fractional size of the step, compared to the ; parameter value. This value supercedes the STEP ; setting. If the parameter is zero, then a default ; step size is chosen. ; ; .MPSIDE - the sidedness of the finite difference when computing ; numerical derivatives. This field can take four ; values: ; ; 0 - one-sided derivative computed automatically ; 1 - one-sided derivative (f(x+h) - f(x) )/h ; -1 - one-sided derivative (f(x) - f(x-h))/h ; 2 - two-sided derivative (f(x+h) - f(x-h))/(2*h) ; ; Where H is the STEP parameter described above. The ; "automatic" one-sided derivative method will chose a ; direction for the finite difference which does not ; violate any constraints. The other methods do not ; perform this check. The two-sided method is in ; principle more precise, but requires twice as many ; function evaluations. Default: 0. ; ; .MPMAXSTEP - the maximum change to be made in the parameter ; value. During the fitting process, the parameter ; will never be changed by more than this value in ; one iteration. ; ; A value of 0 indicates no maximum. Default: 0. ; ; .TIED - a string expression which "ties" the parameter to other ; free or fixed parameters as an equality constraint. Any ; expression involving constants and the parameter array P ; are permitted. ; Example: if parameter 2 is always to be twice parameter ; 1 then use the following: parinfo[2].tied = '2 * P[1]'. ; Since they are totally constrained, tied parameters are ; considered to be fixed; no errors are computed for them. ; [ NOTE: the PARNAME can't be used in a TIED expression. ] ; ; .MPPRINT - if set to 1, then the default ITERPROC will print the ; parameter value. If set to 0, the parameter value ; will not be printed. This tag can be used to ; selectively print only a few parameter values out of ; many. Default: 1 (all parameters printed) ; ; .MPFORMAT - IDL format string to print the parameter within ; ITERPROC. Default: '(G20.6)' (An empty string will ; also use the default.) ; ; Future modifications to the PARINFO structure, if any, will involve ; adding structure tags beginning with the two letters "MP". ; Therefore programmers are urged to avoid using tags starting with ; "MP", but otherwise they are free to include their own fields ; within the PARINFO structure, which will be ignored by MPFIT. ; ; PARINFO Example: ; parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $ ; limits:[0.D,0]}, 5) ; parinfo[0].fixed = 1 ; parinfo[4].limited[0] = 1 ; parinfo[4].limits[0] = 50.D ; parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.] ; ; A total of 5 parameters, with starting values of 5.7, ; 2.2, 500, 1.5, and 2000 are given. The first parameter ; is fixed at a value of 5.7, and the last parameter is ; constrained to be above 50. ; ; COMPATIBILITY ; ; This function is designed to work with IDL 5.0 or greater. ; ; Because TIED parameters rely on the EXECUTE() function, they cannot ; be used with the free version of the IDL Virtual Machine. ; ; ; INPUTS: ; MYFUNCT - a string variable containing the name of an IDL function. ; This function computes the "model" Y values given the ; X values and model parameters, as desribed above. ; ; X - Array of independent variable values. ; ; Y - Array of "measured" dependent variable values. Y should have ; the same data type as X. The function MYFUNCT should map ; X->Y. ; NOTE: the following special cases apply: ; * if Y is NaN or Infinite, and the NAN keyword is ; set, then the corresponding data point is ignored ; ; ERR - Array of "measured" 1-sigma uncertainties. ERR should have ; the same data type as Y. ERR is ignored if the WEIGHTS ; keyword is specified. ; NOTE: the following special cases apply: ; * if ERR is zero, then the corresponding data point ; is ignored ; * if ERR is NaN or Infinite, and the NAN keyword is ; set, then the corresponding data point is ignored ; * if ERR is negative, then the absolute value of ; ERR is used. ; ; START_PARAMS - An array of starting values for each of the ; parameters of the model. The number of parameters ; should be fewer than the number of measurements. ; Also, the parameters should have the same data type ; as the measurements (double is preferred). ; ; This parameter is optional if the PARINFO keyword ; is used (see MPFIT). The PARINFO keyword provides ; a mechanism to fix or constrain individual ; parameters. If both START_PARAMS and PARINFO are ; passed, then the starting *value* is taken from ; START_PARAMS, but the *constraints* are taken from ; PARINFO. ; ; ; RETURNS: ; ; Returns the array of best-fit parameters. ; ; ; KEYWORD PARAMETERS: ; ; BESTNORM - the value of the summed squared residuals for the ; returned parameter values. ; ; BEST_FJAC - upon return, BEST_FJAC contains the Jacobian, or ; partial derivative, matrix for the best-fit model. ; The values are an array, ; ARRAY(N_ELEMENTS(DEVIATES),NFREE) where NFREE is the ; number of free parameters. This array is only ; computed if /CALC_FJAC is set, otherwise BEST_FJAC is ; undefined. ; ; The returned array is such that BEST_FJAC[I,J] is the ; partial derivative of the model with respect to ; parameter PARMS[PFREE_INDEX[J]]. ; ; BEST_RESID - upon return, an array of best-fit deviates, ; normalized by the weights or errors. ; ; COVAR - the covariance matrix for the set of parameters returned ; by MPFIT. The matrix is NxN where N is the number of ; parameters. The square root of the diagonal elements ; gives the formal 1-sigma statistical errors on the ; parameters IF errors were treated "properly" in MYFUNC. ; Parameter errors are also returned in PERROR. ; ; To compute the correlation matrix, PCOR, use this example: ; PCOR = COV * 0 ; FOR i = 0, n-1 DO FOR j = 0, n-1 DO $ ; PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j]) ; or equivalently, in vector notation, ; PCOR = COV / (PERROR # PERROR) ; ; If NOCOVAR is set or MPFIT terminated abnormally, then ; COVAR is set to a scalar with value !VALUES.D_NAN. ; ; CASH - when set, the fit statistic is changed to a derivative of ; the CASH statistic. The model function must be strictly ; positive. WARNING: this option is incomplete and untested. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). It also does not account for data points which ; are assigned zero weight, for example if : ; * WEIGHTS[i] EQ 0, or ; * ERR[i] EQ infinity, or ; * any of the values is "undefined" and /NAN is set. ; ; ERRMSG - a string error or warning message is returned. ; ; FTOL - a nonnegative input variable. Termination occurs when both ; the actual and predicted relative reductions in the sum of ; squares are at most FTOL (and STATUS is accordingly set to ; 1 or 3). Therefore, FTOL measures the relative error ; desired in the sum of squares. Default: 1D-10 ; ; FUNCTARGS - A structure which contains the parameters to be passed ; to the user-supplied function specified by MYFUNCT via ; the _EXTRA mechanism. This is the way you can pass ; additional data to your user-supplied function without ; using common blocks. ; ; By default, no extra parameters are passed to the ; user-supplied function. ; ; GTOL - a nonnegative input variable. Termination occurs when the ; cosine of the angle between fvec and any column of the ; jacobian is at most GTOL in absolute value (and STATUS is ; accordingly set to 4). Therefore, GTOL measures the ; orthogonality desired between the function vector and the ; columns of the jacobian. Default: 1D-10 ; ; ITERARGS - The keyword arguments to be passed to ITERPROC via the ; _EXTRA mechanism. This should be a structure, and is ; similar in operation to FUNCTARGS. ; Default: no arguments are passed. ; ; ITERPROC - The name of a procedure to be called upon each NPRINT ; iteration of the MPFIT routine. It should be declared ; in the following way: ; ; PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $ ; PARINFO=parinfo, QUIET=quiet, ... ; ; perform custom iteration update ; END ; ; ITERPROC must either accept all three keyword ; parameters (FUNCTARGS, PARINFO and QUIET), or at least ; accept them via the _EXTRA keyword. ; ; MYFUNCT is the user-supplied function to be minimized, ; P is the current set of model parameters, ITER is the ; iteration number, and FUNCTARGS are the arguments to be ; passed to MYFUNCT. FNORM should be the ; chi-squared value. QUIET is set when no textual output ; should be printed. See below for documentation of ; PARINFO. ; ; In implementation, ITERPROC can perform updates to the ; terminal or graphical user interface, to provide ; feedback while the fit proceeds. If the fit is to be ; stopped for any reason, then ITERPROC should set the ; common block variable ERROR_CODE to negative value (see ; MPFIT_ERROR common block below). In principle, ; ITERPROC should probably not modify the parameter ; values, because it may interfere with the algorithm's ; stability. In practice it is allowed. ; ; Default: an internal routine is used to print the ; parameter values. ; ; MAXITER - The maximum number of iterations to perform. If the ; number of calculation iterations exceeds MAXITER, then ; the STATUS value is set to 5 and MPFIT returns. ; ; If MAXITER EQ 0, then MPFIT does not iterate to adjust ; parameter values; however, the user function is evaluated ; and parameter errors/covariance/Jacobian are estimated ; before returning. ; Default: 200 iterations ; ; NAN - ignore infinite or NaN values in the Y, ERR or WEIGHTS ; parameters. These values will be treated as missing data. ; However, the fit will still halt with an error condition ; if the model function becomes infinite. ; ; NFEV - the number of MYFUNCT function evaluations performed. ; ; NFREE - the number of free parameters in the fit. This includes ; parameters which are not FIXED and not TIED, but it does ; include parameters which are pegged at LIMITS. ; ; NITER - the number of iterations completed. ; ; NOCOVAR - set this keyword to prevent the calculation of the ; covariance matrix before returning (see COVAR) ; ; NPEGGED - the number of free parameters which are pegged at a ; LIMIT. ; ; NPRINT - The frequency with which ITERPROC is called. A value of ; 1 indicates that ITERPROC is called with every iteration, ; while 2 indicates every other iteration, etc. Be aware ; that several Levenberg-Marquardt attempts can be made in ; a single iteration. Also, the ITERPROC is *always* ; called for the final iteration, regardless of the ; iteration number. ; Default value: 1 ; ; PARINFO - A one-dimensional array of structures. ; Provides a mechanism for more sophisticated constraints ; to be placed on parameter values. When PARINFO is not ; passed, then it is assumed that all parameters are free ; and unconstrained. Values in PARINFO are never ; modified during a call to MPFIT. ; ; See description above for the structure of PARINFO. ; ; Default value: all parameters are free and unconstrained. ; ; PERROR - The formal 1-sigma errors in each parameter, computed ; from the covariance matrix. If a parameter is held ; fixed, or if it touches a boundary, then the error is ; reported as zero. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. ; ; *If* you can assume that the true reduced chi-squared ; value is unity -- meaning that the fit is implicitly ; assumed to be of good quality -- then the estimated ; parameter uncertainties can be computed by scaling PERROR ; by the measured chi-squared value. ; ; DOF = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom ; PCERROR = PERROR * SQRT(BESTNORM / DOF) ; scaled uncertainties ; ; PFREE_INDEX - upon return, PFREE_INDEX contains an index array ; which indicates which parameter were allowed to ; vary. I.e. of all the parameters PARMS, only ; PARMS[PFREE_INDEX] were varied. ; ; QUERY - if set, then MPFIT() will return immediately with one of ; the following values: ; 1 - if MIN_VERSION is not set ; 1 - if MIN_VERSION is set and MPFIT satisfies the minimum ; 0 - if MIN_VERSION is set and MPFIT does not satisfy it ; Default: not set. ; ; QUIET - set this keyword when no textual output should be printed ; by MPFIT ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). It can have one of the ; following values: ; ; -18 a fatal execution error has occurred. More information ; may be available in the ERRMSG string. ; ; -16 a parameter or function value has become infinite or an ; undefined number. This is usually a consequence of ; numerical overflow in the user's model function, which ; must be avoided. ; ; -15 to -1 ; these are error codes that either MYFUNCT or ITERPROC ; may return to terminate the fitting process (see ; description of MPFIT_ERROR common below). If either ; MYFUNCT or ITERPROC set ERROR_CODE to a negative number, ; then that number is returned in STATUS. Values from -15 ; to -1 are reserved for the user functions and will not ; clash with MPFIT. ; ; 0 improper input parameters. ; ; 1 both actual and predicted relative reductions ; in the sum of squares are at most FTOL. ; ; 2 relative error between two consecutive iterates ; is at most XTOL ; ; 3 conditions for STATUS = 1 and STATUS = 2 both hold. ; ; 4 the cosine of the angle between fvec and any ; column of the jacobian is at most GTOL in ; absolute value. ; ; 5 the maximum number of iterations has been reached ; ; 6 FTOL is too small. no further reduction in ; the sum of squares is possible. ; ; 7 XTOL is too small. no further improvement in ; the approximate solution x is possible. ; ; 8 GTOL is too small. fvec is orthogonal to the ; columns of the jacobian to machine precision. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. If WEIGHTS is specified then the ERR ; parameter is ignored. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Y-MYFUNCT(X,P))^2 * ABS(WEIGHTS) ) ; ; Here are common values of WEIGHTS for standard weightings: ; ; 1D/ERR^2 - Normal weighting (ERR is the measurement error) ; 1D/Y - Poisson weighting (counting statistics) ; 1D - Unweighted ; ; NOTE: the following special cases apply: ; * if WEIGHTS is zero, then the corresponding data point ; is ignored ; * if WEIGHTS is NaN or Infinite, and the NAN keyword is ; set, then the corresponding data point is ignored ; * if WEIGHTS is negative, then the absolute value of ; WEIGHTS is used. ; ; XTOL - a nonnegative input variable. Termination occurs when the ; relative error between two consecutive iterates is at most ; XTOL (and STATUS is accordingly set to 2 or 3). Therefore, ; XTOL measures the relative error desired in the approximate ; solution. Default: 1D-10 ; ; YFIT - the best-fit model function, as returned by MYFUNCT. ; ; ; EXAMPLE: ; ; ; First, generate some synthetic data ; npts = 200 ; x = dindgen(npts) * 0.1 - 10. ; Independent variable ; yi = gauss1(x, [2.2D, 1.4, 3000.]) ; "Ideal" Y variable ; y = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise ; sy = sqrt(1000.D + y) ; Poisson errors ; ; ; Now fit a Gaussian to see how well we can recover ; p0 = [1.D, 1., 1000.] ; Initial guess (cent, width, area) ; p = mpfitfun('GAUSS1', x, y, sy, p0) ; Fit a function ; print, p ; ; Generates a synthetic data set with a Gaussian peak, and Poisson ; statistical uncertainty. Then the same function is fitted to the ; data (with different starting parameters) to see how close we can ; get. ; ; ; COMMON BLOCKS: ; ; COMMON MPFIT_ERROR, ERROR_CODE ; ; User routines may stop the fitting process at any time by ; setting an error condition. This condition may be set in either ; the user's model computation routine (MYFUNCT), or in the ; iteration procedure (ITERPROC). ; ; To stop the fitting, the above common block must be declared, ; and ERROR_CODE must be set to a negative number. After the user ; procedure or function returns, MPFIT checks the value of this ; common block variable and exits immediately if the error ; condition has been set. By default the value of ERROR_CODE is ; zero, indicating a successful function/procedure call. ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; Written, Apr-Jul 1998, CM ; Added PERROR keyword, 04 Aug 1998, CM ; Added COVAR keyword, 20 Aug 1998, CM ; Added ITER output keyword, 05 Oct 1998 ; D.L Windt, Bell Labs, windt@bell-labs.com; ; Added ability to return model function in YFIT, 09 Nov 1998 ; Analytical derivatives allowed via AUTODERIVATIVE keyword, 09 Nov 1998 ; Parameter values can be tied to others, 09 Nov 1998 ; Cosmetic documentation updates, 16 Apr 1999, CM ; More cosmetic documentation updates, 14 May 1999, CM ; Made sure to update STATUS, 25 Sep 1999, CM ; Added WEIGHTS keyword, 25 Sep 1999, CM ; Changed from handles to common blocks, 25 Sep 1999, CM ; - commons seem much cleaner and more logical in this case. ; Alphabetized documented keywords, 02 Oct 1999, CM ; Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM ; Corrected EXAMPLE (offset of 1000), 30 Oct 1999, CM ; Check to be sure that X and Y are present, 02 Nov 1999, CM ; Documented PERROR for unweighted fits, 03 Nov 1999, CM ; Changed to ERROR_CODE for error condition, 28 Jan 2000, CM ; Corrected errors in EXAMPLE, 26 Mar 2000, CM ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Propagated improvements from MPFIT, 17 Dec 2000, CM ; Added CASH statistic, 10 Jan 2001 ; Added NFREE and NPEGGED keywords, 11 Sep 2002, CM ; Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002 ; Add DOF keyword to return degrees of freedom, CM, 23 June 2003 ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 ; Oct 2006 ; Add NAN keyword, to ignore non-finite data values, 28 Oct 2006, CM ; Clarify documentation on user-function, derivatives, and PARINFO, ; 27 May 2007 ; Fix bug in handling of explicit derivatives with errors/weights ; (the weights were not being applied), CM, 03 Sep 2007 ; Add COMPATIBILITY section, CM, 13 Dec 2007 ; Add documentation about NAN behavior, CM, 30 Mar 2009 ; Add keywords BEST_RESIDS, CALC_FJAC, BEST_FJAC, PFREE_INDEX; ; update some documentation that had become stale, CM, 2010-10-28 ; Documentation corrections, CM, 2011-08-26 ; Additional documentation about explicit derivatives, CM, 2012-07-23 ; ; $Id: mpfitfun.pro,v 1.19 2012/09/27 23:59:31 cmarkwar Exp $ ;- ; Copyright (C) 1997-2002, 2003, 2006, 2007, 2009, 2010, 2011, 2012, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- FORWARD_FUNCTION mpfitfun_eval, mpfitfun, mpfit ; This is the call-back function for MPFIT. It evaluates the ; function, subtracts the data, and returns the residuals. function mpfitfun_eval, p, dp, _EXTRA=extra COMPILE_OPT strictarr common mpfitfun_common, fcn, x, y, err, wts, f, fcnargs ;; Save the original DP matrix for later use if n_params() GT 1 then if n_elements(dp) GT 0 then dp0 = dp ;; The function is evaluated here. There are four choices, ;; depending on whether (a) FUNCTARGS was passed to MPFITFUN, which ;; is passed to this function as "hf"; or (b) the derivative ;; parameter "dp" is passed, meaning that derivatives should be ;; calculated analytically by the function itself. if n_elements(fcnargs) GT 0 then begin if n_params() GT 1 then f = call_function(fcn, x, p, dp, _EXTRA=fcnargs)$ else f = call_function(fcn, x, p, _EXTRA=fcnargs) endif else begin if n_params() GT 1 then f = call_function(fcn, x, p, dp) $ else f = call_function(fcn, x, p) endelse np = n_elements(p) nf = n_elements(f) ;; Compute the deviates, applying either errors or weights if n_elements(wts) GT 0 then begin result = (y-f)*wts if n_elements(dp0) GT 0 AND n_elements(dp) EQ np*nf then begin for j = 0L, np-1 do dp[j*nf] = dp[j*nf:j*nf+nf-1] * wts endif endif else if n_elements(err) GT 0 then begin result = (y-f)/err if n_elements(dp0) GT 0 AND n_elements(dp) EQ np*nf then begin for j = 0L, np-1 do dp[j*nf] = dp[j*nf:j*nf+nf-1] / err endif endif else begin result = (y-f) endelse ;; Make sure the returned result is one-dimensional. result = reform(result, n_elements(result), /overwrite) return, result end ;; Implement residual and gradient scaling according to the ;; prescription of Cash (ApJ, 228, 939) pro mpfitfun_cash, resid, dresid COMPILE_OPT strictarr common mpfitfun_common, fcn, x, y, err, wts, f, fcnargs sz = size(dresid) m = sz[1] n = sz[2] ;; Do rudimentary dimensions checks, so we don't do something stupid if n_elements(y) NE m OR n_elements(f) NE m OR n_elements(resid) NE m then begin DIM_ERROR: message, 'ERROR: dimensions of Y, F, RESID or DRESID are not consistent' endif ;; Scale gradient by sqrt(y)/f gfact = temporary(dresid) * rebin(reform(sqrt(y)/f,m,1),m,n) dresid = reform(dresid, m, n, /overwrite) ;; Scale residuals by 1/sqrt(y) resid = temporary(resid)/sqrt(y) return end function mpfitfun, fcn, x, y, err, p, WEIGHTS=wts, FUNCTARGS=fa, $ BESTNORM=bestnorm, nfev=nfev, STATUS=status, $ best_resid=best_resid, pfree_index=ifree, $ calc_fjac=calc_fjac, best_fjac=best_fjac, $ parinfo=parinfo, query=query, CASH=cash, $ covar=covar, perror=perror, yfit=yfit, $ niter=niter, nfree=nfree, npegged=npegged, dof=dof, $ quiet=quiet, ERRMSG=errmsg, NAN=NAN, _EXTRA=extra COMPILE_OPT strictarr status = 0L errmsg = '' ;; Detect MPFIT and crash if it was not found catch, catcherror if catcherror NE 0 then begin MPFIT_NOTFOUND: catch, /cancel message, 'ERROR: the required function MPFIT must be in your IDL path', /info return, !values.d_nan endif if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND catch, /cancel if keyword_set(query) then return, 1 if n_params() EQ 0 then begin message, "USAGE: PARMS = MPFITFUN('MYFUNCT', X, Y, ERR, "+ $ "START_PARAMS, ... )", /info return, !values.d_nan endif if n_elements(x) EQ 0 OR n_elements(y) EQ 0 then begin message, 'ERROR: X and Y must be defined', /info return, !values.d_nan endif if n_elements(err) GT 0 OR n_elements(wts) GT 0 AND keyword_set(cash) then begin message, 'ERROR: WEIGHTS or ERROR cannot be specified with CASH', /info return, !values.d_nan endif if keyword_set(cash) then begin scalfcn = 'mpfitfun_cash' endif ;; Use common block to pass data back and forth common mpfitfun_common, fc, xc, yc, ec, wc, mc, ac fc = fcn & xc = x & yc = y & mc = 0L ;; These optional parameters must be undefined first ac = 0 & dummy = size(temporary(ac)) ec = 0 & dummy = size(temporary(ec)) wc = 0 & dummy = size(temporary(wc)) ;; FUNCTARGS if n_elements(fa) GT 0 then ac = fa ;; WEIGHTS or ERROR if n_elements(wts) GT 0 then begin wc = sqrt(abs(wts)) endif else if n_elements(err) GT 0 then begin wh = where(err EQ 0, ct) if ct GT 0 then begin errmsg = 'ERROR: ERROR value must not be zero. Use WEIGHTS instead.' message, errmsg, /info return, !values.d_nan endif ;; Appropriate weight for gaussian errors wc = 1/abs(err) endif ;; Check for weights/errors which do not match the dimension ;; of the data points if n_elements(wc) GT 0 AND $ n_elements(wc) NE 1 AND $ n_elements(wc) NE n_elements(yc) then begin errmsg = 'ERROR: ERROR/WEIGHTS must either be a scalar or match the number of Y values' message, errmsg, /info return, !values.d_nan endif ;; If the weights/errors are a scalar value, and not finite, then ;; the fit will surely fail if n_elements(wc) EQ 1 then begin if finite(wc[0]) EQ 0 then begin errmsg = 'ERROR: the supplied scalar WEIGHT/ERROR value was not finite' message, errmsg, /info return, !values.d_nan endif endif ;; Handle the cases of non-finite data points or weights if keyword_set(nan) then begin ;; Non-finite data points wh = where(finite(yc) EQ 0, ct) if ct GT 0 then begin yc[wh] = 0 ;; Careful: handle case when weights were a scalar... ;; ... promote to a vector if n_elements(wc) EQ 1 then wc = replicate(wc[0], n_elements(yc)) wc[wh] = 0 endif ;; Non-finite weights wh = where(finite(wc) EQ 0, ct) if ct GT 0 then wc[wh] = 0 endif result = mpfit('mpfitfun_eval', p, SCALE_FCN=scalfcn, $ parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$ covar=covar, perror=perror, $ best_resid=best_resid, pfree_index=ifree, $ calc_fjac=calc_fjac, best_fjac=best_fjac, $ niter=niter, nfree=nfree, npegged=npegged, dof=dof, $ ERRMSG=errmsg, quiet=quiet, _EXTRA=extra) ;; Retrieve the fit value yfit = temporary(mc) ;; Rescale the Jacobian according to parameter uncertainties if keyword_set(calc_fjac) AND nfree GT 0 AND status GT 0 then begin ec = 1/wc ;; Per-data-point errors (could be INF or NAN!) for i = 0, nfree-1 do best_fjac[*,i] = - best_fjac[*,i] * ec endif ;; Some cleanup xc = 0 & yc = 0 & wc = 0 & ec = 0 & mc = 0 & ac = 0 ;; Print error message if there is one. if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /info return, result end mpfit2dfun.pro0000644000244500024450000007056612717414567013204 0ustar craigmcraigm;+ ; NAME: ; MPFIT2DFUN ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Perform Levenberg-Marquardt least-squares fit to a 2-D IDL function ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; parms = MPFIT2DFUN(MYFUNCT, X, Y, Z, ERR, start_parms, ...) ; ; DESCRIPTION: ; ; MPFIT2DFUN fits a user-supplied model -- in the form of an IDL ; function -- to a set of user-supplied data. MPFIT2DFUN calls ; MPFIT, the MINPACK-1 least-squares minimizer, to do the main ; work. MPFIT2DFUN is a specialized version for two-dimensional ; data. ; ; Given the data and their uncertainties, MPFIT2DFUN finds the best set ; of model parameters which match the data (in a least-squares ; sense) and returns them in an array. ; ; The user must supply the following items: ; - Two arrays of independent variable values ("X", "Y"). ; - An array of "measured" *dependent* variable values ("Z"). ; - An array of "measured" 1-sigma uncertainty values ("ERR"). ; - The name of an IDL function which computes Z given (X,Y) ("MYFUNCT"). ; - Starting guesses for all of the parameters ("START_PARAMS"). ; ; There are very few restrictions placed on X, Y, Z, or MYFUNCT. ; Simply put, MYFUNCT must map the (X,Y) values into Z values given ; the model parameters. The (X,Y) values are usually the independent ; X and Y coordinate positions in the two dimensional plane, but need ; not be. ; ; MPFIT2DFUN carefully avoids passing large arrays where possible to ; improve performance. ; ; See below for an example of usage. ; ; USER FUNCTION ; ; The user must define a function which returns the model value. For ; applications which use finite-difference derivatives -- the default ; -- the user function should be declared in the following way: ; ; FUNCTION MYFUNCT, X, Y, P ; ; The independent variables are X and Y ; ; Parameter values are passed in "P" ; ZMOD = ... computed model values at (X,Y) ... ; return, ZMOD ; END ; ; The returned array YMOD must have the same dimensions and type as ; the "measured" Z values. ; ; User functions may also indicate a fatal error condition ; using the ERROR_CODE common block variable, as described ; below under the MPFIT_ERROR common block definition. ; ; See the discussion under "ANALYTIC DERIVATIVES" and AUTODERIVATIVE ; in MPFIT.PRO if you wish to compute the derivatives for yourself. ; AUTODERIVATIVE is accepted and passed directly to MPFIT. The user ; function must accept one additional parameter, DP, which contains ; the derivative of the user function with respect to each parameter ; at each data point, as described in MPFIT.PRO. ; ; CREATING APPROPRIATELY DIMENSIONED INDEPENDENT VARIABLES ; ; The user must supply appropriate independent variables to ; MPFIT2DFUN. For image fitting applications, this variable should ; be two-dimensional *arrays* describing the X and Y positions of ; every *pixel*. [ Thus any two dimensional sampling is permitted, ; including irregular sampling. ] ; ; If the sampling is regular, then the x coordinates are the same for ; each row, and the y coordinates are the same for each column. Call ; the x-row and y-column coordinates XR and YC respectively. You can ; then compute X and Y as follows: ; ; X = XR # (YC*0 + 1) eqn. 1 ; Y = (XR*0 + 1) # YC eqn. 2 ; ; For example, if XR and YC have the following values: ; ; XR = [ 1, 2, 3, 4, 5,] ;; X positions of one row of pixels ; YC = [ 15,16,17 ] ;; Y positions of one column of ; pixels ; ; Then using equations 1 and 2 above will give these values to X and ; Y: ; ; X : 1 2 3 4 5 ;; X positions of all pixels ; 1 2 3 4 5 ; 1 2 3 4 5 ; ; Y : 15 15 15 15 15 ;; Y positions of all pixels ; 16 16 16 16 16 ; 17 17 17 17 17 ; ; Using the above technique is suggested, but *not* required. You ; can do anything you wish with the X and Y values. This technique ; only makes it easier to compute your model function values. ; ; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD ; ; The behavior of MPFIT can be modified with respect to each ; parameter to be fitted. A parameter value can be fixed; simple ; boundary constraints can be imposed; limitations on the parameter ; changes can be imposed; properties of the automatic derivative can ; be modified; and parameters can be tied to one another. ; ; These properties are governed by the PARINFO structure, which is ; passed as a keyword parameter to MPFIT. ; ; PARINFO should be an array of structures, one for each parameter. ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; .VALUE - the starting parameter value (but see the START_PARAMS ; parameter for more information). ; ; .FIXED - a boolean value, whether the parameter is to be held ; fixed or not. Fixed parameters are not varied by ; MPFIT, but are passed on to MYFUNCT for evaluation. ; ; .LIMITED - a two-element boolean array. If the first/second ; element is set, then the parameter is bounded on the ; lower/upper side. A parameter can be bounded on both ; sides. Both LIMITED and LIMITS must be given ; together. ; ; .LIMITS - a two-element float or double array. Gives the ; parameter limits on the lower and upper sides, ; respectively. Zero, one or two of these values can be ; set, depending on the values of LIMITED. Both LIMITED ; and LIMITS must be given together. ; ; .PARNAME - a string, giving the name of the parameter. The ; fitting code of MPFIT does not use this tag in any ; way. However, the default ITERPROC will print the ; parameter name if available. ; ; .STEP - the step size to be used in calculating the numerical ; derivatives. If set to zero, then the step size is ; computed automatically. Ignored when AUTODERIVATIVE=0. ; This value is superceded by the RELSTEP value. ; ; .RELSTEP - the *relative* step size to be used in calculating ; the numerical derivatives. This number is the ; fractional size of the step, compared to the ; parameter value. This value supercedes the STEP ; setting. If the parameter is zero, then a default ; step size is chosen. ; ; .MPSIDE - the sidedness of the finite difference when computing ; numerical derivatives. This field can take four ; values: ; ; 0 - one-sided derivative computed automatically ; 1 - one-sided derivative (f(x+h) - f(x) )/h ; -1 - one-sided derivative (f(x) - f(x-h))/h ; 2 - two-sided derivative (f(x+h) - f(x-h))/(2*h) ; ; Where H is the STEP parameter described above. The ; "automatic" one-sided derivative method will chose a ; direction for the finite difference which does not ; violate any constraints. The other methods do not ; perform this check. The two-sided method is in ; principle more precise, but requires twice as many ; function evaluations. Default: 0. ; ; .MPMINSTEP - the minimum change to be made in the parameter ; value. During the fitting process, the parameter ; will be changed by multiples of this value. The ; actual step is computed as: ; ; DELTA1 = MPMINSTEP*ROUND(DELTA0/MPMINSTEP) ; ; where DELTA0 and DELTA1 are the estimated parameter ; changes before and after this constraint is ; applied. Note that this constraint should be used ; with care since it may cause non-converging, ; oscillating solutions. ; ; A value of 0 indicates no minimum. Default: 0. ; ; .MPMAXSTEP - the maximum change to be made in the parameter ; value. During the fitting process, the parameter ; will never be changed by more than this value. ; ; A value of 0 indicates no maximum. Default: 0. ; ; .TIED - a string expression which "ties" the parameter to other ; free or fixed parameters. Any expression involving ; constants and the parameter array P are permitted. ; Example: if parameter 2 is always to be twice parameter ; 1 then use the following: parinfo[2].tied = '2 * P[1]'. ; Since they are totally constrained, tied parameters are ; considered to be fixed; no errors are computed for them. ; [ NOTE: the PARNAME can't be used in expressions. ] ; ; Future modifications to the PARINFO structure, if any, will involve ; adding structure tags beginning with the two letters "MP". ; Therefore programmers are urged to avoid using tags starting with ; the same letters; otherwise they are free to include their own ; fields within the PARINFO structure, and they will be ignored. ; ; PARINFO Example: ; parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $ ; limits:[0.D,0]}, 5) ; parinfo[0].fixed = 1 ; parinfo[4].limited(0) = 1 ; parinfo[4].limits(0) = 50.D ; parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.] ; ; A total of 5 parameters, with starting values of 5.7, ; 2.2, 500, 1.5, and 2000 are given. The first parameter ; is fixed at a value of 5.7, and the last parameter is ; constrained to be above 50. ; ; ; COMPATIBILITY ; ; This function is designed to work with IDL 5.0 or greater. ; ; Because TIED parameters rely on the EXECUTE() function, they cannot ; be used with the free version of the IDL Virtual Machine. ; ; ; INPUTS: ; MYFUNCT - a string variable containing the name of an IDL ; function. This function computes the "model" Z values ; given the X,Y values and model parameters, as described above. ; ; X - Array of "X" independent variable values, as described above. ; These values are passed directly to the fitting function ; unmodified. ; ; Y - Array of "Y" independent variable values, as described ; above. X and Y should have the same data type. ; ; Z - Array of "measured" dependent variable values. Z should have ; the same data type as X and Y. The function MYFUNCT should ; map (X,Y)->Z. ; ; ERR - Array of "measured" 1-sigma uncertainties. ERR should have ; the same data type as Z. ERR is ignored if the WEIGHTS ; keyword is specified. ; ; START_PARAMS - An array of starting values for each of the ; parameters of the model. The number of parameters ; should be fewer than the number of measurements. ; Also, the parameters should have the same data type ; as the measurements (double is preferred). ; ; This parameter is optional if the PARINFO keyword ; is used (see MPFIT). The PARINFO keyword provides ; a mechanism to fix or constrain individual ; parameters. If both START_PARAMS and PARINFO are ; passed, then the starting *value* is taken from ; START_PARAMS, but the *constraints* are taken from ; PARINFO. ; ; RETURNS: ; ; Returns the array of best-fit parameters. ; ; KEYWORD PARAMETERS: ; ; BESTNORM - the value of the summed, squared, weighted residuals ; for the returned parameter values, i.e. the chi-square value. ; ; BEST_FJAC - upon return, BEST_FJAC contains the Jacobian, or ; partial derivative, matrix for the best-fit model. ; The values are an array, ; ARRAY(N_ELEMENTS(DEVIATES),NFREE) where NFREE is the ; number of free parameters. This array is only ; computed if /CALC_FJAC is set, otherwise BEST_FJAC is ; undefined. ; ; The returned array is such that BEST_FJAC[I,J] is the ; partial derivative of the model with respect to ; parameter PARMS[PFREE_INDEX[J]]. ; ; BEST_RESID - upon return, an array of best-fit deviates, ; normalized by the weights or errors. ; ; COVAR - the covariance matrix for the set of parameters returned ; by MPFIT. The matrix is NxN where N is the number of ; parameters. The square root of the diagonal elements ; gives the formal 1-sigma statistical errors on the ; parameters IF errors were treated "properly" in MYFUNC. ; Parameter errors are also returned in PERROR. ; ; To compute the correlation matrix, PCOR, use this example: ; PCOR = COV * 0 ; FOR i = 0, n-1 DO FOR j = 0, n-1 DO $ ; PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j]) ; or equivalently, in vector notation, ; PCOR = COV / (PERROR # PERROR) ; ; If NOCOVAR is set or MPFIT terminated abnormally, then ; COVAR is set to a scalar with value !VALUES.D_NAN. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). ; ; ERRMSG - a string error or warning message is returned. ; ; FTOL - a nonnegative input variable. Termination occurs when both ; the actual and predicted relative reductions in the sum of ; squares are at most FTOL (and STATUS is accordingly set to ; 1 or 3). Therefore, FTOL measures the relative error ; desired in the sum of squares. Default: 1D-10 ; ; FUNCTARGS - A structure which contains the parameters to be passed ; to the user-supplied function specified by MYFUNCT via ; the _EXTRA mechanism. This is the way you can pass ; additional data to your user-supplied function without ; using common blocks. ; ; By default, no extra parameters are passed to the ; user-supplied function. ; ; GTOL - a nonnegative input variable. Termination occurs when the ; cosine of the angle between fvec and any column of the ; jacobian is at most GTOL in absolute value (and STATUS is ; accordingly set to 4). Therefore, GTOL measures the ; orthogonality desired between the function vector and the ; columns of the jacobian. Default: 1D-10 ; ; ITERARGS - The keyword arguments to be passed to ITERPROC via the ; _EXTRA mechanism. This should be a structure, and is ; similar in operation to FUNCTARGS. ; Default: no arguments are passed. ; ; ITERPROC - The name of a procedure to be called upon each NPRINT ; iteration of the MPFIT routine. It should be declared ; in the following way: ; ; PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $ ; PARINFO=parinfo, QUIET=quiet, ... ; ; perform custom iteration update ; END ; ; ITERPROC must either accept all three keyword ; parameters (FUNCTARGS, PARINFO and QUIET), or at least ; accept them via the _EXTRA keyword. ; ; MYFUNCT is the user-supplied function to be minimized, ; P is the current set of model parameters, ITER is the ; iteration number, and FUNCTARGS are the arguments to be ; passed to MYFUNCT. FNORM should be the ; chi-squared value. QUIET is set when no textual output ; should be printed. See below for documentation of ; PARINFO. ; ; In implementation, ITERPROC can perform updates to the ; terminal or graphical user interface, to provide ; feedback while the fit proceeds. If the fit is to be ; stopped for any reason, then ITERPROC should set the ; common block variable ERROR_CODE to negative value (see ; MPFIT_ERROR common block below). In principle, ; ITERPROC should probably not modify the parameter ; values, because it may interfere with the algorithm's ; stability. In practice it is allowed. ; ; Default: an internal routine is used to print the ; parameter values. ; ; MAXITER - The maximum number of iterations to perform. If the ; number is exceeded, then the STATUS value is set to 5 ; and MPFIT returns. ; Default: 200 iterations ; ; NFEV - the number of MYFUNCT function evaluations performed. ; ; NITER - the number of iterations completed. ; ; NOCOVAR - set this keyword to prevent the calculation of the ; covariance matrix before returning (see COVAR) ; ; NPRINT - The frequency with which ITERPROC is called. A value of ; 1 indicates that ITERPROC is called with every iteration, ; while 2 indicates every other iteration, etc. Note that ; several Levenberg-Marquardt attempts can be made in a ; single iteration. ; Default value: 1 ; ; PARINFO - Provides a mechanism for more sophisticated constraints ; to be placed on parameter values. When PARINFO is not ; passed, then it is assumed that all parameters are free ; and unconstrained. Values in PARINFO are never ; modified during a call to MPFIT. ; ; See description above for the structure of PARINFO. ; ; Default value: all parameters are free and unconstrained. ; ; PERROR - The formal 1-sigma errors in each parameter, computed ; from the covariance matrix. If a parameter is held ; fixed, or if it touches a boundary, then the error is ; reported as zero. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. *If* you can assume that the true reduced ; chi-squared value is unity -- meaning that the fit is ; implicitly assumed to be of good quality -- then the ; estimated parameter uncertainties can be computed by ; scaling PERROR by the measured chi-squared value. ; ; DOF = N_ELEMENTS(Z) - N_ELEMENTS(PARMS) ; deg of freedom ; PCERROR = PERROR * SQRT(BESTNORM / DOF) ; scaled uncertainties ; ; PFREE_INDEX - upon return, PFREE_INDEX contains an index array ; which indicates which parameter were allowed to ; vary. I.e. of all the parameters PARMS, only ; PARMS[PFREE_INDEX] were varied. ; ; QUIET - set this keyword when no textual output should be printed ; by MPFIT ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). It can have one of the ; following values: ; ; 0 improper input parameters. ; ; 1 both actual and predicted relative reductions ; in the sum of squares are at most FTOL. ; ; 2 relative error between two consecutive iterates ; is at most XTOL ; ; 3 conditions for STATUS = 1 and STATUS = 2 both hold. ; ; 4 the cosine of the angle between fvec and any ; column of the jacobian is at most GTOL in ; absolute value. ; ; 5 the maximum number of iterations has been reached ; ; 6 FTOL is too small. no further reduction in ; the sum of squares is possible. ; ; 7 XTOL is too small. no further improvement in ; the approximate solution x is possible. ; ; 8 GTOL is too small. fvec is orthogonal to the ; columns of the jacobian to machine precision. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. If WEIGHTS is specified then the ERR ; parameter is ignored. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Z-MYFUNCT(X,Y,P))^2 * ABS(WEIGHTS) ) ; ; Here are common values of WEIGHTS: ; ; 1D/ERR^2 - Normal weighting (ERR is the measurement error) ; 1D/Z - Poisson weighting (counting statistics) ; 1D - Unweighted ; ; XTOL - a nonnegative input variable. Termination occurs when the ; relative error between two consecutive iterates is at most ; XTOL (and STATUS is accordingly set to 2 or 3). Therefore, ; XTOL measures the relative error desired in the approximate ; solution. Default: 1D-10 ; ; YFIT - the best-fit model function, as returned by MYFUNCT. ; ; EXAMPLE: ; ; p = [2.2D, -0.7D, 1.4D, 3000.D] ; x = (dindgen(200)*0.1 - 10.) # (dblarr(200) + 1) ; y = (dblarr(200) + 1) # (dindgen(200)*0.1 - 10.) ; zi = gauss2(x, y, p) ; sz = sqrt(zi>1) ; z = zi + randomn(seed, 200, 200) * sz ; ; p0 = [0D, 0D, 1D, 10D] ; p = mpfit2dfun('GAUSS2', x, y, z, sz, p0) ; ; Generates a synthetic data set with a Gaussian peak, and Poisson ; statistical uncertainty. Then the same function (but different ; starting parameters) is fitted to the data to see how close we can ; get. ; ; It is especially worthy to notice that the X and Y values are ; created as full images, so that a coordinate is attached to each ; pixel independently. This is the format that GAUSS2 accepts, and ; the easiest for you to use in your own functions. ; ; ; COMMON BLOCKS: ; ; COMMON MPFIT_ERROR, ERROR_CODE ; ; User routines may stop the fitting process at any time by ; setting an error condition. This condition may be set in either ; the user's model computation routine (MYFUNCT), or in the ; iteration procedure (ITERPROC). ; ; To stop the fitting, the above common block must be declared, ; and ERROR_CODE must be set to a negative number. After the user ; procedure or function returns, MPFIT checks the value of this ; common block variable and exits immediately if the error ; condition has been set. By default the value of ERROR_CODE is ; zero, indicating a successful function/procedure call. ; ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; Written, transformed from MPFITFUN, 26 Sep 1999, CM ; Alphabetized documented keywords, 02 Oct 1999, CM ; Added example, 02 Oct 1999, CM ; Tried to clarify definitions of X and Y, 29 Oct 1999, CM ; Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM ; Check to be sure that X, Y and Z are present, 02 Nov 1999, CM ; Documented PERROR for unweighted fits, 03 Nov 1999, CM ; Changed to ERROR_CODE for error condition, 28 Jan 2000, CM ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Propagated improvements from MPFIT, 17 Dec 2000, CM ; Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002 ; Add DOF keyword to return degrees of freedom, CM, 23 June 2003 ; Minor documentation adjustment, 03 Feb 2004, CM ; Fix the example to prevent zero errorbars, 28 Mar 2005, CM ; Defend against users supplying strangely dimensioned X and Y, 29 ; Jun 2005, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Add COMPATIBILITY section, CM, 13 Dec 2007 ; Add keywords BEST_RESIDS, CALC_FJAC, BEST_FJAC, PFREE_INDEX; ; update some documentation that had become stale, CM, 2010-10-28 ; Better documentation for STATUS, CM, 2016-04-29 ; ; $Id: mpfit2dfun.pro,v 1.13 2016/05/19 16:08:49 cmarkwar Exp $ ;- ; Copyright (C) 1997-2000, 2002, 2003, 2004, 2005, 2013, 2016 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- FORWARD_FUNCTION mpfit2dfun_eval, mpfit2dfun, mpfit ; This is the call-back function for MPFIT. It evaluates the ; function, subtracts the data, and returns the residuals. function mpfit2dfun_eval, p, dp, _EXTRA=extra COMPILE_OPT strictarr common mpfit2dfun_common, fcn, x, y, z, err, wts, f, fcnargs ;; The function is evaluated here. There are four choices, ;; depending on whether (a) FUNCTARGS was passed to MPFIT2DFUN, which ;; is passed to this function as "hf"; or (b) the derivative ;; parameter "dp" is passed, meaning that derivatives should be ;; calculated analytically by the function itself. if n_elements(fcnargs) GT 0 then begin if n_params() GT 1 then f = call_function(fcn,x,y,p, dp, _EXTRA=fcnargs)$ else f = call_function(fcn,x,y,p, _EXTRA=fcnargs) endif else begin if n_params() GT 1 then f = call_function(fcn,x,y,p, dp) $ else f = call_function(fcn,x,y,p) endelse ;; Compute the deviates, applying either errors or weights if n_elements(err) GT 0 then begin result = (z-f)/err endif else if n_elements(wts) GT 0 then begin result = (z-f)*wts endif else begin result = (z-f) endelse ;; Make sure the returned result is one-dimensional. result = reform(result, n_elements(result), /overwrite) return, result end function mpfit2dfun, fcn, x, y, z, err, p, WEIGHTS=wts, FUNCTARGS=fa, $ BESTNORM=bestnorm, nfev=nfev, STATUS=status, $ best_resid=best_resid, pfree_index=ifree, $ calc_fjac=calc_fjac, best_fjac=best_fjac, $ parinfo=parinfo, query=query, $ npegged=npegged, nfree=nfree, dof=dof, $ covar=covar, perror=perror, niter=iter, yfit=yfit, $ quiet=quiet, ERRMSG=errmsg, _EXTRA=extra COMPILE_OPT strictarr status = 0L errmsg = '' ;; Detect MPFIT and crash if it was not found catch, catcherror if catcherror NE 0 then begin MPFIT_NOTFOUND: catch, /cancel message, 'ERROR: the required function MPFIT must be in your IDL path', /info return, !values.d_nan endif if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND catch, /cancel if keyword_set(query) then return, 1 if n_params() EQ 0 then begin message, "USAGE: PARMS = MPFIT2DFUN('MYFUNCT', X, Y, ERR, "+ $ "START_PARAMS, ... )", /info return, !values.d_nan endif if n_elements(x) EQ 0 OR n_elements(y) EQ 0 OR n_elements(z) EQ 0 then begin message, 'ERROR: X, Y and Z must be defined', /info return, !values.d_nan endif ;; Use common block to pass data back and forth common mpfit2dfun_common, fc, xc, yc, zc, ec, wc, mc, ac fc = fcn & xc = x & yc = y & zc = z & mc = 0L ;; These optional parameters must be undefined first ac = 0 & dummy = size(temporary(ac)) ec = 0 & dummy = size(temporary(ec)) wc = 0 & dummy = size(temporary(wc)) if n_elements(fa) GT 0 then ac = fa if n_elements(wts) GT 0 then begin wc = sqrt(abs(wts)) endif else if n_elements(err) GT 0 then begin wh = where(err EQ 0, ct) if ct GT 0 then begin message, 'ERROR: ERROR value must not be zero. Use WEIGHTS.', $ /info return, !values.d_nan endif ec = err endif result = mpfit('mpfit2dfun_eval', p, $ parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$ covar=covar, perror=perror, niter=iter, $ best_resid=best_resid, pfree_index=ifree, $ calc_fjac=calc_fjac, best_fjac=best_fjac, $ nfree=nfree, npegged=npegged, dof=dof, $ ERRMSG=errmsg, quiet=quiet, _EXTRA=extra) ;; Retrieve the fit value yfit = temporary(mc) ;; Some cleanup xc = 0 & yc = 0 & zc = 0 & wc = 0 & ec = 0 & mc = 0 & ac = 0 ;; Print error message if there is one. if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /info return, result end mpcurvefit.pro0000644000244500024450000006371012717414566013302 0ustar craigmcraigm;+ ; NAME: ; MPCURVEFIT ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Perform Levenberg-Marquardt least-squares fit (replaces CURVEFIT) ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; YFIT = MPCURVEFIT(X, Y, WEIGHTS, P, [SIGMA,] FUNCTION_NAME=FUNC, ; ITER=iter, ITMAX=itmax, ; CHISQ=chisq, NFREE=nfree, DOF=dof, ; NFEV=nfev, COVAR=covar, [/NOCOVAR, ] [/NODERIVATIVE, ] ; FUNCTARGS=functargs, PARINFO=parinfo, ; FTOL=ftol, XTOL=xtol, GTOL=gtol, TOL=tol, ; ITERPROC=iterproc, ITERARGS=iterargs, ; NPRINT=nprint, QUIET=quiet, ; ERRMSG=errmsg, STATUS=status) ; ; DESCRIPTION: ; ; MPCURVEFIT fits a user-supplied model -- in the form of an IDL ; function -- to a set of user-supplied data. MPCURVEFIT calls ; MPFIT, the MINPACK-1 least-squares minimizer, to do the main ; work. ; ; Given the data and their uncertainties, MPCURVEFIT finds the best ; set of model parameters which match the data (in a least-squares ; sense) and returns them in the parameter P. ; ; MPCURVEFIT returns the best fit function. ; ; The user must supply the following items: ; - An array of independent variable values ("X"). ; - An array of "measured" *dependent* variable values ("Y"). ; - An array of weighting values ("WEIGHTS"). ; - The name of an IDL function which computes Y given X ("FUNC"). ; - Starting guesses for all of the parameters ("P"). ; ; There are very few restrictions placed on X, Y or FUNCT. Simply ; put, FUNCT must map the "X" values into "Y" values given the ; model parameters. The "X" values may represent any independent ; variable (not just Cartesian X), and indeed may be multidimensional ; themselves. For example, in the application of image fitting, X ; may be a 2xN array of image positions. ; ; MPCURVEFIT carefully avoids passing large arrays where possible to ; improve performance. ; ; See below for an example of usage. ; ; USER FUNCTION ; ; The user must define a function which returns the model value. For ; applications which use finite-difference derivatives -- the default ; -- the user function should be declared in the following way: ; ; ; MYFUNCT - example user function ; ; X - input independent variable (vector same size as data) ; ; P - input parameter values (N-element array) ; ; YMOD - upon return, user function values ; ; DP - upon return, the user function must return ; ; an ARRAY(M,N) of derivatives in this parameter ; ; ; PRO MYFUNCT, x, p, ymod, dp ; ymod = F(x, p) ;; Model function ; ; if n_params() GE 4 then begin ; ; Create derivative and compute derivative array ; dp = make_array(n_elements(x), n_elements(p), value=x[0]*0) ; ; ; Compute derivative if requested by caller ; for i = 0, n_elements(p)-1 do dp(*,i) = FGRAD(x, p, i) ; endif ; END ; ; where FGRAD(x, p, i) is a model function which computes the ; derivative of the model F(x,p) with respect to parameter P(i) at X. ; The returned array YMOD must have the same dimensions and type as ; the "measured" Y values. The returned array DP[i,j] is the ; derivative of the ith function value with respect to the jth ; parameter. ; ; User functions may also indicate a fatal error condition ; using the ERROR_CODE common block variable, as described ; below under the MPFIT_ERROR common block definition. ; ; If NODERIVATIVE=1, then MPCURVEFIT will never request explicit ; derivatives from the user function, and instead will user numerical ; estimates (i.e. by calling the user function multiple times). ; ; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD ; ; The behavior of MPFIT can be modified with respect to each ; parameter to be fitted. A parameter value can be fixed; simple ; boundary constraints can be imposed; limitations on the parameter ; changes can be imposed; properties of the automatic derivative can ; be modified; and parameters can be tied to one another. ; ; These properties are governed by the PARINFO structure, which is ; passed as a keyword parameter to MPFIT. ; ; PARINFO should be an array of structures, one for each parameter. ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; .VALUE - the starting parameter value (but see the START_PARAMS ; parameter for more information). ; ; .FIXED - a boolean value, whether the parameter is to be held ; fixed or not. Fixed parameters are not varied by ; MPFIT, but are passed on to MYFUNCT for evaluation. ; ; .LIMITED - a two-element boolean array. If the first/second ; element is set, then the parameter is bounded on the ; lower/upper side. A parameter can be bounded on both ; sides. Both LIMITED and LIMITS must be given ; together. ; ; .LIMITS - a two-element float or double array. Gives the ; parameter limits on the lower and upper sides, ; respectively. Zero, one or two of these values can be ; set, depending on the values of LIMITED. Both LIMITED ; and LIMITS must be given together. ; ; .PARNAME - a string, giving the name of the parameter. The ; fitting code of MPFIT does not use this tag in any ; way. However, the default ITERPROC will print the ; parameter name if available. ; ; .STEP - the step size to be used in calculating the numerical ; derivatives. If set to zero, then the step size is ; computed automatically. Ignored when AUTODERIVATIVE=0. ; This value is superceded by the RELSTEP value. ; ; .RELSTEP - the *relative* step size to be used in calculating ; the numerical derivatives. This number is the ; fractional size of the step, compared to the ; parameter value. This value supercedes the STEP ; setting. If the parameter is zero, then a default ; step size is chosen. ; ; .MPSIDE - the sidedness of the finite difference when computing ; numerical derivatives. This field can take four ; values: ; ; 0 - one-sided derivative computed automatically ; 1 - one-sided derivative (f(x+h) - f(x) )/h ; -1 - one-sided derivative (f(x) - f(x-h))/h ; 2 - two-sided derivative (f(x+h) - f(x-h))/(2*h) ; ; Where H is the STEP parameter described above. The ; "automatic" one-sided derivative method will chose a ; direction for the finite difference which does not ; violate any constraints. The other methods do not ; perform this check. The two-sided method is in ; principle more precise, but requires twice as many ; function evaluations. Default: 0. ; ; .MPMAXSTEP - the maximum change to be made in the parameter ; value. During the fitting process, the parameter ; will never be changed by more than this value in ; one iteration. ; ; A value of 0 indicates no maximum. Default: 0. ; ; .TIED - a string expression which "ties" the parameter to other ; free or fixed parameters. Any expression involving ; constants and the parameter array P are permitted. ; Example: if parameter 2 is always to be twice parameter ; 1 then use the following: parinfo(2).tied = '2 * P(1)'. ; Since they are totally constrained, tied parameters are ; considered to be fixed; no errors are computed for them. ; [ NOTE: the PARNAME can't be used in expressions. ] ; ; .MPPRINT - if set to 1, then the default ITERPROC will print the ; parameter value. If set to 0, the parameter value ; will not be printed. This tag can be used to ; selectively print only a few parameter values out of ; many. Default: 1 (all parameters printed) ; ; ; Future modifications to the PARINFO structure, if any, will involve ; adding structure tags beginning with the two letters "MP". ; Therefore programmers are urged to avoid using tags starting with ; the same letters; otherwise they are free to include their own ; fields within the PARINFO structure, and they will be ignored. ; ; PARINFO Example: ; parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $ ; limits:[0.D,0]}, 5) ; parinfo(0).fixed = 1 ; parinfo(4).limited(0) = 1 ; parinfo(4).limits(0) = 50.D ; parinfo(*).value = [5.7D, 2.2, 500., 1.5, 2000.] ; ; A total of 5 parameters, with starting values of 5.7, ; 2.2, 500, 1.5, and 2000 are given. The first parameter ; is fixed at a value of 5.7, and the last parameter is ; constrained to be above 50. ; ; INPUTS: ; X - Array of independent variable values. ; ; Y - Array of "measured" dependent variable values. Y should have ; the same data type as X. The function FUNCT should map ; X->Y. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. If WEIGHTS is specified then the ERR ; parameter is ignored. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Y-FUNCT(X,P))^2 * ABS(WEIGHTS) ) ; ; Here are common values of WEIGHTS: ; ; 1D/ERR^2 - Normal weighting (ERR is the measurement error) ; 1D/Y - Poisson weighting (counting statistics) ; 1D - Unweighted ; ; P - An array of starting values for each of the parameters of the ; model. The number of parameters should be fewer than the ; number of measurements. Also, the parameters should have the ; same data type as the measurements (double is preferred). ; ; Upon successful completion the new parameter values are ; returned in P. ; ; If both START_PARAMS and PARINFO are passed, then the starting ; *value* is taken from START_PARAMS, but the *constraints* are ; taken from PARINFO. ; ; SIGMA - The formal 1-sigma errors in each parameter, computed from ; the covariance matrix. If a parameter is held fixed, or ; if it touches a boundary, then the error is reported as ; zero. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then SIGMA will ; probably not represent the true parameter uncertainties. ; ; *If* you can assume that the true reduced chi-squared ; value is unity -- meaning that the fit is implicitly ; assumed to be of good quality -- then the estimated ; parameter uncertainties can be computed by scaling SIGMA ; by the measured chi-squared value. ; ; DOF = N_ELEMENTS(X) - N_ELEMENTS(P) ; deg of freedom ; CSIGMA = SIGMA * SQRT(CHISQ / DOF) ; scaled uncertainties ; ; RETURNS: ; ; Returns the array containing the best-fitting function. ; ; KEYWORD PARAMETERS: ; ; CHISQ - the value of the summed, squared, weighted residuals for ; the returned parameter values, i.e. the chi-square value. ; ; COVAR - the covariance matrix for the set of parameters returned ; by MPFIT. The matrix is NxN where N is the number of ; parameters. The square root of the diagonal elements ; gives the formal 1-sigma statistical errors on the ; parameters IF errors were treated "properly" in MYFUNC. ; Parameter errors are also returned in PERROR. ; ; To compute the correlation matrix, PCOR, use this: ; IDL> PCOR = COV * 0 ; IDL> FOR i = 0, n-1 DO FOR j = 0, n-1 DO $ ; PCOR(i,j) = COV(i,j)/sqrt(COV(i,i)*COV(j,j)) ; ; If NOCOVAR is set or MPFIT terminated abnormally, then ; COVAR is set to a scalar with value !VALUES.D_NAN. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). ; ; ERRMSG - a string error or warning message is returned. ; ; FTOL - a nonnegative input variable. Termination occurs when both ; the actual and predicted relative reductions in the sum of ; squares are at most FTOL (and STATUS is accordingly set to ; 1 or 3). Therefore, FTOL measures the relative error ; desired in the sum of squares. Default: 1D-10 ; ; FUNCTION_NAME - a scalar string containing the name of an IDL ; procedure to compute the user model values, as ; described above in the "USER MODEL" section. ; ; FUNCTARGS - A structure which contains the parameters to be passed ; to the user-supplied function specified by FUNCT via ; the _EXTRA mechanism. This is the way you can pass ; additional data to your user-supplied function without ; using common blocks. ; ; By default, no extra parameters are passed to the ; user-supplied function. ; ; GTOL - a nonnegative input variable. Termination occurs when the ; cosine of the angle between fvec and any column of the ; jacobian is at most GTOL in absolute value (and STATUS is ; accordingly set to 4). Therefore, GTOL measures the ; orthogonality desired between the function vector and the ; columns of the jacobian. Default: 1D-10 ; ; ITER - the number of iterations completed. ; ; ITERARGS - The keyword arguments to be passed to ITERPROC via the ; _EXTRA mechanism. This should be a structure, and is ; similar in operation to FUNCTARGS. ; Default: no arguments are passed. ; ; ITERPROC - The name of a procedure to be called upon each NPRINT ; iteration of the MPFIT routine. It should be declared ; in the following way: ; ; PRO ITERPROC, FUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $ ; PARINFO=parinfo, QUIET=quiet, ... ; ; perform custom iteration update ; END ; ; ITERPROC must either accept all three keyword ; parameters (FUNCTARGS, PARINFO and QUIET), or at least ; accept them via the _EXTRA keyword. ; ; FUNCT is the user-supplied function to be minimized, ; P is the current set of model parameters, ITER is the ; iteration number, and FUNCTARGS are the arguments to be ; passed to FUNCT. FNORM should be the ; chi-squared value. QUIET is set when no textual output ; should be printed. See below for documentation of ; PARINFO. ; ; In implementation, ITERPROC can perform updates to the ; terminal or graphical user interface, to provide ; feedback while the fit proceeds. If the fit is to be ; stopped for any reason, then ITERPROC should set the ; common block variable ERROR_CODE to negative value (see ; MPFIT_ERROR common block below). In principle, ; ITERPROC should probably not modify the parameter ; values, because it may interfere with the algorithm's ; stability. In practice it is allowed. ; ; Default: an internal routine is used to print the ; parameter values. ; ; ITMAX - The maximum number of iterations to perform. If the ; number is exceeded, then the STATUS value is set to 5 ; and MPFIT returns. ; Default: 200 iterations ; ; NFEV - the number of FUNCT function evaluations performed. ; ; NFREE - the number of free parameters in the fit. This includes ; parameters which are not FIXED and not TIED, but it does ; include parameters which are pegged at LIMITS. ; ; NOCOVAR - set this keyword to prevent the calculation of the ; covariance matrix before returning (see COVAR) ; ; NODERIVATIVE - if set, then the user function will not be queried ; for analytical derivatives, and instead the ; derivatives will be computed by finite differences ; (and according to the PARINFO derivative settings; ; see above for a description). ; ; NPRINT - The frequency with which ITERPROC is called. A value of ; 1 indicates that ITERPROC is called with every iteration, ; while 2 indicates every other iteration, etc. Note that ; several Levenberg-Marquardt attempts can be made in a ; single iteration. ; Default value: 1 ; ; PARINFO - Provides a mechanism for more sophisticated constraints ; to be placed on parameter values. When PARINFO is not ; passed, then it is assumed that all parameters are free ; and unconstrained. Values in PARINFO are never ; modified during a call to MPFIT. ; ; See description above for the structure of PARINFO. ; ; Default value: all parameters are free and unconstrained. ; ; QUIET - set this keyword when no textual output should be printed ; by MPFIT ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). It can have one of the ; following values: ; ; 0 improper input parameters. ; ; 1 both actual and predicted relative reductions ; in the sum of squares are at most FTOL. ; ; 2 relative error between two consecutive iterates ; is at most XTOL ; ; 3 conditions for STATUS = 1 and STATUS = 2 both hold. ; ; 4 the cosine of the angle between fvec and any ; column of the jacobian is at most GTOL in ; absolute value. ; ; 5 the maximum number of iterations has been reached ; ; 6 FTOL is too small. no further reduction in ; the sum of squares is possible. ; ; 7 XTOL is too small. no further improvement in ; the approximate solution x is possible. ; ; 8 GTOL is too small. fvec is orthogonal to the ; columns of the jacobian to machine precision. ; ; TOL - synonym for FTOL. Use FTOL instead. ; ; XTOL - a nonnegative input variable. Termination occurs when the ; relative error between two consecutive iterates is at most ; XTOL (and STATUS is accordingly set to 2 or 3). Therefore, ; XTOL measures the relative error desired in the approximate ; solution. Default: 1D-10 ; ; YERROR - upon return, the root-mean-square variance of the ; residuals. ; ; ; EXAMPLE: ; ; ; First, generate some synthetic data ; npts = 200 ; x = dindgen(npts) * 0.1 - 10. ; Independent variable ; yi = gauss1(x, [2.2D, 1.4, 3000.]) ; "Ideal" Y variable ; y = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise ; sy = sqrt(1000.D + y) ; Poisson errors ; ; ; Now fit a Gaussian to see how well we can recover ; p0 = [1.D, 1., 1000.] ; Initial guess ; yfit = mpcurvefit(x, y, 1/sy^2, p0, $ ; Fit a function ; FUNCTION_NAME='GAUSS1P',/autoderivative) ; print, p ; ; Generates a synthetic data set with a Gaussian peak, and Poisson ; statistical uncertainty. Then the same function is fitted to the ; data to see how close we can get. GAUSS1 and GAUSS1P are ; available from the same web page. ; ; ; COMMON BLOCKS: ; ; COMMON MPFIT_ERROR, ERROR_CODE ; ; User routines may stop the fitting process at any time by ; setting an error condition. This condition may be set in either ; the user's model computation routine (MYFUNCT), or in the ; iteration procedure (ITERPROC). ; ; To stop the fitting, the above common block must be declared, ; and ERROR_CODE must be set to a negative number. After the user ; procedure or function returns, MPFIT checks the value of this ; common block variable and exits immediately if the error ; condition has been set. By default the value of ERROR_CODE is ; zero, indicating a successful function/procedure call. ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; Translated from MPFITFUN, 25 Sep 1999, CM ; Alphabetized documented keywords, 02 Oct 1999, CM ; Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM ; Check to be sure that X and Y are present, 02 Nov 1999, CM ; Documented SIGMA for unweighted fits, 03 Nov 1999, CM ; Changed to ERROR_CODE for error condition, 28 Jan 2000, CM ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Propagated improvements from MPFIT, 17 Dec 2000, CM ; Corrected behavior of NODERIVATIVE, 13 May 2002, CM ; Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002 ; Make more consistent with comparable IDL routines, 30 Jun 2003, CM ; Minor documentation adjustment, 03 Feb 2004, CM ; Fix error in documentation, 26 Aug 2005, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Fix bug in handling of explicit derivatives with errors/weights ; (the weights were not being applied), CM, 2012-07-22 ; Add more documentation on calling interface for user function and ; parameter derivatives, CM, 2012-07-22 ; Better documentation for STATUS, CM, 2016-04-29 ; ; $Id: mpcurvefit.pro,v 1.12 2016/05/19 16:08:49 cmarkwar Exp $ ;- ; Copyright (C) 1997-2000, 2002, 2003, 2004, 2005, 2012, 2016 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- FORWARD_FUNCTION mpcurvefit_eval, mpcurvefit, mpfit ; This is the call-back function for MPFIT. It evaluates the ; function, subtracts the data, and returns the residuals. function mpcurvefit_eval, p, dp, _EXTRA=extra COMPILE_OPT strictarr common mpcurvefit_common, fcn, x, y, wts, f, fcnargs ;; The function is evaluated here. There are four choices, ;; depending on whether (a) FUNCTARGS was passed to MPCURVEFIT, which ;; is passed to this function as "hf"; or (b) the derivative ;; parameter "dp" is passed, meaning that derivatives should be ;; calculated analytically by the function itself. if n_elements(fcnargs) GT 0 then begin if n_params() GT 1 then call_procedure, fcn, x, p, f, dp,_EXTRA=fcnargs $ else call_procedure, fcn, x, p, f, _EXTRA=fcnargs endif else begin if n_params() GT 1 then call_procedure, fcn, x, p, f, dp $ else call_procedure, fcn, x, p, f endelse ;; Compute the deviates, applying the weights result = (y-f)*wts ;; Apply weights to derivative quantities if n_params() GT 1 then begin np = n_elements(p) nf = n_elements(f) for j = 0L, np-1 do dp[j*nf] = dp[j*nf:j*nf+nf-1] * wts endif ;; Make sure the returned result is one-dimensional. result = reform(result, n_elements(result), /overwrite) return, result end function mpcurvefit, x, y, wts, p, perror, function_name=fcn, $ iter=iter, itmax=maxiter, $ chisq=bestnorm, nfree=nfree, dof=dof, $ nfev=nfev, covar=covar, nocovar=nocovar, yerror=yerror, $ noderivative=noderivative, tol=tol, ftol=ftol, $ FUNCTARGS=fa, parinfo=parinfo, $ errmsg=errmsg, STATUS=status, QUIET=quiet, $ query=query, _EXTRA=extra COMPILE_OPT strictarr status = 0L errmsg = '' ;; Detect MPFIT and crash if it was not found catch, catcherror if catcherror NE 0 then begin MPFIT_NOTFOUND: catch, /cancel message, 'ERROR: the required function MPFIT must be in your IDL path', /info return, !values.d_nan endif if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND catch, /cancel if keyword_set(query) then return, 1 if n_params() EQ 0 then begin message, "USAGE: YFIT = MPCURVEFIT(X, Y, WTS, P, DP)", /info return, !values.d_nan endif if n_elements(x) EQ 0 OR n_elements(y) EQ 0 then begin message, 'ERROR: X and Y must be defined', /info return, !values.d_nan endif if n_elements(fcn) EQ 0 then fcn = 'funct' if n_elements(noderivative) EQ 0 then noderivative = 0 common mpcurvefit_common, fc, xc, yc, wc, mc, ac fc = fcn & xc = x & yc = y & wc = sqrt(abs(wts)) & mc = 0L ac = 0 & dummy = size(temporary(ac)) if n_elements(fa) GT 0 then ac = fa if n_elements(tol) GT 0 then ftol = tol result = mpfit('mpcurvefit_eval', p, maxiter=maxiter, $ autoderivative=noderivative, ftol=ftol, $ parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$ covar=covar, perror=perror, niter=iter, nfree=nfree, dof=dof,$ ERRMSG=errmsg, quiet=quiet, _EXTRA=extra) ;; Retrieve the fit value yfit = temporary(mc) ;; Now do some clean-up xc = 0 & yc = 0 & wc = 0 & mc = 0 & ac = 0 if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /info $ else $ p = result yerror = p[0]*0 if n_elements(dof) GT 0 AND dof[0] GT 0 then begin yerror[0] = sqrt( total( (y-yfit)^2 ) / dof[0] ) endif return, yfit end mpfitexpr.pro0000644000244500024450000007650412717414567013142 0ustar craigmcraigm;+ ; NAME: ; MPFITEXPR ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Perform Levenberg-Marquardt least-squares fit to arbitrary expression ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; MYFUNCT = 'X*(1-X)+3' ; parms = MPFITEXPR(MYFUNCT, XVAL, YVAL, ERR, start_parms, ...) ; ; DESCRIPTION: ; ; MPFITEXPR fits a user-supplied model -- in the form of an arbitrary IDL ; expression -- to a set of user-supplied data. MPFITEXPR calls ; MPFIT, the MINPACK-1 least-squares minimizer, to do the main ; work. ; ; Given the data and their uncertainties, MPFITEXPR finds the best set ; of model parameters which match the data (in a least-squares ; sense) and returns them in an array. ; ; The user must supply the following items: ; - An array of independent variable values ("X"). ; - An array of "measured" *dependent* variable values ("Y"). ; - An array of "measured" 1-sigma uncertainty values ("ERR"). ; - A text IDL expression which computes Y given X. ; - Starting guesses for all of the parameters ("START_PARAMS"). ; ; There are very few restrictions placed on X, Y or the expression of ; the model. Simply put, the expression must map the "X" values into ; "Y" values given the model parameters. The "X" values may ; represent any independent variable (not just Cartesian X), and ; indeed may be multidimensional themselves. For example, in the ; application of image fitting, X may be a 2xN array of image ; positions. ; ; Some rules must be obeyed in constructing the expression. First, ; the independent variable name *MUST* be "X" in the expression, ; regardless of the name of the variable being passed to MPFITEXPR. ; This is demonstrated in the above calling sequence, where the X ; variable passed in is called "XVAL" but the expression still refers ; to "X". Second, parameter values must be referred to as an array ; named "P". ; ; If you do not pass in starting values for the model parameters, ; MPFITEXPR will attempt to determine the number of parameters you ; intend to have (it does this by looking for references to the array ; variable named "P"). When no starting values are passed in, the ; values are assumed to start at zero. ; ; MPFITEXPR carefully avoids passing large arrays where possible to ; improve performance. ; ; See below for an example of usage. ; ; EVALUATING EXPRESSIONS ; ; This source module also provides a function called MPEVALEXPR. You ; can use this function to evaluate your expression, given a list of ; parameters. This is one of the easier ways to compute the model ; once the best-fit parameters have been found. Here is an example: ; ; YMOD = MPEVALEXPR(MYFUNCT, XVAL, PARMS) ; ; where MYFUNCT is the expression (see MYFUNCT below), XVAL is the ; list of "X" values, and PARMS is an array of parameters. The ; returned array YMOD contains the expression MYFUNCT evaluated at ; each point in XVAL. ; ; PASSING PRIVATE DATA TO AN EXPRESSION ; ; The most complicated optimization problems typically involve other ; external parameters, in addition to the fitted parameters. While ; it is extremely easy to rewrite an expression dynamically, in case ; one of the external parameters changes, the other possibility is to ; use the PRIVATE data structure. ; ; The user merely passes a structure to the FUNCTARGS keyword. The ; user expression receives this value as the variable PRIVATE. ; MPFITEXPR nevers accesses this variable so it can contain any ; desired values. Usually it would be an IDL structure so that any ; named external parameters can be passed to the expression. ; ; ; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD ; ; The behavior of MPFIT can be modified with respect to each ; parameter to be fitted. A parameter value can be fixed; simple ; boundary constraints can be imposed; limitations on the parameter ; changes can be imposed; properties of the automatic derivative can ; be modified; and parameters can be tied to one another. ; ; These properties are governed by the PARINFO structure, which is ; passed as a keyword parameter to MPFIT. ; ; PARINFO should be an array of structures, one for each parameter. ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; .VALUE - the starting parameter value (but see the START_PARAMS ; parameter for more information). ; ; .FIXED - a boolean value, whether the parameter is to be held ; fixed or not. Fixed parameters are not varied by ; MPFIT, but are passed on to MYFUNCT for evaluation. ; ; .LIMITED - a two-element boolean array. If the first/second ; element is set, then the parameter is bounded on the ; lower/upper side. A parameter can be bounded on both ; sides. Both LIMITED and LIMITS must be given ; together. ; ; .LIMITS - a two-element float or double array. Gives the ; parameter limits on the lower and upper sides, ; respectively. Zero, one or two of these values can be ; set, depending on the values of LIMITED. Both LIMITED ; and LIMITS must be given together. ; ; .PARNAME - a string, giving the name of the parameter. The ; fitting code of MPFIT does not use this tag in any ; way. However, the default ITERPROC will print the ; parameter name if available. ; ; .STEP - the step size to be used in calculating the numerical ; derivatives. If set to zero, then the step size is ; computed automatically. Ignored when AUTODERIVATIVE=0. ; This value is superceded by the RELSTEP value. ; ; .RELSTEP - the *relative* step size to be used in calculating ; the numerical derivatives. This number is the ; fractional size of the step, compared to the ; parameter value. This value supercedes the STEP ; setting. If the parameter is zero, then a default ; step size is chosen. ; ; .MPSIDE - the sidedness of the finite difference when computing ; numerical derivatives. This field can take four ; values: ; ; 0 - one-sided derivative computed automatically ; 1 - one-sided derivative (f(x+h) - f(x) )/h ; -1 - one-sided derivative (f(x) - f(x-h))/h ; 2 - two-sided derivative (f(x+h) - f(x-h))/(2*h) ; ; Where H is the STEP parameter described above. The ; "automatic" one-sided derivative method will chose a ; direction for the finite difference which does not ; violate any constraints. The other methods do not ; perform this check. The two-sided method is in ; principle more precise, but requires twice as many ; function evaluations. Default: 0. ; ; .MPMAXSTEP - the maximum change to be made in the parameter ; value. During the fitting process, the parameter ; will never be changed by more than this value in ; one iteration. ; ; A value of 0 indicates no maximum. Default: 0. ; ; .TIED - a string expression which "ties" the parameter to other ; free or fixed parameters as an equality constraint. Any ; expression involving constants and the parameter array P ; are permitted. ; Example: if parameter 2 is always to be twice parameter ; 1 then use the following: parinfo[2].tied = '2 * P[1]'. ; Since they are totally constrained, tied parameters are ; considered to be fixed; no errors are computed for them. ; [ NOTE: the PARNAME can't be used in a TIED expression. ] ; ; .MPPRINT - if set to 1, then the default ITERPROC will print the ; parameter value. If set to 0, the parameter value ; will not be printed. This tag can be used to ; selectively print only a few parameter values out of ; many. Default: 1 (all parameters printed) ; ; .MPFORMAT - IDL format string to print the parameter within ; ITERPROC. Default: '(G20.6)' (An empty string will ; also use the default.) ; ; Future modifications to the PARINFO structure, if any, will involve ; adding structure tags beginning with the two letters "MP". ; Therefore programmers are urged to avoid using tags starting with ; "MP", but otherwise they are free to include their own fields ; within the PARINFO structure, which will be ignored by MPFIT. ; ; PARINFO Example: ; parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $ ; limits:[0.D,0]}, 5) ; parinfo[0].fixed = 1 ; parinfo[4].limited[0] = 1 ; parinfo[4].limits[0] = 50.D ; parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.] ; ; A total of 5 parameters, with starting values of 5.7, ; 2.2, 500, 1.5, and 2000 are given. The first parameter ; is fixed at a value of 5.7, and the last parameter is ; constrained to be above 50. ; ; ; COMPATIBILITY ; ; This function is designed to work with IDL 5.0 or greater. Because ; this function uses the IDL EXECUTE() function, it will not work ; with the free version of the IDL Virtual machine. ; ; ; INPUTS: ; MYFUNCT - a string variable containing an IDL expression. The ; only restriction is that the independent variable *must* ; be referred to as "X" and model parameters *must* be ; referred to as an array called "P". Do not use symbol ; names beginning with the underscore, "_". ; ; The expression should calculate "model" Y values given ; the X values and model parameters. Using the vector ; notation of IDL, this can be quite easy to do. If your ; expression gets complicated, you may wish to make an IDL ; function which will improve performance and readibility. ; ; The resulting array should be of the same size and ; dimensions as the "measured" Y values. ; ; X - Array of independent variable values. ; ; Y - Array of "measured" dependent variable values. Y should have ; the same data type as X. The function MYFUNCT should map ; X->Y. ; ; ERR - Array of "measured" 1-sigma uncertainties. ERR should have ; the same data type as Y. ERR is ignored if the WEIGHTS ; keyword is specified. ; ; START_PARAMS - An array of starting values for each of the ; parameters of the model. The number of parameters ; should be fewer than the number of measurements. ; Also, the parameters should have the same data type ; as the measurements (double is preferred). ; ; This parameter is optional if the PARINFO keyword ; is used (see MPFIT). The PARINFO keyword provides ; a mechanism to fix or constrain individual ; parameters. If both START_PARAMS and PARINFO are ; passed, then the starting *value* is taken from ; START_PARAMS, but the *constraints* are taken from ; PARINFO. ; ; If no parameters are given, then MPFITEXPR attempts ; to determine the number of parameters by scanning ; the expression. Parameters determined this way are ; initialized to zero. This technique is not fully ; reliable, so users are advised to pass explicit ; parameter starting values. ; ; ; RETURNS: ; ; Returns the array of best-fit parameters. ; ; ; KEYWORD PARAMETERS: ; ; BESTNORM - the value of the summed, squared, weighted residuals ; for the returned parameter values, i.e. the chi-square value. ; ; COVAR - the covariance matrix for the set of parameters returned ; by MPFIT. The matrix is NxN where N is the number of ; parameters. The square root of the diagonal elements ; gives the formal 1-sigma statistical errors on the ; parameters IF errors were treated "properly" in MYFUNC. ; Parameter errors are also returned in PERROR. ; ; To compute the correlation matrix, PCOR, use this: ; IDL> PCOR = COV * 0 ; IDL> FOR i = 0, n-1 DO FOR j = 0, n-1 DO $ ; PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j]) ; ; If NOCOVAR is set or MPFIT terminated abnormally, then ; COVAR is set to a scalar with value !VALUES.D_NAN. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). ; ; ERRMSG - a string error or warning message is returned. ; ; FTOL - a nonnegative input variable. Termination occurs when both ; the actual and predicted relative reductions in the sum of ; squares are at most FTOL (and STATUS is accordingly set to ; 1 or 3). Therefore, FTOL measures the relative error ; desired in the sum of squares. Default: 1D-10 ; ; FUNCTARGS - passed directly to the expression as the variable ; PRIVATE. Any user-private data can be communicated to ; the user expression using this keyword. ; Default: PRIVATE is undefined in user expression ; ; GTOL - a nonnegative input variable. Termination occurs when the ; cosine of the angle between fvec and any column of the ; jacobian is at most GTOL in absolute value (and STATUS is ; accordingly set to 4). Therefore, GTOL measures the ; orthogonality desired between the function vector and the ; columns of the jacobian. Default: 1D-10 ; ; ITERARGS - The keyword arguments to be passed to ITERPROC via the ; _EXTRA mechanism. This should be a structure, and is ; similar in operation to FUNCTARGS. ; Default: no arguments are passed. ; ; ITERPROC - The name of a procedure to be called upon each NPRINT ; iteration of the MPFIT routine. It should be declared ; in the following way: ; ; PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $ ; PARINFO=parinfo, QUIET=quiet, ... ; ; perform custom iteration update ; END ; ; ITERPROC must either accept all three keyword ; parameters (FUNCTARGS, PARINFO and QUIET), or at least ; accept them via the _EXTRA keyword. ; ; MYFUNCT is the user-supplied function to be minimized, ; P is the current set of model parameters, ITER is the ; iteration number, and FUNCTARGS are the arguments to be ; passed to MYFUNCT. FNORM should be the ; chi-squared value. QUIET is set when no textual output ; should be printed. See below for documentation of ; PARINFO. ; ; In implementation, ITERPROC can perform updates to the ; terminal or graphical user interface, to provide ; feedback while the fit proceeds. If the fit is to be ; stopped for any reason, then ITERPROC should set the ; common block variable ERROR_CODE to negative value (see ; MPFIT_ERROR common block below). In principle, ; ITERPROC should probably not modify the parameter ; values, because it may interfere with the algorithm's ; stability. In practice it is allowed. ; ; Default: an internal routine is used to print the ; parameter values. ; ; MAXITER - The maximum number of iterations to perform. If the ; number is exceeded, then the STATUS value is set to 5 ; and MPFIT returns. ; Default: 200 iterations ; ; NFEV - the number of MYFUNCT function evaluations performed. ; ; NFREE - the number of free parameters in the fit. This includes ; parameters which are not FIXED and not TIED, but it does ; include parameters which are pegged at LIMITS. ; ; NITER - the number of iterations completed. ; ; NOCOVAR - set this keyword to prevent the calculation of the ; covariance matrix before returning (see COVAR) ; ; NPEGGED - the number of free parameters which are pegged at a ; LIMIT. ; ; NPRINT - The frequency with which ITERPROC is called. A value of ; 1 indicates that ITERPROC is called with every iteration, ; while 2 indicates every other iteration, etc. Note that ; several Levenberg-Marquardt attempts can be made in a ; single iteration. ; Default value: 1 ; ; PARINFO - Provides a mechanism for more sophisticated constraints ; to be placed on parameter values. When PARINFO is not ; passed, then it is assumed that all parameters are free ; and unconstrained. Values in PARINFO are never ; modified during a call to MPFIT. ; ; See description above for the structure of PARINFO. ; ; Default value: all parameters are free and unconstrained. ; ; PERROR - The formal 1-sigma errors in each parameter, computed ; from the covariance matrix. If a parameter is held ; fixed, or if it touches a boundary, then the error is ; reported as zero. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. ; ; *If* you can assume that the true reduced chi-squared ; value is unity -- meaning that the fit is implicitly ; assumed to be of good quality -- then the estimated ; parameter uncertainties can be computed by scaling PERROR ; by the measured chi-squared value. ; ; DOF = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom ; PCERROR = PERROR * SQRT(BESTNORM / DOF) ; scaled uncertainties ; ; QUIET - set this keyword when no textual output should be printed ; by MPFIT ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). It can have one of the ; following values: ; ; 0 improper input parameters. ; ; 1 both actual and predicted relative reductions ; in the sum of squares are at most FTOL. ; ; 2 relative error between two consecutive iterates ; is at most XTOL ; ; 3 conditions for STATUS = 1 and STATUS = 2 both hold. ; ; 4 the cosine of the angle between fvec and any ; column of the jacobian is at most GTOL in ; absolute value. ; ; 5 the maximum number of iterations has been reached ; ; 6 FTOL is too small. no further reduction in ; the sum of squares is possible. ; ; 7 XTOL is too small. no further improvement in ; the approximate solution x is possible. ; ; 8 GTOL is too small. fvec is orthogonal to the ; columns of the jacobian to machine precision. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. If WEIGHTS is specified then the ERR ; parameter is ignored. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Y-MYFUNCT(X,P))^2 * ABS(WEIGHTS) ) ; ; Here are common values of WEIGHTS: ; ; 1D/ERR^2 - Normal weighting (ERR is the measurement error) ; 1D/Y - Poisson weighting (counting statistics) ; 1D - Unweighted ; ; XTOL - a nonnegative input variable. Termination occurs when the ; relative error between two consecutive iterates is at most ; XTOL (and STATUS is accordingly set to 2 or 3). Therefore, ; XTOL measures the relative error desired in the approximate ; solution. Default: 1D-10 ; ; YFIT - the best-fit model function, as returned by MYFUNCT. ; ; ; EXAMPLE: ; ; ; First, generate some synthetic data ; x = dindgen(200) * 0.1 - 10. ; Independent variable ; yi = gauss1(x, [2.2D, 1.4, 3000.]) + 1000 ; "Ideal" Y variable ; y = yi + randomn(seed, 200) * sqrt(yi) ; Measured, w/ noise ; sy = sqrt(y) ; Poisson errors ; ; ; Now fit a Gaussian to see how well we can recover ; expr = 'P[0] + GAUSS1(X, P[1:3])' ; fitting function ; p0 = [800.D, 1.D, 1., 500.] ; Initial guess ; p = mpfitexpr(expr, x, y, sy, p0) ; Fit the expression ; print, p ; ; plot, x, y ; Plot data ; oplot, x, mpevalexpr(expr, x, p) ; Plot model ; ; Generates a synthetic data set with a Gaussian peak, and Poisson ; statistical uncertainty. Then a model consisting of a constant ; plus Gaussian is fit to the data. ; ; ; COMMON BLOCKS: ; ; COMMON MPFIT_ERROR, ERROR_CODE ; ; User routines may stop the fitting process at any time by ; setting an error condition. This condition may be set in either ; the user's model computation routine (MYFUNCT), or in the ; iteration procedure (ITERPROC). ; ; To stop the fitting, the above common block must be declared, ; and ERROR_CODE must be set to a negative number. After the user ; procedure or function returns, MPFIT checks the value of this ; common block variable and exits immediately if the error ; condition has been set. By default the value of ERROR_CODE is ; zero, indicating a successful function/procedure call. ; ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; Written, Apr-Jul 1998, CM ; Added PERROR keyword, 04 Aug 1998, CM ; Added COVAR keyword, 20 Aug 1998, CM ; Added NITER output keyword, 05 Oct 1998 ; D.L Windt, Bell Labs, windt@bell-labs.com; ; Added ability to return model function in YFIT, 09 Nov 1998 ; Parameter values can be tied to others, 09 Nov 1998 ; Added MPEVALEXPR utility function, 09 Dec 1998 ; Cosmetic documentation updates, 16 Apr 1999, CM ; More cosmetic documentation updates, 14 May 1999, CM ; Made sure to update STATUS value, 25 Sep 1999, CM ; Added WEIGHTS keyword, 25 Sep 1999, CM ; Changed from handles to common blocks, 25 Sep 1999, CM ; - commons seem much cleaner and more logical in this case. ; Alphabetized documented keywords, 02 Oct 1999, CM ; Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM ; Check to be sure that X and Y are present, 02 Nov 1999, CM ; Documented PERROR for unweighted fits, 03 Nov 1999, CM ; Removed ITERPROC='' when quiet EQ 1, 10 Jan 2000, CM ; Changed to ERROR_CODE for error condition, 28 Jan 2000, CM ; Updated the EXAMPLE, 26 Mar 2000, CM ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Propagated improvements from MPFIT, 17 Dec 2000, CM ; Correct reference to _WTS in MPFITEXPR_EVAL, 25 May 2001, CM ; (thanks to Mark Fardal) ; Added useful FUNCTARGS behavior (as yet undocumented), 04 Jul ; 2002, CM ; Documented FUNCTARGS/PRIVATE behavior, 22 Jul 2002, CM ; Added NFREE and NPEGGED keywords, 13 Sep 2002, CM ; Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002 ; Add DOF keyword, CM, 31 Jul 2003 ; Add FUNCTARGS keyword to MPEVALEXPR, CM 08 Aug 2003 ; Minor documentation adjustment, 03 Feb 2004, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Clarify documentation on user-function, derivatives, and PARINFO, ; 27 May 2007 ; Add COMPATIBILITY section, CM, 13 Dec 2007 ; Remove obsolete STR_SEP in favor of STRSPLIT, CM, 2015-03-18 ; Better documentation for STATUS, CM, 2016-04-29 ; ; $Id: mpfitexpr.pro,v 1.16 2016/05/19 16:08:49 cmarkwar Exp $ ;- ; Copyright (C) 1997-2001, 2002, 2003, 2004, 2007, 2015, 2016 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- FORWARD_FUNCTION mpevalexpr, mpfitexpr_eval, mpfitexpr, mpfit ; Utility function which simply returns the value of the expression, ; evaluated at each point in x, using the parameters p. function mpevalexpr, _expr, x, p, functargs=private COMPILE_OPT strictarr _cmd = '_f = '+_expr _err = execute(_cmd) return, _f end ; This is the call-back function for MPFIT. It evaluates the ; expression, subtracts the data, and returns the residuals. function mpfitexpr_eval, p, _EXTRA=private COMPILE_OPT strictarr common mpfitexpr_common, _expr, x, y, err, _wts, _f ;; Compute the model value by executing the expression _f = 0.D _cmd = '_f = '+_expr _xxx = execute(_cmd) if _xxx EQ 0 then message, 'ERROR: command execution failed.' ;; Compute the deviates, applying either errors or weights if n_elements(err) GT 0 then begin result = (y-_f)/err endif else if n_elements(_wts) GT 0 then begin result = (y-_f)*_wts endif else begin result = (y-_f) endelse ;; The returned result should be one-dimensional result = reform(result, n_elements(result), /overwrite) return, result end ;; This is the main entry point for this module function mpfitexpr, expr, x, y, err, p, WEIGHTS=wts, $ BESTNORM=bestnorm, STATUS=status, nfev=nfev, $ parinfo=parinfo, query=query, functargs=fcnargs, $ covar=covar, perror=perror, yfit=yfit, $ niter=niter, nfree=nfree, npegged=npegged, dof=dof, $ quiet=quiet, _EXTRA=extra, errmsg=errmsg COMPILE_OPT strictarr status = 0L errmsg = '' ;; Detect MPFIT and crash if it was not found catch, catcherror if catcherror NE 0 then begin MPFIT_NOTFOUND: catch, /cancel message, 'ERROR: the required function MPFIT must be in your IDL path', /info return, !values.d_nan endif if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND catch, /cancel if keyword_set(query) then return, 1 if n_params() EQ 0 then begin message, "USAGE: PARMS = MPFITEXPR('EXPR', X, Y, ERR, "+ $ "START_PARAMS, ... )", /info return, !values.d_nan endif if n_elements(x) EQ 0 OR n_elements(y) EQ 0 then begin message, 'ERROR: X and Y must be defined', /info return, !values.d_nan endif ;; If no parameters are given, then parse the input expression, ;; and determine the number of parameters automatically. if (n_elements(parinfo) GT 0) AND (n_elements(p) EQ 0) then $ p = parinfo[*].value if (n_elements(p) EQ 0) then begin pos = 0L nparams = 0L ee = strupcase(expr) ;; These are character constants representing the boundaries of ;; variable names. ca = (byte('A'))[0] cz = (byte('Z'))[0] c0 = (byte('0'))[0] c9 = (byte('9'))[0] c_ = (byte('_'))[0] ;; Underscore can be in a variable name ll = strlen(ee) pnames = [''] ;; Now step through, looking for variables looking like p[0], etc. repeat begin i = [strpos(ee, 'P(', pos), strpos(ee, 'P[', pos)] wh = where(i GE 0, ct) if ct LE 0 then goto, DONE_PARAMS i = min(i[wh]) ;; None found, finished if i LT 0 then goto, DONE_PARAMS ;; Too close to the end of the string if i GT ll-4 then goto, DONE_PARAMS ;; Have to be careful here, to be sure that this isn't just ;; a variable name ending in "p" maybe = 0 ;; If this is the first character if i EQ 0 then maybe = 1 $ else begin ;; Or if the preceding character is a non-variable character c = (byte(strmid(ee, i-1, 1)))[0] if NOT ( (c GE ca AND c LE cz) OR (c GE c0 AND c LE c9) $ OR c EQ c_ ) then maybe = 1 endelse if maybe then begin ;; If we found one, then strip out the value inside the ;; parentheses. rest = strmid(ee, i+2, ll-i-2) next = strtrim(strsplit(rest,')',/extract),2) next = next[0] pnames = [pnames, next] endif pos = i+1 endrep until pos GE ll DONE_PARAMS: if n_elements(pnames) EQ 1 then begin message, 'ERROR: no parameters to fit', /info return, !values.d_nan endif ;; Finally, we take the maximum parameter number pnames = pnames[1:*] nparams = max(long(pnames)) + 1 if NOT keyword_set(quiet) then $ message, ' Number of parameters: '+strtrim(nparams,2) $ + ' (initialized to zero)', /info ;; Create a parameter vector, starting at zero p = dblarr(nparams) endif ;; Use common block to pass data back and forth common mpfitexpr_common, fc, xc, yc, ec, wc, mc fc = expr & xc = x & yc = y & mc = 0L ;; These optional parameters must be undefined first ec = 0 & dummy = size(temporary(ec)) wc = 0 & dummy = size(temporary(wc)) if n_elements(wts) GT 0 then begin wc = sqrt(abs(wts)) endif else if n_elements(err) GT 0 then begin wh = where(err EQ 0, ct) if ct GT 0 then begin message, 'ERROR: ERROR value must not be zero. Use WEIGHTS.', $ /info return, !values.d_nan endif ec = err endif ;; Test out the function, as mpfit would call it, to see if it works ;; okay. There is no sense in calling the fitter if the function ;; itself doesn't work. catch, catcherror if catcherror NE 0 then begin CATCH_ERROR: catch, /cancel message, 'ERROR: execution of "'+expr+'" failed.', /info message, ' check syntax and parameter usage', /info xc = 0 & yc = 0 & ec = 0 & wc = 0 & ac = 0 return, !values.d_nan endif ;; Initialize. Function that is actually called is mpfitexpr_eval, ;; which is a wrapper that sets up the expression evaluation. fcn = 'mpfitexpr_eval' ;; FCNARGS are passed by MPFIT directly to MPFITEXPR_EVAL. These ;; actually contain the data, the expression, and a slot to return ;; the model function. fvec = call_function(fcn, p, _EXTRA=fcnargs) if n_elements(fvec) EQ 1 then $ if NOT finite(fvec[0]) then goto, CATCH_ERROR ;; No errors caught if reached this stage catch, /cancel ;; Call MPFIT result = mpfit(fcn, p, $ parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$ covar=covar, perror=perror, functargs=fcnargs, $ niter=niter, nfree=nfree, npegged=npegged, dof=dof, $ ERRMSG=errmsg, quiet=quiet, _EXTRA=extra) ;; Retrieve the fit value yfit = temporary(mc) ;; Some cleanup xc = 0 & yc = 0 & wc = 0 & ec = 0 & mc = 0 & ac = 0 ;; Print error message if there is one. if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /info return, result end mpfitpeak.pro0000644000244500024450000005500311674506601013063 0ustar craigmcraigm;+ ; NAME: ; MPFITPEAK ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Fit a gaussian, lorentzian or Moffat model to data ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; yfit = MPFITPEAK(X, Y, A, NTERMS=nterms, ...) ; ; DESCRIPTION: ; ; MPFITPEAK fits a gaussian, lorentzian or Moffat model using the ; non-linear least squares fitter MPFIT. MPFITPEAK is meant to be a ; drop-in replacement for IDL's GAUSSFIT function (and requires ; MPFIT and MPFITFUN). ; ; The choice of the fitting function is determined by the keywords ; GAUSSIAN, LORENTZIAN and MOFFAT. By default the gaussian model ; function is used. [ The Moffat function is a modified Lorentzian ; with variable power law index. (Moffat, A. F. J. 1969, Astronomy & ; Astrophysics, v. 3, p. 455-461) ] ; ; The functional form of the baseline is determined by NTERMS and ; the function to be fitted. NTERMS represents the total number of ; parameters, A, to be fitted. The functional forms and the ; meanings of the parameters are described in this table: ; ; GAUSSIAN# Lorentzian# Moffat# ; ; Model A[0]*exp(-0.5*u^2) A[0]/(u^2 + 1) A[0]/(u^2 + 1)^A[3] ; ; A[0] Peak Value Peak Value Peak Value ; A[1] Peak Centroid Peak Centroid Peak Centroid ; A[2] Gaussian Sigma HWHM% HWHM% ; A[3] + A[3] * + A[3] * Moffat Index ; A[4] + A[4]*x * + A[4]*x * + A[4] * ; A[5] + A[5]*x * ; ; Notes: # u = (x - A[1])/A[2] ; % Half-width at half maximum ; * Optional depending on NTERMS ; ; By default the initial starting values for the parameters A are ; estimated from the data. However, explicit starting values can be ; supplied using the ESTIMATES keyword. Also, error or weighting ; values can optionally be provided; otherwise the fit is ; unweighted. ; ; MPFITPEAK fits the peak value of the curve. The area under a ; gaussian peak is A[0]*A[2]*SQRT(2*!DPI); the area under a ; lorentzian peak is A[0]*A[2]*!DPI. ; ; Data values of NaN or Infinity for "Y", "ERROR" or "WEIGHTS" will ; be ignored as missing data if the NAN keyword is set. Otherwise, ; they may cause the fitting loop to halt with an error message. ; Note that the fit will still halt if the model function, or its ; derivatives, produces infinite or NaN values, or if an "X" value is ; missing. ; ; RESTRICTIONS: ; ; If no starting parameter ESTIMATES are provided, then MPFITPEAK ; attempts to estimate them from the data. This is not a perfect ; science; however, the author believes that the technique ; implemented here is more robust than the one used in IDL's ; GAUSSFIT. The author has tested cases of strong peaks, noisy ; peaks and broad peaks, all with success. ; ; Users should be aware that if the baseline term contains a strong ; linear component then the automatic estimation may fail. For ; automatic estimation to work the peak amplitude should dominate ; over the the maximum baseline. ; ; COMPATIBILITY ; ; This function is designed to work with IDL 5.0 or greater. ; ; Because TIED parameters rely on the EXECUTE() function, they cannot ; be used with the free version of the IDL Virtual Machine. ; ; ; INPUTS: ; X - Array of independent variable values, whose values should ; monotonically increase. ; ; Y - Array of "measured" dependent variable values. Y should have ; the same data type and dimension as X. ; NOTE: the following special cases apply: ; * if Y is NaN or Infinite, and the NAN keyword is ; set, then the corresponding data point is ignored ; ; OUTPUTS: ; A - Upon return, an array of NTERMS best fit parameter values. ; See the table above for the meanings of each parameter ; element. ; ; ; RETURNS: ; ; Returns the best fitting model function. ; ; KEYWORDS: ; ; ** NOTE ** Additional keywords such as PARINFO, BESTNORM, and ; STATUS are accepted by MPFITPEAK but not documented ; here. Please see the documentation for MPFIT for the ; description of these advanced options. ; ; AUTODERIV - Set to 1 to have MPFIT compute the derivatives numerically. ; Default is 0 - derivatives are computed analytically, which is ; generally faster. (Prior to Jan 2011, the default was 1) ; ; CHISQ - the value of the summed squared residuals for the ; returned parameter values. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). ; ; ERROR - upon input, the measured 1-sigma uncertainties in the "Y" ; values. If no ERROR or WEIGHTS are given, then the fit is ; unweighted. ; NOTE: the following special cases apply: ; * if ERROR is zero, then the corresponding data point ; is ignored ; * if ERROR is NaN or Infinite, and the NAN keyword is ; set, then the corresponding data point is ignored ; * if ERROR is negative, then the absolute value of ; ERROR is used. ; ; ESTIMATES - Array of starting values for each parameter of the ; model. The number of parameters should at least be ; three (four for Moffat), and if less than NTERMS, will ; be extended with zeroes. If ESTIMATES is not set, ; then the starting values are estimated from the data ; directly, before fitting. (This also means that ; PARINFO.VALUES is ignored.) ; Default: not set - parameter values are estimated from data. ; ; GAUSSIAN - if set, fit a gaussian model function. The Default. ; LORENTZIAN - if set, fit a lorentzian model function. ; MOFFAT - if set, fit a Moffat model function. ; ; MEASURE_ERRORS - synonym for ERRORS, for consistency with built-in ; IDL fitting routines. ; ; NAN - ignore infinite or NaN values in the Y, ERR or WEIGHTS ; parameters. These values will be treated as missing data. ; However, the fit will still halt with an error condition if ; the model function becomes infinite, or if X has missing ; values. ; ; NEGATIVE / POSITIVE - if set, and ESTIMATES is not provided, then ; MPFITPEAK will assume that a ; negative/positive peak is present. ; Default: determined automatically ; ; NFREE - the number of free parameters in the fit. This includes ; parameters which are not FIXED and not TIED, but it does ; include parameters which are pegged at LIMITS. ; ; NO_FIT - if set, then return only the initial estimates without ; fitting. Useful to find out what the estimates the ; automatic guessing algorithm produced. If NO_FIT is set, ; then SIGMA and CHISQ values are not produced. The ; routine returns, NAN, and STATUS=5. ; ; NTERMS - An integer describing the number of fitting terms. ; NTERMS must have a minimum value, but can optionally be ; larger depending on the desired baseline. ; ; For gaussian and lorentzian models, NTERMS must be three ; (zero baseline), four (constant baseline) or five (linear ; baseline). Default: 4 ; ; For the Moffat model, NTERMS must be four (zero ; baseline), five (constant baseline), or six (linear ; baseline). Default: 5 ; ; PERROR - upon return, the 1-sigma uncertainties of the parameter ; values A. These values are only meaningful if the ERRORS ; or WEIGHTS keywords are specified properly. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. ; ; *If* you can assume that the true reduced chi-squared ; value is unity -- meaning that the fit is implicitly ; assumed to be of good quality -- then the estimated ; parameter uncertainties can be computed by scaling PERROR ; by the measured chi-squared value. ; ; DOF = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom ; PCERROR = PERROR * SQRT(BESTNORM / DOF) ; scaled uncertainties ; ; QUIET - if set then diagnostic fitting messages are suppressed. ; Default: QUIET=1 (i.e., no diagnostics) ; ; SIGMA - synonym for PERROR (1-sigma parameter uncertainties), for ; compatibility with GAUSSFIT. Do not confuse this with the ; Gaussian "sigma" width parameter. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. If WEIGHTS is specified then the ERROR ; keyword is ignored. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Y-MYFUNCT(X,P))^2 * ABS(WEIGHTS) ) ; ; Here are common values of WEIGHTS: ; ; 1D/ERR^2 - Normal weighting (ERR is the measurement error) ; 1D/Y - Poisson weighting (counting statistics) ; 1D - Unweighted ; ; The ERROR keyword takes precedence over any WEIGHTS ; keyword values. If no ERROR or WEIGHTS are given, then ; the fit is unweighted. ; NOTE: the following special cases apply: ; * if WEIGHTS is zero, then the corresponding data point ; is ignored ; * if WEIGHTS is NaN or Infinite, and the NAN keyword is ; set, then the corresponding data point is ignored ; * if WEIGHTS is negative, then the absolute value of ; WEIGHTS is used. ; ; YERROR - upon return, the root-mean-square variance of the ; residuals. ; ; ; EXAMPLE: ; ; ; First, generate some synthetic data ; npts = 200 ; x = dindgen(npts) * 0.1 - 10. ; Independent variable ; yi = gauss1(x, [2.2D, 1.4, 3000.]) + 1000 ; "Ideal" Y variable ; y = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise ; sy = sqrt(1000.D + y) ; Poisson errors ; ; ; Now fit a Gaussian to see how well we can recover the original ; yfit = mpfitpeak(x, y, a, error=sy) ; print, p ; ; Generates a synthetic data set with a Gaussian peak, and Poisson ; statistical uncertainty. Then the same function is fitted to the ; data. ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; ; New algorithm for estimating starting values, CM, 31 Oct 1999 ; Documented, 02 Nov 1999 ; Small documentation fixes, 02 Nov 1999 ; Slight correction to calculation of dx, CM, 02 Nov 1999 ; Documented PERROR for unweighted fits, 03 Nov 1999, CM ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Change requirements on # elements in X and Y, 20 Jul 2000, CM ; (thanks to David Schlegel ) ; Added documentation on area under curve, 29 Aug 2000, CM ; Added POSITIVE and NEGATIVE keywords, 17 Nov 2000, CM ; Added reference to Moffat paper, 10 Jan 2001, CM ; Added usage message, 26 Jul 2001, CM ; Documentation clarification, 05 Sep 2001, CM ; Make more consistent with comparable IDL routines, 30 Jun 2003, CM ; Assumption of sorted data was removed, CM, 06 Sep 2003, CM ; Add some defensive code against divide by zero, 30 Nov 2005, CM ; Add some defensive code against all Y values equal to each other, ; 17 Apr 2005, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Add COMPATIBILITY section, CM, 13 Dec 2007 ; Missed some old IDL 4 () array syntax, now corrected, 13 Jun 2008 ; Slightly more error checking for pathalogical case, CM, 11 Nov 2008 ; Clarify documentation regarding what happens when ESTIMATES is not ; set, CM, 14 Dec 2008 ; Add the NAN keyword, document how NAN, WEIGHTS and ERROR interact, ; CM, 30 Mar 2009 ; Correct one case of old IDL 4 () array syntax (thanks to I. Urra), ; CM, 25 Jan 2010 ; Improve performance by analytic derivative computation, added AUTODERIV ; keyword, W. Landsman, 2011-01-21 ; Move estimation code to its own function; allow the user to compute ; only the estimate and return immediately without fitting, ; C. Markwardt, 2011-07-12 ; ; $Id: mpfitpeak.pro,v 1.19 2011/12/08 17:51:33 cmarkwar Exp $ ;- ; Copyright (C) 1997-2001, 2003, 2005, 2007, 2008, 2009, 2010, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function mpfit, mpfitfun, mpfitpeak, mpfitpeak_gauss, $ mpfitpeak_lorentz, mpfitpeak_moffat, mpfitpeak_u function mpfitpeak_u, x, p COMPILE_OPT strictarr wid = abs(p[2]) > 1e-20 return, ((x-p[1])/wid) end ; Gaussian Function function mpfitpeak_gauss, x, p, pder, _extra=extra COMPILE_OPT strictarr,hidden sz = size(x,/type) if sz EQ 5 then smax = 26D else smax = 13. u = mpfitpeak_u(x, p) mask = abs(u) LT smax ;; Prevents floating underflow Np = N_elements(p) if Np GE 4 then f = p[3] else f = 0 if Np GE 5 then f = f + p[4]*x uz = mask*exp(-0.5 * u^2 * mask) if N_params() GT 2 then begin ;; Compute derivatives if asked pder = make_array(N_elements(x), Np,type= size(p,/type) ) pder[*,0] = uz if p[2] NE 0 then pder[*,1] = p[0]*uz*u/p[2] pder[*,2] = pder[*,1]*u if Np GE 4 then pder[*,3] = 1. if Np GE 5 then pder[*,4] = x endif return, f + p[0] * uz end ; Lorentzian Function function mpfitpeak_lorentz, x, p, pder, _extra=extra COMPILE_OPT strictarr,hidden u = mpfitpeak_u(x, p) Np = N_elements(p) if Np GE 4 then f = p[3] else f = 0 if Np GE 5 then f = f + p[4]*x denom = 1/(u^2 + 1) if N_params() GT 2 then begin ;; Compute derivatives if asked pder = make_array(N_elements(x), Np,type= size(p,/type) ) pder[*,0] = denom if p[2] NE 0 then pder[*,1] = 2*p[0]*u*denom*denom/p[2] pder[*,2] = pder[*,1]*u if Np GE 4 then pder[*,3] = 1. if Np GE 5 then pder[*,4] = x endif return, f + p[0] *denom end ; Moffat Function function mpfitpeak_moffat, x, p, pder,_extra=extra COMPILE_OPT strictarr u = mpfitpeak_u(x, p) Np = N_elements(p) if Np GE 5 then f = p[4] else f = 0 if Np GE 6 then f = f + p[5]*x denom0 = (u^2 +1) denom = denom0^(-p[3]) if N_params() GT 2 then begin ;; Compute derivatives if asked pder = make_array(N_elements(x), Np,type= size(p,/type) ) pder[*,0] = denom if p[2] NE 0 then pder[*,1] = 2*p[3]*p[0]*u*denom/p[2]/denom0 pder[*,2] = pder[*,1]*u pder[*,3] = -alog(denom0)*p[0]*denom if Np GE 5 then pder[*,4] = 1. if Np GE 6 then pder[*,5] = x endif return, f + p[0]* denom end ; ; Utility function to estimate peak parameters from an X,Y dataset ; ; X - independent variable ; Y - dependent variable (possibly noisy) ; NAN - if set, then ignore NAN values ; POSITIVE_PEAK - if set, search for positive peak ; NEGATIVE_PEAK - if set, search for negative peak ; (if neither POSITIVE_PEAK nor NEGATIVE_PEAK is set, then search ; for the largest magnitude peak) ; ERRMSG - upon return, set to an error code if an error occurred ; function mpfitpeak_est, x, y, nan=nan, $ positive_peak=pos, negative_peak=neg, $ errmsg=errmsg ;; Here is the secret - the width is estimated based on the area ;; above/below the average. Thus, as the signal becomes more ;; noisy the width automatically broadens as it should. nx = n_elements(x) is = sort(x) xs = x[is] & ys = y[is] maxx = max(xs, min=minx) & maxy = max(ys, min=miny, nan=nan) dx = 0.5 * [xs[1]-xs[0], xs[2:*] - xs, xs[nx-1] - xs[nx-2]] totarea = total(dx*ys, nan=nan) ;; Total area under curve av = totarea/(maxx - minx) ;; Average height ;; Degenerate case: all flat with no noise if miny EQ maxy then begin est = ys[0]*0.0 + [0,xs[nx/2],(xs[nx-1]-xs[0])/2, ys[0]] guess = 1 return, est endif ;; Compute the spread in values above and below average... we ;; take the narrowest one as the one with the peak wh1 = where(y GE av, ct1) wh2 = where(y LE av, ct2) if ct1 EQ 0 OR ct2 EQ 0 then begin errmsg = 'ERROR: average Y value should fall within the range of Y data values but does not' return, !values.d_nan endif sd1 = total(x[wh1]^2)/ct1 - (total(x[wh1])/ct1)^2 sd2 = total(x[wh2]^2)/ct2 - (total(x[wh2])/ct2)^2 ;; Compute area above/below average if keyword_set(pos) then goto, POS_PEAK if keyword_set(neg) then goto, NEG_PEAK if sd1 LT sd2 then begin ;; This is a positive peak POS_PEAK: cent = x[where(y EQ maxy)] & cent = cent[0] peak = maxy - av endif else begin ;; This is a negative peak NEG_PEAK: cent = x[where(y EQ miny)] & cent = cent[0] peak = miny - av endelse peakarea = totarea - total(dx*(ys n_elements(est)) p0[0] = est ;; If the user wanted only to get an estimate, then return here if keyword_set(no_fit) then begin status = 5 a = est return, !values.d_nan endif ;; Function call a = mpfitfun(fun, x, y, 0, p0[0:nterms[0]-1], weights=weights, $ bestnorm=bestnorm, nfev=nfev, status=status, $ nfree=nfree, dof=dof, nan=nan, $ parinfo=parinfo, perror=perror, niter=iter, yfit=yfit, $ best_fjac=best_fjac, pfree_index=pfree_index, covar=covar, $ quiet=quiet, errmsg=errmsg, autoderiv=autoderiv, _EXTRA=extra) ;; Print error message if there is one. if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /cont if status NE 0 then begin ;; Make sure the width is positive a[2] = abs(a[2]) ;; For compatibility with GAUSSFIT if n_elements(perror) GT 0 then sigma = perror if n_elements(bestnorm) GT 0 then chisq = bestnorm ;; Root mean squared of residuals yerror = a[0]*0 if n_elements(dof) GT 0 AND dof[0] GT 0 then begin yerror[0] = sqrt( total( (y-yfit)^2, nan=nan ) / dof[0]) endif return, yfit endif return, !values.d_nan end mpfit2dpeak.pro0000644000244500024450000004576112717414567013333 0ustar craigmcraigm;+ ; NAME: ; MPFIT2DPEAK ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Fit a gaussian, lorentzian or Moffat model to data ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; yfit = MPFIT2DPEAK(Z, A [, X, Y, /TILT ...] ) ; ; DESCRIPTION: ; ; MPFIT2DPEAK fits a gaussian, lorentzian or Moffat model using the ; non-linear least squares fitter MPFIT. MPFIT2DPEAK is meant to be ; a drop-in replacement for IDL's GAUSS2DFIT function (and requires ; MPFIT and MPFIT2DFUN). ; ; The choice of the fitting function is determined by the keywords ; GAUSSIAN, LORENTZIAN and MOFFAT. By default the gaussian model ; function is used. [ The Moffat function is a modified Lorentzian ; with variable power law index. ] The two-dimensional peak has ; independent semimajor and semiminor axes, with an optional ; rotation term activated by setting the TILT keyword. The baseline ; is assumed to be a constant. ; ; GAUSSIAN A[0] + A[1]*exp(-0.5*u) ; LORENTZIAN A[0] + A[1]/(u + 1) ; MOFFAT A[0] + A[1]/(u + 1)^A[7] ; ; u = ( (x-A[4])/A[2] )^2 + ( (y-A[5])/A[3] )^2 ; ; where x and y are cartesian coordinates in rotated ; coordinate system if TILT keyword is set. ; ; The returned parameter array elements have the following meanings: ; ; A[0] Constant baseline level ; A[1] Peak value ; A[2] Peak half-width (x) -- gaussian sigma or half-width at half-max ; A[3] Peak half-width (y) -- gaussian sigma or half-width at half-max ; A[4] Peak centroid (x) ; A[5] Peak centroid (y) ; A[6] Rotation angle (radians) if TILT keyword set ; A[7] Moffat power law index if MOFFAT keyword set ; ; By default the initial starting values for the parameters A are ; estimated from the data. However, explicit starting values can be ; supplied using the ESTIMATES keyword. Also, error or weighting ; values can optionally be provided; otherwise the fit is ; unweighted. ; ; RESTRICTIONS: ; ; If no starting parameter ESTIMATES are provided, then MPFIT2DPEAK ; attempts to estimate them from the data. This is not a perfect ; science; however, the author believes that the technique ; implemented here is more robust than the one used in IDL's ; GAUSS2DFIT. The author has tested cases of strong peaks, noisy ; peaks and broad peaks, all with success. ; ; Note that if PARINFO is supplied, PARINFO(*).VALUES is ignored. ; If you wish to supply starting values, use the ESTIMATES keyword. ; ; MPFIT2DPEAK works in two steps. First, it computes initial ; ESTIMATES if none are provided, not using MPFIT. Second, it uses ; the initial ESTIMATES to fit a refined solution using MPFIT. The ; first step, initial estimates, is not required to match any ; constraints supplied with the PARINFO keyword parameter. Thus, if ; you don't supply ESTIMATES but do supply PARINFO, it is possible ; for MPFIT to fail with an error that parameters exceed their ; PARINFO limits. To avoid this situation, call MPFIT2DPEAK with ; ESTIMATES explicitly. ; ; COMPATIBILITY ; ; This function is designed to work with IDL 5.0 or greater. ; ; Because TIED parameters rely on the EXECUTE() function, they cannot ; be used with the free version of the IDL Virtual Machine. ; ; ; INPUTS: ; ; Z - Two dimensional array of "measured" dependent variable values. ; Z should be of the same type and dimension as (X # Y). ; ; X - Optional vector of x positions for a single row of Z. ; ; X[i] should provide the x position of Z[i,*] ; ; Default: X values are integer increments from 0 to NX-1 ; ; Y - Optional vector of y positions for a single column of Z. ; ; Y[j] should provide the y position of Z[*,j] ; ; Default: Y values are integer increments from 0 to NY-1 ; ; OUTPUTS: ; A - Upon return, an array of best fit parameter values. See the ; table above for the meanings of each parameter element. ; ; ; RETURNS: ; ; Returns the best fitting model function as a 2D array. ; ; KEYWORDS: ; ; ** NOTE ** Additional keywords such as PARINFO, BESTNORM, and ; STATUS are accepted by MPFIT2DPEAK but not documented ; here. Please see the documentation for MPFIT for the ; description of these advanced options. ; ; CHISQ - the value of the summed squared residuals for the ; returned parameter values. ; ; CIRCULAR - if set, then the peak profile is assumed to be ; azimuthally symmetric. When set, the parameters A[2) ; and A[3) will be identical and the TILT keyword will ; have no effect. ; ; DOF - number of degrees of freedom, computed as ; DOF = N_ELEMENTS(DEVIATES) - NFREE ; Note that this doesn't account for pegged parameters (see ; NPEGGED). ; ; ERROR - upon input, the measured 1-sigma uncertainties in the "Z" ; values. If no ERROR or WEIGHTS are given, then the fit is ; unweighted. ; ; ESTIMATES - Array of starting values for each parameter of the ; model. If ESTIMATES is not set, then the starting ; values are estimated from the data directly, before ; fitting. (This also means that PARINFO.VALUES is ; ignored.) ; Default: not set - parameter values are estimated from data. ; ; GAUSSIAN - if set, fit a gaussian model function. The Default. ; LORENTZIAN - if set, fit a lorentzian model function. ; MOFFAT - if set, fit a Moffat model function. ; ; MEASURE_ERRORS - synonym for ERRORS, for consistency with built-in ; IDL fitting routines. ; ; NEGATIVE - if set, and ESTIMATES is not provided, then MPFIT2DPEAK ; will assume that a negative peak is present -- a ; valley. Specifying this keyword is not normally ; required, since MPFIT2DPEAK can determine this ; automatically. ; ; NFREE - the number of free parameters in the fit. This includes ; parameters which are not FIXED and not TIED, but it does ; include parameters which are pegged at LIMITS. ; ; PERROR - upon return, the 1-sigma uncertainties of the parameter ; values A. These values are only meaningful if the ERRORS ; or WEIGHTS keywords are specified properly. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. ; ; *If* you can assume that the true reduced chi-squared ; value is unity -- meaning that the fit is implicitly ; assumed to be of good quality -- then the estimated ; parameter uncertainties can be computed by scaling PERROR ; by the measured chi-squared value. ; ; DOF = N_ELEMENTS(Z) - N_ELEMENTS(A) ; deg of freedom ; PCERROR = PERROR * SQRT(BESTNORM / DOF) ; scaled uncertainties ; ; QUIET - if set then diagnostic fitting messages are suppressed. ; Default: QUIET=1 (i.e., no diagnostics) ; ; SIGMA - synonym for PERROR (1-sigma parameter uncertainties), for ; compatibility with GAUSSFIT. Do not confuse this with the ; Gaussian "sigma" width parameter. ; ; TILT - if set, then the major and minor axes of the peak profile ; are allowed to rotate with respect to the image axes. ; Parameter A[6] will be set to the clockwise rotation angle ; of the A[2] axis in radians. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. If WEIGHTS is specified then the ERR ; parameter is ignored. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Z-MYFUNCT(X,Y,P))^2 * ABS(WEIGHTS) ) ; ; Here are common values of WEIGHTS: ; ; 1D/ERR^2 - Normal weighting (ERR is the measurement error) ; 1D/Y - Poisson weighting (counting statistics) ; 1D - Unweighted ; ; The ERROR keyword takes precedence over any WEIGHTS ; keyword values. If no ERROR or WEIGHTS are given, then ; the fit is unweighted. ; ; ; EXAMPLE: ; ; ; Construct a sample gaussian surface in range [-5,5] centered at [2,-3] ; x = findgen(100)*0.1 - 5. & y = x ; xx = x # (y*0 + 1) ; yy = (x*0 + 1) # y ; rr = sqrt((xx-2.)^2 + (yy+3.)^2) ; ; ; Gaussian surface with sigma=0.5, peak value of 3, noise with sigma=0.2 ; z = 3.*exp(-(rr/0.5)^2) + randomn(seed,100,100)*.2 ; ; ; Fit gaussian parameters A ; zfit = mpfit2dpeak(z, a, x, y) ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; ; New algorithm for estimating starting values, CM, 31 Oct 1999 ; Documented, 02 Nov 1999 ; Small documentation fixes, 02 Nov 1999 ; Documented PERROR for unweighted fits, 03 Nov 1999, CM ; Copying permission terms have been liberalized, 26 Mar 2000, CM ; Small cosmetic changes, 21 Sep 2000, CM ; Corrected bug introduced by cosmetic changes, 11 Oct 2000, CM :-) ; Added POSITIVE keyword, 17 Nov 2000, CM ; Removed TILT in common, in favor of FUNCTARGS approach, 23 Nov ; 2000, CM ; Added SYMMETRIC keyword, documentation for TILT, and an example, ; 24 Nov 2000, CM ; Changed SYMMETRIC to CIRCULAR, 17 Dec 2000, CM ; Really change SYMMETRIC to CIRCULAR!, 13 Sep 2002, CM ; Add error messages for SYMMETRIC and CIRCLE, 08 Nov 2002, CM ; Make more consistent with comparable IDL routines, 30 Jun 2003, CM ; Defend against users supplying strangely dimensioned X and Y, 29 ; Jun 2005, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Add COMPATIBILITY section, CM, 13 Dec 2007 ; Clarify documentation regarding what happens when ESTIMATES is not ; set, CM, 14 Dec 2008 ; Add more documentation about the interaction of ESTIMATES and ; PARINFO, CM, 2013-05-28 ; ; $Id: mpfit2dpeak.pro,v 1.11 2013/07/18 03:25:40 cmarkwar Exp $ ;- ; Copyright (C) 1997-2000, 2002, 2003, 2005, 2006, 2007, 2008, 2013 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function mpfit, mpfitfun, mpfit2dpeak, mpfit2dpeak_gauss, $ mpfit2dpeak_lorentz, mpfit2dpeak_moffat, mpfit2dpeak_u ; Compute the "u" value = (x/a)^2 + (y/b)^2 with optional rotation function mpfit2dpeak_u, x, y, p, tilt=tilt, symmetric=sym COMPILE_OPT strictarr widx = abs(p[2]) > 1e-20 & widy = abs(p[3]) > 1e-20 if keyword_set(sym) then widy = widx xp = x-p[4] & yp = y-p[5] theta = p[6] if keyword_set(tilt) AND theta NE 0 then begin c = cos(theta) & s = sin(theta) return, ( (xp * (c/widx) - yp * (s/widx))^2 + $ (xp * (s/widy) + yp * (c/widy))^2 ) endif else begin return, (xp/widx)^2 + (yp/widy)^2 endelse end ; Gaussian Function function mpfit2dpeak_gauss, x, y, p, tilt=tilt, symmetric=sym, _extra=extra COMPILE_OPT strictarr sz = size(x) if sz[sz[0]+1] EQ 5 then smax = 26D else smax = 13. u = mpfit2dpeak_u(x, y, p, tilt=keyword_set(tilt), symmetric=keyword_set(sym)) mask = u LT (smax^2) ;; Prevents floating underflow return, p[0] + p[1] * mask * exp(-0.5 * u * mask) end ; Lorentzian Function function mpfit2dpeak_lorentz, x, y, p, tilt=tilt, symmetric=sym, _extra=extra COMPILE_OPT strictarr u = mpfit2dpeak_u(x, y, p, tilt=keyword_set(tilt), symmetric=keyword_set(sym)) return, p[0] + p[1] / (u + 1) end ; Moffat Function function mpfit2dpeak_moffat, x, y, p, tilt=tilt, symmetric=sym, _extra=extra COMPILE_OPT strictarr u = mpfit2dpeak_u(x, y, p, tilt=keyword_set(tilt), symmetric=keyword_set(sym)) return, p[0] + p[1] / (u + 1)^p[7] end function mpfit2dpeak, z, a, x, y, estimates=est, tilt=tilt, $ gaussian=gauss, lorentzian=lorentz, moffat=moffat, $ perror=perror, sigma=sigma, zerror=zerror, $ chisq=chisq, bestnorm=bestnorm, niter=iter, nfev=nfev, $ error=dz, weights=weights, measure_errors=dzm, $ nfree=nfree, dof=dof, $ negative=neg, parinfo=parinfo, $ circular=sym, circle=badcircle1, symmetric=badcircle2, $ errmsg=errmsg, status=status, $ query=query, quiet=quiet, _extra=extra COMPILE_OPT strictarr status = 0L errmsg = '' ;; Detect MPFIT and crash if it was not found catch, catcherror if catcherror NE 0 then begin MPFIT_NOTFOUND: catch, /cancel message, 'ERROR: the required functions MPFIT and MPFIT2DFUN ' + $ 'must be in your IDL path', /info return, !values.d_nan endif if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND if mpfit2dfun(/query) NE 1 then goto, MPFIT_NOTFOUND catch, /cancel if keyword_set(query) then return, 1 if keyword_set(badcircle1) OR keyword_set(badcircle2) then $ message, 'ERROR: do not use the CIRCLE or SYMMETRIC keywords. ' +$ 'Use CIRCULAR instead.' ;; Reject too few data if n_elements(z) LT 8 then begin message, 'ERROR: array must have at least eight elements', /info return, !values.d_nan endif sz = size(z) if sz[0] LT 2 then begin message, 'ERROR: array must be 2-dimensional', /info return, !values.d_nan endif nx = sz[1] ny = sz[2] ;; Fill in the X and Y values if needed -- note clever promotion to ;; double if needed if n_elements(x) EQ 0 then x = findgen(nx)*(z[0]*0+1) if n_elements(y) EQ 0 then y = findgen(ny)*(z[0]*0+1) if n_elements(x) LT nx then begin message, 'ERROR: X array was not large enough', /info return, !values.d_nan endif if n_elements(y) LT ny then begin message, 'ERROR: Y array was not large enough', /info return, !values.d_nan endif ;; Make 2D arrays of X and Y values -- if the user hasn't done it if n_elements(x) NE n_elements(z) then xx = x[*] # (y[*]*0 + 1) else xx = x if n_elements(y) NE n_elements(z) then yy = (x[*]*0 + 1) # y[*] else yy = y ;; Compute the weighting factors to use if (n_elements(dz) EQ 0 AND n_elements(weights) EQ 0 AND $ n_elements(dzm) EQ 0) then begin weights = z*0+1 ;; Unweighted by default endif else if n_elements(dz) GT 0 then begin weights = dz * 0 ;; Avoid division by zero wh = where(dz NE 0, ct) if ct GT 0 then weights[wh] = 1./dz[wh]^2 endif else if n_elements(dzm) GT 0 then begin weights = dzm * 0 ;; Avoid division by zero wh = where(dzm NE 0, ct) if ct GT 0 then weights[wh] = 1./dzm[wh]^2 endif if n_elements(est) EQ 0 then begin ;; Here is the secret - the width is estimated based on the volume ;; above/below the average. Thus, as the signal becomes more ;; noisy the width automatically broadens as it should. maxx = max(x, min=minx) & maxy = max(y, min=miny) maxz = max(z, whmax) & minz = min(z, whmin) nx = n_elements(x) dx = 0.5 * [x[1]-x[0], x[2:*] - x, x[nx-1] - x[nx-2]] ny = n_elements(y) dy = 0.5 * [y[1]-y[0], y[2:*] - y, y[ny-1] - y[ny-2]] ;; Compute cell areas da = dx # dy totvol = total(da*z) ;; Total volume under curve av = totvol/(total(dx)*total(dy)) ;; Average height ;; Compute the spread in values above and below average... we ;; take the narrowest one as the one with the peak wh = where(z GE av, ct1) sdx1 = total(xx[wh]^2)/ct1 - (total(xx[wh])/ct1)^2 sdy1 = total(yy[wh]^2)/ct1 - (total(yy[wh])/ct1)^2 wh = where(z LE av, ct2) sdx2 = total(xx[wh]^2)/ct2 - (total(xx[wh])/ct2)^2 sdy2 = total(yy[wh]^2)/ct2 - (total(yy[wh])/ct2)^2 wh = 0 ;; conserve memory if keyword_set(pos) then goto, POS_PEAK if keyword_set(neg) then goto, NEG_PEAK ;; Compute volume above/below average if (sdx1 LT sdx2 AND sdy1 LT sdy2) then begin ;; Positive peak POS_PEAK: centx = xx[whmax] centy = yy[whmax] peakz = maxz - av endif else if (sdx1 GT sdx2 AND sdy1 GT sdy2) then begin ;; Negative peak NEG_PEAK: centx = xx[whmin] centy = yy[whmin] peakz = minz - av endif else begin ;; Ambiguous case if abs(maxz - av) GT (minz - av) then goto, POS_PEAK $ else goto, NEG_PEAK endelse peakvol = totvol - total(da*(z n_elements(est)) p0[0] = est ;; Function call fargs = {tilt: keyword_set(tilt), symmetric: keyword_set(sym)} a = mpfit2dfun(fun, xx, yy, z, 0, p0[0:np-1], weights=weights, $ bestnorm=bestnorm, nfev=nfev, status=status, $ parinfo=parinfo, perror=perror, niter=iter, yfit=yfit, $ quiet=quiet, errmsg=errmsg, nfree=nfree, dof=dof, $ functargs=fargs, _EXTRA=extra) ;; Print error message if there is one. if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /info ;; Make sure the parameters are sane if status NE 0 then begin ;; Width is positive a[2] = abs(a[2]) a[3] = abs(a[3]) if keyword_set(sym) then a[3] = a[2] ;; Make sure that theta is in the range [0,pi] a[6] = ((a[6] MOD !dpi) + 2*!dpi) MOD !dpi a = a[0:np-1] if n_elements(perror) GT 0 then sigma = perror if n_elements(bestnorm) GT 0 then chisq = bestnorm if n_elements(yfit) EQ nx*ny then begin yfit = reform(yfit, nx, ny, /overwrite) endif zerror = a[0]*0 if n_elements(dof) GT 0 AND dof[0] GT 0 then begin zerror[0] = sqrt( total( (z-yfit)^2 ) / dof[0] ) endif return, yfit endif return, !values.d_nan end tnmin.pro0000644000244500024450000021545112717414271012235 0ustar craigmcraigm;+ ; NAME: ; TNMIN ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Performs function minimization (Truncated-Newton Method) ; ; MAJOR TOPICS: ; Optimization and Minimization ; ; CALLING SEQUENCE: ; parms = TNMIN(MYFUNCT, X, FUNCTARGS=fcnargs, NFEV=nfev, ; MAXITER=maxiter, ERRMSG=errmsg, NPRINT=nprint, ; QUIET=quiet, XTOL=xtol, STATUS=status, ; FGUESS=fguess, PARINFO=parinfo, BESTMIN=bestmin, ; ITERPROC=iterproc, ITERARGS=iterargs, niter=niter) ; ; DESCRIPTION: ; ; TNMIN uses the Truncated-Newton method to minimize an arbitrary IDL ; function with respect to a given set of free parameters. The ; user-supplied function must compute the gradient with respect to ; each parameter. TNMIN is based on TN.F (TNBC) by Stephen Nash. ; ; If you want to solve a least-squares problem, to perform *curve* ; *fitting*, then you will probably want to use the routines MPFIT, ; MPFITFUN and MPFITEXPR. Those routines are specifically optimized ; for the least-squares problem. TNMIN is suitable for constrained ; and unconstrained optimization problems with a medium number of ; variables. Function *maximization* can be performed using the ; MAXIMIZE keyword. ; ; TNMIN is similar to MPFIT in that it allows parameters to be fixed, ; simple bounding limits to be placed on parameter values, and ; parameters to be tied to other parameters. One major difference ; between MPFIT and TNMIN is that TNMIN does not compute derivatives ; automatically by default. See PARINFO and AUTODERIVATIVE below for ; more discussion and examples. ; ; USER FUNCTION ; ; The user must define an IDL function which returns the desired ; value as a single scalar. The IDL function must accept a list of ; numerical parameters, P. Additionally, keyword parameters may be ; used to pass more data or information to the user function, via the ; FUNCTARGS keyword. ; ; The user function should be declared in the following way: ; ; FUNCTION MYFUNCT, p, dp [, keywords permitted ] ; ; Parameter values are passed in "p" ; f = .... ; Compute function value ; dp = .... ; Compute partial derivatives (optional) ; return, f ; END ; ; The function *must* accept at least one argument, the parameter ; list P. The vector P is implicitly assumed to be a one-dimensional ; array. Users may pass additional information to the function by ; composing and _EXTRA structure and passing it in the FUNCTARGS ; keyword. ; ; User functions may also indicate a fatal error condition using the ; ERROR_CODE common block variable, as described below under the ; TNMIN_ERROR common block definition (by setting ERROR_CODE to a ; number between -15 and -1). ; ; EXPLICIT vs. NUMERICAL DERIVATIVES ; ; By default, the user must compute the function gradient components ; explicitly using AUTODERIVATIVE=0. As explained below, numerical ; derivatives can also be calculated using AUTODERIVATIVE=1. ; ; For explicit derivatives, the user should call TNMIN using the ; default keyword value AUTODERIVATIVE=0. [ This is different ; behavior from MPFIT, where AUTODERIVATIVE=1 is the default. ] The ; IDL user routine should compute the gradient of the function as a ; one-dimensional array of values, one for each of the parameters. ; They are passed back to TNMIN via "dp" as shown above. ; ; The derivatives with respect to fixed parameters are ignored; zero ; is an appropriate value to insert for those derivatives. Upon ; input to the user function, DP is set to a vector with the same ; length as P, with a value of 1 for a parameter which is free, and a ; value of zero for a parameter which is fixed (and hence no ; derivative needs to be calculated). This input vector may be ; overwritten as needed. ; ; For numerical derivatives, a finite differencing approximation is ; used to estimate the gradient values. Users can activate this ; feature by passing the keyword AUTODERIVATIVE=1. Fine control over ; this behavior can be achieved using the STEP, RELSTEP and TNSIDE ; fields of the PARINFO structure. ; ; When finite differencing is used for computing derivatives (ie, ; when AUTODERIVATIVE=1), the parameter DP is not passed. Therefore ; functions can use N_PARAMS() to indicate whether they must compute ; the derivatives or not. However there is no penalty (other than ; computation time) for computing the gradient values and users may ; switch between AUTODERIVATIVE=0 or =1 in order to test both ; scenarios. ; ; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD ; ; The behavior of TNMIN can be modified with respect to each ; parameter to be optimized. A parameter value can be fixed; simple ; boundary constraints can be imposed; limitations on the parameter ; changes can be imposed; properties of the automatic derivative can ; be modified; and parameters can be tied to one another. ; ; These properties are governed by the PARINFO structure, which is ; passed as a keyword parameter to TNMIN. ; ; PARINFO should be an array of structures, one for each parameter. ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; .VALUE - the starting parameter value (but see the START_PARAMS ; parameter for more information). ; ; .FIXED - a boolean value, whether the parameter is to be held ; fixed or not. Fixed parameters are not varied by ; TNMIN, but are passed on to MYFUNCT for evaluation. ; ; .LIMITED - a two-element boolean array. If the first/second ; element is set, then the parameter is bounded on the ; lower/upper side. A parameter can be bounded on both ; sides. Both LIMITED and LIMITS must be given ; together. ; ; .LIMITS - a two-element float or double array. Gives the ; parameter limits on the lower and upper sides, ; respectively. Zero, one or two of these values can be ; set, depending on the values of LIMITED. Both LIMITED ; and LIMITS must be given together. ; ; .PARNAME - a string, giving the name of the parameter. The ; fitting code of TNMIN does not use this tag in any ; way. ; ; .STEP - the step size to be used in calculating the numerical ; derivatives. If set to zero, then the step size is ; computed automatically. Ignored when AUTODERIVATIVE=0. ; ; .TNSIDE - the sidedness of the finite difference when computing ; numerical derivatives. This field can take four ; values: ; ; 0 - one-sided derivative computed automatically ; 1 - one-sided derivative (f(x+h) - f(x) )/h ; -1 - one-sided derivative (f(x) - f(x-h))/h ; 2 - two-sided derivative (f(x+h) - f(x-h))/(2*h) ; ; Where H is the STEP parameter described above. The ; "automatic" one-sided derivative method will chose a ; direction for the finite difference which does not ; violate any constraints. The other methods do not ; perform this check. The two-sided method is in ; principle more precise, but requires twice as many ; function evaluations. Default: 0. ; ; .TIED - a string expression which "ties" the parameter to other ; free or fixed parameters. Any expression involving ; constants and the parameter array P are permitted. ; Example: if parameter 2 is always to be twice parameter ; 1 then use the following: parinfo(2).tied = '2 * P(1)'. ; Since they are totally constrained, tied parameters are ; considered to be fixed; no errors are computed for them. ; [ NOTE: the PARNAME can't be used in expressions. ] ; ; Future modifications to the PARINFO structure, if any, will involve ; adding structure tags beginning with the two letters "MP" or "TN". ; Therefore programmers are urged to avoid using tags starting with ; these two combinations of letters; otherwise they are free to ; include their own fields within the PARINFO structure, and they ; will be ignored. ; ; PARINFO Example: ; parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $ ; limits:[0.D,0]}, 5) ; parinfo(0).fixed = 1 ; parinfo(4).limited(0) = 1 ; parinfo(4).limits(0) = 50.D ; parinfo(*).value = [5.7D, 2.2, 500., 1.5, 2000.] ; ; A total of 5 parameters, with starting values of 5.7, ; 2.2, 500, 1.5, and 2000 are given. The first parameter ; is fixed at a value of 5.7, and the last parameter is ; constrained to be above 50. ; ; ; INPUTS: ; ; MYFUNCT - a string variable containing the name of the function to ; be minimized (see USER FUNCTION above). The IDL routine ; should return the value of the function and optionally ; its gradients. ; ; X - An array of starting values for each of the parameters of the ; model. ; ; This parameter is optional if the PARINFO keyword is used. ; See above. The PARINFO keyword provides a mechanism to fix or ; constrain individual parameters. If both X and PARINFO are ; passed, then the starting *value* is taken from X, but the ; *constraints* are taken from PARINFO. ; ; ; RETURNS: ; ; Returns the array of best-fit parameters. ; ; ; KEYWORD PARAMETERS: ; ; AUTODERIVATIVE - If this is set, derivatives of the function will ; be computed automatically via a finite ; differencing procedure. If not set, then MYFUNCT ; must provide the (explicit) derivatives. ; Default: 0 (explicit derivatives required) ; ; BESTMIN - upon return, the best minimum function value that TNMIN ; could find. ; ; EPSABS - a nonnegative real variable. Termination occurs when the ; absolute error between consecutive iterates is at most ; EPSABS. Note that using EPSREL is normally preferable ; over EPSABS, except in cases where ABS(F) is much larger ; than 1 at the optimal point. A value of zero indicates ; the absolute error test is not applied. If EPSABS is ; specified, then both EPSREL and EPSABS tests are applied; ; if either succeeds then termination occurs. ; Default: 0 (i.e., only EPSREL is applied). ; ; EPSREL - a nonnegative input variable. Termination occurs when the ; relative error between two consecutive iterates is at ; most EPSREL. Therefore, EPSREL measures the relative ; error desired in the function. An additional, more ; lenient, stopping condition can be applied by specifying ; the EPSABS keyword. ; Default: 100 * Machine Precision ; ; ERRMSG - a string error or warning message is returned. ; ; FGUESS - provides the routine a guess to the minimum value. ; Default: 0 ; ; FUNCTARGS - A structure which contains the parameters to be passed ; to the user-supplied function specified by MYFUNCT via ; the _EXTRA mechanism. This is the way you can pass ; additional data to your user-supplied function without ; using common blocks. ; ; Consider the following example: ; if FUNCTARGS = { XVAL:[1.D,2,3], YVAL:[1.D,4,9]} ; then the user supplied function should be declared ; like this: ; FUNCTION MYFUNCT, P, XVAL=x, YVAL=y ; ; By default, no extra parameters are passed to the ; user-supplied function. ; ; ITERARGS - The keyword arguments to be passed to ITERPROC via the ; _EXTRA mechanism. This should be a structure, and is ; similar in operation to FUNCTARGS. ; Default: no arguments are passed. ; ; ITERDERIV - Intended to print function gradient information. If ; set, then the ITERDERIV keyword is set in each call to ; ITERPROC. In the default ITERPROC, parameter values ; and gradient information are both printed when this ; keyword is set. ; ; ITERPROC - The name of a procedure to be called upon each NPRINT ; iteration of the TNMIN routine. It should be declared ; in the following way: ; ; PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $ ; PARINFO=parinfo, QUIET=quiet, _EXTRA=extra ; ; perform custom iteration update ; END ; ; ITERPROC must accept the _EXTRA keyword, in case of ; future changes to the calling procedure. ; ; MYFUNCT is the user-supplied function to be minimized, ; P is the current set of model parameters, ITER is the ; iteration number, and FUNCTARGS are the arguments to be ; passed to MYFUNCT. FNORM is should be the function ; value. QUIET is set when no textual output should be ; printed. See below for documentation of PARINFO. ; ; In implementation, ITERPROC can perform updates to the ; terminal or graphical user interface, to provide ; feedback while the fit proceeds. If the fit is to be ; stopped for any reason, then ITERPROC should set the ; common block variable ERROR_CODE to negative value ; between -15 and -1 (see TNMIN_ERROR common block ; below). In principle, ITERPROC should probably not ; modify the parameter values, because it may interfere ; with the algorithm's stability. In practice it is ; allowed. ; ; Default: an internal routine is used to print the ; parameter values. ; ; MAXITER - The maximum number of iterations to perform. If the ; number is exceeded, then the STATUS value is set to 5 ; and TNMIN returns. ; Default: 200 iterations ; ; MAXIMIZE - If set, the function is maximized instead of ; minimized. ; ; MAXNFEV - The maximum number of function evaluations to perform. ; If the number is exceeded, then the STATUS value is set ; to -17 and TNMIN returns. A value of zero indicates no ; maximum. ; Default: 0 (no maximum) ; ; NFEV - upon return, the number of MYFUNCT function evaluations ; performed. ; ; NITER - upon return, number of iterations completed. ; ; NPRINT - The frequency with which ITERPROC is called. A value of ; 1 indicates that ITERPROC is called with every iteration, ; while 2 indicates every other iteration, etc. ; Default value: 1 ; ; PARINFO - Provides a mechanism for more sophisticated constraints ; to be placed on parameter values. When PARINFO is not ; passed, then it is assumed that all parameters are free ; and unconstrained. Values in PARINFO are never modified ; during a call to TNMIN. ; ; See description above for the structure of PARINFO. ; ; Default value: all parameters are free and unconstrained. ; ; QUIET - set this keyword when no textual output should be printed ; by TNMIN ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). Gaps in the numbering ; system below are to maintain compatibility with MPFIT. ; Upon return, STATUS can have one of the following values: ; ; -18 a fatal internal error occurred during optimization. ; ; -17 the maximum number of function evaluations has been ; reached without convergence. ; ; -16 a parameter or function value has become infinite or an ; undefined number. This is usually a consequence of ; numerical overflow in the user's function, which must be ; avoided. ; ; -15 to -1 ; these are error codes that either MYFUNCT or ITERPROC ; may return to terminate the fitting process (see ; description of TNMIN_ERROR common below). If either ; MYFUNCT or ITERPROC set ERROR_CODE to a negative number, ; then that number is returned in STATUS. Values from -15 ; to -1 are reserved for the user functions and will not ; clash with TNMIN. ; ; 0 improper input parameters. ; ; 1 convergence was reached. ; ; 2-4 (RESERVED) ; ; 5 the maximum number of iterations has been reached ; ; 6-8 (RESERVED) ; ; ; EXAMPLE: ; ; FUNCTION F, X, DF, _EXTRA=extra ;; *** MUST ACCEPT KEYWORDS ; F = (X(0)-1)^2 + (X(1)+7)^2 ; DF = [ 2D * (X(0)-1), 2D * (X(1)+7) ] ; Gradient ; RETURN, F ; END ; ; P = TNMIN('F', [0D, 0D], BESTMIN=F0) ; Minimizes the function F(x0,x1) = (x0-1)^2 + (x1+7)^2. ; ; ; COMMON BLOCKS: ; ; COMMON TNMIN_ERROR, ERROR_CODE ; ; User routines may stop the fitting process at any time by ; setting an error condition. This condition may be set in either ; the user's model computation routine (MYFUNCT), or in the ; iteration procedure (ITERPROC). ; ; To stop the fitting, the above common block must be declared, ; and ERROR_CODE must be set to a negative number. After the user ; procedure or function returns, TNMIN checks the value of this ; common block variable and exits immediately if the error ; condition has been set. By default the value of ERROR_CODE is ; zero, indicating a successful function/procedure call. ; ; ; REFERENCES: ; ; TRUNCATED-NEWTON METHOD, TN.F ; Stephen G. Nash, Operations Research and Applied Statistics ; Department ; http://www.netlib.org/opt/tn ; ; Nash, S. G. 1984, "Newton-Type Minimization via the Lanczos ; Method," SIAM J. Numerical Analysis, 21, p. 770-778 ; ; ; MODIFICATION HISTORY: ; Derived from TN.F by Stephen Nash with many changes and additions, ; to conform to MPFIT paradigm, 19 Jan 1999, CM ; Changed web address to COW, 25 Sep 1999, CM ; Alphabetized documented keyword parameters, 02 Oct 1999, CM ; Changed to ERROR_CODE for error condition, 28 Jan 2000, CM ; Continued and fairly major improvements (CM, 08 Jan 2001): ; - calling of user procedure is now concentrated in TNMIN_CALL, ; and arguments are reduced by storing a large number of them ; in common blocks; ; - finite differencing is done within TNMIN_CALL; added ; AUTODERIVATIVE=1 so that finite differencing can be enabled, ; both one and two sided; ; - a new procedure to parse PARINFO fields, borrowed from MPFIT; ; brought PARINFO keywords up to date with MPFIT; ; - go through and check for float vs. double discrepancies; ; - add explicit MAXIMIZE keyword, and support in TNMIN_CALL and ; TNMIN_DEFITER to print the correct values in that case; ; TNMIN_DEFITER now prints function gradient values if ; requested; ; - convert to common-based system of MPFIT for storing machine ; constants; revert TNMIN_ENORM to simple sum of squares, at ; least for now; ; - remove limit on number of function evaluations, at least for ; now, and until I can understand what happens when we do ; numerical derivatives. ; Further changes: more float vs double; disable TNMINSTEP for now; ; experimented with convergence test in case of function ; maximization, 11 Jan 2001, CM ; TNMINSTEP is parsed but not enabled, 13 Mar 2001 ; Major code cleanups; internal docs; reduced commons, CM, 08 Apr ; 2001 ; Continued code cleanups; documentation; the STATUS keyword ; actually means something, CM, 10 Apr 2001 ; Added reference to Nash paper, CM, 08 Feb 2002 ; Fixed 16-bit loop indices, D. Schelgel, 22 Apr 2003 ; Changed parens to square brackets because of conflicts with ; limits function. K. Tolbert, 23 Feb 2005 ; Some documentation clarifications, CM, 09 Nov 2007 ; Ensure that MY_FUNCT returns a scalar; make it more likely that ; error messages get back out to the user; fatal CATCH'd error ; now returns STATUS = -18, CM, 17 Sep 2008 ; Fix TNMIN_CALL when parameters are TIEd (thanks to Alfred de ; Wijn), CM, 22 Nov 2009 ; Remember to TIE the parameters before final return (thanks to ; Michael Smith), CM, 20 Jan 2010 ; ; TODO ; - scale derivatives semi-automatically; ; - ability to scale and offset parameters; ; ; $Id: tnmin.pro,v 1.20 2016/05/19 16:08:08 cmarkwar Exp $ ;- ; Copyright (C) 1998-2001,2002,2003,2007,2008,2009 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy and distribute unmodified copies for ; non-commercial purposes, and to modify and use for personal or ; internal use, is granted. All other rights are reserved. ;- ;%% TRUNCATED-NEWTON METHOD: SUBROUTINES ; FOR OTHER MACHINES, MODIFY ROUTINE MCHPR1 (MACHINE EPSILON) ; WRITTEN BY: STEPHEN G. NASH ; OPERATIONS RESEARCH AND APPLIED STATISTICS DEPT. ; GEORGE MASON UNIVERSITY ; FAIRFAX, VA 22030 ;****************************************************************** ;; Routine which declares functions and common blocks pro tnmin_dummy forward_function tnmin_enorm, tnmin_step1, tnmin forward_function tnmin_call, tnmin_autoder common tnmin_error, error_code common tnmin_machar, tnmin_machar_vals common tnmin_config, tnmin_tnconfig common tnmin_fcnargs, tnmin_tnfcnargs common tnmin_work, lsk, lyk, ldiagb, lsr, lyr a = 1 return end ;; Following are machine constants that can be loaded once. I have ;; found that bizarre underflow messages can be produced in each call ;; to MACHAR(), so this structure minimizes the number of calls to ;; one. pro tnmin_setmachar, double=isdouble common tnmin_machar, tnmin_machar_vals ;; In earlier versions of IDL, MACHAR itself could produce a load of ;; error messages. We try to mask some of that out here. if (!version.release) LT 5 then dummy = check_math(1, 1) mch = 0. mch = machar(double=keyword_set(isdouble)) dmachep = mch.eps dmaxnum = mch.xmax dminnum = mch.xmin dmaxlog = alog(mch.xmax) dminlog = alog(mch.xmin) if keyword_set(isdouble) then $ dmaxgam = 171.624376956302725D $ else $ dmaxgam = 171.624376956302725 drdwarf = sqrt(dminnum*1.5) * 10 drgiant = sqrt(dmaxnum) * 0.1 tnmin_machar_vals = {machep: dmachep, maxnum: dmaxnum, minnum: dminnum, $ maxlog: dmaxlog, minlog: dminlog, maxgam: dmaxgam, $ rdwarf: drdwarf, rgiant: drgiant} if (!version.release) LT 5 then dummy = check_math(0, 0) return end ;; Procedure to parse the parameter values in PARINFO pro tnmin_parinfo, parinfo, tnames, tag, values, default=def, status=status, $ n_param=n status = 0 if n_elements(n) EQ 0 then n = n_elements(parinfo) if n EQ 0 then begin if n_elements(def) EQ 0 then return values = def status = 1 return endif if n_elements(parinfo) EQ 0 then goto, DO_DEFAULT if n_elements(tnames) EQ 0 then tnames = tag_names(parinfo) wh = where(tnames EQ tag, ct) if ct EQ 0 then begin DO_DEFAULT: if n_elements(def) EQ 0 then return values = make_array(n, value=def(0)) values(0) = def endif else begin values = parinfo.(wh(0)) endelse status = 1 return end ;; Procedure to tie one parameter to another. pro tnmin_tie, p, _ptied _wh = where(_ptied NE '', _ct) if _ct EQ 0 then return for _i = 0L, _ct-1 do begin _cmd = 'p('+strtrim(_wh(_i),2)+') = '+_ptied(_wh(_i)) _err = execute(_cmd) if _err EQ 0 then begin message, 'ERROR: Tied expression "'+_cmd+'" failed.' return endif endfor end function tnmin_autoder, fcn, x, dx, dside=dside common tnmin_machar, machvals common tnmin_config, tnconfig MACHEP0 = machvals.machep DWARF = machvals.minnum if n_elements(dside) NE n_elements(x) then dside = tnconfig.dside eps = sqrt(MACHEP0) h = eps * (1. + abs(x)) ;; if STEP is given, use that wh = where(tnconfig.step GT 0, ct) if ct GT 0 then h(wh) = tnconfig.step(wh) ;; if relative step is given, use that wh = where(tnconfig.dstep GT 0, ct) if ct GT 0 then h(wh) = abs(tnconfig.dstep(wh)*x(wh)) ;; In case any of the step values are zero wh = where(h EQ 0, ct) if ct GT 0 then h(wh) = eps ;; Reverse the sign of the step if we are up against the parameter ;; limit, or if the user requested it. mask = (dside EQ -1 OR (tnconfig.ulimited AND (x GT tnconfig.ulimit-h))) wh = where(mask, ct) if ct GT 0 then h(wh) = -h(wh) dx = x * 0. f = tnmin_call(fcn, x) for i = 0L, n_elements(x)-1 do begin if tnconfig.pfixed(i) EQ 1 then goto, NEXT_PAR hh = h(i) RESTART_PAR: xp = x xp(i) = xp(i) + hh fp = tnmin_call(fcn, xp) if abs(dside(i)) LE 1 then begin ;; COMPUTE THE ONE-SIDED DERIVATIVE dx(i) = (fp-f)/hh endif else begin ;; COMPUTE THE TWO-SIDED DERIVATIVE xp(i) = x(i) - hh fm = tnmin_call(fcn, xp) dx(i) = (fp-fm)/(2*hh) endelse NEXT_PAR: endfor return, f end ;; Call user function or procedure, with _EXTRA or not, with ;; derivatives or not. function tnmin_call, fcn, x1, dx, fullparam_=xall ; on_error, 2 common tnmin_config, tnconfig common tnmin_fcnargs, fcnargs ifree = tnconfig.ifree ;; Following promotes the byte array to a floating point array so ;; that users who simply re-fill the array aren't surprised when ;; their gradient comes out as bytes. :-) dx = tnconfig.pfixed + x1(0)*0. if n_elements(xall) GT 0 then begin x = xall x(ifree) = x1 endif else begin x = x1 endelse ;; Enforce TIEd parameters if keyword_set(tnconfig.qanytied) then tnmin_tie, x, tnconfig.ptied ;; Decide whether we are calling a procedure or function if tnconfig.proc then proc = 1 else proc = 0 tnconfig.nfev = tnconfig.nfev + 1 if n_params() EQ 3 then begin if tnconfig.autoderiv then $ f = tnmin_autoder(fcn, x, dx) $ else if n_elements(fcnargs) GT 0 then $ f = call_function(fcn, x, dx, _EXTRA=fcnargs) $ else $ f = call_function(fcn, x, dx) dx = dx(ifree) if tnconfig.max then begin dx = -dx f = -f endif endif else begin if n_elements(fcnargs) GT 0 then $ f = call_function(fcn, x, _EXTRA=fcnargs) $ else $ f = call_function(fcn, x) if n_elements(f) NE 1 then begin message, 'ERROR: function "'+fcn+'" returned a vector when '+$ 'a scalar was expected.' endif endelse if n_elements(f) GT 1 then return, f $ else return, f(0) end function tnmin_enorm, vec common tnmin_config, tnconfig ;; Very simple-minded sum-of-squares if n_elements(tnconfig) GT 0 then if tnconfig.fastnorm then begin ans = sqrt(total(vec^2,1)) goto, TERMINATE endif common tnmin_machar, machvals agiant = machvals.rgiant / n_elements(vec) adwarf = machvals.rdwarf * n_elements(vec) ;; This is hopefully a compromise between speed and robustness. ;; Need to do this because of the possibility of over- or underflow. mx = max(vec, min=mn) mx = max(abs([mx,mn])) if mx EQ 0 then return, vec(0)* 0. if mx GT agiant OR mx LT adwarf then ans = mx * sqrt(total((vec/mx)^2)) $ else ans = sqrt( total(vec^2) ) TERMINATE: return, ans end ; ; ROUTINES TO INITIALIZE PRECONDITIONER ; pro tnmin_initpc, diagb, emat, n, upd1, yksk, gsk, yrsr, lreset ;; Rename common variables as they appear in INITP3. Those ;; indicated in all caps are not used or renamed here. ; common tnmin_work, lsk, lyk, ldiagb, lsr, lyr common tnmin_work, sk, yk, LDIAGB, sr, yr ; I I I I ;; From INITP3 if keyword_set(upd1) then begin EMAT = DIAGB endif else if keyword_set(lreset) then begin BSK = DIAGB*SK SDS = TOTAL(SK*BSK) EMAT = DIAGB - DIAGB*DIAGB*SK*SK/SDS + YK*YK/YKSK endif else begin BSK = DIAGB * SR SDS = TOTAL(SR*BSK) SRDS = TOTAL(SK*BSK) YRSK = TOTAL(YR*SK) BSK = DIAGB*SK - BSK*SRDS/SDS+YR*YRSK/YRSR EMAT = DIAGB-DIAGB*DIAGB*SR*SR/SDS+YR*YR/YRSR SDS = TOTAL(SK*BSK) EMAT = EMAT - BSK*BSK/SDS+YK*YK/YKSK endelse return end pro tnmin_ssbfgs, n, gamma, sj, yj, hjv, hjyj, yjsj, yjhyj, $ vsj, vhyj, hjp1v ; ; SELF-SCALED BFGS ; DELTA = (1. + GAMMA*YJHYJ/YJSJ)*VSJ/YJSJ - GAMMA*VHYJ/YJSJ BETA = -GAMMA*VSJ/YJSJ HJP1V = GAMMA*HJV + DELTA*SJ + BETA*HJYJ RETURN end ; ; THIS ROUTINE ACTS AS A PRECONDITIONING STEP FOR THE ; LINEAR CONJUGATE-GRADIENT ROUTINE. IT IS ALSO THE ; METHOD OF COMPUTING THE SEARCH DIRECTION FROM THE ; GRADIENT FOR THE NON-LINEAR CONJUGATE-GRADIENT CODE. ; IT REPRESENTS A TWO-STEP SELF-SCALED BFGS FORMULA. ; pro tnmin_msolve, g, y, n, upd1, yksk, gsk, yrsr, lreset, first, $ hyr, hyk, ykhyk, yrhyr ;; Rename common variables as they appear in MSLV ; common tnmin_work, lsk, lyk, ldiagb, lsr, lyr common tnmin_work, sk, yk, diagb, sr, yr ; I I I I I ;; From MSLV if keyword_set(UPD1) then begin Y = G / DIAGB RETURN endif ONE = G(0)*0 + 1. GSK = TOTAL(G*SK) if keyword_set(lreset) then begin ; ; COMPUTE GH AND HY WHERE H IS THE INVERSE OF THE DIAGONALS ; HG = G/DIAGB if keyword_set(FIRST) then begin HYK = YK/DIAGB YKHYK = TOTAL(YK*HYK) endif GHYK = TOTAL(G*HYK) TNMIN_SSBFGS,N,ONE,SK,YK,HG,HYK,YKSK, YKHYK,GSK,GHYK,Y RETURN endif ; ; COMPUTE HG AND HY WHERE H IS THE INVERSE OF THE DIAGONALS ; HG = G/DIAGB if keyword_set(FIRST) then begin HYK = YK/DIAGB HYR = YR/DIAGB YKSR = TOTAL(YK*SR) YKHYR = TOTAL(YK*HYR) endif GSR = TOTAL(G*SR) GHYR = TOTAL(G*HYR) if keyword_set(FIRST) then begin YRHYR = TOTAL(YR*HYR) endif TNMIN_SSBFGS,N,ONE,SR,YR,HG,HYR,YRSR, YRHYR,GSR,GHYR,HG if keyword_set(FIRST) then begin TNMIN_SSBFGS,N,ONE,SR,YR,HYK,HYR,YRSR, YRHYR,YKSR,YKHYR,HYK endif YKHYK = TOTAL(HYK*YK) GHYK = TOTAL(HYK*G) TNMIN_SSBFGS,N,ONE,SK,YK,HG,HYK,YKSK, YKHYK,GSK,GHYK,Y RETURN end ; ; THIS ROUTINE COMPUTES THE PRODUCT OF THE MATRIX G TIMES THE VECTOR ; V AND STORES THE RESULT IN THE VECTOR GV (FINITE-DIFFERENCE VERSION) ; pro tnmin_gtims, v, gv, n, x, g, fcn, first, delta, accrcy, xnorm, $ xnew IF keyword_set(FIRST) THEN BEGIN ;; Extra factor of ten is to avoid clashing with the finite ;; difference scheme which computes the derivatives DELTA = SQRT(100*ACCRCY)*(1.+XNORM) ;; XXX diff than TN.F ; DELTA = SQRT(ACCRCY)*(1.+XNORM) FIRST = 0 ENDIF DINV = 1. /DELTA F = tnmin_call(FCN, X + DELTA*V, GV, fullparam_=xnew) GV = (GV-G)*DINV return end ; ; UPDATE THE PRECONDITIOING MATRIX BASED ON A DIAGONAL VERSION ; OF THE BFGS QUASI-NEWTON UPDATE. ; pro tnmin_ndia3, n, e, v, gv, r, vgv VR = TOTAL(V*R) E = E - R*R/VR + GV*GV/VGV wh = where(e LE 1D-6, ct) if ct GT 0 then e(wh) = 1 return end pro tnmin_fix, whlpeg, whupeg, z if whlpeg(0) NE -1 then z(whlpeg) = 0 if whupeg(0) NE -1 then z(whupeg) = 0 end ; ; THIS ROUTINE PERFORMS A PRECONDITIONED CONJUGATE-GRADIENT ; ITERATION IN ORDER TO SOLVE THE NEWTON EQUATIONS FOR A SEARCH ; DIRECTION FOR A TRUNCATED-NEWTON ALGORITHM. WHEN THE VALUE OF THE ; QUADRATIC MODEL IS SUFFICIENTLY REDUCED, ; THE ITERATION IS TERMINATED. ; ; PARAMETERS ; ; ZSOL - COMPUTED SEARCH DIRECTION ; G - CURRENT GRADIENT ; GV,GZ1,V - SCRATCH VECTORS ; R - RESIDUAL ; DIAGB,EMAT - DIAGONAL PRECONDITONING MATRIX ; NITER - NONLINEAR ITERATION # ; FEVAL - VALUE OF QUADRATIC FUNCTION pro tnmin_modlnp, zsol, gv, r, v, diagb, emat, $ x, g, zk, n, niter, maxit, nmodif, nlincg, $ upd1, yksk, gsk, yrsr, lreset, fcn, whlpeg, whupeg, $ accrcy, gtp, gnorm, xnorm, xnew ; ; GENERAL INITIALIZATION ; zero = x(0)* 0. one = zero + 1 IF (MAXIT EQ 0) THEN RETURN FIRST = 1 RHSNRM = GNORM TOL = zero + 1.E-12 QOLD = zero ; ; INITIALIZATION FOR PRECONDITIONED CONJUGATE-GRADIENT ALGORITHM ; tnmin_initpc, diagb, emat, n, upd1, yksk, gsk, yrsr, lreset R = -G V = G*0. ZSOL = V ; ; ************************************************************ ; MAIN ITERATION ; ************************************************************ ; FOR K = 1L, MAXIT DO BEGIN NLINCG = NLINCG + 1 ; ; CG ITERATION TO SOLVE SYSTEM OF EQUATIONS ; tnmin_fix, whlpeg, whupeg, r TNMIN_MSOLVE, R, ZK, N, UPD1, YKSK, GSK, YRSR, LRESET, FIRST, $ HYR, HYK, YKHYK, YRHYR tnmin_fix, whlpeg, whupeg, zk RZ = TOTAL(R*ZK) IF (RZ/RHSNRM LT TOL) THEN GOTO, MODLNP_80 IF (K EQ 1) THEN BETA = ZERO $ ELSE BETA = RZ/RZOLD V = ZK + BETA*V tnmin_fix, whlpeg, whupeg, v TNMIN_GTIMS, V, GV, N, X, G, FCN, FIRST, DELTA, ACCRCY, XNORM, XNEW tnmin_fix, whlpeg, whupeg, gv VGV = TOTAL(V*GV) IF (VGV/RHSNRM LT TOL) THEN GOTO, MODLNP_50 TNMIN_NDIA3, N,EMAT,V,GV,R,VGV ; ; COMPUTE LINEAR STEP LENGTH ; ALPHA = RZ / VGV ; ; COMPUTE CURRENT SOLUTION AND RELATED VECTORS ; ZSOL = ZSOL + ALPHA*V R = R - ALPHA*GV ; ; TEST FOR CONVERGENCE ; GTP = TOTAL(ZSOL*G) PR = TOTAL(R*ZSOL) QNEW = 5.E-1 * (GTP + PR) QTEST = K * (1.E0 - QOLD/QNEW) IF (QTEST LT 0.D0) THEN GOTO, MODLNP_70 QOLD = QNEW IF (QTEST LE 5.D-1) THEN GOTO, MODLNP_70 ; ; PERFORM CAUTIONARY TEST ; IF (GTP GT 0) THEN GOTO, MODLNP_40 RZOLD = RZ ENDFOR ; ; TERMINATE ALGORITHM ; K = K-1 goto, MODLNP_70 MODLNP_40: ZSOL = ZSOL - ALPHA*V GTP = TOTAL(ZSOL*G) goto, MODLNP_90 MODLNP_50: ;; printed output MODLNP_60: IF (K GT 1) THEN GOTO, MODLNP_70 TNMIN_MSOLVE,G,ZSOL,N,UPD1,YKSK,GSK,YRSR,LRESET,FIRST, $ HYR, HYK, YKHYK, YRHYR ZSOL = -ZSOL tnmin_fix, whlpeg, whupeg, zsol GTP = TOTAL(ZSOL*G) MODLNP_70: goto, MODLNP_90 MODLNP_80: IF (K GT 1) THEN GOTO, MODLNP_70 ZSOL = -G tnmin_fix, whlpeg, whupeg, zsol GTP = TOTAL(ZSOL*G) goto, MODLNP_70 ; ; STORE (OR RESTORE) DIAGONAL PRECONDITIONING ; MODLNP_90: diagb = emat return end function tnmin_step1, fnew, fm, gtp, smax, epsmch ; ******************************************************** ; STEP1 RETURNS THE LENGTH OF THE INITIAL STEP TO BE TAKEN ALONG THE ; VECTOR P IN THE NEXT LINEAR SEARCH. ; ******************************************************** D = ABS(FNEW-FM) ALPHA = FNEW(0)*0 + 1. IF (2.D0*D LE (-GTP) AND D GE EPSMCH) THEN $ ALPHA = -2.*D/GTP IF (ALPHA GE SMAX) THEN ALPHA = SMAX return, alpha end ; ; ************************************************************ ; GETPTC, AN ALGORITHM FOR FINDING A STEPLENGTH, CALLED REPEATEDLY BY ; ROUTINES WHICH REQUIRE A STEP LENGTH TO BE COMPUTED USING CUBIC ; INTERPOLATION. THE PARAMETERS CONTAIN INFORMATION ABOUT THE INTERVAL ; IN WHICH A LOWER POINT IS TO BE FOUND AND FROM THIS GETPTC COMPUTES A ; POINT AT WHICH THE FUNCTION CAN BE EVALUATED BY THE CALLING PROGRAM. ; THE VALUE OF THE INTEGER PARAMETERS IENTRY DETERMINES THE PATH TAKEN ; THROUGH THE CODE. ; ************************************************************ pro tnmin_getptc, big, small, rtsmll, reltol, abstol, tnytol, $ fpresn, eta, rmu, xbnd, u, fu, gu, xmin, fmin, gmin, $ xw, fw, gw, a, b, oldf, b1, scxbnd, e, step, factor, $ braktd, gtest1, gtest2, tol, ientry, itest ;; This chicanery is so that we get the data types right ZERO = fu(0)* 0. ; a1 = zero & scale = zero & chordm = zero ; chordu = zero & d1 = zero & d2 = zero ; denom = zero POINT1 = ZERO + 0.1 HALF = ZERO + 0.5 ONE = ZERO + 1 THREE = ZERO + 3 FIVE = ZERO + 5 ELEVEN = ZERO + 11 if ientry EQ 1 then begin ;; else clause = 20 (OK) ; ; IENTRY=1 ; CHECK INPUT PARAMETERS ; ;; GETPTC_10: ITEST = 2 IF (U LE ZERO OR XBND LE TNYTOL OR GU GT ZERO) THEN RETURN ITEST = 1 IF (XBND LT ABSTOL) THEN ABSTOL = XBND TOL = ABSTOL TWOTOL = TOL + TOL ; ; A AND B DEFINE THE INTERVAL OF UNCERTAINTY, X AND XW ARE POINTS ; WITH LOWEST AND SECOND LOWEST FUNCTION VALUES SO FAR OBTAINED. ; INITIALIZE A,SMIN,XW AT ORIGIN AND CORRESPONDING VALUES OF ; FUNCTION AND PROJECTION OF THE GRADIENT ALONG DIRECTION OF SEARCH ; AT VALUES FOR LATEST ESTIMATE AT MINIMUM. ; A = ZERO XW = ZERO XMIN = ZERO OLDF = FU FMIN = FU FW = FU GW = GU GMIN = GU STEP = U FACTOR = FIVE ; ; THE MINIMUM HAS NOT YET BEEN BRACKETED. ; BRAKTD = 0 ; ; SET UP XBND AS A BOUND ON THE STEP TO BE TAKEN. (XBND IS NOT COMPUTED ; EXPLICITLY BUT SCXBND IS ITS SCALED VALUE.) SET THE UPPER BOUND ; ON THE INTERVAL OF UNCERTAINTY INITIALLY TO XBND + TOL(XBND). ; SCXBND = XBND B = SCXBND + RELTOL*ABS(SCXBND) + ABSTOL E = B + B B1 = B ; ; COMPUTE THE CONSTANTS REQUIRED FOR THE TWO CONVERGENCE CRITERIA. ; GTEST1 = -RMU*GU GTEST2 = -ETA*GU ; ; SET IENTRY TO INDICATE THAT THIS IS THE FIRST ITERATION ; IENTRY = 2 goto, GETPTC_210 endif ; ; IENTRY = 2 ; ; UPDATE A,B,XW, AND XMIN ; ;; GETPTC_20: IF (FU GT FMIN) THEN GOTO, GETPTC_60 ; ; IF FUNCTION VALUE NOT INCREASED, NEW POINT BECOMES NEXT ; ORIGIN AND OTHER POINTS ARE SCALED ACCORDINGLY. ; CHORDU = OLDF - (XMIN + U)*GTEST1 if NOT (FU LE CHORDU) then begin ; ; THE NEW FUNCTION VALUE DOES NOT SATISFY THE SUFFICIENT DECREASE ; CRITERION. PREPARE TO MOVE THE UPPER BOUND TO THIS POINT AND ; FORCE THE INTERPOLATION SCHEME TO EITHER BISECT THE INTERVAL OF ; UNCERTAINTY OR TAKE THE LINEAR INTERPOLATION STEP WHICH ESTIMATES ; THE ROOT OF F(ALPHA)=CHORD(ALPHA). ; CHORDM = OLDF - XMIN*GTEST1 GU = -GMIN DENOM = CHORDM-FMIN IF (ABS(DENOM) LT 1.D-15) THEN BEGIN DENOM = ZERO + 1.E-15 IF (CHORDM-FMIN LT 0.D0) THEN DENOM = -DENOM ENDIF IF (XMIN NE ZERO) THEN GU = GMIN*(CHORDU-FU)/DENOM FU = (HALF*U*(GMIN+GU) + FMIN) > FMIN ; ; IF FUNCTION VALUE INCREASED, ORIGIN REMAINS UNCHANGED ; BUT NEW POINT MAY NOW QUALIFY AS W. ; GETPTC_60: IF (U GE ZERO) THEN BEGIN B = U BRAKTD = 1 ENDIF ELSE BEGIN A = U ENDELSE XW = U FW = FU GW = GU endif else begin ;; GETPTC_30: FW = FMIN FMIN = FU GW = GMIN GMIN = GU XMIN = XMIN + U A = A-U B = B-U XW = -U SCXBND = SCXBND - U IF (GU GT ZERO) THEN BEGIN B = ZERO BRAKTD = 1 ENDIF ELSE BEGIN A = ZERO ENDELSE TOL = ABS(XMIN)*RELTOL + ABSTOL endelse TWOTOL = TOL + TOL XMIDPT = HALF*(A + B) ; ; CHECK TERMINATION CRITERIA ; CONVRG = ABS(XMIDPT) LE TWOTOL - HALF*(B-A) OR $ ABS(GMIN) LE GTEST2 AND FMIN LT OLDF AND $ (ABS(XMIN - XBND) GT TOL OR NOT BRAKTD) IF CONVRG THEN BEGIN ITEST = 0 IF (XMIN NE ZERO) THEN RETURN ; ; IF THE FUNCTION HAS NOT BEEN REDUCED, CHECK TO SEE THAT THE RELATIVE ; CHANGE IN F(X) IS CONSISTENT WITH THE ESTIMATE OF THE DELTA- ; UNIMODALITY CONSTANT, TOL. IF THE CHANGE IN F(X) IS LARGER THAN ; EXPECTED, REDUCE THE VALUE OF TOL. ; ITEST = 3 IF (ABS(OLDF-FW) LE FPRESN*(ONE + ABS(OLDF))) THEN RETURN TOL = POINT1*TOL IF (TOL LT TNYTOL) THEN RETURN RELTOL = POINT1*RELTOL ABSTOL = POINT1*ABSTOL TWOTOL = POINT1*TWOTOL endif ; ; CONTINUE WITH THE COMPUTATION OF A TRIAL STEP LENGTH ; ;; GETPTC_100: R = ZERO Q = ZERO S = ZERO IF (ABS(E) GT TOL) THEN BEGIN ; ; FIT CUBIC THROUGH XMIN AND XW ; R = THREE*(FMIN-FW)/XW + GMIN + GW ABSR = ABS(R) Q = ABSR IF (GW EQ ZERO OR GMIN EQ ZERO) EQ 0 THEN BEGIN ;; else clause = 140 (OK) ; ; COMPUTE THE SQUARE ROOT OF (R*R - GMIN*GW) IN A WAY ; WHICH AVOIDS UNDERFLOW AND OVERFLOW. ; ABGW = ABS(GW) ABGMIN = ABS(GMIN) S = SQRT(ABGMIN)*SQRT(ABGW) IF ((GW/ABGW)*GMIN LE ZERO) THEN BEGIN ; ; COMPUTE THE SQUARE ROOT OF R*R + S*S. ; SUMSQ = ONE P = ZERO IF (ABSR LT S) THEN BEGIN ;; else clause = 110 (OK) ; ; THERE IS A POSSIBILITY OF OVERFLOW. ; IF (S GT RTSMLL) THEN P = S*RTSMLL IF (ABSR GE P) THEN SUMSQ = ONE +(ABSR/S)^2 SCALE = S endif else begin ;; flow to 120 (OK) ; ; THERE IS A POSSIBILITY OF UNDERFLOW. ; ;; GETPTC_110: IF (ABSR GT RTSMLL) THEN P = ABSR*RTSMLL IF (S GE P) THEN SUMSQ = ONE + (S/ABSR)^2 SCALE = ABSR ENDELSE ;; flow to 120 (OK) ;; GETPTC_120: SUMSQ = SQRT(SUMSQ) Q = BIG IF (SCALE LT BIG/SUMSQ) THEN Q = SCALE*SUMSQ endif else begin ;; flow to 140 ; ; COMPUTE THE SQUARE ROOT OF R*R - S*S ; ;; GETPTC_130: Q = SQRT(ABS(R+S))*SQRT(ABS(R-S)) IF (R GE S OR R LE (-S)) EQ 0 THEN BEGIN R = ZERO Q = ZERO goto, GETPTC_150 endif endelse endif ; ; COMPUTE THE MINIMUM OF FITTED CUBIC ; ;; GETPTC_140: IF (XW LT ZERO) THEN Q = -Q S = XW*(GMIN - R - Q) Q = GW - GMIN + Q + Q IF (Q GT ZERO) THEN S = -S IF (Q LE ZERO) THEN Q = -Q R = E IF (B1 NE STEP OR BRAKTD) THEN E = STEP endif ; ; CONSTRUCT AN ARTIFICIAL BOUND ON THE ESTIMATED STEPLENGTH ; GETPTC_150: A1 = A B1 = B STEP = XMIDPT IF (BRAKTD) EQ 0 THEN BEGIN ;; else flow to 160 (OK) STEP = -FACTOR*XW IF (STEP GT SCXBND) THEN STEP = SCXBND IF (STEP NE SCXBND) THEN FACTOR = FIVE*FACTOR ;; flow to 170 (OK) endif else begin ; ; IF THE MINIMUM IS BRACKETED BY 0 AND XW THE STEP MUST LIE ; WITHIN (A,B). ; ;; GETPTC_160: if (a NE zero OR xw GE zero) AND (b NE zero OR xw LE zero) then $ goto, GETPTC_180 ; ; IF THE MINIMUM IS NOT BRACKETED BY 0 AND XW THE STEP MUST LIE ; WITHIN (A1,B1). ; D1 = XW D2 = A IF (A EQ ZERO) THEN D2 = B ; THIS LINE MIGHT BE ; IF (A EQ ZERO) THEN D2 = E U = - D1/D2 STEP = FIVE*D2*(POINT1 + ONE/U)/ELEVEN IF (U LT ONE) THEN STEP = HALF*D2*SQRT(U) endelse ;; GETPTC_170: IF (STEP LE ZERO) THEN A1 = STEP IF (STEP GT ZERO) THEN B1 = STEP ; ; REJECT THE STEP OBTAINED BY INTERPOLATION IF IT LIES OUTSIDE THE ; REQUIRED INTERVAL OR IT IS GREATER THAN HALF THE STEP OBTAINED ; DURING THE LAST-BUT-ONE ITERATION. ; GETPTC_180: if NOT (abs(s) LE abs(half*q*r) OR s LE q*a1 OR s GE q*b1) then begin ;; else clause = 200 (OK) ; ; A CUBIC INTERPOLATION STEP ; STEP = S/Q ; ; THE FUNCTION MUST NOT BE EVALUTATED TOO CLOSE TO A OR B. ; if NOT (step - a GE twotol AND b - step GE twotol) then begin ;; else clause = 210 (OK) IF (XMIDPT LE ZERO) THEN STEP = -TOL ELSE STEP = TOL endif ;; flow to 210 (OK) endif else begin ;; GETPTC_200: E = B-A endelse ; ; IF THE STEP IS TOO LARGE, REPLACE BY THE SCALED BOUND (SO AS TO ; COMPUTE THE NEW POINT ON THE BOUNDARY). ; GETPTC_210: if (step GE scxbnd) then begin ;; else clause = 220 (OK) STEP = SCXBND ; ; MOVE SXBD TO THE LEFT SO THAT SBND + TOL(XBND) = XBND. ; SCXBND = SCXBND - (RELTOL*ABS(XBND)+ABSTOL)/(ONE + RELTOL) endif ;; GETPTC_220: U = STEP IF (ABS(STEP) LT TOL AND STEP LT ZERO) THEN U = -TOL IF (ABS(STEP) LT TOL AND STEP GE ZERO) THEN U = TOL ITEST = 1 RETURN end ; ; LINE SEARCH ALGORITHMS OF GILL AND MURRAY ; pro tnmin_linder, n, fcn, small, epsmch, reltol, abstol, $ tnytol, eta, sftbnd, xbnd, p, gtp, x, f, alpha, g, $ iflag, xnew zero = f(0) * 0. one = zero + 1. LSPRNT = 0L NPRNT = 10000L RTSMLL = SQRT(SMALL) BIG = 1./SMALL ITCNT = 0L ; ; SET THE ESTIMATED RELATIVE PRECISION IN F(X). ; FPRESN = 10.*EPSMCH U = ALPHA FU = F FMIN = F GU = GTP RMU = zero + 1E-4 ; ; FIRST ENTRY SETS UP THE INITIAL INTERVAL OF UNCERTAINTY. ; IENTRY = 1L LINDER_10: ; ; TEST FOR TOO MANY ITERATIONS ; ITCNT = ITCNT + 1 IF (ITCNT GT 30) THEN BEGIN ;; deviation from Nash: allow optimization to continue in outer ;; loop even if we fail to converge, if IFLAG EQ 0. A value of ;; 1 indicates failure. I believe that I tried IFLAG=0 once and ;; there was some problem, but I forget what it was. IFLAG = 1 F = FMIN ALPHA = XMIN X = X + ALPHA*P RETURN ENDIF IFLAG = 0 TNMIN_GETPTC,BIG,SMALL,RTSMLL,RELTOL,ABSTOL,TNYTOL, $ FPRESN,ETA,RMU,XBND,U,FU,GU,XMIN,FMIN,GMIN, $ XW,FW,GW,A,B,OLDF,B1,SCXBND,E,STEP,FACTOR, $ BRAKTD,GTEST1,GTEST2,TOL,IENTRY,ITEST ; ; IF ITEST=1, THE ALGORITHM REQUIRES THE FUNCTION VALUE TO BE ; CALCULATED. ; IF (ITEST EQ 1) THEN BEGIN UALPHA = XMIN + U FU = TNMIN_CALL(FCN, X + UALPHA*P, LG, fullparam_=xnew) GU = TOTAL(LG*P) ; ; THE GRADIENT VECTOR CORRESPONDING TO THE BEST POINT IS ; OVERWRITTEN IF FU IS LESS THAN FMIN AND FU IS SUFFICIENTLY ; LOWER THAN F AT THE ORIGIN. ; IF (FU LE FMIN AND FU LE OLDF-UALPHA*GTEST1) THEN $ G = LG ; print, 'fu = ', fu GOTO, LINDER_10 ENDIF ; ; IF ITEST=2 OR 3 A LOWER POINT COULD NOT BE FOUND ; IFLAG = 1 IF (ITEST NE 0) THEN RETURN ; ; IF ITEST=0 A SUCCESSFUL SEARCH HAS BEEN MADE ; ; print, 'itcnt = ', itcnt IFLAG = 0 F = FMIN ALPHA = XMIN X = X + ALPHA*P RETURN END pro tnmin_defiter, fcn, x, iter, fnorm, fmt=fmt, FUNCTARGS=fcnargs, $ quiet=quiet, deriv=df, dprint=dprint, pfixed=pfixed, $ maximize=maximize, _EXTRA=iterargs if keyword_set(quiet) then return if n_params() EQ 3 then begin fnorm = tnmin_call(fcn, x, df) endif if keyword_set(maximize) then f = -fnorm else f = fnorm print, iter, f, format='("Iter ",I6," FUNCTION = ",G20.8)' if n_elements(fmt) GT 0 then begin print, x, format=fmt endif else begin n = n_elements(x) ii = lindgen(n) p = ' P('+strtrim(ii,2)+') = '+string(x,format='(G)') if keyword_set(dprint) then begin p1 = strarr(n) wh = where(pfixed EQ 0, ct) if ct GT 0 AND n_elements(df) GE ct then begin if keyword_set(maximize) then df1 = -df else df1 = df p1(wh) = string(df1, format='(G)') endif wh = where(pfixed EQ 1, ct) if ct GT 0 then $ p1(wh) = ' (FIXED)' p = p + ' : DF/DP('+strtrim(ii,2)+') = '+p1 endif print, p, format='(A)' endelse return end ; SUBROUTINE TNBC (IERROR, N, X, F, G, W, LW, SFUN, LOW, UP, IPIVOT) ; IMPLICIT DOUBLE PRECISION (A-H,O-Z) ; INTEGER IERROR, N, LW, IPIVOT(N) ; DOUBLE PRECISION X(N), G(N), F, W(LW), LOW(N), UP(N) ; ; THIS ROUTINE SOLVES THE OPTIMIZATION PROBLEM ; ; MINIMIZE F(X) ; X ; SUBJECT TO LOW <= X <= UP ; ; WHERE X IS A VECTOR OF N REAL VARIABLES. THE METHOD USED IS ; A TRUNCATED-NEWTON ALGORITHM (SEE "NEWTON-TYPE MINIMIZATION VIA ; THE LANCZOS ALGORITHM" BY S.G. NASH (TECHNICAL REPORT 378, MATH. ; THE LANCZOS METHOD" BY S.G. NASH (SIAM J. NUMER. ANAL. 21 (1984), ; PP. 770-778). THIS ALGORITHM FINDS A LOCAL MINIMUM OF F(X). IT DOES ; NOT ASSUME THAT THE FUNCTION F IS CONVEX (AND SO CANNOT GUARANTEE A ; GLOBAL SOLUTION), BUT DOES ASSUME THAT THE FUNCTION IS BOUNDED BELOW. ; IT CAN SOLVE PROBLEMS HAVING ANY NUMBER OF VARIABLES, BUT IT IS ; ESPECIALLY USEFUL WHEN THE NUMBER OF VARIABLES (N) IS LARGE. ; ; SUBROUTINE PARAMETERS: ; ; IERROR - (INTEGER) ERROR CODE ; ( 0 => NORMAL RETURN ; ( 2 => MORE THAN MAXFUN EVALUATIONS ; ( 3 => LINE SEARCH FAILED TO FIND LOWER ; ( POINT (MAY NOT BE SERIOUS) ; (-1 => ERROR IN INPUT PARAMETERS ; N - (INTEGER) NUMBER OF VARIABLES ; X - (REAL*8) VECTOR OF LENGTH AT LEAST N; ON INPUT, AN INITIAL ; ESTIMATE OF THE SOLUTION; ON OUTPUT, THE COMPUTED SOLUTION. ; G - (REAL*8) VECTOR OF LENGTH AT LEAST N; ON OUTPUT, THE FINAL ; VALUE OF THE GRADIENT ; F - (REAL*8) ON INPUT, A ROUGH ESTIMATE OF THE VALUE OF THE ; OBJECTIVE FUNCTION AT THE SOLUTION; ON OUTPUT, THE VALUE ; OF THE OBJECTIVE FUNCTION AT THE SOLUTION ; W - (REAL*8) WORK VECTOR OF LENGTH AT LEAST 14*N ; LW - (INTEGER) THE DECLARED DIMENSION OF W ; SFUN - A USER-SPECIFIED SUBROUTINE THAT COMPUTES THE FUNCTION ; AND GRADIENT OF THE OBJECTIVE FUNCTION. IT MUST HAVE ; THE CALLING SEQUENCE ; SUBROUTINE SFUN (N, X, F, G) ; INTEGER N ; DOUBLE PRECISION X(N), G(N), F ; LOW, UP - (REAL*8) VECTORS OF LENGTH AT LEAST N CONTAINING ; THE LOWER AND UPPER BOUNDS ON THE VARIABLES. IF ; THERE ARE NO BOUNDS ON A PARTICULAR VARIABLE, SET ; THE BOUNDS TO -1.D38 AND 1.D38, RESPECTIVELY. ; IPIVOT - (INTEGER) WORK VECTOR OF LENGTH AT LEAST N, USED ; TO RECORD WHICH VARIABLES ARE AT THEIR BOUNDS. ; ; THIS IS AN EASY-TO-USE DRIVER FOR THE MAIN OPTIMIZATION ROUTINE ; LMQNBC. MORE EXPERIENCED USERS WHO WISH TO CUSTOMIZE PERFORMANCE ; OF THIS ALGORITHM SHOULD CALL LMQBC DIRECTLY. ; ;---------------------------------------------------------------------- ; THIS ROUTINE SETS UP ALL THE PARAMETERS FOR THE TRUNCATED-NEWTON ; ALGORITHM. THE PARAMETERS ARE: ; ; ETA - SEVERITY OF THE LINESEARCH ; MAXFUN - MAXIMUM ALLOWABLE NUMBER OF FUNCTION EVALUATIONS ; XTOL - DESIRED ACCURACY FOR THE SOLUTION X* ; STEPMX - MAXIMUM ALLOWABLE STEP IN THE LINESEARCH ; ACCRCY - ACCURACY OF COMPUTED FUNCTION VALUES ; MSGLVL - CONTROLS QUANTITY OF PRINTED OUTPUT ; 0 = NONE, 1 = ONE LINE PER MAJOR ITERATION. ; MAXIT - MAXIMUM NUMBER OF INNER ITERATIONS PER STEP ; function tnmin, fcn, xall, fguess=fguess, functargs=fcnargs, parinfo=parinfo, $ epsrel=epsrel0, epsabs=epsabs0, fastnorm=fastnorm, $ nfev=nfev, maxiter=maxiter0, maxnfev=maxfun0, maximize=fmax, $ errmsg=errmsg, nprint=nprint, status=status, nocatch=nocatch, $ iterproc=iterproc, iterargs=iterargs, niter=niter,quiet=quiet,$ autoderivative=autoderiv, iterderiv=iterderiv, bestmin=f if n_elements(nprint) EQ 0 then nprint = 1 if n_elements(iterproc) EQ 0 then iterproc = 'TNMIN_DEFITER' if n_elements(autoderiv) EQ 0 then autoderiv = 0 if n_elements(msglvl) EQ 0 then msglvl = 0 if n_params() EQ 0 then begin message, "USAGE: PARMS = TNMIN('MYFUNCT', START_PARAMS, ... )", /info return, !values.d_nan endif iterd = keyword_set(iterderiv) maximize = keyword_set(fmax) status = 0L nfev = 0L errmsg = '' catch_msg = 'in TNMIN' common tnmin_config, tnconfig tnconfig = {fastnorm: keyword_set(fastnorm), proc: 0, nfev: 0L, $ autoderiv: keyword_set(autoderiv), max: maximize} ;; Handle error conditions gracefully if NOT keyword_set(nocatch) then begin catch, catcherror if catcherror NE 0 then begin catch, /cancel err_string = ''+!error_state.msg message, /cont, 'Error detected while '+catch_msg+':' message, /cont, err_string message, /cont, 'Error condition detected. Returning to MAIN level.' if errmsg EQ '' then $ errmsg = 'Error detected while '+catch_msg+': '+err_string if status EQ 0 then status = -18 return, !values.d_nan endif endif ;; Parinfo: ;; --------------- STARTING/CONFIG INFO (passed in to routine, not changed) ;; .value - starting value for parameter ;; .fixed - parameter is fixed ;; .limited - a two-element array, if parameter is bounded on ;; lower/upper side ;; .limits - a two-element array, lower/upper parameter bounds, if ;; limited vale is set ;; .step - step size in Jacobian calc, if greater than zero catch_msg = 'parsing input parameters' ;; Parameters can either be stored in parinfo, or x. Parinfo takes ;; precedence if it exists. if n_elements(xall) EQ 0 AND n_elements(parinfo) EQ 0 then begin errmsg = 'ERROR: must pass parameters in X or PARINFO' goto, TERMINATE endif ;; Be sure that PARINFO is of the right type if n_elements(parinfo) GT 0 then begin parinfo_size = size(parinfo) if parinfo_size(parinfo_size(0)+1) NE 8 then begin errmsg = 'ERROR: PARINFO must be a structure.' goto, TERMINATE endif if n_elements(xall) GT 0 AND n_elements(xall) NE n_elements(parinfo) $ then begin errmsg = 'ERROR: number of elements in PARINFO and X must agree' goto, TERMINATE endif endif ;; If the parameters were not specified at the command line, then ;; extract them from PARINFO if n_elements(xall) EQ 0 then begin tnmin_parinfo, parinfo, tagnames, 'VALUE', xall, status=stx if stx EQ 0 then begin errmsg = 'ERROR: either X or PARINFO(*).VALUE must be supplied.' goto, TERMINATE endif sz = size(xall) ;; Convert to double if parameters are not float or double if sz(sz(0)+1) NE 4 AND sz(sz(0)+1) NE 5 then $ xall = double(xall) endif npar = n_elements(xall) zero = xall(0) * 0. one = zero + 1 ten = zero + 10 twothird = (zero+2)/(zero+3) quarter = zero + 0.25 half = zero + 0.5 ;; Extract machine parameters sz = size(xall) tp = sz(sz(0)+1) if tp NE 4 AND tp NE 5 then begin if NOT keyword_set(quiet) then begin message, 'WARNING: input parameters must be at least FLOAT', /info message, ' (converting parameters to FLOAT)', /info endif xall = float(xall) sz = size(xall) endif isdouble = (sz(sz(0)+1) EQ 5) common tnmin_machar, machvals tnmin_setmachar, double=isdouble MCHPR1 = machvals.machep ;; TIED parameters? tnmin_parinfo, parinfo, tagnames, 'TIED', ptied, default='', n=npar ptied = strtrim(ptied, 2) wh = where(ptied NE '', qanytied) qanytied = qanytied GT 0 tnconfig = create_struct(tnconfig, 'QANYTIED', qanytied, 'PTIED', ptied) ;; FIXED parameters ? tnmin_parinfo, parinfo, tagnames, 'FIXED', pfixed, default=0, n=npar pfixed = pfixed EQ 1 pfixed = pfixed OR (ptied NE '') ;; Tied parameters are also effectively fixed ;; Finite differencing step, absolute and relative, and sidedness of derivative tnmin_parinfo, parinfo, tagnames, 'STEP', step, default=zero, n=npar tnmin_parinfo, parinfo, tagnames, 'RELSTEP', dstep, default=zero, n=npar tnmin_parinfo, parinfo, tagnames, 'TNSIDE', dside, default=2, n=npar ;; Maximum and minimum steps allowed to be taken in one iteration tnmin_parinfo, parinfo, tagnames, 'TNMAXSTEP', maxstep, default=zero, n=npar tnmin_parinfo, parinfo, tagnames, 'TNMINSTEP', minstep, default=zero, n=npar qmin = minstep * 0 ;; Disable minstep for now qmax = maxstep NE 0 wh = where(qmin AND qmax AND maxstep LT minstep, ct) if ct GT 0 then begin errmsg = 'ERROR: TNMINSTEP is greater than TNMAXSTEP' goto, TERMINATE endif wh = where(qmin AND qmax, ct) qminmax = ct GT 0 ;; Finish up the free parameters ifree = where(pfixed NE 1, ct) if ct EQ 0 then begin errmsg = 'ERROR: no free parameters' goto, TERMINATE endif ;; Compose only VARYING parameters xnew = xall ;; xnew is the set of parameters to be returned x = xnew(ifree) ;; x is the set of free parameters ;; LIMITED parameters ? tnmin_parinfo, parinfo, tagnames, 'LIMITED', limited, status=st1 tnmin_parinfo, parinfo, tagnames, 'LIMITS', limits, status=st2 if st1 EQ 1 AND st2 EQ 1 then begin ;; Error checking on limits in parinfo wh = where((limited[0,*] AND xall LT limits[0,*]) OR $ (limited[1,*] AND xall GT limits[1,*]), ct) if ct GT 0 then begin errmsg = 'ERROR: parameters are not within PARINFO limits' goto, TERMINATE endif wh = where(limited[0,*] AND limited[1,*] AND $ limits[0,*] GE limits[1,*] AND pfixed EQ 0, ct) if ct GT 0 then begin errmsg = 'ERROR: PARINFO parameter limits are not consistent' goto, TERMINATE endif ;; Transfer structure values to local variables qulim = limited[1, ifree] ulim = limits [1, ifree] qllim = limited[0, ifree] llim = limits [0, ifree] wh = where(qulim OR qllim, ct) if ct GT 0 then qanylim = 1 else qanylim = 0 endif else begin ;; Fill in local variables with dummy values qulim = lonarr(n_elements(ifree)) ulim = x * 0. qllim = qulim llim = x * 0. qanylim = 0 endelse tnconfig = create_struct(tnconfig, $ 'PFIXED', pfixed, 'IFREE', ifree, $ 'STEP', step, 'DSTEP', dstep, 'DSIDE', dside, $ 'ULIMITED', qulim, 'ULIMIT', ulim) common tnmin_fcnargs, tnfcnargs tnfcnargs = 0 & dummy = temporary(tnfcnargs) if n_elements(fcnargs) GT 0 then tnfcnargs = fcnargs ;; SET UP CUSTOMIZING PARAMETERS ;; ETA - SEVERITY OF THE LINESEARCH ;; MAXFUN - MAXIMUM ALLOWABLE NUMBER OF FUNCTION EVALUATIONS ;; XTOL - DESIRED ACCURACY FOR THE SOLUTION X* ;; STEPMX - MAXIMUM ALLOWABLE STEP IN THE LINESEARCH ;; ACCRCY - ACCURACY OF COMPUTED FUNCTION VALUES ;; MSGLVL - DETERMINES QUANTITY OF PRINTED OUTPUT ;; 0 = NONE, 1 = ONE LINE PER MAJOR ITERATION. ;; MAXIT - MAXIMUM NUMBER OF INNER ITERATIONS PER STEP n = n_elements(x) if n_elements(maxit) EQ 0 then begin maxit = (n/2) < 50 > 2 ;; XXX diff than TN.F endif if n_elements(maxfun0) EQ 0 then $ maxfun = 0L $ else $ maxfun = floor(maxfun0(0)) > 1 ; maxfun = 150L*n ; if keyword_set(autoderiv) then $ ; maxfun = maxfun*(1L + round(total(abs(dside)> 1 < 2))) eta = zero + 0.25 stepmx = zero + 10 if n_elements(maxiter0) EQ 0 then $ maxiter = 200L $ else $ maxiter = floor(maxiter0(0)) > 1 g = replicate(x(0)* 0., n) ;; call minimizer ; ; THIS ROUTINE IS A BOUNDS-CONSTRAINED TRUNCATED-NEWTON METHOD. ; THE TRUNCATED-NEWTON METHOD IS PRECONDITIONED BY A LIMITED-MEMORY ; QUASI-NEWTON METHOD (THIS PRECONDITIONING STRATEGY IS DEVELOPED ; IN THIS ROUTINE) WITH A FURTHER DIAGONAL SCALING (SEE ROUTINE NDIA3). ; FOR FURTHER DETAILS ON THE PARAMETERS, SEE ROUTINE TNBC. ; ; ; initialize variables ; common tnmin_work, lsk, lyk, ldiagb, lsr, lyr ; I/O I/O I/O I/O I/O lsk = 0 & lyk = 0 & ldiagb = 0 & lsr = 0 & lyr = 0 zero = x(0)* 0. one = zero + 1 if n_elements(fguess) EQ 0 then fguess = one if maximize then f = -fguess else f = fguess conv = 0 & lreset = 0 & upd1 = 0 & newcon = 0 gsk = zero & yksk = zero & gtp = zero & gtpnew = zero & yrsr = zero upd1 = 1 ireset = 0L nmodif = 0L nlincg = 0L fstop = f conv = 0 nm1 = n - 1 ;; From CHKUCP ; ; CHECKS PARAMETERS AND SETS CONSTANTS WHICH ARE COMMON TO BOTH ; DERIVATIVE AND NON-DERIVATIVE ALGORITHMS ; EPSMCH = MCHPR1 SMALL = EPSMCH*EPSMCH TINY = SMALL NWHY = -1L ; ; SET CONSTANTS FOR LATER ; ;; Some of these constants have been moved around for clarity (!) if n_elements(epsrel0) EQ 0 then epsrel = 100*MCHPR1 $ else epsrel = epsrel0(0)+0. if n_elements(epsabs0) EQ 0 then epsabs = zero $ else epsabs = abs(epsabs0(0))+0. ACCRCY = epsrel XTOL = sqrt(ACCRCY) RTEPS = SQRT(EPSMCH) RTOL = XTOL IF (ABS(RTOL) LT ACCRCY) THEN RTOL = 10. *RTEPS FTOL2 = 0 FTOL1 = RTOL^2 + EPSMCH ;; For func chg convergence test (U1a) if epsabs NE 0 then $ FTOL2 = EPSABS + EPSMCH ;; For absolute func convergence test (U1b) PTOL = RTOL + RTEPS ;; For parm chg convergence test (U2) GTOL1 = ACCRCY^TWOTHIRD ;; For gradient convergence test (U3, squared) GTOL2 = (1D-2*XTOL)^2 ;; For gradient convergence test (U4, squared) ; ; CHECK FOR ERRORS IN THE INPUT PARAMETERS ; IF (ETA LT 0.D0 OR STEPMX LT RTOL) THEN BEGIN errmsg = 'ERROR: input keywords are inconsistent' goto, TERMINATE endif ;; Check input parameters for errors if (n LE 0) OR (xtol LE 0) OR (maxit LE 0) then begin errmsg = 'ERROR: input keywords are inconsistent' goto, TERMINATE endif NWHY = 0L XNORM = TNMIN_ENORM(X) ALPHA = zero TEST = zero ; From SETUCR ; ; CHECK INPUT PARAMETERS, COMPUTE THE INITIAL FUNCTION VALUE, SET ; CONSTANTS FOR THE SUBSEQUENT MINIMIZATION ; fm = f ; ; COMPUTE THE INITIAL FUNCTION VALUE ; catch_msg = 'calling TNMIN_CALL' fnew = tnmin_call(fcn, x, g, fullparam_=xnew) ; ; SET CONSTANTS FOR LATER ; NITER = 0L OLDF = FNEW GTG = TOTAL(G*G) common tnmin_error, tnerr if nprint GT 0 AND iterproc NE '' then begin iflag = 0L if (niter-1) MOD nprint EQ 0 then begin catch_msg = 'calling '+iterproc tnerr = 0 call_procedure, iterproc, fcn, xnew, niter, fnew, $ FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $ dprint=iterd, deriv=g, pfixed=pfixed, maximize=maximize, $ _EXTRA=iterargs iflag = tnerr if iflag LT 0 then begin errmsg = 'WARNING: premature termination by "'+iterproc+'"' nwhy = 4L goto, CLEANUP endif endif endif fold = fnew flast = fnew ; From LMQNBC ; ; TEST THE LAGRANGE MULTIPLIERS TO SEE IF THEY ARE NON-NEGATIVE. ; BECAUSE THE CONSTRAINTS ARE ONLY LOWER BOUNDS, THE COMPONENTS ; OF THE GRADIENT CORRESPONDING TO THE ACTIVE CONSTRAINTS ARE THE ; LAGRANGE MULTIPLIERS. AFTERWORDS, THE PROJECTED GRADIENT IS FORMED. ; catch_msg = 'zeroing derivatives of pegged parameters' lmask = qllim AND (x EQ llim) AND (g GE 0) umask = qulim AND (x EQ ulim) AND (g LE 0) whlpeg = where(lmask, nlpeg) whupeg = where(umask, nupeg) tnmin_fix, whlpeg, whupeg, g GTG = TOTAL(G*G) ; ; CHECK IF THE INITIAL POINT IS A LOCAL MINIMUM. ; FTEST = ONE + ABS(FNEW) IF (GTG LT GTOL2*FTEST*FTEST) THEN GOTO, CLEANUP ; ; SET INITIAL VALUES TO OTHER PARAMETERS ; ICYCLE = NM1 GNORM = SQRT(GTG) DIFNEW = ZERO EPSRED = HALF/TEN FKEEP = FNEW ; ; SET THE DIAGONAL OF THE APPROXIMATE HESSIAN TO UNITY. ; LDIAGB = replicate(one, n) ; ; ..................START OF MAIN ITERATIVE LOOP.......... ; ; COMPUTE THE NEW SEARCH DIRECTION ; catch_msg = 'calling TNMIN_MODLNP' tnmin_modlnp, lpk, lgv, lz1, lv, ldiagb, lemat, $ x, g, lzk, n, niter, maxit, nmodif, nlincg, upd1, yksk, $ gsk, yrsr, lreset, fcn, whlpeg, whupeg, accrcy, gtpnew, gnorm, xnorm, $ xnew ITER_LOOP: catch_msg = 'computing step length' LOLDG = G PNORM = tnmin_enorm(LPK) OLDF = FNEW OLDGTP = GTPNEW ; ; PREPARE TO COMPUTE THE STEP LENGTH ; PE = PNORM + EPSMCH ; ; COMPUTE THE ABSOLUTE AND RELATIVE TOLERANCES FOR THE LINEAR SEARCH ; RELTOL = RTEPS*(XNORM + ONE)/PE ABSTOL = - EPSMCH*FTEST/(OLDGTP - EPSMCH) ; ; COMPUTE THE SMALLEST ALLOWABLE SPACING BETWEEN POINTS IN ; THE LINEAR SEARCH ; TNYTOL = EPSMCH*(XNORM + ONE)/PE ;; From STPMAX SPE = STEPMX/PE mmask = (NOT lmask AND NOT umask) wh = where(mmask AND (lpk GT 0) AND qulim AND (ulim - x LT spe*lpk), ct) if ct GT 0 then begin spe = min( (ulim(wh)-x(wh)) / lpk(wh)) endif wh = where(mmask AND (lpk LT 0) AND qllim AND (llim - x GT spe*lpk), ct) if ct GT 0 then begin spe = min( (llim(wh)-x(wh)) / lpk(wh)) endif ;; From LMQNBC ; ; SET THE INITIAL STEP LENGTH. ; ALPHA = TNMIN_STEP1(FNEW,FM,OLDGTP,SPE, epsmch) ; ; PERFORM THE LINEAR SEARCH ; catch_msg = 'performing linear search' tnmin_linder, n, fcn, small, epsmch, reltol, abstol, tnytol, $ eta, zero, spe, lpk, oldgtp, x, fnew, alpha, g, nwhy, xnew NEWCON = 0 IF (ABS(ALPHA-SPE) GT 1.D1*EPSMCH) EQ 0 THEN BEGIN NEWCON = 1 NWHY = 0L ;; From MODZ mmask = (NOT lmask AND NOT umask) wh = where(mmask AND (lpk LT 0) AND qllim $ AND (x-llim LE 10*epsmch*(abs(llim)+one)),ct) if ct GT 0 then begin flast = fnew lmask(wh) = 1 x(wh) = llim(wh) whlpeg = where(lmask, nlpeg) endif wh = where(mmask AND (lpk GT 0) AND qulim $ AND (ulim-x LE 10*epsmch*(abs(ulim)+one)),ct) if ct GT 0 then begin flast = fnew umask(wh) = 1 x(wh) = ulim(wh) whupeg = where(umask, nupeg) endif xnew(ifree) = x ;; From LMQNBC FLAST = FNEW endif FOLD = FNEW NITER = NITER + 1 ; ; IF REQUIRED, PRINT THE DETAILS OF THIS ITERATION ; if nprint GT 0 AND iterproc NE '' then begin iflag = 0L xx = xnew xx(ifree) = x if (niter-1) MOD nprint EQ 0 then begin catch_msg = 'calling '+iterproc tnerr = 0 call_procedure, iterproc, fcn, xx, niter, fnew, $ FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $ dprint=iterd, deriv=g, pfixed=pfixed, maximize=maximize, $ _EXTRA=iterargs iflag = tnerr if iflag LT 0 then begin errmsg = 'WARNING: premature termination by "'+iterproc+'"' nwhy = 4L goto, CLEANUP endif endif endif catch_msg = 'testing for convergence' IF (NWHY LT 0) THEN BEGIN NWHY = -2L goto, CLEANUP ENDIF IF (NWHY NE 0 AND NWHY NE 2) THEN BEGIN ;; THE LINEAR SEARCH HAS FAILED TO FIND A LOWER POINT NWHY = 3L goto, CLEANUP endif if nwhy GT 1 then begin fnew = tnmin_call(fcn, x, g, fullparam_=xnew) endif wh = where(finite(x) EQ 0, ct) if ct GT 0 OR finite(fnew) EQ 0 then begin nwhy = -3L goto, CLEANUP endif ; ; TERMINATE IF MORE THAN MAXFUN EVALUATIONS HAVE BEEN MADE ; NWHY = 2L if maxfun GT 0 AND tnconfig.nfev GT maxfun then goto, CLEANUP if niter GT maxiter then goto, CLEANUP NWHY = 0L ; ; SET UP PARAMETERS USED IN CONVERGENCE AND RESETTING TESTS ; DIFOLD = DIFNEW DIFNEW = OLDF - FNEW ; ; IF THIS IS THE FIRST ITERATION OF A NEW CYCLE, COMPUTE THE ; PERCENTAGE REDUCTION FACTOR FOR THE RESETTING TEST. ; IF (ICYCLE EQ 1) THEN BEGIN IF (DIFNEW GT 2.D0*DIFOLD) THEN EPSRED = EPSRED + EPSRED IF (DIFNEW LT 5.0D-1*DIFOLD) THEN EPSRED = HALF*EPSRED ENDIF LGV = G tnmin_fix, whlpeg, whupeg, lgv GTG = TOTAL(LGV*LGV) GNORM = SQRT(GTG) FTEST = ONE + ABS(FNEW) XNORM = tnmin_enorm(X) ;; From CNVTST LTEST = (FLAST - FNEW) LE (-5.D-1*GTPNEW) wh = where((lmask AND g LT 0) OR (umask AND g GT 0), ct) if ct GT 0 then begin conv = 0 if NOT ltest then begin mx = max(abs(g(wh)), wh2) lmask(wh(wh2)) = 0 & umask(wh(wh2)) = 0 FLAST = FNEW goto, CNVTST_DONE endif endif ;; Gill Murray and Wright tests are listed to the right. ;; Modifications due to absolute function value test are done here. fconv = abs(DIFNEW) LT FTOL1*FTEST ;; U1a if ftol2 EQ 0 then begin pconv = ALPHA*PNORM LT PTOL*(ONE + XNORM) ;; U2 gconv = GTG LT GTOL1*FTEST*FTEST ;; U3 endif else begin ;; Absolute tolerance implies a loser constraint on parameters fconv = fconv OR (abs(difnew) LT ftol2) ;; U1b acc2 = (FTOL2/FTEST + EPSMCH) pconv = ALPHA*PNORM LT SQRT(acc2)*(ONE + XNORM) ;; U2 gconv = GTG LT (acc2^twothird)*FTEST*FTEST ;; U3 endelse IF ((PCONV AND FCONV AND GCONV) $ ;; U1 + U2 + U3 OR (GTG LT GTOL2*FTEST*FTEST)) THEN BEGIN ;; U4 CONV = 1 ENDIF ELSE BEGIN ;; Convergence failed CONV = 0 ENDELSE ; ; FOR DETAILS, SEE GILL, MURRAY, AND WRIGHT (1981, P. 308) AND ; FLETCHER (1981, P. 116). THE MULTIPLIER TESTS (HERE, TESTING ; THE SIGN OF THE COMPONENTS OF THE GRADIENT) MAY STILL NEED TO ; MODIFIED TO INCORPORATE TOLERANCES FOR ZERO. ; CNVTST_DONE: ;; From LMQNBC IF (CONV) THEN GOTO, CLEANUP tnmin_fix, whlpeg, whupeg, g ; ; COMPUTE THE CHANGE IN THE ITERATES AND THE CORRESPONDING CHANGE ; IN THE GRADIENTS ; IF NEWCON EQ 0 THEN BEGIN LYK = G - LOLDG LSK = ALPHA*LPK ; ; SET UP PARAMETERS USED IN UPDATING THE PRECONDITIONING STRATEGY. ; YKSK = TOTAL(LYK*LSK) LRESET = 0 IF (ICYCLE EQ NM1 OR DIFNEW LT EPSRED*(FKEEP-FNEW)) THEN LRESET = 1 IF (LRESET EQ 0) THEN BEGIN YRSR = TOTAL(LYR*LSR) IF (YRSR LE ZERO) THEN LRESET = 1 ENDIF UPD1 = 0 ENDIF ; ; COMPUTE THE NEW SEARCH DIRECTION ; ;; TNMIN_90: catch_msg = 'calling TNMIN_MODLNP' tnmin_modlnp, lpk, lgv, lz1, lv, ldiagb, lemat, $ x, g, lzk, n, niter, maxit, nmodif, nlincg, upd1, yksk, $ gsk, yrsr, lreset, fcn, whlpeg, whupeg, accrcy, gtpnew, gnorm, xnorm, $ xnew IF (NEWCON) THEN GOTO, ITER_LOOP ; IF (NOT LRESET) OR ICYCLE EQ 1 AND n_elements(LSR) GT 0 THEN BEGIN ;; For testing IF (LRESET EQ 0) THEN BEGIN ; ; COMPUTE THE ACCUMULATED STEP AND ITS CORRESPONDING ; GRADIENT DIFFERENCE. ; LSR = LSR + LSK LYR = LYR + LYK ICYCLE = ICYCLE + 1 goto, ITER_LOOP ENDIF ; ; RESET ; ;; TNMIN_110: IRESET = IRESET + 1 ; ; INITIALIZE THE SUM OF ALL THE CHANGES IN X. ; LSR = LSK LYR = LYK FKEEP = FNEW ICYCLE = 1L goto, ITER_LOOP ; ; ...............END OF MAIN ITERATION....................... ; CLEANUP: nfev = tnconfig.nfev tnfcnargs = 0 catch, /cancel case NWHY of -3: begin ;; INDEFINITE VALUE status = -16L if errmsg EQ '' then $ errmsg = ('ERROR: parameter or function value(s) have become '+$ 'infinite; check model function for over- '+$ 'and underflow') return, !values.d_nan end -2: begin ;; INTERNAL ERROR IN LINE SEARCH status = -18L if errmsg EQ '' then $ errmsg = 'ERROR: Fatal error during line search' return, !values.d_nan end -1: begin TERMINATE: ;; FATAL TERMINATION status = 0L if errmsg EQ '' then errmsg = 'ERROR: Invalid inputs' return, !values.d_nan end 0: begin CONVERGED: status = 1L end 2: begin ;; MAXIMUM NUMBER of FUNC EVALS or ITERATIONS REACHED if maxfun GT 0 AND nfev GT maxfun then begin status = -17L if errmsg EQ '' then $ errmsg = ('WARNING: no convergence within maximum '+$ 'number of function calls') endif else begin status = 5L if errmsg EQ '' then $ errmsg = ('WARNING: no convergence within maximum '+$ 'number of iterations') endelse FNEW = OLDF end 3: begin status = -18L if errmsg EQ '' then errmsg = 'ERROR: Line search failed to converge' end 4: begin ;; ABNORMAL TERMINATION BY USER ROUTINE status = iflag end endcase ;; Successful return F = FNEW xnew(ifree) = x if keyword_set(tnconfig.qanytied) then tnmin_tie, xnew, tnconfig.ptied return, xnew end mpfitellipse.pro0000644000244500024450000003162211410062140013560 0ustar craigmcraigm;+ ; NAME: ; MPFITELLIPSE ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Approximate fit to points forming an ellipse ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; parms = MPFITELLIPSE(X, Y, start_parms, [/TILT, WEIGHTS=wts, ...]) ; ; DESCRIPTION: ; ; MPFITELLIPSE fits a closed elliptical or circular curve to a two ; dimensional set of data points. The user specifies the X and Y ; positions of the points, and an optional set of weights. The ; ellipse may also be tilted at an arbitrary angle. ; ; IMPORTANT NOTE: this fitting program performs simple ellipse ; fitting. It will not work well for ellipse data with high ; eccentricity. More robust answers can usually be obtained with ; "orthogonal distance regression." (See FORTRAN package ODRPACK on ; netlib.org for more information). ; ; The best fitting ellipse parameters are returned from by ; MPFITELLIPSE as a vector, whose values are: ; ; P[0] Ellipse semi axis 1 ; P[1] Ellipse semi axis 2 ( = P[0] if CIRCLE keyword set) ; P[2] Ellipse center - x value ; P[3] Ellipse center - y value ; P[4] Ellipse rotation angle (radians) if TILT keyword set ; ; If the TILT keyword is set, then the P[0] is meant to be the ; semi-major axis, and P[1] is the semi-minor axis, and P[4] ; represents the tilt of the semi-major axis with respect to the X ; axis. If the TILT keyword is not set, the P[0] and P[1] represent ; the ellipse semi-axes in the X and Y directions, respectively. ; The returned semi-axis lengths should always be positive. ; ; The user may specify an initial set of trial parameters, but by ; default MPFITELLIPSE will estimate the parameters automatically. ; ; Users should be aware that in the presence of large amounts of ; noise, namely when the measurement error becomes significant ; compared to the ellipse axis length, then the estimated parameters ; become unreliable. Generally speaking the computed axes will ; overestimate the true axes. For example when (SIGMA_R/R) becomes ; 0.5, the radius of the ellipse is overestimated by about 40%. ; ; This unreliability is also pronounced if the ellipse has high ; eccentricity, as noted above. ; ; Users can weight their data as they see appropriate. However, the ; following prescription for the weighting may serve as a good ; starting point, and appeared to produce results comparable to the ; typical chi-squared value. ; ; WEIGHTS = 0.75/(SIGMA_X^2 + SIGMA_Y^2) ; ; where SIGMA_X and SIGMA_Y are the measurement error vectors in the ; X and Y directions respectively. However, this has not been ; robustly tested, and it should be pointed out that this weighting ; may only be appropriate for a set of points whose measurement ; errors are comparable. If a more robust estimation of the ; parameter values is needed, the so-called orthogonal distance ; regression package should be used (ODRPACK, available in FORTRAN ; at www.netlib.org). ; ; INPUTS: ; ; X - measured X positions of the points in the ellipse. ; Y - measured Y positions of the points in the ellipse. ; ; START_PARAMS - an array of starting values for the ellipse ; parameters, as described above. This parameter is ; optional; if not specified by the user, then the ; ellipse parameters are estimated automatically from ; the properties of the data. ; ; RETURNS: ; ; Returns the best fitting model ellipse parameters. Returned ; values are undefined if STATUS indicates an error condition. ; ; KEYWORDS: ; ; ** NOTE ** Additional keywords such as PARINFO, BESTNORM, and ; STATUS are accepted by MPFITELLIPSE but not documented ; here. Please see the documentation for MPFIT for the ; description of these advanced options. ; ; CIRCULAR - if set, then the curve is assumed to be a circle ; instead of ellipse. When set, the parameters P[0] and ; P[1] will be identical and the TILT keyword will have ; no effect. ; ; PERROR - upon return, the 1-sigma uncertainties of the returned ; ellipse parameter values. These values are only ; meaningful if the WEIGHTS keyword is specified properly. ; ; If the fit is unweighted (i.e. no errors were given, or ; the weights were uniformly set to unity), then PERROR ; will probably not represent the true parameter ; uncertainties. ; ; If STATUS indicates an error condition, then PERROR is ; undefined. ; ; QUIET - if set then diagnostic fitting messages are suppressed. ; Default: QUIET=1 (i.e., no diagnostics] ; ; STATUS - an integer status code is returned. All values greater ; than zero can represent success (however STATUS EQ 5 may ; indicate failure to converge). Please see MPFIT for ; the definitions of status codes. ; ; TILT - if set, then the major and minor axes of the ellipse ; are allowed to rotate with respect to the data axes. ; Parameter P[4] will be set to the clockwise rotation angle ; of the P[0] axis in radians, as measured from the +X axis. ; P[4] should be in the range 0 to !dpi. ; ; WEIGHTS - Array of weights to be used in calculating the ; chi-squared value. The chi-squared value is computed ; as follows: ; ; CHISQ = TOTAL( (Z-MYFUNCT(X,Y,P))^2 * ABS(WEIGHTS)^2 ) ; ; Users may wish to follow the guidelines for WEIGHTS ; described above. ; ; ; EXAMPLE: ; ; ; Construct a set of points on an ellipse, with some noise ; ph0 = 2*!pi*randomu(seed,50) ; x = 50. + 32.*cos(ph0) + 4.0*randomn(seed, 50) ; y = -75. + 65.*sin(ph0) + 0.1*randomn(seed, 50) ; ; ; Compute weights function ; weights = 0.75/(4.0^2 + 0.1^2) ; ; ; Fit ellipse and plot result ; p = mpfitellipse(x, y) ; phi = dindgen(101)*2D*!dpi/100 ; plot, x, y, psym=1 ; oplot, p[2]+p[0]*cos(phi), p[3]+p[1]*sin(phi), color='ff'xl ; ; ; Fit ellipse and plot result - WITH TILT ; p = mpfitellipse(x, y, /tilt) ; phi = dindgen(101)*2D*!dpi/100 ; ; New parameter P[4] gives tilt of ellipse w.r.t. coordinate axes ; ; We must rotate a standard ellipse to this new orientation ; xm = p[2] + p[0]*cos(phi)*cos(p[4]) + p[1]*sin(phi)*sin(p[4]) ; ym = p[3] - p[0]*cos(phi)*sin(p[4]) + p[1]*sin(phi)*cos(p[4]) ; ; plot, x, y, psym=1 ; oplot, xm, ym, color='ff'xl ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; ; Ported from MPFIT2DPEAK, 17 Dec 2000, CM ; More documentation, 11 Jan 2001, CM ; Example corrected, 18 Nov 2001, CM ; Change CIRCLE keyword to the correct CIRCULAR keyword, 13 Sep ; 2002, CM ; Add error messages for SYMMETRIC and CIRCLE, 08 Nov 2002, CM ; Found small error in computation of _EVAL (when CIRCULAR) was set; ; sanity check when CIRCULAR is set, 21 Jan 2003, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 ; Oct 2006 ; Add disclaimer about the suitability of this program for fitting ; ellipses, 17 Sep 2007, CM ; Clarify documentation of TILT angle; make sure output contains ; semi-major axis first, followed by semi-minor; make sure that ; semi-axes are always positive (and can handle negative inputs) ; 17 Sep 2007, CM ; Output tilt angle is now in range 0 to !DPI, 20 Sep 2007, CM ; Some documentation clarifications, including to remove reference ; to the "ERR" keyword, which does not exist, 17 Jan 2008, CM ; Swapping of P[0] and P[1] only occurs if /TILT is set, 06 Nov ; 2009, CM ; Document an example of how to plot a tilted ellipse, 09 Nov 2009, CM ; Check for MPFIT error conditions and return immediately, 23 Jan 2010, CM ; ; $Id: mpfitellipse.pro,v 1.14 2010/01/25 03:38:03 craigm Exp $ ;- ; Copyright (C) 1997-2000,2002,2003,2007,2008,2009,2010 Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- FORWARD_FUNCTION mpfitellipse_u, mpfitellipse_eval, mpfitellipse, mpfit ; Compute the "u" value = (x/a)^2 + (y/b)^2 with optional rotation function mpfitellipse_u, x, y, p, tilt=tilt, circle=circle COMPILE_OPT strictarr widx = abs(p[0]) > 1e-20 & widy = abs(p[1]) > 1e-20 if keyword_set(circle) then widy = widx xp = x-p[2] & yp = y-p[3] theta = p[4] if keyword_set(tilt) AND theta NE 0 then begin c = cos(theta) & s = sin(theta) return, ( (xp * (c/widx) - yp * (s/widx))^2 + $ (xp * (s/widy) + yp * (c/widy))^2 ) endif else begin return, (xp/widx)^2 + (yp/widy)^2 endelse end ; This is the call-back function for MPFIT. It evaluates the ; function, subtracts the data, and returns the residuals. function mpfitellipse_eval, p, tilt=tilt, circle=circle, _EXTRA=extra COMPILE_OPT strictarr common mpfitellipse_common, xy, wc tilt = keyword_set(tilt) circle = keyword_set(circle) u2 = mpfitellipse_u(xy[*,0], xy[*,1], p, tilt=tilt, circle=circle) - 1. if n_elements(wc) GT 0 then begin if circle then u2 = sqrt(abs(p[0]*p[0]*wc))*u2 $ else u2 = sqrt(abs(p[0]*p[1]*wc))*u2 endif return, u2 end function mpfitellipse, x, y, p0, WEIGHTS=wts, $ BESTNORM=bestnorm, nfev=nfev, STATUS=status, $ tilt=tilt, circular=circle, $ circle=badcircle1, symmetric=badcircle2, $ parinfo=parinfo, query=query, $ covar=covar, perror=perror, niter=iter, $ quiet=quiet, ERRMSG=errmsg, _EXTRA=extra COMPILE_OPT strictarr status = 0L errmsg = '' ;; Detect MPFIT and crash if it was not found catch, catcherror if catcherror NE 0 then begin MPFIT_NOTFOUND: catch, /cancel message, 'ERROR: the required function MPFIT must be in your IDL path', /info return, !values.d_nan endif if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND catch, /cancel if keyword_set(query) then return, 1 if n_params() EQ 0 then begin message, "USAGE: PARMS = MPFITELLIPSE(X, Y, START_PARAMS, ... )", $ /info return, !values.d_nan endif nx = n_elements(x) & ny = n_elements(y) if (nx EQ 0) OR (ny EQ 0) OR (nx NE ny) then begin message, 'ERROR: X and Y must have the same number of elements', /info return, !values.d_nan endif if keyword_set(badcircle1) OR keyword_set(badcircle2) then $ message, 'ERROR: do not use the CIRCLE or SYMMETRIC keywords. ' +$ 'Use CIRCULAR instead.' p = make_array(5, value=x[0]*0) if n_elements(p0) GT 0 then begin p[0] = p0 if keyword_set(circle) then p[1] = p[0] endif else begin mx = moment(x) my = moment(y) p[0] = [sqrt(mx[1]), sqrt(my[1]), mx[0], my[0], 0] if keyword_set(circle) then $ p[0:1] = sqrt(mx[1]+my[1]) endelse common mpfitellipse_common, xy, wc if n_elements(wts) GT 0 then begin wc = abs(wts) endif else begin wc = 0 & dummy = temporary(wc) endelse xy = [[x],[y]] nfev = 0L & dummy = temporary(nfev) covar = 0 & dummy = temporary(covar) perror = 0 & dummy = temporary(perror) status = 0 result = mpfit('mpfitellipse_eval', p, $ parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$ covar=covar, perror=perror, niter=iter, $ functargs={circle:keyword_set(circle), tilt:keyword_set(tilt)},$ ERRMSG=errmsg, quiet=quiet, _EXTRA=extra) ;; Print error message if there is one. if NOT keyword_set(quiet) AND errmsg NE '' then $ message, errmsg, /info ;; Return if there is an error condition if status LE 0 then return, result ;; Sanity check on resulting parameters if keyword_set(circle) then begin result[1] = result[0] perror[1] = perror[0] endif if NOT keyword_set(tilt) then begin result[4] = 0 perror[4] = 0 endif ;; Make sure the axis lengths are positive, and the semi-major axis ;; is listed first result[0:1] = abs(result[0:1]) if abs(result[0]) LT abs(result[1]) AND keyword_set(tilt) then begin tmp = result[0] & result[0] = result[1] & result[1] = tmp tmp = perror[0] & perror[0] = perror[1] & perror[1] = tmp result[4] = result[4] - !dpi/2d endif if keyword_set(tilt) then begin ;; Put tilt in the range 0 to +Pi result[4] = result[4] - !dpi * floor(result[4]/!dpi) endif return, result end mpftest.pro0000644000244500024450000003473411410062140012554 0ustar craigmcraigm;+ ; NAME: ; MPFTEST ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Compute the probability of a given F value ; ; MAJOR TOPICS: ; Curve and Surface Fitting, Statistics ; ; CALLING SEQUENCE: ; PROB = MPFTEST(F, DOF1, DOF2, [/SIGMA, /CLEVEL, /SLEVEL ]) ; ; DESCRIPTION: ; ; The function MPFTEST() computes the probability for a value drawn ; from the F-distribution to equal or exceed the given value of F. ; This can be used for confidence testing of a measured value obeying ; the F-distribution (i.e., for testing the ratio of variances, or ; equivalently for the addition of parameters to a fitted model). ; ; P_F(X > F; DOF1, DOF2) = PROB ; ; In specifying the returned probability level the user has three ; choices: ; ; * return the confidence level when the /CLEVEL keyword is passed; ; OR ; ; * return the significance level (i.e., 1 - confidence level) when ; the /SLEVEL keyword is passed (default); OR ; ; * return the "sigma" of the probability (i.e., compute the ; probability based on the normal distribution) when the /SIGMA ; keyword is passed. ; ; Note that /SLEVEL, /CLEVEL and /SIGMA are mutually exclusive. ; ; For the ratio of variance test, the two variances, VAR1 and VAR2, ; should be distributed according to the chi-squared distribution ; with degrees of freedom DOF1 and DOF2 respectively. The F-value is ; computed as: ; ; F = (VAR1/DOF1) / (VAR2/DOF2) ; ; and then the probability is computed as: ; ; PROB = MPFTEST(F, DOF1, DOF2, ... ) ; ; ; For the test of additional parameters in least squares fitting, the ; user should perform two separate fits, and have two chi-squared ; values. One fit should be the "original" fit with no additional ; parameters, and one fit should be the "new" fit with M additional ; parameters. ; ; CHI1 - chi-squared value for original fit ; ; DOF1 - number of degrees of freedom of CHI1 (number of data ; points minus number of original parameters) ; ; CHI2 - chi-squared value for new fit ; ; DOF2 - number of degrees of freedom of CHI2 ; ; Note that according to this formalism, the number of degrees of ; freedom in the "new" fit, DOF2, should be less than the number of ; degrees of freedom in the "original" fit, DOF1 (DOF2 < DOF1); and ; also CHI2 < CHI1. ; ; With the above definition, the F value is computed as: ; ; F = ( (CHI1-CHI2)/(DOF1-DOF2) ) / (CHI2/DOF2) ; ; where DOF1-DOF2 is equal to M, and then the F-test probability is ; computed as: ; ; PROB = MPFTEST(F, DOF1-DOF2, DOF2, ... ) ; ; Note that this formalism assumes that the addition of the M ; parameters is a small peturbation to the overall fit. If the ; additional parameters dramatically changes the character of the ; model, then the first "ratio of variance" test is more appropriate, ; where F = (CHI1/DOF1) / (CHI2/DOF2). ; ; INPUTS: ; ; F - ratio of variances as defined above. ; ; DOF1 - number of degrees of freedom in first variance component. ; ; DOF2 - number of degrees of freedom in second variance component. ; ; ; RETURNS: ; ; Returns a scalar or vector of probabilities, as described above, ; and according to the /SLEVEL, /CLEVEL and /SIGMA keywords. ; ; KEYWORD PARAMETERS: ; ; SLEVEL - if set, then PROB describes the significance level ; (default). ; ; CLEVEL - if set, then PROB describes the confidence level. ; ; SIGMA - if set, then PROB is the number of "sigma" away from the ; mean in the normal distribution. ; ; EXAMPLE: ; ; chi1 = 62.3D & dof1 = 42d ; chi2 = 54.6D & dof2 = 40d ; ; f = ((chi1-chi2)/(dof1-dof2)) / (chi2/dof2) ; print, mpftest(f, dof1-dof2, dof2) ; ; This is a test for addition of parameters. The "original" ; chi-squared value was 62.3 with 42 degrees of freedom, and the ; "new" chi-squared value was 54.6 with 40 degrees of freedom. ; These values reflect the addition of 2 parameters and the ; reduction of the chi-squared value by 7.7. The significance of ; this set of circumstances is 0.071464757. ; ; REFERENCES: ; ; Algorithms taken from CEPHES special function library, by Stephen ; Moshier. (http://www.netlib.org/cephes/) ; ; MODIFICATION HISTORY: ; Completed, 1999, CM ; Documented, 16 Nov 2001, CM ; Reduced obtrusiveness of common block and math error handling, 18 ; Nov 2001, CM ; Added documentation, 30 Dec 2001, CM ; Documentation corrections (thanks W. Landsman), 17 Jan 2002, CM ; Example docs were corrected (Thanks M. Perez-Torres), 17 Feb 2002, ; CM ; Example corrected again (sigh...), 13 Feb 2003, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Usage message with /CONTINUE, 23 Sep 2009, CM ; ; $Id: mpftest.pro,v 1.10 2009/09/23 20:12:46 craigm Exp $ ;- ; Copyright (C) 1999,2001,2002,2003,2009, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function cephes_incbet, cephes_incbcf, cephes_incbd, cephes_pseries ;; Set machine constants, once for this session. Double precision ;; only. pro cephes_setmachar COMPILE_OPT strictarr common cephes_machar, cephes_machar_vals if n_elements(cephes_machar_vals) GT 0 then return if (!version.release) LT 5 then dummy = check_math(1, 1) mch = machar(/double) machep = mch.eps maxnum = mch.xmax minnum = mch.xmin maxlog = alog(mch.xmax) minlog = alog(mch.xmin) maxgam = 171.624376956302725D cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $ maxlog: maxlog, minlog: minlog, maxgam: maxgam} if (!version.release) LT 5 then dummy = check_math(0, 0) return end ; incbet.c ; ; Incomplete beta integral ; ; ; SYNOPSIS: ; ; double a, b, x, y, incbet(); ; ; y = incbet( a, b, x ); ; ; ; DESCRIPTION: ; ; Returns incomplete beta integral of the arguments, evaluated ; from zero to x. The function is defined as ; ; x ; - - ; | (a+b) | | a-1 b-1 ; ----------- | t (1-t) dt. ; - - | | ; | (a) | (b) - ; 0 ; ; The domain of definition is 0 <= x <= 1. In this ; implementation a and b are restricted to positive values. ; The integral from x to 1 may be obtained by the symmetry ; relation ; ; 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). ; ; The integral is evaluated by a continued fraction expansion ; or, when b*x is small, by a power series. ; ; ACCURACY: ; ; Tested at uniformly distributed random points (a,b,x) with a and b ; in "domain" and x between 0 and 1. ; Relative error ; arithmetic domain # trials peak rms ; IEEE 0,5 10000 6.9e-15 4.5e-16 ; IEEE 0,85 250000 2.2e-13 1.7e-14 ; IEEE 0,1000 30000 5.3e-12 6.3e-13 ; IEEE 0,10000 250000 9.3e-11 7.1e-12 ; IEEE 0,100000 10000 8.7e-10 4.8e-11 ; Outputs smaller than the IEEE gradual underflow threshold ; were excluded from these statistics. ; ; ERROR MESSAGES: ; message condition value returned ; incbet domain x<0, x>1 0.0 ; incbet underflow 0.0 function cephes_incbet, aa, bb, xx COMPILE_OPT strictarr forward_function cephes_incbcf, cephes_incbd, cephes_pseries common cephes_machar, machvals MINLOG = machvals.minlog MAXLOG = machvals.maxlog MAXGAM = machvals.maxgam MACHEP = machvals.machep if aa LE 0. OR bb LE 0. then goto, DOMERR if xx LE 0. OR xx GE 1. then begin if xx EQ 0 then return, 0.D if xx EQ 1. then return, 1.D DOMERR: message, 'ERROR: domain', /info return, 0.D endif flag = 0 if bb * xx LE 1. AND xx LE 0.95 then begin t = cephes_pseries(aa, bb, xx) goto, DONE endif w = 1.D - xx if xx GT aa/(aa+bb) then begin flag = 1 a = bb b = aa xc = xx x = w endif else begin a = aa b = bb xc = w x = xx endelse if flag EQ 1 AND b*x LE 1. AND x LE 0.95 then begin t = cephes_pseries(a, b, x) goto, DONE endif ;; Choose expansion for better convergence y = x * (a+b-2.) - (a-1.) if y LT 0. then w = cephes_incbcf(a, b, x) $ else w = cephes_incbd(a, b, x) / xc ;; Multiply w by the factor ;; a b _ _ _ ;; x (1-x) | (a+b) / ( a | (a) | (b) ) . */ y = a * alog(x) t = b * alog(xc) if (a+b) LT MAXGAM AND abs(y) LT MAXLOG AND abs(t) LT MAXLOG then begin t = ((xc^b) * (x^a)) * w * gamma(a+b) / ( a * gamma(a) * gamma(b) ) goto, DONE endif ;; Resort to logarithms y = y + t + lngamma(a+b) - lngamma(a) - lngamma(b) y = y + alog(w/a) if y LT MINLOG then t = 0.D $ else t = exp(y) DONE: if flag EQ 1 then begin if t LE MACHEP then t = 1.D - MACHEP $ else t = 1.D - t endif return, t end ;; Continued fraction expasion #1 for incomplete beta integral function cephes_incbcf, a, b, x COMPILE_OPT strictarr common cephes_machar, machvals MACHEP = machvals.machep big = 4.503599627370496D15 biginv = 2.22044604925031308085D-16 k1 = a k2 = a + b k3 = a k4 = a + 1. k5 = 1. k6 = b - 1. k7 = k4 k8 = a + 2. pkm2 = 0.D qkm2 = 1.D pkm1 = 1.D qkm1 = 1.D ans = 1.D r = 1.D n = 0L thresh = 3.D * MACHEP repeat begin xk = - (x * k1 * k2 ) / (k3 * k4) pk = pkm1 + pkm2 * xk qk = qkm1 + qkm2 * xk pkm2 = pkm1 pkm1 = pk qkm2 = qkm1 qkm1 = qk xk = ( x * k5 * k6 ) / ( k7 * k8) pk = pkm1 + pkm2 * xk qk = qkm1 + qkm2 * xk pkm2 = pkm1 pkm1 = pk qkm2 = qkm1 qkm1 = qk if qk NE 0 then r = pk/qk if r NE 0 then begin t = abs( (ans-r)/r ) ans = r endif else begin t = 1.D endelse if t LT thresh then goto, CDONE k1 = k1 + 1. k2 = k2 + 1. k3 = k3 + 2. k4 = k4 + 2. k5 = k5 + 1. k6 = k6 - 1. k7 = k7 + 2. k8 = k8 + 2. if abs(qk) + abs(pk) GT big then begin pkm2 = pkm2 * biginv pkm1 = pkm1 * biginv qkm2 = qkm2 * biginv qkm1 = qkm1 * biginv endif if abs(qk) LT biginv OR abs(pk) LT biginv then begin pkm2 = pkm2 * big pkm1 = pkm1 * big qkm2 = qkm2 * big qkm1 = qkm1 * big endif n = n + 1 endrep until n GE 300 CDONE: return, ans end ;; Continued fraction expansion #2 for incomplete beta integral function cephes_incbd, a, b, x COMPILE_OPT strictarr common cephes_machar, machvals MACHEP = machvals.machep big = 4.503599627370496D15 biginv = 2.22044604925031308085D-16 k1 = a k2 = b - 1. k3 = a k4 = a + 1. k5 = 1. k6 = a + b k7 = a + 1. k8 = a + 2. pkm2 = 0.D qkm2 = 1.D pkm1 = 1.D qkm1 = 1.D z = x / (1.D - x) ans = 1.D r = 1.D n = 0L thresh = 3.D * MACHEP repeat begin xk = -(z * k1 * k2) / (k3 * k4) pk = pkm1 + pkm2 * xk qk = qkm1 + qkm2 * xk pkm2 = pkm1 pkm1 = pk qkm2 = qkm1 qkm1 = qk xk = (z * k5 * k6) / (k7 * k8) pk = pkm1 + pkm2 * xk qk = qkm1 + qkm2 * xk pkm2 = pkm1 pkm1 = pk qkm2 = qkm1 qkm1 = qk if qk NE 0 then r = pk/qk if r NE 0 then begin t = abs( (ans-r)/r ) ans = r endif else begin t = 1.D endelse if t LT thresh then goto, CDONE k1 = k1 + 1. k2 = k2 - 1. k3 = k3 + 2. k4 = k4 + 2. k5 = k5 + 1. k6 = k6 + 1. k7 = k7 + 2. k8 = k8 + 2. if abs(qk) + abs(pk) GT big then begin pkm2 = pkm2 * biginv pkm1 = pkm1 * biginv qkm2 = qkm2 * biginv qkm1 = qkm1 * biginv endif if abs(qk) LT biginv OR abs(pk) LT biginv then begin pkm2 = pkm2 * big pkm1 = pkm1 * big qkm2 = qkm2 * big qkm1 = qkm1 * big endif n = n + 1 endrep until n GE 300 CDONE: return, ans end ;; Power series for incomplete beta integral. ;; Use when b*x is small and x not too close to 1 function cephes_pseries, a, b, x COMPILE_OPT strictarr common cephes_machar, machvals MINLOG = machvals.minlog MAXLOG = machvals.maxlog MAXGAM = machvals.maxgam MACHEP = machvals.machep ai = 1.D/a u = (1.D - b) * x v = u / (a + 1.D) t1 = v t = u n = 2.D s = 0.D z = MACHEP * ai while abs(v) GT z do begin u = (n-b) * x / n t = t * u v = t / (a+n) s = s + v n = n + 1.D endwhile s = s + t1 + ai u = a * alog(x) if (a+b) LT MAXGAM AND abs(u) LT MAXLOG then begin t = gamma(a+b)/(gamma(a)*gamma(b)) s = s * t * x^a endif else begin t = lngamma(a+b) - lngamma(a) - lngamma(b) + u + alog(s) if t LT MINLOG then s = 0.D else s = exp(t) endelse return, s end ; MPFTEST ; Returns the significance level of a particular F-statistic. ; P(x; nu1, nu2) is probability for F to exceed x ; x - the F-ratio ; For ratio of variance test: ; x = (chi1sq/nu1) / (chi2sq/nu2) ; p = mpftest(x, nu1, nu2) ; For additional parameter test: ; x = [ (chi1sq-chi2sq)/(nu1-nu2) ] / (chi2sq/nu2) ; p = mpftest(x, nu1-nu2, nu2) ; ; nu1 - number of DOF in chi1sq ; nu2 - number of DOF in chi2sq nu2 < nu1 function mpftest, x, nu1, nu2, slevel=slevel, clevel=clevel, sigma=sigma COMPILE_OPT strictarr if n_params() LT 3 then begin message, 'USAGE: PROB = MPFTEST(F, DOF1, DOF2, [/SIGMA, /CLEVEL, /SLEVEL ])', /cont return, !values.d_nan endif cephes_setmachar ;; Set machine constants if nu1 LT 1 OR nu2 LT 1 OR x LT 0. then begin message, 'ERROR: domain', /info return, 0.D endif w = double(nu2) / (double(nu2) + double(nu1)*double(x)) s = cephes_incbet(0.5D * nu2, 0.5D * nu1, w) ;; Return confidence level if requested if keyword_set(clevel) then return, 1D - s if keyword_set(sigma) then return, mpnormlim(s, /slevel) ;; Return significance level otherwise. return, s end mpchitest.pro0000644000244500024450000002005011410062140013054 0ustar craigmcraigm;+ ; NAME: ; MPCHITEST ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Compute the probability of a given chi-squared value ; ; MAJOR TOPICS: ; Curve and Surface Fitting, Statistics ; ; CALLING SEQUENCE: ; PROB = MPCHITEST(CHI, DOF, [/SIGMA, /CLEVEL, /SLEVEL ]) ; ; DESCRIPTION: ; ; The function MPCHITEST() computes the probability for a value drawn ; from the chi-square distribution to equal or exceed the given value ; CHI. This can be used for confidence testing of a measured value ; obeying the chi-squared distribution. ; ; P_CHI(X > CHI; DOF) = PROB ; ; In specifying the returned probability level the user has three ; choices: ; ; * return the confidence level when the /CLEVEL keyword is passed; ; OR ; ; * return the significance level (i.e., 1 - confidence level) when ; the /SLEVEL keyword is passed (default); OR ; ; * return the "sigma" of the probability (i.e., compute the ; probability based on the normal distribution) when the /SIGMA ; keyword is passed. ; ; Note that /SLEVEL, /CLEVEL and /SIGMA are mutually exclusive. ; ; INPUTS: ; ; CHI - chi-squared value to be tested. ; ; DOF - scalar or vector number, giving the number of degrees of ; freedom in the chi-square distribution. ; ; RETURNS: ; ; Returns a scalar or vector of probabilities, as described above, ; and according to the /SLEVEL, /CLEVEL and /SIGMA keywords. ; ; KEYWORD PARAMETERS: ; ; SLEVEL - if set, then PROB describes the significance level ; (default). ; ; CLEVEL - if set, then PROB describes the confidence level. ; ; SIGMA - if set, then PROB is the number of "sigma" away from the ; mean in the normal distribution. ; ; EXAMPLES: ; ; print, mpchitest(1300d,1252d) ; ; Print the probability for a chi-squared value with 1252 degrees of ; freedom to exceed a value of 1300, as a confidence level. ; ; REFERENCES: ; ; Algorithms taken from CEPHES special function library, by Stephen ; Moshier. (http://www.netlib.org/cephes/) ; ; MODIFICATION HISTORY: ; Completed, 1999, CM ; Documented, 16 Nov 2001, CM ; Reduced obtrusiveness of common block and math error handling, 18 ; Nov 2001, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Add usage message, 24 Nov 2006, CM ; Really add usage message, with /CONTINUE, 23 Sep 2009, CM ; ; $Id: mpchitest.pro,v 1.10 2009/10/05 16:22:44 craigm Exp $ ;- ; Copyright (C) 1997-2001, 2006, 2009, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function cephes_igamc, cephes_igam ;; Set machine constants, once for this session. Double precision ;; only. pro cephes_setmachar COMPILE_OPT strictarr common cephes_machar, cephes_machar_vals if n_elements(cephes_machar_vals) GT 0 then return if (!version.release) LT 5 then dummy = check_math(1, 1) mch = machar(/double) machep = mch.eps maxnum = mch.xmax minnum = mch.xmin maxlog = alog(mch.xmax) minlog = alog(mch.xmin) maxgam = 171.624376956302725D cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $ maxlog: maxlog, minlog: minlog, maxgam: maxgam} if (!version.release) LT 5 then dummy = check_math(0, 0) return end function cephes_igam, a, x ; ; Incomplete gamma integral ; ; ; ; SYNOPSIS: ; ; double a, x, y, igam(); ; ; y = igam( a, x ); ; ; DESCRIPTION: ; ; The function is defined by ; ; x ; - ; 1 | | -t a-1 ; igam(a,x) = ----- | e t dt. ; - | | ; | (a) - ; 0 ; ; ; In this implementation both arguments must be positive. ; The integral is evaluated by either a power series or ; continued fraction expansion, depending on the relative ; values of a and x. ; ; ACCURACY: ; ; Relative error: ; arithmetic domain # trials peak rms ; IEEE 0,30 200000 3.6e-14 2.9e-15 ; IEEE 0,100 300000 9.9e-14 1.5e-14 COMPILE_OPT strictarr common cephes_machar, machvals MAXLOG = machvals.maxlog MACHEP = machvals.machep if x LE 0 OR a LE 0 then return, 0.D if x GT 1. AND x GT a then return, 1.D - cephes_igamc(a, x) ax = a * alog(x) - x - lngamma(a) if ax LT -MAXLOG then begin ; message, 'WARNING: underflow', /info return, 0.D endif ax = exp(ax) r = a c = 1.D ans = 1.D repeat begin r = r + 1 c = c * x/r ans = ans + c endrep until (c/ans LE MACHEP) return, ans*ax/a end function cephes_igamc, a, x ; ; Complemented incomplete gamma integral ; ; ; ; SYNOPSIS: ; ; double a, x, y, igamc(); ; ; y = igamc( a, x ); ; ; DESCRIPTION: ; ; The function is defined by ; ; ; igamc(a,x) = 1 - igam(a,x) ; ; inf. ; - ; 1 | | -t a-1 ; = ----- | e t dt. ; - | | ; | (a) - ; x ; ; ; In this implementation both arguments must be positive. ; The integral is evaluated by either a power series or ; continued fraction expansion, depending on the relative ; values of a and x. ; ; ACCURACY: ; ; Tested at random a, x. ; a x Relative error: ; arithmetic domain domain # trials peak rms ; IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 ; IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 COMPILE_OPT strictarr if n_params() EQ 0 then begin message, 'USAGE: PROB = MPCHITEST(CHI, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])', /info return, !values.d_nan endif common cephes_machar, machvals MAXLOG = machvals.maxlog MACHEP = machvals.machep big = 4.503599627370496D15 biginv = 2.22044604925031308085D-16 if x LE 0 OR a LE 0 then return, 1.D if x LT 1. OR x LT a then return, 1.D - cephes_igam(a, x) ax = a * alog(x) - x - lngamma(a) if ax LT -MAXLOG then begin ; message, 'ERROR: underflow', /info return, 0.D endif ax = exp(ax) y = 1.D - a z = x + y + 1.D c = 0.D pkm2 = 1.D qkm2 = x pkm1 = x + 1.D qkm1 = z * x ans = pkm1 / qkm1 repeat begin c = c + 1.D y = y + 1.D z = z + 2.D yc = y * c pk = pkm1 * z - pkm2 * yc qk = qkm1 * z - qkm2 * yc if qk NE 0 then begin r = pk/qk t = abs( (ans-r)/r ) ans = r endif else begin t = 1.D endelse pkm2 = pkm1 pkm1 = pk qkm2 = qkm1 qkm1 = qk if abs(pk) GT big then begin pkm2 = pkm2 * biginv pkm1 = pkm1 * biginv qkm2 = qkm2 * biginv qkm1 = qkm1 * biginv endif endrep until t LE MACHEP return, ans * ax end ; MPCHITEST ; compute the probability for a chi-squared value to exceed x give ; the number of degrees of freedom dof. function mpchitest, x, dof, slevel=slevel, clevel=clevel, sigma=sigma COMPILE_OPT strictarr if n_params() LT 2 then begin message, 'USAGE: PROB = MPCHITEST(CHI, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])', /cont return, !values.d_nan endif cephes_setmachar ;; Set machine constants p = double(x) * 0 for i = 0, n_elements(x)-1 do begin p[i] = cephes_igamc(0.5D * dof, 0.5D * double(x[i])) endfor if keyword_set(clevel) then return, 1D - double(p) if keyword_set(sigma) then return, mpnormlim(p, /slevel) return, p end mpchilim.pro0000644000244500024450000003731011410062140012665 0ustar craigmcraigm;+ ; NAME: ; MPCHILIM ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Compute confidence limits for chi-square statistic ; ; MAJOR TOPICS: ; Curve and Surface Fitting, Statistics ; ; CALLING SEQUENCE: ; DELCHI = MPCHILIM(PROB, DOF, [/SIGMA, /CLEVEL, /SLEVEL ]) ; ; DESCRIPTION: ; ; The function MPCHILIM() computes confidence limits of the ; chi-square statistic for a desired probability level. The returned ; values, DELCHI, are the limiting chi-squared values: a chi-squared ; value of greater than DELCHI will occur by chance with probability ; PROB: ; ; P_CHI(CHI > DELCHI; DOF) = PROB ; ; In specifying the probability level the user has three choices: ; ; * give the confidence level (default); ; ; * give the significance level (i.e., 1 - confidence level) and ; pass the /SLEVEL keyword; OR ; ; * give the "sigma" of the probability (i.e., compute the ; probability based on the normal distribution) and pass the ; /SIGMA keyword. ; ; Note that /SLEVEL, /CLEVEL and /SIGMA are mutually exclusive. ; ; INPUTS: ; ; PROB - scalar or vector number, giving the desired probability ; level as described above. ; ; DOF - scalar or vector number, giving the number of degrees of ; freedom in the chi-square distribution. ; ; RETURNS: ; ; Returns a scalar or vector of chi-square confidence limits. ; ; KEYWORD PARAMETERS: ; ; SLEVEL - if set, then PROB describes the significance level. ; ; CLEVEL - if set, then PROB describes the confidence level ; (default). ; ; SIGMA - if set, then PROB is the number of "sigma" away from the ; mean in the normal distribution. ; ; EXAMPLES: ; ; print, mpchilim(0.99d, 2d, /clevel) ; ; Print the 99% confidence limit for a chi-squared of 2 degrees of ; freedom. ; ; print, mpchilim(5d, 2d, /sigma) ; ; Print the "5 sigma" confidence limit for a chi-squared of 2 ; degrees of freedom. Here "5 sigma" indicates the gaussian ; probability of a 5 sigma event or greater. ; P_GAUSS(5D) = 1D - 5.7330314e-07 ; ; REFERENCES: ; ; Algorithms taken from CEPHES special function library, by Stephen ; Moshier. (http://www.netlib.org/cephes/) ; ; MODIFICATION HISTORY: ; Completed, 1999, CM ; Documented, 16 Nov 2001, CM ; Reduced obtrusiveness of common block and math error handling, 18 ; Nov 2001, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 ; Oct 2006 ; Add usage message, 24 Nov 2006, CM ; Usage message with /CONTINUE, 23 Sep 2009, CM ; ; $Id: mpchilim.pro,v 1.8 2009/09/23 20:12:46 craigm Exp $ ;- ; Copyright (C) 1997-2001, 2006, 2009, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function cephes_ndtri, cephes_igam, cephes_igamc, cephes_igami ;; Set machine constants, once for this session. Double precision ;; only. pro cephes_setmachar COMPILE_OPT strictarr common cephes_machar, cephes_machar_vals if n_elements(cephes_machar_vals) GT 0 then return if (!version.release) LT 5 then dummy = check_math(1, 1) mch = machar(/double) machep = mch.eps maxnum = mch.xmax minnum = mch.xmin maxlog = alog(mch.xmax) minlog = alog(mch.xmin) maxgam = 171.624376956302725D cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $ maxlog: maxlog, minlog: minlog, maxgam: maxgam} if (!version.release) LT 5 then dummy = check_math(0, 0) return end function cephes_polevl, x, coef COMPILE_OPT strictarr ans = coef[0] nc = n_elements(coef) for i = 1L, nc-1 do ans = ans * x + coef[i] return, ans end function cephes_ndtri, y0 ; ; Inverse of Normal distribution function ; ; ; ; SYNOPSIS: ; ; double x, y, ndtri(); ; ; x = ndtri( y ); ; ; ; ; DESCRIPTION: ; ; Returns the argument, x, for which the area under the ; Gaussian probability density function (integrated from ; minus infinity to x) is equal to y. ; ; ; For small arguments 0 < y < exp(-2), the program computes ; z = sqrt( -2.0 * log(y) ); then the approximation is ; x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). ; There are two rational functions P/Q, one for 0 < y < exp(-32) ; and the other for y up to exp(-2). For larger arguments, ; w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). ; ; ; ACCURACY: ; ; Relative error: ; arithmetic domain # trials peak rms ; DEC 0.125, 1 5500 9.5e-17 2.1e-17 ; DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17 ; IEEE 0.125, 1 20000 7.2e-16 1.3e-16 ; IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 ; ; ; ERROR MESSAGES: ; ; message condition value returned ; ndtri domain x <= 0 -MAXNUM ; ndtri domain x >= 1 MAXNUM COMPILE_OPT strictarr common cephes_ndtri_data, s2pi, p0, q0, p1, q1, p2, q2 if n_elements(s2pi) EQ 0 then begin s2pi = sqrt(2.D*!dpi) p0 = [ -5.99633501014107895267D1, 9.80010754185999661536D1, $ -5.66762857469070293439D1, 1.39312609387279679503D1, $ -1.23916583867381258016D0 ] q0 = [ 1.D, $ 1.95448858338141759834D0, 4.67627912898881538453D0, $ 8.63602421390890590575D1, -2.25462687854119370527D2, $ 2.00260212380060660359D2, -8.20372256168333339912D1, $ 1.59056225126211695515D1, -1.18331621121330003142D0 ] p1 = [ 4.05544892305962419923D0, 3.15251094599893866154D1, $ 5.71628192246421288162D1, 4.40805073893200834700D1, $ 1.46849561928858024014D1, 2.18663306850790267539D0, $ -1.40256079171354495875D-1,-3.50424626827848203418D-2,$ -8.57456785154685413611D-4 ] q1 = [ 1.D, $ 1.57799883256466749731D1, 4.53907635128879210584D1, $ 4.13172038254672030440D1, 1.50425385692907503408D1, $ 2.50464946208309415979D0, -1.42182922854787788574D-1,$ -3.80806407691578277194D-2,-9.33259480895457427372D-4 ] p2 = [ 3.23774891776946035970D0, 6.91522889068984211695D0, $ 3.93881025292474443415D0, 1.33303460815807542389D0, $ 2.01485389549179081538D-1, 1.23716634817820021358D-2,$ 3.01581553508235416007D-4, 2.65806974686737550832D-6,$ 6.23974539184983293730D-9 ] q2 = [ 1.D, $ 6.02427039364742014255D0, 3.67983563856160859403D0, $ 1.37702099489081330271D0, 2.16236993594496635890D-1,$ 1.34204006088543189037D-2, 3.28014464682127739104D-4,$ 2.89247864745380683936D-6, 6.79019408009981274425D-9] endif common cephes_machar, machvals MAXNUM = machvals.maxnum if y0 LE 0 then begin message, 'ERROR: domain', /info return, -MAXNUM endif if y0 GE 1 then begin message, 'ERROR: domain', /info return, MAXNUM endif code = 1 y = y0 exp2 = exp(-2.D) if y GT (1.D - exp2) then begin y = 1.D - y code = 0 endif if y GT exp2 then begin y = y - 0.5 y2 = y * y x = y + y * y2 * cephes_polevl(y2, p0) / cephes_polevl(y2, q0) x = x * s2pi return, x endif x = sqrt( -2.D * alog(y)) x0 = x - alog(x)/x z = 1.D/x if x LT 8. then $ x1 = z * cephes_polevl(z, p1) / cephes_polevl(z, q1) $ else $ x1 = z * cephes_polevl(z, p2) / cephes_polevl(z, q2) x = x0 - x1 if code NE 0 then x = -x return, x end function cephes_igam, a, x ; ; Incomplete gamma integral ; ; ; ; SYNOPSIS: ; ; double a, x, y, igam(); ; ; y = igam( a, x ); ; ; DESCRIPTION: ; ; The function is defined by ; ; x ; - ; 1 | | -t a-1 ; igam(a,x) = ----- | e t dt. ; - | | ; | (a) - ; 0 ; ; ; In this implementation both arguments must be positive. ; The integral is evaluated by either a power series or ; continued fraction expansion, depending on the relative ; values of a and x. ; ; ACCURACY: ; ; Relative error: ; arithmetic domain # trials peak rms ; IEEE 0,30 200000 3.6e-14 2.9e-15 ; IEEE 0,100 300000 9.9e-14 1.5e-14 COMPILE_OPT strictarr common cephes_machar, machvals MAXLOG = machvals.maxlog MACHEP = machvals.machep if x LE 0 OR a LE 0 then return, 0.D if x GT 1. AND x GT a then return, 1.D - cephes_igamc(a, x) ax = a * alog(x) - x - lngamma(a) if ax LT -MAXLOG then begin ; message, 'WARNING: underflow', /info return, 0.D endif ax = exp(ax) r = a c = 1.D ans = 1.D repeat begin r = r + 1 c = c * x/r ans = ans + c endrep until (c/ans LE MACHEP) return, ans*ax/a end function cephes_igamc, a, x ; ; Complemented incomplete gamma integral ; ; ; ; SYNOPSIS: ; ; double a, x, y, igamc(); ; ; y = igamc( a, x ); ; ; DESCRIPTION: ; ; The function is defined by ; ; ; igamc(a,x) = 1 - igam(a,x) ; ; inf. ; - ; 1 | | -t a-1 ; = ----- | e t dt. ; - | | ; | (a) - ; x ; ; ; In this implementation both arguments must be positive. ; The integral is evaluated by either a power series or ; continued fraction expansion, depending on the relative ; values of a and x. ; ; ACCURACY: ; ; Tested at random a, x. ; a x Relative error: ; arithmetic domain domain # trials peak rms ; IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 ; IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 COMPILE_OPT strictarr common cephes_machar, machvals MAXLOG = machvals.maxlog MACHEP = machvals.machep big = 4.503599627370496D15 biginv = 2.22044604925031308085D-16 if x LE 0 OR a LE 0 then return, 1.D if x LT 1. OR x LT a then return, 1.D - cephes_igam(a, x) ax = a * alog(x) - x - lngamma(a) if ax LT -MAXLOG then begin ; message, 'ERROR: underflow', /info return, 0.D endif ax = exp(ax) y = 1.D - a z = x + y + 1.D c = 0.D pkm2 = 1.D qkm2 = x pkm1 = x + 1.D qkm1 = z * x ans = pkm1 / qkm1 repeat begin c = c + 1.D y = y + 1.D z = z + 2.D yc = y * c pk = pkm1 * z - pkm2 * yc qk = qkm1 * z - qkm2 * yc if qk NE 0 then begin r = pk/qk t = abs( (ans-r)/r ) ans = r endif else begin t = 1.D endelse pkm2 = pkm1 pkm1 = pk qkm2 = qkm1 qkm1 = qk if abs(pk) GT big then begin pkm2 = pkm2 * biginv pkm1 = pkm1 * biginv qkm2 = qkm2 * biginv qkm1 = qkm1 * biginv endif endrep until t LE MACHEP return, ans * ax end function cephes_igami, a, y0 ; ; Inverse of complemented imcomplete gamma integral ; ; ; ; SYNOPSIS: ; ; double a, x, p, igami(); ; ; x = igami( a, p ); ; ; DESCRIPTION: ; ; Given p, the function finds x such that ; ; igamc( a, x ) = p. ; ; Starting with the approximate value ; ; 3 ; x = a t ; ; where ; ; t = 1 - d - ndtri(p) sqrt(d) ; ; and ; ; d = 1/9a, ; ; the routine performs up to 10 Newton iterations to find the ; root of igamc(a,x) - p = 0. ; ; ACCURACY: ; ; Tested at random a, p in the intervals indicated. ; ; a p Relative error: ; arithmetic domain domain # trials peak rms ; IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 ; IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 ; IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 COMPILE_OPT strictarr common cephes_machar, machvals MAXNUM = machvals.maxnum MAXLOG = machvals.maxlog MACHEP = machvals.machep x0 = MAXNUM yl = 0.D x1 = 0.D yh = 1.D dithresh = 5.D * MACHEP d = 1.D/(9.D*a) y = (1.D - d - cephes_ndtri(y0) * sqrt(d)) x = a * y * y * y lgm = lngamma(a) for i=0, 9 do begin if x GT x0 OR x LT x1 then goto, ihalve y = cephes_igamc(a, x) if y LT yl OR y GT yh then goto, ihalve if y LT y0 then begin x0 = x yl = y endif else begin x1 = x yh = y endelse d = (a-1.D) * alog(x) - x - lgm if d LT -MAXLOG then goto, ihalve d = -exp(d) d = (y - y0)/d if abs(d/x) LT MACHEP then goto, done x = x - d endfor ; Resort to interval halving if Newton iteration did not converge IHALVE: d = 0.0625D if x0 EQ MAXNUM then begin if x LE 0 then x = 1.D while x0 EQ MAXNUM do begin x = (1.D + d) * x y = cephes_igamc(a, x) if y LT y0 then begin x0 = x yl = y goto, DONELOOP1 endif d = d + d endwhile DONELOOP1: endif d = 0.5 dir = 0L for i=0, 399 do begin x = x1 + d * (x0-x1) y = cephes_igamc(a, x) lgm = (x0 - x1)/(x1 + x0) if abs(lgm) LT dithresh then goto, DONELOOP2 lgm = (y - y0)/y0 if abs(lgm) LT dithresh then goto, DONELOOP2 if x LT 0 then goto, DONELOOP2 if y GE y0 then begin x1 = x yh = y if dir LT 0 then begin dir = 0 d = 0.5D endif else if dir GT 1 then begin d = 0.5 * d + 0.5 endif else begin d = (y0 - yl)/(yh - yl) endelse dir = dir + 1 endif else begin x0 = x yl = y if dir GT 0 then begin dir = 0 d = 0.5 endif else if dir LT -1 then begin d = 0.5 * d endif else begin d = (y0 - yl)/(yh - yl) endelse dir = dir - 1 endelse endfor DONELOOP2: if x EQ 0 then begin ; message, 'WARNING: underflow', /info endif DONE: return, x end function mpchilim, p, dof, sigma=sigma, clevel=clevel, slevel=slevel COMPILE_OPT strictarr if n_params() EQ 0 then begin message, 'USAGE: DELCHI = MPCHILIM(PROB, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])', /cont return, !values.d_nan endif cephes_setmachar ;; Set machine constants if n_elements(dof) EQ 0 then dof = 1. ;; Confidence level is the default if n_elements(clevel) EQ 0 then clevel = 1 if keyword_set(sigma) then begin ;; Significance in terms of SIGMA slev = 1D - errorf(p/sqrt(2.)) endif else if keyword_set(slevel) then begin ;; in terms of SIGNIFICANCE LEVEL slev = p endif else if keyword_set(clevel) then begin ;; in terms of CONFIDENCE LEVEL slev = 1.D - double(p) endif else begin message, 'ERROR: must specify one of SIGMA, CLEVEL, SLEVEL' endelse ;; Output will have same type as input y = p*0 ;; Loop through, computing the inverse, incomplete gamma function ;; slev is the significance level for i = 0L, n_elements(p)-1 do begin y[i] = 2.D * cephes_igami(0.5D*double(dof), slev[i]) end return, y end mpnormtest.pro0000644000244500024450000002177711410062140013305 0ustar craigmcraigm;+ ; NAME: ; MPNORMTEST ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Compute the probability of a given normally distributed Z value ; ; MAJOR TOPICS: ; Curve and Surface Fitting, Statistics ; ; CALLING SEQUENCE: ; PROB = MPNORMTEST(Z, [/CLEVEL, /SLEVEL ]) ; ; DESCRIPTION: ; ; The function MPNORMTEST() computes the probability for the ; magnitude of a value drawn from the normal distribution to equal or ; exceed the given value Z. This can be used for confidence testing ; of a measured value obeying the normal distribution. ; ; P_NORM(ABS(X) > Z) = PROB ; ; In specifying the returned probability level the user has two ; choices: ; ; * return the confidence level when the /CLEVEL keyword is passed; ; OR ; ; * return the significance level (i.e., 1 - confidence level) when ; the /SLEVEL keyword is passed (default). ; ; Note that /SLEVEL and /CLEVEL are mutually exclusive. ; ; INPUTS: ; ; Z - the value to best tested. Z should be drawn from a normal ; distribution with zero mean and unit variance. If a given ; quantity Y has mean MU and standard deviation STD, then Z can ; be computed as Z = (Y-MU)/STD. ; ; RETURNS: ; ; Returns a scalar or vector of probabilities, as described above, ; and according to the /SLEVEL and /CLEVEL keywords. ; ; KEYWORD PARAMETERS: ; ; SLEVEL - if set, then PROB describes the significance level ; (default). ; ; CLEVEL - if set, then PROB describes the confidence level. ; ; EXAMPLES: ; ; print, mpnormtest(5d, /slevel) ; ; Print the probability for the magnitude of a randomly distributed ; variable with zero mean and unit variance to exceed 5, as a ; significance level. ; ; REFERENCES: ; ; Algorithms taken from CEPHES special function library, by Stephen ; Moshier. (http://www.netlib.org/cephes/) ; ; MODIFICATION HISTORY: ; Completed, 1999, CM ; Documented, 16 Nov 2001, CM ; Reduced obtrusiveness of common block and math error handling, 18 ; Nov 2001, CM ; Corrected error in handling of CLEVEL keyword, 05 Sep 2003 ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Add usage message, 24 Nov 2006, CM ; Usage message with /CONTINUE, 23 Sep 2009, CM ; ; $Id: mpnormtest.pro,v 1.9 2009/09/23 20:12:46 craigm Exp $ ;- ; Copyright (C) 1997-2001, 2003, 2009, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function cephes_polevl, cephes_erfc, cephes_erf, mpnormtest ;; Set machine constants, once for this session. Double precision ;; only. pro cephes_setmachar COMPILE_OPT strictarr common cephes_machar, cephes_machar_vals if n_elements(cephes_machar_vals) GT 0 then return if (!version.release) LT 5 then dummy = check_math(1, 1) mch = machar(/double) machep = mch.eps maxnum = mch.xmax minnum = mch.xmin maxlog = alog(mch.xmax) minlog = alog(mch.xmin) maxgam = 171.624376956302725D cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $ maxlog: maxlog, minlog: minlog, maxgam: maxgam} if (!version.release) LT 5 then dummy = check_math(0, 0) return end function cephes_polevl, x, coef COMPILE_OPT strictarr ans = coef[0] nc = n_elements(coef) for i = 1L, nc-1 do ans = ans * x + coef[i] return, ans end pro cephes_set_erf_common COMPILE_OPT strictarr common cephes_erf_data, pp, qq, rr, ss, tt, uu, uthresh pp = [ 2.46196981473530512524D-10, 5.64189564831068821977D-1, $ 7.46321056442269912687D0, 4.86371970985681366614D1, $ 1.96520832956077098242D2, 5.26445194995477358631D2, $ 9.34528527171957607540D2, 1.02755188689515710272D3, $ 5.57535335369399327526D2 ] qq = [ 1.00000000000000000000D0, 1.32281951154744992508D1, $ 8.67072140885989742329D1, 3.54937778887819891062D2, $ 9.75708501743205489753D2, 1.82390916687909736289D3, $ 2.24633760818710981792D3, 1.65666309194161350182D3, $ 5.57535340817727675546D2 ] rr = [ 5.64189583547755073984D-1, 1.27536670759978104416D0, $ 5.01905042251180477414D0, 6.16021097993053585195D0, $ 7.40974269950448939160D0, 2.97886665372100240670D0 ] ss = [ 1.00000000000000000000D0, 2.26052863220117276590D0, $ 9.39603524938001434673D0, 1.20489539808096656605D1, $ 1.70814450747565897222D1, 9.60896809063285878198D0, $ 3.36907645100081516050D0 ] tt = [ 9.60497373987051638749D0, 9.00260197203842689217D1, $ 2.23200534594684319226D3, 7.00332514112805075473D3, $ 5.55923013010394962768D4 ] uu = [ 1.00000000000000000000D0, 3.35617141647503099647D1, $ 5.21357949780152679795D2, 4.59432382970980127987D3, $ 2.26290000613890934246D4, 4.92673942608635921086D4 ] uthresh = 37.519379347D return end ; erfc.c ; ; Complementary error function ; ; ; ; SYNOPSIS: ; ; double x, y, erfc(); ; ; y = erfc( x ); ; ; ; ; DESCRIPTION: ; ; ; 1 - erf(x) = ; ; inf. ; - ; 2 | | 2 ; erfc(x) = -------- | exp( - t ) dt ; sqrt(pi) | | ; - ; x ; ; ; For small x, erfc(x) = 1 - erf(x); otherwise rational ; approximations are computed. ; ; ; ; ACCURACY: ; ; Relative error: ; arithmetic domain # trials peak rms ; DEC 0, 9.2319 12000 5.1e-16 1.2e-16 ; IEEE 0,26.6417 30000 5.7e-14 1.5e-14 ; ; ; ERROR MESSAGES: ; ; message condition value returned ; erfc underflow x > 9.231948545 (DEC) 0.0 ; ; ; / function cephes_erfc, a COMPILE_OPT strictarr common cephes_erf_data if n_elements(p) EQ 0 then cephes_set_erf_common common cephes_machar, machvals MAXLOG = machvals.maxlog if a LT 0 then x = -a else x = a if x LT 1. then return, 1.D - cephes_erf(a) z = -a * a if z LT -MAXLOG then begin under: ; message, 'ERROR: underflow', /info if a LT 0 then return, 2.D else return, 0.D endif z = exp(z) if x LT 8. then begin p = cephes_polevl(x, pp) q = cephes_polevl(x, qq) endif else begin p = cephes_polevl(x, rr) q = cephes_polevl(x, ss) endelse y = (z*p)/q if a LT 0 then y = 2.D - y if y EQ 0 then goto, under return, y end ; erf.c ; ; Error function ; ; ; ; SYNOPSIS: ; ; double x, y, erf(); ; ; y = erf( x ); ; ; ; ; DESCRIPTION: ; ; The integral is ; ; x ; - ; 2 | | 2 ; erf(x) = -------- | exp( - t ) dt. ; sqrt(pi) | | ; - ; 0 ; ; The magnitude of x is limited to 9.231948545 for DEC ; arithmetic; 1 or -1 is returned outside this range. ; ; For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise ; erf(x) = 1 - erfc(x). ; ; ; ; ACCURACY: ; ; Relative error: ; arithmetic domain # trials peak rms ; DEC 0,1 14000 4.7e-17 1.5e-17 ; IEEE 0,1 30000 3.7e-16 1.0e-16 ; ; function cephes_erf, x COMPILE_OPT strictarr common cephes_erf_data if abs(x) GT 1. then return, 1.D - cephes_erfc(x) if n_elements(p) EQ 0 then cephes_set_erf_common z = x * x y = x * cephes_polevl(z, tt) / cephes_polevl(z, uu) return, y end function mpnormtest, a, clevel=clevel, slevel=slevel COMPILE_OPT strictarr if n_params() EQ 0 then begin message, 'USAGE: PROB = MPNORMTEST(Z, [/CLEVEL, /SLEVEL ])', /cont return, !values.d_nan endif cephes_setmachar ;; Set machine constants y = a*0 sqrth = sqrt(2.D)/2.D x = a * sqrth ;; Default is to return the significance level if n_elements(slevel) EQ 0 AND n_elements(clevel) EQ 0 then slevel = 1 if keyword_set(slevel) then begin for i = 0L, n_elements(y)-1 do begin if abs(x[i]) LT sqrth then y[i] = 1.D - cephes_erf(abs(x[i])) $ else y[i] = cephes_erfc(abs(x[i])) endfor endif else if keyword_set(clevel) then begin for i = 0L, n_elements(y)-1 do begin if abs(x[i]) LT sqrth then y[i] = cephes_erf(abs(x[i])) $ else y[i] = 1.D - cephes_erfc(x[i]) endfor endif else begin message, 'ERROR: must specify one of CLEVEL, SLEVEL' endelse return, y end mpnormlim.pro0000644000244500024450000002121710531722563013113 0ustar craigmcraigm;+ ; NAME: ; MPNORMLIM ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Compute confidence limits for normally distributed variable ; ; MAJOR TOPICS: ; Curve and Surface Fitting, Statistics ; ; CALLING SEQUENCE: ; Z = MPNORMLIM(PROB, [/CLEVEL, /SLEVEL ]) ; ; DESCRIPTION: ; ; The function MPNORMLIM() computes confidence limits of a normally ; distributed variable (with zero mean and unit variance), for a ; desired probability level. The returned values, Z, are the ; limiting values: a the magnitude of a normally distributed value ; is greater than Z by chance with a probability PROB: ; ; P_NORM(ABS(X) > Z) = PROB ; ; In specifying the probability level the user has two choices: ; ; * give the confidence level (default); ; ; * give the significance level (i.e., 1 - confidence level) and ; pass the /SLEVEL keyword; OR ; ; Note that /SLEVEL and /CLEVEL are mutually exclusive. ; ; INPUTS: ; ; PROB - scalar or vector number, giving the desired probability ; level as described above. ; ; RETURNS: ; ; Returns a scalar or vector of normal confidence limits. ; ; KEYWORD PARAMETERS: ; ; SLEVEL - if set, then PROB describes the significance level. ; ; CLEVEL - if set, then PROB describes the confidence level ; (default). ; ; EXAMPLE: ; ; print, mpnormlim(0.99d, /clevel) ; ; Print the 99% confidence limit for a normally distributed ; variable. In this case it is about 2.58 sigma. ; ; REFERENCES: ; ; Algorithms taken from CEPHES special function library, by Stephen ; Moshier. (http://www.netlib.org/cephes/) ; ; MODIFICATION HISTORY: ; Completed, 1999, CM ; Documented, 16 Nov 2001, CM ; Reduced obtrusiveness of common block and math error handling, 18 ; Nov 2001, CM ; Convert to IDL 5 array syntax (!), 16 Jul 2006, CM ; Move STRICTARR compile option inside each function/procedure, 9 Oct 2006 ; Add usage message, 24 Nov 2006, CM ; ; $Id: mpnormlim.pro,v 1.6 2006/11/25 01:44:13 craigm Exp $ ;- ; Copyright (C) 1997-2001, 2006, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- forward_function cephes_polevl, cephes_ndtri, mpnormlim ;; Set machine constants, once for this session. Double precision ;; only. pro cephes_setmachar COMPILE_OPT strictarr common cephes_machar, cephes_machar_vals if n_elements(cephes_machar_vals) GT 0 then return if (!version.release) LT 5 then dummy = check_math(1, 1) mch = machar(/double) machep = mch.eps maxnum = mch.xmax minnum = mch.xmin maxlog = alog(mch.xmax) minlog = alog(mch.xmin) maxgam = 171.624376956302725D cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $ maxlog: maxlog, minlog: minlog, maxgam: maxgam} if (!version.release) LT 5 then dummy = check_math(0, 0) return end function cephes_polevl, x, coef COMPILE_OPT strictarr ans = coef[0] nc = n_elements(coef) for i = 1L, nc-1 do ans = ans * x + coef[i] return, ans end function cephes_ndtri, y0 ; ; Inverse of Normal distribution function ; ; ; ; SYNOPSIS: ; ; double x, y, ndtri(); ; ; x = ndtri( y ); ; ; ; ; DESCRIPTION: ; ; Returns the argument, x, for which the area under the ; Gaussian probability density function (integrated from ; minus infinity to x) is equal to y. ; ; ; For small arguments 0 < y < exp(-2), the program computes ; z = sqrt( -2.0 * log(y) ); then the approximation is ; x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). ; There are two rational functions P/Q, one for 0 < y < exp(-32) ; and the other for y up to exp(-2). For larger arguments, ; w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). ; ; ; ACCURACY: ; ; Relative error: ; arithmetic domain # trials peak rms ; DEC 0.125, 1 5500 9.5e-17 2.1e-17 ; DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17 ; IEEE 0.125, 1 20000 7.2e-16 1.3e-16 ; IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 ; ; ; ERROR MESSAGES: ; ; message condition value returned ; ndtri domain x <= 0 -MAXNUM ; ndtri domain x >= 1 MAXNUM COMPILE_OPT strictarr common cephes_ndtri_data, s2pi, p0, q0, p1, q1, p2, q2 if n_elements(s2pi) EQ 0 then begin s2pi = sqrt(2.D*!dpi) p0 = [ -5.99633501014107895267D1, 9.80010754185999661536D1, $ -5.66762857469070293439D1, 1.39312609387279679503D1, $ -1.23916583867381258016D0 ] q0 = [ 1.D, $ 1.95448858338141759834D0, 4.67627912898881538453D0, $ 8.63602421390890590575D1, -2.25462687854119370527D2, $ 2.00260212380060660359D2, -8.20372256168333339912D1, $ 1.59056225126211695515D1, -1.18331621121330003142D0 ] p1 = [ 4.05544892305962419923D0, 3.15251094599893866154D1, $ 5.71628192246421288162D1, 4.40805073893200834700D1, $ 1.46849561928858024014D1, 2.18663306850790267539D0, $ -1.40256079171354495875D-1,-3.50424626827848203418D-2,$ -8.57456785154685413611D-4 ] q1 = [ 1.D, $ 1.57799883256466749731D1, 4.53907635128879210584D1, $ 4.13172038254672030440D1, 1.50425385692907503408D1, $ 2.50464946208309415979D0, -1.42182922854787788574D-1,$ -3.80806407691578277194D-2,-9.33259480895457427372D-4 ] p2 = [ 3.23774891776946035970D0, 6.91522889068984211695D0, $ 3.93881025292474443415D0, 1.33303460815807542389D0, $ 2.01485389549179081538D-1, 1.23716634817820021358D-2,$ 3.01581553508235416007D-4, 2.65806974686737550832D-6,$ 6.23974539184983293730D-9 ] q2 = [ 1.D, $ 6.02427039364742014255D0, 3.67983563856160859403D0, $ 1.37702099489081330271D0, 2.16236993594496635890D-1,$ 1.34204006088543189037D-2, 3.28014464682127739104D-4,$ 2.89247864745380683936D-6, 6.79019408009981274425D-9] endif common cephes_machar, machvals MAXNUM = machvals.maxnum if y0 LE 0 then begin message, 'ERROR: domain', /info return, -MAXNUM endif if y0 GE 1 then begin message, 'ERROR: domain', /info return, MAXNUM endif code = 1 y = y0 exp2 = exp(-2.D) if y GT (1.D - exp2) then begin y = 1.D - y code = 0 endif if y GT exp2 then begin y = y - 0.5 y2 = y * y x = y + y * y2 * cephes_polevl(y2, p0) / cephes_polevl(y2, q0) x = x * s2pi return, x endif x = sqrt( -2.D * alog(y)) x0 = x - alog(x)/x z = 1.D/x if x LT 8. then $ x1 = z * cephes_polevl(z, p1) / cephes_polevl(z, q1) $ else $ x1 = z * cephes_polevl(z, p2) / cephes_polevl(z, q2) x = x0 - x1 if code NE 0 then x = -x return, x end ; MPNORMLIM - given a probability level, return the corresponding ; "sigma" level. ; ; p - Either the significance level (if SLEVEL is set) or the ; confidence level (if CLEVEL is set). This should be the ; two-tailed level, ie: ; ; * SLEVEL: p = Prob(|z| > z0) ; * CLEVEL: p = Prob(|z| < z0) ; function mpnormlim, p, clevel=clevel, slevel=slevel COMPILE_OPT strictarr if n_params() EQ 0 then begin message, 'USAGE: Z = MPNORMLIM(PROB, [/CLEVEL, /SLEVEL ])', /info return, !values.d_nan endif cephes_setmachar ;; Set machine constants ;; Default is to assume the confidence level if n_elements(clevel) EQ 0 then clevel = 1 y = 0 * p ;; cephes_ndtri accepts the integrated probability from negative ;; infinity to z, so we have to compute. if keyword_set(slevel) then begin p1 = 0.5D * p ;; Take only one of the two tails for i = 0L, n_elements(y)-1 do begin y[i] = - cephes_ndtri(p1[i]) endfor endif else if keyword_set(clevel) then begin p1 = 0.5D + 0.5D * p ;; On binary computers this computation is ;; exact (to the machine precision), so don't worry about it. ;; This computation shaves off the top half of the confidence ;; region, and then adds the "negative infinity to zero part. for i = 0L, n_elements(y)-1 do begin y[i] = cephes_ndtri(p1[i]) endfor endif else begin message, 'ERROR: must specify one of CLEVEL or SLEVEL' endelse return, y end linfitex.pro0000644000244500024450000000710711171257760012730 0ustar craigmcraigm;+ ; NAME: ; LINFITEX ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Model function for fitting line with errors in X and Y ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; parms = MPFIT('LINFITEX', start_parms, $ ; FUNCTARGS={X: X, Y: Y, SIGMA_X: SIGMA_X, SIGMA_Y: SIGMA_Y}, $ ; ...) ; ; DESCRIPTION: ; ; LINFITEX is a model function to be used with MPFIT in order to ; fit a line to data with errors in both "X" and "Y" directions. ; LINFITEX follows the methodology of Numerical Recipes, in the ; section entitled, "Straight-Line Data with Errors in Both ; Coordinates." ; ; The user is not meant to call LINFITEX directly. Rather, the ; should pass LINFITEX as a user function to MPFIT, and MPFIT will in ; turn call LINFITEX. ; ; Each data point will have an X and Y position, as well as an error ; in X and Y, denoted SIGMA_X and SIGMA_Y. The user should pass ; these values using the FUNCTARGS convention, as shown above. I.e. ; the FUNCTARGS keyword should be set to a single structure ; containing the fields "X", "Y", "SIGMA_X" and "SIGMA_Y". Each ; field should have a vector of the same length. ; ; Upon return from MPFIT, the best fit parameters will be, ; P[0] - Y-intercept of line on the X=0 axis. ; P[1] - slope of the line ; ; NOTE that LINFITEX requires that AUTODERIVATIVE=1, i.e. MPFIT ; should compute the derivatives associated with each parameter ; numerically. ; ; INPUTS: ; P - parameters of the linear model, as described above. ; ; KEYWORD INPUTS: ; (as described above, these quantities should be placed in ; a FUNCTARGS structure) ; X - vector, X position of each data point ; Y - vector, Y position of each data point ; SIGMA_X - vector, X uncertainty of each data point ; SIGMA_Y - vector, Y uncertainty of each data point ; ; RETURNS: ; Returns a vector of residuals, of the same size as X. ; ; EXAMPLE: ; ; ; X and Y values ; XS = [2.9359964E-01,1.0125043E+00,2.5900450E+00,2.6647639E+00,3.7756164E+00,4.0297413E+00,4.9227958E+00,6.4959011E+00] ; YS = [6.0932738E-01,1.3339731E+00,1.3525699E+00,1.4060204E+00,2.8321848E+00,2.7798350E+00,2.0494456E+00,3.3113062E+00] ; ; ; X and Y errors ; XE = [1.8218818E-01,3.3440986E-01,3.7536234E-01,4.5585755E-01,7.3387712E-01,8.0054945E-01,6.2370265E-01,6.7048335E-01] ; YE = [8.9751285E-01,6.4095122E-01,1.1858428E+00,1.4673588E+00,1.0045623E+00,7.8527629E-01,1.2574003E+00,1.0080348E+00] ; ; ; Best fit line ; p = mpfit('LINFITEX', [1d, 1d], $ ; FUNCTARGS={X: XS, Y: YS, SIGMA_X: XE, SIGMA_Y: YE}, $ ; perror=dp, bestnorm=chi2) ; yfit = p[0] + p[1]*XS ; ; ; REFERENCES: ; ; Press, W. H. 1992, *Numerical Recipes in C*, 2nd Ed., Cambridge ; University Press ; ; MODIFICATION HISTORY: ; Written, Feb 2009 ; Documented, 14 Apr 2009, CM ; $Id: linfitex.pro,v 1.3 2009/04/15 04:17:52 craigm Exp $ ; ;- ; Copyright (C) 2009, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- ; function linfitex, p, $ x=x, y=y, sigma_x=sigma_x, sigma_y=sigma_y, $ _EXTRA=extra a = p[0] ;; Intercept b = p[1] ;; Slope f = a + b*x resid = (y - f)/sqrt(sigma_y^2 + (b*sigma_x)^2) return, resid end mpproperr.pro0000644000244500024450000002351511674510451013132 0ustar craigmcraigm;+ ; NAME: ; MPPROPERR ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; UPDATED VERSIONs can be found on my WEB PAGE: ; http://cow.physics.wisc.edu/~craigm/idl/idl.html ; ; PURPOSE: ; Propagate fitted model uncertainties to measured data points ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; YCOVAR = MPPROPERR(BEST_FJAC, PCOVAR, PFREE_INDEX, [/DIAGONAL]) ; ; DESCRIPTION: ; ; MPPROPERR propagates the parameter uncertainties of a fitted ; model to provide estimates of the model uncertainty at each ; measurement point. ; ; When fitting a model to data with uncertainties, the parameters ; will have estimated uncertainties. In fact, the parameter ; variance-covariance matrix indicates the estimated uncertainties ; and correlations between parameters. These uncertainties and ; correlations can, in turn, be used to estimate the "error in the ; model" for each measurement point. In a sense, this quantity also ; reflects the sensitivity of the model to each data point. ; ; The algorithm used by MPPROPERR uses standard propagation of error ; techniques, assuming that errors are small. The input values of ; MPPROPERR should be found from the output keywords of MPFIT or ; MPFITFUN, as documented below. ; ; The user has a choice whether to compute the *full* ; variance-covariance matrix or not, depending on the setting of the ; DIAGONAL keyword. The full matrix is large, and indicates the ; correlation the sampled model function between each measurement ; point and every other point. The variance terms lie on the ; diagonal, and the covariance terms are on the off-diagonal. ; ; Usually however, the user will want to set /DIAGONAL, which only ; returns the "diagonal" or variance terms, which represent the ; model "uncertainty" at each measurement point. The /DIAGONAL ; setting only controls the amount of data returned to the user. ; the full *parameter* covariance matrix is always used to compute ; the output regardless of the setting for /DIAGONAL. ; ; When using MPPROPERR, keep in mind the following dimensions of ; the problem: ; NPOINTS - number of measurement points ; NPAR - total number of fit parameters ; NFREE - number of *free* fit parameters ; ; The inputs to this function are: ; BEST_FJAC - the partial derivative matrix, or Jacobian matrix, ; as estimated by MPFIT or MPFITFUN (see below), ; which has dimensions of ARRAY(NPOINTS,NFREE). ; PCOVAR - the parameter covariance matrix, as estimated by MPFIT ; or MPFITFUN (see below), which has dimensions of ; ARRAY(NPAR,NPAR). ; PFREE_INDEX - an index array which describes which of the ; parameter set were variable, as returned by MPFIT ; or MPFITFUN. Of the total parameter set PARMS, ; only PARMS[PFREE_INDEX] were varied by MPFIT. ; ; There are special considerations about the values returned by ; MPPROPERR. First, if a parameter is touching a boundary ; limit when the fit is complete, then it will be marked as having ; variance and covariance of zero. To avoid this situation, one can ; re-run MPFIT or MPFITFUN with MAXITER=0 and boundary limits ; disabled. This will permit MPFIT to estimate variance and ; covariance for all parameters, without allowing them to actually ; vary during the fit. ; ; Also, it is important to have a quality parameter covariance ; matrix PCOVAR. If the matrix is singular or nearly singular, then ; the measurement variances and covariances will not be meaningful. ; It helps to parameterize the problem to minimize parameter ; covariances. Also, consider fitting with double precision ; quantities instead of single precision to minimize the chances of ; round-off error creating a singular covariance matrix. ; ; IMPORTANT NOTE: the quantities returned by this function are the ; *VARIANCE* and covariance. If the user wishes to compute ; estimated standard deviation, then one should compute ; SQRT(VARIANCE). (see example below) ; ; INPUTS: ; ; BEST_FJAC - the Jacobian matrix, as estimated by MPFIT/MPFITFUN ; (returned in keyword BEST_FJAC). This should be an ; array ARRAY(NPOINTS,NFREE) where NFREE is the number ; of free parameters. ; ; PCOVAR - the full parameter covariance matrix, as returned in the ; COVAR keyword of MPFIT/MPFITFUN. This should be an array ; ARRAY(NPAR,NPAR) where NPAR is the *total* number of ; parameters. ; ; RETURNS: ; ; The estimated uncertainty at each measurement point, due to ; propagation of errors. The dimensions depend on the value of the ; DIAGONAL keyword. ; DIAGONAL=1: returned value is ARRAY(NPOINTS) ; corresponding to the *VARIANCE* of the model ; function sampled at each measurment point ; **NOTE**: the propagated standard deviation would ; then be SQRT(RESULT). ; ; DIAGONAL=0: returned value is ARRAY(NPOINTS,NPOINTS) ; corresponding to the variance-covariance matrix of ; the model function, sampled at the measurement ; points. ; ; ; KEYWORD PARAMETERS: ; ; DIAGONAL - if set, then compute only the "diagonal" (variance) ; terms. If not set, then propagate the full covariance ; matrix for each measurement point. ; ; NAN - if set, then ignore NAN values in BEST_FJAC or PCOVAR ; matrices (they would be set to zero). ; ; PFREE_INDEX - index list of free parameters, as returned in the ; PFREE_INDEX keyword of MPFIT/MPFITFUN. This should ; be an integer array ARRAY(NFREE), such that ; parameters PARMS[PFREE_INDEX] were freely varied during ; the fit, and the remaining parameters were not. ; Thus it should also be the case that PFREE_INDEX ; indicates the rows and columns of the parameter ; covariance matrix which were allowed to vary freely. ; Default: All parameters will be considered free. ; ; ; EXAMPLE: ; ; ; First, generate some synthetic data ; npts = 200 ; x = dindgen(npts) * 0.1 - 10. ; Independent variable ; yi = gauss1(x, [2.2D, 1.4, 3000.]) ; "Ideal" Y variable ; y = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise ; sy = sqrt(1000.D + y) ; Poisson errors ; ; ; Now fit a Gaussian to see how well we can recover ; p0 = [1.D, 1., 1000.] ; Initial guess (cent, width, area) ; p = mpfitfun('GAUSS1', x, y, sy, p0, $ ; Fit a function ; best_fjac=best_fjac, pfree_index=pfree_index, /calc_fjac, $ ; covar=pcovar) ; ; Above statement calculates best Jacobian and parameter ; ; covariance matrix ; ; ; Propagate errors from parameter covariance matrix to estimated ; ; measurement uncertainty. The /DIAG call returns only the ; ; "diagonal" (variance) term for each measurement. ; ycovar = mpproperr(best_fjac, pcovar, pfree_index=pfree_index, /diagonal) ; ; sy_prop = sqrt(ycovar) ; Estimated sigma ; ; ; REFERENCES: ; ; MINPACK-1, Jorge More', available from netlib (www.netlib.org). ; "Optimization Software Guide," Jorge More' and Stephen Wright, ; SIAM, *Frontiers in Applied Mathematics*, Number 14. ; ; MODIFICATION HISTORY: ; Written, 2010-10-27, CM ; Updated documentation, 2011-06-26, CM ; ; $Id: mpproperr.pro,v 1.5 2011/12/22 02:08:22 cmarkwar Exp $ ;- ; Copyright (C) 2011, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- function mpproperr, fjac, pcovar, pfree_index=ifree, diagonal=diag, $ nan=nan, status=status, errmsg=errmsg COMPILE_OPT strictarr status = 0 szf = size(fjac) if szf[0] NE 2 then begin errmsg = 'ERROR: BEST_FJAC must be an NPOINTxNFREE array' return, !values.d_nan endif npoints = szf[1] ;; Number of measurement points nfree = szf[2] ;; Number of free parameters nfree1 = n_elements(ifree) if nfree1 EQ 0 then begin ifree1 = lindgen(nfree) endif else if nfree1 NE nfree then begin errmsg = 'ERROR: Dimensions of PFREE_INDEX and BEST_FJAC must match' return, !values.d_nan endif szc = size(pcovar) if szc[0] NE 2 then begin PCOVAR_BAD_DIMS: errmsg = 'ERROR: PCOVAR must be an NPARxNPAR array' return, !values.d_nan endif if szc[1] NE szc[2] then goto, PCOVAR_BAD_DIMS npar = szc[1] if npar LT nfree then begin errmsg = 'ERROR: size of PCOVAR array is smaller than PFREE_INDEX' return, !values.d_nan endif fjac1 = fjac ;; NOTE: if there are parts of the covariance matrix which are zero, ;; that is OK, since they will contribute nothing to the output. pcovar1 = (pcovar[ifree,*])[*,ifree] ;; Check for NAN values and, if requested, set them to zero. if keyword_set(nan) then begin wh = where(finite(pcovar1) EQ 0, ct) if ct GT 0 then pcovar1[wh] = 0 wh = where(finite(fjac1) EQ 0, ct) if ct GT 0 then fjac1[wh] = 0 endif if NOT keyword_set(diag) then begin ;; Pull out the full covariance matrix (using matrix notation) ycovar = (fjac # pcovar1) # transpose(fjac) endif else begin ;; Only pull out the variance (diagonal) terms, and optimize a ;; little so that we don't use all the memory. ycovar = 0 for i = 0, nfree-1 do begin for j = 0, nfree-1 do begin ycovar = ycovar + fjac[*,i]*fjac[*,j]*pcovar1[i,j] endfor endfor endelse return, ycovar end fakedata.sav0000644000244500024450000001420006561462260012627 0ustar craigmcraigmSR TMon Aug 3 21:30:55 1998craigmbishop.gsfc.nasa.gov„x86linux5.1 (T@ÈÈÀ$À#ÌÌÌÀÀ#™™™€À#fff@À#333À"ÿÿÿÀÀ"ÌÌÌ€À"™™™@À"fffÀ"332ÀÀ!ÿÿÿ€À!ÌÌÌ@À!™™™À!ffeÀÀ!332€À ÿÿÿ@À ÌÌÌÀ ™™˜ÀÀ ffe€À 332@ÀÿÿþÀ™™—€À331ÀÌÌÊ€ÀffdÀÿÿý€À™™—À330€ÀÌÌÊÀffc€ÀÿÿýÀ™™–€À330ÀÌÌÉ€ÀffcÀÿÿü€À™™–À33/€ÀÌÌÉÀffb€ÀÿÿüÀ™™•€À33/ÀÌÌÈ€ÀffbÀÿÿû€À™™•À33.€ÀÌÌÈÀffa€ÀÿÿûÀ™™”€À33.ÀÌÌÇ€ÀffaÀÿÿú€À™™”À33-€ÀÌÌÇÀff`€ÀÿÿôÀ33'ÀffZÀ ™™À ÌÌÀÀ ÿÿóÀ 33&À ffYÀ ™™ŒÀÌÌ¿ÀÿÿòÀ33%ÀffXÀ™™‹ÀÌ̾ÀÿÿñÀ33$ÀffWÀ™™ŠÀÌ̽¿ÿÿÿà¿þffF¿üÌ̬¿û33¿ù™™x¿÷ÿÿÞ¿öffD¿ôÌ̪¿ó33¿ñ™™v¿ïÿÿ¸¿ìÌÌ„¿é™™P¿æff¿ã32è¿ßÿÿh¿Ù™™¿Ó32˜¿É™˜`¿¹™— >„?¹™œ ?É™šà?Ó33Ø?Ù™š@?àT?ã33ˆ?æff¼?é™™ð?ìÌÍ$?ð,?ñ™™Æ?ó33`?ôÌÌú?öff”?ø.?ù™™È?û33b?üÌÌü?þff–@@ÌÌå@™™²@ff@33L@@ÌÌæ@™™³@ff€@33M@@ÌÌç@ ™™´@ ff@ 33N@ @ ÌÌè@ ™™µ@ff‚@33O@@fft€@ÌÌÛ@33A€@™™¨@€@ffu@ÌÌÛ€@33B@™™¨€@@ffu€@ÌÌÜ@33B€@™™©@€@ffv@ÌÌÜ€@33C@™™©€@@ffv€@ÌÌÝ@33C€@™™ª@€@ffw@ÌÌÝ€@33D@™™ª€@@ffw€@ÌÌÞ@33D€@™™«@€@ffx@ÌÌÞ€@33E@™™«€@ @ 33<@@ ffo€@ ™™¢À@ ÌÌÖ@! @@!33<€@!ffoÀ@!™™£@!ÌÌÖ@@" €@"33<À@"ffp@"™™£@@"ÌÌÖ€@# À@#33=@#ffp@@#™™£€@#ÌÌÖÀÌR@ÈÈ@Žè`Q2@¯6¡Ü~@ßpªXS@ŽÄzžÁ%@ëÛ*ñ@ŽÕ!1U1@;¬ô› r@”!wf~@Ž¤ÚÖµ>ù@ŽŸèà ”@‹ñ3M@¨¬ Œò@ŽšÄçbc8@þöKI@‘¶öõÐ*@ŽßÚÎl¢@ŽK9oþ˜@¹·½Ò€@?.@Æ5H ô<@Ž1ýïûšY@N»c.”@|%,ç@j*ºÅh@!ÎBú7@ +¶¬§)@i½D‚@ QI7ÿ@Ž^ë¾þ+ù@S²œíÃ@Ž=LÑÑ{µ@Ž·|œ& š@bÿ5ªÆ^@\uS9@*qÛÂWÔ@ •Ë¨øt@E8SŽ[@ŠóðV+@ŽG>†dZ˜@ö匵QD@mÙ3ÉØ@ªFþ’€@ŽÄqfÿ@ŽÏ9CäôR@KÖ (e=@q¯JÞ@Ž¨"9”Š@c²¨¼"<@Ž"qì¡-@'Ýs—§‘@Ž¢D¾ Z@ÿµjá@3@kÜh@Ž%x¤}@Ž‹$.™@Ž•­–/@T¥Â&#’@d)‰ aÇ@jrWý=@ª`~.A@H r*èi@{•wÞŽ‹@Žõö˜M±@Œ'C K°@0R  Ö@„]ôú=«@Ž~ÃÇÙY@Š{­Ì©{@ŽY#ù{¨@qIš(±@F“ãû½=@¹V¦l³?@Ž8óú{ìD@BÇÖþA@å§c>câ@†Ë…)ÔÝ@ŽRŽtP@D\nW@#õcF0@´½«!@E(ZÜÆK@!þâ“@Êï|-[G@SSØwˆ0@„-tcȉ@šï£;§@þÇ]²@u,ž#\@Š©ÝÛ+7@ë?DD@®ÑJ{˜p@Õò1‰E@‘a÷áþë @‘&þÞ¤á@’#Ρ¿B@‘&ChÝ@‘ر"F/@’æCX]øÀ@“iôçž@“úõЇã@“Š$XÚ@z@”2Öææ‰à@•ÁÔmဎ@•]á}b\@•ì¬KÏÞ…@–¸úÿúú@–ÂLô¯@—Å##j@@˜k"‚Ö@™TZuÏžü@˜ò“ÃìòZ@™zXN3V@š!$à„"@™ú‘^«²›@›c*~$ìÞ@œo¯%yc@ ç@œSÂ-–¨§@œ¤W+Á’@›‰5·ƒr$@œÅqï@œˆò™ÓW¦@œL”…ëª#@œ^%ØŒ«@œßÔ7R2@›ËïB¤ÿ”@œ Óࡉ@œkTù,O@™­ G@fN@›¼Ο½@› H,ÈÎ@™J0¯;NÝ@™Œ*7½¾z@˜–s$'`@˜‘æ…VÆ@˜&Å=D»@—áêæÍæ^@˜inLUwè@–¦ÄŒîb@•”C¬[­@–Þ-ݾ@•¥ÃyÐŒ%@•Ðöæ檵@“óJ,«Ç@“:Ù0oê @“$¦¿ÕzÈ@‘Ôi-.üÃ@’ÿî‰P¹@‘ŒESg8@‘]3+8C@‘-¹º¸×ø@‘®Dsÿ#p@‘¨Aé„@Ž­`èæÿ§@Ž}ÓÕ0ÕÂ@iÇúº6W@ŽÁ%+ó’k@Ž Ñ´‘ÛH@Ûž£í@¤ë2 ö"pRERR@ÈÈ@?rùgv½F@@ RÜUF@@o ¥B@?`°xÄžŽ@?Ž+xTŸr@?i-â˜Z@@ºÛ\Ј@?ÉÛÃÑ@?PŒn†^8@?NoÁ¿I@@Dí€U„!@?Ô8ñÌ„@?KdÉ$/>@? ÛÊ@?È«¦)@?n£>b´@?"žô¿!*@?ÜÈ~²@@?‚V{›$@>ÝøNJ‘@?¤Ì“Ϧ@?¦á˜ú@@=‹5|ÃF@?´¼†qXó@?#žn´@@”€ôÌè@?´…ž‚‹<@?…%AðB@?,¼~J‰@@)£!26È@?vRÎ’]@?ZiNÝ@@13ógžÃ@?­Ñ!‹>@@*íPò@@ÉuT1@@"w ›v@>¿1èª @? “HÝG3@?ûrsp@?¶+@Ö<@>Ïz«lL@?`¬ Ån@?f*à,—v@@%¾ÊnŠ@?¸‡ÕŠ¯P@?R9CøŸ‹@?±xú"éz@? £'U'@@â^¹ûÒ@?OY d¡`@@‹·œßÀ@@‹Ñž@?ØE’˜Ã@?Cb´xïc@?>Ø´¡¶@@*xÞ4¿@?±´ý¢ƒy@?´«ŽÓT@>χÈ"xî@@$'`LTš@@=U.L3@?yu$¨c@>¿ÑÓ¨ïU@@äily@?ÁòÐï7@?<´ô<<&@@Dª~¿C:@?)Äá:W0@?¸TŠÊ®á@>›ˆ« >@?Ü—¼‚¬î@?9Ú¬4Ñ@?Æm™Ö¢³@?òÐúb]§@?Ã+ò<€®@?&c«@>š0 ùÂb@@xði!B@@Yeïal@?¢ ;{{@?I@AÝÇŒ[q@AŠnÎ$ø@A€L9Ê5x@@ãÝû7}{@@ûÃ4X²œ@@ÁØú³@@«­…DA@@”.­U›@@ÑÃ7UÕº@@ÎæÛ`‰ó@@nNFíðø@@«ÌyC< @@döËÓèÉ@?oŠÙáÓz@?sE¼ÿÌ@@Îœc§‹@?ÓCƒ,ï@@gc @@ \õ]u@@8‡ð\t@@>Æ•›@?´Rø#ί@?T¦Ô<“@?¨Ðlêê@?ÁÃr¡@?I«´7æ@?ÍÓ“»·@>½Ç;öS@?D,Ÿ/Ï@?¨,ÿ4DQ@>àõ»/^ø@?œß0uË@>ï1ľãQ@?6®Éj}B@?™“æ’ØQ@?‘°ï‡–@?¬3óý"—@?cš7o:@@uz:F@@dxka½@@6L¶åœM@@pþ„[@?›órg)@?›•;@@? ({µP@@ Qù@?Ï/øPfÚ@@¥”Û]@?[ÊR’#7@?|5ts*@?Tç Ðð@?<•;GˆË@@4®rØà@?^ý…c @?ðYŽÃ•@?íÉÝ°m¼@?ÒUÊ"gauss1.pro0000644000244500024450000000467107362076334012317 0ustar craigmcraigm;+ ; NAME: ; GAUSS1 ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; ; PURPOSE: ; Compute Gaussian curve given the mean, sigma and area. ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; YVALS = GAUSS1(XVALS, [MEAN, SIGMA, AREA], SKEW=skew) ; ; DESCRIPTION: ; ; This routine computes the values of a Gaussian function whose ; X-values, mean, sigma, and total area are given. It is meant to be ; a demonstration for curve-fitting. ; ; XVALS can be an array of X-values, in which case the returned ; Y-values are an array as well. The second parameter to GAUSS1 ; should be an array containing the MEAN, SIGMA, and total AREA, in ; that order. ; ; INPUTS: ; X - Array of X-values. ; ; [MEAN, SIGMA, AREA] - the mean, sigma and total area of the ; desired Gaussian curve. ; ; INPUT KEYWORD PARAMETERS: ; ; SKEW - You may specify a skew value. Default is no skew. ; ; PEAK - if set then AREA is interpreted as the peak value rather ; than the area under the peak. ; ; RETURNS: ; ; Returns the array of Y-values. ; ; EXAMPLE: ; ; p = [2.2D, 1.4D, 3000.D] ; x = dindgen(200)*0.1 - 10. ; y = gauss1(x, p) ; ; Computes the values of the Gaussian at equispaced intervals ; (spacing is 0.1). The gaussian has a mean of 2.2, standard ; deviation of 1.4, and total area of 3000. ; ; REFERENCES: ; ; MODIFICATION HISTORY: ; Written, Jul 1998, CM ; Correct bug in normalization, CM, 01 Nov 1999 ; Optimized for speed, CM, 02 Nov 1999 ; Added copyright notice, 25 Mar 2001, CM ; Added PEAK keyword, 30 Sep 2001, CM ; ; $Id: gauss1.pro,v 1.4 2001/10/13 17:41:48 craigm Exp $ ; ;- ; Copyright (C) 1998,1999,2001, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- function gauss1, x, p, skew=skew, peak=peak, _EXTRA=extra sz = size(x) if sz(sz(0)+1) EQ 5 then smax = 26D else smax = 13. if n_elements(p) GE 3 then norm = p(2) else norm = x(0)*0 + 1 u = ((x-p(0))/(abs(p(1)) > 1e-20))^2 mask = u LT (smax^2) if NOT keyword_set(peak) then norm = norm / (sqrt(2.D * !dpi)*p(1)) f = norm * mask * exp(-0.5*temporary(u) * mask) mask = 0 if n_elements(skew) GT 0 then $ f = (1.D + skew * (x-p(0))/p(1))*f return, f end gauss1p.pro0000644000244500024450000000427707257437167012511 0ustar craigmcraigm;+ ; NAME: ; GAUSS1P ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; ; PURPOSE: ; Compute Gaussian curve given the mean, sigma and area (procedure). ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; GAUSS1, XVALS, [MEAN, SIGMA, AREA], YVALS, SKEW=skew ; ; DESCRIPTION: ; ; This routine computes the values of a Gaussian function whose ; X-values, mean, sigma, and total area are given. It is meant to be ; a demonstration for curve-fitting. ; ; XVALS can be an array of X-values, in which case the returned ; Y-values are an array as well. The second parameter to GAUSS1 ; should be an array containing the MEAN, SIGMA, and total AREA, in ; that order. ; ; INPUTS: ; X - Array of X-values. ; ; [MEAN, SIGMA, AREA] - the mean, sigma and total area of the ; desired Gaussian curve. ; ; YVALS - returns the array of Y-values. ; ; ; KEYWORD PARAMETERS: ; ; SKEW - You may specify a skew value. Default is no skew. ; ; EXAMPLE: ; ; p = [2.2D, 1.4D, 3000.D] ; x = dindgen(200)*0.1 - 10. ; gauss1p, x, p, y ; ; Computes the values of the Gaussian at equispaced intervals ; (spacing is 0.1). The gaussian has a mean of 2.2, standard ; deviation of 1.4, and total area of 3000. ; ; REFERENCES: ; ; MODIFICATION HISTORY: ; Transcribed from GAUSS1, 13 Dec 1999, CM ; Added copyright notice, 25 Mar 2001, CM ; ; $Id: gauss1p.pro,v 1.2 2001/03/25 18:55:12 craigm Exp $ ; ;- ; Copyright (C) 1999,2001, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- pro gauss1p, x, p, f, skew=skew, _EXTRA=extra sz = size(x) if sz(sz(0)+1) EQ 5 then smax = 26D else smax = 13. if n_elements(p) GE 3 then norm = p(2) else norm = x(0)*0 + 1 u = ((x-p(0))/(abs(p(1)) > 1e-20))^2 mask = u LT (smax^2) ;; Prevent floating underflow f = norm * mask * exp(-0.5*temporary(u) * mask) / (sqrt(2.D * !dpi)*p(1)) mask = 0 if n_elements(skew) GT 0 then $ f = (1.D + skew * (x-p(0))/p(1))*f return end gauss2.pro0000644000244500024450000000411107257437167012315 0ustar craigmcraigm;+ ; NAME: ; GAUSS2 ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; ; PURPOSE: ; Compute Gaussian curve given the mean, sigma and area. ; ; MAJOR TOPICS: ; Curve and Surface Fitting ; ; CALLING SEQUENCE: ; YVALS = GAUSS2(X, Y, [XCENT, YCENT, SIGMA, PEAK]) ; ; DESCRIPTION: ; ; This routine computes the values of a Gaussian function whose ; X-values, mean, sigma, and total area are given. It is meant to be ; a demonstration for curve-fitting. ; ; XVALS can be an array of X-values, in which case the returned ; Y-values are an array as well. The second parameter to GAUSS1 ; should be an array containing the MEAN, SIGMA, and total AREA, in ; that order. ; ; INPUTS: ; X - 2-dimensional array of "X"-values. ; Y - 2-dimensional array of "Y"-values. ; ; XCENT - X-position of gaussian centroid. ; YCENT - Y-position of gaussian centroid. ; ; SIGMA - sigma of the curve (X and Y widths are the same). ; ; PEAK - the peak value of the gaussian function. ; ; RETURNS: ; ; Returns the array of Y-values. ; ; EXAMPLE: ; ; p = [2.2D, -0.7D, 1.4D, 3000.D] ; x = (dindgen(200)*0.1 - 10.) # (dblarr(200) + 1) ; y = (dblarr(200) + 1) # (dindgen(200)*0.1 - 10.) ; z = gauss2(x, y, p) ; ; Computes the values of the Gaussian at equispaced intervals in X ; and Y (spacing is 0.1). The gaussian has a centroid position of ; (2.2, -0.7), standard deviation of 1.4, and peak value of 3000. ; ; REFERENCES: ; ; MODIFICATION HISTORY: ; Written, 02 Oct 1999, CM ; Added copyright notice, 25 Mar 2001, CM ; ; $Id: gauss2.pro,v 1.2 2001/03/25 18:55:13 craigm Exp $ ; ;- ; Copyright (C) 1999,2001, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- function gauss2, x, y, p, _EXTRA=extra u = ((x-p(0))/p(2))^2 + ((y-p(1))/p(2))^2 mask = u LT 100 f = p(3) * mask * exp(-0.5D * temporary(u) * mask) mask = 0 return, f end setfitparm.pro0000644000244500024450000004504407214263624013265 0ustar craigmcraigm;+ ; NAME: ; SetFitParm.pro ; ; AUTHOR: ; F.Bringezu, denet - Internetservice, Halle Germany, ; bringezu@denet.de ; ; PURPOSE: ; Provide a widget interface for creating a parinfo structure. ; This parinfo structure can by used by mpfit routines of Craig B. Markwardt. ; ; MAJOR TOPICS: ; Widget, mpfit. ; ; CALLING SEQUENCE: ; parinfo=SetFitParm(used_parinfo) ; ; DESCRIPTION: ; ; SetFitParm creates PARINFO using a widget interface. ; PARINFO provides constraints for paramters used by the mpfit routines. ; ; PARINFO is an array of structures, one for each parameter. ; ; A detailed description can be found in the documentation of mpcurvefit.pro ; This routine creates an array that contains a structure for each element. ; The structure has the following entries. ; ; - VALUE (DOUBLE): The starting parameter ; - FIXED (BOOLEAN): 1 fix the parameter, 0 don't fix it at the ; point given in VALUE. ; - LIMITS (DBLARRAY(2)): Set upper and lower limit. ; - LIMITED (BOOLEAN ARRAY 2): Fix the limit. ; ; ; The parameter OLDPARINFO is optional. OLDPARINFO is used to set ; the default values in the widget. ; ; You can simply run: ; test=SetFitParm() to create the array for the first time. ; Once the array is created it can be used to set the default values ; in the widget by calling ; ; test2=SetFitParm(test) ; ; INPUTS: ; ; ; OPTIONAL INPUTS: ; ; OLDFITPARM - The default values of the new array ; ; INPUT KEYWORD PARAMETERS: ; ; PARENT - if this widget is to be a child, set this keyword to the ; parent widget ID. ; ; OUTPUT KEYWORD PARAMETERS: ; ; CANCEL - if the user selected the cancel button on the SETFITPARM ; widget, then this keyword will be set upon exit. ; ; OUTPUTS: ; PARINFO array of structures ; ; SEE ALSO: ; mpcurvefit ; ; MODIFICATION HISTORY: ; Written, FB, 12/1999 ; Documented, FB, Jan 2000 ; Generalized positioning code, CM 01 Feb 2000 ; ;- ; Copyright (C) 1999, F.Bringezu ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy and distribute unmodified copies for ; non-commercial purposes, and to modify and use for personal or ; internal use, is granted. All other rights are reserved. ;- Pro SetFitParm_Events, event Widget_Control, event.id, Get_Value=buttonValue Widget_Control, event.id, Get_UValue=buttonUValue Widget_Control, event.top, Get_UValue=info, /No_Copy CASE buttonUValue OF 'Cancel' : Widget_Control, event.top, /Destroy 'FIX_HEIGHT': (*info.ptr).fparm(0).fixed = fix(event.select) 'FIX_XMAX': (*info.ptr).fparm(1).fixed = fix(event.select) 'FIX_WIDTH': (*info.ptr).fparm(2).fixed = fix(event.select) 'FIX_OFFSET': (*info.ptr).fparm(3).fixed = fix(event.select) 'FIX_SLOPE': (*info.ptr).fparm(4).fixed = fix(event.select) 'LIMIT_HEIGHT_LOW': (*info.ptr).fparm(0).limited(0) = fix(event.select) 'LIMIT_XMAX_LOW': (*info.ptr).fparm(1).limited(0) = fix(event.select) 'LIMIT_WIDTH_LOW': (*info.ptr).fparm(2).limited(0) = fix(event.select) 'LIMIT_OFFSET_LOW': (*info.ptr).fparm(3).limited(0) = fix(event.select) 'LIMIT_SLOPE_LOW': (*info.ptr).fparm(4).limited(0) = fix(event.select) 'LIMIT_HEIGHT_UP': (*info.ptr).fparm(0).limited(1) = fix(event.select) 'LIMIT_XMAX_UP': (*info.ptr).fparm(1).limited(1) = fix(event.select) 'LIMIT_WIDTH_UP': (*info.ptr).fparm(2).limited(1) = fix(event.select) 'LIMIT_OFFSET_UP': (*info.ptr).fparm(3).limited(1) = fix(event.select) 'LIMIT_SLOPE_UP': (*info.ptr).fparm(4).limited(1) = fix(event.select) 'Accept' : BEGIN ; OK, get the information the user put into the form. ; Should do error checking, but...maybe later! Widget_Control, info.text(0), Get_Value=height Widget_Control, info.text(1), Get_Value=xmax Widget_Control, info.text(2), Get_Value=width Widget_Control, info.text(3), Get_Value=offset Widget_Control, info.text(4), Get_Value=slope Widget_Control, info.text(5), Get_Value=ll_height Widget_Control, info.text(6), Get_Value=ll_xmax Widget_Control, info.text(7), Get_Value=ll_width Widget_Control, info.text(8), Get_Value=ll_offset Widget_Control, info.text(9), Get_Value=ll_slope Widget_Control, info.text(10), Get_Value=ul_height Widget_Control, info.text(11), Get_Value=ul_xmax Widget_Control, info.text(12), Get_Value=ul_width Widget_Control, info.text(13), Get_Value=ul_offset Widget_Control, info.text(14), Get_Value=ul_slope ; Fill out the data structure with information ; collected from the form. (*info.ptr).fparm(0).value = height (*info.ptr).fparm(1).value = xmax (*info.ptr).fparm(2).value = width (*info.ptr).fparm(3).value = offset (*info.ptr).fparm(4).value = slope (*info.ptr).fparm(0).limits(0) = ll_height (*info.ptr).fparm(1).limits(0) = ll_xmax (*info.ptr).fparm(2).limits(0) = ll_width (*info.ptr).fparm(3).limits(0) = ll_offset (*info.ptr).fparm(4).limits(0) = ll_slope (*info.ptr).fparm(0).limits(1) = ul_height (*info.ptr).fparm(1).limits(1) = ul_xmax (*info.ptr).fparm(2).limits(1) = ul_width (*info.ptr).fparm(3).limits(1) = ul_offset (*info.ptr).fparm(4).limits(1) = ul_slope (*info.ptr).cancel = 0 ; Destroy the widget program Widget_Control, event.top, /Destroy END else: ENDCASE if buttonValue ne 'Cancel' and buttonValue ne 'Accept' then begin Widget_Control, event.top, Set_UValue=info, /No_Copy endif END ;******************************************************************* Function SetFitParm, thisFParm,$ Parent=parent,$ Cancel=cancel On_Error, 2 IF N_Elements(thisFParm) EQ 0 THEN $ fparm = replicate({value:0.D, fixed:0, limited:[0,0], limits:[0.D,0]}, 5) $ ELSE FParm=thisFParm Device, Get_Screen_Size=screenSize xCenter=FIX(screenSize(0)/2.) yCenter=FIX(screenSize(1)/2.) xoff=xCenter-150 yoff=yCenter-150 ; Create a top-level base. Must have a Group Leader defined ; for Modal operation. If this widget is NOT modal, then it ; should only be called from the IDL command line as a blocking ; widget. IF N_Elements(parent) NE 0 THEN $ tlb = Widget_Base( GROUP_LEADER=parent $ , UNAME='WID_BASE_0', XOffset=xoff, YOffset=yoff $ , XSIZE=380, YSIZE=320 ,TITLE='Parinfo Setup' ,SPACE=3 ,XPAD=3 $ ,YPAD=3, /Floating, /Modal ,/Base_Align_Center) ELSE $ tlb = Widget_Base( UNAME='WID_BASE_0', XOffset=xoff, YOffset=yoff $ , XSIZE=380, YSIZE=320 ,TITLE='Parinfo Setup' ,SPACE=3 ,XPAD=3 $ ,YPAD=3, /Base_Align_Center) WID_BASE_1 = Widget_Base(tlb, UNAME='WID_BASE_1' ,FRAME=1 $ ,XOFFSET=10 ,YOFFSET=55 , XSIZE=350, YSIZE=200 $ ,TITLE='IDL' ,SPACE=3 ,XPAD=3 ,YPAD=3) WID_LABEL_0 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_0' $ ,XOFFSET=10 ,YOFFSET=45, XSIZE=42, YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='Ampl.') WID_LABEL_1 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_1' $ ,XOFFSET=10 ,YOFFSET=75 , XSIZE=42, YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='X(max)') WID_LABEL_2 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_2' $ ,XOFFSET=10 ,YOFFSET=105 , XSIZE=42 ,YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='Width') WID_LABEL_3 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_3' $ ,XOFFSET=10 ,YOFFSET=135, XSIZE=42 ,YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='Offset') WID_LABEL_4 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_4' $ ,XOFFSET=10 ,YOFFSET=165 ,XSIZE=42 ,YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='Slope') ;;;;;;;;;;;;;;;;;;; table headline ;;;;;;;;;;;;;;;;;;;;;;;; ;; with top labels VALUE AND LIMIT WID_LABEL_6 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_6' $ ,XOFFSET=60 ,YOFFSET=15, XSIZE=42, YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='Value') WID_LABEL_8 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_8' $ ,XOFFSET=250 ,YOFFSET=15 ,XSIZE=40,YSIZE=18 $ ,/ALIGN_LEFT ,VALUE='Limits') ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WID_TEXT_0 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_0' ,FRAME=1 $ ,XOFFSET=60 ,YOFFSET=40 , VALUE=[strtrim(string(fparm(0).value),1)] $ ,XSIZE=5 ,YSIZE=1,/editable,/ALIGN_LEFT) ;;; Amplitude WID_TEXT_1 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_1' ,FRAME=1 $ ,XOFFSET=60 ,YOFFSET=70, VALUE=[strtrim(string(fparm(1).value),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; X(max) WID_TEXT_2 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_2' ,FRAME=1 $ ,XOFFSET=60 ,YOFFSET=100, VALUE=[strtrim(string(fparm(2).value),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Width WID_TEXT_3 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_3' ,FRAME=1 $ ,XOFFSET=60 ,YOFFSET=130,VALUE=[strtrim(string(fparm(3).value),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Offset WID_TEXT_4 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_4' ,FRAME=1 $ ,XOFFSET=60 ,YOFFSET=160 ,VALUE=[strtrim(string(fparm(4).value),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Slope ;;;;; Text widgets for lower limits WID_TEXT_5 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_5' ,FRAME=1 $ ,XOFFSET=210 ,YOFFSET=40 ,VALUE=[strtrim(string(fparm(0).limits(0)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable,/ALIGN_LEFT) ;;; Amplitude WID_TEXT_6 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_6' ,FRAME=1 $ ,XOFFSET=210 ,YOFFSET=70, VALUE=[strtrim(string(fparm(1).limits(0)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; X(max) WID_TEXT_7 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_7' ,FRAME=1 $ ,XOFFSET=210 ,YOFFSET=100,VALUE=[strtrim(string(fparm(2).limits(0)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Width WID_TEXT_8 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_8' ,FRAME=1 $ ,XOFFSET=210 ,YOFFSET=130, VALUE=[strtrim(string(fparm(3).limits(0)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Offset WID_TEXT_9 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_9' ,FRAME=1 $ ,XOFFSET=210 ,YOFFSET=160 ,VALUE=[strtrim(string(fparm(4).limits(0)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Slope ;;;;; Text widgets for upper limits WID_TEXT_10 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_10' ,FRAME=1 $ ,XOFFSET=290 ,YOFFSET=40, VALUE=[strtrim(string(fparm(0).limits(1)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable,/ALIGN_LEFT) ;;; Amplitude WID_TEXT_11 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_11' ,FRAME=1 $ ,XOFFSET=290 ,YOFFSET=70, VALUE=[strtrim(string(fparm(1).limits(1)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; X(max) WID_TEXT_12 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_12' ,FRAME=1 $ ,XOFFSET=290 ,YOFFSET=100, VALUE=[strtrim(string(fparm(2).limits(1)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Width WID_TEXT_13 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_13' ,FRAME=1 $ ,XOFFSET=290 ,YOFFSET=130, VALUE=[strtrim(string(fparm(3).limits(1)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Offset WID_TEXT_14 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_14' ,FRAME=1 $ ,XOFFSET=290 ,YOFFSET=160, VALUE=[strtrim(string(fparm(4).limits(1)),1)] $ ,XSIZE=5 ,YSIZE=1,/editable) ;;; Slope ;;;;;;;;;;;; Container for checkboxes and checkboxes for FIXED ;;;;;;;;;;;;;;;; WID_BASE_2 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_2' $ ,XOFFSET=110 ,YOFFSET=40 ,XSIZE=20 ,YSIZE=20 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER , ROW=1 ,/NONEXCLUSIVE) WID_BUTTON_0 = Widget_Button(WID_BASE_2,/ALIGN_CENTER,UVALUE='FIX_HEIGHT' $ , VALUE='') ;;; Amplitude WID_BASE_3 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_3' $ ,XOFFSET=110 ,YOFFSET=70 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,/NONEXCLUSIVE) WID_BUTTON_1 = Widget_Button(WID_BASE_3 ,/ALIGN_LEFT,UVALUE='FIX_XMAX' $ , VALUE='') ;;; X(max) WID_BASE_4 = Widget_Base(WID_BASE_1 $ ,XOFFSET=110 ,YOFFSET=100 ,XSIZE=20 ,YSIZE=27 ,/ALIGN_TOP ,/BASE_ALIGN_CENTER, /NONEXCLUSIVE) WID_BUTTON_2 = Widget_Button(WID_BASE_4, /ALIGN_LEFT,UVALUE='FIX_WIDTH' $ , VALUE='') ;;; Width WID_BASE_5 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_5' $ ,XOFFSET=110 ,YOFFSET=130 ,XSIZE=20 ,YSIZE=27, /ALIGN_TOP, /BASE_ALIGN_CENTER, /NONEXCLUSIVE) WID_BUTTON_3 = Widget_Button(WID_BASE_5, /ALIGN_LEFT, UVALUE='FIX_OFFSET' $ , VALUE='') ;;; Slope WID_BASE_6 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_6' $ , XOFFSET=110 ,YOFFSET=160, XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER, /NONEXCLUSIVE) WID_BUTTON_4 = Widget_Button(WID_BASE_6,/ALIGN_LEFT, UVALUE='FIX_SLOPE' $ , value='') ;;; Slope ;;;;;;;;;;;; Container for checkboxes and checkboxes for lower limited ;;;;;;;;;;;;;;;; WID_BASE_7 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_7' $ ,XOFFSET=180 ,YOFFSET=40 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_5 = Widget_Button(WID_BASE_7 $ ,/ALIGN_LEFT,UVALUE='LIMIT_HEIGHT_LOW', VALUE='') ;;; Height WID_BASE_8 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_8' $ ,XOFFSET=180 ,YOFFSET=70 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_6 = Widget_Button(WID_BASE_8 $ ,/ALIGN_LEFT,UVALUE='LIMIT_XMAX_LOW', VALUE='') ;;; Xmax WID_BASE_9 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_9' $ ,XOFFSET=180 ,YOFFSET=100 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_7 = Widget_Button(WID_BASE_9 $ ,/ALIGN_LEFT,UVALUE='LIMIT_WIDTH_LOW', value='') ;;; Width WID_BASE_10 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_10' $ ,XOFFSET=180 ,YOFFSET=130 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_8 = Widget_Button(WID_BASE_10, UNAME='WID_BUTTON_8' $ ,/ALIGN_LEFT,UVALUE='LIMIT_OFFSET_LOW', value= '') ;;; Offset WID_BASE_11 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_11' $ ,XOFFSET=180 ,YOFFSET=160 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_9 = Widget_Button(WID_BASE_11, UNAME='WID_BUTTON_9' $ ,/ALIGN_LEFT,UVALUE='LIMIT_SLOPE_LOW', value='') ;;; Offset ;;;;;;;;;;;; Container for checkboxes and checkboxes for upper limited ;;;;;;;;;;;;;;;; WID_BASE_12 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_12' $ ,XOFFSET=265 ,YOFFSET=40 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_10 = Widget_Button(WID_BASE_12, UNAME='WID_BUTTON_10' $ ,/ALIGN_LEFT,UVALUE='LIMIT_HEIGHT_UP', value='') ;;; Height WID_BASE_13 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_13' $ ,XOFFSET=265 ,YOFFSET=70 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_11 = Widget_Button(WID_BASE_13, UNAME='WID_BUTTON_11' $ ,/ALIGN_LEFT,UVALUE='LIMIT_XMAX_UP', value='') ;;; Xmax WID_BASE_14 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_14' $ ,XOFFSET=265 ,YOFFSET=100 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_12 = Widget_Button(WID_BASE_14, UNAME='WID_BUTTON_12' $ ,/ALIGN_LEFT,UVALUE='LIMIT_WIDTH_UP', value='') ;;; Width WID_BASE_15 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_15' $ ,XOFFSET=265 ,YOFFSET=130 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_13 = Widget_Button(WID_BASE_15, UNAME='WID_BUTTON_13' $ ,/ALIGN_LEFT,UVALUE='LIMIT_OFFSET_UP', VALUE='') ;;; Offset WID_BASE_16 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_16' $ ,XOFFSET=265 ,YOFFSET=160 ,XSIZE=20 ,YSIZE=27 $ ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1 $ ,/GRID_LAYOUT ,/NONEXCLUSIVE) WID_BUTTON_14 = Widget_Button(WID_BASE_16, UNAME='WID_BUTTON_14' $ ,/ALIGN_LEFT,UVALUE='LIMIT_SLOPE_UP', value='') ;;; Offset ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BUT_BASE=Widget_Base(tlb,Row=1,yoffset=260,xoffset=120,/ALIGN_CENTER) CANCEL=Widget_Button(BUT_BASE,Value='Cancel', UVALUE='Cancel') ACCEPT=Widget_Button(BUT_BASE,Value='Accept', UVALUE='Accept') ; Create a pointer. This will point to the location where the ; information collected from the user will be stored. ptr = Ptr_New({fparm:fparm, Cancel:1}) ; Create info structure to hold information needed in event handler. This info structure containes also the parinfo ; that is used for mpfit. buttons=[WID_BUTTON_0,WID_BUTTON_1,WID_BUTTON_2,WID_BUTTON_3,WID_BUTTON_4,$ WID_BUTTON_5,WID_BUTTON_6,WID_BUTTON_7,WID_BUTTON_8,WID_BUTTON_9,$ WID_BUTTON_10,WID_BUTTON_11,WID_BUTTON_12,WID_BUTTON_13,WID_BUTTON_14,$ CANCEL] text = [WID_TEXT_0,WID_TEXT_1,WID_TEXT_2,WID_TEXT_3,WID_TEXT_4,$ WID_TEXT_5,WID_TEXT_6,WID_TEXT_7,WID_TEXT_8,WID_TEXT_9,$ WID_TEXT_10,WID_TEXT_11,WID_TEXT_12,WID_TEXT_13,WID_TEXT_14] for i=0,4 do begin widget_control,buttons(i),set_button=fparm(i).fixed endfor for i=5,9 do begin widget_control,buttons(i),set_button=fparm(i-5).limited(0) endfor for i=10,14 do begin widget_control,buttons(i),set_button=fparm(i-10).limited(1) endfor info = {buttons:buttons, $ ; Identifier of widget holding buttons (checkboxes). text:text,$ ; Identifier of widget holding textfields. fparm:fparm,$ ; The actual parinfo ptr:ptr} ; The pointer ; Store the info structure in the top-level base Widget_Control, tlb, Set_UValue=info, /No_Copy Widget_Control, /REALIZE, tlb ; Register the program, set up event loop. Make this program a ; blocking widget. This will allow the program to also be called ; from IDL command line without a PARENT parameter. The program ; blocks here until the entire program is destroyed. XManager, 'SetFitParm', tlb, Event_Handler='SetFitParm_Events' ; OK, newInfo = *ptr Ptr_Free, ptr ; All kinds of things can go wrong now. Let's CATCH them all. Catch, error IF error NE 0 THEN BEGIN Catch, /Cancel ; If an error occurs, set the CANCEL flag and return -1. ok = Dialog_Message(!Err_String) cancel = 1 RETURN, -1 ENDIF ; If the error flag is set, let's disappear! cancel = newInfo.cancel IF cancel THEN RETURN, FParm ; OK, try to read the data file. Watch out! RETURN, newInfo.FParm END ;******************************************************************* INSTALL0000644000244500024450000000373707764421271011425 0ustar craigmcraigmMARKWARDT IDL PROGRAMS INSTALLATION INSTRUCTIONS Craig Markwardt craigm@cow.physics.wisc.edu 31 Jan 2000 The following instructions apply to all functions and procedures included in the Markwardt IDL library. DOWNLOADING Download new versions of from Craig Markwardt's web page: http://cow.physics.wisc.edu/~craigm/idl/idl.html Program modification dates appear on the web page, which you can compare agains your own copy. You can also check the modification history of the file itself to see how recent it is. COMPATIBILITY All programs are intended to be compatible with both Unix, Windows and MacIntosh versions of IDL, unless otherwise noted. If you are downloading archive, then the most suitable archive file type can be found from this chart, depending on your operating system: Windows ZIP archive (must have unzipping utility) MacIntosh ZIP archive (must have unzipping utility) Unix TAR or ZIP archive (must have gunzip or unzip utility) INSTALLATION Program files should be placed in your IDL PATH. You may either copy them to an existing directory in your path, or else create a new directory for them to reside in. Please see your IDL documentation for instructions on how to add directories to your IDL path. You may read the individual program's documentation, stored with the program itself, for more information on usage. If the files you downloaded came in an archive, you must unarchive them. It is recommended that you unarchive them into a separate directory for convenience's sake. For Windows and MacIntosh systems, you should use an appropriate unzipping utility to expand the ZIP archive you downloaded. For Unix systems, you should use one of the following commands, whichever is appropriate: gzip -dc .tar.gz | tar xvf - (for TAR file; or...) unzip .zip (for ZIP file) where is the name of the archive you downloaded. IDL is a registered trademark of RSI MPREADME0000644000244500024450000001002411410062140011447 0ustar craigmcraigm MPFIT PACKAGE MARKWARDT IDL PROGRAMS Craig Markwardt Craig.Markwardt@gmail.com 22 Nov 2009 The following instructions apply to the MPFIT and TNMIN packages of functions for curve fitting under IDL, available from the Markwardt IDL Library. MPFIT is a set of routines for robust least-squares minimization (curve fitting), using arbitrary user written IDL functions or procedures. MPFIT is based on the well-known and tested MINPACK-1 FORTRAN package of routines available at www.netlib.org. The relevant sections of code have been translated almost directly from the FORTRAN equivalent. MPFIT functions are designed for consistent usage and have some special features not found in the standard IDL routines. MPFIT functions permit you to fix any function parameters, as well as to set simple upper and lower parameter bounds. See the documentation under PARINFO for instructions on how to use this facility. When referring to MPFIT in your scientific papers, please cite the following paper. You can use the NASA ADS link below to get a citation in the preferred format for your journal. Markwardt, C. B. 2008, "Non-Linear Least Squares Fitting in IDL with MPFIT," in proc. Astronomical Data Analysis Software and Systems XVIII, Quebec, Canada, ASP Conference Series, Vol. XXX, eds. D. Bohlender, P. Dowler & D. Durand (Astronomical Society of the Pacific: San Francisco), p. 251-254 (ISBN: 978-1-58381-702-5) http://arxiv.org/abs/0902.2850 Link to NASA ADS: http://adsabs.harvard.edu/abs/2009ASPC..411..251M Link to ASP: http://aspbooks.org/a/volumes/table_of_contents/411 Refer to the MPFIT website as: http://purl.com/net/mpfit TNMIN TNMIN solves general minimization problems (generally not curve fitting), and has similar features to the MPFIT family of functions. As of this writing, TNMIN requires the user function to supply derivatives. DOWNLOADING Download new versions of from Craig Markwardt's web page: http://purl.com/net/mpfit Program modification dates appear on the web page, which you can compare agains your own copy. You can also check the modification history of the file itself to see how recent it is. Please see the file INSTALL for installation instructions. MANIFEST The following functions are included: INSTALL - installation instructions MPREADME - this file MPFIT - main fitting engine, required for other driver functions MPFITFUN - driver function for 1D function fitting MPFIT2DFUN - driver function for 2D function fitting (images) MPCURVEFIT - drop-in replacement for IDL's CURVEFIT, requires MPFIT MPFITEXPR - driver function for fitting expressions interactively MPFITPEAK - driver function for fitting Gaussian, Lorentzian or Moffat peaks MPFIT2DPEAK - driver function for fitting 2D peaks GAUSS1 - example 1D gaussian function GAUSS1P - example 2D gaussian *procedure* fakedata.sav - example 1D gaussian data USAGE The general theory of curve fitting is beyond the scope of this document. However, I can offer you a few suggestions. First, read the fitting tutorial found on my web page here: http://purl.com/net/mpfit (and click through to the Fitting section). This should get you started on the basics of 1D fitting, and in fact 2D fitting too since the principles are almost the same. Second, read the documentation! Each of the program files is extensively self-documented in their comment headers. You can either read the files directly or download the documentation from my web page in the documentation section. Finally, don't be afraid to experiment. RECOMMENDATIONS There are a lot of fitting functions available, each one optimized for a specific task. Allow me to suggest which one to use: * For 1D curve fitting, use MPFITFUN; * For 2D surface fitting, use MPFIT2DFUN; * For existing programs which already use CURVEFIT, use MPCURVEFIT; * For general non-linear minimization problems, use TNMIN The main engine, MPFIT, is required in all cases, since the driver functions call it. IDL is a registered trademark of RSI mpfittut.html0000644000244500024450000003645710600526153013127 0ustar craigmcraigm %body %body %body %body %body New! (new %body) Updated! (updated %body) Download!

%0 - %1

%body %body

%body




%body 
%body
 Tutorial: 1D Curve Fitting in IDL using MPFITFUN and MPFITEXPR

I have found curve-fitting in IDL to be somewhat of a frustrating process. There are a number of hoops you have to jump through that just make data analysis a pain. Furthermore, the IDL supplied curve fitting routine, called CURVEFIT, is not as robust as I would like. I have found that I can crash the entire IDL session with some fairly simple data and models. I have translated MINPACK-1, a very nice curve fitting package into IDL. The fitting programs are called MPFIT, MPFITFUN, and MPFITEXPR (and can be downloaded here). Here I present a short tutorial on how to use MPFITFUN and MPFITEXPR.

MPFITEXPR is generally the easiest to use interactively at the command line, while MPFITFUN is most commonly used in programs.

Collecting your data

The first step in any analysis process is to collect your data. You are in charge of that, since only you know the specific details of how your experiment is run. In general, you will have three sets of numbers:

  • The "X" values - these are the independent variables of the experiment.
  • The "Y" values - these are the "measured" dependent variables.
  • The "Error" values - this is typically the 1-sigma uncertainty in your measurement.

Of course you will have your own data, but I will provide some sample data (6 kb), in the form of an IDL "SAVE" file. It contains three variables, which you can imagine might represent the rate measured by a detector: t, r, and rerr, corresponding to a time, rate, and error in the rate. The error is simply the Poisson statistical error. My example below will use these variables.

Here is a plot of the data with errors:

Plot of data and errors

What to do if you don't have error bars

A proper experimenter should always assign error bars to their data. After all, a data point with larger errors should be weighted less in the fit, compared to a point with small error bars. However, I can foresee that under circumstances which only you can judge, the error bars may not be relevant. In that case, you may set the "Error" term to unity and proceed with the fit. Be aware that your data may not be properly weighted, and the error estimates produced by MPFITFUN/EXPR will not be correct. Bevington (Ch. 6.4) has an approach that allows you to assign error bars once you know the best-fit sum-of-squares. This number is returned through the BESTNORM keyword.

Choosing a Model

By fitting a curve to your data, you are assuming that a particular model best represents the data. This again is up to you because of course, only you can assign an interpretation to your own data. Interpretations aside however, we can try to see how well a particular model fits by, well, just fitting it!

In this example, it is pretty clear that there is a fairly constant level of about 1000, with a "hump" near 2.5. I speculate that a constant plus Gaussian will fit that curve quite nicely. [ I in fact generated the data using that model. ]

How do you construct a model that IDL will understand? When you use MPFITEXPR, you only need to supply an IDL expression which computes the model. Here's how I would do the constant plus Gaussian model:

IDL> expr = 'P[0] + GAUSS1(X, P[1:3])'

The variable expr now contains an IDL expression which takes a constant value "P[0]" and adds a Gaussian "GAUSS1(X, P[1:3])". The GAUSS1 function is a one dimensional Gaussian curve, whose source code can be downloaded.

There are a few important things to notice here. First, the name of the independent variable is always "X", no matter what it is called in your session. When MPFITEXPR executes your expression, it substitutes the correct independent variable for "X" in the expression. Second, all of the parameters are stored in a single array variable called "P". Again, you are free to name the parameter array anything you like in your own session, but in the expression it must appear as "P".

When you use MPFITFUN instead, you need to construct an IDL function which does the same thing as the expression above. You should deposit the following function definition into a text file called mygauss.pro:

FUNCTION MYGAUSS, X, P RETURN, P[0] + GAUSS1(X, P[1:3]) END

and compile with:

IDL> .comp mygauss

You will need to decide for yourself how to arrange your parameter values. In my example, I decided that parameter 0, the first parameter, would be the constant value, while parameters 1 through 3 would be the parameters of the Gaussian (the three parameters to GAUSS1 are, in order: mean, sigma, and area under curve). If two parts of the expression require the same parameter value, then just type it in that way! This is a very elegant way to share parameter values between several different model components.

Choosing Starting Values

You need to at least give MPFITFUN/EXPR a starting point in the parameter space. A rough guess is fine for most problems. I can enter my guess into the IDL session like this:

IDL> start = [950.D, 2.5, 1., 1000.]

Those four numbers mean that the constant value will start at 950, and the Gaussian will start with a mean of 2.5, a sigma of 1, and an area of 1000. Since the data is double precision, I force the starting values to be double as well (or else MPFIT will complain). It is the fitting program's job to iterate until it finds the best solution it can.

Choosing the starting values can be somewhat of an art. For some particularly nasty problems with deep local minima, the proper choice of the starting parameters may mean the difference between converging to the global minimum or a local one. Again, only you can make this judgment.

Fitting the Curve

Finally we can fit the curve using MPFITEXPR or MPFITFUN on the command line:

IDL> result = MPFITEXPR(expr, t, r, rerr, start) or IDL> result = MPFITFUN('MYGAUSS', t, r, rerr, start)

This will tell MPFITEXPR or MPFITFUN to fit the time/rate/error data using the model specified in the expression expr and starting at start. The routine will print diagnostic messages showing its progress, and finally it should converge to an answer. When it is done, we can print the results:

IDL> print, result 997.61864 2.1550703 1.4488421 3040.2411

which means that the best-fit constant level is 997, the mean of the "hump" is 2.15 with a width of 1.45, and the area under the hump is 3040. That's all there is too it!

Verifying the Fit

As a final step in the fitting process, we can make a plot of the data and overlay a fitted model:

IDL> ploterr, t, r, rerr IDL> oplot, t, result(0)+gauss1(t, result(1:3)), color=50, thick=5

In the oplot command above, I substituted the proper names for the independent variable and the parameter array. The color and thick keywords make the fitted curve stand out a little better. The results are excellent:

Plot of fitted curve and data

Advanced Topics: Constraining Parameters

Fixing Parameters

Now let's say that I have learned that the constant level should be fixed at 1000 exactly. I need to redo the analysis, and "freeze" the constant to 1000. One way to do that would be to rewrite the expression, and hard-code the value of 1000. Another more natural way to achieve the same thing is to "fix" the value to 1000 within the logic of MPFIT itself. All of the MPFIT functions understand a special keyword called PARINFO which allows you to do this.

You pass an array of structures through the PARINFO keyword, one structure for each parameter. The structure describes which parameters should be fixed, and also whether any constraints should be imposed on the parameter (such as lower or upper bounds). The structures must have a few required fields. You can do this by replicating a single one like this:

IDL> pi = replicate({fixed:0, limited:[0,0], limits:[0.D,0.D]},4)

A total of four structures are made because there are four parameters. Once we have the blank template, then we can fill in any values we desire. For example, we want to fix the first parameter, the constant:

IDL> pi(0).fixed = 1 IDL> start(0) = 1000

I have reset the starting value to 1000 (the desired value), and "fixed" that parameter by setting it to one. If fixed is zero for a particular parameter, then it is allowed to vary. Now we run the fit again, but pass pi to the fitter using the PARINFO keyword:

IDL> result = MPFITEXPR(expr, t, r, rerr, start, PARINFO=pi) IDL> result = MPFITFUN('MYGAUSS', t, r, rerr, start, PARINFO=pi)

You interpret the results the same way as before. It should be clear that the first parameter remained fixed at 1000 rather than varying to 997.

Specifying Constraining Bounds

All of the fitting procedures here also allow you to impose lower and upper bounding constraints on any combination of the parameters you choose. This might be important, say, if you need to require a certain parameter to be positive, or be constrained between two fixed values. The technique again uses the PARINFO keyword. You see above that in addition to the fixed entry, there are some others, including limited and limits. They work in a similar fashion to fixed.

For example, let us say we know a priori that the Gaussian mean must be above a value of 2.3. I need to fill that information into the PARINFO structure like this:

IDL> pi(1).limited(0) = 1 IDL> pi(1).limits(0) = 2.3

Here, for parameter number 1, I have set limited(0) equal to 1. The limited entry has two values corresponding to the lower and upper boundaries, respectively. If limited(0) is set to 1, then the lower boundary is activated. The boundary itself is found in limits(0), where I entered the value of 2.3. The same logic applies to the upper limits (which for each parameter are specified in limited(1) and limits(1)). You can have any combination of lower and upper limits for each parameter. Just make sure that you set both the limited and limits entries: one enables the bound, and the other gives the actual boundary value.

Concluding Remarks

Well, those are the basics of fitting with MPFITEXPR and MPFITFUN. You will need some practice before you can feel comfortable, which is true for anything new. I have documented the usage of each function in the header of the program file. If you need to find more information about the techniques I used above, you may find it there. If you are concerned about error analysis, then you will want to check the parameters called PERROR, COVAR and BESTNORM, which return the 1-sigma parameter errors, covariance matrix and the best-fit chi squared value.

References

Bevington, P. R. and Robinson, D. K. 1992, Data Reduction and Error Analysis for the Physical Sciences, 2nd Ed., McGraw-Hill, Inc.

Files

Nov 24 2006112 kb mpfit.proREQUIRED  
Nov 24 200628 kb mpfitfun.proRecommended  
Nov 24 200630 kb mpfitexpr.pro  
Aug 03 19986 kb fakedata.savSample Data  
Oct 13 20012 kb gauss1.proGaussian Model  
Copyright © 1997-2001 Craig B. Markwardt
Last Modified on 2007-03-22 11:18:50 by Craig Markwardt

fitqa.html0000644000244500024450000004226612717423344012363 0ustar craigmcraigm %body %body %body %body %body New! (new %body) Updated! (updated %body) Download!

%0 - %1

%body %body

%body




MPFIT Frequently Asked Questions

Which MPFIT Files Should I Download and Use?

The easiest solution is to download the entire set of routines as either a ZIP file or a gzipped TAR file, and then extract them in your IDL path. However it is possible to selectively download what you need. Bear in mind that you will always need MPFIT.PRO which is the main fitting engine.

For standard fitting of 1D curves, where the model is a compiled function, download MPFITFUN.PRO and MPFIT.PRO. For specialized peak fitting, use MPFITPEAK.PRO in combination with these two.

For fitting of 2D images or surfaces, download MPFIT2DFUN.PRO and MPFIT.PRO. For peak fitting, use MPFIT2DPEAK.PRO in combination with these two.

For a drop-in replacement for the IDL-supplied CURVEFIT in legacy code, use MPCURVEFIT.PRO along with MPFIT.PRO.

For cases where you don't have a precompiled function, either at the command line on within your program, you can use an IDL expression. Download MPFITEXPR.PRO and MPFIT.PRO.

Is There a Citation for MPFIT?

I regularly get asked if there is a way for users to cite MPFIT in their scientific publications. The answer is yes! I presented a paper about MPFIT at the ADASS XVIII conference in Quebec, Canada, in Nov, 2008, with proceedings published by the Astronomical Society of the Pacific (2009). I welcome you to cite this publication in your own works.

  • Markwardt, C. B. 2009, "Non-Linear Least Squares Fitting in IDL with MPFIT," in proc. Astronomical Data Analysis Software and Systems XVIII, Quebec, Canada, ASP Conference Series, Vol. 411, eds. D. Bohlender, P. Dowler & D. Durand (Astronomical Society of the Pacific: San Francisco), p. 251-254 (ISBN: 978-1-58381-702-5; Link to ASP title listing)
    ADS Bibcode: 2009ASPC..411..251M (click for Bibtex and other citation formats)
    Arxiv preprint: arXiv:0902.2850v1
  • Bibtex entry: 
    \bibitem[Markwardt(2009)]{2009ASPC..411..251M} Markwardt, C.~B.\ 2009,
Astronomical Data Analysis Software and Systems XVIII, 411, 251
  • Referring to the MPFIT website. Please use:
    http://purl.com/net/mpfit
    in your citations. Right now this link redirects to my Wisconsin website, but the Wisconsin website will not exist forever. When I move the website, I will change the purl.com redirect as well.
At the same time, I also urge you to cite the work of the original designer of the MINPACK algorithm, Jorge Moré, especially the first listed citation below.
  • Moré, J. 1978, "The Levenberg-Marquardt Algorithm: Implementation and Theory," in Numerical Analysis, vol. 630, ed. G. A. Watson (Springer-Verlag: Berlin), p. 105
    (DOI: 10.1007/BFb0067690; Link to Springer title listing)
  • Moré, J. & Wright, S. 1993, "Optimization Software Guide," SIAM, Frontiers in Applied Mathematics, Number 14.
    (ISBN: 978-0-898713-22-0; Link to SIAM title listing)
  • MINPACK-1, Jorge More', available from netlib. http://www.netlib.org/minpack

Are there other versions of MPFIT?

Yes! MPFIT is based on the original MINPACK-1 library, written in FORTRAN, available from Netlib at http://netlib.org/minpack.

I'm also pleased to make available a C library version of MPFIT. This library has many of the same capabilities as the IDL version, including parameter bounds and choice of numerical or explicit derivatives, in a small, fast library, with simple calling interface. Of course, some IDL-specific elements such as _EXTRA and "tied" parameters don't make as much sense in C, and they are not present. See the C Version of MPFIT page for more information. The original MINPACK-1 code was translated to C by Stephen Moshier (http://moshier.net/), from which MPFIT borrows extensively.

MPFIT was translated to Python's Numeric library in 2002 by Mark Rivers, and can be found at his website. In 2009, Sergei Koposov ported that code to use the more modern Python Numpy numerical library, and the result can be found in his astrolibpy library.

How can I calculate the best-fit model?

All of the basic functions in the library return the best-fit model function using the keyword YFIT. Simply pass a named variable with this keyword and upon return the best-fit model will be in that variable.

If you change the parameter values manually, it is still simple to recompute the model function. It differs, depending on what type of model you are fitting:

yfit = model(x, p)1D Model named model
zfit = model(x, y, p)2D Model named model
yfit = MPEVALEXPR(expr, x, p)Expression named expr

Here, p is assumed to be the parameter set.

How do I fit a 2D image?

The simplest answer is to use the MPFIT2DFUN.PRO function. You supply the image, the X and Y labels for each pixel, and a 2D model function.

Can I fit a function of several variables?

This is a question when you are fitting a function of several independent variables, such as this:

    y = f(x0,x1,x2, ...; p0, p1, p2, ...)

where the xi are the independent variables and the pi are fitting parameters.

Most of the MPFIT functions do not care how many independent variables there are. In fact, the main fitting routine MPFIT does not accept any independent variables at all! Instead, they are considered to be implicit to the problem. Functions like MPFITFUN do accept an independent variable called X. [ Since MPFIT itself doesn't deal with the independent variables, MPFITFUN creates a common block with that information so that the model function can gain access to it. ]

Therefore, if you are using plain MPFIT to do your fitting, then you have the freedom to construct your model in any way you please.

If you are using MPFITFUN or MPFIT2DFUN, then your model should still be a function of a single variable X, and you should pass a single set of independent variables called X to the fitting routine. However, X can be arbitrarily complicated, so you can have it be a 2D array, the first row containing "x0" values, the second containing "x1", and so on. Thus the burden falls to your IDL model function to decode the contents of X. I recommend the 2D array approach, but you can also simply concatenate the variables in a 1D vector, or pass them by COMMON block (not recommended).

The array approach I am advocating would be something like this:

p = mpfitfun([x0, x1, x2], y, yerr, pstart, ...)

This creates a new "X" variable which is the array concatenation of all of your independent variables. Then the burden would be upon your user function to extract the relevant quantities from this array.

Help! I can't get my fitting to work!

Generally speaking, this is not something I can help with. I am probably not an expert in your field, and I am definitely not an expert in optimization. However, I think there are a few very important things that you must do.

First, you must make sure that the problem is well defined. Make sure that you know exactly what function you plan on fitting. The MPFIT functions are not psychic; they can't figure out how to solve your problem for you.

I see quite a few people who can't get their model functions right. The best kind of model function is self-contained, not depending on any outside data or common blocks. Be sure that your model function works by itself before throwing MPFIT into the mix. It is very difficult to debug the problem when the added layer of MPFIT is disguising everything. Be aware of domain problems. For example, if you will be taking the square root of a parameter, you had better constrain it to be positive.

Finally, and this can't be stressed enough, it is crucial to estimate the starting parameters as best you can. Initializing the parameters to all zeroes is actually the worst thing you can do, since then the problem becomes scale-less, and MPFIT has a much harder time deciding what to do.

Do I need to compute derivatives?

The short answer is, probably not. I have found that in most cases the automatic finite difference technique used by MPFIT is sufficient. Computing the derivatives explicitly seems to slow things down, and can even make a worse final solution. My suggestion is to try it first without computing the derivatives, and them implement derivatives as needed (and the AUTODERIVATIVE=0 keyword).

However, see the caveats below.

How can I embed MPFIT-style fitting in a widget application?

My belief is that the best solution is to use the ITERPROC feature, which in turn would call WIDGET_EVENT manually to dispatch events. Rob Dimeo has successfully integrated this approach into his dedicated peak fitting program named PAN. PAN is the winner of an honorable mention the recent IDL programming contest. Source code is available (uses objects). Nice job, Rob! Here is a small screenshot:

Small screen shot of Dimeo's PAN

Small screen shot of PAN

Why does MPFIT just return my parameters without fitting? / How do I check for processing errors?

Users occcasional report that MPFIT, or one of its drivers, return without fitting any of the parameters. This is usually an indication that MPFIT discovered an error in the user-specified parameters and returned immediately.

Users should check the values of the STATUS and ERRMSG keywords when MPFIT returns. If STATUS is less than or equal to 0, then a processing error has occurred. A more detailed description of the problem can be found by consulting the ERRMSG keyword.

A simple example of error checking using STATUS and ERRMSG might be:

  p = MPFITFUN(x, y, dy, p0, STATUS=status, ERRMSG=errmsg)
  if status LE 0 then message, errmsg

Of course, more sophisticated error handling approaches can be implemented as needed.

Why does MPFIT not converge properly?

For certain problem sets, MPFIT will not converge to the "optimal" solution. It may seem obvious to you that there is a better solution, but MPFIT does not find it. Why could this be?

Be sure you are checking for error conditions. MPFIT may be indicating an error condition which prematurely terminates the fit.

MPFIT normally uses a finite difference approximation to estimate derivatives. This means that it varies each parameter by a small amount, and measures the corresponding variation in the chi-square value. However, if your data or model are discretized for some reason then this approximation can fail, which then causes the fit not to converge. You should check for:

  • Automatically-selected step size too small. In some cases, the automatically-selected step sized used to compute derivatives is too small. This usually happens when the dynamic range of the parameter is very small compared to the absolute value. Solution: set the step size manually with PARINFO.STEP or .RELSTEP, to be small enough to resolve the variations in your fitting function. Another solution is to re-write your model function to remove large constant offsets from parameters.
  • Discretized parameters. Example: a tabulated model, which is evaluated on a discrete grid of parameters. Solution: Interpolate the table smoothly between parameter values; set PARINFO.STEP or .RELSTEP values to be comparable to the grid spacing.
  • Discontinuous functions. Example: use of the ABS() function, or any function which has a discontinous derivative. Solution: use analytical derivatives; or use a smoother approximation to your discontinuous function.
  • Undersampled data. Example: fitting of undersampled peaks. For example, consider data sampled with a grid spacing of 1 unit, which contains a peak whose ideal full-width at half-max is 0.5 unit. Since this peak is undersampled, the small parameter variations attempted by MPFIT may have no measureable effect. Solution: get data with finer sampling; adjust PARINFO.STEP or .RELSTEP to be comparable to the grid spacing.

Also, beware that PARINFO.RELSTEP will not work if the parameter value is zero. Generally speaking, all starting parameter values should be non-zero.

Following along those lines, it's also worth checking what the dynamic range of your parameters is. For example, if you are fitting a model of 'p(0)+p(1)*x' where p(0) is 1 and p(1) is 1d-12, then the fitting won't do very well. There are matrix operations inside of MPFIT that may lose precision if there is a large dynamic range in parameter values. It's better to absorb the 1d-12 factor into the fitting function, so that all of the parameters are of equivalent magnitude.

Finally, beware that if your chi-square function has local minima then MPFIT may become irretrievably stuck. MPFIT is not a global optimizer.
Copyright © 1997-2001 Craig B. Markwardt
Last Modified on 2016-05-19 15:49:40 by Craig Markwardt

.idlwave_catalog0000644000244500024450000016333212134044207013503 0ustar craigmcraigm;; ;; IDLWAVE catalog for library markwardt ;; Automatically Generated -- do not edit. ;; Created by idlwave_catalog on Thu Apr 18 14:24:55 2013 ;; (setq idlwave-library-catalog-libname "markwardt") (setq idlwave-library-catalog-routines '(("mpfit_dummy" pro nil (lib "mpfit.pro" nil "markwardt") "%s" (nil)) ("mpfit_resetprof" pro nil (lib "mpfit.pro" nil "markwardt") "%s" (nil)) ("mpfit_setmachar" pro nil (lib "mpfit.pro" nil "markwardt") "%s" (nil ("double"))) ("mpfit_call_func_noextra" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, x, fjac)" (nil ("_EXTRA"))) ("mpfit_call_func_extra" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, x, fjac)" (nil ("_EXTRA"))) ("mpfit_call_pro_noextra" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, x, fjac)" (nil ("_EXTRA"))) ("mpfit_call_pro_extra" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, x, fjac)" (nil ("_EXTRA"))) ("mpfit_call" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, x, fjac)" (nil ("_EXTRA"))) ("mpfit_fdjac2" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, x, fvec, step, ulimited, ulimit, dside)" (nil ("autoderiv") ("deriv_abstol") ("deriv_debug") ("deriv_reltol") ("dstep") ("epsfcn") ("FUNCTARGS") ("iflag") ("ifree") ("xall"))) ("mpfit_enorm" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(vec)" (nil)) ("mpfit_qrfac" pro nil (lib "mpfit.pro" nil "markwardt") "%s, a, ipvt, rdiag, acnorm" (nil ("pivot"))) ("mpfit_qrsolv" pro nil (lib "mpfit.pro" nil "markwardt") "%s, r, ipvt, diag, qtb, x, sdiag" (nil)) ("mpfit_lmpar" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(r, ipvt, diag, qtb, delta, x, sdiag)" (nil ("par"))) ("mpfit_tie" pro nil (lib "mpfit.pro" nil "markwardt") "%s, p" (nil)) ("mpfit_defprint" pro nil (lib "mpfit.pro" nil "markwardt") "%s, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, p18" (nil ("_EXTRA") ("format") ("unit"))) ("mpfit_defiter" pro nil (lib "mpfit.pro" nil "markwardt") "%s, fcn, x, iter, fnorm" (nil ("_EXTRA") ("dof") ("format") ("FUNCTARGS") ("iterkeybyte") ("iterprint") ("iterstop") ("parinfo") ("pformat") ("quiet"))) ("mpfit_parinfo" pro nil (lib "mpfit.pro" nil "markwardt") "%s, parinfo, tnames, tag, values" (nil ("default") ("n_param") ("status"))) ("mpfit_covar" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(rr, ipvt)" (nil ("tol"))) ("mpfit_revision" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s" (nil)) ("mpfit_parse_version" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(version)" (nil)) ("mpfit_min_version" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(version, min_version)" (nil)) ("mpfit_reset_recursion" pro nil (lib "mpfit.pro" nil "markwardt") "%s" (nil)) ("mpfit" fun nil (lib "mpfit.pro" nil "markwardt") "Result = %s(fcn, xall)" (nil ("autoderivative") ("best_fjac") ("best_resid") ("bestnorm") ("calc_fjac") ("covar") ("diag") ("dof") ("epsfcn") ("errmsg") ("external_fjac") ("external_fvec") ("external_init") ("external_state") ("factor") ("fastnorm") ("ftol") ("FUNCTARGS") ("gtol") ("iterargs") ("iterkeystop") ("iterproc") ("iterstop") ("maxiter") ("min_version") ("nfev") ("nfree") ("niter") ("nocatch") ("nocovar") ("npegged") ("nprint") ("parinfo") ("perror") ("pfree_index") ("proc") ("query") ("quiet") ("rescale") ("resdamp") ("SCALE_FCN") ("STATUS") ("version") ("xtol"))) ("mpfitfun_eval" fun nil (lib "mpfitfun.pro" nil "markwardt") "Result = %s(p, dp)" (nil ("_EXTRA"))) ("mpfitfun_cash" pro nil (lib "mpfitfun.pro" nil "markwardt") "%s, resid, dresid" (nil)) ("mpfitfun" fun nil (lib "mpfitfun.pro" nil "markwardt") "Result = %s(fcn, x, y, err, p)" (nil ("_EXTRA") ("best_fjac") ("best_resid") ("BESTNORM") ("calc_fjac") ("CASH") ("covar") ("dof") ("ERRMSG") ("FUNCTARGS") ("NAN") ("nfev") ("nfree") ("niter") ("npegged") ("parinfo") ("perror") ("pfree_index") ("query") ("quiet") ("STATUS") ("WEIGHTS") ("yfit"))) ("mpfit2dfun_eval" fun nil (lib "mpfit2dfun.pro" nil "markwardt") "Result = %s(p, dp)" (nil ("_EXTRA"))) ("mpfit2dfun" fun nil (lib "mpfit2dfun.pro" nil "markwardt") "Result = %s(fcn, x, y, z, err, p)" (nil ("_EXTRA") ("BESTNORM") ("covar") ("dof") ("ERRMSG") ("FUNCTARGS") ("nfev") ("nfree") ("niter") ("npegged") ("parinfo") ("perror") ("query") ("quiet") ("STATUS") ("WEIGHTS") ("yfit"))) ("mpcurvefit_eval" fun nil (lib "mpcurvefit.pro" nil "markwardt") "Result = %s(p, dp)" (nil ("_EXTRA"))) ("mpcurvefit" fun nil (lib "mpcurvefit.pro" nil "markwardt") "Result = %s(x, y, wts, p, perror)" (nil ("_EXTRA") ("chisq") ("covar") ("dof") ("errmsg") ("ftol") ("FUNCTARGS") ("function_name") ("iter") ("itmax") ("nfev") ("nfree") ("nocovar") ("noderivative") ("parinfo") ("query") ("QUIET") ("STATUS") ("tol") ("yerror"))) ("mpevalexpr" fun nil (lib "mpfitexpr.pro" nil "markwardt") "Result = %s(x, p)" (nil ("functargs"))) ("mpfitexpr_eval" fun nil (lib "mpfitexpr.pro" nil "markwardt") "Result = %s(p)" (nil ("_EXTRA"))) ("mpfitexpr" fun nil (lib "mpfitexpr.pro" nil "markwardt") "Result = %s(expr, x, y, err, p)" (nil ("_EXTRA") ("BESTNORM") ("covar") ("dof") ("errmsg") ("functargs") ("nfev") ("nfree") ("niter") ("npegged") ("parinfo") ("perror") ("query") ("quiet") ("STATUS") ("WEIGHTS") ("yfit"))) ("tnmin_dummy" pro nil (lib "tnmin.pro" nil "markwardt") "%s" (nil)) ("tnmin_setmachar" pro nil (lib "tnmin.pro" nil "markwardt") "%s" (nil ("double"))) ("tnmin_parinfo" pro nil (lib "tnmin.pro" nil "markwardt") "%s, parinfo, tnames, tag, values" (nil ("default") ("n_param") ("status"))) ("tnmin_tie" pro nil (lib "tnmin.pro" nil "markwardt") "%s, p" (nil)) ("tnmin_autoder" fun nil (lib "tnmin.pro" nil "markwardt") "Result = %s(fcn, x, dx)" (nil ("dside"))) ("tnmin_call" fun nil (lib "tnmin.pro" nil "markwardt") "Result = %s(fcn, x1, dx)" (nil ("fullparam_"))) ("tnmin_enorm" fun nil (lib "tnmin.pro" nil "markwardt") "Result = %s(vec)" (nil)) ("tnmin_initpc" pro nil (lib "tnmin.pro" nil "markwardt") "%s, diagb, emat, n, upd1, yksk, gsk, yrsr, lreset" (nil)) ("tnmin_ssbfgs" pro nil (lib "tnmin.pro" nil "markwardt") "%s, n, gamma, sj, yj, hjv, hjyj, yjsj, yjhyj, vsj, vhyj, hjp1v" (nil)) ("tnmin_msolve" pro nil (lib "tnmin.pro" nil "markwardt") "%s, g, y, n, upd1, yksk, gsk, yrsr, lreset, first, hyr, hyk, ykhyk, yrhyr" (nil)) ("tnmin_gtims" pro nil (lib "tnmin.pro" nil "markwardt") "%s, v, gv, n, x, g, fcn, first, delta, accrcy, xnorm, xnew" (nil)) ("tnmin_ndia3" pro nil (lib "tnmin.pro" nil "markwardt") "%s, n, e, v, gv, r, vgv" (nil)) ("tnmin_fix" pro nil (lib "tnmin.pro" nil "markwardt") "%s, whlpeg, whupeg, z" (nil)) ("tnmin_modlnp" pro nil (lib "tnmin.pro" nil "markwardt") "%s, zsol, gv, r, v, diagb, emat, x, g, zk, n, niter, maxit, nmodif, nlincg, upd1, yksk, gsk, yrsr, lreset, fcn, whlpeg, whupeg, accrcy, gtp, gnorm, xnorm, xnew" (nil)) ("tnmin_step1" fun nil (lib "tnmin.pro" nil "markwardt") "Result = %s(fnew, fm, gtp, smax, epsmch)" (nil)) ("tnmin_getptc" pro nil (lib "tnmin.pro" nil "markwardt") "%s, big, small, rtsmll, reltol, abstol, tnytol, fpresn, eta, rmu, xbnd, u, fu, gu, xmin, fmin, gmin, xw, fw, gw, a, b, oldf, b1, scxbnd, e, step, factor, braktd, gtest1, gtest2, tol, ientry, itest" (nil)) ("tnmin_linder" pro nil (lib "tnmin.pro" nil "markwardt") "%s, n, fcn, small, epsmch, reltol, abstol, tnytol, eta, sftbnd, xbnd, p, gtp, x, f, alpha, g, iflag, xnew" (nil)) ("tnmin_defiter" pro nil (lib "tnmin.pro" nil "markwardt") "%s, fcn, x, iter, fnorm" (nil ("_EXTRA") ("deriv") ("dprint") ("fmt") ("FUNCTARGS") ("maximize") ("pfixed") ("quiet"))) ("tnmin" fun nil (lib "tnmin.pro" nil "markwardt") "Result = %s(fcn, xall)" (nil ("autoderivative") ("bestmin") ("epsabs") ("epsrel") ("errmsg") ("fastnorm") ("fguess") ("functargs") ("iterargs") ("iterderiv") ("iterproc") ("maximize") ("maxiter") ("maxnfev") ("nfev") ("niter") ("nocatch") ("nprint") ("parinfo") ("quiet") ("status"))) ("gauss1" fun nil (lib "gauss1.pro" nil "markwardt") "Result = %s(x, p)" (nil ("_EXTRA") ("peak") ("skew"))) ("cmps_form_Draw_Coords" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, drawpixperunit, xoff, yoff, xsize, ysize" (nil)) ("cmps_form_Real_Coords" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, drawpixperunit, xoff, yoff, xsize, ysize" (nil)) ("cmps_form_Select_File" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_PlotBox_Coords" fun nil (lib "cmps_form.pro" nil "markwardt") "Result = %s(xsize, ysize, xoff, yoff, drawpixperunit)" (nil)) ("cmps_form_conv_pscoord" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, info, xpagesize, ypagesize" (nil ("tohuman") ("toidl"))) ("cmps_form_papernames" fun nil (lib "cmps_form.pro" nil "markwardt") "Result = %s" (nil)) ("cmps_form_select_papersize" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, papertype, xpagesize, ypagesize" (nil ("inches") ("index") ("landscape"))) ("cmps_form_load_configs" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, defaultpaper, configs" (nil)) ("cmps_form_Update_Info" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, info" (nil ("_EXTRA") ("set"))) ("cmps_form_draw_box" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, xsize, ysize, xoff, yoff, info" (nil)) ("cmps_form_draw_form" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, info" (nil ("nobox"))) ("cmps_form_Null_Events" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_What_Button_Type" fun nil (lib "cmps_form.pro" nil "markwardt") "Result = %s(event)" (nil)) ("cmps_form_What_Button_Pressed" fun nil (lib "cmps_form.pro" nil "markwardt") "Result = %s(event)" (nil)) ("cmps_form_What_Button_Released" fun nil (lib "cmps_form.pro" nil "markwardt") "Result = %s(event)" (nil)) ("cmps_form_NumEvents" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_Move_Box" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_Grow_Box" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_Box_Events" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_predef_events" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form_Event" pro nil (lib "cmps_form.pro" nil "markwardt") "%s, event" (nil)) ("cmps_form" fun nil (lib "cmps_form.pro" nil "markwardt") "Result = %s(xoffset, yoffset)" (nil ("aspect") ("Bits_Per_Pixel") ("button_names") ("button_sel") ("Cancel") ("Color") ("Create") ("DefaultPaper") ("Defaults") ("Encapsulated") ("Filename") ("Help") ("Inches") ("Initialize") ("Landscape") ("LocalDefaults") ("NoCommon") ("pagebox") ("PaperSize") ("parent") ("PreDefined") ("preserve_aspect") ("select") ("XOffset") ("xpagesize") ("XSize") ("YOffset") ("ypagesize") ("YSize"))) ("NULL_EVENTS" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_ALERT" fun nil (lib "xwindow.pro" nil "markwardt") "Result = %s(message)" (nil ("XOffSet") ("YOffSet"))) ("XWINDOW_COLOR_PROTECTION" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_CONFIGURATION_EVENTS" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_CONFIGURATION" fun nil (lib "xwindow.pro" nil "markwardt") "Result = %s(filetype, config)" (nil ("Cancel") ("Create") ("PARENT") ("TITLE") ("XOFFSET") ("YOFFSET"))) ("XWindow_WhatTypeVariable" fun nil (lib "xwindow.pro" nil "markwardt") "Result = %s(variable)" (nil)) ("XWINDOW_QUIT" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_CLEANUP" pro nil (lib "xwindow.pro" nil "markwardt") "%s, id" (nil)) ("XWINDOW_CONFIGURE_FILES" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_CREATE_FILES" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_COLORS" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_DRAW_EVENT" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW_RESIZE_EVENTS" pro nil (lib "xwindow.pro" nil "markwardt") "%s, event" (nil)) ("XWINDOW" pro nil (lib "xwindow.pro" nil "markwardt") "%s, proName, param1, param2, param3, param4, param5, param6, param7, param8, param9, param10" (nil ("_EXTRA") ("CPMENU") ("DRAWID") ("ERASE") ("GROUP_LEADER") ("JUST_REGISTER") ("NO_CHANGE_CONFIG") ("NOMENU") ("OUTPUT") ("PROTECT") ("TOP") ("WID") ("WTITLE") ("WXPOS") ("WXSIZE") ("WYPOS") ("WYSIZE") ("XCOLORS"))) ("FXGCLOSE" pro nil (lib "fxgclose.pro" nil "markwardt") "%s, UNIT" (nil)) ("fxgfiltered" fun nil (lib "fxgfiltered.pro" nil "markwardt") "Result = %s(unit)" (nil)) ("fxgopen_curl" pro nil (lib "fxgopen.pro" nil "markwardt") "%s, unit, resource, suffix" (nil ("_EXTRA") ("errmsg") ("error"))) ("FXGOPEN" pro nil (lib "fxgopen.pro" nil "markwardt") "%s, UNIT, RESOURCE" (nil ("_EXTRA") ("ACCESS") ("errmsg") ("ERROR") ("SUFFIX"))) ("FXGREAD" pro nil (lib "fxgread.pro" nil "markwardt") "%s, UNIT, BUFFER" (nil ("STATUS") ("TRANSFER_COUNT"))) ("FXGSEEK" pro nil (lib "fxgseek.pro" nil "markwardt") "%s, UNIT, POSITION" (nil)) ("FXGWRITE" pro nil (lib "fxgwrite.pro" nil "markwardt") "%s, UNIT, BUFFER" (nil ("TRANSFER_COUNT"))) ("fxmakemap" pro nil (lib "fxmakemap.pro" nil "markwardt") "%s, suffix, command" (nil ("buffer_gran") ("buffer_max") ("flags") ("get") ("info") ("rm_command") ("scratch_dir"))) ("FXPBUFFR" pro nil (lib "fxpbuffr.pro" nil "markwardt") "%s, UNIT, NEWLEN" (nil)) ("FXPCLOSE" pro nil (lib "fxpclose.pro" nil "markwardt") "%s, UNIT" (nil)) ("FXPOPENR_WRAP_CMD" pro nil (lib "fxpopenr.pro" nil "markwardt") "%s, CMD, SHELL" (nil)) ("FXPOPENR_TMPNAME" fun nil (lib "fxpopenr.pro" nil "markwardt") "Result = %s(CMD)" (nil)) ("FXPOPENR" pro nil (lib "fxpopenr.pro" nil "markwardt") "%s, UNIT, CMD" (nil ("COMPRESS") ("ERRMSG") ("ERROR"))) ("FXPREAD" pro nil (lib "fxpread.pro" nil "markwardt") "%s, UNIT, BUFFER" (nil ("TRANSFER_COUNT"))) ("FXPSEEK" pro nil (lib "fxpseek.pro" nil "markwardt") "%s, UNIT, POSITION" (nil)) ("transread" pro nil (lib "transread.pro" nil "markwardt") "%s, unit, l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12, l13, l14, l15, l16, l17, l18, l19, l20, l21, l22, l23, l24, l25, l26, l27, l28, l29, l30" (nil ("comment") ("count") ("debug") ("delim") ("failcount") ("filename") ("format") ("lines") ("maxlines") ("nocatch") ("noclose") ("skiplines") ("startcue") ("stopcue"))) ("statusline" pro nil (lib "statusline.pro" nil "markwardt") "%s, str, col" (nil ("clear") ("close") ("disable") ("enable") ("left") ("length") ("nocr") ("quiet") ("right"))) ("cmapply_product" fun nil (lib "cmapply.pro" nil "markwardt") "Result = %s(x)" (nil)) ("cmapply_redim" pro nil (lib "cmapply.pro" nil "markwardt") "%s, newarr, dimapply, dimkeep, nkeep, totcol, totkeep" (nil)) ("cmapply" fun nil (lib "cmapply.pro" nil "markwardt") "Result = %s(op, array, dimapply)" (nil ("double") ("functargs") ("nocatch") ("type"))) ("cmrebin" fun nil (lib "cmrebin.pro" nil "markwardt") "Result = %s(array, D1, D2, D3, D4)" (nil ("dimension") ("total"))) ("CMCONGRID" fun nil (lib "cmcongrid.pro" nil "markwardt") "Result = %s(arr, x, y, z)" (nil ("Cubic") ("Half_Half") ("Interp") ("Minus_One"))) ("oplotimage" pro nil (lib "oplotimage.pro" nil "markwardt") "%s, img" (nil ("_EXTRA") ("imgxrange") ("imgyrange"))) ("arg_present" fun nil (lib "arg_present.pro" nil "markwardt") "Result = %s(arg)" (nil ("nocatch"))) ("plotimage_resamp" fun nil (lib "plotimage.pro" nil "markwardt") "Result = %s(image, nx, ny, bdepth, newx, newy)" (nil ("interp"))) ("plotimage_pos" pro nil (lib "plotimage.pro" nil "markwardt") "%s, xrange0, imgxrange0, imgxsize, xreverse, srcxpix, imgxpanel" (nil ("logscale") ("pixtolerance") ("quiet") ("status"))) ("plotimage" pro nil (lib "plotimage.pro" nil "markwardt") "%s, img0" (nil ("_EXTRA") ("bottom") ("dither") ("imgxrange") ("imgyrange") ("interp") ("min_dpi") ("ncolors") ("noaxes") ("nodata") ("noerase") ("order") ("panel") ("pixel_aspect_ratio") ("pixtolerance") ("position") ("preserve_aspect") ("quiet") ("range") ("subpanel") ("title") ("xlog") ("xrange") ("xstyle") ("ylog") ("yrange") ("ystyle"))) ("plotbin" pro nil (lib "plotbin.pro" nil "markwardt") "%s, x0, y0" (nil ("_EXTRA") ("edge") ("midpoint") ("panel") ("pixcenter") ("plotvert") ("subpanel") ("width"))) ("oplotbin" pro nil (lib "oplotbin.pro" nil "markwardt") "%s, x0, y0" (nil ("_EXTRA") ("edge") ("logclip") ("midpoint") ("pixcenter") ("plotvert") ("width"))) ("defsubcell" fun nil (lib "defsubcell.pro" nil "markwardt") "Result = %s(default)" (nil)) ("subcell" fun nil (lib "subcell.pro" nil "markwardt") "Result = %s(subpos, position)" (nil ("margin"))) ("subcellarray" pro nil (lib "subcellarray.pro" nil "markwardt") "%s, xdivs, ydivs, newpanels, newsubpanels" (nil ("panel") ("subpanel") ("xreverse") ("yreverse"))) ("plotpan" pro nil (lib "plotpan.pro" nil "markwardt") "%s, x, y" (nil ("_EXTRA") ("panel") ("subpanel"))) ("arrdelete" fun nil (lib "arrdelete.pro" nil "markwardt") "Result = %s(init)" (nil ("at") ("count") ("empty1") ("length") ("overwrite"))) ("arrinsert" fun nil (lib "arrinsert.pro" nil "markwardt") "Result = %s(init, insert)" (nil ("at") ("count") ("empty1") ("empty2") ("overwrite"))) ("tagsize" fun nil (lib "tagsize.pro" nil "markwardt") "Result = %s(structure)" (nil ("length") ("n_tags") ("nocatch") ("status") ("structure_name") ("tag_names"))) ("legcheb" fun nil (lib "legcheb.pro" nil "markwardt") "Result = %s(a)" (nil ("reset"))) ("dxbreak" pro nil (lib "dxbreak.pro" nil "markwardt") "%s, arg0, arg1" (nil ("_EXTRA") ("is_function") ("nocatch") ("once"))) ("hprnutang_init_iau1980" pro nil (lib "hprnutang.pro" nil "markwardt") "%s, argfacts, psiamps, epsamps" (nil)) ("hprnutang_init_iau1980_args" pro nil (lib "hprnutang.pro" nil "markwardt") "%s, args" (nil)) ("hprnutang_init_iau1996_args" pro nil (lib "hprnutang.pro" nil "markwardt") "%s, args" (nil)) ("hprnutang" pro nil (lib "hprnutang.pro" nil "markwardt") "%s, jdtt, zeta, theta, z, dpsi, deps" (nil ("eq_equinox") ("fixed_base") ("fixed_epoch") ("gas_time") ("gms_time") ("jd_ut1") ("jpl") ("mean_obliquity") ("no_nutation") ("no_ut1") ("polar_x") ("polar_y") ("tbase") ("true_obliquity") ("use_eopdata"))) ("chebcoef_eval" fun nil (lib "chebcoef.pro" nil "markwardt") "Result = %s(x, p)" (nil ("_EXTRA") ("expression"))) ("chebcoef" fun nil (lib "chebcoef.pro" nil "markwardt") "Result = %s(f0, priv)" (nil ("double") ("error") ("expression") ("functargs") ("indices") ("interval") ("nmax") ("precision") ("reduce_algorithm") ("status"))) ("xatt_el_encode_float" fun nil (lib "xatt_el.pro" nil "markwardt") "Result = %s(strs)" (nil)) ("xatt_el_decode_float" fun nil (lib "xatt_el.pro" nil "markwardt") "Result = %s(strs)" (nil)) ("xatt_el_parse" pro nil (lib "xatt_el.pro" nil "markwardt") "%s" (nil ("decode_file") ("encode_file"))) ("xatt_el_value_locate" fun nil (lib "xatt_el.pro" nil "markwardt") "Result = %s(xbins, x)" (nil)) ("xatt_el_tabinv" pro nil (lib "xatt_el.pro" nil "markwardt") "%s, XARR, X, IEFF" (nil)) ("xatt_el_linterp" pro nil (lib "xatt_el.pro" nil "markwardt") "%s, Xtab, Ytab, Xint, Yint" (nil)) ("xatt_el" fun nil (lib "xatt_el.pro" nil "markwardt") "Result = %s(ellist, e)" (nil ("attentype") ("by") ("coherent_scattering") ("incoherent_scattering") ("no_coherent") ("pair_electron") ("pair_nuclear") ("photoelectric") ("total") ("weights"))) ("chebeval" fun nil (lib "chebeval.pro" nil "markwardt") "Result = %s(x0, p)" (nil ("derivative") ("interval"))) ("ps_form_Draw_Coords" pro nil (lib "ps_form.pro" nil "markwardt") "%s, drawpixperunit, xoff, yoff, xsize, ysize" (nil)) ("ps_form_Real_Coords" pro nil (lib "ps_form.pro" nil "markwardt") "%s, drawpixperunit, xoff, yoff, xsize, ysize" (nil)) ("ps_form_Select_File" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_PlotBox_Coords" fun nil (lib "ps_form.pro" nil "markwardt") "Result = %s(xsize, ysize, xoff, yoff, drawpixperunit)" (nil)) ("ps_form_conv_pscoord" pro nil (lib "ps_form.pro" nil "markwardt") "%s, info, xpagesize, ypagesize" (nil ("tohuman") ("toidl"))) ("ps_form_papernames" fun nil (lib "ps_form.pro" nil "markwardt") "Result = %s" (nil)) ("ps_form_select_papersize" pro nil (lib "ps_form.pro" nil "markwardt") "%s, papertype, xpagesize, ypagesize" (nil ("inches") ("index") ("landscape"))) ("ps_form_load_configs" pro nil (lib "ps_form.pro" nil "markwardt") "%s, defaultpaper, configs" (nil)) ("ps_form_Update_Info" pro nil (lib "ps_form.pro" nil "markwardt") "%s, info" (nil ("_EXTRA") ("set"))) ("ps_form_draw_box" pro nil (lib "ps_form.pro" nil "markwardt") "%s, xsize, ysize, xoff, yoff, info" (nil)) ("ps_form_draw_form" pro nil (lib "ps_form.pro" nil "markwardt") "%s, info" (nil ("nobox"))) ("ps_form_Null_Events" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_What_Button_Type" fun nil (lib "ps_form.pro" nil "markwardt") "Result = %s(event)" (nil)) ("ps_form_What_Button_Pressed" fun nil (lib "ps_form.pro" nil "markwardt") "Result = %s(event)" (nil)) ("ps_form_What_Button_Released" fun nil (lib "ps_form.pro" nil "markwardt") "Result = %s(event)" (nil)) ("ps_form_NumEvents" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_Move_Box" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_Grow_Box" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_Box_Events" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_predef_events" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form_Event" pro nil (lib "ps_form.pro" nil "markwardt") "%s, event" (nil)) ("ps_form" fun nil (lib "ps_form.pro" nil "markwardt") "Result = %s(xoffset, yoffset)" (nil ("aspect") ("Bits_Per_Pixel") ("button_names") ("button_sel") ("Cancel") ("Color") ("Create") ("DefaultPaper") ("Defaults") ("Encapsulated") ("Filename") ("Help") ("Inches") ("Initialize") ("Landscape") ("LocalDefaults") ("NoCommon") ("pagebox") ("PaperSize") ("parent") ("PreDefined") ("preserve_aspect") ("select") ("XOffset") ("xpagesize") ("XSize") ("YOffset") ("ypagesize") ("YSize"))) ("chebfit_eval" fun nil (lib "chebfit.pro" nil "markwardt") "Result = %s(p)" (nil ("_EXTRA") ("igood") ("interval") ("nterms"))) ("chebfit" fun nil (lib "chebfit.pro" nil "markwardt") "Result = %s(x, y, err)" (nil ("bestnorm") ("dof") ("even") ("indices") ("initialize") ("interval") ("nmax") ("nocatch") ("odd") ("perror") ("precision") ("quiet") ("reduce_algorithm") ("yfit"))) ("gauss1p" pro nil (lib "gauss1p.pro" nil "markwardt") "%s, x, p, f" (nil ("_EXTRA") ("skew"))) ("gauss2" fun nil (lib "gauss2.pro" nil "markwardt") "Result = %s(x, y, p)" (nil ("_EXTRA"))) ("geograv_unitize" fun nil (lib "geograv.pro" nil "markwardt") "Result = %s(u)" (nil)) ("geograv_one" pro nil (lib "geograv.pro" nil "markwardt") "%s, geogmod, r, phi, a" (nil ("C") ("mmax") ("nmax") ("S") ("unitfact"))) ("geograv" pro nil (lib "geograv.pro" nil "markwardt") "%s, geogmod, r, phi, a" (nil ("mmax") ("nmax") ("units"))) ("chebpcmat" pro nil (lib "chebgrid.pro" nil "markwardt") "%s, npts, npoly, xmat, vmat" (nil ("dweight"))) ("chebpcmat_xonly" pro nil (lib "chebgrid.pro" nil "markwardt") "%s, npts, npoly, xmat" (nil)) ("chebgrid" fun nil (lib "chebgrid.pro" nil "markwardt") "Result = %s(t, x, dxdt)" (nil ("deriv_weight") ("dresiduals") ("drms") ("dxmatrix") ("ngranule") ("npoints") ("npolynomial") ("reset") ("residuals") ("rms") ("xmatrix"))) ("CMPRODUCT" fun nil (lib "cmproduct.pro" nil "markwardt") "Result = %s(ARRAY)" (nil)) ("cmsvlib" fun nil (lib "cmsvlib.pro" nil "markwardt") "Result = %s" (nil ("query") ("version"))) ("cmarg_present" fun nil (lib "cmarg_present.pro" nil "markwardt") "Result = %s(arg)" (nil ("nocatch"))) ("cmreplicate" fun nil (lib "cmreplicate.pro" nil "markwardt") "Result = %s(array, dims)" (nil)) ("arg_present" fun nil (lib "cmrestore.pro" nil "markwardt") "Result = %s(x)" (nil)) ("cmrestore" pro nil (lib "cmrestore.pro" nil "markwardt") "%s, filename0, p0, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, p20, p21, p22, p23, p24, p25, p26, p27, p28, p29" (nil ("all") ("data") ("errmsg") ("filename") ("mtimes") ("names") ("nocatch") ("pass_method") ("quiet") ("relaxed_structure_assignment") ("restored_objects") ("status") ("varstatus") ("verbose") ("version"))) ("cmsvread" pro nil (lib "cmsvread.pro" nil "markwardt") "%s, unit0, data" (nil ("errmsg") ("name") ("no_data") ("promote64") ("quiet") ("size") ("status") ("structure_name") ("timestamp") ("version"))) ("cmsvwrite" pro nil (lib "cmsvwrite.pro" nil "markwardt") "%s, unit0, data" (nil ("compat") ("errmsg") ("name") ("no_end") ("quiet") ("status"))) ("hprstatn" pro nil (lib "hprstatn.pro" nil "markwardt") "%s, jdtt, r_iers, r_eci, v_eci" (nil ("jpl") ("no_nutation") ("no_polar_motion") ("no_precession") ("no_ut1") ("tbase") ("use_eop"))) ("cmsave_handle_value" fun nil (lib "cmsave.pro" nil "markwardt") "Result = %s(handle)" (nil ("no_copy"))) ("cmsave" pro nil (lib "cmsave.pro" nil "markwardt") "%s, p0, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, p20, p21, p22, p23, p24, p25, p26, p27, p28, p29" (nil ("all") ("append") ("compatible") ("data") ("errmsg") ("filename") ("mtimes") ("names") ("nocatch") ("pass_method") ("quiet") ("status") ("useunit") ("varstatus") ("verbose") ("version") ("xdr"))) ("cmsavedir" pro nil (lib "cmsavedir.pro" nil "markwardt") "%s, filename" (nil ("errmsg") ("force") ("func_names") ("n_function") ("n_pro") ("n_variables") ("named_classes") ("named_structs") ("notice") ("pro_names") ("quiet") ("raw") ("read_heap") ("status") ("timestamp") ("types") ("var_names") ("verbose") ("version"))) ("cmset_op_uniq" fun nil (lib "cmset_op.pro" nil "markwardt") "Result = %s(a)" (nil)) ("cmset_op" fun nil (lib "cmset_op.pro" nil "markwardt") "Result = %s(a, op0, b)" (nil ("count") ("empty1") ("empty2") ("index") ("maxarray") ("not1") ("not2"))) ("cmsv_open" pro nil (lib "cmsv_open.pro" nil "markwardt") "%s, unit, filename, offset" (nil ("access") ("compatibility") ("compressed") ("errmsg") ("force") ("get_lun") ("query") ("reopen") ("status"))) ("cmsv_ptrsum" pro nil (lib "cmsv_ptrsum.pro" nil "markwardt") "%s, data, result" (nil ("has_objects") ("null"))) ("cmsv_rconv" pro nil (lib "cmsv_rdata.pro" nil "markwardt") "%s, data" (nil)) ("cmsv_rhdata" pro nil (lib "cmsv_rdata.pro" nil "markwardt") "%s, block, pointer, data, index, offsets, pdata" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rdata" pro nil (lib "cmsv_rdata.pro" nil "markwardt") "%s, block, pointer, sz, data" (nil ("bcstring40") ("bytelong") ("errmsg") ("offset") ("ptr_callback") ("ptr_data") ("ptr_index") ("ptr_offsets") ("start") ("status") ("template") ("temporary") ("unit"))) ("cmsv_rbuf" pro nil (lib "cmsv_rraw.pro" nil "markwardt") "%s, block, pointer, nbytes" (nil ("errmsg") ("status") ("unit"))) ("cmsv_rraw" fun nil (lib "cmsv_rraw.pro" nil "markwardt") "Result = %s(block, pointer, nelt0)" (nil ("buffer") ("byte") ("errmsg") ("long") ("offset") ("status") ("string") ("type") ("unit"))) ("cmsystime_xmod" fun nil (lib "cmsystime.pro" nil "markwardt") "Result = %s(x, m)" (nil)) ("cmsystime_mjd2ymd" pro nil (lib "cmsystime.pro" nil "markwardt") "%s, mjd, yr, mo, da" (nil)) ("cmsystime" fun nil (lib "cmsystime.pro" nil "markwardt") "Result = %s(arg0)" (nil ("extended") ("from_julian") ("from_local") ("from_mjd") ("julian") ("local") ("mjd") ("now") ("seconds") ("timezone"))) ("helpform" fun nil (lib "helpform.pro" nil "markwardt") "Result = %s(name0, value)" (nil ("full_struct") ("recursive_struct") ("shortform") ("single") ("size") ("structure_name") ("tagform") ("width"))) ("inputform_int" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(x, format)" (nil ("zero"))) ("inputform_float" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(x, format)" (nil ("dconvert") ("nfloat") ("zero"))) ("inputform_string" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(x)" (nil ("zero"))) ("inputform_struct" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(data)" (nil ("array_notation") ("errmsg") ("nfloat") ("nocatch") ("status") ("zero"))) ("inputform_ptr" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(x, tp)" (nil ("zero"))) ("inputform_basic" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(x)" (nil ("array_notation") ("errmsg") ("nfloat") ("nocatch") ("si") ("status") ("zero"))) ("inputform_array1" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(type, dims)" (nil)) ("inputform_array" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(x)" (nil ("errmsg") ("si") ("status"))) ("inputform_brackets" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(s, l, r)" (nil ("errmsg") ("si") ("status"))) ("inputform" fun nil (lib "inputform.pro" nil "markwardt") "Result = %s(data)" (nil ("array_notation") ("errmsg") ("max_dimensions") ("max_elements") ("max_len") ("max_tags") ("n_float_digits") ("nocatch") ("status") ("zero"))) ("printlog" pro nil (lib "printlog.pro" nil "markwardt") "%s, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15, d16, d17, d18, d19, d20" (nil ("default_print") ("format") ("log") ("nloglines") ("nocatch") ("onlylog") ("trim") ("unit"))) ("dxclear" pro nil (lib "dxclear.pro" nil "markwardt") "%s, index0" (nil)) ("dxdown" pro nil (lib "dxdown.pro" nil "markwardt") "%s, nlevels0" (nil)) ("dxfinish" pro nil (lib "dxfinish.pro" nil "markwardt") "%s, nlevels0" (nil ("once"))) ("dxget" fun nil (lib "dxget.pro" nil "markwardt") "Result = %s(vname)" (nil ("level") ("status"))) ("dxhelpform" fun nil (lib "dxhelp.pro" nil "markwardt") "Result = %s(name0, value)" (nil ("_EXTRA") ("shortform") ("single") ("structure") ("tagform") ("width"))) ("dxhelp" pro nil (lib "dxhelp.pro" nil "markwardt") "%s, x0, x1, x2, x3, x4, x5, x6, x7, x8, x9" (nil ("_EXTRA") ("all") ("level"))) ("dxlreset" pro nil (lib "dxlreset.pro" nil "markwardt") "%s" (nil ("remove"))) ("dxplevel" pro nil (lib "dxplevel.pro" nil "markwardt") "%s" (nil ("current") ("level"))) ("dxprint" pro nil (lib "dxprint.pro" nil "markwardt") "%s, x0, x1, x2, x3, x4, x5, x6, x7, x8, x9" (nil ("format") ("level"))) ("dxptrace" fun nil (lib "dxptrace.pro" nil "markwardt") "Result = %s(str)" (nil ("status"))) ("dxset" pro nil (lib "dxset.pro" nil "markwardt") "%s, vname, value" (nil ("level"))) ("dxup" pro nil (lib "dxup.pro" nil "markwardt") "%s, nlevels0" (nil)) ("mpfit2dpeak_u" fun nil (lib "mpfit2dpeak.pro" nil "markwardt") "Result = %s(x, y, p)" (nil ("symmetric") ("tilt"))) ("mpfit2dpeak_gauss" fun nil (lib "mpfit2dpeak.pro" nil "markwardt") "Result = %s(x, y, p)" (nil ("_extra") ("symmetric") ("tilt"))) ("mpfit2dpeak_lorentz" fun nil (lib "mpfit2dpeak.pro" nil "markwardt") "Result = %s(x, y, p)" (nil ("_extra") ("symmetric") ("tilt"))) ("mpfit2dpeak_moffat" fun nil (lib "mpfit2dpeak.pro" nil "markwardt") "Result = %s(x, y, p)" (nil ("_extra") ("symmetric") ("tilt"))) ("mpfit2dpeak" fun nil (lib "mpfit2dpeak.pro" nil "markwardt") "Result = %s(z, a, x, y)" (nil ("_extra") ("bestnorm") ("chisq") ("circle") ("circular") ("dof") ("errmsg") ("error") ("estimates") ("gaussian") ("lorentzian") ("measure_errors") ("moffat") ("negative") ("nfev") ("nfree") ("niter") ("parinfo") ("perror") ("query") ("quiet") ("sigma") ("status") ("symmetric") ("tilt") ("weights") ("zerror"))) ("mpfitpeak_u" fun nil (lib "mpfitpeak.pro" nil "markwardt") "Result = %s(x, p)" (nil)) ("mpfitpeak_gauss" fun nil (lib "mpfitpeak.pro" nil "markwardt") "Result = %s(x, p, pder)" (nil ("_extra"))) ("mpfitpeak_lorentz" fun nil (lib "mpfitpeak.pro" nil "markwardt") "Result = %s(x, p, pder)" (nil ("_extra"))) ("mpfitpeak_moffat" fun nil (lib "mpfitpeak.pro" nil "markwardt") "Result = %s(x, p, pder)" (nil ("_extra"))) ("mpfitpeak_est" fun nil (lib "mpfitpeak.pro" nil "markwardt") "Result = %s(x, y)" (nil ("errmsg") ("nan") ("negative_peak") ("positive_peak"))) ("mpfitpeak" fun nil (lib "mpfitpeak.pro" nil "markwardt") "Result = %s(x, y, a)" (nil ("_extra") ("autoderiv") ("best_fjac") ("bestnorm") ("chisq") ("covar") ("dof") ("errmsg") ("error") ("estimates") ("gaussian") ("lorentzian") ("measure_errors") ("moffat") ("nan") ("negative") ("nfev") ("nfree") ("niter") ("no_fit") ("nterms") ("parinfo") ("perror") ("pfree_index") ("positive") ("query") ("quiet") ("sigma") ("status") ("weights") ("yerror"))) ("SetFitParm_Events" pro nil (lib "setfitparm.pro" nil "markwardt") "%s, event" (nil)) ("SetFitParm" fun nil (lib "setfitparm.pro" nil "markwardt") "Result = %s(thisFParm)" (nil ("Cancel") ("Parent"))) ("CONV_UNIX_VAX" pro nil (lib "conv_unix_vax.pro" nil "markwardt") "%s, variable" (nil ("SOURCE_ARCH"))) ("ieee_to_host" pro nil (lib "ieee_to_host.pro" nil "markwardt") "%s, data" (nil ("IDLTYPE"))) ("WHERE_NEGZERO" fun nil (lib "where_negzero.pro" nil "markwardt") "Result = %s(ARRAY, COUNT)" (nil ("QUIET"))) ("cmsv_rcomm" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, names" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rheap" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, index" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rstamp" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, tstamp" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rversion" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, vers" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rident" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, ident" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rnotice" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, notice" (nil ("errmsg") ("offset") ("status") ("unit"))) ("cmsv_rrec" pro nil (lib "cmsv_rrec.pro" nil "markwardt") "%s, block, pointer, data" (nil ("block_name") ("block_type") ("compressed") ("errmsg") ("full") ("initialize") ("next_block") ("offset") ("promote64") ("qblocknames") ("status") ("unit"))) ("cephes_setmachar" pro nil (lib "mpftest.pro" nil "markwardt") "%s" (nil)) ("cephes_incbet" fun nil (lib "mpftest.pro" nil "markwardt") "Result = %s(aa, bb, xx)" (nil)) ("cephes_incbcf" fun nil (lib "mpftest.pro" nil "markwardt") "Result = %s(a, b, x)" (nil)) ("cephes_incbd" fun nil (lib "mpftest.pro" nil "markwardt") "Result = %s(a, b, x)" (nil)) ("cephes_pseries" fun nil (lib "mpftest.pro" nil "markwardt") "Result = %s(a, b, x)" (nil)) ("mpftest" fun nil (lib "mpftest.pro" nil "markwardt") "Result = %s(x, nu1, nu2)" (nil ("clevel") ("sigma") ("slevel"))) ("srvadd" fun nil (lib "srvadd.pro" nil "markwardt") "Result = %s(u, v)" (nil ("classical"))) ("plotcolorfill" pro nil (lib "plotcolorfill.pro" nil "markwardt") "%s, x0, y0" (nil ("_EXTRA") ("bottom") ("color") ("edge") ("midpoint") ("noerase") ("notrace") ("panel") ("position") ("subpanel") ("thick") ("transparent") ("width") ("xlog") ("xstyle") ("ylog") ("ystyle"))) ("cmsv_rarrdesc" pro nil (lib "cmsv_rvtype.pro" nil "markwardt") "%s, block, pointer, sz" (nil ("errmsg") ("status") ("unit"))) ("cmsv_rstructdesc" pro nil (lib "cmsv_rvtype.pro" nil "markwardt") "%s, block, pointer, template" (nil ("errmsg") ("named_classes") ("named_structs") ("no_create") ("status") ("structure_name") ("suffix") ("unit"))) ("cmsv_rvtype" pro nil (lib "cmsv_rvtype.pro" nil "markwardt") "%s, block, pointer, result, sz" (nil ("errmsg") ("heap") ("named_classes") ("named_structs") ("no_create") ("no_type") ("offset") ("status") ("structure_name") ("suffix") ("system") ("template") ("unit"))) ("plotcube" pro nil (lib "plotcube.pro" nil "markwardt") "%s, x, y, z" (nil ("_EXTRA") ("noerase") ("panel") ("subpanel") ("xrange") ("xtitle") ("yrange") ("ytitle") ("zrange") ("ztitle"))) ("cmsv_test_set" pro nil (lib "cmsv_test.pro" nil "markwardt") "%s, a, b, c, d, e" (nil ("print") ("reset") ("set"))) ("cmsv_test_undefine" pro nil (lib "cmsv_test.pro" nil "markwardt") "%s, x" (nil)) ("cmsv_test_unset" pro nil (lib "cmsv_test.pro" nil "markwardt") "%s, a, b, c, d, e" (nil)) ("cmsv_test_vcomp" pro nil (lib "cmsv_test.pro" nil "markwardt") "%s, x0, x, result, failed" (nil ("name"))) ("cmsv_test_comp" pro nil (lib "cmsv_test.pro" nil "markwardt") "%s, a, b, c, d, e, result, failed" (nil)) ("cmsv_test" pro nil (lib "cmsv_test.pro" nil "markwardt") "%s, filename0" (nil ("user_value"))) ("qrfac" pro nil (lib "qrfac.pro" nil "markwardt") "%s, a, r, ipvt, acnorm" (nil ("pivot") ("qmatrix"))) ("cmsv_wconv" pro nil (lib "cmsv_wdata.pro" nil "markwardt") "%s, data" (nil)) ("cmsv_wdata" pro nil (lib "cmsv_wdata.pro" nil "markwardt") "%s, block, pointer, value" (nil ("errmsg") ("ptr_data") ("ptr_index") ("start") ("status") ("temporary") ("unit"))) ("cmsv_enlarge" pro nil (lib "cmsv_wraw.pro" nil "markwardt") "%s, block, pointer, nbytes" (nil ("errmsg") ("status"))) ("cmsv_wraw" pro nil (lib "cmsv_wraw.pro" nil "markwardt") "%s, block, pointer, value0" (nil ("byte") ("errmsg") ("long") ("replen") ("status") ("string") ("unit"))) ("cmsv_wcomm" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer, names" (nil ("errmsg") ("status"))) ("cmsv_wheap" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer, indices" (nil ("errmsg") ("status"))) ("cmsv_wstamp" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer" (nil ("_extra") ("errmsg") ("offset") ("save_date") ("save_host") ("save_user") ("status"))) ("cmsv_wversion" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer" (nil ("_extra") ("arch") ("compatible") ("errmsg") ("format_version") ("os") ("release") ("status"))) ("cmsv_wident" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer" (nil ("_EXTRA") ("author") ("errmsg") ("idcode") ("status") ("title"))) ("cmsv_wnotice" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer" (nil ("_EXTRA") ("errmsg") ("status") ("text"))) ("cmsv_wrec" pro nil (lib "cmsv_wrec.pro" nil "markwardt") "%s, block, pointer, data, name" (nil ("_EXTRA") ("block_name") ("block_type") ("compatibility") ("errmsg") ("finish") ("initialize") ("next_block") ("no_data") ("no_type") ("offset") ("status") ("unit"))) ("cmsv_warrdesc" pro nil (lib "cmsv_wvtype.pro" nil "markwardt") "%s, block, pointer, sz" (nil ("errmsg") ("length") ("status"))) ("cmsv_wstructdesc" pro nil (lib "cmsv_wvtype.pro" nil "markwardt") "%s, block, pointer" (nil ("errmsg") ("nocatch") ("status") ("template"))) ("cmsv_wvtype" pro nil (lib "cmsv_wvtype.pro" nil "markwardt") "%s, block, pointer, data, ident" (nil ("errmsg") ("heap") ("offset") ("status") ("system") ("unit"))) ("cmunique_id" fun nil (lib "cmunique_id.pro" nil "markwardt") "Result = %s(fodder)" (nil)) ("jbepoch" fun nil (lib "jbepoch.pro" nil "markwardt") "Result = %s(ep)" (nil ("b") ("j") ("mjd") ("to_day"))) ("crosspn" fun nil (lib "crosspn.pro" nil "markwardt") "Result = %s(x1, x2)" (nil)) ("ddeabm_dummy" pro nil (lib "ddeabm.pro" nil "markwardt") "%s" (nil)) ("ddeabm_func0n" fun nil (lib "ddeabm.pro" nil "markwardt") "Result = %s(func, a, y, private)" (nil ("_extra"))) ("ddeabm_func1n" fun nil (lib "ddeabm.pro" nil "markwardt") "Result = %s(func, a, y, private)" (nil ("_extra"))) ("ddeabm_func0e" fun nil (lib "ddeabm.pro" nil "markwardt") "Result = %s(func, a, y, private)" (nil ("_extra"))) ("ddeabm_func1e" fun nil (lib "ddeabm.pro" nil "markwardt") "Result = %s(func, a, y, private)" (nil ("_extra"))) ("ddeabm_dhstrt" pro nil (lib "ddeabm.pro" nil "markwardt") "%s, DF, NEQ, A, B, Y, YPRIME, ETOL, MORDER, SMALL, BIG, SPY, PV, YP, SF, PRIVATE, FA, H, DFNAME" (nil)) ("ddeabm_ddes" pro nil (lib "ddeabm.pro" nil "markwardt") "%s, DF, NEQ, T, Y, TOUT, INFO, RTOL, ATOL, IDID, YPOUT, YP, YY, WT, P, PHI, ALPHA, BETA, PSI, V, W, SIG, G, GI, H, EPS, X, XOLD, HOLD, TOLD, DELSGN, TSTOP, TWOU, FOURU, START, PHASE1, NORND, STIFF, INTOUT, NS, KORD, KOLD, INIT, KSTEPS, KLE4, IQUIT, KPREV, IVC, IV, KGI, PRIVATE, FA, dfname" (nil ("errmsg") ("max_stepsize"))) ("DDEABM_DINTP" pro nil (lib "ddeabm.pro" nil "markwardt") "%s, X, Y, XOUT, YOUT, YPOUT, NEQN, KOLD, PHI, IVC, IV, KGI, GI, ALPHA, OG, OW, OX, OY" (nil)) ("DDEABM_DSTEPS" pro nil (lib "ddeabm.pro" nil "markwardt") "%s, DF, NEQN, Y, X, H, EPS, WT, START, HOLD, K, KOLD, CRASH, PHI, P, YP, PSI, ALPHA, BETA, SIG, V, W, G, PHASE1, NS, NORND, KSTEPS, TWOU, FOURU, XOLD, KPREV, IVC, IV, KGI, GI, PRIVATE, FA, dfname" (nil ("max_stepsize"))) ("DDEABM" pro nil (lib "ddeabm.pro" nil "markwardt") "%s, DF, T, Y, TOUT0, PRIVATE" (nil ("CONTROL") ("dostatusline") ("epsabs") ("epsrel") ("errmsg") ("FUNCTARGS") ("init") ("intermediate") ("MAX_STEPSIZE") ("NFEV") ("NGRID") ("NOUTGRID") ("STATE") ("status") ("TGRID") ("TIMPULSE") ("tstop") ("YGRID") ("YIMPULSE") ("YPGRID"))) ("eopdata_read" pro nil (lib "eopdata.pro" nil "markwardt") "%s, file, jd, pmx, pmy, ut1, dpsi, deps" (nil ("status"))) ("eopdata" pro nil (lib "eopdata.pro" nil "markwardt") "%s, jdutc, pmx, pmy, ut1_utc, dpsi, deps" (nil ("angunits") ("filename") ("reset") ("tbase"))) ("geogread" pro nil (lib "geogread.pro" nil "markwardt") "%s, rootfile, geogmod" (nil ("coeff_err") ("errmsg") ("status"))) ("gti2mask" fun nil (lib "gti2mask.pro" nil "markwardt") "Result = %s(gti, time)" (nil ("bad") ("exposure") ("fill") ("good") ("invert") ("minfracexp") ("ntbins") ("overlap") ("query") ("timedel") ("timepixr") ("tlimits"))) ("gtienlarge" fun nil (lib "gtienlarge.pro" nil "markwardt") "Result = %s(gti)" (nil ("count") ("post") ("pre") ("query"))) ("gtimerge" fun nil (lib "gtimerge.pro" nil "markwardt") "Result = %s(gti1, gti2)" (nil ("count") ("intersect") ("invert1") ("invert2") ("query") ("quiet") ("ttolerance") ("union"))) ("linfitex" fun nil (lib "linfitex.pro" nil "markwardt") "Result = %s(p)" (nil ("_EXTRA") ("sigma_x") ("sigma_y") ("x") ("y"))) ("gtiseg" fun nil (lib "gtiseg.pro" nil "markwardt") "Result = %s(time)" (nil ("count") ("indices") ("maxgap") ("mingti") ("query"))) ("gtitrim" fun nil (lib "gtitrim.pro" nil "markwardt") "Result = %s(gti)" (nil ("count") ("maxgap") ("maxgti") ("mingti") ("query"))) ("gtiwhere" fun nil (lib "gtiwhere.pro" nil "markwardt") "Result = %s(time, gti)" (nil ("count") ("include") ("INTERVALS") ("invert") ("query"))) ("init" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s" (nil ("_EXTRA") ("length") ("no_duplicates") ("null_value"))) ("hashent__define" pro nil (lib "hashtable__define.pro" nil "markwardt") "%s" (nil)) ("cleanup" pro "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Obj ->[%s::]%s" (nil)) ("bucket" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s(hashval)" (nil)) ("strhashval" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s(str)" (nil ("radix"))) ("add" pro "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Obj ->[%s::]%s, key, value" (nil ("errmsg") ("hashval") ("position") ("replace") ("status"))) ("count" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s" (nil)) ("remove" pro "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Obj ->[%s::]%s, key" (nil ("all") ("count") ("hashval") ("position"))) ("iscontained" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s(key)" (nil ("count") ("errmsg") ("hashval") ("position") ("value"))) ("get" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s(key)" (nil ("count") ("hashval") ("position"))) ("keys" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s" (nil ("_EXTRA") ("count"))) ("struct" fun "hashtable" (lib "hashtable__define.pro" nil "markwardt") "Result = Obj ->[%s::]%s" (nil ("_EXTRA") ("count"))) ("hashtable__define" pro nil (lib "hashtable__define.pro" nil "markwardt") "%s" (nil)) ("srvdopp" fun nil (lib "srvdopp.pro" nil "markwardt") "Result = %s(u, v)" (nil ("classical"))) ("jplephinterp_calc" pro nil (lib "jplephinterp.pro" nil "markwardt") "%s, info, raw, obj, t, x, y, z, vx, vy, vz" (nil ("tbase") ("velocity"))) ("jplephinterp_denew" pro nil (lib "jplephinterp.pro" nil "markwardt") "%s, info, raw, obj, t, x, y, z, vx, vy, vz" (nil ("tbase") ("velocity"))) ("jplephinterp" pro nil (lib "jplephinterp.pro" nil "markwardt") "%s, info, raw, t, x, y, z, vx, vy, vz" (nil ("center") ("decode_obj") ("earth") ("objectname") ("pos_vel_factor") ("posunits") ("sun") ("tbase") ("velocity") ("velunits") ("xobjnum"))) ("jplephmake" pro nil (lib "jplephmake.pro" nil "markwardt") "%s, info, raw, obj, t, cx, cy, cz" (nil ("author") ("date") ("keyvalues") ("keywords") ("nsubintervals") ("posunits") ("reset"))) ("jplephpar" fun nil (lib "jplephread.pro" nil "markwardt") "Result = %s(header, parname)" (nil ("default") ("fatal"))) ("jplephval" fun nil (lib "jplephread.pro" nil "markwardt") "Result = %s(names, values, name)" (nil ("default") ("fatal"))) ("jplephread" pro nil (lib "jplephread.pro" nil "markwardt") "%s, filename, info, raw, jdlimits" (nil ("errmsg") ("status"))) ("jplephtest" pro nil (lib "jplephtest.pro" nil "markwardt") "%s, ephfile, testfile" (nil ("pause") ("threshold"))) ("litmsol" pro nil (lib "litmsol.pro" nil "markwardt") "%s, t1, x1, y1, z1, t2, info2, raw2, obj2, info, raw" (nil ("error") ("interp_func") ("maxiter") ("niter") ("no_shapiro") ("posunits") ("receiver") ("shapiro_calc") ("shapiro_delay") ("shapiro_deriv") ("tbase") ("tguess") ("tolerance") ("velunits") ("vx1") ("vx2") ("vy1") ("vy2") ("vz1") ("vz2") ("x2") ("xoffset") ("y2") ("yoffset") ("z2") ("zoffset"))) ("mask2gti" fun nil (lib "mask2gti.pro" nil "markwardt") "Result = %s(time, mask, count)" (nil ("bad") ("good") ("indices") ("post") ("pre") ("query") ("timedel") ("timepixr"))) ("mcholdc" pro nil (lib "mcholdc.pro" nil "markwardt") "%s, a, d, e" (nil ("cholsol") ("invpermute") ("outfull") ("permute") ("pivot") ("sparse") ("tau"))) ("cephes_setmachar" pro nil (lib "mpchilim.pro" nil "markwardt") "%s" (nil)) ("cephes_polevl" fun nil (lib "mpchilim.pro" nil "markwardt") "Result = %s(x, coef)" (nil)) ("cephes_ndtri" fun nil (lib "mpchilim.pro" nil "markwardt") "Result = %s(y0)" (nil)) ("cephes_igam" fun nil (lib "mpchilim.pro" nil "markwardt") "Result = %s(a, x)" (nil)) ("cephes_igamc" fun nil (lib "mpchilim.pro" nil "markwardt") "Result = %s(a, x)" (nil)) ("cephes_igami" fun nil (lib "mpchilim.pro" nil "markwardt") "Result = %s(a, y0)" (nil)) ("mpchilim" fun nil (lib "mpchilim.pro" nil "markwardt") "Result = %s(p, dof)" (nil ("clevel") ("sigma") ("slevel"))) ("cephes_setmachar" pro nil (lib "mpchitest.pro" nil "markwardt") "%s" (nil)) ("cephes_igam" fun nil (lib "mpchitest.pro" nil "markwardt") "Result = %s(a, x)" (nil)) ("cephes_igamc" fun nil (lib "mpchitest.pro" nil "markwardt") "Result = %s(a, x)" (nil)) ("mpchitest" fun nil (lib "mpchitest.pro" nil "markwardt") "Result = %s(x, dof)" (nil ("clevel") ("sigma") ("slevel"))) ("mpfitellipse_u" fun nil (lib "mpfitellipse.pro" nil "markwardt") "Result = %s(x, y, p)" (nil ("circle") ("tilt"))) ("mpfitellipse_eval" fun nil (lib "mpfitellipse.pro" nil "markwardt") "Result = %s(p)" (nil ("_EXTRA") ("circle") ("tilt"))) ("mpfitellipse" fun nil (lib "mpfitellipse.pro" nil "markwardt") "Result = %s(x, y, p0)" (nil ("_EXTRA") ("BESTNORM") ("circle") ("circular") ("covar") ("ERRMSG") ("nfev") ("niter") ("parinfo") ("perror") ("query") ("quiet") ("STATUS") ("symmetric") ("tilt") ("WEIGHTS"))) ("cephes_setmachar" pro nil (lib "mpnormlim.pro" nil "markwardt") "%s" (nil)) ("cephes_polevl" fun nil (lib "mpnormlim.pro" nil "markwardt") "Result = %s(x, coef)" (nil)) ("cephes_ndtri" fun nil (lib "mpnormlim.pro" nil "markwardt") "Result = %s(y0)" (nil)) ("mpnormlim" fun nil (lib "mpnormlim.pro" nil "markwardt") "Result = %s(p)" (nil ("clevel") ("slevel"))) ("cephes_setmachar" pro nil (lib "mpnormtest.pro" nil "markwardt") "%s" (nil)) ("cephes_polevl" fun nil (lib "mpnormtest.pro" nil "markwardt") "Result = %s(x, coef)" (nil)) ("cephes_set_erf_common" pro nil (lib "mpnormtest.pro" nil "markwardt") "%s" (nil)) ("cephes_erfc" fun nil (lib "mpnormtest.pro" nil "markwardt") "Result = %s(a)" (nil)) ("cephes_erf" fun nil (lib "mpnormtest.pro" nil "markwardt") "Result = %s(x)" (nil)) ("mpnormtest" fun nil (lib "mpnormtest.pro" nil "markwardt") "Result = %s(a)" (nil ("clevel") ("slevel"))) ("multisort_intkey" fun nil (lib "multisort.pro" nil "markwardt") "Result = %s(x, len)" (nil ("order") ("unsigned"))) ("multisort_fltkey" fun nil (lib "multisort.pro" nil "markwardt") "Result = %s(x1, type)" (nil ("order"))) ("multisort_strkey" fun nil (lib "multisort.pro" nil "markwardt") "Result = %s(x)" (nil ("order"))) ("multisort" fun nil (lib "multisort.pro" nil "markwardt") "Result = %s(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9)" (nil ("keys") ("L64") ("no_builtin") ("order"))) ("normpath" pro nil (lib "normpath.pro" nil "markwardt") "%s, from0, normalized" (nil ("current"))) ("phunwrap" fun nil (lib "phunwrap.pro" nil "markwardt") "Result = %s(ph)" (nil ("maxval") ("tolerance"))) ("profree" pro nil (lib "profree.pro" nil "markwardt") "%s, tree" (nil)) ("prn_strcat" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(strings)" (nil ("joinstring"))) ("prn_push" pro nil (lib "prorend.pro" nil "markwardt") "%s, stack, val" (nil ("nstack") ("template"))) ("prn_opn" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, ptr)" (nil ("embed") ("last_operation") ("type"))) ("prn_return" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_ubop" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil ("binop") ("unop"))) ("prn_assign" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("nstack") ("prefix"))) ("prn_subscript" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree, text)" (nil ("nstack"))) ("prn_procall" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("funct") ("method") ("nstack") ("prefix") ("statement"))) ("prn_array" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_pderef" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_for" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("nstack") ("prefix"))) ("prn_if" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("nstack") ("prefix"))) ("prn_while" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("nstack") ("prefix"))) ("prn_tricond" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_onioerror" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_structref" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_struct" fun nil (lib "prorend.pro" nil "markwardt") "Result = %s(prodecl, tree)" (nil)) ("prn_case" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("nstack") ("prefix"))) ("prn_parse" pro nil (lib "prorend.pro" nil "markwardt") "%s, prodecl, tree, text" (nil ("last_operation") ("nstack") ("prefix"))) ("prorend" pro nil (lib "prorend.pro" nil "markwardt") "%s, tree0, text" (nil ("init") ("mangle"))) ("qpint1d_profile" pro nil (lib "qpint1d.pro" nil "markwardt") "%s" (nil ("clear"))) ("qpint1d_setmachar" pro nil (lib "qpint1d.pro" nil "markwardt") "%s" (nil ("double"))) ("qpint1d_qagse" pro nil (lib "qpint1d.pro" nil "markwardt") "%s, f, a0, b0, result, abserr, private" (nil ("alist") ("blist") ("breakpoints") ("elist") ("epsabs") ("epsrel") ("functargs") ("iord") ("isdouble") ("limit") ("neval") ("npoints") ("nsubintervals") ("rlist") ("status"))) ("qpint1d_qkeval" pro nil (lib "qpint1d.pro" nil "markwardt") "%s, f, a, b, result, abserr, resabs, resasc, priv" (nil ("dirsign") ("functargs") ("inflow") ("isdouble") ("neval") ("npoints") ("reset"))) ("qpint1d_qelg" pro nil (lib "qpint1d.pro" nil "markwardt") "%s, n, epstab, result, abserr, res3la, nres" (nil)) ("qpint1d_qpsrt" pro nil (lib "qpint1d.pro" nil "markwardt") "%s, limit, last, maxerr, ermax, elist, iord, nrmax" (nil)) ("qpint1d_gkweights" pro nil (lib "qpint1d.pro" nil "markwardt") "%s, wg, wgk, xgk, ig, nptsreq, nptsact, prec" (nil)) ("qpint1d_eval" fun nil (lib "qpint1d.pro" nil "markwardt") "Result = %s(x, p)" (nil ("expression"))) ("qpint1d" fun nil (lib "qpint1d.pro" nil "markwardt") "Result = %s(f0, a0, b0, private)" (nil ("alist") ("blist") ("breakpoints") ("elist") ("epsabs") ("epsrel") ("error") ("expression") ("functargs") ("iord") ("limit") ("nfev") ("nocatch") ("npoints") ("nsubintervals") ("rlist") ("status") ("sym_axis") ("symmetric"))) ("qrsolv" fun nil (lib "qrsolv.pro" nil "markwardt") "Result = %s(q, r, b)" (nil ("pivots"))) ("qtang" fun nil (lib "qtang.pro" nil "markwardt") "Result = %s(q)" (nil)) ("qtaxis" fun nil (lib "qtaxis.pro" nil "markwardt") "Result = %s(q)" (nil)) ("qtcompose" fun nil (lib "qtcompose.pro" nil "markwardt") "Result = %s(axis, phi)" (nil)) ("qterp" fun nil (lib "qterp.pro" nil "markwardt") "Result = %s(t0, q0, t1)" (nil ("qdiff") ("reset") ("slerp"))) ("qteuler_extract" pro nil (lib "qteuler.pro" nil "markwardt") "%s, ax, i, ei, angi, ang0, ang1, ang2, ang3, ang4, ang5, ang6, ang7, ang8, ang9" (nil ("errmsg") ("status"))) ("qteuler" fun nil (lib "qteuler.pro" nil "markwardt") "Result = %s(axes, ang0, ang1, ang2, ang3, ang4, ang5, ang6, ang7, ang8, ang9, ang10, ang11, ang12, ang13, ang14, ang15)" (nil ("block"))) ("qtexp" fun nil (lib "qtexp.pro" nil "markwardt") "Result = %s(q)" (nil)) ("qtfind" fun nil (lib "qtfind.pro" nil "markwardt") "Result = %s(amat)" (nil)) ("qtinv" fun nil (lib "qtinv.pro" nil "markwardt") "Result = %s(q)" (nil)) ("qtlog" fun nil (lib "qtlog.pro" nil "markwardt") "Result = %s(q)" (nil)) ("qtmat" fun nil (lib "qtmat.pro" nil "markwardt") "Result = %s(q)" (nil ("invert"))) ("qtmult" fun nil (lib "qtmult.pro" nil "markwardt") "Result = %s(aqt, bqt)" (nil ("inv1") ("inv2"))) ("qtmultn" fun nil (lib "qtmultn.pro" nil "markwardt") "Result = %s(qt1, qt2, qt3, qt4, qt5, qt6, qt7, qt8)" (nil ("inv1") ("inv2") ("inv3") ("inv4") ("inv5") ("inv6") ("inv7") ("inv8"))) ("qtpow" fun nil (lib "qtpow.pro" nil "markwardt") "Result = %s(q, pow)" (nil)) ("qtvrot" fun nil (lib "qtvrot.pro" nil "markwardt") "Result = %s(vin, q)" (nil ("invert"))) ("relpath" pro nil (lib "relpath.pro" nil "markwardt") "%s, from0, to0, relpath" (nil ("cwd") ("file1") ("file2") ("invert"))) ("tai_utc_preload" pro nil (lib "tai_utc.pro" nil "markwardt") "%s, strs, msg" (nil)) ("tai_utc" fun nil (lib "tai_utc.pro" nil "markwardt") "Result = %s(jd)" (nil ("filename") ("invert") ("reload_every") ("reset"))) ("tdb2tdt_calc" fun nil (lib "tdb2tdt.pro" nil "markwardt") "Result = %s(jd)" (nil ("deriv") ("nterms") ("tbase"))) ("tdb2tdt" fun nil (lib "tdb2tdt.pro" nil "markwardt") "Result = %s(jd)" (nil ("deriv") ("nterms") ("tbase"))) ("value_locate" fun nil (lib "value_locate.pro" nil "markwardt") "Result = %s(xbins, x)" (nil ("_EXTRA") ("l64") ("no_crop"))) ("cubeterp" pro nil (lib "cubeterp.pro" nil "markwardt") "%s, xtab, ytab, yptab, xint, yint" (nil ("extrap_order") ("ypint") ("yppint"))) ("acirccirc" fun nil (lib "acirccirc.pro" nil "markwardt") "Result = %s(r1, r2, d)" (nil)) ("quinterp" pro nil (lib "quinterp.pro" nil "markwardt") "%s, xtab, ytab, yptab, ypptab, xint, yint" (nil ("missing") ("ypint") ("yppint"))) ("file_compile" pro nil (lib "file_compile.pro" nil "markwardt") "%s, pathname" (nil ("errmsg") ("error") ("pro_name"))) ("flormat_structcheck" pro nil (lib "flormat.pro" nil "markwardt") "%s, s, n, tn" (nil)) ("flormat" fun nil (lib "flormat.pro" nil "markwardt") "Result = %s(format0, s0)" (nil ("_EXTRA") ("format_am_pm") ("format_days_of_week") ("format_months") ("shell_style$"))) ("litmsol2" pro nil (lib "litmsol2.pro" nil "markwardt") "%s, t1, x1, y1, z1, t2, func2, info2, raw2" (nil ("delay_arg1") ("delay_arg2") ("delay_functargs") ("delay_function") ("error") ("functargs") ("functsave") ("light_time") ("maxiter") ("method") ("niter") ("posunits") ("receiver") ("tguess") ("tolerance") ("vx1") ("vx2") ("vy1") ("vy2") ("vz1") ("vz2") ("x2") ("y2") ("z2"))) ("gapnan_i" pro nil (lib "gapnan.pro" nil "markwardt") "%s, ii, yy" (nil)) ("gapnan" pro nil (lib "gapnan.pro" nil "markwardt") "%s, tt, y1, y2, y3, y4, y5" (nil ("gti") ("include") ("indices") ("maxgap"))) ("mpproperr" fun nil (lib "mpproperr.pro" nil "markwardt") "Result = %s(fjac, pcovar)" (nil ("diagonal") ("errmsg") ("nan") ("pfree_index") ("status"))) ("pxperfect_ps_px_cm" fun nil (lib "pxperfect.pro" nil "markwardt") "Result = %s" (nil)) ("pxperfect" fun nil (lib "pxperfect.pro" nil "markwardt") "Result = %s" (nil ("_EXTRA") ("bits_per_pixel") ("color") ("inches") ("landscape") ("scale_factor") ("thick_factor") ("xoffset") ("xsize") ("yoffset") ("ysize"))) ("tzoffset_init" pro nil (lib "tzoffset.pro" nil "markwardt") "%s, tlimits, tgrid, toff" (nil)) ("tzoffset_str2jd" fun nil (lib "tzoffset.pro" nil "markwardt") "Result = %s(str)" (nil)) ("tzoffset_calc" fun nil (lib "tzoffset.pro" nil "markwardt") "Result = %s(t)" (nil)) ("tzoffset_extendp" pro nil (lib "tzoffset.pro" nil "markwardt") "%s, tstop, tlimits, tgrid, toff" (nil ("tstep"))) ("tzoffset_extendm" pro nil (lib "tzoffset.pro" nil "markwardt") "%s, tstop, tlimits, tgrid, toff" (nil ("tstep"))) ("tzoffset_dst" pro nil (lib "tzoffset.pro" nil "markwardt") "%s, tgrid, toff, dst" (nil)) ("tzoffset" fun nil (lib "tzoffset.pro" nil "markwardt") "Result = %s(tt)" (nil ("is_dst") ("julian") ("local") ("now") ("reset"))) ("qtnormalize" fun nil (lib "qtnormalize.pro" nil "markwardt") "Result = %s(q0)" (nil ("pos3") ("unitize"))) ("angunitvec" fun nil (lib "angunitvec.pro" nil "markwardt") "Result = %s(a0, d0)" (nil ("declination"))) ("unitvecang" fun nil (lib "unitvecang.pro" nil "markwardt") "Result = %s(vecs)" (nil ("declination"))) ("unitize" fun nil (lib "unitize.pro" nil "markwardt") "Result = %s(u)" (nil ("magnitude")))))