[fbf06f]: / partyMod / tests / TreeGrow-regtest.R

Download this file

86 lines (65 with data), 2.3 kB

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