## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 6, fig.height = 4.5) set.seed(2024) ## ----data--------------------------------------------------------------------- library(glmtree) ## ----tree-data---------------------------------------------------------------- data <- generateData(n = 2000, scenario = "tree") train <- sample(nrow(data), 1400) features <- c("x1", "x2", "x3") ## ----tree-fit----------------------------------------------------------------- fit <- glmtree( x = data[train, features], y = data$y[train], K = 5, iterations = 100, ctree_controls = partykit::ctree_control(alpha = 0.1, minbucket = 80, maxdepth = 4) ) fit ## ----tree-predict------------------------------------------------------------- table(true_cluster = data$c[-train], segment = predict(fit, data[-train, features], type = "segment")) plot(fit@best.tree$tree) ## ----tree-evolution----------------------------------------------------------- plot(unlist(fit@performance$criterionEvolution), type = "l", xlab = "Iteration", ylab = "-BIC") abline(v = fit@performance$best_iteration, lty = 2) ## ----tree-compare------------------------------------------------------------- logit <- glm(y ~ x1 + x2 + x3, data = data[train, ], family = binomial) mob <- partykit::glmtree(y ~ x2 + x3 | x1 + x2 + x3, data = data[train, ], family = binomial) c( logit = normalizedGini(data$y[-train], predict(logit, data[-train, ], type = "response")), mob = normalizedGini(data$y[-train], predict(mob, data[-train, ], type = "response")), glmtree = normalizedGini(data$y[-train], predict(fit, data[-train, features])) ) ## ----notree------------------------------------------------------------------- data <- generateData(n = 2000, scenario = "no tree") train <- sample(nrow(data), 1400) fit <- glmtree( x = data[train, c("x1", "x2")], y = data$y[train], K = 5, iterations = 100, ctree_controls = partykit::ctree_control(alpha = 0.1, minbucket = 80, maxdepth = 4) ) logit <- glm(y ~ x1 + x2, data = data[train, ], family = binomial) c( logit = normalizedGini(data$y[-train], predict(logit, data[-train, ], type = "response")), glmtree = normalizedGini(data$y[-train], predict(fit, data[-train, c("x1", "x2")])) ) ## ----validation, eval = FALSE------------------------------------------------- # fit <- glmtree( # x = data[, features], y = data$y, test = TRUE, validation = TRUE, # proportions = c(0.2, 0.2), criterion = "gini", patience = 50 # ) ## ----famd, eval = requireNamespace("FactoMineR", quietly = TRUE)-------------- data <- generateData(n = 2000, scenario = "tree") train <- sample(nrow(data), 1400) mixed <- FactoMineR::FAMD(data[train, features], graph = FALSE) cluster <- function(newdata) stats::predict(mixed, newdata)$coord[, "Dim 1"] < 0 segment <- cluster(data[, features]) pred <- numeric(nrow(data)) for (j in c(TRUE, FALSE)) { model <- glm(y ~ x1 + x2 + x3, data = data[train, ][segment[train] == j, ], family = binomial) pred[segment == j] <- predict(model, data[segment == j, ], type = "response") } normalizedGini(data$y[-train], pred[-train])