Broadway Musicals

加载经常用的R包

library(pacman)
library(lubridate)
p_load(tidyverse, stringr, DT, skimr, DataExplorer, grf, glmnet, caret, tidytext, 
    explore, patchwork, ggrepel, ggcorrplot, gghighlight, ggthemes, fpp2, forecast, 
    magrittr, readxl, writexl, listviewer, car, tseries, vtable)
library(gganimate)

broadway <- read_csv("../H_ggplo2/grosses.csv")

## Parsed with column specification:
## cols(
##   week_ending = col_date(format = ""),
##   week_number = col_double(),
##   weekly_gross_overall = col_double(),
##   show = col_character(),
##   theatre = col_character(),
##   weekly_gross = col_double(),
##   potential_gross = col_logical(),
##   avg_ticket_price = col_double(),
##   top_ticket_price = col_logical(),
##   seats_sold = col_double(),
##   seats_in_theatre = col_double(),
##   pct_capacity = col_double(),
##   performances = col_double(),
##   previews = col_double()
## )

## Warning: 71078 parsing failures.
##  row              col           expected actual                      file
## 6862 potential_gross  1/0/T/F/TRUE/FALSE 383843 '../H_ggplo2/grosses.csv'
## 6862 top_ticket_price 1/0/T/F/TRUE/FALSE 50     '../H_ggplo2/grosses.csv'
## 6885 potential_gross  1/0/T/F/TRUE/FALSE 383843 '../H_ggplo2/grosses.csv'
## 6885 top_ticket_price 1/0/T/F/TRUE/FALSE 50     '../H_ggplo2/grosses.csv'
## 6909 potential_gross  1/0/T/F/TRUE/FALSE 383843 '../H_ggplo2/grosses.csv'
## .... ................ .................. ...... .........................
## See problems(...) for more details.

broadway <- broadway %>% filter(year(week_ending) >= 2010, year(week_ending) <= 2019)
broadway %>% head()

## # A tibble: 6 x 14
##   week_ending week_number weekly_gross_ov~ show  theatre weekly_gross
##   <date>            <dbl>            <dbl> <chr> <chr>          <dbl>
## 1 2010-01-03           32         28089915 A Li~ Walter~      1031543
## 2 2010-01-03           32         28089915 A Vi~ Cort T~       601729
## 3 2010-01-03           32         28089915 Bill~ Imperi~      1663895
## 4 2010-01-03           32         28089915 Burn~ Longac~       594252
## 5 2010-01-03           32         28089915 Bye ~ Henry ~       667496
## 6 2010-01-03           32         28089915 Chic~ Ambass~       888536
## # ... with 8 more variables: potential_gross <lgl>, avg_ticket_price <dbl>,
## #   top_ticket_price <lgl>, seats_sold <dbl>, seats_in_theatre <dbl>,
## #   pct_capacity <dbl>, performances <dbl>, previews <dbl>

topten <- broadway %>% group_by(show) %>% summarize(totalgross = sum(weekly_gross)) %>% 
    arrange(desc(totalgross)) %>% # just get top 10
top_n(n = 10)

## Selecting by totalgross

broadway <- broadway %>% # subset only top 10 obs
filter(show %in% topten$show) %>% # create year column
mutate(year = year(week_ending)) %>% # group data by show and time (week)
group_by(show, year) %>% # calculate totals across theaters
summarize(year_gross = sum(weekly_gross), potential_gross = sum(potential_gross), 
    avg_ticket_price = mean(avg_ticket_price), top_ticket_price = max(avg_ticket_price), 
    seats_sold = sum(seats_sold), seats_in_theatre = sum(seats_in_theatre), performances = sum(performances), 
    previews = sum(previews))
broadway

## # A tibble: 82 x 10
## # Groups:   show [10]
##    show   year year_gross potential_gross avg_ticket_price top_ticket_price
##    <chr> <dbl>      <dbl>           <int>            <dbl>            <dbl>
##  1 Alad~  2014  59050162               NA             98.9             98.9
##  2 Alad~  2015  78948527               NA            113.             113. 
##  3 Alad~  2016  78207510.              NA            111.             111. 
##  4 Alad~  2017  81950158.              NA            113.             113. 
##  5 Alad~  2018  75716100.              NA            107.             107. 
##  6 Alad~  2019  73851144.              NA            105.             105. 
##  7 Beau~  2013   4271877               NA            109.             109. 
##  8 Beau~  2014  58110271               NA            140.             140. 
##  9 Beau~  2015  51701954               NA            132.             132. 
## 10 Beau~  2016  45689407.              NA            117.             117. 
## # ... with 72 more rows, and 4 more variables: seats_sold <dbl>,
## #   seats_in_theatre <dbl>, performances <dbl>, previews <dbl>

# Set theme
lltheme <- theme_set(
  theme_bw() +
    theme(
      text = element_text(size = 12),
      # tilt and adjust position of x axis labels
      axis.text.y = element_text(size = 11, color = 'black'),
      axis.text.x = element_text(size = 11, color = 'black'),
      legend.position = 'none'
    )
)

# Base plot
baseplot <- ggplot(data = broadway, mapping = aes(x = year, y = (year_gross/1e+06), 
    group = show)) + geom_line(mapping = aes(color = show), size = 1.5) + geom_text(data = broadway, 
    mapping = aes(x = year, y = (year_gross/1e+06), label = show), hjust = 0) + coord_cartesian(xlim = c(2010, 
    2025), ylim = c(0, 175)) + xlab("Year") + ylab("Box Office Gross (Millions of USD)") + 
    labs(title = "Earnings of Higest Grossing Musicals of the 2010s", subtitle = "Top 10 in Box Office Gross 2010-2019", 
        caption = "Source: Playbill, The Broadway League")

# animate

animatedplot <- baseplot + transition_reveal(year)

animate(animatedplot, end_pause = 20)

p <- economics_long %>% filter(variable != "pop") %>% ggplot(aes(date, value, group = variable)) + 
    geom_line(aes(col = variable, linetype = variable), size = 1.2) + geom_text(aes(label = variable), 
    hjust = 0.5, family = "Times New Roman") + theme(text = element_text(family = "Times New Roman"))

animatedplot <- p + transition_reveal(date)

animate(animatedplot, end_pause = 20)