# Q4. For each category, which program has the most total global viewing hours?
top_programs_by_category <- GLOBAL_TOP_10 |>
group_by(category, show_title) |>
summarise(total_hours = sum(weekly_hours_viewed, na.rm = TRUE), .groups = "drop_last") |>
slice_max(order_by = total_hours, n = 1, with_ties = FALSE) |>
ungroup() |>
arrange(category)
# Q5. Which TV show had the longest run in a country’s Top 10?
longest_tv_run <- COUNTRY_TOP_10 |>
filter(!is.na(week), grepl("^TV", category)) |>
group_by(country_name, show_title) |>
arrange(week, .by_group = TRUE) |>
mutate(
gap_days = as.integer(week - lag(week)),
new_streak = if_else(is.na(gap_days) | gap_days != 7L, 1L, 0L),
streak_id = cumsum(coalesce(new_streak, 1L))
) |>
group_by(country_name, show_title, streak_id) |>
summarise(
streak_weeks = n(),
start_week = min(week, na.rm = TRUE),
end_week = max(week, na.rm = TRUE),
.groups = "drop"
) |>
arrange(desc(streak_weeks), desc(end_week)) |>
slice(1)
# Q6. Country with a notably short service history window
country_weeks <- COUNTRY_TOP_10 |>
filter(!is.na(week)) |>
group_by(country_name) |>
summarise(
n_weeks = n_distinct(week),
last_week = max(week, na.rm = TRUE),
.groups = "drop"
) |>
arrange(n_weeks, country_name)
country_weeks_outlier <- slice_head(country_weeks, n = 1)
# Q7. Total viewership of Squid Game (all seasons)
squid_game_total <- GLOBAL_TOP_10 |>
filter(grepl("Squid Game", show_title, ignore.case = TRUE),
grepl("^TV", category)) |>
summarise(total_hours = sum(weekly_hours_viewed, na.rm = TRUE))
# Q8. Approximate 2021 views for Red Notice (runtime 118 minutes)
red_notice_views_2021 <- GLOBAL_TOP_10 |>
filter(show_title == "Red Notice", lubridate::year(week) == 2021) |>
summarise(
total_hours_2021 = sum(weekly_hours_viewed, na.rm = TRUE),
approx_views_2021 = (total_hours_2021 * 60) / 118
)
# Q9. Films that reached #1 in the US but did not debut at #1 (+ most recent)
films_reach1_after_count <- COUNTRY_TOP_10 |>
filter(country_name == "United States", grepl("^Films", category)) |>
group_by(show_title) |>
summarise(
debut_week = min(week, na.rm = TRUE),
debut_rank = weekly_rank[which.min(week)],
ever_rank1 = any(weekly_rank == 1, na.rm = TRUE),
first_week_1 = if (ever_rank1) min(week[weekly_rank == 1], na.rm = TRUE) else as.Date(NA),
.groups = "drop"
) |>
filter(ever_rank1, debut_rank != 1) |>
summarise(n = n()) |>
pull(n)
most_recent_reach1 <- COUNTRY_TOP_10 |>
filter(country_name == "United States", grepl("^Films", category)) |>
group_by(show_title) |>
summarise(
debut_week = min(week, na.rm = TRUE),
debut_rank = weekly_rank[which.min(week)],
ever_rank1 = any(weekly_rank == 1, na.rm = TRUE),
first_week_1 = if (ever_rank1) min(week[weekly_rank == 1], na.rm = TRUE) else as.Date(NA),
.groups = "drop"
) |>
filter(ever_rank1, debut_rank != 1) |>
arrange(desc(first_week_1)) |>
slice(1)
# Q10. Which TV show/season hit Top 10 in the most countries in its debut week?
q10_debut_reach <- COUNTRY_TOP_10 |>
filter(grepl("^TV", category)) |>
group_by(show_title, season_title) |>
mutate(overall_debut_week = min(week, na.rm = TRUE)) |>
ungroup() |>
filter(week == overall_debut_week) |>
group_by(show_title, season_title, overall_debut_week) |>
summarise(countries_at_overall_debut = n_distinct(country_name), .groups = "drop") |>
arrange(desc(countries_at_overall_debut), desc(overall_debut_week)) |>
slice(1)