ucminf/0000755000176200001440000000000014536372722011546 5ustar liggesusersucminf/NAMESPACE0000644000176200001440000000017314433637310012757 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(ucminf) useDynLib(ucminf, mfopt, .registration = TRUE, .fixes = "C_") ucminf/README.md0000644000176200001440000001152114434113016013007 0ustar liggesusers # ucminf [![R-CMD-check](https://github.com/hdakpo/ucminf/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/hdakpo/ucminf/actions/workflows/R-CMD-check.yaml) [![Downloads](https://cranlogs.r-pkg.org/badges/ucminf)](https://CRAN.R-project.org/package=ucminf) [![](https://img.shields.io/github/languages/code-size/hdakpo/ucminf.svg)](https://github.com/hdakpo/ucminf) [![](https://img.shields.io/badge/license-GPL-blue)](https://github.com/hdakpo/ucminf) [![CRAN status](https://www.r-pkg.org/badges/version/ucminf)](https://CRAN.R-project.org/package=ucminf) The goal of *ucminf* is to provide an algorithm for general-purpose unconstrained non-linear optimization. The algorithm is of quasi-Newton type with BFGS updating of the inverse Hessian and soft line search with a trust region type monitoring of the input to the line search algorithm. The interface of *ucminf* is designed for easy interchange with `optim` ## Installation You can install the development version of ucminf from [GitHub](https://github.com/) with: ``` r # install.packages("devtools") devtools::install_github("hdakpo/ucminf") ``` ## Example ``` r library(ucminf) # Rosenbrock Banana function fR <- function(x) (1 - x[1])^2 + 100 * (x[2] - x[1]^2)^2 gR <- function(x) c(-400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]), 200 * (x[2] - x[1] * x[1])) ## Find minimum and show trace optRes <- ucminf(par = c(2,.5), fn = fR, gr = gR, control = list(trace = 1)) #> neval = 1, F(x) = 1.2260e+03, max|g(x)| = 2.8020e+03 #> x = 2.0000e+00, 5.0000e-01 #> Line search: alpha = 1.0000e+00, dphi(0) =-2.8881e+03, dphi(1) =-1.4263e+02 #> neval = 2, F(x) = 1.0123e+01, max|g(x)| = 1.3111e+02 #> x = 1.0298e+00, 7.4237e-01 #> Line search: alpha = 1.0000e+00, dphi(0) =-3.1743e+01, dphi(1) = 1.0180e+01 #> neval = 3, F(x) = 1.7049e+00, max|g(x)| = 6.3969e+01 #> x = 1.2600e+00, 1.7155e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-2.5788e+00, dphi(1) =-5.6182e-01 #> neval = 4, F(x) = 1.1612e-01, max|g(x)| = 1.2343e+01 #> x = 1.2174e+00, 1.5083e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-1.5867e-01, dphi(1) = 1.2108e-02 #> neval = 5, F(x) = 4.2253e-02, max|g(x)| = 1.8638e+00 #> x = 1.2033e+00, 1.4449e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-1.1826e-03, dphi(1) =-3.2371e-04 #> neval = 6, F(x) = 4.1500e-02, max|g(x)| = 8.6681e-01 #> x = 1.2035e+00, 1.4474e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-5.9673e-04, dphi(1) =-4.7194e-04 #> neval = 7, F(x) = 4.0965e-02, max|g(x)| = 4.8839e-01 #> x = 1.2024e+00, 1.4456e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-3.9731e-03, dphi(1) =-2.3018e-03 #> neval = 8, F(x) = 3.7853e-02, max|g(x)| = 8.5215e-01 #> x = 1.1928e+00, 1.4254e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-8.0453e-03, dphi(1) =-6.3954e-03 #> neval = 9, F(x) = 3.0800e-02, max|g(x)| = 2.0990e+00 #> x = 1.1676e+00, 1.3685e+00 #> Line search: alpha = 8.2084e-01, dphi(0) =-4.4175e-02, dphi(1) = 1.8746e-02 #> neval = 11, F(x) = 4.8486e-03, max|g(x)| = 2.2862e+00 #> x = 1.0458e+00, 1.0884e+00 #> Line search: alpha = 3.8293e-01, dphi(0) =-4.8734e-03, dphi(1) = 4.6817e-04 #> neval = 13, F(x) = 4.0485e-03, max|g(x)| = 1.1863e+00 #> x = 1.0584e+00, 1.1177e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-6.4354e-04, dphi(1) =-5.6879e-04 #> neval = 14, F(x) = 3.4426e-03, max|g(x)| = 1.1238e+00 #> x = 1.0535e+00, 1.1074e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-4.7371e-03, dphi(1) =-1.0920e-03 #> neval = 15, F(x) = 6.1678e-04, max|g(x)| = 7.3075e-01 #> x = 1.0180e+00, 1.0347e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-7.9043e-04, dphi(1) =-2.5377e-04 #> neval = 16, F(x) = 1.0437e-04, max|g(x)| = 1.6394e-01 #> x = 1.0096e+00, 1.0189e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-1.8089e-04, dphi(1) =-1.8237e-05 #> neval = 17, F(x) = 5.8219e-06, max|g(x)| = 9.1455e-02 #> x = 1.0009e+00, 1.0016e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-1.3102e-05, dphi(1) = 2.0222e-06 #> neval = 18, F(x) = 2.9162e-07, max|g(x)| = 1.7185e-02 #> x = 1.0003e+00, 1.0007e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-5.9332e-07, dphi(1) = 1.1234e-08 #> neval = 19, F(x) = 1.2578e-10, max|g(x)| = 2.0751e-04 #> x = 9.9999e-01, 9.9998e-01 #> Line search: alpha = 1.0000e+00, dphi(0) =-2.5270e-10, dphi(1) = 1.1297e-12 #> neval = 20, F(x) = 3.5670e-15, max|g(x)| = 2.0836e-06 #> x = 1.0000e+00, 1.0000e+00 #> Line search: alpha = 1.0000e+00, dphi(0) =-7.1150e-15, dphi(1) =-1.8980e-17 #> Optimization has converged #> Stopped by small gradient (grtol). #> maxgradient laststep stepmax neval #> 1.020598e-08 6.480989e-08 1.225000e-01 2.100000e+01 ``` ucminf/man/0000755000176200001440000000000014433633720012313 5ustar liggesusersucminf/man/ucminf.Rd0000644000176200001440000001745114433634733014100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ucminf.R \name{ucminf} \alias{ucminf} \title{General-Purpose Unconstrained Non-Linear Optimization} \usage{ ucminf(par, fn, gr = NULL, ..., control = list(), hessian = 0) } \arguments{ \item{par}{Initial estimate of minimum for \code{fn}.} \item{fn}{Objective function to be minimized.} \item{gr}{Gradient of objective function. If \code{NULL} a finite difference approximation is used.} \item{...}{Optional arguments passed to the objective and gradient functions.} \item{control}{A list of control parameters. See \sQuote{Details}.} \item{hessian}{Integer value: \describe{\item{0}{No hessian approximation is returned.} \item{1}{Returns a numerical approximation of the Hessian using \sQuote{hessian} in the package \sQuote{numDeriv}.} \item{2}{Returns final approximation of the inverse Hessian based on the series of BFGS updates during optimization.} \item{3}{Same at 2, but will also return the Hessian (the inverse of 2).}} If a \code{TRUE} or \code{FALSE} value is given it will switch between option 1 or 0.} } \value{ \code{\link{ucminf}} returns a list of class \code{'ucminf'} containing the following elements: \item{par}{Computed minimizer.} \item{value}{Objective function value at computed minimizer.} \item{convergence}{Flag for reason of termination: \describe{ \item{1}{Stopped by small gradient (grtol).} \item{2}{Stopped by small step (xtol).} \item{3}{Stopped by function evaluation limit (maxeval).} \item{4}{Stopped by zero step from line search} \item{-2}{Computation did not start: length(par) = 0.} \item{-4}{Computation did not start: stepmax is too small.} \item{-5}{Computation did not start: grtol or xtol <= 0.} \item{-6}{Computation did not start: maxeval <= 0.} \item{-7}{Computation did not start: given Hessian not pos. definite.}}} \item{message}{String with reason of termination.} \item{hessian, invhessian}{Estimate of (inv.) Hessian at computed minimizer. The type of estimate is given by the input argument \sQuote{hessian}.} \item{invhessian.lt}{The lower triangle of the final approximation to the inverse Hessian based on the series of BFGS updates during optimization.} \item{info}{Information about the search: \describe{ \item{maxgradient}{\eqn{||F'(x)||_\infty}{||F'(x)||_inf}, the largest element in the absolute value of the gradient at the computed minimizer.} \item{laststep}{Length of last step.} \item{stepmax}{Final maximal allowed step length.} \item{neval}{Number of calls to both objective and gradient function.}}} } \description{ An algorithm for general-purpose unconstrained non-linear optimization. The algorithm is of quasi-Newton type with BFGS updating of the inverse Hessian and soft line search with a trust region type monitoring of the input to the line search algorithm. The interface of \sQuote{ucminf} is designed for easy interchange with \sQuote{optim}. } \details{ The algorithm is documented in (Nielsen, 2000) (see References below) together with a comparison to the Fortran subroutine \sQuote{MINF} and the Matlab function \sQuote{fminunc}. The implementation of \sQuote{ucminf} in \R uses the original Fortran version of the algorithm. The interface in R is designed so that it is very easy to switch between using \sQuote{ucminf} and \sQuote{\link[stats]{optim}}. The arguments \code{par}, \code{fn}, \code{gr}, and \code{hessian} are all the same (with a few extra options for \code{hessian} in \sQuote{ucminf}). The difference is that there is no \code{method} argument in \sQuote{ucminf} and that some of the components in the \code{control} argument are different due to differences in the algorithms. The algorithm can be given an initial estimate of the Hessian for the optimization and it is possible to get the final approximation of the Hessian based on the series of BFGS updates. This extra functionality may be useful for optimization in a series of related problems. The functions \code{fn} and \code{gr} can return \code{Inf} or \code{NaN} if the functions cannot be evaluated at the supplied value, but the functions must be computable at the initial value. The functions are not allowed to return \code{NA}. Any names given to \code{par} will be copied to the vectors passed to \code{fn} and \code{gr}. No other attributes of \code{par} are copied over. The \code{control} argument is a list that can supply any of the following components: \describe{\item{\code{trace}}{If trace is positive then detailed tracing information is printed for each iteration.} \item{\code{grtol}}{The algorithm stops when \eqn{||F'(x)||_\infty \leq }{||F'(x)||_inf <=} grtol, that is when the largest absolute value of the gradient is less than grtol. Default value is \code{grtol = 1e-6}. } \item{\code{xtol}}{The algorithm stops when \eqn{||x-x_p||_2 \leq \textrm{xtol}\cdot(\textrm{xtol} + ||x||_2)}{||x-x_p||_2 <= xtol*(xtol + ||x||_2)}, where \eqn{x_p} and \eqn{x} are the previous and current estimate of the minimizer. Thus the algorithm stops when the last relative step length is sufficiently small. Default value is \code{xtol = 1e-12}.} \item{\code{stepmax}}{Initial maximal allowed step length (radius of trust-region). The value is updated during the optimization. Default value is \code{stepmax = 1}.} \item{\code{maxeval}}{The maximum number of function evaluations. A function evaluation is counted as one evaluation of the objective function and of the gradient function. Default value is \code{maxeval = 500}.} \item{\code{grad}}{Either \sQuote{forward} or \sQuote{central}. Controls the type of finite difference approximation to be used for the gradient if no gradient function is given in the input argument \sQuote{gr}. Default value is \code{grad = 'forward'}.} \item{\code{gradstep}}{Vector of length 2. The step length in finite difference approximation for the gradient. Step length is \eqn{|x_i|\cdot\textrm{gradstep[1]+gradstep[2]}}{|x_i|*gradstep[1]+ gradstep[2]}. Default value is \code{gradstep = c(1e-6, 1e-8)}.} \item{\code{invhessian.lt}}{A vector with an initial approximation to the lower triangle of the inverse Hessian. If not given, the inverse Hessian is initialized as the identity matrix. If \code{H0} is the initial hessian matrix then the lower triangle of the inverse of \code{H0} can be found as \code{invhessian.lt = solve(H0)[lower.tri(H0,diag=TRUE)]}.}} } \examples{ ## Rosenbrock Banana function fR <- function(x) (1 - x[1])^2 + 100 * (x[2] - x[1]^2)^2 gR <- function(x) c(-400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]), 200 * (x[2] - x[1] * x[1])) # Find minimum and show trace ucminf(par = c(2,.5), fn = fR, gr = gR, control = list(trace = 1)) } \references{ Nielsen, H. B. (2000) \sQuote{UCMINF - An Algorithm For Unconstrained, Nonlinear Optimization}, Report IMM-REP-2000-19, Department of Mathematical Modelling, Technical University of Denmark. \url{http://www.imm.dtu.dk/documents/ftp/tr00/tr19_00.pdf} The original Fortran source code was found at \code{http://www2.imm.dtu.dk/projects/hbn_software/ucminf.f}. (That URL is no longer available but archived at \url{https://web.archive.org/web/20050418082240/http://www.imm.dtu.dk/~hbn/Software/ucminf.f} -- Dr Nielsen passed away in 2015). The code has been slightly modified in this package to be suitable for use with \R. The general structure of the implementation in \R is based on the package \sQuote{FortranCallsR} by Diethelm Wuertz. } \seealso{ \code{\link[stats]{optim}}, \code{\link[stats]{nlminb}}, \code{\link[stats]{nlm}}. } \author{ \sQuote{UCMINF} algorithm design and Fortran code by Hans Bruun Nielsen. K Hervé Dakpo took over maintenance of the package in May. 2023. Implementation in \R by Stig B. Mortensen, \email{stigbm@gmail.com}. Modifications by Douglas Bates \href{mailto:bates@stat.wisc.edu}{bates@stat.wisc.edu}, Nov. 2010, to support nested optimization and correct issues with printing on Windows. } \keyword{nonlinear} \keyword{optimize} ucminf/man/ucminf-package.Rd0000644000176200001440000000113114433635475015461 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ucminf-package.R \docType{package} \name{ucminf-package} \alias{ucminf-package} \title{ucminf: General-Purpose Unconstrained Non-Linear Optimization} \description{ The \pkg{ucminf} package provides an algorithm for general-purpose unconstrained non-linear optimization. } \section{Bugreport}{ Any bug or suggestion can be reported using the \code{ucminf} tracker facilities at: \url{https://github.com/hdakpo/ucminf/issues} } \author{ K Hervé Dakpo, Hans Bruun Nielsen, and Stig Bousgaard Mortensen } ucminf/DESCRIPTION0000644000176200001440000000220714536372722013255 0ustar liggesusersPackage: ucminf Title: General-Purpose Unconstrained Non-Linear Optimization Version: 1.2.1 Authors@R: c( person("K Hervé", "Dakpo", email = "k-herve.dakpo@inrae.fr", role = c("ctb", "cre")), person("Hans Bruun", "Nielsen", role = "aut"), person("Stig Bousgaard", "Mortensen", role = "aut") ) Description: An algorithm for general-purpose unconstrained non-linear optimization. The algorithm is of quasi-Newton type with BFGS updating of the inverse Hessian and soft line search with a trust region type monitoring of the input to the line search algorithm. The interface of 'ucminf' is designed for easy interchange with 'optim'. License: GPL (>= 2) URL: https://github.com/hdakpo/ucminf BugReports: https://github.com/hdakpo/ucminf/issues Encoding: UTF-8 RoxygenNote: 7.2.3 Depends: R (>= 3.5.0) Suggests: numDeriv NeedsCompilation: yes Packaged: 2023-12-11 12:17:24 UTC; Dakpo Author: K Hervé Dakpo [ctb, cre], Hans Bruun Nielsen [aut], Stig Bousgaard Mortensen [aut] Maintainer: K Hervé Dakpo Repository: CRAN Date/Publication: 2023-12-13 18:20:02 UTC ucminf/src/0000755000176200001440000000000014535576723012343 5ustar liggesusersucminf/src/fortran.f0000644000176200001440000004156714433165326014170 0ustar liggesusers SUBROUTINE UCMINF(N,X,DX,EPS,MAXFUN,W,IW,ICONTR,GRAD,GRSTEP,RHO) ************************************************************************ * Unconstrained minimization of a scalar function. * * For a User's guide see H.B. Nielsen "UCMINF -- AN ALGORITHM FOR * UNCONSTRAINED, NONLINEAR OPTIMIZATION", Report IMM-REP-2000-18, * Department of Mathematical Modelling, Technical University of Denmark, * December 2000. * * Hans Bruun Nielsen, IMM, DTU. 00.12.19 * * Changes for implementation in R: * - FDF removed from argument to UCMINF and thus not declared EXTERNAL. * - GRAD, GRADSTEP are passed to FDF to choose gradient type. * - OUT is changed from INTEGER to CHARACTER to store output from * write which is then displayed in R using DBLEPR. * - DBLEPR is declared EXTERNAL. * Stig Mortensen, IMM, DTU. December 2008. * ************************************************************************ IMPLICIT NONE C Parameters C EXTERNAL FDF INTEGER N, MAXFUN, IW, ICONTR, GRAD, RHO(*) DOUBLE PRECISION X(N), DX, EPS(2), W(IW), GRSTEP(2) C Local variables LOGICAL DGIVN, OPTIM, REDU, TRACE, USEDEL INTEGER DI,DN,FAIL,GN,GP,HN,I,II,INDX(3), & MEVAL,NEVAL,NN,NN1,WN DOUBLE PRECISION A,FX,FXN,NMG,NMH,NMX,SL(2),THRX,YH,YV INTRINSIC ABS,DBLE,MAX,MIN C C BLAS functions INTEGER IDAMAX DOUBLE PRECISION DDOT, DNRM2 C If BLAS is available, then remove the * in col. 1 of the next lines C and delete from line ??? to the end of the file EXTERNAL DCOPY, DDOT, DNRM2, DSCAL, DSPMV, DSPR2, IDAMAX C ... What job ? OPTIM = (ICONTR .GT. 0) DGIVN = (ICONTR .GT. 2) TRACE = ((ICONTR .EQ. 2) .OR. (ICONTR .GT. 3)) C ... Simple checks ICONTR = 0 NN = (N * (N+1)) / 2 IF (N .LE. 0) THEN ICONTR = -2 ELSEIF (OPTIM) THEN IF (DX .LE. 0D0) THEN ICONTR = -4 ELSEIF ((EPS(1) .LE. 0D0) .OR. (EPS(2) .LE. 0D0)) THEN ICONTR = -5 ELSEIF (MAXFUN .LE. 0) THEN ICONTR = -6 ENDIF ELSEIF (DX .EQ. 0D0) THEN ICONTR = -4 ELSEIF ((IW .LT. MAX((N*(N+11))/2, 7)) .OR. + (DGIVN .AND. (IW .LT. MAX(2*NN, NN+5*N)))) THEN ICONTR = -8 ENDIF C ... Exit if error in a parameter IF (ICONTR .LT. 0) RETURN C IF (.NOT. OPTIM) THEN C ... Check gradient GN = 5 HN = GN + N CALL CHKDFN(N,X,DX,W,INDX,W(GN),W(HN),FAIL,GRAD,GRSTEP,RHO) IF (FAIL .GT. 0) THEN C ... DX is too small ICONTR = -4 ELSE DO 10 I = 1, 3 10 W(I+4) = DBLE(INDX(I)) ENDIF RETURN ENDIF C C ... Optimize. Split workspace GP = N + 1 GN = GP + N HN = GN + N DN = HN + N WN = DN + NN C IF (DGIVN) THEN C ... Check given D0 NN1 = NN + 1 CALL DCOPY(NN, W(DN),1, W,1) CALL DCOPY(NN, W,1, W(NN1),1) CALL SPCHOL(N,W(NN1),FAIL) IF (FAIL .NE. 0) THEN C ... Not positive definite ICONTR = -7 RETURN ENDIF C ... Restore given D CALL DCOPY(NN, W,-1, W(DN),-1) USEDEL = .FALSE. ELSE C ... Initialize inverse Hessian to unit matrix DO 20 I = HN, WN 20 W(I) = 0D0 II = DN DI = N DO 30 I = 1, N W(II) = 1D0 II = II + DI DI = DI - 1 30 CONTINUE USEDEL = .TRUE. ENDIF C ... First call of FDF CALL FDF(N,X,W(GN),FX,GRAD,GRSTEP,RHO) NEVAL = 1 NMH = 0D0 NMX = DNRM2(N, X,1) NMG = ABS(W(GN-1 + IDAMAX(N, W(GN),1))) IF (NMG .LE. EPS(1)) THEN ICONTR = 1 GOTO 200 ENDIF C C ... Repeat from here 100 CONTINUE IF (TRACE) THEN CALL PRTRAC(NEVAL, FX, NMG, N, X) c$$$ WRITE(OUT,'(A,I3,2(2X,A,1P1D11.3))') 'neval =',NEVAL, c$$$ + 'F(x) =',FX, 'max|g(x)| =',NMG c$$$ CALL DBLEPR (OUT, -1, X, 0) c$$$ CALL PRVCTR(' x',X,1,N,OUT) ENDIF C C ... Copy current x and gradient and get new step CALL DCOPY(N, X,1, W,1) CALL DCOPY(N, W(GN),1, W(GP),1) CALL DSPMV('L', N, -1D0, W(DN), W(GN),1, 0D0,W(HN),1) C ... Adjust step length to trust region REDU = .FALSE. NMH = DNRM2(N, W(HN),1) IF (NMH .LE. EPS(2)*(EPS(2) + NMX)) THEN ICONTR = 2 GOTO 200 ENDIF IF ((NMH .GT. DX) .OR. USEDEL) THEN REDU = .TRUE. CALL DSCAL(N, DX/NMH, W(HN),1) NMH = DX USEDEL = .FALSE. ENDIF C ... Line search (MEVAL is max iterations in line search) MEVAL = 5 CALL SLINE(N,X,FX,W(GN),W(HN),W(WN),A,FXN,SL,MEVAL, & GRAD,GRSTEP,RHO) IF (TRACE) THEN CALL PRLINE(A, SL) c$$$ WRITE(OUT,'(A,1P1D11.3,2(2X,A,1P1D11.3))') c$$$ + 'Line search: alpha =', c$$$ + A, 'dphi(0) =',SL(1),'dphi(alpha) =',SL(2) c$$$ CALL DBLEPR (OUT, -1, X, 0) ENDIF IF (A .EQ. 0D0) THEN ICONTR = 4 NMH = 0D0 GOTO 200 ENDIF C ... Update neval, x, f(x) and ||g|| NEVAL = NEVAL + MEVAL NMG = ABS(W(GN-1 + IDAMAX(N, W(GN),1))) FX = FXN CALL DAXPY(N, A, W(HN),1, X,1) NMX = DNRM2(N, X,1) CALL DAXPY(N, -1D0, X,1, W,1) NMH = DNRM2(N, W,1) C ... Update trust region IF (A .LT. 1D0) THEN C ... Reduce Delta DX = .35D0 * DX ELSEIF (REDU .AND. (SL(2) .LT. .7D0*SL(1))) THEN C ... Increase Delta DX = 3D0 * DX ENDIF C ... Update of inverse Hessian by BFGS CALL DSCAL(N, -1D0, W,1) CALL DAXPY(N, -1D0,W(GN),1, W(GP),1) YH = -DDOT(N, W(GP),1, W,1) IF (YH .GT. 1D-8 * NMH * DNRM2(N, W(GP),1)) THEN CALL DSPMV('L', N, -1D0, W(DN), W(GP),1, 0D0,W(HN),1) YV = -DDOT(N, W(GP),1, W(HN),1) A = (1D0 + YV/YH)/YH CALL DSCAL(N, -1D0/YH, W(HN),1) CALL DAXPY(N, .5D0*A, W,1, W(HN),1) CALL DSPR2('L', N, 1D0, W,1, W(HN),1, W(DN)) ENDIF C ... Check stopping criteria THRX = EPS(2)*(EPS(2) + NMX) DX = MAX(DX, THRX) IF (NEVAL .GE. MAXFUN) ICONTR = 3 IF (NMH .LE. THRX) ICONTR = 2 IF (NMG .LE. EPS(1)) ICONTR = 1 IF (ICONTR .EQ. 0) GOTO 100 C 200 CONTINUE C ... Set return values MAXFUN = NEVAL W(1) = FX W(2) = NMG W(3) = NMH IF (TRACE) THEN IF(ICONTR.EQ.1.OR.ICONTR.EQ.2.OR.ICONTR.EQ.4) THEN c$$$ WRITE(OUT,'(A)') 'Optimization has converged.' CALL PRCONV() ELSE c$$$ WRITE(OUT,'(A27,I3,A22)') 'Optimization stopped after ' c$$$ + ,NEVAL,' function evaluations.' CALL PRFAIL(NEVAL) ENDIF c$$$ CALL DBLEPR (OUT, -1, X, 0) ENDIF RETURN *************************** End of UCMINF *************************** END C SUBROUTINE SLINE(N,X,F,G,H,W,ALPHA,FN,SLPS,NEV,GRAD,GRSTEP,RHO) ************************************************************************ * Soft line search * Hans Bruun Nielsen, IMM, DTU. 00.12.18 ************************************************************************ IMPLICIT NONE C Parameters C EXTERNAL FDF INTEGER N, NEV, GRAD, RHO(*) DOUBLE PRECISION X(N),F,G(N),H(N),W(*),ALPHA,FN,SLPS(2) DOUBLE PRECISION GRSTEP(2) C Local variables LOGICAL OK,STOP INTEGER MEVAL,NG,NX DOUBLE PRECISION A,B,C,D,FI0,SL0,SLTHR,XFD(3,3) INTRINSIC ABS,DBLE,MAX,MIN C BLAS functions DOUBLE PRECISION DDOT C If BLAS is available, then remove the * in col. 1 of the next lines C and delete from line ??? to the end of the file EXTERNAL DAXPY, DCOPY, DDOT C C ... Default return values ALPHA = 0D0 FN = F MEVAL = NEV NEV = 0 C ... Get initial slope and check descent direction SLPS(1) = DDOT(N, G,1, H,1) SLPS(2) = SLPS(1) IF (SLPS(1) .GE. 0D0) RETURN C ... Split work space and finish initialization NX = 1 NG = N + 1 FI0 = F SL0 = 5D-2 * SLPS(1) SLTHR = .995D0 * SLPS(1) OK = .FALSE. STOP = .FALSE. XFD(1,1) = 0D0 XFD(2,1) = F XFD(3,1) = SLPS(1) NEV = 0 B = 1D0 10 CONTINUE C ... Evaluate at x + b*h XFD(1,2) = B CALL DCOPY(N, X,1, W,1) CALL DAXPY(N, B, H,1, W,1) c XTMP=X c WRITE(6,'(A,2F8.3)') 'X1a =',X CALL FDF(N,W,W(NG),XFD(2,2),GRAD,GRSTEP,RHO) c WRITE(6,'(A,2F8.3)') 'X1b =',X c X=XTMP c WRITE(6,'(A,2F8.3)') 'X1c =',X NEV = NEV + 1 XFD(3,2) = DDOT(N, W(NG),1, H,1) IF (B .EQ. 1D0) SLPS(2) = XFD(3,2) IF (XFD(2,2) .LE. FI0 + SL0*XFD(1,2)) THEN C ... New lower bound IF (XFD(3,2) .LE. ABS(SLTHR)) THEN OK = .TRUE. ALPHA = XFD(1,2) FN = XFD(2,2) SLPS(2) = XFD(3,2) CALL DCOPY(N, W(NG),1, G,1) IF ((B .LT. 2D0) .AND. (XFD(3,2) .LT. SLTHR)) THEN C ... Expand CALL DCOPY(3, XFD(1,2),1, XFD(1,1),1) B = 2D0 GOTO 10 ENDIF ENDIF ENDIF C D = XFD(1,2) - XFD(1,1) C 20 IF (OK .OR. (NEV .EQ. MEVAL)) RETURN C C ... Refine interval. Min of quadratic interpolator C = XFD(2,2) - XFD(2,1) - D*XFD(3,1) IF (C .GT. 1D-15*DBLE(n)*XFD(1,2)) THEN C ... Minimizer in interval A = XFD(1,1) - .5D0 * XFD(3,1) * (D**2 / C) D = .1D0 * D XFD(1,3) = MIN(MAX(XFD(1,1)+D,A), XFD(1,2)-D) ELSE XFD(1,3) = .5D0 * (XFD(1,1) + XFD(1,2)) ENDIF CALL DCOPY(N, X,1, W,1) CALL DAXPY(N, XFD(1,3), H,1, W,1) c XTMP=X c WRITE(6,'(A,2F8.3)') 'X2a =',X CALL FDF(N,W,W(NG),XFD(2,3),GRAD,GRSTEP,RHO) c WRITE(6,'(A,2F8.3)') 'X2b =',X c X=XTMP NEV = NEV + 1 XFD(3,3) = DDOT(N, W(NG),1, H,1) IF (XFD(2,3) .LT. FI0 + SL0*XFD(1,3)) THEN C ... New lower bound OK = .TRUE. ALPHA = XFD(1,3) FN = XFD(2,3) SLPS(2) = XFD(3,3) CALL DCOPY(N, W(NG),1, G,1) CALL DCOPY(3, XFD(1,3),1, XFD(1,1),1) ELSE CALL DCOPY(3, XFD(1,3),1, XFD(1,2),1) ENDIF C ... Check convergence D = XFD(1,2) - XFD(1,1) OK = OK .AND. (ABS(XFD(3,3)) .LE. ABS(SLTHR)) OK = OK .OR. (D .LE. 0D0) GOTO 20 C *************************** End of SLINE **************************** END C SUBROUTINE SPCHOL(N,A,FAIL) ************************************************************************ * Cholesky factorization of symmetric matrix given in lower triangle, * packed form. * FAIL = 0: The matrix is positive definite and the Cholesky factor * has overwritten A * FAIL > 0: The leading minor of order FAIL is not positive definite * * Hans Bruun Nielsen, IMM, DTU. 00.12.18 ************************************************************************ IMPLICIT NONE C Parameters INTEGER N,FAIL DOUBLE PRECISION A(*) C Local variables INTEGER K,KK,KN,NK INTRINSIC SQRT C C If BLAS is available, then remove the * in col. 1 of the next lines C and delete from line ??? to the end of the file EXTERNAL DSCAL, DSPR C FAIL = 0 KK = 1 DO 10 K = 1, N C ... Test for pos def IF (A(KK) .LE. 0D0) THEN FAIL = K RETURN ENDIF A(KK) = SQRT(A(KK)) IF (K .LT. N) THEN C ... Compute k'th column and update trailing submatrix NK = N - K CALL DSCAL(NK, 1D0/A(KK), A(KK+1),1) KN = KK + NK + 1 CALL DSPR('L',NK, -1D0,A(KK+1),1, A(KN)) KK = KN ENDIF 10 CONTINUE RETURN *************************** End of SPCHOL *************************** END C SUBROUTINE CHKDFN(N,X,STEPL,DIFF,INDX,G,G1,FAIL,GRAD,GRSTEP,RHO) ************************************************************************ * Check implementation of gradient of function of N variables * Hans Bruun Nielsen, IMM, DTU. 00.09.29 ************************************************************************ IMPLICIT NONE INTEGER N,INDX(3),FAIL, I,GRAD, RHO(*) DOUBLE PRECISION X(N),STEPL,DIFF(4),G(N),G1(N), & F,F1, XI,H,AF,AB,AE,ER, GRSTEP(2) C EXTERNAL FDF INTRINSIC ABS, MAX C ... Initialize FAIL = 1 DO 10 I = 1, 4 10 DIFF(I) = 0D0 DO 20 I = 1, 3 20 INDX(I) = 0 CALL FDF(N,X,G,F,GRAD,GRSTEP,RHO) C ... Run through components of X DO 30 I = 1, N DIFF(1) = MAX(DIFF(1), ABS(G(I))) XI = X(I) C ... Forward X(I) = XI + STEPL H = X(I) - XI IF (H .EQ. 0D0) RETURN CALL FDF(N,X,G1,F1,GRAD,GRSTEP,RHO) AF = (F1 - F)/H ER = AF - G(I) IF (ABS(ER) .GT. ABS(DIFF(2))) THEN DIFF(2) = ER INDX(1) = I ENDIF C ... Back X(I) = XI - .5D0 * STEPL H = X(I) - XI IF (H .EQ. 0D0) RETURN CALL FDF(N,X,G1,F1,GRAD,GRSTEP,RHO) AB = (F1 - F)/H ER = AB - G(I) IF (ABS(ER) .GT. ABS(DIFF(3))) THEN DIFF(3) = ER INDX(2) = I ENDIF C ... Extrapolated AE = (2D0*AB + AF)/3D0 ER = AE - G(I) IF (ABS(ER) .GT. ABS(DIFF(4))) THEN DIFF(4) = ER INDX(3) = I ENDIF C ... Restore x(i) X(I) = XI 30 CONTINUE FAIL = 0 RETURN ************************** end of CHKDFN **************************** END c$$$ c$$$ SUBROUTINE PRVCTR(NAME,X,I1,I2,UNT) c$$$************************************************************************ c$$$* Print on UNT elements I1 to I2 of X with name NAME c$$$* Hans Bruun Nielsen, Numerisk Institut, DTH. 89.09.28. c$$$************************************************************************ c$$$* Modified for printing in R. Stig B. Mortensen, Dec. 2008. c$$$************************************************************************ c$$$ c$$$ IMPLICIT NONE c$$$ CHARACTER*3 NAME c$$$ INTEGER I1,I2,J,J1,J2 c$$$ DOUBLE PRECISION X(*) c$$$ CHARACTER UNT*80 c$$$ EXTERNAL DBLEPR c$$$C c$$$ J2 = I1 - 1 c$$$ 10 IF (J2 .GE. I2) RETURN c$$$ J1 = J2 + 1 c$$$ J2 = J2 + 5 c$$$ IF (J2 .GT. I2) J2 = I2 c$$$ WRITE(UNT,'(1X,A,A,I3,A,I3,A,T18,1P1D10.3,1P4D12.3)') c$$$ / NAME,'(',J1,'..',J2,') =',(X(J), J=J1,J2) c$$$ CALL DBLEPR (UNT, -1, X(1), 0) c$$$ GOTO 10 c$$$************************** end of PRVCTR **************************** c$$$ END c$$$ c ------------------------------------------------------------------------------ SUBROUTINE FDF(N, X, G, F, GRAD, GRSTEP, RHO) IMPLICIT NONE INTEGER N, GRAD, RHO(*) DOUBLE PRECISION X(N), G(N), F, GRSTEP(2) CALL FUNC(N, X, F, RHO) IF(GRAD==0) THEN CALL USRGR(N, X, G, RHO) ELSE CALL GR(N, X, F, G, GRAD, GRSTEP, RHO) ENDIF END c ------------------------------------------------------------------------------ c$$$ SUBROUTINE FUNC(N, X, VALUE) c$$$ IMPLICIT NONE c$$$ INTEGER N c$$$ DOUBLE PRECISION X(N), VALUE c$$$ CALL CFUNC(N, X, VALUE) c$$$ END c$$$ c$$$ SUBROUTINE USRGR(N, X, G) c$$$ IMPLICIT NONE c$$$ INTEGER N c$$$ DOUBLE PRECISION X(N), G(N) c$$$ CALL CGRAD(N, X, G) c$$$ END SUBROUTINE GR(N, X, F, G, GRAD, GRSTEP, RHO) IMPLICIT NONE INTEGER N,I,J, GRAD, RHO(*) LOGICAL FWDIFF DOUBLE PRECISION X(N), G(N), F, DX, X2(N), F2, F3, GRSTEP(2) INTRINSIC ABS !---- FLAG FOR FORWARD OR CENTRAL DIFF FWDIFF = (GRAD==1) DO I=1,N DO J=1,N X2(J) = X(J) ENDDO DX = ABS(X2(I)) * GRSTEP(1) + GRSTEP(2) X2(I) = X2(I) + DX CALL FUNC(N, X2, F2, RHO) IF(FWDIFF) THEN G(I) = (F2-F)/DX ELSE X2(I) = X2(I) - 2*DX CALL FUNC(N, X2, F3, RHO) G(I) = (F2-F3)/(2*DX) ENDIF ENDDO END ucminf/src/init.c0000644000176200001440000000060514433165326013441 0ustar liggesusers#include #include #include // for NULL #include /* .Call calls */ extern SEXP mfopt(SEXP rho); static const R_CallMethodDef CallEntries[] = { {"mfopt", (DL_FUNC) &mfopt, 1}, {NULL, NULL, 0} }; void R_init_ucminf(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, TRUE); } ucminf/src/Makevars0000644000176200001440000000005614433165326014026 0ustar liggesusersPKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) ucminf/src/interface.c0000644000176200001440000001020114535562705014434 0ustar liggesusers/* Stig Bousgaard Mortensen DTU Informatics sbm@imm.dtu.dk Based on R-package 'FortranCallsR' by Diethelm Wuertz, ETH Zurich, www.rmetrics.org Modifications by Douglas Bates , Nov. 2010 Modifications by Tomas Kalibera Aug. 2016. Modifications by K Hervé Dakpo Dec. 2023. */ #include #include //R internal structures #include //F77_CALL etc. // Declare FORTRAN routine for use in C extern void F77_NAME(ucminf)(int*, double[], double*, double[], int*,double[],int*,int*,int*,double[],SEXP); /*------------------------------------------------------------------------------- Define C functions that calls user defined function in R */ void installPar(int nn, double x[], SEXP rho) { int i; SEXP PAR = findVarInFrame(rho, install(".x")); double *xpt = REAL(PAR); if (LENGTH(PAR) != nn) error("Dimension mismatch, length(.x) = %d != n = %d", LENGTH(PAR), nn); for (i = 0; i < nn; i++) xpt[i] = x[i] ; } void F77_SUB(func)(int *n, double x[], double *value, SEXP rho) { installPar(*n, x, rho); SEXP dotf = findVarInFrame(rho, install(".f")); PROTECT(dotf); *value = asReal(PROTECT(eval(dotf, rho))) ; UNPROTECT(2); } void F77_SUB(usrgr)(int *n, double x[], double grval[], SEXP rho) { SEXP OUT; int i, nn = *n; double *grv; installPar(nn, x, rho); SEXP dotgr = PROTECT(findVarInFrame(rho, install(".gr"))); PROTECT(OUT = eval(dotgr, rho)); if (LENGTH(OUT) != nn || !isReal(OUT)) error("gradient evaluation must return a numeric vector of length %d", nn); grv = REAL(OUT); for (i = 0; i < nn; i++) grval[i] = grv[i]; UNPROTECT(2) ; } /*-------------------------------------------------------------------------------- Define C function to be called from R */ SEXP mfopt(SEXP rho) { int n = asInteger(PROTECT(findVarInFrame(rho, install( ".n")))), iw = asInteger(PROTECT(findVarInFrame(rho, install( ".iw")))), grad = asInteger(PROTECT(findVarInFrame(rho, install( ".grad")))); UNPROTECT(3); SEXP EPS = PROTECT(findVarInFrame(rho, install( ".eps"))), GRSTEP = PROTECT(findVarInFrame(rho, install(".grstep"))), PAR = PROTECT(findVarInFrame(rho, install( ".par"))), icontr = PROTECT(findVarInFrame(rho, install(".icontr"))), maxfun = PROTECT(findVarInFrame(rho, install(".maxfun"))), dx = PROTECT(findVarInFrame(rho, install(".stepmax"))), W = PROTECT(findVarInFrame(rho, install( ".w"))); if (LENGTH(EPS) < 2 || !isReal(EPS)) error(".eps must be a numeric vector of length >= 2"); if (LENGTH(GRSTEP) < 2 || !isReal(GRSTEP)) error(".eps must be a numeric vector of length >= 2"); if (LENGTH(PAR) != n || !isReal(PAR)) error("Dimension mismatch, length(.par) = %d != n = %d", LENGTH(PAR), n); if (LENGTH(W) != iw || !isReal(W)) error("Dimension mismatch, length(.w) = %d != .iw = %d", LENGTH(W), iw); // duplicate dx, maxfun, .w because they are input/output arguments maxfun = PROTECT(duplicate(maxfun)); defineVar(install(".maxfun"), maxfun, rho); dx = PROTECT(duplicate(dx)); defineVar(install(".stepmax"), dx, rho); W = PROTECT(duplicate(W)); defineVar(install(".w"), W, rho); UNPROTECT(3); // now protected via rho // Call the FORTRAN routine 'ucminf' F77_CALL(ucminf)(&n, REAL(PAR), REAL(dx), REAL(EPS), INTEGER(maxfun), REAL(W), &iw, INTEGER(icontr), &grad, REAL(GRSTEP), rho) ; UNPROTECT(7); return R_NilValue; } void F77_SUB(prtrac)(int *neval, double *fx, double *nmg, int *n, double x[]) { int i, nn = *n; Rprintf(" neval = %3d, F(x) =%11.4e, max|g(x)| =%11.4e\n", *neval, *fx, *nmg); Rprintf(" x =%11.4e", x[0]); for (i = 1; i < nn; i++) Rprintf(",%11.4e", x[i]); Rprintf("\n"); } void F77_SUB(prline)(double *a, double sl[]) { Rprintf(" Line search: alpha =%11.4e, dphi(0) =%11.4e, dphi(1) =%11.4e\n", *a, sl[0], sl[1]); } void F77_SUB(prconv)(void) { Rprintf(" Optimization has converged\n"); } void F77_SUB(prfail)(int *neval) { Rprintf(" Optimization stopped after %d function evaluations\n", *neval); } ucminf/R/0000755000176200001440000000000014433630027011736 5ustar liggesusersucminf/R/ucminf-package.R0000644000176200001440000000304114433637310014733 0ustar liggesusers################################################################################ # # # ucminf package doc # # # ################################################################################ #------------------------------------------------------------------------------# # ucminf package overview # # Algorithms: quasi-Newton type + # # BFGS updating of the inverse Hessian + # # soft line search with a trust region # #------------------------------------------------------------------------------# #' ucminf: General-Purpose Unconstrained Non-Linear Optimization #' #' The \pkg{ucminf} package provides an algorithm for general-purpose #' unconstrained non-linear optimization. #' #' @name ucminf-package #' #' @aliases ucminf-package #' #' @docType package #' #' @useDynLib ucminf, mfopt, .registration = TRUE, .fixes = "C_" #' #' @section Bugreport: Any bug or suggestion can be reported using the #' \code{ucminf} tracker facilities at: #' \url{https://github.com/hdakpo/ucminf/issues} #' #' @author K Hervé Dakpo, Hans Bruun Nielsen, and Stig Bousgaard Mortensen #' # @importFrom numDeriv hessian # @importFrom calculus jacobian NULL ucminf/R/ucminf.R0000644000176200001440000003063114433634732013354 0ustar liggesusers################################################################################ # # # R function for the ucminf package # # # ################################################################################ #------------------------------------------------------------------------------# # ucminf: General-Purpose Unconstrained Non-Linear Optimization # #------------------------------------------------------------------------------# #' General-Purpose Unconstrained Non-Linear Optimization #' #' An algorithm for general-purpose unconstrained non-linear optimization. The #' algorithm is of quasi-Newton type with BFGS updating of the inverse #' Hessian and soft line search with a trust region type monitoring of the #' input to the line search algorithm. The interface of \sQuote{ucminf} is #' designed for easy interchange with \sQuote{optim}. #' #' @param par Initial estimate of minimum for \code{fn}. #' @param fn Objective function to be minimized. #' @param gr Gradient of objective function. If \code{NULL} a finite difference #' approximation is used. #' @param ... Optional arguments passed to the objective and gradient functions. #' @param control A list of control parameters. See \sQuote{Details}. #' @param hessian Integer value: \describe{\item{0}{No hessian approximation is #' returned.} \item{1}{Returns a numerical approximation of the Hessian using #' \sQuote{hessian} in the package \sQuote{numDeriv}.} \item{2}{Returns final #' approximation of the inverse Hessian based on the series of BFGS updates #' during optimization.} \item{3}{Same at 2, but will also return the Hessian #' (the inverse of 2).}} If a \code{TRUE} or \code{FALSE} value is given it will #' switch between option 1 or 0. #' #' @details #' The algorithm is documented in (Nielsen, 2000) (see References below) #' together with a comparison to the Fortran subroutine \sQuote{MINF} and the #' Matlab function \sQuote{fminunc}. The implementation of \sQuote{ucminf} in #' \R uses the original Fortran version of the algorithm. #' #' The interface in R is designed so that it is very easy to switch #' between using \sQuote{ucminf} and \sQuote{\link[stats]{optim}}. The #' arguments \code{par}, \code{fn}, \code{gr}, and \code{hessian} #' are all the same (with a few extra options for \code{hessian} in #' \sQuote{ucminf}). The difference is that there is no \code{method} #' argument in \sQuote{ucminf} and that some of the components in the #' \code{control} argument are different due to differences in the algorithms. #' #' The algorithm can be given an initial estimate of the Hessian for the #' optimization and it is possible to get the final approximation of the #' Hessian based on the series of BFGS updates. This extra functionality #' may be useful for optimization in a series of related problems. #' #' The functions \code{fn} and \code{gr} can return \code{Inf} or \code{NaN} #' if the functions cannot be evaluated at the supplied value, but the #' functions must be computable at the initial value. The functions #' are not allowed to return \code{NA}. Any names given to \code{par} will be #' copied to the vectors passed to \code{fn} and \code{gr}. No #' other attributes of \code{par} are copied over. #' #' The \code{control} argument is a list that can supply any of the #' following components: #' \describe{\item{\code{trace}}{If trace is positive then detailed tracing #' information is printed for each iteration.} #' \item{\code{grtol}}{The algorithm stops when #' \eqn{||F'(x)||_\infty \leq }{||F'(x)||_inf <=} grtol, that is when the #' largest absolute value of the gradient is less than grtol. Default value is #' \code{grtol = 1e-6}. } #' \item{\code{xtol}}{The algorithm stops when \eqn{||x-x_p||_2 \leq #' \textrm{xtol}\cdot(\textrm{xtol} + ||x||_2)}{||x-x_p||_2 <= xtol*(xtol + #' ||x||_2)}, where \eqn{x_p} and \eqn{x} are the previous and current estimate #' of the minimizer. Thus the algorithm stops when the last relative step length #' is sufficiently small. Default value is \code{xtol = 1e-12}.} #' \item{\code{stepmax}}{Initial maximal allowed step length (radius of #' trust-region). The value is updated during the optimization. Default value #' is \code{stepmax = 1}.} #' \item{\code{maxeval}}{The maximum number of function evaluations. #' A function evaluation is counted as one evaluation of the objective function #' and of the gradient function. Default value is \code{maxeval = 500}.} #' \item{\code{grad}}{Either \sQuote{forward} or \sQuote{central}. Controls #' the type of finite difference approximation to be used for the gradient if no #' gradient function is given in the input argument \sQuote{gr}. Default value #' is \code{grad = 'forward'}.} #' \item{\code{gradstep}}{Vector of length 2. The step length in finite #' difference approximation for the gradient. Step length is #' \eqn{|x_i|\cdot\textrm{gradstep[1]+gradstep[2]}}{|x_i|*gradstep[1]+ #' gradstep[2]}. Default value is \code{gradstep = c(1e-6, 1e-8)}.} #' \item{\code{invhessian.lt}}{A vector with an initial approximation to the #' lower triangle of the inverse Hessian. If not given, the inverse Hessian is #' initialized as the identity matrix. If \code{H0} is the initial hessian #' matrix then the lower triangle of the inverse of \code{H0} can be found as #' \code{invhessian.lt = solve(H0)[lower.tri(H0,diag=TRUE)]}.}} #' #' @return \code{\link{ucminf}} returns a list of class \code{'ucminf'} #' containing the following elements: #' #' \item{par}{Computed minimizer.} #' \item{value}{Objective function value at computed minimizer.} #' \item{convergence}{Flag for reason of termination: #' \describe{ #' \item{1}{Stopped by small gradient (grtol).} #' \item{2}{Stopped by small step (xtol).} #' \item{3}{Stopped by function evaluation limit (maxeval).} #' \item{4}{Stopped by zero step from line search} #' \item{-2}{Computation did not start: length(par) = 0.} #' \item{-4}{Computation did not start: stepmax is too small.} #' \item{-5}{Computation did not start: grtol or xtol <= 0.} #' \item{-6}{Computation did not start: maxeval <= 0.} #' \item{-7}{Computation did not start: given Hessian not pos. definite.}}} #' \item{message}{String with reason of termination.} #' \item{hessian, invhessian}{Estimate of (inv.) Hessian at computed minimizer. #' The type of estimate is given by the input argument \sQuote{hessian}.} #' \item{invhessian.lt}{The lower triangle of the final approximation to the #' inverse Hessian based on the series of BFGS updates during optimization.} #' \item{info}{Information about the search: #' \describe{ #' \item{maxgradient}{\eqn{||F'(x)||_\infty}{||F'(x)||_inf}, the largest element #' in the absolute value of the gradient at the computed minimizer.} #' \item{laststep}{Length of last step.} #' \item{stepmax}{Final maximal allowed step length.} #' \item{neval}{Number of calls to both objective and gradient function.}}} #' #' @author \sQuote{UCMINF} algorithm design and Fortran code by Hans Bruun #' Nielsen. #' #' K Hervé Dakpo took over maintenance of the package in May. 2023. #' #' Implementation in \R by Stig B. Mortensen, \email{stigbm@gmail.com}. #' #' Modifications by Douglas Bates , Nov. 2010, to #' support nested optimization and correct issues with printing on Windows. #' #' @seealso \code{\link[stats]{optim}}, \code{\link[stats]{nlminb}}, #' \code{\link[stats]{nlm}}. #' #' @references Nielsen, H. B. (2000) \sQuote{UCMINF - An Algorithm For #' Unconstrained, Nonlinear Optimization}, Report IMM-REP-2000-19, Department of #' Mathematical Modelling, Technical University of Denmark. #' \url{http://www.imm.dtu.dk/documents/ftp/tr00/tr19_00.pdf} #' #' The original Fortran source code was found at #' \code{http://www2.imm.dtu.dk/projects/hbn_software/ucminf.f}. #' (That URL is no longer available but archived at #' \url{https://web.archive.org/web/20050418082240/http://www.imm.dtu.dk/~hbn/Software/ucminf.f} #' -- Dr Nielsen passed away in 2015). The code has been slightly modified in #' this package to be suitable for use with \R. #' #' The general structure of the implementation in \R is based on the #' package \sQuote{FortranCallsR} by Diethelm Wuertz. #' #' @keywords optimize nonlinear #' @export #' #' @examples #' ## Rosenbrock Banana function #' fR <- function(x) (1 - x[1])^2 + 100 * (x[2] - x[1]^2)^2 #' gR <- function(x) c(-400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]), #' 200 * (x[2] - x[1] * x[1])) #' # Find minimum and show trace #' ucminf(par = c(2,.5), fn = fR, gr = gR, control = list(trace = 1)) ucminf <- function(par, fn, gr = NULL, ..., control = list(), hessian = 0) { con <- list(trace = 0, grtol = 1e-06, xtol = 1e-12, stepmax = 1, maxeval = 500, grad = "forward", gradstep = c(1e-06, 1e-08), invhessian.lt = NULL) stopifnot(names(control) %in% names(con)) con[names(control)] <- control stopifnot(length(con$gradstep) == 2, con$grad %in% c("forward", "central")) fnstr <- quote(fn(.x, ...)) grstr <- quote(gr(.x, ...)) rho = new.env(parent = environment()) n <- length(par) eps <- c(con$grtol, con$xtol) if (!is.null(gr)) { grad <- 0 } else { grad <- ifelse(con$grad == "forward", 1, 2) } iw <- n * ceiling(max(n + 1, (n + 11)/2)) + 10 w <- rep(0, iw) trace <- con$trace > 0 icontr = 1 + trace + 2 * !is.null(con$invhessian.lt) if (!is.null(con$invhessian.lt)) w[(4 * n + 1):(4 * n + n * (n + 1)/2)] <- con$invhessian.lt par0 <- rep(0, n) for (i in 1:n) par0[i] = par[i] xname <- as.double(rep(0, n)) names(xname) <- names(par) assign(".f", fnstr, envir = rho) assign(".gr", grstr, envir = rho) assign(".n", as.integer(n), envir = rho) assign(".x", xname, envir = rho) assign(".par", as.double(par0), envir = rho) assign(".stepmax", as.double(con$stepmax), envir = rho) assign(".eps", as.double(eps), envir = rho) assign(".maxfun", as.integer(con$maxeval), envir = rho) assign(".w", as.double(w), envir = rho) assign(".iw", as.integer(iw), envir = rho) assign(".icontr", as.integer(icontr), envir = rho) assign(".grad", as.integer(grad), envir = rho) assign(".grstep", as.double(con$gradstep), envir = rho) # .Call(C_mfopt, rho) # W <- get(".w", envir = rho) icontr <- get(".icontr", envir = rho) ans = list(par = get(".par", envir = rho), value = W[1], convergence = icontr, message = switch(as.character(icontr), `1` = "Stopped by small gradient (grtol).", `2` = "Stopped by small step (xtol).", `3` = "Stopped by function evaluation limit (maxeval)", `4` = "Stopped by zero step from line search", `-2` = "Computation did not start: length(par) = 0.", `-4` = "Computation did not start: stepmax is too small.", `-5` = "Computation did not start: grtol or xtol <= 0.", `-6` = "Computation did not start: maxeval <= 0.", `-7` = "Computation did not start: given hessian not pos. definite.", `-8` = "Computation did not start: iw too small.")) if (0 < icontr) { if (hessian == 1) { if (requireNamespace("numDeriv", quietly = TRUE)) { p0 <- ans$par names(p0) <- names(par) ans$hessian <- numDeriv::hessian(fn, p0, method = "Richardson", ...) } else { warning("Skipped hessian estimation - package 'numDeriv' must be installed for hessian option 1") } } if (hessian == 2 | hessian == 3) { logicMat <- (matrix(-(1:n^2), n, n, byrow = TRUE) + matrix(1:n^2, n, n)) <= 0 COV <- matrix(0, n, n) COV[logicMat] <- W[(4 * n + 1):(4 * n + n * (n + 1)/2)] COV <- t(COV) + COV - diag(diag(COV)) ans$invhessian <- COV } if (hessian == 3) ans$hessian <- solve(COV) ans$invhessian.lt <- W[(4 * n + 1):(4 * n + n * (n + 1)/2)] ans$info = c(maxgradient = W[2], laststep = W[3], stepmax = get(".stepmax", envir = rho), neval = get(".maxfun", envir = rho)) } if (trace) { cat(paste(ans$message, "\n")) if (!is.null(ans$info)) print(ans$info) } nm <- names(par) if (!is.null(nm)) { names(ans$par) <- nm if (!is.null(ans$hessian)) colnames(ans$hessian) <- rownames(ans$hessian) <- nm } class(ans) <- "ucminf" return(ans) } ucminf/NEWS.md0000644000176200001440000000044514535564742012653 0ustar liggesusers# ucminf 1.2.1 ## BUG FIXES * Fixed warnings associated with arguments format in interface.c file # ucminf 1.2.0 * Added a `NEWS.md` file to track changes to the package. * Use of roxygen comments to generate package elements * K Hervé Dakpo takes over package maintenance ucminf/MD50000644000176200001440000000107014536372722012054 0ustar liggesuserse6ab7a4fdfa95a2ff1968007d6ad14ce *DESCRIPTION 7f99dd2a7b136e04419ba23efa97ba90 *NAMESPACE 5b2d2d40b7a59e89420216c3879186a3 *NEWS.md 56edc3f7bad68c3d6234d25b3d37250b *R/ucminf-package.R 70232859a288693aae4355afab525ffe *R/ucminf.R a26098afc56f53cf9b5e06a8dc7800ce *README.md 0529c54cfa88a266e514138f6b2f57a4 *man/ucminf-package.Rd b1ccd4ff968b33037be9344af2538e75 *man/ucminf.Rd 3996e7c16bfb96fad295ee425815cb4d *src/Makevars 1c0df5573f64d62f2d23c1a1ffc08dc9 *src/fortran.f 1f2dd1e47092e0a7331856caf66772c0 *src/init.c 95f056798071bc1641911635de174164 *src/interface.c