Survival Analysis

The code that produced every figure in this report, exactly as it ran. Fingerprint 7adb926250e5cbd1. The same code on the same data gives the same report.

`standard_survival_v2` <- function(pf) {
  `%||%` <- function(a, b) if (!is.null(a)) a else b
  #' Readable figures (LAT-3181): 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)))))
  }
  #' A p-value of exactly 0 is double-precision underflow, not certainty.
  P_FLOOR <- 2e-16
  p_out <- function(p) { p <- as.numeric(p); ifelse(is.na(p), NA_real_, ifelse(p < P_FLOOR, P_FLOOR, signif(p, 4))) }
  p_text <- function(p) if (is.na(p)) "could not be computed" else if (p < P_FLOOR) "< 2e-16" else paste0("= ", format(signif(p, 3)))
  #' P-VALUES BELOW 0.0001 LEAVE AS A FLOOR (LAT-3181): results serialize at four decimal digits, so 1.4e-05 would
  #' arrive as 0. 1e-12 survives and the mapper shows any p under 0.0001 as "<0.0001". Table cells only.
  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 %||%
    "How long until the event happens, and does the time differ between groups?"

  #' ## Column mapping
  #' The customer maps a numeric `time`, an `event` and optionally a `group`. Every other column of the file is
  #' excluded by construction and named as such in the method.
  col_map <- inputs$column_mapping %||% list()
  raw <- inputs$dataset
  raw_names <- if (is.data.frame(raw)) names(raw) else if (is.list(raw) && length(raw)) names(raw[[1]]) else character(0)
  unmapped <- setdiff(raw_names, as.character(unlist(col_map)))
  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) }
  time_name <- human("time"); event_name <- human("event"); group_name <- human("group")

  #' ## Parameters
  max_groups <- suppressWarnings(as.integer(params$max_groups %||% 6L))
  if (is.na(max_groups) || max_groups < 2 || max_groups > 8) stop("module_parameters$max_groups must be an integer between 2 and 8")
  unit <- trimws(as.character(params$time_unit %||% ""))
  u1 <- if (nzchar(unit)) sub("s$", "", unit) else "unit"          # one of them
  uN <- if (nzchar(unit)) unit else "units"                        # many of them
  fmt_t <- function(x) if (is.na(x)) "could not be reached" else paste(format(tidy(x)), uN)

  #' ## Reading time and the event
  n_in <- nrow(df)
  if (!"time" %in% names(df)) stop("column_mapping must map a 'time' column: how long each row lasted before the event, or before it was last seen")
  if (!"event" %in% names(df)) stop("column_mapping must map an 'event' column: whether the event happened for that row")
  tv <- df$time
  if (!is.numeric(tv)) {
    ch <- as.character(tv); nb <- !is.na(ch) & trimws(ch) != ""; conv <- suppressWarnings(as.numeric(ch))
    if (sum(nb) == 0 || sum(!is.na(conv[nb])) < 0.95 * sum(nb))
      stop(sprintf("The time column '%s' is not numeric: fewer than 95%% of its values parse as numbers. It must be a DURATION (how long each row lasted), not a date.", time_name))
    tv <- conv
  }
  tv <- as.numeric(tv)

  #' The event is 1/0, TRUE/FALSE, or text. A row where the event has NOT happened is not missing data: it is
  #' counted for the time it lasted (right-censored), which is the whole point of survival analysis.
  ev_raw <- df$event
  EVENT_WORDS <- c("1", "true", "t", "yes", "y", "event", "churn", "churned", "cancelled", "canceled", "failed",
                   "fail", "failure", "dead", "death", "died", "relapse", "relapsed", "left", "lost", "converted", "closed")
  CENSOR_WORDS <- c("0", "false", "f", "no", "n", "none", "censored", "censor", "active", "alive", "working", "ok",
                    "retained", "stayed", "still active", "running", "open", "survived", "current")
  ev <- rep(NA_real_, length(ev_raw)); ev_read <- ""
  if (is.logical(ev_raw)) { ev <- as.numeric(ev_raw); ev_read <- "TRUE or FALSE"
  } else {
    num <- suppressWarnings(as.numeric(as.character(ev_raw)))
    vals <- sort(unique(num[!is.na(num)]))
    if (sum(!is.na(num)) >= 0.95 * sum(!is.na(ev_raw) & trimws(as.character(ev_raw)) != "") && length(vals) && all(vals %in% c(0, 1))) {
      ev <- num; ev_read <- "1 for the event and 0 for a row still going"
    } else {
      ch <- tolower(trimws(as.character(ev_raw)))
      hit_e <- ch %in% EVENT_WORDS; hit_c <- ch %in% CENSOR_WORDS
      if (!any(hit_e)) {
        seen <- paste(utils::head(unique(as.character(ev_raw)[!is.na(ev_raw)]), 6), collapse = ", ")
        stop(sprintf("The event column '%s' could not be read as whether the event happened. It carries: %s. Use 1 and 0, TRUE and FALSE, or words such as churned and active.", event_name, seen))
      }
      ev[hit_e] <- 1; ev[hit_c] <- 0
      ev_read <- sprintf("text (%s read as the event, %s as still going)",
                         paste(unique(ch[hit_e]), collapse = "/"), if (any(hit_c)) paste(unique(ch[hit_c]), collapse = "/") else "everything else")
      ev[is.na(ev) & !is.na(ch) & nzchar(ch)] <- 0
    }
  }

  keep <- !is.na(tv) & !is.na(ev) & tv >= 0
  n_bad <- sum(!keep)
  t_ok <- tv[keep]; e_ok <- ev[keep]
  #' ## The group column, when there is one
  g_ok <- NULL; dropped_groups <- character(0); lumped <- character(0)
  if ("group" %in% names(df)) {
    g <- as.character(df$group)[keep]
    g[is.na(g) | trimws(g) == ""] <- "Missing"
    tabn <- table(g)
    if (length(tabn) > max_groups) {
      lumped <- setdiff(names(tabn), names(sort(tabn, decreasing = TRUE))[seq_len(max_groups)])
      g[g %in% lumped] <- "Other"
    }
    #' a group with no events carries no survival curve worth testing, and one with fewer than 5 rows carries no
    #' interval: both are dropped and NAMED rather than left to distort the comparison
    tabn <- table(g); ev_by <- tapply(e_ok, g, sum)
    bad <- union(names(tabn)[tabn < 5], names(ev_by)[is.na(ev_by) | ev_by < 1])
    if (length(bad)) {
      dropped_groups <- paste0(bad, " (n = ", as.integer(tabn[bad]), ", events = ", as.integer(ev_by[bad] %||% 0), ")")
      sel <- !(g %in% bad); t_ok <- t_ok[sel]; e_ok <- e_ok[sel]; g <- g[sel]
    }
    #' The reference every hazard ratio is read against is the LARGEST group, not whichever name sorts first:
    #' an alphabetical reference is arbitrary and can be the smallest, least certain curve on the page.
    if (length(unique(g)) >= 2) g_ok <- stats::relevel(factor(g), ref = names(which.max(table(g))))
  }
  n_used <- length(t_ok); n_events <- sum(e_ok == 1); n_censored <- n_used - n_events
  if (n_used < 20) stop(sprintf("Only %d rows have a readable time and event; survival analysis needs at least 20.", n_used))
  if (n_events < 5) stop(sprintf("Only %d rows had the event in '%s'; at least 5 are needed to fit a survival curve.", n_events, event_name))
  if (all(e_ok == 1)) message("every row had the event: nothing is censored, which is legal but unusual for this analysis")

  sv <- survival::Surv(t_ok, e_ok)
  grouped <- !is.null(g_ok)
  k <- if (grouped) nlevels(g_ok) else 1L
  tmax <- max(t_ok)

  #' ## Kaplan-Meier, the curve and the life table
  fit <- if (grouped) survival::survfit(sv ~ g_ok, conf.type = "log-log") else survival::survfit(sv ~ 1, conf.type = "log-log")
  grid <- unique(sort(c(0, seq(0, tmax, length.out = 40))))
  sg <- summary(fit, times = grid, extend = TRUE)
  if (grouped) {
    curve_df <- data.frame(time = tidy(sg$time), survival_pct = tidy(100 * sg$surv),
                           series = sub("^g_ok=", "", as.character(sg$strata)), stringsAsFactors = FALSE)
  } else {
    curve_df <- data.frame(time = tidy(rep(sg$time, 3)), survival_pct = tidy(100 * c(sg$surv, sg$lower, sg$upper)),
                           series = rep(c("All rows", "Lower 95%", "Upper 95%"), each = length(sg$time)), stringsAsFactors = FALSE)
  }
  curve_df <- curve_df[!is.na(curve_df$survival_pct), , drop = FALSE]
  names(curve_df)[1:2] <- c("time", "survival_pct")

  cps <- pretty(c(0, tmax), n = 6); cps <- cps[cps > 0 & cps <= tmax]
  fit1 <- survival::survfit(sv ~ 1, conf.type = "log-log")
  sc <- summary(fit1, times = cps, extend = TRUE)
  life_df <- data.frame(time = tidy(sc$time), survival_pct = tidy(100 * sc$surv), low = tidy(100 * sc$lower),
                        high = tidy(100 * sc$upper), at_risk = as.integer(sc$n.risk),
                        events = as.integer(cumsum(sc$n.event)), stringsAsFactors = FALSE)

  #' ## Median time to the event, overall and per group
  tab1 <- summary(fit1)$table
  med_all <- unname(tab1["median"]); med_lo <- unname(tab1["0.95LCL"]); med_hi <- unname(tab1["0.95UCL"])
  med_df <- NULL
  if (grouped) {
    tb <- summary(fit)$table
    med_df <- data.frame(group = sub("^g_ok=", "", rownames(tb)), median = tidy(tb[, "median"]),
                         low = tidy(tb[, "0.95LCL"]), high = tidy(tb[, "0.95UCL"]), stringsAsFactors = FALSE)
    rownames(med_df) <- NULL
    #' A median that was never reached means MORE than half the group is still going: that group outlasts every
    #' group with a median, so it sorts FIRST. order(-median) puts NA last and the answer then read "longest first"
    #' over a list that began with the shortest-lived group (live run on Telco, 2026-09-15).
    #' Groups that never reached a median are TIED on the median and must not be ordered by name: printing "One year,
    #' Two year" says the first lasts longer, and on Telco it does not (live run, 2026-09-15). They are ordered by the
    #' share of each still going at the end of the window, which is what "lasts longer" means when no median exists.
    s_last <- vapply(levels(g_ok), function(l) {
      ok <- g_ok == l
      utils::tail(summary(survival::survfit(survival::Surv(t_ok[ok], e_ok[ok]) ~ 1), times = tmax, extend = TRUE)$surv, 1)
    }, numeric(1))
    med_df$still_going_at_end <- tidy(100 * unname(s_last[med_df$group]))
    med_df <- med_df[order(!is.na(med_df$median), -med_df$median, -med_df$still_going_at_end), , drop = FALSE]
    med_df$still_going_at_end <- NULL
  }

  #' ## Log-rank across groups, and Cox proportional hazards against the first group
  lr_chi <- NA_real_; lr_p <- NA_real_; cox <- NULL; hr_df <- NULL; cox_p <- NA_real_; zph_p <- NA_real_
  if (grouped) {
    sd <- tryCatch(survival::survdiff(sv ~ g_ok), error = function(e) NULL)
    if (!is.null(sd)) { lr_chi <- sd$chisq; lr_p <- stats::pchisq(lr_chi, k - 1, lower.tail = FALSE) }
    cox <- tryCatch(survival::coxph(sv ~ g_ok), error = function(e) NULL)
    if (!is.null(cox)) {
      cs <- summary(cox)
      ref <- levels(g_ok)[1]
      #' A RATIO CANNOT SHARE A SCALE WITH ANYTHING ELSE (LAT-3180/3181): the chart is the LOG hazard ratio, where 0
      #' is no difference; the plain ratio rides in the row so the reader still sees it.
      hr_df <- data.frame(term = paste0(sub("^g_ok", "", rownames(cs$coefficients)), " vs ", ref),
                          log_hazard_ratio = tidy(cs$coefficients[, "coef"]),
                          low = tidy(log(cs$conf.int[, "lower .95"])), high = tidy(log(cs$conf.int[, "upper .95"])),
                          hazard_ratio = tidy(cs$conf.int[, "exp(coef)"]),
                          p_value = p_cell(cs$coefficients[, "Pr(>|z|)"]), stringsAsFactors = FALSE)
      rownames(hr_df) <- NULL
      cox_p <- unname(cs$logtest["pvalue"])
      zph <- tryCatch(survival::cox.zph(cox), error = function(e) NULL)
      if (!is.null(zph)) zph_p <- unname(zph$table[nrow(zph$table), "p"])
    }
  }

  #' ## Weibull accelerated failure time: the failure pattern, the hazard curve and the life figures.
  #' The image carries `survival` and not `flexsurv`, so this is survreg: shape k = 1/fit$scale, scale lambda =
  #' exp(intercept), hazard h(t) = (k/lambda) (t/lambda)^(k-1).
  #' survreg refuses a time of 0, and a file that records "still in its first period" as 0 is ordinary (Telco's
  #' tenure does). The Weibull half is fitted on the POSITIVE times and SAYS how many rows that left out; the
  #' Kaplan-Meier curve, the medians and the log-rank test still use every row.
  pos <- t_ok > 0
  n_zero_time <- sum(!pos)
  wb <- if (sum(pos) >= 10 && sum(e_ok[pos] == 1) >= 5)
    tryCatch(survival::survreg(survival::Surv(t_ok[pos], e_ok[pos]) ~ 1, dist = "weibull"), error = function(e) NULL) else NULL
  haz_df <- NULL; shape <- NA_real_; lambda <- NA_real_; b10 <- NA_real_; med_life <- NA_real_; mean_life <- NA_real_
  fit_gap <- NA_real_; failure_mode <- "could not be fitted"
  if (!is.null(wb)) {
    shape <- 1 / wb$scale; lambda <- unname(exp(stats::coef(wb)[1]))
    b10 <- lambda * (-log(0.9))^(1 / shape); med_life <- lambda * log(2)^(1 / shape)
    mean_life <- lambda * gamma(1 + 1 / shape)
    ht <- seq(max(tmax / 200, 1e-6), tmax, length.out = 40)
    haz_df <- data.frame(time = tidy(ht), hazard = tidy((shape / lambda) * (ht / lambda)^(shape - 1)), stringsAsFactors = FALSE)
    #' how well the fitted curve tracks the observed one: the largest gap in survival, in points
    s_obs <- summary(fit1, times = ht, extend = TRUE)$surv
    fit_gap <- 100 * max(abs(s_obs - exp(-(ht / lambda)^shape)), na.rm = TRUE)
    failure_mode <- if (shape > 1.15) "wear-out: the event gets more likely the longer a row lasts" else
      if (shape < 0.85) "early-life: the event is most likely early on, and survivors settle down" else
      "constant: the event arrives at a steady rate whatever the age"
  }

  #' ## Every test and fitted figure, in one table. The rows are in DIFFERENT UNITS, which is why this is a table
  #' and not a chart (LAT-3180).
  test_rows <- list()
  add_test <- function(test, statistic, p, estimate, note)
    test_rows[[length(test_rows) + 1]] <<- data.frame(test = test, statistic = if (is.na(statistic)) NA_real_ else tidy(statistic),
      p_value = if (is.na(p)) NA_real_ else p_cell(p), estimate = estimate, note = note, stringsAsFactors = FALSE)
  if (grouped) {
    add_test(sprintf("Log-rank across %d groups", k), lr_chi, lr_p, sprintf("chi-square, %d df", k - 1),
             "whether the survival curves differ at all")
    if (!is.null(cox)) {
      top <- hr_df[which.max(abs(hr_df$log_hazard_ratio)), ]
      add_test("Cox proportional hazards", unname(summary(cox)$logtest["test"]), cox_p,
               sprintf("largest hazard ratio %s (%s)", format(top$hazard_ratio), top$term),
               sprintf("the rate the event arrives at, against %s", levels(g_ok)[1]))
      if (!is.na(zph_p)) add_test("Proportional hazards (cox.zph)", unname(survival::cox.zph(cox)$table[nrow(survival::cox.zph(cox)$table), "chisq"]), zph_p,
               "global test", "a small p-value means the hazard ratio itself changes over time")
    }
  }
  if (!is.null(wb)) {
    add_test("Weibull shape", shape, NA_real_, failure_mode, "above 1 is wear-out, below 1 is early-life, 1 is a constant rate")
    add_test("Weibull scale", lambda, NA_real_, sprintf("%s to the 63rd percentile", fmt_t(lambda)), "the characteristic life of the fitted curve")
    add_test("B10 life", b10, NA_real_, fmt_t(b10), "the time by which one row in ten has had the event")
    add_test("Weibull median life", med_life, NA_real_, fmt_t(med_life), "the fitted time by which half have had the event")
    add_test("Weibull mean life", mean_life, NA_real_, fmt_t(mean_life), "the fitted average time to the event")
  }
  tests_df <- do.call(rbind, test_rows)

  #' ## Assumption checks (LAT-3138)
  cens_share <- n_censored / n_used
  min_group <- if (grouped) min(as.integer(table(g_ok))) else NA_integer_
  checks_df <- data.frame(
    check = c("Enough events", "Rows still going are recorded", "Compared groups large enough",
              "Proportional hazards", "The Weibull curve fits", "Rows complete"),
    statistic = c(sprintf("%d events in %d rows", n_events, n_used),
                  sprintf("%s%% still going at the end", format(tidy(100 * cens_share))),
                  if (is.na(min_group)) "no group column, one overall curve" else sprintf("smallest group: %d rows", min_group),
                  if (is.na(zph_p)) "not tested without groups" else "cox.zph global test",
                  if (is.na(fit_gap)) "no Weibull fit" else sprintf("largest gap to the observed curve: %s points", format(tidy(fit_gap))),
                  sprintf("%d of %d rows excluded", n_bad, n_in)),
    p_value = c(NA_real_, NA_real_, NA_real_, if (is.na(zph_p)) NA_real_ else p_cell(zph_p), NA_real_, NA_real_),
    verdict = c(if (n_events >= 30) "holds" else if (n_events >= 10) "strained" else "violated",
                if (cens_share == 0) "strained" else if (cens_share > 0.9) "strained" else "holds",
                if (is.na(min_group)) "holds" else if (min_group >= 30) "holds" else if (min_group >= 10) "strained" else "violated",
                if (is.na(zph_p)) "holds" else if (zph_p >= 0.05) "holds" else if (zph_p >= 0.01) "strained" else "violated",
                if (is.na(fit_gap)) "strained" else if (fit_gap <= 5) "holds" else if (fit_gap <= 10) "strained" else "violated",
                if (n_in == 0 || n_bad / n_in <= 0.05) "holds" else if (n_bad / n_in <= 0.15) "strained" else "violated"),
    note = c("few events make the curve and every comparison uncertain",
             "a file with nothing still going usually leaves out the rows that have not had the event, which shortens every estimate",
             "a small group's curve swings on a few rows",
             "when the hazard ratio changes over time, one ratio understates the difference in some stretches",
             "a poor fit means the Weibull life figures should be read as rough; the Kaplan-Meier curve does not depend on it",
             "rows whose time or event could not be read are left out"),
    stringsAsFactors = FALSE)

  #' ## Method, assumptions, answer
  excluded <- character(0)
  if (n_bad > 0) excluded <- c(excluded, sprintf("%d row%s with an unreadable time or event", n_bad, if (n_bad > 1) "s" else ""))
  if (length(dropped_groups)) excluded <- c(excluded, paste0("groups too small or with no events: ", paste(dropped_groups, collapse = ", ")))
  if (length(lumped)) excluded <- c(excluded, sprintf("%d smaller group%s folded into Other", length(lumped), if (length(lumped) > 1) "s" else ""))
  if (length(unmapped)) excluded <- c(excluded, sprintf("columns not used by this analysis: %s", paste(unmapped, collapse = ", ")))
  method <- paste0(
    "Survival analysis of ", n_used, " rows (", n_events, " events, ", n_censored, " still going at the end and counted for the time they lasted, right-censored): ",
    "time from '", time_name, "' in ", uN, ", the event from '", event_name, "' read as ", ev_read,
    "; Kaplan-Meier curves with log-log 95% intervals",
    if (grouped) paste0(" by '", group_name, "' (", k, " groups), compared with the log-rank test and Cox proportional hazards against ", levels(g_ok)[1],
                        " (the largest group), with proportional hazards checked by cox.zph") else " over all rows",
    if (!is.null(wb)) paste0("; a Weibull accelerated failure time fit (survreg) over the ", n_used - n_zero_time, " rows with a time above 0 gives shape ",
                             format(tidy(shape)), " and scale ", format(tidy(lambda)), ", the hazard curve, B10 life and mean life")
    else "; the Weibull fit could not be made, so the failure pattern and the life figures are not shown",
    if (length(excluded)) paste0("; excluded: ", paste(excluded, collapse = "; ")) else "", ".")
  assumptions <- list(
    "Rows that have not had the event are counted for the time they lasted, not dropped; leaving them out shortens every estimate.",
    "Every row is assumed to start at time 0 and to be watched independently of the others.",
    "A median that could not be reached means fewer than half the rows had the event within the time observed.",
    if (grouped) "A single hazard ratio assumes the difference between groups holds at every point in time; the cox.zph row says whether it does." else "With no group column this is one overall curve, and no difference between groups is claimed.",
    "The Weibull life figures depend on the fitted shape; the Kaplan-Meier curve and the log-rank test do not.")
  s_end <- 100 * utils::tail(summary(fit1, times = tmax, extend = TRUE)$surv, 1)
  answer <- paste0(
    if (is.na(med_all))
      sprintf("Fewer than half of all rows had the event within the %s watched, so there is no median time to it: %s%% were still going at the end",
              fmt_t(tmax), format(tidy(s_end)))
    else paste0("Half of all rows reach the event by ", fmt_t(med_all)),
    if (!is.na(med_all) && !is.na(med_lo) && !is.na(med_hi)) paste0(" (95% ", format(tidy(med_lo)), " to ", format(tidy(med_hi)), ")") else "",
    if (grouped && !is.na(lr_p)) paste0("; the ", k, " groups of '", group_name, "' differ with a log-rank p ", p_text(lr_p),
                                        ", longest-lasting first: ", paste(utils::head(med_df$group, 3), collapse = ", "),
                                        if (any(is.na(med_df$median))) sprintf(" (%s never reached a median, so more than half of each is still going)",
                                                                               paste(med_df$group[is.na(med_df$median)], collapse = ", ")) else "") else "",
    if (!is.null(wb)) paste0(". The fitted shape is ", format(tidy(shape)), ", ",
                             if (grepl("^[aeiou]", failure_mode)) "an " else "a ", sub(":.*", "", failure_mode), " pattern.") else ".")

  #' ## The places. The verdict and the headline are NOT places of a library tool (LAT-3130): a library tool supplies
  #' data objects, and the answer is written by the last mile, which is the first stage to read them together.
  results <- list()
  #' A metric card leads with the figure it has. With no median reached, `median_survival` is NA and leading on it
  #' gives the reader a blank where the answer should be, so the share still going at the end leads instead.
  summary_vals <- list(median_survival = tidy(med_all), still_going_at_end = tidy(s_end), watched_for = tidy(tmax),
                       n = n_used, n_events = n_events, n_censored = n_censored, failure_mode = sub(":.*", "", failure_mode))
  if (grouped) summary_vals$p_value <- p_cell(lr_p)
  # The STRONGEST effect is the one furthest from no difference in EITHER direction. `max()` over the ratios
  #' names the weakest when every group is read against a reference they all beat (the largest group usually is).
  if (grouped && !is.null(hr_df)) {
    top <- hr_df[which.max(abs(hr_df$log_hazard_ratio)), ]
    summary_vals$hazard_ratio <- top$hazard_ratio
    summary_vals$largest_difference <- top$term
  }
  results$summary_metrics <- place_metric(summary_vals, lead = if (is.na(med_all)) "still_going_at_end" else "median_survival",
                                          place = "summary_metrics")
  results$survival_curve <- place_trend(curve_df, x = "time", y = "survival_pct", series = "series", place = "survival_curve")
  results$life_table <- place_table(life_df, place = "life_table")
  #' A CONDITIONAL PLACE IS WRITTEN EITHER WAY (LAT-3102): an absent entry is a refusal the mapper logs at ERROR and
  #' cannot tell from a tool that died mid-write. The reason is what the reader sees instead of the card.
  if (grouped && !is.null(med_df)) {
    results$median_by_group <- place_interval(med_df, term = "group", value = "median", low = "low", high = "high", place = "median_by_group")
  } else {
    results$median_by_group <- place_dropped(sprintf(
      "no group column with two or more usable groups was mapped, so there is one overall curve and no per-group median; the curve and the life table above cover every row%s",
      if (length(dropped_groups)) paste0(" (dropped: ", paste(dropped_groups, collapse = ", "), ")") else ""), place = "median_by_group")
  }
  if (!is.null(hr_df) && nrow(hr_df)) {
    results$hazard_ratios <- place_interval(hr_df, term = "term", value = "log_hazard_ratio", low = "low", high = "high", place = "hazard_ratios")
  } else {
    results$hazard_ratios <- place_dropped(if (!grouped)
      "no group column was mapped, so there is nothing to compare the rate of the event against" else
      "the Cox model could not be fitted on these groups, so no hazard ratio is shown; the log-rank test in the results table still stands", place = "hazard_ratios")
  }
  if (!is.null(haz_df)) {
    results$hazard_curve <- place_trend(haz_df, x = "time", y = "hazard", place = "hazard_curve")
  } else {
    results$hazard_curve <- place_dropped(sprintf(
      "the Weibull fit did not converge on these %d events, so the rate the event arrives at over time cannot be drawn; the Kaplan-Meier curve above does not depend on it", n_events), place = "hazard_curve")
  }
  results$test_results <- place_table(tests_df, place = "test_results")
  results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
  results$survival_method <- list(kind = "metric", values = list(
    method = method, n_in = n_in, n_used = n_used, excluded = as.list(unname(excluded)), assumptions = assumptions,
    # LAT-3181: the method card's "rows, x to y" line reads these; unset, it printed a bare arrow
    x_column = if (grouped) group_name else time_name, y_column = if (grouped) time_name else event_name),
    value_order = list("n_used", "n_in"))

  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))
}