Skip to contents

This is the implementation of a Broyden Fletcher Goldfarb Shanno (BFGS) method for nonlinear minimization with box constraints.

Usage

bfgsb_min(f_name, f_options, x0, l, u, options = list())

Arguments

f_name

A function name (as a text string) that returns an objective function and the gradient of that objective function, in that order. See calc_ofv_and_grad as used in Doptim.

f_options

Options for the f_name argument.

x0

the initial values to optimize

l

the lower bounds

u

the upper bounds

options

a list of additional settings arguments

Value

A list containing:

x_k

The objective function.

f_k

The gradient.

B_k

The hessian.

Examples

library(PopED)

############# START #################
## Create PopED database
## (warfarin model for optimization)
#####################################

## Warfarin example from software comparison in:
## Nyberg et al., "Methods and software tools for design evaluation 
##   for population pharmacokinetics-pharmacodynamics studies", 
##   Br. J. Clin. Pharm., 2014. 

## Optimization using an additive + proportional reidual error  
## to avoid sample times at very low concentrations (time 0 or very late samples).

## find the parameters that are needed to define from the structural model
ff.PK.1.comp.oral.sd.CL
#> function (model_switch, xt, parameters, poped.db) 
#> {
#>     with(as.list(parameters), {
#>         y = xt
#>         y = (DOSE * Favail * KA/(V * (KA - CL/V))) * (exp(-CL/V * 
#>             xt) - exp(-KA * xt))
#>         return(list(y = y, poped.db = poped.db))
#>     })
#> }
#> <bytecode: 0x557079188b38>
#> <environment: namespace:PopED>

## -- parameter definition function 
## -- names match parameters in function ff
sfg <- function(x,a,bpop,b,bocc){
  parameters=c(CL=bpop[1]*exp(b[1]),
               V=bpop[2]*exp(b[2]),
               KA=bpop[3]*exp(b[3]),
               Favail=bpop[4],
               DOSE=a[1])
  return(parameters) 
}

## -- Define initial design  and design space
poped.db <- create.poped.database(ff_fun=ff.PK.1.comp.oral.sd.CL,
                                  fg_fun=sfg,
                                  fError_fun=feps.add.prop,
                                  bpop=c(CL=0.15, V=8, KA=1.0, Favail=1), 
                                  notfixed_bpop=c(1,1,1,0),
                                  d=c(CL=0.07, V=0.02, KA=0.6), 
                                  sigma=c(prop=0.01,add=0.25),
                                  groupsize=32,
                                  xt=c( 0.5,1,2,6,24,36,72,120),
                                  minxt=0.01,
                                  maxxt=120,
                                  a=c(DOSE=70),
                                  mina=c(DOSE=0.01),
                                  maxa=c(DOSE=100))

############# END ###################
## Create PopED database
## (warfarin model for optimization)
#####################################


if (FALSE) { # \dontrun{  
  
  # BFGS search, DOSE and sample time optimization
  bfgs.output <- poped_optimize(poped.db,opt_xt=1,opt_a=0,
                                bUseRandomSearch= 0,
                                bUseStochasticGradient = 0,
                                bUseBFGSMinimizer = 1,
                                bUseLineSearch = 0)
  
  f_name <- 'calc_ofv_and_grad' 
  gen_des <- downsizing_general_design(poped.db)
  
  aa <- 0*poped.db$settings$cfaa*matrix(1,poped.db$design$m,size(poped.db$design$a,2))
  axt=1*poped.db$settings$cfaxt*matrix(1,poped.db$design$m,max(poped.db$design_space$maxni))
  
  f_options_1 <- list(gen_des$x,1, 0, gen_des$model_switch,
                    aa=aa,axt=axt,poped.db$design$groupsize,
                    gen_des$ni,
                    gen_des$xt,gen_des$x,gen_des$a,gen_des$bpop[,2,drop=F],
                    getfulld(gen_des$d[,2,drop=F],poped.db$parameters$covd),
                    poped.db$parameters$sigma,
                    getfulld(poped.db$parameters$docc[,2,drop=F],
                             poped.db$parameters$covdocc),poped.db)
  
  options=list('factr'=poped.db$settings$BFGSConvergenceCriteriaMinStep,
               #'factr'=0.01,
               'pgtol'=poped.db$settings$BFGSProjectedGradientTol,
               'ftol'=poped.db$settings$BFGSTolerancef,
               'gtol'=poped.db$settings$BFGSToleranceg,
               'xtol'=poped.db$settings$BFGSTolerancex)
  
  x_k=t(gen_des$xt)
  lb=t(gen_des$minxt)
  ub=t(gen_des$maxxt)
  
  output <- bfgsb_min(f_name,f_options, x_k,lb,ub,options) 
  
} # }