193 lines (169 with data), 7.0 kB

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
> library("coin")
Loading required package: survival
Loading required package: splines
> 
> "hohnloser" <-
+ structure(list(EF = as.integer(c(11, 11, 12, 13, 13, 13, 15,
+ 17, 20, 20, 20, 20, 20, 21, 22, 22, 22, 22, 23, 24, 24, 24, 24,
+ 24, 24, 24, 25, 25, 26, 26, 26, 27, 28, 30, 30, 31, 31, 32, 33,
+ 33, 33, 33, 34, 34, 34, 34, 36, 37, 38, 38, 38, 39, 40, 41, 41,
+ 41, 43, 43, 43, 44, 44, 49, 50, 51, 51, 51, 52, 52, 52, 56, 56,
+ 56, 57, 57, 58, 58, 58, 59, 60, 60, 61, 64, 64, 64, 64, 65, 70,
+ 70, 72, 75, 77, 77, 80, 93)), month = as.integer(c(1, 5, 14,
+ 2, 10, 39, 16, 17, 1, 1, 1, 8, 29, 22, 1, 3, 11, 15, 13, 1, 1,
+ 3, 5, 7, 11, 33, 3, 16, 1, 13, 23, 20, 12, 1, 1, 18, 20, 23,
+ 9, 12, 17, 21, 1, 5, 14, 38, 6, 1, 3, 12, 18, 8, 19, 3, 10, 15,
+ 19, 31, 33, 23, 24, 5, 13, 4, 21, 28, 3, 16, 37, 1, 3, 33, 23,
+ 29, 5, 9, 36, 19, 1, 10, 7, 1, 6, 7, 14, 6, 5, 23, 36, 30, 10,
+ 20, 7, 22)), cens = as.integer(c(0, 1, 0, 1, 0, 0, 1, 0, 1, 1,
+ 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0,
+ 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1,
+ 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
+ 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+ ))), .Names = c("EF", "month", "cens"), class = "data.frame", row.names =
+ c("1",
+ "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13",
+ "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24",
+ "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35",
+ "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46",
+ "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57",
+ "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68",
+ "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79",
+ "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90",
+ "91", "92", "93", "94"))
> 
> 
> ### 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 cutpoint search
> ###    
> ###    functions defined in file `./src/Splits.c'    
> 
> ### tests for function C_Split
> x <- rnorm(100)
> y <- rnorm(100)
> weights <- rep(1, length(x))
> splitctrl <- new("SplitControl")
> split <- Split(x, y, weights, splitctrl)
> mydata <- data.frame(y, x)
> ms <- show(maxstat_test(y ~ x, data = mydata, distribution = approximate(10)))

	Approximative Maxstat Test

data:  y by x
maxT = 1.1008, p-value = 0.9
sample estimates:
$cutpoint
[1] 1.337766


> stopifnot(isequal(split[[1]], ms$estimate[[1]]))
> stopifnot(isequal(split[[2]], ms$statistic))
> stopifnot(isequal(max(split[[3]]), ms$statistic))
> 
> ### Hohnloser data
> ms <-  show(maxstat_test(Surv(month, cens) ~ EF, data = hohnloser,
+ distribution = approximate(10)))

	Approximative Maxstat Test

data:  Surv(month, cens) by EF
maxT = 3.5647, p-value = 0.1
sample estimates:
$cutpoint
[1] 39


> splitctrl <- new("SplitControl")
> splitctrl@minprob <- 0.1
> splitctrl@minsplit <- as.integer(5)
> 
> split <- Split(hohnloser$EF, logrank_trafo(Surv(hohnloser$month, hohnloser$cens)),
+                rep(1, nrow(hohnloser)), splitctrl)
> stopifnot(isequal(split[[1]], ms$estimate[[1]]))
> stopifnot(isequal(split[[2]], ms$statistic))
> stopifnot(isequal(max(split[[3]]), ms$statistic))
> 
> ### categorical splits
> n <- 100
> xf <- gl(5, 100/5)
> yf <- gl(4, 100/4)[sample(1:length(xf))]
> weights <- rep(1, length(xf))
> splitctrl <- new("SplitControl")
> splitctrl@minprob <- 0.1
> splitctrl@minsplit <- as.integer(5)
> split <- Split(xf, yf, weights, splitctrl)
> split
[[1]]
[1] 1

[[2]]
[1] 4.021194

[[3]]
  [1] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
  [9] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [17] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [25] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [33] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 1.876166 0.000000
 [41] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [49] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [57] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [65] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [73] 0.000000 0.000000 0.000000 0.000000 0.000000 4.021194 0.000000 0.000000
 [81] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [89] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
 [97] 0.000000 0.000000 2.297825 0.000000

[[4]]
[1] 1 1 1 0 1

> 
> ### Check if the statistic used for selecting the split is
> ### correct: For the ranks of a continuous response the statistic
> ### needs to be equal to the standardized Wilcoxon statistic
> 
> y <- rnorm(100) + c(rep(0, 25), rep(1, 25), rep(0, 25), rep(1, 25))
> x <- gl(4, 25)
> weights <- rep(1, length(y))
> split <- Split(x, rank(y), weights, splitctrl)
> levelset <- levels(x)[split[[4]] == 1]
> tstat <- split[[2]]
> p <- wilcox.test(y ~ I(x %in% levelset),corr = FALSE,
+                 alternative = "less")$p.value
> stopifnot(isequal(round(abs(qnorm(p)), 6), round(tstat, 6)))
> 
> y <- rnorm(100) + c(rep(0, 25), rep(1, 25), rep(0, 25), rep(1, 25))
> x <- rnorm(100)
> weights <- rep(1, length(y))
> split <- Split(x, rank(y), weights, splitctrl)
> tstat <- split[[2]]
> p <- wilcox.test(y ~ I(x <= split[[1]]), corr = FALSE,
+                 alternative = "less")$p.value
> stopifnot(isequal(round(abs(qnorm(p)), 6), round(tstat, 6)))
> 
> proc.time()
   user  system elapsed 
  0.708   0.056   0.765