01-25-2022 Tidy Tuesday: Board Games
2022-01-25
The Data
This data comes from Tidy Tuesday 01/25/2022 and is about Board Game details + ratings. I just used the ratings data set though there is a lot of info in the details data set that would be cool to use. Also, as a caveat, this project was totally for fun (and out of boredom from a slew of covid-positive close contacts). So, actually making the board game plot was a little tedious and usually I would have strayed away from given it involved a lot of manual entry, but hey! right now I am made of time.
ratings <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-01-25/ratings.csv')
details <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-01-25/details.csv')ratings %>%
head()## # A tibble: 6 × 10
## num id name year rank average bayes_a…¹ users…² url thumb…³
## <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr>
## 1 105 30549 Pandemic 2008 106 7.59 7.49 108975 /boa… https:…
## 2 189 822 Carcassonne 2000 190 7.42 7.31 108738 /boa… https:…
## 3 428 13 Catan 1995 429 7.14 6.97 108024 /boa… https:…
## 4 72 68448 7 Wonders 2010 73 7.74 7.63 89982 /boa… https:…
## 5 103 36218 Dominion 2008 104 7.61 7.50 81561 /boa… https:…
## 6 191 9209 Ticket to Ride 2004 192 7.41 7.30 76171 /boa… https:…
## # … with abbreviated variable names ¹bayes_average, ²users_rated, ³thumbnailboard_games <- full_join(details, ratings, by = "id") %>%
select(-num.x, -num.y, -name)board_games %>%
head()## # A tibble: 6 × 29
## id primary descr…¹ yearp…² minpl…³ maxpl…⁴ playi…⁵ minpl…⁶ maxpl…⁷ minage
## <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 30549 Pandemic In Pan… 2008 2 4 45 45 45 8
## 2 822 Carcasso… Carcas… 2000 2 5 45 30 45 7
## 3 13 Catan In CAT… 1995 3 4 120 60 120 10
## 4 68448 7 Wonders You ar… 2010 2 7 30 30 30 10
## 5 36218 Dominion "… 2008 2 4 30 30 30 13
## 6 9209 Ticket t… With e… 2004 2 5 60 30 60 8
## # … with 19 more variables: boardgamecategory <chr>, boardgamemechanic <chr>,
## # boardgamefamily <chr>, boardgameexpansion <chr>,
## # boardgameimplementation <chr>, boardgamedesigner <chr>,
## # boardgameartist <chr>, boardgamepublisher <chr>, owned <dbl>,
## # trading <dbl>, wanting <dbl>, wishing <dbl>, year <dbl>, rank <dbl>,
## # average <dbl>, bayes_average <dbl>, users_rated <dbl>, url <chr>,
## # thumbnail <chr>, and abbreviated variable names ¹description, …
## # ℹ Use `colnames()` to see all variable namesTop 10 Board Games
top_10 <- ratings %>%
filter(users_rated > 866) %>%
arrange(desc(average)) %>%
slice(1:10)
top_10 <- left_join(top_10, details, by = "id") %>%
select(-num.x, -num.y, -primary, -boardgameimplementation, -boardgameexpansion, -boardgamefamily)top_10 %>%
glimpse()## Rows: 10
## Columns: 26
## $ id <dbl> 169427, 174430, 235802, 266507, 342942, 233078, 291…
## $ name <chr> "Middara: Unintentional Malum – Act 1", "Gloomhaven…
## $ year <dbl> 2019, 2017, 2018, 2019, 2021, 2017, 2020, 2020, 201…
## $ rank <dbl> 542, 1, 249, 30, 463, 5, 6, 38, 369, 3
## $ average <dbl> 8.84, 8.74, 8.74, 8.70, 8.70, 8.68, 8.68, 8.68, 8.6…
## $ bayes_average <dbl> 6.861, 8.511, 7.201, 7.843, 6.942, 8.262, 8.260, 7.…
## $ users_rated <dbl> 1581, 47827, 2100, 4935, 1495, 16025, 15918, 5373, …
## $ url <chr> "/boardgame/169427/middara-unintentional-malum-act-…
## $ thumbnail <chr> "https://cf.geekdo-images.com/hRuD1y5BxdNpssgBqamS0…
## $ description <chr> "Middara is a 1-4 player cooperative choose-your-ow…
## $ yearpublished <dbl> 2019, 2017, 2018, 2019, 2021, 2017, 2020, 2020, 201…
## $ minplayers <dbl> 1, 1, 1, 2, 1, 3, 1, 2, 1, 2
## $ maxplayers <dbl> 4, 4, 2, 4, 4, 6, 4, 6, 4, 4
## $ playingtime <dbl> 60, 120, 180, 120, 150, 480, 120, 200, 60, 120
## $ minplaytime <dbl> 60, 60, 60, 90, 90, 240, 30, 60, 60, 60
## $ maxplaytime <dbl> 60, 120, 180, 120, 150, 480, 120, 200, 60, 120
## $ minage <dbl> 15, 14, 12, 13, 14, 14, 14, 14, 14, 14
## $ boardgamecategory <chr> "['Adventure', 'Exploration', 'Fantasy', 'Fighting'…
## $ boardgamemechanic <chr> "['Action Points', 'Cooperative Game', 'Dice Rollin…
## $ boardgamedesigner <chr> "['Clayton Helme', 'Brooklynn Lundberg', 'Brenna Mo…
## $ boardgameartist <chr> "['Stephanie Gustafsson', 'Alex Hansen', 'Hector Se…
## $ boardgamepublisher <chr> "['Succubus Publishing']", "['Cephalofair Games', '…
## $ owned <dbl> 3667, 77758, 6139, 10263, 2461, 20542, 38398, 8959,…
## $ trading <dbl> 30, 648, 19, 49, 8, 120, 342, 28, 35, 128
## $ wanting <dbl> 255, 1346, 320, 530, 677, 986, 448, 773, 185, 1522
## $ wishing <dbl> 1774, 17658, 944, 4296, 4903, 8984, 6410, 5320, 896…top_10$rating_group <- cut(top_10$users_rated, 10)
top_10$avg_group <- cut(top_10$average, 10)library(RCurl)
library(grid)rating_list <- rep(unique(top_10$rating_group), 10)
avg_list <- rep(unique(unique(top_10$avg_group)), 10)top_10_mod <- top_10 %>%
select(name,rating_group, avg_group)df2 <- data.frame(matrix(c(rating_list, avg_list), nrow = 40, ncol = 2)) %>%
rename(rating_group = X1, avg_group = X2) %>%
mutate(name = NA) %>%
select(name, everything()) %>%
anti_join(top_10_mod, by = c("rating_group","avg_group"))## Warning in matrix(c(rating_list, avg_list), nrow = 40, ncol = 2): data length
## [90] is not a sub-multiple or multiple of the number of rows [40]df_new <- bind_rows(top_10_mod, df2)
df_new <- df_new %>%
mutate(name = case_when(
name == "Aeon's End: The New Age" ~ "Aeon's End: \n The New \n Age",
name == "Brass: Birmingham" ~ "Brass: \n Birmingham",
name == "Middara: Unintentional Malum – Act 1" ~ "Middara: \n Unintentional \n Malum \n – Act 1",
name == "Too Many Bones: Undertow" ~ "Too Many \n Bones: \n Undertow",
name == "Clank!: Legacy – Acquisitions Incorporated" ~ "Clank!: \n Legacy \n & \n Ark Nova",
name == "Twilight Imperium: Fourth Edition" ~ "Twilight \n Imperium & \n Gloomhaven: \n Jaws of \n the Lion",
name == "Eclipse: Second Dawn for the Galaxy" ~ "Eclipse: \n Second Dawn \n for the \n Galaxy",
TRUE ~ name
)) %>%
filter(name != "Ark Nova" & name != "Gloomhaven: Jaws of the Lion" | is.na(name))The Plot
library(ggstar)plot <- df_new %>%
ggplot(aes(x = rating_group, y = avg_group, fill = name))+
geom_tile(size = 0.5, color="black")+
geom_text(aes(label=name), size = 3, color = "white", fontface = "bold")+
geom_rect(xmin = 2.5, xmax = 3.5, ymin = 4.5, ymax = 5.5, alpha = .2, fill = "lightyellow", size = .5, color = "black")+
geom_rect(xmin = 2.5, xmax = 3.5, ymin = 3.5, ymax = 4.5, alpha = .2, fill = "lightyellow", size = .5, color = "black")+
annotate("text", x = 2, y=1, label = "Aeon's End: \n 8.67/10 stars \n & \n 1757 reviews", size = 3)+
annotate("text", x = 4, y=1, label = "Brass: \n Birmingham \n 8.66/10 stars \n & \n 25484 reviews", size = 3)+
annotate("text", x = 3, y=2, label = "Eclipse: \n 8.68/10 stars \n & \n 5373 reviews", size = 3)+
annotate("text", x = 4, y=2, label = "Twilight and \n Gloomhaven: Jaws \n 8.68/10 stars \n & \n Twilight: 16025 \n Gloomhaven: 15918 \n Reviews", size = 2)+
annotate("text", x = 3, y=5, label = "Middara: \n 8.84/10 stars \n & \n 1581 reviews", size = 3)+
annotate("text", x = 4, y=3, label = "Clank!: \n Legacy: \n 8.70/10 stars \n & \n 4935 reviews", size = 3)+
annotate("text", x = 2, y=3, label = "Ark Nova: \n 8.70/10 stars \n & \n 1495 reviews", size = 3)+
annotate("text", x = 3, y=4, label = "Gloomhaven: \n 8.74/10 stars \n & \n 47827 reviews", size = 3)+
annotate("text", x = 2, y=4, label = "Too Many \n Bones: \n 8.74/10 stars \n & \n 2100 reviews", size = 3)+
coord_equal()+
geom_star(x = 3, y = 3, fill = "orange", color = "orange", starshape = 1, size = 20, alpha = .8)+
geom_star(x = 2, y = 5, fill = "orange", color = "orange", starshape = 1, size = 20, alpha = .8)+
geom_rect(xmin = 3.5, xmax = 4.5, ymin = 4.5, ymax = 5.5, alpha = .2, fill = "lightblue1", size = .5, color = "black")+
annotate("text", x = 4, y=5, label = "FINISH!", size = 6, fontface = "bold", color = "blue")+
theme_minimal()+
theme(legend.position = "none", plot.title = element_text(face = "bold", size = 17), plot.title.position = "panel", axis.title = element_text(face = "bold"), axis.text = element_blank(), plot.background = element_rect(fill = "white"))+
scale_fill_brewer(palette = "Dark2", na.value = "white")+
ggtitle("Top 10 Board Games", subtitle = "Yellow = Best Board Game for Some Metric")+
xlab("Number of User Ratings (Increasing Left to Right)")+
ylab("Average User Rating (Increasing Bottom to Top)")+
labs(caption="Tidy Tuesday 01/25/2022 | Github: @scolando")plot
ggsave("boardgames.png", plot)## Saving 7 x 5 in imageExtraneous Code
library(png)
library(jpeg)## did not end up using this part, orginally the sqaures were going to have to game thumbnails via the urls included in the details data frame, but the resolution was terrible and it involved a lot of annotation to get them in -- that said totally welcome people with more willpower and better grob skills to try this out!
for(i in 1:10){
if(grepl("jpg", top_10$thumbnail[i]) == "TRUE"){
img <- readJPEG(getURLContent(top_10$thumbnail[i]))
img_new <- rasterGrob(img, interpolate=TRUE)
assign(paste0("image_",i),img_new)}
else{
img <- readPNG(getURLContent(top_10$thumbnail[i]))
img_new <- rasterGrob(img, interpolate=TRUE)
assign(paste0("image_",i),img_new)}
}praise::praise()## [1] "You are wondrous!"