[Robast-commits] r787 - in branches/robast-1.0/pkg/RobAStBase: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 8 15:05:54 CEST 2014
Author: ruckdeschel
Date: 2014-09-08 15:05:54 +0200 (Mon, 08 Sep 2014)
New Revision: 787
Modified:
branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R
branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R
branches/robast-1.0/pkg/RobAStBase/inst/NEWS
branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd
branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd
Log:
[RobAStBase] fixed an issue with outlyingPlot.R discovered by Bernhard
Modified: branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R 2014-08-19 01:51:56 UTC (rev 786)
+++ branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R 2014-09-08 13:05:54 UTC (rev 787)
@@ -36,20 +36,19 @@
new("cutoff", fct = fct0, name = name, cutoff.quantile = cutoff.quantile)
}
-cutoff.sememp <- function(){cutoff(name = "semi-empirical",
+cutoff.sememp <- function(cutoff.quantile = 0.95){cutoff(name = "semi-empirical",
body.fct0 = substitute({n.05 <- chol(QF)
# print(QF)
N0 <- matrix(rnorm(nsim*nrow(QF)),ncol=ncol(QF))
N0 <- N0 %*% n.05
- quantile((rowSums(N0^2))^.5,cutoff.quantile)
- }),
- cutoff.quantile = 0.95)}
+ quantile((rowSums(N0^2))^.5,cutoff.quantile0)
+ }, list(cutoff.quantile0 = cutoff.quantile))
+ )}
-cutoff.chisq <- function(){cutoff(name = "chisq",
+cutoff.chisq <- function(cutoff.quantile = 0.95){cutoff(name = "chisq",
body.fct0 = substitute({dim = nrow(as.matrix(data))
- qchisq(df = dim, cutoff.quantile)^.5
- }),
- cutoff.quantile = 0.95)}
+ qchisq(df = dim, cutoff.quantile0)^.5
+ }, list(cutoff.quantile0 = cutoff.quantile)))}
cutoff.quant <- function(qfct){
if(missing(qfct)) qfct <- NULL
Modified: branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-19 01:51:56 UTC (rev 786)
+++ branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-09-08 13:05:54 UTC (rev 787)
@@ -3,8 +3,8 @@
IC.y = IC.x,
dist.x = NormType(),
dist.y,
- cutoff.y = cutoff.chisq(),
- cutoff.x = cutoff.sememp(),
+ cutoff.x = cutoff.sememp(0.95),
+ cutoff.y = cutoff.chisq(0.95),
...,
cutoff.quantile.x = 0.95,
cutoff.quantile.y = cutoff.quantile.x,
@@ -34,47 +34,11 @@
if(is.null(dots$ylim)) dots$ylim <- TRUE
if(is.null(mc$cutoff.quantile.x)) mc$cutoff.quantile.x <- 0.95
if(is.null(mc$cutoff.quantile.y)) mc$cutoff.quantile.y <- cutoff.quantile.x
- if(is.null(mc$cutoff.x)) mc$cutoff.x <- cutoff.sememp()
- if(is.null(mc$cutoff.y)) mc$cutoff.y <- cutoff.chisq()
+ if(is.null(mc$cutoff.x)) mc$cutoff.x <- cutoff.sememp(mc$cutoff.quantile.x)
+ if(is.null(mc$cutoff.y)) mc$cutoff.y <- cutoff.chisq(mc$cutoff.quantile.y)
if(missing(IC.x)) stop("Argument 'IC.x' must be given as argument to 'outlyingPlot'")
if(missing(data)) stop("Argument 'data' must be given as argument to 'outlyingPlot'")
- if(missing(dist.y)){
- if(robCov.y){
- evIC <- evalIC(IC.y,as.matrix(data))
- if(is.null(dim(evIC))){
- asVar <- PosSemDefSymmMatrix(mad(evIC)^2)
- if(asVar < 1e-8) asVar <- 1
- }else{
- dimevIC <- dim(evIC)[1]
- devIC <- data.frame(t(evIC[1:dimevIC,,drop=FALSE]))
- CMcd <- PosSemDefSymmMatrix(getCov(CovMcd(devIC,alpha=0.5)))
- asVar <- CMcd
- # cat("\n", sep="", gettext("Robust asVar"), ":\n")
- # print(asVar)
- }
- }else{
- if("asCov" %in% names(Risks(IC.y)))
- if(is.matrix(Risks(IC.y)$asCov) || length(Risks(IC.y)$asCov) == 1)
- {asVar <- Risks(IC.y)$asCov
- cat("\n", sep="", gettext("asVar"));# print("HHHH");
- print(asVar)
- }
- else{asVar <- Risks(IC.y)$asCov$value
- cat("\n", sep="", gettext("asVar"));#print("HHHH");
- print(asVar)
- }
- else{asVar <- getRiskIC(IC.y, risk = asCov())$asCov$value
- cat("\n", sep="", gettext("Classic asVar"));
- # print("HHHH");
- print(asVar)
- }
- }
-
- asVar <- PosSemDefSymmMatrix(solve(asVar))
- mc$dist.y <- QFNorm(name = gettext("Mahalonobis-Norm"), QuadForm = asVar)
- }
-
if(missing(dist.x)){
#mc$dist.x <- NormType()
if(robCov.x){
@@ -86,7 +50,8 @@
dimevIC <- dim(evIC)[1]
devIC <- data.frame(t(evIC[1:dimevIC,,drop=FALSE]))
CMcd <- PosSemDefSymmMatrix(getCov(CovMcd(devIC,alpha=0.5)))
- asVar <- solve(CMcd)
+ asVar <- CMcd
+# asVar <- solve(CMcd)
# cat("\n", sep="", gettext("Robust asVar"), ":\n")
# print(asVar)
}
@@ -113,10 +78,47 @@
}
}
- asVar <- PosSemDefSymmMatrix(solve(asVar))
- mc$dist.x <- QFNorm(name = gettext("Mahalonobis-Norm"), QuadForm = asVar)
+# asVar <- PosSemDefSymmMatrix(solve(asVar))
+ mc$dist.x <- QFNorm(name = gettext("Mahalonobis-Norm"), QuadForm = PosSemDefSymmMatrix(solve(asVar)))
}
+ if(missing(dist.y)){
+ if(robCov.y){
+ evIC <- evalIC(IC.y,as.matrix(data))
+ if(is.null(dim(evIC))){
+ asVar <- PosSemDefSymmMatrix(mad(evIC)^2)
+ if(asVar < 1e-8) asVar <- 1
+ }else{
+ dimevIC <- dim(evIC)[1]
+ devIC <- data.frame(t(evIC[1:dimevIC,,drop=FALSE]))
+ CMcd <- PosSemDefSymmMatrix(getCov(CovMcd(devIC,alpha=0.5)))
+ asVar <- CMcd
+ # cat("\n", sep="", gettext("Robust asVar"), ":\n")
+ # print(asVar)
+ }
+ }else{
+ if("asCov" %in% names(Risks(IC.y)))
+ if(is.matrix(Risks(IC.y)$asCov) || length(Risks(IC.y)$asCov) == 1)
+ {asVar <- Risks(IC.y)$asCov
+ cat("\n", sep="", gettext("asVar"));# print("HHHH");
+ print(asVar)
+ }
+ else{asVar <- Risks(IC.y)$asCov$value
+ cat("\n", sep="", gettext("asVar"));#print("HHHH");
+ print(asVar)
+ }
+ else{asVar <- getRiskIC(IC.y, risk = asCov())$asCov$value
+ cat("\n", sep="", gettext("Classic asVar"));
+ # print("HHHH");
+ print(asVar)
+ }
+ }
+
+ mc$dist.y <- QFNorm(name = gettext("Mahalonobis-Norm"),
+ QuadForm = PosSemDefSymmMatrix(solve(asVar)))
+ }
+
+
if(missing(tf.x)){
tf.x <- function(x) apply(x,2,function(xx) evalIC(IC.x,xx))
}else{tf.x <- mc$tf.x}
Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-19 01:51:56 UTC (rev 786)
+++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-09-08 13:05:54 UTC (rev 787)
@@ -69,7 +69,7 @@
+ bug in kStepEstimator: after evaluation of starting estimator, IC must be
shifted to correct parameter value -> new arguments withPreModif, withPostModif
+ in comparePlot it should be resc.Dargs instead of rescD.args
-+ fixed errors detected by Matthias / Misha in comparePlot.R, cutoff-class.R,
++ fixed errors detected by Matthias / Misha, Bernhard in comparePlot.R, cutoff-class.R,
ddPlot_utils.R, infoPlot.R, outlyingPlot.R
+ comparePlot now plots the whole range
+ ddPlots / outlyingPlot.R now have alpha transparency and jitter and cex.pts
Modified: branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd 2014-08-19 01:51:56 UTC (rev 786)
+++ branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd 2014-09-08 13:05:54 UTC (rev 787)
@@ -12,8 +12,8 @@
cutoff(name = "empirical", body.fct0,
cutoff.quantile = 0.95,
norm = NormType(), QF, nsim = 100000)
-cutoff.sememp()
-cutoff.chisq()
+cutoff.sememp(cutoff.quantile = 0.95)
+cutoff.chisq(cutoff.quantile = 0.95)
cutoff.quant(qfct)
}
\arguments{
Modified: branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd 2014-08-19 01:51:56 UTC (rev 786)
+++ branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd 2014-09-08 13:05:54 UTC (rev 787)
@@ -5,7 +5,7 @@
to ICs}
\usage{
outlyingPlotIC(data, IC.x, IC.y = IC.x, dist.x = NormType(),
- dist.y, cutoff.y = cutoff.chisq(), cutoff.x = cutoff.sememp(),
+ dist.y, cutoff.x = cutoff.sememp(0.95), cutoff.y = cutoff.chisq(0.95),
..., cutoff.quantile.x = 0.95,
cutoff.quantile.y = cutoff.quantile.x,
id.n, cex.pts = 1,lab.pts, jitt.pts = 0, alpha.trsp = NA,
More information about the Robast-commits
mailing list