--- 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