Deploy 7a572e1 from GitHub

.dockerignore

@@ -0,0 +1,10 @@
+.env
+.Renviron
+.Rhistory
+.RData
+.Rproj.user/
+.DS_Store
+.git
+.github
+tests/
+status/

Dockerfile

@@ -0,0 +1,31 @@
+FROM rocker/shiny:4.6.1
+
+# Install system dependencies for R packages
+# - libcurl4-openssl-dev, libssl-dev: for httr2 and curl
+# - libxml2-dev: for xml2
+# - libmagick++-dev: for magick (decisions resizes images with it)
+# - libfontconfig1-dev, libfreetype6-dev: for magick text rendering
+RUN apt-get update && apt-get install -y \
+    libcurl4-openssl-dev \
+    libssl-dev \
+    libxml2-dev \
+    libmagick++-dev \
+    libfontconfig1-dev \
+    libfreetype6-dev \
+    && rm -rf /var/lib/apt/lists/*
+
+WORKDIR /code
+
+# Install pak, then decisions at a fixed commit and the other packages at fixed
+# versions. The last line fails the build if any of them cannot be loaded.
+RUN R -e "install.packages('pak', repos = 'https://cloud.r-project.org')" \
+    && R -e "pak::pak('url::https://github.com/fmegahed/decisions/archive/b25fc9ffa7908e9a6a2d9833f080de1456c9d50a.tar.gz')" \
+    && R -e "pak::pak(c('shiny@1.14.0', 'mirai@2.7.1', 'dplyr@1.2.1', 'purrr@1.2.2', 'stringr@1.6.0', 'tibble@3.3.1', 'readr@2.2.0', 'jsonlite@2.0.0', 'httr2@1.2.3', 'yardstick@1.4.0', 'magick@2.9.0', 'zip@3.0.0', 'janitor@2.2.1', 'openssl@2.4.2'))" \
+    && R -e "for (p in c('shiny', 'decisions', 'mirai', 'dplyr', 'purrr', 'stringr', 'tibble', 'readr', 'jsonlite', 'httr2', 'yardstick', 'magick', 'zip', 'janitor', 'openssl')) library(p, character.only = TRUE)"
+
+# Copy only what the app needs (tests, .env and .git are excluded by .dockerignore)
+COPY app.R ./
+COPY R/ ./R/
+COPY www/ ./www/
+
+CMD ["R", "--quiet", "-e", "shiny::runApp(host='0.0.0.0', port=7860)"]

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2026 Fadel M. Megahed and Ying-Ju Chen
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

R/_disable_autoload.R

@@ -0,0 +1,3 @@
+# Shiny sources every file in R/ by itself. app.R sources the files in a fixed
+# order, so the existence of this file turns the automatic sourcing off.
+# The file holds no code.

R/answers.R

@@ -0,0 +1,112 @@
+# Answers: the table of a run, its stats, the notes and the CSV.
+# The table holds only the category message of an error, never the raw .error.
+
+# The table of answers, sorted by the probability of the target, highest first
+answers_table <- function(spec, answers, target) {
+  names_ans <- names(spec$question$answers)
+  probs <- answers[pred_column(names_ans)] |>
+    stats::setNames(paste0("p_", janitor::make_clean_names(names_ans, case = "none")))
+  error <- answers[[".error"]] %||% rep(NA_character_, nrow(answers))
+  tibble::tibble(
+    id = answers$id,
+    answer = as.character(answers$.pred_class),
+    p_target = answers[[pred_column(target)]],
+    probs,
+    tokens = answers$.input_tokens,
+    seconds = answers$.seconds,
+    problem = error_message(classify_error(error))
+  ) |>
+    dplyr::left_join(
+      spec$inputs |> dplyr::select(id, file, text, label),
+      by = "id"
+    ) |>
+    dplyr::mutate(text = stringr::str_trunc(text, 150, ellipsis = "...")) |>
+    dplyr::select(
+      id, file, text, answer, p_target, dplyr::starts_with("p_"),
+      label, tokens, seconds, problem
+    ) |>
+    dplyr::arrange(dplyr::desc(p_target))
+}
+
+# Number of inputs, cost (USD), accuracy and AUC; NA when they do not apply
+answer_stats <- function(table, spec, target) {
+  names_ans <- names(spec$question$answers)
+  labelled <- table |> dplyr::filter(!is.na(label), !is.na(answer))
+  accuracy <- if (nrow(labelled) == 0) {
+    NA_real_
+  } else {
+    yardstick::accuracy_vec(
+      factor(labelled$label, levels = names_ans),
+      factor(labelled$answer, levels = names_ans)
+    )
+  }
+  scored <- labelled |> dplyr::filter(!is.na(p_target))
+  auc <- if (length(names_ans) == 2 && dplyr::n_distinct(scored$label) == 2) {
+    yardstick::roc_auc_vec(
+      factor(scored$label, levels = c(target, setdiff(names_ans, target))),
+      scored$p_target, event_level = "first"
+    )
+  } else {
+    NA_real_
+  }
+  list(
+    n = nrow(table),
+    cost = sum(table$tokens, na.rm = TRUE) * PRICE_PER_TOKEN,
+    accuracy = accuracy, auc = auc
+  )
+}
+
+# The text for the image of a row, for screen readers
+alt_text <- function(row, target) {
+  sprintf(
+    "%s: answer %s, probability of %s %s",
+    row$file, row$answer, target, format(round(row$p_target, 2), nsmall = 2)
+  )
+}
+
+# What the probability is. The facts of a sample follow only for its saved
+# answers and its default target.
+help_note <- function(spec, stats, target, saved = FALSE) {
+  generic <- sprintf(
+    "The probability is the raw probability of Jev for %s. It is not calibrated.",
+    target
+  )
+  facts <- spec$source %in% names(SAMPLE_FACTS_TEXT) && saved &&
+    identical(target, target_answer(spec$question))
+  if (!facts) return(generic)
+  paste(c(generic, SAMPLE_FACTS_TEXT[[spec$source]]), collapse = " ")
+}
+
+# The CSV text of the table for the download
+answers_csv <- function(table) {
+  readr::format_csv(table, na = "")
+}
+
+# The answers belong to one setup and one set of inputs. The ids alone repeat
+# ("Text 1", "Row 1", "001_a.jpg"), so the key holds the paths and the texts too.
+answers_key <- function(spec) {
+  content <- spec$inputs[intersect(c("id", "path", "text"), names(spec$inputs))]
+  rlang::hash(list(spec_fingerprint(spec), content))
+}
+
+# The answers table as the page shows it: the input, the answer, the
+# probability of each answer, the label, the tokens, the seconds, the problem
+table_view <- function(table, spec) {
+  answers <- names(spec$question$answers)
+  probs <- table[paste0("p_", janitor::make_clean_names(answers, case = "none"))] |>
+    stats::setNames(paste("p", answers))
+  shown <- tibble::tibble(Input = dplyr::coalesce(table$text, table$file), Answer = table$answer) |>
+    dplyr::bind_cols(probs) |>
+    dplyr::mutate(
+      Label = table$label, Tokens = as.integer(table$tokens), Seconds = table$seconds,
+      Problem = table$problem
+    )
+  empty <- c(Label = all(is.na(table$label)), Problem = all(is.na(table$problem)))
+  shown |> dplyr::select(-dplyr::any_of(names(empty)[empty]))
+}
+
+# The answers table of a spec with no answers (for a download before a run)
+empty_table <- function(spec) {
+  answers <- empty_answers(spec$question, 0) |> dplyr::mutate(id = character(), .before = 1)
+  answers_table(spec, answers, target_answer(spec$question))
+}

R/bundle.R

@@ -0,0 +1,235 @@
+# Bundle and import. The bundle is one zip file with the code, the setup of
+# decisions, the answers and the references of a run. It holds no input image
+# of the visitor and no key. Import reads a setup of this app back, with our
+# own parser: it never calls decisions::read_setup() and never unserializes.
+
+# The text of the README of a bundle (80% ASD-STE100)
+bundle_readme <- function(spec, refs, name, has_data, date) {
+  files <- c(
+    sprintf("- `%s.R`: the R code of the run.", name),
+    sprintf(
+      "- `%s-setup.json`: the setup of the run. It holds the model, the question, the references and the image settings. It holds no key.",
+      name
+    ),
+    sprintf("- `%s-answers.csv`: the answers of the run.", name),
+    if (nrow(refs) > 0) "- `references/`: the reference images of the run. The code reads them.",
+    if (has_data) "- `data.csv`: your texts. The code reads them."
+  )
+  run <- c(
+    "Put the files in one folder. Make this folder the working directory of R.",
+    if (spec$mode == "image" && spec$source != "textiles") {
+      'Put your images in the folder "images", as the code lists them. This bundle holds no input image.'
+    },
+    if (spec$mode == "text" && spec$source == "upload" && !has_data) {
+      'Save your file as "data.csv" in the same folder.'
+    },
+    sprintf("Then run `%s.R`.", name)
+  )
+  paste(c(
+    sprintf("# %s", name),
+    "",
+    "This zip file holds one run of the decisions Space.",
+    "",
+    "## Files",
+    "",
+    files,
+    "",
+    "## Versions",
+    "",
+    sprintf("- App: %s", APP_VERSION),
+    sprintf("- decisions: commit %s", DECISIONS_SHA),
+    sprintf("- Model: %s", MODEL),
+    sprintf("- Date: %s", format(date)),
+    "",
+    "## Install",
+    "",
+    "Install the package decisions in R:",
+    "",
+    '    pak::pak("fmegahed/decisions")',
+    "",
+    "## Key",
+    "",
+    "The code needs your TypeSafe key. Save the key in the environment variable `TYPESAFE_API_KEY`.",
+    "For example, add the line `TYPESAFE_API_KEY=` followed by your key to the file `.Renviron` in your home folder. Then restart R.",
+    "Never write the key in the script.",
+    "",
+    "## Run",
+    "",
+    run,
+    "",
+    "## Cite",
+    "",
+    "If you use this run, cite the package and the Space:",
+    "",
+    sprintf("- Megahed, F. M., & Chen, Y.-J. (2026). *decisions: Typed decisions from decision models* (R package version %s). https://github.com/fmegahed/decisions", as.character(utils::packageVersion("decisions"))),
+    sprintf(
+      "- Megahed, F. M., & Chen, Y.-J. (2026). *decisions Space* (Version %s) [Web application]. Hugging Face. https://huggingface.co/spaces/fmegahed/decisions",
+      APP_VERSION
+    )
+  ), collapse = "\n")
+}
+
+# Write the bundle of a run to `zipfile` and return its path. `table` is the
+# answers table of answers_table().
+write_bundle <- function(spec, table, zipfile, date = Sys.Date()) {
+  name <- run_name(spec)
+  refs <- reference_files(spec)
+  dir <- tempfile("bundle")
+  dir.create(dir)
+  on.exit(unlink(dir, recursive = TRUE))
+  readr::write_file(paste0(run_code(spec, date), "\n"), file.path(dir, paste0(name, ".R")))
+  readr::write_file(answers_csv(table), file.path(dir, paste0(name, "-answers.csv")))
+  # The setup holds the references as the prepared images; the key stays out
+  references <- if (nrow(refs) > 0) spec$references[unique(refs$answer)]
+  setup <- decisions::decision_setup(
+    make_decider(), stats::setNames(list(as_decisions_question(spec$question)), name),
+    references = references, max_size = IMAGE_SETTINGS$max_size,
+    upscale = IMAGE_SETTINGS$upscale
+  )
+  decisions::write_setup(setup, file.path(dir, paste0(name, "-setup.json")))
+  # The references of a sample stay in the package (system.file())
+  if (nrow(refs) > 0 && spec$source != "textiles") {
+    dest <- file.path(dir, "references", refs$folder, refs$file)
+    purrr::walk(unique(dirname(dest)), dir.create, recursive = TRUE)
+    file.copy(refs$path, dest)
+  }
+  # Pasted text goes in as data.csv; the file of a CSV upload stays with the visitor
+  has_data <- spec$mode == "text" && spec$source == "upload" &&
+    is.null(spec$text_column) && nrow(spec$inputs) > 0
+  if (has_data) {
+    readr::write_csv(tibble::tibble(text = spec$inputs$text), file.path(dir, "data.csv"))
+  }
+  readr::write_file(
+    bundle_readme(spec, refs, name, has_data, date), file.path(dir, "README.md")
+  )
+  zipfile <- normalizePath(zipfile, mustWork = FALSE)
+  zip::zip(zipfile, files = list.files(dir), root = dir, mode = "mirror")
+  zipfile
+}
+
+# The files of the bundle of a spec, as write_bundle() makes them (a folder
+# ends in "/"; test-bundle.R checks that the two agree)
+bundle_names <- function(spec) {
+  name <- run_name(spec)
+  has_refs <- nrow(reference_files(spec)) > 0 && spec$source != "textiles"
+  has_data <- spec$mode == "text" && spec$source == "upload" &&
+    is.null(spec$text_column) && nrow(spec$inputs) > 0
+  c(
+    paste0(name, c(".R", "-setup.json", "-answers.csv")),
+    if (has_refs) "references/", if (has_data) "data.csv", "README.md"
+  )
+}
+
+# --- Import ---------------------------------------------------------------
+
+IMPORT_REFUSED <- "This file was not made by this app."
+
+# One text value: a string that is not NA
+is_one_string <- function(x) is.character(x) && length(x) == 1 && !is.na(x)
+
+# The path of the setup file: the file itself, or the `*-setup.json` of a zip
+# file, unpacked below `dir`. NULL when there is none.
+import_setup_path <- function(path, dir = tempfile("import")) {
+  if (!utils::file_test("-f", path) || file.size(path) > mb_bytes(MAX_ZIP_MB)) return(NULL)
+  if (tolower(tools::file_ext(path)) != "zip") return(path)
+  entries <- tryCatch(zip::zip_list(path), error = function(e) NULL)
+  if (is.null(entries)) return(NULL)
+  found <- entries |>
+    dplyr::filter(
+      endsWith(filename, "-setup.json"), purrr::map_lgl(filename, safe_entry),
+      !purrr::map_lgl(filename, is_junk), uncompressed_size <= mb_bytes(MAX_ZIP_MB)
+    )
+  if (nrow(found) == 0) return(NULL)
+  dest <- file.path(dir, "setup")
+  zip::unzip(path, files = found$filename[1], exdir = dest)
+  file.path(dest, found$filename[1])
+}
+
+# TRUE when the parsed JSON has the layout and the settings of this app
+is_app_setup <- function(json) {
+  question <- if (length(json$questions) == 1) json$questions[[1]]
+  answers <- question$answers
+  settings <- json$image_settings
+  is.list(json) &&
+    identical(as.numeric(json$version), 1) &&
+    is_one_string(json$decider$model) &&
+    is.null(json$calibrator) && is.null(json$calibrator_hash) &&
+    is_one_string(question$type) && question$type %in% c("noul", "choice", "score") &&
+    is_one_string(question$instructions) &&
+    length(answers) > 0 && !is.null(names(answers)) &&
+    all(purrr::map_lgl(answers, \(x) is.null(x) || is_one_string(x))) &&
+    identical(as.numeric(settings$max_size), as.numeric(IMAGE_SETTINGS$max_size)) &&
+    identical(settings$upscale, IMAGE_SETTINGS$upscale) &&
+    identical(settings$crop, IMAGE_SETTINGS$crop)
+}
+
+# Decode the references of the file below `dir`, as
+# references/<answer>/ref_<i>.jpg. NULL when there is a bad reference.
+import_references <- function(json, answers, dir = tempfile("import")) {
+  encoded <- json$references
+  if (length(encoded) == 0) return(list(paths = NULL, problems = character()))
+  # The references are an object keyed by answer: names that are all answers
+  keys <- names(encoded)
+  if (!is.list(encoded) || is.null(keys) || anyNA(keys) || anyDuplicated(keys) > 0 ||
+      !all(keys %in% names(answers))) {
+    return(NULL)
+  }
+  folders <- answer_folders(names(answers))
+  paths <- tryCatch(
+    purrr::imap(encoded, \(images, answer) {
+      if (!is.list(images) || length(images) > MAX_REFERENCES) stop("bad references")
+      purrr::imap_chr(unname(images), \(x, i) {
+        bytes <- if (is_one_string(x)) jsonlite::base64_dec(x) else raw()
+        jpeg <- length(bytes) > 3 && all(bytes[1:3] == as.raw(c(0xff, 0xd8, 0xff)))
+        if (!jpeg || length(bytes) > mb_bytes(MAX_FILE_MB)) stop("bad reference")
+        path <- file.path(dir, "references", folders[[answer]], sprintf("ref_%s.jpg", i))
+        dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
+        writeBin(bytes, path)
+        path
+      })
+    }),
+    error = function(e) NULL
+  )
+  if (is.null(paths)) return(NULL)
+  list(paths = paths, problems = character())
+}
+
+# Read a setup of this app: a bundle zip or the setup JSON. Returns the
+# question (in the format of spec.R), the references (answer to file paths) and
+# the problems. `question` is NULL when the file is refused. Every file of the
+# import is written below `dir` (the server gives the folder of the session).
+read_import_file <- function(path, dir = tempfile("import")) {
+  refuse <- function(problems = IMPORT_REFUSED) {
+    list(question = NULL, references = NULL, problems = problems)
+  }
+  setup_path <- import_setup_path(path, dir)
+  if (is.null(setup_path)) return(refuse())
+  json <- tryCatch(jsonlite::read_json(setup_path), error = function(e) NULL)
+  if (is.null(json) || !isTRUE(tryCatch(is_app_setup(json), error = function(e) FALSE))) {
+    return(refuse())
+  }
+  raw <- json$questions[[1]]
+  answers <- purrr::map_chr(raw$answers, \(x) x %||% "")
+  if (raw$type == "noul" && !setequal(names(answers), c("true", "false"))) return(refuse())
+  question <- list(type = raw$type, instructions = raw$instructions, answers = answers)
+  problems <- check_question(question)
+  if (length(problems) > 0) return(refuse(problems))
+  references <- import_references(json, answers, dir)
+  if (is.null(references) || (raw$type == "score" && length(references$paths) > 0)) return(refuse())
+  model <- json$decider$model
+  if (model != MODEL) {
+    problems <- c(problems, sprintf("This file uses %s. The app uses %s.", model, MODEL))
+  }
+  list(
+    question = question, references = references$paths,
+    problems = c(problems, references$problems)
+  )
+}
+
+# Read an import file. It never stops: any error refuses the file.
+read_import <- function(path, dir = tempfile("import")) {
+  tryCatch(
+    read_import_file(path, dir),
+    error = function(e) list(question = NULL, references = NULL, problems = IMPORT_REFUSED)
+  )
+}

R/code.R

@@ -0,0 +1,258 @@
+# R code of a run: the text that the visitor copies, downloads or finds in the
+# bundle. It uses only functions of decisions and base R (dplyr only for the
+# subset of the injuries sample). Every string of the visitor goes through
+# encodeString(), so quotes, backticks and new lines stay valid R.
+
+# An R string with double quotes
+r_string <- function(x) encodeString(x, quote = '"')
+
+# A name for the left side of `name = value`: bare when R allows it, else quoted
+r_name <- function(x) ifelse(make.names(x) == x, x, r_string(x))
+
+# Folder names for the answers: a name with one of `/ \ : * ? " < > |`, a
+# control character or a leading dot is cleaned, and the clean names stay
+# unique. The names of the result are the answers.
+answer_folders <- function(answers) {
+  folder <- answers |>
+    stringr::str_replace_all('[/\\\\:*?"<>|[:cntrl:]]', "_") |>
+    stringr::str_remove("^\\.+") |>
+    stringr::str_squish()
+  folder[folder == ""] <- "answer"
+  stats::setNames(make.unique(folder, sep = "_"), answers)
+}
+
+# The reference files of a spec: one row for each file, with its answer, the
+# folder of the answer, the source path and the file name in the folder.
+# A score question has none (Jev attaches references to noul and choice only).
+reference_files <- function(spec) {
+  empty <- tibble::tibble(
+    answer = character(), folder = character(), path = character(), file = character()
+  )
+  if (is.null(spec$references) || spec$question$type == "score") return(empty)
+  folders <- answer_folders(names(spec$question$answers))
+  purrr::imap(spec$references, \(paths, answer) {
+    file <- basename(paths)
+    twice <- duplicated(file) | duplicated(file, fromLast = TRUE)
+    file[twice] <- paste0(seq_along(file)[twice], "_", file[twice])
+    tibble::tibble(answer = answer, folder = folders[[answer]], path = paths, file = file)
+  }) |>
+    purrr::list_rbind()
+}
+
+# The name of a run for file names: "my parts" gives "my_parts"
+run_name <- function(spec) {
+  name <- janitor::make_clean_names(spec$name, case = "snake")
+  if (name == "") "run" else name
+}
+
+# The variable that holds the question in the code
+question_var <- function(spec) {
+  switch(spec$source, textiles = "weave", injuries = "injury", "question")
+}
+
+# Strings in lines of at most `width` characters, with a comma after each
+# string but the last. Used for long lists of files.
+pack_lines <- function(items, indent = "  ", width = 80) {
+  lines <- character()
+  line <- ""
+  for (i in seq_along(items)) {
+    piece <- if (i < length(items)) paste0(items[i], ",") else items[i]
+    if (nzchar(line) && nchar(indent) + nchar(line) + 1 + nchar(piece) > width) {
+      lines <- c(lines, paste0(indent, line))
+      line <- piece
+    } else {
+      line <- stringr::str_trim(paste(line, piece))
+    }
+  }
+  c(lines, paste0(indent, line))
+}
+
+# c("a", "b") as code: on one line when short, else in packed lines
+r_vector <- function(strings, indent = "") {
+  one <- paste0("c(", paste(r_string(strings), collapse = ", "), ")")
+  if (nchar(indent) + nchar(one) <= 80) return(one)
+  lines <- pack_lines(r_string(strings), paste0(indent, "  "))
+  paste0("c(\n", paste(lines, collapse = "\n"), "\n", indent, ")")
+}
+
+# The six lines of the comment on paths
+paths_comment <- function(spec, refs) {
+  folders <- if (nrow(refs) > 0) {
+    'the folder "images" and the folder "references"'
+  } else {
+    'the folder "images"'
+  }
+  working_directory <- c(
+    "working directory (RStudio: Session > Set Working Directory > To Source",
+    "File Location). getwd() shows where R looks."
+  )
+  lines <- if (spec$mode == "text" && spec$source == "injuries") {
+    c(
+      "Paths. This run used the sample texts of the package: the dataset",
+      "ohio_injuries comes with decisions, so no path needs a change.",
+      'Your own texts use a file next to this script: "data.csv".',
+      'Put this script and the file "data.csv" in one folder, and make it the',
+      working_directory
+    )
+  } else if (spec$mode == "text") {
+    column <- if (is.null(spec$text_column)) {
+      'The bundle holds your texts there, in the column "text".'
+    } else {
+      sprintf(
+        'Name your file "data.csv". The texts are in the column %s.',
+        r_string(spec$text_column)
+      )
+    }
+    c(
+      "Paths. This run used your own texts. The code reads them from the file",
+      '"data.csv" next to this script.',
+      column,
+      'Put this script and the file "data.csv" in one folder, and make it the',
+      working_directory
+    )
+  } else if (spec$source == "textiles") {
+    c(
+      "Paths. This run used the sample images of the package: system.file()",
+      "finds them on any computer, so no path needs a change.",
+      'Your own images use relative paths, such as "images/part_001.jpg".',
+      sprintf("Put this script, %s in one", folders),
+      "folder, and make it the working directory (RStudio: Session > Set Working",
+      "Directory > To Source File Location). getwd() shows where R looks."
+    )
+  } else {
+    c(
+      "Paths. This run used your own images. The code reads them with relative",
+      'paths, such as "images/part_001.jpg". The bundle holds no input image.',
+      sprintf("Put this script, %s in one", folders),
+      "folder, and make it the working directory (RStudio: Session > Set Working",
+      "Directory > To Source File Location). getwd() shows where R looks.",
+      'Put your images in the folder "images", as the code below lists them.'
+    )
+  }
+  paste0("# ", lines, collapse = "\n")
+}
+
+# The definition of `references` from relative paths (empty without references)
+references_code <- function(refs) {
+  if (nrow(refs) == 0) return("")
+  by_answer <- refs |>
+    dplyr::summarise(
+      code = paste0(
+        "  ", r_name(dplyr::first(answer)), " = ",
+        r_vector(paste0("references/", dplyr::first(folder), "/", file), indent = "  ")
+      ),
+      .by = answer
+    )
+  paste0("\nreferences <- list(\n", paste(by_answer$code, collapse = ",\n"), "\n)")
+}
+
+# The lines that define `texts` (or `injuries`)
+text_code <- function(spec) {
+  if (spec$source == "injuries") {
+    return(paste(
+      "set.seed(2026)",
+      "# This line needs the package dplyr.",
+      "injuries <- ohio_injuries |>",
+      "  dplyr::slice_sample(n = 20, by = collapsed_nature_title)",
+      sep = "\n"
+    ))
+  }
+  if (is.null(spec$text_column)) {
+    return('texts <- read.csv("data.csv")$text')
+  }
+  # read.csv() changes odd column names unless check.names is FALSE
+  read <- if (make.names(spec$text_column) == spec$text_column) {
+    'read.csv("data.csv")'
+  } else {
+    'read.csv("data.csv", check.names = FALSE)'
+  }
+  paste0("texts <- ", read, "[[", r_string(spec$text_column), "]]")
+}
+
+# The lines that define `images` and `references`
+inputs_code <- function(spec, refs) {
+  if (spec$mode == "text") return(text_code(spec))
+  if (spec$source == "textiles") {
+    by_answer <- refs |>
+      dplyr::summarise(
+        code = paste0(
+          "  ", r_name(dplyr::first(answer)), " = file.path(folder, ",
+          r_vector(file, indent = "  "), ")"
+        ),
+        .by = answer
+      )
+    return(paste0(
+      'folder <- system.file("extdata", "textiles", package = "decisions")\n',
+      'images <- file.path(folder, textiles$file[textiles$role == "input"])\n',
+      "references <- list(\n", paste(by_answer$code, collapse = ",\n"), "\n)"
+    ))
+  }
+  inputs <- spec$inputs
+  images <- if (nrow(inputs) == 0) {
+    'images <- list.files("images", full.names = TRUE)'
+  } else {
+    labels <- unique(stats::na.omit(inputs$label))
+    folders <- answer_folders(union(names(spec$question$answers), labels))
+    sub <- ifelse(is.na(inputs$label), "", paste0(folders[inputs$label], "/"))
+    files <- r_string(paste0("images/", sub, inputs$file))
+    paste0("images <- c(\n", paste(pack_lines(files), collapse = "\n"), "\n)")
+  }
+  paste0(images, references_code(refs))
+}
+
+# The call of the question constructor, with the exact text of the question
+question_code <- function(question, var) {
+  answers <- question$answers
+  args <- r_string(question$instructions)
+  if (question$type == "noul") {
+    given <- answers[nzchar(answers)]
+    if (length(given) > 0) args <- c(args, paste0(names(given), " = ", r_string(given)))
+  } else {
+    names_r <- r_name(names(answers))
+    padded <- stringr::str_pad(names_r, max(nchar(names_r)), side = "right")
+    args <- c(args, paste0(
+      "c(\n", paste0("    ", padded, " = ", r_string(answers), collapse = ",\n"), "\n  )"
+    ))
+  }
+  paste0(
+    var, " <- question_", question$type, "(\n",
+    paste0("  ", args, collapse = ",\n"), "\n)"
+  )
+}
+
+# The code of a run, as one string. `date` is the day of the run.
+run_code <- function(spec, date = Sys.Date()) {
+  refs <- reference_files(spec)
+  var <- question_var(spec)
+  data_arg <- if (spec$mode == "text") {
+    paste0("text = ", if (spec$source == "injuries") "injuries$final_narrative" else "texts")
+  } else {
+    "image = images"
+  }
+  if (nrow(refs) > 0) data_arg <- paste0(data_arg, ", references = references")
+  paste(
+    sprintf("# The run of the decisions Space on %s, in R. Run it with your own key.", format(date)),
+    "library(decisions)",
+    "",
+    paths_comment(spec, refs),
+    inputs_code(spec, refs),
+    "",
+    question_code(spec$question, var),
+    "",
+    "answers <- decide(",
+    sprintf('  decider_typesafe("%s"), %s,', MODEL, var),
+    paste0("  ", data_arg, ","),
+    sprintf(
+      "  max_size = %s, upscale = %s",
+      IMAGE_SETTINGS$max_size, toupper(IMAGE_SETTINGS$upscale)
+    ),
+    ")",
+    "answers",
+    sep = "\n"
+  )
+}
+
+# The number of lines of the code, for the closed card
+code_lines <- function(code) {
+  stringr::str_count(code, "\n") + 1L
+}

R/config.R

@@ -0,0 +1,74 @@
+# Configuration: the single place for the model id, the limits and the links.
+# Everything a user reads about the model or the limits comes from these
+# values (see app_config() at the end), so the text cannot drift from the
+# behaviour.
+
+# Version of this app
+APP_VERSION <- "1.0.0"
+APP_DATE <- "24 October 2026"
+
+# Model used for every call. This is the ONLY place a model id may be written
+# (tests/testthat/test-config.R enforces this).
+MODEL <- "jev-1.14.0"
+
+# Commit of the decisions package that the app uses
+DECISIONS_SHA <- "b25fc9ffa7908e9a6a2d9833f080de1456c9d50a"
+
+# Price in USD for each input token (USD 0.042 for each million tokens)
+PRICE_PER_TOKEN <- 0.042 / 1e6
+
+# Spending limits in USD (all days and months are in UTC)
+LIMIT_SESSION <- 0.25
+LIMIT_DAY <- 2
+LIMIT_MONTH <- 20
+
+# Token guesses for the cost check before the first call
+TOKENS_GUESS <- c(image = 16000, text = 1000)
+
+# Input limits
+MAX_FILE_MB <- 5
+MAX_ZIP_MB <- 50
+MAX_IMAGES <- 100
+MAX_TEXTS <- 200
+MAX_TEXT_CHARS <- 4000
+MAX_INSTRUCTIONS <- 500
+MAX_DESCRIPTION <- 300
+
+# Number of answers for a choice question and of levels for a score question
+ANSWER_RANGE <- list(choice = c(2, 6), score = c(2, 5))
+
+# Reference images for each answer, and inputs for each call to Jev
+MAX_REFERENCES <- 2
+CHUNK_SIZE <- 10
+
+# Image settings that decisions applies before it sends an image
+IMAGE_SETTINGS <- list(max_size = 768, upscale = TRUE, crop = "none")
+
+# Names of the environment variables (the values are never in the code)
+KEY_VAR <- "HF_JEV_API"
+USAGE_TOKEN_VAR <- "HF_USAGE_TOKEN"
+
+# Private dataset that stores the usage, and the public status file
+USAGE_REPO <- "fmegahed/decisions-space-usage"
+STATUS_URL <- "https://raw.githubusercontent.com/fmegahed/decisions-space/main/status/status.csv"
+
+# Address of the Space, and the video (empty until the video exists)
+SPACE_HOST <- "https://fmegahed-decisions.hf.space"
+VIDEO_URL <- ""
+
+# The values that the help text uses, in one named list
+app_config <- function() {
+  list(
+    version = APP_VERSION, date = APP_DATE, model = MODEL,
+    price_per_million = PRICE_PER_TOKEN * 1e6,
+    limit_session = LIMIT_SESSION, limit_day = LIMIT_DAY,
+    limit_month = LIMIT_MONTH, tokens_guess = TOKENS_GUESS,
+    max_file_mb = MAX_FILE_MB, max_zip_mb = MAX_ZIP_MB,
+    max_images = MAX_IMAGES, max_texts = MAX_TEXTS,
+    max_text_chars = MAX_TEXT_CHARS, max_instructions = MAX_INSTRUCTIONS,
+    max_description = MAX_DESCRIPTION, answer_range = ANSWER_RANGE,
+    max_references = MAX_REFERENCES, chunk_size = CHUNK_SIZE,
+    image_settings = IMAGE_SETTINGS, space_host = SPACE_HOST,
+    video_url = VIDEO_URL
+  )
+}

R/data.R

@@ -0,0 +1,326 @@
+# Data of the visitor: images (loose files or zip files), references, pasted
+# text and CSV files. Each reader returns a list with `inputs` (the inputs
+# tibble of spec.R) and `problems` (short sentences for the visitor). The
+# readers never stop on bad data: they skip it and say why.
+
+IMAGE_EXTENSIONS <- c("jpg", "jpeg", "png", "webp")
+
+# Bytes in a limit given in MB
+mb_bytes <- function(mb) mb * 1024^2
+
+# TRUE when a file name is an image that Jev can read
+is_image_name <- function(x) tolower(tools::file_ext(x)) %in% IMAGE_EXTENSIONS
+
+# TRUE when a zip entry stays inside the folder of the zip: no absolute path,
+# no drive letter, no backslash and no `..`
+safe_entry <- function(x) {
+  !startsWith(x, "/") && !grepl("^[A-Za-z]:", x) && !grepl("\\", x, fixed = TRUE) &&
+    !any(strsplit(x, "/", fixed = TRUE)[[1]] == "..")
+}
+
+# TRUE for the files that macOS and Windows add to a zip file: a folder
+# __MACOSX, a dot file or folder (._a.jpg, .DS_Store), Thumbs.db, desktop.ini
+is_junk <- function(x) {
+  parts <- strsplit(x, "/", fixed = TRUE)[[1]]
+  any(parts == "__MACOSX" | startsWith(parts, ".")) ||
+    tolower(utils::tail(parts, 1)) %in% c("thumbs.db", "desktop.ini")
+}
+
+# The inputs tibble with no rows
+empty_inputs <- function() {
+  tibble::tibble(
+    id = character(), path = character(), text = character(),
+    file = character(), label = character()
+  )
+}
+
+# Unique ids: a running number joined with the file name, so that the same
+# name in two folders gives two ids. Spaces and odd characters become "_".
+make_ids <- function(file) {
+  clean <- stringr::str_replace_all(file, "[^\\p{L}\\p{N}._-]+", "_")
+  sprintf("%03d_%s", seq_along(file), clean)
+}
+
+# Unpack the safe image entries of a zip file into the folder `dest`. The
+# entries are counted from the listing first: when they are more than
+# `budget`, nothing is extracted. An entry over the file limit is never
+# extracted. One call to zip::unzip() extracts the rest, below `dest` only.
+# Returns the files (`rel`, `path`, `size`), the count of other files, the
+# count of images and the problems.
+unpack_zip <- function(zipfile, name, dest, budget = MAX_IMAGES) {
+  entries <- tryCatch(zip::zip_list(zipfile), error = function(e) NULL)
+  if (is.null(entries)) {
+    return(list(
+      files = NULL, other = 0L, count = 0L,
+      problems = sprintf("%s could not be opened. Check that it is a zip file.", name)
+    ))
+  }
+  kept <- entries |>
+    dplyr::filter(!endsWith(filename, "/")) |>
+    dplyr::filter(purrr::map_lgl(filename, safe_entry)) |>
+    dplyr::filter(!purrr::map_lgl(filename, is_junk))
+  # A single top folder around the label folders is not a label
+  parts <- strsplit(kept$filename, "/", fixed = TRUE)
+  tops <- unique(purrr::map_chr(parts, 1))
+  rel <- kept$filename
+  if (length(tops) == 1 && any(lengths(parts) >= 3)) {
+    rel <- stringr::str_remove(rel, stringr::fixed(paste0(tops, "/")))
+  }
+  kept <- kept |> dplyr::mutate(rel = rel)
+  is_img <- is_image_name(kept$filename)
+  too_big <- is_img & kept$uncompressed_size > mb_bytes(MAX_FILE_MB)
+  use <- kept |> dplyr::filter(is_img, !too_big)
+  problems <- sprintf("%s was skipped. A file can be at most %s MB.", basename(kept$rel[too_big]), MAX_FILE_MB)
+  out <- list(files = NULL, other = sum(!is_img), count = nrow(use), problems = problems)
+  if (nrow(use) == 0 || nrow(use) > budget) return(out)
+  dir.create(dest, recursive = TRUE, showWarnings = FALSE)
+  zip::unzip(zipfile, files = use$filename, exdir = dest)
+  out$files <- use |>
+    dplyr::mutate(path = file.path(dest, filename), size = uncompressed_size) |>
+    dplyr::select(rel, path, size)
+  out
+}
+
+# Sentence for the files that are not images
+not_image_problem <- function(n) {
+  if (n == 0) return(character())
+  if (n == 1) return("1 file is not an image and was skipped. Use JPEG, PNG or WebP.")
+  sprintf("%d files are not images and were skipped. Use JPEG, PNG or WebP.", n)
+}
+
+# Copy a loose upload into `dir` (one subfolder for each upload); returns the new path
+keep_upload <- function(path, name, dir, i) {
+  dest <- file.path(dir, sprintf("file%03d", i))
+  dir.create(dest, recursive = TRUE, showWarnings = FALSE)
+  file.copy(path, file.path(dest, basename(name)))
+  file.path(dest, basename(name))
+}
+
+# Images from the files of shiny::fileInput() (columns `name`, `datapath`).
+# A folder in a zip file gives the label; loose files have no label. Every
+# file is written below `dir`, so the caller can delete `dir` at the end of
+# the session. The result carries `dir`.
+read_images <- function(files, dir = tempfile("upload")) {
+  if (is.null(files) || nrow(files) == 0) {
+    return(list(inputs = empty_inputs(), problems = character(), dir = dir))
+  }
+  problems <- character()
+  other <- 0L
+  loaded <- 0L
+  counted <- 0L
+  found <- purrr::pmap(list(files$name, files$datapath, seq_len(nrow(files))), \(name, path, i) {
+    if (tolower(tools::file_ext(name)) == "zip") {
+      if (file.size(path) > mb_bytes(MAX_ZIP_MB)) {
+        problems <<- c(problems, sprintf("%s was skipped. A zip file can be at most %s MB.", name, MAX_ZIP_MB))
+        return(NULL)
+      }
+      zipped <- unpack_zip(path, name, file.path(dir, sprintf("zip%03d", i)), MAX_IMAGES - loaded)
+      problems <<- c(problems, zipped$problems)
+      other <<- other + zipped$other
+      counted <<- counted + zipped$count
+      loaded <<- loaded + NROW(zipped$files)
+      return(zipped$files)
+    }
+    if (is_junk(name)) return(NULL)
+    if (!is_image_name(name)) {
+      other <<- other + 1L
+      return(NULL)
+    }
+    if (file.size(path) > mb_bytes(MAX_FILE_MB)) {
+      problems <<- c(problems, sprintf("%s was skipped. A file can be at most %s MB.", name, MAX_FILE_MB))
+      return(NULL)
+    }
+    counted <<- counted + 1L
+    if (loaded >= MAX_IMAGES) return(NULL)
+    loaded <<- loaded + 1L
+    tibble::tibble(rel = name, path = keep_upload(path, name, dir, i), size = file.size(path))
+  })
+  images <- dplyr::bind_rows(found)
+  problems <- c(problems, not_image_problem(other))
+  if (counted > MAX_IMAGES) {
+    problems <- c(problems, sprintf(
+      "A run can have at most %d images. This upload has %d. Upload fewer images.",
+      MAX_IMAGES, counted
+    ))
+    images <- images[0, ]
+  }
+  if (nrow(images) == 0) return(list(inputs = empty_inputs(), problems = problems, dir = dir))
+  parts <- strsplit(images$rel, "/", fixed = TRUE)
+  file <- purrr::map_chr(parts, utils::tail, 1)
+  label <- purrr::map_chr(parts, \(p) if (length(p) >= 2) p[1] else NA_character_)
+  inputs <- tibble::tibble(
+    id = make_ids(file), path = images$path, text = NA_character_,
+    file = file, label = label
+  )
+  list(inputs = inputs, problems = problems, dir = dir)
+}
+
+# Reference images: loose image files, at most MAX_REFERENCES, copied below `dir`
+read_references <- function(files, dir = tempfile("upload")) {
+  if (is.null(files) || nrow(files) == 0) {
+    return(list(paths = character(), problems = character(), dir = dir))
+  }
+  is_img <- is_image_name(files$name)
+  too_big <- is_img & file.size(files$datapath) > mb_bytes(MAX_FILE_MB)
+  problems <- c(
+    sprintf("%s was skipped. A file can be at most %s MB.", files$name[too_big], MAX_FILE_MB),
+    not_image_problem(sum(!is_img))
+  )
+  use <- which(is_img & !too_big)
+  if (length(use) > MAX_REFERENCES) {
+    problems <- c(problems, sprintf(
+      "You can add at most %d references for each answer. The app used the first %d.",
+      MAX_REFERENCES, MAX_REFERENCES
+    ))
+    use <- use[seq_len(MAX_REFERENCES)]
+  }
+  paths <- purrr::map_chr(use, \(i) keep_upload(files$datapath[i], files$name[i], dir, i))
+  list(paths = paths, problems = problems, dir = dir)
+}
+
+# Inputs from texts: skip the texts that are too long, and stop when there
+# are too many. `file` is the display name of each text.
+texts_to_inputs <- function(text, file, label, problems = character()) {
+  long <- stringr::str_length(text) > MAX_TEXT_CHARS
+  if (any(long)) {
+    problems <- c(problems, sprintf(
+      "%s was skipped. A text can have at most %s characters.",
+      file[long], format(MAX_TEXT_CHARS, big.mark = ",")
+    ))
+  }
+  keep <- !long
+  if (sum(keep) > MAX_TEXTS) {
+    problems <- c(problems, sprintf(
+      "A run can have at most %d texts. This upload has %d. Use fewer texts.",
+      MAX_TEXTS, sum(keep)
+    ))
+    keep <- rep(FALSE, length(text))
+  }
+  if (!any(keep)) return(list(inputs = empty_inputs(), problems = problems))
+  inputs <- tibble::tibble(
+    id = make_ids(file[keep]), path = NA_character_, text = text[keep],
+    file = file[keep], label = label[keep]
+  )
+  list(inputs = inputs, problems = problems)
+}
+
+# One input for each paragraph; one or more blank lines separate paragraphs
+read_text_paste <- function(text) {
+  if (is.null(text) || length(text) == 0 || is.na(text[1])) text <- ""
+  paragraphs <- text[1] |>
+    stringr::str_replace_all("\r\n?", "\n") |>
+    stringr::str_split("\\n\\s*\\n") |>
+    unlist() |>
+    stringr::str_trim()
+  paragraphs <- paragraphs[paragraphs != ""]
+  texts_to_inputs(
+    paragraphs, sprintf("Text %d", seq_along(paragraphs)),
+    rep(NA_character_, length(paragraphs))
+  )
+}
+
+# The encoding of a CSV file: UTF-8 when the bytes are valid UTF-8 (a BOM is
+# fine), else the best guess of readr, else Latin-1
+csv_encoding <- function(path) {
+  bytes <- readBin(path, "raw", file.size(path))
+  if (!0x00 %in% bytes && validUTF8(rawToChar(bytes))) return("UTF-8")
+  guess <- readr::guess_encoding(path)$encoding
+  if (length(guess) == 0 || is.na(guess[1])) "latin1" else guess[1]
+}
+
+# Read a CSV file with every column as text; NULL when it cannot be read
+read_csv_text <- function(path, n_max = Inf) {
+  tryCatch(
+    readr::read_csv(
+      path, locale = readr::locale(encoding = csv_encoding(path)),
+      col_types = readr::cols(.default = "c"), na = character(),
+      n_max = n_max, progress = FALSE
+    ),
+    error = function(e) NULL
+  )
+}
+
+# The column names of a CSV file
+csv_columns <- function(path) {
+  if (file.size(path) > mb_bytes(MAX_FILE_MB)) return(character())
+  names(read_csv_text(path, n_max = 0))
+}
+
+# Inputs from a CSV file: the text column, and optionally the label column.
+# Empty texts are dropped with a count; blank labels stay unlabelled.
+read_text_csv <- function(path, text_col, label_col = NULL, name = basename(path)) {
+  if (file.size(path) > mb_bytes(MAX_FILE_MB)) {
+    return(list(
+      inputs = empty_inputs(),
+      problems = sprintf("%s was skipped. A file can be at most %s MB.", name, MAX_FILE_MB)
+    ))
+  }
+  data <- read_csv_text(path)
+  if (is.null(data)) {
+    return(list(inputs = empty_inputs(), problems = "The CSV file could not be read."))
+  }
+  if (!text_col %in% names(data)) {
+    return(list(
+      inputs = empty_inputs(),
+      problems = sprintf("The column %s is not in the file.", text_col)
+    ))
+  }
+  has_label <- !is.null(label_col) && label_col %in% names(data)
+  data <- tibble::tibble(
+    text = stringr::str_trim(data[[text_col]]),
+    label = if (has_label) stringr::str_trim(data[[label_col]]) else NA_character_,
+    file = sprintf("Row %d", seq_len(nrow(data)))
+  ) |>
+    dplyr::mutate(label = dplyr::na_if(label, ""))
+  empty <- data$text == ""
+  problems <- if (sum(empty) == 1) {
+    "1 empty text was dropped"
+  } else if (sum(empty) > 1) {
+    sprintf("%d empty texts were dropped", sum(empty))
+  } else {
+    character()
+  }
+  data <- data[!empty, ]
+  texts_to_inputs(data$text, data$file, data$label, problems)
+}
+
+# Match the labels to the answer names after str_squish() and str_to_lower().
+# A matched label gets the exact answer name; any other label becomes NA (the
+# input stays, unlabelled) and is listed once. `answers` is the vector of
+# answers (named) or of answer names.
+match_labels <- function(inputs, answers) {
+  clean <- \(x) stringr::str_to_lower(stringr::str_squish(x))
+  answer_names <- if (is.null(names(answers))) answers else names(answers)
+  hit <- match(clean(inputs$label), clean(answer_names))
+  unmatched <- stringr::str_squish(inputs$label[is.na(hit) & !is.na(inputs$label)])
+  unmatched <- unmatched[!duplicated(clean(unmatched))]
+  inputs$label <- answer_names[hit]
+  list(inputs = inputs, problems = sprintf("%s is not an answer", unmatched))
+}
+
+# A small JPEG copy of an image (at most 320 pixels on the long side) for the
+# page; FALSE when the image cannot be read
+make_thumb <- function(path, dest) {
+  tryCatch(
+    {
+      magick::image_read(path)[1] |>
+        magick::image_background("white") |>
+        magick::image_scale("320x320>") |>
+        magick::image_write(dest, format = "jpeg")
+      TRUE
+    },
+    error = \(e) FALSE
+  )
+}
+
+# Delete the files of Shiny uploads, and their folders when they are empty
+remove_uploads <- function(paths) {
+  unlink(paths)
+  folders <- setdiff(
+    unique(normalizePath(dirname(paths), winslash = "/", mustWork = FALSE)),
+    normalizePath(tempdir(), winslash = "/")
+  )
+  files <- lengths(lapply(folders, list.files, all.files = TRUE, no.. = TRUE))
+  empty <- folders[dir.exists(folders) & files == 0]
+  unlink(empty, recursive = TRUE)
+}

R/help.R

@@ -0,0 +1,140 @@
+# Help: the text of the intro, the help lines, the notes, the Record tab and
+# About. All text is in 80% ASD-STE100: short sentences, active voice, no
+# contractions. Numbers and versions come from app_config(), so the text
+# cannot drift from the behaviour.
+
+# The keys of help_text()
+HELP_KEYS <- c(
+  "intro", "data", "question", "references", "references_score", "answers",
+  "code", "privacy", "record", "about"
+)
+
+# The authors, as the footer and About show them
+AUTHORS <- "Fadel M. Megahed (Miami University) \u00b7 Ying-Ju (Tessa) Chen (University of Dayton)"
+
+# Links of the package, the records and the source of the app
+LINKS <- list(
+  package = "https://github.com/fmegahed/decisions",
+  package_record = "https://fmegahed.github.io/decisions/record/",
+  project_record = "https://github.com/fmegahed/decision-models-for-industrial-image-qc/tree/main/replication_materials",
+  source = "https://github.com/fmegahed/decisions-space",
+  license = "https://github.com/fmegahed/decisions-space/blob/main/LICENSE",
+  issues = "https://github.com/fmegahed/decisions-space/issues",
+  status = "https://github.com/fmegahed/decisions-space/blob/main/status/status.csv"
+)
+
+# The installed version of decisions, as "0.1.0"
+package_version_text <- function() as.character(utils::packageVersion("decisions"))
+
+# The version of decisions and the short commit, as "0.1.0 @ b25fc9f"
+decisions_version <- function() {
+  sprintf("%s @ %s", package_version_text(), substr(DECISIONS_SHA, 1, 7))
+}
+
+# The help text of `key`, as one string. The text of "about" is Markdown.
+help_text <- function(key) {
+  key <- rlang::arg_match(key, HELP_KEYS)
+  cfg <- app_config()
+  switch(key,
+    intro = "The app sends your question to Jev, a decision model of TypeSafe. Start from a sample, or use your own images or texts.",
+    data = "Your own images: one zip file with one folder for each answer (labelled), or image files (unlabelled). Your own texts: paste them with a blank line between two texts, or use a CSV file.",
+    question = sprintf(
+      "Give each answer a short name and a description. A choice question has %d to %d answers. A score question has %d to %d levels, from low to high. Yes / no has the answers true and false.",
+      cfg$answer_range$choice[1], cfg$answer_range$choice[2],
+      cfg$answer_range$score[1], cfg$answer_range$score[2]
+    ),
+    references = sprintf(
+      "Give at most %d example images for each answer. They show the model what to look for.",
+      cfg$max_references
+    ),
+    references_score = "A score question takes no references. References attach only to Yes / no and Choice questions.",
+    answers = "The answers show here after a run. A sample shows its saved answers at once, at no cost.",
+    code = "The code repeats this run: the question, the references, the model and one decide() call. Run it in your own R with your TypeSafe key in TYPESAFE_API_KEY. Install the package with pak::pak(\"fmegahed/decisions\"). For your own images, read the comment on paths at the top of the code.",
+    privacy = "Your images and texts go to TypeSafe (Jev). Do not upload confidential data.",
+    record = "A GitHub workflow opens this app twice a day, as a visitor does. Each visit adds a row to a public file. The visit also keeps the app awake. The table shows the last 60 visits.",
+    about = about_text(cfg)
+  )
+}
+
+# The text of the About tab, as Markdown
+about_text <- function(cfg = app_config()) {
+  usd <- \(x) paste("USD", format(x, big.mark = ","))
+  num <- \(x) format(x, big.mark = ",")
+  paste(c(
+    "## App",
+    "",
+    "This app asks Jev, a decision model of TypeSafe, a question about each image or text in a set. For each input, it shows the answer and the probability of each answer. It also gives the R code of the run and a bundle with the setup and the answers. You need no key and no account.",
+    "",
+    "## Package",
+    "",
+    sprintf(
+      "The app uses the R package [decisions](%s), version %s. The [package record](%s) shows how the package was made and tested. The method comes from the paper \"Beyond CLIP: Calibrated (Few-Shot) Defect Detection With Structured Decision Models\" (in preparation). The [project record](%s) holds its decisions and its data.",
+      LINKS$package, package_version_text(), LINKS$package_record, LINKS$project_record
+    ),
+    "",
+    "## Model",
+    "",
+    sprintf(
+      "Each call goes to %s. The app sends each image with a longest side of %d pixels. It shows the raw probabilities of Jev. They are not calibrated. The package can calibrate them.",
+      cfg$model, cfg$image_settings$max_size
+    ),
+    "",
+    "## Limits",
+    "",
+    sprintf("- Each file: %d MB. Each zip file: %d MB.", cfg$max_file_mb, cfg$max_zip_mb),
+    sprintf(
+      "- Each run: %d images or %d texts. Each text: %s characters.",
+      cfg$max_images, cfg$max_texts, num(cfg$max_text_chars)
+    ),
+    sprintf(
+      "- Instructions: %d characters. Each description: %d characters.",
+      cfg$max_instructions, cfg$max_description
+    ),
+    sprintf(
+      "- Choice: %d to %d answers. Score: %d to %d levels. References: at most %d for each answer.",
+      cfg$answer_range$choice[1], cfg$answer_range$choice[2],
+      cfg$answer_range$score[1], cfg$answer_range$score[2], cfg$max_references
+    ),
+    sprintf(
+      "- Cost: %s for each visit, %s each day and %s each month for all visitors together (UTC). When a limit is reached, the samples and the R code still work.",
+      usd(cfg$limit_session), usd(cfg$limit_day), usd(cfg$limit_month)
+    ),
+    sprintf(
+      "- The app estimates the cost from the input tokens, at %s for each million tokens.",
+      usd(cfg$price_per_million)
+    ),
+    "",
+    "## Privacy",
+    "",
+    "Your images, texts and references go to TypeSafe (Jev). Do not upload confidential data. The app keeps no input after your session. It stores only the daily totals of calls, tokens and cost. The bundle and the logs hold no key.",
+    "",
+    "## Versions",
+    "",
+    sprintf(
+      "decisions-space %s (%s) \u00b7 decisions %s \u00b7 %s",
+      cfg$version, cfg$date, decisions_version(), cfg$model
+    ),
+    "",
+    "## Cite",
+    "",
+    sprintf(
+      "- Megahed, F. M., & Chen, Y.-J. (2026). *decisions: Typed decisions from decision models* (R package version %s). %s",
+      package_version_text(), LINKS$package
+    ),
+    sprintf(
+      "- Megahed, F. M., & Chen, Y.-J. (2026). *decisions Space* (Version %s) [Web application]. Hugging Face. https://huggingface.co/spaces/fmegahed/decisions",
+      cfg$version
+    ),
+    "",
+    "## Authors",
+    "",
+    AUTHORS,
+    "",
+    "## Source",
+    "",
+    sprintf(
+      "The source code is on [GitHub](%s), under the [MIT license](%s). Report a problem as an [issue](%s).",
+      LINKS$source, LINKS$license, LINKS$issues
+    )
+  ), collapse = "\n")
+}

R/render.R

@@ -0,0 +1,164 @@
+# Output builders: the dynamic inputs of the question (answer_rows,
+# reference_rows) and the parts of the outputs that the server renders
+# (spending meter, stats line, gallery, bundle files). The look is in
+# www/theme.css. They use sr(), upload_input() and IMAGE_ACCEPT of R/ui.R,
+# which R finds when a builder runs.
+
+# The answers of a question: a name and a description for each answer, with
+# buttons to add and remove answers. Yes / no has the fixed names true and
+# false, so it has no name inputs and no buttons.
+answer_rows <- function(question) {
+  answers <- question$answers
+  fixed <- question$type == "noul"
+  range <- answer_range(question$type)
+  rows <- purrr::map(seq_along(answers), \(i) {
+    shiny::div(
+      class = "answer-row",
+      if (fixed) {
+        shiny::span(class = "k", names(answers)[i])
+      } else {
+        shiny::textInput(paste0("answer_name_", i), sr(paste("Name of answer", i)), names(answers)[i])
+      },
+      shiny::textAreaInput(
+        paste0("answer_desc_", i), sr(paste("Description of answer", i)), answers[[i]], rows = 3
+      ),
+      if (!fixed && length(answers) > range[1]) {
+        shiny::actionButton(
+          paste0("answer_remove_", i), shiny::span(`aria-hidden` = "true", "\u00d7"),
+          class = "btn-quiet btn-icon", `aria-label` = paste("Remove answer", i)
+        )
+      }
+    )
+  })
+  shiny::tagList(
+    shiny::div(
+      class = "answer-head", `aria-hidden` = "true",
+      shiny::span(if (fixed) "Answer" else "Name"), shiny::span("Description")
+    ),
+    rows,
+    if (!fixed && length(answers) < range[2]) {
+      shiny::actionButton("answer_add", "Add answer", class = "btn-quiet sm")
+    }
+  )
+}
+
+# The id of the reference input of each answer: "ref_" and the clean name
+ref_input_id <- function(answers) {
+  paste0("ref_", janitor::make_clean_names(answers, case = "none"))
+}
+
+# One row for each answer: its reference images and a file input. `srcs` is a
+# named list of image addresses. A score question takes no references.
+reference_rows <- function(question, srcs = list()) {
+  if (question$type == "score") return(shiny::tagList())
+  answers <- names(question$answers)
+  ids <- ref_input_id(answers)
+  purrr::map(seq_along(answers), \(i) {
+    thumbs <- purrr::imap(srcs[[answers[i]]] %||% character(), \(src, j) {
+      shiny::img(src = src, alt = sprintf("Reference %d of %s", j, answers[i]))
+    })
+    shiny::div(
+      class = "ref-row",
+      shiny::span(class = "k-plain", answers[i]),
+      shiny::div(
+        shiny::div(class = "thumbs", thumbs),
+        upload_input(
+          ids[i], sr(paste("References of", answers[i])), IMAGE_ACCEPT,
+          multiple = TRUE, button = "Add"
+        )
+      )
+    )
+  }) |>
+    shiny::tagList()
+}
+
+# The spending meter of the visit
+spend_meter_ui <- function(spent, limit = LIMIT_SESSION) {
+  shiny::div(
+    class = "spend",
+    shiny::div(
+      class = "spend-row", shiny::span("This visit"),
+      shiny::span(class = "mono", sprintf("$%.2f of $%.2f", spent, limit))
+    ),
+    shiny::div(
+      class = "meter", `aria-hidden` = "true",
+      shiny::tags$i(style = sprintf("width:%.0f%%", min(100, 100 * spent / limit)))
+    )
+  )
+}
+
+# The stats line of answer_stats(); `note` is a short tag such as "Saved run"
+stats_ui <- function(stats, mode, note = NULL) {
+  item <- \(value, label) {
+    shiny::span(class = "stat", shiny::span(class = "v", value), shiny::span(class = "l", label))
+  }
+  shiny::div(
+    class = "stats",
+    if (!is.na(stats$auc)) item(sprintf("%.2f", stats$auc), "AUC"),
+    if (!is.na(stats$accuracy)) item(sprintf("%.2f", stats$accuracy), "accuracy"),
+    item(stats$n, if (mode == "image") "images" else "texts"),
+    item(sprintf("$%.3f", stats$cost), "cost"),
+    if (!is.null(note)) shiny::span(class = "chip", note)
+  )
+}
+
+# The gallery: one tile for each row of answers_table(), with the probability
+# of the target as a number and a bar, the answer and the label. `src` holds
+# the address of the image of each row.
+gallery_ui <- function(table, target, src) {
+  tiles <- purrr::map(seq_len(nrow(table)), \(i) {
+    row <- table[i, ]
+    p <- row$p_target
+    caption <- c(
+      if (!is.na(row$answer)) paste("answer", row$answer),
+      if (!is.na(row$label)) paste("label", row$label)
+    )
+    shiny::tags$figure(
+      class = "tile",
+      shiny::img(src = src[i], alt = alt_text(row, target), loading = "lazy"),
+      shiny::tags$figcaption(
+        if (is.na(p)) {
+          shiny::div(class = "t", if (is.na(row$problem)) "No answer" else row$problem)
+        } else {
+          shiny::div(
+            class = "p", sprintf("%.2f", p),
+            shiny::span(
+              class = "bar", `aria-hidden` = "true",
+              shiny::tags$i(style = sprintf("width:%.0f%%", 100 * p))
+            )
+          )
+        },
+        shiny::div(class = "t", paste(caption, collapse = " \u00b7 "))
+      )
+    )
+  })
+  shiny::div(class = "gallery", tiles)
+}
+
+# The files of the bundle, with one line on each. `files` are the names in the
+# zip file (a folder ends in "/").
+BUNDLE_FILE_TEXT <- c(
+  "\\.R$" = "The code above.",
+  "-setup\\.json$" = "Model, question, references and image settings. Read it with read_setup().",
+  "-answers\\.csv$" = "Each input: answer, probabilities, label, tokens, seconds.",
+  "^README\\.md$" = "Versions, date, install, key and citation. Import reopens the setup here.",
+  "^references/?$" = "The reference images of the run.",
+  "^data\\.csv$" = "Your texts. The code reads them."
+)
+bundle_files_ui <- function(files, zip_name) {
+  describe <- \(f) {
+    hit <- purrr::detect_index(names(BUNDLE_FILE_TEXT), \(pattern) stringr::str_detect(f, pattern))
+    if (hit == 0) "" else BUNDLE_FILE_TEXT[[hit]]
+  }
+  shiny::tagList(
+    shiny::h3(
+      class = "eyebrow", shiny::tags$b(`aria-hidden` = "true", "\u203a"), " Bundle \u00b7 ", zip_name
+    ),
+    shiny::tags$ul(
+      class = "files",
+      purrr::map(files, \(f) {
+        shiny::tags$li(class = "file", shiny::div(class = "n", f), shiny::div(class = "d", describe(f)))
+      })
+    )
+  )
+}

R/runs.R

@@ -0,0 +1,148 @@
+# Runs: calls to Jev in chunks, the classes of errors, and the cost.
+# The raw .error text of decide() can hold a part of a key. It must never be
+# shown or logged: the app uses only the category of classify_error().
+
+# The decider of TypeSafe; the key is read only when decide() asks for it
+make_decider <- function() {
+  decisions::decider_typesafe(MODEL, credentials = \() Sys.getenv(KEY_VAR))
+}
+
+# Row numbers 1..n in chunks of `size`, as a list of integer vectors
+chunk_ids <- function(n, size = CHUNK_SIZE) {
+  split(seq_len(n), ceiling(seq_len(n) / size)) |> unname()
+}
+
+# Names of the probability columns of decide(), one for each answer name
+pred_column <- function(answers) {
+  paste0(".pred_", janitor::make_clean_names(answers, case = "none"))
+}
+
+# Columns of a decide() output with NA answers, one row for each input.
+# The column names follow decide(): .pred_<cleaned answer name>.
+empty_answers <- function(question, n, error = "config") {
+  answers <- names(question$answers)
+  cols <- stats::setNames(
+    rep(list(rep(NA_real_, n)), length(answers)),
+    pred_column(answers)
+  )
+  out <- tibble::tibble(
+    .pred_class = factor(rep(NA_character_, n), levels = answers),
+    !!!cols
+  )
+  if (question$type == "score") out$.score <- rep(NA_real_, n)
+  out |>
+    dplyr::mutate(
+      .model = MODEL, .input_tokens = NA_real_, .cost = NA_real_,
+      .seconds = NA_real_, .error = error
+    )
+}
+
+# Run the inputs `rows` of a spec through decide(); one row for each input.
+# When decide() aborts (for example with no key), every row gets
+# .error = "config" and NA answers, so that the chunks can be bound.
+run_chunk <- function(spec, rows, decide_fn = decisions::decide) {
+  inputs <- spec$inputs[rows, ]
+  data_arg <- if (spec$mode == "image") {
+    list(image = inputs$path)
+  } else {
+    list(text = inputs$text)
+  }
+  answers <- tryCatch(
+    rlang::exec(
+      decide_fn, make_decider(), as_decisions_question(spec$question),
+      !!!data_arg, references = spec$references,
+      max_size = IMAGE_SETTINGS$max_size, upscale = IMAGE_SETTINGS$upscale,
+      crop = IMAGE_SETTINGS$crop
+    ),
+    error = \(e) empty_answers(spec$question, nrow(inputs))
+  )
+  tibble::as_tibble(answers) |>
+    dplyr::mutate(id = inputs$id, .before = 1)
+}
+
+# Category of an error text (vectorised): NA when there is no error
+classify_error <- function(text) {
+  dplyr::case_when(
+    is.na(text) ~ NA_character_,
+    text == "config" ~ "config",
+    stringr::str_detect(text, "^HTTP 402") |
+      stringr::str_detect(text, stringr::regex(
+        "credit|balance|insufficient|payment", ignore_case = TRUE
+      )) ~ "credit",
+    stringr::str_detect(text, "^HTTP 40[13]") ~ "auth",
+    stringr::str_detect(text, "^HTTP 429") ~ "rate",
+    stringr::str_detect(text, "^HTTP 5") |
+      stringr::str_detect(text, stringr::regex(
+        "timeout|timed out", ignore_case = TRUE
+      )) ~ "server",
+    stringr::str_detect(text, "^HTTP 4") ~ "input",
+    .default = "answer"
+  )
+}
+
+# The sentence that the visitor reads for a category
+error_message <- function(category) {
+  unname(c(
+    config = "The demo is not available right now.",
+    auth = "The demo is not available right now.",
+    credit = "The credit of this demo is used up. Try again later.",
+    rate = "Too many requests. Try again in a minute.",
+    server = "TypeSafe did not answer. Try again.",
+    input = "TypeSafe refused this input.",
+    answer = "The answer could not be read."
+  )[category])
+}
+
+# These categories stop all runs for the rest of the day
+stops_the_day <- function(category) {
+  category %in% c("config", "auth", "credit")
+}
+
+# Calls, input tokens and cost (USD) of the answers of a chunk
+chunk_usage <- function(answers) {
+  tokens <- sum(answers$.input_tokens, na.rm = TRUE)
+  list(calls = nrow(answers), tokens = tokens, cost = tokens * PRICE_PER_TOKEN)
+}
+
+# Cost (USD) of n inputs, with the guess or with the measured mean of tokens
+estimate_cost <- function(spec, n, mean_tokens = NULL) {
+  n * (mean_tokens %||% TOKENS_GUESS[[spec$mode]]) * PRICE_PER_TOKEN
+}
+
+# The files that a chunk of a spec reads: the images of its rows and every
+# reference. decide() aborts when one is missing, so the server checks them first.
+chunk_files <- function(spec, rows) {
+  c(character(), if (spec$mode == "image") spec$inputs$path[rows], unlist(spec$references, use.names = FALSE))
+}
+
+# The reasons not to start a run (empty when it can start). decisions checks the
+# question here, in this process: an error inside a chunk counts as a key
+# problem, and it stops the runs of the day.
+run_problems <- function(spec) {
+  if (nrow(spec$inputs) == 0) {
+    return(if (spec$mode == "image") "Add images first." else "Add texts first.")
+  }
+  problems <- check_question(spec$question)
+  if (length(problems) > 0) return(problems)
+  valid <- tryCatch(!is.null(as_decisions_question(spec$question)), error = \(e) FALSE)
+  if (!valid) {
+    return(paste(
+      "The app cannot use this question.",
+      "Write the instructions, and give each answer a different name."
+    ))
+  }
+  character()
+}
+
+# One log line for each chunk: the time, the counts, the tokens, the cost and
+# the error categories. Never an input, a file name, the question or an
+# .error text.
+log_chunk <- function(now, n, use, categories) {
+  counts <- table(categories[!is.na(categories)])
+  errors <- if (length(counts) == 0) "none" else paste(names(counts), counts, collapse = ", ")
+  message(sprintf(
+    "%s chunk: %d inputs, %d calls, %.0f tokens, USD %.6f, errors: %s",
+    format(now, "%Y-%m-%d %H:%M:%S UTC", tz = "UTC"), n, use$calls, use$tokens,
+    use$cost, errors
+  ))
+}

R/samples.R

@@ -0,0 +1,109 @@
+# Samples: the two runs of the vignettes of decisions, with their saved answers.
+# The inputs and the answers come from the installed package, so the app and
+# the vignettes cannot drift apart.
+
+# Numbers of the saved runs and the sentences that the help text shows
+SAMPLE_FACTS <- list(
+  textiles = c(auc = 0.75, accuracy = 0.80),
+  injuries = c(accuracy = 0.96)
+)
+SAMPLE_FACTS_TEXT <- list(
+  textiles = c(
+    sprintf(
+      "The saved run has an AUC of %.2f and an accuracy of %.2f.",
+      SAMPLE_FACTS$textiles[["auc"]], SAMPLE_FACTS$textiles[["accuracy"]]
+    ),
+    "Jev puts all 14 local flaws (one broken spot) at the top.",
+    "The 9 global flaws, where the whole pattern is distorted, score like regular weaves (0.14 to 0.26).",
+    "A sharper description of \"defective\" or another reference can help there."
+  ),
+  injuries = sprintf(
+    "The saved run has an accuracy of %.2f.", SAMPLE_FACTS$injuries[["accuracy"]]
+  )
+)
+
+# The questions, copied from the vignettes images.Rmd and choosing-a-model.Rmd
+sample_question <- function(id) {
+  switch(id,
+    textiles = list(
+      type = "choice",
+      instructions = "Does the woven pattern in `inspection_image` have a flaw?",
+      answers = c(
+        nominal = "The weave is regular. The pattern repeats with no break.",
+        defective = "The weave has a flaw. A part of the pattern is broken, or the whole pattern is distorted."
+      )
+    ),
+    injuries = list(
+      type = "choice",
+      instructions = "Which injury does this report of a work injury describe? Choose the main injury.",
+      answers = c(
+        amputation = "A body part is cut or torn off, in whole or in part.",
+        fracture = "A bone is broken or cracked.",
+        `crushing injury` = "A body part is squeezed hard between objects, and the tissue is damaged.",
+        `thermal burn` = "Heat, flame, hot liquid or a hot surface burns the skin.",
+        concussion = "A blow or a shake to the head hurts the brain."
+      )
+    )
+  )
+}
+
+# Folder of the textile images in the installed package
+textiles_folder <- function() {
+  system.file("extdata", "textiles", package = "decisions")
+}
+
+# The spec of a sample, id "textiles" or "injuries"
+sample_spec <- function(id) {
+  id <- rlang::arg_match(id, c("textiles", "injuries"))
+  if (id == "textiles") {
+    files <- decisions::textiles
+    inputs <- files |>
+      dplyr::filter(role == "input") |>
+      dplyr::transmute(
+        id = file, path = file.path(textiles_folder(), file),
+        text = NA_character_, file = file, label = as.character(class)
+      )
+    refs <- files |>
+      dplyr::filter(role == "reference") |>
+      dplyr::arrange(class, reference_rank) |>
+      dplyr::mutate(path = file.path(textiles_folder(), file))
+    references <- list(
+      nominal = refs$path[refs$class == "nominal"],
+      defective = refs$path[refs$class == "defective"]
+    )
+    mode <- "image"
+  } else {
+    saved <- readRDS(system.file("extdata", "choosing-a-model.rds", package = "decisions"))
+    inputs <- saved$injuries |>
+      dplyr::transmute(
+        id = id, path = NA_character_, text = final_narrative, file = id,
+        label = as.character(collapsed_nature_title)
+      )
+    references <- NULL
+    mode <- "text"
+  }
+  list(
+    mode = mode, question = sample_question(id), references = references,
+    inputs = inputs, source = id, name = id
+  )
+}
+
+# The saved output of decide() for Jev, with the id of each input
+sample_answers <- function(id) {
+  id <- rlang::arg_match(id, c("textiles", "injuries"))
+  saved <- readRDS(system.file(
+    "extdata", if (id == "textiles") "images.rds" else "choosing-a-model.rds",
+    package = "decisions"
+  ))
+  stopifnot(nrow(saved$answers$jev) == nrow(sample_spec(id)$inputs))
+  saved$answers$jev |>
+    dplyr::mutate(id = sample_spec(id)$inputs$id, .before = 1)
+}
+
+# The two samples, read once for each R process
+SAMPLE_CACHE <- new.env(parent = emptyenv())
+sample_data <- function(id) {
+  SAMPLE_CACHE[[id]] <- SAMPLE_CACHE[[id]] %||%
+    list(spec = sample_spec(id), answers = sample_answers(id))
+  SAMPLE_CACHE[[id]]
+}

R/server.R

@@ -0,0 +1,589 @@
+# Server: the wiring of the page. The logic is in the other files of R/; this
+# file keeps the state of a session (the question, the data, the answers and
+# the spend) and runs the calls to Jev in chunks, as a background task.
+#
+# app_deps() holds what a test replaces: decide(), the usage store, the status
+# reader, the clock, and `async` (FALSE runs the chunks in this R process).
+# app.R makes it once for all sessions, so its `state` (the stop for the UTC
+# day after a key or credit error) holds for every visitor.
+
+# The dependencies of the server. With SPACE_MOCK=1 (local checks only; the
+# Dockerfile never sets it), the mock of decide() and a store in memory
+# replace the defaults.
+app_deps <- function(decide_fn = decisions::decide, store = usage_store_hf(),
+                     status_fn = read_status, now = Sys.time, async = TRUE) {
+  if (Sys.getenv("SPACE_MOCK") == "1" && (missing(decide_fn) || missing(store))) {
+    mock <- mock_deps()
+    if (missing(decide_fn)) decide_fn <- mock$decide_fn
+    if (missing(store)) store <- mock$store
+  }
+  list(
+    decide_fn = decide_fn, store = store, status_fn = status_fn, now = now,
+    async = async, state = new.env(parent = emptyenv())
+  )
+}
+
+# The mock of the tests (with the saved answers of both samples) and a store in
+# memory. The mock stays in tests/: the app code holds no mock. APP_ROOT is the
+# app folder (set by app.R, and by the helper of the tests).
+mock_deps <- function(path = file.path(APP_ROOT, "tests", "testthat", "helper-mock.R")) {
+  if (!file.exists(path)) {
+    stop(
+      "SPACE_MOCK=1 needs ", path,
+      ". Start the app from the repository folder, or unset SPACE_MOCK.",
+      call. = FALSE
+    )
+  }
+  env <- new.env(parent = environment(mock_deps))
+  sys.source(path, envir = env)
+  lookup <- dplyr::bind_rows(env$sample_lookup("textiles"), env$sample_lookup("injuries"))
+  list(decide_fn = env$mock_decide(lookup), store = usage_store_memory())
+}
+
+# The category that stops the runs today, or NULL
+stop_reason <- function(deps) {
+  if (identical(deps$state$stop_day, utc_date(deps$now()))) deps$state$stop_reason
+}
+
+# The accounts of a chunk, in the main R process (never in a daemon): add the
+# usage to the store, stop the day after a key or credit error, and write the
+# log line. Rows that failed before any request ("config") cost nothing.
+account_chunk <- function(answers, deps) {
+  categories <- classify_error(answers$.error)
+  use <- chunk_usage(answers[!categories %in% "config", ])
+  now <- deps$now()
+  usage <- if (use$calls > 0) usage_record(deps$store, now, use$calls, use$tokens, use$cost)
+  stop <- dplyr::first(categories[stops_the_day(categories)])
+  if (!is.na(stop)) {
+    deps$state$stop_day <- utc_date(now)
+    deps$state$stop_reason <- stop
+  }
+  log_chunk(now, nrow(answers), use, categories)
+  list(answers = answers, cost = use$cost, usage = usage)
+}
+
+app_server <- function(input, output, session, deps = app_deps()) {
+  # --- The folder of the session: uploads, imports and thumbnails -----------
+  dir <- tempfile("session")
+  dir.create(file.path(dir, "thumbs"), recursive = TRUE)
+  # The thumbnails are served under a prefix that no other visitor can guess
+  prefix <- paste(openssl::rand_bytes(16), collapse = "")
+  shiny::addResourcePath(prefix, file.path(dir, "thumbs"))
+  uploads <- character()
+  folders <- 0L
+  new_dir <- function(kind) {
+    folders <<- folders + 1L
+    file.path(dir, kind, folders)
+  }
+  keep_uploads <- function(files) uploads <<- c(uploads, files$datapath)
+  job <- new.env(parent = emptyenv())
+  # Files are deleted only when no chunk is in flight: a chunk reads its images
+  # and references until it ends, and a missing file would stop the day
+  after_chunk <- function(delete) {
+    if (isTRUE(job$in_flight)) job$deletes <- c(job$deletes, delete) else delete()
+  }
+  session$onSessionEnded(\() {
+    shiny::removeResourcePath(prefix)
+    remove_uploads(uploads)
+    after_chunk(\() unlink(dir, recursive = TRUE))
+  })
+
+  # The thumbnail of an image, and its address ("" for an image that cannot be read)
+  thumb_file <- function(path) file.path(dir, "thumbs", paste0(rlang::hash(path), ".jpg"))
+  thumb <- function(paths) {
+    purrr::map_chr(paths, \(path) {
+      dest <- thumb_file(path)
+      if (file.exists(dest) || make_thumb(path, dest)) paste0(prefix, "/", basename(dest)) else ""
+    })
+  }
+
+  # --- State --------------------------------------------------------------------
+  question <- shiny::reactiveVal()
+  refs <- shiny::reactiveVal(list()) # reference paths, one element for each answer
+  data_mode <- shiny::reactiveVal("image")
+  data_source <- shiny::reactiveVal("textiles")
+  image_upload <- shiny::reactiveVal(NULL)
+  csv_file <- shiny::reactiveVal(NULL)
+  text_kind <- shiny::reactiveVal("paste")
+  results <- shiny::reactiveVal(NULL) # list(answers, key, saved, token of the run)
+  mean_tokens <- shiny::reactiveVal(NULL) # list(fingerprint, mean)
+  session_cost <- shiny::reactiveVal(0)
+  usage <- shiny::reactiveVal(deps$store$read())
+  notice <- shiny::reactiveVal(character())
+  running <- shiny::reactiveVal(FALSE)
+  rows_version <- shiny::reactiveVal(0) # renders the answer rows again
+
+  # --- The spec of the sidebar --------------------------------------------------
+  text_upload <- shiny::reactive({
+    csv <- csv_file()
+    if (text_kind() == "paste" || is.null(csv)) {
+      return(c(read_text_paste(input$paste_text), list(name = "texts")))
+    }
+    if (length(csv$columns) == 0) {
+      return(list(
+        inputs = empty_inputs(), problems = "The CSV file could not be read.", name = csv$name
+      ))
+    }
+    column <- if (isTRUE(input$csv_text_col %in% csv$columns)) input$csv_text_col else csv$text_col
+    label <- if (isTRUE(input$csv_label_col %in% csv$columns)) input$csv_label_col
+    c(read_text_csv(csv$path, column, label, csv$file), list(name = csv$name, text_column = column))
+  })
+  data <- shiny::reactive({
+    id <- data_source()
+    if (id != "upload") return(list(inputs = sample_data(id)$spec$inputs, name = id))
+    upload <- if (data_mode() == "image") image_upload() else text_upload()
+    upload %||% list(inputs = empty_inputs(), name = "upload")
+  })
+  matched <- shiny::reactive(match_labels(data()$inputs, question()$answers))
+  spec <- shiny::reactive({
+    q <- question()
+    references <- if (data_mode() == "image" && q$type != "score") {
+      stats::setNames(refs()[seq_along(q$answers)], names(q$answers)) |> purrr::compact()
+    }
+    list(
+      mode = data_mode(), question = q,
+      references = if (length(references) > 0) references,
+      inputs = matched()$inputs, source = data_source(), name = data()$name,
+      text_column = data()$text_column
+    )
+  })
+  key <- shiny::reactive(answers_key(spec()))
+  # The type and the names of the answers: the reference rows and the target follow them
+  layout <- shiny::reactiveVal()
+  shiny::observe(layout(list(type = question()$type, answers = names(question()$answers))))
+
+  # Send the setup of the server to the inputs of the page. The page answers
+  # each update with the new value, so an observer never sends its own input
+  # (or one above it: mode, then source, then the question) back: two crossing
+  # updates would flip the input forever. `send` names the inputs of the data.
+  show_setup <- function(send = c("mode", "source")) {
+    q <- question()
+    if ("mode" %in% send) shiny::updateRadioButtons(session, "mode", selected = data_mode())
+    if ("source" %in% send) {
+      shiny::updateSelectInput(
+        session, "source", choices = source_choices(data_mode()), selected = data_source()
+      )
+    }
+    shiny::updateRadioButtons(session, "qtype", selected = q$type)
+    shiny::updateTextAreaInput(session, "instructions", value = q$instructions)
+    shiny::updateRadioButtons(
+      session, "view", selected = if (data_mode() == "image") "gallery" else "table"
+    )
+    rows_version(rows_version() + 1)
+  }
+
+  # A sample opens with its saved answers and makes no call
+  load_sample <- function(id, send = c("mode", "source")) {
+    sample <- sample_data(id)
+    question(sample$spec$question)
+    refs(unname(sample$spec$references) %||% list())
+    data_mode(sample$spec$mode)
+    data_source(id)
+    results(list(answers = sample$answers, key = answers_key(sample$spec), saved = TRUE))
+    notice(character())
+    show_setup(send)
+  }
+  # The page opens with Images and the textile sample; only the choices of the source change
+  shiny::isolate(load_sample("textiles", send = "source"))
+
+  # --- Data -------------------------------------------------------------------
+  shiny::observeEvent(input$sample_textiles, load_sample("textiles"))
+  shiny::observeEvent(input$sample_injuries, load_sample("injuries"))
+  shiny::observeEvent(input$mode, {
+    if (input$mode == data_mode()) return()
+    if (data_source() != "upload") {
+      return(load_sample(if (input$mode == "image") "textiles" else "injuries", send = "source"))
+    }
+    data_mode(input$mode)
+    refs(list())
+    notice(character())
+    show_setup(send = "source")
+  })
+  shiny::observeEvent(input$source, {
+    # A source of the other mode is the late answer to an older update
+    if (input$source == data_source() || !input$source %in% source_choices(data_mode())) return()
+    if (input$source != "upload") return(load_sample(input$source, send = character()))
+    data_source("upload")
+    refs(list())
+    notice(character())
+  })
+  shiny::observeEvent(input$upload_images, {
+    files <- input$upload_images
+    keep_uploads(files)
+    notice(character())
+    old <- image_upload()
+    if (!is.null(old)) {
+      after_chunk(\() unlink(c(old$dir, thumb_file(old$inputs$path)), recursive = TRUE))
+    }
+    read <- read_images(files, dir = new_dir("images"))
+    bad <- thumb(read$inputs$path) == ""
+    image_upload(list(
+      inputs = read$inputs[!bad, ], dir = read$dir,
+      problems = c(
+        read$problems, sprintf("%s could not be read and was skipped.", read$inputs$file[bad])
+      ),
+      name = if (nrow(files) == 1) tools::file_path_sans_ext(files$name) else "images"
+    ))
+  })
+  shiny::observeEvent(input$paste_text, text_kind("paste"), ignoreInit = TRUE)
+  shiny::observeEvent(input$upload_csv, {
+    file <- input$upload_csv
+    keep_uploads(file)
+    notice(character())
+    path <- file.path(new_dir("csv"), "data.csv")
+    dir.create(dirname(path), recursive = TRUE)
+    file.copy(file$datapath, path)
+    columns <- csv_columns(path)
+    text_col <- if ("text" %in% columns) "text" else columns[1]
+    csv_file(list(
+      path = path, file = file$name, name = tools::file_path_sans_ext(file$name),
+      columns = columns, text_col = text_col
+    ))
+    text_kind("csv")
+    shiny::updateSelectInput(session, "csv_text_col", choices = columns, selected = text_col)
+    shiny::updateSelectInput(
+      session, "csv_label_col", choices = c(None = "", columns), selected = ""
+    )
+  })
+
+  # --- Question ---------------------------------------------------------------
+  # Each input changes one part of the question. A change that the server made
+  # comes back from the page with the same value, so it changes nothing.
+  shiny::observeEvent(input$instructions, {
+    q <- question()
+    q$instructions <- input$instructions
+    question(q)
+  })
+  edit_answer <- function(i, part, value) {
+    q <- question()
+    if (i > length(q$answers) || (part == "name" && q$type == "noul")) return()
+    if (part == "name") names(q$answers)[i] <- value else q$answers[[i]] <- value
+    question(q)
+  }
+  purrr::walk(seq_len(max(unlist(ANSWER_RANGE))), \(i) {
+    shiny::observeEvent(input[[paste0("answer_name_", i)]], {
+      edit_answer(i, "name", input[[paste0("answer_name_", i)]])
+    })
+    shiny::observeEvent(input[[paste0("answer_desc_", i)]], {
+      edit_answer(i, "desc", input[[paste0("answer_desc_", i)]])
+    })
+    shiny::observeEvent(input[[paste0("answer_remove_", i)]], {
+      q <- question()
+      if (i > length(q$answers) || length(q$answers) <= answer_range(q$type)[1]) return()
+      q$answers <- q$answers[-i]
+      question(q)
+      refs(refs()[-i])
+      rows_version(rows_version() + 1)
+    })
+  })
+  shiny::observeEvent(input$answer_add, {
+    q <- question()
+    n <- length(q$answers)
+    if (n >= answer_range(q$type)[2]) return()
+    name <- utils::tail(make.unique(c(names(q$answers), paste("answer", n + 1)), sep = " "), 1)
+    q$answers <- c(q$answers, stats::setNames("", name))
+    question(q)
+    rows_version(rows_version() + 1)
+  })
+  shiny::observeEvent(input$qtype, {
+    q <- question()
+    if (input$qtype == q$type) return()
+    q$answers <- if (input$qtype == "noul") {
+      c(true = "", false = "")
+    } else {
+      utils::head(q$answers, answer_range(input$qtype)[2])
+    }
+    q$type <- input$qtype
+    question(q)
+    rows_version(rows_version() + 1)
+  })
+  # The reference inputs: a new upload replaces the references of its answer
+  seen <- character()
+  shiny::observe({
+    ids <- ref_input_id(shiny::req(layout())$answers)
+    for (i in seq_along(ids)) {
+      files <- input[[ids[i]]]
+      if (is.null(files) || all(files$datapath %in% seen)) next
+      seen <<- c(seen, files$datapath)
+      keep_uploads(files)
+      read <- read_references(files, dir = new_dir("references"))
+      shiny::isolate({
+        r <- refs()
+        r[[i]] <- read$paths
+        refs(r)
+        notice(read$problems)
+      })
+    }
+  })
+  # Import restores the question and the references; it makes no call
+  shiny::observeEvent(input$import_file, {
+    file <- input$import_file
+    keep_uploads(file)
+    read <- read_import(file$datapath, dir = new_dir("import"))
+    if (is.null(read$question)) return(notice(read$problems))
+    question(read$question)
+    refs(purrr::map(names(read$question$answers), \(a) read$references[[a]] %||% character()))
+    if (length(read$references) > 0 && data_mode() == "text") {
+      data_mode("image")
+      data_source("upload")
+    }
+    notice(c("The setup is imported.", read$problems))
+    show_setup()
+  })
+  shiny::observe({
+    l <- shiny::req(layout())
+    shiny::updateSelectInput(
+      session, "target", choices = if (l$type == "noul") "true" else l$answers,
+      selected = target_answer(shiny::isolate(question()), shiny::isolate(input$target))
+    )
+  })
+
+  # The answers show only while the setup and the inputs are those of the
+  # answers (table() checks the key). They are not deleted: the page can answer
+  # an older update late, and the setup then comes back. A change stops a run.
+  shiny::observe({
+    k <- key()
+    if (shiny::isolate(running()) && !identical(job$key, k)) job$stop <- TRUE
+  })
+
+  # --- Runs -------------------------------------------------------------------
+  mean_for <- function(s) {
+    m <- mean_tokens()
+    if (!is.null(m) && identical(m$fingerprint, spec_fingerprint(s))) m$mean
+  }
+  checks <- shiny::reactive({
+    s <- spec()
+    status <- spend_status(session_cost(), usage(), deps$now())
+    purrr::map(c(try5 = 5, run_all = Inf), \(k) {
+      n <- min(k, nrow(s$inputs))
+      cost <- estimate_cost(s, n, mean_for(s))
+      c(run_allowed(cost, status), list(n = n, cost = cost))
+    })
+  })
+  shiny::observe({
+    shiny::updateActionButton(session, "try5", disabled = !checks()$try5$ok)
+    shiny::updateActionButton(session, "run_all", disabled = !checks()$run_all$ok)
+  })
+
+  # Each chunk runs in a mirai daemon (or here, when async is FALSE); its
+  # accounts are kept in this process, also when the session has ended. The
+  # files that waited for the chunk are deleted when it ends.
+  task <- shiny::ExtendedTask$new(function(spec, rows) {
+    job$in_flight <- TRUE
+    chunk <- tryCatch(
+      if (deps$async) {
+        mirai::mirai(
+          run_chunk(spec, rows, decide_fn),
+          .args = list(spec = spec, rows = rows, decide_fn = deps$decide_fn)
+        )
+      } else {
+        run_chunk(spec, rows, deps$decide_fn)
+      },
+      error = \(e) promises::promise_reject(e)
+    )
+    promises::then(promises::promise_resolve(chunk), \(answers) account_chunk(answers, deps)) |>
+      promises::finally(\() {
+        job$in_flight <- FALSE
+        deletes <- job$deletes
+        job$deletes <- NULL
+        purrr::walk(deletes, \(delete) delete())
+      }) |>
+      # A closed session has no task to finish (it would fail on its destroyed
+      # values): its chunk was counted above, and the promise stays open
+      promises::then(
+        onFulfilled = \(done) if (session$isClosed()) never_settles() else done,
+        onRejected = \(e) if (session$isClosed()) never_settles() else stop(e)
+      )
+  })
+  never_settles <- function() promises::promise(\(resolve, reject) NULL)
+  # Before each chunk, its images and references must exist. A missing file
+  # ends the run; decide() would abort, and that would stop the day.
+  run_next <- function() {
+    rows <- job$chunks[[job$done + 1L]]
+    if (!all(file.exists(chunk_files(job$spec, rows)))) {
+      notice("The files of this run are not available. Upload them again.")
+      return(end_run())
+    }
+    task$invoke(job$spec, rows)
+  }
+
+  start_run <- function(n) {
+    if (running()) return()
+    s <- spec()
+    problems <- run_problems(s)
+    if (length(problems) > 0) return(notice(problems))
+    if (!is.null(stop_reason(deps))) return(notice(error_message(stop_reason(deps))))
+    # The latest totals of all sessions decide, not the copy of this session
+    latest <- deps$store$read()
+    usage(latest)
+    n <- min(n, nrow(s$inputs))
+    allowed <- run_allowed(
+      estimate_cost(s, n, mean_for(s)), spend_status(session_cost(), latest, deps$now())
+    )
+    if (!allowed$ok) return(notice(limit_message(allowed$reason)))
+    notice(character())
+    job$spec <- s
+    job$key <- key()
+    job$chunks <- chunk_ids(n)
+    job$done <- 0L
+    job$stop <- FALSE
+    job$answers <- NULL
+    # The run writes its answers only while the card holds the answers that it
+    # found or wrote: a sample loaded during the run keeps its saved answers
+    job$token <- (job$token %||% 0L) + 1L
+    results(utils::modifyList(results() %||% list(), list(token = job$token)))
+    running(TRUE)
+    session$sendCustomMessage("run-state", TRUE)
+    run_next()
+  }
+  end_run <- function() {
+    running(FALSE)
+    session$sendCustomMessage("run-state", FALSE)
+  }
+  # After each chunk: show its answers, then run the next chunk or stop
+  finish_chunk <- function(done) {
+    if (!running()) return()
+    job$done <- job$done + 1L
+    if (is.null(done)) {
+      notice("The run stopped. Try again.")
+      return(end_run())
+    }
+    session_cost(session_cost() + done$cost)
+    if (!is.null(done$usage)) usage(done$usage)
+    job$answers <- dplyr::bind_rows(job$answers, done$answers)
+    shown <- identical(results()$token, job$token)
+    if (shown) results(list(answers = job$answers, key = job$key, saved = FALSE, token = job$token))
+    # Only calls with tokens count: a mean of 0 would make the next run look free
+    tokens <- job$answers$.input_tokens
+    tokens <- tokens[!is.na(tokens) & tokens > 0]
+    if (length(tokens) > 0) {
+      mean_tokens(list(fingerprint = spec_fingerprint(job$spec), mean = mean(tokens)))
+    }
+    reason <- stop_reason(deps)
+    if (!is.null(reason)) notice(error_message(reason))
+    # A run whose answers nobody sees stops (its chunk is counted all the same)
+    if (job$stop || !shown || !is.null(reason) || job$done >= length(job$chunks)) return(end_run())
+    run_next()
+  }
+  shiny::observe({
+    if (!task$status() %in% c("success", "error")) return()
+    done <- tryCatch(task$result(), error = \(e) NULL)
+    shiny::isolate(finish_chunk(done))
+  })
+  shiny::observeEvent(input$try5, start_run(5))
+  shiny::observeEvent(input$run_all, start_run(Inf))
+  # Stop takes effect at the end of the current chunk
+  shiny::observeEvent(input$stop, job$stop <- TRUE, priority = 10)
+
+  # --- Outputs: sidebar -------------------------------------------------------
+  output$answers_ui <- shiny::renderUI({
+    rows_version()
+    answer_rows(shiny::isolate(question()))
+  })
+  output$references_ui <- shiny::renderUI({
+    l <- shiny::req(layout())
+    r <- refs()
+    srcs <- purrr::map(seq_along(l$answers), \(i) {
+      if (i <= length(r)) thumb(r[[i]]) else character()
+    })
+    reference_rows(
+      list(type = l$type, answers = stats::setNames(character(length(l$answers)), l$answers)),
+      stats::setNames(srcs, l$answers)
+    )
+  })
+  # A cost below one cent reads "< $0.01", not "$0.00": a run is never free
+  output$run_estimate <- shiny::renderText({
+    all <- checks()$run_all
+    cost <- if (all$cost > 0 && all$cost < 0.005) "< $0.01" else sprintf("\u2248 $%.2f", all$cost)
+    paste(all$n, "\u00b7", cost)
+  })
+  output$spend_meter <- shiny::renderUI(spend_meter_ui(session_cost()))
+  output$limits_text <- shiny::renderText({
+    all <- checks()$run_all
+    refused <- if (!all$ok) limit_message(all$reason)
+    sentences <- unique(c(notice(), data()$problems, matched()$problems, refused))
+    paste(stringr::str_replace(sentences, "([^.!?])$", "\\1."), collapse = " ")
+  })
+
+  # --- Outputs: answers -------------------------------------------------------
+  target <- shiny::reactive(target_answer(question(), input$target))
+  table <- shiny::reactive({
+    r <- results()
+    if (is.null(r$answers) || !identical(r$key, key())) return(NULL)
+    answers_table(spec(), r$answers, target())
+  })
+  # The table of the downloads: no rows while the card shows no answers
+  download_table <- shiny::reactive(table() %||% empty_table(spec()))
+  stats <- shiny::reactive(if (!is.null(table())) answer_stats(table(), spec(), target()))
+  output$stats <- shiny::renderUI({
+    if (is.null(stats())) return(NULL)
+    r <- results()
+    note <- if (r$saved) {
+      paste0("Saved run, ", MODEL)
+    } else if (running()) {
+      sprintf("%d of %d", nrow(r$answers), length(unlist(job$chunks)))
+    }
+    stats_ui(stats(), spec()$mode, note)
+  })
+  output$help_answers <- shiny::renderText({
+    if (is.null(stats())) return(help_text("answers"))
+    help_note(spec(), stats(), target(), saved = results()$saved)
+  })
+  output$gallery <- shiny::renderUI({
+    t <- table()
+    if (is.null(t) || spec()$mode != "image") return(NULL)
+    inputs <- spec()$inputs
+    gallery_ui(t, target(), thumb(inputs$path[match(t$id, inputs$id)]))
+  })
+  output$table <- shiny::renderTable(
+    if (!is.null(table())) table_view(table(), spec()),
+    digits = 2, na = ""
+  )
+  output$download_answers <- shiny::downloadHandler(
+    filename = \() paste0(run_name(spec()), "-answers.csv"),
+    content = \(file) readr::write_file(answers_csv(download_table()), file)
+  )
+
+  # --- Outputs: R code and bundle ---------------------------------------------
+  run_date <- function() as.Date(deps$now())
+  zip_name <- function() sprintf("%s-%s.zip", run_name(spec()), format(run_date()))
+  code <- shiny::reactive(run_code(spec(), run_date()))
+  output$code_summary <- shiny::renderText(
+    sprintf("R code of this run \u00b7 %d lines", code_lines(code()))
+  )
+  output$code <- shiny::renderText(code())
+  output$bundle_files <- shiny::renderUI(bundle_files_ui(bundle_names(spec()), zip_name()))
+  for (id in c("code", "bundle_files", "code_summary")) {
+    shiny::outputOptions(output, id, suspendWhenHidden = FALSE)
+  }
+  output$download_code <- shiny::downloadHandler(
+    filename = \() paste0(run_name(spec()), ".R"),
+    content = \(file) readr::write_file(paste0(code(), "\n"), file)
+  )
+  output$download_bundle <- shiny::downloadHandler(
+    filename = zip_name,
+    content = \(file) write_bundle(spec(), download_table(), file, run_date())
+  )
+
+  # --- Outputs: status ----------------------------------------------------------
+  # The status file is read at the start and every hour
+  status <- shiny::reactive({
+    shiny::invalidateLater(3600000)
+    status_summary(deps$status_fn(), deps$now())
+  })
+  output$status_chip <- shiny::renderText(status_chip(status()))
+  output$record_table <- shiny::renderTable(
+    {
+      s <- status()
+      s$last |>
+        dplyr::arrange(dplyr::desc(time_utc)) |>
+        dplyr::transmute(
+          `Time (UTC)` = time_utc, HTTP = suppressWarnings(as.integer(http_status)),
+          Seconds = suppressWarnings(as.numeric(seconds)),
+          !!sprintf("Answered (%d of %d)", s$answered, s$checks) := answered,
+          Version = app_version
+        )
+    },
+    digits = 1, na = ""
+  )
+}

R/spec.R

@@ -0,0 +1,76 @@
+# Run spec: the question, the references and the inputs of one run.
+#
+# A question is list(type, instructions, answers). The type is "noul",
+# "choice" or "score". The names of answers are the answer names. The values
+# are the descriptions ("" for none). For noul the names are "true" and "false".
+#
+# A spec is list(mode, question, references, inputs, source, name). The inputs
+# are a tibble with id, path, text, file and label.
+
+# The smallest and the largest number of answers of a type. Yes / no has the
+# two fixed answers true and false.
+answer_range <- function(type) ANSWER_RANGE[[type]] %||% c(2, 2)
+
+# Problems of a question, as a character vector (empty when it is valid)
+check_question <- function(question) {
+  answers <- question$answers
+  problems <- character()
+  if (question$type %in% names(ANSWER_RANGE)) {
+    range <- ANSWER_RANGE[[question$type]]
+    if (length(answers) < range[1] || length(answers) > range[2]) {
+      problems <- c(problems, stringr::str_glue(
+        "A {question$type} question needs {range[1]} to {range[2]} answers."
+      ))
+    }
+  }
+  if (nchar(question$instructions) > MAX_INSTRUCTIONS) {
+    problems <- c(problems, stringr::str_glue(
+      "The instructions can have {MAX_INSTRUCTIONS} characters at most."
+    ))
+  }
+  if (any(nchar(answers) > MAX_DESCRIPTION)) {
+    problems <- c(problems, stringr::str_glue(
+      "A description can have {MAX_DESCRIPTION} characters at most."
+    ))
+  }
+  keys <- stringr::str_to_lower(stringr::str_squish(names(answers)))
+  if (anyDuplicated(keys) > 0 || any(keys == "")) {
+    problems <- c(problems, "The answer names must be unique and not empty.")
+  }
+  as.character(problems)
+}
+
+# The question of the decisions package that decide() needs
+as_decisions_question <- function(question) {
+  answers <- as.list(question$answers)
+  switch(question$type,
+    noul = decisions::question_noul(
+      question$instructions,
+      true = if (nzchar(answers$true)) answers$true,
+      false = if (nzchar(answers$false)) answers$false
+    ),
+    choice = decisions::question_choice(question$instructions, unlist(answers)),
+    score = decisions::question_score(question$instructions, unlist(answers))
+  )
+}
+
+# The answer that counts as the target of the metrics
+target_answer <- function(question, pick = NULL) {
+  answers <- names(question$answers)
+  if (question$type == "noul") {
+    "true"
+  } else if (!is.null(pick) && pick %in% answers) {
+    pick
+  } else {
+    dplyr::last(answers)
+  }
+}
+
+# One hash for what decides the answers, so that a saved run can be matched
+spec_fingerprint <- function(spec) {
+  rlang::hash(list(
+    spec$mode, spec$question$type, spec$question$instructions,
+    spec$question$answers, MODEL,
+    purrr::map(spec$references, \(paths) list(basename(paths), file.size(paths)))
+  ))
+}

R/spending.R

@@ -0,0 +1,187 @@
+# Spending: the usage totals, the limits, and the stores that keep the totals.
+# A usage store is list(read = function() <tibble>, write = function(usage)).
+# The tibble has one row for each UTC date: date, calls, input_tokens, cost.
+# The usage token is read only here. It is never in a message or a warning.
+
+# A usage with no rows
+empty_usage <- function() {
+  tibble::tibble(
+    date = character(), calls = integer(),
+    input_tokens = double(), cost = double()
+  )
+}
+
+# UTC date (YYYY-MM-DD) of a time
+utc_date <- function(now) format(now, "%Y-%m-%d", tz = "UTC")
+
+# Add a chunk to the row of the UTC date of `now`
+usage_add <- function(usage, now, calls, tokens, cost) {
+  day <- utc_date(now)
+  add <- tibble::tibble(
+    date = day, calls = as.integer(calls),
+    input_tokens = as.numeric(tokens), cost = as.numeric(cost)
+  )
+  dplyr::bind_rows(usage, add) |>
+    dplyr::summarise(
+      dplyr::across(c(calls, input_tokens, cost), sum), .by = date
+    ) |>
+    dplyr::arrange(date)
+}
+
+# For each date, the larger totals of two usages (the totals only grow)
+usage_merge <- function(a, b) {
+  dplyr::bind_rows(a, b) |>
+    dplyr::summarise(
+      dplyr::across(c(calls, input_tokens, cost), max), .by = date
+    ) |>
+    dplyr::arrange(date)
+}
+
+# Read the latest totals, add the chunk, write, and return the new usage.
+# Each session adds to the latest totals, so it never writes a stale copy.
+usage_record <- function(store, now, calls, tokens, cost) {
+  usage <- store$read() |>
+    usage_add(now, calls, tokens, cost)
+  store$write(usage)
+  usage
+}
+
+# Seconds to wait for Hugging Face (a stalled call would block every visitor)
+USAGE_TIMEOUT <- 10
+
+# Parse the text of usage.csv; NULL when the columns, a date or a total is bad
+parse_usage <- function(text) {
+  usage <- tryCatch(
+    suppressWarnings(readr::read_csv(
+      I(text),
+      col_types = readr::cols(
+        date = "c", calls = "i", input_tokens = "d", cost = "d"
+      ),
+      na = character(), show_col_types = FALSE
+    )),
+    error = \(e) NULL
+  )
+  ok <- !is.null(usage) &&
+    all(c("date", "calls", "input_tokens", "cost") %in% names(usage)) &&
+    all(grepl("^[0-9]{4}-[0-9]{2}-[0-9]{2}$", usage$date)) &&
+    !anyNA(usage[c("calls", "input_tokens", "cost")])
+  if (!ok) return(NULL)
+  usage[c("date", "calls", "input_tokens", "cost")]
+}
+
+# Store in memory (tests and the local mock mode)
+usage_store_memory <- function(usage = empty_usage()) {
+  list(
+    read = function() usage,
+    write = function(new) {
+      usage <<- new
+      invisible(TRUE)
+    }
+  )
+}
+
+# Store in a private Hugging Face dataset (the file usage.csv).
+# The cache holds the last totals written or read: if a request fails, the app
+# goes on with the cache.
+usage_store_hf <- function(repo = USAGE_REPO,
+                           token = Sys.getenv(USAGE_TOKEN_VAR)) {
+  cache <- empty_usage()
+  auth <- paste("Bearer", token)
+
+  # Send a request; NULL when it fails. The text of a failure has no token.
+  send <- function(req, what) {
+    resp <- tryCatch(
+      req |>
+        httr2::req_headers(Authorization = auth) |>
+        httr2::req_timeout(USAGE_TIMEOUT) |>
+        httr2::req_error(is_error = \(r) FALSE) |>
+        httr2::req_perform(),
+      error = \(e) NULL
+    )
+    if (is.null(resp)) {
+      warning("usage store: ", what, " failed (no response)", call. = FALSE)
+    }
+    resp
+  }
+
+  read <- function() {
+    url <- paste0("https://huggingface.co/datasets/", repo, "/resolve/main/usage.csv")
+    resp <- send(httr2::request(url), "read")
+    if (is.null(resp)) return(cache)
+    status <- httr2::resp_status(resp)
+    if (status == 404) return(cache)
+    if (status >= 400) {
+      warning("usage store: read failed (HTTP ", status, ")", call. = FALSE)
+      return(cache)
+    }
+    remote <- parse_usage(httr2::resp_body_string(resp))
+    if (is.null(remote)) {
+      warning("usage store: read failed (bad file)", call. = FALSE)
+      return(cache)
+    }
+    cache <<- usage_merge(remote, cache)
+    cache
+  }
+
+  write <- function(usage) {
+    cache <<- usage_merge(cache, usage)
+    csv <- readr::format_csv(cache)
+    lines <- list(
+      list(key = "header", value = list(summary = paste("usage", utc_date(Sys.time())))),
+      list(key = "file", value = list(
+        path = "usage.csv",
+        content = jsonlite::base64_enc(charToRaw(csv)),
+        encoding = "base64"
+      ))
+    ) |>
+      purrr::map_chr(\(x) as.character(jsonlite::toJSON(x, auto_unbox = TRUE)))
+    body <- paste0(paste(lines, collapse = "\n"), "\n")
+    url <- paste0("https://huggingface.co/api/datasets/", repo, "/commit/main")
+    resp <- send(
+      httr2::request(url) |> httr2::req_body_raw(body, "application/x-ndjson"),
+      "write"
+    )
+    if (is.null(resp)) return(invisible(FALSE))
+    status <- httr2::resp_status(resp)
+    if (status >= 400) {
+      warning("usage store: write failed (HTTP ", status, ")", call. = FALSE)
+      return(invisible(FALSE))
+    }
+    invisible(TRUE)
+  }
+
+  list(read = read, write = write)
+}
+
+# Money left (USD) in the session, the UTC day and the UTC month of `now`
+spend_status <- function(session_cost, usage, now = Sys.time()) {
+  day <- utc_date(now)
+  spent <- function(rows) sum(usage$cost[rows])
+  list(
+    session_left = LIMIT_SESSION - session_cost,
+    day_left = LIMIT_DAY - spent(usage$date == day),
+    month_left = LIMIT_MONTH - spent(substr(usage$date, 1, 7) == substr(day, 1, 7))
+  )
+}
+
+# Is a run with this estimated cost allowed? The first limit that fails wins.
+# An NA amount fails the limit, so the check fails closed.
+run_allowed <- function(estimate, status) {
+  fits <- \(left) isTRUE(estimate <= left)
+  reason <- dplyr::case_when(
+    !fits(status$session_left) ~ "session",
+    !fits(status$day_left) ~ "day",
+    !fits(status$month_left) ~ "month",
+    .default = NA_character_
+  )
+  list(ok = is.na(reason), reason = reason)
+}
+
+# The text for a refused run (the three texts of the design, section 6)
+limit_message <- function(reason) {
+  c(
+    session = "The limit of this visit is reached.",
+    day = "The limit of today is reached. Try again tomorrow.",
+    month = "The limit of this month is reached."
+  )[[reason]]
+}

R/status.R

@@ -0,0 +1,65 @@
+# Uptime record. A GitHub workflow adds a row to status/status.csv twice a day.
+# The app reads this file from GitHub and shows the days in service (chip) and
+# the last checks (Record tab).
+
+# The columns of status.csv
+STATUS_COLUMNS <- c("time_utc", "http_status", "seconds", "answered", "app_version")
+
+# Read the status file. A failed read gives an empty tibble: the chip then
+# shows "new" and the app does not crash. All columns are read as text, so
+# that an odd value cannot stop the read.
+read_status <- function(url = STATUS_URL,
+                        read_fn = \(u) readr::read_csv(
+                          u, col_types = readr::cols(.default = "c")
+                        )) {
+  empty <- tibble::tibble(
+    time_utc = character(), http_status = character(), seconds = character(),
+    answered = character(), app_version = character()
+  )
+  tryCatch(
+    read_fn(url),
+    error = \(e) empty
+  )
+}
+
+# Days in service, checks answered, checks made, and the last 60 checks.
+# A row with a time that cannot be read is ignored. A check counts as answered
+# only when its value is true (in any case).
+status_summary <- function(status, now = Sys.time()) {
+  checks <- status |>
+    dplyr::mutate(
+      time = as.POSIXct(
+        as.character(.data$time_utc), format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC"
+      ),
+      ok = stringr::str_to_lower(as.character(.data$answered)) %in% "true"
+    ) |>
+    dplyr::filter(!is.na(.data$time)) |>
+    dplyr::arrange(.data$time)
+  first_ok <- checks |>
+    dplyr::filter(.data$ok) |>
+    dplyr::slice_head(n = 1)
+  days <- if (nrow(first_ok) == 0) {
+    0
+  } else {
+    max(0, floor(as.numeric(difftime(now, first_ok$time, units = "days"))))
+  }
+  list(
+    days = days,
+    answered = sum(checks$ok),
+    checks = nrow(checks),
+    last = checks |>
+      dplyr::select(-"time", -"ok") |>
+      utils::tail(60)
+  )
+}
+
+# Short text for the chip: "in service 37 days", "in service 1 day" or "new"
+status_chip <- function(summary) {
+  if (summary$days < 1) {
+    return("new")
+  }
+  stringr::str_glue(
+    "in service {summary$days} {if (summary$days == 1) 'day' else 'days'}"
+  ) |>
+    as.character()
+}

R/ui.R

@@ -0,0 +1,406 @@
+# User interface: the page, its parts, and small helpers that build the
+# dynamic inputs and outputs. The look is in www/theme.css, the behaviour in
+# the browser (tabs, Help switch, menu, video, Copy) in www/app.js.
+
+# The address of the video ("" for none). The page reads it through this
+# function, so that a test can replace it.
+video_url <- function() VIDEO_URL
+
+# The embed address of a YouTube video, on youtube-nocookie.com ("" if the
+# address holds no video id)
+video_embed <- function(url) {
+  id <- stringr::str_match(url, "(?:v=|youtu\\.be/|/embed/)([A-Za-z0-9_-]{11})")[, 2]
+  if (is.na(id)) "" else paste0("https://www.youtube-nocookie.com/embed/", id)
+}
+
+# The data sources of the sidebar
+SOURCE_CHOICES <- c(
+  "Sample \u00b7 woven textiles (images, labelled)" = "textiles",
+  "Sample \u00b7 injury reports (texts, labelled)" = "injuries",
+  "Your own data" = "upload"
+)
+
+# The sources of the data that go with a mode
+source_choices <- function(mode) {
+  SOURCE_CHOICES[SOURCE_CHOICES %in% c(if (mode == "image") "textiles" else "injuries", "upload")]
+}
+
+# The file types of the image uploads
+IMAGE_ACCEPT <- paste0(".", IMAGE_EXTENSIONS)
+
+# --- Small parts ------------------------------------------------------------
+
+# Text for screen readers only
+sr <- function(text) shiny::span(class = "sr-only", text)
+
+# One help line of the sidebar, and one Help note of a card. The Help switch
+# hides both (class "help").
+help_line <- function(text) shiny::p(class = "help help-line", text)
+note_box <- function(...) shiny::div(class = "howto help", shiny::strong("Help."), " ", ...)
+
+# Radio buttons that look like a segmented control
+seg_radio <- function(id, label, choices, selected = NULL, class = "seg") {
+  shiny::div(
+    class = class,
+    shiny::radioButtons(id, sr(label), choices, selected = selected, inline = TRUE)
+  )
+}
+
+# A file input. The read-only box that shows the chosen file gets a name for
+# screen readers (Shiny gives it none) and no tab stop (it does nothing).
+upload_input <- function(id, label, accept, multiple = FALSE, button = "Browse") {
+  input <- shiny::fileInput(id, label, multiple = multiple, accept = accept, buttonLabel = button)
+  htmltools::tagQuery(input)$
+    find("input.form-control")$
+    addAttrs(`aria-label` = "Chosen file", tabindex = "-1")$
+    allTags()
+}
+
+# Small icons for the buttons of the R code card
+icon_svg <- function(path) {
+  htmltools::HTML(sprintf(
+    '<svg class="ico" aria-hidden="true" focusable="false" viewBox="0 0 16 16" width="14" height="14"><path d="%s" fill="none" stroke="currentColor" stroke-width="1.6" stroke-linecap="round" stroke-linejoin="round"/></svg>',
+    path
+  ))
+}
+ICON_COPY <- "M5 5h8v8H5zM3 11V3h8"
+ICON_DOWNLOAD <- "M8 2v8M4.5 6.5 8 10l3.5-3.5M3 13h10"
+
+# The links of the page open in a new tab: the app runs in a frame on
+# Hugging Face, and the visitor keeps the session
+ext_link <- function(text, href) shiny::a(href = href, target = "_blank", rel = "noopener", text)
+
+# --- Top bar ----------------------------------------------------------------
+
+tab_button <- function(id, label, selected = FALSE) {
+  shiny::tags$button(
+    type = "button", role = "tab", id = paste0("tab-", id),
+    `aria-controls` = paste0("panel-", id), `aria-selected` = tolower(selected),
+    tabindex = if (selected) "0" else "-1", label
+  )
+}
+
+help_switch <- function() {
+  shiny::tags$label(
+    class = "switch", `for` = "help_on",
+    shiny::tags$input(id = "help_on", type = "checkbox", role = "switch", checked = NA),
+    shiny::span(class = "track", `aria-hidden` = "true"),
+    "Help"
+  )
+}
+
+samples_menu <- function() {
+  shiny::tags$details(
+    id = "samples_menu", class = "menu",
+    shiny::tags$summary(class = "btn btn-red", "Samples"),
+    shiny::div(
+      class = "menu-list",
+      shiny::actionButton("sample_textiles", "Woven textiles (images)", class = "menu-item"),
+      shiny::actionButton("sample_injuries", "Injury reports (texts)", class = "menu-item")
+    )
+  )
+}
+
+top_bar <- function(video) {
+  shiny::tags$header(
+    class = "topbar",
+    shiny::div(
+      class = "brand",
+      shiny::img(src = "logo.svg", alt = "", class = "logo", width = "28", height = "32"),
+      shiny::h1(class = "name", "decisions"),
+      shiny::span(class = "tag", "Decision models")
+    ),
+    shiny::tags$nav(
+      class = "tabs", `aria-label` = "Pages",
+      shiny::div(
+        role = "tablist",
+        tab_button("build", "Build", TRUE), tab_button("about", "About"),
+        tab_button("record", "Record")
+      )
+    ),
+    shiny::div(
+      class = "topbar-right",
+      help_switch(),
+      shiny::span(
+        class = "chip", shiny::span(class = "dot", `aria-hidden` = "true", "\u25cf"), " ",
+        shiny::textOutput("status_chip", inline = TRUE)
+      ),
+      if (nzchar(video)) {
+        shiny::tags$button(
+          id = "open_video", type = "button", class = "btn btn-quiet",
+          `aria-haspopup` = "dialog", "Video"
+        )
+      },
+      shiny::div(
+        class = "import-btn",
+        upload_input("import_file", NULL, c(".zip", ".json"), button = "Import")
+      ),
+      samples_menu()
+    )
+  )
+}
+
+# --- Build tab: sidebar -----------------------------------------------------
+
+# A numbered group of the sidebar, such as "01 - Data"
+group <- function(num, title, ...) {
+  shiny::div(class = "group", shiny::h2(class = "eyebrow", shiny::tags$b(num), " \u00b7 ", title), ...)
+}
+
+sidebar <- function() {
+  textiles <- sample_question("textiles")
+  shiny::tags$aside(
+    class = "card sidebar", `aria-label` = "Setup",
+    group(
+      "01", "Data",
+      seg_radio("mode", "Kind of data", c(Images = "image", Text = "text")),
+      shiny::selectInput("source", sr("Source"), SOURCE_CHOICES, selectize = FALSE),
+      shiny::conditionalPanel(
+        "input.source == 'upload' && input.mode == 'image'",
+        upload_input("upload_images", "Images or zip file", c(IMAGE_ACCEPT, ".zip"), multiple = TRUE)
+      ),
+      shiny::conditionalPanel(
+        "input.source == 'upload' && input.mode == 'text'",
+        shiny::textAreaInput("paste_text", "Texts", rows = 4),
+        upload_input("upload_csv", "CSV file", ".csv"),
+        shiny::selectInput("csv_text_col", "Text column", character(), selectize = FALSE),
+        shiny::selectInput("csv_label_col", "Label column", character(), selectize = FALSE)
+      ),
+      help_line(help_text("data"))
+    ),
+    group(
+      "02", "Question",
+      seg_radio(
+        "qtype", "Type of question",
+        c("Yes / no" = "noul", Choice = "choice", Score = "score"), selected = textiles$type
+      ),
+      shiny::textAreaInput("instructions", "Instructions", textiles$instructions, rows = 2),
+      shiny::uiOutput("answers_ui"),
+      help_line(help_text("question"))
+    ),
+    shiny::conditionalPanel(
+      "input.mode == 'image'",
+      group(
+        "03", "References",
+        shiny::conditionalPanel("input.qtype != 'score'", help_line(help_text("references"))),
+        shiny::conditionalPanel("input.qtype == 'score'", help_line(help_text("references_score"))),
+        shiny::uiOutput("references_ui")
+      )
+    ),
+    shiny::div(
+      class = "run-row",
+      shiny::actionButton("try5", "Try on 5", class = "btn-ghost"),
+      shiny::actionButton(
+        "run_all", shiny::tagList("Run all ", shiny::textOutput("run_estimate", inline = TRUE)),
+        class = "btn-red"
+      )
+    ),
+    shiny::div(class = "stop-row", shiny::actionButton("stop", "Stop", class = "btn-ghost")),
+    htmltools::tagAppendChild(shiny::uiOutput("spend_meter"), spend_meter_ui(0)),
+    shiny::p(class = "privacy", help_text("privacy")),
+    shiny::div(class = "limits", role = "status", shiny::textOutput("limits_text", inline = TRUE))
+  )
+}
+
+# --- Build tab: cards -------------------------------------------------------
+
+intro_card <- function() {
+  step <- \(n, name, text) {
+    shiny::tags$li(
+      shiny::span(class = "num", `aria-hidden` = "true", n),
+      shiny::span(shiny::strong(name), " \u00b7 ", text)
+    )
+  }
+  shiny::tags$section(
+    id = "intro", class = "card intro", `aria-label` = "Intro",
+    shiny::div(
+      shiny::p(class = "intro-lead", "Ask a model a question about each image or text."),
+      shiny::p(class = "intro-help", help_text("intro"), " ", shiny::actionLink("intro_hide", "Hide"))
+    ),
+    shiny::tags$ol(
+      class = "steps",
+      step("1", "Question", "a question, its answers and a few examples"),
+      step(
+        "2", "Answers",
+        "an answer and a probability for each input; with labels, how often Jev is right"
+      ),
+      step("3", "R code", "the same run in R, to copy or download")
+    )
+  )
+}
+
+# A region that scrolls sideways; it takes keyboard focus, so that the arrow
+# keys can scroll it
+scroll_region <- function(label, ...) {
+  shiny::div(class = "table-wrap", tabindex = "0", role = "region", `aria-label` = label, ...)
+}
+
+answers_card <- function() {
+  shiny::tags$section(
+    class = "card answers-card", `aria-labelledby` = "answers_title",
+    shiny::div(
+      class = "hd",
+      shiny::h2(
+        id = "answers_title", class = "card-title", tabindex = "-1",
+        shiny::span(class = "eyebrow-num", `aria-hidden` = "true", "1"), "Answers"
+      ),
+      shiny::div(
+        class = "hd-tools",
+        shiny::selectInput("target", "Target", character(), selectize = FALSE, width = "auto"),
+        seg_radio("view", "View", c(Gallery = "gallery", Table = "table"), class = "seg vtabs")
+      )
+    ),
+    shiny::div(
+      class = "bd",
+      shiny::uiOutput("stats"),
+      note_box(shiny::span(id = "help_answers", class = "shiny-text-output", help_text("answers"))),
+      shiny::conditionalPanel("input.view == 'gallery'", shiny::uiOutput("gallery")),
+      shiny::conditionalPanel(
+        "input.view == 'table'",
+        scroll_region("Answers table", shiny::tableOutput("table"))
+      ),
+      shiny::div(
+        class = "card-foot",
+        shiny::downloadButton("download_answers", "Answers .csv", class = "btn-quiet sm", icon = NULL)
+      )
+    )
+  )
+}
+
+# Server: shiny::outputOptions(output, id, suspendWhenHidden = FALSE) for "code", "bundle_files", "code_summary"
+code_card <- function() {
+  code <- htmltools::tagAppendAttributes(
+    shiny::verbatimTextOutput("code", placeholder = FALSE),
+    class = "code", tabindex = "0", role = "region", `aria-label` = "R code of this run"
+  )
+  shiny::tags$section(
+    class = "card code-card", `aria-labelledby` = "code_title",
+    # A heading for screen readers (the visible title is the summary line)
+    shiny::h2(id = "code_title", class = "sr-only", "R code"),
+    # The summary holds only the summary line; the buttons sit outside it
+    shiny::tags$details(
+      class = "code-details",
+      shiny::tags$summary(
+        class = "code-summary",
+        shiny::span(class = "eyebrow-num", `aria-hidden` = "true", "2"),
+        shiny::span(id = "code_summary", class = "shiny-text-output", "R code")
+      ),
+      shiny::div(class = "bd", note_box(help_text("code")), code, shiny::uiOutput("bundle_files"))
+    ),
+    shiny::div(
+      class = "code-actions",
+      shiny::tags$button(
+        type = "button", class = "btn btn-quiet sm copy-btn", `data-target` = "code",
+        icon_svg(ICON_COPY), shiny::span(class = "copy-label", "Copy")
+      ),
+      shiny::downloadButton(
+        "download_code", shiny::tagList(icon_svg(ICON_DOWNLOAD), "Download .R"),
+        class = "btn-quiet sm", icon = NULL
+      ),
+      shiny::downloadButton(
+        "download_bundle", shiny::tagList(icon_svg(ICON_DOWNLOAD), "Bundle .zip"),
+        class = "btn-red sm", icon = NULL
+      )
+    ),
+    shiny::div(id = "copy_status", class = "sr-only", role = "status")
+  )
+}
+
+build_panel <- function() {
+  shiny::div(
+    class = "build", sidebar(),
+    shiny::div(class = "cards", intro_card(), answers_card(), code_card())
+  )
+}
+
+# --- About and Record tabs --------------------------------------------------
+
+about_panel <- function() {
+  # The About text is Markdown; its links open in a new tab
+  html <- shiny::markdown(help_text("about")) |>
+    as.character() |>
+    stringr::str_replace_all("<a href=", '<a target="_blank" rel="noopener" href=')
+  shiny::div(class = "page card", shiny::div(class = "bd prose", htmltools::HTML(html)))
+}
+
+record_panel <- function() {
+  shiny::div(
+    class = "page card",
+    shiny::div(
+      class = "bd prose",
+      shiny::h2("Record"),
+      shiny::p(help_text("record")),
+      scroll_region("Record table", shiny::tableOutput("record_table")),
+      shiny::p(
+        ext_link("Status file", LINKS$status), " \u00b7 ",
+        ext_link("Package record", LINKS$package_record), " \u00b7 ",
+        ext_link("Project record", LINKS$project_record)
+      )
+    )
+  )
+}
+
+tab_panel <- function(id, content, selected = FALSE) {
+  shiny::tags$section(
+    id = paste0("panel-", id), role = "tabpanel", `aria-labelledby` = paste0("tab-", id),
+    hidden = if (!selected) NA, content
+  )
+}
+
+# --- Footer and video ---------------------------------------------------------
+
+footer_bar <- function() {
+  shiny::tags$footer(
+    class = "foot",
+    shiny::span(sprintf(
+      "decisions-space %s \u00b7 decisions %s \u00b7 %s", APP_VERSION, decisions_version(), MODEL
+    )),
+    shiny::span(
+      AUTHORS, " \u00b7 ", ext_link("Source", LINKS$source), " \u00b7 ",
+      ext_link("MIT", LINKS$license)
+    )
+  )
+}
+
+# The video dialog (only when there is a video). The iframe gets its address
+# from data-src when the dialog opens, so nothing loads before a click.
+video_dialog <- function(url) {
+  shiny::tags$dialog(
+    id = "video_dialog", class = "video-dialog", `aria-labelledby` = "video_title",
+    shiny::div(
+      class = "video-head",
+      shiny::h2(id = "video_title", "Video"),
+      shiny::tags$button(id = "close_video", type = "button", class = "btn btn-quiet sm", "Close")
+    ),
+    shiny::tags$iframe(
+      id = "video_frame", class = "video-frame", title = "Video of the decisions app",
+      `data-src` = video_embed(url), allow = "autoplay; encrypted-media; picture-in-picture; fullscreen",
+      referrerpolicy = "strict-origin-when-cross-origin"
+    )
+  )
+}
+
+# --- The page -----------------------------------------------------------------
+
+# The page. Shiny passes the HTTP request; the page does not use it.
+app_ui <- function(request) {
+  video <- video_url()
+  shiny::bootstrapPage(
+    title = "decisions", lang = "en",
+    shiny::tags$head(
+      shiny::tags$meta(name = "app-version", content = APP_VERSION),
+      shiny::tags$link(rel = "icon", type = "image/png", href = "logo.png"),
+      shiny::tags$link(rel = "stylesheet", href = "theme.css")
+    ),
+    top_bar(video),
+    shiny::tags$main(
+      id = "main",
+      tab_panel("build", build_panel(), selected = TRUE),
+      tab_panel("about", about_panel()),
+      tab_panel("record", record_panel())
+    ),
+    footer_bar(),
+    if (nzchar(video)) video_dialog(video),
+    shiny::tags$script(src = "app.js")
+  )
+}

README.md

@@ -1,10 +1,90 @@
 ---
-title: Decisions
-emoji: 🏆
-colorFrom: pink
-colorTo: pink
+title: decisions
+emoji: 🔎
+colorFrom: red
+colorTo: yellow
 sdk: docker
+app_port: 7860
 pinned: false
+license: mit
+short_description: Ask Jev a question about each image or text in a set.
 ---
 
-Check out the configuration reference at https://huggingface.co/docs/hub/spaces-config-reference
+# decisions
+
+## App
+
+This app asks Jev a question about each image or text in a set. Jev is a decision model of TypeSafe. For each input, the app shows the answer and the probability of each answer. It also gives the R code of the run and a bundle with the setup and the answers. A visitor needs no key and no account.
+
+The app uses the R package [decisions](https://github.com/fmegahed/decisions) (version 0.1.0). Two samples run at no cost: textile images and injury reports. Their answers are saved.
+
+Open the app: <https://huggingface.co/spaces/fmegahed/decisions>
+
+## Privacy
+
+Your images, texts and references go to TypeSafe (Jev). Do not upload confidential data. The app keeps no input after your session. It stores only the daily totals of calls, tokens and cost. The bundle and the logs hold no key.
+
+## Limits
+
+The demo pays for every call. The limits protect its credit.
+
+- Each session can spend USD 0.25. Each day (UTC) can spend USD 2. Each month (UTC) can spend USD 20.
+- A file can have 5 MB. A zip file can have 50 MB.
+- A run can have 100 images or 200 texts.
+- The app sends 10 inputs in each chunk.
+- Jev costs USD 0.042 for each million input tokens.
+
+Edit `R/config.R` to change these values. The help text of the app reads them from this file.
+
+## Docker
+
+The Space runs this Docker image. You can build it and run it yourself.
+
+```sh
+docker build -t decisions-space .
+docker run -p 7860:7860 -e HF_JEV_API=... decisions-space
+```
+
+Then open <http://localhost:7860>. Replace `...` with a TypeSafe key.
+
+- `HF_JEV_API` is the TypeSafe key. Without it, the app opens, but a run shows "The demo is not available right now." The samples still show their saved answers.
+- `HF_USAGE_TOKEN` is a Hugging Face token that can write to the private dataset `fmegahed/decisions-space-usage`. The app keeps its daily totals there. Without it, the app cannot reach the dataset. It then keeps the totals in memory, writes a warning to the log, and loses the totals when the app restarts.
+
+The app never writes a key to a file or to the log.
+
+## Layout
+
+- `app.R`: starts the app.
+- `R/`: the app code. `config.R` holds the model, the limits and the links.
+- `www/`: the style, the script, the logo and the fonts.
+- `Dockerfile`: the image of the Space.
+- `tests/`: the tests. `tests/live_smoke.R` makes two paid calls and is not part of the suite.
+- `status/status.csv`: one row for each visit of the status workflow.
+- `.github/workflows/`: `tests.yml` runs the tests and builds the image. `deploy.yml` uploads the app files to the Space. `status.yml` visits the app twice a day.
+
+## Tests
+
+Run the tests from the repository root:
+
+```sh
+Rscript tests/testthat.R
+```
+
+The tests use a mock in place of Jev, so they need no key and make no paid call. Set `SPACE_MOCK=1` to start the app with the same mock, for example `SPACE_MOCK=1 Rscript -e 'shiny::runApp()'`. This mode is for local checks only. The Dockerfile never sets it.
+
+The accessibility test needs Chrome (shinytest2 and axe-core). If chromote does not find Chrome, set the variable `CHROMOTE_CHROME` to the path of Chrome.
+
+## License
+
+MIT. See `LICENSE`.
+
+## Authors
+
+Fadel M. Megahed (Miami University) and Ying-Ju (Tessa) Chen (University of Dayton).
+
+## Citation
+
+If you use the package or the app, cite both:
+
+- Megahed, F. M., & Chen, Y.-J. (2026). *decisions: Typed decisions from decision models* (R package version 0.1.0). https://github.com/fmegahed/decisions
+- Megahed, F. M., & Chen, Y.-J. (2026). *decisions Space* (Version 1.0.0) [Web application]. Hugging Face. https://huggingface.co/spaces/fmegahed/decisions

app.R

@@ -0,0 +1,27 @@
+# App logic lives in R/ and is sourced here in a fixed order
+# (R/_disable_autoload.R stops Shiny from sourcing the directory a second time).
+# APP_ROOT is the app folder; the mock mode finds the mock of the tests there.
+APP_ROOT <- normalizePath(".")
+APP_FILES <- c("config.R", "spec.R", "samples.R", "data.R", "runs.R", "spending.R", "answers.R", "code.R", "bundle.R", "status.R", "help.R", "render.R", "ui.R", "server.R")
+for (r_file in APP_FILES) {
+  source(file.path("R", r_file), local = TRUE)
+}
+
+# Uploads larger than this are rejected by Shiny
+options(shiny.maxRequestSize = MAX_ZIP_MB * 1024^2)
+
+# Two background R processes run the calls to Jev, so a run does not block the
+# app. They load the same code; the key reaches them only as the environment
+# variable that they inherit.
+mirai::daemons(2)
+mirai::everywhere(
+  for (f in files) source(f),
+  .args = list(files = normalizePath(file.path("R", APP_FILES)))
+)
+shiny::onStop(\() mirai::daemons(0))
+
+# One set of dependencies for all sessions: the stop for the day after a key
+# or credit error holds for every visitor (R/server.R)
+deps <- app_deps()
+
+shiny::shinyApp(app_ui, \(input, output, session) app_server(input, output, session, deps))

www/app.js

@@ -0,0 +1,255 @@
+// Client-side behaviour: the tabs, the Help switch, the intro, the Samples
+// menu, the video dialog, the Copy button, the colours of the R code and the
+// run state. The script sits at the end of the page, so the elements exist.
+// Every access to browser storage is in try/catch (a private window or a
+// blocked site can refuse it).
+(function() {
+  'use strict';
+
+  function readStore(store, key) {
+    try { return window[store].getItem(key); } catch (e) { return null; }
+  }
+  function writeStore(store, key, value) {
+    try { window[store].setItem(key, value); } catch (e) { /* storage refused */ }
+  }
+  function byId(id) { return document.getElementById(id); }
+
+  // ---- Tabs: Build, About, Record ----------------------------------------
+
+  var TABS = ['build', 'about', 'record'];
+
+  function showTab(name, moveFocus) {
+    TABS.forEach(function(t) {
+      var tab = byId('tab-' + t);
+      var panel = byId('panel-' + t);
+      if (!tab || !panel) return;
+      var on = (t === name);
+      tab.setAttribute('aria-selected', on ? 'true' : 'false');
+      tab.setAttribute('tabindex', on ? '0' : '-1');
+      panel.hidden = !on;
+      if (on && moveFocus) tab.focus();
+    });
+    if (window.Shiny && Shiny.setInputValue) Shiny.setInputValue('tab', name);
+  }
+
+  function onTabKey(event) {
+    var index = TABS.indexOf(event.currentTarget.id.replace('tab-', ''));
+    var next = null;
+    if (event.key === 'ArrowRight') next = TABS[(index + 1) % TABS.length];
+    else if (event.key === 'ArrowLeft') next = TABS[(index + TABS.length - 1) % TABS.length];
+    else if (event.key === 'Home') next = TABS[0];
+    else if (event.key === 'End') next = TABS[TABS.length - 1];
+    if (next !== null) {
+      event.preventDefault();
+      showTab(next, true);
+    }
+  }
+
+  TABS.forEach(function(t) {
+    var tab = byId('tab-' + t);
+    if (!tab) return;
+    tab.addEventListener('click', function() { showTab(t, false); });
+    tab.addEventListener('keydown', onTabKey);
+  });
+
+  // ---- Help switch: hides the help lines and notes; kept for the session --
+
+  var helpSwitch = byId('help_on');
+  function applyHelp() { document.body.classList.toggle('help-off', !helpSwitch.checked); }
+  if (helpSwitch) {
+    if (readStore('sessionStorage', 'decisions-help') === 'off') helpSwitch.checked = false;
+    applyHelp();
+    helpSwitch.addEventListener('change', function() {
+      applyHelp();
+      writeStore('sessionStorage', 'decisions-help', helpSwitch.checked ? 'on' : 'off');
+    });
+  }
+
+  // ---- Intro: open on the first visit; Hide closes it for this browser ----
+
+  var intro = byId('intro');
+  if (intro && readStore('localStorage', 'decisions-intro') === 'hidden') intro.hidden = true;
+  var introHide = byId('intro_hide');
+  if (introHide) {
+    introHide.addEventListener('click', function(event) {
+      event.preventDefault();
+      intro.hidden = true;
+      writeStore('localStorage', 'decisions-intro', 'hidden');
+      var title = byId('answers_title');
+      if (title) title.focus();
+    });
+  }
+
+  // ---- Samples menu: closes on a choice, on Escape and on a click outside --
+
+  function closeMenu(menu, moveFocus) {
+    if (!menu.open) return;
+    menu.open = false;
+    if (moveFocus) menu.querySelector('summary').focus();
+  }
+
+  document.addEventListener('click', function(event) {
+    document.querySelectorAll('details.menu[open]').forEach(function(menu) {
+      if (!menu.contains(event.target)) closeMenu(menu, false);
+      else if (event.target.closest('.menu-item')) closeMenu(menu, true);
+    });
+  });
+
+  document.addEventListener('keydown', function(event) {
+    if (event.key !== 'Escape') return;
+    document.querySelectorAll('details.menu[open]').forEach(function(menu) {
+      closeMenu(menu, menu.contains(document.activeElement));
+    });
+  });
+
+  // ---- Video dialog (only when the page has one) ---------------------------
+  // The embed address is set when the dialog opens and cleared when it
+  // closes, so nothing loads before a click and the video stops on close.
+  // Escape closes the dialog; Tab stays in the dialog.
+
+  var dialog = byId('video_dialog');
+  var openVideo = byId('open_video');
+  if (dialog && openVideo && dialog.showModal) {
+    var frame = byId('video_frame');
+    var closeButton = byId('close_video');
+    var lastFocused = null;
+
+    openVideo.addEventListener('click', function() {
+      lastFocused = document.activeElement;
+      frame.setAttribute('src', frame.getAttribute('data-src'));
+      dialog.showModal();
+      closeButton.focus();
+    });
+    closeButton.addEventListener('click', function() { dialog.close(); });
+    dialog.addEventListener('click', function(event) {
+      if (event.target === dialog) dialog.close();
+    });
+    dialog.addEventListener('close', function() {
+      frame.setAttribute('src', 'about:blank');
+      if (lastFocused && lastFocused.focus) lastFocused.focus();
+    });
+    dialog.addEventListener('keydown', function(event) {
+      if (event.key !== 'Tab') return;
+      if (event.shiftKey && document.activeElement === closeButton) {
+        event.preventDefault();
+        frame.focus();
+      } else if (!event.shiftKey && document.activeElement === frame) {
+        event.preventDefault();
+        closeButton.focus();
+      }
+    });
+  }
+
+  // ---- Copy button of the R code -------------------------------------------
+  // The code output sits in the R code card, which is closed when the page
+  // opens. Shiny renders a hidden output only when it shows, so the code can
+  // be empty. Then Copy opens the card and copies when the code arrives (see
+  // the shiny:value handler below), or says that there is nothing to copy
+  // yet. Copy never says "Copied" for an empty text.
+
+  var pendingCopy = null;
+  var pendingTimer = null;
+
+  // Show a message on the button and in the live region for 2 seconds
+  function sayCopy(button, message) {
+    var label = button.querySelector('.copy-label');
+    var status = byId('copy_status');
+    if (label) label.textContent = message;
+    if (status) status.textContent = message;
+    window.setTimeout(function() {
+      if (label) label.textContent = 'Copy';
+      if (status) status.textContent = '';
+    }, 2000);
+  }
+
+  function writeCopy(button, text) {
+    if (navigator.clipboard && navigator.clipboard.writeText) {
+      navigator.clipboard.writeText(text).then(
+        function() { sayCopy(button, 'Copied'); },
+        function() { sayCopy(button, 'Copy failed. Select the code and copy it.'); }
+      );
+    } else {
+      sayCopy(button, 'Copy is not available. Select the code and copy it.');
+    }
+  }
+
+  function copyCode(button) {
+    var target = byId(button.getAttribute('data-target'));
+    if (!target) return;
+    var text = target.textContent;
+    if (!text) {
+      var details = target.closest('details');
+      if (details && !details.open) {
+        // Open the card; the copy waits for the code, at most 5 seconds
+        pendingCopy = button;
+        details.open = true;
+        window.clearTimeout(pendingTimer);
+        pendingTimer = window.setTimeout(function() {
+          if (pendingCopy !== button) return;
+          pendingCopy = null;
+          sayCopy(button, 'Nothing to copy yet.');
+        }, 5000);
+      } else {
+        sayCopy(button, 'Nothing to copy yet.');
+      }
+      return;
+    }
+    writeCopy(button, text);
+  }
+
+  document.addEventListener('click', function(event) {
+    var button = event.target.closest ? event.target.closest('.copy-btn') : null;
+    if (button) copyCode(button);
+  });
+
+  // ---- Colours of the R code -----------------------------------------------
+  // The server sends the code as plain text. The text is escaped first, then
+  // comments, strings and function names get a span. Copy reads textContent,
+  // so it copies the plain code.
+
+  var TOKEN = /(#[^\n]*)|("(?:[^"\\\n]|\\.)*")|([A-Za-z.][A-Za-z0-9._]*)(?=\()/g;
+
+  function escapeHtml(text) {
+    return text.replace(/&/g, '&amp;').replace(/</g, '&lt;').replace(/>/g, '&gt;');
+  }
+
+  function highlightR(code) {
+    var html = '';
+    var last = 0;
+    var match;
+    TOKEN.lastIndex = 0;
+    while ((match = TOKEN.exec(code)) !== null) {
+      html += escapeHtml(code.slice(last, match.index));
+      var kind = match[1] ? 'c' : (match[2] ? 's' : 'f');
+      html += '<span class="' + kind + '">' + escapeHtml(match[0]) + '</span>';
+      last = TOKEN.lastIndex;
+    }
+    return html + escapeHtml(code.slice(last));
+  }
+
+  if (window.jQuery) {
+    window.jQuery(document).on('shiny:value', function(event) {
+      if (event.name !== 'code' || typeof event.value !== 'string') return;
+      event.preventDefault();
+      byId('code').innerHTML = highlightR(event.value);
+      // A Copy that waited for the code runs now
+      if (pendingCopy) {
+        var button = pendingCopy;
+        pendingCopy = null;
+        window.clearTimeout(pendingTimer);
+        if (event.value) writeCopy(button, event.value);
+        else sayCopy(button, 'Nothing to copy yet.');
+      }
+    });
+  }
+
+  // ---- Run state -------------------------------------------------------------
+  // The server sends session$sendCustomMessage("run-state", TRUE) when a run
+  // starts and FALSE when it ends: Stop replaces Try on 5 and Run all.
+
+  if (window.Shiny && Shiny.addCustomMessageHandler) {
+    Shiny.addCustomMessageHandler('run-state', function(running) {
+      document.body.classList.toggle('is-running', !!running);
+    });
+  }
+})();

www/fonts/OFL-ibm-plex-mono.txt

@@ -0,0 +1,93 @@
+Copyright © 2017 IBM Corp. with Reserved Font Name "Plex"
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+
+This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

www/fonts/OFL-source-sans-3.txt

@@ -0,0 +1,93 @@
+Copyright 2010-2024 Adobe (http://www.adobe.com/), with Reserved Font Name 'Source'. All Rights Reserved. Source is a trademark of Adobe in the United States and/or other countries.
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+
+This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

www/fonts/OFL-source-serif-4.txt

@@ -0,0 +1,93 @@
+Copyright 2014 - 2023 Adobe (http://www.adobe.com/), with Reserved Font Name ‘Source’. All Rights Reserved. Source is a trademark of Adobe in the United States and/or other countries.
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+
+This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded,
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

www/theme.css

@@ -0,0 +1,272 @@
+/* Theme of the decisions Space: the Miami palette (no tints), WCAG 2.2 AA.
+   Measured contrast: muted text #5f5a52 on white 6.84:1, on #FAF9F7 6.49:1;
+   Dark Tan #70685C on white 5.49:1 (never small text on Light Tan);
+   Miami Red #C41230 on white 6.04:1; code on #fbfaf7: text #22262b 14.58:1,
+   comments #5f5a52 6.55:1, functions #3E5468 7.53:1, strings #7a3e00 7.99:1. */
+
+/* Fonts: Latin subsets (woff2), SIL Open Font License 1.1, served from www/fonts.
+   Source Serif 4 and Source Sans 3: @fontsource 5.3.1; IBM Plex Mono: @fontsource
+   5.3.0 (cdn.jsdelivr.net/npm/@fontsource/<family>@<version>/files/). The license
+   texts come from adobe-fonts/source-serif, adobe-fonts/source-sans and IBM/plex. */
+@font-face { font-family: "Source Serif 4"; font-style: normal; font-weight: 700; font-display: swap;
+  src: url("fonts/source-serif-4-latin-700-normal.woff2") format("woff2"); }
+@font-face { font-family: "Source Sans 3"; font-style: normal; font-weight: 400; font-display: swap;
+  src: url("fonts/source-sans-3-latin-400-normal.woff2") format("woff2"); }
+@font-face { font-family: "Source Sans 3"; font-style: normal; font-weight: 600; font-display: swap;
+  src: url("fonts/source-sans-3-latin-600-normal.woff2") format("woff2"); }
+@font-face { font-family: "Source Sans 3"; font-style: normal; font-weight: 700; font-display: swap;
+  src: url("fonts/source-sans-3-latin-700-normal.woff2") format("woff2"); }
+@font-face { font-family: "IBM Plex Mono"; font-style: normal; font-weight: 400; font-display: swap;
+  src: url("fonts/ibm-plex-mono-latin-400-normal.woff2") format("woff2"); }
+@font-face { font-family: "IBM Plex Mono"; font-style: normal; font-weight: 600; font-display: swap;
+  src: url("fonts/ibm-plex-mono-latin-600-normal.woff2") format("woff2"); }
+
+:root {
+  --red: #C41230; --tan: #EDECE2; --tan2: #CCC9B8; --tan3: #70685C;
+  --warm: #FAF9F7; --slate: #3E5468; --ink: #1b1b1b; --muted: #5f5a52;
+  --code-bg: #fbfaf7; --code-text: #22262b; --code-c: #5f5a52; --code-f: #3E5468; --code-s: #7a3e00;
+  --serif: "Source Serif 4", Georgia, serif;
+  --sans: "Source Sans 3", system-ui, -apple-system, "Segoe UI", sans-serif;
+  --mono: "IBM Plex Mono", Consolas, "Courier New", monospace;
+}
+
+/* --- Base ------------------------------------------------------------------ */
+html, body { background: var(--warm); }
+body { margin: 0; font-family: var(--sans); font-size: 14px; line-height: 1.45; color: var(--ink); }
+[hidden] { display: none !important; }
+a { color: var(--red); text-decoration: underline; }
+a:hover, a:focus { color: var(--red); text-decoration: underline; }
+h1, h2, h3 { color: var(--ink); }
+.mono { font-family: var(--mono); }
+::placeholder { color: var(--muted); opacity: 1; }
+
+/* Focus: one visible ring on every control (3px Slate Blue) */
+a:focus-visible, button:focus-visible, summary:focus-visible, input:focus-visible,
+select:focus-visible, textarea:focus-visible, [tabindex]:focus-visible, .btn:focus-visible {
+  outline: 3px solid var(--slate) !important; outline-offset: 2px !important; box-shadow: none;
+}
+.btn:focus:not(:focus-visible), a:focus:not(:focus-visible) { outline: none; }
+.form-control:focus { border-color: var(--slate); box-shadow: none; }
+.btn-file:focus-within { outline: 3px solid var(--slate); outline-offset: 2px; }
+
+/* --- Buttons ----------------------------------------------------------------- */
+.btn { font-family: var(--sans); font-weight: 600; font-size: 13.5px; border-radius: 6px;
+  padding: 7px 12px; display: inline-flex; align-items: center; justify-content: center; gap: 6px;
+  white-space: nowrap; text-decoration: none; }
+.btn:focus { text-decoration: none; }
+.btn:hover { text-decoration: underline; }
+.btn.sm { padding: 4px 10px; font-size: 12.5px; }
+.btn.btn-red, .btn.btn-red:hover, .btn.btn-red:focus, .btn.btn-red:active {
+  background: var(--red); border: 1px solid var(--red); color: #fff; }
+.btn.btn-ghost, .btn.btn-ghost:focus { background: #fff; border: 1px solid var(--red); color: var(--red); }
+.btn.btn-ghost:hover, .btn.btn-ghost:active { background: var(--tan); border-color: var(--red); color: var(--red); }
+.btn.btn-quiet, .btn.btn-quiet:focus, .btn-file.btn { background: #fff; border: 1px solid var(--tan2); color: var(--ink); }
+.btn.btn-quiet:hover, .btn.btn-quiet:active, .btn-file.btn:hover { background: var(--tan); border-color: var(--tan2); color: var(--ink); }
+.btn.btn-icon { padding: 2px 8px; font-size: 16px; line-height: 1.2; }
+.btn .ico { flex: none; }
+
+/* --- Top bar ------------------------------------------------------------------ */
+.topbar { display: flex; flex-wrap: wrap; align-items: center; gap: 10px 18px; padding: 10px 18px;
+  background: #fff; border-bottom: 1px solid var(--tan2); }
+.brand { display: flex; align-items: center; gap: 8px; }
+.brand .logo { height: 32px; width: auto; }
+.brand .name { margin: 0; font-family: var(--serif); font-weight: 700; font-size: 20px; line-height: 1; }
+.brand .tag { font-family: var(--mono); font-size: 10.5px; letter-spacing: .14em; text-transform: uppercase; color: var(--tan3); }
+.tabs [role="tablist"] { display: flex; gap: 4px; }
+.tabs [role="tab"] { font-family: var(--mono); font-size: 12px; letter-spacing: .1em; text-transform: uppercase;
+  padding: 6px 10px; border: 0; border-radius: 6px; background: transparent; color: var(--muted); }
+.tabs [role="tab"]:hover { color: var(--ink); text-decoration: underline; }
+.tabs [role="tab"][aria-selected="true"] { background: var(--tan); color: var(--ink); font-weight: 600; }
+.topbar-right { margin-left: auto; display: flex; flex-wrap: wrap; align-items: center; gap: 10px; }
+
+/* Help switch: a real checkbox with the role switch */
+.switch { position: relative; display: inline-flex; align-items: center; gap: 6px; margin: 0;
+  font-size: 13px; font-weight: 400; color: var(--muted); cursor: pointer; }
+.switch input { position: absolute; left: 0; top: 50%; width: 30px; height: 16px; margin: -8px 0 0; opacity: 0; cursor: pointer; }
+.switch .track { position: relative; display: inline-block; width: 30px; height: 16px; border-radius: 8px;
+  background: #fff; border: 1px solid var(--tan3); }
+.switch .track::after { content: ""; position: absolute; left: 2px; top: 2px; width: 10px; height: 10px;
+  border-radius: 5px; background: var(--tan3); transition: left .15s; }
+.switch input:checked + .track { background: var(--slate); border-color: var(--slate); }
+.switch input:checked + .track::after { left: 16px; background: #fff; }
+.switch input:focus-visible + .track { outline: 3px solid var(--slate); outline-offset: 2px; }
+
+.chip { font-family: var(--mono); font-size: 11.5px; color: var(--slate); background: #fff;
+  border: 1px solid var(--tan2); padding: 3px 9px; border-radius: 999px; white-space: nowrap; }
+/* An empty output must keep its size: Shiny does not render an output with display: none */
+.chip:has(.shiny-text-output:empty) { visibility: hidden; }
+
+/* Import: a file input that looks like one button */
+.import-btn .form-group { margin: 0; width: auto !important; }
+.import-btn .control-label, .import-btn .form-control, .import-btn .progress { display: none; }
+.import-btn .input-group { display: block; }
+.import-btn .input-group-btn { display: inline-block; width: auto; font-size: inherit; }
+.import-btn .btn-file { border-radius: 6px !important; }
+
+/* Samples menu */
+.menu { position: relative; }
+.menu > summary { list-style: none; cursor: pointer; }
+.menu > summary::-webkit-details-marker { display: none; }
+.menu > summary::after { content: ""; display: inline-block; margin-left: 2px; border: 4px solid transparent;
+  border-top-color: currentColor; transform: translateY(2px); }
+.menu-list { position: absolute; right: 0; top: calc(100% + 4px); z-index: 20; min-width: 220px; padding: 6px;
+  display: flex; flex-direction: column; background: #fff; border: 1px solid var(--tan2); border-radius: 8px;
+  box-shadow: 0 4px 12px rgba(0, 0, 0, .08); }
+.menu-list .btn.menu-item { justify-content: flex-start; background: #fff; border: 0; color: var(--ink); font-weight: 400; }
+.menu-list .btn.menu-item:hover { background: var(--tan); }
+
+/* --- Layout -------------------------------------------------------------------- */
+.build { display: grid; grid-template-columns: 320px minmax(0, 1fr); gap: 14px; padding: 14px; align-items: start; }
+.cards { display: flex; flex-direction: column; gap: 14px; min-width: 0; }
+.page { max-width: 880px; margin: 14px auto; }
+/* A narrow screen puts the sidebar above the cards (reflow at 320 CSS pixels) */
+@media (max-width: 899px) {
+  .build { grid-template-columns: minmax(0, 1fr); }
+  .page { margin: 14px; }
+}
+
+.card { background: #fff; border: 1px solid var(--tan); border-radius: 10px; box-shadow: 0 1px 2px rgba(0, 0, 0, .04); }
+.card .hd { display: flex; flex-wrap: wrap; align-items: center; gap: 10px; padding: 12px 16px 10px; border-bottom: 1px solid var(--tan); }
+.card .bd { padding: 12px 16px; }
+.card-title { margin: 0; display: flex; align-items: baseline; gap: 8px; font-family: var(--serif); font-weight: 700; font-size: 18px; }
+.eyebrow-num { font-family: var(--mono); font-size: 12px; font-weight: 600; color: var(--red); }
+.hd-tools { margin-left: auto; display: flex; flex-wrap: wrap; align-items: center; gap: 10px; }
+.hd-tools .form-group { display: flex; align-items: center; gap: 6px; margin: 0; }
+.hd-tools .control-label { margin: 0; font-family: var(--mono); font-size: 11.5px; font-weight: 400;
+  letter-spacing: .08em; text-transform: uppercase; color: var(--muted); }
+.card-foot { margin-top: 12px; }
+
+/* --- Sidebar -------------------------------------------------------------------- */
+.sidebar { padding: 14px 16px; display: flex; flex-direction: column; gap: 14px; }
+.sidebar .shiny-input-container:not(.shiny-input-container-inline) { width: 100%; }
+.sidebar .form-group { margin-bottom: 6px; }
+.sidebar .control-label { font-size: 12.5px; font-weight: 600; margin-bottom: 3px; }
+/* A label for screen readers only takes no space */
+.control-label:has(> .sr-only:only-child) { position: absolute; margin: 0; }
+.sidebar .shiny-file-input-progress { height: 6px; margin: 2px 0 4px; }
+.sidebar .shiny-file-input-progress .progress-bar { font-size: 0; }
+.ref-row .form-group { margin-bottom: 0; }
+.eyebrow { margin: 0 0 6px; font-family: var(--mono); font-size: 11.5px; font-weight: 400; letter-spacing: .12em;
+  text-transform: uppercase; color: var(--tan3); }
+.eyebrow b { color: var(--red); font-weight: 600; }
+.help { color: var(--muted); font-size: 13px; }
+.help-line { margin: 4px 0 0; }
+body.help-off .help { display: none !important; }
+
+.form-control { border: 1px solid var(--tan3); border-radius: 6px; box-shadow: none; color: var(--ink);
+  font-size: 13.5px; height: auto; padding: 6px 8px; }
+textarea.form-control { resize: vertical; }
+.form-control[readonly] { background: #fff; }
+
+/* Segmented controls: native radio buttons, styled */
+.seg .form-group { margin: 0; }
+.seg .shiny-options-group { display: flex; border: 1px solid var(--tan3); border-radius: 6px; background: #fff; }
+.seg .radio-inline { flex: 1; position: relative; margin: 0; padding: 0; border-right: 1px solid var(--tan3); font-weight: 400; }
+.seg .radio-inline + .radio-inline { margin-left: 0; }
+.seg .radio-inline:last-child { border-right: 0; }
+.seg .radio-inline input[type="radio"] { position: absolute; width: 1px; height: 1px; margin: 0; opacity: 0; }
+.seg .radio-inline span { display: block; padding: 5px 6px; text-align: center; font-size: 13px; color: var(--muted); cursor: pointer; }
+.seg .radio-inline:first-child span { border-radius: 5px 0 0 5px; }
+.seg .radio-inline:last-child span { border-radius: 0 5px 5px 0; }
+.seg input:checked + span { background: var(--ink); color: #fff; font-weight: 600; }
+.seg input:focus-visible + span { position: relative; z-index: 1; outline: 3px solid var(--slate); outline-offset: 2px; }
+.vtabs .shiny-options-group { border: 0; gap: 6px; }
+.vtabs .radio-inline { border: 0; flex: none; }
+.vtabs .radio-inline span { font-family: var(--mono); font-size: 11.5px; letter-spacing: .06em; text-transform: uppercase;
+  padding: 5px 9px; border: 1px solid var(--tan3); border-radius: 6px !important; }
+.vtabs input:checked + span { border-color: var(--ink); }
+
+/* Answers and references of the question */
+.answer-head, .answer-row { display: grid; grid-template-columns: 88px minmax(0, 1fr) auto; gap: 6px; align-items: start; }
+.answer-head { margin-top: 8px; font-size: 11.5px; color: var(--muted); }
+.answer-row { margin-top: 6px; }
+.answer-row .form-group { margin: 0; }
+.answer-row input.form-control, .answer-row .k { font-family: var(--mono); font-size: 12px; background: var(--tan); text-align: center; padding: 5px 4px; }
+.answer-row .k { display: block; border-radius: 4px; }
+.answer-row textarea.form-control { font-size: 13px; padding: 5px 7px; }
+#answer_add { margin-top: 8px; }
+.ref-row { display: grid; grid-template-columns: 88px minmax(0, 1fr); gap: 6px; align-items: start; margin-top: 8px; }
+.ref-row .k-plain { font-family: var(--mono); font-size: 12px; padding-top: 4px; word-break: break-word; }
+.thumbs { display: flex; gap: 4px; margin-bottom: 4px; }
+.thumbs img { width: 42px; height: 42px; object-fit: cover; border-radius: 4px; }
+
+/* Run, spending and privacy */
+.run-row, .stop-row { display: flex; gap: 8px; }
+.run-row .btn { flex: 1; padding: 9px 8px; }
+.run-row #run_all { flex: 1.4; }
+.stop-row { display: none; }
+.stop-row .btn { flex: 1; }
+body.is-running .stop-row { display: flex; }
+body.is-running .run-row { display: none; }
+.spend-row { display: flex; justify-content: space-between; font-size: 12.5px; }
+.meter { height: 6px; margin: 4px 0 2px; background: var(--tan); border-radius: 3px; overflow: hidden; }
+.meter i, .bar i { display: block; height: 100%; background: var(--slate); }
+.privacy { margin: 0; font-size: 12.5px; color: var(--muted); }
+.limits { font-size: 13px; font-weight: 600; color: var(--red); }
+
+/* --- Cards -------------------------------------------------------------------- */
+.intro { display: grid; grid-template-columns: 1.2fr 1fr; gap: 22px; align-items: center; padding: 16px 18px; }
+.intro-lead { margin: 0; font-family: var(--serif); font-weight: 700; font-size: 21px; line-height: 1.2; }
+.intro-help { margin: 6px 0 0; font-size: 13.5px; color: var(--muted); }
+.steps { list-style: none; margin: 0; padding: 0; display: flex; flex-direction: column; gap: 8px; font-size: 13.5px; }
+.steps li { display: flex; gap: 8px; align-items: flex-start; }
+.num { flex: none; display: inline-flex; align-items: center; justify-content: center; width: 22px; height: 22px;
+  border-radius: 11px; background: var(--red); color: #fff; font-weight: 700; font-size: 12px; }
+@media (max-width: 899px) { .intro { grid-template-columns: minmax(0, 1fr); gap: 12px; } }
+
+.stats { display: flex; flex-wrap: wrap; align-items: baseline; gap: 8px 22px; margin: 0 0 10px; }
+.stats .v { font-family: var(--serif); font-size: 24px; font-weight: 700; }
+.stats .l { margin-left: 4px; font-size: 12.5px; color: var(--muted); }
+.howto { margin: 0 0 10px; padding: 6px 10px; border-left: 3px solid var(--tan2); background: var(--warm); font-size: 13px; }
+.howto strong { color: var(--ink); }
+
+.gallery { display: grid; grid-template-columns: repeat(auto-fill, minmax(140px, 1fr)); gap: 10px; }
+.tile { margin: 0; }
+.tile img { display: block; width: 100%; aspect-ratio: 1; object-fit: cover; border-radius: 5px; background: var(--tan); }
+.tile .p { display: flex; align-items: center; gap: 6px; margin-top: 4px; font-family: var(--mono); font-size: 12px; }
+.tile .bar { flex: 1; height: 4px; background: var(--tan); border-radius: 2px; overflow: hidden; }
+.tile .t { font-size: 12px; color: var(--muted); }
+
+.table-wrap { max-width: 100%; overflow-x: auto; }
+.table-wrap table { margin: 0; font-size: 13px; }
+.table-wrap th { font-family: var(--mono); font-size: 11.5px; font-weight: 600; white-space: nowrap; }
+
+/* R code card: the summary line and the buttons share the first row */
+.code-card { display: grid; grid-template-columns: minmax(0, 1fr) auto; }
+.code-details { grid-column: 1 / -1; grid-row: 1; min-width: 0; }
+.code-actions { grid-column: 2; grid-row: 1; align-self: start; position: relative; z-index: 1;
+  display: flex; flex-wrap: wrap; gap: 8px; padding: 11px 16px; }
+.code-summary { display: flex; align-items: center; gap: 8px; padding: 14px 340px 14px 16px; cursor: pointer;
+  list-style: none; font-family: var(--serif); font-weight: 700; font-size: 17px; }
+.code-summary::-webkit-details-marker { display: none; }
+.code-summary::before { content: "\203A"; display: inline-block; font-family: var(--mono); color: var(--red); transition: transform .15s; }
+.code-details[open] > .code-summary { border-bottom: 1px solid var(--tan); }
+.code-details[open] > .code-summary::before { transform: rotate(90deg); }
+@media (max-width: 760px) {
+  .code-summary { padding-right: 16px; }
+  .code-actions { grid-row: 2; padding-top: 0; }
+}
+pre.code { margin: 0 0 12px; padding: 10px 12px; background: var(--code-bg); border: 1px solid var(--tan); border-radius: 8px;
+  font-family: var(--mono); font-size: 13px; line-height: 1.6; color: var(--code-text);
+  white-space: pre; word-break: normal; overflow-wrap: normal; overflow-x: auto; }
+.code .c { color: var(--code-c); }
+.code .f { color: var(--code-f); font-weight: 600; }
+.code .s { color: var(--code-s); }
+.files { list-style: none; margin: 8px 0 0; padding: 0; display: grid; grid-template-columns: repeat(auto-fill, minmax(180px, 1fr)); gap: 8px; }
+.file { padding: 8px 10px; background: var(--warm); border: 1px solid var(--tan); border-radius: 8px; }
+.file .n { font-family: var(--mono); font-size: 12px; font-weight: 600; word-break: break-all; }
+.file .d { margin-top: 3px; font-size: 12.5px; color: var(--muted); }
+
+/* --- About and Record ----------------------------------------------------------- */
+.prose h2 { margin: 18px 0 6px; font-family: var(--serif); font-weight: 700; font-size: 18px; }
+.prose h2:first-child { margin-top: 4px; }
+.prose p, .prose li { max-width: 72ch; }
+
+/* --- Footer and video -------------------------------------------------------------- */
+.foot { display: flex; flex-wrap: wrap; justify-content: space-between; gap: 6px 12px; padding: 10px 18px;
+  background: #fff; border-top: 1px solid var(--tan2); font-size: 12.5px; color: var(--muted); }
+.video-dialog { width: min(880px, 94vw); padding: 0; border: 0; border-radius: 10px; background: #fff; }
+.video-dialog::backdrop { background: rgba(27, 27, 27, .7); }
+.video-head { display: flex; align-items: center; justify-content: space-between; padding: 10px 14px; }
+.video-head h2 { margin: 0; font-family: var(--serif); font-weight: 700; font-size: 18px; }
+.video-frame { display: block; width: 100%; aspect-ratio: 16 / 9; border: 0; }