if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse,
tidytuesdayR,
ggtext,
showtext,
patchwork,
janitor, #for clean_names()
scales,
htmltools, #for tagList()
glue,
here,
stopwords,
tidytext #for text management
)
font_add_google("Charm")
showtext_auto()tt_year <- 2020
tt_week <- 40
tuesdata <- tidytuesdayR::tt_load(tt_year, week = tt_week)
beyonce_lyrics <- tuesdata$beyonce_lyrics
taylor_swift_lyrics <- tuesdata$taylor_swift_lyricsbeyonce_lyrics %>%
glimpse()Rows: 22,616
Columns: 6
$ line <chr> "If I ain't got nothing, I got you", "If I ain't got somet…
$ song_id <dbl> 50396, 50396, 50396, 50396, 50396, 50396, 50396, 50396, 50…
$ song_name <chr> "1+1", "1+1", "1+1", "1+1", "1+1", "1+1", "1+1", "1+1", "1…
$ artist_id <dbl> 498, 498, 498, 498, 498, 498, 498, 498, 498, 498, 498, 498…
$ artist_name <chr> "Beyoncé", "Beyoncé", "Beyoncé", "Beyoncé", "Beyoncé", "Be…
$ song_line <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,…taylor_swift_lyrics %>%
glimpse()Rows: 132
Columns: 4
$ `Artist ` <chr> "Taylor Swift ", "Taylor Swift ", "Taylor Swift ", "Taylor S…
$ Album <chr> "Taylor Swift ", "Taylor Swift ", "Taylor Swift ", "Taylor S…
$ `Title ` <chr> "Tim McGraw", "Picture to Burn", "Teardrops on my Guitar ", …
$ Lyrics <chr> "He said the way my blue eyes shinx\nPut those Georgia stars…Stop words should be approached in a custom way given the context of the data. Because lyrics tend to use lots of traditional stop words that are meaningful to the song, I chose to only filter out stop words of three characters or less (using the snowball lexicon).
I’d like to visualize the bigrams, or word pairs, in their lyrics, excluding any that are repeated words. I also considered removing any numbers, but given that I plan to only visualize the top bigrams, these won’t be a factor.
tok_beyonce_lyrics <- beyonce_lyrics %>%
janitor::clean_names() %>%
tidytext::unnest_tokens(output = bigram,
input = line,
token = 'ngrams',
n = 2) %>%
distinct(bigram, song_id, .keep_all = TRUE) %>%
select(bigram, artist_name) %>%
separate(bigram, into = c('first', 'second'), sep=' ', remove=FALSE) %>%
left_join(stop_words_lyrics, by=c('first' = 'word')) %>%
left_join(stop_words_lyrics, by=c('second' = 'word')) %>%
mutate(first_stopword = if_else(is.na(lexicon.x), 0, 1),
second_stopword = if_else(is.na(lexicon.y), 0, 1)) %>%
filter(first_stopword == 0 & second_stopword == 0,
first != second,
!is.na(bigram)) %>%
select(-starts_with('lexicon'),
-ends_with('stopword')) %>%
janitor::tabyl(bigram) %>%
as.data.frame() %>%
mutate(artist_name = 'Beyoncé')
tok_taylor_swift_lyrics <- taylor_swift_lyrics %>%
janitor::clean_names() %>%
unnest_tokens(output = bigram,
input = lyrics,
token = 'ngrams',
n = 2) %>%
distinct(bigram, title, .keep_all = TRUE) %>%
select(bigram, artist_name = artist) %>%
separate(bigram, into = c('first', 'second'), sep=' ', remove=FALSE) %>%
left_join(stop_words_lyrics, by=c('first' = 'word')) %>%
left_join(stop_words_lyrics, by=c('second' = 'word')) %>%
mutate(first_stopword = if_else(is.na(lexicon.x), 0, 1),
second_stopword = if_else(is.na(lexicon.y), 0, 1)) %>%
filter(first_stopword == 0 & second_stopword == 0,
first != second) %>%
select(-starts_with('lexicon'),
-ends_with('stopword')) %>%
janitor::tabyl(bigram) %>%
as.data.frame() %>%
mutate(artist_name = 'Taylor Swift')my_theme <- theme(
# choose font family
text = element_text(family = 'Charm', size=14, color='gray98'),
axis.ticks = element_blank(),
plot.background = element_rect(fill = "gray20", color = "gray20"),
panel.background = element_rect(fill = "gray20", color = "gray20"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.line.x = element_line(color='gray98'),
axis.title.x = element_text(color='gray98'),
axis.text.y = element_blank(),
axis.text.x = element_text(color='gray98'),
legend.position = 'none')tswift_viz <- tok_taylor_swift_lyrics %>%
slice_max(percent, n=10) %>%
ggplot(.,
aes(x=percent,
y=reorder(bigram, percent))) +
geom_col(fill = 'cyan3') +
geom_text(aes(label = bigram),
hjust = 1.5,
size = 12,
color = 'gray98',
family = 'Charm',
fontface = 'bold') +
labs(x='Word Count (% of corpus)',
y='') +
scale_x_continuous(labels = percent) +
my_theme
beyonce_viz <- tok_beyonce_lyrics %>%
slice_max(percent, n=10) %>%
ggplot(.,
aes(x=percent,
y=reorder(bigram, percent))) +
geom_col(fill = 'green3') +
geom_text(aes(label = bigram),
hjust = 1.5,
size = 12,
color = 'gray98',
family = 'Charm',
fontface = 'bold') +
labs(x='Word Count (% of corpus)',
y='') +
scale_x_continuous(labels = percent) +
my_theme
p <- tswift_viz + beyonce_viz +
plot_annotation(title = glue("Most frequently used bigrams in <span style='color:cyan3'>**Taylor Swift**</span> and <span style='color:green3'>**Beyonce**</span> songs"),
subtitle = 'Top 10 bigrams by artist',
caption = '<br>Tidy Tuesday Week 40 (2020)<br>Created by @mickey_rafa',
theme = theme(plot.title = element_textbox_simple(size=rel(4), family='Charm',
face='bold', color='gray98',
margin = margin(t=10)),
plot.subtitle = element_textbox_simple(size=rel(2.5), family='Charm',
face='bold', color='gray98'),
plot.caption = element_textbox(size=rel(2), color='gray98',
family='Charm', lineheight=.3),
plot.background = element_rect(fill = "gray20", color = NA),
panel.background = element_rect(fill = "gray20"),
plot.margin = unit(c(0, 0, 0, 0), "pt")))# Save the plot as PNG
ggsave(
filename = glue("tt_{tt_year}_{tt_week}.png"),
plot = p,
width = 6, height = 4, units = "in", dpi = 320
)
# make thumbnail for page
magick::image_read(glue("tt_{tt_year}_{tt_week}.png")) %>%
magick::image_resize(geometry = "400") %>%
magick::image_write(glue("tt_{tt_year}_{tt_week}_thumbnail.png"))R version 4.4.0 (2024-04-24)
Platform: aarch64-apple-darwin20
Running under: macOS Sonoma 14.6.1
Matrix products: default
BLAS: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.0
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: America/Denver
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] tidytext_0.4.2 stopwords_2.3 here_1.0.1 glue_1.8.0
[5] htmltools_0.5.8.1 scales_1.3.0 janitor_2.2.0 patchwork_1.3.0
[9] showtext_0.9-7 showtextdb_3.0 sysfonts_0.8.9 ggtext_0.1.2
[13] tidytuesdayR_1.1.2 lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1
[17] dplyr_1.1.4 purrr_1.0.2 readr_2.1.5 tidyr_1.3.1
[21] tibble_3.2.1 ggplot2_3.5.1 tidyverse_2.0.0 pacman_0.5.1
loaded via a namespace (and not attached):
[1] gtable_0.3.5 xfun_0.48 httr2_1.0.5 htmlwidgets_1.6.4
[5] gh_1.4.1 lattice_0.22-6 tzdb_0.4.0 vctrs_0.6.5
[9] tools_4.4.0 generics_0.1.3 parallel_4.4.0 curl_5.2.3
[13] fansi_1.0.6 janeaustenr_1.0.0 pkgconfig_2.0.3 tokenizers_0.3.0
[17] Matrix_1.7-1 lifecycle_1.0.4 compiler_4.4.0 farver_2.1.2
[21] textshaping_0.4.0 munsell_0.5.1 snakecase_0.11.1 SnowballC_0.7.1
[25] yaml_2.3.10 crayon_1.5.3 pillar_1.9.0 magick_2.8.5
[29] commonmark_1.9.2 tidyselect_1.2.1 digest_0.6.37 stringi_1.8.4
[33] labeling_0.4.3 rprojroot_2.0.4 fastmap_1.2.0 grid_4.4.0
[37] colorspace_2.1-1 cli_3.6.3 magrittr_2.0.3 utf8_1.2.4
[41] withr_3.0.1 rappdirs_0.3.3 bit64_4.5.2 timechange_0.3.0
[45] rmarkdown_2.28 gitcreds_0.1.2 bit_4.5.0 ragg_1.3.3
[49] hms_1.1.3 evaluate_1.0.1 knitr_1.48 markdown_1.13
[53] rlang_1.1.4 gridtext_0.1.5 Rcpp_1.0.13 xml2_1.3.6
[57] vroom_1.6.5 rstudioapi_0.17.1 jsonlite_1.8.9 R6_2.5.1
[61] systemfonts_1.1.0