AI for Biometrics

Run and build the find-hours app

The complete R Shiny app, every line

Hours / effort only throughout: no dollars, rates, or headcount. The one equation:

NET FINDABLE = (Sum of Planned + Contingency) - Sum of EAC

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("budget_reconciliation/shiny")

Edit a task’s EAC, change the ask, and the net-findable roll-up and the absorbable-vs-change-order verdict recompute live. Download the change-order draft when there is a shortfall, and the reconciled ledger to CSV for the Excel workbook.

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

shiny/R/logic.R — the pure reconciliation math (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 “net findable” means without touching the app, and change how it looks without touching the rules.

The data it reads

One CSV is the whole dataset. Edit it to point the app at your study (keep the column names): project_hours_ledger.csv. The rows named CONTINGENCY and TOTAL are handled specially by hours_load(): the contingency row sets the reserve, the total row is dropped, and everything else is a real deliverable.

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

Every line of the logic. hours_load() reads the ledger CSV and splits out the contingency reserve; hours_metrics() is the portfolio roll-up; find_hours() sources a new ask from under-run slack first, then contingency, and reports the residual; change_order_text() drafts the hours-only note. Nothing here depends on Shiny, so you can test it in a plain console.

# ---------------------------------------------------------------------------
# logic.R — pure reconciliation logic for the "Find Hours" tool.
# HOURS / EFFORT ONLY. No dollars, rates, ROI, or headcount. Synthetic data.
#
# These are plain functions with no Shiny dependency, so the Shiny app, the
# Quarto documents, and the unit tests all call the SAME logic. Edit the math
# in one place and every surface updates.
# ---------------------------------------------------------------------------

DEFAULT_CONTINGENCY <- 40L

# Load the effort ledger from a CSV (the editable template) and split out the
# contingency reserve and the TOTAL summary row from the real deliverable rows.
hours_load <- function(path = NULL) {
  cand <- c(path,
            "../templates/project_hours_ledger.csv",
            "templates/project_hours_ledger.csv",
            "budget_reconciliation/templates/project_hours_ledger.csv")
  cand <- Filter(Negate(is.null), cand)
  p <- Find(file.exists, cand)
  if (is.null(p)) stop("Cannot find project_hours_ledger.csv (looked in: ",
                       paste(cand, collapse = ", "), ")")
  d <- utils::read.csv(p, stringsAsFactors = FALSE, check.names = FALSE)
  cont_row  <- grepl("^CONTINGENCY", d$Deliverable, ignore.case = TRUE)
  total_row <- grepl("^TOTAL",       d$Deliverable, ignore.case = TRUE)
  contingency <- if (any(cont_row)) as.integer(d$PlannedHours[cont_row][1]) else DEFAULT_CONTINGENCY
  ledger <- d[!cont_row & !total_row,
              c("Deliverable", "PlannedHours", "ActualToDate", "PctComplete", "EAC")]
  names(ledger) <- c("deliverable", "planned", "actual", "pct", "eac")
  ledger[c("planned", "actual", "pct", "eac")] <-
    lapply(ledger[c("planned", "actual", "pct", "eac")], as.numeric)
  rownames(ledger) <- NULL
  list(ledger = ledger, contingency = contingency)
}

# Portfolio-level roll-up. net_slack is the honest under-run across every task
# (planned minus the forecast cost to finish, floored at zero); findable adds
# the contingency reserve. This is the one number the whole tool is about.
hours_metrics <- function(ledger, contingency = DEFAULT_CONTINGENCY) {
  planned <- sum(ledger$planned); actual <- sum(ledger$actual); eac <- sum(ledger$eac)
  net_slack <- max(0, planned - eac)
  list(planned = planned, actual = actual, eac = eac,
       net_slack = net_slack, contingency = contingency,
       findable = net_slack + contingency)
}

# Test a new out-of-scope ask against the net headroom, sourcing hours in order:
# under-run slack first, then contingency, then whatever is left is a shortfall.
find_hours <- function(need, ledger, contingency = DEFAULT_CONTINGENCY) {
  need <- max(0, round(as.numeric(need)))
  m <- hours_metrics(ledger, contingency)
  from_slack <- min(need, m$net_slack)
  from_cont  <- min(need - from_slack, contingency)
  shortfall  <- need - from_slack - from_cont
  absorbable <- shortfall <= 0
  list(need = need, from_slack = from_slack, from_cont = from_cont,
       shortfall = shortfall, contingency_left = contingency - from_cont,
       absorbable = absorbable, metrics = m,
       verdict = if (absorbable) "Absorbable internally"
                 else sprintf("Change order needed: %d h", shortfall))
}

# Draft a change-order note (hours only) for a residual shortfall.
change_order_text <- function(fh, study = "CP-XXX", deliverable = "<out-of-scope deliverable>") {
  paste0(
    "# Change Order (effort, hours)\n\n",
    "Study: ", study, "\n",
    "Added deliverable: ", deliverable, "\n\n",
    "Estimated effort: ", fh$need, " h\n",
    "Absorbed internally: ", fh$need - fh$shortfall, " h ",
    "(", fh$from_slack, " h under-run slack + ", fh$from_cont, " h contingency)\n",
    "Additional scope requiring a change order: ", fh$shortfall, " h\n\n",
    "Justification: the residual ", fh$shortfall,
    " h is not covered by planned effort or the management reserve and represents ",
    "scope beyond the current SOW.\n\n",
    "Approvals: Lead Biostatistician ______  Project Manager ______  Sponsor ______\n\n",
    "Hours/effort only. Pricing is handled downstream by the PM / project finance.\n")
}

Read find_hours(): it sources the ask in a fixed order. from_slack <- min(need, m$net_slack) takes what it can from under-run slack, from_cont <- min(need - from_slack, contingency) takes the rest from the reserve, and shortfall <- need - from_slack - from_cont is whatever is left. The ask is absorbable exactly when shortfall <= 0. Change that sourcing order and you have changed what “find the hours you already have” 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 — Hours Budget Reconciliation ("Find Hours") Shiny app
#
# A runnable, editable version of the find-hours worksheet. Edit the effort
# ledger, type an out-of-scope ask, and watch net-findable and the
# absorbable-vs-change-order verdict recompute live. HOURS ONLY, synthetic.
#
# Run:  shiny::runApp("budget_reconciliation/shiny")   (from the package root)
#   or: setwd("budget_reconciliation/shiny"); shiny::runApp()
#
# The math lives in R/logic.R (shared with the Quarto docs + unit tests);
# the seed data is ../templates/project_hours_ledger.csv (edit it to reuse).
# ===========================================================================
library(shiny)
library(bslib)
library(DT)
library(ggplot2)
source("R/logic.R")

`%||%` <- function(a, b) if (is.null(a) || length(a) == 0 || is.na(a)) b else a

seed <- hours_load()

ui <- page_sidebar(
  title = "Find Hours — Hours Budget Reconciliation",
  theme = bs_theme(version = 5, bootswatch = "darkly", primary = "#5b8cff"),
  sidebar = sidebar(
    width = 300,
    div(class = "text-warning small fw-bold", "HOURS / EFFORT ONLY — no $, no headcount"),
    numericInput("need", "Out-of-scope ask (hours)", value = 45, min = 0, step = 5),
    div(class = "d-flex flex-wrap gap-1 mb-2",
        actionButton("q20",  "20h",  class = "btn-sm btn-outline-secondary"),
        actionButton("q45",  "45h",  class = "btn-sm btn-outline-secondary"),
        actionButton("q90",  "90h",  class = "btn-sm btn-outline-secondary"),
        actionButton("q150", "150h", class = "btn-sm btn-outline-secondary")),
    numericInput("contingency", "Contingency reserve (hours)",
                 value = seed$contingency, min = 0, step = 5),
    hr(),
    actionButton("reset", "Reset ledger", class = "btn-sm btn-outline-warning"),
    downloadButton("dl_ledger", "Download ledger (CSV)", class = "btn-sm"),
    downloadButton("dl_co", "Download change order", class = "btn-sm"),
    hr(),
    div(class = "small text-muted",
        "Edit any blue-editable cell in the ledger (Planned, Actual, % done, EAC). ",
        "This app connects to no real budget or timesheet.")
  ),
  layout_columns(
    col_widths = c(2, 2, 3, 2, 3),
    value_box("Planned", textOutput("v_planned"), theme = "secondary"),
    value_box("Spent",   textOutput("v_actual"),  theme = "secondary"),
    value_box("Forecast (EAC)", textOutput("v_eac"), theme = "info"),
    value_box("Contingency", textOutput("v_cont"), theme = "secondary"),
    value_box("Net findable", textOutput("v_find"), theme = "success")
  ),
  layout_columns(
    col_widths = c(7, 5),
    card(card_header("Project effort ledger (hours) — editable"),
         DTOutput("ledger")),
    card(card_header("Find hours for the new ask"),
         uiOutput("verdict"))
  ),
  layout_columns(
    col_widths = c(7, 5),
    card(card_header("Planned vs forecast (EAC) by deliverable"),
         plotOutput("plot", height = "320px")),
    card(card_header("The find-hours decision tree"),
         tags$ol(class = "small",
           tags$li(tags$b("Reallocate under-run slack."),
                   " Move hours from tasks forecasting under plan (EAC < planned) — already yours."),
           tags$li(tags$b("Draw the contingency buffer."),
                   " The management reserve exists for this; a decision to record, not a silent move."),
           tags$li(tags$b("Defer / re-sequence lower-priority in-scope work,"),
                   " with the PM's agreement on new dates."),
           tags$li(tags$b("Escalate a change order"),
                   " for any residual shortfall — genuine added scope, not a silent over-run.")))
  )
)

server <- function(input, output, session) {

  withVar <- function(l) { l$variance <- l$planned - l$eac; l }
  rv <- reactiveValues(ledger = withVar(seed$ledger))

  # quick-pick buttons
  observeEvent(input$q20,  updateNumericInput(session, "need", value = 20))
  observeEvent(input$q45,  updateNumericInput(session, "need", value = 45))
  observeEvent(input$q90,  updateNumericInput(session, "need", value = 90))
  observeEvent(input$q150, updateNumericInput(session, "need", value = 150))
  observeEvent(input$reset, rv$ledger <- withVar(seed$ledger))

  metrics <- reactive(hours_metrics(rv$ledger, input$contingency %||% seed$contingency))
  fh <- reactive(find_hours(input$need %||% 0, rv$ledger, input$contingency %||% seed$contingency))

  output$v_planned <- renderText(sprintf("%d h", metrics()$planned))
  output$v_actual  <- renderText(sprintf("%d h", metrics()$actual))
  output$v_eac     <- renderText(sprintf("%d h", metrics()$eac))
  output$v_cont    <- renderText(sprintf("%d h", metrics()$contingency))
  output$v_find    <- renderText(sprintf("%d h", metrics()$findable))

  output$ledger <- renderDT({
    isolate({
      d <- rv$ledger
      names(d) <- c("Deliverable", "Planned", "Actual", "% done", "EAC", "Variance")
      datatable(d, rownames = FALSE, selection = "none",
                editable = list(target = "cell", disable = list(columns = c(0, 5))),
                options = list(dom = "t", paging = FALSE, ordering = FALSE,
                               scrollY = "300px", scrollCollapse = TRUE)) |>
        formatStyle("Variance", color = styleInterval(c(-0.5, 0.5),
                    c("#e8657a", "#94a1c0", "#43c47d")))
    })
  }, server = TRUE)

  proxy <- dataTableProxy("ledger")
  observeEvent(input$ledger_cell_edit, {
    info <- input$ledger_cell_edit
    j <- info$col + 1L                      # rownames=FALSE -> 0-based data cols
    num <- suppressWarnings(as.numeric(info$value))
    if (j %in% 2:5 && !is.na(num)) {
      rv$ledger[info$row, j] <- num
      rv$ledger$variance <- rv$ledger$planned - rv$ledger$eac
      d <- rv$ledger; names(d) <- c("Deliverable","Planned","Actual","% done","EAC","Variance")
      replaceData(proxy, d, resetPaging = FALSE, rownames = FALSE)
    }
  })

  output$verdict <- renderUI({
    f <- fh(); m <- f$metrics
    src <- tags$div(class = "mb-2",
      tags$div(class = "d-flex justify-content-between border-bottom pb-1",
               tags$b(sprintf("Need: %d h", f$need))),
      tags$div(class = "d-flex justify-content-between",
               tags$span("1 · Under-run slack"), tags$span(class = "text-success", sprintf("−%d h", f$from_slack))),
      tags$div(class = "d-flex justify-content-between",
               tags$span("2 · Contingency"), tags$span(class = "text-success", sprintf("−%d h", f$from_cont))),
      tags$div(class = "d-flex justify-content-between",
               tags$span("3 · Shortfall"),
               tags$span(class = if (f$shortfall > 0) "text-danger" else "text-success",
                         sprintf("%d h", f$shortfall))))
    if (f$absorbable) {
      box <- tags$div(class = "alert alert-success",
        tags$div(class = "h5", "Absorbable internally"),
        sprintf("Sourced %d h from under-run slack and %d h from contingency (%d h contingency left). Record the reallocation; no change order needed.",
                f$from_slack, f$from_cont, f$contingency_left))
    } else {
      box <- tags$div(class = "alert alert-danger",
        tags$div(class = "h5", sprintf("Change order needed: %d h", f$shortfall)),
        sprintf("Net headroom (%d h) covers %d h; the remaining %d h is genuine added scope. Defer lower-priority work or raise a change order — do not absorb it as a silent over-run.",
                m$findable, f$need - f$shortfall, f$shortfall))
    }
    tagList(src, box)
  })

  output$plot <- renderPlot({
    d <- rv$ledger
    dd <- rbind(
      data.frame(deliverable = d$deliverable, hours = d$planned, kind = "Planned"),
      data.frame(deliverable = d$deliverable, hours = d$eac,     kind = "Forecast (EAC)"))
    dd$deliverable <- factor(dd$deliverable, levels = rev(d$deliverable))
    ggplot(dd, aes(hours, deliverable, fill = kind)) +
      geom_col(position = "dodge", width = 0.7) +
      scale_fill_manual(values = c("Planned" = "#5b8cff", "Forecast (EAC)" = "#3fd0c9")) +
      labs(x = "Hours", y = NULL, fill = NULL) +
      theme_minimal(base_size = 12) +
      theme(legend.position = "top",
            panel.grid.major.y = element_blank(),
            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.x = element_line(colour = "#3a4157"))
  })

  output$dl_ledger <- downloadHandler(
    filename = function() "effort_ledger.csv",
    content = function(file) {
      d <- rv$ledger
      names(d) <- c("Deliverable","PlannedHours","ActualToDate","PctComplete","EAC","Variance")
      utils::write.csv(d, file, row.names = FALSE)
    })
  output$dl_co <- downloadHandler(
    filename = function() "change_order.md",
    content = function(file) writeLines(change_order_text(fh()), file))
}

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 verdict.

The editable state lives in one place. rv <- reactiveValues(ledger = withVar(seed$ledger)) holds the one frame the user can change. The helper withVar() recomputes the variance column (planned - eac) each time the ledger is rebuilt. 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. metrics <- reactive(hours_metrics(rv$ledger, input$contingency)) and fh <- reactive(find_hours(input$need, rv$ledger, input$contingency)) re-run automatically whenever the ledger or the ask input or the contingency changes. You never call the roll-up by hand.

The value boxes just read the reactive. output$v_planned, output$v_actual, output$v_eac, output$v_cont, and output$v_find each render one field of metrics(). They know nothing about how it was computed.

Editing a cell mutates the state. The ledger is a DT with per-cell editing enabled on the numeric columns. The observer on input$ledger_cell_edit coerces the new value with as.numeric(), writes it into rv$ledger for that row and column, recomputes the variance column, and pushes the frame back through a dataTableProxy with replaceData() so the user does not lose their place. That write is what makes the verdict flip, because fh() depends on rv$ledger.

The quick-pick buttons set the ask. Each of input$q20, input$q45, input$q90, and input$q150 calls updateNumericInput(session, "need", value = 90) (or 20, 45, 150), which retriggers fh(). The input$reset observer restores rv$ledger from the seed.

The verdict reads the reactive and branches. output$verdict reads fh(), shows the three-line sourcing breakdown (slack, contingency, shortfall), then renders a green “Absorbable internally” alert when f$absorbable is true, or a red “Change order needed” alert with the residual hours when it is not.

The downloads round-trip to Excel and the eTMF. output$dl_ledger writes rv$ledger to CSV with the workbook’s column names; output$dl_co writes change_order_text(fh()), the hours-only change-order draft, to a Markdown file.

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("budget_reconciliation/shiny", {
  # a 90 h ask exhausts slack and reserve, leaving a change-order residual
  session$setInputs(need = 90, contingency = 40)
  fh()$shortfall            # 31

  # a 45 h ask is fully absorbable
  session$setInputs(need = 45)
  fh()$absorbable           # TRUE
})

The unit tests: shiny is not involved

The reconciliation 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 find-hours logic. Zero dependencies (base R only).
# Run from the package root:  Rscript budget_reconciliation/tests/test-logic.R
# or from this folder:        Rscript test-logic.R

lp <- Find(file.exists, c("../shiny/R/logic.R", "budget_reconciliation/shiny/R/logic.R", "shiny/R/logic.R"))
stopifnot("found logic.R" = !is.null(lp))
source(lp)

d <- hours_load()
m <- hours_metrics(d$ledger, d$contingency)

stopifnot(
  "planned totals 850"   = m$planned == 850,
  "eac totals 831"       = m$eac == 831,
  "net slack 19"         = m$net_slack == 19,
  "contingency 40"       = m$contingency == 40,
  "net findable 59"      = m$findable == 59
)

# a 45 h ask is absorbable; a 90 h ask needs a 31 h change order
a45 <- find_hours(45, d$ledger, d$contingency)
a90 <- find_hours(90, d$ledger, d$contingency)
stopifnot(
  "45 h absorbable"          = a45$absorbable && a45$shortfall == 0,
  "90 h -> 31 h change order" = !a90$absorbable && a90$shortfall == 31,
  "sourcing order (slack first)" = a90$from_slack == 19 && a90$from_cont == 40
)

cat("find-hours logic: all tests passed\n")

Run it:

Rscript budget_reconciliation/tests/test-logic.R   # prints: find-hours logic: all tests passed

Make it yours

Change the data: edit project_hours_ledger.csv in templates/.
Change the rule: edit hours_metrics() or find_hours() in shiny/R/logic.R, for example to hold back part of the contingency as untouchable.
Add a source step: insert it into the sourcing order in find_hours(), before the shortfall line.
Add a column: add it to the CSV and to the datatable() column list in app.R.

The same skeleton, a logic core plus reactiveValues plus reactive rules plus outputs, builds the UAT tracker and the four dashboards too.