Gallery
gallery.Rmd
library(ratioScales)
#> Loading required package: ggplot2
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, union
library(ggplot2)
library(patchwork)This vignette illustrates the use of ratioScales in data visualizations on topics ranging from exchange rates and college admissions to ## Wealth and college admissions In July 2023, Chetty et al. published a study that showed, among other things, that after controlling for SAT scores, wealthy students had much higher attendance rates at the most elite US colleges. Their data were visualized by Bhatia et al. in the New York Times, where the headline highlighted how at the most “Selective” colleges, parent income boosted admissions rates after controlling for standardized test scores. Their visualizations were later developed into an interactive toolkit Although the original Chetty et al. paper used traditional linear scales, the NYT/upshot visualizations used the ratio scale we call “divMult” in ratioScales.
Here, we pulled out some additional relationships revealed by Chetty et al.’s data, visualizing them, with and without ratio scales.
These data conflate admissions and “yield”… showing relative attendance rates for students with parents in each income bracket after controlling (within school tier/type) and relative application rates. A rate >1 may mean students are admitted at higher rates, or that they choose to attend once offered admission at higher rates, or a combination of both factors, compared to expectations given by their test scores.
# create a base plot (linear scale)
bp <- admit %>%
# filter(tier == "Ivy Plus", par_income_lab != "Top 1") %>%
# not using: , "Highly selective private"
filter(tier %in% c("Highly selective public", "Ivy Plus", "Other elite schools (public and private)")
, par_income_lab != "Top 1") %>%
group_by(tier, par_income_lab) %>%
summarize(mean_rel_att = mean(rel_att_cond_app)
, sd_rel_att = sd(rel_att_cond_app)) %>%
ggplot(aes(par_income_lab
, y = mean_rel_att
, color = tier
, group = tier
)) +
geom_hline(yintercept = 1) +
geom_line(linewidth = 1) +
geom_point(size = 2) +
labs(x = "parent income (percentile)"
, y = "relative attendance rate \n(controlling for test score and application rate)") +
theme_classic() +
# scale_y_continuous(breaks = c(0.5, 1/1.5, 1/1.25, 1, 1.25, 1.5, 2)
# , limits = c(0.48, 2.5)
# , labels = function(x){round(x,2)}
# ) +
scale_color_viridis_d()
#> `summarise()` has grouped output by 'tier'. You can override using the
#> `.groups` argument.
# add ratio scale
ratioscaled <- bp +
scale_y_ratio(tickVal = "divMult"
, slashStar = FALSE
# custom breaks to get more guidelines over small y-range
, breaks = c(0.5, 1/1.5, 1/1.25, 1, 1.25, 1.5, 2)
, limits = c(0.48, 2.5)
) +
annotate(x = "80-90", y = 2, label = "divMult ratio scale", geom = "text")
#print plots side by side
bp +
annotate(x = "80-90", y = 2, label = "traditional linear scale", geom = "text") +
theme(legend.position = "none") +
ratioscaled +
labs(y = NULL, color = NULL)
Of course, both plots show the same data, but they seem to tell somewhat different stories. Both plots show that the wealthiest students attend the most selective colleges… “Ivy Plus” and “Other elite,” at much higher-than-expected rates… over double for the top 0.1% at the Ivy Plus schools. A tier down, the “Highly selective colleges” show an opposing pattern, where the wealthiest students disproportionately do not attend. Presumably these students don’t receive an admissions disadvantage at these public schools, but instead are choosing to attend those most selective colleges.
The ratio scale highlights, among the “Highly selective public” colleges, the dramatically low attendance rate for the wealthiest students. This dramatic difference is compressed on the linear scale.
Home value change during great recession
Across the United States, home values plummeted during the great recession, but unevenly across regions.
It is common to describe appreciation as a percentage difference relative to the starting value. Here, we visualize changes in home values, where for each region the Zillow Home Value Index is computed, the baseline value is the value in the first reporting period.
base_HV_plot <- ushs %>%
filter(RegionType == "msa", !is.na(TypicalHomeValue)) %>%
# zoom in on SW
filter(StateName %in% c("NV", "AZ", "CO", "UT", "NM", "CA")) %>%
group_by(RegionID) %>%
mutate(NormTypicalHomeValue = TypicalHomeValue/TypicalHomeValue[1] ) %>%
ggplot(aes(RecordDate, NormTypicalHomeValue, color = RegionName)) +
geom_line() +
facet_wrap(~StateName
# , scales = "free_y"
, ncol = 3
) +
labs(y = "percent change in typical home value", x = "date") +
theme_minimal() +
theme(legend.position = "none"
, axis.text.x = element_text(angle = 90
# , hjust =1
, vjust = 0.5
))
base_HV_plot + scale_y_ratio(tickVal = "percDiff"
# , n = 6
# , limits = c(0.5, 4.3)
, breaks = c(0.5, 0.75, 1, 1.5, 2, 3.5)
) 
These pictures show that losing 50% of a value is as big a change as gaining 100% (and much bigger than gaining 50%). This also makes it easy to spot when trends are synchronous and asynchronous in a short time period or across time series with different starting points.
Striped Bass (a.k.a. Rockfish) catch
rockfish %>%
group_by(Region, Fishing.Mode) %>%
mutate(normCatch = PSE.Total.Catch..A.B1.B2./PSE.Total.Catch..A.B1.B2.[1]) %>%
ggplot(aes(Year, normCatch, color = Fishing.Mode)) +
geom_line()+
facet_wrap(~Region) +
theme_classic() +
scale_y_ratio(tickVal = "propDiff")
#> Warning in trans_picker(tickVal, ...): 'base = 2' chosen by defaut. Setting
#> base of log affects breaking function behavior, and 'exp(1)' may give
#> strange-looking numbers for the propDiff scale