The GitHub repository for TidyTuesday was cloned from https://github.com/rfordatascience/tidytuesday, and the CSV file for 2/14/2023 was copied and pasted into the data folder of this portfolio.
library(tidyverse)── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
✔ ggplot2 3.4.0 ✔ purrr 1.0.1
✔ tibble 3.1.8 ✔ dplyr 1.0.10
✔ tidyr 1.2.1 ✔ stringr 1.5.0
✔ readr 2.1.3 ✔ forcats 0.5.2
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()data <- read_csv("data/age_gaps.csv")Rows: 1155 Columns: 13
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (6): movie_name, director, actor_1_name, actor_2_name, character_1_gend...
dbl (5): release_year, age_difference, couple_number, actor_1_age, actor_2_age
date (2): actor_1_birthdate, actor_2_birthdate
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(data)spc_tbl_ [1,155 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ movie_name : chr [1:1155] "Harold and Maude" "Venus" "The Quiet American" "The Big Lebowski" ...
$ release_year : num [1:1155] 1971 2006 2002 1998 2010 ...
$ director : chr [1:1155] "Hal Ashby" "Roger Michell" "Phillip Noyce" "Joel Coen" ...
$ age_difference : num [1:1155] 52 50 49 45 43 42 40 39 38 38 ...
$ couple_number : num [1:1155] 1 1 1 1 1 1 1 1 1 1 ...
$ actor_1_name : chr [1:1155] "Ruth Gordon" "Peter O'Toole" "Michael Caine" "David Huddleston" ...
$ actor_2_name : chr [1:1155] "Bud Cort" "Jodie Whittaker" "Do Thi Hai Yen" "Tara Reid" ...
$ character_1_gender: chr [1:1155] "woman" "man" "man" "man" ...
$ character_2_gender: chr [1:1155] "man" "woman" "woman" "woman" ...
$ actor_1_birthdate : Date[1:1155], format: "1896-10-30" "1932-08-02" ...
$ actor_2_birthdate : Date[1:1155], format: "1948-03-29" "1982-06-03" ...
$ actor_1_age : num [1:1155] 75 74 69 68 81 59 62 69 57 77 ...
$ actor_2_age : num [1:1155] 23 24 20 23 38 17 22 30 19 39 ...
- attr(*, "spec")=
.. cols(
.. movie_name = col_character(),
.. release_year = col_double(),
.. director = col_character(),
.. age_difference = col_double(),
.. couple_number = col_double(),
.. actor_1_name = col_character(),
.. actor_2_name = col_character(),
.. character_1_gender = col_character(),
.. character_2_gender = col_character(),
.. actor_1_birthdate = col_date(format = ""),
.. actor_2_birthdate = col_date(format = ""),
.. actor_1_age = col_double(),
.. actor_2_age = col_double()
.. )
- attr(*, "problems")=<externalptr> colnames(data) [1] "movie_name" "release_year" "director"
[4] "age_difference" "couple_number" "actor_1_name"
[7] "actor_2_name" "character_1_gender" "character_2_gender"
[10] "actor_1_birthdate" "actor_2_birthdate" "actor_1_age"
[13] "actor_2_age" Overall, it appears that the original data given by TidyTuesday is pretty clean already, so I will be modifying column order so that it feels easier to read across the variables. I will also be modifying gender for each character to read as “Male” or “Female” and marking each decade that the movie was released.
# Desired Order: Movie Name, Release Year, Director,
## Actor 1 Name, Actor 1 Birthdate, Actor 1 Age,
## Actor 2 Name, Actor 2 Birthdate, Actor 2 Age,
## Age Difference, Couple Number
data <- data %>%
# Actor 1
relocate(actor_1_name, .after = director) %>%
relocate(actor_1_birthdate, .after = actor_1_name) %>%
relocate(actor_1_age, .after = actor_1_birthdate) %>%
# Actor 2
relocate(actor_2_name, .after = actor_1_age) %>%
relocate(actor_2_birthdate, .after = actor_2_name) %>%
relocate(actor_2_age, .after = actor_2_birthdate) %>%
# Age Difference + Couple Number
relocate(age_difference, .after = actor_2_age) %>%
relocate(couple_number, .after = age_difference)data <- data %>%
mutate(character_1_gender = case_when(
character_1_gender == "man" ~ "Male",
character_1_gender == "woman" ~ "Female")) %>%
mutate(character_2_gender = case_when(
character_2_gender == "man" ~ "Male",
character_2_gender == "woman" ~ "Female"))data <- data %>%
mutate(Decade = case_when(
release_year >= 1930 & release_year < 1940 ~ "1930s",
release_year >= 1940 & release_year < 1950 ~ "1940s",
release_year >= 1950 & release_year < 1960 ~ "1950s",
release_year >= 1960 & release_year < 1970 ~ "1960s",
release_year >= 1970 & release_year < 1980 ~ "1970s",
release_year >= 1980 & release_year < 1990 ~ "1980s",
release_year >= 1990 & release_year < 2000 ~ "1990s",
release_year >= 2000 & release_year < 2010 ~ "2000s",
release_year >= 2010 & release_year < 2020 ~ "2010s",
release_year >= 2020 & release_year < 2030 ~ "2020s")) %>%
mutate(Decade_Numeric = case_when(
Decade == "1930s" ~ 1930,
Decade == "1940s" ~ 1940,
Decade == "1950s" ~ 1950,
Decade == "1960s" ~ 1960,
Decade == "1970s" ~ 1970,
Decade == "1980s" ~ 1980,
Decade == "1990s" ~ 1990,
Decade == "2000s" ~ 2000,
Decade == "2010s" ~ 2010,
Decade == "2020s" ~ 2020))data_summary <- do.call(cbind, lapply(data %>% select(
Decade_Numeric, release_year,
actor_1_age, actor_2_age,
age_difference, couple_number), summary))
data_summary <- data.frame(data_summary)
rmarkdown::paged_table(data_summary)Unfortunately, this feels like a poor view of the data…
ggplot(data, aes(x = release_year, y = age_difference)) +
geom_point() +
geom_line() +
geom_smooth(method = "loess", color = "red", fill = "red") +
geom_smooth(method = lm, color = "blue", fill = "blue") +
labs(x = "Age Difference", y = "Release Year",
title = "Age Difference by Release Year")`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
According to this graph, it does appear that age difference decreases as time passes. However, the lines become “messy” towards the end, so I will try to tackle this by grouping by decade.
data_2 <- data %>%
group_by(Decade) %>%
summarise(Decade_Numeric, release_year, Decade,
Average_Age_Difference_by_Decade =
mean(age_difference)) %>%
count(release_year, Decade,
Average_Age_Difference_by_Decade, Decade_Numeric)`summarise()` has grouped output by 'Decade'. You can override using the
`.groups` argument.ggplot(data = data_2, aes(x = Decade_Numeric, y = Average_Age_Difference_by_Decade)) +
geom_point() +
geom_line() +
geom_smooth() +
labs(x = "Decade", y = "Average Age Difference",
title = "Average Age Difference by Decade")`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Again, it seems that there is an overall decrease in age difference from the 1940s to about the year 2000, but we see age difference increasing once again from the 2000s onward.
# Character 1 Age
ggplot(data, aes(x = character_1_gender, y = actor_1_age)) +
geom_point() +
geom_line() +
geom_boxplot() +
labs(x = "Gender", y = "Age",
title = "Boxplot of Age by Gender for Character 1")
# Character 2 Age
ggplot(data, aes(x = character_2_gender, y = actor_2_age)) +
geom_point() +
geom_line() +
geom_boxplot() +
labs(x = "Gender", y = "Age",
title = "Boxplot of Age by Gender for Character 2")
Yes, it does appear that men are usually slightly older than women in these films.
ggplot(data, aes(x = couple_number, y = age_difference, group = couple_number)) +
geom_point() +
geom_line() +
geom_boxplot()
As we can see from the graph, the lower the couple number, the greater the age difference in general. It is interesting, though, that we see increasing age difference once again for couple numbers 6 and 7.