# Descriptive results the paper cites beside the registered analysis: what the searches found, how many
# trials were eligible and in which group, where their numbers came from, which failed which integrity
# check, and how many registrations never reported. Reads data/, results/effects.csv, and
# results/registrations.csv (from analyze.R), and writes results/D.json.
#
#   Rscript code/summarize.R [data dir] [results dir]

suppressPackageStartupMessages(library(jsonlite))
args <- commandArgs(trailingOnly = TRUE)
data_dir <- if (length(args) >= 1) args[1] else "data"
out_dir <- if (length(args) >= 2) args[2] else "results"
`%||%` <- function(a, b) if (is.null(a) || length(a) == 0) b else a

search <- fromJSON(file.path(data_dir, "search.json"), simplifyVector = FALSE)
records <- fromJSON(file.path(data_dir, "records.json"), simplifyVector = FALSE)
trials <- fromJSON(file.path(data_dir, "trials.json"), simplifyVector = FALSE)
registry <- fromJSON(file.path(data_dir, "registry.json"), simplifyVector = FALSE)$registrations
eff <- read.csv(file.path(out_dir, "effects.csv"), stringsAsFactors = FALSE)
regs <- read.csv(file.path(out_dir, "registrations.csv"), stringsAsFactors = FALSE, na.strings = "")

count_by <- function(xs, f) { v <- vapply(xs, f, ""); as.list(table(v)) }
eligible <- Filter(function(t) isTRUE(t$design$eligible), trials)
dosing <- function(t) t$design$conscious_dosing %||% "unclear"
early <- eff[eff$outcome == "depression" & eff$window == "early", ]
# A trial that gives two comparisons (T097, as T097m and T097a) is one trial: its integrity facts are the
# trial's, and it fails the screen if either comparison does.
by_trial <- function(flag) tapply(flag, early$parent, any)
untrusted <- by_trial(!early$trustworthy)
due <- Filter(function(r) isTRUE(r$due), registry)

# Exploratory, outside the plan: depression means with their SDs, as printed, that two different trials
# report on the same scale on the same day. Trials report independent samples, so an identical pair is
# unexpected; extraction coders noticed one, and this checks every trial the same way.
extraction <- fromJSON(file.path(data_dir, "extraction.json"), simplifyVector = FALSE)
by_id <- setNames(trials, vapply(trials, function(t) t$trial, ""))
scale_of <- function(t, m) {
  for (x in t$design$depression_measures %||% list()) if (identical(x$measure, m)) return(x$code %||% "OTHER")
  "OTHER"
}
printed <- lapply(extraction, function(x) {
  out <- character()
  for (e in x$depression %||% list()) {
    if (!identical(e$form, "mean_sd") || is.null(e$day)) next
    for (v in e$values) if (is.list(v) && !is.null(v$mean) && !is.null(v$sd)) {
      out <- c(out, paste(scale_of(by_id[[x$trial]], e$measure), e$day, v$mean, v$sd, sep = "|"))
    }
  }
  unique(out)
})
names(printed) <- vapply(extraction, function(x) x$trial, "")
shared <- list()
for (i in seq_along(printed)) for (j in seq_along(printed)) if (i < j) {
  common <- intersect(printed[[i]], printed[[j]])
  if (length(common) > 0) shared[[length(shared) + 1]] <- list(trials = names(printed)[c(i, j)], values = length(common))
}

d <- list(
  records = length(records),
  pubmed = search$searches[[1]]$count, europe_pmc = search$searches[[2]]$count, registrations_searched = search$searches[[3]]$count,
  trials = length(trials),
  eligible = length(eligible),
  masked = sum(vapply(eligible, function(t) dosing(t) == "none", TRUE)),
  awake = sum(vapply(eligible, function(t) dosing(t) == "some", TRUE)),
  unclear = sum(vapply(eligible, function(t) dosing(t) == "unclear", TRUE)),
  masked_surgery = sum(vapply(eligible, function(t) dosing(t) == "none" && identical(t$design$setting, "surgery"), TRUE)),
  awake_surgery = sum(vapply(eligible, function(t) dosing(t) == "some" && identical(t$design$setting, "surgery"), TRUE)),
  sources = count_by(eligible, function(t) t$source),
  drugs = count_by(eligible, function(t) t$drug %||% "unknown"),
  blinding_checks = sum(vapply(extraction, function(x) !is.null(x$blinding_check), TRUE)),
  in_china = sum(vapply(eligible, function(t) identical(t$design$country, "China"), TRUE)),
  registered = sum(!is.na(regs$registration)),
  registered_from = as.list(table(regs$from[!is.na(regs$registration)])),
  selected = list(masked = sum(vapply(eligible, function(t) dosing(t) == "none" && identical(t$design$depression_selection, "selected"), TRUE)),
                  awake = sum(vapply(eligible, function(t) dosing(t) == "some" && identical(t$design$depression_selection, "selected"), TRUE))),
  masked_late_dosing = list(yes = sum(vapply(eligible, function(t) dosing(t) == "none" && isTRUE(t$design$late_dosing), TRUE)),
                            no = sum(vapply(eligible, function(t) dosing(t) == "none" && identical(t$design$late_dosing, FALSE), TRUE)),
                            unclear = sum(vapply(eligible, function(t) dosing(t) == "none" && is.null(t$design$late_dosing), TRUE))),
  with_depression_effect = length(unique(eff$parent[eff$outcome == "depression"])),
  early = list(trials = length(unique(early$parent)), comparisons = nrow(early),
               masked = sum(early$group == "masked"), awake = sum(early$group == "awake"), unclear = sum(early$group == "unclear"),
               masked_participants = sum(early$n[early$group == "masked"]), awake_participants = sum(early$n[early$group == "awake"]),
               strictly_masked = sum(early$group == "masked" & early$early_end),
               masked_at_induction = sum(early$group == "masked" & early$induction), trustworthy = sum(!untrusted),
               untrustworthy = sum(untrusted), unregistered = sum(untrusted & by_trial(!early$registered)),
               retrospective = sum(untrusted & by_trial(early$retrospective)), grim = sum(untrusted & by_trial(early$grim_fails >= 2)),
               implausible = sum(untrusted & by_trial(early$implausible)),
               grim_means_checked = sum(early$grim_checked[!duplicated(early$parent)])),
  shared_values = list(trials_checked = sum(lengths(printed) > 0), values_checked = sum(lengths(printed)),
                       pairs_found = length(shared), pairs = shared),
  pain_entries_not_ratings = as.list(table(unlist(lapply(extraction, function(x) lapply(x$pain %||% list(), function(e) e$kind))))),
  shared_registration = sum(vapply(trials, function(t) length(t$registration_shared_with %||% list()) > 0, TRUE)),
  allocation_conflict = sum(vapply(trials, function(t) isTRUE(t$design_conflict), TRUE)),
  registry = list(eligible = length(registry), due = length(due),
                  published = sum(vapply(due, function(r) isTRUE(r$published), TRUE)),
                  results_only = sum(vapply(due, function(r) !isTRUE(r$published) && isTRUE(r$results_posted), TRUE)),
                  unreported = sum(vapply(due, function(r) !isTRUE(r$published) && !isTRUE(r$results_posted), TRUE)),
                  unreported_pct = round(100 * mean(vapply(due, function(r) !isTRUE(r$published) && !isTRUE(r$results_posted), TRUE))))
)
write(toJSON(d, auto_unbox = TRUE, pretty = TRUE, digits = NA), file.path(out_dir, "D.json"))
cat("descriptive results written\n")