ADD week 3

R/helpers.R

@@ -71,23 +71,25 @@ min_max <- function(x, a, b) {
 #'
 #' @return
 #' @export
-make_caption <- function(accent, data) {
+make_caption <- function(accent, bg, data) {
 
   if(length(accent) != 4) {
     accent <- rep(accent[1], 4)
   }
 
-  github <- glue("<span style='font-family:fa-brands; color:{accent[1]}'>&#xf09b;</span>")
-  twitter <- glue("<span style='font-family:fa-brands; color:{accent[2]}'>&#xf099;</span>")
-  threads <- glue("<span style='font-family:fa-brands; color:{accent[3]}'>&#xe618;</span>")
-  mastodon <- glue("<span style='font-family:fa-brands; color:{accent[4]}'>&#xf4f6;</span>")
-  bluesky <- glue("<span style='font-family:fa-brands; color:{accent[4]}'>&#xe671;</span>")
+  github <- glue("<span style='font-family:fa-brands; color:{accent}'>&#xf09b;</span>")
+  twitter <- glue("<span style='font-family:fa-brands; color:{accent}'>&#xf099;</span>")
+  threads <- glue("<span style='font-family:fa-brands; color:{accent}'>&#xe618;</span>")
+  mastodon <- glue("<span style='font-family:fa-brands; color:{accent}'>&#xf4f6;</span>")
+  bluesky <- glue("<span style='font-family:fa-brands; color:{accent}'>&#xe671;</span>")
+  linkedin <- glue("<span style='font-family:fa-brands; color:{accent}'>&#xf08c;</span>")
   floppy <- glue("<span style='font-family:fa-solid; color:{accent}'>&#xf0c7;</span>")
   space <- glue("<span style='color:{bg};font-size:1px'>'</span>")
   space2 <- glue("<span style='color:{bg}'>-</span>") # can't believe I'm doing this
   glue("
-       {github} doehm/tidytues
-       {bluesky} @danoehm.bsky.social
+       {github} {space2} doehm/tidytues {space2}
+       {bluesky} {space2} @danoehm.bsky.social {space2}
+       {linkedin} {space2} Dan Oehm
        ")
 }
 
@@ -111,9 +113,10 @@ to_pct <- function(x, digit) {
 #'
 #' @return
 #' @export
-make_image_small <- function(week, year = 2023) {
-  dir <- list.files("scripts/2023", pattern = as.character(week), full.names = TRUE)
-  files <- list.files(dir, pattern = ".png", full.names = TRUE)
+make_image_small <- function(week, year = 2025) {
+  week <- str_pad(week, width = 2, pad = "0")
+  dir <- list.files("scripts/2025/", pattern = as.character(week), full.names = TRUE)
+  files <- list.files(dir, pattern = "final", full.names = TRUE)
   files <- files[!str_detect(files, "-s.png")]
   new_file <- str_replace(files, ".png", "-s.png")
   walk2(files, new_file, ~{

README.Rmd

@@ -5,14 +5,26 @@ output:
 
 Click on header or the chart for the code.
 
+# 2025
+
+## [Week 3: Himalayan Expeditions](https://github.com/doehm/tidytues/blob/main/scripts/2025/03 - himalaya/himalaya.R)
+
+<a href='https://github.com/doehm/tidytues/blob/main/scripts/2025/03 - himalaya/himalaya.png'>
+  <img src='scripts/2025/03 - himalaya/himalaya-s.png'/></a>
+
 # 2024
 
-## [Week 49: Traffic](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-49-traffic/traffic.R)
+## [Week 50: The Scent of Data](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-50-perfume/perfume.R)
+
+<a href='https://github.com/doehm/tidytues/blob/main/scripts/2024/week-50-perfume/perfume-final.png'>
+  <img src='scripts/2024/week-50-perfume/perfume-final.png'/></a>
+
+## [Week 49: National Highways Traffic Flow](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-49-traffic/traffic.R)
 
 <a href='https://github.com/doehm/tidytues/blob/main/scripts/2024/week-49-traffic/traffic-final.png'>
   <img src='scripts/2024/week-49-traffic/traffic-final.png'/></a>
 
-## [Week 48: ](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-48-border-control/border-control.R)
+## [Week 48: Customs and Border Control](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-48-border-control/border-control.R)
 
 <a href='https://github.com/doehm/tidytues/blob/main/scripts/2024/week-48-border-control/border-control-final.png'>
   <img src='scripts/2024/week-48-border-control/border-control-final.png'/></a>

README.md

@@ -1,14 +1,26 @@
 
 Click on header or the chart for the code.
 
+# 2025
+
+## [Week 3: Himalayan Expeditions](https://github.com/doehm/tidytues/blob/main/scripts/2025/03%20-%20himalaya/himalaya.R)
+
+<a href='https://github.com/doehm/tidytues/blob/main/scripts/2025/03 - himalaya/himalaya.png'>
+<img src='scripts/2025/03 - himalaya/himalaya-s.png'/></a>
+
 # 2024
 
-## [Week 49: Traffic](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-49-traffic/traffic.R)
+## [Week 50: The Scent of Data](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-50-perfume/perfume.R)
+
+<a href='https://github.com/doehm/tidytues/blob/main/scripts/2024/week-50-perfume/perfume-final.png'>
+<img src='scripts/2024/week-50-perfume/perfume-final.png'/></a>
+
+## [Week 49: National Highways Traffic Flow](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-49-traffic/traffic.R)
 
 <a href='https://github.com/doehm/tidytues/blob/main/scripts/2024/week-49-traffic/traffic-final.png'>
 <img src='scripts/2024/week-49-traffic/traffic-final.png'/></a>
 
-## [Week 48:](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-48-border-control/border-control.R)
+## [Week 48: Customs and Border Control](https://github.com/doehm/tidytues/blob/main/scripts/2024/week-48-border-control/border-control.R)
 
 <a href='https://github.com/doehm/tidytues/blob/main/scripts/2024/week-48-border-control/border-control-final.png'>
 <img src='scripts/2024/week-48-border-control/border-control-final.png'/></a>

scripts/2024/week-50-perfume/perfume.R

@@ -0,0 +1,134 @@
+# https://github.com/rfordatascience/tidytuesday
+
+#
+
+library(tidyverse)
+library(showtext)
+library(patchwork)
+library(janitor)
+library(glue)
+library(ggtext)
+library(ggwordcloud)
+
+# 💾 load data ---------------------------------------------------------------
+
+df <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2024/2024-12-10/parfumo_data_clean.csv') |>
+  clean_names()
+
+# ✍️ fonts and palettes ------------------------------------------------------
+
+txt <- "grey20"
+sunset <- c("#355070", "#6d597a", "#b56576", "#e56b6f", "#eaac8b")
+perfume <- c("#EDE3E1", "#F3D9D7", "#F8CFCF", "#FCD7D8", "#FDE1E1", "#FCEBE9")
+font_add_google("Poppins", "pop", regular.wt = 200)
+ft <- "pop"
+pal <- perfume
+bg <- pal[3]
+showtext_auto()
+
+# 🤼 wrangle -----------------------------------------------------------------
+
+make_word_df <- function(df, x) {
+  tibble(
+    word = str_split(df[x], ", ") |>
+      reduce(c),
+    category = x
+  )
+}
+
+clean_brands <- function(x) {
+
+  id <- str_detect(x, "/")
+
+  ifelse(
+    id,
+    str_extract(x, ".+/") |>
+      str_remove_all("/") |>
+      str_trim(),
+    x
+  )
+
+}
+
+categories <- c("main_accords", "top_notes", "middle_notes", "base_notes")
+
+df_top_n <- df |>
+  filter(rating_count > 100) |>
+  arrange(desc(rating_value)) |>
+  slice_head(n = 50)
+
+df_word <- map_dfr(categories, ~make_word_df(df_top_n, .x)) |>
+  filter(!is.na(word)) |>
+  mutate(
+    word = str_remove_all(word, '"'),
+    word = str_remove_all(word, '\\n'),
+    word = tolower(word)
+    ) |>
+  count(category, word) |>
+  mutate(
+    word = str_to_sentence(word),
+    category = factor(category, levels = rev(c("main_accords", "base_notes", "middle_notes", "top_notes")))
+    ) |>
+  arrange(category, desc(n)) |>
+  group_by(category) |>
+  slice_head(n = 50)
+
+# 🔡 text --------------------------------------------------------------------
+
+
+# 📊 plot --------------------------------------------------------------------
+
+df_word |>
+  ggplot() +
+  geom_text_wordcloud(aes(label = word, size = n), family = ft, shape = "triangle-forward") +
+  scale_size_area(max_size = 60) +
+  facet_wrap(~category, ncol = 1) +
+  theme_void() +
+  theme(
+    text = element_text(family = ft, size = 32, lineheight = 0.3, colour = txt),
+    # plot.background = element_rect(fill = bg, colour = bg),
+    plot.title = element_text(size = 128, hjust = 0.5),
+    plot.subtitle = element_text(),
+    plot.caption = element_markdown(colour = txt, hjust = 0.5, margin = margin(t = 20)),
+    plot.margin = margin(b = 20, t = 50, r = 50, l = 50),
+    strip.text = element_blank()
+  )
+
+# save --------------------------------------------------------------------
+
+ggsave("scripts/2024/week-50-perfume/perfume.png", height = 16, width = 12)
+
+# bar chart of brands -----------------------------------------------------
+
+df |>
+  count(brand) |>
+  mutate(
+    brand = clean_brands(brand),
+    brand = fct_reorder(brand, n)
+  ) |>
+  arrange(desc(n)) |>
+  slice_head(n = 30) |>
+  ggplot() +
+  geom_col(aes(brand, n), fill = txt) +
+  scale_y_continuous(position = "right") +
+  coord_flip() +
+  theme_void() +
+  theme(
+    text = element_text(family = ft, size = 48, lineheight = 0.3, colour = txt),
+    # plot.background = element_rect(fill = bg, colour = bg),
+    plot.title = element_text(size = 128, hjust = 0.5),
+    plot.subtitle = element_text(),
+    plot.caption = element_markdown(colour = txt, hjust = 0.5, margin = margin(t = 20)),
+    plot.margin = margin(b = 20, t = 50, r = 50, l = 50),
+    strip.text = element_blank(),
+    axis.text.y = element_text(hjust = 1),
+    axis.line.x = element_line(),
+    axis.ticks = element_line(),
+    axis.ticks.length.x = unit(0.25, "cm"),
+    axis.text = element_text()
+  )
+
+# save --------------------------------------------------------------------
+
+ggsave("scripts/2024/week-50-perfume/brands.png", height = 12, width = 10)
+

scripts/2025/02 - posit-conf/posit-conf.R

@@ -0,0 +1,101 @@
+# https://github.com/rfordatascience/tidytuesday
+
+library(tidyverse)
+library(showtext)
+library(patchwork)
+library(janitor)
+library(glue)
+library(ggtext)
+library(ggchicklet)
+
+# 💾 load data ---------------------------------------------------------------
+
+conf2023 <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-01-14/conf2023.csv')
+conf2024 <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-01-14/conf2024.csv')
+
+# ✍️ fonts and palettes ------------------------------------------------------
+
+
+font_add("fa-brands", regular = "../../Assets/Fonts/fontawesome/webfonts/fa-brands-400.ttf")
+font_add("fa-solid", regular = "../../Assets/Fonts/fontawesome/webfonts/fa-solid-900.ttf")
+
+txt <- "grey20"
+bg <- "white"
+sunset <- c("#355070", "#6d597a", "#b56576", "#e56b6f", "#eaac8b")
+font_add_google("Poppins", "pop", regular.wt = 200)
+ft <- "pop"
+showtext_auto()
+
+# 🚙 functions ---------------------------------------------------------------
+
+first_name <- function(x) {
+  str_sub(x, 1, 1)
+}
+
+last_name <- function(x) {
+  map_chr(x, ~{
+    str_split_1(.x, " ") |>
+      tail(1) |>
+      str_sub(1,1)
+  })
+}
+
+# 🤼 wrangle -----------------------------------------------------------------
+
+df <- conf2023 |>
+  mutate(year = 2023) |>
+  bind_rows(
+    conf2024 |>
+      mutate(year = 2024)
+  ) |>
+  select(year, speaker_name) |>
+  mutate(
+    `First name` = first_name(speaker_name),
+    `Last name` = last_name(speaker_name)
+  ) |>
+  select(-speaker_name) |>
+  pivot_longer(-year, names_to = "name", values_to = "val") |>
+  group_by(year, name, val) |>
+  mutate(n = 1:n())
+
+# 🔡 text --------------------------------------------------------------------
+
+caption <- make_caption(txt)
+title <- "posit::conf()"
+subtitle <- str_wrap("Distribution of the first letter of the speaker's first and last name.
+2023 was the year of the J's and M's. 2024 was the year of the A's. There has yet
+to be a speaker with a name starting with a Q, X, or Y.", 110)
+
+# 📊 plot --------------------------------------------------------------------
+
+expand_grid(
+  year = c(2023, 2024),
+  name = c("First name", "Last name"),
+  val = LETTERS
+  ) |>
+  left_join(df, join_by(year, name, val)) |>
+  ggplot() +
+  geom_tile(aes(val, n, fill = n), width = 0.9, height = 0.9) +
+  scale_fill_gradientn(colours = sunset) +
+  facet_grid(year ~ name) +
+  labs(
+    title = title,
+    subtitle = subtitle,
+    caption = caption
+  ) +
+  theme_void() +
+  theme(
+    text = element_text(family = ft, size = 32, lineheight = 0.3, colour = txt),
+    plot.background = element_rect(fill = bg, colour = NA),
+    plot.title = element_text(size = 128, hjust = 0.5, face = "bold", margin = margin(b = 10)),
+    plot.subtitle = element_text(hjust = 0, margin = margin(b = 20), size = 48),
+    plot.caption = element_markdown(colour = txt, hjust = 0.5, margin = margin(t = 20)),
+    plot.margin = margin(b = 20, t = 50, r = 50, l = 50),
+    legend.position = "none",
+    panel.spacing = unit(1, "cm"),
+    axis.text.x = element_text(margin = margin(t = 5)),
+    strip.text = element_text(size = 48)
+  )
+
+ggsave("scripts/2025/02-posit-conf/posit-conf.png", height = 10, width = 12)
+