[Robast-commits] r1020 - in branches/robast-1.1/pkg/ROptEst: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 22 18:48:54 CEST 2018
Author: ruckdeschel
Date: 2018-07-22 18:48:53 +0200 (Sun, 22 Jul 2018)
New Revision: 1020
Modified:
branches/robast-1.1/pkg/ROptEst/R/cniperCont.R
branches/robast-1.1/pkg/ROptEst/R/getStartIC.R
branches/robast-1.1/pkg/ROptEst/R/internal.roptest.R
branches/robast-1.1/pkg/ROptEst/R/optIC.R
branches/robast-1.1/pkg/ROptEst/R/plotWrapper.R
branches/robast-1.1/pkg/ROptEst/R/roptest.new.R
branches/robast-1.1/pkg/ROptEst/man/cniperCont.Rd
branches/robast-1.1/pkg/ROptEst/man/getStartIC-methods.Rd
branches/robast-1.1/pkg/ROptEst/man/inputGenerator.Rd
branches/robast-1.1/pkg/ROptEst/man/optIC.Rd
Log:
[ROptEst] branch 1.1
+ optIC gains argument withMakeIC
+ roptest gains argument withMakeIC
+ getStartIC-methods gain argument withMakeIC
+ cniperPointPlot gains argument withMakeIC
+ genkStepCtrl gains argument withMakeIC
Modified: branches/robast-1.1/pkg/ROptEst/R/cniperCont.R
===================================================================
--- branches/robast-1.1/pkg/ROptEst/R/cniperCont.R 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/R/cniperCont.R 2018-07-22 16:48:53 UTC (rev 1020)
@@ -427,7 +427,7 @@
lab.pts = NULL, lab.font = NULL, alpha.trsp = NA,
which.lbs = NULL, which.nonlbs = NULL,
which.Order = NULL, attr.pre = FALSE, return.Order = FALSE,
- withSubst = TRUE){
+ withSubst = TRUE, withMakeIC = FALSE){
args0 <- list(L2Fam = L2Fam, data=data,
neighbor = if(missing(neighbor)) NULL else neighbor,
@@ -451,7 +451,8 @@
alpha.trsp = alpha.trsp,
which.lbs = which.lbs, which.Order = which.Order,
which.nonlbs = which.nonlbs, attr.pre = attr.pre,
- return.Order = return.Order, withSubst = withSubst)
+ return.Order = return.Order, withSubst = withSubst,
+ withMakeIC = withMakeIC)
mc0 <- match.call(#call = sys.call(sys.parent(1)),
expand.dots = FALSE)
@@ -483,9 +484,9 @@
robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
- mcl$IC1 <- optIC(model = L2Fam, risk = asCov())
+ mcl$IC1 <- optIC(model = L2Fam, risk = asCov(), withMakeIC = withMakeIC)
mcl$IC2 <- if(is(risk,"interpolRisk")){
- getStartIC(model=L2Fam, risk = risk)
+ getStartIC(model=L2Fam, risk = risk, withMakeIC = withMakeIC)
}else optIC(model = robMod, risk = risk)
mcl$L2Fam <- NULL
if(is.null(dots$ylab))
Modified: branches/robast-1.1/pkg/ROptEst/R/getStartIC.R
===================================================================
--- branches/robast-1.1/pkg/ROptEst/R/getStartIC.R 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/R/getStartIC.R 2018-07-22 16:48:53 UTC (rev 1020)
@@ -2,7 +2,8 @@
function(model, risk, ...) stop("not yet implemented"))
setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asGRisk"),
- function(model, risk, ..., withEvalAsVar = TRUE, ..debug=FALSE){
+ function(model, risk, ..., withEvalAsVar = TRUE, withMakeIC = FALSE,
+ ..debug=FALSE){
mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1)))
dots <- as.list(mc$"...")
if("fsCor" %in% names(dots)){
@@ -32,6 +33,7 @@
dots.optic$model <- NULL
dots.optic$risk <- NULL
dots.optic$.withEvalAsVar <- withEvalAsVar
+ dots.optic$withMakeIC <- withMakeIC
if(is.null(eps[["e"]])){
dots.rmx$loRad <- eps$sqn * eps$lower
@@ -59,15 +61,15 @@
})
setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asCov"),
- function(model, risk, ..., ..debug=FALSE){
- return(optIC(model, risk))
+ function(model, risk, ..., withMakeIC = FALSE, ..debug=FALSE){
+ return(optIC(model, risk, withMakeIC = withMakeIC))
})
setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "trAsCov"),
getMethod("getStartIC", signature(model = "L2ParamFamily", risk = "asCov"))
)
setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asBias"),
- function(model, risk, ..., ..debug=FALSE){
+ function(model, risk, ..., withMakeIC = FALSE, ..debug=FALSE){
mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1)))
dots <- as.list(mc$"...")
if("neighbor" %in% names(dots)){
@@ -76,7 +78,7 @@
}else neighbor <- ContNeighborhood()
infMod <- InfRobModel(center = model, neighbor = neighbor)
- return(optIC(infMod, risk))
+ return(optIC(infMod, risk, withMakeIC = withMakeIC))
})
Modified: branches/robast-1.1/pkg/ROptEst/R/internal.roptest.R
===================================================================
--- branches/robast-1.1/pkg/ROptEst/R/internal.roptest.R 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/R/internal.roptest.R 2018-07-22 16:48:53 UTC (rev 1020)
@@ -215,7 +215,7 @@
withICList = getRobAStBaseOption("withICList"),
withPICList = getRobAStBaseOption("withPICList"),
scalename = "scale", withLogScale = TRUE,
- withEvalAsVar = NULL){
+ withEvalAsVar = NULL, withMakeIC = FALSE){
es.call <- match.call()
es.list <- as.list(es.call[-1])
es.list <- .fix.in.defaults(es.list,genkStepCtrl)
Modified: branches/robast-1.1/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-1.1/pkg/ROptEst/R/optIC.R 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/R/optIC.R 2018-07-22 16:48:53 UTC (rev 1020)
@@ -6,7 +6,7 @@
lower = 1e-4, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4,
warn = TRUE, noLow = FALSE, verbose = NULL, ...,
- .withEvalAsVar = TRUE, returnNAifProblem = FALSE){
+ .withEvalAsVar = TRUE, withMakeIC = FALSE, returnNAifProblem = FALSE){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
L2derivDim <- numberOfMaps(model at center@L2deriv)
@@ -71,6 +71,7 @@
}
}
#IC.o <- moveICBackFromRefParam(IC.o,L2Fam)
+ if(withMakeIC) IC.o <- makeIC(IC.o, model)
return(IC.o)
})
@@ -80,13 +81,13 @@
###############################################################################
setMethod("optIC", signature(model = "InfRobModel", risk = "asUnOvShoot"),
function(model, risk, upper = 1e4, lower = 1e-4, maxiter = 50,
- tol = .Machine$double.eps^0.4, warn = TRUE, verbose = NULL){
+ tol = .Machine$double.eps^0.4, withMakeIC = FALSE, warn = TRUE, verbose = NULL){
L2derivDistr <- model at center@L2derivDistr[[1]]
ow <- options("warn")
on.exit(options(ow))
if((length(model at center@L2derivDistr) == 1) & is(L2derivDistr, "UnivariateDistribution")){
if(identical(all.equal(model at neighbor@radius, 0), TRUE)){
- return(optIC(model at center, risk = asCov()))
+ return(optIC(model at center, risk = asCov(), withMakeIC = withMakeIC))
}else{
options(warn = -1)
res <- getInfRobIC(L2deriv = L2derivDistr,
@@ -102,7 +103,9 @@
res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
neighbor = model at neighbor,
risk = risk, verbose = verbose))
- return(generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res))
+ IC.o <- generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res)
+ if(withMakeIC) IC.o <- makeIC(IC.o, model)
+ return(IC.o)
}
}else{
stop("restricted to 1-dimensional parameteric models")
@@ -115,7 +118,7 @@
###############################################################################
setMethod("optIC", signature(model = "FixRobModel", risk = "fiUnOvShoot"),
function(model, risk, sampleSize, upper = 1e4, lower = 1e-4, maxiter = 50,
- tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A",
+ tol = .Machine$double.eps^0.4, withMakeIC = FALSE, warn = TRUE, Algo = "A",
cont = "left", verbose = NULL){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
@@ -137,7 +140,9 @@
res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
neighbor = model at neighbor,
risk = risk, verbose = verbose))
- return(generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res))
+ IC.o <- generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res)
+ if(withMakeIC) IC.o <- makeIC(IC.o, model)
+ return(IC.o)
}else{
stop("restricted to 1-dimensional parametric models")
}
Modified: branches/robast-1.1/pkg/ROptEst/R/plotWrapper.R
===================================================================
--- branches/robast-1.1/pkg/ROptEst/R/plotWrapper.R 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/R/plotWrapper.R 2018-07-22 16:48:53 UTC (rev 1020)
@@ -111,6 +111,7 @@
,ylab=substitute("Asymptotic Risk difference (classic - robust)")
,bty = substitute("o")
,withSubst = TRUE
+ ,withMakeIC = FALSE
), scaleList)
# print(argsList)
##parameter for plotting
Modified: branches/robast-1.1/pkg/ROptEst/R/roptest.new.R
===================================================================
--- branches/robast-1.1/pkg/ROptEst/R/roptest.new.R 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/R/roptest.new.R 2018-07-22 16:48:53 UTC (rev 1020)
@@ -88,7 +88,7 @@
na.rm = TRUE, initial.est.ArgList, ...,
withLogScale = TRUE,..withCheck=FALSE,
withTimings = FALSE, withMDE = NULL,
- withEvalAsVar = NULL){
+ withEvalAsVar = NULL, withMakeIC = FALSE){
mc <- match.call(expand.dots=FALSE)
dots <- mc[["..."]]
scalename <- dots[["scalename"]]
@@ -115,6 +115,7 @@
kStepCtrl[["scalename"]] <- if(!is.null(scalename)) scalename else "scale"
kStepCtrl[["withLogScale"]] <- if(!missing(withLogScale)) withLogScale else TRUE
kStepCtrl[["withEvalAsVar"]] <- if(!missing(withEvalAsVar)) withEvalAsVar else NULL
+ kStepCtrl[["withMakeIC"]] <- if(!missing(withMakeIC)) withMakeIC else FALSE
retV <- robest(x=x, L2Fam=L2Fam, fsCor = fsCor,
risk = risk, steps = steps, verbose = verbose,
@@ -169,6 +170,8 @@
withEvalAsVar <- kStepCtrl$withEvalAsVar
if(is.null(withEvalAsVar)) withEvalAsVar <- L2Fam at .withEvalAsVar
+ withMakeIC <- kStepCtrl$MakeIC
+ if(is.null(withMakeIC)) withMakeIC <- FALSE
es.list <- as.list(es.call0[-1])
@@ -279,7 +282,8 @@
es.list0$fsCor <- eval(es.list0$fsCor)
if(debug) {cat("\n\n\n::::\n\n")
- argList <- c(list(model=L2Fam,risk=risk,neighbor=neighbor),
+ argList <- c(list(model=L2Fam,risk=risk,neighbor=neighbor,
+ withEvalAsVar = withEvalAsVar, withMakeIC = withMakeIC),
es.list0)
print(argList)
cat("\n\n\n")
@@ -287,7 +291,8 @@
if(!debug){
sy.getStartIC <- system.time({
ICstart <- do.call(getStartIC, args=c(list(model=L2FamStart,risk=risk,
- neighbor=neighbor, withEvalAsVar = withEvalAsVar),
+ neighbor=neighbor, withEvalAsVar = withEvalAsVar,
+ withMakeIC = withMakeIC),
es.list0))
})
if (withTimings) print(sy.getStartIC)
@@ -305,7 +310,8 @@
na.rm = na.rm,
scalename = kStepCtrl$scalename,
withLogScale = kStepCtrl$withLogScale,
- withEvalAsVar = withEvalAsVar)
+ withEvalAsVar = withEvalAsVar,
+ withMakeIC = withMakeIC)
print(argList) }
sy.kStep <- system.time({
res <- kStepEstimator(x, IC = ICstart, start = initial.est, steps = steps,
@@ -317,7 +323,8 @@
na.rm = na.rm,
scalename = kStepCtrl$scalename,
withLogScale = kStepCtrl$withLogScale,
- withEvalAsVar = withEvalAsVar)
+ withEvalAsVar = withEvalAsVar,
+ withMakeIC = withMakeIC)
})
if (withTimings) print(sy.kStep)
Modified: branches/robast-1.1/pkg/ROptEst/man/cniperCont.Rd
===================================================================
--- branches/robast-1.1/pkg/ROptEst/man/cniperCont.Rd 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/man/cniperCont.Rd 2018-07-22 16:48:53 UTC (rev 1020)
@@ -42,7 +42,7 @@
lab.pts = NULL, lab.font = NULL, alpha.trsp = NA,
which.lbs = NULL, which.nonlbs = NULL,
which.Order = NULL, attr.pre = FALSE, return.Order = FALSE,
- withSubst = TRUE)
+ withSubst = TRUE, withMakeIC = FALSE)
}
\arguments{
\item{IC1}{ object of class \code{IC} }
@@ -150,6 +150,8 @@
otherwise we return \code{invisible()} as usual.}
\item{withSubst}{logical; if \code{TRUE} (default) pattern substitution for
titles and lables is used; otherwise no substitution is used. }
+ \item{withMakeIC}{logical; if \code{TRUE} the [p]IC is passed through
+ \code{makeIC} before return.}
}
\details{
In case of \code{cniperCont} the difference between the risks of two ICs
Modified: branches/robast-1.1/pkg/ROptEst/man/getStartIC-methods.Rd
===================================================================
--- branches/robast-1.1/pkg/ROptEst/man/getStartIC-methods.Rd 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/man/getStartIC-methods.Rd 2018-07-22 16:48:53 UTC (rev 1020)
@@ -16,10 +16,10 @@
\usage{getStartIC(model, risk, ...)
\S4method{getStartIC}{ANY,ANY}(model, risk, ...)
\S4method{getStartIC}{L2ParamFamily,asGRisk}(model, risk, ...,
- withEvalAsVar = TRUE,..debug=FALSE)
-\S4method{getStartIC}{L2ParamFamily,asBias}(model, risk, ..., ..debug=FALSE)
-\S4method{getStartIC}{L2ParamFamily,asCov}(model, risk, ..., ..debug=FALSE)
-\S4method{getStartIC}{L2ParamFamily,trAsCov}(model, risk, ..., ..debug=FALSE)
+ withEvalAsVar = TRUE, withMakeIC = FALSE, ..debug=FALSE)
+\S4method{getStartIC}{L2ParamFamily,asBias}(model, risk, ..., withMakeIC = FALSE, ..debug=FALSE)
+\S4method{getStartIC}{L2ParamFamily,asCov}(model, risk, ..., withMakeIC = FALSE, ..debug=FALSE)
+\S4method{getStartIC}{L2ParamFamily,trAsCov}(model, risk, ..., withMakeIC = FALSE, ..debug=FALSE)
}
\arguments{
@@ -29,6 +29,8 @@
\item{withEvalAsVar}{logical (of length 1):
if \code{TRUE}, risks based on covariances are to be
evaluated (default), otherwise just a call is returned.}
+ \item{withMakeIC}{logical; if \code{TRUE} the IC is passed through
+ \code{makeIC} before return.}
\item{..debug}{logical; if \code{TRUE} information for debugging is issued.}
}
\section{Methods}{\describe{
Modified: branches/robast-1.1/pkg/ROptEst/man/inputGenerator.Rd
===================================================================
--- branches/robast-1.1/pkg/ROptEst/man/inputGenerator.Rd 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/man/inputGenerator.Rd 2018-07-22 16:48:53 UTC (rev 1020)
@@ -14,7 +14,7 @@
withICList = getRobAStBaseOption("withICList"),
withPICList = getRobAStBaseOption("withPICList"),
scalename = "scale", withLogScale = TRUE,
- withEvalAsVar = NULL)
+ withEvalAsVar = NULL, withMakeIC = FALSE)
genstartCtrl(initial.est = NULL, initial.est.ArgList = NULL,
startPar = NULL, distance = CvMDist, withMDE = NULL)
gennbCtrl(neighbor = ContNeighborhood(), eps, eps.lower, eps.upper)
@@ -41,7 +41,8 @@
to do so. If \code{withEvalAsVar} is \code{NULL} (default), the content
of slot \code{.withEvalAsVar} in the L2 family is used instead to take
this decision.}
-
+ \item{withMakeIC}{logical; if \code{TRUE} the [p]IC is passed through
+ \code{makeIC} before return.}
\item{initial.est}{ initial estimate for unknown parameter. If missing
minimum distance estimator is computed. }
\item{initial.est.ArgList}{a list of arguments to be given to argument \code{start} if the latter
Modified: branches/robast-1.1/pkg/ROptEst/man/optIC.Rd
===================================================================
--- branches/robast-1.1/pkg/ROptEst/man/optIC.Rd 2018-07-22 16:43:20 UTC (rev 1019)
+++ branches/robast-1.1/pkg/ROptEst/man/optIC.Rd 2018-07-22 16:48:53 UTC (rev 1020)
@@ -17,17 +17,19 @@
OptOrIter = "iterate", maxiter = 50,
tol = .Machine$double.eps^0.4, warn = TRUE,
noLow = FALSE, verbose = NULL, ...,
- .withEvalAsVar = TRUE,
+ .withEvalAsVar = TRUE, withMakeIC = FALSE,
returnNAifProblem = FALSE)
\S4method{optIC}{InfRobModel,asUnOvShoot}(model, risk, upper = 1e4,
lower = 1e-4, maxiter = 50,
- tol = .Machine$double.eps^0.4, warn = TRUE,
+ tol = .Machine$double.eps^0.4,
+ withMakeIC = FALSE, warn = TRUE,
verbose = NULL)
\S4method{optIC}{FixRobModel,fiUnOvShoot}(model, risk, sampleSize, upper = 1e4, lower = 1e-4,
maxiter = 50, tol = .Machine$double.eps^0.4,
- warn = TRUE, Algo = "A", cont = "left",
+ withMakeIC = FALSE, warn = TRUE,
+ Algo = "A", cont = "left",
verbose = NULL)
}
\arguments{
@@ -58,6 +60,8 @@
\item{.withEvalAsVar}{logical (of length 1):
if \code{TRUE}, risks based on covariances are to be
evaluated (default), otherwise just a call is returned. }
+ \item{withMakeIC}{logical; if \code{TRUE} the [p]IC is passed through
+ \code{makeIC} before return.}
\item{returnNAifProblem}{logical (of length 1):
if \code{TRUE} (not the default), in case of convergence problems in
the algorithm, returns \code{NA}. }
More information about the Robast-commits
mailing list