# What the analyst sees: simulated Medicare claims (plan D17).
# Latent quantities (Z_t, true smoking, frailty, skill, style, progression rate) never
# leave this function except in `hidden`, which analysis code must not touch.

HIDDEN_COLS <- c("skill", "style", "frailty", "fi_noise", "smoking_true", "z0", "rate", "venous", "z")

#' Turn a population and its simulated course into claims-like records.
#'
#' @return list(patients = one row per patient: measured baseline and coded event times;
#'   pm = person-months (id, t, sev_obs) from month 0 to death or month 59;
#'   hidden = latent traits, for oracle analyses and checks only).
make_records <- function(pop, course, par) {
  pat <- pop$pat; ev <- course$events; ms <- par$measurement
  M <- par$size$months
  smoking <- if (isTRUE(ms$smoking) || identical(ms$smoking, "true")) pat$smoking_true else pat$smoking_coded
  rel <- ms$frailty_reliability
  fi <- sqrt(rel) * pat$frailty + sqrt(1 - rel) * pat$fi_noise

  patients <- data.table(id = pat$id, phys_id = pat$phys_id, obl = pat$obl, age = pat$age,
                         female = pat$female, black = pat$black, year = pat$year,
                         diabetes = pat$diabetes, ckd = pat$ckd, chf = pat$chf, copd = pat$copd,
                         prior_cvd = pat$prior_cvd, smoking = smoking, frailty_index = fi)
  patients <- cbind(patients, ev[, !"id"])
  # t_clti_true is latent: only the coded date is in claims
  patients[, t_clti_true := NULL]

  # observed severity: exact Z_t (clean worlds) or a claims proxy (world W5, WR)
  last <- pmin(ifelse(is.na(ev$t_death), M - 1L, ev$t_death), M - 1L)
  nrep <- last + 1L
  id <- rep(pat$id, nrep)
  t <- sequence(nrep) - 1L
  idx <- cbind(id, t + 1L)
  if (identical(ms$severity, "exact")) {
    sev <- course$z[idx]
  } else if (identical(ms$severity, "noisy")) {
    sev <- course$z[idx] + rnorm(length(id), 0, ms$noise_sd)   # EHR/registry: measured with error
  } else {
    w <- ms$proxy_window
    cs <- t(apply(course$counts, 1, function(x) { x[is.na(x)] <- 0L; cumsum(x) }))
    lagged <- cbind(matrix(0, nrow(cs), w), cs)[, seq_len(M)]
    sev <- log1p(cs[idx] - lagged[idx])
  }
  pm <- data.table(id = id, t = t, sev_obs = sev)

  hidden <- data.table(id = pat$id, skill = pat$skill, style = pat$style, frailty = pat$frailty,
                       smoking_true = pat$smoking_true, rate = pat$rate,
                       t_clti_true = ev$t_clti_true)
  hidden_pm <- data.table(id = id, t = t, z = course$z[idx])
  list(patients = patients, pm = pm, hidden = hidden, hidden_pm = hidden_pm, par = par)
}

#' Stop if an analysis table carries a latent column.
assert_no_hidden <- function(dt) {
  bad <- intersect(names(dt), HIDDEN_COLS)
  if (length(bad)) stop("latent columns in analysis data: ", paste(bad, collapse = ", "))
  invisible(TRUE)
}

#' One replicate's records: population, natural course, claims view.
simulate_records <- function(par, rep = 1L, n = par$size$n_patients) {
  seed <- replicate_seed(par$world, par$scenario, rep)
  pop <- make_population(par, n = n, seed = seed)
  course <- simulate_course(pop, par, policy("natural"), seed = seed + 104729L, record = TRUE)
  make_records(pop, course, par)
}

#' Reproducible seed for a world x scenario x replicate.
replicate_seed <- function(world, scenario, rep) {
  key <- paste(world, scenario, rep, sep = "|")
  h <- sum(utf8ToInt(key) * seq_along(utf8ToInt(key))^2)
  as.integer((h * 2654435761) %% 2147483647)
}

#' Physician-cluster bootstrap resample of a replicate's records (D28): physicians are
#' drawn with replacement and each draw brings all of its patients, with new patient and
#' physician ids so repeated physicians count as separate clusters.
bootstrap_records <- function(rec, seed) {
  set.seed(seed)
  phys <- unique(rec$patients$phys_id)
  draw <- data.table(phys_id = sample(phys, length(phys), replace = TRUE), new_phys = seq_along(phys))
  map <- rec$patients[, .(id, phys_id)][draw, on = "phys_id", allow.cartesian = TRUE]
  map[, new_id := seq_len(.N)]
  remap <- function(x) {
    x <- x[map[, .(id, new_id)], on = "id", allow.cartesian = TRUE]
    x[, id := new_id][, new_id := NULL][]
  }
  out <- rec
  out$patients <- remap(rec$patients)[map[, .(new_id, new_phys)], on = c(id = "new_id"), phys_id := i.new_phys]
  out$pm <- setkey(remap(rec$pm), id, t)
  out$hidden <- remap(rec$hidden)
  out$hidden_pm <- remap(rec$hidden_pm)
  out
}