Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
196 lines (159 sloc) 9.3 KB
---
title: 'Light It Red: Exploring Bell Tower Celebrations with R'
author: ~
date: '2019-04-14'
slug: exploring-bell-tower-celebrations-r
categories: ["R","Web Scraping"]
tags: []
description: ''
keywords: []
---
## NC State Belltower
Among the sights to see when taking a trip to Raleigh is NC State’s iconic Belltower. Erected as a monument to honor fallen soldiers of WW1, the memorial Belltower has become a symbol of pride for NC State students and alumni.
On any given night, the bell tower might have a red illumination. Red bell tower lightings signify special achievements made by NC State organizations and staff as well as memorial holidays.
Every Belltower lighting since the summer of 2010 has been recorded at ncsu.edu, along with its occasion. I thought it was worth trying to understand a litle more about what makes the Belltower shine red.
```{r setup, message=FALSE,echo=FALSE}
library(tidyverse)
library(lubridate)
library(rvest)
```
## Getting the data
[In the archive](https://www.ncsu.edu/about/history-and-tradition/belltower-celebrations/archive/), dates are listed with their occasion. Scores are listed for Baseball, Football, and Basketball. For this analysis, I used the **rvest** package for scraping the page, and then did some manipulation to get the data into a tidy format.
```{r data,message=FALSE,echo=FALSE,include=TRUE,warning=FALSE}
lights <- read_html("https://www.ncsu.edu/about/history-and-tradition/belltower-celebrations/archive") %>%
html_nodes("div.section-txt p") %>% html_text() %>% tbl_df() %>%
filter(str_detect(value,"Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec")) %>%
mutate(date = str_remove(value,"(\\n.+)+"),
date=mdy(date),
occasion = str_extract(value,"(?<=\\n).+")) %>% filter(!is.na(date),
date<=Sys.Date()) %>% select(-1)
lights %>% head() %>% knitr::kable()
```
Since June of 2010, there have been 320 Belltower celebrations.
Going through the data, it becomes evident pretty quickly that sports victories make a large number of Belltower celebrations. Students are likely quick to assume that a red Belltower means that one of our Basketball or Football teams had an ACC win. Interesting that NC State women's basketball outranks the men in this measure.
```{r, echo=FALSE}
lights %>% count(occasion,sort=TRUE) %>% filter(!is.na(occasion)) %>% DT::datatable()
```
<br>
Among the less common occasions are a number of personal achievements made by individuals affiliated with the University. When lumping these personal recognitions together, it turns out that they make up a significant number.
```{r, echo=FALSE}
lights %>% mutate(occasion =case_when(
str_detect(occasion,"Recognition")==TRUE ~ "Recognition",
str_detect(occasion,"Recognition")==FALSE ~ occasion
)) %>% count(occasion,sort = TRUE) %>% head() %>% knitr::kable()
```
## How often is the Belltower lit?
Students can be seen gathering around the Belltower after big wins, but how likely is that you'll see it red on random night in Raleigh?
```{r,echo=FALSE,fig.align="center"}
light_dated <- lights %>% mutate(year = year(date),
month = month(date,
label = TRUE,
abbr=FALSE),
weekday = wday(date,
label = TRUE,
abbr=FALSE,
week_start = 1))
light_dated %>% count(weekday,sort=TRUE) %>%
ggplot(aes(fct_rev(weekday),n,label=n)) + geom_col(fill="#CC0000") +
geom_text(hjust=-1,family="PT Sans") +
expand_limits(y=c(0,100)) +
theme(axis.text = element_text(size=13,
family = "PT Sans"),
panel.background = element_rect(fill="#F2F2F2"),
plot.margin = margin(20,20,20,20,"pt"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(family = "PT Sans",size = 21),
panel.border = element_blank(),
axis.title = element_text(size=11,
family = "PT Sans",hjust = 1),
plot.background = element_rect(fill="#F2F2F2"),
plot.subtitle = element_text(family = "PT Sans")) +
coord_flip() +
labs(x=NULL,y="# of Nights Lit Red",title = "Weekdays the NC State Belltower is lit",
subtitle = "(June 2010 - April 2019)")
#light_dated %>% filter(!str_detect(year,"2019|2010")) %>% count(month,sort=TRUE)
#light_dated %>% filter(!str_detect(year,"2019|2010")) %>% count(month,weekday,sort=TRUE)
```
It turns out that the weekend is a good time to see a red Belltower. College football games are almost always played on Saturdays, but even with 34 less occasions, Saturday would still be tied for the highest occuring day.
```{r,echo=FALSE,fig.align="center"}
light_dated %>% filter(!str_detect(year,"2019|2010")) %>% count(month,sort=TRUE) %>%
ggplot(aes(fct_rev(month),n,label=n)) + geom_col(fill="#CC0000") +
geom_text(hjust=-1,family="PT Sans") +
expand_limits(y=c(0,55))+
theme(axis.text = element_text(size=13,
family = "PT Sans"),
panel.background = element_rect(fill="#F2F2F2"),
plot.margin = margin(20,20,20,20,"pt"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(family = "PT Sans",size = 21),
plot.subtitle = element_text(family="PT Sans"),
panel.border = element_blank(),
axis.title = element_text(size=11,
family = "PT Sans",hjust = 1),
plot.background = element_rect(fill="#F2F2F2"),) +
coord_flip() +
labs(x=NULL,y="# of Nights Lit Red",title = "Months the NC State Belltower is lit",
subtitle = "(2011-2018)")
```
The winter months stand out as those with the most nights with a lit Belltower. Based on the numbers for the most frequently occuring occasions, it's easy to guess that Basketball is the cause. Also interesting is that there have been 0 Belltower lightings in the month of July for these 8 years.
```{r, echo=FALSE}
light_dated %>% filter(!is.na(occasion)) %>%mutate(
occasion = case_when(
str_detect(occasion, "Recognition") == TRUE ~ "Recognition",
str_detect(occasion, "Recognition") == FALSE ~ occasion
),
occasion = fct_lump(occasion, 5)
) %>%
group_by(occasion, month) %>%
summarise(n = n()) %>% ggplot(aes(fct_rev(month), n, fill = occasion)) +
geom_col() + coord_flip() +
theme(axis.text = element_text(size=13,
family = "PT Sans"),
panel.background = element_rect(fill="#F2F2F2"),
plot.margin = margin(20,20,20,20,"pt"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(family = "PT Sans",size = 21),
plot.subtitle = element_text(family="PT Sans"),
panel.border = element_blank(),
axis.title = element_text(size=11,
family = "PT Sans",hjust = 1),
plot.background = element_rect(fill="#F2F2F2"),
legend.position = "bottom",
legend.background = element_rect(fill="#F2F2F2"),
legend.text = element_text(family="PT Sans"),
legend.title = element_text(family = "PT Sans")) +
labs(x=NULL,y="# of Nights Lit Red",title = "Months the NC State Belltower is lit",
subtitle = "(2011-2018)",fill="Occasion for Celebration") +
scale_fill_manual(values = c("#990000","#D14905","#FDD726","#6F7D1C","#427E93","#4156A1"))
```
## What is the longest drought between celebrations?
Since 2010, what's the longest time the Belltower has gone without being lit?
```{r,echo=FALSE,message=FALSE,warning=FALSE}
lights_numbered <- lights %>% arrange(desc(date)) %>% mutate(numdate = as.numeric(date))
for (i in 1:length(lights_numbered$numdate)){
lights_numbered$gap[i]= lights_numbered$numdate[i] - lights_numbered$numdate[i+1]
}
lights_numbered <- lights_numbered %>% mutate(previous = as_date(numdate-gap)) %>% filter(!is.na(occasion))
lights_numbered %>% arrange(desc(gap)) %>% select(-numdate) %>% head(5) %>% knitr::kable()
```
In 2011, the Belltower underwent construction to prevent water seepage through its joints. Interesting too is that the Wolfpack Welcome Week tradition of Packapalooza has a reputation for ending droughts.
## What is the longest streak of Belltower lightings?
```{r, echo=FALSE,warning=FALSE}
lighted <- lights %>% distinct(date,.keep_all = TRUE) %>% arrange(desc(date)) %>% mutate(numdate = as.numeric(date))
for (i in 1:length(lighted$numdate)){
lighted$gap[i]= lighted$numdate[i] - lighted$numdate[i+1]
}
lighted %>% arrange(date) %>% mutate(gap = ifelse(gap==0,1,gap),
streak = rle(gap)$lengths %>% sequence(),
streak = ifelse(gap==1,streak+1,streak)) %>%
filter(gap==1,
!is.na(occasion)) %>%
arrange(desc(streak)) %>% select(-numdate,-gap) %>% head(10) %>% knitr::kable()
```
It's pretty unlikely to see the Belltower lit more than 3 consecutive days.
The NC State Belltower has a rich history and will continue to represent success for the Wolfpack nation.
The code for this blog can be found [here](https://github.com/StephonLEB/lookingatnumbers/blob/master/public/post/2019-04-10-light-it-red-exploring-bell-tower-celebrations-with-r.Rmd)
**Go Pack!!**
You can’t perform that action at this time.