We have building shiny software

library(shiny)
library(bslib)

Attaching package: 'bslib'

The following object is masked from 'package:utils':

    page

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.2.1     ✔ readr     2.2.0
✔ forcats   1.0.1     ✔ stringr   1.6.0
✔ ggplot2   4.0.3     ✔ tibble    3.3.1
✔ lubridate 1.9.5     ✔ tidyr     1.3.2
✔ purrr     1.2.2     

── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(plotly)

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

library(DT)

Attaching package: 'DT'

The following objects are masked from 'package:shiny':

    dataTableOutput, renderDataTable

library(scales)

Attaching package: 'scales'

The following object is masked from 'package:purrr':

    discard

The following object is masked from 'package:readr':

    col_factor

# Paste the outbreak_data creation code here.
outbreak_data <- tidyr::expand_grid(
  week = 1:12,
  district = c("North", "Central", "South", "East", "West"),
  sex = c("Female", "Male"),
  age_group = c("<5", "5–14", "15–29", "30–49", "50+"),
  disease = c("Cholera", "Measles")
) |>
  mutate(
    cases = rpois(
      n(),
      lambda = case_when(
        district == "North" & disease == "Cholera" ~ week * 2.6,
        district == "Central" ~ 12,
        district == "East" ~ 9,
        TRUE ~ 6
      )
    ),
    deaths = rbinom(n(), size = cases, prob = 0.025),
    facility = sample(
      paste("Facility", LETTERS[1:8]),
      size = n(),
      replace = TRUE
    )
  )

outbreak_data

# A tibble: 1,200 × 8
    week district sex    age_group disease cases deaths facility  
   <int> <chr>    <chr>  <chr>     <chr>   <int>  <int> <chr>     
 1     1 North    Female <5        Cholera     1      0 Facility F
 2     1 North    Female <5        Measles     3      0 Facility C
 3     1 North    Female 5–14      Cholera     9      0 Facility E
 4     1 North    Female 5–14      Measles     6      0 Facility D
 5     1 North    Female 15–29     Cholera     0      0 Facility A
 6     1 North    Female 15–29     Measles     5      0 Facility B
 7     1 North    Female 30–49     Cholera     2      0 Facility G
 8     1 North    Female 30–49     Measles     8      0 Facility B
 9     1 North    Female 50+       Cholera     2      0 Facility C
10     1 North    Female 50+       Measles     6      1 Facility A
# ℹ 1,190 more rows

ui <- page_sidebar(
  title = "Weekly Disease Surveillance Dashboard",
  sidebar = sidebar(
    selectInput(
      "district",
      "District",
      choices = c("All", sort(unique(outbreak_data$district)))
    ),
    selectInput(
      "disease",
      "Disease",
      choices = c("All", sort(unique(outbreak_data$disease)))
    )
  ),
  layout_columns(
    value_box("Total cases", textOutput("total_cases")),
    value_box("Total deaths", textOutput("total_deaths")),
    value_box("CFR", textOutput("cfr")),
    value_box("New cases", textOutput("new_cases"))
  ),
  layout_columns(
    card(card_header("Weekly trend"), plotlyOutput("trend_plot")),
    card(card_header("Cases by district"), plotlyOutput("district_plot"))
  ),
  layout_columns(
    card(card_header("Cases by age group"), plotlyOutput("age_plot")),
    card(card_header("Data table"), DTOutput("data_table"))
  )
)



server <- function(input, output, session) {
  filtered_data <- reactive({
    data <- outbreak_data

    if (input$district != "All") {
      data <- data |> filter(district == input$district)
    }

    if (input$disease != "All") {
      data <- data |> filter(disease == input$disease)
    }

    data
  })

  output$total_cases <- renderText(comma(sum(filtered_data()$cases)))
  output$total_deaths <- renderText(comma(sum(filtered_data()$deaths)))
  output$cfr <- renderText({
    percent(sum(filtered_data()$deaths) / sum(filtered_data()$cases), accuracy = 0.1)
  })
  output$new_cases <- renderText({
    latest_week <- max(filtered_data()$week)
    comma(sum(filtered_data()$cases[filtered_data()$week == latest_week]))
  })
  
  
  
  output$trend_plot <- renderPlotly({
  p <- filtered_data() |>
    summarise(cases = sum(cases), .by = week) |>
    ggplot(aes(x = week, y = cases)) +
    geom_line(color = "#00507F", linewidth = 1.2) +
    geom_point(color = "#3F9C35", size = 2) +
    labs(x = "Week", y = "Cases") +
    theme_minimal(base_size = 14)

  ggplotly(p)
})

output$district_plot <- renderPlotly({
  p <- filtered_data() |>
    summarise(cases = sum(cases), .by = district) |>
    mutate(district = fct_reorder(district, cases)) |>
    ggplot(aes(x = district, y = cases)) +
    geom_col(fill = "#00507F") +
    coord_flip() +
    labs(x = NULL, y = "Cases") +
    theme_minimal(base_size = 14)

  ggplotly(p)
})


output$age_plot <- renderPlotly({
  p <- filtered_data() |>
    summarise(cases = sum(cases), .by = age_group) |>
    ggplot(aes(x = age_group, y = cases)) +
    geom_col(fill = "#3F9C35") +
    labs(x = "Age group", y = "Cases") +
    theme_minimal(base_size = 14)

  ggplotly(p)
})

output$data_table <- renderDT({
  filtered_data() |>
    arrange(desc(week), district, disease) |>
    datatable(options = list(pageLength = 10))
})

}


shinyApp(ui, server)

Shiny applications not supported in static R Markdown documents