Executive Summary
When did Daily Active Users shift, and by how much?
Daily Active Users shifted level twice across 120 time points spanning January to April 2023. The largest move occurred on 2023-02-10, where the average rose from 99.58 to 125.72—a gain of 26.14 users or 26.25% (p = 0.002, very strong evidence). The second break fell on 2023-03-22, with a decline of 15.30 users or 12.17%. Together, these two level steps account for 89.99% of the variation in Daily Active Users. The analysis identifies when the level changed; it cannot explain why—causation requires evidence beyond the series itself.
Analysis Overview
Binary segmentation for level shifts in Daily Active Users across 120 time points.
Daily Active Users underwent level shifts detected via binary segmentation of 120 time points from January to April 2023. The method scored every possible split using the Gaussian change-in-mean likelihood ratio and accepted only those clearing a modified-BIC penalty of 14.36—a threshold chosen to prevent noise from masquerading as regime change. Two breaks cleared this threshold, dividing the series into 3 distinct levels that together explain 89.99% of its variation. The search was bounded by a minimum segment length of 6 points and a maximum of 5 breaks, ensuring a single outlier cannot present itself as a shift.
Data Preparation
How the series was assembled and how the search was bounded.
All 120 rows loaded and retained; no records were dropped for missing dates or values, and no averaging was required since each observation date appears once. The minimum segment length of 6 points and the maximum break count of 5 both serve the same purpose: preventing transient noise from being misread as a level shift. The series spans 120 distinct time points ordered by observation date, with no gaps or duplicates. These constraints are structural safeguards, not data losses—they ensure that only persistent changes in the series average qualify as breaks.
The Series With Its Fitted Level
The observed series and the step level fitted to it, from 2023-01-01 to 2023-04-30.
From 2023-01-01 through 2023-04-30, Daily Active Users remained flat around 99.58 until 2023-02-10, when it jumped to 125.72. It held that elevated level until 2023-03-22, when it dropped to 110.42 and remained there through the end of the window. Within each level, scatter ranges from 3.42 to 3.90 users—the noise any break must overcome. The two risers (26.14 on 2023-02-10 and −15.30 on 2023-03-22) are clearly larger than this within-level noise, indicating meaningful shifts rather than random fluctuation. No drift within levels suggests the step model is appropriate; a steady climb or decline would indicate a trend model would fit better.
Detected Level Shifts
Each break dated, with the level before and after, the magnitude, and its significance.
| Change Date | Level Before | Level After | Change | Direction | Percent Change | Lr Statistic | P Value | Evidence | Identification | Status |
|---|---|---|---|---|---|---|---|---|---|---|
| 2023-02-10 | 99.58 | 125.7 | 26.14 | increase | 26.25 | 219.4 | 0.002 | very strong | well inside the series | accepted |
| 2023-03-22 | 125.7 | 110.4 | -15.3 | decrease | -12.17 | 134.4 | 0.002 | very strong | well inside the series | accepted |
Two breaks reached statistical significance under permutation testing (p = 0.002 for both). The first, on 2023-02-10, raised the level by 26.144 users from 99.577 to 125.721, scoring a likelihood-ratio statistic of 219.39. The second, on 2023-03-22, lowered the level by 15.304 users from 125.721 to 110.417, scoring 134.45. Both breaks sit well inside the series (at least 12 points from either end), so both sides have sufficient data to estimate their respective levels reliably. The p-values reflect a permutation test that reshuffles values 499 times; they are optimistic because the break locations were discovered by searching the same data.
The Levels Between Breaks
3 level(s) with their date range, length, average and within-level spread.
| Segment | Start Date | End Date | N Points | Mean Level | SD Within |
|---|---|---|---|---|---|
| Level 1 | 2023-01-01 | 2023-02-09 | 40 | 99.58 | 3.422 |
| Level 2 | 2023-02-10 | 2023-03-21 | 40 | 125.7 | 3.527 |
| Level 3 | 2023-03-22 | 2023-04-30 | 40 | 110.4 | 3.902 |
The two breaks partition Daily Active Users into three equal-length regimes of 40 points each. Level 1 (2023-01-01 to 2023-02-09) averaged 99.577 with within-level spread of 3.422. Level 2 (2023-02-10 to 2023-03-21) averaged 125.721 with spread of 3.527. Level 3 (2023-03-22 to 2023-04-30) averaged 110.417 with spread of 3.902. The largest shift (26.14 users) far exceeds the widest within-level scatter (3.90), confirming that the breaks represent genuine level changes rather than noise. All three levels are equally long, a consequence of the search algorithm rather than a design choice.
Method & Limits
The search, the criterion, the penalty, the significance test, and what the method cannot do.
| Item | Detail |
|---|---|
| Design | Observational detection of level shifts in a single series of Daily Active Users. No control series, no treatment assignment, no experiment. |
| Search | Binary segmentation: the whole series is scanned for its best split, that split is kept if it clears the penalty, and each resulting piece is then scanned again. Implemented directly in base R over cumulative sums — no changepoint-detection package is used. |
| Criterion | Gaussian change-in-mean likelihood ratio. A segment of length m with residual sum of squares RSS costs m x log(RSS / m); a candidate break scores the whole-segment cost minus the two piece costs. It tests a change in the LEVEL of Daily Active Users, not a change in its slope or its variance. |
| Penalty | Modified BIC, 3 x log(120) = 14.36. Plain BIC (2 x log n) is too permissive when the break location is itself searched over, because the largest statistic across every candidate split clears it on pure noise too often. 2 break(s) cleared it; the next-strongest candidate (2023-01-30) scored 8.97 and was rejected because its score did not clear the penalty. |
| Minimum segment | 6 point(s). No break is placed closer than this to a series end or to another break, which is what stops a single outlier from being read as a regime change. |
| Maximum breaks | 5. The search stops there even if further splits would score above the penalty. |
| Significance | Permutation test, 499 permutations per break: the values inside the two segments adjoining the break are reshuffled and the LARGEST statistic anywhere in that window is recomputed each time. Comparing the break's own statistic against the maximum makes the p-value conservative. The smallest p-value it can report is 0.002, and because the break's location and window were chosen from the same data, the evidence is still optimistic. |
| Autocorrelation check | The lag-1 residual autocorrelation around the step fit is 0.04, low enough that treating the points within a window as exchangeable is a reasonable approximation for the permutation test. |
| Trend caveat | A straight line through Daily Active Users explains 13.39% of its variation, so the breaks below are not merely a staircase approximation of a smooth trend. |
| Edge caveat | A break within 12 point(s) of either end of the series is estimated from very few points on that side; its date and its size are both poorly determined and it is flagged as weakly identified in the break table. |
| What it cannot tell you | Where the level of Daily Active Users changed, and by how much — never why. The method has no access to causes: a break is a description of the series, and any explanation for it has to come from outside this analysis. |
Binary segmentation scanned every admissible split of the 120-point series, scoring each with the Gaussian change-in-mean likelihood ratio and accepting only splits that improved fit by more than 14.36 (modified-BIC penalty, equal to 3 × log(120)). This penalty replaces plain BIC because the break location is itself searched over, making plain BIC too permissive on noise. Minimum segment length of 6 points prevents outliers from creating false breaks. Lag-1 residual autocorrelation of 0.04 is low enough that permutation-test exchangeability is reasonable. A linear trend explains only 13.39% of variation, so the step model is not merely approximating a smooth drift. The method detects changes in level only—not slope or variance—and locates breaks without explaining them; causation requires external evidence.
Methodology
Statistical methodology and diagnostics for Changepoint Detection
Statistical Method
Standard-library analysis: when did my metric shift? Detect structural breaks and level changes in a time series with dates and magnitudes. Map a date column and a numeric series and get every point at which the average level moved: the date of each break, the mean level before and after, the size and direction of the move in units and percent, a permutation p-value per break, and the series charted with the fitted step level so each break is visible as a riser. Binary segmentation with a Gaussian change-in-mean likelihood ratio decides how many breaks the data supports, guarded by a minimum segment length, a modified-BIC penalty and a stated maximum number of changepoints — and when nothing clears the penalty the report says so and shows the candidate it rejected.
- The series is ordered in time and each date carries one value (several rows on a date are averaged)
- Within a segment the values vary around a constant level, without a systematic trend
- The values within a permutation window are exchangeable under the no-break hypothesis — autocorrelation breaks this and is checked and reported
- A shift in the level is what matters; changes in slope or in volatility are not what this method tests
- The analysis finds WHERE the level changed, never why — attributing a break to any particular cause needs evidence this method does not have
- A break close to either end of the series is estimated from very few points on one side; its date and its magnitude are both weakly identified and flagged as such
- The break locations are chosen by searching the same data used to test them, so the permutation p-values are optimistic, and their smallest reportable value is 0.002
- A smooth trend can be approximated by a staircase of same-direction level shifts; when that pattern appears the report warns, but it cannot distinguish the two
Analysis Code
Complete R source code for this analysis
Core Analysis Pipeline
Step 1: Resolve the mapped columns (humanized everywhere in prose)
initial_rows <- nrow(df)
date_h <- humanize_semantic("date", col_map)
value_h <- humanize_semantic("value", col_map)
for (req in c("date", "value")) {
if (!(req %in% names(df))) {
stop(sprintf("Changepoint detection needs '%s' (%s) mapped.",
humanize_semantic(req, col_map),
c(date = "the date/time column that orders the series",
value = "the numeric series to search for level shifts")[[req]]))
}
}Step 2: Coerce the value to numeric (95% rule)
y_raw <- df$value
if (!is.numeric(y_raw)) {
ch <- as.character(y_raw)
non_blank <- !is.na(ch) & trimws(ch) != ""
conv <- suppressWarnings(as.numeric(ch))
if (sum(non_blank) == 0 ||
sum(!is.na(conv[non_blank])) < 0.95 * sum(non_blank)) {
stop(sprintf("The value column '%s' does not look numeric — fewer than 95%% of its values parse as numbers. Map a numeric column so its level can be tracked over time.",
value_h))
}
y_raw <- conv
}Step 3: Parse the date column (ISO, mdy, dmy, or integer years)
parse_dates_vec <- function(ch) {
ok <- function(dd) sum(!is.na(dd)) >= 0.95 * sum(!is.na(ch) & trimws(ch) != "")
d <- suppressWarnings(as.Date(ch, format = "%Y-%m-%d"))
if (!ok(d)) d <- suppressWarnings(as.Date(lubridate::ymd(ch, quiet = TRUE)))
if (!ok(d)) d <- suppressWarnings(as.Date(lubridate::mdy(ch, quiet = TRUE)))
if (!ok(d)) d <- suppressWarnings(as.Date(lubridate::dmy(ch, quiet = TRUE)))
if (!ok(d)) {
nv <- suppressWarnings(as.numeric(ch))
nv_ok <- stats::na.omit(nv)
if (length(nv_ok) >= 0.95 * sum(!is.na(ch) & trimws(ch) != "") &&
length(nv_ok) > 0 && all(nv_ok == round(nv_ok)) &&
all(nv_ok >= 1900 & nv_ok <= 2100)) {
d <- as.Date(ifelse(is.na(nv), NA, sprintf("%04d-01-01", nv)),
format = "%Y-%m-%d")
}
}
if (ok(d)) d else NULL
}
d_ch <- trimws(as.character(df$date))
dts <- parse_dates_vec(d_ch)
if (is.null(dts)) {
stop(sprintf("The date column '%s' could not be read as dates — fewer than 95%% of its values parse as calendar dates (or integer years). Map a date column so the series can be ordered in time.",
date_h))
}Step 4: Keep complete rows; average ties on the same date
keep <- !is.na(y_raw) & !is.na(dts)
n_dropped <- sum(!keep)
y_k <- y_raw[keep]
d_k <- dts[keep]
final_rows <- length(y_k)
rows_removed <- initial_rows - final_rows
if (final_rows < 2) {
stop(sprintf("Only %d usable row(s) remained after dropping rows missing %s or %s — there is no series to analyse.",
final_rows, date_h, value_h))
}
agg <- stats::aggregate(list(y = y_k),
by = list(date_iso = format(d_k, "%Y-%m-%d")),
FUN = mean)
agg <- agg[order(agg$date_iso), , drop = FALSE]
n_points <- nrow(agg)
agg_note <- if (n_points < final_rows) {
sprintf("Several rows share the same %s, so the %s values on each date were averaged into one point(%s rows became %d time points).",
date_h, value_h, format(final_rows, big.mark = ","), n_points)
} else ""
MIN_POINTS <- 20L
if (n_points < MIN_POINTS) {
stop(sprintf("The series in '%s' has only %d distinct time point(s) — changepoint detection needs at least %d so that each side of a break has enough points to estimate a level.",
date_h, n_points, MIN_POINTS))
}
y <- agg$y
rss_null <- sum((y - mean(y))^2)
if (!is.finite(rss_null) || rss_null <= 0) {
stop(sprintf("The value column '%s' is constant across all %d time points — a series that never moves has no level shift to find.",
value_h, n_points))
}
eps <- max(.Machine$double.eps, 1e-12 * rss_null)Step 5: Search settings — minimum segment, maximum breaks, penalty
min_seg_req <- params$min_segment_length %||% NULL
min_seg <- if (!is.null(min_seg_req)) {
v <- suppressWarnings(as.integer(min_seg_req))
if (is.na(v) || v < 3L) {
stop(sprintf("min_segment_length must be a whole number of at least 3; received '%s'.",
as.character(min_seg_req)))
}
v
} else {
max(5L, as.integer(ceiling(0.05 * n_points)))
}
if (2L * min_seg > n_points) min_seg <- max(3L, as.integer(floor(n_points / 2)) - 1L)
max_cp_cap <- max(1L, as.integer(floor(n_points / min_seg)) - 1L)
max_cp_req <- params$max_changepoints %||% 5
max_cp <- suppressWarnings(as.integer(max_cp_req))
if (is.na(max_cp) || max_cp < 0L) max_cp <- 5L
max_cp <- min(max_cp, max_cp_cap)Modified-BIC penalty. Plain BIC (2 log n) is too permissive here because the break location is itself searched over: the maximum statistic over every candidate split exceeds 2 log n on pure noise often enough to manufacture breaks. 3 log n is the modified-BIC form used for change-in-mean and is what this module applies.
penalty <- 3 * log(n_points)Step 6: Binary segmentation — split, score, accept only past penalty
segs <- list(c(1L, n_points))
cand <- list(cp_best_split(y[1:n_points], min_seg, eps))
cps <- integer(0)
rej_k <- NA_integer_
rej_lr <- NA_real_
rej_reason <- "no admissible split remained"
repeat {
lrs <- vapply(cand, function(x) if (is.null(x)) -Inf else x$lr, numeric(1))
fin <- which(is.finite(lrs))
if (length(fin) == 0L) break
bi <- fin[which.max(lrs[fin])]
best <- cand[[bi]]
sg <- segs[[bi]]
global_k <- sg[1] + best$k - 1L
if (length(cps) >= max_cp) {
rej_k <- global_k; rej_lr <- best$lr
rej_reason <- sprintf("the maximum of %d break(s) had already been accepted", max_cp)
break
}
if (best$lr <= penalty) {
rej_k <- global_k; rej_lr <- best$lr
rej_reason <- "its score did not clear the penalty"
break
}
cps <- c(cps, global_k)
segs[[bi]] <- c(sg[1], global_k)
segs <- append(segs, list(c(global_k + 1L, sg[2])), after = bi)
cand[[bi]] <- cp_best_split(y[sg[1]:global_k], min_seg, eps)
cand <- append(cand,
list(cp_best_split(y[(global_k + 1L):sg[2]], min_seg, eps)),
after = bi)
}
cps <- sort(cps)
n_cp <- length(cps)Step 7: Segments, step fit, residual diagnostics
bnd_start <- c(1L, cps + 1L)
bnd_end <- c(cps, n_points)
n_seg <- length(bnd_start)
seg_mean <- vapply(seq_len(n_seg),
function(i) mean(y[bnd_start[i]:bnd_end[i]]), numeric(1))
seg_sd <- vapply(seq_len(n_seg), function(i) {
z <- y[bnd_start[i]:bnd_end[i]]
if (length(z) >= 2) stats::sd(z) else NA_real_
}, numeric(1))
fitted_step <- rep(seg_mean, times = bnd_end - bnd_start + 1L)
res <- y - fitted_step
rss_step <- sum(res^2)
var_expl <- if (rss_null > 0) 1 - rss_step / rss_null else NA_real_
r1 <- if (n_points >= 10) {
suppressWarnings(stats::cor(res[-1], res[-n_points]))
} else NA_real_
ac_flag <- !is.na(r1) && abs(r1) > 0.3
ac_verdict <- if (is.na(r1)) {
"The lag-1 residual autocorrelation could not be computed."
} else if (ac_flag) {
sprintf("CAUTION: the lag-1 residual autocorrelation around the step fit is %s, beyond the 0.3 threshold. The permutation test assumes the points within a window are exchangeable, which autocorrelation breaks, so the p-values reported here are anti-conservative — too small. In a strongly autocorrelated series a slow wander can also look exactly like a level shift.",
r2(r1))
} else {
sprintf("The lag-1 residual autocorrelation around the step fit is %s, low enough that treating the points within a window as exchangeable is a reasonable approximation for the permutation test.",
r2(r1))
}Smooth-trend masquerade check: a gradual drift can be approximated by a staircase of same-direction steps, and this method cannot tell the two apart.
tt <- seq_len(n_points)
lin_fit <- stats::lm(y ~ tt)
trend_r2 <- suppressWarnings(summary(lin_fit)$r.squared)
if (!is.finite(trend_r2)) trend_r2 <- NA_real_
same_dir <- n_cp >= 2 && (all(diff(seg_mean) > 0) || all(diff(seg_mean) < 0))
trend_flag <- !is.na(trend_r2) && trend_r2 > 0.5 && same_dir
trend_verdict <- if (trend_flag) {
sprintf("CAUTION: a straight line through %s already explains %s%% of its variation, and every accepted break moves in the same direction. A smooth trend can be approximated by a staircase of same-direction level shifts, and this method cannot tell the two apart — read the breaks as convenient description, not as evidence of abrupt events.",
value_h, r2(100 * trend_r2))
} else if (!is.na(trend_r2)) {
sprintf("A straight line through %s explains %s%% of its variation, so the breaks below are not merely a staircase approximation of a smooth trend.",
value_h, r2(100 * trend_r2))
} else {
"The smooth-trend comparison could not be computed."
}Step 8: Permutation significance per break
The reference distribution is the LARGEST statistic anywhere in the window, while the observed statistic is the one at this break, which makes the p-value conservative. Its floor is 1 / (permutations + 1).
n_perm <- 499L
cp_lr <- rep(NA_real_, n_cp)
cp_p <- rep(NA_real_, n_cp)
if (n_cp > 0) {
for (i in seq_len(n_cp)) {
ws <- bnd_start[i]
we <- bnd_end[i + 1L]
win <- y[ws:we]
kk <- cps[i] - ws + 1L
obs <- cp_lr_at(win, kk, eps)
cp_lr[i] <- obs
if (is.na(obs)) next
set.seed(4242L + i)
hits <- 0L
for (b in seq_len(n_perm)) {
mx <- cp_max_lr(sample(win), min_seg, eps)
if (!is.na(mx) && mx >= obs - 1e-9) hits <- hits + 1L
}
cp_p[i] <- (1 + hits) / (n_perm + 1)
}
}
p_floor <- 1 / (n_perm + 1)The strongest candidate that was NOT accepted, scored the same way.
rej_p <- NA_real_
rej_date <- NA_character_
if (!is.na(rej_k) && rej_k >= 1L && rej_k < n_points) {
rej_date <- agg$date_iso[rej_k + 1L]
rw_i <- max(which(bnd_start <= rej_k))
ws <- bnd_start[rw_i]
we <- bnd_end[rw_i]
win <- y[ws:we]
obs <- cp_lr_at(win, rej_k - ws + 1L, eps)
if (!is.na(obs)) {
set.seed(9999L)
hits <- 0L
for (b in seq_len(n_perm)) {
mx <- cp_max_lr(sample(win), min_seg, eps)
if (!is.na(mx) && mx >= obs - 1e-9) hits <- hits + 1L
}
rej_p <- (1 + hits) / (n_perm + 1)
}
}Step 9: Per-break description
edge_win <- max(min_seg, as.integer(ceiling(0.10 * n_points)))
cp_dates <- if (n_cp > 0) agg$date_iso[cps + 1L] else character(0)
cp_before <- if (n_cp > 0) seg_mean[seq_len(n_cp)] else numeric(0)
cp_after <- if (n_cp > 0) seg_mean[seq_len(n_cp) + 1L] else numeric(0)
cp_change <- cp_after - cp_before
cp_pct <- ifelse(abs(cp_before) > 1e-8, 100 * cp_change / abs(cp_before), NA_real_)
cp_edge <- if (n_cp > 0) (cps < edge_win) | ((n_points - cps) < edge_win) else logical(0)
cp_conf <- vapply(cp_p, function(p) {
if (is.na(p)) "not computed"
else if (p < 0.01) "very strong"
else if (p < 0.05) "strong"
else if (p < 0.10) "moderate"
else "weak — the permutation test does not separate it from noise"
}, character(1))
big_i <- if (n_cp > 0) {
ab <- abs(cp_change)
fin <- which(is.finite(ab))
if (length(fin) > 0) fin[which.max(ab[fin])] else 1L
} else NA_integer_
changepoints_df <- if (n_cp > 0) {
data.frame(
change_date = cp_dates,
level_before = round(cp_before, 3),
level_after = round(cp_after, 3),
change = round(cp_change, 3),
direction = ifelse(cp_change > 0, "increase",
ifelse(cp_change < 0, "decrease", "no net change")),
percent_change = ifelse(is.na(cp_pct), NA_real_, round(cp_pct, 2)),
lr_statistic = round(cp_lr, 2),
p_value = vapply(cp_p, fmt_p, character(1)),
evidence = cp_conf,
identification = ifelse(cp_edge,
"weak — sits close to a series edge, few points on one side",
"well inside the series"),
status = "accepted",
stringsAsFactors = FALSE
)
} else {Step 10: Chart dataset — the series plus the fitted step level
keep_i <- seq_len(n_points)
if (n_points > 500) {
keep_i <- sort(unique(c(1L, n_points, cps, cps + 1L,
as.integer(round(seq(1, n_points, length.out = 500))))))
keep_i <- keep_i[keep_i >= 1L & keep_i <= n_points]
}
changepoint_series_df <- rbind(
data.frame(period_date = agg$date_iso[keep_i],
series_value = round(y[keep_i], 3),
series_label = "Observed", stringsAsFactors = FALSE),
data.frame(period_date = agg$date_iso[keep_i],
series_value = round(fitted_step[keep_i], 3),
series_label = "Level(step fit)", stringsAsFactors = FALSE)
)
rownames(changepoint_series_df) <- NULLStep 11: Methods disclosure
accepted_txt <- if (n_cp > 0) {
sprintf("%d break(s) cleared it; the next-strongest candidate(%s) scored %s and was rejected because %s.",
n_cp,
if (!is.na(rej_date)) rej_date else "none remained",
if (is.na(rej_lr)) "n/a" else r2(rej_lr), rej_reason)
} else {
sprintf("No break cleared it: the strongest candidate anywhere in the series(%s) scored %s.",
if (!is.na(rej_date)) rej_date else "none",
if (is.na(rej_lr)) "n/a" else r2(rej_lr))
}
methods_df <- data.frame(
item = c("Design", "Search", "Criterion", "Penalty", "Minimum segment",
"Maximum breaks", "Significance", "Autocorrelation check",
"Trend caveat", "Edge caveat", "What it cannot tell you"),
detail = c(
sprintf("Observational detection of level shifts in a single series of %s. No control series, no treatment assignment, no experiment.", value_h),
sprintf("Binary segmentation: the whole series is scanned for its best split, that split is kept if it clears the penalty, and each resulting piece is then scanned again. Implemented directly in base R over cumulative sums — no changepoint-detection package is used."),
sprintf("Gaussian change-in-mean likelihood ratio. A segment of length m with residual sum of squares RSS costs m x log(RSS / m); a candidate break scores the whole-segment cost minus the two piece costs. It tests a change in the LEVEL of %s, not a change in its slope or its variance.", value_h),
sprintf("Modified BIC, 3 x log(%d) = %s. Plain BIC(2 x log n) is too permissive when the break location is itself searched over, because the largest statistic across every candidate split clears it on pure noise too often. %s",
n_points, r2(penalty), accepted_txt),
sprintf("%d point(s). No break is placed closer than this to a series end or to another break, which is what stops a single outlier from being read as a regime change.", min_seg),
sprintf("%d. The search stops there even if further splits would score above the penalty%s.", max_cp,
if (n_cp >= max_cp && max_cp > 0) " — this cap was reached, so more breaks may exist" else ""),
sprintf("Permutation test, %d permutations per break: the values inside the two segments adjoining the break are reshuffled and the LARGEST statistic anywhere in that window is recomputed each time. Comparing the break's own statistic against the maximum makes the p-value conservative. The smallest p-value it can report is %s, and because the break's location and window were chosen from the same data, the evidence is still optimistic.",
n_perm, r3(p_floor)),
ac_verdict,
trend_verdict,
sprintf("A break within %d point(s) of either end of the series is estimated from very few points on that side; its date and its size are both poorly determined and it is flagged as weakly identified in the break table.", edge_win),
sprintf("Where the level of %s changed, and by how much — never why. The method has no access to causes: a break is a description of the series, and any explanation for it has to come from outside this analysis.", value_h)
),
stringsAsFactors = FALSE
)
metrics <- list(
`Time Points` = n_points,
`Breaks Found` = as.integer(n_cp),
`Levels` = as.integer(n_seg),
`Largest Shift` = if (n_cp > 0) round(cp_change[big_i], 3) else 0,
`Largest Shift Date` = if (n_cp > 0) cp_dates[big_i] else "none",
`Variance Explained` = if (is.na(var_expl)) "n/a" else paste0(r2(100 * var_expl), "%"),
`Lag-1 Autocorrelation` = if (is.na(r1)) "n/a" else r2(r1)
)Step 12: The computed one-paragraph answer
break_clause <- if (n_cp == 0) {
sprintf("no structural break in the level of %s cleared the modified-BIC penalty of %s — the strongest candidate, %s, scored only %s(%s), so the level is best described as one regime averaging %s",
value_h, r2(penalty),
if (!is.na(rej_date)) rej_date else "none",
if (is.na(rej_lr)) "n/a" else r2(rej_lr), fmt_pp(rej_p), r2(seg_mean[1]))
} else {
parts <- vapply(seq_len(n_cp), function(i) {
sprintf("%s(%s from %s to %s, a %s of %s%s, %s)",
cp_dates[i],
if (cp_change[i] > 0) "up" else "down",
r2(cp_before[i]), r2(cp_after[i]),
if (cp_change[i] > 0) "rise" else "fall",
r2(abs(cp_change[i])),
if (is.na(cp_pct[i])) "" else sprintf(" or %s%%", r2(abs(cp_pct[i]))),
fmt_pp(cp_p[i]))
}, character(1))
sprintf("%d structural break(s) in the level of %s: %s. The step model explains %s of the series' variation",
n_cp, value_h, paste(parts, collapse = "; "),
if (is.na(var_expl)) "an undetermined share" else paste0(r2(100 * var_expl), "%"))
}
edge_clause <- if (n_cp > 0 && any(cp_edge)) {
sprintf(" %d break(s) sit close to a series edge and are weakly identified — their dates and sizes should be treated as provisional.",
sum(cp_edge))
} else ""
ac_clause <- if (ac_flag) {
sprintf(" CAUTION: residual autocorrelation is %s, so the permutation p-values are anti-conservative and a slow wander can imitate a level shift.", r2(r1))
} else ""
trend_clause <- if (trend_flag) {
" CAUTION: a smooth trend explains most of this series and every break moves the same way, so these breaks may be a staircase approximation of gradual drift rather than abrupt events."
} else ""
json_output <- list(
answer = paste0(
"Changepoint detection by binary segmentation on ", value_h, " across ",
n_points, " time points in ", date_h, ": ", break_clause, ".",
edge_clause, ac_clause, trend_clause,
" The method locates where the level changed and by how much; it cannot say why, and it is a description of this series rather than evidence that any particular event moved it."
),
cards = lapply(
c("tldr", "overview", "preprocessing", "series_breaks", "changepoints",
"segments", "methods"),
function(cid) list(id = cid, metrics = metrics)
)
)
list(
initial_rows = initial_rows, final_rows = final_rows,
rows_removed = rows_removed, n_dropped = n_dropped,
date_h = date_h, value_h = value_h,
n_points = n_points, agg_note = agg_note,
min_seg = min_seg, max_cp = max_cp, max_cp_cap = max_cp_cap,
penalty = penalty, n_perm = n_perm, p_floor = p_floor,
edge_win = edge_win,
cps = cps, n_cp = n_cp, n_seg = n_seg,
bnd_start = bnd_start, bnd_end = bnd_end,
seg_mean = seg_mean, seg_sd = seg_sd,
cp_dates = cp_dates, cp_before = cp_before, cp_after = cp_after,
cp_change = cp_change, cp_pct = cp_pct, cp_lr = cp_lr, cp_p = cp_p,
cp_edge = cp_edge, cp_conf = cp_conf, big_i = big_i,
rej_k = rej_k, rej_lr = rej_lr, rej_p = rej_p, rej_date = rej_date,
rej_reason = rej_reason,
var_expl = var_expl, r1 = r1, ac_flag = ac_flag, ac_verdict = ac_verdict,
trend_r2 = trend_r2, trend_flag = trend_flag, trend_verdict = trend_verdict,
changepoint_series_df = changepoint_series_df,
changepoints_df = changepoints_df, segments_df = segments_df,
methods_df = methods_df,
metrics = metrics, json_output = json_output
)
}