project

R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

library(tidyverse)

## Warning: package 'ggplot2' was built under R version 4.5.3

## Warning: package 'readr' was built under R version 4.5.3

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.2     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.1     
## ── 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(shiny)

## Warning: package 'shiny' was built under R version 4.5.3

library(leaflet)
library(dplyr)
library(ggplot2)
library(scales)

## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor

library(tidyr)
library(stringr)
library(plotly)

## Warning: package 'plotly' was built under R version 4.5.3

## 
## 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

branch_info <- read_csv("tpl-branch-general-information - 4326.csv")

## Rows: 112 Columns: 28
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (12): BranchCode, BranchName, Address, PostalCode, Website, Telephone, P...
## dbl (16): _id, PhysicalBranch, SquareFootage, KidsStop, LeadingReading, CLC,...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

visits <- read_csv("tpl-visits-annual-by-branch.csv")

## Rows: 1233 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): BranchCode
## dbl (3): _id, Year, Visits
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

events <- read_csv("tpl-events-feed.csv")

## Rows: 8512 Columns: 17
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (9): EventID, Title, LocationName, Audiences, Languages, EventTypes, St...
## dbl  (1): _id
## lgl  (3): IsRecurring, IsFull, RegistrationClosed
## dttm (3): StartTime, EndTime, LastUpdatedOn
## date (1): StartDateLocal
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

population <- read_csv("population.csv")

## New names:
## • `` -> `...3`
## • `` -> `...4`

## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
##   dat <- vroom(...)
##   problems(dat)

## Rows: 1658 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): area_code
## num (1): Population, 2021
## lgl (2): ...3, ...4
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

events <- events %>%
  filter(year(as.Date(StartDateLocal)) == 2026)

branch_lookup <- branch_info %>%
  transmute(
    BranchCode = as.character(BranchCode),
    BranchName = trimws(as.character(BranchName)),
    Address = as.character(Address),
    WardName = as.character(WardName),
    NBHDName = as.character(NBHDName),
    ServiceTier = as.character(`Service Tier`),
    Lat = as.numeric(Lat),
    Long = as.numeric(Long),
    PostalCode = str_to_upper(str_trim(as.character(PostalCode))),
    area_code = str_sub(str_replace_all(PostalCode, " ", ""), 1, 3)
  )

population_clean <- population %>%
  transmute(
    area_code = str_to_upper(str_trim(as.character(area_code))),
    Population2021 = as.numeric(str_replace_all(`Population, 2021`, ",", ""))
  )

branch_lookup <- branch_lookup %>%
  left_join(population_clean, by = "area_code") %>%
  distinct(BranchCode, .keep_all = TRUE)

## Warning in left_join(., population_clean, by = "area_code"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 6 of `x` matches multiple rows in `y`.
## ℹ Row 1647 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

visits2 <- visits %>%
  transmute(
    VisitYear = as.integer(Year),
    BranchCode = as.character(BranchCode),
    Visits = as.numeric(Visits)
  )

annual_data <- visits2 %>%
  left_join(branch_lookup, by = "BranchCode") %>%
  filter(!is.na(Lat), !is.na(Long), !is.na(Visits), !is.na(VisitYear))

map_points <- annual_data %>%
  distinct(BranchCode, BranchName, Long, Lat) %>%
  filter(!is.na(Long), !is.na(Lat))

lng_range <- range(map_points$Long, na.rm = TRUE)
lat_range <- range(map_points$Lat, na.rm = TRUE)
lng_pad <- diff(lng_range) * 0.08
lat_pad <- diff(lat_range) * 0.08

visit_years <- sort(unique(annual_data$VisitYear), decreasing = TRUE)

events_raw <- events

if ("Status" %in% names(events_raw)) {
  events_raw <- events_raw %>%
    filter(is.na(Status) | Status == "ACTIVE")
}

events_base <- events_raw %>%
  transmute(
    LocationName = trimws(as.character(LocationName)),
    StartDateLocal = as.character(StartDateLocal),
    EventTypes = as.character(EventTypes),
    Audiences = as.character(Audiences)
  ) %>%
  mutate(
    LocationName = recode(
      LocationName,
      "Daniel G. Hill" = "Daniel G. Hill (formely Jane/Dundas)",
      "Dufferin/St.Clair" = "Dufferin/St. Clair",
      "Ethennonnhawahstihnen'" = "Ethennonnhawahstihnen' (formely Bayview)",
      "Junction Triangle" = "Junction Triangle (formely Perth/Dupont)",
      "Junction Triangle - Closed" = "Junction Triangle (formely Perth/Dupont)"
    ),
    EventTypes = ifelse(is.na(EventTypes) | EventTypes == "", "Unknown", EventTypes),
    Audiences = ifelse(is.na(Audiences) | Audiences == "", "Unknown", Audiences),
    EventYear = suppressWarnings(as.integer(stringr::str_extract(StartDateLocal, "(19|20)\\d{2}")))
  ) %>%
  left_join(
    branch_lookup %>% select(BranchCode, BranchName),
    by = c("LocationName" = "BranchName")
  ) %>%
  filter(!is.na(BranchCode), !is.na(EventYear))

events_type_long <- events_base %>%
  separate_rows(EventTypes, sep = ",\\s*") %>%
  mutate(EventTypes = str_squish(EventTypes)) %>%
  filter(!is.na(EventTypes), EventTypes != "")

events_audience_long <- events_base %>%
  separate_rows(Audiences, sep = ",\\s*") %>%
  mutate(Audiences = str_squish(Audiences)) %>%
  filter(!is.na(Audiences), Audiences != "")

event_years <- sort(unique(stats::na.omit(events_base$EventYear)), decreasing = TRUE)

safe_rescale <- function(x, to = c(6, 16)) {
  x <- as.numeric(x)
  if (length(x) == 0) return(numeric(0))
  if (all(is.na(x))) return(rep(mean(to), length(x)))
  rng <- range(x, na.rm = TRUE)
  if (rng[1] == rng[2]) return(rep(mean(to), length(x)))
  scales::rescale(x, to = to, from = rng)
}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(" 
      body {
        background: #f5f7fb;
        color: #1f2937;
        font-family: Arial, Helvetica, sans-serif;
      }
      .container-fluid {
        max-width: 1380px;
        margin: 0 auto;
        padding: 24px 24px 10px 24px;
      }
      .app-title {
        font-size: 34px;
        font-weight: 700;
        margin-bottom: 6px;
        color: #0f172a;
      }
      .app-subtitle {
        font-size: 15px;
        color: #475569;
        margin-bottom: 22px;
        max-width: 900px;
      }
      .panel-card {
        background: white;
        border: 1px solid #e2e8f0;
        border-radius: 18px;
        padding: 18px 18px 10px 18px;
        box-shadow: 0 6px 18px rgba(15, 23, 42, 0.05);
        margin-bottom: 18px;
      }
      .section-title {
        font-size: 19px;
        font-weight: 700;
        margin-bottom: 4px;
        color: #0f172a;
      }
      .section-note {
        font-size: 13px;
        color: #64748b;
        margin-bottom: 12px;
      }
      .metric-card {
        background: #f8fafc;
        border: 1px solid #e2e8f0;
        border-radius: 14px;
        padding: 12px 14px;
        margin-bottom: 12px;
      }
      .metric-label {
        font-size: 12px;
        text-transform: uppercase;
        letter-spacing: 0.04em;
        color: #64748b;
        margin-bottom: 4px;
      }
      .metric-value {
        font-size: 24px;
        font-weight: 700;
        color: #0f172a;
        line-height: 1.1;
      }
      .metric-sub {
        font-size: 13px;
        color: #475569;
        margin-top: 3px;
      }
      .leaflet-container {
        border-radius: 14px;
      }
      .control-label {
        color: #334155;
        font-weight: 600;
      }
    "))
  ),

  div(class = "app-title", "Public Libraries as Civic Hubs"),
  div(
    class = "app-subtitle",
    "Explore the public libraries across Toronto. The map shows annual visits, and the charts summarize the selected branch's event."
  ),

  fluidRow(
    column(
      width = 3,
      div(
        class = "panel-card",
        div(class = "section-title", "Filters"),
        div(class = "section-note", "Use one year for visits on the map and another for event programming."),
        selectInput(
          "visit_year",
          "Visits year",
          choices = visit_years,
          selected = max(visit_years)
        ),
        selectInput(
          "event_year",
          "Events year",
          choices = event_years,
          selected = if (length(event_years) > 0) max(event_years) else NULL
        ),
        hr(),
        htmlOutput("branch_info")
      )
    ),

    column(
      width = 9,
      div(
        class = "panel-card",
        div(class = "section-title", "Branch Visits Map"),
        div(class = "section-note", "Larger and darker points represent more visits. Click a branch to update the detail panels and comparison charts."),
        leafletOutput("map", height = 450)
      )
    )
  ),

  fluidRow(
    column(width = 4, uiOutput("summary_cards")),
    column(
      width = 8,
      div(
        class = "panel-card",
        div(class = "section-title", "Top Event Types"),
        div(class = "section-note", "Sorted bars make branch-level differences easier to compare than unordered categories."),
        plotlyOutput("bar_chart", height = 420)
      )
    )
  ),

  fluidRow(
    column(
      width = 7,
      div(
        class = "panel-card",
        div(class = "section-title", "Audience Mix"),
        div(class = "section-note", "Audience categories are shown as a ranked bar chart so size comparisons are immediate and labels remain readable."),
        plotlyOutput("audience_chart", height = 380)
      )
    ),
    column(
      width = 5,
      div(
        class = "panel-card",
        div(class = "section-title", "Audience Distribution"),
        plotlyOutput("pie_chart", height = 420)
      )
    )
  )
)

server <- function(input, output, session) {
  selected_branch <- reactiveVal(NULL)

  filtered_map <- reactive({
    annual_data %>%
      filter(VisitYear == as.integer(input$visit_year))
  })

  selected_branch_meta <- reactive({
    req(selected_branch())
    branch_lookup %>%
      filter(BranchCode == selected_branch()) %>%
      slice(1)
  })

  selected_branch_visits <- reactive({
    req(selected_branch(), input$visit_year)
    annual_data %>%
      filter(
        BranchCode == selected_branch(),
        VisitYear == as.integer(input$visit_year)
      ) %>%
      slice(1)
  })

  selected_branch_events <- reactive({
    req(selected_branch(), input$event_year)
    events_base %>%
      filter(
        BranchCode == selected_branch(),
        EventYear == as.integer(input$event_year)
      )
  })

  bar_data <- reactive({
    req(selected_branch(), input$event_year)

    df <- events_type_long %>%
      filter(
        BranchCode == selected_branch(),
        EventYear == as.integer(input$event_year)
      ) %>%
      count(EventTypes, name = "count", sort = TRUE)

    if (nrow(df) == 0) return(df)

    if (nrow(df) > 8) {
      top_names <- df$EventTypes[1:8]
      df <- df %>%
        mutate(EventTypes = ifelse(EventTypes %in% top_names, EventTypes, "Other")) %>%
        group_by(EventTypes) %>%
        summarise(count = sum(count), .groups = "drop") %>%
        arrange(desc(count))
    }

    df %>%
      mutate(
        share = count / sum(count),
        label = paste0(comma(count), "  (", percent(share, accuracy = 0.1), ")")
      )
  })
  pie_data <- reactive({
    req(selected_branch(), input$event_year)
    
    events_audience_long %>%
      filter(
        BranchCode == selected_branch(),
        EventYear == as.integer(input$event_year)
      ) %>%
      count(Audiences, name = "count", sort = TRUE)
  })

  audience_data <- reactive({
    req(selected_branch(), input$event_year)

    df <- events_audience_long %>%
      filter(
        BranchCode == selected_branch(),
        EventYear == as.integer(input$event_year)
      ) %>%
      count(Audiences, name = "count", sort = TRUE)

    if (nrow(df) == 0) return(df)

    if (nrow(df) > 8) {
      top_names <- df$Audiences[1:8]
      df <- df %>%
        mutate(Audiences = ifelse(Audiences %in% top_names, Audiences, "Other")) %>%
        group_by(Audiences) %>%
        summarise(count = sum(count), .groups = "drop") %>%
        arrange(desc(count))
    }

    df %>%
      mutate(
        share = count / sum(count),
        label = paste0(comma(count), "  (", percent(share, accuracy = 0.1), ")")
      )
  })

  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
      fitBounds(
        lng1 = lng_range[1] - lng_pad,
        lat1 = lat_range[1] - lat_pad,
        lng2 = lng_range[2] + lng_pad,
        lat2 = lat_range[2] + lat_pad
      )
  })

  observe({
    df <- filtered_map()
    sel_code <- selected_branch()

    if (nrow(df) == 0) {
      leafletProxy("map") %>% clearMarkers() %>% clearControls()
      return()
    }
  radii <- safe_rescale(df$Visits, to = c(7, 18))

  pal <- colorNumeric(
    palette = "Blues",
    domain = log1p(annual_data$Visits),
    na.color = "#cbd5e1"
  )

    df <- df %>%
      mutate(
        is_selected = if (is.null(sel_code)) FALSE else BranchCode == sel_code,
        border_col = ifelse(is_selected, "#0f172a", "white"),
        border_wt = ifelse(is_selected, 3.5, 1.3),
        point_radius = ifelse(is_selected, radii + 3, radii)
      )

    leafletProxy("map", data = df) %>%
      clearMarkers() %>%
      clearControls() %>%
      addCircleMarkers(
        lng = ~Long,
        lat = ~Lat,
        layerId = ~BranchCode,
        radius = ~point_radius,
        fillColor = ~pal(log1p(Visits)),
        fillOpacity = 0.9,
        color = ~border_col,
        weight = ~border_wt,
        stroke = TRUE,
        opacity = 1,
        label = ~paste0(BranchName, " — ", comma(Visits), " visits"),
        popup = ~paste0(
          "<strong>", BranchName, "</strong><br>",
          "Visits year: ", VisitYear, "<br>",
          "Visits: ", comma(Visits), "<br>"
        )
      ) %>%
      addLegend(
    position = "bottomright",
    pal = pal,
    values = log1p(annual_data$Visits),
    title = "Annual visits",
    opacity = 1,
    labFormat = function(type, cuts, p) {
      format(round(expm1(cuts)), big.mark = ",")
    }
  )
  })

  observeEvent(input$map_marker_click, {
    selected_branch(input$map_marker_click$id)
  }, ignoreInit = TRUE)

  output$branch_info <- renderUI({
    if (is.null(selected_branch())) {
      HTML("<b>Selected branch:</b> None<br><span style='color:#64748b;'>Click a point on the map to see branch details.</span>")
    } else {
      branch_meta <- selected_branch_meta()
      visit_row <- selected_branch_visits()
      total_events <- nrow(selected_branch_events())

      visit_text <- if (nrow(visit_row) == 0) "No visits data" else comma(visit_row$Visits)
      pop_text <- if (is.na(branch_meta$Population2021)) "Not available" else comma(branch_meta$Population2021)

      HTML(paste0(
        "<b>Selected branch:</b> ", branch_meta$BranchName, "<br>",
        "<b>Address:</b> ", branch_meta$Address, "<br>",
        "<b>Neighbourhood:</b> ", branch_meta$NBHDName, "<br>",
        "<b>Ward:</b> ", branch_meta$WardName, "<br>",
        "<b>Service tier:</b> ", branch_meta$ServiceTier, "<br>",
        "<b>Area population (FSA):</b> ", pop_text, "<br>",
        "<b>", input$visit_year, " visits:</b> ", visit_text, "<br>",
        "<b>", input$event_year, " events:</b> ", comma(total_events)
      ))
    }
  })

  output$summary_cards <- renderUI({
    if (is.null(selected_branch())) {
      return(
        div(
          class = "panel-card",
          div(class = "section-title", "Branch summary"),
          div(class = "section-note", "Select a branch on the map to populate the summary cards.")
        )
      )
    }

    branch_meta <- selected_branch_meta()
    visit_row <- selected_branch_visits()
    event_rows <- selected_branch_events()

    visits_value <- if (nrow(visit_row) == 0) NA_real_ else visit_row$Visits[[1]]
    area_pop <- branch_meta$Population2021[[1]]
    visits_per_capita <- if (is.na(visits_value) || is.na(area_pop) || area_pop == 0) NA_real_ else visits_value / area_pop

    top_type <- bar_data()
    top_type_label <- if (nrow(top_type) == 0) "No data" else as.character(top_type$EventTypes[[1]])
    top_type_count <- if (nrow(top_type) == 0) "" else paste0(comma(top_type$count[[1]]), " events")

    audience_top <- audience_data()
    audience_label <- if (nrow(audience_top) == 0) "No data" else as.character(audience_top$Audiences[[1]])
    audience_count <- if (nrow(audience_top) == 0) "" else paste0(comma(audience_top$count[[1]]), " tags")

    tagList(
      div(
        class = "panel-card",
        div(class = "section-title", paste0(selected_branch_meta()$BranchName, " summary")),
        div(class = "metric-card",
            div(class = "metric-label", paste(input$visit_year, "visits")),
            div(class = "metric-value", ifelse(is.na(visits_value), "N/A", comma(visits_value))),
            div(class = "metric-sub", "Annual branch visits shown on the map")
        ),
        div(class = "metric-card",
            div(class = "metric-label", paste(input$event_year, "events")),
            div(class = "metric-value", comma(nrow(event_rows))),
            div(class = "metric-sub", "Total scheduled programs matched to this branch")
        ),
        div(class = "metric-card",
            div(class = "metric-label", "Visits per resident"),
            div(class = "metric-value", ifelse(is.na(visits_per_capita), "N/A", number(visits_per_capita, accuracy = 0.01))),
            div(class = "metric-sub", "Visits divided by local FSA population")
        ),
        div(class = "metric-card",
            div(class = "metric-label", "Most common event type"),
            div(class = "metric-value", top_type_label),
            div(class = "metric-sub", top_type_count)
        ),
        div(class = "metric-card",
            div(class = "metric-label", "Largest audience group"),
            div(class = "metric-value", audience_label),
            div(class = "metric-sub", audience_count)
        )
      )
    )
  })

  output$bar_chart <- plotly::renderPlotly({
    if (is.null(selected_branch())) {
      return(plot_ly() %>%
        layout(
          annotations = list(list(
            x = 0.5, y = 0.5,
            text = "Click a branch on the map",
            showarrow = FALSE,
            xref = "paper", yref = "paper",
            font = list(size = 18, color = "#64748b")
          )),
          xaxis = list(visible = FALSE),
          yaxis = list(visible = FALSE),
          paper_bgcolor = "white",
          plot_bgcolor = "white"
        ) %>%
        config(displayModeBar = FALSE))
    }

    df <- bar_data()

    if (nrow(df) == 0) {
      return(plot_ly() %>%
        layout(
          annotations = list(list(
            x = 0.5, y = 0.5,
            text = "No event type data for this branch and year",
            showarrow = FALSE,
            xref = "paper", yref = "paper",
            font = list(size = 18, color = "#64748b")
          )),
          xaxis = list(visible = FALSE),
          yaxis = list(visible = FALSE),
          paper_bgcolor = "white",
          plot_bgcolor = "white"
        ) %>%
        config(displayModeBar = FALSE))
    }

    df$EventTypes <- factor(df$EventTypes, levels = rev(df$EventTypes))

    plot_ly(
      data = df,
      x = ~count,
      y = ~EventTypes,
      type = "bar",
      orientation = "h",
      marker = list(color = "#2563eb"),
      text = ~label,
      textposition = "outside",
      cliponaxis = FALSE,
      hovertemplate = paste0(
        "<b>%{y}</b><br>",
        "Count: %{x:,}<br>",
        "Share: %{customdata}<extra></extra>"
      ),
      customdata = ~percent(share, accuracy = 0.1)
    ) %>%
      layout(
        title = list(
          text = paste0(selected_branch_meta()$BranchName, " — Event types in ", input$event_year),
          x = 0.02,
          xanchor = "left",
          font = list(size = 18)
        ),
        xaxis = list(
          title = "Number of event tags",
          showgrid = TRUE,
          gridcolor = "#e2e8f0",
          zeroline = FALSE,
          rangemode = "tozero"
        ),
        yaxis = list(
          title = "",
          automargin = TRUE,
          categoryorder = "array",
          showgrid = FALSE
        ),
        margin = list(l = 210, r = 130, t = 60, b = 55),
        paper_bgcolor = "white",
        plot_bgcolor = "white",
        showlegend = FALSE
      ) %>%
      config(displayModeBar = FALSE)
  })

  output$audience_chart <- plotly::renderPlotly({
    if (is.null(selected_branch())) {
      return(plot_ly() %>%
        layout(
          annotations = list(list(
            x = 0.5, y = 0.5,
            text = "Click a branch on the map",
            showarrow = FALSE,
            xref = "paper", yref = "paper",
            font = list(size = 18, color = "#64748b")
          )),
          xaxis = list(visible = FALSE),
          yaxis = list(visible = FALSE),
          paper_bgcolor = "white",
          plot_bgcolor = "white"
        ) %>%
        config(displayModeBar = FALSE))
    }

    df <- audience_data()

    if (nrow(df) == 0) {
      return(plot_ly() %>%
        layout(
          annotations = list(list(
            x = 0.5, y = 0.5,
            text = "No audience data for this branch and year",
            showarrow = FALSE,
            xref = "paper", yref = "paper",
            font = list(size = 18, color = "#64748b")
          )),
          xaxis = list(visible = FALSE),
          yaxis = list(visible = FALSE),
          paper_bgcolor = "white",
          plot_bgcolor = "white"
        ) %>%
        config(displayModeBar = FALSE))
    }

    df$Audiences <- factor(df$Audiences, levels = rev(df$Audiences))

    plot_ly(
      data = df,
      x = ~count,
      y = ~Audiences,
      type = "bar",
      orientation = "h",
      marker = list(color = "#0f766e"),
      text = ~label,
      textposition = "outside",
      cliponaxis = FALSE,
      hovertemplate = paste0(
        "<b>%{y}</b><br>",
        "Count: %{x:,}<br>",
        "Share: %{customdata}<extra></extra>"
      ),
      customdata = ~percent(share, accuracy = 0.1)
    ) %>%
      layout(
        title = list(
          text = paste0(selected_branch_meta()$BranchName, " — Audience mix in ", input$event_year),
          x = 0.02,
          xanchor = "left",
          font = list(size = 18)
        ),
        xaxis = list(
          title = "Number of audience tags",
          showgrid = TRUE,
          gridcolor = "#e2e8f0",
          zeroline = FALSE,
          rangemode = "tozero"
        ),
        yaxis = list(
          title = "",
          automargin = TRUE,
          showgrid = FALSE
        ),
        margin = list(l = 190, r = 130, t = 60, b = 55),
        paper_bgcolor = "white",
        plot_bgcolor = "white",
        showlegend = FALSE
      ) %>%
      config(displayModeBar = FALSE)
  })
output$pie_chart <- plotly::renderPlotly({
  if (is.null(selected_branch())) {
    return(NULL)
  }
  
  df <- pie_data()
  
  if (nrow(df) == 0) {
    return(NULL)
  }
  
  df <- df %>%
    mutate(
      percent = count / sum(count),
      hover_text = paste0(
        "Event type: ", Audiences,
        "<br>Count: ", scales::comma(count),
        "<br>Percentage: ", scales::percent(percent, accuracy = 0.1)
      )
    )
  
  plotly::plot_ly(
    data = df,
    labels = ~Audiences,
    values = ~count,
    type = "pie",
    hole = 0.6,
    textinfo = "label",
    hoverinfo = "text",
    text = ~hover_text
  ) %>%
    plotly::layout(
      title = paste(
        "Audience Distribution:",
        selected_branch_meta()$BranchName, "-", input$event_year
      ),
      legend = list(title = list(text = "Audience Group"))
    )
})
}

shinyApp(ui = ui, server = server)

Shiny applications not supported in static R Markdown documents