2 Visualizing the data
Note
Again, please note that data paths are relative to the root of the GitHub repository
Warning
This chapter requires data from Section 1.2 to be loaded!
## extra packages
require(ggimage)
require(packcircles)
require(ggrepel)
require(cowplot)
The most worn looks
Code
## map hex colour to outfit
<- unique(surpriseSongsDressColours %>% select(DressName, ColourHex1))
dressColorMapping <- setNames(dressColorMapping$ColourHex1, dressColorMapping$DressName)
colorPaletteDresses <- "dress_images/images_high_res/cropped/"
pathToDressColours ## map outfits to the corresponding images
%>%
oneRowPerConcert count(DressName) %>%
mutate(
percentage = n / sum(n) * 100,
imagePath = case_when(
== "Pink" ~paste0(pathToDressColours, "pink.jpg"),
DressName == "Green" ~paste0(pathToDressColours, "green.jpg"),
DressName == "Yellow" ~paste0(pathToDressColours, "yellow.jpg"),
DressName == "Blue" ~paste0(pathToDressColours, "blue.jpg"),
DressName == "Flamingo pink" ~ paste0(pathToDressColours,"flamingo_pink.jpg"),
DressName == "Ocean blue" ~ paste0(pathToDressColours,"ocean_blue.jpg"),
DressName == "Sunset orange" ~ paste0(pathToDressColours,"sunset_orange.jpg"),
DressName == "Cotton candy" ~paste0(pathToDressColours, "cotton_candy.jpg"),
DressName == "Blurple" ~paste0(pathToDressColours, "blurple.jpg"),
DressName == "Grapefruit" ~ paste0(pathToDressColours,"grapefruit.jpg"),
DressName == "Popsicle" ~ paste0(pathToDressColours,"popsicle.jpg"),
DressName TRUE ~ NA_character_
-> outfits
))
## barchart
ggplot(outfits, aes(x = reorder(DressName, -n), y = n, fill = DressName)) +
geom_bar(stat = "identity", width = 0.8) +
geom_image(
aes(image = imagePath, y = n),
size = 0.15,
by = "height"
+
) geom_text(
aes(y = n + 3.8, label = paste0(n, "\n(", round(percentage, 1), "%)")),
vjust = 0,
color = "black",
size = 4
+
) scale_fill_manual(values = colorPaletteDresses) +
theme_minimal() +
labs(title = "", x = "", y = "") +
theme(
axis.text.x = element_text(angle = 45, hjust = 1, size = 14),
axis.text.y = element_text(size = 14),
plot.title = element_text(hjust = 0.5, size = 16),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none"
+ ylim(0, 35) )
Eras’ Outfits and Special Events
Code
<- surpriseSongsDressColours %>%
dress_first_appearance group_by(DressName) %>%
summarize(FirstAppearance = min(Date)) %>%
arrange((FirstAppearance))
$DressName <- factor(surpriseSongsDressColours$DressName,
surpriseSongsDressColourslevels = dress_first_appearance$DressName)
<- length(unique(surpriseSongsDressColours$DressName))
max_dress_level <- levels(factor(surpriseSongsDressColours$DressName))
dress_levels $DressName <- factor(outfits$DressName, levels = dress_levels)
outfits
<- ggplot(surpriseSongsDressColours, aes(x = as.Date(Date), y = DressName, color = ColourHex1)) +
main_plot geom_point(size = 4, alpha = 1) +
scale_color_identity() +
theme_minimal() +
labs(title = "", x = "", y = "" ) +
geom_rect(aes(xmin = as.Date("2023-08-28"), xmax = as.Date("2023-11-08"),
ymin = -Inf, ymax = Inf), fill = "gray", alpha = 0.01, color = NA) +
geom_rect(aes(xmin = as.Date("2023-11-27"), xmax = as.Date("2024-02-06"),
ymin = -Inf, ymax = Inf), fill = "gray", alpha = 0.01, color = NA) +
geom_rect(aes(xmin = as.Date("2024-03-10"), xmax = as.Date("2024-05-08"),
ymin = -Inf, ymax = Inf), fill = "gray", alpha = 0.01, color = NA) +
geom_rect(aes(xmin = as.Date("2024-08-21"), xmax = as.Date("2024-10-17"),
ymin = -Inf, ymax = Inf), fill = "gray", alpha = 0.01, color = NA) +
## Vertical lines for the key events
geom_vline(xintercept = as.Date("2024-05-09"), linetype = "dashed", color = "black") +
geom_vline(xintercept = as.Date("2023-03-17"), linetype = "dashed", color = "black") +
geom_vline(xintercept = as.Date("2024-10-18"), linetype = "dashed", color = "black") +
geom_vline(xintercept = as.Date("2023-08-24"), linetype = "dashed", color = "black") +
geom_vline(xintercept = as.Date("2024-02-07"), linetype = "dashed", color = "black") +
geom_vline(xintercept = as.Date("2024-04-16"), linetype = "solid", color = "darkgray", linewidth = 2) +
## Changed to 16 (the right day is 19th) for vis requirements
geom_vline(xintercept = as.Date("2023-07-07"), linetype = "solid", color = "purple", linewidth = 2) +
geom_vline(xintercept = as.Date("2023-10-27"), linetype = "solid", color = "blue", linewidth = 2) +
## Text annotations for the events above
annotate("text", x = as.Date("2024-05-09"), y = max_dress_level,
label = "Europe¹", color = "black", angle = -90, vjust = -0.5,
size = 5) +
annotate("text", x = as.Date("2023-03-17"), y = max_dress_level,
label = "United\nStates¹", color = "black", angle = -90, vjust = -0.2,
size = 5) +
annotate("text", x = as.Date("2024-10-18"), y = max_dress_level,
label = "North \nAmerica¹", color = "black", angle = -90, vjust = -0.2,
size = 5) +
annotate("text", x = as.Date("2023-08-24"), y = max_dress_level,
label = "Latin \nAmerica¹", color = "black", angle = -90, vjust = -0.2,
size = 5) +
annotate("text", x = as.Date("2024-02-07"), y = max_dress_level,
label = "Asia/\nOceania¹", color = "black", angle = -90, vjust = -0.2,
size = 5) +
annotate("text", x = as.Date("2024-04-16"), y = max_dress_level,
label = "TTPD²", color = "darkgray", angle = -90, vjust = -0.5,
size = 5) +
annotate("text", x = as.Date("2023-07-07"), y = max_dress_level,
label = "Speak\nNow TV²", color = "purple", angle = -90, vjust = -0.2,
size = 5) +
annotate("text", x = as.Date("2023-10-27"), y = max_dress_level,
label = "1989\nTV²", color = "blue", angle = -90, vjust = -0.2,
size = 5) +
scale_x_date(date_labels = "%b %Y", date_breaks = "3 months") +
theme(axis.text.x = element_text(angle = 0, hjust = 1, size = 14),
axis.text.y = element_text(size = 14, hjust = 0),
plot.title = element_text(hjust=0.5, size = 14, margin = margin(b = 20), face = "bold"),
plot.margin = margin(t = -7, r = 0, b = 10, l = 0),
text = element_text(color = "black", size = 14))
<- ggplot(outfits, aes(x = n, y = DressName, fill = DressName)) +
count_plot geom_bar(stat = "identity", width = 0.8) +
geom_image(
aes(image = imagePath, x = n),
size = 0.09,
nudge_x = 2,
by = "height"
+
) geom_text(
aes(x = n + 3, label = paste0(n, " (", round(percentage, 1), "%)")),
hjust = 0,
nudge_x = 3,
color = "black",
size = 5
+
) scale_fill_manual(values = colorPaletteDresses) +
theme_minimal() +
labs( title = "",x = "", y = "") +
theme(
axis.text.y = element_blank(),
axis.text.x = element_blank(),
plot.title = element_text(hjust = 0.5, size = 12),
legend.position = "none",
plot.margin = margin(t = -7, r = 0, b = 10, l = 0),
text = element_text(color = "black", size = 14)
+ xlim(0, 50)
)
<- plot_grid(
merged_plot
count_plot, main_plot,ncol = 2,
align = "h",
axis = "tb",
rel_widths = c(1.5, 3))
<- ggdraw() +
title_with_subtitle draw_label(
"She Was Screaming Color",
size = 20,
y = 0.55,
hjust = 0.5
+
) draw_label(
"Frequency and Timeline of Taylor Swift's Dress Colors Across Tour Legs¹ and Album Releases²",
size = 16,
y = 0.1,
hjust = 0.5)
plot_grid(
title_with_subtitle, merged_plot,ncol = 1,
rel_heights = c(0.2, 2))
Surprise song color groups
Code
$groupName <- sapply(surpriseSongsDressColours$DressName, function(color) {
surpriseSongsDressColoursif (color %in% c("Pink", "Flamingo pink")) return("reds")
if (color %in% c("Green")) return("greens")
if(color %in% c("Yellow", "Sunset orange")) return("yellows")
if (color %in% c("Ocean blue", "Blue", "Blurple")) return ("blues")
if (color %in% c("Popsicle", "Cotton candy", "Grapefruit")) return ("colorful")
return("Neutral")
})
<- surpriseSongsDressColours %>%
songs_with_single_color_group group_by(`Song title`) %>%
summarize(
total_performances = n(),
unique_color_groups = n_distinct(groupName),
color_group = first(groupName)
%>%
) filter(unique_color_groups == 1, total_performances > 1) %>%
arrange(desc(total_performances))
<- surpriseSongsDressColours %>%
single_color_performances filter(`Song title` %in% songs_with_single_color_group$`Song title`)
## pics
<- paste("dress_images/images_high_res/cropped/", c("blue", "ocean_blue", "blurple"), ".jpg", sep = "")
blues <- paste("dress_images/images_high_res/cropped/", c("pink", "flamingo_pink"), ".jpg", sep = "")
reds <- paste("dress_images/images_high_res/cropped/", c("yellow", "sunset_orange"), ".jpg", sep = "")
yellows
<- circleProgressiveLayout(table(single_color_performances$groupName),
coords sizetype = 'area')
$id <- names(table(single_color_performances$groupName))
coords<- circleLayoutVertices(coords, npoints = 8, id = 4)
df.gg <- single_color_performances %>% select('Song title', groupName) %>%
snames group_by(`Song title`) %>% mutate(count = n()) %>% ungroup() |> unique()
set.seed(1984) ## for jitter repel
<- ggplot() + theme_void() +
plot ## blues
geom_polygon(data = df.gg[df.gg$id == "blues",], aes(x = x, y = y),
fill = "#0000FF", alpha = 0.05) +
geom_text_repel(aes(x = coords$x[1],
y = coords$y[1],
label = snames$`Song title`[snames$groupName == "blues"]),
col = "#0000FF", nudge_y = -1.1, nudge_x = 0.1, segment.color = NA,
size = 1.5*snames$count[snames$groupName == "blues"], box.padding = 0.1) +
## reds
geom_polygon(data = df.gg[df.gg$id == "reds",], aes(x = x, y = y),
fill = "#FF0000", alpha = 0.05) +
geom_text_repel(aes(x = coords$x[2],
y = coords$y[2],
label = snames$`Song title`[snames$groupName == "reds"]),
col = "#FF0000", nudge_y = -0.9, nudge_x = 0.1, segment.color = NA,
size = 1.5*snames$count[snames$groupName == "reds"], box.padding = 0.1) +
## yellows
geom_polygon(data = df.gg[df.gg$id == "yellows",], aes(x = x, y = y),
fill = "#FFD700", alpha = 0.05) +
geom_text_repel(aes(x = coords$x[3],
y = coords$y[3],
label = snames$`Song title`[snames$groupName == "yellows"]),
col = "#FFD700", nudge_y = 1.4, nudge_x = 0, segment.color = NA,
size = 1.5*snames$count[snames$groupName == "yellows"], box.padding = 0.1)
## image sizes relative to
## table(single_color_performances$DressName, single_color_performances$groupName)
set.seed(1984) ## for jitter repel
ggdraw() +
draw_plot(plot) +
draw_image(blues[1], -0.37, 0.23, scale = 0.5/3) +
draw_image(blues[2], -0.2, 0.32, scale = 0.8/3) +
draw_image(blues[3], -0.07, 0.26, scale = 0.4/3) +
draw_image(reds[1], 0.1, 0.27, scale = 0.8/3) +
draw_image(reds[2], 0.3, 0.33, scale = 0.7/3) +
draw_image(yellows[1], -0.1, -0.25, scale = 0.7/3) +
draw_image(yellows[2], 0.1, -0.3, scale = 1.1/3)