R/epitool_app.R

In R4VN: Health Data Analysis and Publication-Ready Reporting

# =============================================================================
# R4VN EpiTool Studio - Shiny application
# File: R/epitool_app.R
# =============================================================================

.r4vn_epi_example_outbreak <- function(n=180,spatial=TRUE) {
  ice <- stats::rbinom(n,1,.58); salad <- stats::rbinom(n,1,.45); chicken <- stats::rbinom(n,1,.72)
  p <- stats::plogis(-2 + 1.65*ice + .55*salad + .1*chicken)
  ill <- stats::rbinom(n,1,p)
  party <- as.POSIXct("2026-08-09 12:00:00",tz="Asia/Ho_Chi_Minh")
  inc <- pmax(4,round(stats::rlnorm(n,log(18),.42)))
  onset <- party + inc*3600; onset[ill==0] <- as.POSIXct(NA)
  # Three spatial concentrations around synthetic HCMC-like coordinates.
  cl <- sample(1:3,n,TRUE,prob=c(.55,.3,.15))
  centers <- matrix(c(10.7626,106.6602,10.775,106.681,10.748,106.672),ncol=2,byrow=TRUE)
  lat <- centers[cl,1]+stats::rnorm(n,0,.004); lon <- centers[cl,2]+stats::rnorm(n,0,.004)
  d <- data.frame(
    case_id=sprintf("WB%03d",seq_len(n)),
    age=pmin(90,pmax(1,round(stats::rnorm(n,32,15)))),
    sex=sample(c("Female","Male"),n,TRUE),
    district=paste("District",LETTERS[cl]),
    ill=factor(ifelse(ill==1,"Yes","No"),levels=c("No","Yes")),
    onset_date=onset,
    report_date=as.Date(onset)+sample(0:2,n,TRUE),
    case_status=ifelse(ill==1,sample(c("Confirmed","Probable"),n,TRUE,prob=c(.7,.3)),"Excluded"),
    ice=factor(ifelse(ice==1,"Yes","No"),levels=c("No","Yes")),
    salad=factor(ifelse(salad==1,"Yes","No"),levels=c("No","Yes")),
    chicken=factor(ifelse(chicken==1,"Yes","No"),levels=c("No","Yes")),
    latitude=lat,longitude=lon,stringsAsFactors=FALSE
  )
  d
}

.r4vn_epi_example_surveillance <- function() {
  dates <- seq(as.Date("2022-01-03"),as.Date("2026-08-10"),by="week")
  season <- 18+12*sin(2*pi*as.integer(format(dates,"%V"))/52)
  trend <- seq(0,7,length.out=length(dates))
  cases <- stats::rpois(length(dates),pmax(1,season+trend))
  hit <- dates>=as.Date("2026-07-20")
  cases[hit] <- cases[hit]+seq(12,by=8,length.out=sum(hit))
  data.frame(date=dates,cases=cases,area="Example surveillance area",population=250000)
}

.r4vn_epi_example_sources <- function() {
  data.frame(
    source_id=c("S001","S002"),
    source_name=c("Water point A","School B"),
    source_type=c("Water","School"),
    latitude=c(10.764,10.776),
    longitude=c(106.662,106.681),
    stringsAsFactors=FALSE
  )
}

.r4vn_epi_template_copy <- function(template_id,file) {
  src <- .r4vn_epi_template_path(template_id)
  if(!nzchar(src)||!file.exists(src)) stop("Bundled template was not found.",call.=FALSE)
  file.copy(src,file,overwrite=TRUE)
}

.r4vn_epi_table_ui <- function(id) {
  if(requireNamespace("DT",quietly=TRUE)) DT::DTOutput(id) else shiny::tableOutput(id)
}

.r4vn_epi_set_table <- function(output,id,expr) {
  if(requireNamespace("DT",quietly=TRUE)) {
    output[[id]] <- DT::renderDT({
      x <- expr()
      DT::datatable(x,rownames=FALSE,filter="top",
                    options=list(pageLength=10,scrollX=TRUE,autoWidth=TRUE))
    })
  } else {
    output[[id]] <- shiny::renderTable(expr(),striped=TRUE,bordered=TRUE,spacing="s")
  }
}

.r4vn_epi_download_template <- function(output,id,template_id) {
  output[[id]] <- shiny::downloadHandler(
    filename=function() .r4vn_epi_template_info(template_id)$file,
    content=function(file) .r4vn_epi_template_copy(template_id,file)
  )
}

.r4vn_epi_epitool_css <- function() {
  shiny::tags$style(shiny::HTML("
  :root{--epi:#0B5D6B;--epi2:#087F8C;--soft:#F3F8F9;--ink:#18333A;--muted:#667B80;}
  body{background:#F7FAFB;color:var(--ink);font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Arial,sans-serif;}
  .epi-shell{max-width:1600px;margin:0 auto;}
  .epi-top{background:linear-gradient(115deg,#083F49,#0B6977);color:white;padding:18px 24px;border-radius:0 0 18px 18px;
           box-shadow:0 5px 22px rgba(10,70,80,.16);margin-bottom:18px;}
  .epi-brand{font-size:24px;font-weight:750;letter-spacing:.2px}.epi-sub{opacity:.88;margin-top:3px;}
  .epi-card{background:white;border:1px solid #E2ECEE;border-radius:14px;padding:18px;margin-bottom:16px;box-shadow:0 2px 10px rgba(20,60,70,.04);}
  .epi-card h3,.epi-card h4{margin-top:0}.epi-muted{color:var(--muted);}
  .epi-kpis{display:grid;grid-template-columns:repeat(auto-fit,minmax(150px,1fr));gap:12px;margin:12px 0 18px;}
  .epi-kpi{background:#F7FBFC;border:1px solid #DFECEE;border-radius:12px;padding:14px;}
  .epi-kpi .v{font-size:24px;font-weight:750;color:var(--epi)}.epi-kpi .l{font-size:12px;color:var(--muted);text-transform:uppercase;letter-spacing:.45px;}
  .epi-nav .radio{margin:0 0 4px}.epi-nav label{font-weight:600}.epi-nav .control-label{display:none;}
  .epi-upload-card{border:1px dashed #9BC2C8;background:#FAFDFD;border-radius:12px;padding:16px;margin:12px 0;}
  .epi-inline-actions{display:flex;gap:8px;flex-wrap:wrap;margin:8px 0 10px;}
  .epi-note{padding:11px 13px;border-left:4px solid #4A9BA5;background:#F0F8F9;border-radius:5px;margin:10px 0;}
  .epi-warning{padding:11px 13px;border-left:4px solid #D18B32;background:#FFF8EC;border-radius:5px;margin:10px 0;}
  .epi-danger{padding:11px 13px;border-left:4px solid #B84444;background:#FFF2F2;border-radius:5px;margin:10px 0;}
  .epi-ok{padding:11px 13px;border-left:4px solid #2D8B57;background:#F0FAF4;border-radius:5px;margin:10px 0;}
  .epi-table{border-collapse:collapse;width:100%}.epi-table th,.epi-table td{padding:8px;border-bottom:1px solid #E5ECEE;text-align:left}.epi-table th{background:#F1F7F8;}
  .well{background:white;border:1px solid #E2ECEE;box-shadow:none;border-radius:12px;}
  .btn-primary{background:var(--epi2);border-color:var(--epi2)}.btn-primary:hover{background:var(--epi);border-color:var(--epi);}
  @media(max-width:900px){.epi-top{border-radius:0}.epi-brand{font-size:21px}.epi-card{padding:14px}}
  "))
}

.r4vn_epitool_app <- function(data=NULL,data_name=NULL,mode="field",level="frontline") {
  if(!requireNamespace("shiny",quietly=TRUE)) stop("`epitool()` requires `shiny`.",call.=FALSE)
  if(is.null(data_name)||!nzchar(data_name)) data_name <- if(is.null(data))"No active data" else "data"

  ui <- shiny::fluidPage(
    .r4vn_epi_epitool_css(),
    shiny::div(class="epi-shell",
      shiny::div(class="epi-top",
        shiny::div(class="epi-brand","R4VN EpiTool Studio"),
        shiny::div(class="epi-sub","Field epidemiology, from data to action")
      ),
      shiny::sidebarLayout(
        shiny::sidebarPanel(width=3,
          shiny::div(class="epi-nav",
            shiny::radioButtons("page",NULL,choiceNames=c(
              "\u2302  Home","Data workspace","Outbreak & line list","Epidemic curve",
              "Exposure explorer","2 x 2 & measures","Surveillance","Spatial epidemiology",
              "Diagnostic tests","Report & history"),
              choiceValues=c("home","data","outbreak","curve","exposure","calc","surveillance","spatial","diagnostic","report"),
              selected="home")
          ),
          shiny::hr(),
          shiny::selectInput("mode","Mode",c("Field"="field","Teaching"="teaching"),selected=mode),
          shiny::selectInput("level","Level",c("Frontline"="frontline","Advanced"="advanced"),selected=level),
          shiny::tags$small(class="epi-muted","Complex options stay hidden until they are useful.")
        ),
        shiny::mainPanel(width=9,shiny::uiOutput("page_ui"))
      )
    )
  )

  server <- function(input,output,session) {
    rv <- shiny::reactiveValues(
      data=data, data_name=data_name,
      imported=NULL, import_template="outbreak", import_validation=NULL,
      history=data.frame(Time=character(),Analysis=character(),Details=character(),stringsAsFactors=FALSE),
      hypotheses=data.frame(Hypothesis=character(),Status=character(),Notes=character(),stringsAsFactors=FALSE),
      actions=data.frame(Action=character(),Status=character(),Date=character(),stringsAsFactors=FALSE),
      case_definition=list(clinical="",person="",place="",time="",laboratory=""),
      spatial_sources=NULL,boundary=NULL,population=NULL,buffer_result=NULL,
      area_result=NULL,hotspot_result=NULL
    )

    add_history <- function(analysis,details="") {
      rv$history <- rbind(rv$history,data.frame(Time=format(Sys.time(),"%Y-%m-%d %H:%M:%S"),
        Analysis=analysis,Details=details,stringsAsFactors=FALSE))
    }
    prof <- shiny::reactive(.r4vn_epi_profile(rv$data))
    vars <- shiny::reactive(if(is.null(rv$data)) character() else names(rv$data))

    # ------------------------------ page UI ------------------------------
    output$page_ui <- shiny::renderUI({
      pg <- input$page
      if(pg=="home") return(shiny::tagList(
        shiny::div(class="epi-card",
          shiny::h2("What do you want to do?"),
          shiny::p(class="epi-muted","Start from a field question, not from the name of a statistical test."),
          shiny::div(class="row",
            shiny::div(class="col-md-6",
              shiny::actionButton("go_outbreak","Investigate an outbreak",class="btn btn-primary btn-lg",width="100%"),
              shiny::br(),shiny::br(),
              shiny::actionButton("go_surv","Analyze surveillance data",class="btn btn-default btn-lg",width="100%")
            ),
            shiny::div(class="col-md-6",
              shiny::actionButton("go_spatial","Map cases / explore hotspots",class="btn btn-default btn-lg",width="100%"),
              shiny::br(),shiny::br(),
              shiny::actionButton("go_calc","Calculate an epidemiologic measure",class="btn btn-default btn-lg",width="100%")
            )
          )
        ),
        shiny::uiOutput("home_data_summary"),
        shiny::div(class="epi-card",
          shiny::h3("Try EpiTool immediately"),
          shiny::p("No file prepared yet? Load a complete synthetic outbreak and explore person, place, time, exposures and spatial analysis."),
          shiny::actionButton("load_demo","Load outbreak demo",class="btn-primary")
        )
      ))

      if(pg=="data") return(shiny::tagList(
        shiny::div(class="epi-card",
          shiny::h2("Data workspace"),
          shiny::p(class="epi-muted","Every upload follows the same path: Template \u2192 Map columns \u2192 Validate \u2192 Fix or continue \u2192 Analyze."),
          shiny::selectInput("import_template","What kind of data are you importing?",
            choices=setNames(names(.r4vn_epi_template_registry()),
                            vapply(.r4vn_epi_template_registry(),`[[`,character(1),"title"))),
          shiny::fileInput("import_file","Upload your file",accept=c(".xlsx",".xls",".csv",".rds",".dta",".sav")),
          shiny::div(class="epi-inline-actions",
            shiny::downloadButton("download_selected_template","Download template"),
            shiny::actionButton("load_template_example","Load example")
          ),
          shiny::uiOutput("import_mapping_ui"),
          shiny::actionButton("validate_import","Validate data",class="btn-primary"),
          shiny::actionButton("use_imported","Use in workspace",class="btn-success"),
          shiny::uiOutput("import_status"),
          .r4vn_epi_table_ui("import_issues")
        )
      ))

      if(pg=="outbreak") return(shiny::tagList(
        shiny::div(class="epi-card",
          shiny::h2("Outbreak & line-list workspace"),
          shiny::uiOutput("need_data_outbreak"),
          shiny::h4("Case definition"),
          shiny::textInput("cd_clinical","Clinical criteria",rv$case_definition$clinical),
          shiny::textInput("cd_person","Person",rv$case_definition$person),
          shiny::textInput("cd_place","Place",rv$case_definition$place),
          shiny::textInput("cd_time","Time",rv$case_definition$time),
          shiny::textInput("cd_lab","Laboratory",rv$case_definition$laboratory),
          shiny::actionButton("save_case_def","Save case definition",class="btn-primary"),
          shiny::hr(),
          shiny::h4("Line-list health check"),
          shiny::selectInput("health_id","Case ID",choices=c("None"="",vars())),
          shiny::selectInput("health_onset","Onset date",choices=c("None"="",vars())),
          shiny::selectInput("health_report","Report date",choices=c("None"="",vars())),
          shiny::selectInput("health_age","Age",choices=c("None"="",vars())),
          shiny::actionButton("run_health","Check line list",class="btn-primary"),
          shiny::uiOutput("health_kpi"),
          .r4vn_epi_table_ui("health_table"),
          shiny::hr(),
          shiny::h4("Hypothesis board"),
          shiny::fluidRow(
            shiny::column(5,shiny::textInput("hypothesis_text","Hypothesis","")),
            shiny::column(3,shiny::selectInput("hypothesis_status","Status",c("Open","Supported","Weakened","Rejected","Pending evidence"))),
            shiny::column(4,shiny::textInput("hypothesis_notes","Notes",""))
          ),
          shiny::actionButton("add_hypothesis","Add hypothesis"),
          .r4vn_epi_table_ui("hypothesis_table"),
          shiny::hr(),
          shiny::h4("Public-health action tracker"),
          shiny::fluidRow(
            shiny::column(5,shiny::textInput("action_text","Action","")),
            shiny::column(3,shiny::selectInput("action_status","Status",c("Proposed","Approved","Implemented","Completed","Cancelled"))),
            shiny::column(4,shiny::dateInput("action_date","Date",value=Sys.Date()))
          ),
          shiny::actionButton("add_action","Add action"),
          .r4vn_epi_table_ui("action_table")
        )
      ))

      if(pg=="curve") return(shiny::div(class="epi-card",
        shiny::h2("Epidemic curve"),
        shiny::uiOutput("need_data_curve"),
        shiny::selectInput("curve_onset","Onset date",choices=vars()),
        shiny::selectInput("curve_group","Stack / group by",choices=c("None"="",vars())),
        shiny::selectInput("curve_interval","Interval",c("Hour"="hour","Day"="day","Week"="week","Month"="month"),selected="day"),
        shiny::actionButton("run_curve","Create epidemic curve",class="btn-primary"),
        shiny::plotOutput("curve_plot",height="430px"),
        .r4vn_epi_table_ui("curve_table")
      ))

      if(pg=="exposure") return(shiny::div(class="epi-card",
        shiny::h2("Exposure explorer"),
        shiny::uiOutput("need_data_exposure"),
        shiny::selectInput("exp_outcome","Outcome",choices=vars()),
        shiny::textInput("exp_event","Outcome event","Yes"),
        shiny::selectizeInput("exp_vars","Exposure variables",choices=vars(),multiple=TRUE),
        shiny::textInput("exp_level","Exposed level","Yes"),
        shiny::actionButton("run_exposure","Analyze all exposures",class="btn-primary"),
        shiny::div(class="epi-warning","Ranking supports hypothesis exploration; it does not identify a causal source from p-values alone."),
        .r4vn_epi_table_ui("exposure_table"),
        shiny::hr(),
        shiny::h3("Stratified analysis / Mantel-Haenszel"),
        shiny::fluidRow(
          shiny::column(4,shiny::selectInput("str_outcome","Outcome",choices=vars())),
          shiny::column(4,shiny::selectInput("str_exposure","Exposure",choices=vars())),
          shiny::column(4,shiny::selectInput("str_strata","Stratify by",choices=vars()))
        ),
        shiny::fluidRow(
          shiny::column(4,shiny::textInput("str_event","Outcome event","Yes")),
          shiny::column(4,shiny::textInput("str_exposed","Exposed level","Yes")),
          shiny::column(4,shiny::actionButton("run_stratified","Run stratified analysis",class="btn-primary"))
        ),
        shiny::uiOutput("stratified_summary"),
        .r4vn_epi_table_ui("stratified_table")
      ))

      if(pg=="calc") return(shiny::tagList(
        shiny::div(class="epi-card",
          shiny::h2("Quick epidemiologic measures"),
          shiny::selectInput("measure_type","Measure",
            c("Prevalence"="prevalence","Cumulative incidence / risk"="risk","Attack rate"="attack_rate",
              "Case fatality ratio"="case_fatality","Incidence / mortality rate"="rate")),
          shiny::numericInput("measure_num","Numerator",20,min=0),
          shiny::numericInput("measure_den","Denominator / person-time",100,min=.0001),
          shiny::numericInput("measure_mult","Multiplier",100,min=1),
          shiny::actionButton("run_measure","Calculate",class="btn-primary"),
          shiny::uiOutput("measure_result")
        ),
        shiny::div(class="epi-card",
          shiny::h2("2 x 2 table"),
          shiny::HTML("<pre>                  Disease +   Disease -\nExposed +             a           b\nExposed -             c           d</pre>"),
          shiny::fluidRow(
            shiny::column(3,shiny::numericInput("a","a",20,min=0)),
            shiny::column(3,shiny::numericInput("b","b",80,min=0)),
            shiny::column(3,shiny::numericInput("c","c",10,min=0)),
            shiny::column(3,shiny::numericInput("d","d",90,min=0))
          ),
          shiny::actionButton("run_2x2","Analyze 2 x 2",class="btn-primary"),
          .r4vn_epi_table_ui("table_2x2"),
          shiny::uiOutput("teach_2x2")
        ),
        shiny::div(class="epi-card",
          shiny::h2("Sample size"),
          shiny::p(class="epi-muted","Quick FETP calculations. Advanced study-design planning should remain in design()."),
          shiny::selectInput("ss_type","Calculation",c("Estimate one proportion"="oneprop","Compare two proportions"="twoprop")),
          shiny::uiOutput("ss_inputs"),
          shiny::actionButton("run_ss","Calculate sample size",class="btn-primary"),
          shiny::uiOutput("ss_result")
        )
      ))

      if(pg=="surveillance") return(shiny::div(class="epi-card",
        shiny::h2("Surveillance control room"),
        shiny::uiOutput("need_data_surv"),
        shiny::div(class="epi-inline-actions",
          shiny::downloadButton("tpl_surveillance","Download surveillance template"),
          shiny::actionButton("demo_surveillance","Load surveillance demo")
        ),
        shiny::selectInput("surv_date","Date",choices=vars()),
        shiny::selectInput("surv_count","Case count (leave blank for one row = one case)",choices=c("One row = one case"="",vars())),
        shiny::selectInput("surv_interval","Interval",c("Epidemiologic week"="week","Month"="month")),
        shiny::numericInput("surv_years","Historical years",3,min=2,max=10),
        shiny::numericInput("surv_k","Threshold SD multiplier",2,min=.5,max=5,step=.5),
        shiny::actionButton("run_surv","Analyze surveillance",class="btn-primary"),
        shiny::uiOutput("surv_signal"),
        shiny::plotOutput("surv_plot",height="400px"),
        .r4vn_epi_table_ui("surv_table")
      ))

      if(pg=="spatial") return(shiny::tagList(
        shiny::div(class="epi-card",
          shiny::h2("Spatial Epidemiology Studio"),
          shiny::p(class="epi-muted","Case map \u2192 buffers \u2192 density/clusters \u2192 area rates \u2192 statistical hotspots."),
          shiny::uiOutput("spatial_header"),
          shiny::div(class="epi-inline-actions",
            shiny::downloadButton("tpl_spatial_cases","Download case-map template"),
            shiny::actionButton("demo_spatial","Load spatial demo")
          ),
          shiny::fluidRow(
            shiny::column(4,shiny::selectInput("sp_lat","Latitude",choices=vars())),
            shiny::column(4,shiny::selectInput("sp_lon","Longitude",choices=vars())),
            shiny::column(4,shiny::selectInput("sp_id","Case ID",choices=c("None"="",vars())))
          ),
          shiny::fluidRow(
            shiny::column(4,shiny::selectInput("sp_onset","Onset date",choices=c("None"="",vars()))),
            shiny::column(4,shiny::selectInput("sp_status","Color/group",choices=c("None"="",vars()))),
            shiny::column(4,shiny::selectInput("sp_privacy","Privacy",c("Analysis coordinates"="analysis","Presentation: jitter points"="presentation")))
          ),
          shiny::uiOutput("sp_map_ui"),
          shiny::uiOutput("spatial_validation"),
          .r4vn_epi_table_ui("spatial_summary")
        ),
        shiny::div(class="epi-card",
          shiny::h3("Buffer & suspected-source analysis"),
          shiny::p("Upload a source file or enter one source manually. EpiTool keeps distance variables available for later epidemiologic analysis."),
          shiny::fileInput("source_file","Upload suspected sources",accept=c(".xlsx",".xls",".csv")),
          shiny::div(class="epi-inline-actions",shiny::downloadButton("tpl_sources","Download source template")),
          shiny::fluidRow(
            shiny::column(4,shiny::numericInput("manual_source_lat","Manual source latitude",10.764)),
            shiny::column(4,shiny::numericInput("manual_source_lon","Manual source longitude",106.662)),
            shiny::column(4,shiny::numericInput("buffer_radius","Buffer radius (m)",500,min=10,step=50))
          ),
          shiny::actionButton("run_buffer","Analyze buffer",class="btn-primary"),
          shiny::uiOutput("buffer_summary"),
          .r4vn_epi_table_ui("buffer_table")
        ),
        shiny::div(class="epi-card",
          shiny::h3("Density & point clusters"),
          shiny::fluidRow(
            shiny::column(4,shiny::selectInput("grid_shape","Density grid",c("Hexagon"="hexagon","Square"="square"))),
            shiny::column(4,shiny::numericInput("grid_size","Grid cell size (m)",500,min=50,step=50)),
            shiny::column(4,shiny::numericInput("cluster_eps","Cluster radius (m)",500,min=50,step=50))
          ),
          shiny::numericInput("cluster_minpts","Minimum cases per cluster",5,min=2,max=100),
          shiny::actionButton("run_grid","Create density grid"),
          shiny::actionButton("run_cluster","Find point clusters"),
          shiny::uiOutput("cluster_note"),
          .r4vn_epi_table_ui("cluster_table")
        ),
        shiny::div(class="epi-card",
          shiny::h3("Area rates & statistical hotspots"),
          shiny::p("Upload administrative boundaries and population denominators. Every upload includes an example/template."),
          shiny::fileInput("boundary_file","Boundary file",accept=c(".gpkg",".geojson",".json",".kml",".zip",".shp")),
          shiny::downloadButton("boundary_example","Download boundary example"),
          shiny::fileInput("population_file","Population file",accept=c(".xlsx",".xls",".csv")),
          shiny::downloadButton("tpl_population","Download population template"),
          shiny::uiOutput("area_controls"),
          shiny::actionButton("run_area_rates","Calculate area rates",class="btn-primary"),
          shiny::uiOutput("hotspot_controls"),
          shiny::actionButton("run_hotspot","Run hotspot analysis"),
          shiny::div(class="epi-warning","Density, high rates and statistical hotspots answer different questions. A statistical signal does not by itself establish an outbreak or causal source."),
          .r4vn_epi_table_ui("area_table")
        )
      ))

      if(pg=="diagnostic") return(shiny::div(class="epi-card",
        shiny::h2("Diagnostic / screening accuracy"),
        shiny::div(class="epi-inline-actions",shiny::downloadButton("tpl_diagnostic","Download diagnostic template")),
        shiny::fluidRow(
          shiny::column(3,shiny::numericInput("tp","True positive",80,min=0)),
          shiny::column(3,shiny::numericInput("fp","False positive",10,min=0)),
          shiny::column(3,shiny::numericInput("fn","False negative",20,min=0)),
          shiny::column(3,shiny::numericInput("tn","True negative",90,min=0))
        ),
        shiny::actionButton("run_diag","Calculate",class="btn-primary"),
        .r4vn_epi_table_ui("diag_table")
      ))

      if(pg=="report") return(shiny::tagList(
        shiny::div(class="epi-card",
          shiny::h2("Report & reproducibility"),
          shiny::p("Analysis history is recorded automatically. Project metadata can be saved without embedding the raw line list."),
          shiny::downloadButton("download_brief","Download field brief (HTML)"),
          shiny::downloadButton("download_project","Save project metadata (.rds)"),
          shiny::hr(),
          shiny::h4("Restore an EpiTool project"),
          shiny::fileInput("project_file","Project metadata file",accept=".rds"),
          shiny::actionButton("restore_project","Restore metadata"),
          shiny::tags$small(class="epi-muted","Use a project .rds previously created by EpiTool; raw line-list data are not embedded by default."),
          shiny::hr(),
          .r4vn_epi_table_ui("history_table")
        )
      ))
    })

    # ------------------------------ navigation ------------------------------
    observe_go <- function(id,page) shiny::observeEvent(input[[id]],shiny::updateRadioButtons(session,"page",selected=page))
    observe_go("go_outbreak","outbreak"); observe_go("go_surv","surveillance")
    observe_go("go_spatial","spatial"); observe_go("go_calc","calc")
    shiny::observeEvent(input$load_demo,{
      rv$data <- .r4vn_epi_example_outbreak(); rv$data_name <- "Synthetic foodborne outbreak"
      add_history("Loaded example","Synthetic outbreak")
      shiny::showNotification("Synthetic outbreak loaded.",type="message")
    })

    output$home_data_summary <- shiny::renderUI({
      if(is.null(rv$data)) return(shiny::div(class="epi-card",shiny::h3("No active data"),
        shiny::p("Calculators still work. Open Data workspace to upload a file, or load the demo.")))
      p <- prof()
      shiny::div(class="epi-card",
        shiny::h3(paste0("Dataset: ",rv$data_name)),
        shiny::div(class="epi-kpis",
          shiny::div(class="epi-kpi",shiny::div(class="v",p$n),shiny::div(class="l","Records")),
          shiny::div(class="epi-kpi",shiny::div(class="v",p$p),shiny::div(class="l","Variables")),
          shiny::div(class="epi-kpi",shiny::div(class="v",.r4vn_epi_pct(1-p$missing)),shiny::div(class="l","Cell completeness")),
          shiny::div(class="epi-kpi",shiny::div(class="v",if(length(p$lat_candidates)&&length(p$lon_candidates))"Yes" else "No"),shiny::div(class="l","Coordinates detected"))
        ),
        if(length(p$lat_candidates)&&length(p$lon_candidates))
          shiny::div(class="epi-ok","Spatial coordinates detected. Spatial Epidemiology Studio is ready to configure.")
      )
    })

    # ------------------------------ import ------------------------------
    output$download_selected_template <- shiny::downloadHandler(
      filename=function() .r4vn_epi_template_info(input$import_template)$file,
      content=function(file) .r4vn_epi_template_copy(input$import_template,file)
    )

    shiny::observeEvent(input$import_file,{
      req <- shiny::req(input$import_file$datapath)
      rv$imported <- tryCatch(.r4vn_epi_read_tabular(req),error=function(e){shiny::showNotification(e$message,type="error");NULL})
      rv$import_template <- input$import_template
      rv$import_validation <- NULL
    })

    shiny::observeEvent(input$load_template_example,{
      id <- input$import_template
      rv$imported <- switch(id,
        outbreak=.r4vn_epi_example_outbreak(),
        foodborne=.r4vn_epi_example_outbreak(),
        surveillance=.r4vn_epi_example_surveillance(),
        spatial_cases=.r4vn_epi_example_outbreak(),
        spatial_sources=.r4vn_epi_example_sources(),
        area_rates=data.frame(area_id=c("A01","A02","A03"),area_name=c("District A","District B","District C"),
                              cases=c(42,18,11),population=c(125000,98000,76000)),
        diagnostic=data.frame(id=1:4,index_test=c("Positive","Negative","Positive","Negative"),
                              reference_standard=c("Positive","Negative","Negative","Positive")),
        case_control=data.frame(id=1:8,case=rep(c("Case","Control"),each=4),
                                exposure=rep(c("Exposed","Unexposed"),4)),
        .r4vn_epi_example_outbreak()
      )
      rv$import_template <- id; rv$import_validation <- NULL
    })

    output$import_mapping_ui <- shiny::renderUI({
      if(is.null(rv$imported)) return(shiny::div(class="epi-note","Upload a file or load an example."))
      map <- .r4vn_epi_guess_mapping(rv$imported,input$import_template)
      info <- .r4vn_epi_template_info(input$import_template)
      fields <- unique(c(info$required,info$recommended,names(info$aliases)))
      shiny::tagList(
        shiny::h4("Column mapper"),
        shiny::p(class="epi-muted","EpiTool guessed the fields below. Confirm or change them; exact template column names are not required."),
        lapply(fields,function(f) {
          shiny::selectInput(paste0("map_",f),paste0(f,if(f%in%info$required)" *" else ""),
            choices=c("Not mapped"="",names(rv$imported)),
            selected=if(f%in%names(map)&&!is.na(map[[f]]))map[[f]] else "")
        })
      )
    })

    shiny::observeEvent(input$validate_import,{
      shiny::req(rv$imported)
      info <- .r4vn_epi_template_info(input$import_template)
      fields <- unique(c(info$required,info$recommended,names(info$aliases)))
      mapping <- setNames(vapply(fields,function(f) input[[paste0("map_",f)]] %||% "",character(1)),fields)
      mapping[mapping==""] <- NA_character_
      rv$import_validation <- .r4vn_epi_validate_import(rv$imported,input$import_template,mapping)
      add_history("Validated import",input$import_template)
    })

    shiny::observeEvent(input$use_imported,{
      if(is.null(rv$import_validation)) {
        shiny::showNotification("Validate the file first.",type="warning"); return()
      }
      rv$data <- rv$import_validation$data
      rv$data_name <- paste("Imported",.r4vn_epi_template_info(input$import_template)$title)
      add_history("Activated imported data",input$import_template)
      shiny::showNotification("Data are now active in EpiTool.",type="message")
    })

    output$import_status <- shiny::renderUI({
      z <- rv$import_validation
      if(is.null(z)) return(NULL)
      cls <- if(z$critical>0)"epi-danger" else if(z$warning>0)"epi-warning" else "epi-ok"
      shiny::div(class=cls,shiny::strong(paste0("Data readiness: ",round(z$readiness),"%")),
        shiny::br(),paste(z$critical,"critical issue(s) and",z$warning,"warning(s)."))
    })
    .r4vn_epi_set_table(output,"import_issues",function() if(is.null(rv$import_validation))data.frame() else rv$import_validation$issues)

    # ------------------------------ data-dependent selectors ------------------------------
    shiny::observeEvent(rv$data,{
      nms <- vars(); p <- prof()
      pick <- function(cand,all=nms) if(length(cand))cand[1] else if(length(all))all[1] else ""
      shiny::updateSelectInput(session,"health_id",choices=c("None"="",nms),selected=pick(p$id_candidates,c("")))
      shiny::updateSelectInput(session,"health_onset",choices=c("None"="",nms),selected=pick(p$dates,c("")))
      report_cand <- nms[grepl("report|notify|bao.?cao|b\u00e1o.?c\u00e1o",tolower(nms))]
      age_cand <- nms[grepl("^age$|tuoi|tu\u1ed5i",tolower(nms))]
      shiny::updateSelectInput(session,"health_report",choices=c("None"="",nms),selected=pick(report_cand,c("")))
      shiny::updateSelectInput(session,"health_age",choices=c("None"="",nms),selected=pick(age_cand,c("")))
      shiny::updateSelectInput(session,"curve_onset",choices=nms,selected=pick(p$dates))
      shiny::updateSelectInput(session,"curve_group",choices=c("None"="",nms))
      shiny::updateSelectInput(session,"exp_outcome",choices=nms,selected=pick(p$case_candidates))
      shiny::updateSelectizeInput(session,"exp_vars",choices=nms,server=TRUE)
      shiny::updateSelectInput(session,"str_outcome",choices=nms,selected=pick(p$case_candidates))
      shiny::updateSelectInput(session,"str_exposure",choices=nms)
      shiny::updateSelectInput(session,"str_strata",choices=nms,selected=pick(p$categorical))
      shiny::updateSelectInput(session,"surv_date",choices=nms,selected=pick(p$dates))
      shiny::updateSelectInput(session,"surv_count",choices=c("One row = one case"="",nms))
      shiny::updateSelectInput(session,"sp_lat",choices=nms,selected=pick(p$lat_candidates))
      shiny::updateSelectInput(session,"sp_lon",choices=nms,selected=pick(p$lon_candidates))
      shiny::updateSelectInput(session,"sp_id",choices=c("None"="",nms),selected=pick(p$id_candidates,c("")))
      shiny::updateSelectInput(session,"sp_onset",choices=c("None"="",nms),selected=pick(p$dates,c("")))
      shiny::updateSelectInput(session,"sp_status",choices=c("None"="",nms),selected=pick(p$case_candidates,c("")))
    },ignoreInit=FALSE)

    # ------------------------------ common no-data UI ------------------------------
    need_data <- function(text="This analysis requires individual-level data.") {
      if(is.null(rv$data)) shiny::div(class="epi-warning",text," Open Data workspace or load an example.") else NULL
    }
    output$need_data_outbreak <- shiny::renderUI(need_data())
    output$need_data_curve <- shiny::renderUI(need_data("An epidemic curve requires a dataset containing a usable onset date."))
    output$need_data_exposure <- shiny::renderUI(need_data("Exposure Explorer requires an outcome and one or more exposure variables."))
    output$need_data_surv <- shiny::renderUI(need_data("Surveillance analysis requires dates and either counts or one row per case."))

    # ------------------------------ outbreak ------------------------------
    shiny::observeEvent(input$save_case_def,{
      rv$case_definition <- list(clinical=input$cd_clinical,person=input$cd_person,place=input$cd_place,time=input$cd_time,laboratory=input$cd_lab)
      add_history("Updated case definition","")
      shiny::showNotification("Case definition saved.",type="message")
    })
    health_res <- shiny::eventReactive(input$run_health,{
      shiny::req(rv$data)
      z <- .r4vn_epi_health(rv$data,input$health_id,input$health_onset,input$health_report,input$health_age)
      add_history("Line-list health check",paste0("Readiness ",round(z$readiness),"%")); z
    })
    output$health_kpi <- shiny::renderUI({
      z <- health_res(); cls <- if(z$critical>0)"epi-danger" else if(z$warning>0)"epi-warning" else "epi-ok"
      shiny::div(class=cls,shiny::strong(paste0("Readiness: ",round(z$readiness),"%")),
                 shiny::br(),paste(z$critical,"critical issue(s),",z$warning,"warning(s)."))
    })
    .r4vn_epi_set_table(output,"health_table",function() health_res()$table)

    shiny::observeEvent(input$add_hypothesis,{
      if(!nzchar(trimws(input$hypothesis_text %||% ""))) return()
      rv$hypotheses <- rbind(rv$hypotheses,data.frame(
        Hypothesis=trimws(input$hypothesis_text),Status=input$hypothesis_status,
        Notes=input$hypothesis_notes %||% "",stringsAsFactors=FALSE))
      add_history("Hypothesis added",trimws(input$hypothesis_text))
      shiny::updateTextInput(session,"hypothesis_text",value="")
      shiny::updateTextInput(session,"hypothesis_notes",value="")
    })
    shiny::observeEvent(input$add_action,{
      if(!nzchar(trimws(input$action_text %||% ""))) return()
      rv$actions <- rbind(rv$actions,data.frame(
        Action=trimws(input$action_text),Status=input$action_status,
        Date=as.character(input$action_date),stringsAsFactors=FALSE))
      add_history("Public-health action added",trimws(input$action_text))
      shiny::updateTextInput(session,"action_text",value="")
    })
    .r4vn_epi_set_table(output,"hypothesis_table",function() rv$hypotheses)
    .r4vn_epi_set_table(output,"action_table",function() rv$actions)

    # ------------------------------ epi curve ------------------------------
    curve_res <- shiny::eventReactive(input$run_curve,{
      shiny::req(rv$data,input$curve_onset)
      z <- .r4vn_epi_curve(rv$data,input$curve_onset,input$curve_group,input$curve_interval)
      add_history("Epidemic curve",paste(input$curve_onset,input$curve_interval)); z
    })
    output$curve_plot <- shiny::renderPlot({
      z <- curve_res(); if(!nrow(z))return()
      x <- seq_len(nrow(z))
      if(length(unique(z$Group))==1) {
        graphics::barplot(z$Cases,names.arg=z$Time,las=2,cex.names=.65,
          ylab="Cases",xlab="Time",main="Epidemic curve")
      } else {
        wide <- xtabs(Cases~Group+Time,data=z)
        graphics::barplot(wide,beside=FALSE,las=2,cex.names=.6,ylab="Cases",xlab="Time",
                          main="Epidemic curve",legend.text=TRUE,args.legend=list(x="topright",cex=.75))
      }
    })
    .r4vn_epi_set_table(output,"curve_table",function() curve_res())

    # ------------------------------ exposure ------------------------------
    exposure_res <- shiny::eventReactive(input$run_exposure,{
      shiny::req(rv$data,input$exp_outcome,input$exp_vars)
      z <- .r4vn_epi_exposure_screen(rv$data,input$exp_outcome,input$exp_vars,
        event=input$exp_event,exposed_event=input$exp_level)
      add_history("Exposure explorer",paste(length(input$exp_vars),"exposures")); z
    })
    .r4vn_epi_set_table(output,"exposure_table",function() exposure_res())

    stratified_res <- shiny::eventReactive(input$run_stratified,{
      shiny::req(rv$data,input$str_outcome,input$str_exposure,input$str_strata)
      z <- .r4vn_epi_stratified(rv$data,input$str_outcome,input$str_exposure,input$str_strata,
                                event=input$str_event,exposed_event=input$str_exposed)
      add_history("Stratified analysis",paste(input$str_exposure,"by",input$str_strata)); z
    })
    output$stratified_summary <- shiny::renderUI({
      z <- stratified_res()
      shiny::div(class="epi-kpis",
        shiny::div(class="epi-kpi",shiny::div(class="v",.r4vn_epi_num(z$crude$or)),shiny::div(class="l","Crude OR")),
        shiny::div(class="epi-kpi",shiny::div(class="v",.r4vn_epi_num(z$mh_or)),shiny::div(class="l","Mantel-Haenszel OR")),
        shiny::div(class="epi-kpi",shiny::div(class="v",paste0(.r4vn_epi_num(z$mh_ci[1]),"\u2013",.r4vn_epi_num(z$mh_ci[2]))),shiny::div(class="l","MH 95% CI")),
        shiny::div(class="epi-kpi",shiny::div(class="v",format.pval(z$mh_p,digits=3,eps=.001)),shiny::div(class="l","MH p-value"))
      )
    })
    .r4vn_epi_set_table(output,"stratified_table",function() stratified_res()$strata)

    # ------------------------------ calculators ------------------------------
    measure_res <- shiny::eventReactive(input$run_measure,{
      z <- .r4vn_epi_measure(input$measure_type,input$measure_num,input$measure_den,input$measure_mult)
      add_history("Quick measure",z$label); z
    })
    output$measure_result <- shiny::renderUI({
      z <- measure_res()
      shiny::div(class="epi-kpis",
        shiny::div(class="epi-kpi",shiny::div(class="v",.r4vn_epi_num(z$estimate,2)),shiny::div(class="l",z$label)),
        shiny::div(class="epi-kpi",shiny::div(class="v",paste0(.r4vn_epi_num(z$ci[1],2),"\u2013",.r4vn_epi_num(z$ci[2],2))),shiny::div(class="l","95% CI"))
      )
    })
    x22 <- shiny::eventReactive(input$run_2x2,{
      z <- .r4vn_epi_2x2(input$a,input$b,input$c,input$d)
      add_history("2 x 2 analysis","RR/OR/RD"); z
    })
    .r4vn_epi_set_table(output,"table_2x2",function() .r4vn_epi_2x2_table(x22()))
    output$teach_2x2 <- shiny::renderUI({
      if(input$mode!="teaching")return(NULL)
      z <- x22()
      shiny::div(class="epi-note",
        shiny::strong("Formula: "),
        shiny::HTML("RR = [a/(a+b)] / [c/(c+d)]"),
        shiny::br(),
        paste0("Substitution: [",input$a,"/(",input$a,"+",input$b,")] / [",input$c,"/(",input$c,"+",input$d,")] = ",.r4vn_epi_num(z$rr)),
        shiny::br(),
        "Interpretation: the exposed group had ",.r4vn_epi_num(z$rr)," times the risk of the outcome compared with the unexposed group."
      )
    })

    output$ss_inputs <- shiny::renderUI({
      if(input$ss_type=="oneprop") {
        shiny::fluidRow(
          shiny::column(3,shiny::numericInput("ss_p","Expected proportion",.5,min=.001,max=.999,step=.01)),
          shiny::column(3,shiny::numericInput("ss_d","Absolute precision",.05,min=.001,max=.5,step=.01)),
          shiny::column(3,shiny::numericInput("ss_conf","Confidence level",.95,min=.8,max=.999,step=.01)),
          shiny::column(3,shiny::numericInput("ss_deff","Design effect",1,min=.1,step=.1))
        )
      } else {
        shiny::fluidRow(
          shiny::column(3,shiny::numericInput("ss_p1","Proportion group 1",.40,min=.001,max=.999,step=.01)),
          shiny::column(3,shiny::numericInput("ss_p2","Proportion group 2",.25,min=.001,max=.999,step=.01)),
          shiny::column(2,shiny::numericInput("ss_power","Power",.80,min=.5,max=.99,step=.01)),
          shiny::column(2,shiny::numericInput("ss_alpha","Alpha",.05,min=.001,max=.2,step=.01)),
          shiny::column(2,shiny::numericInput("ss_ratio","Group 2:1 ratio",1,min=.1,step=.1))
        )
      }
    })
    ss_res <- shiny::eventReactive(input$run_ss,{
      if(input$ss_type=="oneprop") {
        z <- .r4vn_epi_ss_oneprop(input$ss_p,input$ss_d,input$ss_conf,input$ss_deff)
        add_history("Sample size","One proportion")
        list(type="oneprop",n=z)
      } else {
        z <- .r4vn_epi_ss_twoprop(input$ss_p1,input$ss_p2,input$ss_power,input$ss_alpha,input$ss_ratio)
        add_history("Sample size","Two proportions")
        list(type="twoprop",n=z)
      }
    })
    output$ss_result <- shiny::renderUI({
      z <- ss_res()
      if(z$type=="oneprop")
        shiny::div(class="epi-kpi",shiny::div(class="v",z$n),shiny::div(class="l","Required sample size"))
      else shiny::div(class="epi-kpis",
        shiny::div(class="epi-kpi",shiny::div(class="v",z$n[1]),shiny::div(class="l","Group 1")),
        shiny::div(class="epi-kpi",shiny::div(class="v",z$n[2]),shiny::div(class="l","Group 2")),
        shiny::div(class="epi-kpi",shiny::div(class="v",sum(z$n)),shiny::div(class="l","Total"))
      )
    })

    # ------------------------------ surveillance ------------------------------
    .r4vn_epi_download_template(output,"tpl_surveillance","surveillance")
    shiny::observeEvent(input$demo_surveillance,{
      rv$data <- .r4vn_epi_example_surveillance(); rv$data_name <- "Synthetic weekly surveillance"
      add_history("Loaded example","Surveillance")
    })
    surv_res <- shiny::eventReactive(input$run_surv,{
      shiny::req(rv$data,input$surv_date)
      z <- .r4vn_epi_surveillance(rv$data,input$surv_date,input$surv_count,input$surv_interval,input$surv_years,input$surv_k)
      add_history("Surveillance analysis",paste(input$surv_interval,"baseline",input$surv_years,"years")); z
    })
    output$surv_signal <- shiny::renderUI({
      z <- surv_res(); cur <- z[nrow(z),,drop=FALSE]
      if(isTRUE(cur$signal)) shiny::div(class="epi-warning",shiny::strong("Statistical signal detected.")," Epidemiologic review is recommended; this is not automatically an outbreak.")
      else shiny::div(class="epi-ok","No threshold exceedance in the latest analyzed period using the selected rule.")
    })
    output$surv_plot <- shiny::renderPlot({
      z <- surv_res(); xx <- seq_len(nrow(z))
      graphics::plot(xx,z$cases,type="l",lwd=2,xlab="Reporting period",ylab="Cases",main="Surveillance trend")
      good <- is.finite(z$threshold)
      if(any(good)) graphics::lines(xx[good],z$threshold[good],lty=2,lwd=2)
      graphics::legend("topleft",c("Cases","Historical threshold"),lty=c(1,2),lwd=2,bty="n")
    })
    .r4vn_epi_set_table(output,"surv_table",function() tail(surv_res(),100))

    # ------------------------------ spatial templates/import ------------------------------
    .r4vn_epi_download_template(output,"tpl_spatial_cases","spatial_cases")
    .r4vn_epi_download_template(output,"tpl_sources","spatial_sources")
    .r4vn_epi_download_template(output,"tpl_population","area_rates")
    .r4vn_epi_download_template(output,"tpl_diagnostic","diagnostic")

    output$boundary_example <- shiny::downloadHandler(
      filename=function()"boundary_example.geojson",
      content=function(file) {
        p <- system.file("extdata","epitool_templates","boundary_example.geojson",package="R4VN")
        if(!nzchar(p)) p <- file.path("inst","extdata","epitool_templates","boundary_example.geojson")
        file.copy(p,file,overwrite=TRUE)
      }
    )

    shiny::observeEvent(input$demo_spatial,{
      rv$data <- .r4vn_epi_example_outbreak(); rv$data_name <- "Synthetic spatial outbreak"
      rv$spatial_sources <- .r4vn_epi_example_sources()
      add_history("Loaded example","Spatial outbreak")
    })

    output$spatial_header <- shiny::renderUI({
      if(is.null(rv$data)) return(shiny::div(class="epi-warning","No active dataset. Upload spatial cases in Data workspace or load the demo."))
      p <- prof()
      if(length(p$lat_candidates)&&length(p$lon_candidates))
        shiny::div(class="epi-ok","Coordinate-like variables detected automatically.")
      else shiny::div(class="epi-note","Select the latitude and longitude columns below. Exact template names are not required.")
    })

    spatial_val <- shiny::reactive({
      shiny::req(rv$data,input$sp_lat,input$sp_lon)
      tryCatch(.r4vn_epi_spatial_validate(rv$data,input$sp_lat,input$sp_lon),error=function(e)NULL)
    })
    output$spatial_validation <- shiny::renderUI({
      z <- spatial_val(); if(is.null(z))return(NULL)
      cls <- if(z$invalid_range_n>0)"epi-warning" else "epi-ok"
      shiny::div(class=cls,
        paste0(z$valid_n,"/",z$n," valid coordinates (",.r4vn_epi_pct(z$completeness),"). "),
        if(z$possible_swapped_n>0) paste0(z$possible_swapped_n," possible reversed coordinate(s).") else "")
    })
    .r4vn_epi_set_table(output,"spatial_summary",function() {
      shiny::req(rv$data,input$sp_lat,input$sp_lon)
      .r4vn_epi_spatial_summary(rv$data,input$sp_lat,input$sp_lon)
    })

    output$sp_map_ui <- shiny::renderUI({
      if(requireNamespace("leaflet",quietly=TRUE)) leaflet::leafletOutput("sp_map",height="520px")
      else shiny::tagList(shiny::div(class="epi-warning","Install `leaflet` for the interactive map. A static preview is shown below."),
                          shiny::plotOutput("sp_map_static",height="450px"))
    })

    spatial_display_data <- shiny::reactive({
      shiny::req(rv$data,input$sp_lat,input$sp_lon)
      if(input$sp_privacy=="presentation")
        .r4vn_epi_spatial_privacy(rv$data,input$sp_lat,input$sp_lon,"presentation",jitter_m=150)
      else rv$data
    })

    if(requireNamespace("leaflet",quietly=TRUE)) {
      output$sp_map <- leaflet::renderLeaflet({
        d <- spatial_display_data()
        z <- .r4vn_epi_spatial_validate(d,input$sp_lat,input$sp_lon)
        d <- d[z$valid,,drop=FALSE]
        la <- as.numeric(d[[input$sp_lat]]); lo <- as.numeric(d[[input$sp_lon]])
        label <- if(nzchar(input$sp_id)&&input$sp_id%in%names(d)) as.character(d[[input$sp_id]]) else paste("Case",seq_len(nrow(d)))
        m <- leaflet::leaflet(d) |>
          leaflet::addProviderTiles("CartoDB.Positron") |>
          leaflet::addCircleMarkers(lng=lo,lat=la,radius=5,stroke=TRUE,weight=1,fillOpacity=.65,
                                    label=htmltools::htmlEscape(label),group="Cases") |>
          leaflet::addLayersControl(overlayGroups="Cases",options=leaflet::layersControlOptions(collapsed=FALSE))
        if(!is.null(rv$buffer_result)) {
          m <- m |>
            leaflet::addPolygons(data=rv$buffer_result$buffers_sf,fillOpacity=.10,weight=2,group="Buffers") |>
            leaflet::addCircleMarkers(data=rv$buffer_result$sources_sf,radius=7,fillOpacity=.9,group="Sources") |>
            leaflet::addLayersControl(overlayGroups=c("Cases","Buffers","Sources"),
                                      options=leaflet::layersControlOptions(collapsed=FALSE))
        }
        if(!is.null(rv$area_result)) {
          ar <- sf::st_transform(rv$area_result,4326)
          pal <- leaflet::colorNumeric("YlOrRd",domain=ar$rate,na.color="transparent")
          fill <- pal(ar$rate)
          lab <- paste0("Cases: ",ar$cases," | Population: ",ar$population," | Rate: ",round(ar$rate,1))
          m <- m |> leaflet::addPolygons(data=ar,fillColor=fill,fillOpacity=.45,weight=1,color="#666",
                                        label=lab,group="Area rates")
        }
        m
      })
    } else {
      output$sp_map_static <- shiny::renderPlot({
        d <- spatial_display_data(); z <- .r4vn_epi_spatial_validate(d,input$sp_lat,input$sp_lon)
        graphics::plot(as.numeric(d[[input$sp_lon]])[z$valid],as.numeric(d[[input$sp_lat]])[z$valid],
          xlab="Longitude",ylab="Latitude",main="Case locations",pch=19)
      })
    }

    shiny::observeEvent(input$source_file,{
      rv$spatial_sources <- tryCatch({
        d <- .r4vn_epi_read_tabular(input$source_file$datapath)
        v <- .r4vn_epi_validate_import(d,"spatial_sources")
        if(v$critical>0) shiny::showNotification("Source file has validation issues; review variable names/coordinates.",type="warning")
        v$data
      },error=function(e){shiny::showNotification(e$message,type="error");NULL})
    })

    buffer_res <- shiny::eventReactive(input$run_buffer,{
      shiny::req(rv$data,input$sp_lat,input$sp_lon)
      src <- rv$spatial_sources
      if(is.null(src)) src <- data.frame(source_id="Manual source",latitude=input$manual_source_lat,longitude=input$manual_source_lon)
      if(!all(c("latitude","longitude")%in%names(src))) {
        vv <- .r4vn_epi_validate_import(src,"spatial_sources")
        src <- vv$data
      }
      z <- .r4vn_epi_spatial_buffer(rv$data,src,input$buffer_radius,input$sp_lat,input$sp_lon,
                                    "latitude","longitude",if("source_id"%in%names(src))"source_id" else names(src)[1])
      rv$buffer_result <- z
      add_history("Spatial buffer",paste(input$buffer_radius,"m")); z
    })
    output$buffer_summary <- shiny::renderUI({
      z <- buffer_res(); n <- sum(z$data$within_buffer,na.rm=TRUE)
      shiny::div(class="epi-kpis",
        shiny::div(class="epi-kpi",shiny::div(class="v",n),shiny::div(class="l","Cases within buffer")),
        shiny::div(class="epi-kpi",shiny::div(class="v",paste0(input$buffer_radius," m")),shiny::div(class="l","Buffer radius")),
        shiny::div(class="epi-kpi",shiny::div(class="v",.r4vn_epi_num(stats::median(z$data$distance_source_m,na.rm=TRUE),0)),shiny::div(class="l","Median distance, m"))
      )
    })
    .r4vn_epi_set_table(output,"buffer_table",function() {
      z <- buffer_res()$data
      keep <- intersect(c(input$sp_id,"nearest_source","distance_source_m","within_buffer"),names(z))
      head(z[,keep,drop=FALSE],200)
    })

    grid_res <- shiny::eventReactive(input$run_grid,{
      shiny::req(rv$data,input$sp_lat,input$sp_lon)
      z <- .r4vn_epi_spatial_grid(rv$data,input$sp_lat,input$sp_lon,input$grid_size,input$grid_shape)
      add_history("Spatial density grid",paste(input$grid_shape,input$grid_size,"m")); z
    })
    cluster_res <- shiny::eventReactive(input$run_cluster,{
      shiny::req(rv$data,input$sp_lat,input$sp_lon)
      z <- .r4vn_epi_spatial_dbscan(rv$data,input$sp_lat,input$sp_lon,input$cluster_eps,input$cluster_minpts)
      add_history("Point clustering",paste("DBSCAN",input$cluster_eps,"m")); z
    })
    output$cluster_note <- shiny::renderUI({
      if(input$run_cluster==0) return(shiny::div(class="epi-note","Density shows where many observed cases are located. It is not the same as elevated disease risk."))
      z <- tryCatch(cluster_res(),error=function(e)NULL)
      if(is.null(z)) return(shiny::div(class="epi-warning","Install the optional package `dbscan` to run point clustering."))
      k <- length(setdiff(unique(z$cluster_id),0))
      shiny::div(class="epi-ok",paste(k,"cluster(s) identified; cluster 0 denotes noise/unclustered points."))
    })
    .r4vn_epi_set_table(output,"cluster_table",function() {
      if(input$run_cluster>0) {
        z <- cluster_res()
        as.data.frame(table(cluster=z$cluster_id),stringsAsFactors=FALSE)
      } else if(input$run_grid>0) {
        sf::st_drop_geometry(grid_res())
      } else data.frame()
    })

    shiny::observeEvent(input$boundary_file,{
      rv$boundary <- tryCatch(.r4vn_epi_read_spatial(input$boundary_file$datapath),
                              error=function(e){shiny::showNotification(e$message,type="error");NULL})
    })
    shiny::observeEvent(input$population_file,{
      rv$population <- tryCatch({
        d <- .r4vn_epi_read_tabular(input$population_file$datapath)
        .r4vn_epi_validate_import(d,"area_rates")$data
      },error=function(e){shiny::showNotification(e$message,type="error");NULL})
    })

    output$area_controls <- shiny::renderUI({
      if(is.null(rv$boundary)||is.null(rv$population)) return(shiny::div(class="epi-note","Upload both boundary and population data to calculate area-specific rates."))
      geom <- attr(rv$boundary,"sf_column") %||% "geometry"
      bfields <- setdiff(names(rv$boundary),geom)
      shiny::fluidRow(
        shiny::column(4,shiny::selectInput("boundary_area_id","Boundary area ID",bfields)),
        shiny::column(4,shiny::selectInput("population_area_id","Population area ID",
          choices=names(rv$population),selected=if("area_id"%in%names(rv$population))"area_id" else names(rv$population)[1])),
        shiny::column(4,shiny::numericInput("rate_multiplier","Rate per",100000,min=1))
      )
    })

    shiny::observeEvent(input$run_area_rates,{
      shiny::req(rv$data,rv$boundary,rv$population,input$boundary_area_id,input$population_area_id)
      rv$area_result <- tryCatch(
        .r4vn_epi_spatial_area_rates(rv$data,rv$boundary,input$boundary_area_id,
          rv$population,input$population_area_id,input$rate_multiplier,input$sp_lat,input$sp_lon),
        error=function(e){shiny::showNotification(e$message,type="error");NULL}
      )
      if(!is.null(rv$area_result)) add_history("Area rates",paste("per",input$rate_multiplier))
    })

    output$hotspot_controls <- shiny::renderUI({
      if(is.null(rv$area_result)) return(NULL)
      numeric_fields <- names(rv$area_result)[vapply(sf::st_drop_geometry(rv$area_result),is.numeric,logical(1))]
      shiny::fluidRow(
        shiny::column(4,shiny::selectInput("hotspot_method","Method",c("Local Moran's I"="moran","Getis-Ord G*"="getis"))),
        shiny::column(4,shiny::selectInput("hotspot_value","Value",numeric_fields,selected=if("rate"%in%numeric_fields)"rate" else numeric_fields[1])),
        shiny::column(4,shiny::numericInput("hotspot_alpha","Significance level",.05,min=.001,max=.2,step=.01))
      )
    })

    shiny::observeEvent(input$run_hotspot,{
      shiny::req(rv$area_result,input$hotspot_value,input$hotspot_method)
      rv$hotspot_result <- tryCatch({
        if(input$hotspot_method=="moran")
          .r4vn_epi_spatial_local_moran(rv$area_result,input$hotspot_value,input$hotspot_alpha)
        else .r4vn_epi_spatial_getis(rv$area_result,input$hotspot_value,input$hotspot_alpha)
      },error=function(e){shiny::showNotification(e$message,type="error");NULL})
      if(!is.null(rv$hotspot_result)) add_history("Statistical hotspot",input$hotspot_method)
    })

    .r4vn_epi_set_table(output,"area_table",function() {
      x <- if(!is.null(rv$hotspot_result))rv$hotspot_result else rv$area_result
      if(is.null(x)) return(data.frame())
      sf::st_drop_geometry(x)
    })

    # ------------------------------ diagnostic ------------------------------
    diag_res <- shiny::eventReactive(input$run_diag,{
      z <- .r4vn_epi_diag(input$tp,input$fp,input$fn,input$tn)
      add_history("Diagnostic accuracy","Sensitivity/specificity/PPV/NPV"); z
    })
    .r4vn_epi_set_table(output,"diag_table",function() .r4vn_epi_diag_table(diag_res()))

    # ------------------------------ report/history ------------------------------
    .r4vn_epi_set_table(output,"history_table",function() rv$history)

    shiny::observeEvent(input$restore_project,{
      shiny::req(input$project_file$datapath)
      obj <- tryCatch(readRDS(input$project_file$datapath),error=function(e){
        shiny::showNotification(paste("Could not read project:",e$message),type="error"); NULL
      })
      if(is.null(obj)) return()
      if(!is.null(obj$case_definition)) rv$case_definition <- obj$case_definition
      if(!is.null(obj$hypotheses)) rv$hypotheses <- obj$hypotheses
      if(!is.null(obj$actions)) rv$actions <- obj$actions
      if(!is.null(obj$history)) rv$history <- obj$history
      if(!is.null(obj$data_name)) rv$data_name <- obj$data_name
      add_history("Restored project metadata",basename(input$project_file$name))
      shiny::showNotification("Project metadata restored. Reattach the raw data if required.",type="message")
    })

    output$download_project <- shiny::downloadHandler(
      filename=function()paste0("epitool_project_",format(Sys.Date(),"%Y%m%d"),".rds"),
      content=function(file) {
        obj <- list(
          version="2.0",
          saved_at=Sys.time(),
          data_name=rv$data_name,
          data_fingerprint=if(is.null(rv$data))NULL else list(n=nrow(rv$data),p=ncol(rv$data),names=names(rv$data)),
          case_definition=rv$case_definition,
          hypotheses=rv$hypotheses,
          actions=rv$actions,
          history=rv$history,
          spatial=list(has_sources=!is.null(rv$spatial_sources),has_boundary=!is.null(rv$boundary),
                       has_population=!is.null(rv$population),last_buffer_radius=if(is.null(rv$buffer_result))NULL else rv$buffer_result$radius_m),
          raw_data_embedded=FALSE
        )
        saveRDS(obj,file)
      }
    )

    output$download_brief <- shiny::downloadHandler(
      filename=function()paste0("epitool_field_brief_",format(Sys.Date(),"%Y%m%d"),".html"),
      content=function(file) {
        dline <- if(is.null(rv$data))"No active dataset" else paste(rv$data_name,"\u00b7",nrow(rv$data),"records \u00b7",ncol(rv$data),"variables")
        cdef <- paste0("<ul><li><b>Clinical:</b> ",htmltools::htmlEscape(rv$case_definition$clinical),
          "</li><li><b>Person:</b> ",htmltools::htmlEscape(rv$case_definition$person),
          "</li><li><b>Place:</b> ",htmltools::htmlEscape(rv$case_definition$place),
          "</li><li><b>Time:</b> ",htmltools::htmlEscape(rv$case_definition$time),
          "</li><li><b>Laboratory:</b> ",htmltools::htmlEscape(rv$case_definition$laboratory),"</li></ul>")
        html <- paste0("<!doctype html><html><head><meta charset='utf-8'><title>R4VN EpiTool Field Brief</title>",
          "<style>body{font-family:Arial,sans-serif;max-width:1000px;margin:32px auto;color:#18333A}",
          "h1{color:#0B5D6B}.epi-table{border-collapse:collapse;width:100%}.epi-table th,.epi-table td{padding:8px;border-bottom:1px solid #ddd;text-align:left}",
          ".epi-table th{background:#F1F7F8}</style></head><body>",
          "<h1>R4VN EpiTool Field Brief</h1><p><b>Generated:</b> ",format(Sys.time(),"%Y-%m-%d %H:%M:%S"),"</p>",
          "<p><b>Data:</b> ",htmltools::htmlEscape(dline),"</p><h2>Case definition</h2>",cdef,
          "<h2>Analysis history</h2>",.r4vn_epi_html_table(rv$history,3),
          "<p><i>Statistical and spatial results should be interpreted together with field, laboratory, environmental and contextual evidence.</i></p>",
          "</body></html>")
        writeLines(html,file,useBytes=TRUE)
      }
    )
  }

  shiny::shinyApp(ui=ui,server=server)
}

#' R4VN EpiTool Studio
#'
#' Opens an interactive field epidemiology workspace for FETP-style work.
#' EpiTool combines epidemiologic calculators, outbreak workflows, surveillance,
#' universal file templates and validation, and optional spatial epidemiology.
#'
#' @param data Optional data frame. If `NULL`, EpiTool attempts to use the
#'   active R4VN data set selected with `usedf()`.
#' @param mode Initial interface mode: `"field"` or `"teaching"`.
#' @param level Initial complexity level: `"frontline"` or `"advanced"`.
#' @param launch.browser Passed to `shiny::runApp()`.
#' @param host Host passed to `shiny::runApp()`.
#' @param port Optional Shiny port.
#'
#' @details
#' ## File-first usability
#' Every EpiTool workflow that needs external tabular data is paired with a
#' downloadable Excel template containing DATA, DICTIONARY and INSTRUCTIONS
#' sheets. Exact column names are not mandatory because EpiTool includes a
#' column mapper and validation layer.
#'
#' ## Spatial epidemiology
#' Spatial functions are optional. When `sf` and `leaflet` are installed,
#' EpiTool supports case maps, source buffers, nearest-source distance,
#' density grids, DBSCAN point clusters, point-to-area spatial joins,
#' population-based area rates, Local Moran's I and Getis-Ord G* analysis.
#'
#' Density, rate and hotspot outputs are deliberately separated because they
#' answer different epidemiologic questions. A density concentration or
#' statistical hotspot should not be interpreted automatically as a causal
#' source or confirmed outbreak.
#'
#' ## Privacy
#' Presentation mode can jitter displayed case coordinates. Analysis should
#' continue to use the original coordinates.
#'
#' @return Invisibly returns the Shiny app after it exits.
#' @examples
#' if (interactive()) {
#' epitool()
#'
#' outbreak <- data.frame(
#'   case_id = 1:20,
#'   onset_date = as.Date("2026-08-01") + sample(0:7,20,TRUE),
#'   latitude = 10.76 + rnorm(20,0,.005),
#'   longitude = 106.66 + rnorm(20,0,.005)
#' )
#' usedf(outbreak, quiet = TRUE)
#' epitool(mode = "teaching")
#' }
#' @export
epitool <- function(data=NULL,
                    mode=c("field","teaching"),
                    level=c("frontline","advanced"),
                    launch.browser=interactive(),
                    host="127.0.0.1",
                    port=NULL) {
  mode <- match.arg(mode); level <- match.arg(level)
  if(!requireNamespace("shiny",quietly=TRUE))
    stop("`epitool()` requires the optional package `shiny`. Install it with install.packages('shiny').",call.=FALSE)

  data_name <- NULL
  if(is.null(data)) {
    if(exists(".r4vn_get_active",mode="function",inherits=TRUE)) {
      data <- tryCatch(.r4vn_get_active(required=FALSE),error=function(e)NULL)
      if(exists(".r4vn_active_name",mode="function",inherits=TRUE))
        data_name <- tryCatch(.r4vn_active_name(),error=function(e)NULL)
    } else if(exists(".r4vn_resolve_analysis_data",mode="function",inherits=TRUE)) {
      data <- tryCatch(.r4vn_resolve_analysis_data(NULL),error=function(e)NULL)
    }
  } else {
    if(!is.data.frame(data)) stop("`data` must be a data frame.",call.=FALSE)
    data_name <- paste(deparse(substitute(data),width.cutoff=120L),collapse="")
  }
  app <- .r4vn_epitool_app(data=data,data_name=data_name,mode=mode,level=level)
  shiny::runApp(app,launch.browser=launch.browser,host=host,port=port)
  invisible(app)
}