smooth.profile: Smooth existing profiles

In GabelHub/ProfileIroning: Calculates Likelihood Profiles And Smooths Them

Description

Smooths existing profiles by refitting bad estimates. To this end, smooth.profile checks for neighbouring points that have an unusual large difference in log-likelihood and spikes, i.e. points that have higher values than both of the neighbouring points

Usage

smooth.profile(which.par, fit.fn, threshold = "auto", spike.min = 0.01,
  do.not.fit = NULL, homedir = getwd(), optim.runs = 5,
  random.borders = 1, con.tol = 0.1, control.optim = list(maxit =
  1000), parscale.pars = TRUE, save.rel.diff = 0, future.off = F,
  ...)

Arguments

which.par	A vector containing the names of all parameters for which the respective profiles should be smoothed. Alternatively, supplying "all.par" smooths all existing profiles.
fit.fn	A cost function. Has to take the complete parameter vector as an input (needs to be names parms) and must return the corresponding negative log-likelihood (-2LL, see Burnham and Anderson 2002).
threshold	A numeric value determining the minimal difference between two neighbouring points that leads to refitting. Alternatively, threshold can be set to "auto" (default), which chooses a minimal difference automatically (this is calculated by dividing the difference between maximal and minimal values by the number of profile points).
spike.min	A numeric value determining the minimal difference for detecting spikes. Default to 0.01.
do.not.fit	The names of the parameter that are not to be fitted. Can only be supplied if a single profile is smoothed
homedir	The directory to which the results should be saved to. Default to getwd().
optim.runs	The number of times that each model will be fitted by optim. Default to 5.
random.borders	The ranges from which the random initial parameter conditions for all optim.runs larger than one are sampled. Can be either given as a vector containing the relative deviations for all parameters or as a matrix containing in its first column the lower and in its second column the upper border values. Parameters are uniformly sampled based on runif. Default to 1 (100% deviation of all parameters). Alternatively, functions such as rnorm, rchisq, etc. can be used if the additional arguments are passed along as well.
con.tol	The absolute convergence tolerance of each fitting run (see Details). Default is set to 0.1.
control.optim	Control parameters passed along to optim. For more details, see optim.
parscale.pars	Logical. If TRUE (default), the parscale option will be used when fitting with optim. This is helpful, if the parameter values are on different scales.
save.rel.diff	A numeric value indicating a relative threshold when to overwrite a pre-existing result. Default to 0, which means that results get overwritten if an improvement is made.
future.off	Logical. If TRUE, future will not be used to calculate the results. Default to FALSE.
...	Additional parameters that can be passed along to future or fit.fn.

Value

NULL. Saves the refitted profiles in the folder "Profiles-Result/Tables/".

Examples

#create data with standard deviation of 1
x.values <- 1:7
y.values <-  9 * x.values^2 - exp(2 * x.values)
sd.y.values <- rep(1,7)

#define initial parameter values
inits <- c(p1 = 3, p2 = 4, p3 = -2, p4 = 2, p5 = 0)

#define cost function that returns the negative log-likelihood
cost_function <- function(parms, x.vals, y.vals, sd.y){
  # restrict the search range to -5 to +5
  if(max(abs(parms)) > 5){
    return(NA)
  }
  with(as.list(c(parms)), {
    res <- p1*4 + p2*x.vals + p3^2*x.vals^2 + p4*sin(x.vals)  - exp(p5*x.vals)
    diff <- sum((res - y.vals)^2/sd.y)
  })
}

#create profiles
res <- create.profile(which.par = "p1",
                      par.names = inits,
                      range = list(seq(0, 2, 0.2)),
                      fit.fn = cost_function,
                      homedir = getwd(),
                      delete.old = TRUE,
                      x.vals = x.values,
                      y.vals = y.values,
                      sd.y = sd.y.values)

#add noise to profile
res[,1] <-  res[,1] + runif(n = nrow(res), min = 0, max = 5)
saveRDS(res, paste0(getwd(), "/Profile-Results/Tables/p1.rds"))

#smooth profile
smooth.profile(which.par = "p1",
               fit.fn = cost_function,
               homedir = getwd(),
               optim.runs = 1,
               x.vals = x.values,
               y.vals = y.values,
               sd.y = sd.y.values)

GabelHub/ProfileIroning documentation built on May 17, 2019, 12:49 p.m.