2022_09_06_legos.Rmd

---
title: "Legos"
date: 2022-09-06
output: html_output
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)

library(tidyverse)
library(tidytuesdayR)
library(scales)
theme_set(theme_light())

```

```{r Load}

inventories <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-09-06/inventories.csv.gz')
inventory_sets <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-09-06/inventory_sets.csv.gz')
sets <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-09-06/sets.csv.gz')
```

```{r}
inventories %>%
  count(set_num, sort = TRUE)

inventory_sets

lego_datasets <- tibble(file = dir("lego-data", full.names = TRUE)) %>%
  mutate(data = map(file, read_csv)) %>%
  extract(file, "name", "legos/(.*).csv.gz") %>%
  deframe()

lego_datasets$sets

lego_datasets$sets %>%
  ggplot(aes(year)) +
  geom_histogram()

lego_datasets$sets %>%
  count(year) %>%
  ggplot(aes(year, n)) +
  geom_col() +
  labs(y = "# of LEGO sets")

lego_datasets$sets %>%
  group_by(name) %>%
  summarize(n_sets = n(),
            year_first = min(year),
            year_last = max(year)) %>%
  arrange(desc(n_sets))

sets_with_themes <- lego_datasets$sets %>%
  left_join(lego_datasets$themes %>%
              select(id, theme_name = name),
            by = c(theme_id = "id")) %>%
  mutate(num_parts = na_if(num_parts, 0))

sets_with_themes %>%
  count(theme_name, sort = TRUE) %>%
  head(25) %>%
  mutate(theme_name = fct_reorder(theme_name, n)) %>%
  ggplot(aes(n, theme_name)) +
  geom_col() +
  labs(x = "# of sets",
       y = "",
       title = "Most common LEGO themes")

sets_with_themes %>%
  filter(num_parts == 0)

by_theme <- sets_with_themes %>%
  group_by(theme_name) %>%
  summarize(n_sets = n(),
            median_parts = median(num_parts, na.rm = TRUE)) %>%
  arrange(desc(n_sets))

by_theme %>%
  filter(n_sets >= 75) %>%
  ggplot(aes(n_sets, median_parts)) +
  geom_point() +
  geom_text(aes(label = theme_name), hjust = 1, vjust = 1,
            check_overlap = TRUE) +
  scale_x_log10() +
  scale_y_log10() +
  expand_limits(x = 30)

by_theme %>%
  head(25) %>%
  mutate(theme_name = fct_reorder(theme_name, median_parts)) %>%
  ggplot(aes(median_parts, theme_name)) +
  geom_col() +
  labs(title = "What are the most/least complex themes?",
       subtitle = "Among the 25 themes with the most sets",
       x = "Median # of parts in a set",
       y = "")

sets_with_themes %>%
  filter(fct_lump(theme_name, 25) != "Other") %>%
  mutate(theme_name = fct_reorder(theme_name, num_parts, na.rm = TRUE)) %>%
  ggplot(aes(num_parts, theme_name)) +
  geom_boxplot() +
  scale_x_log10() +
  labs(x = "# of parts",
       y = "",
       title = "What are the most/least complex themes?",
       subtitle = "Among the 25 themes with the most sets")
```

Have sets been getting more complicated over time?

```{r}
sets_with_themes %>%
  group_by(decade = 10 * (year %/% 10)) %>%
  summarize(n_sets = n(),
            median_num_parts = median(num_parts, na.rm = TRUE))

sets_with_themes %>%
  mutate(decade = 10 * (year %/% 10)) %>%
  ggplot(aes(decade, num_parts, group = decade)) +
  geom_boxplot() +
  geom_jitter(height = 0, width = 3, alpha = .1) +
  scale_y_log10()

sets_with_themes %>%
  filter(theme_name == "Star Wars") %>%
  mutate(decade = 10 * (year %/% 10)) %>%
  ggplot(aes(decade, num_parts, group = decade)) +
  geom_boxplot() +
  geom_jitter(height = 0, width = 3, alpha = .1) +
  scale_y_log10()
```

- Colors (common colors, colors associated with themes, colors appearing together in sets)
- Part categories 

```{r}
# Most recent version of each inventory for each set_num
inventories_current <- lego_datasets$inventories %>%
  arrange(desc(version)) %>%
  distinct(set_num, .keep_all = TRUE) %>%
  select(inventory_id = id, set_num)

set_parts <- sets_with_themes %>%
  inner_join(inventories_current, by = "set_num") %>%
  inner_join(lego_datasets$inventory_parts, by = "inventory_id", suffix = c("", "_inventory")) %>%
  left_join(lego_datasets$colors %>%
              rename(color = name), by = c(color_id = "id")) %>%
  mutate(rgb = paste0("#", rgb))

set_parts %>%
  count(color = fct_lump(color, 16),
        rgb = fct_lump(rgb, 16),
        sort = TRUE) %>%
  filter(color != "Other") %>%
  mutate(color = fct_reorder(color, n)) %>%
  ggplot(aes(n, color, fill = I(rgb))) +
  geom_col() +
  labs(x = "# of parts with this color",
       y = "")
```

```{r}
library(tidytext)

by_theme_color <- set_parts %>%
  count(theme_name,
        color = fct_lump(color, 20),
        rgb = fct_lump(rgb, 20),
        sort = TRUE) %>%
  filter(color != "Other")

by_theme_color %>%
  filter(theme_name %in% c("Star Wars", "Batman", "Harry Potter", "Christmas")) %>%
  # mutate(color = fct_reorder(color, n)) %>%
  mutate(color = reorder_within(color, n, theme_name)) %>%
  ggplot(aes(n, color, fill = I(rgb))) +
  geom_col() +
  facet_wrap(~ theme_name, scales = "free") +
  scale_y_reordered() +
  labs(x = "# of parts with this color",
       y = "") +
  theme(axis.text.y = element_blank())

by_theme_color %>%
  filter(fct_lump(theme_name, 30) != "Other") %>%
  ggplot(aes(n, theme_name, fill = I(rgb))) +
  geom_col(position = "fill") +
  labs(x = "% of parts in this theme",
       y = "")

library(widyr)

# Most similar palettes
by_theme_color %>%
  filter(fct_lump(theme_name, 50) != "Other") %>%
  mutate(color = as.character(color),
         n = log2(n)) %>%
  pairwise_cor(theme_name, color, n, sort = TRUE) %>%
  filter(item1 == "Batman")
```

```{r}
set_parts %>%
  count(year,
        rgb,
        sort = TRUE) %>%
  complete(year, rgb, fill = list(n = 0)) %>%
  ggplot(aes(year, n, fill = I(rgb))) +
  geom_area(position = position_fill(reverse = TRUE)) +
  scale_y_continuous(labels = percent_format()) +
  labs(x = "Year",
       y = "% of parts with this color") +
  theme_minimal() +
  theme(panel.grid = element_blank())
```