appKPI: Logic and Workflow

Technical documentation of the Shiny application

Published

February 22, 2026

Overview

appKPI is a Shiny application for monitoring and visualising weekly Key Performance Indicators (KPIs) for a network of analytical laboratories. Data is loaded automatically at startup from a fixed Excel file (datos.xlsx) located in the same directory as app.R. The user does not upload any file — the app is ready to use as soon as it launches.

The application allows the user to:

  • Filter by date range (start and end week),
  • Drill down by laboratory group (grupo) and department / laboratory (depto),
  • Explore four KPIs through time-series line charts (interactive, Plotly) and summary bar charts (static, ggplot2),
  • Consult four value boxes that display aggregate KPIs for the selected period.

Packages used

Show code
library(stringr)          # String manipulation (regex extraction, detection, removal)
library(dplyr)            # Data wrangling (filter, mutate, group_by, summarise, between)
library(shiny)            # Core Shiny framework
library(bslib)            # Modern layout (page_navbar, sidebar, card, value_box, layout_columns)
library(readr)            # Fast file reading (loaded; readxl is used instead for the Excel file)
library(plotly)           # Interactive charts (ggplotly)
library(shinyWidgets)     # Enhanced widgets (pickerInput, pickerOptions)
library(shinycssloaders)  # Loading spinner while plots render (withSpinner)
library(ggtext)           # Rich-text plot titles via element_markdown
library(lubridate)        # Date parsing and arithmetic (dmy, ymd, between)
library(readxl)           # Reading .xlsx workbooks (read_excel)

Data file structure

The data file datos.xlsx must be present in the working directory when the app starts. It is read once at startup (outside the server function), so the data does not change during the session.

Raw columns (as read from the file)

Column Type Description
Rango Fechas Character Week label in the format "DD/MM/YYYY - DD/MM/YYYY"
Laboratorio Character Laboratory identifier
CantidadMetodos Numeric Number of methods processed that week
Desvios de Tiempo de respuesta % Numeric Percentage of results delivered outside the target window
Tiempo de respuesta promedio (días) Numeric Mean turnaround time in days
Productividad Numeric Productivity index (target ≥ 80)

Transformations applied at load time

Show code
datei <- read_excel("datos.xlsx") %>%
  # Rename columns to cleaner display names
  rename(
    "Cantidad de métodos"             = CantidadMetodos,
    "Desvíos de tiempo de respuesta"  = `Desvios de Tiempo de respuesta %`,
    "Tiempo de respuesta promedio"    = `Tiempo de respuesta promedio (días)`
  ) %>%
  # Extract the start date from the "Rango Fechas" string and parse it
  mutate(Fecha = dmy(str_extract(`Rango Fechas`, ".........."))) %>%
  # Extract the group prefix from the lab name (e.g. "GC" from "GC-AMB")
  mutate(
    grupo = str_remove(str_extract(Laboratorio, "\\w+-"), "-"),
    grupo = ifelse(is.na(grupo), "MI", grupo)
  )

After loading, datei is a plain (non-reactive) data frame available globally within the app session. The Fecha column enables proper date-based filtering with dplyr::between().

KPI thresholds

Indicator Target
Productivity ≥ 80
Response-time deviations (%) ≤ 8
Average response time (days) ≤ 8

Charts use green for values that meet the target and red for those that do not.


User Interface (UI)

The UI is built with bslib::page_navbar(), which combines a top navigation bar with a collapsible sidebar. There is currently one main tab.

General layout

page_navbar  (position = "fixed-top", fillable = FALSE)
│
├── nav_panel("Indicadores por laboratorio")
│       │
│       ├── conditionalPanel (output.metodos_tot)
│       │       └── layout_columns (4 equal columns)
│       │               ├── value_box: "Métodos ingresados"      → metodos_tot
│       │               ├── value_box: "Productividad"           → productividad_total
│       │               ├── value_box: "Desvíos de tiempo (%)"  → desv_tot
│       │               └── value_box: "Tiempo de respuesta"     → tiempo_tot
│       │
│       ├── card
│       │   └── tabsetPanel
│       │         ├── "Cantidad de métodos"              → cantidad_met   (plotly)
│       │         ├── "Desvíos de tiempo de respuesta"   → desvios        (plotly)
│       │         ├── "Tiempo de respuesta promedio"     → tiempo          (plotly)
│       │         └── "Productividad"                    → productividad   (plotly)
│       │
│       ├── card
│       │   └── tabsetPanel
│       │         ├── "Cantidad de métodos"              → metodos_bar          (static)
│       │         ├── "Desvíos de tiempo de respuesta"   → desv_bar             (static)
│       │         ├── "Tiempo de respuesta promedio"     → tiempo_bar            (static)
│       │         ├── "Proporción de cantidad de métodos"→ treemap               (static)
│       │         ├── "Métodos por semana (mediana)"     → cant_metodos_semana   (static)
│       │         └── "Productividad"                    → productividad_bar     (static)
│       │
│       └── footer (includeHTML("www/footer.html"))
│
├── sidebar
│       ├── conditionalPanel (nav == "Indicadores")
│       │       ├── uiOutput("selec_grupo")   ← Group picker (dynamic)
│       │       └── uiOutput("selec_depto")   ← Department picker (dynamic)
│       │
│       ├── conditionalPanel (nav == "Indicadores")
│       │       └── selectizeInput("fechas1") ← Start week
│       │
│       └── conditionalPanel (nav == "Indicadores")
│               └── selectizeInput("fechas2") ← End week (filtered by fechas1)
│
├── nav_spacer
└── nav_item: img (logo)

Value box visibility

The four value boxes are wrapped in a conditionalPanel keyed on output.metodos_tot. This means they only appear once subsetted() has produced data. To make this work the corresponding outputs must be marked as suspendWhenHidden = FALSE (see server section).

Dynamic widgets

Two sidebar pickers are rendered dynamically because they depend on the loaded data and on each other:

Output Widget produced Depends on
selec_grupo pickerInput (multi-select, with “Select all”) datei$grupo — unique group prefixes in the data
selec_depto pickerInput (multi-select, with “Select all”) depto() — labs matching the currently selected groups

Server logic

Reactive flow diagram

datei  (global, loaded at startup)
    │
    ├──► observe ──► updateSelectizeInput("fechas1")   ← all dates, oldest pre-selected
    │
    ├──► output$selec_grupo (renderUI)                 ← unique groups
    │
    └──► depto()  ──► output$selec_depto (renderUI)   ← labs matching selected groups
             │
             (depends on input$grupo)

input$fechas1
    │
    └──► fechas2()  ──► observe ──► updateSelectizeInput("fechas2")
                                      (choices ≥ fechas1, latest pre-selected)

input$fechas1 + input$fechas2 + input$depto + input$grupo
    │
    └──► subsetted()
             │
             ├── met_totales()
             ├── cant_methods()
             │       ├──► output$treemap
             │       └──► output$cant_metodos_semana
             │
             ├──► output$metodos_tot         (value box)
             ├──► output$productividad_total (value box)
             ├──► output$desv_tot            (value box)
             ├──► output$tiempo_tot          (value box)
             │
             ├──► output$cantidad_met        (plotly, time-series)
             ├──► output$desvios             (plotly, time-series)
             ├──► output$tiempo              (plotly, time-series)
             ├──► output$productividad       (plotly, time-series)
             │
             ├──► output$metodos_bar         (static bar)
             ├──► output$desv_bar            (static bar)
             ├──► output$tiempo_bar          (static bar)
             └──► output$productividad_bar   (static bar)

Date range selectors

The start-week selector is populated from the full set of unique dates in datei, with the oldest date pre-selected:

Show code
fechas1 <- datei$Fecha   # plain vector, computed once

observe({
  updateSelectizeInput(session, "fechas1",
                       choices  = sort(fechas1),
                       selected = head(fechas1, 1),
                       server   = TRUE)
})

The end-week selector is filtered dynamically to only show dates on or after the selected start week. Its choices update whenever input$fechas1 changes, with the latest available date pre-selected:

Show code
fechas2 <- reactive({
  req(input$fechas1)
  fechas1[which(fechas1 >= input$fechas1)]
})

observe({
  updateSelectizeInput(session, "fechas2",
                       choices  = sort(fechas2()),
                       selected = tail(fechas2(), 1),
                       server   = TRUE)
})

This ensures the user can never select an end date that precedes the start date.

Dynamic lab filters: depto()

The department picker depends on which groups are selected. str_match() extracts the leading word of each lab name and checks it against input$grupo:

Show code
depto <- reactive({
  req(input$grupo)
  unique(datei$Laboratorio[
    which(str_match(datei$Laboratorio, "\\w+") %in% input$grupo)
  ])
})

When the group selection changes, depto() recomputes and selec_depto re-renders with the matching labs, all pre-selected.


Derived reactive datasets

subsetted() – filtered and pre-aggregated data

This is the central reactive. It filters datei by the selected date range and lab selection, then adds pre-computed summary columns at two levels of granularity:

Show code
subsetted <- reactive({
  req(input$fechas1, input$fechas2, input$depto)

  datei %>%
    filter(
      between(Fecha, ymd(input$fechas1), ymd(input$fechas2)) &
      Laboratorio %in% input$depto &
      grupo %in% input$grupo
    ) %>%
    # Per-laboratory summaries (used by bar charts and value boxes)
    group_by(Laboratorio) %>%
    mutate(
      "Productividad promedio"                    = round(mean(Productividad, na.rm = TRUE), 2),
      "Cantidad de métodos totales"               = sum(`Cantidad de métodos`),
      "Desvíos de tiempo de respuesta promedio"   = round(mean(`Desvíos de tiempo de respuesta`, na.rm = TRUE), 2),
      "Tiempo de respuesta promedio promedio"      = round(mean(`Tiempo de respuesta promedio`, na.rm = TRUE), 2)
    ) %>%
    ungroup() %>%
    # Per-group summaries (available for potential group-level charts)
    group_by(grupo) %>%
    mutate(
      "Productividad promedio grupo"                  = mean(Productividad, na.rm = TRUE),
      "Cantidad de métodos totales grupo"             = sum(`Cantidad de métodos`),
      "Desvíos de tiempo de respuesta promedio grupo" = mean(`Desvíos de tiempo de respuesta`, na.rm = TRUE),
      "Tiempo de respuesta promedio promedio grupo"   = mean(`Tiempo de respuesta promedio`, na.rm = TRUE)
    )
})

Design note: mutate() (not summarise()) is used deliberately, so that the row-level data needed for time-series charts is preserved alongside the aggregate columns needed for bar charts — all in the same data frame.

met_totales() – total method count

Show code
met_totales <- reactive(
  sum(subsetted()$`Cantidad de métodos`)
)

A single scalar used as the denominator when computing each lab’s share of total methods.

cant_methods() – cumulative method counts per laboratory

Drives both the treemap and the median methods per week bar chart.

Show code
cant_methods <- reactive({
  subsetted() %>%
    group_by(Laboratorio) %>%
    summarise(
      met_acum   = sum(`Cantidad de métodos`),
      met_semana = median(`Cantidad de métodos`),   # median weekly count
      prop       = met_acum / met_totales() * 100
    ) %>%
    # Extract group prefix for treemap hierarchy
    mutate(
      grupo  = str_remove(str_extract(Laboratorio, "\\w+-"), "-"),
      grupo  = ifelse(is.na(grupo), "MI", grupo),
      grupo1 = paste(Laboratorio, round(prop, 1), sep = "\n")
    ) %>%
    group_by(grupo) %>%
    mutate(
      prop2  = sum(prop),
      grupo2 = ifelse(str_detect(grupo, "MI"),
                      grupo1,
                      paste(grupo, round(prop2, 1), sep = "\n"))
    )
})

Visualizations

Value boxes (summary KPIs)

Four value_box outputs display aggregate metrics for the selected period. They use renderUI() to output plain numeric values:

Show code
output$metodos_tot         <- renderUI(sum(subsetted()$`Cantidad de métodos`, na.rm = TRUE))
output$productividad_total <- renderUI(round(mean(subsetted()$Productividad, na.rm = TRUE), 2))
output$desv_tot            <- renderUI(round(mean(subsetted()$`Desvíos de tiempo de respuesta`, na.rm = TRUE), 2))
output$tiempo_tot          <- renderUI(round(mean(subsetted()$`Tiempo de respuesta promedio`, na.rm = TRUE), 2))

Because these outputs are inside a conditionalPanel and would normally be suspended when hidden, they are explicitly kept alive:

Show code
outputOptions(output, "metodos_tot",         suspendWhenHidden = FALSE)
outputOptions(output, "productividad_total",  suspendWhenHidden = FALSE)
outputOptions(output, "desv_tot",            suspendWhenHidden = FALSE)
outputOptions(output, "tiempo_tot",          suspendWhenHidden = FALSE)

Time-series charts (Plotly)

All four interactive charts share the same structure: Fecha (real date) on the x-axis, one KPI on the y-axis, coloured by Laboratorio, with geom_point() + geom_line(). dynamicTicks = TRUE lets Plotly rescale the axes when zooming.

Show code
output$productividad <- renderPlotly({
  b <- subsetted() %>%
    ggplot(aes(Fecha, Productividad, color = Laboratorio)) +
    geom_point() + geom_line() +
    theme_minimal() + xlab("Semanas") +
    ggtitle(paste("Productividad", fechas_inicio(), "a", fechas_fin()))
  ggplotly(b, tooltip = c("Productividad", "Laboratorio", "Fecha"),
           dynamicTicks = TRUE)
})

Using real Date values on the x-axis (rather than an ordered factor) allows Plotly’s zoom and pan to work correctly with calendar-aware tick formatting.

Bar charts (static, ggplot2)

The four static bar charts display period averages per laboratory (pre-computed in subsetted()), sorted in descending order. Each applies the green / red compliance colouring:

Output Y variable Threshold
metodos_bar Cantidad de métodos totales none (fixed fill #73B77B)
desv_bar Desvíos de tiempo de respuesta promedio > 8 → red
tiempo_bar Tiempo de respuesta promedio promedio > 8 → red
productividad_bar Productividad promedio < 80 → red

Example (response-time deviations):

Show code
output$desv_bar <- renderPlot({
  subsetted() %>%
    mutate(cumple = ifelse(`Desvíos de tiempo de respuesta promedio` > 8,
                           "No cumple", "Cumple")) %>%
    ggplot(aes(reorder(Laboratorio, -`Desvíos de tiempo de respuesta promedio`),
               `Desvíos de tiempo de respuesta promedio`,
               fill = cumple)) +
    theme_minimal() +
    geom_col(position = "dodge", color = "black") +
    scale_fill_manual(values = c("Cumple" = "green", "No cumple" = "red")) +
    geom_text(aes(label = round(`Desvíos de tiempo de respuesta promedio`, 0)),
              color = "black", nudge_y = 2) +
    theme(axis.text.x = element_text(size = 12), legend.position = "none",
          axis.title.x = element_blank(),
          plot.title = element_markdown(lineheight = 1, size = 18)) +
    ggtitle(paste0("Desvíos en los tiempos de respuesta por laboratorio desde la semana ",
                   fechas_inicio(), " a la semana ", fechas_fin()))
})

Treemap – method share

Uses treemap::treemap() with a two-level index (grupo2grupo1) to nest individual labs inside their group prefix. Tile size is proportional to each lab’s share of total methods over the selected period.

Median methods per week bar chart (cant_metodos_semana)

Plots met_semana (median weekly count per lab, from cant_methods()) as a descending bar chart with theme_minimal().


Complete workflow summary

App launches
    │
    ▼
datei loaded from datos.xlsx (once, at startup)
    │
    ├── date vector extracted ──► fechas1 selector populated (oldest pre-selected)
    ├── group prefixes extracted ──► selec_grupo picker populated (all selected)
    │
User selects a start date (fechas1)
    │
    ▼
fechas2() recomputes ──► fechas2 selector updated (dates ≥ fechas1, latest pre-selected)

User selects groups (input$grupo)
    │
    ▼
depto() recomputes ──► selec_depto picker updated (matching labs, all selected)

User selects end date and/or labs
    │
    ▼
subsetted() recomputes
    │
    ├── met_totales()  ← scalar total for the period
    ├── cant_methods() ← per-lab cumulative + median counts
    │       ├──► treemap
    │       └──► cant_metodos_semana
    │
    ├── value boxes update (metodos_tot, productividad_total, desv_tot, tiempo_tot)
    │
    ├── time-series plots update (cantidad_met, desvios, tiempo, productividad)
    │
    └── bar charts update (metodos_bar, desv_bar, tiempo_bar, productividad_bar)

Design observations

Strengths

  • Startup loading. Reading datei once outside server avoids repeated file I/O and makes the data immediately available to all reactive expressions without an upload step.
  • Cascading date selectors. Dynamically filtering the end-week choices to be ≥ the start week makes it impossible to create an invalid date range.
  • Single subsetted() reactive with dual granularity. Using mutate() instead of summarise() preserves individual rows for time-series charts while adding period-average columns for bar charts, so the data only needs to be filtered once.
  • suspendWhenHidden = FALSE. Correctly handles the conditionalPanel wrapping the value boxes, ensuring their outputs are computed even before the panel becomes visible (which is what drives the panel’s own visibility condition).
  • Consistent lab hierarchy. The grupo column is derived at load time and reused throughout — in the pickers, in subsetted(), and in cant_methods() — maintaining a single source of truth for the grouping logic.

Opportunities for refactoring (for future reference)

  • The four time-series renderPlotly() blocks and the four static renderPlot() bar chart blocks are structurally identical and differ only by the column name being plotted. A helper function parametrised by column name and threshold would reduce significant code duplication.
  • The grupo label for single-word labs is hard-coded as "MI" (via ifelse(is.na(grupo), "MI", grupo)). Parameterising this default would make the app easier to adapt to different lab naming conventions.