From 19236efd34bccb9fc8d9111c435f77add18f8c6b Mon Sep 17 00:00:00 2001 From: Hide Kojima Date: Sat, 18 Jul 2026 02:09:40 -0700 Subject: [PATCH] feat(chaid): emit split test stats in tree_nodes for tree display Add p_value, adjusted_p_value, split_statistic, split_df columns to the CHAID tree_nodes tidy output (build_chaid_tree_nodes) so the interactive decision-tree renderer can show each split's adjusted p-value, chi-square statistic, and df, SPSS-style. Stats are stored on the splitting node (from the winning predictor's chi-square test) and left NA on leaves. Co-Authored-By: Claude Opus 4.8 --- R/build_chaid.R | 10 ++++++++++ R/chaid.R | 8 ++++++++ tests/testthat/test_build_chaid.R | 29 +++++++++++++++++++++++++++++ 3 files changed, 47 insertions(+) diff --git a/R/build_chaid.R b/R/build_chaid.R index 6d26230c..def7a4d6 100644 --- a/R/build_chaid.R +++ b/R/build_chaid.R @@ -429,6 +429,10 @@ build_chaid_tree_nodes <- function(x) { }) class_json <- as.character(jsonlite::toJSON(arr, auto_unbox = TRUE, digits = NA)) + # Split-test stats belong to nodes that actually split; NA everywhere else + # (leaves, and nodes whose best candidate failed the alpha_split gate). + is_split <- !isTRUE(nodes$is_terminal[i]) + edge_row <- which(edges$child_id == id) if (length(edge_row) == 1) { cond_column <- map_name(edges$split_variable[edge_row]) @@ -458,6 +462,12 @@ build_chaid_tree_nodes <- function(x) { sd_value = NA_real_, rmse_value = NA_real_, dist_json = NA_character_, + # CHAID split test at this node (NA for leaves). The interactive tree + # renderer shows these on the splitting (parent) node, SPSS-style. + p_value = if (is_split) nodes$p_value[i] else NA_real_, + adjusted_p_value = if (is_split) nodes$adjusted_p_value[i] else NA_real_, + split_statistic = if (is_split) nodes$split_statistic[i] else NA_real_, + split_df = if (is_split) nodes$split_df[i] else NA_real_, stringsAsFactors = FALSE ) }) diff --git a/R/chaid.R b/R/chaid.R index e9317b6b..42cb3d2d 100644 --- a/R/chaid.R +++ b/R/chaid.R @@ -86,6 +86,8 @@ chaid_fit <- function(data, split_variable = NA_character_, p_value = NA_real_, adjusted_p_value = NA_real_, + split_statistic = NA_real_, + split_df = NA_real_, rule = 'Root', stringsAsFactors = FALSE ) @@ -655,6 +657,8 @@ grow_chaid_tree <- function(data, target, predictors, parameters, split_variable = NA_character_, p_value = NA_real_, adjusted_p_value = NA_real_, + split_statistic = NA_real_, + split_df = NA_real_, rule = rule ) state$node_records[[as.character(node.id)]] <- record @@ -705,6 +709,8 @@ grow_chaid_tree <- function(data, target, predictors, parameters, current.record <- state$node_records[[as.character(node.id)]] current.record$p_value <- best$p_value current.record$adjusted_p_value <- best$adjusted_p_value + current.record$split_statistic <- best$test$statistic + current.record$split_df <- best$test$df state$node_records[[as.character(node.id)]] <- current.record if (is.na(best$p_value) || best$adjusted_p_value > parameters$alpha_split) { @@ -769,6 +775,8 @@ grow_chaid_tree <- function(data, target, predictors, parameters, split_variable = record$split_variable, p_value = record$p_value, adjusted_p_value = record$adjusted_p_value, + split_statistic = record$split_statistic, + split_df = record$split_df, rule = record$rule, stringsAsFactors = FALSE ) diff --git a/tests/testthat/test_build_chaid.R b/tests/testthat/test_build_chaid.R index 2caaf30c..36d1ca37 100644 --- a/tests/testthat/test_build_chaid.R +++ b/tests/testthat/test_build_chaid.R @@ -66,6 +66,35 @@ test_that("tree_nodes tidy output matches the renderer schema", { expect_true(all(c("label", "n", "pct") %in% names(parsed))) }) +test_that("tree_nodes carries CHAID split stats on split nodes, NA on leaves", { + # Build a target that genuinely depends on `plan` so CHAID makes a split. + set.seed(3) + n <- 400 + plan <- sample(c("A", "B"), n, replace = TRUE) + is_churn <- ifelse(plan == "A", runif(n) < 0.8, runif(n) < 0.2) + df <- data.frame(is_churn = is_churn, plan = plan, + region = sample(c("east", "west"), n, replace = TRUE), + stringsAsFactors = FALSE) + model_df <- suppressWarnings(exp_chaid(df, is_churn, plan, region, + min_split = 20, min_bucket = 5)) + nodes <- model_df %>% tidy_rowwise(model, type = "tree_nodes") + + stat_cols <- c("p_value", "adjusted_p_value", "split_statistic", "split_df") + expect_true(all(stat_cols %in% colnames(nodes))) + + split_nodes <- nodes[!nodes$is_leaf, ] + leaf_nodes <- nodes[nodes$is_leaf, ] + expect_gt(nrow(split_nodes), 0) + # Every splitting node reports a finite chi-square, df, and adjusted p-value. + expect_true(all(is.finite(split_nodes$split_statistic))) + expect_true(all(is.finite(split_nodes$split_df))) + expect_true(all(is.finite(split_nodes$adjusted_p_value))) + expect_true(all(split_nodes$adjusted_p_value >= 0 & split_nodes$adjusted_p_value <= 1)) + # Leaves never carry a split test. + expect_true(all(is.na(leaf_nodes$split_statistic))) + expect_true(all(is.na(leaf_nodes$split_df))) +}) + test_that("binary tree_nodes lists the positive (TRUE) class first", { df <- make_binary_df() model_df <- suppressWarnings(exp_chaid(df, is_churn, plan, region,