[Robast-commits] r245 - in branches/robast-0.7/pkg: ROptEst/R ROptEst/chm RobAStBase/R RobAStBase/chm RobAStBase/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jan 28 06:45:19 CET 2009
Author: ruckdeschel
Date: 2009-01-28 06:45:19 +0100 (Wed, 28 Jan 2009)
New Revision: 245
Modified:
branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R
branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R
branches/robast-0.7/pkg/ROptEst/R/optIC.R
branches/robast-0.7/pkg/ROptEst/R/optRisk.R
branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R
branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
branches/robast-0.7/pkg/RobAStBase/R/AllClass.R
branches/robast-0.7/pkg/RobAStBase/R/ContIC.R
branches/robast-0.7/pkg/RobAStBase/R/TotalVarIC.R
branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
branches/robast-0.7/pkg/RobAStBase/R/generateICfct.R
branches/robast-0.7/pkg/RobAStBase/R/getBiasIC.R
branches/robast-0.7/pkg/RobAStBase/R/getRiskIC.R
branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
branches/robast-0.7/pkg/RobAStBase/R/optIC.R
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html
branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd
Log:
fixed issues with polymorph nature of slot param of ParamFamParameter:
now we can determine opt-rob ICs for trafos; annotation gets right;
see example(comparePlot)
Modified: branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -14,9 +14,9 @@
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps,
+ trafo = trafo(L2Fam at param), maxiter = MaxIter, tol = eps,
warn = warn, verbose = verbose)
- trafo <- as.vector(L2Fam at param@trafo)
+ trafo <- as.vector(trafo(L2Fam at param))
ineffLo <- (as.vector(res$A)*trafo - res$b^2*(radius^2-loRad^2))/loRisk
if(upRad == Inf)
ineffUp <- res$b^2/upRisk
@@ -45,7 +45,7 @@
L2derivDistrSymm <- new("DistrSymmList", L2)
}
}
- trafo <- L2Fam at param@trafo
+ trafo <- trafo(L2Fam at param)
p <- nrow(trafo)
neighbor at radius <- radius
res <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
Modified: branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -16,7 +16,8 @@
biastype <- biastype(risk)
normtype <- normtype(risk)
- FI0 <- L2Fam at param@trafo%*%solve(L2Fam at FisherInfo)%*%t(L2Fam at param@trafo)
+ trafo <- trafo(L2Fam at param)
+ FI0 <- trafo%*%solve(L2Fam at FisherInfo)%*%t(trafo)
FI <- solve(FI0)
if(is(normtype,"InfoNorm") || is(normtype,"SelfNorm") )
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
@@ -41,31 +42,31 @@
resLo <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps,
+ trafo = trafo, maxiter = MaxIter, tol = eps,
warn = warn, verbose = verbose)
loRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resLo$b, cent = resLo$a,
- stand = resLo$A, trafo = L2Fam at param@trafo)[[1]]
+ stand = resLo$A, trafo = trafo)[[1]]
}
if(upRad == Inf){
bmin <- getAsRisk(risk = asBias(biastype = biastype),
L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
- trafo = L2Fam at param@trafo, symm = L2Fam at L2derivSymm[[1]])
+ trafo = trafo, symm = L2Fam at L2derivSymm[[1]])
upRisk <- bmin^2
}else{
neighbor at radius <- upRad
resUp <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps,
+ trafo = trafo, maxiter = MaxIter, tol = eps,
warn = warn, verbose = verbose)
upRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resUp$b, cent = resUp$a,
- stand = resUp$A, trafo = L2Fam at param@trafo)[[1]]
+ stand = resUp$A, trafo = trafo)[[1]]
}
loNorm<- upNorm <- NormType()
leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
@@ -111,7 +112,7 @@
}
std <- if(is(normtype,"QFNorm"))
- QuadForm(normtype) else diag(nrow(L2Fam at param@trafo))
+ QuadForm(normtype) else diag(nrow(trafo))
leastFavFct <- function(r, L2Fam, neighbor, risk, rho,
z.start, A.start, upper.b, MaxIter, eps, warn){
@@ -122,7 +123,6 @@
ow <- options("warn")
on.exit(options(ow))
options(warn = -1)
- trafo <- L2Fam at param@trafo
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
loRisk <- sum(diag(std%*%FI0))
@@ -185,7 +185,7 @@
return(ineff)
}
if(is.null(z.start)) z.start <- numeric(L2derivDim)
- if(is.null(A.start)) A.start <- L2Fam at param@trafo
+ if(is.null(A.start)) A.start <- trafo
leastFavR <- optimize(leastFavFct, lower = 1e-4, upper = upRad,
tol = .Machine$double.eps^0.25, maximum = TRUE,
L2Fam = L2Fam, neighbor = neighbor, risk = risk,
Modified: branches/robast-0.7/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/optIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/ROptEst/R/optIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -13,7 +13,7 @@
res <- getInfRobIC(L2deriv = model at center@L2derivDistr[[1]],
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
- Finfo = model at center@FisherInfo, trafo = model at center@param at trafo,
+ Finfo = model at center@FisherInfo, trafo = trafo(model at center@param),
upper = upper, maxiter = maxiter, tol = tol, warn = warn,
noLow = noLow, verbose = verbose)
res$info <- c("optIC", res$info)
@@ -47,7 +47,7 @@
risk = risk, Distr = model at center@distribution,
DistrSymm = model at center@distrSymm, L2derivSymm = L2derivSymm,
L2derivDistrSymm = L2derivDistrSymm, Finfo = model at center@FisherInfo,
- trafo = model at center@param at trafo, z.start = z.start, A.start = A.start,
+ trafo = trafo(model at center@param), z.start = z.start, A.start = A.start,
upper = upper, maxiter = maxiter, tol = tol, warn = warn,
verbose = verbose)
options(ow)
@@ -80,7 +80,7 @@
res <- getInfRobIC(L2deriv = L2derivDistr,
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
- Finfo = model at center@FisherInfo, trafo = model at center@param at trafo,
+ Finfo = model at center@FisherInfo, trafo = trafo(model at center@param),
upper = upper, maxiter = maxiter, tol = tol, warn = warn)
options(ow)
if(is(model at neighbor, "ContNeighborhood"))
Modified: branches/robast-0.7/pkg/ROptEst/R/optRisk.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/optRisk.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/ROptEst/R/optRisk.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -21,7 +21,7 @@
res <- getInfRobIC(L2deriv = model at center@L2derivDistr[[1]],
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
- Finfo = model at center@FisherInfo, trafo = model at center@param at trafo,
+ Finfo = model at center@FisherInfo, trafo = trafo(model at center@param),
upper = upper, maxiter = maxiter, tol = tol, warn = warn,
noLow = noLow)
options(ow)
@@ -53,7 +53,7 @@
risk = risk, Distr = model at center@distribution,
DistrSymm = model at center@distrSymm, L2derivSymm = L2derivSymm,
L2derivDistrSymm = L2derivDistrSymm, Finfo = model at center@FisherInfo,
- trafo = model at center@param at trafo, z.start = z.start, A.start = A.start,
+ trafo = trafo(model at center@param), z.start = z.start, A.start = A.start,
upper = upper, maxiter = maxiter, tol = tol, warn = warn)
options(ow)
return(res$risk)
Modified: branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -18,6 +18,7 @@
stop("'upRad < loRad' is not fulfilled")
biastype <- biastype(risk)
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
+ trafo <- trafo(L2Fam at param)
if(is(normtype(risk),"SelfNorm")||is(normtype(risk),"InfoNorm"))
upRad <- min(upRad,10)
@@ -36,31 +37,31 @@
resLo <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol,
+ trafo = trafo, maxiter = maxiter, tol = tol,
warn = warn, verbose = verbose)
loRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resLo$b, cent = resLo$a,
- stand = resLo$A, trafo = L2Fam at param@trafo)[[1]]
+ stand = resLo$A, trafo = trafo)[[1]]
}
if(upRad == Inf){
bmin <- getAsRisk(risk = asBias(biastype = biastype),
L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
- trafo = L2Fam at param@trafo)$asBias
+ trafo = trafo)$asBias
upRisk <- bmin^2
}else{
neighbor at radius <- upRad
resUp <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol,
+ trafo = trafo, maxiter = maxiter, tol = tol,
warn = warn, verbose = verbose)
upRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resUp$b, cent = resUp$a,
- stand = resUp$A, trafo = L2Fam at param@trafo)[[1]]
+ stand = resUp$A, trafo = trafo)[[1]]
}
loNorm<- upNorm <- NormType()
@@ -74,7 +75,7 @@
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol,
+ trafo = trafo, maxiter = maxiter, tol = tol,
warn = warn, verbose = verbose)
options(ow)
res$info <- c("radiusMinimaxIC", paste("radius minimax IC for radius interval [",
@@ -112,7 +113,6 @@
normtype <- normtype(risk)
Finfo <- L2Fam at FisherInfo
- trafo <- L2Fam at param@trafo
p <- nrow(trafo)
FI0 <- trafo%*%solve(Finfo)%*%t(trafo)
Modified: branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: branches/robast-0.7/pkg/RobAStBase/R/AllClass.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/AllClass.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/AllClass.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -102,7 +102,7 @@
contains = "InfluenceCurve",
validity = function(object){
L2Fam <- eval(object at CallL2Fam)
- trafo <- L2Fam at param@trafo
+ trafo <- trafo(L2Fam at param)
if(nrow(trafo) != dimension(object at Curve))
stop("wrong dimension of 'Curve'")
if(dimension(Domain(L2Fam at L2deriv[[1]])) != dimension(Domain(object at Curve[[1]])))
@@ -139,7 +139,7 @@
if(length(object at lowerCase) != nrow(object at stand))
stop("length of 'lowerCase' != nrow of standardizing matrix")
L2Fam <- eval(object at CallL2Fam)
- if(!identical(dim(L2Fam at param@trafo), dim(object at stand)))
+ if(!identical(dim(trafo(L2Fam at param)), dim(object at stand)))
stop(paste("dimension of 'trafo' of 'param' != dimension of 'stand'"))
return(TRUE)
})
Modified: branches/robast-0.7/pkg/RobAStBase/R/ContIC.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/ContIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/ContIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -24,7 +24,7 @@
if(length(lowerCase) != nrow(stand))
stop("length of 'lowerCase' != nrow of standardizing matrix")
L2Fam <- eval(CallL2Fam)
- if(!identical(dim(L2Fam at param@trafo), dim(stand)))
+ if(!identical(dim(trafo(L2Fam at param)), dim(stand)))
stop(paste("dimension of 'trafo' of 'param' != dimension of 'stand'"))
contIC <- new("ContIC")
@@ -60,9 +60,11 @@
normtype <- res$normtype
biastype <- res$biastype
w <- res$w
+ L2call <- L2Fam at fam.call
+ L2call$trafo <- trafo(L2Fam)
return(ContIC(
name = "IC of contamination type",
- CallL2Fam = L2Fam at fam.call,
+ CallL2Fam = L2call,
Curve = generateIC.fct(neighbor, L2Fam, res),
clip = b,
cent = a,
Modified: branches/robast-0.7/pkg/RobAStBase/R/TotalVarIC.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/TotalVarIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/TotalVarIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -19,7 +19,7 @@
if((length(clipLo) != 1) && (length(clipLo) != length(Curve)))
stop("length of lower clipping bound != 1 and != length of 'Curve'")
L2Fam <- eval(CallL2Fam)
- if(!identical(dim(L2Fam at param@trafo), dim(stand)))
+ if(!identical(dim(trafo(L2Fam at param)), dim(stand)))
stop(paste("dimension of 'trafo' of 'param' != dimension of 'stand'"))
IC1 <- new("TotalVarIC")
@@ -57,9 +57,12 @@
else
clipUp <- clipLo + b
+ L2call <- L2Fam at fam.call
+ L2call$trafo <- trafo(L2Fam)
+
return(TotalVarIC(
name = "IC of total variation type",
- CallL2Fam = L2Fam at fam.call,
+ CallL2Fam = L2call,
Curve = generateIC.fct(neighbor, L2Fam, res),
clipUp = clipUp,
clipLo = clipLo,
Modified: branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -97,7 +97,7 @@
dotsP$xlim <- xlim
dots$xlim <- NULL
- dims <- nrow(L2Fam at param@trafo)
+ dims <- nrow(trafo(L2Fam at param))
IC1 <- as(diag(dimm) %*% obj1 at Curve, "EuclRandVariable")
IC2 <- as(diag(dimm) %*% obj2 at Curve, "EuclRandVariable")
@@ -201,7 +201,10 @@
}else{if(any(is.na(inner))||any(!inner)) {
innerT <- as.list(rep("",dims)); innerL <- FALSE
}else{innerL <- TRUE
- innerT <- as.list(paste(paste(gettext("Component "), 1:dims,
+ tnm <- c(rownames(trafO))
+ tnms <- if(is.null(tnm)) paste(1:dims) else
+ paste("'", tnm, "'", sep = "")
+ innerT <- as.list(paste(paste(gettext("Component "), tnms,
gettext(" of (partial) IC\nfor "),
name(L2Fam)[1], sep =""), innerParam))
}
Modified: branches/robast-0.7/pkg/RobAStBase/R/generateICfct.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/generateICfct.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/generateICfct.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -20,7 +20,7 @@
{ ind <- 1-.eq(Y(x))
Y(x)*w(L(x)) + zi*(1-ind)*d*b },
list(Y = Y at Map[[1]], L = L.fct, w = w, b = b, d = d,
- zi = sign(L2Fam at param@trafo), .eq = .eq))
+ zi = sign(trafo(L2Fam at param)), .eq = .eq))
}else{
ICfct[[1]] <- function(x){}
body(ICfct[[1]]) <- substitute({ Y(x)*w(L(x)) },
Modified: branches/robast-0.7/pkg/RobAStBase/R/getBiasIC.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/getBiasIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/getBiasIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -20,7 +20,7 @@
x <- as.matrix(x[!duplicated(x),])
Bias <- .evalBiasIC(IC = IC, neighbor = neighbor, biastype = biastype,
- normtype = normtype, x = x, trafo = L2Fam at param@trafo)
+ normtype = normtype, x = x, trafo = trafo(L2Fam at param))
prec <- if(misF) checkIC(IC, out = FALSE) else
checkIC(IC, L2Fam, out = FALSE)
Modified: branches/robast-0.7/pkg/RobAStBase/R/getRiskIC.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/getRiskIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/getRiskIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -17,7 +17,6 @@
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'")
- trafo <- L2Fam at param@trafo
IC1 <- as(diag(dimension(IC at Curve)) %*% IC at Curve, "EuclRandVariable")
bias <- E(L2Fam, IC1)
Modified: branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -88,7 +88,7 @@
dotsP <- dotsL <- dotsT <- dots
dotsP$xlim <- xlim
- trafo <- L2Fam at param@trafo
+ trafo <- trafo(L2Fam at param)
mainL <- FALSE
Modified: branches/robast-0.7/pkg/RobAStBase/R/optIC.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/optIC.R 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/R/optIC.R 2009-01-28 05:45:19 UTC (rev 245)
@@ -3,14 +3,15 @@
###############################################################################
setMethod("optIC", signature(model = "L2ParamFamily", risk = "asCov"),
function(model, risk){
- Curve <- as((model at param@trafo %*% solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
- asCov <- model at param@trafo %*% solve(model at FisherInfo) %*% t(model at param@trafo)
+ Curve <- as((trafo(model at param) %*% solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
+ asCov <- trafo(model at param) %*% solve(model at FisherInfo) %*% t(trafo(model at param))
modifyIC <- function(L2Fam, IC){ optIC(L2Fam, asCov()) }
-
+ L2call <- model at fam.call
+ L2call$trafo <- trafo(model)
return(IC(
name = paste("Classical optimal influence curve for", model at name),
- CallL2Fam = model at fam.call,
+ CallL2Fam = L2call,
Curve = EuclRandVarList(Curve),
modifyIC = modifyIC,
Risks = list(asCov = asCov, trAsCov = sum(diag(asCov))),
Modified: branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html 2009-01-28 05:45:19 UTC (rev 245)
@@ -184,6 +184,27 @@
panel.first= grid(),ylim=c(-4,4),xlim=c(-6,6))
## matrix-valued ylim
comparePlot(IC1, IC2, panel.first= grid(),ylim=c(-4,4,0,4),xlim=c(-6,6))
+
+## with use of trafo-matrix:
+G <- GammaFamily(scale = 1, shape = 2)
+## explicitely transforming to
+## MASS parametrization:
+mtrafo <- function(x){
+ nms0 <- names(c(main(param(G)),nuisance(param(G))))
+ nms <- c("shape","rate")
+ fval0 <- c(x[2], 1/x[1])
+ names(fval0) <- nms
+ mat0 <- matrix( c(0, -1/x[1]^2, 1, 0), nrow = 2, ncol = 2,
+ dimnames = list(nms,nms0))
+ list(fval = fval0, mat = mat0)}
+G2 <- G
+trafo(G2) <- mtrafo
+G2
+G2.Rob1 <- InfRobModel(center = G2, neighbor = ContNeighborhood(radius = 0.5))
+IC1 <- optIC(model = G2, risk = asCov())
+IC2 <- optIC(model = G2.Rob1, risk = asMSE())
+comparePlot(IC1,IC2)
+
}
</pre>
Modified: branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd 2009-01-28 04:39:13 UTC (rev 244)
+++ branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd 2009-01-28 05:45:19 UTC (rev 245)
@@ -111,6 +111,27 @@
panel.first= grid(),ylim=c(-4,4),xlim=c(-6,6))
## matrix-valued ylim
comparePlot(IC1, IC2, panel.first= grid(),ylim=c(-4,4,0,4),xlim=c(-6,6))
+
+## with use of trafo-matrix:
+G <- GammaFamily(scale = 1, shape = 2)
+## explicitely transforming to
+## MASS parametrization:
+mtrafo <- function(x){
+ nms0 <- names(c(main(param(G)),nuisance(param(G))))
+ nms <- c("shape","rate")
+ fval0 <- c(x[2], 1/x[1])
+ names(fval0) <- nms
+ mat0 <- matrix( c(0, -1/x[1]^2, 1, 0), nrow = 2, ncol = 2,
+ dimnames = list(nms,nms0))
+ list(fval = fval0, mat = mat0)}
+G2 <- G
+trafo(G2) <- mtrafo
+G2
+G2.Rob1 <- InfRobModel(center = G2, neighbor = ContNeighborhood(radius = 0.5))
+IC1 <- optIC(model = G2, risk = asCov())
+IC2 <- optIC(model = G2.Rob1, risk = asMSE())
+comparePlot(IC1,IC2)
+
}
}
\keyword{robust}
More information about the Robast-commits
mailing list