Model Critique
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.4
## ✔ ggplot2 3.4.3 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.0## ── 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(gapminder)
library(ggthemes)
gapminder_raw <- gapminder_unfilteredgapminder_raw <- gapminder_unfiltered
gapminder <- gapminder_unfiltered |>
rename(life_exp = "lifeExp",
population = "pop",
gdp_per_cap = "gdpPercap") |>
mutate(years_since = year(now()) - year)For this lab, you’ll be working with a group of other classmates, and each group will be assigned a lab from a previous week. Your goal is to critique the models (or analyses) present in the lab.
First, review the materials from the Lesson on Ethics and Epistemology (week 5?). This includes lecture slides, the lecture video, or the reading. You can use these as reference materials for this lab. You may even consider the reading for the week associated with the lab, or even supplementary research on the topic at hand (e.g., news outlets, historical articles, etc.).
For the lab your group has been assigned, consider issues with models, interpretations, analyses, visualizations, etc. Use this notebook as a sandbox for trying out different code, and investigating the data from a different perspective. Take notes on all the issues you see, and possible solutions (even if you would need to request more data or resources to accomplish those solutions).
Share your model critique in this notebook as your data dive submission for the week.
As a start, think about the context of the lab and consider the following:
Analytical issues, such as model assumptions
Overcoming biases (existing or potential)
Possible risks or societal implications
Crucial issues which might not be measurable
Treat this exercise as if the analyses in your assigned lab
(i.e., the one you are critiquing) were to be published, made available
to the public in a press release, or used at some large company (e.g.,
for mpg data, imagine if Toyota used the conclusions to
drive strategic decisions).
First Critique:
oom_breaks <- 10 ^ c(4, 5, 6, 7, 8, 9, 10)
oom_labels <- c(">10K", ">100K", ">1M", ">10M", ">100M", ">1B")
gapminder <-
gapminder |>
mutate(pop_oom = cut(population, breaks = oom_breaks,
labels = oom_labels, right = TRUE))#original code
plot_data <-
gapminder %>%
filter(country == "Portugal")
plot_data %>%
ggplot(mapping = aes(x = population, y = life_exp)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Population", y = "Life Expectancy",
title = "Life Expectancy as Population Increases",
subtitle = paste("Covariance:",
round(cov(plot_data$population,
plot_data$life_exp), 2),
"\nPearson Correlation:",
round(cor(plot_data$population,
plot_data$life_exp), 2))) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
#altered code
plot_data <-
gapminder
plot_data |>
ggplot(aes(x = population, y = life_exp)) +
geom_point(aes(color = country)) +
scale_color_manual(values = c ("United States" = "pink", "China" = "yellow", "India" = "purple")) +
#geom_smooth(method = "lm", se = FALSE) +
labs(x = "Population", y = "Life Expectancy",
title = "Life Expectancy as Population Increases",
subtitle = paste("Covariance:", round(cov(plot_data$population,
plot_data$life_exp), 2))) +
theme_minimal()
Adding a line to this model to show the linear trend is beneficial to creating the model for this data. We had more ethical issues than technical with this chart. We also thought that this was an unusual chart to create because the life expectancy of a country is dependent on more than just the population. It might have been better to use multivariate regression to consider other variables that might affect life expectancy, such as GDP, obesity rate, healthcare availability, and access to technology. We would need more information to perform a well rounded multivariate regression.
Correlation does not equal causation. Adding 1,000 people to your population will probably not increase your life expectancy.
Second Critique
gapminder <-
gapminder |>
group_by(continent, year) |>
mutate(pop_median = median(population),
pop_half = ifelse(population >= median(population),
"upper half",
"lower half")) |>
ungroup()# plotting just for a randomly selected year
plot_year <- sample(gapminder$year, 1)
gapminder |>
filter(year == plot_year) |>
ggplot() +
geom_point(mapping = aes(x = population,
y = continent,
colour = pop_half)) +
scale_x_log10() +
scale_colour_brewer(palette = "Dark2") +
theme_hc() +
labs(title = paste("Population 50th percentiles for the year", plot_year))
library(ggrepel)
gap_by_year <- gapminder %>%
group_by(year) %>%
summarise(year_count = n())
gap_by_year %>%
ggplot() +
geom_line(mapping = aes(x = year,y = year_count)) +
geom_text_repel(
data = subset(gap_by_year, year_count > 100),
aes(x=year, y=year_count, label = year),
size = 3,
point.padding = 0.2,
nudge_x = .3,
segment.curvature = -1e-20,
arrow = arrow(length = unit(0.015, "npc"))
) +
theme_hc() +
labs(title = "Observation Count by Year",
x = "Year",
y = "Observation Count")
There is bias introduced in the original method for plotting the population data percentiles because most countries are not reporting their information each year to a census, unlike larger countries like the USA and Canada. For each year, the average for each continent will vary because not all countries are submitting population data.
If you were to consider the average population for the Americas in 2001 and Brazil did not have data fro that year, your average will be inherently bias towards the countries that did submit their data. When using this model to make inferences, we may make the wrong inferences.
It would be beneficial to try and fill in the missing data for countries. One way to do this would be by taking the average of the two years that surround the desired year statistics. For example: Uganda has not submitted 1999 data, only 1995 and 2000. We could then use the average of these two numbers to compute a more realistic average between all countries in a continent. It is important to recognize that these data will not be entirely correct, but may follow the correct trend.
The second chart displays how there are varying amounts of observations reported each year, supporting the idea of misrepresentation.