Library Event Attendance and Performance Analysis

Welcome to the Library Event Attendance and Performance Analysis. This report provides a comprehensive, data-driven look into our library’s adult event programming, helping us understand what drives event success and inform future planning.

We began by taking our raw event data and refining it. To focus on meaningful adult programs, we first cleaned the data by filtering out any events intended for children or youth, as well as cancelled events and those with zero registrations. We then applied a precise filter to include only events that occurred during our standard library operating hours for each day of the week. This process ensured our analysis was based on a realistic and relevant dataset.

A key step in our preparation was the creation of a new primary subject categorization. We developed a custom logic to group events by their main topic, such as “Technology Classes” or “Arts & Culture,” which allows for a more focused analysis of popular themes.

Analysis and Insights

The core of this report is a series of visual heatmaps that show us when people are most likely to register for events. We’ve created an overall heatmap to reveal general attendance trends across all adult programs. By looking at a simple grid of days and times, we can immediately spot overall patterns.

To gain deeper insights, we also generated subject-specific and room-specific heatmaps. This allows us to answer detailed questions like, “Do our technology workshops perform better on Tuesday mornings?” or “Is a particular room more popular in the evening?”

To complement the visualizations, we’ve included a section with two interactive data tables. These tables allow you to explore the data in detail, filtering by subject, day, and time to see average registrations and total events.

Ultimately, this analysis provides a clear, actionable overview of when and where our adult programs are most successful. By leveraging this information, we can strategically plan our future events to better meet the needs of our community and maximize attendance.

Data Preparation and Processing

# Load required libraries
library(tidyverse)
library(janitor)
library(lubridate)
library(kableExtra)
library(viridis)
library(DT)
library(purrr)

# Load and prepare the data
event_data <- read_csv("event_data_with_analysis.csv", 
                       col_types = cols(), 
                       na = c("", "NA", "N/A")) %>%
  clean_names() %>%
  mutate(
    # Parse event dates and times in UTC
    event_start_time = ymd_hms(event_start_time, tz = "UTC"),
    
    # Convert to local time (Central Time)
    local_start_time = with_tz(event_start_time, tzone = "America/Chicago"),
    
    # Extract local time components
    event_date = as.Date(local_start_time),
    event_year = year(event_date),
    event_month = month(event_date),
    event_day_of_week = wday(local_start_time, label = TRUE),
    event_hour_decimal = hour(local_start_time) + minute(local_start_time) / 60,
    
    # Library hours filter
    is_during_library_hours = case_when(
      event_day_of_week %in% c("Mon", "Tue", "Wed", "Thu", "Fri") & 
        hour(local_start_time) >= 9 & hour(local_start_time) < 21 ~ TRUE,
      event_day_of_week == "Sat" & 
        hour(local_start_time) >= 9 & hour(local_start_time) < 17 ~ TRUE,
      event_day_of_week == "Sun" & 
        hour(local_start_time) >= 12 & hour(local_start_time) < 18 ~ TRUE,
      TRUE ~ FALSE
    ),
    
    # Create primary subject categorization
    primary_subject = map_chr(as.character(event_subjects), function(subjects) {
      if (is.na(subjects)) return("Uncategorized")
      
      priority_subjects <- c(
        "Books & Authors", "ESL", "Technology Classes", 
        "Business & Nonprofit", "Makerplace", "Senior Center", 
        "Genealogy", "Health & Wellness", "Arts & Culture"
      )
      
      tags <- str_split(subjects, ";")[[1]] %>% 
        str_trim() %>%
        .[!str_detect(., "^\\d+$")]
      
      for (subject in priority_subjects) {
        if (any(str_detect(tags, fixed(subject)))) {
          return(subject)
        }
      }
      
      return(tags[1] %||% "Uncategorized")
    }),
    
    # Filter out children/youth events and cancelled events
    is_valid_event = 
      !str_detect(tolower(event_title %||% ""), "child|kid|family|youth") &
      !str_detect(tolower(primary_subject), "child|kid|family|youth") &
      !str_detect(tolower(event_title %||% ""), "cancel") &
      !is.na(event_date) &
      !is.na(actual_registrations) & 
      actual_registrations > 0
  ) %>%
  filter(is_valid_event & is_during_library_hours)

# Print summary of processed data
cat("Total events after filtering:", nrow(event_data), "\n")

Total events after filtering: 5726 

cat("Unique subjects:", length(unique(event_data$primary_subject)), "\n")

Unique subjects: 24 

Overall Event Registration Heatmap

# Create overall heatmap
overall_heatmap_data <- event_data %>%
  group_by(event_day_of_week, event_hour_decimal = floor(event_hour_decimal)) %>%
  summarise(
    avg_registrations = mean(actual_registrations, na.rm = TRUE),
    event_count = n(),
    .groups = "drop"
  )

ggplot(overall_heatmap_data, 
       aes(x = event_day_of_week, 
           y = event_hour_decimal, 
           fill = avg_registrations)) +
  geom_tile(color = "white") +
  scale_fill_viridis_c(name = "Avg Registrations", option = "plasma") +
  labs(title = "Overall Registration Patterns by Day and Time",
       x = "Day of Week", y = "Hour of Day") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Subject-Specific Heatmaps

# Function to create heatmap for a specific subject
create_subject_heatmap <- function(subject) {
  # Prepare data for the specific subject
  subject_heatmap_data <- event_data %>%
    filter(primary_subject == subject) %>%
    group_by(event_day_of_week, event_hour_decimal = floor(event_hour_decimal)) %>%
    summarise(
      avg_registrations = mean(actual_registrations, na.rm = TRUE),
      event_count = n(),
      .groups = "drop"
    )
  
  # Create the heatmap
  p <- ggplot(subject_heatmap_data, 
         aes(x = event_day_of_week, 
             y = event_hour_decimal, 
             fill = avg_registrations)) +
    geom_tile(color = "white") +
    scale_fill_viridis_c(name = "Avg Registrations", option = "plasma") +
    labs(title = paste("Registration Patterns for", subject),
         x = "Day of Week", y = "Hour of Day") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  # Print the plot with a header
  cat("\n\n###", subject, "Events\n\n")
  print(p)
}

# Generate heatmaps for each unique subject
# Limit to top 10 subjects to prevent overwhelming output
top_subjects <- event_data %>%
  group_by(primary_subject) %>%
  summarise(
    total_events = n(),
    total_registrations = sum(actual_registrations, na.rm = TRUE)
  ) %>%
  slice_max(total_events, n = 10) %>%
  pull(primary_subject)

# Create heatmaps for top subjects
walk(top_subjects, create_subject_heatmap)

ESL Events

No Subjects Listed Events

Technology Classes Events

Makerplace Events

Books & Authors Events

Storytime Events

Genealogy Events

Business & Nonprofit Events

Movies Events

Senior Center Events

Room-Specific Heatmaps

# Function to create heatmap for a specific room
create_room_heatmap <- function(room) {
  # Prepare data for the specific room
  room_heatmap_data <- event_data %>%
    filter(event_room_name == room) %>%
    group_by(event_day_of_week, event_hour_decimal = floor(event_hour_decimal)) %>%
    summarise(
      avg_registrations = mean(actual_registrations, na.rm = TRUE),
      event_count = n(),
      .groups = "drop"
    )
  
  # Create the heatmap
  p <- ggplot(room_heatmap_data, 
         aes(x = event_day_of_week, 
             y = event_hour_decimal, 
             fill = avg_registrations)) +
    geom_tile(color = "white") +
    scale_fill_viridis_c(name = "Avg Registrations", option = "plasma") +
    labs(title = paste("Registration Patterns for", room),
         x = "Day of Week", y = "Hour of Day") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  # Print the plot with a header
  cat("\n\n###", room, "Room\n\n")
  print(p)
}

# Generate heatmaps for top rooms
top_rooms <- event_data %>%
  group_by(event_room_name) %>%
  summarise(
    total_events = n(),
    total_registrations = sum(actual_registrations, na.rm = TRUE)
  ) %>%
  slice_max(total_events, n = 10) %>%
  pull(event_room_name)

# Create heatmaps for top rooms
walk(top_rooms, create_room_heatmap)

Zoom Event Room

Training Center Room

Hendrickson South Room

Cardinal Room Room

Sr Center Computer Room Room

ESL/Literacy Office Room

Makerplace - Kitchen Room

Lindsey Room Room

Makerplace - Creative Arts Room

Makerplace - Flex Space 2 Room

Detailed Event Data Tables

# Prepare detailed data table
detailed_events_table <- event_data %>%
  group_by(event_day_of_week, event_hour = floor(event_hour_decimal), primary_subject) %>%
  summarise(
    avg_registrations = round(mean(actual_registrations, na.rm = TRUE), 2),
    total_events = n(),
    .groups = "drop"
  ) %>%
  arrange(desc(total_events))

# Create interactive data table
datatable(detailed_events_table, 
          filter = 'top', 
          options = list(
            pageLength = 10, 
            autoWidth = TRUE,
            scrollX = TRUE
          ),
          caption = "Detailed Event Registration Data")

# Prepare room-specific data table
room_events_table <- event_data %>%
  group_by(event_room_name, event_day_of_week, event_hour = floor(event_hour_decimal)) %>%
  summarise(
    avg_registrations = round(mean(actual_registrations, na.rm = TRUE), 2),
    total_events = n(),
    .groups = "drop"
  ) %>%
  arrange(desc(total_events))

# Create interactive room data table
datatable(room_events_table, 
          filter = 'top', 
          options = list(
            pageLength = 10, 
            autoWidth = TRUE,
            scrollX = TRUE
          ),
          caption = "Room-Specific Event Registration Data")