Executive Summary
Executive Summary
When did Close shift, and by how much?
Time Points
2416
Breaks Found
5
Levels
6
Largest Shift
107.842
Largest Shift Date
2013-04-22
Variance Explained
89.51%
Lag-1 Autocorrelation
0.98
Close shifted level 5 time(s) across 2416 time points. The largest move is at 2013-04-22, where the average went from 28.89 to 136.73 — a rise of 107.84 or 373.30% (p = 0.002, very strong evidence). The other break(s) fall on 2014-02-07 (up 49.80, 36.42%); 2014-02-10 (up 39.73, 21.30%); 2015-06-30 (down 4.93, 2.18%); 2017-02-08 (up 89.32, 40.35%). Together the level steps explain 89.51% of the variation in Close. CAUTION: residual autocorrelation is 0.98, above the 0.3 threshold — the p-values above are anti-conservative, and in a series that wanders slowly a gradual drift can imitate an abrupt step. This analysis says where the level of Close changed and by how much. It cannot say why: the date of a break is a fact about the series, and attributing it to any particular cause needs evidence this method does not have.
What this means
Tesla's stock price shifted to a new average level on 5 distinct dates between June 2010 and February 2020. The largest jump occurred on 2013-04-22, when Close rose from an average of 28.89 to 136.73—a jump of 107.84 (p = 0.002, very strong evidence). Four of the five breaks show p < 0.05; the weakest is 2015-06-30 (down 4.93, p = 0.082). Together these level steps account for 89.51% of the price variation. However, residual autocorrelation is 0.98, well above the 0.3 threshold, meaning the p-values reported are anti-conservative and a gradual drift could imitate an abrupt step in such a strongly autocorrelated series.
Overview
Analysis Overview
Binary segmentation for level shifts in Close across 2416 time points.
N Points2416
N Changepoints5
N Segments6
Penalty23.37
What this means
Binary segmentation searched 2416 daily closing prices for abrupt level shifts, scoring each candidate split with a Gaussian likelihood ratio and accepting only those clearing a modified-BIC penalty of 23.37. This penalty prevents high-noise wobbles from masquerading as regime changes. The method found 5 breaks that split the series into 6 distinct levels, explaining 89.51% of the variation in Close. No break was placed within 121 trading days of another break or of a series boundary, ensuring each shift rests on enough data to estimate both the before and after level. The search was capped at 5 breaks maximum.
Data Preparation
Data Preparation
How the series was assembled and how the search was bounded.
Initial Rows2416
Final Rows2416
Rows Removed0
What this means
All 2416 rows loaded and used; no rows were dropped for missing dates or values, and no averaging was needed because each date appears once. The minimum segment length of 121 points and the maximum of 5 breaks were set before the search began—both constraints exist to prevent a single unusual reading from presenting itself as a structural change. These guardrails mean the detected breaks represent sustained shifts in the average level, not transient spikes.
Visualization
The Series With Its Fitted Level
The observed series and the step level fitted to it, from 2010-06-29 to 2020-02-03.
What this means
Close drifted in a narrow band around 28.89 from June 2010 through April 2013, then jumped to 136.73 on 2013-04-22. It rose further on 2014-02-07 (to 186.53) and again on 2014-02-10 (to 226.26), paused with a small dip on 2015-06-30 (to 221.33), then surged on 2017-02-08 to 310.65, where it remained through February 2020. The observed series shows clear vertical jumps at each break date; within each regime, prices scatter around their level with a range from 5.40 to 61.78, the widest scatter in the final period.
Data Table
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 |
|---|---|---|---|---|---|---|---|---|---|---|
| 2013-04-22 | 28.89 | 136.7 | 107.8 | increase | 373.3 | 3212 | 0.002 | very strong | well inside the series | accepted |
| 2014-02-07 | 136.7 | 186.5 | 49.8 | increase | 36.42 | 18.35 | 0.002 | very strong | well inside the series | accepted |
| 2014-02-10 | 186.5 | 226.3 | 39.73 | increase | 21.3 | 18.43 | 0.002 | very strong | well inside the series | accepted |
| 2015-06-30 | 226.3 | 221.3 | -4.928 | decrease | -2.18 | 9.03 | 0.082 | moderate | well inside the series | accepted |
| 2017-02-08 | 221.3 | 310.6 | 89.32 | increase | 40.35 | 926.7 | 0.002 | very strong | well inside the series | accepted |
What this means
The 2013-04-22 break is the decisive one: it moved Close by 107.84 points with a likelihood-ratio statistic of 3212.49 (p = 0.002). The next two breaks, on 2014-02-07 and 2014-02-10, are smaller (49.80 and 39.73 points respectively) but equally significant (both p = 0.002). The 2015-06-30 break is a rare decrease of 4.93 points (p = 0.082, moderate evidence). The final break on 2017-02-08 is substantial at 89.32 points (p = 0.002). All breaks sit well inside the series—at least 242 points from either boundary—so both sides have adequate data. The p-values are optimistic because the break locations were chosen by searching this same data.
Data Table
The Levels Between Breaks
6 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 | 2010-06-29 | 2013-04-19 | 707 | 28.89 | 5.402 |
| Level 2 | 2013-04-22 | 2014-02-06 | 202 | 136.7 | 36.12 |
| Level 3 | 2014-02-07 | 2014-02-07 | 1 | 186.5 | — |
| Level 4 | 2014-02-10 | 2015-06-29 | 349 | 226.3 | 23.61 |
| Level 5 | 2015-06-30 | 2017-02-07 | 406 | 221.3 | 25.11 |
| Level 6 | 2017-02-08 | 2020-02-03 | 751 | 310.6 | 61.78 |
What this means
The 6 levels range from 1 to 751 points in length. Level 1 (707 points, average 28.89) is the longest early period; Level 6 (751 points, average 310.65) is the longest final period. Level 3 consists of just 1 point (186.53 on 2014-02-07), a consequence of two breaks falling 3 trading days apart. The within-level spreads are 5.40 (Level 1) to 61.78 (Level 6). The largest shift is 107.84, which exceeds the widest within-level scatter, indicating that the detected breaks are substantially larger than the noise inside each regime.
Data Table
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 Close. 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 Close, not a change in its slope or its variance. |
| Penalty | Modified BIC, 3 x log(2416) = 23.37. 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. 5 break(s) cleared it; the next-strongest candidate (2011-10-27) scored 480.18 and was rejected because the maximum of 5 break(s) had already been accepted. |
| Minimum segment | 121 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 — this cap was reached, so more breaks may exist. |
| 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 | CAUTION: the lag-1 residual autocorrelation around the step fit is 0.98, 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. |
| Trend caveat | A straight line through Close explains 79.25% of its variation, so the breaks below are not merely a staircase approximation of a smooth trend. |
| Edge caveat | A break within 242 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 Close 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. |
What this means
Binary segmentation scanned every admissible split of the cumulative sum, scored each with the Gaussian change-in-mean likelihood ratio, and accepted splits only when they improved fit by more than the modified-BIC penalty of 23.37 (equal to 3 × log(2416)). The method tests for changes in the level of Close, not changes in slope or volatility. Significance was assessed via permutation test (499 shuffles per break), comparing each break's statistic to the maximum statistic in its window. CRITICAL LIMITATION: lag-1 residual autocorrelation is 0.98, far above the 0.3 threshold, making the permutation p-values anti-conservative and enabling a slow wander to mimic a level shift. A linear trend explains 79.25% of the variation, so the breaks are not merely a staircase approximation of smooth drift. The method locates breaks; external evidence is required to explain why they occurred.
The exact source that produced this report — yours to keep, read, and re-run.
Download PDF
How this was computed
method · R source · citation
The code that did it
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
)
}Your data has more stories to tell.Run any analysis on your own data — validated R modules, interactive reports, AI insights, and PDF export. 500 free credits on signup.
Try Free — No SignupSign Up Free