[Robast-commits] r694 - branches/robast-0.9/pkg/RandVar branches/robast-0.9/pkg/RobAStBase pkg pkg/ROptEst pkg/ROptEst/R pkg/ROptEst/inst pkg/ROptEst/inst/scripts pkg/ROptEst/man pkg/RandVar pkg/RandVar/man pkg/RobAStBase pkg/RobAStBase/man pkg/RobAStRDA pkg/RobAStRDA/R pkg/RobAStRDA/inst pkg/RobAStRDA/inst/AddMaterial pkg/RobAStRDA/inst/AddMaterial/interpolation pkg/RobAStRDA/man pkg/RobExtremes pkg/RobExtremes/R pkg/RobExtremes/inst pkg/RobExtremes/inst/AddMaterial pkg/RobExtremes/inst/AddMaterial/interpolation pkg/RobExtremes/inst/scripts pkg/RobExtremes/inst/unitTests pkg/RobExtremes/man pkg/RobExtremes/src pkg/RobExtremes/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 11 19:32:41 CEST 2013
Author: ruckdeschel
Date: 2013-09-11 19:32:41 +0200 (Wed, 11 Sep 2013)
New Revision: 694
Added:
pkg/ROptEst/.Rbuildignore
pkg/ROptEst/R/00internal.R
pkg/ROptEst/R/AllPlot.R
pkg/ROptEst/R/comparePlot.R
pkg/ROptEst/R/getInfRad.R
pkg/ROptEst/R/getRadius.R
pkg/ROptEst/R/getRiskBV.R
pkg/ROptEst/R/getStartIC.R
pkg/ROptEst/R/internal.roptest.R
pkg/ROptEst/R/interpolLM.R
pkg/ROptEst/R/plotWrapper.R
pkg/ROptEst/R/roptest.new.R
pkg/ROptEst/R/versionSuff.R
pkg/ROptEst/man/CniperPointPlotWrapper.Rd
pkg/ROptEst/man/comparePlot.Rd
pkg/ROptEst/man/getInfRad.Rd
pkg/ROptEst/man/getRadius.Rd
pkg/ROptEst/man/getRiskFctBV-methods.Rd
pkg/ROptEst/man/getStartIC-methods.Rd
pkg/ROptEst/man/inputGenerator.Rd
pkg/ROptEst/man/internal-interpolate.Rd
pkg/ROptEst/man/internalMBRE.Rd
pkg/ROptEst/man/internalRobestHelpers.Rd
pkg/ROptEst/man/internal_Cniperplots.Rd
pkg/ROptEst/man/plot-methods.Rd
pkg/ROptEst/man/robest.Rd
pkg/RobAStRDA/
pkg/RobAStRDA/.Rbuildignore
pkg/RobAStRDA/DESCRIPTION
pkg/RobAStRDA/NAMESPACE
pkg/RobAStRDA/R/
pkg/RobAStRDA/R/Comment.R
pkg/RobAStRDA/R/interpolAux.R
pkg/RobAStRDA/R/sysdata.rda
pkg/RobAStRDA/inst/
pkg/RobAStRDA/inst/AddMaterial/
pkg/RobAStRDA/inst/AddMaterial/interpolation/
pkg/RobAStRDA/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt
pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R
pkg/RobAStRDA/inst/NEWS
pkg/RobAStRDA/inst/TOBEDONE
pkg/RobAStRDA/man/
pkg/RobAStRDA/man/0RobRDA-package.Rd
pkg/RobAStRDA/man/internal-interpolate.Rd
pkg/RobExtremes/
pkg/RobExtremes/.Rbuildignore
pkg/RobExtremes/DESCRIPTION
pkg/RobExtremes/NAMESPACE
pkg/RobExtremes/R/
pkg/RobExtremes/R/00fromRobAStRDA.R
pkg/RobExtremes/R/AllClass.R
pkg/RobExtremes/R/AllGeneric.R
pkg/RobExtremes/R/AllInitialize.R
pkg/RobExtremes/R/AllShow.R
pkg/RobExtremes/R/Expectation.R
pkg/RobExtremes/R/Functionals.R
pkg/RobExtremes/R/GEV.R
pkg/RobExtremes/R/GEVFamily.R
pkg/RobExtremes/R/GEVFamily.R.bak
pkg/RobExtremes/R/GEVFamilyMuUnknown.R
pkg/RobExtremes/R/GPareto.R
pkg/RobExtremes/R/GParetoFamily.R
pkg/RobExtremes/R/Gumbel.R
pkg/RobExtremes/R/GumbelLocationFamily.R
pkg/RobExtremes/R/Kurtosis.R
pkg/RobExtremes/R/LDEstimator.R
pkg/RobExtremes/R/Pareto.R
pkg/RobExtremes/R/ParetoFamily.R
pkg/RobExtremes/R/PickandsEstimator.R
pkg/RobExtremes/R/QBCC.R
pkg/RobExtremes/R/Skewness.R
pkg/RobExtremes/R/SnQn.R
pkg/RobExtremes/R/WeibullFamily.R
pkg/RobExtremes/R/asvarMedkMAD.R
pkg/RobExtremes/R/asvarPickands.R
pkg/RobExtremes/R/bdpPickands.R
pkg/RobExtremes/R/getStartIC.R
pkg/RobExtremes/R/internal-getpsi.R
pkg/RobExtremes/R/interpolLM.R
pkg/RobExtremes/R/interpolSn.R
pkg/RobExtremes/R/kMAD.R
pkg/RobExtremes/R/move2bckRefParam.R
pkg/RobExtremes/R/plotOutlyingness.R
pkg/RobExtremes/R/rescaleFct.R
pkg/RobExtremes/inst/
pkg/RobExtremes/inst/AddMaterial/
pkg/RobExtremes/inst/AddMaterial/comment.txt
pkg/RobExtremes/inst/AddMaterial/interpolation/
pkg/RobExtremes/inst/AddMaterial/interpolation/SnTest.Rdata
pkg/RobExtremes/inst/AddMaterial/interpolation/Snplot.pdf
pkg/RobExtremes/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt
pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R
pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
pkg/RobExtremes/inst/CITATION
pkg/RobExtremes/inst/NEWS
pkg/RobExtremes/inst/TOBEDONE
pkg/RobExtremes/inst/scripts/
pkg/RobExtremes/inst/scripts/ExamplesForDiagnosticsWrappersWithGEVGPD.R
pkg/RobExtremes/inst/scripts/GumbelLocationModel.R
pkg/RobExtremes/inst/unitTests/
pkg/RobExtremes/inst/unitTests/runit.GEV.R
pkg/RobExtremes/inst/unitTests/runit.GEV_family.R
pkg/RobExtremes/inst/unitTests/runit.GPareto.R
pkg/RobExtremes/inst/unitTests/runit.GPareto_family.R
pkg/RobExtremes/inst/unitTests/runit.Gumbel.R
pkg/RobExtremes/inst/unitTests/runit.Gumbel_location_family.R
pkg/RobExtremes/inst/unitTests/runit.LD_estimator.R
pkg/RobExtremes/inst/unitTests/runit.Pareto.R
pkg/RobExtremes/inst/unitTests/runit.SnQn.R
pkg/RobExtremes/inst/unitTests/runit.expectation.R
pkg/RobExtremes/inst/unitTests/runit.functionals.R
pkg/RobExtremes/inst/unitTests/runit.kMAD.R
pkg/RobExtremes/inst/unitTests/runit.kurtosis.R
pkg/RobExtremes/inst/unitTests/runit.skewness.R
pkg/RobExtremes/man/
pkg/RobExtremes/man/0RobExtremes-package.Rd
pkg/RobExtremes/man/E.Rd
pkg/RobExtremes/man/GEV-class.Rd
pkg/RobExtremes/man/GEV.Rd
pkg/RobExtremes/man/GEVFamily.Rd
pkg/RobExtremes/man/GEVFamilyMuUnknown.Rd
pkg/RobExtremes/man/GEVParameter-class.Rd
pkg/RobExtremes/man/GPareto-class.Rd
pkg/RobExtremes/man/GPareto.Rd
pkg/RobExtremes/man/GParetoFamily.Rd
pkg/RobExtremes/man/GParetoParameter-class.Rd
pkg/RobExtremes/man/Gumbel-class.Rd
pkg/RobExtremes/man/Gumbel.Rd
pkg/RobExtremes/man/GumbelLocationFamily.Rd
pkg/RobExtremes/man/GumbelParameter-class.Rd
pkg/RobExtremes/man/InternalReturnClasses-class.Rd
pkg/RobExtremes/man/LDEstimate-class.Rd
pkg/RobExtremes/man/LDEstimator.Rd
pkg/RobExtremes/man/Pareto-class.Rd
pkg/RobExtremes/man/Pareto.Rd
pkg/RobExtremes/man/ParetoFamily.Rd
pkg/RobExtremes/man/ParetoParameter-class.Rd
pkg/RobExtremes/man/PickandsEstimator.Rd
pkg/RobExtremes/man/QuantileBCCEstimator.Rd
pkg/RobExtremes/man/RobExtremesConstants.Rd
pkg/RobExtremes/man/Var.Rd
pkg/RobExtremes/man/WeibullFamily.Rd
pkg/RobExtremes/man/asvarMedkMAD.Rd
pkg/RobExtremes/man/asvarPickands.Rd
pkg/RobExtremes/man/asvarQBCC.Rd
pkg/RobExtremes/man/getStartIC-methods.Rd
pkg/RobExtremes/man/internal-interpolate.Rd
pkg/RobExtremes/man/internalldeHelpers.Rd
pkg/RobExtremes/man/interpolateSn.Rd
pkg/RobExtremes/man/kMAD.Rd
pkg/RobExtremes/man/mov2bckRef-methods.Rd
pkg/RobExtremes/man/rescaleFunction-methods.Rd
pkg/RobExtremes/man/validParameter-methods.Rd
pkg/RobExtremes/src/
pkg/RobExtremes/src/kMad.c
pkg/RobExtremes/tests/
pkg/RobExtremes/tests/doRUnit.R
Removed:
pkg/ROptEst/chm/
Modified:
branches/robast-0.9/pkg/RandVar/DESCRIPTION
branches/robast-0.9/pkg/RobAStBase/DESCRIPTION
pkg/ROptEst/DESCRIPTION
pkg/ROptEst/NAMESPACE
pkg/ROptEst/R/AllGeneric.R
pkg/ROptEst/R/LowerCaseMultivariate.R
pkg/ROptEst/R/cniperCont.R
pkg/ROptEst/R/getIneffDiff.R
pkg/ROptEst/R/getInfClip.R
pkg/ROptEst/R/getInfRobIC_asAnscombe.R
pkg/ROptEst/R/getInfRobIC_asBias.R
pkg/ROptEst/R/getInfRobIC_asGRisk.R
pkg/ROptEst/R/getInfRobIC_asHampel.R
pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
pkg/ROptEst/R/getInfV.R
pkg/ROptEst/R/getRiskIC.R
pkg/ROptEst/R/leastFavorableRadius.R
pkg/ROptEst/R/optIC.R
pkg/ROptEst/R/radiusMinimaxIC.R
pkg/ROptEst/R/roptest.R
pkg/ROptEst/inst/NEWS
pkg/ROptEst/inst/scripts/NormalLocationModel.R
pkg/ROptEst/man/0ROptEst-package.Rd
pkg/ROptEst/man/cniperCont.Rd
pkg/ROptEst/man/getAsRisk.Rd
pkg/ROptEst/man/getIneffDiff.Rd
pkg/ROptEst/man/getInfClip.Rd
pkg/ROptEst/man/getInfRobIC.Rd
pkg/ROptEst/man/getMaxIneff.Rd
pkg/ROptEst/man/getReq.Rd
pkg/ROptEst/man/getRiskIC.Rd
pkg/ROptEst/man/internals.Rd
pkg/ROptEst/man/optIC.Rd
pkg/ROptEst/man/optRisk.Rd
pkg/ROptEst/man/radiusMinimaxIC.Rd
pkg/ROptEst/man/roptest.Rd
pkg/RandVar/DESCRIPTION
pkg/RandVar/man/0RandVar-package.Rd
pkg/RobAStBase/DESCRIPTION
pkg/RobAStBase/man/0RobAStBase-package.Rd
Log:
merged RobAStRDA, RandVar, RobAStBase, ROptEst, RobExtremes to trunk
Modified: branches/robast-0.9/pkg/RandVar/DESCRIPTION
===================================================================
--- branches/robast-0.9/pkg/RandVar/DESCRIPTION 2013-09-11 14:31:27 UTC (rev 693)
+++ branches/robast-0.9/pkg/RandVar/DESCRIPTION 2013-09-11 17:32:41 UTC (rev 694)
@@ -1,5 +1,5 @@
Package: RandVar
-Version: 0.9.2
+Version: 0.9.3
Date: 2013-09-06
Title: Implementation of random variables
Description: Implementation of random variables by means of S4 classes and methods
Modified: branches/robast-0.9/pkg/RobAStBase/DESCRIPTION
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/DESCRIPTION 2013-09-11 14:31:27 UTC (rev 693)
+++ branches/robast-0.9/pkg/RobAStBase/DESCRIPTION 2013-09-11 17:32:41 UTC (rev 694)
@@ -1,5 +1,5 @@
Package: RobAStBase
-Version: 0.9
+Version: 0.9.1
Date: 2012-06-05
Title: Robust Asymptotic Statistics
Description: Base S4-classes and functions for robust asymptotic statistics.
Added: pkg/ROptEst/.Rbuildignore
===================================================================
--- pkg/ROptEst/.Rbuildignore (rev 0)
+++ pkg/ROptEst/.Rbuildignore 2013-09-11 17:32:41 UTC (rev 694)
@@ -0,0 +1,3 @@
+^.*\.svn.+
+inst/doc/Rplots.pdf
+.*-Ex\.R
\ No newline at end of file
Modified: pkg/ROptEst/DESCRIPTION
===================================================================
--- pkg/ROptEst/DESCRIPTION 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/DESCRIPTION 2013-09-11 17:32:41 UTC (rev 694)
@@ -1,12 +1,10 @@
Package: ROptEst
-Version: 0.8.1
-Date: 2011-09-30
+Version: 0.9
+Date: 2013-09-11
Title: Optimally robust estimation
-Description: Optimally robust estimation in general smoothly parameterized models using S4
- classes and methods.
-Depends: R(>= 2.7.0), methods, distr(>= 2.0), distrEx(>= 2.0), distrMod(>= 2.0), RandVar(>=
- 0.6.4), RobAStBase
-Suggests: MASS, RobLox
+Description: Optimally robust estimation in general smoothly parameterized models using S4 classes and methods.
+Depends: R(>= 2.10.0), methods, distr(>= 2.4), distrEx(>= 2.4), distrMod(>= 2.4), RandVar(>= 0.6.4), RobAStBase
+Suggests: RobLox, MASS
Author: Matthias Kohl, Peter Ruckdeschel
Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
ByteCompile: yes
@@ -16,4 +14,4 @@
Encoding: latin1
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-SVNRevision: 454
+SVNRevision: 693
Modified: pkg/ROptEst/NAMESPACE
===================================================================
--- pkg/ROptEst/NAMESPACE 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/NAMESPACE 2013-09-11 17:32:41 UTC (rev 694)
@@ -11,6 +11,7 @@
"getFixRobIC",
"getAsRisk",
"getFiRisk",
+ "getInfRad",
"getInfClip",
"getFixClip",
"getInfGamma",
@@ -25,11 +26,17 @@
"lowerCaseRadius",
"minmaxBias", "getBiasIC",
"getL1normL2deriv",
- "getModifyIC",
- "cniperCont", "cniperPoint", "cniperPointPlot")
+ "getModifyIC")
exportMethods("updateNorm", "scaleUpdateIC", "eff",
- "get.asGRisk.fct")
+ "get.asGRisk.fct", "getStartIC", "plot",
+ "comparePlot", "getRiskFctBV")
export("getL2normL2deriv",
"asAnscombe", "asL1", "asL4",
- "getReq", "getMaxIneff")
-export("roptest","getLagrangeMultByOptim","getLagrangeMultByIter")
+ "getReq", "getMaxIneff", "getRadius")
+export("roptest","roptest.old", "robest",
+ "getLagrangeMultByOptim","getLagrangeMultByIter")
+export("genkStepCtrl", "genstartCtrl", "gennbCtrl")
+export("cniperCont", "cniperPoint", "cniperPointPlot")
+export(".generateInterpGrid",".getLMGrid",".saveGridToCSV", ".readGridFromCSV")
+export(".RMXE.th",".OMSE.th", ".MBRE.th")
+export("CniperPointPlot")
\ No newline at end of file
Added: pkg/ROptEst/R/00internal.R
===================================================================
--- pkg/ROptEst/R/00internal.R (rev 0)
+++ pkg/ROptEst/R/00internal.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -0,0 +1,25 @@
+.rescalefct <- RobAStBase:::.rescalefct
+.plotRescaledAxis <- RobAStBase:::.plotRescaledAxis
+.makedotsP <- RobAStBase:::.makedotsP
+.makedotsLowLevel <- RobAStBase:::.makedotsLowLevel
+.SelectOrderData <- RobAStBase:::.SelectOrderData
+### helper function to recursively evaluate list
+.evalListRec <- RobAStBase:::.evalListRec
+
+
+if(packageVersion("distrMod")<"2.5"){
+.isUnitMatrix <- function(m){
+### checks whether m is unit matrix
+ m.row <- nrow(m)
+ isTRUE(all.equal(m, diag(m.row), check.attributes = FALSE))
+ }
+
+.deleteDim <- function(x){
+ attribs <- attributes(x)
+ attribs$dim <- NULL
+ attribs$dimnames <- NULL
+ attributes(x) <- attribs
+ x
+ }
+
+}
Modified: pkg/ROptEst/R/AllGeneric.R
===================================================================
--- pkg/ROptEst/R/AllGeneric.R 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/R/AllGeneric.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -18,6 +18,10 @@
setGeneric("getInfClip",
function(clip, L2deriv, risk, neighbor, ...) standardGeneric("getInfClip"))
}
+if(!isGeneric("getInfRad")){
+ setGeneric("getInfRad",
+ function(clip, L2deriv, risk, neighbor, ...) standardGeneric("getInfRad"))
+}
if(!isGeneric("getFixClip")){
setGeneric("getFixClip",
function(clip, Distr, risk, neighbor, ...) standardGeneric("getFixClip"))
@@ -77,18 +81,12 @@
if(!isGeneric("scaleUpdateIC")){
setGeneric("scaleUpdateIC", function(neighbor, ...) standardGeneric("scaleUpdateIC"))
}
-if(!isGeneric("cniperCont")){
- setGeneric("cniperCont", function(IC1, IC2, L2Fam, neighbor, risk, ...) standardGeneric("cniperCont"))
-}
-if(!isGeneric("cniperPoint")){
- setGeneric("cniperPoint", function(L2Fam, neighbor, risk, ...) standardGeneric("cniperPoint"))
-}
-if(!isGeneric("cniperPointPlot")){
- setGeneric("cniperPointPlot", function(L2Fam, neighbor, risk, ...) standardGeneric("cniperPointPlot"))
-}
if(!isGeneric("eff")){
setGeneric("eff", function(object) standardGeneric("eff"))
}
if(!isGeneric("get.asGRisk.fct")){
setGeneric("get.asGRisk.fct", function(Risk) standardGeneric("get.asGRisk.fct"))
}
+if(!isGeneric("getStartIC")){
+ setGeneric("getStartIC", function(model, risk, ...) standardGeneric("getStartIC"))
+}
Added: pkg/ROptEst/R/AllPlot.R
===================================================================
--- pkg/ROptEst/R/AllPlot.R (rev 0)
+++ pkg/ROptEst/R/AllPlot.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -0,0 +1,52 @@
+setMethod("plot", signature(x = "IC", y = "missing"),
+ function(x, ...,withSweave = getdistrOption("withSweave"),
+ main = FALSE, inner = TRUE, sub = FALSE,
+ col.inner = par("col.main"), cex.inner = 0.8,
+ bmar = par("mar")[1], tmar = par("mar")[3],
+ with.legend = FALSE, legend = NULL, legend.bg = "white",
+ legend.location = "bottomright", legend.cex = 0.8,
+ withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
+ lty.MBR = "dashed", lwd.MBR = 0.8, n.MBR = 10000,
+ scaleX = FALSE, scaleX.fct, scaleX.inv,
+ scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+ scaleN = 9, x.ticks = NULL, y.ticks = NULL,
+ mfColRow = TRUE, to.draw.arg = NULL){
+
+ mcl <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)
+
+ L2Fam <- eval(x at CallL2Fam); trafO <- trafo(L2Fam at param)
+ dims <- nrow(trafO); to.draw <- 1:dims
+ dimnms <- c(rownames(trafO))
+ if(is.null(dimnms))
+ dimnms <- paste("dim",1:dims,sep="")
+ if(! is.null(to.draw.arg)){
+ if(is.character(to.draw.arg))
+ to.draw <- pmatch(to.draw.arg, dimnms)
+ else if(is.numeric(to.draw.arg))
+ to.draw <- to.draw.arg
+ }
+ dims0 <- length(to.draw)
+
+ MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T)
+ if(withMBR && all(is.na(MBRB))){
+ robModel <- InfRobModel(center = L2Fam, neighbor =
+ ContNeighborhood(radius = 0.5))
+ ICmbr <- try(optIC(model = robModel, risk = asBias()), silent=TRUE)
+ if(!is(ICmbr,"try-error"))
+ MBRB <- .getExtremeCoordIC(ICmbr, distribution(L2Fam), to.draw,
+ n = n.MBR)
+ else withMBR <- FALSE
+ }
+ mcl$MBRB <- MBRB
+ mcl$withMBR <- withMBR
+ plm <- getMethod("plot", signature(x = "IC", y = "missing"),
+ where="RobAStBase")
+ do.call(plm, as.list(mcl[-1]), envir=parent.frame(2))
+ return(invisible())
+ })
+
+.getExtremeCoordIC <- function(IC, D, indi, n = 10000){
+ x <- q(D)(seq(1/2/n,1-1/2/n, length=n))
+ y <- (matrix(evalIC(IC,matrix(x,ncol=1)),ncol=n))[indi,]
+ return(cbind(min=apply(y,1,min),max=apply(y,1,max)))
+}
\ No newline at end of file
Modified: pkg/ROptEst/R/LowerCaseMultivariate.R
===================================================================
--- pkg/ROptEst/R/LowerCaseMultivariate.R 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/R/LowerCaseMultivariate.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -70,7 +70,7 @@
w <<- w0
if(verbose && itermin %% 15 == 1){
# if(verbose && itermin %% 2 == 1){
- cat("trying to find lower case solution;\n")
+ cat("trying to find lower case solution;\n")
cat("current Lagrange Multiplier value:\n")
print(list(A=A, z=z,erg=erg))
}
@@ -86,13 +86,15 @@
erg <- optim(p.vec, bmin.fct, method = "Nelder-Mead",
control = list(reltol = tol, maxit = 100*maxiter),
L2deriv = L2deriv, Distr = Distr, trafo = trafo)
+ problem <- (erg$convergence > 0)
A.max <- max(abs(stand(w)))
stand(w) <- stand(w)/A.max
weight(w) <- minbiasweight(w, neighbor = neighbor,
biastype = biastype,
normW = normtype)
- return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin))
+ return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin,
+ problem = problem ))
}
@@ -132,6 +134,7 @@
control = list(reltol = tol, maxit = 100*maxiter),
L2deriv = L2deriv, Distr = Distr, trafo = trafo)
+ problem <- (erg$convergence > 0)
A <- matrix(erg$par, ncol = k, nrow = 1)
b <- 1/erg$value
stand(w) <- A
@@ -153,6 +156,6 @@
weight(w) <- minbiasweight(w, neighbor = neighbor,
biastype = biastype,
normW = normtype)
- return(list(A=A,b=b, w=w, a=a, itermin = itermin))
+ return(list(A=A,b=b, w=w, a=a, itermin = itermin, problem = problem))
}
Modified: pkg/ROptEst/R/cniperCont.R
===================================================================
--- pkg/ROptEst/R/cniperCont.R 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/R/cniperCont.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -1,74 +1,153 @@
-setMethod("cniperCont", signature(IC1 = "IC",
- IC2 = "IC",
- L2Fam = "L2ParamFamily",
- neighbor = "ContNeighborhood",
- risk = "asMSE"),
- function(IC1, IC2, L2Fam, neighbor, risk, lower, upper, n = 101){
- R1 <- Risks(IC1)[["trAsCov"]]
- if(is.null(R1)) R1 <- getRiskIC(IC1, risk = trAsCov(), L2Fam = L2Fam)
- if(length(R1) > 1) R1 <- R1$value
- R2 <- Risks(IC2)[["trAsCov"]]
- if(is.null(R2)) R2 <- getRiskIC(IC2, risk = trAsCov(), L2Fam = L2Fam)
- if(length(R2) > 1) R2 <- R2$value
+.plotData <- function(
+ ## helper function for cniper-type plots to plot in data
+ data, # data to be plot in
+ dots, # dots from the calling function
+ origCl, # call from the calling function
+ fun, # function to determine risk difference
+ L2Fam, # L2Family
+ IC # IC1 in cniperContPlot and eta in cniperPointPlot
+){
+ dotsP <- .makedotsP(dots)
+ dotsP$col <- rep(eval(origCl$col.pts), length.out=n)
+ dotsP$pch <- rep(eval(origCl$pch.pts), length.out=n)
- r <- neighbor at radius
+ al <- eval(origCl$alpha.trsp)
+ if(!is.na(al))
+ dotsP$col <- sapply(dotsP$col, addAlphTrsp2col, alpha=al)
- fun <- function(x){
- y1 <- evalIC(IC1, x)
- y2 <- evalIC(IC2, x)
- R1 - R2 + r^2*(as.vector(y1 %*% y1) - as.vector(y2 %*% y2))
+ n <- if(!is.null(dim(data))) nrow(data) else length(data)
+ if(!is.null(lab.pts))
+ lab.pts <- rep(origCl$lab.pts, length.out=n)
+
+ sel <- .SelectOrderData(data, function(x)sapply(x,fun),
+ eval(origCl$which.lbs),
+ eval(origCl$which.Order))
+ i.d <- sel$ind
+ i0.d <- sel$ind1
+ y.d <- sel$y
+ x.d <- sel$data
+ n <- length(i.d)
+
+ resc.dat <- .rescalefct(x.d, function(x) sapply(x,fun),
+ eval(origCl$scaleX), origCl$scaleX.fct, origCl$scaleX.inv,
+ eval(origCl$scaleY), origCl$scaleY.fct,
+ dots$xlim, dots$ylim, dots)
+
+ dotsP$x <- resc.dat$X
+ dotsP$y <- resc.dat$Y
+
+ trafo <- trafo(L2Fam at param)
+ dims <- nrow(trafo)
+ QF <- diag(dims)
+ if(is(IC,"ContIC") & dims>1 )
+ {if (is(normtype(IC),"QFNorm"))
+ QF <- QuadForm(normtype(IC))}
+
+ absInfoEval <- function(x,y) sapply(x, y at Map[[1]])
+ IC.rv <- as(diag(dims) %*% IC at Curve, "EuclRandVariable")
+ absy.f <- t(IC.rv) %*% QF %*% IC.rv
+ absy <- absInfoEval(x.d, absy.f)
+
+ if(is.null(origCl$cex.pts)) origCl$cex.pts <- par("cex")
+ dotsP$cex <- log(absy+1)*3*rep(origCl$cex.pts, length.out=n)
+
+ dotsT <- dotsP
+ dotsT$pch <- NULL
+ dotsT$cex <- dotsP$cex/2
+ dotsT$labels <- if(is.null(lab.pts)) i.d else lab.pts[i.d]
+ do.call(points,dotsP)
+ if(!is.null(origCl$with.lab))
+ if(origCl$with.lab) do.call(text,dotsT)
+ if(!is.null(origCl$return$order))
+ if(origCl$return.Order) return(i0.d)
+ return(invisible(NULL))
}
- x <- seq(from = lower, to = upper, length = n)
- y <- sapply(x, fun)
- plot(x, y, type = "l", main = "Cniper region plot",
- xlab = "Dirac point", ylab = "Asymptotic MSE difference (IC1 - IC2)")
-# text(min(x), max(y)/2, "IC2", pos = 4)
-# text(min(x), min(y)/2, "IC1", pos = 4)
- abline(h = 0)
- invisible()
- })
-setMethod("cniperPoint", signature(L2Fam = "L2ParamFamily",
- neighbor = "ContNeighborhood",
- risk = "asMSE"),
- function(L2Fam, neighbor, risk, lower, upper){
- D <- trafo(L2Fam at param)
- tr.invF <- sum(diag(D %*% solve(FisherInfo(L2Fam)) %*% t(D)))
- psi <- optIC(model = L2Fam, risk = asCov())
- robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
- eta <- optIC(model = robMod, risk = asMSE())
- maxMSE <- Risks(eta)$asMSE$value
- Delta <- sqrt(maxMSE - tr.invF)/neighbor at radius
- fun <- function(x){
- y <- evalIC(psi, x)
- sqrt(as.vector(y %*% y)) - Delta
+
+
+.getFunCnip <- function(IC1,IC2, risk, L2Fam, r, b20=NULL){
+
+ riskfct <- getRiskFctBV(risk, biastype(risk))
+
+ .getTrVar <- function(IC){
+ R <- Risks(IC)[["trAsCov"]]
+ if(is.null(R)) R <- getRiskIC(IC, risk = trAsCov(), L2Fam = L2Fam)
+ if(length(R) > 1) R <- R$value
+ return(R)
}
- res <- uniroot(fun, lower = lower, upper = upper)$root
- names(res) <- "cniper point"
- res
- })
-setMethod("cniperPointPlot", signature(L2Fam = "L2ParamFamily",
- neighbor = "ContNeighborhood",
- risk = "asMSE"),
- function(L2Fam, neighbor, risk, lower, upper, n = 101, ...){
- dots <- as.list(match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"...")
- D <- trafo(L2Fam at param)
- tr.invF <- sum(diag(D %*% solve(FisherInfo(L2Fam)) %*% t(D)))
- psi <- optIC(model = L2Fam, risk = asCov())
- robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
- eta <- optIC(model = robMod, risk = asMSE())
- maxMSE <- Risks(eta)$asMSE$value
+ R1 <- .getTrVar (IC1)
+ R2 <- .getTrVar (IC2)
+
+
fun <- function(x){
- y <- evalIC(psi, x)
- tr.invF + as.vector(y %*% y)*neighbor at radius^2 - maxMSE
+ y1 <- evalIC(IC1,as.matrix(x,ncol=1))
+ r1 <- riskfct(var=R1,bias=r*fct(normtype(risk))(y1))
+ if(!is.null(b20))
+ r2 <- riskfct(var=R1,bias=b20) else{
+ y2 <- sapply(x,function(x0) evalIC(IC2,x0))
+ r2 <- riskfct(var=R2,bias=r*fct(normtype(risk))(y2))
+ }
+ r1 - r2
}
- dots$x <- x <- seq(from = lower, to = upper, length = n)
- dots$y <- sapply(x, fun)
+
+ return(fun)
+}
+
+cniperCont <- function(IC1, IC2, data = NULL, ...,
+ neighbor, risk, lower=getdistrOption("DistrResolution"),
+ upper=1-getdistrOption("DistrResolution"), n = 101,
+ scaleX = FALSE, scaleX.fct, scaleX.inv,
+ scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+ scaleN = 9, x.ticks = NULL, y.ticks = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 19, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL, alpha.trsp = NA,
+ which.lbs = NULL, which.Order = NULL,
+ return.Order = FALSE){
+
+ mc <- match.call(expand.dots = FALSE)
+ dots <- as.list(mc$"...")
+ if(!is(IC1,"IC")) stop ("IC1 must be of class 'IC'")
+ if(!is(IC2,"IC")) stop ("IC2 must be of class 'IC'")
+ if(!identical(IC1 at CallL2Fam, IC2 at CallL2Fam))
+ stop("IC1 and IC2 must be defined on the same model")
+
+ L2Fam <- eval(IC1 at CallL2Fam)
+
+ b20 <- NULL
+ fCpl <- eval(dots$fromCniperPlot)
+ if(!is.null(fCpl))
+ if(fCpl) b20 <- neighbor at radius*Risks(IC2)$asBias$value
+ dots$fromCniperPlot <- NULL
+
+ fun <- .getFunCnip(IC1,IC2, risk, L2Fam, neighbor at radius, b20)
+
+ if(missing(scaleX.fct)){
+ scaleX.fct <- p(L2Fam)
+ scaleX.inv <- q(L2Fam)
+ }
+
+ if(!is.null(as.list(mc)$lower)) lower <- p(L2Fam)(lower)
+ if(!is.null(as.list(mc)$upper)) upper <- p(L2Fam)(upper)
+ x <- q(L2Fam)(seq(lower,upper,length=n))
+ if(is(distribution(L2Fam), "DiscreteDistribution"))
+ x <- seq(q(L2Fam)(lower),q(L2Fam)(upper),length=n)
+ resc <- .rescalefct(x, fun, scaleX, scaleX.fct,
+ scaleX.inv, scaleY, scaleY.fct, dots$xlim, dots$ylim, dots)
+ dots$x <- resc$X
+ dots$y <- resc$Y
+
+
+ dots$type <- "l"
+ if(is.null(dots$main)) dots$main <- gettext("Cniper region plot")
+ if(is.null(dots$xlab)) dots$xlab <- gettext("Dirac point")
+ if(is.null(dots$ylab))
+ dots$ylab <- gettext("Asymptotic Risk difference (IC1 - IC2)")
+
colSet <- ltySet <- lwdSet <- FALSE
if(!is.null(dots$col)) {colSet <- TRUE; colo <- eval(dots$col)}
if(colSet) {
- colo <- rep(colo,length.out=2)
+ colo <- rep(colo,length.out=2)
dots$col <- colo[1]
}
if(!is.null(dots$lwd)) {lwdSet <- TRUE; lwdo <- eval(dots$lwd)}
@@ -78,29 +157,87 @@
}
if(!is.null(dots$lty)) {ltySet <- TRUE; ltyo <- eval(dots$lty)}
if(ltySet && ((!is.numeric(ltyo) && length(ltyo)==1)||
- is.numeric(ltyo))){
+ is.numeric(ltyo))){
ltyo <- list(ltyo,ltyo)
dots$lty <- ltyo[[1]]
}else{ if (ltySet && !is.numeric(ltyo) && length(ltyo)==2){
dots$lty <- ltyo[[1]]
}
}
- if(is.null(dots$main)) dots$main <- gettext("Cniper point plot")
- if(is.null(dots$xlab)) dots$xlab <- gettext("Dirac point")
- if(is.null(dots$ylab))
- dots$ylab <- gettext("Asymptotic MSE difference (classic - robust)")
- dots$type <- "l"
- do.call(plot, dots)
-# text(min(x), max(y)/2, "Robust", pos = 4)
-# text(min(x), min(y)/2, "Classic", pos = 4)
- dots$x <- dots$y <- dots$xlab <- dots$ylab <- dots$main <- dots$type <- NULL
- dots$h <- 0
+ do.call(plot,dots)
+
+ dots <- .makedotsLowLevel(dots)
+ dots$x <- dots$y <- NULL
if(colSet) dots$col <- colo[2]
if(lwdSet) dots$lwd <- lwdo[2]
if(ltySet) dots$lty <- ltyo[[2]]
+
+ dots$h <- if(scaleY) scaleY.fct(0) else 0
do.call(abline, dots)
- invisible()
- })
-#
-#cniperPointPlot(L2Fam=N0, neighbor=ContNeighborhood(radius = 0.5), risk=asMSE(),lower=-12, n =30, upper=8, lwd=c(2,4),lty=list(c(5,1),3),col=c(2,4))
-
\ No newline at end of file
+
+ .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct,
+ scaleY.inv, dots$xlim, dots$ylim, resc$X, ypts = 400,
+ n = scaleN, x.ticks = x.ticks, y.ticks = y.ticks)
+ if(!is.null(data))
+ return(.plotData(data, dots, mc, fun, L2Fam, IC1))
+ invisible(NULL)
+}
+
+cniperPoint <- function(L2Fam, neighbor, risk= asMSE(),
+ lower=getdistrOption("DistrResolution"),
+ upper=1-getdistrOption("DistrResolution")){
+
+
+ mc <- match.call(expand.dots = FALSE)
+
+ if(!is.null(as.list(mc)$lower)) lower <- p(L2Fam)(lower)
+ if(!is.null(as.list(mc)$upper)) upper <- p(L2Fam)(upper)
+ lower <- q(L2Fam)(lower)
+ upper <- q(L2Fam)(upper)
+
+ robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
+
+ psi <- optIC(model = L2Fam, risk = asCov())
+ eta <- optIC(model = robMod, risk = risk)
+
+ fun <- .getFunCnip(psi,eta, risk, L2Fam, neighbor at radius)
+
+ res <- uniroot(fun, lower = lower, upper = upper)$root
+ names(res) <- "cniper point"
+ res
+}
+
+cniperPointPlot <- function(L2Fam, data=NULL, ..., neighbor, risk= asMSE(),
+ lower=getdistrOption("DistrResolution"),
+ upper=1-getdistrOption("DistrResolution"), n = 101,
+ withMaxRisk = TRUE,
+ scaleX = FALSE, scaleX.fct, scaleX.inv,
+ scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+ scaleN = 9, x.ticks = NULL, y.ticks = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 19, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL, alpha.trsp = NA,
+ which.lbs = NULL, which.Order = NULL,
+ return.Order = FALSE){
+
+ mc <- match.call(#call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)
+ mcl <- as.list(mc[-1])
+ dots <- as.list(mc$"...")
+
+ robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
+
+ mcl$IC1 <- optIC(model = L2Fam, risk = asCov())
+ mcl$IC2 <- optIC(model = robMod, risk = risk)
+ mcl$L2Fam <- NULL
+ if(is.null(dots$ylab))
+ mcl$ylab <- gettext("Asymptotic Risk difference (classic - robust)")
+ if(is.null(dots$main))
+ mcl$main <- gettext("Cniper point plot")
+
+ if(withMaxRisk) mcl$fromCniperPlot <- TRUE
+ do.call(cniperCont, mcl)
+}
+
+
+
Added: pkg/ROptEst/R/comparePlot.R
===================================================================
--- pkg/ROptEst/R/comparePlot.R (rev 0)
+++ pkg/ROptEst/R/comparePlot.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -0,0 +1,52 @@
+setMethod("comparePlot", signature("IC","IC"),
+ function(obj1,obj2, obj3 = NULL, obj4 = NULL, data = NULL,
+ ..., withSweave = getdistrOption("withSweave"),
+ main = FALSE, inner = TRUE, sub = FALSE,
+ col = par("col"), lwd = par("lwd"), lty,
+ col.inner = par("col.main"), cex.inner = 0.8,
+ bmar = par("mar")[1], tmar = par("mar")[3],
+ with.legend = FALSE, legend = NULL, legend.bg = "white",
+ legend.location = "bottomright", legend.cex = 0.8,
+ withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
+ lty.MBR = "dashed", lwd.MBR = 0.8, n.MBR = 10000,
+ scaleX = FALSE, scaleX.fct, scaleX.inv,
+ scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+ scaleN = 9, x.ticks = NULL, y.ticks = NULL,
+ mfColRow = TRUE, to.draw.arg = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL, alpha.trsp = NA,
+ which.lbs = NULL, which.Order = NULL, return.Order = FALSE){
+
+ mcl <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)
+
+ L2Fam <- eval(obj1 at CallL2Fam); trafO <- trafo(L2Fam at param)
+ dims <- nrow(trafO); to.draw <- 1:dims
+ dimnms <- c(rownames(trafO))
+ if(is.null(dimnms))
+ dimnms <- paste("dim",1:dims,sep="")
+ if(! is.null(to.draw.arg)){
+ if(is.character(to.draw.arg))
+ to.draw <- pmatch(to.draw.arg, dimnms)
+ else if(is.numeric(to.draw.arg))
+ to.draw <- to.draw.arg
+ }
+ dims0 <- length(to.draw)
+
+ MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T)
+ if(withMBR && all(is.na(MBRB))){
+ robModel <- InfRobModel(center = L2Fam, neighbor =
+ ContNeighborhood(radius = 0.5))
+ ICmbr <- try(optIC(model = robModel, risk = asBias()), silent=TRUE)
+ if(!is(ICmbr,"try-error"))
+ MBRB <- .getExtremeCoordIC(ICmbr, distribution(L2Fam), to.draw,
+ n=n.MBR)
+ else withMBR <- FALSE
+ }
+ mcl$MBRB <- MBRB
+ mcl$withMBR <- withMBR
+ do.call(getMethod("comparePlot", signature("IC","IC"),
+ where="RobAStBase"), as.list(mcl[-1]),
+ envir=parent.frame(2))
+ return(invisible())
+ })
Modified: pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- pkg/ROptEst/R/getIneffDiff.R 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/R/getIneffDiff.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -9,10 +9,10 @@
z.start = NULL, A.start = NULL, upper.b = NULL, lower.b = NULL,
OptOrIter = "iterate", MaxIter, eps, warn,
loNorm = NULL, upNorm = NULL,
- verbose = NULL, ...){
-
+ verbose = NULL, ..., withRetIneff = FALSE){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
+
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
if(L2derivDim == 1){
##print(radius)
@@ -35,9 +35,10 @@
ineffUp <- res$b^2/upRisk
else
ineffUp <- (as.vector(res$A)*trafo - res$b^2*(radius^2-upRad^2))/upRisk
- assign("ineff", ineffUp, envir = sys.frame(which = -4))
+ ##assign("ineff", ineffUp, envir = sys.frame(which = -5))
##print(c(ineffUp,ineffLo,ineffUp - ineffLo))
- return(ineffUp - ineffLo)
+ if(withRetIneff) return(c(lo= ineffLo, up=ineffUp))
+ else return(ineffUp - ineffLo)
}else{
if(is(L2Fam at distribution, "UnivariateDistribution")){
if((length(L2Fam at L2deriv) == 1) & is(L2Fam at L2deriv[[1]], "RealRandVariable")){
@@ -94,12 +95,12 @@
}else{
ineffLo <- (sum(diag(std%*%res$A%*%t(trafo))) -
biasLo^2*(radius^2-loRad^2))/loRisk
- if(upRad == Inf)
- ineffUp <- biasUp^2/upRisk
- else
- ineffUp <- (sum(diag(std%*%res$A%*%t(trafo))) -
- biasUp^2*(radius^2-upRad^2))/upRisk}
- assign("ineff", ineffUp, envir = sys.frame(which = -4))
+ if(upRad == Inf)
+ ineffUp <- biasUp^2/upRisk
+ else
+ ineffUp <- (sum(diag(std%*%res$A%*%t(trafo))) -
+ biasUp^2*(radius^2-upRad^2))/upRisk
+ }
if(verbose)
cat(paste(rep("-",75), sep = "", collapse = ""),"\n",
"current radius: ", round(radius,4),
@@ -109,7 +110,8 @@
collapse = ""),"\n",sep="")
)
- return(ineffUp - ineffLo)
+ if(withRetIneff) return(c(lo= ineffLo, up=ineffUp))
+ else return(ineffUp - ineffLo)
}else{
stop("not yet implemented")
}
Modified: pkg/ROptEst/R/getInfClip.R
===================================================================
--- pkg/ROptEst/R/getInfClip.R 2013-09-11 14:31:27 UTC (rev 693)
+++ pkg/ROptEst/R/getInfClip.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -155,7 +155,7 @@
L2deriv = "UnivariateDistribution",
risk = "asSemivar",
neighbor = "ContNeighborhood"),
- function(clip, L2deriv, risk, neighbor, cent, symm, trafo){
+ function(clip, L2deriv, risk, neighbor, biastype, cent, symm, trafo){
biastype <- if(sign(risk)==1) positiveBias() else negativeBias()
z0 <- getInfCent(L2deriv = L2deriv, risk = risk, neighbor = neighbor,
biastype = biastype,
Added: pkg/ROptEst/R/getInfRad.R
===================================================================
--- pkg/ROptEst/R/getInfRad.R (rev 0)
+++ pkg/ROptEst/R/getInfRad.R 2013-09-11 17:32:41 UTC (rev 694)
@@ -0,0 +1,175 @@
+###############################################################################
+## optimal radius for given clipping bound for asymptotic MSE
+###############################################################################
+
+setMethod("getInfRad", signature(clip = "numeric",
+ L2deriv = "UnivariateDistribution",
+ risk = "asMSE",
+ neighbor = "ContNeighborhood"),
+ function(clip, L2deriv, risk, neighbor, biastype,
+ cent, symm, trafo){
+ gamm <- getInfGamma(L2deriv = L2deriv, risk = risk, neighbor = neighbor,
+ biastype = biastype, cent = cent, clip = clip)
+ return((-gamm/clip)^.5)
+ })
+
+setMethod("getInfRad", signature(clip = "numeric",
+ L2deriv = "UnivariateDistribution",
+ risk = "asMSE",
+ neighbor = "TotalVarNeighborhood"),
+ function(clip, L2deriv, risk, neighbor, biastype,
+ cent, symm, trafo){
+ gamm <- getInfGamma(L2deriv = sign(as.vector(trafo))*L2deriv, risk = risk,
+ neighbor = neighbor, biastype = biastype,
+ cent = if(symm) -clip/2 else cent , clip = clip)
+ return((-gamm/clip)^.5)
+ })
+
+setMethod("getInfRad", signature(clip = "numeric",
+ L2deriv = "EuclRandVariable",
+ risk = "asMSE",
+ neighbor = "UncondNeighborhood"),
+ function(clip, L2deriv, risk, neighbor, biastype,
+ Distr, stand, cent, trafo){
+ gamm <- getInfGamma(L2deriv = L2deriv, risk = risk, neighbor = neighbor,
+ biastype = biastype, Distr = Distr, stand = stand,
+ cent = cent, clip = clip)
+ return((-gamm/clip)^.5)
+ })
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 694
More information about the Robast-commits
mailing list