Last updated on 2026-08-03 14:51:06 CEST.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 1.2-29 | 15.47 | 253.21 | 268.68 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 1.2-29 | 9.46 | 187.31 | 196.77 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 1.2-29 | 26.00 | 399.87 | 425.87 | ERROR | |
| r-devel-linux-x86_64-fedora-gcc | 1.2-29 | 10.00 | 179.35 | 189.35 | ERROR | |
| r-devel-windows-x86_64 | 1.2-29 | 18.00 | 314.00 | 332.00 | ERROR | |
| r-patched-linux-x86_64 | 1.2-29 | 15.11 | 241.06 | 256.17 | ERROR | |
| r-release-linux-x86_64 | 1.2-29 | 15.17 | 243.80 | 258.97 | ERROR | |
| r-release-macos-arm64 | 1.2-29 | 4.00 | 78.00 | 82.00 | OK | |
| r-release-macos-x86_64 | 1.2-29 | 12.00 | 392.00 | 404.00 | OK | |
| r-release-windows-x86_64 | 1.2-29 | 18.00 | 304.00 | 322.00 | ERROR | |
| r-oldrel-macos-arm64 | 1.2-29 | 3.00 | 81.00 | 84.00 | OK | |
| r-oldrel-macos-x86_64 | 1.2-29 | 12.00 | 597.00 | 609.00 | OK | |
| r-oldrel-windows-x86_64 | 1.2-29 | 24.00 | 381.00 | 405.00 | ERROR |
Version: 1.2-29
Check: examples
Result: ERROR
Running examples in ‘partykit-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: glmtree
> ### Title: Generalized Linear Model Trees
> ### Aliases: glmtree plot.glmtree predict.glmtree print.glmtree
> ### Keywords: tree
>
> ### ** Examples
>
> if(require("mlbench") && require("vcd")) {
+
+ ## 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
Loading required package: vcd
Warning in data("PimaIndiansDiabetes", package = "mlbench") :
data set ‘PimaIndiansDiabetes’ not found
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: glmtree ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
Execution halted
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-patched-linux-x86_64, r-release-linux-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running ‘bugfixes.R’ [5s/7s]
Comparing ‘bugfixes.Rout’ to ‘bugfixes.Rout.save’ ... OK
Running ‘constparty.R’ [5s/6s]
Comparing ‘constparty.Rout’ to ‘constparty.Rout.save’ ... OK
Running ‘regtest-MIA.R’ [2s/2s]
Comparing ‘regtest-MIA.Rout’ to ‘regtest-MIA.Rout.save’ ... OK
Running ‘regtest-cforest.R’ [14s/18s]
Comparing ‘regtest-cforest.Rout’ to ‘regtest-cforest.Rout.save’ ... OK
Running ‘regtest-ctree.R’ [2s/3s]
Comparing ‘regtest-ctree.Rout’ to ‘regtest-ctree.Rout.save’ ... OK
Running ‘regtest-glmtree.R’ [34s/42s]
Running ‘regtest-honesty.R’ [2s/2s]
Running ‘regtest-lmtree.R’ [3s/3s]
Running ‘regtest-nmax.R’ [2s/3s]
Comparing ‘regtest-nmax.Rout’ to ‘regtest-nmax.Rout.save’ ... OK
Running ‘regtest-node.R’ [2s/2s]
Comparing ‘regtest-node.Rout’ to ‘regtest-node.Rout.save’ ... OK
Running ‘regtest-party-random.R’ [2s/3s]
Running ‘regtest-party.R’ [5s/5s]
Comparing ‘regtest-party.Rout’ to ‘regtest-party.Rout.save’ ... OK
Running ‘regtest-split.R’ [2s/2s]
Comparing ‘regtest-split.Rout’ to ‘regtest-split.Rout.save’ ... OK
Running ‘regtest-weights.R’ [2s/3s]
Comparing ‘regtest-weights.Rout’ to ‘regtest-weights.Rout.save’ ... OK
Running the tests in ‘tests/regtest-glmtree.R’ failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 1.2-29
Check: re-building of vignette outputs
Result: ERROR
Error(s) in re-building vignettes:
...
--- re-building ‘constparty.Rnw’ using knitr
--- finished re-building ‘constparty.Rnw’
--- re-building ‘ctree.Rnw’ using knitr
--- finished re-building ‘ctree.Rnw’
--- re-building ‘mob.Rnw’ using knitr
Quitting from mob.Rnw:443-445 [PimaIndiansDiabetes-mob]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<error/rlang_error>
Error:
! object 'PimaIndiansDiabetes' not found
---
Backtrace:
x
1. +-stats::model.frame(...)
2. \-Formula:::model.frame.Formula(...)
3. +-stats::model.frame(...)
4. +-stats::terms(formula, lhs = lhs, rhs = rhs, data = data, dot = dot)
5. \-Formula:::terms.Formula(...)
6. +-stats::terms(form, ...)
7. \-stats::terms.formula(form, ...)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error: processing vignette 'mob.Rnw' failed with diagnostics:
object 'PimaIndiansDiabetes' not found
--- failed re-building ‘mob.Rnw’
--- re-building ‘partykit.Rnw’ using knitr
--- finished re-building ‘partykit.Rnw’
SUMMARY: processing the following file failed:
‘mob.Rnw’
Error: Vignette re-building failed.
Execution halted
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-patched-linux-x86_64, r-release-linux-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running ‘bugfixes.R’ [4s/5s]
Comparing ‘bugfixes.Rout’ to ‘bugfixes.Rout.save’ ... OK
Running ‘constparty.R’ [4s/5s]
Comparing ‘constparty.Rout’ to ‘constparty.Rout.save’ ... OK
Running ‘regtest-MIA.R’ [1s/2s]
Comparing ‘regtest-MIA.Rout’ to ‘regtest-MIA.Rout.save’ ... OK
Running ‘regtest-cforest.R’ [10s/12s]
Comparing ‘regtest-cforest.Rout’ to ‘regtest-cforest.Rout.save’ ... OK
Running ‘regtest-ctree.R’ [1s/2s]
Comparing ‘regtest-ctree.Rout’ to ‘regtest-ctree.Rout.save’ ... OK
Running ‘regtest-glmtree.R’ [25s/33s]
Running ‘regtest-honesty.R’ [1s/2s]
Running ‘regtest-lmtree.R’ [2s/2s]
Running ‘regtest-nmax.R’ [1s/2s]
Comparing ‘regtest-nmax.Rout’ to ‘regtest-nmax.Rout.save’ ... OK
Running ‘regtest-node.R’ [2s/2s]
Comparing ‘regtest-node.Rout’ to ‘regtest-node.Rout.save’ ... OK
Running ‘regtest-party-random.R’ [2s/2s]
Running ‘regtest-party.R’ [3s/3s]
Comparing ‘regtest-party.Rout’ to ‘regtest-party.Rout.save’ ... OK
Running ‘regtest-split.R’ [1s/2s]
Comparing ‘regtest-split.Rout’ to ‘regtest-split.Rout.save’ ... OK
Running ‘regtest-weights.R’ [2s/2s]
Comparing ‘regtest-weights.Rout’ to ‘regtest-weights.Rout.save’ ... OK
Running the tests in ‘tests/regtest-glmtree.R’ failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.2-29
Check: for new files in some other directories
Result: NOTE
Found the following files/directories:
‘~/tmp/scratch/Rtmp07h4VN’ ‘~/tmp/scratch/Rtmp1H4rMW’
‘~/tmp/scratch/Rtmp1H5cac’ ‘~/tmp/scratch/Rtmp1tb2MM’
‘~/tmp/scratch/Rtmp29mCcS’ ‘~/tmp/scratch/Rtmp2MTRHm’
‘~/tmp/scratch/Rtmp2VI02A’ ‘~/tmp/scratch/Rtmp2cH1z9’
‘~/tmp/scratch/Rtmp2oS2i5’ ‘~/tmp/scratch/Rtmp3FTbbv’
‘~/tmp/scratch/Rtmp3vbuhX’ ‘~/tmp/scratch/Rtmp4JNPis’
‘~/tmp/scratch/Rtmp4VweSV’ ‘~/tmp/scratch/Rtmp4ZjvNK’
‘~/tmp/scratch/Rtmp4ofxwQ’ ‘~/tmp/scratch/Rtmp5cLiRF’
‘~/tmp/scratch/Rtmp64LsWR’ ‘~/tmp/scratch/Rtmp6ZSTCE’
‘~/tmp/scratch/Rtmp6rXfHB’ ‘~/tmp/scratch/Rtmp6uNISw’
‘~/tmp/scratch/Rtmp762bEf’ ‘~/tmp/scratch/Rtmp7ciHW9’
‘~/tmp/scratch/Rtmp7eMo3U’ ‘~/tmp/scratch/Rtmp7fSL9E’
‘~/tmp/scratch/Rtmp7xRwyx’ ‘~/tmp/scratch/Rtmp8GN810’
‘~/tmp/scratch/Rtmp94ZbsK’ ‘~/tmp/scratch/Rtmp9IoA0I’
‘~/tmp/scratch/Rtmp9fkSnO’ ‘~/tmp/scratch/RtmpAhB4FZ’
‘~/tmp/scratch/RtmpAjfmzi’ ‘~/tmp/scratch/RtmpBBmQBv’
‘~/tmp/scratch/RtmpBdv3OC’ ‘~/tmp/scratch/RtmpBx0VGU’
‘~/tmp/scratch/RtmpC4mMNo’ ‘~/tmp/scratch/RtmpCf62Ho’
‘~/tmp/scratch/RtmpCizvwW’ ‘~/tmp/scratch/RtmpDWaXF5’
‘~/tmp/scratch/RtmpEvTHk1’ ‘~/tmp/scratch/RtmpF7VDkm’
‘~/tmp/scratch/RtmpF92R5w’ ‘~/tmp/scratch/RtmpFFgVaz’
‘~/tmp/scratch/RtmpFGLk5h’ ‘~/tmp/scratch/RtmpFGiXGD’
‘~/tmp/scratch/RtmpFNRDW8’ ‘~/tmp/scratch/RtmpFgJQTZ’
‘~/tmp/scratch/RtmpG2UCRg’ ‘~/tmp/scratch/RtmpG3ZuDr’
‘~/tmp/scratch/RtmpG6TPMq’ ‘~/tmp/scratch/RtmpGa2y4B’
‘~/tmp/scratch/RtmpGstTq7’ ‘~/tmp/scratch/RtmpGvurWK’
‘~/tmp/scratch/RtmpH0kUjY’ ‘~/tmp/scratch/RtmpHNGlFr’
‘~/tmp/scratch/RtmpJ5yKwy’ ‘~/tmp/scratch/RtmpJG7z7c’
‘~/tmp/scratch/RtmpJbsA70’ ‘~/tmp/scratch/RtmpJsZzmp’
‘~/tmp/scratch/RtmpLAw2Qw’ ‘~/tmp/scratch/RtmpLBloTv’
‘~/tmp/scratch/RtmpLLET5c’ ‘~/tmp/scratch/RtmpLfxkgE’
‘~/tmp/scratch/RtmpM9VjU2’ ‘~/tmp/scratch/RtmpMPHUEX’
‘~/tmp/scratch/RtmpMYUrFw’ ‘~/tmp/scratch/RtmpMYqzYT’
‘~/tmp/scratch/RtmpMniVRB’ ‘~/tmp/scratch/RtmpMsAZFs’
‘~/tmp/scratch/RtmpMykMrk’ ‘~/tmp/scratch/RtmpNIjPNj’
‘~/tmp/scratch/RtmpNdfuqH’ ‘~/tmp/scratch/RtmpO60cJ1’
‘~/tmp/scratch/RtmpPVWlpD’ ‘~/tmp/scratch/RtmpPYcpuo’
‘~/tmp/scratch/RtmpPfMEER’ ‘~/tmp/scratch/RtmpPkCQeo’
‘~/tmp/scratch/RtmpPwMo5P’ ‘~/tmp/scratch/RtmpQTPyjr’
‘~/tmp/scratch/RtmpQX9AlA’ ‘~/tmp/scratch/RtmpQoVuBV’
‘~/tmp/scratch/RtmpRJQ2jK’ ‘~/tmp/scratch/RtmpROjkCR’
‘~/tmp/scratch/RtmpRYVW8a’ ‘~/tmp/scratch/RtmpRtVwXG’
‘~/tmp/scratch/RtmpSwJG9K’ ‘~/tmp/scratch/RtmpTCvZbb’
‘~/tmp/scratch/RtmpTKAThO’ ‘~/tmp/scratch/RtmpUEkYxZ’
‘~/tmp/scratch/RtmpUcvVm4’ ‘~/tmp/scratch/RtmpUfjwyr’
‘~/tmp/scratch/RtmpUghC60’ ‘~/tmp/scratch/RtmpVv03xs’
‘~/tmp/scratch/RtmpWIngnE’ ‘~/tmp/scratch/RtmpWJzZr3’
‘~/tmp/scratch/RtmpWtikeh’ ‘~/tmp/scratch/RtmpXARZdC’
‘~/tmp/scratch/RtmpXapYUc’ ‘~/tmp/scratch/RtmpXezuB0’
‘~/tmp/scratch/RtmpXflJe4’ ‘~/tmp/scratch/RtmpY9Aozs’
‘~/tmp/scratch/RtmpYTM6Dm’ ‘~/tmp/scratch/Rtmpaga4qi’
‘~/tmp/scratch/RtmpbMwy0f’ ‘~/tmp/scratch/RtmpbSNzt2’
‘~/tmp/scratch/RtmpbWa2RA’ ‘~/tmp/scratch/Rtmpc0E8Q3’
‘~/tmp/scratch/RtmpckwcBJ’ ‘~/tmp/scratch/RtmpdNeqUf’
‘~/tmp/scratch/RtmpdVWbaB’ ‘~/tmp/scratch/RtmpdW4cL9’
‘~/tmp/scratch/RtmpddtrlX’ ‘~/tmp/scratch/RtmpeEoQbz’
‘~/tmp/scratch/RtmpeGVVyD’ ‘~/tmp/scratch/RtmpfJ3U07’
‘~/tmp/scratch/Rtmpflv1uO’ ‘~/tmp/scratch/RtmpfxJUeG’
‘~/tmp/scratch/Rtmpfxy6wp’ ‘~/tmp/scratch/RtmpgGVBgI’
‘~/tmp/scratch/Rtmpgm69oS’ ‘~/tmp/scratch/RtmpgsoZ6E’
‘~/tmp/scratch/RtmpgzLZM1’ ‘~/tmp/scratch/RtmphKA6ZQ’
‘~/tmp/scratch/RtmphRJTIh’ ‘~/tmp/scratch/RtmphmH9T8’
‘~/tmp/scratch/Rtmpi69qKO’ ‘~/tmp/scratch/RtmpiAYkPk’
‘~/tmp/scratch/Rtmpib3jyf’ ‘~/tmp/scratch/RtmpifaGpn’
‘~/tmp/scratch/Rtmpj1QGBW’ ‘~/tmp/scratch/Rtmpj6JHra’
‘~/tmp/scratch/Rtmpj8QIbp’ ‘~/tmp/scratch/RtmpjKw4M4’
‘~/tmp/scratch/RtmpjS12Fx’ ‘~/tmp/scratch/RtmpjWxYW7’
‘~/tmp/scratch/RtmpjlAV7l’ ‘~/tmp/scratch/Rtmpl1vcwr’
‘~/tmp/scratch/RtmplI6zcm’ ‘~/tmp/scratch/RtmpldIHIn’
‘~/tmp/scratch/RtmpldtRAc’ ‘~/tmp/scratch/Rtmpm6el49’
‘~/tmp/scratch/Rtmpm8dRWo’ ‘~/tmp/scratch/RtmpmR7P9E’
‘~/tmp/scratch/RtmpmhZWtF’ ‘~/tmp/scratch/RtmpnPfuhN’
‘~/tmp/scratch/Rtmpnyodup’ ‘~/tmp/scratch/Rtmpo4KtXu’
‘~/tmp/scratch/Rtmpo7Eo3r’ ‘~/tmp/scratch/RtmpoGl21b’
‘~/tmp/scratch/Rtmpp8obf5’ ‘~/tmp/scratch/RtmppPzyyO’
‘~/tmp/scratch/RtmppsQ70D’ ‘~/tmp/scratch/RtmppvBTbx’
‘~/tmp/scratch/Rtmpq2h0D6’ ‘~/tmp/scratch/RtmpqTLBVo’
‘~/tmp/scratch/RtmpqcmJlH’ ‘~/tmp/scratch/Rtmpr3mUKb’
‘~/tmp/scratch/Rtmpr75727’ ‘~/tmp/scratch/Rtmps2mRYH’
‘~/tmp/scratch/Rtmps6Wtly’ ‘~/tmp/scratch/RtmpsNNKlA’
‘~/tmp/scratch/RtmpsOD0br’ ‘~/tmp/scratch/Rtmpskr9D4’
‘~/tmp/scratch/RtmptIcvp3’ ‘~/tmp/scratch/RtmptNMaTp’
‘~/tmp/scratch/RtmptxGqYr’ ‘~/tmp/scratch/RtmpuEPrYz’
‘~/tmp/scratch/RtmpuzGCr5’ ‘~/tmp/scratch/RtmpvGa8Qa’
‘~/tmp/scratch/Rtmpvlbl8e’ ‘~/tmp/scratch/RtmpwECVDA’
‘~/tmp/scratch/RtmpwUBDxF’ ‘~/tmp/scratch/RtmpwWHG9o’
‘~/tmp/scratch/RtmpwZNkzr’ ‘~/tmp/scratch/RtmpwrzCHE’
‘~/tmp/scratch/Rtmpwtg3OT’ ‘~/tmp/scratch/RtmpxMpZwk’
‘~/tmp/scratch/RtmpxVrC6p’ ‘~/tmp/scratch/RtmpxVszW2’
‘~/tmp/scratch/RtmpyTydPD’ ‘~/tmp/scratch/Rtmpyoslxv’
‘~/tmp/scratch/RtmpzAZcAu’ ‘~/tmp/scratch/RtmpzQaNzb’
‘~/tmp/scratch/RtmpzZ0koA’ ‘~/tmp/scratch/xvfb-run.0hZ3JU’
‘~/tmp/scratch/xvfb-run.1KGpzO’ ‘~/tmp/scratch/xvfb-run.1fRXxC’
‘~/tmp/scratch/xvfb-run.1xyJhp’ ‘~/tmp/scratch/xvfb-run.3RWgzW’
‘~/tmp/scratch/xvfb-run.4ZDYdI’ ‘~/tmp/scratch/xvfb-run.50sCAJ’
‘~/tmp/scratch/xvfb-run.5J6vTY’ ‘~/tmp/scratch/xvfb-run.5LKpZc’
‘~/tmp/scratch/xvfb-run.5ffhAk’ ‘~/tmp/scratch/xvfb-run.6SpuNZ’
‘~/tmp/scratch/xvfb-run.6Xp0ZO’ ‘~/tmp/scratch/xvfb-run.6pdloz’
‘~/tmp/scratch/xvfb-run.6wQefe’ ‘~/tmp/scratch/xvfb-run.8zebCv’
‘~/tmp/scratch/xvfb-run.96aKgf’ ‘~/tmp/scratch/xvfb-run.9kAhn9’
‘~/tmp/scratch/xvfb-run.9vDNVr’ ‘~/tmp/scratch/xvfb-run.9vNEfX’
‘~/tmp/scratch/xvfb-run.A1MGuB’ ‘~/tmp/scratch/xvfb-run.Ayo3QY’
‘~/tmp/scratch/xvfb-run.Ce3kQ4’ ‘~/tmp/scratch/xvfb-run.CgxP8M’
‘~/tmp/scratch/xvfb-run.CsUlfs’ ‘~/tmp/scratch/xvfb-run.DQ88za’
‘~/tmp/scratch/xvfb-run.DRN0iI’ ‘~/tmp/scratch/xvfb-run.FtrA8o’
‘~/tmp/scratch/xvfb-run.GPTztK’ ‘~/tmp/scratch/xvfb-run.GUETSr’
‘~/tmp/scratch/xvfb-run.GUfmBY’ ‘~/tmp/scratch/xvfb-run.IuhuLn’
‘~/tmp/scratch/xvfb-run.KBG6xA’ ‘~/tmp/scratch/xvfb-run.LE494I’
‘~/tmp/scratch/xvfb-run.Ldp7Li’ ‘~/tmp/scratch/xvfb-run.LjqGQ6’
‘~/tmp/scratch/xvfb-run.Mciqru’ ‘~/tmp/scratch/xvfb-run.MeirPt’
‘~/tmp/scratch/xvfb-run.Myk6zI’ ‘~/tmp/scratch/xvfb-run.N19Voz’
‘~/tmp/scratch/xvfb-run.NcaATF’ ‘~/tmp/scratch/xvfb-run.OTUgUq’
‘~/tmp/scratch/xvfb-run.SZtCtI’ ‘~/tmp/scratch/xvfb-run.T6T3if’
‘~/tmp/scratch/xvfb-run.UO4TbL’ ‘~/tmp/scratch/xvfb-run.URjrab’
‘~/tmp/scratch/xvfb-run.XToFZa’ ‘~/tmp/scratch/xvfb-run.YhPvxd’
‘~/tmp/scratch/xvfb-run.ZMjXLV’ ‘~/tmp/scratch/xvfb-run.ZwwmwX’
‘~/tmp/scratch/xvfb-run.ZyGfFJ’ ‘~/tmp/scratch/xvfb-run.aQZqxJ’
‘~/tmp/scratch/xvfb-run.b0yLSL’ ‘~/tmp/scratch/xvfb-run.bvscUm’
‘~/tmp/scratch/xvfb-run.bybOhV’ ‘~/tmp/scratch/xvfb-run.c5ydfX’
‘~/tmp/scratch/xvfb-run.e9swke’ ‘~/tmp/scratch/xvfb-run.fj29BL’
‘~/tmp/scratch/xvfb-run.gKzZoB’ ‘~/tmp/scratch/xvfb-run.gky3Lu’
‘~/tmp/scratch/xvfb-run.h8Xixr’ ‘~/tmp/scratch/xvfb-run.hCUa7b’
‘~/tmp/scratch/xvfb-run.isYCOQ’ ‘~/tmp/scratch/xvfb-run.jGqGKe’
‘~/tmp/scratch/xvfb-run.jkWhDV’ ‘~/tmp/scratch/xvfb-run.kk4FZ6’
‘~/tmp/scratch/xvfb-run.lRzooL’ ‘~/tmp/scratch/xvfb-run.nsPGa5’
‘~/tmp/scratch/xvfb-run.ospGKh’ ‘~/tmp/scratch/xvfb-run.ppQkIa’
‘~/tmp/scratch/xvfb-run.prfmHM’ ‘~/tmp/scratch/xvfb-run.rb4alb’
‘~/tmp/scratch/xvfb-run.sxWj2v’ ‘~/tmp/scratch/xvfb-run.u1rvHs’
‘~/tmp/scratch/xvfb-run.uYF2EO’ ‘~/tmp/scratch/xvfb-run.ukjjsq’
‘~/tmp/scratch/xvfb-run.vi86oA’ ‘~/tmp/scratch/xvfb-run.xjYkyZ’
‘~/tmp/scratch/xvfb-run.yLVDyw’
‘/dev/shm/sm_segment.gimli1.1001.16390000.0’
‘/dev/shm/sm_segment.gimli1.1001.1a2f0000.0’
‘/dev/shm/sm_segment.gimli1.1001.27890000.0’
‘/dev/shm/sm_segment.gimli1.1001.2ea20000.0’
‘/dev/shm/sm_segment.gimli1.1001.3a990000.0’
‘/dev/shm/sm_segment.gimli1.1001.41c90000.0’
‘/dev/shm/sm_segment.gimli1.1001.47a80000.0’
‘/dev/shm/sm_segment.gimli1.1001.5240000.0’
‘/dev/shm/sm_segment.gimli1.1001.55ba0000.0’
‘/dev/shm/sm_segment.gimli1.1001.57170000.0’
‘/dev/shm/sm_segment.gimli1.1001.5ac80000.0’
‘/dev/shm/sm_segment.gimli1.1001.623e0000.0’
‘/dev/shm/sm_segment.gimli1.1001.664a0000.0’
‘/dev/shm/sm_segment.gimli1.1001.69180000.0’
‘/dev/shm/sm_segment.gimli1.1001.6b350000.0’
‘/dev/shm/sm_segment.gimli1.1001.6c200000.0’
‘/dev/shm/sm_segment.gimli1.1001.736c0000.0’
‘/dev/shm/sm_segment.gimli1.1001.76f20000.0’
‘/dev/shm/sm_segment.gimli1.1001.84f80000.0’
‘/dev/shm/sm_segment.gimli1.1001.90380000.0’
‘/dev/shm/sm_segment.gimli1.1001.93330000.0’
‘/dev/shm/sm_segment.gimli1.1001.93e20000.0’
‘/dev/shm/sm_segment.gimli1.1001.97d0000.0’
‘/dev/shm/sm_segment.gimli1.1001.97d60000.0’
‘/dev/shm/sm_segment.gimli1.1001.99850000.0’
‘/dev/shm/sm_segment.gimli1.1001.a2fb0000.0’
‘/dev/shm/sm_segment.gimli1.1001.a7e20000.0’
‘/dev/shm/sm_segment.gimli1.1001.ac2e0000.0’
‘/dev/shm/sm_segment.gimli1.1001.ae830000.0’
‘/dev/shm/sm_segment.gimli1.1001.b4cb0000.0’
‘/dev/shm/sm_segment.gimli1.1001.b5b70000.0’
‘/dev/shm/sm_segment.gimli1.1001.b61b0000.0’
‘/dev/shm/sm_segment.gimli1.1001.b820000.0’
‘/dev/shm/sm_segment.gimli1.1001.bcec0000.0’
‘/dev/shm/sm_segment.gimli1.1001.cc880000.0’
‘/dev/shm/sm_segment.gimli1.1001.ccfc0000.0’
‘/dev/shm/sm_segment.gimli1.1001.cd3e0000.0’
‘/dev/shm/sm_segment.gimli1.1001.d1c10000.0’
‘/dev/shm/sm_segment.gimli1.1001.d27f0000.0’
‘/dev/shm/sm_segment.gimli1.1001.de2f0000.0’
‘/dev/shm/sm_segment.gimli1.1001.de9d0000.0’
‘/dev/shm/sm_segment.gimli1.1001.e02f0000.0’
‘/dev/shm/sm_segment.gimli1.1001.e58b0000.0’
‘/dev/shm/sm_segment.gimli1.1001.e5b50000.0’
‘/dev/shm/sm_segment.gimli1.1001.fc9a0000.0’
‘/dev/shm/sm_segment.gimli1.1001.feec0000.0’
‘~/.cache/pocl/uncached/tempfile_0WYHdv’
‘~/.cache/pocl/uncached/tempfile_1FMP4W’
‘~/.cache/pocl/uncached/tempfile_1cH8Y9’
‘~/.cache/pocl/uncached/tempfile_1x0Xhi’
‘~/.cache/pocl/uncached/tempfile_2RY0uE’
‘~/.cache/pocl/uncached/tempfile_97RPNB’
‘~/.cache/pocl/uncached/tempfile_AbPGqs’
‘~/.cache/pocl/uncached/tempfile_CuqyEs’
‘~/.cache/pocl/uncached/tempfile_D4SBpS’
‘~/.cache/pocl/uncached/tempfile_FzNzvz’
‘~/.cache/pocl/uncached/tempfile_Guy17i’
‘~/.cache/pocl/uncached/tempfile_HmbiI3’
‘~/.cache/pocl/uncached/tempfile_ITSwL2’
‘~/.cache/pocl/uncached/tempfile_KAkMd6’
‘~/.cache/pocl/uncached/tempfile_LKrQqi’
‘~/.cache/pocl/uncached/tempfile_NCMFv6’
‘~/.cache/pocl/uncached/tempfile_OEFrQF’
‘~/.cache/pocl/uncached/tempfile_OJzYbi’
‘~/.cache/pocl/uncached/tempfile_Od25Yz’
‘~/.cache/pocl/uncached/tempfile_P6UyDO’
‘~/.cache/pocl/uncached/tempfile_Qy6VF5’
‘~/.cache/pocl/uncached/tempfile_RutcF6’
‘~/.cache/pocl/uncached/tempfile_THMpdp’
‘~/.cache/pocl/uncached/tempfile_VPq0OW’
‘~/.cache/pocl/uncached/tempfile_VYHu1l’
‘~/.cache/pocl/uncached/tempfile_Wn2OKx’
‘~/.cache/pocl/uncached/tempfile_WoG9ol’
‘~/.cache/pocl/uncached/tempfile_XuJi3b’
‘~/.cache/pocl/uncached/tempfile_aspUnG’
‘~/.cache/pocl/uncached/tempfile_b6UYGX’
‘~/.cache/pocl/uncached/tempfile_fCzvFT’
‘~/.cache/pocl/uncached/tempfile_g4eq9X’
‘~/.cache/pocl/uncached/tempfile_jALcN8’
‘~/.cache/pocl/uncached/tempfile_jyAgBa’
‘~/.cache/pocl/uncached/tempfile_k3ksgm’
‘~/.cache/pocl/uncached/tempfile_kZZXMy’
‘~/.cache/pocl/uncached/tempfile_lAaEUI’
‘~/.cache/pocl/uncached/tempfile_mpYemN’
‘~/.cache/pocl/uncached/tempfile_nMJdOd’
‘~/.cache/pocl/uncached/tempfile_pEDh2G’
‘~/.cache/pocl/uncached/tempfile_pXbaxP’
‘~/.cache/pocl/uncached/tempfile_qzrr9o’
‘~/.cache/pocl/uncached/tempfile_rEcWer’
‘~/.cache/pocl/uncached/tempfile_updX8v’
‘~/.cache/pocl/uncached/tempfile_xDGA0z’
‘~/.cache/pocl/uncached/tempfile_zlBQ5J’
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.2-29
Check: examples
Result: ERROR
Running examples in ‘partykit-Ex.R’ failed
The error most likely occurred in:
> ### Name: glmtree
> ### Title: Generalized Linear Model Trees
> ### Aliases: glmtree plot.glmtree predict.glmtree print.glmtree
> ### Keywords: tree
>
> ### ** Examples
>
> if(require("mlbench") && require("vcd")) {
+
+ ## 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
Loading required package: vcd
Warning in data("PimaIndiansDiabetes", package = "mlbench") :
data set ‘PimaIndiansDiabetes’ not found
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: glmtree ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
Execution halted
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-devel-windows-x86_64, r-release-windows-x86_64, r-oldrel-windows-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running ‘bugfixes.R’ [9s/11s]
Comparing ‘bugfixes.Rout’ to ‘bugfixes.Rout.save’ ... OK
Running ‘constparty.R’ [9s/11s]
Comparing ‘constparty.Rout’ to ‘constparty.Rout.save’ ... OK
Running ‘regtest-MIA.R’
Comparing ‘regtest-MIA.Rout’ to ‘regtest-MIA.Rout.save’ ... OK
Running ‘regtest-cforest.R’ [21s/27s]
Comparing ‘regtest-cforest.Rout’ to ‘regtest-cforest.Rout.save’ ... OK
Running ‘regtest-ctree.R’
Comparing ‘regtest-ctree.Rout’ to ‘regtest-ctree.Rout.save’ ... OK
Running ‘regtest-glmtree.R’ [55s/71s]
Running ‘regtest-honesty.R’
Running ‘regtest-lmtree.R’
Running ‘regtest-nmax.R’
Comparing ‘regtest-nmax.Rout’ to ‘regtest-nmax.Rout.save’ ... OK
Running ‘regtest-node.R’
Comparing ‘regtest-node.Rout’ to ‘regtest-node.Rout.save’ ... OK
Running ‘regtest-party-random.R’
Running ‘regtest-party.R’
Comparing ‘regtest-party.Rout’ to ‘regtest-party.Rout.save’ ... OK
Running ‘regtest-split.R’
Comparing ‘regtest-split.Rout’ to ‘regtest-split.Rout.save’ ... OK
Running ‘regtest-weights.R’
Comparing ‘regtest-weights.Rout’ to ‘regtest-weights.Rout.save’ ... OK
Running the tests in ‘tests/regtest-glmtree.R’ failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 1.2-29
Check: re-building of vignette outputs
Result: ERROR
Error(s) in re-building vignettes:
--- re-building ‘constparty.Rnw’ using knitr
--- finished re-building ‘constparty.Rnw’
--- re-building ‘ctree.Rnw’ using knitr
--- finished re-building ‘ctree.Rnw’
--- re-building ‘mob.Rnw’ using knitr
Quitting from mob.Rnw:443-445 [PimaIndiansDiabetes-mob]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<error/rlang_error>
Error:
! object 'PimaIndiansDiabetes' not found
---
Backtrace:
x
1. +-stats::model.frame(...)
2. \-Formula:::model.frame.Formula(...)
3. +-stats::model.frame(...)
4. +-stats::terms(formula, lhs = lhs, rhs = rhs, data = data, dot = dot)
5. \-Formula:::terms.Formula(...)
6. +-stats::terms(form, ...)
7. \-stats::terms.formula(form, ...)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error: processing vignette 'mob.Rnw' failed with diagnostics:
object 'PimaIndiansDiabetes' not found
--- failed re-building ‘mob.Rnw’
--- re-building ‘partykit.Rnw’ using knitr
--- finished re-building ‘partykit.Rnw’
SUMMARY: processing the following file failed:
‘mob.Rnw’
Error: Vignette re-building failed.
Execution halted
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-devel-windows-x86_64, r-release-windows-x86_64, r-oldrel-windows-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running ‘bugfixes.R’
Comparing ‘bugfixes.Rout’ to ‘bugfixes.Rout.save’ ... OK
Running ‘constparty.R’
Comparing ‘constparty.Rout’ to ‘constparty.Rout.save’ ... OK
Running ‘regtest-MIA.R’
Comparing ‘regtest-MIA.Rout’ to ‘regtest-MIA.Rout.save’ ... OK
Running ‘regtest-cforest.R’
Comparing ‘regtest-cforest.Rout’ to ‘regtest-cforest.Rout.save’ ... OK
Running ‘regtest-ctree.R’
Comparing ‘regtest-ctree.Rout’ to ‘regtest-ctree.Rout.save’ ... OK
Running ‘regtest-glmtree.R’ [26s/27s]
Running ‘regtest-honesty.R’
Running ‘regtest-lmtree.R’
Running ‘regtest-nmax.R’
Comparing ‘regtest-nmax.Rout’ to ‘regtest-nmax.Rout.save’ ... OK
Running ‘regtest-node.R’
Comparing ‘regtest-node.Rout’ to ‘regtest-node.Rout.save’ ... OK
Running ‘regtest-party-random.R’
Running ‘regtest-party.R’
Comparing ‘regtest-party.Rout’ to ‘regtest-party.Rout.save’ ... OK
Running ‘regtest-split.R’
Comparing ‘regtest-split.Rout’ to ‘regtest-split.Rout.save’ ... OK
Running ‘regtest-weights.R’
Comparing ‘regtest-weights.Rout’ to ‘regtest-weights.Rout.save’ ... OK
Running the tests in ‘tests/regtest-glmtree.R’ failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc
Version: 1.2-29
Check: tests
Result: ERROR
Running 'bugfixes.R' [5s]
Comparing 'bugfixes.Rout' to 'bugfixes.Rout.save' ... OK
Running 'constparty.R' [5s]
Comparing 'constparty.Rout' to 'constparty.Rout.save' ... OK
Running 'regtest-MIA.R' [2s]
Comparing 'regtest-MIA.Rout' to 'regtest-MIA.Rout.save' ... OK
Running 'regtest-cforest.R' [9s]
Comparing 'regtest-cforest.Rout' to 'regtest-cforest.Rout.save' ... OK
Running 'regtest-ctree.R' [2s]
Comparing 'regtest-ctree.Rout' to 'regtest-ctree.Rout.save' ... OK
Running 'regtest-glmtree.R' [45s]
Running 'regtest-honesty.R' [2s]
Running 'regtest-lmtree.R' [3s]
Running 'regtest-nmax.R' [2s]
Comparing 'regtest-nmax.Rout' to 'regtest-nmax.Rout.save' ... OK
Running 'regtest-node.R' [1s]
Comparing 'regtest-node.Rout' to 'regtest-node.Rout.save' ... OK
Running 'regtest-party-random.R' [2s]
Running 'regtest-party.R' [5s]
Comparing 'regtest-party.Rout' to 'regtest-party.Rout.save' ... OK
Running 'regtest-split.R' [2s]
Comparing 'regtest-split.Rout' to 'regtest-split.Rout.save' ... OK
Running 'regtest-weights.R' [2s]
Comparing 'regtest-weights.Rout' to 'regtest-weights.Rout.save' ... OK
Running the tests in 'tests/regtest-glmtree.R' failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-devel-windows-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running ‘bugfixes.R’ [5s/7s]
Comparing ‘bugfixes.Rout’ to ‘bugfixes.Rout.save’ ... OK
Running ‘constparty.R’ [5s/7s]
Comparing ‘constparty.Rout’ to ‘constparty.Rout.save’ ... OK
Running ‘regtest-MIA.R’ [2s/4s]
Comparing ‘regtest-MIA.Rout’ to ‘regtest-MIA.Rout.save’ ... OK
Running ‘regtest-cforest.R’ [12s/15s]
Comparing ‘regtest-cforest.Rout’ to ‘regtest-cforest.Rout.save’ ... OK
Running ‘regtest-ctree.R’ [2s/3s]
Comparing ‘regtest-ctree.Rout’ to ‘regtest-ctree.Rout.save’ ... OK
Running ‘regtest-glmtree.R’ [33s/40s]
Running ‘regtest-honesty.R’ [2s/2s]
Running ‘regtest-lmtree.R’ [3s/3s]
Running ‘regtest-nmax.R’ [2s/2s]
Comparing ‘regtest-nmax.Rout’ to ‘regtest-nmax.Rout.save’ ... OK
Running ‘regtest-node.R’ [2s/3s]
Comparing ‘regtest-node.Rout’ to ‘regtest-node.Rout.save’ ... OK
Running ‘regtest-party-random.R’ [2s/3s]
Running ‘regtest-party.R’ [5s/5s]
Comparing ‘regtest-party.Rout’ to ‘regtest-party.Rout.save’ ... OK
Running ‘regtest-split.R’ [2s/2s]
Comparing ‘regtest-split.Rout’ to ‘regtest-split.Rout.save’ ... OK
Running ‘regtest-weights.R’ [2s/3s]
Comparing ‘regtest-weights.Rout’ to ‘regtest-weights.Rout.save’ ... OK
Running the tests in ‘tests/regtest-glmtree.R’ failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-patched-linux-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running ‘bugfixes.R’ [5s/7s]
Comparing ‘bugfixes.Rout’ to ‘bugfixes.Rout.save’ ... OK
Running ‘constparty.R’ [5s/6s]
Comparing ‘constparty.Rout’ to ‘constparty.Rout.save’ ... OK
Running ‘regtest-MIA.R’ [2s/2s]
Comparing ‘regtest-MIA.Rout’ to ‘regtest-MIA.Rout.save’ ... OK
Running ‘regtest-cforest.R’ [12s/13s]
Comparing ‘regtest-cforest.Rout’ to ‘regtest-cforest.Rout.save’ ... OK
Running ‘regtest-ctree.R’ [2s/2s]
Comparing ‘regtest-ctree.Rout’ to ‘regtest-ctree.Rout.save’ ... OK
Running ‘regtest-glmtree.R’ [33s/40s]
Running ‘regtest-honesty.R’ [2s/3s]
Running ‘regtest-lmtree.R’ [3s/3s]
Running ‘regtest-nmax.R’ [2s/3s]
Comparing ‘regtest-nmax.Rout’ to ‘regtest-nmax.Rout.save’ ... OK
Running ‘regtest-node.R’ [2s/2s]
Comparing ‘regtest-node.Rout’ to ‘regtest-node.Rout.save’ ... OK
Running ‘regtest-party-random.R’ [2s/3s]
Running ‘regtest-party.R’ [5s/5s]
Comparing ‘regtest-party.Rout’ to ‘regtest-party.Rout.save’ ... OK
Running ‘regtest-split.R’ [2s/2s]
Comparing ‘regtest-split.Rout’ to ‘regtest-split.Rout.save’ ... OK
Running ‘regtest-weights.R’ [2s/3s]
Comparing ‘regtest-weights.Rout’ to ‘regtest-weights.Rout.save’ ... OK
Running the tests in ‘tests/regtest-glmtree.R’ failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-release-linux-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running 'bugfixes.R' [5s]
Comparing 'bugfixes.Rout' to 'bugfixes.Rout.save' ... OK
Running 'constparty.R' [4s]
Comparing 'constparty.Rout' to 'constparty.Rout.save' ... OK
Running 'regtest-MIA.R' [2s]
Comparing 'regtest-MIA.Rout' to 'regtest-MIA.Rout.save' ... OK
Running 'regtest-cforest.R' [8s]
Comparing 'regtest-cforest.Rout' to 'regtest-cforest.Rout.save' ... OK
Running 'regtest-ctree.R' [2s]
Comparing 'regtest-ctree.Rout' to 'regtest-ctree.Rout.save' ... OK
Running 'regtest-glmtree.R' [41s]
Running 'regtest-honesty.R' [2s]
Running 'regtest-lmtree.R' [2s]
Running 'regtest-nmax.R' [2s]
Comparing 'regtest-nmax.Rout' to 'regtest-nmax.Rout.save' ... OK
Running 'regtest-node.R' [2s]
Comparing 'regtest-node.Rout' to 'regtest-node.Rout.save' ... OK
Running 'regtest-party-random.R' [3s]
Running 'regtest-party.R' [4s]
Comparing 'regtest-party.Rout' to 'regtest-party.Rout.save' ... OK
Running 'regtest-split.R' [1s]
Comparing 'regtest-split.Rout' to 'regtest-split.Rout.save' ... OK
Running 'regtest-weights.R' [2s]
Comparing 'regtest-weights.Rout' to 'regtest-weights.Rout.save' ... OK
Running the tests in 'tests/regtest-glmtree.R' failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-release-windows-x86_64
Version: 1.2-29
Check: tests
Result: ERROR
Running 'bugfixes.R' [8s]
Comparing 'bugfixes.Rout' to 'bugfixes.Rout.save' ... OK
Running 'constparty.R' [7s]
Comparing 'constparty.Rout' to 'constparty.Rout.save' ... OK
Running 'regtest-MIA.R' [3s]
Comparing 'regtest-MIA.Rout' to 'regtest-MIA.Rout.save' ... OK
Running 'regtest-cforest.R' [13s]
Comparing 'regtest-cforest.Rout' to 'regtest-cforest.Rout.save' ... OK
Running 'regtest-ctree.R' [3s]
Comparing 'regtest-ctree.Rout' to 'regtest-ctree.Rout.save' ... OK
Running 'regtest-glmtree.R' [58s]
Running 'regtest-honesty.R' [3s]
Running 'regtest-lmtree.R' [4s]
Running 'regtest-nmax.R' [3s]
Comparing 'regtest-nmax.Rout' to 'regtest-nmax.Rout.save' ... OK
Running 'regtest-node.R' [3s]
Comparing 'regtest-node.Rout' to 'regtest-node.Rout.save' ... OK
Running 'regtest-party-random.R' [3s]
Running 'regtest-party.R' [6s]
Comparing 'regtest-party.Rout' to 'regtest-party.Rout.save' ... OK
Running 'regtest-split.R' [2s]
Comparing 'regtest-split.Rout' to 'regtest-split.Rout.save' ... OK
Running 'regtest-weights.R' [3s]
Comparing 'regtest-weights.Rout' to 'regtest-weights.Rout.save' ... OK
Running the tests in 'tests/regtest-glmtree.R' failed.
Complete output:
> suppressWarnings(RNGversion("3.5.2"))
>
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
>
> set.seed(29)
> n <- 1000
> x <- runif(n)
> z <- runif(n)
> y <- rnorm(n, mean = x * c(-1, 1)[(z > 0.7) + 1], sd = 3)
> z_noise <- factor(sample(1:3, size = n, replace = TRUE))
> d <- data.frame(y = y, x = x, z = z, z_noise = z_noise)
>
>
> fmla <- as.formula("y ~ x | z + z_noise")
> fmly <- gaussian()
> fit <- partykit:::glmfit
>
> # versions of the data
> d1 <- d
> d1$z <- signif(d1$z, digits = 1)
>
> k <- 20
> zs_noise <- matrix(rnorm(n*k), nrow = n)
> colnames(zs_noise) <- paste0("z_noise_", 1:k)
> d2 <- cbind(d, zs_noise)
> fmla2 <- as.formula(paste("y ~ x | z + z_noise +",
+ paste0("z_noise_", 1:k, collapse = " + ")))
>
>
> d3 <- d2
> d3$z <- factor(sample(1:3, size = n, replace = TRUE, prob = c(0.1, 0.5, 0.4)))
> d3$y <- rnorm(n, mean = x * c(-1, 1)[(d3$z == 2) + 1], sd = 3)
>
> ## check weights
> w <- rep(1, n)
> w[1:10] <- 2
> (mw1 <- glmtree(formula = fmla, data = d, weights = w))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 706
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 304
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
> (mw2 <- glmtree(formula = fmla, data = d, weights = w, caseweights = FALSE))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1447422 -0.8138701
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.07006626 0.73278593
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.48
>
>
>
> ## check dfsplit
> (mmfluc2 <- mob(formula = fmla, data = d, fit = partykit:::glmfit))
Model-based recursive partitioning (partykit:::glmfit)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function: 2551.673
> (mmfluc3 <- glmtree(formula = fmla, data = d))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
> (mmfluc3_dfsplit <- glmtree(formula = fmla, data = d, dfsplit = 10))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
>
> ## check tests
> if (require("strucchange"))
+ print(sctest(mmfluc3, node = 1)) # does not yet work
Loading required package: strucchange
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: sandwich
z z_noise
statistic 2.292499e+01 0.6165335
p.value 7.780038e-04 0.9984952
>
> x <- mmfluc3
> (tst3 <- nodeapply(x, ids = nodeids(x), function(n) n$info$criterion))
$`1`
NULL
$`2`
NULL
$`3`
NULL
>
>
>
>
> ## check logLik and AIC
> logLik(mmfluc2)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3)
'log Lik.' -2551.673 (df=7)
> logLik(mmfluc3_dfsplit)
'log Lik.' -2551.673 (df=16)
> logLik(glm(y ~ x, data = d))
'log Lik.' -2563.694 (df=3)
>
> AIC(mmfluc3)
[1] 5117.347
> AIC(mmfluc3_dfsplit)
[1] 5135.347
>
> ## check pruning
> pr2 <- prune.modelparty(mmfluc2)
> AIC(mmfluc2)
[1] 5117.347
> AIC(pr2)
[1] 5117.347
>
> mmfluc_dfsplit3 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 3)
> mmfluc_dfsplit4 <- glmtree(formula = fmla, data = d, alpha = 0.5, dfsplit = 4)
> pr_dfsplit3 <- prune.modelparty(mmfluc_dfsplit3)
> pr_dfsplit4 <- prune.modelparty(mmfluc_dfsplit4)
> AIC(mmfluc_dfsplit3)
[1] 5142.774
> AIC(mmfluc_dfsplit4)
[1] 5156.774
> AIC(pr_dfsplit3)
[1] 5142.774
> AIC(pr_dfsplit4)
[1] 5124.456
>
> width(mmfluc_dfsplit3)
[1] 8
> width(mmfluc_dfsplit4)
[1] 8
> width(pr_dfsplit3)
[1] 8
> width(pr_dfsplit4)
[1] 3
>
> ## check inner and terminal
> options <- list(NULL,
+ "object",
+ "estfun",
+ c("object", "estfun"))
>
> arguments <- list("inner",
+ "terminal",
+ c("inner", "terminal"))
>
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, inner = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
>
> for (o in options) {
+ print(o)
+ x <- glmtree(formula = fmla, data = d, terminal = o)
+ str(nodeapply(x, ids = nodeids(x), function(n) n$info[c("object", "estfun")]), 2)
+ }
NULL
List of 3
$ 1:List of 2
..$ NA: NULL
..$ NA: NULL
$ 2:List of 2
..$ NA: NULL
..$ NA: NULL
$ 3:List of 2
..$ NA: NULL
..$ NA: NULL
[1] "object"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ NA : NULL
[1] "estfun"
List of 3
$ 1:List of 2
..$ NA : NULL
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ NA : NULL
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ NA : NULL
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
[1] "object" "estfun"
List of 3
$ 1:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:1000, 1:2] -0.1375 -0.0583 -0.0553 0.1043 -0.0744 ...
.. ..- attr(*, "dimnames")=List of 2
$ 2:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:704, 1:2] -0.1291 0.5104 -0.0603 -0.1868 -0.0981 ...
.. ..- attr(*, "dimnames")=List of 2
$ 3:List of 2
..$ object:List of 24
.. ..- attr(*, "class")= chr [1:2] "glm" "lm"
..$ estfun: num [1:296, 1:2] -0.1053 -0.0877 0.0544 -0.1581 0.43 ...
.. ..- attr(*, "dimnames")=List of 2
>
>
> ## check model
> m_mt <- glmtree(formula = fmla, data = d, model = TRUE)
> m_mf <- glmtree(formula = fmla, data = d, model = FALSE)
>
> dim(m_mt$data)
[1] 1000 4
> dim(m_mf$data)
[1] 0 4
>
>
> ## check multiway
> (m_mult <- glmtree(formula = fmla2, data = d3, catsplit = "multiway", minsize = 80))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise + z_noise_1 + z_noise_2 + z_noise_3 + z_noise_4 +
z_noise_5 + z_noise_6 + z_noise_7 + z_noise_8 + z_noise_9 +
z_noise_10 + z_noise_11 + z_noise_12 + z_noise_13 + z_noise_14 +
z_noise_15 + z_noise_16 + z_noise_17 + z_noise_18 + z_noise_19 +
z_noise_20
Fitted party:
[1] root
| [2] z in 1: n = 76
| (Intercept) x
| 0.9859847 -3.2600047
| [3] z in 2: n = 537
| (Intercept) x
| -0.06970187 1.12305074
| [4] z in 3: n = 387
| (Intercept) x
| 0.3824392 -1.8337151
Number of inner nodes: 1
Number of terminal nodes: 3
Number of parameters per node: 2
Objective function (negative log-likelihood): 2511.927
>
>
> ## check parm
> fmla_p <- as.formula("y ~ x + z_noise + z_noise_1 | z + z_noise_2")
> (m_interc <- glmtree(formula = fmla_p, data = d2, parm = 1))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root
| [2] z <= 0.65035: n = 644
| (Intercept) x z_noise2 z_noise3 z_noise_1
| -0.05585503 -1.01257554 0.34044520 -0.16384987 0.24197601
| [3] z > 0.65035: n = 356
| (Intercept) x z_noise2 z_noise3 z_noise_1
| 0.06411865 0.78733976 -0.67811149 -0.14240432 -0.01239154
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 5
Objective function (negative log-likelihood): 2548.32
>
> (m_p3 <- glmtree(formula = fmla_p, data = d2, parm = 3))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x + z_noise + z_noise_1 | z + z_noise_2
Fitted party:
[1] root: n = 1000
(Intercept) x z_noise2 z_noise3 z_noise_1
-0.058855295 -0.340314311 -0.008404682 -0.109839080 0.154798281
Number of inner nodes: 0
Number of terminal nodes: 1
Number of parameters per node: 5
Objective function (negative log-likelihood): 2562.32
>
>
> ## check trim
> (m_tt <- glmtree(formula = fmla, data = d, trim = 0.2))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.70311: n = 704
| (Intercept) x
| -0.1619978 -0.7896293
| [3] z > 0.70311: n = 296
| (Intercept) x
| 0.08683535 0.65598287
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2551.673
>
> (m_tf <- glmtree(formula = fmla, data = d, trim = 300, minsize = 300))
Generalized linear model tree (family: gaussian)
Model formula:
y ~ x | z + z_noise
Fitted party:
[1] root
| [2] z <= 0.6892: n = 691
| (Intercept) x
| -0.1778199 -0.7692901
| [3] z > 0.6892: n = 309
| (Intercept) x
| 0.1065746 0.5562243
Number of inner nodes: 1
Number of terminal nodes: 2
Number of parameters per node: 2
Objective function (negative log-likelihood): 2552.12
>
>
>
> ## check breakties
> m_bt <- glmtree(formula = fmla, data = d1, breakties = TRUE)
> m_df <- glmtree(formula = fmla, data = d1, breakties = FALSE)
>
> all.equal(m_bt, m_df, check.environment = FALSE)
[1] "Component \"node\": Component \"kids\": Component 1: Component 5: Component 6: Mean relative difference: 0.1237503"
[2] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 5: Mean relative difference: 0.1746109"
[3] "Component \"node\": Component \"kids\": Component 2: Component 5: Component 6: Mean relative difference: 0.0443985"
[4] "Component \"node\": Component \"info\": Component \"p.value\": Mean relative difference: 1.100407"
[5] "Component \"node\": Component \"info\": Component \"test\": Mean relative difference: 0.07721086"
[6] "Component \"info\": Component \"call\": target, current do not match when deparsed"
[7] "Component \"info\": Component \"control\": Component \"breakties\": 1 element mismatch"
>
> unclass(m_bt)$node$info$criterion
NULL
> unclass(m_df)$node$info$criterion
NULL
>
> if (requireNamespace("mlbench")) {
+
+ ### example from mob vignette
+ data("PimaIndiansDiabetes", package = "mlbench")
+
+ logit <- function(y, x, start = NULL, weights = NULL, offset = NULL, ...) {
+ glm(y ~ 0 + x, family = binomial, start = start, ...)
+ }
+
+ pid_formula <- diabetes ~ glucose | pregnant + pressure + triceps +
+ insulin + mass + pedigree + age
+
+ pid_tree <- mob(pid_formula, data = PimaIndiansDiabetes, fit = logit)
+ print(pid_tree)
+ print(nodeapply(pid_tree, ids = nodeids(pid_tree), function(n) n$info$criterion))
+
+ }
Loading required namespace: mlbench
Error in eval(mf, parent.frame()) :
object 'PimaIndiansDiabetes' not found
Calls: mob ... model.frame -> terms -> terms.Formula -> terms -> terms.formula
In addition: Warning message:
In data("PimaIndiansDiabetes", package = "mlbench") :
data set 'PimaIndiansDiabetes' not found
Execution halted
Flavor: r-oldrel-windows-x86_64