https://github.com/tjmahr/bachfantasy

Plots for our Bachelorette fantasy league
https://github.com/tjmahr/bachfantasy

Last synced: 1 day ago
JSON representation

Plots for our Bachelorette fantasy league

• Host: GitHub
• URL: https://github.com/tjmahr/bachfantasy
• Owner: tjmahr
• License: gpl-3.0
• Created: 2017-05-24T00:59:18.000Z (over 7 years ago)
• Default Branch: master
• Last Pushed: 2017-06-07T02:32:32.000Z (over 7 years ago)
• Last Synced: 2025-01-04T01:05:25.911Z (8 days ago)
• Size: 82 KB
• Stars: 0
• Watchers: 3
• Forks: 0
• Open Issues: 0
• Metadata Files:
  • Readme: README.Rmd
  • License: LICENSE

Awesome Lists containing this project

README

        
---

title: "Bachelorette Fantasy League :rose:"

output: github_document

---

```{r setup, include=FALSE}

knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>")

```

## Get the data

Connect to Google Sheets and download the team rosters and the scores.

```{r, message = FALSE}

# Private file where I store the sheet-key 

source("sheet-key.R")

sheet <- googlesheets::gs_key(sheet_key)

teams <- googlesheets::gs_read_csv(sheet, "League Member Teams")

teams

scores <- googlesheets::gs_read_csv(sheet, "Contestant Scores")

scores

```

Create some mock data to prototype for future plots.

```{r}

# scores$Ep2 <- sample(scores$Ep1, replace = TRUE)

# scores$Ep3 <- sample(scores$Ep2, replace = TRUE)

```

Clean the scores into a long-format table.

```{r, message = FALSE}

library(tidyverse)

scores_long <- scores %>% 

  select(Contestant, starts_with("Ep")) %>% 

  # Remove weeks without scores

  select_if(function(xs) !all(is.na(xs))) %>% 

  # Convert to long format

  gather(Episode, Score, -Contestant) %>% 

  # Extract the number from the episode

  extract(Episode, into = c("Episode"), regex = "(\\d+)", convert = TRUE) %>% 

  # Replace NAs with 0s

  replace_na(replace = list(Score = 0))

# Add cumulative scores for each contestant

scores_long <- scores_long %>% 

  arrange(Contestant, Episode) %>% 

  group_by(Contestant) %>% 

  mutate(RunningScore = cumsum(Score)) %>% 

  ungroup()

```

Create a long-format table of the rosters.

```{r}

teams_long <- teams %>% 

  gather(Player, OnTeam, -Contestant) %>% 

  filter(!is.na(OnTeam)) %>% 

  select(Player, Contestant)

teams_long

```

Combine the rosters and the scores.

```{r}

league <- inner_join(teams_long, scores_long, by = "Contestant")

league_sums <- league %>% 

  group_by(Player, Episode) %>% 

  summarise(Score = sum(RunningScore))

```

## Plots

```{r, warning = FALSE}

library(hrbrthemes)

ggplot(league_sums) + 

  aes(x = Episode, y = Score, color = Player) + 

  geom_line() + 

  theme_ipsum_rc() + 

  scale_x_continuous(breaks = seq_len(max(league$Episode))) +

  labs(title = "Running scores")

knitr::kable(league_sums)

ggplot(league) + 

  aes(x = Episode, y = Score, group = Contestant) + 

  geom_line() + 

  facet_wrap("Player") +

  theme_ipsum_rc() + 

  labs(title = "Team performance", caption = "lines: individual contestants") +

  scale_x_continuous(breaks = seq_len(max(league$Episode)))

```