Library Event Attendance and Performance Analysis

Analysis and Insights

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 

Library Card and Focused Events Analysis

# Create a more comprehensive filtering and categorization
focused_events_data <- event_data %>%
  mutate(
    # Standardize library card status with more comprehensive matching
    library_card_status = case_when(
      library_card_requirement_status == "AHML Cardholders Only" ~ "Requires Library Card",
      library_card_requirement_status == "No Library Card Required" ~ "Does Not Require Library Card",
      tolower(library_card_requirement_status) %in% c("required", "yes", "ahml cardholders only") ~ "Requires Library Card",
      tolower(library_card_requirement_status) %in% c("no", "no library card required", "not required") ~ "Does Not Require Library Card",
      library_card_requirement_raw == 1 ~ "Requires Library Card",
      library_card_requirement_raw == 0 ~ "Does Not Require Library Card",
      TRUE ~ "Unknown Library Card Requirement"
    ),
    
    # Expanded and more flexible category matching
    focused_category = case_when(
      # Primary subject matching
      primary_subject == "Technology Classes" ~ "Technology Classes Events",
      primary_subject == "Makerplace" ~ "Makerplace Events",
      
      # Room name matching with more flexible approach
      grepl("makerplace.*kitchen", tolower(event_room_name)) ~ "Makerplace - Kitchen Room",
      grepl("training center", tolower(event_room_name)) ~ "Training Center Room",
      
      # Fallback
      TRUE ~ "Other"
    )
  ) %>%
  # Filter to include the specific categories
  filter(
    focused_category %in% c(
      "Technology Classes Events", 
      "Makerplace Events", 
      "Makerplace - Kitchen Room", 
      "Training Center Room"
    )
  )

# Create the pivot-like summary table
library_card_summary <- focused_events_data %>%
  group_by(library_card_status, focused_category) %>%
  summarise(
    total_events = n(),
    total_registrations = sum(actual_registrations, na.rm = TRUE),
    avg_registrations = mean(actual_registrations, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  arrange(desc(total_events))

# Print the resulting table
library_card_summary %>%
  kable(
    caption = "Event Distribution by Library Card Requirement and Category",
    format.args = list(big.mark = ",")
  ) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

Event Distribution by Library Card Requirement and Category

library_card_status	focused_category	total_events	total_registrations	avg_registrations
Requires Library Card	Technology Classes Events	675	4,462	6.61037
Requires Library Card	Makerplace Events	618	22,082	35.73139
Does Not Require Library Card	Technology Classes Events	471	6,931	14.71550
Does Not Require Library Card	Makerplace Events	95	1,386	14.58947
Does Not Require Library Card	Training Center Room	45	778	17.28889
Unknown Library Card Requirement	Makerplace Events	20	302	15.10000
Requires Library Card	Makerplace - Kitchen Room	16	296	18.50000
Does Not Require Library Card	Makerplace - Kitchen Room	9	155	17.22222
Requires Library Card	Training Center Room	8	85	10.62500
Unknown Library Card Requirement	Training Center Room	4	29	7.25000
Unknown Library Card Requirement	Makerplace - Kitchen Room	1	30	30.00000

Heatmaps for Specialized Events

# Categories to analyze
categories_to_analyze <- c(
  "Technology Classes Events",
  "Makerplace Events",
  "Makerplace - Kitchen Room",
  "Training Center Room"
)

# Function to create heatmaps
create_heatmaps <- function(data, category) {
  # Filter data for specific category
  cat_data <- data %>% 
    filter(focused_category == category)
  
  # Skip if no data
  if (nrow(cat_data) == 0) {
    cat("\n\n###", category, "- No data available\n\n")
    return(NULL)
  }
  
  # Average registrations heatmap
  avg_regs <- cat_data %>%
    group_by(event_day_of_week, event_hour = floor(event_hour_decimal)) %>%
    summarise(avg_value = mean(actual_registrations, na.rm = TRUE), .groups = "drop")
  
  p1 <- ggplot(avg_regs, 
         aes(x = event_day_of_week, y = event_hour, fill = avg_value)) +
    geom_tile(color = "white") +
    scale_fill_gradient(low = "lightblue", high = "darkblue", name = "Avg Registrations") +
    labs(title = paste(category, "- Average Registrations"),
         x = "Day of Week", y = "Hour of Day") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  # Event count heatmap
  event_counts <- cat_data %>%
    group_by(event_day_of_week, event_hour = floor(event_hour_decimal)) %>%
    summarise(event_count = n(), .groups = "drop")
  
  p2 <- ggplot(event_counts, 
         aes(x = event_day_of_week, y = event_hour, fill = event_count)) +
    geom_tile(color = "white") +
    scale_fill_gradient(low = "lightgreen", high = "darkgreen", name = "Number of Events") +
    labs(title = paste(category, "- Number of Events"),
         x = "Day of Week", y = "Hour of Day") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  # Print plots
  cat("\n\n###", category, "\n\n")
  print(p1)
  print(p2)
  
  # Return plots invisibly in case they're needed later
  invisible(list(p1, p2))
}

# Generate heatmaps
for (category in categories_to_analyze) {
  create_heatmaps(focused_events_data, category)
}

Technology Classes Events

Makerplace Events

Makerplace - Kitchen Room

Training Center Room

Summary of Findings

# Overall library card requirement summary
overall_library_card_summary <- focused_events_data %>%
  group_by(library_card_status) %>%
  summarise(
    total_events = n(),
    total_registrations = sum(actual_registrations, na.rm = TRUE),
    avg_registrations = mean(actual_registrations, na.rm = TRUE),
    .groups = "drop"
  )

# Print overall summary
overall_library_card_summary %>%
  kable(
    caption = "Overall Library Card Requirement Summary",
    format.args = list(big.mark = ",")
  ) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

Overall Library Card Requirement Summary

library_card_status	total_events	total_registrations	avg_registrations
Does Not Require Library Card	620	9,250	14.91935
Requires Library Card	1,317	26,925	20.44419
Unknown Library Card Requirement	25	361	14.44000

# Key insights
cat("\n### Key Insights:\n")

### Key Insights:

cat("1. Library Card Requirement Distribution:\n")

1. Library Card Requirement Distribution:

print(table(focused_events_data$library_card_status))

   Does Not Require Library Card            Requires Library Card 
                             620                             1317 
Unknown Library Card Requirement 
                              25