# ---------------------------------------------------------------------------
# logic.R — pure UAT evaluation logic for the IRT/RTSM tracker.
# Operations-only, synthetic, no PHI. "participant" not "subject".
#
# Plain functions shared by the Shiny app, the Quarto documents, and the unit
# tests. The go-live gate and the KPIs are computed here, once.
# ---------------------------------------------------------------------------
STATUSES <- c("Pass", "Fail", "Blocked", "In Progress", "Not Run")
SEVERITIES <- c("Critical", "Major", "Minor")
uat_load <- function(dir = NULL) {
cand <- c(dir, "../templates", "templates", "uat_irt/templates")
cand <- Filter(Negate(is.null), cand)
base <- Find(function(d) file.exists(file.path(d, "test_scripts.csv")), cand)
if (is.null(base)) stop("Cannot find templates/test_scripts.csv (looked in: ",
paste(cand, collapse = ", "), ")")
rd <- function(f) utils::read.csv(file.path(base, f), stringsAsFactors = FALSE, check.names = FALSE)
list(tests = rd("test_scripts.csv"),
defects = rd("defect_log.csv"),
trace = rd("traceability_matrix.csv"))
}
# The go-live sign-off gate. READY only when: every Critical test passes,
# there are zero OPEN Critical/Major defects, and traceability is complete.
uat_gate <- function(tests, defects, trace) {
crit_fail <- sum(tests$Priority == "Critical" & tests$Status != "Pass")
open_cm <- sum(defects$Status == "Open" & defects$Severity %in% c("Critical", "Major"))
trace_gap <- sum(trace$Covered != "Y")
go <- crit_fail == 0 && open_cm == 0 && trace_gap == 0
list(crit_fail = crit_fail, open_cm = open_cm, trace_gap = trace_gap, go = go,
verdict = if (go) "READY for sign-off" else "NOT ready - blocked")
}
uat_summary <- function(tests, defects, trace) {
total <- nrow(tests)
pass <- sum(tests$Status == "Pass")
fail <- sum(tests$Status == "Fail")
open_now <- sum(tests$Status %in% c("Blocked", "In Progress", "Not Run"))
run <- sum(tests$Status %in% c("Pass", "Fail"))
open_def <- sum(defects$Status == "Open")
traced <- sum(trace$Covered == "Y")
list(total = total, pass = pass, fail = fail, open_now = open_now,
open_def = open_def, traced = traced, n_urs = nrow(trace),
cov = round(100 * traced / nrow(trace)),
pass_rate = if (run > 0) round(100 * pass / run) else 0)
}
# Counts per test area by status, tidy for a stacked bar.
uat_area_counts <- function(tests) {
df <- as.data.frame(table(Area = tests$Area, Status = factor(tests$Status, levels = STATUSES)))
df[df$Freq > 0, ]
}AI for Biometrics
Run and build the UAT tracker
The complete R Shiny app, every line
Run it
The interactive tool is a real R Shiny app. From the package root:
install.packages(c("shiny", "bslib", "DT", "ggplot2")) # once
shiny::runApp("uat_irt/shiny")Select a test and mark it Pass/Fail, close a defect, and the KPIs and the go-live sign-off gate recompute live. Download your results to CSV from the sidebar to drop into the Excel workbook and the eTMF.
The whole app is two files, shown here in full, nothing elided:
- shiny/R/logic.R — the pure gate and KPI logic (no Shiny). The visual guide, the dashboard, and the unit tests call these same functions.
- shiny/app.R — the UI and the reactive server.
The one idea to hold onto: the rules live in logic.R, the screen lives in app.R. You can change what the gate means without touching the app, and change how it looks without touching the rules.
The data it reads
Three CSVs are the whole dataset. Edit them to point the app at your study (keep the column names): test_scripts.csv, defect_log.csv, traceability_matrix.csv.
The complete logic core: shiny/R/logic.R
Every line of the logic. uat_load() reads the three CSVs; uat_gate() is the conjunctive go-live rule; uat_summary() is the KPI row; uat_area_counts() shapes the by-area bar. Nothing here depends on Shiny, so you can test it in a plain console.
Read the gate: it counts three things and requires all three to be zero. A Critical test not yet Pass, an open Critical or Major defect, or a requirement with no test, any one of them holds the gate. That is the whole meaning of “conjunctive”, written as go <- crit_fail == 0 && open_cm == 0 && trace_gap == 0. Change that line and you have changed what “ready” means, everywhere, at once.
The complete app: shiny/app.R
Every line of the UI and server. Read it top to bottom; the walk-through below points at the parts that matter.
# ===========================================================================
# app.R — IRT / RTSM UAT Execution & Sign-off Tracker (Shiny)
#
# A runnable, editable version of the UAT tracker. Select a test and mark it
# Pass/Fail/Blocked, close a defect, and watch the KPIs and the go-live sign-off
# gate recompute live. Operations-only, synthetic, no PHI.
#
# Run: shiny::runApp("uat_irt/shiny") (from the package root)
#
# The gate + KPI logic lives in R/logic.R (shared with the Quarto docs + unit
# tests); the seed data is ../templates/*.csv (edit it to reuse for a study).
# ===========================================================================
library(shiny)
library(bslib)
library(DT)
library(ggplot2)
source("R/logic.R")
seed <- uat_load()
ui <- page_sidebar(
title = "IRT / RTSM UAT Tracker",
theme = bs_theme(version = 5, bootswatch = "darkly", primary = "#5b8cff"),
sidebar = sidebar(
width = 330,
div(class = "small text-muted", "Operations-only, synthetic, no PHI. ",
"Select a test row to see its detail and mark it; close a defect to watch the gate move."),
hr(),
uiOutput("detail"),
hr(),
downloadButton("dl_tests", "Download test results (CSV)", class = "btn-sm"),
actionButton("reset", "Reset to seed", class = "btn-sm btn-outline-warning")
),
layout_columns(
col_widths = c(2, 2, 2, 3, 3),
value_box("Test scripts", textOutput("v_total"), theme = "secondary"),
value_box("Passed", textOutput("v_pass"), theme = "success"),
value_box("Failed", textOutput("v_fail"), theme = "danger"),
value_box("Open defects", textOutput("v_def"), theme = "warning"),
value_box("Requirements traced", textOutput("v_cov"), theme = "info")
),
layout_columns(
col_widths = c(8, 4),
card(card_header("Test scripts — click a row to select"),
DTOutput("tests")),
card(card_header("Go-live sign-off gate"),
uiOutput("gate"))
),
layout_columns(
col_widths = c(7, 5),
card(card_header("Execution by test area"), plotOutput("plot", height = "300px")),
card(card_header("Defect log — edit Status (Open / Closed)"), DTOutput("defects"))
)
)
server <- function(input, output, session) {
rv <- reactiveValues(tests = seed$tests, defects = seed$defects, trace = seed$trace)
observeEvent(input$reset, {
rv$tests <- seed$tests; rv$defects <- seed$defects; rv$trace <- seed$trace
})
gate <- reactive(uat_gate(rv$tests, rv$defects, rv$trace))
summ <- reactive(uat_summary(rv$tests, rv$defects, rv$trace))
output$v_total <- renderText(as.character(summ()$total))
output$v_pass <- renderText(as.character(summ()$pass))
output$v_fail <- renderText(as.character(summ()$fail))
output$v_def <- renderText(as.character(summ()$open_def))
output$v_cov <- renderText(sprintf("%d%%", summ()$cov))
# ---- tests table (select a row) ----
output$tests <- renderDT({
isolate({
d <- rv$tests[, c("TestID","Area","RequirementID","TestTitle","Priority","Status","LinkedDefect")]
datatable(d, rownames = FALSE, selection = "single", filter = "top",
colnames = c("ID","Area","Requirement","Title","Priority","Status","Defect"),
options = list(pageLength = 10, dom = "tip", scrollX = TRUE)) |>
formatStyle("Status", fontWeight = "bold",
color = styleEqual(c("Pass","Fail","Blocked","In Progress","Not Run"),
c("#43c47d","#e8657a","#e0a64c","#94a1c0","#94a1c0")))
})
}, server = TRUE)
tproxy <- dataTableProxy("tests")
refresh_tests <- function() {
d <- rv$tests[, c("TestID","Area","RequirementID","TestTitle","Priority","Status","LinkedDefect")]
replaceData(tproxy, d, resetPaging = FALSE, rownames = FALSE)
}
# ---- selected-test detail + status setter ----
output$detail <- renderUI({
sel <- input$tests_rows_selected
if (is.null(sel) || length(sel) == 0)
return(div(class = "small text-muted", "No test selected."))
t <- rv$tests[sel, ]
tagList(
div(class = "fw-bold", sprintf("%s — %s", t$TestID, t$TestTitle)),
div(class = "small text-muted mb-1", sprintf("%s · %s · %s", t$Area, t$RequirementID, t$Priority)),
div(class = "small mb-1", tags$b("Steps: "), t$Steps),
div(class = "small mb-2", tags$b("Expected: "), t$ExpectedResult),
radioButtons("set_status", "Mark this test:", choices = STATUSES,
selected = t$Status, inline = TRUE)
)
})
observeEvent(input$set_status, {
sel <- input$tests_rows_selected
if (!is.null(sel) && length(sel) == 1 && rv$tests$Status[sel] != input$set_status) {
rv$tests$Status[sel] <- input$set_status
refresh_tests()
}
})
# ---- defect log (edit Status) ----
output$defects <- renderDT({
isolate({
d <- rv$defects[, c("DefectID","Severity","Status","FoundInTest","Description")]
datatable(d, rownames = FALSE, selection = "none",
editable = list(target = "cell", disable = list(columns = c(0,1,3,4))),
colnames = c("ID","Severity","Status","Test","Description"),
options = list(dom = "t", paging = FALSE)) |>
formatStyle("Status", fontWeight = "bold",
color = styleEqual(c("Open","Closed"), c("#e8657a","#43c47d")))
})
}, server = TRUE)
dproxy <- dataTableProxy("defects")
observeEvent(input$defects_cell_edit, {
info <- input$defects_cell_edit
val <- trimws(info$value)
if (info$col + 1L == 3L && val %in% c("Open","Closed")) { # Status column
rv$defects$Status[info$row] <- val
d <- rv$defects[, c("DefectID","Severity","Status","FoundInTest","Description")]
replaceData(dproxy, d, resetPaging = FALSE, rownames = FALSE)
}
})
# ---- gate ----
output$gate <- renderUI({
g <- gate()
crit_cls <- if (g$go) "alert alert-success" else "alert alert-danger"
chk <- function(ok, txt) div(class = "small",
tags$span(class = if (ok) "text-success" else "text-danger",
if (ok) "✔ " else "✘ "), txt)
div(
div(class = crit_cls, div(class = "h5 mb-0", g$verdict)),
chk(g$crit_fail == 0, sprintf("%d critical test(s) not yet passing", g$crit_fail)),
chk(g$open_cm == 0, sprintf("%d open critical/major defect(s)", g$open_cm)),
chk(g$trace_gap == 0, sprintf("%d requirement(s) without a test", g$trace_gap)),
div(class = "small text-muted mt-2",
"A named tester/biostatistician signs UAT off. The gate packages the evidence; it does not grant approval.")
)
})
# ---- area plot ----
output$plot <- renderPlot({
df <- uat_area_counts(rv$tests)
ggplot(df, aes(Freq, Area, fill = Status)) +
geom_col(width = 0.7) +
scale_fill_manual(values = c("Pass" = "#43c47d", "Fail" = "#e8657a",
"Blocked" = "#e0a64c", "In Progress" = "#5b8cff", "Not Run" = "#6b7794"),
drop = FALSE) +
labs(x = "Tests", y = NULL, fill = NULL) +
theme_minimal(base_size = 11) +
theme(legend.position = "top",
plot.background = element_rect(fill = "#222630", colour = NA),
panel.background = element_rect(fill = "#222630", colour = NA),
text = element_text(colour = "#e9edf7"),
axis.text = element_text(colour = "#c5cee4"),
panel.grid.major = element_line(colour = "#3a4157"),
panel.grid.minor = element_blank())
})
output$dl_tests <- downloadHandler(
filename = function() "uat_test_results.csv",
content = function(file) utils::write.csv(rv$tests, file, row.names = FALSE))
}
shinyApp(ui, server)How the reactivity works, part by part
Follow the data, not the layout. Here is the chain that makes a click flip the gate.
The editable state lives in one place. rv <- reactiveValues(tests = seed$tests, defects = seed$defects, trace = seed$trace) holds everything the user can change. Every output reads from rv, so when rv changes, everything that depends on it recomputes. That is the entire trick.
The rules are reactive expressions. gate <- reactive(uat_gate(rv$tests, rv$defects, rv$trace)) and summ <- reactive(uat_summary(rv$tests, rv$defects, rv$trace)) re-run automatically whenever any of the three frames in rv changes. You never call the gate by hand.
Selecting a row shows its detail. The tests table is a DT with single-row selection. input$tests_rows_selected gives the selected row; output$detail renders that test’s steps, expected result, and a radioButtons control set to its current status.
Marking a test mutates the state. The observer on input$set_status writes the new status into rv$tests for the selected row. That write is what makes the gate flip, because gate() depends on rv$tests. You do not recompute anything yourself; changing rv triggers the reactive that does.
Closing a defect does the same. The defect table is editable on its Status column; the observer on input$defects_cell_edit accepts only “Open” or “Closed”, writes it into rv$defects, and the gate recomputes.
Everything else just reads the reactives. The value boxes read summ(), the gate card reads gate(), the by-area plot reads rv$tests, and the download handler writes rv$tests to CSV so results round-trip to Excel and the eTMF.
Verify it without a browser
You can drive the reactive graph headless, which is how this app was checked before it was ever opened in a browser:
shiny::testServer("uat_irt/shiny", {
# mark the failing critical test as Pass and watch the count drop
session$setInputs(
tests_rows_selected = which(rv$tests$TestID == "RAND-04"),
set_status = "Pass"
)
gate()$crit_fail # one lower than before
# close the two open critical/major defects
session$setInputs(defects_cell_edit = list(row = which(rv$defects$DefectID == "DEF-01"),
col = 2, value = "Closed"))
gate()$open_cm # drops toward zero
})The unit tests: shiny is not involved
The gate logic is covered by a zero-dependency test you run with Rscript. It is the same file the guide and dashboard trust:
#!/usr/bin/env Rscript
# Unit tests for the UAT gate/KPI logic. Zero dependencies (base R only).
# Run from the package root: Rscript uat_irt/tests/test-logic.R
# or from this folder: Rscript test-logic.R
lp <- Find(file.exists, c("../shiny/R/logic.R", "uat_irt/shiny/R/logic.R", "shiny/R/logic.R"))
stopifnot("found logic.R" = !is.null(lp))
source(lp)
dir <- Find(function(d) file.exists(file.path(d, "test_scripts.csv")),
c("../templates", "uat_irt/templates", "templates"))
d <- uat_load(dir)
g <- uat_gate(d$tests, d$defects, d$trace)
s <- uat_summary(d$tests, d$defects, d$trace)
stopifnot(
"seed gate is blocked" = !g$go,
"two open critical/major" = g$open_cm == 2,
"one traceability gap" = g$trace_gap == 1,
"at least one critical failing" = g$crit_fail >= 1,
"coverage < 100 with the gap" = s$cov < 100,
"totals add up" = s$pass + s$fail + s$open_now == s$total
)
# fixing every criterion makes the gate READY
t2 <- d$tests; t2$Status[t2$Priority == "Critical"] <- "Pass"
df2 <- d$defects; df2$Status[df2$Severity %in% c("Critical", "Major")] <- "Closed"
tr2 <- d$trace; tr2$Covered <- "Y"
stopifnot("fixing all criteria -> READY" = uat_gate(t2, df2, tr2)$go)
cat("UAT logic: all tests passed\n")Run it:
Rscript uat_irt/tests/test-logic.R # prints: UAT logic: all tests passedMake it yours
- Change the rule: edit
uat_gate()inshiny/R/logic.R, for example to allow a Minor-defect waiver. Nothing else changes, because everything calls that one function. - Change the data: edit the three CSVs in
templates/. - Add a column: add it to the CSV and to the
datatable()column list inapp.R. - Add a panel: another
card()in the UI and a matchingrender*in the server.
The same skeleton, a logic core plus reactiveValues plus reactive rules plus outputs, builds the find-hours app and the four dashboards too.