
R version 3.6.0 (2019-04-26) -- "Planting of a Tree"
Copyright (C) 2019 The R Foundation for Statistical Computing
Platform: x86_64-pc-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.

  Natural language support but running in an English locale

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.

> pkgname <- "partykit"
> source(file.path(R.home("share"), "R", "examples-header.R"))
> options(warn = 1)
> library('partykit')
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
> 
> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
> base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')
> cleanEx()
> nameEx("HuntingSpiders")
> ### * HuntingSpiders
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: HuntingSpiders
> ### Title: Abundance of Hunting Spiders
> ### Aliases: HuntingSpiders
> ### Keywords: datasets
> 
> ### ** Examples
> 
> 
> ## load data
> data("HuntingSpiders", package = "partykit")
> 
> ## fit multivariate tree for 12-dimensional species abundance
> ## (warnings by mvtnorm are suppressed)
> suppressWarnings(sptree <- ctree(arct.lute + pard.lugu + zora.spin + pard.nigr + pard.pull +
+   aulo.albi + troc.terr + alop.cune + pard.mont + alop.acce + alop.fabr +
+   arct.peri ~ herbs + reft + moss + sand + twigs + water, data = HuntingSpiders,
+   teststat = "max", minsplit = 5))
> plot(sptree, terminal_panel = node_barplot)
> 
> 
> 
> cleanEx()
> nameEx("WeatherPlay")
> ### * WeatherPlay
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: WeatherPlay
> ### Title: Weather Conditions and Playing a Game
> ### Aliases: WeatherPlay
> ### Keywords: datasets
> 
> ### ** Examples
> 
> ## load weather data
> data("WeatherPlay", package = "partykit")
> WeatherPlay
    outlook temperature humidity windy play
1     sunny          85       85 false   no
2     sunny          80       90  true   no
3  overcast          83       86 false  yes
4     rainy          70       96 false  yes
5     rainy          68       80 false  yes
6     rainy          65       70  true   no
7  overcast          64       65  true  yes
8     sunny          72       95 false   no
9     sunny          69       70 false  yes
10    rainy          75       80 false  yes
11    sunny          75       70  true  yes
12 overcast          72       90  true  yes
13 overcast          81       75 false  yes
14    rainy          71       91  true   no
> 
> ## construct simple tree
> pn <- partynode(1L,
+   split = partysplit(1L, index = 1:3),
+   kids = list(
+     partynode(2L,
+       split = partysplit(3L, breaks = 75),
+       kids = list(
+         partynode(3L, info = "yes"),
+         partynode(4L, info = "no"))),
+     partynode(5L, info = "yes"),
+     partynode(6L,
+       split = partysplit(4L, index = 1:2),
+       kids = list(
+         partynode(7L, info = "yes"),
+         partynode(8L, info = "no")))))
> pn
[1] root
|   [2] V1 in (-Inf,1]
|   |   [3] V3 <= 75 *
|   |   [4] V3 > 75 *
|   [5] V1 in (1,2] *
|   [6] V1 in (2, Inf]
|   |   [7] V4 <= 1 *
|   |   [8] V4 > 1 *
> 
> ## couple with data
> py <- party(pn, WeatherPlay)
> 
> ## print/plot/predict
> print(py)
[1] root
|   [2] outlook in sunny
|   |   [3] humidity <= 75: yes
|   |   [4] humidity > 75: no
|   [5] outlook in overcast: yes
|   [6] outlook in rainy
|   |   [7] windy in false: yes
|   |   [8] windy in true: no
> plot(py)
> predict(py, newdata = WeatherPlay)
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 
 4  4  5  7  7  8  5  4  3  7  3  5  5  8 
> 
> ## customize printing
> print(py,
+   terminal_panel = function(node) paste(": play=", info_node(node), sep = ""))
[1] root
|   [2] outlook in sunny
|   |   [3] humidity <= 75: play=yes
|   |   [4] humidity > 75: play=no
|   [5] outlook in overcast: play=yes
|   [6] outlook in rainy
|   |   [7] windy in false: play=yes
|   |   [8] windy in true: play=no
> 
> 
> 
> cleanEx()
> nameEx("cforest")
> ### * cforest
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: cforest
> ### Title: Conditional Random Forests
> ### Aliases: cforest gettree gettree.cforest predict.cforest
> ### Keywords: tree
> 
> ### ** Examples
> 
> ## basic example: conditional inference forest for cars data
> cf <- cforest(dist ~ speed, data = cars)
> 
> ## prediction of fitted mean and visualization
> nd <- data.frame(speed = 4:25)
> nd$mean  <- predict(cf, newdata = nd, type = "response")
> plot(dist ~ speed, data = cars)
> lines(mean ~ speed, data = nd)
> 
> ## predict quantiles (aka quantile regression forest)
> myquantile <- function(y, w) quantile(rep(y, w), probs = c(0.1, 0.5, 0.9))
> p <- predict(cf, newdata = nd, type = "response", FUN = myquantile)
> colnames(p) <- c("lower", "median", "upper")
> nd <- cbind(nd, p)
> 
> ## visualization with conditional (on speed) prediction intervals
> plot(dist ~ speed, data = cars, type = "n")
> with(nd, polygon(c(speed, rev(speed)), c(lower, rev(upper)),
+   col = "lightgray", border = "transparent"))
> points(dist ~ speed, data = cars)
> lines(mean ~ speed, data = nd, lwd = 1.5)
> lines(median ~ speed, data = nd, lty = 2, lwd = 1.5)
> legend("topleft", c("mean", "median", "10% - 90% quantile"),
+   lwd = c(1.5, 1.5, 10), lty = c(1, 2, 1),
+   col = c("black", "black", "lightgray"), bty = "n")
> 
> ### we may also use predicted conditional (on speed) densities
> mydensity <- function (y, w) approxfun(density(y, weights = w/sum(w))[1:2], rule = 2)
> pd <- predict(cf, newdata = nd, type = "response", FUN = mydensity)
> 
> ## visualization in heatmap (instead of scatterplot)
> ## with fitted curves as above
> dist <- -10:150
> dens <- t(sapply(seq_along(pd), function(i) pd[[i]](dist)))
> image(nd$speed, dist, dens, xlab = "speed", col = rev(gray.colors(9)))
> lines(mean ~ speed, data = nd, lwd = 1.5)
> lines(median ~ speed, data = nd, lty = 2, lwd = 1.5)
> lines(lower ~ speed, data = nd, lty = 2)
> lines(upper ~ speed, data = nd, lty = 2)
> 
> ## Not run: 
> ##D 
> ##D ### honest (i.e., out-of-bag) cross-classification of
> ##D ### true vs. predicted classes
> ##D data("mammoexp", package = "TH.data")
> ##D table(mammoexp$ME, predict(cforest(ME ~ ., data = mammoexp, ntree = 50),
> ##D                            OOB = TRUE, type = "response"))
> ##D 
> ##D ### fit forest to censored response
> ##D if (require("TH.data") && require("survival")) {
> ##D 
> ##D     data("GBSG2", package = "TH.data")
> ##D     bst <- cforest(Surv(time, cens) ~ ., data = GBSG2, ntree = 50)
> ##D 
> ##D     ### estimate conditional Kaplan-Meier curves
> ##D     print(predict(bst, newdata = GBSG2[1:2,], OOB = TRUE, type = "prob"))
> ##D 
> ##D     print(gettree(bst))
> ##D }
> ## End(Not run)
> 
> 
> 
> cleanEx()
> nameEx("ctree")
> ### * ctree
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: ctree
> ### Title: Conditional Inference Trees
> ### Aliases: ctree sctest.constparty
> ### Keywords: tree
> 
> ### ** Examples
> 
> ### regression
> airq <- subset(airquality, !is.na(Ozone))
> airct <- ctree(Ozone ~ ., data = airq)
> airct

Model formula:
Ozone ~ Solar.R + Wind + Temp + Month + Day

Fitted party:
[1] root
|   [2] Temp <= 82
|   |   [3] Wind <= 6.9: 55.600 (n = 10, err = 21946.4)
|   |   [4] Wind > 6.9
|   |   |   [5] Temp <= 77: 18.479 (n = 48, err = 3956.0)
|   |   |   [6] Temp > 77: 31.143 (n = 21, err = 4620.6)
|   [7] Temp > 82
|   |   [8] Wind <= 10.3: 81.633 (n = 30, err = 15119.0)
|   |   [9] Wind > 10.3: 48.714 (n = 7, err = 1183.4)

Number of inner nodes:    4
Number of terminal nodes: 5
> plot(airct)
> mean((airq$Ozone - predict(airct))^2)
[1] 403.6668
> 
> ### classification
> irisct <- ctree(Species ~ .,data = iris)
> irisct

Model formula:
Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width

Fitted party:
[1] root
|   [2] Petal.Length <= 1.9: setosa (n = 50, err = 0.0%)
|   [3] Petal.Length > 1.9
|   |   [4] Petal.Width <= 1.7
|   |   |   [5] Petal.Length <= 4.8: versicolor (n = 46, err = 2.2%)
|   |   |   [6] Petal.Length > 4.8: versicolor (n = 8, err = 50.0%)
|   |   [7] Petal.Width > 1.7: virginica (n = 46, err = 2.2%)

Number of inner nodes:    3
Number of terminal nodes: 4
> plot(irisct)
> table(predict(irisct), iris$Species)
            
             setosa versicolor virginica
  setosa         50          0         0
  versicolor      0         49         5
  virginica       0          1        45
> 
> ### estimated class probabilities, a list
> tr <- predict(irisct, newdata = iris[1:10,], type = "prob")
> 
> ### survival analysis
> if (require("TH.data") && require("survival") && 
+     require("coin") && require("Formula")) {
+ 
+   data("GBSG2", package = "TH.data")
+   (GBSG2ct <- ctree(Surv(time, cens) ~ ., data = GBSG2))
+   predict(GBSG2ct, newdata = GBSG2[1:2,], type = "response")	  
+   plot(GBSG2ct)
+ 
+   ### with weight-dependent log-rank scores
+   ### log-rank trafo for observations in this node only (= weights > 0)
+   h <- function(y, x, start = NULL, weights, offset, estfun = TRUE, object = FALSE, ...) {
+       if (is.null(weights)) weights <- rep(1, NROW(y))
+       s <- logrank_trafo(y[weights > 0,,drop = FALSE])
+       r <- rep(0, length(weights))
+       r[weights > 0] <- s
+       list(estfun = matrix(as.double(r), ncol = 1), converged = TRUE)
+   }
+ 
+   ### very much the same tree
+   (ctree(Surv(time, cens) ~ ., data = GBSG2, ytrafo = h))
+ }
Loading required package: TH.data
Loading required package: survival
Loading required package: MASS

Attaching package: ‘TH.data’

The following object is masked from ‘package:MASS’:

    geyser

Loading required package: coin
Loading required package: Formula

Model formula:
Surv(time, cens) ~ horTh + age + menostat + tsize + tgrade + 
    pnodes + progrec + estrec

Fitted party:
[1] root
|   [2] pnodes <= 3
|   |   [3] horTh in no: 2093.000 (n = 248)
|   |   [4] horTh in yes: Inf (n = 128)
|   [5] pnodes > 3
|   |   [6] progrec <= 20: 624.000 (n = 144)
|   |   [7] progrec > 20: 1701.000 (n = 166)

Number of inner nodes:    3
Number of terminal nodes: 4
> 
> ### multivariate responses
> airct2 <- ctree(Ozone + Temp ~ ., data = airq)
> airct2

Model formula:
~Ozone + Temp + (Solar.R + Wind + Month + Day)

Fitted party:
[1] root
|   [2] Wind <= 6.3: *
|   [3] Wind > 6.3
|   |   [4] Month <= 5: *
|   |   [5] Month > 5
|   |   |   [6] Wind <= 9.7: *
|   |   |   [7] Wind > 9.7
|   |   |   |   [8] Day <= 13: *
|   |   |   |   [9] Day > 13: *

Number of inner nodes:    4
Number of terminal nodes: 5
> plot(airct2)
> 
> 
> 
> cleanEx()

detaching ‘package:Formula’, ‘package:coin’, ‘package:TH.data’,
  ‘package:MASS’, ‘package:survival’

> nameEx("extree_data")
> ### * extree_data
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: extree_data
> ### Title: Data Preprocessing for Extensible Trees.
> ### Aliases: extree_data
> ### Keywords: tree
> 
> ### ** Examples
> 
> 
>   data("iris")
> 
>   ed <- extree_data(Species ~ Sepal.Width + Sepal.Length | Petal.Width + Petal.Length, 
+                     data = iris, nmax = c("yx" = 25, "z" = 10), yx = "matrix")
> 
>   ### the model.frame
>   mf <- model.frame(ed)
>   all.equal(mf, iris[, names(mf)])
[1] "Attributes: < Length mismatch: comparison on first 2 components >"
> 
>   ### binned y ~ x part
>   model.frame(ed, yxonly = TRUE)
       Species Sepal.Width Sepal.Length
1       setosa         2.3        4.600
2       setosa         2.9        4.600
3       setosa         3.0        4.600
4       setosa         3.1        4.600
5       setosa         3.2        4.600
6       setosa         3.4        4.600
7       setosa         3.6        4.600
8       setosa         3.0        4.800
9       setosa         3.1        4.800
10      setosa         3.2        4.800
11      setosa         3.4        4.800
12  versicolor         2.4        4.900
13   virginica         2.5        4.900
14      setosa         3.0        4.900
15      setosa         3.1        4.900
16      setosa         3.6        4.900
17  versicolor         2.0        5.000
18  versicolor         2.3        5.000
19      setosa         3.0        5.000
20      setosa         3.2        5.000
21      setosa         3.3        5.000
22      setosa         3.4        5.000
23      setosa         3.5        5.000
24      setosa         3.6        5.000
25  versicolor         2.5        5.100
26      setosa         3.3        5.100
27      setosa         3.4        5.100
28      setosa         3.5        5.100
29      setosa         3.7        5.100
30      setosa         3.8        5.100
31  versicolor         2.7        5.200
32      setosa         3.4        5.200
33      setosa         3.5        5.200
34      setosa         4.1        5.200
35  versicolor         3.0        5.400
36      setosa         3.4        5.400
37      setosa         3.7        5.400
38      setosa         3.9        5.400
39  versicolor         2.3        5.500
40  versicolor         2.4        5.500
41  versicolor         2.5        5.500
42  versicolor         2.6        5.500
43      setosa         3.5        5.500
44      setosa         4.2        5.500
45  versicolor         2.5        5.600
46  versicolor         2.7        5.600
47   virginica         2.8        5.600
48  versicolor         2.9        5.600
49  versicolor         3.0        5.600
50   virginica         2.5        5.700
51  versicolor         2.6        5.700
52  versicolor         2.8        5.700
53  versicolor         2.9        5.700
54  versicolor         3.0        5.700
55      setosa         3.8        5.700
56      setosa         4.4        5.700
57  versicolor         2.6        5.800
58  versicolor         2.7        5.800
59   virginica         2.7        5.800
60   virginica         2.8        5.800
61      setosa         4.0        5.800
62  versicolor         2.2        6.000
63   virginica         2.2        6.000
64  versicolor         2.7        6.000
65  versicolor         2.9        6.000
66  versicolor         3.0        6.000
67   virginica         3.0        6.000
68  versicolor         3.2        6.000
69  versicolor         3.4        6.000
70   virginica         2.6        6.100
71  versicolor         2.8        6.100
72  versicolor         2.9        6.100
73  versicolor         3.0        6.100
74   virginica         3.0        6.100
75  versicolor         2.2        6.200
76   virginica         2.8        6.200
77  versicolor         2.9        6.200
78   virginica         3.4        6.200
79  versicolor         2.3        6.300
80  versicolor         2.5        6.300
81   virginica         2.5        6.300
82   virginica         2.7        6.300
83   virginica         2.8        6.300
84   virginica         2.9        6.300
85  versicolor         3.3        6.300
86   virginica         3.3        6.300
87   virginica         3.4        6.300
88   virginica         2.7        6.400
89   virginica         2.8        6.400
90  versicolor         2.9        6.400
91   virginica         3.1        6.400
92  versicolor         3.2        6.400
93   virginica         3.2        6.400
94  versicolor         2.8        6.520
95   virginica         3.0        6.520
96   virginica         3.2        6.520
97   virginica         2.5        6.700
98  versicolor         2.9        6.700
99  versicolor         3.0        6.700
100  virginica         3.0        6.700
101 versicolor         3.1        6.700
102  virginica         3.1        6.700
103  virginica         3.3        6.700
104 versicolor         2.8        6.800
105  virginica         3.0        6.800
106  virginica         3.2        6.800
107 versicolor         3.1        7.008
108  virginica         3.1        7.008
109 versicolor         3.2        7.008
110  virginica         3.2        7.008
111  virginica         2.8        7.408
112  virginica         2.9        7.408
113  virginica         3.0        7.408
114  virginica         3.2        7.408
115  virginica         3.6        7.408
116  virginica         2.6        7.900
117  virginica         2.8        7.900
118  virginica         3.0        7.900
119  virginica         3.8        7.900
> 
>   ### binned Petal.Width
>   ed[[4, type = "index"]]
  [1] 0.2  0.2  0.2  0.2  0.2  0.4  0.4  0.2  0.2  0.2  0.2  0.2  0.2  0.2  0.2 
 [16] 0.4  0.4  0.4  0.4  0.4  0.2  0.4  0.2  1.16 0.2  0.2  0.4  0.2  0.2  0.2 
 [31] 0.2  0.4  0.2  0.2  0.2  0.2  0.2  0.2  0.2  0.2  0.4  0.4  0.2  1.16 0.4 
 [46] 0.4  0.2  0.2  0.2  0.2  1.5  1.5  1.5  1.3  1.5  1.3  1.8  1.16 1.3  1.5 
 [61] 1.16 1.5  1.16 1.5  1.3  1.5  1.5  1.16 1.5  1.16 1.8  1.3  1.5  1.3  1.3 
 [76] 1.5  1.5  1.8  1.5  1.16 1.16 1.16 1.3  1.8  1.5  1.8  1.5  1.3  1.3  1.3 
 [91] 1.3  1.5  1.3  1.16 1.3  1.3  1.3  1.3  1.16 1.3  2.5  1.9  2.2  1.8  2.2 
[106] 2.2  1.8  1.8  1.8  2.5  2.2  1.9  2.2  2.2  2.5  2.5  1.8  2.2  2.5  1.5 
[121] 2.5  2.2  2.2  1.8  2.2  1.8  1.8  1.8  2.2  1.8  1.9  2.2  2.2  1.5  1.5 
[136] 2.5  2.5  1.8  1.8  2.2  2.5  2.5  1.9  2.5  2.5  2.5  1.9  2.2  2.5  1.8 
Levels: 0.2 0.4 1.16 1.3 1.5 1.8 1.9 2.2 2.5
> 
>   ### response
>   ed$yx$y
  [1] setosa     setosa     setosa     setosa     setosa     setosa    
  [7] setosa     setosa     setosa     setosa     setosa     versicolor
 [13] virginica  setosa     setosa     setosa     versicolor versicolor
 [19] setosa     setosa     setosa     setosa     setosa     setosa    
 [25] versicolor setosa     setosa     setosa     setosa     setosa    
 [31] versicolor setosa     setosa     setosa     versicolor setosa    
 [37] setosa     setosa     versicolor versicolor versicolor versicolor
 [43] setosa     setosa     versicolor versicolor virginica  versicolor
 [49] versicolor virginica  versicolor versicolor versicolor versicolor
 [55] setosa     setosa     versicolor versicolor virginica  virginica 
 [61] setosa     versicolor virginica  versicolor versicolor versicolor
 [67] virginica  versicolor versicolor virginica  versicolor versicolor
 [73] versicolor virginica  versicolor virginica  versicolor virginica 
 [79] versicolor versicolor virginica  virginica  virginica  virginica 
 [85] versicolor virginica  virginica  virginica  virginica  versicolor
 [91] virginica  versicolor virginica  versicolor virginica  virginica 
 [97] virginica  versicolor versicolor virginica  versicolor virginica 
[103] virginica  versicolor virginica  virginica  versicolor virginica 
[109] versicolor virginica  virginica  virginica  virginica  virginica 
[115] virginica  virginica  virginica  virginica  virginica 
Levels: setosa versicolor virginica
> 
>   ### model matrix 
>   ed$yx$x
    (Intercept) Sepal.Width Sepal.Length
1             1         2.3        4.600
2             1         2.9        4.600
3             1         3.0        4.600
4             1         3.1        4.600
5             1         3.2        4.600
6             1         3.4        4.600
7             1         3.6        4.600
8             1         3.0        4.800
9             1         3.1        4.800
10            1         3.2        4.800
11            1         3.4        4.800
12            1         2.4        4.900
13            1         2.5        4.900
14            1         3.0        4.900
15            1         3.1        4.900
16            1         3.6        4.900
17            1         2.0        5.000
18            1         2.3        5.000
19            1         3.0        5.000
20            1         3.2        5.000
21            1         3.3        5.000
22            1         3.4        5.000
23            1         3.5        5.000
24            1         3.6        5.000
25            1         2.5        5.100
26            1         3.3        5.100
27            1         3.4        5.100
28            1         3.5        5.100
29            1         3.7        5.100
30            1         3.8        5.100
31            1         2.7        5.200
32            1         3.4        5.200
33            1         3.5        5.200
34            1         4.1        5.200
35            1         3.0        5.400
36            1         3.4        5.400
37            1         3.7        5.400
38            1         3.9        5.400
39            1         2.3        5.500
40            1         2.4        5.500
41            1         2.5        5.500
42            1         2.6        5.500
43            1         3.5        5.500
44            1         4.2        5.500
45            1         2.5        5.600
46            1         2.7        5.600
47            1         2.8        5.600
48            1         2.9        5.600
49            1         3.0        5.600
50            1         2.5        5.700
51            1         2.6        5.700
52            1         2.8        5.700
53            1         2.9        5.700
54            1         3.0        5.700
55            1         3.8        5.700
56            1         4.4        5.700
57            1         2.6        5.800
58            1         2.7        5.800
59            1         2.7        5.800
60            1         2.8        5.800
61            1         4.0        5.800
62            1         2.2        6.000
63            1         2.2        6.000
64            1         2.7        6.000
65            1         2.9        6.000
66            1         3.0        6.000
67            1         3.0        6.000
68            1         3.2        6.000
69            1         3.4        6.000
70            1         2.6        6.100
71            1         2.8        6.100
72            1         2.9        6.100
73            1         3.0        6.100
74            1         3.0        6.100
75            1         2.2        6.200
76            1         2.8        6.200
77            1         2.9        6.200
78            1         3.4        6.200
79            1         2.3        6.300
80            1         2.5        6.300
81            1         2.5        6.300
82            1         2.7        6.300
83            1         2.8        6.300
84            1         2.9        6.300
85            1         3.3        6.300
86            1         3.3        6.300
87            1         3.4        6.300
88            1         2.7        6.400
89            1         2.8        6.400
90            1         2.9        6.400
91            1         3.1        6.400
92            1         3.2        6.400
93            1         3.2        6.400
94            1         2.8        6.520
95            1         3.0        6.520
96            1         3.2        6.520
97            1         2.5        6.700
98            1         2.9        6.700
99            1         3.0        6.700
100           1         3.0        6.700
101           1         3.1        6.700
102           1         3.1        6.700
103           1         3.3        6.700
104           1         2.8        6.800
105           1         3.0        6.800
106           1         3.2        6.800
107           1         3.1        7.008
108           1         3.1        7.008
109           1         3.2        7.008
110           1         3.2        7.008
111           1         2.8        7.408
112           1         2.9        7.408
113           1         3.0        7.408
114           1         3.2        7.408
115           1         3.6        7.408
116           1         2.6        7.900
117           1         2.8        7.900
118           1         3.0        7.900
119           1         3.8        7.900
attr(,"assign")
[1] 0 1 2
attr(,"formula")
Species ~ Sepal.Width + Sepal.Length
<environment: 0x563beb6f5178>
attr(,"terms")
Species ~ Sepal.Width + Sepal.Length
attr(,"variables")
list(Species, Sepal.Width, Sepal.Length)
attr(,"factors")
             Sepal.Width Sepal.Length
Species                0            0
Sepal.Width            1            0
Sepal.Length           0            1
attr(,"term.labels")
[1] "Sepal.Width"  "Sepal.Length"
attr(,"order")
[1] 1 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: 0x563beb6f5178>
> 
> 
> 
> 
> cleanEx()
> nameEx("glmtree")
> ### * glmtree
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: glmtree
> ### Title: Generalized Linear Model Trees
> ### Aliases: glmtree plot.glmtree predict.glmtree print.glmtree
> ### Keywords: tree
> 
> ### ** Examples
> 
> if(require("mlbench")) {
+ 
+ ## Pima Indians diabetes data
+ data("PimaIndiansDiabetes", package = "mlbench")
+ 
+ ## recursive partitioning of a logistic regression model
+ pid_tree2 <- glmtree(diabetes ~ glucose | pregnant +
+   pressure + triceps + insulin + mass + pedigree + age,
+   data = PimaIndiansDiabetes, family = binomial)
+ 
+ ## printing whole tree or individual nodes
+ print(pid_tree2)
+ print(pid_tree2, node = 1)
+ 
+ ## visualization
+ plot(pid_tree2)
+ plot(pid_tree2, tp_args = list(cdplot = TRUE))
+ plot(pid_tree2, terminal_panel = NULL)
+ 
+ ## estimated parameters
+ coef(pid_tree2)
+ coef(pid_tree2, node = 5)
+ summary(pid_tree2, node = 5)
+ 
+ ## deviance, log-likelihood and information criteria
+ deviance(pid_tree2)
+ logLik(pid_tree2)
+ AIC(pid_tree2)
+ BIC(pid_tree2)
+ 
+ ## different types of predictions
+ pid <- head(PimaIndiansDiabetes)
+ predict(pid_tree2, newdata = pid, type = "node")
+ predict(pid_tree2, newdata = pid, type = "response")
+ predict(pid_tree2, newdata = pid, type = "link")
+ 
+ }
Loading required package: mlbench
Generalized linear model tree (family: binomial)

Model formula:
diabetes ~ glucose | pregnant + pressure + triceps + insulin + 
    mass + pedigree + age

Fitted party:
[1] root
|   [2] mass <= 26.3: n = 167
|       (Intercept)     glucose 
|       -9.95150963  0.05870786 
|   [3] mass > 26.3
|   |   [4] age <= 30: n = 304
|   |       (Intercept)     glucose 
|   |       -6.70558554  0.04683748 
|   |   [5] age > 30: n = 297
|   |       (Intercept)     glucose 
|   |       -2.77095386  0.02353582 

Number of inner nodes:    2
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 355.4578
Generalized linear model tree (family: binomial) 
-- Node 1 --

Estimated parameters:
(Intercept)     glucose 
-5.35008039  0.03787304 

Objective function:
404.3598

Parameter instability tests:
              pregnant  pressure    triceps   insulin         mass    pedigree
statistic 2.988542e+01 7.5024235 15.9409542 6.5969297 4.880982e+01 18.33476114
p.value   9.778517e-05 0.9104325  0.0647362 0.9701412 8.316815e-09  0.02252955
                   age
statistic 4.351412e+01
p.value   1.182811e-07
Loading required namespace: vcd
         1          2          3          4          5          6 
 0.7123469 -0.7704095  0.7920297 -2.5370501  0.4534529 -3.1413973 
> 
> 
> 
> cleanEx()

detaching ‘package:mlbench’

> nameEx("lmtree")
> ### * lmtree
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: lmtree
> ### Title: Linear Model Trees
> ### Aliases: lmtree plot.lmtree predict.lmtree print.lmtree
> ### Keywords: tree
> 
> ### ** Examples
> 
> if(require("mlbench")) {
+ 
+ ## Boston housing data
+ data("BostonHousing", package = "mlbench")
+ BostonHousing <- transform(BostonHousing,
+   chas = factor(chas, levels = 0:1, labels = c("no", "yes")),
+   rad = factor(rad, ordered = TRUE))
+ 
+ ## linear model tree
+ bh_tree <- lmtree(medv ~ log(lstat) + I(rm^2) | zn +
+   indus + chas + nox + age + dis + rad + tax + crim + b + ptratio,
+   data = BostonHousing, minsize = 40)
+ 
+ ## printing whole tree or individual nodes
+ print(bh_tree)
+ print(bh_tree, node = 7)
+ 
+ ## plotting
+ plot(bh_tree)
+ plot(bh_tree, tp_args = list(which = "log(lstat)"))
+ plot(bh_tree, terminal_panel = NULL)
+ 
+ ## estimated parameters
+ coef(bh_tree)
+ coef(bh_tree, node = 9)
+ summary(bh_tree, node = 9)
+ 
+ ## various ways for computing the mean squared error (on the training data)
+ mean((BostonHousing$medv - fitted(bh_tree))^2)
+ mean(residuals(bh_tree)^2)
+ deviance(bh_tree)/sum(weights(bh_tree))
+ deviance(bh_tree)/nobs(bh_tree)
+ 
+ ## log-likelihood and information criteria
+ logLik(bh_tree)
+ AIC(bh_tree)
+ BIC(bh_tree)
+ ## (Note that this penalizes estimation of error variances, which
+ ## were treated as nuisance parameters in the fitting process.)
+ 
+ ## different types of predictions
+ bh <- BostonHousing[c(1, 10, 50), ]
+ predict(bh_tree, newdata = bh, type = "node")
+ predict(bh_tree, newdata = bh, type = "response")
+ predict(bh_tree, newdata = bh, type = function(object) summary(object)$r.squared)
+ 
+ }
Loading required package: mlbench
Linear model tree

Model formula:
medv ~ log(lstat) + I(rm^2) | zn + indus + chas + nox + age + 
    dis + rad + tax + crim + b + ptratio

Fitted party:
[1] root
|   [2] tax <= 432
|   |   [3] ptratio <= 15.2: n = 72
|   |       (Intercept)  log(lstat)     I(rm^2) 
|   |         9.2348804  -4.9390955   0.6859136 
|   |   [4] ptratio > 15.2
|   |   |   [5] ptratio <= 19.6
|   |   |   |   [6] tax <= 265: n = 63
|   |   |   |       (Intercept)  log(lstat)     I(rm^2) 
|   |   |   |         3.9637196  -2.7662873   0.6881287 
|   |   |   |   [7] tax > 265: n = 162
|   |   |   |       (Intercept)  log(lstat)     I(rm^2) 
|   |   |   |        -1.7983871  -0.2677070   0.6538864 
|   |   |   [8] ptratio > 19.6: n = 56
|   |   |       (Intercept)  log(lstat)     I(rm^2) 
|   |   |        17.5864899  -4.6189750   0.3386744 
|   [9] tax > 432: n = 153
|       (Intercept)  log(lstat)     I(rm^2) 
|        68.2970874 -16.3540061  -0.1477939 

Number of inner nodes:    4
Number of terminal nodes: 5
Number of parameters per node: 3
Objective function (residual sum of squares): 6089.803
Linear model tree 
-- Node 7 --

Estimated parameters:
(Intercept)  log(lstat)     I(rm^2) 
 -1.7983871  -0.2677070   0.6538864 

Objective function:
1118.535

Parameter instability tests:
                 zn     indus     chas       nox        age       dis
statistic 11.998039 7.3971233 7.227770 9.2936189 14.3023962 8.9239826
p.value    0.574642 0.9931875 0.522447 0.9119621  0.2886603 0.9389895
                 rad        tax       crim         b    ptratio
statistic 33.1746444 16.6666129 11.7143758 9.9050903 11.5927528
p.value    0.3926249  0.1206412  0.6153455 0.8539893  0.6328381
        1        10        50 
0.8172892 0.9220070 0.8176030 
> 
> 
> if(require("AER")) {
+ 
+ ## Demand for economics journals data
+ data("Journals", package = "AER")
+ Journals <- transform(Journals,
+   age = 2000 - foundingyear,
+   chars = charpp * pages)
+ 
+ ## linear regression tree (OLS)
+ j_tree <- lmtree(log(subs) ~ log(price/citations) | price + citations +
+   age + chars + society, data = Journals, minsize = 10, verbose = TRUE)
+ 
+ ## printing and plotting
+ j_tree
+ plot(j_tree)
+ 
+ ## coefficients and summary
+ coef(j_tree, node = 1:3)
+ summary(j_tree, node = 1:3)
+ 
+ }
Loading required package: AER
Loading required package: car
Loading required package: carData
Loading required package: lmtest
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: survival

-- Node 1 ---------------------------------
Number of observations: 180

Parameter instability tests:
              price citations          age     chars   society
statistic 6.5617160  5.261443 4.219816e+01 4.5638410 3.2797248
p.value   0.9217588  0.988134 1.629130e-07 0.9976804 0.6598605

Best splitting variable: age
Perform split? yes
Selected split: <= 18 | > 18

-- Node 2 ---------------------------------
Number of observations: 53

Parameter instability tests:
              price citations       age     chars   society
statistic 3.3415225 3.7259445 5.6132430 6.0399915 0.6495396
p.value   0.9996007 0.9984132 0.9353808 0.8978925 0.9983602

Best splitting variable: chars
Perform split? no

-- Node 3 ---------------------------------
Number of observations: 127

Parameter instability tests:
              price citations      age     chars   society
statistic 3.3695027  6.839065 5.986772 3.6768804 0.6083476
p.value   0.9999824  0.894352 0.959765 0.9999056 0.9987591

Best splitting variable: citations
Perform split? no

$`1`

Call:
lm(formula = log(subs) ~ log(price/citations))

Residuals:
     Min       1Q   Median       3Q      Max 
-2.72478 -0.53609  0.03721  0.46619  1.84808 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)    
(Intercept)           4.76621    0.05591   85.25   <2e-16 ***
log(price/citations) -0.53305    0.03561  -14.97   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.7497 on 178 degrees of freedom
Multiple R-squared:  0.5573,	Adjusted R-squared:  0.5548 
F-statistic:   224 on 1 and 178 DF,  p-value: < 2.2e-16


$`2`

Call:
lm(formula = log(subs) ~ log(price/citations))

Residuals:
     Min       1Q   Median       3Q      Max 
-2.12974 -0.37882 -0.05063  0.35693  1.57877 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)    
(Intercept)           4.35278    0.11687  37.244  < 2e-16 ***
log(price/citations) -0.60486    0.07483  -8.083 1.08e-10 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.6682 on 51 degrees of freedom
Multiple R-squared:  0.5616,	Adjusted R-squared:  0.553 
F-statistic: 65.34 on 1 and 51 DF,  p-value: 1.078e-10


$`3`

Call:
lm(formula = log(subs) ~ log(price/citations))

Residuals:
     Min       1Q   Median       3Q      Max 
-2.16039 -0.38995  0.08398  0.41365  1.52063 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)    
(Intercept)           5.01127    0.05985   83.74   <2e-16 ***
log(price/citations) -0.40298    0.03804  -10.59   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.659 on 125 degrees of freedom
Multiple R-squared:  0.4731,	Adjusted R-squared:  0.4689 
F-statistic: 112.2 on 1 and 125 DF,  p-value: < 2.2e-16


> 
> 
> if(require("AER")) {
+ 
+ ## Beauty and teaching ratings data
+ data("TeachingRatings", package = "AER")
+ 
+ ## linear regression (WLS)
+ ## null model
+ tr_null <- lm(eval ~ 1, data = TeachingRatings, weights = students,
+   subset = credits == "more")
+ ## main effects
+ tr_lm <- lm(eval ~ beauty + gender + minority + native + tenure + division,
+   data = TeachingRatings, weights = students, subset = credits == "more")
+ ## tree
+ tr_tree <- lmtree(eval ~ beauty | minority + age + gender + division + native + tenure,
+    data = TeachingRatings, weights = students, subset = credits == "more",
+    caseweights = FALSE)
+ 
+ ## visualization
+ plot(tr_tree)
+ 
+ ## beauty slope coefficient
+ coef(tr_lm)[2]
+ coef(tr_tree)[, 2]
+ 
+ ## R-squared
+ 1 - deviance(tr_lm)/deviance(tr_null)
+ 1 - deviance(tr_tree)/deviance(tr_null)
+ }
[1] 0.3820419
> 
> 
> 
> 
> cleanEx()

detaching ‘package:AER’, ‘package:survival’, ‘package:sandwich’,
  ‘package:lmtest’, ‘package:zoo’, ‘package:car’, ‘package:carData’,
  ‘package:mlbench’

> nameEx("mob")
> ### * mob
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: mob
> ### Title: Model-based Recursive Partitioning
> ### Aliases: mob modelparty coef.modelparty deviance.modelparty
> ###   fitted.modelparty formula.modelparty getCall.modelparty
> ###   logLik.modelparty model.frame.modelparty nobs.modelparty
> ###   plot.modelparty predict.modelparty print.modelparty
> ###   residuals.modelparty summary.modelparty weights.modelparty
> ###   refit.modelparty sctest.modelparty
> ### Keywords: tree
> 
> ### ** Examples
> 
> if(require("mlbench")) {
+ 
+ ## Pima Indians diabetes data
+ data("PimaIndiansDiabetes", package = "mlbench")
+ 
+ ## a simple basic fitting function (of type 1) for a logistic regression
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+   glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+ 
+ ## set up a logistic regression tree
+ pid_tree <- mob(diabetes ~ glucose | pregnant + pressure + triceps + insulin +
+   mass + pedigree + age, data = PimaIndiansDiabetes, fit = logit)
+ ## see lmtree() and glmtree() for interfaces with more efficient fitting functions
+ 
+ ## print tree
+ print(pid_tree)
+ 
+ ## print information about (some) nodes
+ print(pid_tree, node = 3:4)
+ 
+ ## visualization
+ plot(pid_tree)
+ 
+ ## coefficients and summary
+ coef(pid_tree)
+ coef(pid_tree, node = 1)
+ summary(pid_tree, node = 1)
+ 
+ ## average deviance computed in different ways
+ mean(residuals(pid_tree)^2)
+ deviance(pid_tree)/sum(weights(pid_tree))
+ deviance(pid_tree)/nobs(pid_tree)
+ 
+ ## log-likelihood and information criteria
+ logLik(pid_tree)
+ AIC(pid_tree)
+ BIC(pid_tree)
+ 
+ ## predicted nodes
+ predict(pid_tree, newdata = head(PimaIndiansDiabetes, 6), type = "node")
+ ## other types of predictions are possible using lmtree()/glmtree()
+ }
Loading required package: mlbench
Model-based recursive partitioning (logit)

Model formula:
diabetes ~ glucose | pregnant + pressure + triceps + insulin + 
    mass + pedigree + age

Fitted party:
[1] root
|   [2] mass <= 26.3: n = 167
|       x(Intercept)     xglucose 
|        -9.95150963   0.05870786 
|   [3] mass > 26.3
|   |   [4] age <= 30: n = 304
|   |       x(Intercept)     xglucose 
|   |        -6.70558554   0.04683748 
|   |   [5] age > 30: n = 297
|   |       x(Intercept)     xglucose 
|   |        -2.77095386   0.02353582 

Number of inner nodes:    2
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function: 355.4578
Model-based recursive partitioning (logit) 
-- Node 3 --

Estimated parameters:
x(Intercept)     xglucose 
 -4.61015031   0.03426267 

Objective function:
344.225

Parameter instability tests:
              pregnant  pressure  triceps   insulin      mass    pedigree
statistic 2.673912e+01 6.1757583 7.346804 7.8963977 9.1545915 17.96438828
p.value   4.434356e-04 0.9845137 0.922646 0.8700398 0.7033477  0.02646585
                   age
statistic 3.498466e+01
p.value   8.098640e-06

-- Node 4 --

Estimated parameters:
x(Intercept)     xglucose 
 -6.70558554   0.04683748 

Objective function:
140.4905

Parameter instability tests:
           pregnant  pressure  triceps   insulin      mass pedigree       age
statistic 4.3749991 9.4006532 7.661457 9.0583568 5.4287861 5.640420 6.3088818
p.value   0.9998989 0.6656073 0.893893 0.7168659 0.9967316 0.994611 0.9804133
1 2 3 4 5 6 
5 5 2 4 5 2 
> 
> 
> 
> cleanEx()

detaching ‘package:mlbench’

> nameEx("nodeapply")
> ### * nodeapply
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: nodeapply
> ### Title: Apply Functions Over Nodes
> ### Aliases: nodeapply nodeapply.party nodeapply.partynode
> ### Keywords: tree
> 
> ### ** Examples
> 
> 
>     ## a tree as flat list structure
>     nodelist <- list(
+         # root node
+         list(id = 1L, split = partysplit(varid = 4L, breaks = 1.9),
+             kids = 2:3),
+         # V4 <= 1.9, terminal node
+         list(id = 2L, info = "terminal A"),
+         # V4 > 1.9
+         list(id = 3L, split = partysplit(varid = 5L, breaks = 1.7),
+             kids = c(4L, 7L)),
+         # V5 <= 1.7
+         list(id = 4L, split = partysplit(varid = 4L, breaks = 4.8),
+             kids = 5:6),
+         # V4 <= 4.8, terminal node
+         list(id = 5L, info = "terminal B"),
+         # V4 > 4.8, terminal node
+         list(id = 6L, info = "terminal C"),
+         # V5 > 1.7, terminal node
+         list(id = 7L, info = "terminal D")
+     )
> 
>     ## convert to a recursive structure
>     node <- as.partynode(nodelist)
> 
>     ## return root node 
>     nodeapply(node)
[[1]]
[1] root
|   [2] V4 <= 1.9 *
|   [3] V4 > 1.9
|   |   [4] V5 <= 1.7
|   |   |   [5] V4 <= 4.8 *
|   |   |   [6] V4 > 4.8 *
|   |   [7] V5 > 1.7 *

> 
>     ## return info slots of terminal nodes
>     nodeapply(node, ids = nodeids(node, terminal = TRUE), 
+         FUN = function(x) info_node(x))
[[1]]
[1] "terminal A"

[[2]]
[1] "terminal B"

[[3]]
[1] "terminal C"

[[4]]
[1] "terminal D"

> 
>     ## fit tree using rpart
>     library("rpart")
>     rp <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)
> 
>     ## coerce to `constparty'
>     rpk <- as.party(rp)
> 
>     ## extract nodeids
>     nodeids(rpk)
[1] 1 2 3 4 5 6 7 8 9
>     unlist(nodeapply(node_party(rpk), ids = nodeids(rpk), 
+         FUN = id_node))
[1] 1 2 3 4 5 6 7 8 9
>     unlist(nodeapply(rpk, ids = nodeids(rpk), FUN = id_node))
1 2 3 4 5 6 7 8 9 
1 2 3 4 5 6 7 8 9 
> 
>     ## but root nodes of party objects always have id = 1
>     unlist(nodeapply(rpk, ids = nodeids(rpk), FUN = function(x) 
+         id_node(node_party(x)), by_node = FALSE))
1 2 3 4 5 6 7 8 9 
1 1 1 1 1 1 1 1 1 
> 
> 
> 
> cleanEx()

detaching ‘package:rpart’

> nameEx("nodeids")
> ### * nodeids
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: nodeids
> ### Title: Extract Node Identifiers
> ### Aliases: nodeids nodeids.party nodeids.partynode get_paths
> ### Keywords: tree
> 
> ### ** Examples
> 
> 
>   ## a tree as flat list structure
>   nodelist <- list(
+       # root node
+       list(id = 1L, split = partysplit(varid = 4L, breaks = 1.9),
+           kids = 2:3),
+       # V4 <= 1.9, terminal node
+       list(id = 2L),
+       # V4 > 1.9
+       list(id = 3L, split = partysplit(varid = 1L, breaks = 1.7),
+           kids = c(4L, 7L)),
+       # V1 <= 1.7
+       list(id = 4L, split = partysplit(varid = 4L, breaks = 4.8),
+           kids = 5:6),
+       # V4 <= 4.8, terminal node
+       list(id = 5L),
+       # V4 > 4.8, terminal node
+       list(id = 6L),
+       # V1 > 1.7, terminal node
+       list(id = 7L)
+   )
> 
>   ## convert to a recursive structure
>   node <- as.partynode(nodelist)
> 
>   ## set up party object
>   data("iris")
>   tree <- party(node, data = iris, 
+       fitted = data.frame("(fitted)" = 
+                           fitted_node(node, data = iris),
+                           check.names = FALSE))
>   tree
[1] root
|   [2] Petal.Width <= 1.9: *
|   [3] Petal.Width > 1.9
|   |   [4] Sepal.Length <= 1.7
|   |   |   [5] Petal.Width <= 4.8: *
|   |   |   [6] Petal.Width > 4.8: *
|   |   [7] Sepal.Length > 1.7: *
>   
>   ### ids of all nodes
>   nodeids(tree)
[1] 1 2 3 4 5 6 7
> 
>   ### ids of all terminal nodes
>   nodeids(tree, terminal = TRUE)
[1] 2 5 6 7
> 
>   ### ids of terminal nodes in subtree with root [3]
>   nodeids(tree, from = 3, terminal = TRUE)
[1] 5 6 7
> 
>   ### get paths and extract all terminal nodes
>   tr <- unclass(node_party(tree))
>   lapply(get_paths(tree, nodeids(tree, terminal = TRUE)), 
+          function(path) tr[path])
[[1]]
[[1]]$kids
[[1]]$kids[[1]]
[2] root * 

[[1]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[1]]$id
[1] 1


[[2]]
[[2]]$kids
[[2]]$kids[[1]]
[2] root * 

[[2]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[2]]$split
$varid
[1] 4

$breaks
[1] 1.9

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"

[[2]]$kids
[[2]]$kids[[1]]
[2] root * 

[[2]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[2]]$id
[1] 1

[[2]]$kids
[[2]]$kids[[1]]
[2] root * 

[[2]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[2]]$id
[1] 1


[[3]]
[[3]]$kids
[[3]]$kids[[1]]
[2] root * 

[[3]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[3]]$split
$varid
[1] 4

$breaks
[1] 1.9

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"

[[3]]$kids
[[3]]$kids[[1]]
[2] root * 

[[3]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[3]]$id
[1] 1

[[3]]$kids
[[3]]$kids[[1]]
[2] root * 

[[3]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[3]]$split
$varid
[1] 4

$breaks
[1] 1.9

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"


[[4]]
[[4]]$kids
[[4]]$kids[[1]]
[2] root * 

[[4]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[4]]$split
$varid
[1] 4

$breaks
[1] 1.9

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"

[[4]]$kids
[[4]]$kids[[1]]
[2] root * 

[[4]]$kids[[2]]
[3] root
|   [4] V1 <= 1.7
|   |   [5] V4 <= 4.8 *
|   |   [6] V4 > 4.8 *
|   [7] V1 > 1.7 *


[[4]]$split
$varid
[1] 4

$breaks
[1] 1.9

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"


> 
> 
> 
> 
> cleanEx()
> nameEx("party-coercion")
> ### * party-coercion
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: party-coercion
> ### Title: Coercion Functions
> ### Aliases: party-coercion as.party as.party.rpart as.party.Weka_tree
> ###   as.party.XMLNode as.constparty as.simpleparty as.simpleparty.party
> ###   as.simpleparty.simpleparty as.simpleparty.XMLNode
> ###   as.simpleparty.constparty pmmlTreeModel
> ### Keywords: tree
> 
> ### ** Examples
> 
> ## fit tree using rpart
> library("rpart")
> rp <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)
> 
> ## coerce to `constparty'
> as.party(rp)

Model formula:
Kyphosis ~ Age + Number + Start

Fitted party:
[1] root
|   [2] Start >= 8.5
|   |   [3] Start >= 14.5: absent (n = 29, err = 0.0%)
|   |   [4] Start < 14.5
|   |   |   [5] Age < 55: absent (n = 12, err = 0.0%)
|   |   |   [6] Age >= 55
|   |   |   |   [7] Age >= 111: absent (n = 14, err = 14.3%)
|   |   |   |   [8] Age < 111: present (n = 7, err = 42.9%)
|   [9] Start < 8.5: present (n = 19, err = 42.1%)

Number of inner nodes:    4
Number of terminal nodes: 5
> 
> 
> 
> cleanEx()

detaching ‘package:rpart’

> nameEx("party-methods")
> ### * party-methods
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: party-methods
> ### Title: Methods for Party Objects
> ### Aliases: party-methods length.party print.party print.simpleparty
> ###   print.constparty [.party [[.party depth.party width.party
> ###   getCall.party nodeprune nodeprune.party
> ### Keywords: tree
> 
> ### ** Examples
> 
> 
>     ## a tree as flat list structure
>     nodelist <- list(
+         # root node
+         list(id = 1L, split = partysplit(varid = 4L, breaks = 1.9), 
+             kids = 2:3),
+         # V4 <= 1.9, terminal node
+         list(id = 2L),
+         # V4 > 1.9
+         list(id = 3L, split = partysplit(varid = 5L, breaks = 1.7), 
+             kids = c(4L, 7L)),
+         # V5 <= 1.7
+         list(id = 4L, split = partysplit(varid = 4L, breaks = 4.8), 
+             kids = 5:6),
+         # V4 <= 4.8, terminal node
+         list(id = 5L),
+         # V4 > 4.8, terminal node
+         list(id = 6L),
+         # V5 > 1.7, terminal node
+         list(id = 7L)
+     )
> 
>     ## convert to a recursive structure
>     node <- as.partynode(nodelist)
> 
>     ## set up party object
>     data("iris")
>     tree <- party(node, data = iris, 
+         fitted = data.frame("(fitted)" = 
+             fitted_node(node, data = iris),
+             check.names = FALSE))
>     names(tree) <- paste("Node", nodeids(tree), sep = " ")
> 
>     ## number of kids in root node
>     length(tree)
[1] 7
> 
>     ## depth of tree
>     depth(tree)
[1] 3
> 
>     ## number of terminal nodes
>     width(tree)
[1] 4
> 
>     ## node number four
>     tree["Node 4"]
[Node 4] root
|   [Node 5] Petal.Width <= 4.8: *
|   [Node 6] Petal.Width > 4.8: *
>     tree[["Node 4"]]
[Node 4] root
|   [Node 5] Petal.Width <= 4.8: *
|   [Node 6] Petal.Width > 4.8: *
> 
> 
> 
> 
> cleanEx()
> nameEx("party-predict")
> ### * party-predict
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: party-predict
> ### Title: Tree Predictions
> ### Aliases: party-predict predict.party predict_party
> ###   predict_party.default predict_party.constparty
> ###   predict_party.simpleparty
> ### Keywords: tree
> 
> ### ** Examples
> 
> 
>   ## fit tree using rpart
>   library("rpart")
>   rp <- rpart(skips ~ Opening + Solder + Mask + PadType + Panel,
+               data = solder, method = 'anova')
> 
>   ## coerce to `constparty'
>   pr <- as.party(rp)
> 
>   ## mean predictions
>   predict(pr, newdata = solder[c(3, 541, 640),])
       3      541      640 
1.030952 1.030952 1.030952 
> 
>   ## ecdf
>   predict(pr, newdata = solder[c(3, 541, 640),], type = "prob")
$`3`
Empirical CDF 
Call: ecdf(y)
 x[1:11] =      0,      1,      2,  ...,      9,     12

$`541`
Empirical CDF 
Call: ecdf(y)
 x[1:11] =      0,      1,      2,  ...,      9,     12

$`640`
Empirical CDF 
Call: ecdf(y)
 x[1:11] =      0,      1,      2,  ...,      9,     12

> 
>   ## terminal node identifiers
>   predict(pr, newdata = solder[c(3, 541, 640),], type = "node")
  3 541 640 
  3   3   3 
> 
>   ## median predictions
>   predict(pr, newdata = solder[c(3, 541, 640),], 
+           FUN = function(y, w = 1) median(y))
  3 541 640 
  0   0   0 
> 
> 
> 
> 
> cleanEx()

detaching ‘package:rpart’

> nameEx("party")
> ### * party
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: party
> ### Title: Recursive Partytioning
> ### Aliases: party names.party names<-.party node_party is.constparty
> ###   is.simpleparty data_party data_party.default
> ### Keywords: tree
> 
> ### ** Examples
> 
> ### data ###
> ## artificial WeatherPlay data
> data("WeatherPlay", package = "partykit")
> str(WeatherPlay)
'data.frame':	14 obs. of  5 variables:
 $ outlook    : Factor w/ 3 levels "sunny","overcast",..: 1 1 2 3 3 3 2 1 1 3 ...
 $ temperature: num  85 80 83 70 68 65 64 72 69 75 ...
 $ humidity   : num  85 90 86 96 80 70 65 95 70 80 ...
 $ windy      : Factor w/ 2 levels "false","true": 1 2 1 1 1 2 2 1 1 1 ...
 $ play       : Factor w/ 2 levels "yes","no": 2 2 1 1 1 2 1 2 1 1 ...
> 
> 
> ### splits ###
> ## split in overcast, humidity, and windy
> sp_o <- partysplit(1L, index = 1:3)
> sp_h <- partysplit(3L, breaks = 75)
> sp_w <- partysplit(4L, index = 1:2)
> 
> ## query labels
> character_split(sp_o)
$name
[1] "V1"

$levels
[1] "(-Inf,1]" "(1,2]"    "(2, Inf]"

> 
> 
> ### nodes ###
> ## set up partynode structure
> pn <- partynode(1L, split = sp_o, kids = list(
+   partynode(2L, split = sp_h, kids = list(
+     partynode(3L, info = "yes"),
+     partynode(4L, info = "no"))),
+   partynode(5L, info = "yes"),
+   partynode(6L, split = sp_w, kids = list(
+     partynode(7L, info = "yes"),
+     partynode(8L, info = "no")))))
> pn
[1] root
|   [2] V1 in (-Inf,1]
|   |   [3] V3 <= 75 *
|   |   [4] V3 > 75 *
|   [5] V1 in (1,2] *
|   [6] V1 in (2, Inf]
|   |   [7] V4 <= 1 *
|   |   [8] V4 > 1 *
> 
> 
> ### tree ###
> ## party: associate recursive partynode structure with data
> py <- party(pn, WeatherPlay)
> py
[1] root
|   [2] outlook in sunny
|   |   [3] humidity <= 75: yes
|   |   [4] humidity > 75: no
|   [5] outlook in overcast: yes
|   [6] outlook in rainy
|   |   [7] windy in false: yes
|   |   [8] windy in true: no
> plot(py)
> 
> 
> ### variations ###
> ## tree stump
> n1 <- partynode(id = 1L, split = sp_o, kids = lapply(2L:4L, partynode))
> print(n1, data = WeatherPlay)
[1] root
|   [2] outlook in sunny *
|   [3] outlook in overcast *
|   [4] outlook in rainy *
> 
> ## query fitted nodes and kids ids
> fitted_node(n1, data = WeatherPlay)
 [1] 2 2 3 4 4 4 3 2 2 4 2 3 3 4
> kidids_node(n1, data = WeatherPlay)
 [1] 1 1 2 3 3 3 2 1 1 3 1 2 2 3
> 
> ## tree with full data sets
> t1 <- party(n1, data = WeatherPlay)
> 
> ## tree with empty data set
> party(n1, data = WeatherPlay[0, ])
[1] root
|   [2] outlook in sunny: *
|   [3] outlook in overcast: *
|   [4] outlook in rainy: *
> 
> ## constant-fit tree
> t2 <- party(n1, 
+   data = WeatherPlay,
+   fitted = data.frame(
+     "(fitted)" = fitted_node(n1, data = WeatherPlay),
+     "(response)" = WeatherPlay$play,
+     check.names = FALSE),
+   terms = terms(play ~ ., data = WeatherPlay),
+ )
> t2 <- as.constparty(t2)
> t2

Model formula:
play ~ outlook + temperature + humidity + windy

Fitted party:
[1] root
|   [2] outlook in sunny: no (n = 5, err = 40.0%)
|   [3] outlook in overcast: yes (n = 4, err = 0.0%)
|   [4] outlook in rainy: yes (n = 5, err = 40.0%)

Number of inner nodes:    1
Number of terminal nodes: 3
> plot(t2)
> 
> 
> 
> cleanEx()
> nameEx("partynode-methods")
> ### * partynode-methods
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: partynode-methods
> ### Title: Methods for Node Objects
> ### Aliases: partynode-methods is.partynode as.partynode
> ###   as.partynode.partynode as.partynode.list as.list.partynode
> ###   length.partynode [.partynode [[.partynode is.terminal
> ###   is.terminal.partynode depth.partynode width width.partynode
> ###   print.partynode nodeprune.partynode
> ### Keywords: tree
> 
> ### ** Examples
> 
> ## a tree as flat list structure
> nodelist <- list(
+   # root node
+   list(id = 1L, split = partysplit(varid = 4L, breaks = 1.9), 
+       kids = 2:3),
+   # V4 <= 1.9, terminal node
+   list(id = 2L),
+   # V4 > 1.9
+   list(id = 3L, split = partysplit(varid = 1L, breaks = 1.7), 
+       kids = c(4L, 7L)),
+   # V1 <= 1.7
+   list(id = 4L, split = partysplit(varid = 4L, breaks = 4.8), 
+       kids = 5:6),
+   # V4 <= 4.8, terminal node
+   list(id = 5L),
+   # V4 > 4.8, terminal node
+   list(id = 6L),
+   # V1 > 1.7, terminal node
+   list(id = 7L)
+ )
> 
> ## convert to a recursive structure
> node <- as.partynode(nodelist)
> 
> ## print raw recursive structure without data
> print(node)
[1] root
|   [2] V4 <= 1.9 *
|   [3] V4 > 1.9
|   |   [4] V1 <= 1.7
|   |   |   [5] V4 <= 4.8 *
|   |   |   [6] V4 > 4.8 *
|   |   [7] V1 > 1.7 *
> 
> ## print tree along with the associated iris data
> data("iris", package = "datasets")
> print(node, data = iris)
[1] root
|   [2] Petal.Width <= 1.9 *
|   [3] Petal.Width > 1.9
|   |   [4] Sepal.Length <= 1.7
|   |   |   [5] Petal.Width <= 4.8 *
|   |   |   [6] Petal.Width > 4.8 *
|   |   [7] Sepal.Length > 1.7 *
> 
> ## print subtree
> print(node[2], data = iris)
[3] root
|   [4] Sepal.Length <= 1.7
|   |   [5] Petal.Width <= 4.8 *
|   |   [6] Petal.Width > 4.8 *
|   [7] Sepal.Length > 1.7 *
> 
> ## print subtree, with root node number one
> print(as.partynode(node[2], from = 1), data = iris)
[1] root
|   [2] Sepal.Length <= 1.7
|   |   [3] Petal.Width <= 4.8 *
|   |   [4] Petal.Width > 4.8 *
|   [5] Sepal.Length > 1.7 *
> 
> ## number of kids in root node
> length(node)
[1] 2
> 
> ## depth of tree
> depth(node)
[1] 3
> 
> ## number of terminal nodes
> width(node)
[1] 4
> 
> ## convert back to flat structure
> as.list(node)
[[1]]
[[1]]$id
[1] 1

[[1]]$split
$varid
[1] 4

$breaks
[1] 1.9

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"

[[1]]$kids
[1] 2 3


[[2]]
[[2]]$id
[1] 2

[[2]]$info
NULL


[[3]]
[[3]]$id
[1] 3

[[3]]$split
$varid
[1] 1

$breaks
[1] 1.7

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"

[[3]]$kids
[1] 4 7


[[4]]
[[4]]$id
[1] 4

[[4]]$split
$varid
[1] 4

$breaks
[1] 4.8

$index
NULL

$right
[1] TRUE

$prob
NULL

$info
NULL

attr(,"class")
[1] "partysplit"

[[4]]$kids
[1] 5 6


[[5]]
[[5]]$id
[1] 5

[[5]]$info
NULL


[[6]]
[[6]]$id
[1] 6

[[6]]$info
NULL


[[7]]
[[7]]$id
[1] 7

[[7]]$info
NULL


> 
> 
> 
> cleanEx()
> nameEx("partynode")
> ### * partynode
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: partynode
> ### Title: Inner and Terminal Nodes
> ### Aliases: partynode kidids_node fitted_node id_node split_node
> ###   surrogates_node kids_node info_node formatinfo_node
> ### Keywords: tree
> 
> ### ** Examples
> 
> data("iris", package = "datasets")
> 
> ## a stump defined by a binary split in Sepal.Length
> stump <- partynode(id = 1L, 
+     split = partysplit(which(names(iris) == "Sepal.Length"),
+ 	breaks = 5),
+     kids = lapply(2:3, partynode))
> 
> ## textual representation
> print(stump, data = iris)  
[1] root
|   [2] Sepal.Length <= 5 *
|   [3] Sepal.Length > 5 *
> 
> ## list element number and node id of the two terminal nodes
> table(kidids_node(stump, iris), 
+     fitted_node(stump, data = iris))
   
      2   3
  1  32   0
  2   0 118
> 
> ## assign terminal nodes with probability 0.5
> ## to observations with missing `Sepal.Length'
> iris_NA <- iris
> iris_NA[sample(1:nrow(iris), 50), "Sepal.Length"] <- NA
> table(fitted_node(stump, data = iris_NA, 
+     obs = !complete.cases(iris_NA)))

 2  3 
23 27 
> 
> ## a stump defined by a primary split in `Sepal.Length'
> ## and a surrogate split in `Sepal.Width' which
> ## determines terminal nodes for observations with
> ## missing `Sepal.Length'
> stump <- partynode(id = 1L, 
+     split = partysplit(which(names(iris) == "Sepal.Length"),
+ 	breaks = 5),
+     kids = lapply(2:3, partynode),
+     surrogates = list(partysplit(
+ 	which(names(iris) == "Sepal.Width"), breaks = 3)))
> f <- fitted_node(stump, data = iris_NA, 
+     obs = !complete.cases(iris_NA))
> tapply(iris_NA$Sepal.Width[!complete.cases(iris_NA)], f, range)
$`2`
[1] 2.3 3.0

$`3`
[1] 3.1 4.2

> 
> 
> 
> 
> cleanEx()
> nameEx("partysplit")
> ### * partysplit
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: partysplit
> ### Title: Binary and Multiway Splits
> ### Aliases: partysplit kidids_split character_split varid_split
> ###   breaks_split index_split right_split prob_split info_split
> ### Keywords: tree
> 
> ### ** Examples
> 
> data("iris", package = "datasets")
> 
> ## binary split in numeric variable `Sepal.Length'
> sl5 <- partysplit(which(names(iris) == "Sepal.Length"),
+     breaks = 5)
> character_split(sl5, data = iris)
$name
[1] "Sepal.Length"

$levels
[1] "<= 5" "> 5" 

> table(kidids_split(sl5, data = iris), iris$Sepal.Length <= 5)
   
    FALSE TRUE
  1     0   32
  2   118    0
> 
> ## multiway split in numeric variable `Sepal.Width', 
> ## higher values go to the first kid, smallest values 
> ## to the last kid
> sw23 <- partysplit(which(names(iris) == "Sepal.Width"),    
+     breaks = c(3, 3.5), index = 3:1)	
> character_split(sw23, data = iris)    
$name
[1] "Sepal.Width"

$levels
[1] "(3.5, Inf]" "(3,3.5]"    "(-Inf,3]"  

> table(kidids_split(sw23, data = iris), 
+     cut(iris$Sepal.Width, breaks = c(-Inf, 2, 3, Inf)))   
   
    (-Inf,2] (2,3] (3, Inf]
  1        0     0       19
  2        0     0       48
  3        1    82        0
> 
> ## binary split in factor `Species'
> sp <- partysplit(which(names(iris) == "Species"),
+     index = c(1L, 1L, 2L))
> character_split(sp, data = iris)
$name
[1] "Species"

$levels
[1] "setosa, versicolor" "virginica"         

> table(kidids_split(sp, data = iris), iris$Species)
   
    setosa versicolor virginica
  1     50         50         0
  2      0          0        50
> 
> ## multiway split in factor `Species'
> sp <- partysplit(which(names(iris) == "Species"), index = 1:3)
> character_split(sp, data = iris)
$name
[1] "Species"

$levels
[1] "setosa"     "versicolor" "virginica" 

> table(kidids_split(sp, data = iris), iris$Species)
   
    setosa versicolor virginica
  1     50          0         0
  2      0         50         0
  3      0          0        50
> 
> ## multiway split in numeric variable `Sepal.Width'
> sp <- partysplit(which(names(iris) == "Sepal.Width"), 
+     breaks = quantile(iris$Sepal.Width))
> character_split(sp, data = iris)
$name
[1] "Sepal.Width"

$levels
[1] "(-Inf,2]"   "(2,2.8]"    "(2.8,3]"    "(3,3.3]"    "(3.3,4.4]" 
[6] "(4.4, Inf]"

> 
> 
> 
> 
> cleanEx()
> nameEx("prune.modelparty")
> ### * prune.modelparty
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: prune.modelparty
> ### Title: Post-Prune 'modelparty' Objects
> ### Aliases: prune.modelparty prune.lmtree
> 
> ### ** Examples
> 
> set.seed(29)
> n <- 1000
> d <- data.frame(
+   x = runif(n),
+   z = runif(n),
+   z_noise = factor(sample(1:3, size = n, replace = TRUE))
+ )
> d$y <- rnorm(n, mean = d$x * c(-1, 1)[(d$z > 0.7) + 1], sd = 3)
> 
> ## glm versus lm / logLik versus sum of squared residuals
> fmla <- y ~ x | z + z_noise
> lm_big <- lmtree(formula = fmla, data = d, maxdepth = 3, alpha = 1)
> glm_big <- glmtree(formula = fmla, data = d, maxdepth = 3, alpha = 1)
> 
> AIC(lm_big)
[1] 5129.346
> AIC(glm_big)
[1] 5126.784
> 
> ## load rpart for prune() generic
> ## (otherwise: use prune.modelparty directly)
> if (require("rpart")) {
+ 
+ ## pruning
+ lm_aic <- prune(lm_big, type = "AIC")
+ lm_bic <- prune(lm_big, type = "BIC")
+ 
+ width(lm_big)
+ width(lm_aic)
+ width(lm_bic)
+ 
+ glm_aic <- prune(glm_big, type = "AIC")
+ glm_bic <- prune(glm_big, type = "BIC")
+ 
+ width(glm_big)
+ width(glm_aic)
+ width(glm_bic)
+ 
+ }
Loading required package: rpart
[1] 2
> 
> 
> 
> cleanEx()

detaching ‘package:rpart’

> nameEx("varimp")
> ### * varimp
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: varimp
> ### Title: Variable Importance
> ### Aliases: varimp varimp.constparty varimp.cforest
> ### Keywords: tree
> 
> ### ** Examples
> 
>     
>    set.seed(290875)
>    data("readingSkills", package = "party")
>    readingSkills.cf <- cforest(score ~ ., data = readingSkills, 
+                                mtry = 2, ntree = 50)
> 
>    # standard importance
>    varimp(readingSkills.cf)
nativeSpeaker           age      shoeSize 
     12.17150      65.18361      16.09479 
> 
>    # conditional importance, may take a while...
>    varimp(readingSkills.cf, conditional = TRUE)
nativeSpeaker           age      shoeSize 
   12.3017295    39.5830711     0.4435327 
> 
> 
> 
> 
> ### * <FOOTER>
> ###
> cleanEx()
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
Time elapsed:  9.355 0.127 9.543 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')
