[Robast-commits] r633 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobAStRDA/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 14 13:50:49 CET 2013
Author: ruckdeschel
Date: 2013-03-14 13:50:49 +0100 (Thu, 14 Mar 2013)
New Revision: 633
Modified:
branches/robast-0.9/pkg/ROptEst/R/interpolLM.R
branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd
branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd
branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
Log:
grid-construction gains more control over the calls to optIC() and radiusMinimaxIC();
enhance documentaion for RobAStRDA (as package)
Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633)
@@ -1,42 +1,84 @@
-.RMXE.th <- function(th, PFam, modifyfct){
+.RMXE.th <- function(th, PFam, modifyfct, loRad = 0, upRad = Inf, z.start = NULL,
+ A.start = NULL, upper = NULL, lower = NULL,
+ OptOrIter = "iterate", maxiter = 50,
+ tol = .Machine$double.eps^0.4, loRad0 = 1e-3, ...){
PFam <- modifyfct(th,PFam)
IC <- radiusMinimaxIC(L2Fam=PFam, neighbor= ContNeighborhood(),
- risk = asMSE(), verbose = FALSE)
+ risk = asMSE(), verbose = FALSE,
+ loRad = loRad, upRad = upRad, z.start = z.start,
+ A.start = A.start, upper = upper, lower = lower,
+ OptOrIter = OptOrIter, maxiter = maxiter,
+ tol = tol, warn = FALSE,
+ loRad0 = loRad0)
return(c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
A=stand(IC), A.w = stand(weight(IC))))
}
-.MBRE.th <- function(th, PFam, modifyfct){
+.MBRE.th <- function(th, PFam, modifyfct,
+ z.start = NULL, A.start = NULL, upper = 1e4,
+ lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4, ...){
PFam <- modifyfct(th,PFam)
RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = 15))
- IC <- optIC(model = RobM, risk = asBias(), verbose = FALSE)
+ IC <- optIC(model = RobM, risk = asBias(), verbose = FALSE,
+ z.start = z.start, A.start = A.start, upper = upper,
+ lower = lower, OptOrIter = OptOrIter,
+ maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE,
+ .withEvalAsVar = FALSE)
mA <- max(stand(IC))
mAw <- max(stand(weight(IC)))
return(c(b=clip(IC), a=cent(IC), aw=cent(weight(IC)),
A=stand(IC)/mA, Aw=stand(weight(IC))/mAw))
}
-.OMSE.th <- function(th, PFam, modifyfct){
+.OMSE.th <- function(th, PFam, modifyfct, radius = 0.5,
+ z.start = NULL, A.start = NULL, upper = 1e4,
+ lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4, ...){
PFam <- modifyfct(th,PFam)
- RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = .5))
- IC <- optIC(model = RobM, risk = asMSE(), verbose = FALSE)
+ RobM <- InfRobModel(center = PFam,
+ neighbor = ContNeighborhood(radius = radius))
+ IC <- optIC(model = RobM, risk = asMSE(), verbose = FALSE,
+ z.start = z.start, A.start = A.start, upper = upper,
+ lower = lower, OptOrIter = OptOrIter,
+ maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE,
+ .withEvalAsVar = FALSE)
res=c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
A=stand(IC), A.w = stand(weight(IC)))
return(res)
}
-.getLMGrid <- function(thGrid, PFam, optFct = .RMXE.th, modifyfct,
- GridFileName="LMGrid.Rdata", withPrint = FALSE){
+.getLMGrid <- function(thGrid, PFam, optFct = .RMXE.th, modifyfct, radius = 0.5,
+ GridFileName="LMGrid.Rdata", withPrint = FALSE,
+ upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4,
+ loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ withStartLM = TRUE
+ ){
wprint <- function(...){ if (withPrint) print(...)}
thGrid <- unique(sort(thGrid))
itLM <- 0
+ z.start <- NULL
+ A.start <- NULL
getLM <- function(th){
itLM <<- itLM + 1
if(withPrint) cat("Evaluation Nr.", itLM," at th = ",th,"\n")
a <- try(
- optFct(th=th,PFam=PFam,modifyfct=modifyfct) , silent=TRUE)
- if(is(a,"try-error")) a <- rep(NA,13)
+ optFct(th = th, PFam = PFam, modifyfct = modifyfct,
+ z.start = z.start, A.start = A.start,
+ upper = upper, lower = lower, OptOrIter = OptOrIter,
+ maxiter = maxiter, tol = tol,
+ loRad = loRad, upRad = upRad, loRad0 = loRad0),
+ silent=TRUE)
+ if(is(a,"try-error")){ a <- rep(NA,13)}else{
+ if(withStartLM){
+ pdim <- length(a[["a"]])
+ kdim <- length(a[["a.w"]])
+ z.start <<- a[["a.w"]]
+ A.start <<- matrix(a[["A"]],pdim,kdim)
+ }
+ }
return(a)
}
Modified: branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-14 12:50:49 UTC (rev 633)
@@ -20,12 +20,25 @@
\usage{
-.RMXE.th(th, PFam, modifyfct)
-.MBRE.th(th, PFam, modifyfct)
-.OMSE.th(th, PFam, modifyfct)
+.RMXE.th(th, PFam, modifyfct, loRad = 0, upRad = Inf, z.start = NULL,
+ A.start = NULL, upper = NULL, lower = NULL,
+ OptOrIter = "iterate", maxiter = 50,
+ tol = .Machine$double.eps^0.4, loRad0 = 1e-3, ...)
+.MBRE.th(th, PFam, modifyfct,
+ z.start = NULL, A.start = NULL, upper = 1e4,
+ lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4, ...)
+.OMSE.th(th, PFam, modifyfct, radius = 0.5,
+ z.start = NULL, A.start = NULL, upper = 1e4,
+ lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4, ...)
-.getLMGrid(thGrid, PFam, optFct = .RMXE.th, modifyfct,
- GridFileName = "LMGrid.Rdata", withPrint = FALSE)
+.getLMGrid(thGrid, PFam, optFct = .RMXE.th, modifyfct, radius = 0.5,
+ GridFileName = "LMGrid.Rdata", withPrint = FALSE,
+ upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4,
+ loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ withStartLM = TRUE)
.saveGridToCSV(Grid, toFileCSV, namPFam, nameInSysdata)
@@ -46,8 +59,33 @@
\item{modifyfct}{function with arguments \code{th} and \code{PFam} to move
the parametric family to the point of the grid value; returns the
moved parametric family.}
- \item{withSmooth}{logical of length 1: shall a smoothing spline be used?}
- \item{withPrint}{logical of length 1: shall current grid value be printed out?}
+ \item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the
+ neighborhood for which the LM's are to be computed;
+ defaults to 0.5. }
+ \item{loRad}{ the lower end point of the interval to be searched. }
+ \item{upRad}{ the upper end point of the interval to be searched. }
+ \item{z.start}{ initial value for the centering constant. }
+ \item{A.start}{ initial value for the standardizing matrix. }
+ \item{upper}{ upper bound for the optimal clipping bound. }
+ \item{lower}{ lower bound for the optimal clipping bound. }
+ \item{OptOrIter}{character; which method to be used for determining Lagrange
+ multipliers \code{A} and \code{a}: if (partially) matched to \code{"optimize"},
+ \code{getLagrangeMultByOptim} is used; otherwise: by default, or if matched to
+ \code{"iterate"} or to \code{"doubleiterate"},
+ \code{getLagrangeMultByIter} is used. More specifically,
+ when using \code{getLagrangeMultByIter}, and if argument \code{risk} is of
+ class \code{"asGRisk"}, by default and if matched to \code{"iterate"}
+ we use only one (inner) iteration, if matched to \code{"doubleiterate"}
+ we use up to \code{Maxiter} (inner) iterations. }
+ \item{maxiter}{ the maximum number of iterations. }
+ \item{tol}{ the desired accuracy (convergence tolerance).}
+ \item{loRad0}{ for numerical reasons: the effective lower bound for the zero search;
+ internally set to \code{max(loRad,loRad0)}. }
+ \item{\dots}{ additional parameters. }
+ \item{withStartLM}{ logical of length 1: shall the LM's of the preceding grid
+ value serve as starting value for the next grid value? }
+ \item{withSmooth}{logical of length 1: shall a smoothing spline be used? }
+ \item{withPrint}{logical of length 1: shall current grid value be printed out? }
\item{thGrid}{numeric; grid values. }
\item{optFct}{function with arguments \code{theta}, \code{PFam},
and modifyfct; determines the Lagrange multipliers. }
@@ -68,7 +106,7 @@
}
\details{
\code{.MBRE.th} computes the Lagrange multipliers for the MBRE estimator,
- \code{.OMSE.th} for the OMSE estimator at radius \code{r=0.5},
+ \code{.OMSE.th} for the OMSE estimator at radius \code{radius},
and \code{.RMXE.th} the RMXE estimator.
\code{.getLMGrid} in a large loop computes the Lagrange multipliers for
Modified: branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd
===================================================================
--- branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd 2013-03-14 12:50:49 UTC (rev 633)
@@ -7,15 +7,23 @@
}
\description{
This package only contains sysdata.rda (with corresponding interpolation grids
-for speedup); it is currently used in package RobExtremes.
-The code to produce its contents can be drawn from CRAN-packages
-ROptEst and RobExtremes, more specifically: see ?.RMXE.xi (RobExtremes)
-resp. ?.RMXE.th (ROptEst), as well as the contents of the (system) folder
+for speedup); it is currently used in package \pkg{RobExtremes}.
+The code to produce its contents is split into two parts: (a) grid construction
+and (b) interpolator construction. While the code for (a) can be drawn from
+CRAN-packages \pkg{ROptEst} and \pkg{RobExtremes}, more specifically:
+see \code{?.RMXE.xi} (\pkg{RobExtremes}) resp. \code{?.RMXE.th} (\pkg{ROptEst}),
+as well as the contents of the (system) folder
of package RobExtremes, i.e.,
- dir(file.path(system.file(package="RobExtremes"),"AddMaterial","interpolation"))
+ \code{dir(file.path(system.file(package="RobExtremes"),"AddMaterial","interpolation"))},
+the code for (b) resides in the present package (and does not need to know anything
+about the grid construction). As it is not meant for users but rather for
+developers, it is not exported to the namespace; still, it is documented,
+see \code{?.generateInterpolators}.
The reason to separate the rda file from the actual R packages is to
-keep the latter small while we expect this package to only need seldom updates.
+keep the latter small while we expect the present package to only need
+seldom updates.
+
See also mail exchange P.Ruckdeschel - U.Ligges on R-devel---
\url{https://stat.ethz.ch/pipermail/r-devel/2013-February/065794.html}.
}
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633)
@@ -33,7 +33,11 @@
.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
#.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(5, cutoff.at.0=0.005),
- PFam = GParetoFamily(shape=1,scale=2)){
+ PFam = GParetoFamily(shape=1,scale=2), radius = 0.5,
+ upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
+ maxiter = 50, tol = .Machine$double.eps^0.4,
+ loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ withStartLM = TRUE){
namF <- gsub("\\.th$","",paste(deparse(substitute(optF))))
namF <- gsub("^\\.(.+)","\\1",namF)
to <- gsub("XXXX",gsub(" ","",name(PFam)),
@@ -43,7 +47,10 @@
PFam = PFam, toFileCSV = to,
getFun = ROptEst:::.getLMGrid,
modifyfct = .modify.xi.PFam.call, optFct = optF,
- nameInSysdata = namF, withPrint = TRUE)
+ nameInSysdata = namF, withPrint = TRUE, radius = radius,
+ upper = upper, lower = lower, OptOrIter = OptOrIter,
+ maxiter = maxiter, tol = tol, loRad = loRad, upRad = upRad,
+ loRad0 = loRad0, withStartLM = withStartLM)
}
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-14 12:50:49 UTC (rev 633)
@@ -1,7 +1,7 @@
-getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast"){
+getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast", withPrint=FALSE){
## Gridnam in (Sn,OMSE,RMXE,MBRE)
## Famnam in "Generalized Pareto Family",
- ## "Generalized Extreme Value Family with positive shape parameter: Frechet Family",
+ ## "GEV Family",
## "Gamma family",
## "Weibull Family"
## xi Scaleparameter (can be vector)
@@ -12,17 +12,20 @@
load(file, envir=nE)
Gnams <- c("Sn","OMSE","RMXE","MBRE")
Fnams <- c("Generalized Pareto Family",
- "Generalized Extreme Value Family with positive shape parameter: Frechet Family",
+ "GEV Family",
"Gamma family",
"Weibull Family")
if(! Gridnam %in% Gnams) stop("Falscher Gittername")
if(! Famnam %in% Fnams) stop("Falscher Familienname")
+ Famnam0 <- gsub(" ","",Famnam)
isSn <- (Gridnam == "Sn")
GN0 <- Gridnam; if(isSn) GN0 <- "SnGrids"
- GN <- paste(".",GN0,".",if(getRversion()<"2.16") "O" else "N", sep="")
- fct <- get(GN,envir=nE)[[Famnam]]$fct
+ GN <- paste(".",GN0, sep="")
+ funN <- paste("fun",".",if(getRversion()<"2.16") "O" else "N",sep="")
+ if(withPrint) print(c(GN, Famnam0, funN))
+ fct <- get(GN,envir=nE)[[Famnam0]][[funN]]
- if(!isSn)){
+ if(!isSn){
## für Gridnam != Sn ist LM für jeden xi Wert ein Vektor der Länge 13, genauer
# in 1:13 (clip=b, cent.a=a1.a,a2.a, cent.i=a1.i,a2.i,
## stand.a=A.a=matrix(c(A11.a,(A12.a+A21.a)/2,
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-14 12:50:49 UTC (rev 633)
@@ -1,7 +1,8 @@
-plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast"){
+plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast",
+ withSmooth=FALSE, gridRestriction = NULL, prehook={}, posthook={}, ...){
## Gridnam in (Sn,OMSE,RMXE,MBRE)
## Famnam in "Generalized Pareto Family",
- ## "Generalized Extreme Value Family with positive shape parameter: Frechet Family",
+ ## "GEV Family",
## "Gamma family",
## "Weibull Family"
## whichLM ignoriert für Gridnam == Sn
@@ -12,24 +13,58 @@
# (A12.i+A21.i)/2,A.22.i), 2, 2),
## und optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.*
## basedir: Oberverzeichnis des r-forge svn checkouts
- file <- file.path(baseDir, "branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda")
+ file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda")
if(!file.exists(file)) stop("Fehler mit Checkout")
nE <- new.env()
load(file, envir=nE)
Gnams <- c("Sn","OMSE","RMXE","MBRE")
Fnams <- c("Generalized Pareto Family",
- "Generalized Extreme Value Family with positive shape parameter: Frechet Family",
+ "GEV Family",
"Gamma family",
"Weibull Family")
+ Gridnam <- Gnams[pmatch(Gridnam, Gnams)]
+ Famnam <- Fnams[pmatch(Famnam, Fnams)]
if(! Gridnam %in% Gnams) stop("Falscher Gittername")
if(! Famnam %in% Fnams) stop("Falscher Familienname")
isSn <- (Gridnam == "Sn")
+ Famnam0 <- gsub(" ","",Famnam)
GN0 <- Gridnam; if(isSn) GN0 <- "SnGrids"
- GN <- paste(".",GN0,".",if(getRversion()<"2.16") "O" else "N", sep="")
- gr <- get(GN,envir=nE)[[Famnam]]$grid
-
- if(!isSn) if(whichLM<1 | whichLM>13) stop("Falsche Koordinate")
+ GN <- paste(".",GN0,sep="")
+ funN <- paste("fun",".",if(getRversion()<"2.16") "O" else "N",sep="")
+ gN <- if(withSmooth) "gridS" else "grid"
+ gr <- get(GN,envir=nE)[[Famnam0]][[gN]]
+ if(is.null(gridRestriction)) gridRestriction <- rep(TRUE, nrow(gr))
+ if(!isSn) if(whichLM!="all") if(whichLM<1 | whichLM>13) stop("Falsche Koordinate")
+ if(!isSn) if(whichLM=="all"){
+ eval(prehook)
+ par(mfrow=c(4,4))
+ for(i in 2:14)
+ plot(gr[gridRestriction,1], gr[gridRestriction,i], ...)
+ par(mfrow=c(1,1))
+ eval(posthook)
+ return(invisible(NULL))
+ }
if(isSn) whichLM <- 1
wM <- whichLM + 1
- plot(gr[,1], gr[,wm])
+ eval(prehook)
+ plot(gr[gridRestriction,1], gr[gridRestriction,wM], ...)
+ eval(posthook)
+ return(invisible(NULL))
}
+
+if(FALSE){
+## Examples
+plotLM("OMSE","Gamma","all", type="l", gridR=-(1:20))
+plotLM("OMSE","Pareto","all", type="l", gridR=-(1:20))
+plotLM("OMSE","Gener","all", type="l", gridR=-(1:20))
+plotLM("OMSE","GEV","all", type="l", gridR=-(1:20))
+plotLM("OMSE","Wei","all", type="l", gridR=-(1:20))
+plotLM("MBRE","Wei","all", type="l", gridR=-(1:20))
+plotLM("MBRE","GE","all", type="l", gridR=-(1:20))
+plotLM("MBRE","Gene","all", type="l", gridR=-(1:20))
+plotLM("MBRE","Gam","all", type="l", gridR=-(1:20))
+plotLM("RMXE","Gam","all", type="l", gridR=-(1:20))
+plotLM("RMXE","Wei","all", type="l", gridR=-(1:20))
+plotLM("RMXE","Gene","all", type="l", gridR=-(1:20))
+plotLM("RMXE","GE","all", type="l", gridR=-(1:20))
+}
\ No newline at end of file
Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-13 17:38:23 UTC (rev 632)
+++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-14 12:50:49 UTC (rev 633)
@@ -33,7 +33,10 @@
optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE)
.svInt(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
- PFam = GParetoFamily(shape=1,scale=2))
+ PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, upper = 1e4,
+ lower = 1e-4, OptOrIter = "iterate", maxiter = 50,
+ tol = .Machine$double.eps^0.4, loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ withStartLM = TRUE)
.generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
PFam = GParetoFamily(), withPrint = TRUE)
@@ -60,6 +63,26 @@
\item{GridFileName}{character; if \code{GridFileName!=""}, the pure
y-grid values are saved under this filename. }
\item{withPrint}{logical of length 1: shall current shape value be printed out?}
+ \item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the
+ neighborhood for which the LM's are to be computed;
+ defaults to 0.5. }
+ \item{loRad}{ the lower end point of the interval to be searched. }
+ \item{upRad}{ the upper end point of the interval to be searched. }
+ \item{upper}{ upper bound for the optimal clipping bound. }
+ \item{lower}{ lower bound for the optimal clipping bound. }
+ \item{OptOrIter}{character; which method to be used for determining Lagrange
+ multipliers \code{A} and \code{a}: if (partially) matched to \code{"optimize"},
+ \code{getLagrangeMultByOptim} is used; otherwise: by default, or if matched to
+ \code{"iterate"} or to \code{"doubleiterate"},
+ \code{getLagrangeMultByIter} is used. More specifically,
+ when using \code{getLagrangeMultByIter}, and if argument \code{risk} is of
+ class \code{"asGRisk"}, by default and if matched to \code{"iterate"}
+ we use only one (inner) iteration, if matched to \code{"doubleiterate"}
+ we use up to \code{Maxiter} (inner) iterations. }
+ \item{loRad0}{ for numerical reasons: the effective lower bound for the zero search;
+ internally set to \code{max(loRad,loRad0)}. }
+ \item{withStartLM}{ logical of length 1: shall the LM's of the preceding grid
+ value serve as starting value for the next grid value? }
}
\details{
\code{.getpsi} reads the respective interpolating function
More information about the Robast-commits
mailing list