Executive Summary
What is associated with Churned across 500 observations
The short answer
A binomial (logistic) regression on 500 observations identifies Support Tickets as the strongest predictor of Churned, with 2 of 3 predictors statistically significant and the model explaining 15.7% of deviance. Logistic regression was chosen because the outcome is yes/no; a straight line would predict impossible probabilities.
The detail
Model family: Binomial (logistic). Observations: 500. Predictors: Support Tickets, Tenure Months, Shoe Size. Significant predictors: 2 at p < 0.05. Top predictor: Support Tickets, with each additional unit multiplying the odds of Churned = 'yes' by 3.271. Deviance explained: 0.157. AIC: 558.7.
What this can't tell you
The 15.7% deviance explained indicates substantial unexplained variation; other drivers or random noise dominate the outcome. Statistical significance of 2 predictors does not imply practical importance or that the model is actionable.
Analysis Overview
Binomial (logistic) regression of Churned on 3 predictors across 500 observations.
The short answer
A binomial (logistic) regression is the right choice here because the outcome is yes/no; a straight-line model would predict impossible probabilities outside [0, 1]. Logistic regression models odds instead, yielding effect sizes as odds ratios. The model explains 15.7% of the deviance in Churned across 500 observations using 3 predictors.
The detail
The outcome Churned takes exactly 2 distinct values, triggering selection of the binomial (logistic) family. This family models the probability that Churned = 'yes' on a multiplicative (odds) scale. Effects are reported as odds ratios with 95% confidence intervals — a multiplicative change in odds per unit of each predictor. The three predictors are Support Tickets, Tenure Months, and Shoe Size. Deviance explained is 0.157, a modest share of variation.
What this can't tell you
This cross-sectional snapshot cannot establish temporal order or causal direction. Association between predictors and Churned does not imply one drives the other.
Data Quality
Outcome validation, predictor typing, and exclusions.
The short answer
All 500 rows were retained and used in the model. Numeric predictors were imputed at the median where missing; categorical predictors had rare levels grouped into 'Other' and blanks labeled 'Missing'. No rows were dropped for blank outcome values.
The detail
Initial rows loaded: 500. Final rows modeled: 500. Rows removed: 0. Numeric predictors (Support Tickets, Tenure Months, Shoe Size) received median imputation for missing values. Text predictors were treated as categories, with rare levels lumped into 'Other' and blanks explicitly labeled 'Missing'. The outcome inspection confirmed Churned takes exactly 2 distinct values, driving the binomial family choice. All mapped predictor columns were usable in the final model.
What this can't tell you
The specific count of missing values in each numeric predictor is not reported, so the magnitude of imputation cannot be assessed. The frequency thresholds for rare-level lumping are not specified, limiting replication of the exact grouping on new data.
Effects
Each predictor's odds ratio with a 95% confidence interval and plain-language significance.
The short answer
Support Tickets dominates: its odds ratio of 3.271 is far larger than the other two predictors. Tenure Months shows a weak negative association (odds ratio 0.979), while Shoe Size has no reliable effect (odds ratio 0.987, not significant).
The detail
Support Tickets (odds ratio 3.271, 95% CI: 2.513–4.256, p < 0.001) leads by a wide margin. Tenure Months (odds ratio 0.979, 95% CI: 0.965–0.995, p = 0.0076) is statistically significant but represents a small multiplicative decrease per month. Shoe Size (odds ratio 0.987, 95% CI: 0.929–1.048, p = 0.664) is not significant; its confidence interval includes 1, indicating no reliable effect. Two of three terms are significant at p < 0.05. The intercept (0.200 on the response scale) represents the baseline predicted probability of churn with all numeric predictors at zero and categories at reference levels.
What this can't tell you
The confidence intervals for Tenure Months and Shoe Size are narrow, but Shoe Size's interval straddles 1, so no meaningful effect can be claimed for that predictor.
Strongest Predictor Effect
Model-predicted Churned across the strongest numeric predictor, all else held typical.
The short answer
As Support Tickets rises from 0.01 to 2.99, the predicted probability of churn climbs from 8.1% to 75.1% in a curved S-shape. The curve bends because the model works on a multiplicative scale: equal steps in Support Tickets produce proportional, not equal, changes in the prediction.
The detail
With all other predictors held at their typical values (numeric at median, categories at most common level), moving Support Tickets from its observed low (0.01) to high (2.99) shifts the predicted probability from 0.0813 to 0.751. The relationship is not linear: at Support Tickets = 0.01, the prediction is 0.0813; at 1.0202, it is 0.2265; at 2.0, it is approximately 0.54. This curved pattern reflects the logistic model's multiplicative structure: each unit increase multiplies the odds by 3.271, producing proportional rather than constant increments in probability.
What this can't tell you
The curve shows the model's predictions holding other predictors constant, not the causal effect of Support Tickets alone. Confounding or interaction with unmeasured variables cannot be ruled out from this observational model.
Predicted vs Actual
How closely the model's predictions track the observed Churned.
The short answer
Predictions track observations reasonably well across most of the range, clustering near the diagonal, but the model under-predicts at high probabilities: where predicted probability is 0.6316, actual churn is only 0.52; where predicted is 0.7416, actual is 0.8. This suggests the model is well-calibrated in the middle but slightly optimistic at the high end.
The detail
Ten bins group rows by predicted probability; each point compares average predicted (horizontal) to observed churn rate (vertical). Points on the diagonal indicate honest predictions. Observed points: (0.0923, 0.1), (0.1308, 0.16), (0.1716, 0.12), (0.2175, 0.2), (0.2772, 0.24), (0.3482, 0.38), (0.4463, 0.46), (0.5429, 0.62), (0.6316, 0.52), (0.7416, 0.8). The point at (0.6316, 0.52) sits notably below the diagonal.
What this can't tell you
Calibration plots do not assess discrimination (the model's ability to rank high-risk from low-risk cases). Small bin sizes at extreme probabilities may inflate noise.
Model Diagnostics
The family decision trail and fit quality for the binomial (logistic) model.
| Metric | Value | Interpretation |
|---|---|---|
| Outcome type detected | Churned takes exactly 2 distinct values, so it is a yes/no outcome; the analysis models the probability that Churned = 'yes' | What the outcome column's own values say about which model family applies. |
| Family chosen | Binomial (logistic) | Chosen because the outcome has exactly two values, and a straight-line model on a yes/no outcome predicts impossible probabilities; logistic regression models the odds instead. |
| Deviance explained | 0.157 | The predictors account for 15.7% of the deviance in Churned. |
| AIC | 558.7 | Model comparison score (lower is better); only comparable between models fit to this same data. |
| Baseline (intercept) | 0.200 | With every numeric predictor at zero and categories at their reference level, the predicted probability of Churned = 'yes' is 20%. |
| Rows used / dropped | 500 / 0 | Rows with a valid Churned value were modeled; rows with a blank or unusable outcome were dropped, never imputed. |
The short answer
The binomial (logistic) family was chosen because Churned has exactly 2 distinct values, making it a yes/no outcome. The model explains 15.7% of the deviance. All 500 rows were used; none were dropped.
The detail
The family decision trail: Churned takes exactly 2 distinct values, so the analysis models the probability that Churned = 'yes' using the binomial (logistic) family. A straight-line model on a yes/no outcome predicts impossible probabilities; logistic regression models the odds instead. Deviance explained: 0.157. AIC: 558.7 (for comparing alternative models fit to this same data). Baseline (intercept): 0.200, meaning with every numeric predictor at zero and categories at reference level, the predicted probability of Churned = 'yes' is 20%. Rows used: 500. Rows dropped: 0 (all rows had a valid Churned value).
What this can't tell you
The 15.7% deviance explained indicates substantial unexplained variation. Whether this gap reflects unmeasured variables, measurement error, or inherent randomness cannot be determined from diagnostics alone.
Methodology
Statistical methodology and diagnostics for GLM Explorer — the right regression family, chosen from your data
Statistical Method
Standard-library analysis: regression that inspects your outcome column and chooses the correct model family instead of assuming one — what it adds over plain linear regression. A yes/no outcome gets logistic regression with odds ratios; a non-negative whole-number count gets Poisson regression with rate ratios (upgraded to quasi-Poisson when an overdispersion test demands it); a continuous outcome gets ordinary least squares with plain coefficients. The family decision and its evidence are reported openly, every effect carries a 95% confidence interval and plain-language significance, and you get the strongest predictor's partial-effect curve plus a predicted-vs-actual fit check (binned calibration for logistic). Works on any dataset: map one outcome and 1-8 predictors.
- One outcome column that is continuous, a count, or two-category; predictors numeric or categorical
- Observations are independent
- Effects are additive on the link scale (linear for gaussian, multiplicative on odds/rates for logit/log links)
- For Poisson results: variance roughly equals the mean (checked via the dispersion statistic; the model upgrades to quasi-Poisson automatically when violated)
- Effects describe association, not causation
- Multi-category outcomes are out of scope (use the classification drivers tool)
- The family is chosen from the outcome's observed values — an integer-valued continuous measure (e.g. whole-dollar revenue) will be read as a count; the decision trail makes this visible
- Counts from unequal exposure windows are not offset-adjusted in this tool
Analysis Code
Complete R source code for this analysis
GLM Explorer — The Right Regression Family, Chosen From Your Data
Models any outcome on the predictor columns the user selects, choosing the correct generalized linear model family from the outcome itself: a two-value outcome gets logistic regression (odds ratios), a non-negative whole-number outcome gets Poisson regression (rate ratios, upgraded to quasi-Poisson when overdispersed), and anything else gets ordinary least squares (plain coefficients). The decision and its evidence are reported, never hidden.
Why This Method?
Plain linear regression quietly assumes a continuous, unbounded outcome. Run it on a yes/no flag or an event count and the coefficients, intervals, and predictions are all wrong in ways that look fine. A GLM keeps the same "outcome ~ drivers" question but swaps in the distribution and link the outcome actually follows — this module inspects the outcome, picks the family, and shows its work.
What This Analysis Covers
- Automatic family selection with an explicit decision trail
- Effect sizes in the family's native language (coefficients, odds
ratios, or rate ratios) with 95% confidence intervals
- Partial effect of the strongest predictor, others held typical
- Predicted-vs-actual fit (binned calibration for logistic)
- Diagnostics: deviance explained, AIC, dispersion, rows used
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {outcome, base_1..base_N}. All narrative is derived from the user's own column names and computed values.
suppressPackageStartupMessages(library(DT))
suppressPackageStartupMessages(library(htmlwidgets))
suppressPackageStartupMessages(library(arrow))
suppressPackageStartupMessages(library(knitr))
suppressPackageStartupMessages(library(rmarkdown))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(tidyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(stringr))
suppressPackageStartupMessages(library(lubridate))
suppressPackageStartupMessages(library(broom))
suppressPackageStartupMessages(library(Matrix))
suppressPackageStartupMessages(library(cluster))
suppressPackageStartupMessages(library(data.table))Step 1: Row accounting + semantic column discovery
initial_rows <- nrow(df)
if (!"outcome" %in% names(df)) {
stop("column_mapping must map an 'outcome' column (the value to explain)")
}
pred_cols <- grep("^base_[0-9]+$", names(df), value = TRUE)
pred_cols <- pred_cols[order(as.integer(sub("^base_", "", pred_cols)))]
if (length(pred_cols) == 0) {
stop("column_mapping must map at least one predictor column(base_1)")
}
outcome_name <- humanize_semantic("outcome", col_map)
predictor_names <- setNames(humanize_semantic(pred_cols, col_map), pred_cols)Step 2: Inspect the outcome and choose the family
The decision trail: (1) exactly two distinct non-blank values -> binomial (logistic); (2) numeric by the 95% rule AND all non-negative whole numbers -> Poisson candidate (the overdispersion check after the fit decides Poisson vs quasi-Poisson); (3) numeric otherwise -> gaussian (ordinary least squares); (4) anything else cannot be modeled and stops with a humanized message.
raw_chr <- trimws(as.character(df$outcome))
nonblank <- !is.na(df$outcome) & raw_chr != "" & tolower(raw_chr) != "na"
n_nonblank <- sum(nonblank)
if (n_nonblank < 30) {
stop(sprintf(
"Only %d rows have a value in the outcome column('%s'). At least 30 are required to fit a regression.",
n_nonblank, outcome_name))
}
vals <- raw_chr[nonblank]
lv_norm <- unique(tolower(vals))
family_key <- NULL
success_display <- NA_character_
vm_ratio <- NA_real_
outcome_evidence <- ""
if (length(lv_norm) == 1) {
stop(sprintf(
"The outcome column('%s') has only one distinct value, so there is nothing to explain.",
outcome_name))
} else if (length(lv_norm) == 2) {Two distinct values -> binomial. Recognized yes-side tokens map to 1; otherwise the alphabetically-second level is modeled as the event.
pos_tokens <- c("1", "yes", "true", "y")
neg_tokens <- c("0", "no", "false", "n")
if (sum(lv_norm %in% pos_tokens) == 1 && sum(lv_norm %in% neg_tokens) == 1) {
success_norm <- lv_norm[lv_norm %in% pos_tokens]
} else {
success_norm <- sort(lv_norm)[2]
}
success_display <- vals[match(success_norm, tolower(vals))]
y <- as.integer(tolower(raw_chr) == success_norm)
y[!nonblank] <- NA_integer_
df$outcome <- y
family_key <- "binomial"
outcome_evidence <- paste0(
outcome_name, " takes exactly 2 distinct values, so it is a yes/no ",
"outcome; the analysis models the probability that ", outcome_name,
" = '", success_display, "'")
} else {
conv <- suppressWarnings(as.numeric(raw_chr))
n_num <- sum(nonblank & !is.na(conv))
if (n_num < 0.95 * n_nonblank) {
stop(sprintf(
paste0("The outcome column('%s') has %d distinct text values. This ",
"analysis needs an outcome that is numeric(continuous or a ",
"count) or has exactly two categories(yes/no). For a ",
"multi-category outcome, use the classification drivers tool ",
"instead."),
outcome_name, length(lv_norm)))
}
conv[!nonblank] <- NA_real_
df$outcome <- conv
y_ok <- conv[!is.na(conv)]
if (isTRUE(stats::var(y_ok) == 0)) {
stop(sprintf(
"The outcome column('%s') is constant after cleaning, so there is nothing to explain.",
outcome_name))
}
is_countlike <- all(y_ok >= 0) && all(abs(y_ok - round(y_ok)) <= 1e-6)
if (is_countlike) {
family_key <- "poisson"
vm_ratio <- stats::var(y_ok) / mean(y_ok)
outcome_evidence <- paste0(
outcome_name, " contains only non-negative whole numbers ",
"(variance/mean ratio = ", round(vm_ratio, 2),
"), so it is treated as an event count")
} else {
family_key <- "gaussian"
outcome_evidence <- paste0(
outcome_name, " is a continuous numeric measure(it has ",
"fractional or negative values), so ordinary least squares ",
"applies directly")
}
}Drop rows with a missing outcome (never impute the outcome).
df <- df[!is.na(df$outcome), , drop = FALSE]
if (nrow(df) < 30) {
stop(sprintf(
"Only %d rows have a usable value in the outcome column('%s') after validation. At least 30 are required.",
nrow(df), outcome_name))
}
if (family_key == "binomial") {
class_tab <- table(df$outcome)
if (length(class_tab) < 2 || min(class_tab) < 5) {
stop(sprintf(
"The outcome column('%s') needs at least 5 rows in each of its two categories to fit a logistic regression; the rarer category has %d.",
outcome_name, if (length(class_tab) < 2) 0L else as.integer(min(class_tab))))
}
}Step 3: Type each predictor — numeric if >=95% of values convert,
else categorical. Impute numeric NA with the median; label blank categories "Missing"; drop identifier-like near-unique text columns; lump categorical levels beyond 10 into "Other".
dropped_predictors <- character(0)
for (dc in pred_cols) {
v <- df[[dc]]
if (!is.numeric(v)) {
conv_d <- suppressWarnings(as.numeric(as.character(v)))
n_orig <- sum(!is.na(v) & trimws(as.character(v)) != "")
if (n_orig > 0 && sum(!is.na(conv_d)) >= 0.95 * n_orig) {
df[[dc]] <- conv_d
}
}
v <- df[[dc]]
if (is.numeric(v)) {
med <- median(v, na.rm = TRUE)
if (is.na(med)) { dropped_predictors <- c(dropped_predictors, dc); next }
v[is.na(v)] <- med
df[[dc]] <- v
} else {
v <- as.character(v)
v[is.na(v) | trimws(v) == ""] <- "Missing"
if (length(unique(v)) > nrow(df) / 2) {Near-unique text column (an ID or free text, not a predictor) — exclude BEFORE lumping, or the lump step disguises identifiers as 10 categories.
dropped_predictors <- c(dropped_predictors, dc)
next
}
tab <- sort(table(v), decreasing = TRUE)
if (length(tab) > 10) {
keep <- names(tab)[1:10]
v[!(v %in% keep)] <- "Other"
}
df[[dc]] <- factor(v)
}
}Step 4: Drop zero-variance predictors
for (dc in setdiff(pred_cols, dropped_predictors)) {
v <- df[[dc]]
zero_var <- if (is.numeric(v)) {
isTRUE(stats::var(v, na.rm = TRUE) == 0) || is.na(stats::var(v, na.rm = TRUE))
} else {
length(unique(v)) <= 1
}
if (zero_var) dropped_predictors <- c(dropped_predictors, dc)
}
model_predictors <- setdiff(pred_cols, dropped_predictors)
if (length(model_predictors) == 0) {
stop("No usable predictor columns remained after cleaning(all were constant, empty, or identifier-like).")
}
df_clean <- df[, c(model_predictors, "outcome"), drop = FALSE]
final_rows <- nrow(df_clean)
rows_removed <- initial_rows - final_rowsStep 5: Guard — need clearly more rows than model terms
n_terms_est <- sum(sapply(model_predictors, function(dc) {
if (is.factor(df_clean[[dc]])) nlevels(df_clean[[dc]]) - 1 else 1
}))
while (n_terms_est >= final_rows - 5 && length(model_predictors) > 1) {
drop_dc <- model_predictors[length(model_predictors)]
dropped_predictors <- c(dropped_predictors, drop_dc)
model_predictors <- model_predictors[-length(model_predictors)]
df_clean <- df_clean[, c(model_predictors, "outcome"), drop = FALSE]
n_terms_est <- sum(sapply(model_predictors, function(dc) {
if (is.factor(df_clean[[dc]])) nlevels(df_clean[[dc]]) - 1 else 1
}))
}Step 6: Fit the chosen family; on the Poisson path, test
overdispersion (Pearson chi-squared / residual df, with its chi-squared p-value) and upgrade to quasi-Poisson when the counts vary more than Poisson allows (dispersion > 1.5 AND p < 0.05).
dispersion <- NA_real_
disp_p <- NA_real_
overdispersed <- FALSE
if (family_key == "binomial") {
model <- glm(outcome ~ ., family = binomial(), data = df_clean)
family_label <- "Binomial(logistic)"
effect_label <- "odds ratio"
family_reason <- paste0(
"the outcome has exactly two values, and a straight-line model on a ",
"yes/no outcome predicts impossible probabilities; logistic ",
"regression models the odds instead")
} else if (family_key == "poisson") {
fit_pois <- glm(outcome ~ ., family = poisson(), data = df_clean)
df_res <- df.residual(fit_pois)
pearson_stat <- sum(residuals(fit_pois, type = "pearson")^2)
dispersion <- if (df_res > 0) pearson_stat / df_res else NA_real_
disp_p <- if (df_res > 0) {
stats::pchisq(pearson_stat, df = df_res, lower.tail = FALSE)
} else NA_real_
overdispersed <- is.finite(dispersion) && dispersion > 1.5 &&
is.finite(disp_p) && disp_p < 0.05
if (overdispersed) {
model <- glm(outcome ~ ., family = quasipoisson(), data = df_clean)
family_key <- "quasipoisson"
family_label <- "Quasi-Poisson"
effect_label <- "rate ratio"
family_reason <- paste0(
"the outcome is a count, but its Pearson dispersion is ",
round(dispersion, 2), " (chi-squared p ",
format_p(disp_p), ") — well above the 1.0 plain Poisson assumes — ",
"so quasi-Poisson widens the standard errors to stay honest")
} else {
model <- fit_pois
family_label <- "Poisson"
effect_label <- "rate ratio"
family_reason <- paste0(
"the outcome is a non-negative whole-number count and its Pearson ",
"dispersion is ", round(dispersion, 2),
", close to the 1.0 a Poisson model assumes")
}
} else {
model <- glm(outcome ~ ., family = gaussian(), data = df_clean)
family_label <- "Gaussian(linear)"
effect_label <- "coefficient"
family_reason <- paste0(
"the outcome is a continuous numeric measure, so ordinary least ",
"squares — the gaussian family — is the right fit")
}
exp_scale <- family_key %in% c("binomial", "poisson", "quasipoisson")
dev_explained <- 1 - model$deviance / model$null.deviance
if (!is.finite(dev_explained)) dev_explained <- NA_real_
aic <- tryCatch(as.numeric(stats::AIC(model)), error = function(e) NA_real_)
if (family_key == "quasipoisson") aic <- NA_real_Step 7: Effects table — 95% CIs (Wald, tryCatch-guarded);
exponentiated to odds/rate ratios for the log/logit families.
tidy_df <- broom::tidy(model)
ci <- tryCatch(suppressMessages(stats::confint.default(model)),
error = function(e) NULL)
if (!is.null(ci) && all(tidy_df$term %in% rownames(ci))) {
ci_lo_raw <- ci[tidy_df$term, 1]
ci_hi_raw <- ci[tidy_df$term, 2]
} else {
ci_lo_raw <- tidy_df$estimate - 1.96 * tidy_df$std.error
ci_hi_raw <- tidy_df$estimate + 1.96 * tidy_df$std.error
}
scale_est <- function(x) {
out <- if (exp_scale) exp(x) else x
out[!is.finite(out)] <- NA_real_
round(out, 3)
}
effects_all <- data.frame(
term_raw = tidy_df$term,
term = humanize_term(tidy_df$term, model_predictors, col_map),
estimate = scale_est(tidy_df$estimate),
ci_low = scale_est(ci_lo_raw),
ci_high = scale_est(ci_hi_raw),
p_value = format_p(tidy_df$p.value),
significance = sig_word(tidy_df$p.value),
stringsAsFactors = FALSE
)
rownames(effects_all) <- NULLIntercept: reported on the response scale in the diagnostics table and in prose; the chart excludes it so effect bars share one scale.
int_idx <- which(tidy_df$term == "(Intercept)")
intercept_est <- if (length(int_idx) == 1) tidy_df$estimate[int_idx] else NA_real_
baseline_response <- if (!is.finite(intercept_est)) NA_real_ else {
switch(family_key,
binomial = stats::plogis(intercept_est),
poisson = exp(intercept_est),
quasipoisson = exp(intercept_est),
intercept_est)
}
coefficients_df <- effects_all[effects_all$term_raw != "(Intercept)",
c("term", "estimate", "ci_low", "ci_high",
"p_value", "significance"), drop = FALSE]
rownames(coefficients_df) <- NULLStep 8: Predictor importance — max |z| per predictor, NA-filtered
term_raw <- tidy_df$term[tidy_df$term != "(Intercept)"]
term_z <- tidy_df$statistic[tidy_df$term != "(Intercept)"]
term_est <- tidy_df$estimate[tidy_df$term != "(Intercept)"]
term_p <- tidy_df$p.value[tidy_df$term != "(Intercept)"]
imp_rows <- lapply(model_predictors, function(dc) {
idx <- which(startsWith(term_raw, dc))Aliased (perfectly collinear) terms carry NA statistics — filter NA BEFORE which.max so an all-NA predictor is excluded instead of crashing (LAT-1445 class).
idx <- idx[!is.na(term_z[idx])]
if (length(idx) == 0) return(NULL)
best <- idx[which.max(abs(term_z[idx]))]
data.frame(
semantic = dc,
driver = predictor_names[[dc]],
abs_z = abs(term_z[best]),
direction = if (is.numeric(df_clean[[dc]])) {
if (term_est[best] > 0) "positive" else "negative"
} else "categorical",
p_raw = term_p[best],
best_term = term_raw[best],
best_est = term_est[best],
stringsAsFactors = FALSE
)
})
importance_df <- do.call(rbind, Filter(Negate(is.null), imp_rows))
if (!is.null(importance_df) && nrow(importance_df) > 0) {
importance_df <- importance_df[order(-importance_df$abs_z), , drop = FALSE]
max_z <- max(importance_df$abs_z, na.rm = TRUE)
importance_df$importance_score <- if (is.finite(max_z) && max_z > 0) {
round(100 * importance_df$abs_z / max_z, 1)
} else 0
importance_df$significance <- sig_word(importance_df$p_raw)
rownames(importance_df) <- NULL
} else {
importance_df <- data.frame(
semantic = character(0), driver = character(0), abs_z = numeric(0),
direction = character(0), p_raw = numeric(0), best_term = character(0),
best_est = numeric(0), importance_score = numeric(0),
significance = character(0), stringsAsFactors = FALSE)
}
top_driver_name <- if (nrow(importance_df) > 0) importance_df$driver[1] else "Unknown"
top_term_effect <- if (nrow(importance_df) > 0) {
round(if (exp_scale) exp(importance_df$best_est[1]) else importance_df$best_est[1], 3)
} else NA_real_
top_term_p <- if (nrow(importance_df) > 0) importance_df$p_raw[1] else NA_real_
top_is_numeric <- if (nrow(importance_df) > 0) importance_df$direction[1] != "categorical" else FALSE
top_term_label <- if (nrow(importance_df) > 0) {
humanize_term(importance_df$best_term[1], model_predictors, col_map)
} else "Unknown"One computed clause describing the top effect in the family's language.
top_effect_phrase <- if (!is.finite(top_term_effect)) {
"no predictor effect was estimable"
} else if (family_key == "binomial") {
if (top_is_numeric) {
paste0("each additional unit of ", top_driver_name,
" multiplies the odds of ", outcome_name, " = '",
success_display, "' by ", top_term_effect)
} else {
paste0(top_term_label, " multiplies the odds of ", outcome_name,
" = '", success_display, "' by ", top_term_effect,
" versus the baseline category")
}
} else if (exp_scale) {
if (top_is_numeric) {
paste0("each additional unit of ", top_driver_name,
" multiplies the expected ", outcome_name, " by ", top_term_effect)
} else {
paste0(top_term_label, " multiplies the expected ", outcome_name,
" by ", top_term_effect, " versus the baseline category")
}
} else {
if (top_is_numeric) {
paste0("each additional unit of ", top_driver_name,
if (top_term_effect >= 0) " adds " else " removes ",
abs(top_term_effect),
if (top_term_effect >= 0) " to " else " from ",
"the expected ", outcome_name)
} else {
paste0(top_term_label, " shifts the expected ", outcome_name, " by ",
top_term_effect, " versus the baseline category")
}
}Step 9: Partial effect of the strongest NUMERIC predictor —
predictions across its observed range with every other predictor held typical (numeric at median, categorical at its modal level). Computed from the fitted model, never canned.
num_rank <- importance_df$semantic[
sapply(importance_df$semantic, function(s) is.numeric(df_clean[[s]]))]
partial_sem <- if (length(num_rank) > 0) num_rank[1] else NA_character_
if (!is.na(partial_sem)) {
v_top <- df_clean[[partial_sem]]
xs <- seq(min(v_top), max(v_top), length.out = 60)
nd <- data.frame(row.names = seq_len(60))
for (dc in model_predictors) {
col <- df_clean[[dc]]
if (is.numeric(col)) {
nd[[dc]] <- rep(median(col), 60)
} else {
modal <- names(sort(table(col), decreasing = TRUE))[1]
nd[[dc]] <- factor(rep(modal, 60), levels = levels(col))
}
}
nd[[partial_sem]] <- xs
preds <- tryCatch(
as.numeric(predict(model, newdata = nd, type = "response")),
error = function(e) rep(NA_real_, 60))
partial_effect_df <- data.frame(
driver_value = round(xs, 4),
predicted_outcome = round(preds, 4),
stringsAsFactors = FALSE
)
partial_effect_df <- partial_effect_df[is.finite(partial_effect_df$predicted_outcome), ,
drop = FALSE]
rownames(partial_effect_df) <- NULL
partial_driver_name <- predictor_names[[partial_sem]]
} else {
partial_effect_df <- data.frame(driver_value = numeric(0),
predicted_outcome = numeric(0),
stringsAsFactors = FALSE)
partial_driver_name <- NA_character_
}Step 10: Predicted vs actual — response-scale fit check.
For binomial, raw 0/1 points are unreadable, so the standard binned calibration is computed instead: rows are grouped into up to 10 predicted-probability bins; each point is (mean predicted, observed share). The diagonal is perfect calibration either way.
fitted_vals <- as.numeric(fitted(model))
pred_actual_cor <- suppressWarnings(
stats::cor(fitted_vals, df_clean$outcome, use = "complete.obs"))
if (family_key == "binomial") {
br <- unique(stats::quantile(fitted_vals, probs = seq(0, 1, length.out = 11),
na.rm = TRUE))
if (length(br) < 3) {
br <- unique(c(min(fitted_vals) - 1e-9, stats::median(fitted_vals),
max(fitted_vals) + 1e-9))
}
bins <- cut(fitted_vals, breaks = br, include.lowest = TRUE)
pred_actual_df <- do.call(rbind, lapply(levels(bins), function(b) {
sel <- bins == b
if (sum(sel, na.rm = TRUE) == 0) return(NULL)
data.frame(predicted = round(mean(fitted_vals[sel], na.rm = TRUE), 4),
actual = round(mean(df_clean$outcome[sel], na.rm = TRUE), 4),
stringsAsFactors = FALSE)
}))
rownames(pred_actual_df) <- NULL
pred_actual_kind <- "calibration"
} else {
set.seed(42)
sidx <- if (final_rows > 1000) sample(final_rows, 1000) else seq_len(final_rows)
pred_actual_df <- data.frame(
predicted = round(fitted_vals[sidx], 4),
actual = round(as.numeric(df_clean$outcome[sidx]), 4),
stringsAsFactors = FALSE
)
pred_actual_df <- pred_actual_df[order(pred_actual_df$predicted), , drop = FALSE]
rownames(pred_actual_df) <- NULL
pred_actual_kind <- "rows"
}Step 11: Significant predictors + KPI metrics
n_sig <- sum(importance_df$p_raw < 0.05, na.rm = TRUE)
metrics <- list(
`Observations` = final_rows,
`Model Family` = family_label,
`Deviance Explained` = round(dev_explained, 3),
`Significant Predictors` = as.integer(n_sig),
`Top Predictor` = top_driver_name
)
if (is.finite(aic)) metrics$AIC <- round(aic, 1)Step 12: Diagnostics table — the family decision trail plus fit
quality, all values as strings (no e-notation).
baseline_phrase <- if (!is.finite(baseline_response)) {
"Not estimable."
} else if (family_key == "binomial") {
paste0("With every numeric predictor at zero and categories at their ",
"reference level, the predicted probability of ", outcome_name,
" = '", success_display, "' is ",
round(100 * baseline_response, 1), "%.")
} else if (exp_scale) {
paste0("With every numeric predictor at zero and categories at their ",
"reference level, the expected ", outcome_name, " is ",
round(baseline_response, 2), ".")
} else {
paste0("The expected ", outcome_name, " when every numeric predictor ",
"is zero and categories are at their reference level.")
}
diag_metric <- c("Outcome type detected", "Family chosen")
diag_value <- c(outcome_evidence, family_label)
diag_interp <- c(
"What the outcome column's own values say about which model family applies.",
paste0("Chosen because ", family_reason, "."))
if (family_key %in% c("poisson", "quasipoisson")) {
diag_metric <- c(diag_metric, "Overdispersion(Pearson chi-squared / df)")
diag_value <- c(diag_value, paste0(
formatC(dispersion, digits = 2, format = "f"),
" (chi-squared p ", format_p(disp_p), ")"))
diag_interp <- c(diag_interp, if (overdispersed) {
"Above 1.5 with a significant chi-squared test: the counts vary more than plain Poisson allows, so Poisson p-values would be overconfident."
} else {
"Near 1: the variance tracks the mean, so the plain Poisson model is adequate."
})
}
diag_metric <- c(diag_metric, "Deviance explained")
diag_value <- c(diag_value, formatC(dev_explained, digits = 3, format = "f"))
diag_interp <- c(diag_interp, paste0(
"The predictors account for ", round(100 * dev_explained, 1),
"% of the deviance in ", outcome_name,
if (family_key == "gaussian") " (identical to R-squared here)." else "."))
diag_metric <- c(diag_metric, "AIC")
diag_value <- c(diag_value, if (is.finite(aic)) {
formatC(aic, digits = 1, format = "f")
} else {
"not defined"
})
diag_interp <- c(diag_interp, if (is.finite(aic)) {
"Model comparison score(lower is better); only comparable between models fit to this same data."
} else {
"AIC is not defined for quasi-likelihood models — quasi-Poisson has no full likelihood."
})
diag_metric <- c(diag_metric, "Baseline(intercept)")
diag_value <- c(diag_value, if (is.finite(baseline_response)) {
formatC(baseline_response, digits = 3, format = "f")
} else "not estimable")
diag_interp <- c(diag_interp, baseline_phrase)
diag_metric <- c(diag_metric, "Rows used / dropped")
diag_value <- c(diag_value, paste0(
format(final_rows, big.mark = ","), " / ",
format(rows_removed, big.mark = ",")))
diag_interp <- c(diag_interp, paste0(
"Rows with a valid ", outcome_name, " value were modeled; rows with a ",
"blank or unusable outcome were dropped, never imputed."))
diagnostics_df <- data.frame(metric = diag_metric, value = diag_value,
interpretation = diag_interp,
stringsAsFactors = FALSE)Step 13: json_output machine channel
json_output <- list(
answer = paste0(
family_label, " regression of ", outcome_name, " on ",
length(model_predictors),
if (length(model_predictors) == 1) " predictor" else " predictors",
" across ", format(final_rows, big.mark = ","), " rows. ",
"Family chosen because ", family_reason, ". ",
top_driver_name, " is the strongest predictor: ", top_effect_phrase,
" (", sig_word(top_term_p), "). ",
n_sig, " of ", nrow(importance_df),
if (nrow(importance_df) == 1) " predictor is" else " predictors are",
" significant at p < 0.05; the model explains ",
round(100 * dev_explained, 1), "% of the deviance in ",
outcome_name, "."
),
cards = lapply(
c("tldr", "overview", "preprocessing", "coefficients",
"effect_of_top_driver", "predicted_vs_actual", "diagnostics"),
function(cid) list(id = cid, metrics = metrics)
)
)Machine-readable verdict for the overdispersion diagnostic (LAT-1783) — only the Poisson path actually COMPUTES a diagnostic; gaussian and binomial fits have no genuine assumption test here, so they emit nothing rather than inventing a check. As in standard_count_regression, overdispersion is "warn" not "fail": the module SELF-CORRECTS by switching to quasi-Poisson, so downstream should surface the model change, not cap claim strength.
assumption_checks <- if (family_key %in% c("poisson", "quasipoisson")) {
list(list(
name = "overdispersion",
verdict = if (!is.finite(dispersion)) "warn"
else if (overdispersed) "warn" else "pass",
statistic = if (!is.finite(dispersion)) "dispersion not estimable"
else sprintf("Pearson dispersion = %s, chi-squared p %s(threshold 1.5)",
round(dispersion, 2), format_p(disp_p))
))
} else {
list()
}
list(
initial_rows = initial_rows,
final_rows = final_rows,
rows_removed = rows_removed,
outcome_name = outcome_name,
predictor_names = predictor_names,
model_predictors = model_predictors,
dropped_predictors = dropped_predictors,
family_key = family_key,
family_label = family_label,
family_reason = family_reason,
outcome_evidence = outcome_evidence,
effect_label = effect_label,
exp_scale = exp_scale,
success_display = success_display,
vm_ratio = vm_ratio,
dispersion = dispersion,
disp_p = disp_p,
overdispersed = overdispersed,
dev_explained = dev_explained,
aic = aic,
model = model,
df_clean = df_clean,
coefficients_df = coefficients_df,
effects_all = effects_all,
intercept_est = intercept_est,
baseline_response = baseline_response,
importance_df = importance_df,
top_driver_name = top_driver_name,
top_term_effect = top_term_effect,
top_term_p = top_term_p,
top_is_numeric = top_is_numeric,
top_term_label = top_term_label,
top_effect_phrase = top_effect_phrase,
partial_effect_df = partial_effect_df,
partial_driver_name = partial_driver_name,
pred_actual_df = pred_actual_df,
pred_actual_kind = pred_actual_kind,
pred_actual_cor = pred_actual_cor,
diagnostics_df = diagnostics_df,
n_sig = n_sig,
metrics = metrics,
json_output = json_output,
assumption_checks = assumption_checks
)
}Compute shared resources
shared <- compute_shared(df, params, col_map)