R/stepchk.R In fda: Functional Data Analysis

Defines functions stepchk

stepchk <- function(oldstep, cvec, deltac, limwrd, ind,
climit=50*c(-rep(1,ncvec), rep(1,ncvec)),
active=1:ncvec, dbgwrd){
# last changed 2007 or 2008 by Spencer Graves
#  check the step size to keep parameters within boundaries
ncvec   <- length(deltac)
bot     <- climit[1:ncvec]
top     <- climit[ncvec+(1:ncvec)]
limflg  <- FALSE
newstep <- oldstep
stepi   <- oldstep*deltac
stepmin <- min(stepi)
index   <- stepi[active] == stepmin
#  ensure that step does not go beyond lower limit on parameters
if (any(stepi[index] < bot[index]-cvec[index]) &
any(deltac[index] != 0) )  {
anew <- min((bot[index]-cvec[index])/deltac[index])
if (dbgwrd) {
print("Lower limit reached ... new step:")
cat(c(stepi, round(c(oldstep, anew),4)),"\n")
cat(round(cvec + anew*deltac,4),"\n")
}
newstep <- anew
limflg <- TRUE
}
#  ensure that step does not go beyond upper limit on parameters
stepi   <- oldstep*deltac
stepmax <- max(stepi)
index   <- stepi[active] == stepmax
if (any(stepi[index] > top[index]-cvec[index]) &
any(deltac[index] != 0) ) {
anew <- min((top[index]-cvec[index])/deltac[index])
if (dbgwrd) {
print("Upper limit reached ... new step:")
cat(c(stepi, round(c(oldstep, anew),4)),"\n")
}
newstep <- anew
limflg <- TRUE
}
#  check whether lower limit has been reached twice in a row
if (limflg) {
if (limwrd[1]) ind <- 1 else limwrd <- TRUE
} else limwrd <- FALSE
return(list(newstep, ind, limwrd))
}

Try the fda package in your browser

Any scripts or data that you put into this service are public.

fda documentation built on May 2, 2019, 5:12 p.m.