tests/TreeGrow-regtest.R

In party: A Laboratory for Recursive Partytioning

set.seed(290875)
library("party")
if (!require("TH.data"))
    stop("cannot load package TH.data")
if (!require("coin"))
    stop("cannot load package coin")

### get rid of the NAMESPACE
attach(list2env(as.list(asNamespace("party"))))

gtctrl <- new("GlobalTestControl")
tlev <- levels(gtctrl@testtype)

data(GlaucomaM, package = "TH.data")
gtree <- ctree(Class ~ ., data = GlaucomaM)
tree <- gtree@tree
stopifnot(isequal(tree[[5]][[3]], 0.059))
predict(gtree)

# print(tree)

stump <- ctree(Class ~ ., data = GlaucomaM, 
               control = ctree_control(stump = TRUE))
print(stump)

data(treepipit, package = "coin")

tr <- ctree(counts ~ ., data = treepipit)
tr
plot(tr)


data(GlaucomaM, package = "TH.data")

tr <- ctree(Class ~ ., data = GlaucomaM)
tr
plot(tr)

data(GBSG2, package = "TH.data")  

GBSG2tree <- ctree(Surv(time, cens) ~ ., data = GBSG2)
GBSG2tree
plot(GBSG2tree)
plot(GBSG2tree, terminal_panel = node_surv(GBSG2tree))
survfit(Surv(time, cens) ~ as.factor(GBSG2tree@where), data = GBSG2)
names(GBSG2)

tr <- ctree(Surv(time, cens) ~ ., data = GBSG2, 
            control = ctree_control(teststat = "max", 
                                    testtype = "Univariate"))
tr
plot(tr)

data("mammoexp", package = "TH.data")
attr(mammoexp$ME, "scores") <- 1:3   
attr(mammoexp$SYMPT, "scores") <- 1:4
attr(mammoexp$DECT, "scores") <- 1:3 
names(mammoexp)[names(mammoexp) == "SYMPT"] <- "symptoms"
names(mammoexp)[names(mammoexp) == "PB"] <- "benefit"

names(mammoexp)
tr <- ctree(ME ~ ., data = mammoexp)
tr
plot(tr)

treeresponse(tr, newdata = mammoexp[1:5,])

### check different user interfaces
data("iris")
x <- as.matrix(iris[,colnames(iris) != "Species"])
y <- iris[,"Species"]
newx <- x

ls <- LearningSample(x, y)
p1 <- unlist(treeresponse(ctree(Species ~ ., data = iris), newdata = as.data.frame(newx)))
p2 <- unlist(treeresponse(ctreefit(ls, control = ctree_control()), newdata = as.matrix(newx)))
stopifnot(identical(max(abs(p1 - p2)), 0))

set.seed(29)
p1 <- unlist(treeresponse(cforestfit(ls, control = cforest_unbiased(mtry = 1)), newdata = as.matrix(newx)))
set.seed(29)
p2 <- unlist(treeresponse(cforest(Species ~ ., data = iris, control = cforest_unbiased(mtry = 1)), 
             newdata = as.data.frame(newx)))
stopifnot(identical(max(abs(p1 - p2)), 0))