Switch to side-by-side view

--- a
+++ b/partyMod/tests/LinearStatistic-regtest.Rout.save
@@ -0,0 +1,165 @@
+
+R Under development (unstable) (2014-06-29 r66051) -- "Unsuffered Consequences"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+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.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> 
+> set.seed(290875)
+> library("party")
+Loading required package: grid
+Loading required package: zoo
+
+Attaching package: 'zoo'
+
+The following objects are masked from 'package:base':
+
+    as.Date, as.Date.numeric
+
+Loading required package: sandwich
+Loading required package: strucchange
+Loading required package: modeltools
+Loading required package: stats4
+> 
+> ### get rid of the NAMESPACE
+> attach(asNamespace("party"))
+The following objects are masked from package:party:
+
+    cforest, cforest_classical, cforest_control, cforest_unbiased,
+    conditionalTree, ctree, ctree_control, ctree_memory, edge_simple,
+    mob, mob_control, node_barplot, node_bivplot, node_boxplot,
+    node_density, node_hist, node_inner, node_scatterplot, node_surv,
+    node_terminal, proximity, ptrafo, reweight, sctest.mob, varimp,
+    varimpAUC
+
+> 
+> ### 
+> ###
+> ###    Regression tests for linear statistics, expectations and covariances
+> ###    
+> ###    functions defined in file `./src/LinearStatistics.c'    
+> 
+> ### tests for function C_LinearStatistic
+> ### Linear Statistics
+> x = matrix(c(rep.int(1,4), rep.int(0,6)), ncol = 1)
+> y = matrix(1:10, ncol = 1)
+> weights = rep(1, 10)
+> linstat = LinearStatistic(x, y, weights)
+> stopifnot(isequal(linstat, sum(1:4)))
+> 
+> weights[1] = 0
+> linstat = LinearStatistic(x, y, weights) 
+> stopifnot(isequal(linstat, sum(2:4)))
+> 
+> xf <- gl(3, 10)
+> yf <- gl(3, 10)[sample(1:30)]
+> x <- sapply(levels(xf), function(l) as.numeric(xf == l))
+> colnames(x) <- NULL
+> y <- sapply(levels(yf), function(l) as.numeric(yf == l))
+> colnames(y) <- NULL
+> weights <- sample(1:30)
+> linstat <- LinearStatistic(x, y, weights) 
+> stopifnot(isequal(linstat, as.vector(t(x) %*% diag(weights) %*% y)))
+> 
+> xf <- factor(cut(rnorm(6000), breaks = c(-Inf, -2, 0.5, Inf)))
+> x <- sapply(levels(xf), function(l) as.numeric(xf == l))
+> yf <- factor(cut(rnorm(6000), breaks = c(-Inf, -0.5, 1.5, Inf)))
+> y <- sapply(levels(yf), function(l) as.numeric(yf == l))
+> weights <- rep(1, nrow(x))
+> colnames(x) <- NULL
+> colnames(y) <- NULL
+> weights <- rep(1, 6000)
+> linstat <- LinearStatistic(x, y, weights)
+> stopifnot(isequal(as.vector(table(xf, yf)), linstat))
+> stopifnot(isequal(as.vector(t(x)%*%y), linstat))
+> 
+> 
+> ### tests for function C_ExpectCovarInfluence
+> eci <- ExpectCovarInfluence(y, weights)
+> isequal(eci@sumweights, sum(weights))
+[1] TRUE
+> isequal(eci@expectation, drop(weights %*% y / sum(weights)))
+[1] TRUE
+> ys <- t(t(y) - eci@expectation)
+> stopifnot(isequal(eci@covariance, (t(ys) %*% (weights * ys)) /
++                   sum(weights)))
+> 
+> ### tests for function C_ExpectCovarLinearStatistic
+> ### Conditional Expectation and Variance (via Kruskal-Wallis statistic)
+> 
+> ### case 1: p > 1, q = 1
+> group <- gl(3, 5)
+> x <- sapply(levels(group), function(l) as.numeric(group == l))
+> y <- matrix(1:15, ncol = 1)
+> weights <- rep(1, 15)
+> 
+> linstat <- LinearStatistic(x, y, weights)
+> expcov <- ExpectCovarLinearStatistic(x, y, weights)
+> KW <- quadformTestStatistic(linstat, expcov@expectation, expcov@covariance)
+> kts <- kruskal.test(y ~ group)$statistic
+> stopifnot(isequal(KW, kts))
+> 
+> ### case 2: p = 1, q > 1
+> linstat <- LinearStatistic(y, x, weights)
+> expcov <- ExpectCovarLinearStatistic(y, x, weights)
+> KW <- quadformTestStatistic(linstat, expcov@expectation, expcov@covariance)
+> kts <- kruskal.test(y ~ group)$statistic
+> stopifnot(isequal(KW, kts))
+> 
+> ### case 3: p = 1, q = 1
+> x <- x[,1,drop = FALSE]
+> linstat <- LinearStatistic(x, y, weights)
+> expcov <- ExpectCovarLinearStatistic(x, y, weights)
+> KW <- quadformTestStatistic(linstat, expcov@expectation, expcov@covariance)
+> kts <- kruskal.test(y ~ as.factor(x))$statistic
+> stopifnot(isequal(KW, kts))
+> 
+> ### case 4: p > 1, q > 1 via chisq.test
+> n <- 900
+> xf <- gl(3, n / 3)
+> yf <- gl(3, n / 3)[sample(1:n)]
+> x <- sapply(levels(xf), function(l) as.numeric(xf == l))
+> colnames(x) <- NULL
+> y <- sapply(levels(yf), function(l) as.numeric(yf == l))
+> colnames(y) <- NULL
+> weights <- rep(1, n)
+> linstat <- LinearStatistic(x, y, weights)
+> expcov <- ExpectCovarLinearStatistic(x, y, weights)
+> chi <- quadformTestStatistic(linstat, expcov@expectation, expcov@covariance)
+> chis <- chisq.test(table(xf, yf))$statistic
+> stopifnot(isequal(round(chi, 1), round(chis, 1)))
+> 
+> ### tests for function C_PermutedLinearStatistic
+> ### Linear Statistics with permuted indices
+> x <- matrix(rnorm(100), ncol = 2)
+> y <- matrix(rnorm(100), ncol = 2)
+> weights <- rep(1, 50)
+> indx <- 1:50
+> perm <- 1:50
+> stopifnot(isequal(LinearStatistic(x, y, weights), 
++                   PermutedLinearStatistic(x, y, indx, perm)))
+> x <- matrix(1:10000, ncol = 2)
+> y <- matrix(1:10000, ncol = 2)
+> 
+> for (i in 1:100) {
++   indx <- sample(1:ncol(y), replace = TRUE)
++   perm <- sample(1:ncol(y), replace = TRUE)
++ 
++   stopifnot(isequal(as.vector(t(x[indx,]) %*% y[perm, ]),
++                     PermutedLinearStatistic(x, y, indx, perm)))
++ }
+> 
+> proc.time()
+   user  system elapsed 
+  0.776   0.020   0.793