Assignment 5
Harold Nelson
10/28/2024
Human Mortality Database
This is an initial exploration of the Human Mortality Database, which is at https://www.mortality.org/.
Download the entire database and place it in your current working directory.
Setup
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(plotly)##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutUSAM Data
Load the data for USA males. Add a variable country and set it to “USA”.
Select country, Year, Age and qx.
Make Age numeric.
Eliminate any missing data.
Solution
USAM <- read_table("USA.mltper_1x1.txt", skip = 2) %>%
mutate(country = "USA") %>%
select(country, Year, Age, qx) %>%
mutate(Age = as.numeric(Age)) %>%
filter(Age < 85) %>%
rename(male_prob_death = qx) %>%
drop_na()##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## Year = col_double(),
## Age = col_character(),
## mx = col_double(),
## qx = col_double(),
## ax = col_double(),
## lx = col_double(),
## dx = col_double(),
## Lx = col_double(),
## Tx = col_double(),
## ex = col_double()
## )## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `Age = as.numeric(Age)`.
## Caused by warning:
## ! NAs introduced by coercionsummary(USAM)## country Year Age male_prob_death
## Length:7565 Min. :1933 Min. : 0 Min. :0.00010
## Class :character 1st Qu.:1955 1st Qu.:21 1st Qu.:0.00167
## Mode :character Median :1977 Median :42 Median :0.00457
## Mean :1977 Mean :42 Mean :0.01991
## 3rd Qu.:1999 3rd Qu.:63 3rd Qu.:0.02441
## Max. :2021 Max. :84 Max. :0.17284Canada
Do the same for Canada.
Solution
CANM <- read_table("CAN.mltper_1x1.txt", skip = 2) %>%
mutate(country = "Canada") %>%
select(country, Year, Age, qx) %>%
mutate(Age = as.numeric(Age)) %>%
filter(Age < 85) %>%
rename(male_prob_death = qx) %>%
drop_na()##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## Year = col_double(),
## Age = col_character(),
## mx = col_double(),
## qx = col_double(),
## ax = col_double(),
## lx = col_double(),
## dx = col_double(),
## Lx = col_double(),
## Tx = col_double(),
## ex = col_double()
## )## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `Age = as.numeric(Age)`.
## Caused by warning:
## ! NAs introduced by coercionCombine
Combine the two dataframes into USA_CANM using rbind().
Solution
USA_CANM = rbind(USAM, CANM)Male Infant Mortality USA and Canada
Produce a graph showing the probability of male death at age 0 for the USA and Canada. Use color to see two time-series plots. Create this graph beginning in 1940.
Solutiom
USA_CANM %>%
filter(Age == 0 & Year > 1940) %>%
ggplot(aes(x = Year, y = male_prob_death, color = country)) +
geom_point() +
ggtitle("Male Infant Mortality - USA and Canada")
USA/Canada 2
Create a graph comparing USA and Canadian male mortality at age 79.
Solution
USA_CANM %>%
filter(Age == 79 & Year > 1940) %>%
ggplot(aes(x = Year, y = male_prob_death, color = country)) +
geom_point() +
ggtitle("Age 79 Male Mortality - USA and Canada")
Task 1
Copy and modify the code above to produce USAF, CANF and USA_CANF. Do summaries to verify your work.
USAF <- read_table("USA.fltper_1x1.txt", skip = 2) %>%
mutate(country = "USA") %>%
select(country, Year, Age, qx) %>%
mutate(Age = as.numeric(Age)) %>%
filter(Age < 85) %>%
rename(female_prob_death = qx) %>%
drop_na()##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## Year = col_double(),
## Age = col_character(),
## mx = col_double(),
## qx = col_double(),
## ax = col_double(),
## lx = col_double(),
## dx = col_double(),
## Lx = col_double(),
## Tx = col_double(),
## ex = col_double()
## )## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `Age = as.numeric(Age)`.
## Caused by warning:
## ! NAs introduced by coercionsummary(USAF) ## country Year Age female_prob_death
## Length:7565 Min. :1933 Min. : 0 Min. :0.00008
## Class :character 1st Qu.:1955 1st Qu.:21 1st Qu.:0.00073
## Mode :character Median :1977 Median :42 Median :0.00298
## Mean :1977 Mean :42 Mean :0.01348
## 3rd Qu.:1999 3rd Qu.:63 3rd Qu.:0.01444
## Max. :2021 Max. :84 Max. :0.15084CANF <- read_table("CAN.fltper_1x1.txt", skip = 2) %>%
mutate(country = "Canada") %>%
select(country, Year, Age, qx) %>%
mutate(Age = as.numeric(Age)) %>%
filter(Age < 85) %>%
rename(female_prob_death = qx) %>%
drop_na()##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## Year = col_double(),
## Age = col_character(),
## mx = col_double(),
## qx = col_double(),
## ax = col_double(),
## lx = col_double(),
## dx = col_double(),
## Lx = col_double(),
## Tx = col_double(),
## ex = col_double()
## )## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `Age = as.numeric(Age)`.
## Caused by warning:
## ! NAs introduced by coercionsummary(CANF)## country Year Age female_prob_death
## Length:8670 Min. :1921 Min. : 0 Min. :0.000030
## Class :character 1st Qu.:1946 1st Qu.:21 1st Qu.:0.000650
## Mode :character Median :1972 Median :42 Median :0.003125
## Mean :1972 Mean :42 Mean :0.013531
## 3rd Qu.:1997 3rd Qu.:63 3rd Qu.:0.013325
## Max. :2022 Max. :84 Max. :0.159520USAF_CANF <- rbind(USAF, CANF)
summary(USAF_CANF)## country Year Age female_prob_death
## Length:16235 Min. :1921 Min. : 0 Min. :0.000030
## Class :character 1st Qu.:1950 1st Qu.:21 1st Qu.:0.000695
## Mode :character Median :1974 Median :42 Median :0.003070
## Mean :1974 Mean :42 Mean :0.013506
## 3rd Qu.:1998 3rd Qu.:63 3rd Qu.:0.013720
## Max. :2022 Max. :84 Max. :0.159520Task 2
Redo the graphs you produced above for females in the USA and Canada. Do you see the same patterns?
USAF_CANF <- rbind(USAF, CANF)
USAF_CANF %>%
filter(Age == 0 & Year > 1940) %>%
ggplot(aes(x = Year, y = female_prob_death, color = country)) +
geom_point() +
ggtitle("Female Infant Mortality - USA and Canada") +
labs(y = "Probability of Death at Age 0", x = "Year")
USAF_CANF %>%
filter(Age == 79 & Year > 1940) %>%
ggplot(aes(x = Year, y = female_prob_death, color = country)) +
geom_point() +
ggtitle("Age 79 Female Mortality - USA and Canada") +
labs(y = "Probability of Death at Age 79", x = "Year") 
Task 3: Male + Female
Combine USAM and USAF into USA. This new dataframe will have both male and female probabilities of death. Run a summary to verify your work.
USAM <- USAM %>% rename(prob_death = male_prob_death)
USAF <- USAF %>% rename(prob_death = female_prob_death)
USA <- rbind(USAM %>% mutate(gender = "Male"), USAF %>% mutate(gender = "Female"))
summary(USA)## country Year Age prob_death
## Length:15130 Min. :1933 Min. : 0 Min. :0.00008
## Class :character 1st Qu.:1955 1st Qu.:21 1st Qu.:0.00112
## Mode :character Median :1977 Median :42 Median :0.00369
## Mean :1977 Mean :42 Mean :0.01669
## 3rd Qu.:1999 3rd Qu.:63 3rd Qu.:0.01883
## Max. :2021 Max. :84 Max. :0.17284
## gender
## Length:15130
## Class :character
## Mode :character
##
##
## Task 4: The Ratio
Compute a new variable ratio. It is the ratio of the male probability of death to the female probability. For the year 2019, plot this ratio with Age on the horizontal axis. Use geom_point().
USA <- USA %>%
group_by(Age) %>%
mutate(ratio = ifelse(gender == "Male", prob_death / first(prob_death[gender == "Female"]), NA)) %>%
ungroup()
ratio_2019 <- USA %>% filter(Year == 2019)
ggplot(ratio_2019, aes(x = Age, y = ratio)) +
geom_point() +
ggtitle("Male to Female Probability of Death Ratio - 2019") +
labs(x = "Age", y = "Male/Female Probability Ratio") +
theme_minimal()## Warning: Removed 85 rows containing missing values or values outside the scale range
## (`geom_point()`).
Task 5: Comments
Describe what you saw in Task 4. How would you explain this?
#solution: As part of Task 4, I made a graph that displayed the 2019 male to female mortality ratio. This ratio varies with age, as the plot demonstrated. The ratio was near to 1 for younger ages, particularly in infancy and childhood, indicating that boys and girls had comparable mortality rates. However, the ratio rose with age, suggesting that men were more likely than women to die. According to this pattern, men may be at higher risk for health problems as they get older.
These patterns could be caused by a number of factors. Males may be biologically more susceptible to specific health problems, which can result in increased mortality rates. In addition, men may not seek medical attention as frequently as women do and frequently participate in risky behaviors. These disparities are also influenced by social variables, such as lifestyle choices and healthcare access. All things considered, the graph shows notable gender disparities in health outcomes, which are impacted by a combination of societal and biological factors.