[Robast-commits] r490 - in branches/robast-0.9/pkg/RobLox: inst inst/scripts tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jun 30 14:27:20 CEST 2012
Author: stamats
Date: 2012-06-30 14:27:20 +0200 (Sat, 30 Jun 2012)
New Revision: 490
Added:
branches/robast-0.9/pkg/RobLox/inst/scripts/
branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactor.R
branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorLocation.R
branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorScale.R
branches/robast-0.9/pkg/RobLox/inst/scripts/LMinterpolation.R
Modified:
branches/robast-0.9/pkg/RobLox/tests/Examples/RobLox-Ex.Rout.save
Log:
added folder scripts with some R-files that can be used to compute interpolation of Lagrange multipliers and finite sample correction
Added: branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactor.R
===================================================================
--- branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactor.R (rev 0)
+++ branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactor.R 2012-06-30 12:27:20 UTC (rev 490)
@@ -0,0 +1,138 @@
+###############################################################################
+## Find finite-sample correction factor for asymptotic radius
+###############################################################################
+
+library(distr)
+library(RobLox)
+library(Biobase)
+
+## in combination with sysdata.rda of package RobLox
+rowRoblox1 <- function(x, r, k = 1L){
+ mean <- rowMedians(x, na.rm = TRUE)
+ sd <- rowMedians(abs(x-mean), na.rm = TRUE)/qnorm(0.75)
+ if(r > 10){
+ b <- sd*1.618128043
+ const <- 1.263094656
+ A2 <- b^2*(1+r^2)/(1+const)
+ A1 <- const*A2
+ a <- -0.6277527697*A2/sd
+ mse <- A1 + A2
+ }else{
+ A1 <- sd^2*.getA1.locsc(r)
+ A2 <- sd^2*.getA2.locsc(r)
+ a <- sd*.geta.locsc(r)
+ b <- sd*.getb.locsc(r)
+ mse <- A1 + A2
+ }
+ robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd),
+ A1 = A1, A2 = A2, a = a, b = b, k = k)
+ colnames(robEst$est) <- c("mean", "sd")
+ return(robEst$est)
+}
+
+## attaining the maximum finite-sample risk
+n <- 10
+M <- 1e5
+eps <- 0.01
+D <- 0.1
+fun <- function(r, x, n){
+ RadMinmax <- rowRoblox1(x, r = r)
+ n*(mean(RadMinmax[,1]^2) + mean((RadMinmax[,2]-1)^2))
+}
+
+r <- rbinom(n*M, prob = eps, size = 1)
+Mid <- rnorm(n*M)
+Mcont <- rep(D, n*M)
+Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n)
+ind <- rowSums(matrix(r, ncol = n)) >= n/2
+while(any(ind)){
+ M1 <- sum(ind)
+ cat("M1:\t", M1, "\n")
+ r <- rbinom(n*M1, prob = eps, size = 1)
+ Mid <- rnorm(n*M1)
+ Mcont <- r(contD)(n*M1)
+ Mre[ind,] <- (1-r)*Mid + r*Mcont
+ ind[ind] <- rowSums(matrix(r, ncol = n)) >= n/2
+}
+
+fun(r = 1, x = Mre, n = n)
+
+fun1 <- function(D){
+ Mcont <- rep(D, n*M)
+ Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n)
+ fun(r = 1, x = Mre, n = n)
+}
+sapply(c(seq(0.1, 10, length = 20), 20, 50, 100, 1000, 1e4, 1e6), fun1)
+
+
+## finite-sample optimal radius
+## n at least 3, for n = 2 not possible to have less than 50% contamination
+n <- c(3:50, seq(55, 100, by = 5), seq(110, 200, by = 10), seq(250, 500, by = 50))
+eps <- c(seq(0.001, 0.01, by = 0.001), seq(0.02, to = 0.5, by = 0.01))
+M <- 1e5
+contD <- Dirac(1e6)
+
+r.fi <- matrix(NA, nrow = length(eps), ncol = length(n))
+colnames(r.fi) <- n
+rownames(r.fi) <- eps
+r.as <- r.fi
+for(j in seq(along = n)){
+ ptm <- proc.time()
+ cat("aktuelles n:\t", n[j], "\n")
+ i <- 0
+ repeat{
+ i <- i + 1
+ cat("aktuelles eps:\t", eps[i], "\n")
+ r <- rbinom(n[j]*M, prob = eps[i], size = 1)
+ Mid <- rnorm(n[j]*M)
+ Mcont <- r(contD)(n[j]*M)
+ Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n[j])
+ rm(Mid, Mcont)
+ gc()
+ ind <- rowSums(matrix(r, ncol = n[j])) >= n[j]/2
+ rm(r)
+ gc()
+ while(any(ind)){
+ M1 <- sum(ind)
+ cat("M1:\t", M1, "\n")
+ r <- rbinom(n[j]*M1, prob = eps[i], size = 1)
+ Mid <- rnorm(n[j]*M1)
+ Mcont <- r(contD)(n[j]*M1)
+ Mre[ind,] <- (1-r)*Mid + r*Mcont
+ ind[ind] <- rowSums(matrix(r, ncol = n[j])) >= n[j]/2
+ rm(Mid, Mcont, r)
+ gc()
+ }
+ fun <- function(r, x, n){
+ RadMinmax <- rowRoblox1(x, r = r)
+ n*(mean(RadMinmax[,1]^2) + mean((RadMinmax[,2]-1)^2))
+ }
+ r.fi[i,j] <- optimize(fun, interval = c(eps[i], min(max(2, n[j]*eps[i]*25), 10)), x = Mre, n = n[j])$minimum
+ r.as[i,j] <- sqrt(n[j])*eps[i]
+ cat("finit:\t", r.fi[i,j], "\t asympt:\t", r.as[i,j], "\n")
+ rm(Mre)
+ gc()
+ if(round(r.fi[i,j], 2) == 1.74 | i == length(eps)) break
+ }
+ save.image(file = "FiniteSample1.RData")
+ cat("Dauer:\t", proc.time() - ptm, "\n")
+}
+
+r.as <- outer(eps, sqrt(n))
+r.fi[is.na(r.fi)] <- 1.74
+r.finite <- round(pmax(r.fi, r.as, na.rm = TRUE), 4)
+
+finiteSampleCorrection <- function(r, n){
+ if(r >= 1.74) return(r)
+
+ eps <- r/sqrt(n)
+ ns <- c(3:50, seq(55, 100, by = 5), seq(110, 200, by = 10),
+ seq(250, 500, by = 50))
+ epss <- c(seq(0.001, 0.01, by = 0.001), seq(0.02, to = 0.5, by = 0.01))
+ if(n %in% ns){
+ ind <- ns == n
+ }else{
+ ind <- which.min(abs(ns-n))
+ }
+ return(approx(x = epss, y = finiteSampleRadius[,ind], xout = eps, rule = 2)$y)
+}
Property changes on: branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactor.R
___________________________________________________________________
Added: svn:executable
+ *
Added: branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorLocation.R
===================================================================
--- branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorLocation.R (rev 0)
+++ branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorLocation.R 2012-06-30 12:27:20 UTC (rev 490)
@@ -0,0 +1,126 @@
+###############################################################################
+## Find finite-sample correction factor for asymptotic radius
+###############################################################################
+
+library(distr)
+library(RobLox)
+library(Biobase)
+
+## in combination with sysdata.rda of package RobLox
+rowRoblox1 <- function(x, r, sd = 1, k = 1L){
+ mean <- rowMedians(x, na.rm = TRUE)
+ if(length(sd) == 1) sd <- rep(sd, length(mean))
+
+ if(r > 10){
+ b <- sd*sqrt(pi/2)
+ A <- b^2*(1+r^2)
+ }else{
+ A <- sd^2*.getA.loc(r)
+ b <- sd*.getb.loc(r)
+ }
+ robEst <- as.matrix(.kstep.loc.matrix(x = x, initial.est = mean, A = A, b = b, sd = sd, k = k))
+ colnames(robEst) <- "mean"
+ return(robEst)
+}
+
+## attaining the maximum finite-sample risk
+n <- 10
+M <- 1e5
+eps <- 0.01
+D <- 0.1
+fun <- function(r, x, n){
+ RadMinmax <- rowRoblox1(x, r = r)
+ n*mean(RadMinmax[,1]^2)
+}
+
+r <- rbinom(n*M, prob = eps, size = 1)
+Mid <- rnorm(n*M)
+Mcont <- rep(D, n*M)
+Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n)
+ind <- rowSums(matrix(r, ncol = n)) >= n/2
+while(any(ind)){
+ M1 <- sum(ind)
+ cat("M1:\t", M1, "\n")
+ r <- rbinom(n*M1, prob = eps, size = 1)
+ Mid <- rnorm(n*M1)
+ Mcont <- r(contD)(n*M1)
+ Mre[ind,] <- (1-r)*Mid + r*Mcont
+ ind[ind] <- rowSums(matrix(r, ncol = n)) >= n/2
+}
+
+fun(r = 1, x = Mre, n = n)
+
+fun1 <- function(D){
+ Mcont <- rep(D, n*M)
+ Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n)
+ fun(r = 1, x = Mre, n = n)
+}
+sapply(c(seq(0.1, 10, length = 20), 20, 50, 100, 1000, 1e4, 1e6), fun1)
+
+
+## finite-sample optimal radius
+## n at least 3, for n = 2 not possible to have less than 50% contamination
+n <- c(3:50, seq(55, 100, by = 5), seq(110, 200, by = 10), seq(250, 500, by = 50))
+eps <- c(seq(0.001, 0.01, by = 0.001), seq(0.02, to = 0.5, by = 0.01))
+M <- 1e5
+contD <- Dirac(1e6)
+
+r.fi <- matrix(NA, nrow = length(eps), ncol = length(n))
+colnames(r.fi) <- n
+rownames(r.fi) <- eps
+for(j in seq(along = n)){
+ ptm <- proc.time()
+ cat("aktuelles n:\t", n[j], "\n")
+ i <- 0
+ repeat{
+ i <- i + 1
+ cat("aktuelles eps:\t", eps[i], "\n")
+ r <- rbinom(n[j]*M, prob = eps[i], size = 1)
+ Mid <- rnorm(n[j]*M)
+ Mcont <- r(contD)(n[j]*M)
+ Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n[j])
+ rm(Mid, Mcont)
+ gc()
+ ind <- rowSums(matrix(r, ncol = n[j])) >= n[j]/2
+ rm(r)
+ gc()
+ while(any(ind)){
+ M1 <- sum(ind)
+ cat("M1:\t", M1, "\n")
+ r <- rbinom(n[j]*M1, prob = eps[i], size = 1)
+ Mid <- rnorm(n[j]*M1)
+ Mcont <- r(contD)(n[j]*M1)
+ Mre[ind,] <- (1-r)*Mid + r*Mcont
+ ind[ind] <- rowSums(matrix(r, ncol = n[j])) >= n[j]/2
+ rm(Mid, Mcont, r)
+ gc()
+ }
+ r.fi[i,j] <- optimize(fun, interval = c(eps[i], min(max(2, n[j]*eps[i]*25), 11)), x = Mre, n = n[j])$minimum
+ cat("finit:\t", r.fi[i,j], "\t asympt:\t", sqrt(n[j])*eps[i], "\n")
+ rm(Mre)
+ gc()
+ if(round(r.fi[i,j], 2) > 3 | i == length(eps)) break
+ }
+ save.image(file = "FiniteSampleLocation.RData")
+ cat("Dauer:\t", proc.time() - ptm, "\n")
+}
+
+r.as <- outer(eps, sqrt(n))
+r.fi[r.fi > 3] <- 3.5
+r.fi[is.na(r.fi)] <- 3.5
+r.finite <- round(pmax(r.fi, r.as, na.rm = TRUE), 4)
+
+finiteSampleCorrection <- function(r, n){
+ if(r >= 3.0) return(r)
+
+ eps <- r/sqrt(n)
+ ns <- c(3:50, seq(55, 100, by = 5), seq(110, 200, by = 10),
+ seq(250, 500, by = 50))
+ epss <- c(seq(0.001, 0.01, by = 0.001), seq(0.02, to = 0.5, by = 0.01))
+ if(n %in% ns){
+ ind <- ns == n
+ }else{
+ ind <- which.min(abs(ns-n))
+ }
+ return(approx(x = epss, y = finiteSampleRadius[,ind], xout = eps, rule = 2)$y)
+}
Property changes on: branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorLocation.R
___________________________________________________________________
Added: svn:executable
+ *
Added: branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorScale.R
===================================================================
--- branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorScale.R (rev 0)
+++ branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorScale.R 2012-06-30 12:27:20 UTC (rev 490)
@@ -0,0 +1,114 @@
+###############################################################################
+## Find finite-sample correction factor for asymptotic radius
+###############################################################################
+
+library(distr)
+library(RobLox)
+library(Biobase)
+
+## in combination with sysdata.rda of package RobLox
+rowRoblox2 <- function(x, r, mean = 0, k = 1L){
+ M <- rowMedians(x, na.rm = TRUE)
+ sd <- rowMedians(abs(x-M), na.rm = TRUE)/qnorm(0.75)
+ if(r > 10){
+ b <- sd/(4*qnorm(0.75)*dnorm(qnorm(0.75)))
+ A <- b^2*(1+r^2)
+ a <- (qnorm(0.75)^2 - 1)/sd*A
+ }else{
+ A <- sd^2*.getA.sc(r)
+ a <- sd*.geta.sc(r)
+ b <- sd*.getb.sc(r)
+ }
+ robEst <- .kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ robEst$est <- as.matrix(robEst$est)
+ colnames(robEst$est) <- "sd"
+ return(robEst$est)
+}
+
+## attaining the maximum finite-sample risk
+n <- 10
+M <- 1e5
+eps <- 0.01
+D <- 0.1
+fun <- function(r, x, n){
+ RadMinmax <- rowRoblox2(x, r = r)
+ n*mean(RadMinmax[,1]^2)
+}
+
+r <- rbinom(n*M, prob = eps, size = 1)
+Mid <- rnorm(n*M)
+Mcont <- rep(D, n*M)
+Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n)
+ind <- rowSums(matrix(r, ncol = n)) >= n/2
+while(any(ind)){
+ M1 <- sum(ind)
+ cat("M1:\t", M1, "\n")
+ r <- rbinom(n*M1, prob = eps, size = 1)
+ Mid <- rnorm(n*M1)
+ Mcont <- r(contD)(n*M1)
+ Mre[ind,] <- (1-r)*Mid + r*Mcont
+ ind[ind] <- rowSums(matrix(r, ncol = n)) >= n/2
+}
+
+fun(r = 1, x = Mre, n = n)
+
+fun1 <- function(D){
+ Mcont <- rep(D, n*M)
+ Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n)
+ fun(r = 1, x = Mre, n = n)
+}
+sapply(c(seq(0.1, 10, length = 20), 20, 50, 100, 1000, 1e4, 1e6), fun1)
+
+
+## finite-sample optimal radius
+## n at least 3, for n = 2 not possible to have less than 50% contamination
+n <- c(3:50, seq(55, 100, by = 5), seq(110, 200, by = 10), seq(250, 500, by = 50))
+eps <- c(seq(0.001, 0.01, by = 0.001), seq(0.02, to = 0.5, by = 0.01))
+M <- 1e5
+contD <- Dirac(1e6)
+
+r.fi <- matrix(NA, nrow = length(eps), ncol = length(n))
+colnames(r.fi) <- n
+rownames(r.fi) <- eps
+#for(j in seq(along = n)){
+for(j in 65:74){
+ ptm <- proc.time()
+ cat("aktuelles n:\t", n[j], "\n")
+ i <- 0
+ repeat{
+ i <- i + 1
+ cat("aktuelles eps:\t", eps[i], "\n")
+ r <- rbinom(n[j]*M, prob = eps[i], size = 1)
+ Mid <- rnorm(n[j]*M)
+ Mcont <- r(contD)(n[j]*M)
+ Mre <- matrix((1-r)*Mid + r*Mcont, ncol = n[j])
+ rm(Mid, Mcont)
+ gc()
+ ind <- rowSums(matrix(r, ncol = n[j])) >= n[j]/2
+ rm(r)
+ gc()
+ while(any(ind)){
+ M1 <- sum(ind)
+ cat("M1:\t", M1, "\n")
+ r <- rbinom(n[j]*M1, prob = eps[i], size = 1)
+ Mid <- rnorm(n[j]*M1)
+ Mcont <- r(contD)(n[j]*M1)
+ Mre[ind,] <- (1-r)*Mid + r*Mcont
+ ind[ind] <- rowSums(matrix(r, ncol = n[j])) >= n[j]/2
+ rm(Mid, Mcont, r)
+ gc()
+ }
+ r.fi[i,j] <- optimize(fun, interval = c(eps[i], min(max(2, n[j]*eps[i]*25), 11)), x = Mre, n = n[j])$minimum
+ cat("finit:\t", r.fi[i,j], "\t asympt:\t", sqrt(n[j])*eps[i], "\n")
+ rm(Mre)
+ gc()
+ if(round(r.fi[i,j], 2) > 3 | i == length(eps)) break
+ }
+ save.image(file = "FiniteSampleScale1.RData")
+ cat("Dauer:\t", proc.time() - ptm, "\n")
+}
+
+r.as <- outer(eps, sqrt(n))
+r.fi[r.fi > 3] <- 3.5
+r.fi[is.na(r.fi)] <- 3.5
+r.finite <- round(pmax(r.fi, r.as, na.rm = TRUE), 4)
Property changes on: branches/robast-0.9/pkg/RobLox/inst/scripts/FiniteSampleCorrectionFactorScale.R
___________________________________________________________________
Added: svn:executable
+ *
Added: branches/robast-0.9/pkg/RobLox/inst/scripts/LMinterpolation.R
===================================================================
--- branches/robast-0.9/pkg/RobLox/inst/scripts/LMinterpolation.R (rev 0)
+++ branches/robast-0.9/pkg/RobLox/inst/scripts/LMinterpolation.R 2012-06-30 12:27:20 UTC (rev 490)
@@ -0,0 +1,42 @@
+###############################################################################
+## Interpolated functions to speed up computation of Lagrange Multipliers
+###############################################################################
+
+library(RobLox)
+radius <- c(1e-8, 5e-8, 1e-7, 5e-7, 1e-6, 5e-6, 1e-5, 5e-5, seq(1e-4, 0.01, by = 0.001),
+ seq(0.02, 5, by = 0.01), seq(5.05, 10, by = 0.05))
+location <- sapply(radius, rlOptIC, computeIC = FALSE)
+scale <- sapply(radius, rsOptIC, computeIC = FALSE)
+
+fun <- function(radius){
+ print(radius)
+ rlsOptIC.AL(radius, computeIC = FALSE)
+}
+locationScale <- sapply(radius, fun)
+#locationScale <- sapply(radius, rlsOptIC.AL, computeIC = FALSE)
+
+A.loc <- unlist(location[1,])
+b.loc <- unlist(location[3,])
+.getA.loc <- approxfun(radius, A.loc, yleft = 1)
+.getb.loc <- approxfun(radius, b.loc, yleft = Inf)
+
+A.sc <- unlist(scale[1,])
+a.sc <- unlist(scale[2,])
+b.sc <- unlist(scale[3,])
+.getA.sc <- approxfun(radius, A.sc, yleft = 0.5)
+.geta.sc <- approxfun(radius, a.sc, yleft = 0)
+.getb.sc <- approxfun(radius, b.sc, yleft = Inf)
+
+n <- length(radius)
+A1.locsc <- unlist(locationScale[1,])[seq(1, 4*n-3, by = 4)]
+A2.locsc <- unlist(locationScale[1,])[seq(4, 4*n, by = 4)]
+a.locsc <- unlist(locationScale[2,])[seq(2, 2*n, by = 2)]
+b.locsc <- unlist(locationScale[3,])
+.getA1.locsc <- approxfun(radius, A1.locsc, yleft = 1)
+.getA2.locsc <- approxfun(radius, A2.locsc, yleft = 0.5)
+.geta.locsc <- approxfun(radius, a.locsc, yleft = 0)
+.getb.locsc <- approxfun(radius, b.locsc, yleft = Inf)
+
+save(.getA.loc, .getb.loc, .getA.sc, .geta.sc, .getb.sc, .getA1.locsc, .getA2.locsc,
+ .geta.locsc, .getb.locsc, file = "savedata.rda")
+
Modified: branches/robast-0.9/pkg/RobLox/tests/Examples/RobLox-Ex.Rout.save
===================================================================
--- branches/robast-0.9/pkg/RobLox/tests/Examples/RobLox-Ex.Rout.save 2012-06-25 14:02:00 UTC (rev 489)
+++ branches/robast-0.9/pkg/RobLox/tests/Examples/RobLox-Ex.Rout.save 2012-06-30 12:27:20 UTC (rev 490)
@@ -1,7 +1,8 @@
-R version 2.10.0 beta (2009-10-15 r50107)
-Copyright (C) 2009 The R Foundation for Statistical Computing
+R version 2.15.1 Patched (2012-06-29 r59688) -- "Roasted Marshmallows"
+Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
+Platform: x86_64-unknown-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
@@ -17,78 +18,13 @@
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
-> ### * <HEADER>
-> ###
-> attach(NULL, name = "CheckExEnv")
-> assign("nameEx",
-+ local({
-+ s <- "__{must remake R-ex/*.R}__"
-+ function(new) {
-+ if(!missing(new)) s <<- new else s
-+ }
-+ }),
-+ pos = "CheckExEnv")
-> ## Add some hooks to label plot pages for base and grid graphics
-> assign("base_plot_hook",
-+ function() {
-+ pp <- par(c("mfg","mfcol","oma","mar"))
-+ if(all(pp$mfg[1:2] == c(1, pp$mfcol[2]))) {
-+ outer <- (oma4 <- pp$oma[4]) > 0; mar4 <- pp$mar[4]
-+ mtext(sprintf("help(\"%s\")", nameEx()), side = 4,
-+ line = if(outer)max(1, oma4 - 1) else min(1, mar4 - 1),
-+ outer = outer, adj = 1, cex = .8, col = "orchid", las=3)
-+ }
-+ },
-+ pos = "CheckExEnv")
-> assign("grid_plot_hook",
-+ function() {
-+ grid::pushViewport(grid::viewport(width=grid::unit(1, "npc") -
-+ grid::unit(1, "lines"), x=0, just="left"))
-+ grid::grid.text(sprintf("help(\"%s\")", nameEx()),
-+ x=grid::unit(1, "npc") + grid::unit(0.5, "lines"),
-+ y=grid::unit(0.8, "npc"), rot=90,
-+ gp=grid::gpar(col="orchid"))
-+ },
-+ pos = "CheckExEnv")
-> setHook("plot.new", get("base_plot_hook", pos = "CheckExEnv"))
-> setHook("persp", get("base_plot_hook", pos = "CheckExEnv"))
-> setHook("grid.newpage", get("grid_plot_hook", pos = "CheckExEnv"))
-> assign("cleanEx",
-+ function(env = .GlobalEnv) {
-+ rm(list = ls(envir = env, all.names = TRUE), envir = env)
-+ RNGkind("default", "default")
-+ set.seed(1)
-+ options(warn = 1)
-+ .CheckExEnv <- as.environment("CheckExEnv")
-+ delayedAssign("T", stop("T used instead of TRUE"),
-+ assign.env = .CheckExEnv)
-+ delayedAssign("F", stop("F used instead of FALSE"),
-+ assign.env = .CheckExEnv)
-+ sch <- search()
-+ newitems <- sch[! sch %in% .oldSearch]
-+ for(item in rev(newitems))
-+ eval(substitute(detach(item), list(item=item)))
-+ missitems <- .oldSearch[! .oldSearch %in% sch]
-+ if(length(missitems))
-+ warning("items ", paste(missitems, collapse=", "),
-+ " have been removed from the search path")
-+ },
-+ pos = "CheckExEnv")
-> assign("ptime", proc.time(), pos = "CheckExEnv")
-> ## at least one package changes these via ps.options(), so do this
-> ## before loading the package.
-> ## Use postscript as incomplete files may be viewable, unlike PDF.
-> ## Choose a size that is close to on-screen devices, fix paper
-> grDevices::ps.options(width = 7, height = 7, paper = "a4", reset = TRUE)
-> grDevices::postscript("RobLox-Ex.ps")
->
-> assign("par.postscript", graphics::par(no.readonly = TRUE), pos = "CheckExEnv")
-> options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
+> pkgname <- "RobLox"
+> source(file.path(R.home("share"), "R", "examples-header.R"))
> options(warn = 1)
> library('RobLox')
Loading required package: distrMod
Loading required package: startupmsg
-:startupmsg> Utilities for start-up messages (version 0.7)
+:startupmsg> Utilities for start-up messages (version 0.8)
:startupmsg>
:startupmsg> For more information see ?"startupmsg",
:startupmsg> NEWS("startupmsg")
@@ -97,7 +33,7 @@
Loading required package: sfsmisc
Loading required package: SweaveListingUtils
:SweaveListingUtils> Utilities for Sweave together with
-:SweaveListingUtils> TeX listings package (version 0.4)
+:SweaveListingUtils> TeX listings package (version 0.6)
:SweaveListingUtils>
:SweaveListingUtils> Some functions from package 'base'
:SweaveListingUtils> are intentionally masked ---see
@@ -116,16 +52,14 @@
:SweaveListingUtils> vignette("ExampleSweaveListingUtils").
-Attaching package: 'SweaveListingUtils'
+Attaching package: ‘SweaveListingUtils’
+The following object(s) are masked from ‘package:base’:
- The following object(s) are masked from package:base :
+ library, require
- library,
- require
-
-:distr> Object orientated implementation of distributions (version
-:distr> 2.2)
+:distr> Object oriented implementation of distributions (version
+:distr> 2.4)
:distr>
:distr> Attention: Arithmetics on distribution objects are
:distr> understood as operations on corresponding random variables
@@ -144,31 +78,22 @@
:distr> vignette("distr").
-Attaching package: 'distr'
+Attaching package: ‘distr’
+The following object(s) are masked from ‘package:stats’:
- The following object(s) are masked from package:stats :
+ df, qqplot, sd
- df,
- qqplot,
- sd
-
Loading required package: distrEx
-Loading required package: evd
-Loading required package: actuar
-
-Attaching package: 'actuar'
-
-
- The following object(s) are masked from package:grDevices :
-
- cm
-
-:distrEx> Extensions of package distr (version 2.2)
+:distrEx> Extensions of package distr (version 2.4)
:distrEx>
:distrEx> Note: Packages "e1071", "moments", "fBasics" should be
-:distrEx> attached /before/ package "distrEx". See distrExMASK().
+:distrEx> attached /before/ package "distrEx". See
+:distrEx> distrExMASK().Note: Extreme value distribution
+:distrEx> functionality has been moved to
:distrEx>
+:distrEx> package "RobExtremes". See distrExMOVED().
+:distrEx>
:distrEx> For more information see ?"distrEx", NEWS("distrEx"), as
:distrEx> well as
:distrEx> http://distr.r-forge.r-project.org/
@@ -177,18 +102,14 @@
:distrEx> vignette("distr").
-Attaching package: 'distrEx'
+Attaching package: ‘distrEx’
+The following object(s) are masked from ‘package:stats’:
- The following object(s) are masked from package:stats :
+ IQR, mad, median, var
- IQR,
- mad,
- median,
- var
-
Loading required package: RandVar
-:RandVar> Implementation of random variables (version 0.7)
+:RandVar> Implementation of random variables (version 0.9)
:RandVar>
:RandVar> For more information see ?"RandVar", NEWS("RandVar"), as
:RandVar> well as
@@ -198,8 +119,8 @@
Loading required package: MASS
Loading required package: stats4
-:distrMod> Object orientated implementation of probability models
-:distrMod> (version 2.2)
+:distrMod> Object oriented implementation of probability models
+:distrMod> (version 2.4)
:distrMod>
:distrMod> Some functions from pkg's 'base' and 'stats' are
:distrMod> intentionally masked ---see distrModMASK().
@@ -210,25 +131,30 @@
:distrMod> For more information see ?"distrMod",
:distrMod> NEWS("distrMod"), as well as
:distrMod> http://distr.r-forge.r-project.org/
-:distrMod> Package "distrDoc" provides a vignette to this package
+:distrMod> There is a vignette to this package; try
+:distrMod> vignette("distrMod").
+:distrMod> Package "distrDoc" provides a vignette to the other
+:distrMod> distrXXX packages,
:distrMod> as well as to several related packages; try
:distrMod> vignette("distr").
-Attaching package: 'distrMod'
+Attaching package: ‘distrMod’
+The following object(s) are masked from ‘package:stats4’:
- The following object(s) are masked from package:stats4 :
+ confint
- confint
+The following object(s) are masked from ‘package:stats’:
+ confint
- The following object(s) are masked from package:stats :
+The following object(s) are masked from ‘package:base’:
- confint
+ norm
Loading required package: RobAStBase
-:RobAStBase> Robust Asymptotic Statistics (version 0.7)
+:RobAStBase> Robust Asymptotic Statistics (version 0.9)
:RobAStBase>
:RobAStBase> Some functions from pkg's 'stats' and 'graphics'
:RobAStBase> are intentionally masked ---see RobAStBaseMASK().
@@ -241,22 +167,16 @@
:RobAStBase> http://robast.r-forge.r-project.org/
-Attaching package: 'RobAStBase'
+Attaching package: ‘RobAStBase’
+The following object(s) are masked from ‘package:graphics’:
- The following object(s) are masked from package:stats :
+ clip
- start
-
-
- The following object(s) are masked from package:graphics :
-
- clip
-
>
> assign(".oldSearch", search(), pos = 'CheckExEnv')
-> assign(".oldNS", loadedNamespaces(), pos = 'CheckExEnv')
-> cleanEx(); nameEx("0RobLox-package")
+> cleanEx()
+> nameEx("0RobLox-package")
> ### * 0RobLox-package
>
> flush(stderr()); flush(stdout())
@@ -330,7 +250,7 @@
### name: IC of contamination type
### L2-differentiable parametric family: normal location and scale family
-### param: An object of class "ParamFamParameter"
+### param: An object of class "ParamWithScaleFamParameter"
name: location and scale
mean: -0.111150435088002
sd: 0.89284240215757
@@ -361,10 +281,10 @@
precision of centering: 8.833545e-17 1.265596e-05
precision of Fisher consistency:
mean sd
-mean 1.637539e-05 -1.822532e-17
+mean 1.652391e-05 -1.822532e-17
sd 3.168531e-17 -8.653862e-07
maximum deviation
- 1.637539e-05
+ 1.652391e-05
> Risks(pIC(res))
$asMSE
[1] 2.385308
@@ -397,12 +317,30 @@
> X <- matrix(rnorm(200, mean=ind*3, sd=(1-ind) + ind*9), nrow = 2)
> rowRoblox(X)
Loading required package: Biobase
+Loading required package: BiocGenerics
+Attaching package: ‘BiocGenerics’
+
+The following object(s) are masked from ‘package:RandVar’:
+
+ Map
+
+The following object(s) are masked from ‘package:stats’:
+
+ xtabs
+
+The following object(s) are masked from ‘package:base’:
+
+ Filter, Find, Map, Position, Reduce, anyDuplicated, cbind,
+ colnames, duplicated, eval, get, intersect, lapply, mapply, mget,
+ order, paste, pmax, pmax.int, pmin, pmin.int, rbind, rep.int,
+ rownames, sapply, setdiff, table, tapply, union, unique
+
Welcome to Bioconductor
- Vignettes contain introductory material. To view, type
- 'openVignette()'. To cite Bioconductor, see
- 'citation("Biobase")' and for packages 'citation(pkgname)'.
+ Vignettes contain introductory material; view with
+ 'browseVignettes()'. To cite Bioconductor, see
+ 'citation("Biobase")', and for packages 'citation("pkgname")'.
Evaluations of Optimally robust estimate:
-----------------------------------------
@@ -411,9 +349,9 @@
rowRoblox(x = X)
samplesize: 100
estimate:
- mean sd
-[1,] -0.09216816 1.131706
-[2,] 0.10169428 0.952022
+ mean sd
+[1,] -0.09216816 1.1317057
+[2,] 0.10169428 0.9520219
Infos:
method message
[1,] "roblox" "radius-minimax estimates for contamination interval [0, 0.5]"
@@ -426,7 +364,11 @@
>
>
>
-> cleanEx(); nameEx("finiteSampleCorrection")
+> cleanEx()
+
+detaching ‘package:Biobase’, ‘package:BiocGenerics’
+
+> nameEx("finiteSampleCorrection")
> ### * finiteSampleCorrection
>
> flush(stderr()); flush(stdout())
@@ -447,7 +389,8 @@
>
>
>
-> cleanEx(); nameEx("rlOptIC")
+> cleanEx()
+> nameEx("rlOptIC")
> ### * rlOptIC
>
> flush(stderr()); flush(stdout())
@@ -477,7 +420,7 @@
[1] 2.053826
$asCov
-[1] 1.011980
+[1] 1.01198
> cent(IC1)
[1] 0
@@ -490,7 +433,8 @@
>
>
>
-> cleanEx(); nameEx("rlsOptIC.AL")
+> cleanEx()
+> nameEx("rlsOptIC.AL")
> ### * rlsOptIC.AL
>
> flush(stderr()); flush(stdout())
@@ -503,17 +447,17 @@
> ### ** Examples
>
> IC1 <- rlsOptIC.AL(r = 0.1, check = TRUE)
-Fisher consistency of eta.loc: -1.743714e-10
-centering of eta.sc: -3.903789e-10
-Fisher consistency of eta.sc: 2.926104e-09
+Fisher consistency of eta.loc: -1.743783e-10
+centering of eta.sc: -3.904033e-10
+Fisher consistency of eta.sc: 2.926179e-09
MSE equation: 1.207368e-14
> distrExOptions("ErelativeTolerance" = 1e-12)
> checkIC(IC1)
-precision of centering: 0 -6.039298e-07
+precision of centering: 0 -6.039278e-07
precision of Fisher consistency:
- mean sd
-mean -1.102483e-06 0.000000e+00
-sd 0.000000e+00 -1.685676e-05
+ mean sd
+mean -1.10248e-06 0.000000e+00
+sd 0.00000e+00 -1.685676e-05
maximum deviation
1.685676e-05
> distrExOptions("ErelativeTolerance" = .Machine$double.eps^0.25) # default
@@ -537,9 +481,9 @@
> clip(IC1)
[1] 3.182504
> stand(IC1)
- [,1] [,2]
-[1,] 1.051890 0.0000000
-[2,] 0.000000 0.5958748
+ [,1] [,2]
+[1,] 1.05189 0.0000000
+[2,] 0.00000 0.5958748
> plot(IC1)
> infoPlot(IC1)
>
@@ -584,12 +528,12 @@
samplesize: 100
estimate:
mean sd
- -0.11387679 0.94029614
- ( 0.10699408) ( 0.09076235)
+ -0.11387679 0.94042674
+ ( 0.10700894) ( 0.09077496)
asymptotic (co)variance (multiplied with samplesize):
[,1] [,2]
-[1,] 1.144773 0.0000000
-[2,] 0.000000 0.8237805
+[1,] 1.145091 0.0000000
+[2,] 0.000000 0.8240093
Infos:
method
[1,] "oneStepEstimator"
@@ -599,16 +543,16 @@
[2,] "computation of IC, trafo, asvar and asbias via useLast = TRUE"
asymptotic bias:
sd
-0.9035723
+0.9036978
(partial) influence curve:
An object of class “ContIC”
### name: IC of contamination type
### L2-differentiable parametric family: normal location and scale family
-### param: An object of class "ParamFamParameter"
+### param: An object of class "ParamWithScaleFamParameter"
name: location and scale
mean: -0.113876786446744
-sd: 0.940296140129343
+sd: 0.940426740646572
trafo:
mean sd
mean 1 0
@@ -617,12 +561,12 @@
### neighborhood radius: 0.5
### clip: sd
-1.807145
-### cent: [1] 0.000000 -0.347277
+1.807396
+### cent: [1] 0.0000000 -0.3473252
### stand:
[,1] [,2]
-[1,] 1.401722 0.000000
-[2,] 0.000000 1.091808
+[1,] 1.402111 0.000000
+[2,] 0.000000 1.092111
### Infos:
method message
@@ -643,12 +587,12 @@
samplesize: 100
estimate:
mean sd
- -0.11639746 0.93646837
- ( 0.10655853) ( 0.09039288)
+ -0.11639567 0.93647284
+ ( 0.10655904) ( 0.09039331)
asymptotic (co)variance (multiplied with samplesize):
- [,1] [,2]
-[1,] 1.135472 0.0000000
-[2,] 0.000000 0.8170872
+ [,1] [,2]
+[1,] 1.135483 0.000000
+[2,] 0.000000 0.817095
Infos:
method
[1,] "kStepEstimator"
@@ -657,17 +601,17 @@
[1,] "3-step estimate for normal location and scale family"
[2,] "computation of IC, trafo, asvar and asbias via useLast = TRUE"
asymptotic bias:
- sd
-0.899894
+ sd
+0.8998983
(partial) influence curve:
An object of class “ContIC”
### name: IC of contamination type
### L2-differentiable parametric family: normal location and scale family
-### param: An object of class "ParamFamParameter"
+### param: An object of class "ParamWithScaleFamParameter"
name: location and scale
-mean: -0.116397459115411
-sd: 0.936468369096108
+mean: -0.116395665238717
+sd: 0.936472837098548
trafo:
mean sd
mean 1 0
@@ -676,12 +620,12 @@
### neighborhood radius: 0.5
### clip: sd
-1.799788
-### cent: [1] 0.0000000 -0.3458633
+1.799797
+### cent: [1] 0.0000000 -0.3458649
### stand:
[,1] [,2]
-[1,] 1.390333 0.000000
-[2,] 0.000000 1.082937
+[1,] 1.390346 0.000000
+[2,] 0.000000 1.082947
### Infos:
method message
@@ -707,13 +651,13 @@
oneStepEstimator(x = x, IC = IC2, start = est0)
samplesize: 100
estimate:
- mean sd
- -0.1194805 0.9318553
- ( 0.1090220) ( 0.0968585)
+ mean sd
+ -0.11948046 0.93188234
+ ( 0.10902521) ( 0.09686132)
asymptotic (co)variance (multiplied with samplesize):
- [,1] [,2]
-[1,] 1.188581 0.000000
-[2,] 0.000000 0.938157
+ [,1] [,2]
+[1,] 1.18865 0.0000000
+[2,] 0.00000 0.9382114
Infos:
method
[1,] "oneStepEstimator"
@@ -723,16 +667,16 @@
[2,] "computation of IC, trafo, asvar and asbias via useLast = TRUE"
asymptotic bias:
sd
-1.000433
+1.000462
(partial) influence curve:
An object of class “ContIC”
### name: IC of contamination type
### L2-differentiable parametric family: normal location and scale family
-### param: An object of class "ParamFamParameter"
+### param: An object of class "ParamWithScaleFamParameter"
name: location and scale
-mean: -0.119480464646405
-sd: 0.931855339791047
+mean: -0.119480464646407
+sd: 0.931882340990481
trafo:
mean sd
mean 1 0
@@ -741,12 +685,12 @@
### neighborhood radius: 0.579
### clip: sd
-1.727864
-### cent: [1] 0.0000000 -0.4415191
+1.727914
+### cent: [1] 0.0000000 -0.4415319
### stand:
[,1] [,2]
-[1,] 1.505494 0.000000
-[2,] 0.000000 1.206706
+[1,] 1.505582 0.000000
+[2,] 0.000000 1.206776
### Infos:
method message
@@ -769,12 +713,12 @@
samplesize: 100
estimate:
mean sd
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 490
More information about the Robast-commits
mailing list