# ---------------------------------------------------------------------------
# logic.R - pure SCREENING logic for TRIALMON. Operations-only, synthetic, no PHI.
# Every function is a screening lens: it flags a position for a human reviewer.
# It never reports a clinical number and never adjudicates a DLT or a Hy's-Law case.
# Reported safety numbers come from the validated safety database.
#
# Screening rules (illustrative thresholds):
# eDISH / Hy's-Law : (ALT or AST > 3x ULN) AND TBili > 2x ULN -> RED
# QTcF (ICH E14) : QTcF > 500 ms or dQTcF > 60 ms -> RED ; >480/>30 -> AMBER
# 3+3 DLT : >= 2 adjudicated DLT in an evaluable cohort -> RED ; 1 -> AMBER
# ---------------------------------------------------------------------------
trialmon_load <- function(dir = NULL) {
cand <- c(dir, "data", "../data", "trialmon_shiny/data", "sasr_monitoring_wiki/trialmon_shiny/data")
cand <- Filter(Negate(is.null), cand)
base <- Find(function(d) file.exists(file.path(d, "participants.csv")), cand)
if (is.null(base)) stop("Cannot find participants.csv (run R/gen_data.R first)")
rd <- function(f) utils::read.csv(file.path(base, f), stringsAsFactors = FALSE)
list(participants = rd("participants.csv"), aes = rd("aes.csv"), cohorts = rd("cohorts.csv"))
}
qtc_sev <- function(qt, dqt) {
if (qt > 500 || dqt > 60) "RED" else if (qt > 480 || dqt > 30) "AMBER" else if (qt > 450) "watch" else "GREEN"
}
r_pattern <- function(r) if (r >= 5) "hepatocellular" else if (r >= 2) "mixed" else "cholestatic"
# Attach screening columns to the participant frame.
score_participants <- function(p) {
p$hys <- (p$alt > 3 | p$ast > 3) & p$tbl > 2
p$rratio <- round(p$alt / p$alp, 1)
p$pattern <- vapply(p$rratio, r_pattern, character(1))
p$qsev <- mapply(qtc_sev, p$qt, p$dqt)
p
}
# Per-cohort 3+3 DLT screening state.
dlt_state <- function(tm) {
p <- tm$participants
do.call(rbind, lapply(split(p, p$cohort), function(x) {
nd <- sum(x$dltfl == "Y"); neval <- sum(x$dlteval == "Y")
sev <- if (nd >= 2) "RED" else if (nd == 1) "AMBER" else "GREEN"
data.frame(cohort = x$cohort[1], dose_mg = x$dose_mg[1], n = nrow(x),
dlt = nd, evaluable = neval, sev = sev, stringsAsFactors = FALSE)
}))
}
sev_rank <- function(x) match(x, c("GREEN","watch","AMBER","RED"))
worst <- function(v) c("GREEN","watch","AMBER","RED")[max(sev_rank(v), na.rm = TRUE)]
# The screening worklist: every firing position, ranked RED before AMBER.
trialmon_worklist <- function(tm) {
p <- score_participants(tm$participants); wl <- list()
add <- function(id, sev, check, val, rule) wl[[length(wl)+1]] <<-
data.frame(id=id, sev=sev, check=check, value=val, rule=rule, stringsAsFactors=FALSE)
for (j in which(p$hys)) add(p$id[j], "RED", "eDISH / Hy's-Law screen",
sprintf("ALT %.1fx & TBili %.1fx (R %.1f %s)", p$alt[j], p$tbl[j], p$rratio[j], p$pattern[j]),
"(ALT or AST >3x) AND TBili >2x")
for (j in which(p$qsev == "RED")) add(p$id[j], "RED", "QTcF (ICH E14 screen)",
sprintf("%d ms, d%d", p$qt[j], p$dqt[j]), "QTcF >500 or dQTcF >60 ms")
for (j in which(p$qsev == "AMBER")) add(p$id[j], "AMBER", "QTcF (ICH E14 screen)",
sprintf("%d ms, d%d", p$qt[j], p$dqt[j]), "QTcF >480 or dQTcF >30 ms")
ds <- dlt_state(tm)
for (j in which(ds$sev != "GREEN")) add(paste(ds$cohort[j], "cohort"), ds$sev[j],
"Adjudicated DLT vs 3+3", sprintf("%d/%d evaluable", ds$dlt[j], ds$evaluable[j]),
if (ds$sev[j]=="RED") ">=2 DLT in cohort" else "1 DLT in cohort")
if (!length(wl)) return(data.frame())
out <- do.call(rbind, wl); out[order(out$sev != "RED"), ]
}
trialmon_status <- function(tm) {
p <- score_participants(tm$participants); ds <- dlt_state(tm)
worst(c(if (any(p$hys)) "RED" else "GREEN", p$qsev, ds$sev))
}
trialmon_kpis <- function(tm) {
p <- score_participants(tm$participants); ae <- tm$aes
list(n = nrow(p), cohorts = nrow(tm$cohorts),
red = sum(p$hys) + sum(p$qsev == "RED") + sum(dlt_state(tm)$sev == "RED"),
amber = sum(p$qsev == "AMBER") + sum(dlt_state(tm)$sev == "AMBER"),
g3ae = length(unique(ae$id[ae$grade >= 3])),
sae = sum(ae$serious == "Y"),
ongoing = sum(p$disposition == "Ongoing"))
}
# A simple visit trajectory for one analyte, baseline -> peak (for the detail view).
trajectory <- function(baseline, peak, visits = c("Screen","C1D1","C1D8","C1D15","C2D1","C3D1","EOT")) {
n <- length(visits); f <- seq(0, 1, length.out = n)^1.4
data.frame(visit = factor(visits, levels = visits), value = round(baseline + (peak - baseline) * f, 2))
}AI for Biometrics
Run and build TRIALMON
The complete R Shiny safety-screening console, every line
Run it
TRIALMON is a real R Shiny app. From the package root:
install.packages(c("shiny", "bslib", "ggplot2")) # once
shiny::runApp("sasr_monitoring_wiki/trialmon_shiny")Click a point on the eDISH plot (or pick a participant in the sidebar) to open that participant’s evidence packet: the eDISH position, the QTcF tier, the adverse events, the disposition, and the analyte trajectory. Every panel is a SCREENING lens. It flags a position for the medical monitor / SRC / DSMB, it never reports a clinical number and never adjudicates a DLT or a Hy’s-Law case. Reported safety numbers come from the validated safety database.
The whole tool is a few short files, shown here in full, nothing elided:
- trialmon_shiny/R/logic.R — the pure screening rules (no Shiny). The visual guide, the dashboard, and the unit tests all call these same functions.
- trialmon_shiny/R/gen_data.R — writes the synthetic CSVs so you can see the shape; swap them for a read-only safety-database export.
- trialmon_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 a screen means without touching the app, and change how it looks without touching the rules.
The data it reads
Three CSVs are the whole dataset. Open them directly, or edit them to point the app at your study (keep the column names): participants.csv (one row per participant, values as xULN multiples and ms, not measurements), aes.csv (the adverse-event rows), and cohorts.csv (the dose ladder). On a real study you replace them with a read-only export from the validated safety database / ADaM (ADLB, ADEG, ADAE), same columns. Nothing writes back.
The complete screening core: R/logic.R
Every line of the screening logic. trialmon_load() reads the three CSVs; score_participants() attaches the eDISH AND-gate and the QTcF tier to each participant; dlt_state() rolls DLTs up per cohort for the 3+3 ladder; trialmon_worklist() builds the ranked flag list; trialmon_status() and trialmon_kpis() summarise the whole portfolio. Nothing here depends on Shiny, so you can test it in a plain console.
Read the eDISH gate: p$hys <- (p$alt > 3 | p$ast > 3) & p$tbl > 2. That single line is why a high ALT alone does not fire. Bilirubin must be up too. In the synthetic data CP101-009 (ALT 4.2x, TBili 1.6x) stays green because the second half of the & is false, while CP101-014 (ALT 5.6x, TBili 3.1x) lands in the RED quadrant. Change that line and you change what “a Hy’s-Law position” means, everywhere the guide, the dashboard, the app, and the tests, all at once.
The complete data generator: R/gen_data.R
Every line of the synthetic-data builder. It writes the three CSVs deterministically from one seed, plants the signature illustrative positions (the RED CP101-014, the near-miss CP101-009, the coordinated sub-threshold drift on CP101-011), and stops. On a real study you delete this step and drop in the safety-database export instead.
# ---------------------------------------------------------------------------
# gen_data.R - deterministic synthetic safety-monitoring portfolio for TRIALMON.
# Values are xULN multiples / ms, NOT real measurements. No PHI. The dashboard is
# a SCREENING lens: it flags positions for a human, it never reports a number and
# never adjudicates. Writes ../data/*.csv (participants, aes, cohorts).
# ---------------------------------------------------------------------------
gen_trialmon <- function(out_dir = "data", seed = 20260611L) {
set.seed(seed)
COH <- data.frame(
cohort = c("C1","C2","C3","C4","C5"),
dose_mg = c(10,30,60,120,200), planned_n = c(3,3,6,6,4),
stringsAsFactors = FALSE)
disp_choices <- c("Ongoing","Completed","Discontinued")
rows <- list(); k <- 0
for (ci in seq_len(nrow(COH))) {
for (j in seq_len(COH$planned_n[ci])) {
k <- k + 1
id <- sprintf("CP101-%03d", k)
rows[[k]] <- data.frame(
id = id, cohort = COH$cohort[ci], dose_mg = COH$dose_mg[ci],
disposition = sample(disp_choices, 1, prob = c(.6,.3,.1)),
alt = round(runif(1, .7, 1.6), 1), ast = round(runif(1, .7, 1.4), 1),
tbl = round(runif(1, .4, .9), 1), alp = round(runif(1, .8, 1.2), 1),
qt = round(runif(1, 405, 442)), dqt = round(runif(1, 2, 20)),
qbase = round(runif(1, 400, 430)),
hgb = round(runif(1, 12.8, 15.2), 1), neut = round(runif(1, 2.4, 5.5), 1),
plt = round(runif(1, 190, 300)), creat = round(runif(1, .75, 1.05), 2),
dltfl = "N", dlteval = "Y", note = "", stringsAsFactors = FALSE)
}
}
P <- do.call(rbind, rows)
set_p <- function(id, ...) { P[P$id == id, names(list(...))] <<- list(...) }
# the signature illustrative positions (screening lenses)
set_p("CP101-006", qt = 486, dqt = 33, qbase = 453,
note = "QTcF 486 ms (>480) - AMBER tier (as-collected, pending ECG QC). Baseline 453 already watch-band.")
set_p("CP101-009", alt = 4.2, ast = 3.6, tbl = 1.6, alp = 1.2,
note = "ALT 4.2x but TBili 1.6x (<2x) -> NOT a Hy's-Law position (the AND-gate). GREEN every visit; the eDISH near-miss.")
set_p("CP101-011", alt = 2.6, ast = 2.4, tbl = 1.7, alp = 1.3, qt = 474, dqt = 26,
hgb = 11.1, neut = 1.9, creat = 1.28,
note = "Every univariate value below its own action threshold, yet several organs drift together. No single rule fires; whether the coordinated sub-threshold drift warrants a human look is a clinical judgement, not an automated flag.")
set_p("CP101-012", alt = 2.3, ast = 2.1, tbl = 1.4, qt = 468, dqt = 22,
note = "Mild co-drift, every value sub-threshold (QTcF 468 = watch). GREEN/watch on every deterministic check.")
set_p("CP101-014", alt = 5.6, ast = 4.9, tbl = 3.1, alp = 1.4, dltfl = "Y",
disposition = "Discontinued",
note = "Hy's-Law screening position (RED): ALT 5.6x AND TBili 3.1x. R-ratio ~4 = MIXED pattern. Also an adjudicated DLT. Medical monitor + SRC notified.")
set_p("CP101-018", qt = 503, dqt = 41, qbase = 462,
note = "QTcF 503 ms (>500) - RED tier at an on-treatment visit (as-collected, pending ECG QC). Baseline 462 already watch-band.")
AE <- rbind(
data.frame(id="CP101-014", soc="Investigations", pt="ALT increased", grade=3L, serious="Y", related="Related", teae="Y", onset=18L, resolution=NA_integer_),
data.frame(id="CP101-014", soc="Investigations", pt="AST increased", grade=3L, serious="N", related="Related", teae="Y", onset=18L, resolution=NA_integer_),
data.frame(id="CP101-014", soc="Hepatobiliary disorders", pt="Hyperbilirubinaemia", grade=3L, serious="Y", related="Related", teae="Y", onset=22L, resolution=NA_integer_),
data.frame(id="CP101-009", soc="Investigations", pt="ALT increased", grade=2L, serious="N", related="Possible", teae="Y", onset=15L, resolution=34L),
data.frame(id="CP101-018", soc="Investigations", pt="Electrocardiogram QT prolonged", grade=2L, serious="N", related="Possible", teae="Y", onset=22L, resolution=NA_integer_),
data.frame(id="CP101-006", soc="Investigations", pt="Electrocardiogram QT prolonged", grade=1L, serious="N", related="Unlikely", teae="Y", onset=15L, resolution=40L),
data.frame(id="CP101-011", soc="Blood/lymphatic disorders", pt="Anaemia", grade=1L, serious="N", related="Possible", teae="Y", onset=20L, resolution=NA_integer_),
stringsAsFactors = FALSE)
# a scatter of mild, expected background AEs
bg <- c("Nausea","Headache","Fatigue","Dizziness","Diarrhoea")
for (i in 1:9) {
pid <- sprintf("CP101-%03d", sample(1:22, 1))
AE <- rbind(AE, data.frame(id=pid, soc="General disorders", pt=sample(bg,1),
grade=sample(1:2,1), serious="N", related=sample(c("Unlikely","Possible"),1),
teae="Y", onset=sample(3:40,1), resolution=sample(c(NA,20:50),1), stringsAsFactors=FALSE))
}
dir.create(out_dir, showWarnings = FALSE, recursive = TRUE)
utils::write.csv(P, file.path(out_dir, "participants.csv"), row.names = FALSE)
utils::write.csv(AE, file.path(out_dir, "aes.csv"), row.names = FALSE)
utils::write.csv(COH, file.path(out_dir, "cohorts.csv"), row.names = FALSE)
invisible(P)
}
if (sys.nframe() == 0) gen_trialmon(out_dir = file.path(dirname(getwd()), "data"))The complete app: 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 - TRIALMON participant-safety SCREENING console (Shiny).
#
# The signature eDISH / Hy's-Law scatter, the QTcF and 3+3 screens, an AE grid,
# and a per-participant evidence packet. Click a point on the eDISH plot (or pick
# a participant) to open the packet. Every panel is a SCREENING lens: it flags a
# position for the medical monitor / SRC, it never reports a number or adjudicates.
# Synthetic, no PHI (values are xULN multiples / ms, not measurements).
#
# Run: shiny::runApp("sasr_monitoring_wiki/trialmon_shiny")
# ===========================================================================
library(shiny); library(bslib); library(ggplot2)
source("R/logic.R")
if (!file.exists("data/participants.csv")) { source("R/gen_data.R"); gen_trialmon("data") }
tm <- trialmon_load("data")
P <- score_participants(tm$participants)
DARK <- theme_minimal(base_size = 12) + theme(
legend.position = "top", plot.background = element_rect(fill="#141925", colour=NA),
panel.background = element_rect(fill="#141925", colour=NA), text = element_text(colour="#e9edf7"),
axis.text = element_text(colour="#c5cee4"), panel.grid = element_line(colour="#2a3242"),
legend.text = element_text(colour="#c5cee4"), plot.title = element_text(colour="#e9edf7", size=12))
ui <- page_sidebar(
title = "TRIALMON - Participant-Safety Screening",
theme = bs_theme(version = 5, bootswatch = "darkly", primary = "#5b8cff"),
sidebar = sidebar(
width = 320,
div(class = "small text-muted",
"A screening lens across the safety database. It flags positions; the medical ",
"monitor / SRC / DSMB decide. Values are xULN multiples, synthetic, no PHI. ",
"Click a point on the eDISH plot or pick a participant to open the evidence packet."),
selectInput("pid", "Participant", choices = sort(P$id), selected = "CP101-014"),
hr(),
uiOutput("packet")
),
layout_columns(
col_widths = c(2,2,2,2,2,2),
value_box("Safety status", uiOutput("v_status"), theme = "secondary"),
value_box("Participants", textOutput("v_n"), theme = "secondary"),
value_box("RED flags", textOutput("v_red"), theme = "danger"),
value_box("AMBER flags", textOutput("v_amber"), theme = "warning"),
value_box("Grade >=3 AE", textOutput("v_g3"), theme = "secondary"),
value_box("SAEs", textOutput("v_sae"), theme = "secondary")
),
layout_columns(
col_widths = c(7,5),
card(card_header("eDISH / Hy's-Law screen (click a point)"), plotOutput("edish", height="360px", click="edish_click")),
card(card_header("Screening worklist (ranked)"), uiOutput("worklist"))
),
layout_columns(
col_widths = c(4,4,4),
card(card_header("3+3 DLT ladder"), plotOutput("ladder", height="240px")),
card(card_header("AE by SOC x max grade"), plotOutput("aegrid", height="240px")),
card(card_header(textOutput("traj_hdr")), plotOutput("traj", height="240px"))
)
)
server <- function(input, output, session) {
st <- trialmon_status(tm); k <- trialmon_kpis(tm)
output$v_status <- renderUI({
col <- c(GREEN="#43c47d", watch="#5f8aa8", AMBER="#e0a64c", RED="#e8657a")[st]
span(style = sprintf("color:%s;font-weight:700;white-space:nowrap", col), st)
})
output$v_n <- renderText(as.character(k$n)); output$v_red <- renderText(as.character(k$red))
output$v_amber <- renderText(as.character(k$amber)); output$v_g3 <- renderText(as.character(k$g3ae))
output$v_sae <- renderText(as.character(k$sae))
output$edish <- renderPlot({
P$flag <- ifelse(P$hys, "Hy's-Law (RED)", ifelse(P$alt > 3 & P$tbl <= 2, "ALT-only (near-miss)", "within limits"))
ggplot(P, aes(alt, tbl, colour = flag)) +
annotate("rect", xmin=3, xmax=Inf, ymin=2, ymax=Inf, fill="#e8657a", alpha=.08) +
geom_hline(yintercept=2, linetype=2, colour="#e0a64c") +
geom_vline(xintercept=3, linetype=2, colour="#e0a64c") +
geom_point(size=3) +
geom_text(data=P[P$hys | P$alt>3, ], aes(label=id), colour="#c5cee4", size=3, vjust=-1) +
scale_x_log10() + scale_y_log10() +
scale_colour_manual(values=c("Hy's-Law (RED)"="#e8657a","ALT-only (near-miss)"="#e0a64c","within limits"="#43c47d")) +
labs(x="peak ALT (x ULN, log)", y="peak TBili (x ULN, log)", colour=NULL,
title="Upper-right quadrant = Hy's-Law screening position") + DARK
})
observeEvent(input$edish_click, {
np <- nearPoints(P, input$edish_click, xvar="alt", yvar="tbl", maxpoints=1)
if (nrow(np)) updateSelectInput(session, "pid", selected = np$id[1])
})
output$worklist <- renderUI({
wl <- trialmon_worklist(tm)
if (!nrow(wl)) return(div(class="text-muted small", "No screening flags - all within limits."))
tagList(lapply(seq_len(nrow(wl)), function(j) {
r <- wl[j, ]; col <- if (r$sev=="RED") "#e8657a" else "#e0a64c"
div(class="d-flex gap-2 py-1", style="border-bottom:1px solid #2a3242",
div(style=sprintf("flex:0 0 8px;height:8px;border-radius:50%%;background:%s;margin-top:6px",col)),
div(div(class="small", tags$b(r$id), " · ", r$check),
div(class="small text-muted", r$value, " — ", tags$code(r$rule))))
}))
})
output$ladder <- renderPlot({
ds <- dlt_state(tm); ds$cohort <- factor(ds$cohort, levels=ds$cohort)
ds$col <- c(GREEN="#43c47d", AMBER="#e0a64c", RED="#e8657a")[ds$sev]
ggplot(ds, aes(cohort, dose_mg, fill=sev)) + geom_col(width=.7) +
geom_text(aes(label=sprintf("%d/%d DLT", dlt, evaluable)), vjust=-0.5, colour="#e9edf7", size=3.3) +
scale_fill_manual(values=c(GREEN="#43c47d", AMBER="#e0a64c", RED="#e8657a")) +
labs(x=NULL, y="dose (mg)", fill=NULL, title="Dose escalation vs 3+3") + DARK
})
output$aegrid <- renderPlot({
ae <- tm$aes; ae$soc <- sub(" disorders","", ae$soc)
g <- aggregate(list(n=ae$grade), by=list(soc=ae$soc, grade=factor(ae$grade, levels=1:4)), length)
ggplot(g, aes(grade, soc, fill=n)) + geom_tile(colour="#141925") +
geom_text(aes(label=n), colour="#0b1020", fontface="bold", size=3.6) +
scale_fill_gradient(low="#3a4157", high="#e8657a") +
labs(x="CTCAE grade", y=NULL, fill=NULL, title="Treatment-emergent AEs") + DARK +
theme(legend.position="none")
})
sel <- reactive(P[P$id == input$pid, ])
output$traj_hdr <- renderText(sprintf("%s trajectory (x ULN)", input$pid))
output$traj <- renderPlot({
s <- sel()
d <- rbind(cbind(trajectory(1.0, s$alt), analyte="ALT"),
cbind(trajectory(0.9, s$ast), analyte="AST"),
cbind(trajectory(0.7, s$tbl), analyte="TBili"))
ggplot(d, aes(visit, value, colour=analyte, group=analyte)) +
geom_hline(yintercept=c(2,3), linetype=3, colour="#e0a64c") +
geom_line(linewidth=1) + geom_point(size=2) +
scale_colour_manual(values=c(ALT="#e8657a", AST="#e0a64c", TBili="#5b8cff")) +
labs(x=NULL, y="x ULN", colour=NULL) + DARK +
theme(axis.text.x=element_text(angle=40, hjust=1))
})
output$packet <- renderUI({
s <- sel(); ae <- tm$aes[tm$aes$id == input$pid, ]
scol <- c(GREEN="#43c47d", watch="#5f8aa8", AMBER="#e0a64c", RED="#e8657a")
tagList(
div(class="fw-bold", sprintf("%s — %s (%d mg)", s$id, s$cohort, s$dose_mg)),
div(class="small text-muted mb-1", s$disposition),
div(class="small", tags$b("eDISH: "),
if (s$hys) span(style="color:#e8657a;font-weight:700", sprintf("Hy's-Law position — ALT %.1fx & TBili %.1fx (R %.1f, %s)", s$alt, s$tbl, s$rratio, s$pattern))
else sprintf("ALT %.1fx / TBili %.1fx — not a Hy's position", s$alt, s$tbl)),
div(class="small", tags$b("QTcF: "), span(style=sprintf("color:%s;font-weight:700", scol[s$qsev]),
sprintf("%d ms (d%d) — %s", s$qt, s$dqt, s$qsev))),
if (nrow(ae)) div(class="small mt-1", tags$b(sprintf("AEs (%d): ", nrow(ae))),
paste(sprintf("%s G%d%s", ae$pt, ae$grade, ifelse(ae$serious=="Y"," SAE","")), collapse="; ")),
if (nzchar(s$note)) div(class="small text-muted mt-1", tags$em(s$note))
)
})
}
shinyApp(ui, server)How the reactivity works, part by part
Follow the data, not the layout. Here is the chain that makes a click on the scatter open a participant’s evidence packet.
The whole portfolio is scored once, up front. tm <- trialmon_load("data") reads the CSVs and P <- score_participants(tm$participants) attaches the eDISH and QTcF columns. The value boxes, the eDISH plot, the worklist, and the 3+3 ladder are all views of that one scored frame, so they always agree.
The signature scatter is a plot output with a click. output$edish renders the log-log ALT-vs-TBili scatter with the Hy’s-Law quadrant shaded; the plotOutput("edish", click="edish_click") in the UI turns every pixel of it into a click target.
Clicking maps back to a participant. The observer on input$edish_click calls nearPoints(P, input$edish_click, xvar="alt", yvar="tbl", maxpoints=1) to find the nearest point on the log-log plot, then updateSelectInput(session, "pid", selected = np$id[1]) sets the selected participant. You never wire the click to the packet by hand; changing input$pid is enough.
The selected participant drives the packet. sel <- reactive(P[P$id == input$pid, ]) is the one reactive everything on the detail side depends on. When input$pid changes, sel() recomputes, and output$packet (the sidebar evidence packet) and output$traj (the analyte trajectory) both re-render for the new participant.
The screens read the scored frame, not each other. output$worklist calls trialmon_worklist(tm), output$ladder calls dlt_state(tm), and the value boxes read trialmon_kpis(tm). Each is a pure function of the data, so there is no hidden order of operations to get wrong.
Verify it without a browser
The screening rules are covered by a zero-dependency test you run with Rscript. It is the same file the guide and dashboard trust, and it pins the AND-gate directly: a high ALT with normal bilirubin must NOT be flagged as a Hy’s-Law position.
#!/usr/bin/env Rscript
# Unit tests for the TRIALMON screening logic. Base R only.
# Run: Rscript sasr_monitoring_wiki/trialmon_tests/test-logic.R
lp <- Find(file.exists, c("../trialmon_shiny/R/logic.R", "sasr_monitoring_wiki/trialmon_shiny/R/logic.R", "trialmon_shiny/R/logic.R"))
stopifnot("found logic.R" = !is.null(lp)); source(lp)
dir <- Find(function(d) file.exists(file.path(d, "participants.csv")),
c("../trialmon_shiny/data", "sasr_monitoring_wiki/trialmon_shiny/data", "trialmon_shiny/data"))
tm <- trialmon_load(dir)
p <- score_participants(tm$participants)
wl <- trialmon_worklist(tm)
k <- trialmon_kpis(tm)
stopifnot(
"22 participants" = nrow(p) == 22,
"CP101-014 is a Hy's position" = isTRUE(p$hys[p$id == "CP101-014"]),
"CP101-009 is the AND-gate near-miss (ALT>3, TBili<2, NOT Hy's)" =
p$alt[p$id=="CP101-009"] > 3 && p$tbl[p$id=="CP101-009"] < 2 && !p$hys[p$id=="CP101-009"],
"CP101-018 QTcF RED" = p$qsev[p$id == "CP101-018"] == "RED",
"CP101-006 QTcF AMBER" = p$qsev[p$id == "CP101-006"] == "AMBER",
"overall status RED" = trialmon_status(tm) == "RED",
"worklist ranked red-first" = nrow(wl) == 0 || wl$sev[1] == "RED",
"C4 cohort shows a DLT" = dlt_state(tm)$dlt[dlt_state(tm)$cohort == "C4"] == 1,
"two SAEs" = k$sae == 2
)
# the eDISH AND-gate: ALT high alone must NOT fire Hy's without bili
stopifnot("AND-gate holds" = !score_participants(
transform(tm$participants, alt = ifelse(id=="CP101-001", 9, alt)))$hys[tm$participants$id=="CP101-001"])
cat("TRIALMON logic: all tests passed\n")Run it:
Rscript sasr_monitoring_wiki/trialmon_tests/test-logic.R # prints: TRIALMON logic: all tests passedMake it yours
- Change a threshold: edit
qtc_sev()or the eDISH gate inR/logic.R. Everything that shows a screen updates, because they all call that one function. - Change the data: swap the three CSVs for a read-only safety-database / ADaM export with the same columns.
- Add a screen: add a rule to
R/logic.Rand atrialmon_worklist()entry, then a matchingrender*inapp.R. - Add a panel: another
card()in the UI and a matchingrenderPlot/renderUIin the server.
The same skeleton, a logic core plus scored frame plus pure summary functions plus outputs, builds the lifecycle monitor and the find-hours app too.