[Robast-commits] r1026 - in branches/robast-1.1/pkg/RobAStBase: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 23 21:15:17 CEST 2018
Author: ruckdeschel
Date: 2018-07-23 21:15:16 +0200 (Mon, 23 Jul 2018)
New Revision: 1026
Modified:
branches/robast-1.1/pkg/RobAStBase/R/getBiasIC.R
branches/robast-1.1/pkg/RobAStBase/R/getRiskIC.R
branches/robast-1.1/pkg/RobAStBase/R/internalGridHelpers.R
branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R
branches/robast-1.1/pkg/RobAStBase/R/qqplot.R
branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R
branches/robast-1.1/pkg/RobAStBase/inst/NEWS
branches/robast-1.1/pkg/RobAStBase/man/getBiasIC.Rd
branches/robast-1.1/pkg/RobAStBase/man/getRiskIC.Rd
Log:
[RobAStBase] branch 1.1
+ getRiskIC and getBiasIC gain argument withCheck to speed up things if one does not want to call checkIC
+ in kStepEstimator, withCheck is set to FALSE when getRiskIC is called, and makeIC is only called just
before the last update, and, if useLast == TRUE for the last update (of course, only if withMakeIC ==TRUE)
+ in qqplot & returnlevelplot for x = "ANY", y = "kStepEstimate" the weight function needs not to be bounded by 1 (e.g. in case of MBRE),
so the numeric weights are scaled to [0,1] first
+ bugfix: in .preparePanelFirstLast if condition with.automatic.grid was (possibly) vector valued
Modified: branches/robast-1.1/pkg/RobAStBase/R/getBiasIC.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/getBiasIC.R 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/R/getBiasIC.R 2018-07-23 19:15:16 UTC (rev 1026)
@@ -5,7 +5,7 @@
neighbor = "UncondNeighborhood"),
function(IC, neighbor, L2Fam, biastype = symmetricBias(),
normtype = NormType(), tol = .Machine$double.eps^0.25,
- numbeval = 1e5){
+ numbeval = 1e5, withCheck = TRUE){
misF <- FALSE
if(missing(L2Fam)){
@@ -22,12 +22,7 @@
Bias <- .evalBiasIC(IC = IC, neighbor = neighbor, biastype = biastype,
normtype = normtype, x = x, trafo = trafo(L2Fam at param))
- prec <- if(misF) checkIC(IC, out = FALSE) else
- checkIC(IC, L2Fam, out = FALSE)
- if(prec > tol)
- warning("The maximum deviation from the exact IC properties is ", prec,
- "\nThis is larger than the specified 'tol' ",
- "=> the result may be wrong")
+ if(withCheck) if(misF) .checkICWithWarning(IC, tol=tol) else .checkICWithWarning(IC, L2Fam, tol=tol)
return(list(asBias = list(distribution = .getDistr(L2Fam),
neighborhood = neighbor at type, value = Bias)))
})
Modified: branches/robast-1.1/pkg/RobAStBase/R/getRiskIC.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/getRiskIC.R 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/R/getRiskIC.R 2018-07-23 19:15:16 UTC (rev 1026)
@@ -1,3 +1,14 @@
+.checkICWithWarning <- function(IC, L2Fam, tol){
+ if(!missing(L2Fam)){
+ prec <- checkIC(IC, L2Fam, out = FALSE)
+ }else{
+ prec <- checkIC(IC, out = FALSE)
+ }
+ if(prec > tol)
+ warning("The maximum deviation from the exact IC properties is ", prec,
+ "\nThis is larger than the specified 'tol' ",
+ "=> the result may be wrong")
+}
###############################################################################
## asymptotic covariance
###############################################################################
@@ -5,15 +16,15 @@
risk = "asCov",
neighbor = "missing",
L2Fam = "missing"),
- function(IC, risk, tol = .Machine$double.eps^0.25)
+ function(IC, risk, tol = .Machine$double.eps^0.25, withCheck = TRUE)
getRiskIC(IC = IC, risk = risk, L2Fam = eval(IC at CallL2Fam),
- tol = tol))
+ tol = tol, withCheck = withCheck))
setMethod("getRiskIC", signature(IC = "IC",
risk = "asCov",
neighbor = "missing",
L2Fam = "L2ParamFamily"),
- function(IC, risk, L2Fam, tol = .Machine$double.eps^0.25){
+ function(IC, risk, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE){
if(dimension(Domain(IC at Curve[[1]])) != dimension(img(L2Fam at distribution)))
stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
@@ -22,11 +33,7 @@
bias <- E(L2Fam, IC1)
Cov <- E(L2Fam, IC1 %*% t(IC1))
- prec <- checkIC(IC, L2Fam, out = FALSE)
- if(prec > tol)
- warning("The maximum deviation from the exact IC properties is ", prec,
- "\nThis is larger than the specified 'tol' ",
- "=> the result may be wrong")
+ if(withCheck) .checkICWithWarning(IC, L2Fam, tol)
return(list(asCov = list(distribution = .getDistr(L2Fam), value = Cov - bias %*% t(bias))))
})
@@ -38,28 +45,23 @@
risk = "trAsCov",
neighbor = "missing",
L2Fam = "missing"),
- function(IC, risk, tol = .Machine$double.eps^0.25){
+ function(IC, risk, tol = .Machine$double.eps^0.25, withCheck = TRUE){
getRiskIC(IC = IC, risk = risk, L2Fam = eval(IC at CallL2Fam),
- tol = tol)
+ tol = tol, withCheck = withCheck)
})
setMethod("getRiskIC", signature(IC = "IC",
risk = "trAsCov",
neighbor = "missing",
L2Fam = "L2ParamFamily"),
- function(IC, risk, L2Fam, tol = .Machine$double.eps^0.25){
+ function(IC, risk, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE){
if(dimension(Domain(IC at Curve[[1]])) != dimension(img(L2Fam at distribution)))
stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
- trCov <- getRiskIC(IC, risk = asCov(), L2Fam = L2Fam)$asCov
+ trCov <- getRiskIC(IC, risk = asCov(), L2Fam = L2Fam, withCheck = withCheck)$asCov
trCov$value <- sum(diag(as.matrix(trCov$value)))
- prec <- checkIC(IC, L2Fam, out = FALSE)
- if(prec > tol)
- warning("The maximum deviation from the exact IC properties is ", prec,
- "\nThis is larger than the specified 'tol' ",
- "=> the result may be wrong")
-
+ if(withCheck) .checkICWithWarning(IC, L2Fam, tol)
return(list(trAsCov = trCov))
})
@@ -70,18 +72,19 @@
risk = "asBias",
neighbor = "UncondNeighborhood",
L2Fam = "missing"),
- function(IC, risk, neighbor, tol = .Machine$double.eps^0.25){
+ function(IC, risk, neighbor, tol = .Machine$double.eps^0.25, withCheck = TRUE){
getBiasIC(IC = IC, neighbor = neighbor,
- biastype = biastype(risk), normtype = normtype(risk), tol = tol)
+ biastype = biastype(risk), normtype = normtype(risk), tol = tol,
+ withCheck = withCheck)
})
setMethod("getRiskIC", signature(IC = "IC",
risk = "asBias",
neighbor = "UncondNeighborhood",
L2Fam = "L2ParamFamily"),
- function(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25){
+ function(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE){
getBiasIC(IC = IC, neighbor = neighbor, L2Fam = L2Fam,
biastype = biastype(risk), normtype = normtype(risk),
- tol = tol)
+ tol = tol, withCheck = withCheck)
})
###############################################################################
## asymptotic MSE
@@ -90,32 +93,27 @@
risk = "asMSE",
neighbor = "UncondNeighborhood",
L2Fam = "missing"),
- function(IC, risk, neighbor, tol = .Machine$double.eps^0.25){
+ function(IC, risk, neighbor, tol = .Machine$double.eps^0.25, withCheck = TRUE){
L2Fam <- eval(IC at CallL2Fam)
getRiskIC(IC = IC, risk = risk, neighbor = neighbor,
- L2Fam = L2Fam, tol = tol)
+ L2Fam = L2Fam, tol = tol, withCheck = withCheck)
})
setMethod("getRiskIC", signature(IC = "IC",
risk = "asMSE",
neighbor = "UncondNeighborhood",
L2Fam = "L2ParamFamily"),
- function(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25){
+ function(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE){
if(dimension(Domain(IC at Curve[[1]])) != dimension(img(L2Fam at distribution)))
stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
rad <- neighbor at radius
if(rad == Inf) return(Inf)
- trCov <- getRiskIC(IC = IC, risk = trAsCov(), L2Fam = L2Fam)
- Bias <- getRiskIC(IC = IC, risk = asBias(), neighbor = neighbor, L2Fam = L2Fam)
+ trCov <- getRiskIC(IC = IC, risk = trAsCov(), L2Fam = L2Fam, withCheck = FALSE)
+ Bias <- getRiskIC(IC = IC, risk = asBias(), neighbor = neighbor, L2Fam = L2Fam, withCheck = FALSE)
- prec <- checkIC(IC, L2Fam, out = FALSE)
- if(prec > tol)
- warning("The maximum deviation from the exact IC properties is ", prec,
- "\nThis is larger than the specified 'tol' ",
- "=> the result may be wrong")
-
+ if(withCheck) .checkICWithWarning(IC, L2Fam, tol)
nghb <- paste(neighbor at type, "with radius", neighbor at radius)
return(list(asMSE = list(distribution = .getDistr(L2Fam),
Modified: branches/robast-1.1/pkg/RobAStBase/R/internalGridHelpers.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/internalGridHelpers.R 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/R/internalGridHelpers.R 2018-07-23 19:15:16 UTC (rev 1026)
@@ -389,7 +389,7 @@
}
}
- gridS <- if(with.automatic.grid)
+ gridS <- if(any(with.automatic.grid))
substitute({grid <- function(...){}}) else expression({})
pL <- pL.0
Modified: branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R 2018-07-23 19:15:16 UTC (rev 1026)
@@ -106,7 +106,8 @@
### update - function
updateStep <- function(u.theta, theta, IC, L2Fam, Param,
withPreModif = FALSE,
- withPostModif = TRUE, with.u.var = FALSE
+ withPostModif = TRUE, with.u.var = FALSE,
+ oldmodifIC = NULL
){
if(withPreModif){
@@ -119,6 +120,10 @@
.withL2derivDistr = L2Fam at .withEvalL2derivDistr)
# print(L2Fam)
IC <- modifyIC(IC)(L2Fam, IC)
+ if(steps==1L &&withMakeIC){
+ IC <- makeIC(IC, L2Fam)
+ IC at modifyIC <- oldmodifIC
+ }
# print(IC)
}
@@ -233,10 +238,10 @@
rownames(uksteps) <- u.est.names
if(!is(modifyIC(IC), "NULL") ){
for(i in 1:steps){
+ modif.old <- modifyIC(IC)
if(i>1){
IC <- upd$IC
L2Fam <- upd$L2Fam
- modif.old <- modifyIC(IC)
if((i==steps)&&withMakeIC){
IC <- makeIC(IC,L2Fam)
IC at modifyIC <- modif.old
@@ -248,7 +253,7 @@
upd <- updateStep(u.theta,theta,IC, L2Fam, Param,
withPreModif = withPre,
withPostModif = (steps>i) | useLast,
- with.u.var = i==steps)
+ with.u.var = i==steps, oldmodifIC = modif.old)
uksteps[,i] <- u.theta <- upd$u.theta
ksteps[,i] <- theta <- upd$theta
if(withICList)
@@ -271,6 +276,7 @@
tf <- trafo(L2Fam, Param)
Infos <- rbind(Infos, c("kStepEstimator",
"computation of IC, trafo, asvar and asbias via useLast = TRUE"))
+ if(withMakeIC) IC <- makeIC(IC, L2Fam)
}else{
Infos <- rbind(Infos, c("kStepEstimator",
"computation of IC, trafo, asvar and asbias via useLast = FALSE"))
@@ -315,7 +321,7 @@
else
asVar <- Risks(IC)$asCov$value
else
- asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+ asVar <- getRiskIC(IC, risk = asCov(), withCheck = FALSE)$asCov$value
}else asVar <- var0
# print(asVar)
@@ -329,7 +335,7 @@
if(is(IC, "HampIC")){
r <- neighborRadius(IC)
asBias <- r*getRiskIC(IC, risk = asBias(),
- neighbor = neighbor(IC))$asBias$value
+ neighbor = neighbor(IC), withCheck = FALSE)$asBias$value
}else{
asBias <- NULL
}
Modified: branches/robast-1.1/pkg/RobAStBase/R/qqplot.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/qqplot.R 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/R/qqplot.R 2018-07-23 19:15:16 UTC (rev 1026)
@@ -185,6 +185,7 @@
weight(weight(IC))(L.fct(matrix(x))[,,1])
wx <- w.fct(x)
+ if(max(wx)>1) wx <- wx/max(wx)
mcl$order.traf <- function(x) 1/w.fct(x)
cex.lbl <- if(is.null(mcl$cex.lbl)) par("cex") else eval(mcl$cex.lbl)
Modified: branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R 2018-07-23 19:15:16 UTC (rev 1026)
@@ -170,6 +170,7 @@
weight(weight(IC))(L.fct(matrix(x))[,,1])
wx <- w.fct(x)
+ if(max(wx)>1) wx <- wx/max(wx)
mcl$order.traf <- function(x) 1/w.fct(x)
cex.lbl <- if(is.null(mcl$cex.lbl)) par("cex") else eval(mcl$cex.lbl)
Modified: branches/robast-1.1/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/inst/NEWS 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/inst/NEWS 2018-07-23 19:15:16 UTC (rev 1026)
@@ -15,16 +15,23 @@
+ plot-methods now have arguments .nonlb to only plot (but not label) some points
+ plot-methods are vectorized to a higher extent in all arguments
+ plot methods now return an S3 object of class \code{c("plotInfo","DiagnInfo")}, i.e., a list containing the
-information needed to produce the respective plot, which at a later stage could be used by different graphic engines (like, e.g.
-\code{ggplot}) to produce the plot in a different framework. A more detailed description will follow in a subsequent version.
+ information needed to produce the respective plot, which at a later stage could be used by different graphic engines (like, e.g.
+ \code{ggplot}) to produce the plot in a different framework. A more detailed description will follow in a subsequent version.
+ new methods for returnlevelplot for RobModel, InfRobModel, kStepEstimate (as qqplot)
+ unified return values for qqplot
+ oneStepEstimator and kStepEstimator gain an argument withMakeIC
+ optIC gains an argument withMakeIC
+ DESCRIPTION tag SVNRevision changed to VCS/SVNRevision
++ getRiskIC and getBiasIC gain argument withCheck to speed up things if one does not want to call checkIC
++ getRiskIC and getBiasIC gain argument withCheck to speed up things if one does not want to call checkIC
++ in kStepEstimator, withCheck is set to FALSE when getRiskIC is called, and makeIC is only called just
+ before the last update, and, if useLast == TRUE for the last update (of course, only if withMakeIC ==TRUE)
bug fix:
+ slot modifyIC was set to a wrong value in makeIC / former (potential) move was overridden
++ in .preparePanelFirstLast if condition with.automatic.grid was (possibly) vector valued
++ in qqplot & returnlevelplot for x = "ANY", y = "kStepEstimate" the weight function
+ needs not to be bounded by 1 (e.g. in case of MBRE), so the numeric weights are scaled to [0,1] first
under the hood:
+ wherever possible also use q.l internally instead of q to
Modified: branches/robast-1.1/pkg/RobAStBase/man/getBiasIC.Rd
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/man/getBiasIC.Rd 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/man/getBiasIC.Rd 2018-07-23 19:15:16 UTC (rev 1026)
@@ -10,8 +10,9 @@
\usage{
getBiasIC(IC, neighbor, ...)
-\S4method{getBiasIC}{IC,UncondNeighborhood}(IC, neighbor, L2Fam, biastype = symmetricBias(),
- normtype = NormType(), tol = .Machine$double.eps^0.25, numbeval = 1e5)
+\S4method{getBiasIC}{IC,UncondNeighborhood}(IC, neighbor, L2Fam,
+ biastype = symmetricBias(), normtype = NormType(),
+ tol = .Machine$double.eps^0.25, numbeval = 1e5, withCheck = TRUE)
}
\arguments{
\item{IC}{ object of class \code{"InfluenceCurve"} }
@@ -22,6 +23,8 @@
\item{normtype}{object of class \code{"NormType"}}
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{numbeval}{number of evalation points.}
+ \item{withCheck}{logical: should a call to \code{checkIC} be done to
+ check accuracy (defaults to \code{TRUE}).}
}
%\details{}
\value{The bias of the IC is computed.}
Modified: branches/robast-1.1/pkg/RobAStBase/man/getRiskIC.Rd
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/man/getRiskIC.Rd 2018-07-23 12:43:08 UTC (rev 1025)
+++ branches/robast-1.1/pkg/RobAStBase/man/getRiskIC.Rd 2018-07-23 19:15:16 UTC (rev 1026)
@@ -20,21 +20,21 @@
\usage{
getRiskIC(IC, risk, neighbor, L2Fam, ...)
-\S4method{getRiskIC}{IC,asCov,missing,missing}(IC, risk, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,asCov,missing,missing}(IC, risk, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,asCov,missing,L2ParamFamily}(IC, risk, L2Fam, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,asCov,missing,L2ParamFamily}(IC, risk, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,trAsCov,missing,missing}(IC, risk, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,trAsCov,missing,missing}(IC, risk, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,trAsCov,missing,L2ParamFamily}(IC, risk, L2Fam, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,trAsCov,missing,L2ParamFamily}(IC, risk, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,asBias,UncondNeighborhood,missing}(IC, risk, neighbor, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,asBias,UncondNeighborhood,missing}(IC, risk, neighbor, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,asBias,UncondNeighborhood,L2ParamFamily}(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,asBias,UncondNeighborhood,L2ParamFamily}(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,asMSE,UncondNeighborhood,missing}(IC, risk, neighbor, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,asMSE,UncondNeighborhood,missing}(IC, risk, neighbor, tol = .Machine$double.eps^0.25, withCheck = TRUE)
-\S4method{getRiskIC}{IC,asMSE,UncondNeighborhood,L2ParamFamily}(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25)
+\S4method{getRiskIC}{IC,asMSE,UncondNeighborhood,L2ParamFamily}(IC, risk, neighbor, L2Fam, tol = .Machine$double.eps^0.25, withCheck = TRUE)
\S4method{getRiskIC}{TotalVarIC,asUnOvShoot,UncondNeighborhood,missing}(IC, risk, neighbor)
@@ -52,6 +52,8 @@
\item{sampleSize}{ integer: sample size. }
\item{Algo}{ "A" or "B". }
\item{cont}{ "left" or "right". }
+ \item{withCheck}{logical: should a call to \code{checkIC} be done to
+ check accuracy (defaults to \code{TRUE}).}
}
\details{To make sure that the results are valid, it is recommended
to include an additional check of the IC properties of \code{IC}
More information about the Robast-commits
mailing list