AI for Biometrics

Run and build the Study Knowledge Graph

The complete R Shiny graph, every line

Run it

The interactive tool is a real R Shiny app. From the package root:

install.packages(c("shiny", "bslib", "visNetwork", "igraph"))   # once
shiny::runApp("knowledge_vault/shiny")

Filter by note type, click a note to read its detail and its neighbours, and read the graph metrics (notes, links, clusters, the hub). Synthetic study, no PHI.

The whole app is two files, shown here in full, nothing elided:

shiny/R/logic.R — the pure graph logic (no Shiny). The visual guide, the interactive graph, and the unit tests call these same functions.
shiny/app.R — the UI and the reactive server that draws the graph.

The one idea to hold onto: the graph math lives in logic.R, the screen lives in app.R. You can change what “important” means without touching the app, and change how it looks without touching the math.

The data it reads

Three CSVs are the whole vault. Edit them to point the app at your study (keep the column names): nodes.csv, edges.csv, types.csv.

nodes.csv:  id, title, type, status, owner, cluster, summary
edges.csv:  from, to
types.csv:  type, label, color

Each row of nodes.csv is one study artifact (protocol, SAP, ADaM specs, DMP, monitoring plan, milestones). Each row of edges.csv is one dependency between two notes. types.csv gives every note type a label and a colour. Nothing about the study is hard-coded.

The complete logic core: shiny/R/logic.R

Every line of the graph logic. kg_load() reads the three CSVs; kg_igraph() builds the undirected igraph; kg_metrics() attaches degree and betweenness to each note; kg_neighbors() lists what a note links to; kg_stats() is the value-box row (notes, links, clusters, the hub, the top broker); kg_vis() shapes nodes and edges for visNetwork. Nothing here depends on Shiny, so you can test it in a plain console.

# ---------------------------------------------------------------------------
# logic.R - pure graph logic for the Study Knowledge Graph (CP-101 KB).
# The vault is a set of linked notes; this computes the graph metrics the app,
# the Quarto page, and the tests all share. No PHI. Synthetic study.
# ---------------------------------------------------------------------------
suppressWarnings(suppressMessages(library(igraph)))

kg_load <- function(dir = NULL) {
  cand <- c(dir, "data", "../data", "shiny/data", "knowledge_vault/shiny/data")
  cand <- Filter(Negate(is.null), cand)
  base <- Find(function(d) file.exists(file.path(d, "nodes.csv")), cand)
  if (is.null(base)) stop("Cannot find nodes.csv")
  rd <- function(f) utils::read.csv(file.path(base, f), stringsAsFactors = FALSE)
  list(nodes = rd("nodes.csv"), edges = rd("edges.csv"), types = rd("types.csv"))
}

kg_igraph <- function(kg) {
  g <- igraph::graph_from_data_frame(kg$edges[, c("from", "to")],
         directed = FALSE, vertices = kg$nodes["id"])
  igraph::simplify(g)
}

# Attach degree + betweenness to the node frame (drives node size / importance).
kg_metrics <- function(kg) {
  g <- kg_igraph(kg)
  n <- kg$nodes
  deg <- igraph::degree(g)[n$id]
  btw <- round(igraph::betweenness(g, normalized = TRUE)[n$id] * 100)
  n$degree <- as.integer(deg)
  n$betweenness <- as.integer(btw)
  n
}

kg_neighbors <- function(kg, id) {
  e <- kg$edges
  ids <- unique(c(e$to[e$from == id], e$from[e$to == id]))
  kg$nodes[kg$nodes$id %in% ids, c("id", "title", "type")]
}

kg_stats <- function(kg) {
  n <- kg_metrics(kg)
  hub <- n[order(-n$degree), ][1, ]
  broker <- n[order(-n$betweenness), ][1, ]
  list(n_nodes = nrow(n), n_edges = nrow(kg$edges),
       n_clusters = length(unique(n$cluster)), n_types = length(unique(n$type)),
       hub_id = hub$id, hub_title = hub$title, hub_degree = hub$degree,
       broker_id = broker$id, broker_title = broker$title,
       by_type = as.data.frame(table(type = n$type)),
       orphans = sum(n$degree == 0))
}

# Nodes/edges shaped for visNetwork (id/label/group/value/color/title + from/to).
kg_vis <- function(kg) {
  n <- kg_metrics(kg)
  col <- setNames(kg$types$color, kg$types$type)
  nodes <- data.frame(
    id = n$id, label = n$title, group = n$type,
    value = pmax(4, n$degree), color = unname(col[n$type]),
    title = sprintf("<b>%s</b><br>%s · %s<br>owner: %s<br>%s",
             n$title, n$type, n$status, n$owner, n$summary),
    stringsAsFactors = FALSE)
  edges <- data.frame(from = kg$edges$from, to = kg$edges$to, stringsAsFactors = FALSE)
  list(nodes = nodes, edges = edges, legend = kg$types)
}

Read the metrics: kg_metrics() calls igraph::degree() (how many notes link to a note, which drives node size) and igraph::betweenness() (how much a note sits between clusters, which finds the broker). kg_stats() then sorts by each to pick the hub and the broker. Those numbers are computed from the edges, never asserted.

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 - Study Knowledge Graph (Shiny + visNetwork).
#
# The CP-101 study knowledge base as an interactive, force-directed graph of
# linked notes. Filter by note type, click a node to see its detail and its
# neighbours, and read the graph metrics (degree, brokers, clusters). No PHI.
#
# Run:  shiny::runApp("knowledge_vault/shiny")
# Data: data/nodes.csv + edges.csv + types.csv (swap in your own vault).
# ===========================================================================
library(shiny); library(bslib); library(visNetwork)
source("R/logic.R")
kg <- kg_load("data")
V  <- kg_vis(kg)

ui <- page_sidebar(
  title = "Study Knowledge Graph",
  theme = bs_theme(version = 5, bootswatch = "darkly", primary = "#5b8cff"),
  sidebar = sidebar(
    width = 320,
    div(class = "small text-muted",
        "The CP-101 study knowledge base as a linked-note graph. Filter by type, ",
        "click a node for its detail and neighbours. Synthetic, no PHI."),
    checkboxGroupInput("types", "Show note types",
      choices = setNames(kg$types$type, kg$types$label), selected = kg$types$type),
    selectInput("focus", "Focus a note", choices = c("(none)" = "", setNames(kg$nodes$id, kg$nodes$title))),
    hr(),
    uiOutput("detail")
  ),
  layout_columns(
    col_widths = c(3,3,3,3),
    value_box("Notes", textOutput("k_nodes"), theme = "secondary"),
    value_box("Links", textOutput("k_edges"), theme = "secondary"),
    value_box("Clusters", textOutput("k_clusters"), theme = "info"),
    value_box("Hub links (CP-101)", textOutput("k_hub"), theme = "warning")
  ),
  card(card_header("Knowledge graph (drag to explore · click a note)"),
       visNetworkOutput("net", height = "560px"))
)

server <- function(input, output, session) {
  st <- kg_stats(kg)
  output$k_nodes    <- renderText(as.character(st$n_nodes))
  output$k_edges    <- renderText(as.character(st$n_edges))
  output$k_clusters <- renderText(as.character(st$n_clusters))
  output$k_hub      <- renderText(as.character(st$hub_degree))

  sub <- reactive({
    keep <- V$nodes$group %in% input$types
    ns <- V$nodes[keep, ]
    es <- V$edges[V$edges$from %in% ns$id & V$edges$to %in% ns$id, ]
    list(nodes = ns, edges = es)
  })

  output$net <- renderVisNetwork({
    s <- sub()
    legend <- data.frame(label = kg$types$label, color = kg$types$color,
                         shape = "dot", stringsAsFactors = FALSE)
    visNetwork(s$nodes, s$edges, background = "#141925") |>
      visNodes(font = list(color = "#e9edf7", size = 16), borderWidth = 1) |>
      visEdges(color = list(color = "#2A3242", highlight = "#5b8cff"), smooth = FALSE) |>
      visOptions(highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE)) |>
      visPhysics(solver = "forceAtlas2Based",
                 forceAtlas2Based = list(gravitationalConstant = -55), stabilization = TRUE) |>
      visLegend(useGroups = FALSE, addNodes = legend, width = 0.18, position = "left", ncol = 1) |>
      visEvents(selectNode = "function(n){ Shiny.setInputValue('kg_sel', n.nodes[0], {priority:'event'}); }")
  })

  observeEvent(input$focus, {
    if (nzchar(input$focus)) visNetworkProxy("net") |> visFocus(id = input$focus, scale = 1.2) |>
      visSelectNodes(id = input$focus)
  })
  selected <- reactiveVal("hub")
  observeEvent(input$kg_sel, selected(input$kg_sel))
  observeEvent(input$focus, if (nzchar(input$focus)) selected(input$focus))

  output$detail <- renderUI({
    id <- selected(); n <- kg$nodes[kg$nodes$id == id, ]
    if (!nrow(n)) return(div(class = "small text-muted", "Click a note in the graph."))
    nb <- kg_neighbors(kg, id)
    col <- setNames(kg$types$color, kg$types$type)[n$type]
    tagList(
      div(class = "fw-bold", n$title),
      div(class = "small", tags$span(style = sprintf("color:%s;font-weight:700", col), n$type),
          " · ", n$status, " · ", n$owner),
      div(class = "small text-muted my-1", n$summary),
      div(class = "small", tags$b(sprintf("Links to %d notes: ", nrow(nb))),
          paste(nb$title, collapse = ", "))
    )
  })
}

shinyApp(ui, server)

How the reactivity works, part by part

Follow the data, not the layout. Here is the chain that makes a checkbox redraw the graph and a click fill the detail panel.

The graph is loaded once, up front. kg <- kg_load("data") and V <- kg_vis(kg) run when the app starts, so the shaped nodes and edges (V$nodes, V$edges) are ready before any input. The value-box numbers come from st <- kg_stats(kg) in the server.

The type checkboxes drive one reactive. The sub reactive keeps only the nodes whose group is in input$types, then keeps only the edges whose both ends survive. Re-checking a type re-runs sub(), which is the only thing renderVisNetwork reads, so the subgraph redraws. You never redraw by hand.

Drawing the graph reads that reactive. output$net renders the visNetwork from sub() and attaches a selectNode event handler. That JavaScript callback fires Shiny.setInputValue("kg_sel", nodes.nodes[0]) whenever you click a node, which is how a click in the browser becomes an R input.

Selecting a note fills the detail panel. selected is a reactiveVal that starts at "hub". observeEvent(input$kg_sel, selected(input$kg_sel)) updates it on a click, and the focus dropdown updates it too. output$detail reads selected(), looks up that note, and calls kg_neighbors(kg, id) to list what it links to.

Focus just recenters. The input$focus observer uses a visNetworkProxy to call visFocus() and visSelectNodes() on the chosen note, without redrawing the whole graph.

Everything else just reads the loaded data. The value boxes read st, the graph reads sub(), and the detail panel reads selected() plus kg_neighbors(). Change the CSVs and every one of these updates on the next run.

Verify it without a browser

The graph logic has no Shiny in it, so you can drive it in a plain console. This is how the logic was checked before it was ever opened in a browser:

source("knowledge_vault/shiny/R/logic.R")
kg <- kg_load("knowledge_vault/shiny/data")
st <- kg_stats(kg)
st$n_nodes           # number of notes
st$n_edges           # number of links
st$hub_title         # the most-connected note
st$broker_title      # the note that most brokers between clusters
nrow(kg_neighbors(kg, "sap"))   # how many notes the SAP links to

The unit tests: shiny is not involved

The graph logic is covered by a zero-dependency test you run with Rscript. It is the same file the guide and the interactive graph trust:

#!/usr/bin/env Rscript
# Unit tests for the Study Knowledge Graph logic. Needs igraph.
# Run:  Rscript knowledge_vault/tests/test-logic.R

lp <- Find(file.exists, c("../shiny/R/logic.R", "knowledge_vault/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, "nodes.csv")),
            c("../shiny/data", "knowledge_vault/shiny/data", "shiny/data"))
kg <- kg_load(dir)
s  <- kg_stats(kg)
v  <- kg_vis(kg)

stopifnot(
  "28 notes"                 = s$n_nodes == 28,
  "59 links"                 = s$n_edges == 59,
  "hub is most-connected"    = s$hub_id == "hub",
  "no orphan notes"          = s$orphans == 0,
  "every vis node has colour"= all(!is.na(v$nodes$color)),
  "no India/NA in owners"    = !any(grepl("India|\\(NA\\)", kg$nodes$owner)),
  "SAP links to 7 notes"     = nrow(kg_neighbors(kg, "sap")) == 7
)

cat("Knowledge-graph logic: all tests passed\n")

Run it:

Rscript knowledge_vault/tests/test-logic.R   # prints: Knowledge-graph logic: all tests passed

Make it yours

Add a note: a row in nodes.csv plus its links in edges.csv. It appears in the graph, sized by how many notes link to it.
Add a category: a row in types.csv (type, label, colour), and it becomes a checkbox and a legend entry.
Change what “important” means: size nodes by betweenness instead of degree in kg_vis(). Nothing else changes, because everything reads that one function.
Add a panel: another card() in the UI and a matching render* in the server.

The same skeleton, a logic core plus data as CSV plus one render path, builds the lifecycle monitor and the UAT tracker too.