Deploy 71faef1 from GitHub

R/answers.R

@@ -20,7 +20,6 @@ answers_table <- function(spec, answers, target) {
       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
@@ -64,17 +63,20 @@ alt_text <- function(row, target) {
   )
 }
 
-# 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) {
+# What the probability is. A saved run of a sample adds that the app reuses it.
+# The facts of a sample describe its full saved run: they follow only for all
+# its saved answers (`full`, not Try on 5) and its default target.
+help_note <- function(spec, stats, target, saved = FALSE, full = TRUE) {
   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 = " ")
+  saved <- spec$source %in% names(SAMPLE_FACTS_TEXT) && saved
+  if (!saved) return(generic)
+  facts <- if (full && identical(target, target_answer(spec$question))) {
+    SAMPLE_FACTS_TEXT[[spec$source]]
+  }
+  paste(c(generic, facts, SAVED_RUN_TEXT), collapse = " ")
 }
 
 # The CSV text of the table for the download

R/bundle.R

@@ -70,14 +70,15 @@ bundle_readme <- function(spec, refs, name, has_data, date) {
 }
 
 # 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()) {
+# answers table of answers_table(). `rows` are the rows of Try on 5 for the
+# code (NULL for all inputs).
+write_bundle <- function(spec, table, zipfile, date = Sys.Date(), rows = NULL) {
   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(paste0(run_code(spec, date, rows), "\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)]

R/code.R

@@ -146,19 +146,33 @@ references_code <- function(refs) {
   paste0("\nreferences <- list(\n", paste(by_answer$code, collapse = ",\n"), "\n)")
 }
 
-# The lines that define `texts` (or `injuries`)
-text_code <- function(spec) {
+# The comment above the inputs of Try on 5
+TRY_COMMENT <- "# The inputs of Try on 5 in the app"
+
+# The lines that keep the rows of Try on 5: x[c(3, 17), ] for a data frame,
+# x[c(3, 17)] for a vector. Empty with no rows.
+keep_code <- function(var, rows, frame = FALSE) {
+  if (length(rows) == 0) return("")
+  sprintf(
+    "\n%s\n%s <- %s[c(%s)%s]",
+    TRY_COMMENT, var, var, paste(rows, collapse = ", "), if (frame) ", " else ""
+  )
+}
+
+# The lines that define `texts` (or `injuries`). With `rows` (Try on 5), one
+# more line keeps those rows.
+text_code <- function(spec, rows = NULL) {
   if (spec$source == "injuries") {
-    return(paste(
+    return(paste0(paste(
       "set.seed(2026)",
       "# This line needs the package dplyr.",
       "injuries <- ohio_injuries |>",
       "  dplyr::slice_sample(n = 20, by = collapsed_nature_title)",
       sep = "\n"
-    ))
+    ), keep_code("injuries", rows, frame = TRUE)))
   }
   if (is.null(spec$text_column)) {
-    return('texts <- read.csv("data.csv")$text')
+    return(paste0('texts <- read.csv("data.csv")$text', keep_code("texts", rows)))
   }
   # read.csv() changes odd column names unless check.names is FALSE
   read <- if (make.names(spec$text_column) == spec$text_column) {
@@ -166,12 +180,15 @@ text_code <- function(spec) {
   } else {
     'read.csv("data.csv", check.names = FALSE)'
   }
-  paste0("texts <- ", read, "[[", r_string(spec$text_column), "]]")
+  # A CSV file keeps its own row numbers ("Row 3"): the app drops empty texts
+  file_rows <- as.integer(stringr::str_extract(spec$inputs$file[rows], "[0-9]+$"))
+  paste0("texts <- ", read, "[[", r_string(spec$text_column), "]]", keep_code("texts", file_rows))
 }
 
-# The lines that define `images` and `references`
-inputs_code <- function(spec, refs) {
-  if (spec$mode == "text") return(text_code(spec))
+# The lines that define `images` and `references`. With `rows` (Try on 5),
+# the code names only the images of those rows.
+inputs_code <- function(spec, refs, rows = NULL) {
+  if (spec$mode == "text") return(text_code(spec, rows))
   if (spec$source == "textiles") {
     by_answer <- refs |>
       dplyr::summarise(
@@ -181,13 +198,18 @@ inputs_code <- function(spec, refs) {
         ),
         .by = answer
       )
+    images <- if (is.null(rows)) {
+      'images <- file.path(folder, textiles$file[textiles$role == "input"])'
+    } else {
+      paste0(TRY_COMMENT, "\nimages <- file.path(folder, ", r_vector(spec$inputs$file[rows]), ")")
+    }
     return(paste0(
       'folder <- system.file("extdata", "textiles", package = "decisions")\n',
-      'images <- file.path(folder, textiles$file[textiles$role == "input"])\n',
+      images, "\n",
       "references <- list(\n", paste(by_answer$code, collapse = ",\n"), "\n)"
     ))
   }
-  inputs <- spec$inputs
+  inputs <- if (is.null(rows)) spec$inputs else spec$inputs[rows, ]
   images <- if (nrow(inputs) == 0) {
     'images <- list.files("images", full.names = TRUE)'
   } else {
@@ -220,8 +242,9 @@ question_code <- function(question, var) {
   )
 }
 
-# The code of a run, as one string. `date` is the day of the run.
-run_code <- function(spec, date = Sys.Date()) {
+# The code of a run, as one string. `date` is the day of the run. `rows` are
+# the rows of Try on 5 (NULL for all inputs).
+run_code <- function(spec, date = Sys.Date(), rows = NULL) {
   refs <- reference_files(spec)
   var <- question_var(spec)
   data_arg <- if (spec$mode == "text") {
@@ -232,10 +255,10 @@ run_code <- function(spec, date = Sys.Date()) {
   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)",
+    'library(decisions) # install once: pak::pak("fmegahed/decisions")',
     "",
     paths_comment(spec, refs),
-    inputs_code(spec, refs),
+    inputs_code(spec, refs, rows),
     "",
     question_code(spec$question, var),
     "",
@@ -252,7 +275,12 @@ run_code <- function(spec, date = Sys.Date()) {
   )
 }
 
-# The number of lines of the code, for the closed card
+# The number of lines of code, for the closed card: the top-level calls, so
+# comments and blank lines do not count. Code that does not parse counts the
+# lines that are not blank and not only a comment.
 code_lines <- function(code) {
-  stringr::str_count(code, "\n") + 1L
+  calls <- tryCatch(length(parse(text = code, keep.source = FALSE)), error = \(e) NULL)
+  if (!is.null(calls)) return(calls)
+  lines <- stringr::str_trim(stringr::str_split_1(code, "\n"))
+  sum(lines != "" & !startsWith(lines, "#"))
 }

R/config.R

@@ -11,6 +11,9 @@ APP_DATE <- "24 October 2026"
 # (tests/testthat/test-config.R enforces this).
 MODEL <- "jev-1.14.0"
 
+# Day of the saved runs of the two samples (their answers record MODEL)
+SAVED_RUN_DATE <- "2026-10-23"
+
 # Commit of the decisions package that the app uses
 DECISIONS_SHA <- "b25fc9ffa7908e9a6a2d9833f080de1456c9d50a"
 

R/help.R

@@ -1,4 +1,4 @@
-# Help: the text of the intro, the help lines, the notes, the Record tab and
+# Help: the text of the intro, the help lines, the notes, the Uptime 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.
@@ -48,7 +48,7 @@ help_text <- function(key) {
       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.",
+    answers = "The answers show here after a run. A run of an unchanged sample shows its saved run, 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.",

R/runs.R

@@ -12,6 +12,17 @@ chunk_ids <- function(n, size = CHUNK_SIZE) {
   split(seq_len(n), ceiling(seq_len(n) / size)) |> unname()
 }
 
+# The rows of Try on 5, sorted: the same rows each time. With labels, the
+# first row of each label in a shuffle comes first, then the other rows of the
+# shuffle. The seed does not change the random state of the session.
+try_rows <- function(inputs, n = 5, seed = 2026) {
+  if (nrow(inputs) <= n) return(seq_len(nrow(inputs)))
+  shuffled <- withr::with_seed(seed, sample(nrow(inputs)))
+  label <- inputs$label[shuffled]
+  first <- utils::head(shuffled[!is.na(label) & !duplicated(label)], n)
+  sort(c(first, setdiff(shuffled, first))[seq_len(n)])
+}
+
 # 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"))

R/samples.R

@@ -22,6 +22,9 @@ SAMPLE_FACTS_TEXT <- list(
   )
 )
 
+# The sentence of the Help note when the answers on show are a saved run
+SAVED_RUN_TEXT <- "The app reuses this run to save cost. Change the question or a description to ask Jev again."
+
 # The questions, copied from the vignettes images.Rmd and choosing-a-model.Rmd
 sample_question <- function(id) {
   switch(id,
@@ -107,3 +110,18 @@ sample_data <- function(id) {
     list(spec = sample_spec(id), answers = sample_answers(id))
   SAMPLE_CACHE[[id]]
 }
+
+# Is the spec the setup of its sample? Then a run shows the saved run and makes
+# no call. Edits of spaces only in the instructions and the descriptions do not
+# count; every other part must be the same.
+sample_unchanged <- function(spec) {
+  if (!isTRUE(spec$source %in% c("textiles", "injuries"))) return(FALSE)
+  sample <- sample_data(spec$source)$spec
+  setup <- \(s) {
+    list(
+      s$mode, s$source, s$inputs, s$references, s$question$type, names(s$question$answers),
+      stringr::str_squish(s$question$instructions), stringr::str_squish(unname(s$question$answers))
+    )
+  }
+  identical(setup(spec), setup(sample))
+}

R/server.R

@@ -105,7 +105,8 @@ app_server <- function(input, output, session, deps = app_deps()) {
   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)
+  # list(answers, key, saved, token of the run, rows of Try on 5 or NULL for all)
+  results <- shiny::reactiveVal(NULL)
   mean_tokens <- shiny::reactiveVal(NULL) # list(fingerprint, mean)
   session_cost <- shiny::reactiveVal(0)
   usage <- shiny::reactiveVal(deps$store$read())
@@ -172,14 +173,14 @@ app_server <- function(input, output, session, deps = app_deps()) {
     rows_version(rows_version() + 1)
   }
 
-  # A sample opens with its saved answers and makes no call
+  # A sample opens with no answers and makes no call. A run of the unchanged
+  # sample then shows its saved run (see start_run()).
   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)
   }
@@ -351,15 +352,18 @@ app_server <- function(input, output, session, deps = app_deps()) {
     m <- mean_tokens()
     if (!is.null(m) && identical(m$fingerprint, spec_fingerprint(s))) m$mean
   }
+  # A run of an unchanged sample shows its saved run: it costs nothing, so no
+  # limit stops it
   checks <- shiny::reactive({
     s <- spec()
+    saved <- sample_unchanged(s)
     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))
-      allowed <- run_allowed(cost, status)
+      cost <- if (saved) 0 else estimate_cost(s, n, mean_for(s))
+      allowed <- if (saved) list(ok = TRUE, reason = NA_character_) else run_allowed(cost, status)
       # No inputs: the buttons stay off, and no limit is the reason
-      list(ok = allowed$ok && n > 0, reason = allowed$reason, n = n, cost = cost)
+      list(ok = allowed$ok && n > 0, reason = allowed$reason, n = n, cost = cost, saved = saved)
     })
   })
   shiny::observe({
@@ -412,13 +416,25 @@ app_server <- function(input, output, session, deps = app_deps()) {
   start_run <- function(n) {
     if (running()) return()
     s <- spec()
+    n <- min(n, nrow(s$inputs))
+    # Try on 5 takes the rows of try_rows(); Run all takes all rows (try_rows()
+    # gives all rows when n is the number of inputs). The R code repeats the
+    # rows of Try on 5 (`subset`).
+    rows <- try_rows(s$inputs, n)
+    subset <- if (n < nrow(s$inputs)) rows
+    # An unchanged sample shows the saved answers of these rows at once: no
+    # call, no cost and no write to the usage store
+    if (sample_unchanged(s)) {
+      notice(character())
+      saved <- sample_data(s$source)$answers[rows, ]
+      return(results(list(answers = saved, key = key(), saved = TRUE, rows = subset)))
+    }
     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())
     )
@@ -426,12 +442,13 @@ app_server <- function(input, output, session, deps = app_deps()) {
     notice(character())
     job$spec <- s
     job$key <- key()
-    job$chunks <- chunk_ids(n)
+    job$chunks <- purrr::map(chunk_ids(n), \(i) rows[i])
+    job$rows <- subset
     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
+    # found or wrote
     job$token <- (job$token %||% 0L) + 1L
     results(utils::modifyList(results() %||% list(), list(token = job$token)))
     running(TRUE)
@@ -454,7 +471,11 @@ app_server <- function(input, output, session, deps = app_deps()) {
     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))
+    if (shown) {
+      results(list(
+        answers = job$answers, key = job$key, saved = FALSE, token = job$token, rows = job$rows
+      ))
+    }
     # 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]
@@ -493,10 +514,12 @@ app_server <- function(input, output, session, deps = app_deps()) {
       stats::setNames(srcs, l$answers)
     )
   })
-  # A cost below one cent reads "< $0.01", not "$0.00": a run is never free
+  # A cost below one cent reads "< $0.01", not "$0.00": a run is never free.
+  # Only the saved run of an unchanged sample costs nothing.
   output$run_estimate <- shiny::renderText({
     all <- checks()$run_all
     if (all$n == 0) return("")
+    if (all$saved) return(paste(all$n, "\u00b7 saved run, no cost"))
     cost <- if (all$cost > 0 && all$cost < 0.005) "< $0.01" else sprintf("\u2248 $%.2f", all$cost)
     paste(all$n, "\u00b7", cost)
   })
@@ -522,7 +545,7 @@ app_server <- function(input, output, session, deps = app_deps()) {
     if (is.null(stats())) return(NULL)
     r <- results()
     note <- if (r$saved) {
-      paste0("Saved run, ", MODEL)
+      sprintf("Saved run of %s, %s", SAVED_RUN_DATE, MODEL)
     } else if (running()) {
       sprintf("%d of %d", nrow(r$answers), length(unlist(job$chunks)))
     }
@@ -536,9 +559,11 @@ app_server <- function(input, output, session, deps = app_deps()) {
       )
     }
   })
+  # The facts of a sample describe its full saved run, not Try on 5
   output$help_answers <- shiny::renderText({
     if (is.null(stats())) return(help_text("answers"))
-    help_note(spec(), stats(), target(), saved = results()$saved)
+    r <- results()
+    help_note(spec(), stats(), target(), saved = r$saved, full = is.null(r$rows))
   })
   output$gallery <- shiny::renderUI({
     t <- table()
@@ -558,9 +583,12 @@ app_server <- function(input, output, session, deps = app_deps()) {
   # --- 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()))
+  # The code repeats the run on show: after Try on 5, the same rows; with no
+  # answers on show, or after Run all, all inputs
+  code_rows <- shiny::reactive(if (!is.null(table())) results()$rows)
+  code <- shiny::reactive(run_code(spec(), run_date(), code_rows()))
   output$code_summary <- shiny::renderText(
-    sprintf("R code of this run \u00b7 %d lines", code_lines(code()))
+    sprintf("R code of this run \u00b7 %d lines of code", code_lines(code()))
   )
   output$code <- shiny::renderText(code())
   output$bundle_files <- shiny::renderUI(bundle_files_ui(bundle_names(spec()), zip_name()))
@@ -573,7 +601,7 @@ app_server <- function(input, output, session, deps = app_deps()) {
   )
   output$download_bundle <- shiny::downloadHandler(
     filename = zip_name,
-    content = \(file) write_bundle(spec(), download_table(), file, run_date())
+    content = \(file) write_bundle(spec(), download_table(), file, run_date(), code_rows())
   )
 
   # --- Outputs: status ----------------------------------------------------------

R/status.R

@@ -1,6 +1,6 @@
 # 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 last checks (Uptime tab).
 
 # The columns of status.csv
 STATUS_COLUMNS <- c("time_utc", "http_status", "seconds", "answered", "app_version")

R/ui.R

@@ -115,7 +115,7 @@ top_bar <- function(video) {
       shiny::div(
         role = "tablist",
         tab_button("build", "Build", TRUE), tab_button("about", "About"),
-        tab_button("record", "Record")
+        tab_button("record", "Uptime")
       )
     ),
     shiny::div(
@@ -315,7 +315,7 @@ build_panel <- function() {
   )
 }
 
-# --- About and Record tabs --------------------------------------------------
+# --- About and Uptime tabs --------------------------------------------------
 
 about_panel <- function() {
   # The About text is Markdown; its links open in a new tab
@@ -330,9 +330,9 @@ record_panel <- function() {
     class = "page card",
     shiny::div(
       class = "bd prose",
-      shiny::h2("Record"),
+      shiny::h2("Uptime"),
       shiny::p(help_text("record")),
-      scroll_region("Record table", shiny::tableOutput("record_table")),
+      scroll_region("Uptime table", shiny::tableOutput("record_table")),
       shiny::p(
         ext_link("Status file", LINKS$status), " \u00b7 ",
         ext_link("Package record", LINKS$package_record), " \u00b7 ",

README.md

@@ -47,7 +47,7 @@ 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_JEV_API` is the TypeSafe key. Without it, the app opens, but a run shows "The demo is not available right now." A run of an unchanged sample still shows its 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.

www/app.js

@@ -14,7 +14,7 @@
   }
   function byId(id) { return document.getElementById(id); }
 
-  // ---- Tabs: Build, About, Record ----------------------------------------
+  // ---- Tabs: Build, About, Uptime ----------------------------------------
 
   var TABS = ['build', 'about', 'record'];
 

www/theme.css

@@ -231,6 +231,8 @@ body.is-running .run-row { display: none; }
 .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; }
+/* The full text of an input wraps in a column that is wide enough to read */
+#table td:first-child { min-width: 16em; }
 
 /* R code card: the summary line and the buttons share the first row */
 .code-card { display: grid; grid-template-columns: minmax(0, 1fr) auto; }
@@ -258,7 +260,7 @@ pre.code { margin: 0 0 12px; padding: 10px 12px; background: var(--code-bg); bor
 .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 ----------------------------------------------------------- */
+/* --- About and Uptime ----------------------------------------------------------- */
 .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; }