[Robast-commits] r1103 - in branches/robast-1.2/pkg/ROptEst: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 6 14:57:21 CEST 2018
Author: ruckdeschel
Date: 2018-08-06 14:57:20 +0200 (Mon, 06 Aug 2018)
New Revision: 1103
Modified:
branches/robast-1.2/pkg/ROptEst/DESCRIPTION
branches/robast-1.2/pkg/ROptEst/NAMESPACE
branches/robast-1.2/pkg/ROptEst/R/comparePlot.R
branches/robast-1.2/pkg/ROptEst/R/getStartIC.R
branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R
branches/robast-1.2/pkg/ROptEst/R/roptest.new.R
branches/robast-1.2/pkg/ROptEst/man/getStartIC-methods.Rd
Log:
[ROptEst] branch 1.2: this was harder than thought:
+ require more recent versions in DESCRIPTION
+ L2LocationFamily, L2LocationScaleFamily, and L2LocationScaleFamily gain methods for interpolRisk
~> speed up is prepared (only need to store the reference LMs in sysdata.rda)
=> due to affine equivariance, we only have to store one set of LM's
+ comparePlot has a try catch now for MBRE
+ some buglets in getStartIC
+ some tedious debugging in getStartIClcsc.R
+ clarified if clauses in roptest.new (and removed .with.checkEstClassForParamFamily from dots to be sure)
Modified: branches/robast-1.2/pkg/ROptEst/DESCRIPTION
===================================================================
--- branches/robast-1.2/pkg/ROptEst/DESCRIPTION 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/DESCRIPTION 2018-08-06 12:57:20 UTC (rev 1103)
@@ -4,8 +4,8 @@
Title: Optimally Robust Estimation
Description: Optimally robust estimation in general smoothly parameterized models using S4
classes and methods.
-Depends: R(>= 2.14.0), methods, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2),
- RandVar(>= 0.9.2), RobAStBase(>= 1.0)
+Depends: R(>= 2.14.0), methods, distr(>= 2.7.0), distrEx(>= 2.8.0), distrMod(>= 2.8.0),
+ RandVar(>= 1.1.0), RobAStBase(>= 1.2.0)
Imports: startupmsg, MASS, stats, graphics, utils, grDevices
Suggests: RobLox
Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph"),
Modified: branches/robast-1.2/pkg/ROptEst/NAMESPACE
===================================================================
--- branches/robast-1.2/pkg/ROptEst/NAMESPACE 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/NAMESPACE 2018-08-06 12:57:20 UTC (rev 1103)
@@ -11,7 +11,8 @@
"title")
importFrom("stats", "complete.cases", "dnorm", "na.omit", "optim",
"optimize", "pnorm", "qnorm", "uniroot")
-importFrom("utils", "read.csv", "read.table", "str", "write.table")
+importFrom("utils", "read.csv", "read.table", "str", "write.table",
+ "getFromNamespace")
importFrom("graphics", "abline")
importFrom("MASS", "ginv")
Modified: branches/robast-1.2/pkg/ROptEst/R/comparePlot.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/comparePlot.R 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/R/comparePlot.R 2018-08-06 12:57:20 UTC (rev 1103)
@@ -74,7 +74,7 @@
MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T)
if(withMBR && all(is.na(MBRB))){
ICmbr <- try(getStartIC(model = L2Fam, risk = MBRRisk()), silent=TRUE)
- if(is(ICmbr),"try-error"){
+ if(is(ICmbr,"try-error")){
robModel <- InfRobModel(center = L2Fam, neighbor =
ContNeighborhood(radius = 0.5))
ICmbr <- try(optIC(model = robModel, risk = asBias()), silent=TRUE)
Modified: branches/robast-1.2/pkg/ROptEst/R/getStartIC.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/getStartIC.R 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/R/getStartIC.R 2018-08-06 12:57:20 UTC (rev 1103)
@@ -13,6 +13,7 @@
}else fsCor <- 1
if("eps" %in% names(dots)){
eps <- dots[["eps"]]
+ names(eps) <- gsub("eps\\.","",names(eps))
dots$eps <- NULL
}else eps <- NULL
if("neighbor" %in% names(dots)){
@@ -20,6 +21,7 @@
dots$neighbor <- NULL
}else neighbor <- ContNeighborhood()
+# cat("......\n");print(eps);cat(":......\n")
if(is.null(eps[["e"]])){
sm.rmx <- selectMethod("radiusMinimaxIC", signature(
@@ -82,13 +84,19 @@
mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1)))
dots <- as.list(mc$"...")
+ #print(mc)
+ #print(dots)
+
if("neighbor" %in% names(dots)){
neighbor <- eval(dots[["neighbor"]])
dots$neighbor <- NULL
}else neighbor <- ContNeighborhood()
+
if("warn" %in% names(dots)) dots$warn <- NULL
infMod <- InfRobModel(center = model, neighbor = neighbor)
+ #print(list(c(list(infMod, risk), dots, list(warn = FALSE,
+ # withMakeIC = withMakeIC, modifyICwarn = modifyICwarn))))
return(do.call(optIC, c(list(infMod, risk), dots, list(warn = FALSE,
withMakeIC = withMakeIC, modifyICwarn = modifyICwarn)),
envir=parent.frame(2)))
Modified: branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R 2018-08-06 12:57:20 UTC (rev 1103)
@@ -2,7 +2,7 @@
setMethod("getStartIC",signature(model = "L2LocationFamily", risk = "interpolRisk"),
function(model, risk, ...) .getStIC(model, risk, ..., intfct=.getPsi.loc, pkg="ROptEst"))
-setMethod("getStartIC",signature(model = "L2LocationFamily", risk = "interpolRisk"),
+setMethod("getStartIC",signature(model = "L2ScaleFamily", risk = "interpolRisk"),
function(model, risk, ...) .getStIC(model, risk, ..., intfct=.getPsi.sca, pkg="ROptEst"))
setMethod("getStartIC",signature(model = "L2LocationScaleFamily", risk = "interpolRisk"),
@@ -10,8 +10,8 @@
.getStIC <- function(model,risk, ..., intfct, pkg="ROptEst"){
- mc <- match.call(call = sys.call(sys.parent(2)))
- dots <- match.call(call = sys.call(sys.parent(2)),
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
gridn <- gsub("\\.","",type(risk))
@@ -44,9 +44,22 @@
return(IC0)
}
}
- IC <- do.call(getStartIC, as.list(mc[-1]), envir=parent.frame(2))
- mc$risk <- if(type(risk)==".MBRE") asMSE() else asBias()
- mc$neighbor <- ContNeighborhood(radius=0.5)
+ mc1 <- as.list(mc)[-1]
+ mc1[["risk"]] <- if(type(risk)==".MBRE") asBias() else asMSE()
+ mc1[["neighbor"]] <- ContNeighborhood(radius=0.5)
+ mc1[["verbose"]] <- FALSE
+ if(type(risk)==".MBRE") mc1[["eps"]] <- list(e=40)
+ if(type(risk)==".OMSE"){
+ n <- length(get("x", envir=parent.frame(2)))
+ eps <- list("e" =0.5/sqrt(n), "sqn"= sqrt(n))
+ mc1[["eps"]] <- eps
+ }
+ if(type(risk)==".RMXE"){
+ n <- length(get("x", envir=parent.frame(2)))
+ eps <- list("eps.lower"=0, "eps.upper"=20, "sqn"= sqrt(n))
+ mc1[["eps"]] <- eps
+ }
+ IC <- do.call(getStartIC, mc1, envir=parent.frame(2))
return(IC)
}
Modified: branches/robast-1.2/pkg/ROptEst/R/roptest.new.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/roptest.new.R 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/R/roptest.new.R 2018-08-06 12:57:20 UTC (rev 1103)
@@ -220,6 +220,7 @@
.isOKsteps(steps)
+ dots$.with.checkEstClassForParamFamily <- NULL
if(debug){
if(is.null(startCtrl$initial.est)){
print(substitute(MDEstimator(x = x0, ParamFamily = L2Fam0,
@@ -235,13 +236,16 @@
L2Fam at startPar else startCtrl$startPar
wMDE <- if(is.null(startCtrl$withMDE))
L2Fam at .withMDE else startCtrl$withMDE
- if(is(startPar0, "function")) if(!wMDE){
- startCtrl$initial.est <- function(x,...)startPar0(x)
- }else
- startCtrl$initial.est <- MDEstimator(x = x, ParamFamily = L2Fam,
- distance = startCtrl$distance,
- startPar = startCtrl$startPar, ...)
-
+ if(is(startPar0, "function") && (!wMDE)){
+ startCtrl$initial.est <- function(x,...)startPar0(x)
+ }else{
+ if(is(startPar0, "function")) startPar0 <- startPar0(x)
+ argListMDE <- c(list(x = x, ParamFamily = L2Fam,
+ distance = startCtrl$distance,
+ startPar = startPar0), dots,
+ list(.with.checkEstClassForParamFamily = FALSE))
+ startCtrl$initial.est <- do.call(MDEstimator, argListMDE)
+ }
}
}
nrvalues <- length(L2Fam at param)
Modified: branches/robast-1.2/pkg/ROptEst/man/getStartIC-methods.Rd
===================================================================
--- branches/robast-1.2/pkg/ROptEst/man/getStartIC-methods.Rd 2018-08-06 12:48:26 UTC (rev 1102)
+++ branches/robast-1.2/pkg/ROptEst/man/getStartIC-methods.Rd 2018-08-06 12:57:20 UTC (rev 1103)
@@ -8,6 +8,9 @@
\alias{getStartIC,L2ParamFamily,asCov-method}
\alias{getStartIC,L2ParamFamily,asAnscombe-method}
\alias{getStartIC,L2ParamFamily,trAsCov-method}
+\alias{getStartIC,L2LocationFamily,interpolRisk-method}
+\alias{getStartIC,L2ScaleFamily,interpolRisk-method}
+\alias{getStartIC,L2LocationScaleFamily,interpolRisk-method}
\title{Methods for Function getStartIC in Package `ROptEst' }
@@ -28,6 +31,9 @@
\S4method{getStartIC}{L2ParamFamily,asAnscombe}(model, risk, ...,
withEvalAsVar = TRUE, withMakeIC = FALSE, ..debug=FALSE,
modifyICwarn = NULL)
+\S4method{getStartIC}{L2LocationFamily,interpolRisk}(model, risk, ...)
+\S4method{getStartIC}{L2ScaleFamily,interpolRisk}(model, risk, ...)
+\S4method{getStartIC}{L2LocationScaleFamily,interpolRisk}(model, risk, ...)
}
\arguments{
More information about the Robast-commits
mailing list