From noreply at r-forge.r-project.org Mon Sep 8 15:05:54 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Sep 2014 15:05:54 +0200 (CEST) Subject: [Robast-commits] r787 - in branches/robast-1.0/pkg/RobAStBase: R inst man Message-ID: <20140908130554.CA8FC187526@r-forge.r-project.org> 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, From noreply at r-forge.r-project.org Wed Sep 24 16:00:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Sep 2014 16:00:08 +0200 (CEST) Subject: [Robast-commits] r788 - branches/robast-1.0/pkg/RobAStBase/R Message-ID: <20140924140008.48DE61876BB@r-forge.r-project.org> Author: ruckdeschel Date: 2014-09-24 16:00:07 +0200 (Wed, 24 Sep 2014) New Revision: 788 Modified: branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R Log: RobAStBase: a forgot commit to outlyingPlot.R ... Modified: branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-09-08 13:05:54 UTC (rev 787) +++ branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-09-24 14:00:07 UTC (rev 788) @@ -57,24 +57,15 @@ } #cat("\nRobust asVar:") ;print("KKKKK") #print(asVar) - }else{if("asCov" %in% names(Risks(IC.y))) - if(is.matrix(Risks(IC.x)$asCov) || length(Risks(IC.y)$asCov) == 1) + }else{if("asCov" %in% names(Risks(IC.x))) + if(is.matrix(Risks(IC.x)$asCov) || length(Risks(IC.x)$asCov) == 1) {asVar <- Risks(IC.x)$asCov - cat("\n", sep="", gettext("asVar")); - #print("KKKKK2"); - print(asVar) } else {asVar <- Risks(IC.x)$asCov$value - cat("\n", sep="", gettext("asVar")); - # print("KKKKK3"); - print(asVar) } else {asVar <- getRiskIC(IC.x, risk = asCov())$asCov$value - cat("\n", sep="", gettext("Classic asVar")); - #print("KKKKK4"); - print(asVar) } } @@ -93,25 +84,20 @@ 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) + cat("Fall 1\n\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) } + cat("Fall 2\n\n") + print(asVar) } mc$dist.y <- QFNorm(name = gettext("Mahalonobis-Norm"),