Linear Regression
Shows how much a set of factors explains an outcome, which factors matter most and in which direction, and how far the results can be trusted.
RUN DATE · 14 September 2026
DATA · 240 rows
Which drivers explain weekly sales, how strongly, and how well does the model fit?
- Fit summaryHow much of the outcome the factors explain together.
- Where the variation comes fromHow much each factor adds to what the model explains.
- Predicted against actualHow closely the predictions match the measured values.
- Which factors matter mostEvery factor compared on the same scale, with its direction.
- Effect of each factorEvery factor's effect on one common scale, with its likely range.
- Full resultsEvery estimate and its uncertainty, to check the figures line by line.
- Errors across the rangeWhether the prediction errors stay even from low values to high.
- Spread of the errorsWhether the errors grow or shrink as the predictions rise.
- Shape of the errorsWhether the errors are balanced around zero.
- Normality checkWhether the errors follow the expected bell shape.
- What the results rely onEach condition the analysis depends on, and whether it holds.
- Overlap between factorsWhether two factors carry the same information.
- Influential rowsWhether a handful of rows is steering the result.
- How it was doneThe method, the data used, and what to keep in mind.
Ad spend drives weekly sales; price pulls them down
Ad spend, unit price and region together explain almost all of the week-to-week variation in sales (R² 0.996). Ad spend is the dominant driver: each extra 1k of ad spend goes with about 6.6k more in weekly sales. A higher unit price pulls sales down, by about 9.3k per unit of price. Region adds a smaller lift, largest in the South (about 20k over East). One check is violated: the relationship bends slightly away from a straight line, so read these effects as averages across the range.
How well it fits
Ad spend explains most of the variation
Ad spend explains far more variation than price or region, and the residual left over is small.
Region's contribution, though statistically significant, is much smaller than either price or ad spend.
Ad spend explains most of the variation
Ad spend carries most of the explained variation, unit price is a clear second and region a small but real third. The residual row is small beside the drivers, which is why the fit is so tight. The linearity check is violated, so read each share as an average across the range.
Region's contribution, though statistically significant, is much smaller than either price or ad spend.
What drives it
Ad spend leads, unit price pulls sales down
Ad spend moves sales most strongly upward; unit price moves sales downward; region's effect is weak.
Ad spend bar is tallest and positive; unit price bar is negative; region bar is smallest.
Ad spend leads, unit price pulls sales down
Ad spend dominates the standardized scale, moving sales upward clearly. Unit price moves sales downward, but far less strongly than ad spend moves it upward. Region's effect is weak compared to both. The linear relationship assumption is violated and residuals show strain, which limits confidence in the precise magnitudes, but the ranking and directions are stable across the data.
Ad spend bar is tallest and positive; unit price bar is negative; region bar is smallest.
Ad spend leads, price pulls sales down
Ad spend is the strongest driver; unit price pulls sales down; region effects are weak and far behind.
Ad spend sits far right with a tight interval; unit price sits left of zero; every region level sits just right of zero.
Ad spend leads, price pulls sales down
On a common scale ad spend clearly dominates, with unit price a distant second pulling sales down. Every region level sits just above zero: small, positive shifts from the East reference. All intervals are tight and clear of zero, but the linearity check is violated, so read the effects as averages.
Ad spend sits far right with a tight interval; unit price sits left of zero; every region level sits just right of zero.
The coefficients
Ad spend leads, price pulls sales down
Ad spend rises with sales far ahead; price falls with sales; region effects are weak.
South lifts sales the most of the regions, well ahead of West and North against the East reference.
Ad spend leads, price pulls sales down
Ad spend shows the strongest standardized effect, clearly dominant across all drivers. Unit price moves in the opposite direction with a much weaker standardized effect. Region effects are far behind both continuous drivers, with South ahead of West and North. The linear relationship assumption is violated and residuals show strain, which limits confidence in the intervals and significance tests, though the main directions remain clear.
South lifts sales the most of the regions, well ahead of West and North against the East reference.
Does the model hold
Errors stay close to zero, with one large miss
Errors stay close to zero across the range, with one large miss; the linearity check still finds a slight curve.
Look for the single point far below zero near the middle of the range; the rest form an even band.
Errors stay close to zero, with one large miss
Most errors sit within a narrow band around zero from low to high predictions, and the band keeps its width, so variance is steady. One week near the middle was over-predicted by a wide margin. The RESET check finds a slight curve the straight line misses, too gentle to see here, which is why the effects read as averages.
Look for the single point far below zero near the middle of the range; the rest form an even band.
Error spread stays level across predictions
Error spread stays roughly level as predictions rise, so uneven variance is not inflating the standard errors.
Scan left to right: the band of points stays about the same height across the range.
Error spread stays level across predictions
The spread of the scaled errors stays roughly level from low to high predictions, with no funnel, and the constant variance check holds. Strained normality still limits how exact the intervals are, but uneven spread is not the problem here.
Scan left to right: the band of points stays about the same height across the range.
Are the residuals normal
Errors cluster near zero with long lower tail
Residuals center near zero but extend lower, limiting confidence in intervals and p-values.
The histogram or density plot center shows clustering near zero; the left tail extends further than the right.
Errors cluster near zero with long lower tail
Most errors cluster tightly around zero, but the lower tail runs further than the upper one: in a few weeks the model predicted more sales than happened. That strains the normality check, so the intervals and p-values are close rather than exact. Check whether those weeks share a region or an unusual price.
The histogram or density plot center shows clustering near zero; the left tail extends further than the right.
Residuals show lower tail departure from normal
Lower tail stretches beyond normal expectation, indicating model occasionally over-predicts sales badly.
Left side of the plot where sample points drop well below the diagonal line.
Residuals show lower tail departure from normal
The middle of the residuals follows the normal line closely, but the lower end drops well below it: a few weeks were over-predicted by more than normal errors would allow. The normality check is strained rather than violated, so the intervals are close rather than exact.
Left side of the plot where sample points drop well below the diagonal line.
Assumptions and method
Checks: one violated, two strained, four hold
Violated: linear relationship; strained: residuals are normal, no dominant rows.
Holding: constant variance, independent residuals, no strong collinearity, enough rows per term.
Checks: one violated, two strained, four hold
Residuals are normal is strained: skewness -0.76; with many rows a small departure is significant but harmless. Linear relationship is violated: a curve or threshold the straight line misses would show here. No dominant rows is strained: a few rows steering the fit would show as large Cook's distances. The other four hold.
Holding: constant variance, independent residuals, no strong collinearity, enough rows per term.
Ordinary least squares regression of sales_k on ad_spend_k, unit_price, region over 240 rows (0 dropped for a missing outcome); 95% confidence intervals on the coefficients; standardized effects = coefficient x sd(driver) / sd(outcome); assumption checks: Shapiro-Wilk, Breusch-Pagan, Durbin-Watson, RESET, VIF, Cook's distance, all base R.
240 of 240 rows · ad_spend_k, unit_price, region → sales_k
caveatLinear relationship assumption violated; residuals show strain in normality and outlier influence, limiting inference precision.
Ordinary least squares fitted the cleaned data without dropping rows, treating ad spend k and unit price as continuous and region as categorical. The method assumes linear relationships, independent homoscedastic normal residuals, and no strong collinearity. The run's checks flag a violated linear relationship and strained normality and outlier influence, which could distort confidence intervals and tests on coefficients. Constant variance, independence, and collinearity held. These violations suggest the model's fitted values and predictions merit skepticism, especially at extreme sales levels.
Overlap and influence
All drivers show low overlap, coefficients readable
No driver overlaps significantly with others, so each coefficient can be read independently without inflation.
All drivers sit well below the threshold for inflated standard errors, with no driver standing apart from the others.
All drivers show low overlap, coefficients readable
On this card's data, every VIF is low: no driver overlaps much with the others, and none stands apart.
All drivers sit well below the threshold for inflated standard errors, with no driver standing apart from the others.
Most influential row has low leverage
A few rows steer the fit, but the most influential one sits in the low leverage range, limiting stability.
The most extreme point at the far left shows the largest Cook's distance; it has low leverage but a large residual.
Most influential row has low leverage
The most influential row sits in the low part of the leverage range with a large negative residual, creating high Cook's distance. The highest-leverage rows are not the most influential ones, which is a mixed signal: influence is not spread evenly across the dataset, but the dominant row's low leverage makes it a strained assumption of no dominant rows. This means the model's stability is limited when a row with unusual driver values could have stronger influence.
The most extreme point at the far left shows the largest Cook's distance; it has low leverage but a large residual.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint dd0e9572556948bc. The same code on the same data gives the same report.
`standard_linear_regression_v2` <- function(pf) {
`%||%` <- function(a, b) if (!is.null(a)) a else b
#' Readable figures (LAT-3180): whole numbers from a thousand up, one decimal from a hundred, two from one, three
#' significant figures below one. A cell carries what the value needs, not what R prints.
tidy <- function(x) {
x <- as.numeric(x)
ifelse(is.na(x), NA_real_,
ifelse(abs(x) >= 1000, round(x, 0),
ifelse(abs(x) >= 100, round(x, 1),
ifelse(abs(x) >= 1, round(x, 2), signif(x, 3)))))
}
inputs <- pf$taskList$inputs
params <- inputs$module_parameters %||% list()
# THE QUESTION this tool answers: the customer's objective, verbatim, when given.
question <- (inputs$userContext %||% list())$objective %||%
"Which drivers explain the outcome, how strongly, and how well does the model fit?"
#' ## Column mapping
#' The customer maps one numeric `outcome` and one to five `driver_N` columns.
#' Semantic names are used inside; the customer's own headers are carried in
#' `col_map` so every table names the columns the reader knows.
col_map <- inputs$column_mapping %||% list()
df <- renderObject.taskFunction.init(inputs, col_map) # df has SEMANTIC names
human <- function(sem) {
v <- col_map[[sem]]
if (is.null(v) || !nzchar(as.character(v))) sem else as.character(v)
}
#' ## Data preparation
#' Rows without a numeric outcome are dropped. Numeric drivers are median-
#' imputed; text drivers become factors with blanks as "Missing" and levels
#' beyond twelve lumped into "Other"; identifier-like and constant drivers
#' are excluded. The model must have clearly more rows than terms.
n_in <- nrow(df)
if (!"outcome" %in% names(df)) stop("column_mapping must map an 'outcome' column (the numeric value to explain)")
driver_cols <- grep("^driver_[0-9]+$", names(df), value = TRUE)
driver_cols <- driver_cols[order(as.integer(sub("^driver_", "", driver_cols)))]
if (length(driver_cols) == 0) stop("column_mapping must map at least one driver column (driver_1)")
df$outcome <- suppressWarnings(as.numeric(df$outcome))
df <- df[!is.na(df$outcome), , drop = FALSE]
if (nrow(df) < 10) stop(sprintf("Only %d rows have a usable numeric outcome ('%s'); at least 10 are required.", nrow(df), human("outcome")))
dropped <- character(0)
for (dc in driver_cols) {
v <- df[[dc]]
if (!is.numeric(v)) {
conv <- suppressWarnings(as.numeric(as.character(v)))
n_orig <- sum(!is.na(v) & as.character(v) != "")
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) df[[dc]] <- conv
}
v <- df[[dc]]
if (is.numeric(v)) {
med <- median(v, na.rm = TRUE)
if (is.na(med)) { dropped <- c(dropped, dc); next }
v[is.na(v)] <- med; df[[dc]] <- v
} else {
v <- as.character(v); v[is.na(v) | trimws(v) == ""] <- "Missing"
tab <- sort(table(v), decreasing = TRUE)
if (length(tab) > 12) v[!(v %in% names(tab)[1:12])] <- "Other"
if (length(unique(v)) > nrow(df) / 2) { dropped <- c(dropped, dc); next }
df[[dc]] <- factor(v)
}
}
for (dc in setdiff(driver_cols, dropped)) {
v <- df[[dc]]
zero_var <- if (is.numeric(v)) isTRUE(var(v) == 0) || is.na(var(v)) else length(unique(v)) <= 1
if (zero_var) dropped <- c(dropped, dc)
}
model_drivers <- setdiff(driver_cols, dropped)
if (length(model_drivers) == 0) stop("No usable driver columns remained after cleaning (all constant, empty, or identifier-like).")
n_terms <- function(dcs) sum(sapply(dcs, function(dc) if (is.factor(df[[dc]])) nlevels(df[[dc]]) - 1 else 1))
while (n_terms(model_drivers) >= nrow(df) - 5 && length(model_drivers) > 1) {
dropped <- c(dropped, model_drivers[length(model_drivers)])
model_drivers <- model_drivers[-length(model_drivers)]
}
df_clean <- df[, c(model_drivers, "outcome"), drop = FALSE]
n_used <- nrow(df_clean)
#' ## Ordinary least squares
#' `lm(outcome ~ .)` on the cleaned frame. Coefficients carry 95% confidence
#' intervals; a driver's importance is the largest |t| across its terms,
#' scaled so the strongest driver reads 100.
model <- lm(outcome ~ ., data = df_clean)
sm <- summary(model)
r2 <- unname(sm$r.squared); adj_r2 <- unname(sm$adj.r.squared); sigma <- unname(sm$sigma)
fstat <- sm$fstatistic
model_p <- if (is.null(fstat)) NA_real_ else unname(pf(fstat[1], fstat[2], fstat[3], lower.tail = FALSE))
ci <- suppressMessages(confint(model, level = 0.95))
co <- sm$coefficients
#' Standardized scale (LAT-3134, per term since LAT-3180): beta = b * sd(model-matrix column) / sd(outcome).
X <- model.matrix(model)
sd_y <- sd(df_clean$outcome)
col_sd <- apply(X[, -1, drop = FALSE], 2, sd)
betas <- unname(coef(model)[-1]) * col_sd / sd_y
names(betas) <- colnames(X)[-1]
terms_raw <- rownames(co)
human_term <- function(t) {
if (t == "(Intercept)") return("(Intercept)")
for (dc in model_drivers) if (startsWith(t, dc)) {
lvl <- substring(t, nchar(dc) + 1)
return(if (nzchar(lvl)) paste0(human(dc), " = ", lvl) else human(dc))
}
t
}
# LAT-3180: every term's standardized effect beside its per-unit estimate; the intercept has none
term_scale <- vapply(terms_raw, function(t) if (t %in% names(col_sd)) unname(col_sd[t]) / sd_y else NA_real_, numeric(1))
coef_df <- data.frame(
term = vapply(terms_raw, human_term, character(1), USE.NAMES = FALSE),
estimate = tidy(unname(co[, "Estimate"])),
beta = round(unname(co[, "Estimate"]) * unname(term_scale), 3),
std_error = tidy(unname(co[, "Std. Error"])),
t_value = round(unname(co[, "t value"]), 2),
p_value = signif(unname(co[, "Pr(>|t|)"]), 3),
low = tidy(unname(ci[terms_raw, 1])),
high = tidy(unname(ci[terms_raw, 2])),
stringsAsFactors = FALSE
)
rownames(coef_df) <- NULL
# LAT-3180: the interval chart on the standardized scale, so factors in different units compare on one axis
interval_df <- data.frame(
term = coef_df$term, beta = coef_df$beta,
low = round(unname(ci[terms_raw, 1]) * unname(term_scale), 3),
high = round(unname(ci[terms_raw, 2]) * unname(term_scale), 3), stringsAsFactors = FALSE)
interval_df <- interval_df[terms_raw != "(Intercept)" & !is.na(interval_df$beta), , drop = FALSE]
rownames(interval_df) <- NULL
#' ## Standardized effects (LAT-3134)
#' The textbook quantity: beta = b * sd(x) / sd(y), the change in the outcome in
#' standard deviations per standard deviation of the driver. A categorical
#' driver's beta is that of its largest-|beta| level (dummy columns of the model
#' matrix). This replaces the earlier max-|t|-scaled-to-100 "importance", which
#' measured how clearly a driver was distinguishable from zero, not how much it
#' moved the outcome, and had to be explained away in every brief.
std_rows <- lapply(model_drivers, function(dc) {
idx <- which(startsWith(names(betas), dc))
idx <- idx[!is.na(betas[idx])]
if (length(idx) == 0) return(NULL)
best <- idx[which.max(abs(betas[idx]))]
data.frame(driver = human(dc), beta = round(unname(betas[best]), 3),
direction = if (is.numeric(df_clean[[dc]])) { if (betas[best] > 0) "positive" else "negative" } else "categorical",
stringsAsFactors = FALSE)
})
std_df <- do.call(rbind, std_rows)
std_df <- std_df[order(-abs(std_df$beta)), , drop = FALSE]
rownames(std_df) <- NULL
top_driver <- std_df$driver[1]
top_dir <- std_df$direction[1]
#' ## ANOVA table (LAT-3134)
an <- anova(model)
anova_df <- data.frame(
source = vapply(rownames(an), function(r) if (r == "Residuals") "Residuals" else human(r), character(1), USE.NAMES = FALSE),
df = an$Df,
sum_sq = tidy(an[["Sum Sq"]]),
mean_sq = tidy(an[["Mean Sq"]]),
f_value = tidy(an[["F value"]]),
p_value = signif(an[["Pr(>F)"]], 3),
stringsAsFactors = FALSE)
anova_df$f_value[is.na(anova_df$f_value)] <- NA
rownames(anova_df) <- NULL
#' ## Residual diagnostics beyond residuals-vs-fitted (LAT-3134)
#' Standardized residuals, leverage and Cook's distance from the fitted model;
#' the normal quantiles for the Q-Q plot; sqrt|standardized residual| for the
#' scale-location plot.
fitted_v <- unname(fitted(model)); resid_v <- unname(residuals(model)) # also defined below for the frames
std_res <- unname(rstandard(model))
lev <- unname(hatvalues(model))
cook <- unname(cooks.distance(model))
qq <- qqnorm(std_res, plot.it = FALSE)
#' ## Variance inflation (LAT-3134), base R: 1 / (1 - R2) of each model-matrix
#' column regressed on the others; a driver's VIF is the largest across its columns.
vif_df <- if (ncol(X) > 2) {
Xd <- X[, -1, drop = FALSE]; cn <- colnames(Xd)
# per DRIVER: a factor's dummies are collinear with each other by construction, so
# each column is regressed on the OTHER drivers' columns only (LAT-3138 fix)
owner <- vapply(cn, function(c) { m <- model_drivers[startsWith(c, model_drivers)]; if (length(m)) m[which.max(nchar(m))] else c }, character(1))
vifs <- vapply(seq_len(ncol(Xd)), function(j) {
others <- which(owner != owner[j]); if (!length(others)) return(1)
r2j <- summary(lm(Xd[, j] ~ Xd[, others, drop = FALSE]))$r.squared
if (is.na(r2j) || r2j >= 1) Inf else 1 / (1 - r2j)
}, numeric(1))
names(vifs) <- colnames(Xd)
rows <- lapply(model_drivers, function(dc) {
idx <- which(startsWith(names(vifs), dc)); if (!length(idx)) return(NULL)
v <- max(vifs[idx])
data.frame(driver = human(dc), vif = round(v, 2),
reading = if (v > 10) "high" else if (v > 5) "moderate" else "low", stringsAsFactors = FALSE)
})
do.call(rbind, rows)
} else data.frame(driver = human(model_drivers[1]), vif = 1, reading = "only one driver", stringsAsFactors = FALSE)
rownames(vif_df) <- NULL
max_vif <- max(vif_df$vif)
#' ## Assumption checks (LAT-3134): one row per assumption with a verdict.
#' Base R throughout. holds / strained / violated are rules of thumb a reader can
#' re-derive from the statistic shown beside them.
verdict_p <- function(p, soft = 0.05, hard = 0.001) if (is.na(p)) "unknown" else if (p >= soft) "holds" else if (p >= hard) "strained" else "violated"
fmt_p <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else as.character(signif(p, 3))
e <- resid_v
# normality: Shapiro-Wilk on at most 5 000 residuals
sw_idx <- if (n_used > 5000) sort(sample.int(n_used, 5000)) else seq_len(n_used)
sw <- tryCatch(shapiro.test(e[sw_idx]), error = function(err) NULL)
skew <- mean((e - mean(e))^3) / sd(e)^3
norm_verdict <- if (is.null(sw)) "unknown" else if (sw$p.value >= 0.05) "holds" else if (abs(skew) < 1) "strained" else "violated"
# constant variance: Breusch-Pagan, LM = n * R2 of e^2 on fitted, chi-square(1)
bp_r2 <- summary(lm(e^2 ~ fitted_v))$r.squared
bp_stat <- n_used * bp_r2; bp_p <- pchisq(bp_stat, df = 1, lower.tail = FALSE)
# independence: Durbin-Watson on the row order
dw <- sum(diff(e)^2) / sum(e^2)
dw_verdict <- if (dw >= 1.5 && dw <= 2.5) "holds" else if (dw >= 1 && dw <= 3) "strained" else "violated"
# linearity: a RESET-style test, does fitted^2 add explanatory power
reset_p <- tryCatch({
m2 <- lm(df_clean$outcome ~ X[, -1, drop = FALSE] + I(fitted_v^2))
a2 <- anova(model, m2); a2[["Pr(>F)"]][2]
}, error = function(err) NA_real_)
# influence: rows with Cook's distance above 4/n
n_infl <- sum(cook > 4 / n_used, na.rm = TRUE); infl_share <- n_infl / n_used
infl_verdict <- if (infl_share < 0.02) "holds" else if (infl_share < 0.05) "strained" else "violated"
# sample size: rows per estimated term
per_term <- n_used / (ncol(X) - 1)
size_verdict <- if (per_term >= 20) "holds" else if (per_term >= 10) "strained" else "violated"
checks_df <- data.frame(
check = c("Residuals are normal", "Constant variance", "Independent residuals", "Linear relationship",
"No strong collinearity", "No dominant rows", "Enough rows per term"),
statistic = c(if (is.null(sw)) "Shapiro-Wilk not run" else paste0("Shapiro-Wilk W = ", round(sw$statistic, 4)),
paste0("Breusch-Pagan LM = ", round(bp_stat, 3)),
paste0("Durbin-Watson d = ", round(dw, 3)),
"RESET (fitted squared added)",
paste0("max VIF = ", round(max_vif, 2)),
paste0(n_infl, " of ", n_used, " rows with Cook's D > 4/n"),
paste0(round(per_term, 1), " rows per term")),
p_value = c(if (is.null(sw)) "" else fmt_p(sw$p.value), fmt_p(bp_p), "", fmt_p(reset_p), "", "", ""),
verdict = c(norm_verdict, verdict_p(bp_p), dw_verdict, verdict_p(reset_p),
if (max_vif > 10) "violated" else if (max_vif > 5) "strained" else "holds",
infl_verdict, size_verdict),
note = c(paste0("skewness ", round(skew, 2), "; with many rows a small departure is significant but harmless"),
"residual spread should not change with the fitted value",
"meaningful only if the rows are in a natural order such as time",
"a curve or threshold the straight line misses would show here",
"a VIF above 5 inflates that driver's standard error",
"a few rows steering the fit would show as large Cook's distances",
"fewer than ten rows per estimated term makes the coefficients unstable"),
stringsAsFactors = FALSE)
#' ## Fit and residual frames (sampled to 1 000 rows for the pictures)
set.seed(42)
keep <- if (n_used > 1000) sort(sample.int(n_used, 1000)) else seq_len(n_used)
fitted_v <- unname(fitted(model)); resid_v <- unname(residuals(model))
fit_df <- data.frame(predicted = round(fitted_v[keep], 4), actual = round(df_clean$outcome[keep], 4))
resid_df <- data.frame(fitted = round(fitted_v[keep], 4), residual = round(resid_v[keep], 4))
resid_dist_df <- data.frame(residual = round(resid_v[keep], 4))
qq_df <- data.frame(theoretical = round(qq$x[keep], 4), sample = round(qq$y[keep], 4))
sl_df <- data.frame(fitted = round(fitted_v[keep], 4), sqrt_abs_std_residual = round(sqrt(abs(std_res[keep])), 4))
infl_df <- data.frame(leverage = round(lev[keep], 4), std_residual = round(std_res[keep], 4), cooks_distance = round(cook[keep], 4))
#' ## Method text and the answer
method <- paste0(
"Ordinary least squares regression of ", human("outcome"), " on ",
paste(vapply(model_drivers, human, character(1)), collapse = ", "),
" over ", n_used, " rows (", n_in - n_used, " dropped for a missing outcome",
if (length(dropped)) paste0("; drivers excluded: ", paste(vapply(dropped, human, character(1)), collapse = ", ")) else "",
"); 95% confidence intervals on the coefficients; standardized effects = coefficient x sd(driver) / sd(outcome); ",
"assumption checks: Shapiro-Wilk, Breusch-Pagan, Durbin-Watson, RESET, VIF, Cook's distance, all base R."
)
answer <- list(
r_squared = round(r2, 4), adj_r_squared = round(adj_r2, 4), rmse = round(sigma, 4),
model_p_value = model_p, top_driver = top_driver, top_driver_direction = top_dir,
n_drivers = length(model_drivers), n = n_used
)
# ── Results: one entry per place ─────────────────────────────────────────────
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): a
#' library tool supplies data objects; the answer is written by the last mile,
#' which is the first stage that reads the objects together.
#' ## fit_metrics: the model summary, read at a glance (LAT-3134)
results$fit_metrics <- place_metric(list(
r_squared = round(r2, 4), adj_r_squared = round(adj_r2, 4), rmse = tidy(sigma),
f_statistic = tidy(unname(fstat[1])), model_p_value = signif(model_p, 3),
n = n_used, n_drivers = length(model_drivers)), lead = "r_squared", place = "fit_metrics")
#' ## anova_table: the variance the drivers explain, by source
results$anova_table <- place_table(anova_df, place = "anova_table")
#' ## predicted_vs_actual: how closely the model tracks the outcome
results$predicted_vs_actual <- place_relationship(fit_df, x = "predicted", y = "actual",
place = "predicted_vs_actual")
#' ## standardized_effects: beta per driver, signed
results$standardized_effects <- place_comparison(std_df, category = "driver", value = "beta",
series = "direction", place = "standardized_effects")
#' ## coefficient_interval: the coefficient chart (no intercept)
results$coefficient_interval <- place_interval(interval_df, term = "term", value = "beta", low = "low", high = "high",
place = "coefficient_interval")
#' ## coefficient_table: every term with CI and p
results$coefficient_table <- place_table(coef_df, place = "coefficient_table")
#' ## residual_vs_fitted: linearity and constant variance by eye
results$residual_vs_fitted <- place_relationship(resid_df, x = "fitted", y = "residual",
place = "residual_vs_fitted")
#' ## scale_location: the spread of residuals across the fitted range
results$scale_location <- place_relationship(sl_df, x = "fitted", y = "sqrt_abs_std_residual",
place = "scale_location")
#' ## residual_distribution: the shape of the residuals
results$residual_distribution <- place_distribution(resid_dist_df, x = "residual", place = "residual_distribution")
#' ## qq_plot: residual quantiles against normal quantiles
results$qq_plot <- place_relationship(qq_df, x = "theoretical", y = "sample", place = "qq_plot")
#' ## assumption_checks: a verdict per assumption (a `checks` place, table-shaped)
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
#' ## vif_table: collinearity per driver
results$vif_table <- place_table(vif_df, place = "vif_table")
#' ## influence: leverage against standardized residual, sized by Cook's distance
results$influence <- place_relationship(infl_df, x = "leverage", y = "std_residual", size = "cooks_distance",
place = "influence")
#' ## fit_method: how it was done
results$fit_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = n_used, excluded = if (length(dropped)) vapply(dropped, human, character(1)) else character(0),
# LAT-3180: the method card's "rows · x → y" line reads these; unset, it printed a bare arrow
x_column = paste(vapply(model_drivers, human, character(1)), collapse = ", "), y_column = human("outcome"),
assumptions = "Linear relationship between drivers and outcome; independent, homoscedastic, roughly normal residuals; no strong collinearity among drivers."))
objects <- list() # filled by the object layer, not here
list(answer = answer, method = method, n = n_used, results = results, objects = objects,
json_output = list(answer = answer, method = method, n = n_used))
}