Executive Summary
Where sales came from, and how much of the split can be believed.
Search is the largest single contributor at 41.3 percent of total sales, but insert delivers the best return per unit of spend at 256.916 (95% interval 116.762 to 397.071) and is only 13.4 percent saturated, leaving room to grow. Radio and social carry negative estimated effects—meaning their spend rose when sales fell, not that the advertising destroyed demand. Four of eight channel coefficients are distinguishable from zero; the other four cannot be ruled out as returning nothing. Channel spends vary independently (highest VIF 4.05), so the per-channel split is stable. These are associations fitted to spend already chosen, not experimental effects; only a holdout or geo test can prove causation.
Analysis Overview
A media mix model of sales across 209 weekly periods and 8 channel(s).
An MMM credits channels only for the sales movement they explain beyond what would have arrived anyway. This model splits sales into 54.1 percent baseline (trend and seasonality) and 45.9 percent marketing. The baseline includes two annual seasonal harmonics and a linear trend. The model evaluated 1,365 candidate fits to find the best carryover decay rates and saturation curves for each of the 8 channels, using the Akaike information criterion. Because carryover means spend works past the week it is bought and saturation means the tenth dollar buys less than the first, the channel blocks in a decomposition are smaller than raw spend-versus-sales would suggest.
Data Preparation
How the timeline, the outcome and the spend columns were cleaned.
All 209 weekly periods loaded with no rows dropped and no missing spend cells. The cadence was inferred as weekly from the 'week' column with no gaps in the timeline. Every mapped spend column varied over time, so none were dropped. The data required no cleaning beyond loading: it was ready to model as-is.
Where the Outcome Came From, Period by Period
The fitted split of sales into baseline and each channel.
Each bar splits weekly sales into the non-marketing baseline and each channel's fitted contribution. Periods are grouped 2 at a time for readability. The baseline carries 54.1 percent of total sales—the part that would have arrived with no marketing under this model. Radio is the largest marketing block at −47.0 percent of total sales, reflecting its negative estimated effect. The blocks sum to the model's fitted value, which reproduces 61.6 percent of actual movement; the rest is residual unexplained by the model.
Contribution, Return and Fitted Shape by Channel
Per-channel contribution, share, return per unit of spend, and the fitted carryover and saturation.
| Channel | Contribution | Share PCT | Spend | Return Per Spend | Marginal Return | Decay Rate | Saturation Point | PCT Of Ceiling | Significance |
|---|---|---|---|---|---|---|---|---|---|
| radio | -1.06e+10 | -46.95 | 2.562e+07 | -413.7 | -122.5 | 0.39 | 1.32e+05 | 88.2 | p below 0.05 |
| search | 9.327e+09 | 41.3 | 1.309e+08 | 71.27 | 58.97 | 0.44 | 5.059e+06 | 24.8 | p below 0.001 |
| tv | 5283989777 | 23.4 | 3.515e+07 | 150.3 | 133.2 | 0.49 | 2.443e+06 | 14.7 | p below 0.001 |
| insert | 4267443042 | 18.9 | 1.661e+07 | 256.9 | 230.4 | 0.15 | 1.274e+06 | 13.4 | p below 0.001 |
| online display | 3746071074 | 16.59 | 4.512e+07 | 83.03 | 25.58 | 0.06 | 2.298e+05 | 88.5 | not distinguishable from zero |
| social | -3.247e+09 | -14.38 | 2.132e+07 | -152.3 | -41.5 | 0 | 9.343e+04 | 91.9 | not distinguishable from zero |
| newspaper | 9.17e+08 | 4.06 | 5.32e+07 | 17.24 | 15.27 | 0 | 6.133e+06 | 9.1 | not distinguishable from zero |
| direct mail | 6.722e+08 | 2.98 | 1.584e+08 | 4.245 | 1.362 | 0 | 9.351e+05 | 84.5 | not distinguishable from zero |
The short answer
Search and insert drive the most sales: search contributes 41.3% of sales and returns 71.2704 per dollar spent; insert returns the highest per dollar at 256.9163 and has room to grow (only 13.4% saturated). TV is the third major driver at 23.4% of sales. Radio and social are net negatives and should not receive incremental spend. Online display, newspaper, and direct mail cannot be distinguished from zero effect — the data does not support spending against them.
The detail
Search delivers 9,326,590,886.7 in contribution with a marginal return of 58.9719, and at 24.8% of its saturation ceiling still has substantial headroom. Insert's coefficient is significant (p < 0.001) and shows 256.9163 return per spend with 230.4285 marginal return, operating at only 13.4% of ceiling. TV carries the slowest decay (0.49), meaning 49.0% of weekly spend persists to the next week, and returns 150.3476 per spend. Radio and social both show negative contributions (−10,601,757,247.6 and −3,246,689,440.3 respectively) with significance below 0.05 and marked as not distinguishable from zero, respectively. Online display, newspaper, and direct mail are marked "not distinguishable from zero" — their coefficients lack statistical separation from noise.
What this can't tell you
These coefficients measure association with sales after accounting for carryover and saturation, not incrementality. Channels whose budgets follow demand (such as retargeting or brand search) may receive credit for sales that would have occurred anyway; newspaper spend shows a baseline correlation of −0.549, reducing this risk. The true intervals around return estimates are wider than regression confidence alone suggests because they exclude uncertainty in carryover and saturation parameters.
Return per Unit of Spend, with 95 Percent Intervals
Modelled sales returned per unit of spend, by channel.
The short answer
Four channels have intervals spanning zero — online display, newspaper, direct mail, and social — meaning the data cannot rule out that they return nothing. Insert has the tightest interval (116.7619 to 397.0707), making it the most defensible choice for the next dollar. Radio's interval is widest (−754.3722 to −73.0911), so its negative point estimate is the least reliable.
The detail
Insert returns 256.9163 per unit of spend with a 95% interval of 116.7619 to 397.0707. TV returns 150.3476 (64.9746 to 235.7207), and search returns 71.2704 (44.6042 to 97.9367). Online display (−97.7462 to 263.8117), newspaper (−10.1858 to 44.6565), direct mail (−12.694 to 21.1834), and social (−360.4491 to 55.8845) all span zero. Radio spans −754.3722 to −73.0911 — the widest interval — and does not include zero, indicating a reliably negative effect but with substantial estimation uncertainty.
What this can't tell you
These intervals reflect regression coefficient uncertainty only and do not include the uncertainty in fitted carryover and saturation parameters, so true intervals are wider than shown. A zero-spanning interval means the point estimate cannot be defended from sampling variability, not that the channel has zero true effect; more data would narrow these bounds.
Response Curves — Where Each Channel Flattens Out
Modelled outcome at each sustained spend level, per channel.
Each curve shows modelled sales at a sustained spend level once carryover settles. Social is furthest along its curve at 91.9 percent of ceiling at average spend of 102,010 per week—the flattest place to add budget. Newspaper has the most curve left at 9.1 percent of its ceiling, so it could theoretically absorb more spend with less saturation penalty. The curves are extrapolated to 1.5 times the highest observed spend per channel; beyond that range they reflect the model's saturation shape assumption, not observed data.
Can the Per-Channel Split Be Believed?
Variance inflation, pairwise spend correlation, and how closely each channel tracks the baseline.
| Channel | Vif | Max Pair Correlation | Baseline Correlation | Curve Span | Verdict |
|---|---|---|---|---|---|
| tv | 4.05 | 0.581 | -0.233 | 0.502 | separately identified |
| social | 3.3 | 0.582 | 0.388 | 1 | separately identified |
| search | 2.97 | 0.56 | 0.02 | 0.611 | separately identified |
| newspaper | 2.91 | 0.559 | -0.549 | 0.562 | separately identified |
| online display | 2.4 | 0.582 | 0.185 | 0.658 | separately identified |
| insert | 2.35 | 0.581 | -0.364 | 0.594 | separately identified |
| radio | 1.48 | 0.511 | -0.06 | 0.757 | separately identified |
| direct mail | 1.2 | 0.291 | -0.225 | 0.997 | separately identified |
The short answer
The per-channel split is stable. The highest variance inflation factor is 4.05 (TV), well below the 10 threshold that would signal budget multicollinearity. Every channel spans at least 0.50 of its saturation curve, so contribution levels are identified by observed spend variation, not by curve shape alone. One caveat: newspaper's spend correlates with the fitted baseline at −0.549, meaning part of its estimated contribution may reflect demand that was already arriving.
The detail
TV has a VIF of 4.05, social 3.3, search 2.97, newspaper 2.91, online display 2.4, insert 2.35, radio 1.48, and direct mail 1.2. The highest pairwise spend correlation is 0.582 (social and online display), confirming channels move independently. Curve span ranges from 0.502 (TV) to 0.997 (direct mail), so each channel traverses enough of its own saturation curve that the intercept cannot absorb its contribution. Baseline correlation ranges from −0.549 (newspaper) to 0.388 (social); newspaper's negative correlation with the baseline suggests its budget does not track demand, reducing the risk that it is handed credit for organic sales.
What this can't tell you
A low baseline correlation does not guarantee incrementality — it only reduces the risk that a channel's budget follows demand. The collinearity checks confirm the per-channel attribution is not mechanically unstable; they do not confirm that each channel's effect is causal or that carryover and saturation parameters are correctly specified. Wider confidence intervals on channel coefficients would firm up the split further.
Model Fit Diagnostics
How well the model reproduces the outcome, and where its fit statistics flatter it.
| Metric | Value | Interpretation |
|---|---|---|
| R-squared | 0.616 | share of the period-to-period movement in sales the model reproduces |
| Adjusted R-squared | 0.590 | the same, penalised for the 14 fitted terms |
| Periods used | 209 | observed weekly periods after cleaning |
| Parameters fitted | 14 | intercept, trend, 4 seasonal term(s) and 8 channel coefficient(s) |
| Durbin-Watson | 2.36 | residuals show no strong autocorrelation |
| Highest channel VIF | 4.05 | collinearity between channels — the per-channel split is stable |
| Holdout RMSE (last 42 weeks) | 34,633,635.0 | typical error on week periods never used to fit the model |
| Holdout MAPE | 27.2 percent | the same error as a share of the actual outcome |
The model reproduces 61.6 percent of period-to-period sales movement (59.0 percent adjusted for 14 fitted terms). The Durbin-Watson statistic of 2.36 shows no strong residual autocorrelation, so intervals are not understated by autocorrelation bias. The model was chosen on the Akaike information criterion over all 209 weeks and validated on the last 42 weeks held out, with holdout RMSE of 34,633,635 and MAPE of 27.2 percent. High R-squared on an MMM is easy to reach because trend and seasonality alone explain most business series; the collinearity card is the one that speaks to whether the channel split is believable.
Methods and Disclosure
The exact model form, the search, and what the numbers do and do not license.
| Item | Detail |
|---|---|
| Model form | sales in period t is modelled as a baseline plus a linear trend plus seasonality plus, for each channel, a coefficient times a saturated, carried-over version of that channel's spend. |
| Carryover (adstock) | Geometric: carried spend in period t equals this period's spend plus a decay rate times the previous period's carried spend. The decay rate was searched over 0.0 to 0.8 and fitted per channel, not assumed. |
| Diminishing returns (saturation) | Negative exponential: effect equals 1 minus the exponential of minus carried spend divided by a saturation scale. Concave everywhere, so the model can never imply that spend keeps paying back at a constant rate. |
| Baseline controls | Intercept, a linear trend term, and Fourier seasonality (annual cycle, harmonic 1; annual cycle, harmonic 2). Without these every channel absorbs whatever the business was going to do anyway. |
| Parameter search | Coordinate-wise grid search: 9 decay values times up to 7 saturation scales per channel, repeated over 3 pass(es), 1,365 model fits evaluated. A further 147 candidate scales were rejected before fitting because they compressed a channel into less than 0.50 of its response curve, where the coefficient stops being separable from the intercept. |
| Selection criterion | Chosen on the Akaike information criterion over all 209 fitted weekly periods, with the shape parameters counted as parameters, then checked against the last 42 weeks held out of the fit. |
| Estimation | Ordinary least squares on 209 observed weekly periods with 14 fitted terms. No regularisation is applied: shrinking the coefficients would make an entangled per-channel split look calmer than it is, and this analysis reports the entanglement instead. |
| Uncertainty | 95 percent intervals come from the coefficient standard errors and scale straight through to contribution, return per unit of spend and marginal return, because each is that coefficient multiplied by a fixed quantity. They do NOT include the uncertainty in the fitted decay and saturation parameters, so they are narrower than the truth. |
| Marginal return | Computed by lifting each channel's entire spend path by 1 percent, re-running that channel's own fitted carryover and saturation, and dividing the change in modelled outcome by the change in spend. |
| Collinearity diagnostic | Variance inflation factor per channel, computed by regressing each channel's transformed spend on the other model terms. Above 10, the channels move together too closely for their individual coefficients to be separated. |
| Neighbouring questions | This answers how much of sales each channel's SPEND is associated with over time. It is not an incrementality test, which measures the lift of one specific intervention against markets deliberately held back; and it is not multi-touch attribution, which splits credit for conversions that already happened across the touchpoints inside each individual journey. The three answer different questions and will not agree. |
| What this is not | This is a model fitted to observed spend, not an experiment. Channels whose budgets follow demand will be credited with demand. The honest test of a causal claim about sales is a holdout or geo experiment in which spend is deliberately varied; this analysis is not one. |
The model form is sales = baseline + trend + seasonality + Σ(channel coefficient × saturated, carried-over spend). Carryover uses geometric adstock with decay rates searched from 0.0 to 0.8 per channel. Saturation is negative exponential, concave everywhere, so spend never returns at a constant rate. The grid search evaluated 1,365 candidate fits over 3 passes, choosing the best on AIC, then validated on 42 held-out weeks. OLS estimation on 209 periods with 14 fitted terms; no regularisation applied because shrinking coefficients would mask entanglement. Intervals treat decay and saturation as known, so they understate true uncertainty. A channel funded because demand was rising will be credited with that demand—nothing here establishes that changing spend would change sales by these amounts; only an experiment can do that.
Media Mix Model — Lite
Estimates how much of a dated outcome (sales, revenue, conversions) each marketing channel's spend is associated with, using the three things that separate a media mix model from a naive regression on raw spend: fitted carryover (adstock), fitted diminishing returns (saturation), and an explicit non-marketing baseline with trend and seasonality controls.
Why This Method?
Regressing an outcome on raw weekly spend gets two things wrong at once. It assumes advertising works only in the period it is bought (it does not — it decays), and it assumes the tenth unit of spend works as hard as the first (it does not — it saturates). Without a baseline, trend and seasonality, every channel also absorbs whatever the business was going to do anyway, and every channel looks effective.
What This Analysis Covers
- Per-channel carryover rate and saturation point, fitted by grid search
- Contribution and share of the outcome, with the non-marketing baseline
- Return per unit of spend and marginal return, each with a 95% interval
- Response curves showing where each channel flattens out
- The decomposition over time as a stacked view
- Model fit diagnostics and a collinearity diagnostic that says out loud
when the per-channel split cannot be trusted
Standard Library
Platform standard-library module (LAT-1441): runs on ANY dataset via the semantic mapping {date, outcome, spend_1..spend_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))Helpers
Core Analysis Pipeline
compute_shared <- function(df, params, col_map = list()) {
# === SHARED EXPORTS ===
# initial_rows/final_rows/rows_removed $ row accounting
# date_name / outcome_name $ humanized single-word keys
# channel_names $ named chr, semantic -> user name
# used_channels / dropped_df $ kept vs excluded spend columns
# cadence / period_word / n_periods $ time grid
# n_missing_periods / n_dup_rows / n_blank_spend / n_missing_outcome
# par $ fitted theta/kappa per channel
# selection_rule / selection_label $ holdout vs information criterion
# channel_df $ channel, contribution, share_pct, spend,
# return_per_spend, marginal_return, decay_rate,
# saturation_point, p_value (card dataset)
# roi_df $ channel, return_per_spend, ci_low, ci_high
# decomp_df $ period(ISO), component, contribution
# curves_df $ channel, spend_level, response
# collinearity_df $ channel, vif, max_pair_correlation,
# baseline_correlation, verdict
# fit_df_out $ metric, value, interpretation
# methods_df $ item, detail
# r2 / adj_r2 / dw / holdout_rmse / holdout_mape
# vif_max / collin_verdict / collin_phrase
# neg_channels / demand_followers / aliased_channels
# metrics / json_output
# === /SHARED EXPORTS ===
initial_rows <- nrow(df)
date_name <- humanize_semantic("date", col_map)[1]
outcome_name <- humanize_semantic("outcome", col_map)[1]Step 1: Find the mapped columns
if (!("date" %in% names(df))) {
stop(sprintf("A dated period column must be mapped(expected '%s') — a media mix model needs one row per time period.",
date_name))
}
if (!("outcome" %in% names(df))) {
stop(sprintf("An outcome column must be mapped(expected '%s') — sales, revenue or conversions per period.",
outcome_name))
}
sp_cols <- grep("^spend_[0-9]+$", names(df), value = TRUE)
sp_cols <- sp_cols[order(as.integer(sub("^spend_", "", sp_cols)))]
if (length(sp_cols) < 1) {
stop("At least one marketing-spend column must be mapped — there is nothing to attribute the outcome to.")
}
channel_names <- setNames(humanize_semantic(sp_cols, col_map), sp_cols)Step 2: Coerce the outcome (95% rule) and the spend columns
yv <- df$outcome
if (!is.numeric(yv)) {
conv <- suppressWarnings(as.numeric(as.character(yv)))
n_orig <- sum(!is.na(yv) & nzchar(trimws(as.character(yv))))
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) {
yv <- conv
} else {
stop(sprintf("The outcome column '%s' is not numeric — a media mix model needs a numeric outcome such as sales, revenue or conversions.",
outcome_name))
}
}
yv <- as.numeric(yv)
dropped_names <- character(0)
dropped_reason <- character(0)
spend_raw <- list()
n_blank_spend <- 0L
for (sc in sp_cols) {
v <- df[[sc]]
if (!is.numeric(v)) {
conv <- suppressWarnings(as.numeric(as.character(v)))
n_orig <- sum(!is.na(v) & nzchar(trimws(as.character(v))))
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) {
v <- conv
} else {
dropped_names <- c(dropped_names, channel_names[[sc]])
dropped_reason <- c(dropped_reason, "not numeric")
next
}
}
v <- as.numeric(v)
n_blank_spend <- n_blank_spend + sum(is.na(v))
v[is.na(v)] <- 0 # a blank spend cell is read as no spend that period
spend_raw[[sc]] <- v
}
if (length(spend_raw) < 1) {
stop(sprintf("None of the mapped spend columns(%s) could be read as numbers.",
paste(channel_names[sp_cols], collapse = ", ")))
}Step 3: Parse the dates
raw_date <- df$date
non_blank <- !(is.na(raw_date) | !nzchar(trimws(as.character(raw_date))))
d <- parse_dates_robust(raw_date)
n_nonblank <- sum(non_blank)
if (n_nonblank == 0) {
stop(sprintf("The period column '%s' is empty — there are no dates to model over.", date_name))
}
n_unparsed <- sum(non_blank & is.na(d))
if (n_unparsed / n_nonblank > 0.05) {
stop(sprintf("%d of %d values in '%s' could not be read as dates. Please use a recognizable date format, for example 2024-01-31 or 01/31/2024.",
n_unparsed, n_nonblank, date_name))
}Step 4: Keep complete rows, aggregate duplicate periods by sum
keep <- !is.na(d) & !is.na(yv)
n_missing_outcome <- sum(!is.na(d) & is.na(yv))
if (sum(keep) < 2) {
stop(sprintf("Fewer than two periods have both a readable '%s' and a '%s' value.",
date_name, outcome_name))
}
work <- data.frame(date = d[keep], outcome = yv[keep], stringsAsFactors = FALSE)
for (sc in names(spend_raw)) work[[sc]] <- spend_raw[[sc]][keep]
n_dup_rows <- nrow(work) - length(unique(work$date))
val_cols <- setdiff(names(work), "date")
agg <- aggregate(work[, val_cols, drop = FALSE],
by = list(date = work$date), FUN = sum)
agg <- agg[order(agg$date), , drop = FALSE]
rownames(agg) <- NULL
if (nrow(agg) < 2) {
stop(sprintf("Only one distinct period in '%s' after cleaning — a media mix model needs a time series.",
date_name))
}Step 5: Infer the cadence and lay a regular time grid
med_gap <- median(as.numeric(diff(agg$date)))
if (med_gap <= 1.5) {
cadence <- "daily"; period_word <- "day"; step_days <- 1
season_periods <- c(7, 365.25); season_labels <- c("weekly", "annual")
theta_grid <- seq(0, 0.9, by = 0.1)
} else if (med_gap >= 5.5 && med_gap <= 8.5) {
cadence <- "weekly"; period_word <- "week"; step_days <- 7
season_periods <- c(365.25 / 7); season_labels <- "annual"
theta_grid <- seq(0, 0.8, by = 0.1)
} else if (med_gap >= 26 && med_gap <= 35) {
cadence <- "monthly"; period_word <- "month"; step_days <- NA
season_periods <- c(12); season_labels <- "annual"
theta_grid <- seq(0, 0.8, by = 0.1)
} else {
cadence <- "irregular"; period_word <- sprintf("%d-day period", max(1, round(med_gap)))
step_days <- max(1, round(med_gap))
season_periods <- numeric(0); season_labels <- character(0)
theta_grid <- seq(0, 0.8, by = 0.1)
}
if (cadence == "monthly") {
snapped <- as.Date(format(agg$date, "%Y-%m-01"))
agg <- aggregate(agg[, val_cols, drop = FALSE], by = list(date = snapped), FUN = sum)
agg <- agg[order(agg$date), , drop = FALSE]
grid_dates <- seq(min(agg$date), max(agg$date), by = "month")
} else {
grid_dates <- seq(min(agg$date), max(agg$date), by = step_days)
}
n_grid <- length(grid_dates)
pos <- match(agg$date, grid_dates)
# Periods whose date does not land on the grid (irregular reporting) are
# snapped to the nearest grid period rather than discarded.
if (any(is.na(pos))) {
for (i in which(is.na(pos))) {
pos[i] <- safe_which_max(-abs(as.numeric(grid_dates - agg$date[i])))
}
if (anyNA(pos)) {
agg <- agg[!is.na(pos), , drop = FALSE]
pos <- pos[!is.na(pos)]
if (!nrow(agg)) stop(sprintf("No period in '%s' could be placed on the inferred timeline.", date_name))
}
}
y_grid <- rep(NA_real_, n_grid)
spend_grid <- lapply(names(spend_raw), function(sc) rep(0, n_grid))
names(spend_grid) <- names(spend_raw)
for (i in seq_along(pos)) {
k <- pos[i]
y_grid[k] <- if (is.na(y_grid[k])) agg$outcome[i] else y_grid[k] + agg$outcome[i]
for (sc in names(spend_grid)) spend_grid[[sc]][k] <- spend_grid[[sc]][k] + agg[[sc]][i]
}
obs_idx <- which(!is.na(y_grid))
n_obs <- length(obs_idx)
n_missing_periods <- n_grid - n_obs
if (n_grid > 0 && n_missing_periods / n_grid > 0.3) {
stop(sprintf("%d of the %d %s periods between the first and last '%s' have no data (%s of the timeline). The series is too broken to model.",
n_missing_periods, n_grid, cadence, date_name,
fmt_pct(100 * n_missing_periods / n_grid)))
}Step 6: Drop spend columns with no variation over the observed periods
used_channels <- character(0)
for (sc in names(spend_grid)) {
v <- spend_grid[[sc]][obs_idx]
if (all(!is.finite(v)) || isTRUE(all(v == v[1])) || isTRUE(sd(v) == 0) || is.na(sd(v))) {
dropped_names <- c(dropped_names, channel_names[[sc]])
dropped_reason <- c(dropped_reason, "constant — no spend variation to learn from")
} else if (all(v <= 0)) {
dropped_names <- c(dropped_names, channel_names[[sc]])
dropped_reason <- c(dropped_reason, "no positive spend recorded")
} else {
used_channels <- c(used_channels, sc)
}
}
if (length(used_channels) < 1) {
stop(sprintf("None of the mapped spend columns(%s) vary over time, so none of them can explain movement in '%s'.",
paste(channel_names[sp_cols], collapse = ", "), outcome_name))
}Step 7: Build the non-marketing controls — trend and seasonality
tt <- seq_len(n_grid) - 1L
ctrl <- matrix(as.numeric(tt), ncol = 1)
ctrl_names <- "trend"
seasonal_terms <- character(0)
for (si in seq_along(season_periods)) {
P <- season_periods[si]
if (P <= 1 || n_obs < 1.5 * P) next
K <- if (n_obs >= 3 * P) 2L else 1L
for (k in seq_len(K)) {
ctrl <- cbind(ctrl, sin(2 * pi * k * tt / P), cos(2 * pi * k * tt / P))
nm <- sprintf("seas_%s_%d", season_labels[si], k)
ctrl_names <- c(ctrl_names, paste0(nm, "_sin"), paste0(nm, "_cos"))
seasonal_terms <- c(seasonal_terms, sprintf("%s cycle, harmonic %d", season_labels[si], k))
}
}
colnames(ctrl) <- ctrl_names
n_params <- 1L + ncol(ctrl) + length(used_channels)
min_needed <- max(24L, as.integer(3 * n_params))
if (n_obs < min_needed) {
stop(sprintf("Only %d %s periods of '%s' are usable. Fitting carryover, saturation and a baseline for %d channel(s) needs at least %d periods.",
n_obs, cadence, outcome_name, length(used_channels), min_needed))
}Step 8: Fit carryover and saturation
Two stages, and the decay rates are FITTED in both, never assumed. (a) A coordinate-wise GRID search: each channel's (decay, saturation scale) pair is scored against the whole model with the other channels held at their current values, repeated until no channel improves. (b) A continuous Nelder-Mead REFINEMENT started from the grid solution, because the grid is deliberately coarse and the criterion surface between grid points is not flat. The criterion in both stages is the Akaike information criterion, counting the two fitted shape parameters per channel as parameters. When the series is long enough, the last fifth of it is additionally held back and scored out-of-sample as an INDEPENDENT check — reported, never selected on.
y_obs <- y_grid[obs_idx]
h <- max(6L, as.integer(ceiling(0.2 * n_obs)))
use_holdout <- (n_obs >= 30L) && ((n_obs - h) >= (3L * n_params))
train_i <- seq_len(n_obs); test_i <- if (use_holdout) (n_obs - h + 1L):n_obs else integer(0)
selection_rule <- "aic"
selection_label <- sprintf(
"the Akaike information criterion over all %d fitted %s periods, with the shape parameters counted as parameters%s",
n_obs, cadence,
if (use_holdout) sprintf(", then checked against the last %d %ss held out of the fit", h, period_word) else "")Saturation scales are proposed as multiples of the channel's own mean positive carried spend, then FILTERED: a scale so small that every active period sits on the flat top of the curve turns the regressor into a near constant, and a near-constant regressor's coefficient is not separable from the intercept — it explodes while the intercept absorbs the offset, inflating the channel's contribution with no change in fit. A candidate must therefore let the channel traverse at least half of its response curve across the observed periods; if none does, the widest-spanning candidate is kept and the channel is flagged as weakly identified.
MIN_TRANSFORM_SPAN <- 0.5
kappa_candidates <- function(a) {
p <- a[a > 0]
if (!length(p)) return(list())
m <- mean(p)
if (!is.finite(m) || m <= 0) return(list())
ks <- sort(unique(m * c(0.25, 0.4, 0.6, 0.85, 1.2, 1.8, 3.0)))
out <- vector("list", length(ks)); spans <- numeric(length(ks))
for (i in seq_along(ks)) {
z <- saturate_negexp(a, ks[i])
zo <- z[obs_idx]
spans[i] <- if (length(zo) && all(is.finite(zo))) diff(range(zo)) else 0
out[[i]] <- list(kappa = ks[i], z = z)
}
ok <- which(spans >= MIN_TRANSFORM_SPAN)
if (!length(ok)) {
w <- safe_which_max(spans)
if (is.na(w)) return(list())
ok <- w
}
out[ok]
}
Zcur <- matrix(0, nrow = n_grid, ncol = length(used_channels),
dimnames = list(NULL, used_channels))
par <- list()
n_rejected_scales <- 0L
for (sc in used_channels) {
a0 <- adstock_geometric(spend_grid[[sc]], 0)
k0 <- kappa_candidates(a0)
if (!length(k0)) {
par[[sc]] <- list(theta = 0, kappa = max(1e-9, mean(a0[a0 > 0])))
Zcur[, sc] <- saturate_negexp(a0, par[[sc]]$kappa)
} else {
pick <- k0[[max(1L, as.integer(ceiling(length(k0) / 2)))]]
par[[sc]] <- list(theta = 0, kappa = pick$kappa)
Zcur[, sc] <- pick$z
}
}
n_shape <- 2L * length(used_channels)
score_design <- function(Z) {
if (any(!is.finite(Z))) return(Inf)
X <- cbind(`(Intercept)` = 1, ctrl, Z)[obs_idx, , drop = FALSE]
f <- tryCatch(stats::lm.fit(X, y_obs), error = function(e) NULL)
if (is.null(f)) return(Inf)
r <- as.numeric(f$residuals); nn <- length(r); rss <- sum(r^2)
if (!is.finite(rss) || rss <= 0) return(Inf)
nn * log(rss / nn) + 2 * (f$rank + 1L + n_shape)
}
best_score <- score_design(Zcur)
n_evals <- 0L
n_passes <- 0L
for (pass in seq_len(3L)) {
n_passes <- pass
improved <- FALSE
for (sc in used_channels) {
keep_col <- Zcur[, sc]
best_col <- keep_col
best_par <- par[[sc]]
for (th in theta_grid) {
a <- adstock_geometric(spend_grid[[sc]], th)
cands <- kappa_candidates(a)
n_rejected_scales <- n_rejected_scales + (7L - length(cands))
for (cd in cands) {
Zcur[, sc] <- cd$z
s <- score_design(Zcur)
n_evals <- n_evals + 1L
if (is.finite(s) && s < best_score - 1e-9) {
best_score <- s; best_col <- cd$z
best_par <- list(theta = th, kappa = cd$kappa); improved <- TRUE
}
}
}
Zcur[, sc] <- best_col
par[[sc]] <- best_par
}
if (!improved) break
}Stage (b): continuous refinement from the grid solution. Decay is optimised on a logistic scale bounded below 0.95 (a decay of 1 would mean spend never stops working) and the saturation scale on a log scale. The same minimum-span rule applies as a hard barrier, so the optimiser cannot walk into the region where a channel's coefficient stops being separable from the intercept.
THETA_MAX <- 0.95
span_of <- function(z) {
zo <- z[obs_idx]
if (!length(zo) || !all(is.finite(zo))) return(NA_real_)
diff(range(zo))
}Channels whose widest available candidate already falls short of the minimum span cannot be held to it — the barrier for those is their own best achievable span, so the refinement can still improve their fit instead of being frozen at an infeasible start. They stay flagged.
span_floor <- setNames(sapply(used_channels, function(sc) {
g <- span_of(Zcur[, sc])
if (is.na(g)) 0 else min(MIN_TRANSFORM_SPAN, g)
}), used_channels)
span_ok <- function(z, sc) {
sp <- span_of(z)
!is.na(sp) && sp >= span_floor[[sc]] - 1e-9
}
to_v <- function(pl) unlist(lapply(used_channels, function(sc) {
th <- min(max(pl[[sc]]$theta, 1e-4), THETA_MAX - 1e-4)
c(log(th / (THETA_MAX - th)), log(max(pl[[sc]]$kappa, 1e-9)))
}))
from_v <- function(v) {
out <- list()
for (i in seq_along(used_channels)) {
e <- exp(v[2 * i - 1])
out[[used_channels[i]]] <- list(theta = THETA_MAX * e / (1 + e),
kappa = exp(v[2 * i]))
}
out
}
n_refine <- 0L
obj_v <- function(v) {
if (any(!is.finite(v))) return(1e12)
pl <- from_v(v)
Z <- Zcur
for (sc in used_channels) {
z <- saturate_negexp(adstock_geometric(spend_grid[[sc]], pl[[sc]]$theta), pl[[sc]]$kappa)
if (!span_ok(z, sc)) return(1e12)
Z[, sc] <- z
}
n_refine <<- n_refine + 1L
s <- score_design(Z)
if (!is.finite(s)) 1e12 else s
}
v0 <- to_v(par)
if (all(is.finite(v0)) && is.finite(obj_v(v0))) {
op <- tryCatch(stats::optim(v0, obj_v, method = "Nelder-Mead",
control = list(maxit = 800, reltol = 1e-10)),
error = function(e) NULL)
if (!is.null(op) && is.finite(op$value) && op$value < best_score - 1e-9) {
par <- from_v(op$par)
for (sc in used_channels) {
Zcur[, sc] <- saturate_negexp(
adstock_geometric(spend_grid[[sc]], par[[sc]]$theta), par[[sc]]$kappa)
}
best_score <- op$value
}
}Step 9: Final fit on every observed period, with the chosen transforms
fit_frame <- as.data.frame(cbind(ctrl, Zcur)[obs_idx, , drop = FALSE])
ch_alias <- setNames(paste0("ch_", seq_along(used_channels)), used_channels)
names(fit_frame) <- c(ctrl_names, unname(ch_alias[used_channels]))
fit_frame$.y <- y_obs
final_fit <- lm(.y ~ ., data = fit_frame)
aliased_channels <- character(0)
cf <- coef(final_fit)
bad <- names(cf)[is.na(cf)]
bad_ch <- names(ch_alias)[ch_alias %in% bad]
if (length(bad_ch) > 0) {
aliased_channels <- unname(channel_names[bad_ch])
used_channels <- setdiff(used_channels, bad_ch)
if (length(used_channels) < 1) {
stop(sprintf("Every mapped spend column is an exact linear combination of the others, so no channel-level effect on '%s' can be separated.",
outcome_name))
}
Zcur <- Zcur[, used_channels, drop = FALSE]
ch_alias <- setNames(paste0("ch_", seq_along(used_channels)), used_channels)
fit_frame <- as.data.frame(cbind(ctrl, Zcur)[obs_idx, , drop = FALSE])
names(fit_frame) <- c(ctrl_names, unname(ch_alias[used_channels]))
fit_frame$.y <- y_obs
final_fit <- lm(.y ~ ., data = fit_frame)
}
sm <- summary(final_fit)
cmat <- sm$coefficients
r2 <- as.numeric(sm$r.squared)
adj_r2 <- as.numeric(sm$adj.r.squared)
dfres <- final_fit$df.residual
tcrit <- if (dfres > 0) qt(0.975, dfres) else NA_real_
resid_v <- as.numeric(residuals(final_fit))
dw <- if (sum(resid_v^2) > 0) sum(diff(resid_v)^2) / sum(resid_v^2) else NA_real_Step 10: Contribution, share, return and marginal return per channel
total_outcome <- sum(y_obs)
ch_rows <- list()
for (i in seq_along(used_channels)) {
sc <- used_channels[i]
ali <- unname(ch_alias[sc])
zi <- Zcur[obs_idx, sc]
sum_z <- sum(zi)
est <- if (ali %in% rownames(cmat)) cmat[ali, "Estimate"] else NA_real_
se <- if (ali %in% rownames(cmat)) cmat[ali, "Std. Error"] else NA_real_
pv <- if (ali %in% rownames(cmat)) cmat[ali, "Pr(>|t|)"] else NA_real_
contrib <- est * sum_z
c_lo <- (est - tcrit * se) * sum_z
c_hi <- (est + tcrit * se) * sum_z
spend_tot <- sum(spend_grid[[sc]][obs_idx])
roi <- if (spend_tot > 0) contrib / spend_tot else NA_real_
r_lo <- if (spend_tot > 0) c_lo / spend_tot else NA_real_
r_hi <- if (spend_tot > 0) c_hi / spend_tot else NA_real_
# Marginal return: lift the channel's whole spend path by 1 percent and
# re-run its own fitted adstock + saturation. Captures carryover and
# curvature exactly rather than approximating the derivative.
bump <- spend_grid[[sc]] * 1.01
z_bump <- saturate_negexp(adstock_geometric(bump, par[[sc]]$theta), par[[sc]]$kappa)
d_spend <- 0.01 * spend_tot
kfac <- if (d_spend > 0) (sum(z_bump[obs_idx]) - sum_z) / d_spend else NA_real_
mroi <- est * kfac
m_lo <- (est - tcrit * se) * kfac
m_hi <- (est + tcrit * se) * kfac
sat90 <- 2.302585 * par[[sc]]$kappa * (1 - par[[sc]]$theta)
avg_spend <- mean(spend_grid[[sc]][obs_idx])
ss_now <- if (par[[sc]]$theta < 1) avg_spend / (1 - par[[sc]]$theta) else avg_spend
pct_ceiling <- 100 * saturate_negexp(ss_now, par[[sc]]$kappa)
ch_rows[[length(ch_rows) + 1]] <- data.frame(
channel = unname(channel_names[[sc]]),
contribution = round(contrib, 1),
share_pct = round(100 * contrib / total_outcome, 2),
spend = round(spend_tot, 1),
return_per_spend = round(roi, 4),
marginal_return = round(mroi, 4),
decay_rate = round(par[[sc]]$theta, 2),
saturation_point = round(sat90, 1),
pct_of_ceiling = round(pct_ceiling, 1),
p_value = signif(pv, 3),
ci_low = round(r_lo, 4),
ci_high = round(r_hi, 4),
m_low = round(m_lo, 4),
m_high = round(m_hi, 4),
contrib_low = round(c_lo, 1),
contrib_high = round(c_hi, 1),
avg_spend = round(avg_spend, 1),
semantic = sc,
stringsAsFactors = FALSE
)
}
channel_all <- do.call(rbind, ch_rows)
channel_all <- channel_all[order(-abs(channel_all$contribution)), , drop = FALSE]
rownames(channel_all) <- NULL
channel_all$significance <- ifelse(is.na(channel_all$p_value), "",
ifelse(channel_all$p_value < 0.001, "p below 0.001",
ifelse(channel_all$p_value < 0.01, "p below 0.01",
ifelse(channel_all$p_value < 0.05, "p below 0.05",
"not distinguishable from zero"))))
marketing_total <- sum(channel_all$contribution, na.rm = TRUE)
marketing_share <- 100 * marketing_total / total_outcome
baseline_share <- 100 - marketing_share
degenerate_decomposition <- isTRUE(marketing_share > 100) || isTRUE(baseline_share < 0)Step 11: Collinearity — can the per-channel split be believed?
base_fit <- rep(coef(final_fit)[["(Intercept)"]], n_obs)
for (nm in ctrl_names) {
cv <- coef(final_fit)[[nm]]
if (!is.null(cv) && is.finite(cv)) base_fit <- base_fit + cv * ctrl[obs_idx, nm]
}
vifs <- setNames(rep(NA_real_, length(used_channels)), used_channels)
if (length(used_channels) >= 2) {
for (sc in used_channels) {
others <- cbind(ctrl[obs_idx, , drop = FALSE],
Zcur[obs_idx, setdiff(used_channels, sc), drop = FALSE])
aux <- tryCatch(summary(lm(Zcur[obs_idx, sc] ~ others)), error = function(e) NULL)
r2j <- if (!is.null(aux)) as.numeric(aux$r.squared) else NA_real_
vifs[sc] <- if (is.na(r2j)) NA_real_ else if (r2j >= 1 - 1e-10) 9999 else 1 / (1 - r2j)
}
} else {
vifs[used_channels] <- 1
}
pair_max <- setNames(rep(NA_real_, length(used_channels)), used_channels)
if (length(used_channels) >= 2) {
S <- sapply(used_channels, function(sc) spend_grid[[sc]][obs_idx])
CM <- suppressWarnings(cor(S))
for (sc in used_channels) {
v <- CM[sc, setdiff(used_channels, sc)]
v <- v[is.finite(v)]
pair_max[sc] <- if (length(v)) max(abs(v)) else NA_real_
}
}
base_corr <- setNames(rep(NA_real_, length(used_channels)), used_channels)
for (sc in used_channels) {
v <- suppressWarnings(cor(spend_grid[[sc]][obs_idx], base_fit))
base_corr[sc] <- if (is.finite(v)) v else NA_real_
}
vif_max <- if (all(is.na(vifs))) NA_real_ else max(vifs, na.rm = TRUE)
collin_verdict <- if (is.na(vif_max)) "not assessable" else
if (vif_max >= 10) "unreliable" else if (vif_max >= 5) "fragile" else "stable"
collin_phrase <- switch(collin_verdict,
unreliable = "the per-channel split is NOT trustworthy",
fragile = "the per-channel split is fragile and should be read as indicative",
stable = "the per-channel split is stable",
"the per-channel split could not be assessed")
curve_span <- setNames(sapply(used_channels, function(sc) {
z <- Zcur[obs_idx, sc]
if (!length(z) || !all(is.finite(z))) NA_real_ else diff(range(z))
}), used_channels)
# At or below the barrier means the saturation scale was decided by the
# identification constraint rather than by the data.
weak_span_channels <- unname(channel_names[used_channels[
is.finite(curve_span) & curve_span <= MIN_TRANSFORM_SPAN + 1e-6]])
collinearity_df <- data.frame(
channel = unname(channel_names[used_channels]),
vif = round(pmin(vifs, 9999), 2),
max_pair_correlation = round(pair_max, 3),
baseline_correlation = round(base_corr, 3),
curve_span = round(curve_span, 3),
verdict = ifelse(is.na(vifs), "not assessable",
ifelse(vifs >= 10, "not separable from the other channels",
ifelse(vifs >= 5, "partly entangled with the other channels",
ifelse(is.finite(curve_span) & curve_span <= MIN_TRANSFORM_SPAN + 1e-6,
"separable, but its contribution level is weakly identified",
"separately identified")))),
stringsAsFactors = FALSE
)
collinearity_df <- collinearity_df[order(-collinearity_df$vif), , drop = FALSE]
rownames(collinearity_df) <- NULL
neg_channels <- channel_all$channel[is.finite(channel_all$contribution) &
channel_all$contribution < 0]
demand_followers <- collinearity_df$channel[is.finite(collinearity_df$baseline_correlation) &
abs(collinearity_df$baseline_correlation) >= 0.5]Step 12: Holdout accuracy at the chosen parameters
holdout_rmse <- NA_real_; holdout_mape <- NA_real_
if (use_holdout) {
Xf <- cbind(`(Intercept)` = 1, ctrl, Zcur)[obs_idx, , drop = FALSE]
ftr <- tryCatch(stats::lm.fit(Xf[train_i, , drop = FALSE], y_obs[train_i]),
error = function(e) NULL)
if (!is.null(ftr)) {
b <- ftr$coefficients; b[is.na(b)] <- 0
pr <- as.numeric(Xf[test_i, , drop = FALSE] %*% b)
if (all(is.finite(pr))) {
holdout_rmse <- sqrt(mean((y_obs[test_i] - pr)^2))
den <- abs(y_obs[test_i])
okd <- den > 0
if (any(okd)) holdout_mape <- 100 * mean(abs(y_obs[test_i][okd] - pr[okd]) / den[okd])
}
}
}Step 13: Decomposition over time (stacked view)
comp_mat <- data.frame(period = format(grid_dates[obs_idx], "%Y-%m-%d"),
stringsAsFactors = FALSE)
comp_mat[["Baseline(no marketing)"]] <- base_fit
for (sc in used_channels) {
est <- cmat[unname(ch_alias[sc]), "Estimate"]
comp_mat[[unname(channel_names[[sc]])]] <- est * Zcur[obs_idx, sc]
}
n_comp <- ncol(comp_mat) - 1L
max_chart_rows <- 1200L
max_periods <- max(8L, as.integer(floor(max_chart_rows / max(1L, n_comp))))
bucket_size <- 1L
if (n_obs > max_periods) {
bucket_size <- as.integer(ceiling(n_obs / max_periods))
grp <- ((seq_len(n_obs) - 1L) %/% bucket_size) + 1L
lab <- tapply(comp_mat$period, grp, function(x) x[1])
num <- comp_mat[, -1, drop = FALSE]
agg2 <- rowsum(as.matrix(num), group = grp)
comp_mat <- data.frame(period = as.character(lab), agg2,
check.names = FALSE, stringsAsFactors = FALSE)
}
decomp_df <- do.call(rbind, lapply(setdiff(names(comp_mat), "period"), function(cn) {
data.frame(period = comp_mat$period, component = cn,
contribution = round(as.numeric(comp_mat[[cn]]), 1),
stringsAsFactors = FALSE)
}))
rownames(decomp_df) <- NULLStep 14: Response curves (sustained-spend steady state)
curve_rows <- list()
for (sc in used_channels) {
est <- cmat[unname(ch_alias[sc]), "Estimate"]
th <- par[[sc]]$theta; kp <- par[[sc]]$kappa
xmax <- max(spend_grid[[sc]][obs_idx])
if (!is.finite(xmax) || xmax <= 0) next
xs <- seq(0, 1.5 * xmax, length.out = 25)
a_ss <- if (th < 1) xs / (1 - th) else xs
curve_rows[[length(curve_rows) + 1]] <- data.frame(
channel = unname(channel_names[[sc]]),
spend_level = round(xs, 1),
response = round(est * saturate_negexp(a_ss, kp), 1),
stringsAsFactors = FALSE)
}
curves_df <- do.call(rbind, curve_rows)
rownames(curves_df) <- NULLStep 16: Metrics + json answer
top_i <- safe_which_max(channel_all$contribution)
top_channel <- if (is.na(top_i)) "not estimable" else channel_all$channel[top_i]
top_share <- if (is.na(top_i)) NA_real_ else channel_all$share_pct[top_i]
roi_i <- safe_which_max(channel_all$return_per_spend)
best_roi_channel <- if (is.na(roi_i)) "not estimable" else channel_all$channel[roi_i]
best_roi <- if (is.na(roi_i)) NA_real_ else channel_all$return_per_spend[roi_i]
metrics <- list(
`Periods Analysed` = n_obs,
`Channels Modelled` = length(used_channels),
`Model R-squared` = round(r2, 3),
`Marketing-Attributed Share` = fmt_pct(marketing_share),
`Baseline Share` = fmt_pct(baseline_share),
`Largest Contributor` = top_channel,
`Largest Contributor Share` = fmt_pct(top_share),
`Best Return per Spend` = best_roi_channel,
`Highest Channel VIF` = if (is.na(vif_max)) NA_real_ else round(min(vif_max, 9999), 2),
`Collinearity Verdict` = collin_verdict,
`Decomposition Verdict` = if (degenerate_decomposition) "degenerate" else "coherent",
`Parameter Selection` = selection_rule
)
neg_sentence <- if (length(neg_channels) > 0) paste0(
" ", paste(neg_channels, collapse = " and "),
if (length(neg_channels) == 1) " carries a NEGATIVE estimated effect" else " carry NEGATIVE estimated effects",
" and is reported that way rather than clipped to zero — in observational spend data that usually means the spend rose when the outcome was falling, not that the advertising destroyed demand.") else ""
collin_sentence <- if (collin_verdict == "unreliable") sprintf(
" Channel spends move together too closely(highest variance inflation factor %s), so %s: read the combined marketing number, not the per-channel split.",
formatC(min(vif_max, 9999), format = "f", digits = 1), collin_phrase)
else if (collin_verdict == "fragile") sprintf(
" Channel spends partly move together(highest variance inflation factor %s), so %s.",
formatC(vif_max, format = "f", digits = 1), collin_phrase)
else sprintf(" Channel spends vary independently enough(highest variance inflation factor %s) that %s.",
if (is.na(vif_max)) "not assessable" else formatC(vif_max, format = "f", digits = 1),
collin_phrase)
degenerate_sentence <- if (degenerate_decomposition) sprintf(
" WARNING: this decomposition is degenerate — it credits marketing with %s of total %s and leaves the non-marketing baseline at %s. No model can honestly claim marketing produced more than the whole outcome, so the split below should not be used; look for an outlier period, a control the model is missing, or a channel whose spend barely varies.",
fmt_pct(marketing_share), outcome_name, fmt_pct(baseline_share)) else ""
span_sentence <- if (length(weak_span_channels) > 0) sprintf(
" %s never move far along their own response curve in this data(the spend range covers less than half of it), so their contribution LEVEL leans on the model's assumed curve shape rather than on anything observed; treat those totals as the softest numbers in the report.",
paste(weak_span_channels, collapse = " and ")) else ""
demand_sentence <- if (length(demand_followers) > 0) sprintf(
" %s spend tracks the fitted baseline closely(correlation of %s or more), so %s credited with demand that would have arrived anyway.",
paste(demand_followers, collapse = " and "),
formatC(max(abs(base_corr[is.finite(base_corr)])), format = "f", digits = 2),
if (length(demand_followers) == 1) "part of its contribution is likely" else "part of their contribution is likely")
else " No channel's spend tracks the fitted baseline closely enough to suggest it is simply following demand."
json_output <- list(
answer = paste0(
"Media mix model of ", outcome_name, " over ", fmt_num(n_obs), " ", cadence,
" periods with ", length(used_channels), " channel(s): the model reproduces ",
fmt_pct(100 * r2), " of the movement, and attributes ", fmt_pct(marketing_share),
" of total ", outcome_name, " to marketing and ", fmt_pct(baseline_share),
" to the non-marketing baseline, trend and seasonality. ",
"The largest contributor is ", top_channel, " at ", fmt_pct(top_share),
" of the outcome; the best return per unit of spend is ", best_roi_channel,
if (is.na(best_roi)) "" else paste0(" at ", formatC(best_roi, format = "f", digits = 3),
" units of ", outcome_name, " per unit of spend"),
". Carryover and saturation were fitted per channel by grid search on ",
selection_label, ".", degenerate_sentence, collin_sentence, span_sentence,
demand_sentence, neg_sentence,
" These are associations fitted to observed spend, not experimental effects: the honest test of the causal claim is a holdout or geo experiment, which this analysis is not."
),
cards = lapply(
c("tldr", "overview", "preprocessing", "decomposition", "channel_contribution",
"roi_intervals", "response_curves", "collinearity", "model_fit", "methods"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows, final_rows = n_obs,
rows_removed = max(0L, initial_rows - n_obs),
date_name = date_name, outcome_name = outcome_name,
channel_names = channel_names, used_channels = used_channels,
dropped_df = dropped_df, aliased_channels = aliased_channels,
cadence = cadence, period_word = period_word, n_periods = n_obs,
n_grid = n_grid, n_missing_periods = n_missing_periods,
n_dup_rows = n_dup_rows, n_blank_spend = n_blank_spend,
n_missing_outcome = n_missing_outcome,
par = par, theta_grid = theta_grid, n_evals = n_evals, n_passes = n_passes,
selection_rule = selection_rule, selection_label = selection_label,
holdout_h = h, holdout_rmse = holdout_rmse, holdout_mape = holdout_mape,
channel_all = channel_all, channel_df = channel_df, roi_df = roi_df,
decomp_df = decomp_df, curves_df = curves_df,
collinearity_df = collinearity_df, fit_df_out = fit_df_out,
methods_df = methods_df, bucket_size = bucket_size,
seasonal_terms = seasonal_terms, seasonal_note = seasonal_note,
n_params = n_params, r2 = r2, adj_r2 = adj_r2, dw = dw,
total_outcome = total_outcome, marketing_total = marketing_total,
marketing_share = marketing_share, baseline_share = baseline_share,
vifs = vifs, vif_max = vif_max, collin_verdict = collin_verdict,
curve_span = curve_span, weak_span_channels = weak_span_channels,
degenerate_decomposition = degenerate_decomposition,
degenerate_sentence = degenerate_sentence,
span_sentence = span_sentence, n_rejected_scales = n_rejected_scales,
min_transform_span = MIN_TRANSFORM_SPAN,
collin_phrase = collin_phrase, base_corr = base_corr,
neg_channels = neg_channels, demand_followers = demand_followers,
top_channel = top_channel, top_share = top_share,
best_roi_channel = best_roi_channel, best_roi = best_roi,
collin_sentence = collin_sentence, demand_sentence = demand_sentence,
neg_sentence = neg_sentence,
metrics = metrics, json_output = json_output
)
}Your turn
Bring your own data and the question you actually need answered.
CympleData Scientist Send me your data and question, I’ll send you the analytics. ds@mcpanalytics.ai