Trend Test
Shows whether a series is really rising or falling rather than just moving around, by how much per period, and how certain the trend is.
RUN DATE · 14 September 2026
DATA · 24 rows
Is this weekly series trending upward, and how fast?
- SummaryThe change per period, the total change, and how certain the trend is.
- The series as recordedEvery value over time, before any line is drawn.
- The trend lineThe series with its underlying trend drawn through it.
- How certain the trend isThe likely range of the change per period.
- Consistency of the changeWhether the change points the same way across the whole series.
- Independence checkWhether each period's deviation echoes the one before it.
- Full resultsEvery figure behind the result, with what it means.
- What the results rely onEach condition the analysis depends on, and whether it holds.
- How it was doneThe method, the data used, and what to keep in mind.
Is it trending
Orders rise steadily across all weeks
Orders rise clearly and steadily from start to finish, supporting an upward trend.
The series begins near one hundred and climbs consistently to nearly two hundred, with each week higher than earlier weeks.
Orders rise steadily across all weeks
The orders series climbs throughout the entire period, moving from the lowest values early on to the highest values at the end. This upward movement is clear and unbroken, with no sustained dips or reversals. The straight line assumption holds, and the pattern shows a steady rather than stepped or seasonal movement. The strained independence check reflects the serial nature of weekly data but does not contradict the upward direction.
The series begins near one hundred and climbs consistently to nearly two hundred, with each week higher than earlier weeks.
Series follows steady upward trend
Weekly values rise clearly and consistently with the trend line, showing steady upward movement.
The actual series points cluster tightly around the Sen trend line as both climb together from January through June.
Series follows steady upward trend
On this card's data, the actual points fall on both sides of the trend line, so the series follows it rather than running above or ahead of it.
The actual series points cluster tightly around the Sen trend line as both climb together from January through June.
How sure we are
Orders rise steadily each week
Orders climb clearly each week, with tight confidence in the trend despite strained independence.
The estimate and interval both sit well above zero, showing consistent upward movement.
Orders rise steadily each week
The change per week estimate sits solidly above zero with a narrow interval around it, clearly excluding zero and indicating a real trend. The tightness of the interval relative to the estimate itself shows the trend is well defined. Independence of observations is strained, which slightly limits confidence in the interval's precision, but the linear model holds and tied values are few. Check whether the strained independence reflects genuine autocorrelation or clustering in the weekly data.
The estimate and interval both sit well above zero, showing consistent upward movement.
Upward trend clearly dominates across the series
Pairwise slopes cluster overwhelmingly positive, showing consistent upward movement throughout the weekly series.
The distribution concentrates heavily on the positive side, with most slopes clustered between two and four.
Upward trend clearly dominates across the series
Nearly all pairwise slopes sit well above zero, indicating the upward trend is robust and consistent across the series. The tight clustering around positive values, particularly in the three to four range, shows the change points the same way throughout. The few negative slopes at the left tail are vastly outnumbered by the positive mass. However, independent observations are strained, which limits confidence in the precision of the rate estimate.
The distribution concentrates heavily on the positive side, with most slopes clustered between two and four.
The numbers
Residuals alternate sign, test conservative
Residuals swing sharply from positive to negative, showing negative serial correlation that makes the trend test cautious.
The scatter tilts downward from upper left to lower right, showing a clear alternating pattern.
Residuals alternate sign, test conservative
The cloud of points tilts downward, with positive residuals paired to negative ones and vice versa across the sequence. This negative serial correlation is clear and consistent through the data. The strained independence assumption means the p-value errs toward caution, so a reported upward trend is conservative and trustworthy. Check whether the alternating pattern reflects real oscillation in the series or a misfit in the model.
The scatter tilts downward from upper left to lower right, showing a clear alternating pattern.
The numbers
Weekly series trends upward, clearly and steadily
The series rises steadily over the window, with a strong upward trend that is unlikely to be chance.
The lag-1 autocorrelation is strongly negative, so residuals alternate sharply about the trend line rather than clustering.
Weekly series trends upward, clearly and steadily
The Mann-Kendall z statistic and p-value mark the trend as clearly statistically significant. The Sen slope shows a consistent weekly gain that compounds to substantial total change across the window. The lag-1 autocorrelation is strongly negative, indicating residuals alternate sharply rather than cluster, which strains the independence assumption and makes the p-value conservative; the true significance may be even stronger. Check whether the alternating pattern reflects genuine oscillation in the process or measurement artifacts.
The lag-1 autocorrelation is strongly negative, so residuals alternate sharply about the trend line rather than clustering.
Assumptions and method
Checks: one strained, three hold
Strained: independent observations.
Holding: enough time points, a straight line describes it, few tied values.
Checks: one strained, three hold
Independent observations is strained: negative serial correlation makes the p-value conservative: it errs on the safe side. The other three hold.
Holding: enough time points, a straight line describes it, few tied values.
Mann-Kendall trend test (two-sided, tie-corrected variance, continuity-corrected normal approximation) with Sen's slope (the median of all 276 pairwise slopes) on orders ordered by week, 24 distinct time points from 24 rows (2026-01-05 to 2026-06-15, about one point per week). Only the mapped time and value columns are used, and the data carried no other columns. The 95% interval on the slope is the classical rank-based interval of the ordered pairwise slopes; the p-value tests the null of no monotonic trend. Lag-1 autocorrelation of the residuals from a straight-line fit is -0.937, below -0.3: values alternate about the line, so the p-value is conservative.
24 of 24 rows · week → orders
caveatAutocorrelation is strongly negative, making the p-value conservative and the trend confidence weaker than reported.
The analysis applied Mann-Kendall trend test with Sen's slope to weekly orders over twenty-four weeks. The lag-1 autocorrelation of residuals is negative and strong, which means values alternate about the fitted line rather than drift smoothly. This strained assumption makes the reported p-value conservative: a true effect may be harder to detect than the test suggests. The other assumptions held: enough time points exist, the data fit a straight line, and tied values are few. A reader relying on the p-value alone should check the slope interval next to see whether zero lies within it.
The code behind this report
The code that produced every figure in this report, exactly as it ran. Fingerprint ed5fab45744e8d39. The same code on the same data gives the same report.
`standard_trend_test_v2` <- function(pf) {
`%||%` <- function(a, b) if (!is.null(a)) a else b
#' Readable figures (LAT-3181, as LAT-3180): whole numbers from a thousand up, one decimal from a hundred, two from
#' one, three significant figures below one. A cell carries what the value needs, not what R prints.
tidy <- function(x) {
x <- as.numeric(x)
ifelse(is.na(x), NA_real_,
ifelse(abs(x) >= 1000, round(x, 0),
ifelse(abs(x) >= 100, round(x, 1),
ifelse(abs(x) >= 1, round(x, 2), signif(x, 3)))))
}
fmtn <- function(v) format(tidy(v), big.mark = ",", trim = TRUE, scientific = FALSE)
#' P-VALUES BELOW 0.0001 LEAVE AS A FLOOR (LAT-3181). The results serialize at four decimal digits, which rounds a p of
#' 1.4e-05 to 0 and 6e-05 up to 0.0001; a table printed "p-value 0". 1e-12 survives the serializer and the mapper shows
#' any p under 0.0001 as "<0.0001", which is what the reader should see. Table and tile cells only; the answer keeps p.
p_cell <- function(p) { p <- as.numeric(p); ifelse(is.na(p), NA_real_, ifelse(p < 1e-4, 1e-12, signif(p, 3))) }
inputs <- pf$taskList$inputs
params <- inputs$module_parameters %||% list()
# THE QUESTION this tool answers: the customer's objective, verbatim, when given.
question <- (inputs$userContext %||% list())$objective %||%
"Is this series really rising or falling over time, by how much per period, and how sure can we be?"
#' ## Column mapping
#' The customer maps a time column (`date`) and one numeric measure (`value`).
#' Semantic names are used inside; the customer's own headers are carried in
#' `col_map` so every axis, term and sentence names the columns the reader knows.
col_map <- inputs$column_mapping %||% list()
df <- renderObject.taskFunction.init(inputs, col_map) # df has SEMANTIC names
human <- function(sem) {
v <- col_map[[sem]]
if (is.null(v) || !nzchar(as.character(v))) sem else as.character(v)
}
date_name <- human("date"); value_name <- human("value")
if (!("date" %in% names(df)) || !("value" %in% names(df)))
stop(sprintf("Both a time column ('%s') and a numeric value column ('%s') must be mapped.", date_name, value_name))
n_in <- nrow(df)
#' ## The columns this tool did not look at
#' This tool maps exactly two slots, so everything else in the customer's file is
#' ignored, and the reader deserves their names rather than the phrase "every
#' other column". `renderObject.taskFunction.init` has already dropped them from
#' `df`, so they are read from the RAW rows still on `inputs` (a data.frame
#' locally, a list of row objects in production, under `dataset` or `df`). When
#' that raw shape cannot be read, the method says so instead of implying the
#' file had no other columns, which is a different and false claim.
raw_names <- local({
ds <- inputs$dataset %||% inputs$df
if (is.data.frame(ds)) return(names(ds))
if (is.list(ds) && length(ds) > 0) {
# a list of row objects (production): union the keys of the first rows, because
# a ragged row would otherwise hide a column
rows <- ds[seq_len(min(length(ds), 50))]
nm <- unique(unlist(lapply(rows, function(r) if (is.list(r)) names(r) else NULL)))
if (length(nm)) return(nm)
# a list of COLUMNS (the shape init turns into a data.frame directly)
if (!is.null(names(ds)) && all(nzchar(names(ds)))) return(names(ds))
}
character(0)
})
mapped_actual <- unique(as.character(unlist(col_map)))
ignored_cols <- setdiff(raw_names, unique(c(mapped_actual, make.names(mapped_actual))))
ignored_note <- if (!length(raw_names)) {
paste0("Only the mapped time and value columns are used; this run could not read the other column names from the ",
"data as it arrived, so none can be listed here.")
} else if (!length(ignored_cols)) {
paste0("Only the mapped time and value columns are used, and the data carried no other columns.")
} else {
paste0("Only the mapped time and value columns are used; the other ", length(ignored_cols),
" column", if (length(ignored_cols) > 1) "s" else "", " in the data ",
if (length(ignored_cols) > 1) "were" else "was", " ignored: ",
paste(utils::head(ignored_cols, 12), collapse = ", "),
if (length(ignored_cols) > 12) sprintf(" and %d more", length(ignored_cols) - 12) else "", ".")
}
#' ## Reading the time axis
#' Real dates first (the format that parses the most values wins, at least 80%
#' of non-blank entries must parse), else a sortable numeric index (95% numeric).
parse_dates <- function(v) {
s <- trimws(as.character(v)); s[is.na(s)] <- ""
fmts <- c("%Y-%m-%d", "%Y/%m/%d", "%m/%d/%Y", "%d/%m/%Y", "%Y%m%d", "%d-%m-%Y", "%m-%d-%Y",
"%b %d %Y", "%d %b %Y", "%B %d %Y", "%d %B %Y", "%Y-%m")
best <- rep(as.Date(NA), length(s)); best_n <- -1
for (f in fmts) {
ss <- if (f == "%Y-%m") ifelse(grepl("^[0-9]{4}-[0-9]{1,2}$", s), paste0(s, "-01"), NA) else sub("[T ].*$", "", s)
ff <- if (f == "%Y-%m") "%Y-%m-%d" else f
d <- suppressWarnings(as.Date(ss, format = ff))
if (sum(!is.na(d)) > best_n) { best <- d; best_n <- sum(!is.na(d)) }
}
best
}
raw_seq <- df$date
non_blank <- !(is.na(raw_seq) | !nzchar(trimws(as.character(raw_seq))))
n_nonblank <- sum(non_blank)
d <- parse_dates(raw_seq)
frac_dates <- if (n_nonblank > 0) sum(!is.na(d)) / n_nonblank else 0
numseq <- suppressWarnings(as.numeric(as.character(raw_seq)))
frac_num <- if (n_nonblank > 0) sum(!is.na(numseq)) / n_nonblank else 0
if (frac_dates >= 0.8) { t_raw <- as.numeric(d); seq_kind <- "date" }
else if (frac_num >= 0.95 && n_nonblank > 0) { t_raw <- numseq; seq_kind <- "numeric" }
else stop(sprintf("The '%s' column could not be read as dates or as a sortable numeric index; a trend test needs an orderable time axis.", date_name))
#' ## Data preparation
#' The value is coerced to numeric (95% rule). Rows with a blank or unreadable
#' time or value are excluded and counted by reason; duplicate time points are
#' averaged into one. At least 8 distinct time points with some variation are required.
mv <- df$value
if (!is.numeric(mv)) {
conv <- suppressWarnings(as.numeric(as.character(mv)))
n_orig <- sum(!is.na(mv) & nzchar(as.character(mv)))
if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) mv <- conv
else stop(sprintf("The '%s' column is not numeric; a trend test needs a numeric value to track.", value_name))
}
mv <- as.numeric(mv)
# is.finite, not !is.na: an Inf value survived every check here and then killed the run
# inside stats::lm with "NA/NaN/Inf in 'y'", an R internal message no customer can act on.
# A non-finite value is an excluded row like any other, and is counted and named as one.
bad_time <- !is.finite(t_raw); bad_value <- !bad_time & !is.finite(mv)
n_bad_time <- sum(bad_time); n_bad_value <- sum(bad_value)
keep <- !bad_time & !bad_value
t_kept <- t_raw[keep]; x_kept <- mv[keep]
ord <- order(t_kept); t_kept <- t_kept[ord]; x_kept <- x_kept[ord]
n_dup <- 0L
if (anyDuplicated(t_kept)) {
agg <- tapply(x_kept, t_kept, mean)
t_num <- as.numeric(names(agg)); x <- as.numeric(agg)
o2 <- order(t_num); t_num <- t_num[o2]; x <- x[o2]
n_dup <- length(t_kept) - length(x)
} else { t_num <- t_kept; x <- x_kept }
n_points <- length(x); n_used <- n_points
if (n_points < 8) stop(sprintf("Only %d usable time points of '%s' over '%s'; a trend test needs at least 8.", n_points, value_name, date_name))
if (isTRUE(max(x) == min(x))) stop(sprintf("'%s' has no variation across its %d time points, so there is no trend to test.", value_name, n_points))
#' ## The reporting period
gaps <- diff(t_num); step <- stats::median(gaps)
if (seq_kind == "date") {
period <- if (step <= 1.5) "day" else if (step >= 6 && step <= 8) "week" else if (step >= 13 && step <= 15) "fortnight"
else if (step >= 28 && step <= 31.5) "month" else if (step >= 84 && step <= 95) "quarter" else if (step >= 350 && step <= 380) "year"
else sprintf("%s-day period", format(round(step, 1)))
window <- sprintf("%s to %s", format(as.Date(min(t_num), origin = "1970-01-01")), format(as.Date(max(t_num), origin = "1970-01-01")))
} else { period <- "step"; window <- sprintf("%s to %s", format(min(t_num)), format(max(t_num))) }
#' ## Mann-Kendall: S, tie-corrected variance, continuity-corrected z, two-sided p
S <- 0
for (i in seq_len(n_points - 1)) S <- S + sum(sign(x[(i + 1):n_points] - x[i]))
tie_tab <- table(x); tie_sizes <- as.numeric(tie_tab[tie_tab > 1])
n_tie_groups <- length(tie_sizes)
varS <- (n_points * (n_points - 1) * (2 * n_points + 5) - sum(tie_sizes * (tie_sizes - 1) * (2 * tie_sizes + 5))) / 18
if (!is.finite(varS) || varS <= 0) stop(sprintf("'%s' has effectively no variation (all %d values tied); there is no trend to test.", value_name, n_points))
z_stat <- if (S > 0) (S - 1) / sqrt(varS) else if (S < 0) (S + 1) / sqrt(varS) else 0
p_value <- 2 * stats::pnorm(-abs(z_stat))
#' ## Sen's slope: the median of pairwise slopes, with its rank-based 95% interval
#' All n(n-1)/2 pairs when that is at most 5 000; otherwise a seeded sample of 5 000 pairs.
n_pairs <- n_points * (n_points - 1) / 2
sampled <- n_pairs > 5000
if (!sampled) {
ii <- rep(seq_len(n_points - 1), times = (n_points - 1):1)
jj <- unlist(lapply(seq_len(n_points - 1), function(i) (i + 1):n_points))
} else {
set.seed(42); ii <- integer(0); jj <- integer(0)
while (length(ii) < 5000) {
a <- sample.int(n_points, 8000, replace = TRUE); b <- sample.int(n_points, 8000, replace = TRUE); ok <- a < b
ii <- c(ii, a[ok]); jj <- c(jj, b[ok])
}
ii <- ii[1:5000]; jj <- jj[1:5000]
}
slopes <- (x[jj] - x[ii]) / (t_num[jj] - t_num[ii])
slopes <- sort(slopes[is.finite(slopes)])
n_pairs_used <- length(slopes)
sen_t <- stats::median(slopes)
C_alpha <- stats::qnorm(0.975) * sqrt(varS)
p_lo <- min(max(((n_pairs - C_alpha) / 2) / n_pairs, 1 / n_pairs_used), 1)
p_hi <- min(max(((n_pairs + C_alpha) / 2 + 1) / n_pairs, 1 / n_pairs_used), 1)
ci_t <- as.numeric(stats::quantile(slopes, probs = c(p_lo, p_hi), type = 1, names = FALSE))
sen_period <- sen_t * step; ci_lo <- ci_t[1] * step; ci_hi <- ci_t[2] * step
intercept <- stats::median(x - sen_t * t_num)
span_t <- max(t_num) - min(t_num)
total_change <- sen_t * span_t
start_level <- intercept + sen_t * min(t_num)
pct_change <- if (is.finite(start_level) && abs(start_level) > 1e-12) 100 * total_change / abs(start_level) else NA_real_
#' ## Serial correlation: lag-1 autocorrelation of the residuals from a straight-line fit
fit <- stats::lm(x ~ t_num); e <- stats::residuals(fit); em <- mean(e)
r1 <- sum((e[-n_points] - em) * (e[-1] - em)) / sum((e - em)^2)
#' THE SIGN DECIDES WHAT SERIAL CORRELATION DOES (LAT-3181). Positive correlation shrinks the effective sample and
#' makes the p-value optimistic; negative correlation (values alternating about the line) makes the test
#' conservative. The check read |r1| and told a reader a lag-1 of -0.937 made the p-value optimistic.
autocorr_optimistic <- is.finite(r1) && r1 > 0.3
autocorr_conservative <- is.finite(r1) && r1 < -0.3
autocorr_flag <- autocorr_optimistic
# short on purpose: it is a table cell, and a longer one pushed the last row of the full results onto a page of its own
autocorr_text <- if (autocorr_optimistic) "above 0.3: values echo the one before, so the p-value is optimistic" else
if (autocorr_conservative) "below -0.3: values alternate about the line, so the p-value is conservative" else
"between -0.3 and 0.3: the p-value can be read at face value"
#' ## Verdict
significant <- is.finite(p_value) && p_value < 0.05
direction <- if (S > 0) "rising" else if (S < 0) "falling" else "flat"
verdict <- if (!significant) "no clear trend" else direction
#' ## Frames for the places (series sampled to at most 1 000 points, first and last kept)
set.seed(42)
keep_idx <- if (n_points <= 1000) seq_len(n_points) else sort(unique(c(1L, n_points, sample(2:(n_points - 1), 998))))
period_chr <- if (seq_kind == "date") format(as.Date(t_num[keep_idx], origin = "1970-01-01")) else as.character(t_num[keep_idx])
observed <- data.frame(a = period_chr, b = round(x[keep_idx], 4), stringsAsFactors = FALSE)
names(observed) <- c(date_name, value_name)
obs_cols <- c(date_name, value_name)
fitted_line <- intercept + sen_t * t_num[keep_idx]
fit_df <- rbind(data.frame(period = period_chr, value = round(x[keep_idx], 4), series = "Actual", stringsAsFactors = FALSE),
data.frame(period = period_chr, value = tidy(fitted_line), series = "Sen trend", stringsAsFactors = FALSE))
set.seed(42)
sl_idx <- if (n_pairs_used <= 1000) seq_len(n_pairs_used) else sort(sample(n_pairs_used, 1000))
slopes_df <- data.frame(slope_per_period = tidy(slopes[sl_idx] * step))
set.seed(42)
res_idx <- if (n_points - 1 <= 1000) seq_len(n_points - 1) else sort(sample(n_points - 1, 1000))
resid_df <- data.frame(residual_previous = tidy(e[res_idx]), residual = tidy(e[res_idx + 1]))
#' ONE SCALE PER CHART (LAT-3181). The slope per period (3.6) and the total change over the window (83) shared an
#' axis, so the slope drew as a dot. The chart carries the change per period; the total is in the table and tiles.
int_df <- data.frame(term = sprintf("Change per %s", period), estimate = tidy(sen_period),
low = tidy(ci_lo), high = tidy(ci_hi), stringsAsFactors = FALSE)
fmt <- function(v, d = 3) format(round(v, d), nsmall = d, big.mark = ",", trim = TRUE)
fmt_p <- function(p) if (p < 1e-4) "< 0.0001" else fmt(p, 4)
test_df <- data.frame(
statistic = c("Mann-Kendall S", "Variance of S (tie-corrected)", "z statistic (continuity-corrected)", "Two-sided p-value",
"Tied value groups", "Time points tested", sprintf("Sen slope per %s", period), "95% interval for the slope",
"Implied total change over the window", "Implied change as % of the starting level", "Observed window",
"Lag-1 autocorrelation of residuals"),
value = c(fmt(S, 0), fmt(varS, 1), fmt(z_stat, 3), fmt_p(p_value), sprintf("%d", n_tie_groups), sprintf("%d", n_points),
fmtn(sen_period), sprintf("%s to %s", fmtn(ci_lo), fmtn(ci_hi)), fmtn(total_change),
if (is.na(pct_change)) "n/a (starting level near zero)" else sprintf("%s%%", fmt(pct_change, 1)), window, fmt(r1, 3)),
detail = c(sprintf("Concordant minus discordant pairs; positive means %s tends to rise over %s", value_name, date_name),
sprintf("Null-hypothesis variance of S, reduced for %d group(s) of tied values", n_tie_groups),
"S standardised by its null variance with the +/-1 continuity correction",
if (significant) sprintf("Below 0.05: the %s trend is unlikely to be chance", direction) else "At or above 0.05: the ordering is consistent with noise",
if (n_tie_groups > 0) "Repeated values carry no ordering information" else "No repeated values; the full ordering was used",
sprintf("Distinct time points of %s after cleaning", value_name),
sprintf("Median of %s pairwise slopes%s, in units of %s per %s", format(n_pairs_used, big.mark = ","),
if (sampled) sprintf(" (a seeded sample of the %s pairs)", format(n_pairs, big.mark = ",")) else "", value_name, period),
"Classical rank-based interval from the ordered pairwise slopes",
sprintf("The Sen slope carried across the window, in units of %s", value_name),
if (is.na(pct_change)) "The trend line starts near zero, so a percentage is not meaningful" else sprintf("Relative to the trend line's starting level of %s", fmtn(start_level)),
sprintf("The span of %s covered", date_name),
paste0(toupper(substring(autocorr_text, 1, 1)), substring(autocorr_text, 2))),
stringsAsFactors = FALSE)
#' ## Method text and the answer
excluded_rows <- c(if (n_bad_value > 0) sprintf("%d row%s with a blank, non-numeric or non-finite %s", n_bad_value, if (n_bad_value > 1) "s" else "", value_name),
if (n_bad_time > 0) sprintf("%d row%s with an unreadable %s", n_bad_time, if (n_bad_time > 1) "s" else "", date_name),
if (n_dup > 0) sprintf("%d duplicate time point%s averaged into one", n_dup, if (n_dup > 1) "s" else ""))
method <- paste0(
"Mann-Kendall trend test (two-sided, tie-corrected variance, continuity-corrected normal approximation) with Sen's slope ",
"(the median of ", if (sampled) "a seeded sample of 5,000 of the " else "all ", format(n_pairs, big.mark = ","), " pairwise slopes) ",
"on ", value_name, " ordered by ", date_name, ", ", n_points, " distinct time points from ", n_in, " rows (", window,
if (seq_kind == "date") paste0(", about one point per ", period, ")") else ")",
if (length(excluded_rows)) paste0("; excluded: ", paste(excluded_rows, collapse = ", ")) else "",
". ", ignored_note, " ",
"The 95% interval on the slope is the classical rank-based interval of the ordered pairwise slopes; the p-value tests the null of no monotonic trend. ",
"Lag-1 autocorrelation of the residuals from a straight-line fit is ", fmt(r1, 3), ", ", autocorr_text, ".")
statement <- if (significant)
sprintf("%s is %s by %s per %s (95%% interval %s to %s; Mann-Kendall p %s, n = %d), a total change of %s over %s",
value_name, direction, fmtn(sen_period), period, fmtn(ci_lo), fmtn(ci_hi),
if (p_value < 1e-4) "< 0.0001" else paste0("= ", fmt(p_value, 4)), n_points, fmtn(total_change), window)
else sprintf("%s shows no clear trend over %s (Sen slope %s per %s, 95%% interval %s to %s spans zero or Mann-Kendall p = %s, n = %d)",
value_name, window, fmtn(sen_period), period, fmtn(ci_lo), fmtn(ci_hi), fmt(p_value, 4), n_points)
answer <- list(verdict = verdict, direction = direction, significant = significant, sen_slope_per_period = round(sen_period, 4),
period = period, slope_low = round(ci_lo, 4), slope_high = round(ci_hi, 4), mann_kendall_S = S,
z = round(z_stat, 4), p_value = signif(p_value, 3), total_change = round(total_change, 4),
pct_change = if (is.na(pct_change)) NULL else round(pct_change, 2), lag1_autocorrelation = round(r1, 4),
autocorrelation_caution = autocorr_flag, autocorrelation_conservative = autocorr_conservative, n = n_points)
# ── Results: one entry per place. Row-bearing places are constructor calls (the
# columns are derived from the frame, the roles are named); the three
# value-bearing places carry an explicit value_order. ──
#' ## Summary metrics and assumption checks (LAT-3138): the figures that summarise the
#' whole analysis as one metrics row, and one verdict per assumption of the method,
#' each with the statistic behind it. holds / strained / violated are rules of thumb a
#' reader can re-derive from the statistic shown beside them. Base R throughout.
verdict_p <- function(p, soft = 0.05, hard = 0.001) if (is.na(p)) "unknown" else if (p >= soft) "holds" else if (p >= hard) "strained" else "violated"
fmt_p <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else as.character(signif(p, 3))
summary_vals <- list(sen_slope_per_period = tidy(sen_period), p_value = p_cell(p_value), total_change = tidy(total_change),
pct_change = if (is.null(pct_change) || is.na(pct_change)) NA_real_ else round(pct_change, 1),
lag1_autocorrelation = round(r1, 2), n = n_points)
tt <- seq_along(x)
curve_p <- tryCatch({ m1 <- lm(x ~ tt); m2 <- lm(x ~ tt + I(tt^2)); anova(m1, m2)[["Pr(>F)"]][2] }, error = function(err) NA_real_)
tie_share <- sum(duplicated(x)) / n_points
checks_df <- data.frame(
check = c("Independent observations", "Enough time points", "A straight line describes it", "Few tied values"),
statistic = c(paste0("lag-1 autocorrelation = ", round(r1, 2)), paste0(n_points, " time points"),
"a squared time term added to the straight-line fit", paste0(round(100 * tie_share, 1), "% of values tied")),
p_value = c("", "", fmt_p(curve_p), ""),
verdict = c(if (!is.finite(r1)) "unknown" else if (r1 >= 0.6) "violated" else if (r1 >= 0.3 || r1 <= -0.3) "strained" else "holds",
if (n_points >= 20) "holds" else if (n_points >= 10) "strained" else "violated",
verdict_p(curve_p),
if (tie_share < 0.1) "holds" else if (tie_share < 0.3) "strained" else "violated"),
note = c(if (autocorr_conservative) "negative serial correlation makes the p-value conservative: it errs on the safe side" else
"positive serial correlation shrinks the effective sample and makes the p-value optimistic",
"few points make the slope interval wide",
"a curve means the single slope per period understates or overstates parts of the window",
"many ties weaken the rank-based test"),
stringsAsFactors = FALSE)
results <- list()
#' The verdict and the headline are NOT places of a library tool (LAT-3130): a
#' library tool supplies data objects; the answer is written by the last mile,
#' which is the first stage that reads the objects together.
#' ## summary_metrics: the whole analysis at a glance (LAT-3138)
results$summary_metrics <- place_metric(summary_vals, lead = "sen_slope_per_period", place = "summary_metrics")
#' ## assumption_checks: a verdict per assumption (a `checks` place, table-shaped)
results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
#' ## slope_interval: how sure, the slope per period and the total change with their 95% intervals
results$slope_interval <- place_interval(int_df, term = "term", value = "estimate", low = "low", high = "high",
place = "slope_interval")
#' ## observed_series: the customer's own series, drawn on the customer's own columns
results$observed_series <- place_trend(observed, x = obs_cols[1], y = obs_cols[2], draws = "dataset",
place = "observed_series")
#' ## trend_fit: the series with the Sen trend line overlaid
results$trend_fit <- place_trend(fit_df, x = "period", y = "value", series = "series", place = "trend_fit")
#' ## pairwise_slopes: the spread of pairwise slopes the Sen estimate is the median of
results$pairwise_slopes <- place_distribution(slopes_df, x = "slope_per_period", place = "pairwise_slopes")
#' ## autocorrelation_check: each residual against the one before it
results$autocorrelation_check <- place_relationship(resid_df, x = "residual_previous", y = "residual",
place = "autocorrelation_check")
#' ## test_table: every statistic with its value and what it means
results$test_table <- place_table(test_df, place = "test_table")
#' ## trend_method: how it was done
results$trend_method <- list(kind = "metric", values = list(
method = method, n_in = n_in, n_used = n_used,
excluded = as.list(excluded_rows),
# LAT-3181: the method card's "rows · x → y" line reads these; unset, it printed a bare arrow
x_column = date_name, y_column = value_name,
assumptions = list(
"Mann-Kendall tests for a MONOTONIC trend using only the ordering of the values; a rise then fall can score as no trend.",
"The p-value assumes independent observations; positive serial correlation makes it optimistic and negative serial correlation makes it conservative (the lag-1 check above says which applies).",
"Sen's slope is a straight-line rate in the value's own units per period; it does not describe curvature or seasonality.",
"Duplicate time points were averaged; a series with many repeats per period is better aggregated first.",
"A trend describes the window observed; it is not a forecast.")))
objects <- list() # filled by the object layer, not here
list(answer = answer, method = method, n = n_used, results = results, objects = objects,
json_output = list(answer = answer, method = method, n = n_used))
}