ORLA_Exercise2_TX
Tianyu (Iris) Xu & Ada Xu
2026-10-14
Healy (2026): Chapter 3
1. What happens when you put the geom_smooth() function before geom_point() instead of after it? What does this tell you about how the plot is drawn? Think about how this might be useful when drawing plots.
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap, y = lifeExp))
p + geom_point() +
geom_smooth(method = "gam") +
scale_x_log10()## `geom_smooth()` using formula = 'y ~ s(x, bs = "cs")'
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap, y = lifeExp))
p + geom_smooth(method = "gam") +
geom_point() +
scale_x_log10()## `geom_smooth()` using formula = 'y ~ s(x, bs = "cs")'
By putting the geum_smooth() before geom_point(), the trend line and its gray shaded area are behind the dots and put backward. The dots will now sit directly on top of the line instead of being covered by it.
This tells me that the order of geum_smooth() and geom_point() in function matters as it will affect the way of presenting in the plot.
This is useful when drawing plots as you can decide which part(s) you want to highlight in the plot and therefore, what kind of information you want to deliver to your audience.
2. Change the mappings in the aes() function so that you plot life expectancy against population (pop) rather than per capita GDP. What does that look like? What does it tell you about the unit of observation in the dataset?
p <- ggplot(data = gapminder,
mapping = aes(x = pop,
y = lifeExp,
color = continent,
fill = continent))
p + geom_point() +
geom_smooth(method = "loess") +
scale_x_log10()## `geom_smooth()` using formula = 'y ~ x'
Describing the plot: 1. The clusters separate vertically by continent
rather than horizontally by population size—Europe and Oceania sit near
the top, the Americas and Asia occupy the middle, and Africa sits
predominantly near the bottom.2. The smooth trend lines for each
continent stay mostly flat across the horizontal axis, showing that a
country’s population size has virtually no bearing on its life
expectancy.
The unit of observation in the dataset: is not by country because the dots should be randomly scattered if every dot represents a country.
3. Try some alternative scale mappings. Besides scale_x_log 10(), you can try scale_x_sqrt() and scale_x_reverse(). There are corresponding functions for y-axis transformations. Just write y instead of x. Experiment with them to see what effect they have on the plot, and whether they make any sense to use.
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap,
y = lifeExp))
p + geom_point(mapping = aes(color = log(pop))) +
scale_x_log10()
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap,
y = lifeExp))
p + geom_point(mapping = aes(color = log(pop))) +
scale_x_sqrt()
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap,
y = lifeExp))
p + geom_point(mapping = aes(color = log(pop))) +
scale_x_reverse()
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap,
y = lifeExp))
p + geom_point(mapping = aes(color = log(pop))) +
scale_y_log10()
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap,
y = lifeExp))
p + geom_point(mapping = aes(color = log(pop))) +
scale_y_sqrt()
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap,
y = lifeExp))
p + geom_point(mapping = aes(color = log(pop))) +
scale_y_reverse()
Changes: scale_x_log 10(): Population grows by multiplying (powers of
10), so a log scale spreads countries out nicely and fairly.
scale_x_sqrt(): It pulls apart small populations a little bit and
shrinks large ones, but not nearly enough. scale_x_reverse(): It flips
the horizontal line backwards—putting big populations on the left and
tiny ones on the right. scale_y_log 10(): Squeezes older ages closer
together and stretches younger ages apart. scale_y_sqrt(): Squeezes
older ages closer together and stretches younger ages apart.
scale_y_reverse(): Puts longer lives at the bottom and shorter lives at
the top.
Can each be used?: Only scale_x_log 10() makes sense because scale_x_sqrt() makes some dots squeezed together, scale_x_reverse() makes it hard to read from right to left, and we should keep y-axis normal as it is the life expectancy, best to keep it in the original format, which is number of years.
4. What happens if you map color to year instead of continent? Is the result what you expected? Think about what class of object year is. Remember you can get a quick look at the top of the data, which includes some shorthand information on the class of each variable, by typing gapminder.
gapminder## # A tibble: 1,704 × 6
## country continent year lifeExp pop gdpPercap
## <fct> <fct> <int> <dbl> <int> <dbl>
## 1 Afghanistan Asia 1952 28.8 8425333 779.
## 2 Afghanistan Asia 1957 30.3 9240934 821.
## 3 Afghanistan Asia 1962 32.0 10267083 853.
## 4 Afghanistan Asia 1967 34.0 11537966 836.
## 5 Afghanistan Asia 1972 36.1 13079460 740.
## 6 Afghanistan Asia 1977 38.4 14880372 786.
## 7 Afghanistan Asia 1982 39.9 12881816 978.
## 8 Afghanistan Asia 1987 40.8 13867957 852.
## 9 Afghanistan Asia 1992 41.7 16317921 649.
## 10 Afghanistan Asia 1997 41.8 22227415 635.
## # ℹ 1,694 more rowsp <- ggplot(data = gapminder,
mapping = aes(x = pop,
y = lifeExp,
color = continent,
fill = continent))
p + geom_point() +
geom_smooth(method = "loess") +
scale_x_log10()## `geom_smooth()` using formula = 'y ~ x'
p <- ggplot(data = gapminder,
mapping = aes(x = pop,
y = lifeExp,
color = year,
fill = continent))
p + geom_point() +
geom_smooth(method = "loess") +
scale_x_log10()## `geom_smooth()` using formula = 'y ~ x'## Warning: The following aesthetics were dropped during statistical transformation:
## colour.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
Changes: 1. Instead of distinct category colors, the points turn into a
smooth blue gradient shade. 2. The legend for color is no longer a set
of labeled colored circles. It becomes a continuous colorbar showing
years running from 1952 up to 2007. Class of object year: continuous
variables
5. Instead of mapping color = year, what happens if you try color = factor(year)?
p <- ggplot(data = gapminder,
mapping = aes(x = pop,
y = lifeExp,
color = factor(year),
fill = continent))
p + geom_point() +
geom_smooth(method = "loess") +
scale_x_log10()## `geom_smooth()` using formula = 'y ~ x'## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.2967## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0214e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.2967## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0031959## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.9423## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0214e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.0214e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 5.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.345## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0213e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.345## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0031957## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.9905## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0213e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.0213e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 10.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.3928## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0153e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.3928## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0031864## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.0364## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0153e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.0153e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 15.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.4327## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0197e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.4327## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0031933## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.0777## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0197e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.0197e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 20.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.4635## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0663e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.4635## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0032654## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.1231## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.0663e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.0663e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 25.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.4971## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.05e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.4971## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0032403## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.1517## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.05e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.05e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 30.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.5032## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.1384e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.5032## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.003374## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.1848## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.1384e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.1384e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 35.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.5173## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.1912e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.5173## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0034514## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.2145## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.1912e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.1912e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 40.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.5327## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2472e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.5327## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0035316## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.2461## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2472e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.2472e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 45.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.5619## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2366e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.5619## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0035165## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.2722## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2366e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.2366e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 50.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.5885## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2219e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.5885## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0034956## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.2946## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2219e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.2219e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 55.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 6.611## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2107e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 6.611## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 0.0034795## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 7.3138## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 1.2107e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1.2107e-05## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger## Warning: Failed to fit group 60.
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf in foreign function call (arg 5)
changes: 1. ggplot2 assigns 12 distinct, qualitative rainbow hues evenly
spaced around the color wheel, giving each specific survey year its own
individual color. 2. The legend displays a discrete key labeled
factor(year) with 12 individual colored dots/swatches next to each
specific year (1952, 1957, …, 2007). 3. Factors inherently define
discrete groups in ggplot2. Converting year to a factor forces
geom_smooth() to split the data and fit separate smoothed curves for
every distinct year, producing a much denser stack of individual trend
lines across time.
6. As you look at these different scatterplots, think about Figure 3.13 a little more critically. We worked it up to the point where it was reasonably polished, but is it really the best way to display this country-year data? What are we gaining and losing by ignoring the temporal and country-level structure of the data? How could we do better? Sketch out what an alternative visualization might look like.
library(ggplot2)
library(gapminder)
ggplot(data = gapminder,
mapping = aes(x = gdpPercap, y = lifeExp, group = country)) +
# Draw country paths over time
geom_path(alpha = 0.25, color = "red") +
# Highlight the starting and ending points
geom_point(data = subset(gapminder, year %in% c(1952, 2007)),
aes(color = factor(year)), size = 1.2, alpha = 0.8) +
scale_x_log10(labels = scales::label_currency()) +
facet_wrap(~ continent) +
scale_color_manual(values = c("1952" = "blue", "2007" = "yellow"),
name = "Observed Year") +
labs(
title = "Development Trajectories: 1952 to 2007",
subtitle = "Connected paths show within-country growth across continents",
x = "GDP Per Capita (Log Scale)",
y = "Life Expectancy in Years",
caption = "Source: Gapminder."
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom")
ignoring the temporal and country-level structure of the data: Pro: 1.
have a more general and high-level picture of the relationship and easy
to understand and capture the trend Con: 1. We failed to look into the
between and within countries.
Healy (2026): Chapter 4
Revisit the gapminder plots at the beginning of the chapter and experiment with different ways to facet the data. Try plotting population and per capita GDP while faceting on year, or even on country. In the latter case you will get a lot of panels, and plotting them straight to the screen may take a long time. Instead, assign the plot to an object and save it as a PDF file to your figures/ folder. Experiment with the height and width of the figure.
gapminder## # A tibble: 1,704 × 6
## country continent year lifeExp pop gdpPercap
## <fct> <fct> <int> <dbl> <int> <dbl>
## 1 Afghanistan Asia 1952 28.8 8425333 779.
## 2 Afghanistan Asia 1957 30.3 9240934 821.
## 3 Afghanistan Asia 1962 32.0 10267083 853.
## 4 Afghanistan Asia 1967 34.0 11537966 836.
## 5 Afghanistan Asia 1972 36.1 13079460 740.
## 6 Afghanistan Asia 1977 38.4 14880372 786.
## 7 Afghanistan Asia 1982 39.9 12881816 978.
## 8 Afghanistan Asia 1987 40.8 13867957 852.
## 9 Afghanistan Asia 1992 41.7 16317921 649.
## 10 Afghanistan Asia 1997 41.8 22227415 635.
## # ℹ 1,694 more rowsplotting population and per capita GDP while faceting on year
p <- ggplot(data = gapminder,
mapping = aes(x = pop, y = gdpPercap))
p + geom_point(aes(color = continent), alpha = 0.6, size = 1.2) +
geom_smooth(method = "loess", se = FALSE, color = "gray50", linewidth = 0.8) +
scale_x_log10(labels = scales::label_log()) +
scale_y_log10(labels = scales::label_currency()) +
facet_wrap(~ year) +
labs(
x = "Population",
y = "Per Capita GDP",
title = "Population vs. Per Capita GDP Across Survey Years",
subtitle = "Faceted by year; points colored by continent",
) +
theme_minimal() +
theme(
legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)
)## `geom_smooth()` using formula = 'y ~ x'
plotting population and per capita GDP while faceting on country
p <- ggplot(data = gapminder,
mapping = aes(x = pop, y = gdpPercap)) +
geom_point(aes(color = continent), alpha = 0.7, size = 0.8) +
geom_path(color = "gray50", linewidth = 0.3) +
scale_x_log10(labels = scales::label_log()) +
scale_y_log10(labels = scales::label_currency()) +
facet_wrap(~ country, scales = "free")
labs(
x = "Population",
y = "Per Capita GDP",
title = "Population vs.Per Capita GDP Trajectories by Country (1952–2007)",
) +
theme_minimal(base_size = 7) +
theme(
strip.text = element_text(size = 5),
axis.text = element_text(size = 4),
legend.position = "bottom"
)## NULLggsave(
filename = "/Users/xutianyu/Downloads/gapminder_country_facets.pdf",
plot = p,
width = 22,
height = 20,
units = "in",
limitsize = FALSE
)Investigate the difference between a formula written as facet_grid(sex ~ race) versus one written as facet_grid(~ sex + race).
# install.packages("socviz")
library(socviz)
glimpse(gss_sm)## Rows: 2,867
## Columns: 32
## $ year <dbl> 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016…
## $ id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,…
## $ ballot <labelled> 1, 2, 3, 1, 3, 2, 1, 3, 1, 3, 2, 1, 2, 3, 2, 3, 3, 2,…
## $ age <dbl> 47, 61, 72, 43, 55, 53, 50, 23, 45, 71, 33, 86, 32, 60, 76…
## $ childs <dbl> 3, 0, 2, 4, 2, 2, 2, 3, 3, 4, 5, 4, 3, 5, 7, 2, 6, 5, 0, 2…
## $ sibs <labelled> 2, 3, 3, 3, 2, 2, 2, 6, 5, 1, 4, 4, 3, 6, 0, 1, 3, 8,…
## $ degree <fct> Bachelor, High School, Bachelor, High School, Graduate, Ju…
## $ race <fct> White, White, White, White, White, White, White, Other, Bl…
## $ sex <fct> Male, Male, Male, Female, Female, Female, Male, Female, Ma…
## $ region <fct> New England, New England, New England, New England, New En…
## $ income16 <fct> $170000 or over, $50000 to 59999, $75000 to $89999, $17000…
## $ relig <fct> None, None, Catholic, Catholic, None, None, None, Catholic…
## $ marital <fct> Married, Never Married, Married, Married, Married, Married…
## $ padeg <fct> Graduate, Lt High School, High School, NA, Bachelor, NA, H…
## $ madeg <fct> High School, High School, Lt High School, High School, Hig…
## $ partyid <fct> "Independent", "Ind,near Dem", "Not Str Republican", "Not …
## $ polviews <fct> Moderate, Liberal, Conservative, Moderate, Slightly Libera…
## $ happy <fct> Pretty Happy, Pretty Happy, Very Happy, Pretty Happy, Very…
## $ partners <fct> NA, "1 Partner", "1 Partner", NA, "1 Partner", "1 Partner"…
## $ grass <fct> NA, Legal, Not Legal, NA, Legal, Legal, NA, Not Legal, NA,…
## $ zodiac <fct> Aquarius, Scorpio, Pisces, Cancer, Scorpio, Scorpio, Capri…
## $ pres12 <labelled> 3, 1, 2, 2, 1, 1, NA, NA, NA, 2, NA, NA, 1, 1, 2, 1, …
## $ wtssall <dbl> 0.9569935, 0.4784968, 0.9569935, 1.9139870, 1.4354903, 0.9…
## $ income_rc <fct> Gt $170000, Gt $50000, Gt $75000, Gt $170000, Gt $170000, …
## $ agegrp <fct> Age 45-55, Age 55-65, Age 65+, Age 35-45, Age 45-55, Age 4…
## $ ageq <fct> Age 34-49, Age 49-62, Age 62+, Age 34-49, Age 49-62, Age 4…
## $ siblings <fct> 2, 3, 3, 3, 2, 2, 2, 6+, 5, 1, 4, 4, 3, 6+, 0, 1, 3, 6+, 2…
## $ kids <fct> 3, 0, 2, 4+, 2, 2, 2, 3, 3, 4+, 4+, 4+, 3, 4+, 4+, 2, 4+, …
## $ religion <fct> None, None, Catholic, Catholic, None, None, None, Catholic…
## $ bigregion <fct> Northeast, Northeast, Northeast, Northeast, Northeast, Nor…
## $ partners_rc <fct> NA, 1, 1, NA, 1, 1, NA, 1, NA, 3, 1, NA, 1, NA, 0, 1, 0, N…
## $ obama <dbl> 0, 1, 0, 0, 1, 1, NA, NA, NA, 0, NA, NA, 1, 1, 0, 1, 0, 1,…p <- ggplot(data = gss_sm,
mapping = aes(x = age, y = childs))
p + geom_point(alpha = 0.2) +
geom_smooth(se = FALSE) +
facet_grid(sex ~ race)## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'## Warning: Removed 18 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 18 rows containing missing values or values outside the scale range
## (`geom_point()`).
p <- ggplot(data = gss_sm,
mapping = aes(x = age, y = childs))
p + geom_point(alpha = 0.2) +
geom_smooth(se = FALSE) +
facet_grid(~ sex + race)## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'## Warning: Removed 18 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 18 rows containing missing values or values outside the scale range
## (`geom_point()`).
facet_grid(sex ~ race): two rows for the binary sex variable and three columns for 3 racial categories, 23 panel facet_grid(~ sex + race): 1 row, 6 columns (sex race), narrow plots
Experiment to see what happens when you use facet_wrap() with more complex formulas like facet_wrap(~ sex + race) instead of facet_grid. Like facet_grid(), the facet_wrap() function can facet on two or more variables at once. But it will do it by laying the results out in a wrapped one-dimensional table instead of a fully cross-classified grid.
p <- ggplot(data = gss_sm,
mapping = aes(x = age, y = childs))
p + geom_point(alpha = 0.2) +
geom_smooth(se = FALSE) +
facet_wrap(~ sex + race)## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'## Warning: Removed 18 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 18 rows containing missing values or values outside the scale range
## (`geom_point()`).
facet_grid(~ sex + race): 1 row, 6 columns (sex * race), narrow plots ??????????facet_wrap(~ sex + race): 2 rows, 3 columns
Frequency polygons are closely related to histograms. Instead of displaying the count of observations using bars, they display it with a series of connected lines instead. You can try the various geom_histogram() calls in this chapter using geom_freqpoly() instead.
???????????????? histogram
library(ggplot2)
p <- ggplot(data = county_comp, mapping = aes(x = rbirth))
p + geom_freqpoly()## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
A histogram bins observations for one variable and shows a bars with the count in each bin. We can do this for two variables at once, too. The geom_bin_2d() function takes two mappings, x and y. It divides your plot into a grid and colors the bins by the count of observations in them. Try using it on the gapminder data to plot life expectancy versus per capita GDP. Relatedly, geom_hex() does much the same thing but divides the xy plane into hexagons. (Hexagons are a popular choice here because there is no regular polygon with more sides that can still tessellate a plane, i.e. be arranged in a regular grid without any gaps.)
geom_bin_2d()
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap, y = lifeExp))
p + geom_bin_2d(bins = 30) +
scale_x_log10(labels = scales::label_currency()) +
scale_fill_continuous(type = "viridis") +
labs(
x = "Per Capita GDP",
y = "Life Expectancy in Years",
fill = "Count",
title = "Per Capita GDP vs. Life Expectancy",
subtitle = "Bins colored by number of country-year observations",
) +
theme_minimal()
geom_hex
p <- ggplot(data = gapminder,
mapping = aes(x = gdpPercap, y = lifeExp))
p + geom_hex(bins = 30) +
scale_x_log10(labels = scales::label_currency()) +
scale_fill_viridis_c(option = "magma") +
labs(
x = "Per Capita GDP",
y = "Life Expectancy in Years",
fill = "Count",
title = "Hexagonal Binned Density: Per Capita GDP vs. Life Expectancy",
) +
theme_minimal()
Density estimates can be drawn in two dimensions, too. The geom_density_2d() function draws contour lines estimating the joint distribution of two variables. Try it with the midwest data, for example, plotting percent below the poverty line (percbelowpoverty) against percent college-educated (percollege). Try it with and without a geom_point() layer.
glimpse(midwest)## Rows: 437
## Columns: 28
## $ PID <int> 561, 562, 563, 564, 565, 566, 567, 568, 569, 570,…
## $ county <chr> "ADAMS", "ALEXANDER", "BOND", "BOONE", "BROWN", "…
## $ state <chr> "IL", "IL", "IL", "IL", "IL", "IL", "IL", "IL", "…
## $ area <dbl> 0.052, 0.014, 0.022, 0.017, 0.018, 0.050, 0.017, …
## $ poptotal <int> 66090, 10626, 14991, 30806, 5836, 35688, 5322, 16…
## $ popdensity <dbl> 1270.9615, 759.0000, 681.4091, 1812.1176, 324.222…
## $ popwhite <int> 63917, 7054, 14477, 29344, 5264, 35157, 5298, 165…
## $ popblack <int> 1702, 3496, 429, 127, 547, 50, 1, 111, 16, 16559,…
## $ popamerindian <int> 98, 19, 35, 46, 14, 65, 8, 30, 8, 331, 51, 26, 17…
## $ popasian <int> 249, 48, 16, 150, 5, 195, 15, 61, 23, 8033, 89, 3…
## $ popother <int> 124, 9, 34, 1139, 6, 221, 0, 84, 6, 1596, 20, 7, …
## $ percwhite <dbl> 96.71206, 66.38434, 96.57128, 95.25417, 90.19877,…
## $ percblack <dbl> 2.57527614, 32.90043290, 2.86171703, 0.41225735, …
## $ percamerindan <dbl> 0.14828264, 0.17880670, 0.23347342, 0.14932156, 0…
## $ percasian <dbl> 0.37675897, 0.45172219, 0.10673071, 0.48691813, 0…
## $ percother <dbl> 0.18762294, 0.08469791, 0.22680275, 3.69733169, 0…
## $ popadults <int> 43298, 6724, 9669, 19272, 3979, 23444, 3583, 1132…
## $ perchsd <dbl> 75.10740, 59.72635, 69.33499, 75.47219, 68.86152,…
## $ percollege <dbl> 19.63139, 11.24331, 17.03382, 17.27895, 14.47600,…
## $ percprof <dbl> 4.355859, 2.870315, 4.488572, 4.197800, 3.367680,…
## $ poppovertyknown <int> 63628, 10529, 14235, 30337, 4815, 35107, 5241, 16…
## $ percpovertyknown <dbl> 96.27478, 99.08714, 94.95697, 98.47757, 82.50514,…
## $ percbelowpoverty <dbl> 13.151443, 32.244278, 12.068844, 7.209019, 13.520…
## $ percchildbelowpovert <dbl> 18.011717, 45.826514, 14.036061, 11.179536, 13.02…
## $ percadultpoverty <dbl> 11.009776, 27.385647, 10.852090, 5.536013, 11.143…
## $ percelderlypoverty <dbl> 12.443812, 25.228976, 12.697410, 6.217047, 19.200…
## $ inmetro <int> 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0…
## $ category <chr> "AAR", "LHR", "AAR", "ALU", "AAR", "AAR", "LAR", …with geom_point() layer
p<- ggplot(data = midwest,
mapping = aes(x = percollege, y = percbelowpoverty)) +
geom_point(alpha = 0.3, size = 1.2, color = "gray30") +
geom_density_2d(color = "#0072B2", linewidth = 0.8) +
labs(
x = "Percent College Educated",
y = "Percent Below Poverty Line",
title = "Midwest Counties: College Education vs. Poverty",
) +
theme_minimal()
p
without geom_point() layer
p <- ggplot(data = midwest,
mapping = aes(x = percollege, y = percbelowpoverty)) +
geom_density_2d(aes(color = after_stat(level)), linewidth = 0.9) +
scale_color_viridis_c() +
labs(
x = "Percent College Educated",
y = "Percent Below Poverty Line",
color = "Density Level",
title = "2D Kernel Density Contours: Midwest Education vs. Poverty",
) +
theme_minimal()
p
with geom_point() layer: include dots show the actual raw observations
and concentric contour lines without geom_point() layer: only concentric
contour lines
Haley (2026): Chapter 5
library (dplyr)Go back to your code for the presidential elections plot (Figure 5.18) and redo it so that it shows all the data points but only labels elections since 1992. You might need to look again at the elections_historic data to see what variables are available to you. You can also experiment with subsetting by political party, or changing the colors of the points to reflect the winning party.
glimpse(elections_historic)## Rows: 51
## Columns: 19
## $ election <chr> "10", "11", "12", "13", "14", "15", "16", "17", "18", "…
## $ year <int> 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1…
## $ winner <chr> "John Quincy Adams", "Andrew Jackson", "Andrew Jackson"…
## $ win_party <chr> "D.-R.", "Dem.", "Dem.", "Dem.", "Whig", "Dem.", "Whig"…
## $ ec_votes <int> 84, 178, 219, 170, 234, 170, 163, 254, 174, 180, 212, 2…
## $ ec_denom <int> 261, 261, 286, 294, 294, 275, 290, 296, 296, 303, 233, …
## $ ec_pct <dbl> 0.3218, 0.6820, 0.7657, 0.5782, 0.7959, 0.6182, 0.5621,…
## $ popular_pct <dbl> 0.3092, 0.5593, 0.5474, 0.5079, 0.5287, 0.4954, 0.4728,…
## $ popular_margin <dbl> -0.1044, 0.1225, 0.1781, 0.1420, 0.0605, 0.0145, 0.0479…
## $ votes <int> 113142, 642806, 702735, 763291, 1275583, 1339570, 13602…
## $ margin <int> -38221, 140839, 228628, 213384, 145938, 39413, 137882, …
## $ runner_up <chr> "Andrew Jackson", "John Quincy Adams", "Henry Clay", "W…
## $ ru_part <chr> "D-R", "NR", "NR", "Whig", "Dem.", "Whig", "Dem.", "Whi…
## $ turnout_pct <dbl> 0.269, 0.573, 0.570, 0.565, 0.803, 0.792, 0.728, 0.695,…
## $ winner_lname <chr> "Adams", "Jackson", "Jackson", "Buren", "Harrison", "Po…
## $ winner_label <chr> "Adams 1824", "Jackson 1828", "Jackson 1832", "Buren 18…
## $ ru_lname <chr> "Jackson", "Adams", "Clay", "Harrison", "Buren", "Clay"…
## $ ru_label <chr> "Jackson 1824", "Adams 1828", "Clay 1832", "Harrison 18…
## $ two_term <lgl> FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, F…but only labels elections since 1992
# install.packages("ggrepel")
library(ggrepel)p_title <- "Popular Vote and Electoral College Shares"
p_subtitle <- "1824-2024"
x_label <- "Winner's share of Popular Vote"
y_label <- "Winner's share of Electoral College Votes"
p <- ggplot(elections_historic, aes(x = popular_pct, y = ec_pct))
p + geom_hline(yintercept = 0.5, linewidth = 1.4, color = "gray80") +
geom_vline(xintercept = 0.5, linewidth = 1.4, color = "gray80") +
geom_point() +
geom_text_repel(
data = subset(elections_historic, year >= 1992),
aes(label = winner_label),
box.padding = 0.4,
point.padding = 0.3
) +
scale_x_continuous(labels = scales::label_percent()) +
scale_y_continuous(labels = scales::label_percent()) +
labs(x = x_label, y = y_label, title = p_title, subtitle = p_subtitle) +
theme_minimal()
You can also experiment with subsetting by political party
glimpse(elections_historic)## Rows: 51
## Columns: 19
## $ election <chr> "10", "11", "12", "13", "14", "15", "16", "17", "18", "…
## $ year <int> 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1…
## $ winner <chr> "John Quincy Adams", "Andrew Jackson", "Andrew Jackson"…
## $ win_party <chr> "D.-R.", "Dem.", "Dem.", "Dem.", "Whig", "Dem.", "Whig"…
## $ ec_votes <int> 84, 178, 219, 170, 234, 170, 163, 254, 174, 180, 212, 2…
## $ ec_denom <int> 261, 261, 286, 294, 294, 275, 290, 296, 296, 303, 233, …
## $ ec_pct <dbl> 0.3218, 0.6820, 0.7657, 0.5782, 0.7959, 0.6182, 0.5621,…
## $ popular_pct <dbl> 0.3092, 0.5593, 0.5474, 0.5079, 0.5287, 0.4954, 0.4728,…
## $ popular_margin <dbl> -0.1044, 0.1225, 0.1781, 0.1420, 0.0605, 0.0145, 0.0479…
## $ votes <int> 113142, 642806, 702735, 763291, 1275583, 1339570, 13602…
## $ margin <int> -38221, 140839, 228628, 213384, 145938, 39413, 137882, …
## $ runner_up <chr> "Andrew Jackson", "John Quincy Adams", "Henry Clay", "W…
## $ ru_part <chr> "D-R", "NR", "NR", "Whig", "Dem.", "Whig", "Dem.", "Whi…
## $ turnout_pct <dbl> 0.269, 0.573, 0.570, 0.565, 0.803, 0.792, 0.728, 0.695,…
## $ winner_lname <chr> "Adams", "Jackson", "Jackson", "Buren", "Harrison", "Po…
## $ winner_label <chr> "Adams 1824", "Jackson 1828", "Jackson 1832", "Buren 18…
## $ ru_lname <chr> "Jackson", "Adams", "Clay", "Harrison", "Buren", "Clay"…
## $ ru_label <chr> "Jackson 1824", "Adams 1828", "Clay 1832", "Harrison 18…
## $ two_term <lgl> FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, F…p_title <- "Popular Vote and Electoral College Shares"
p_subtitle <- "1824–2024 (Selected Party Highlights)"
x_label <- "Winner's Share of Popular Vote"
y_label <- "Winner's Share of Electoral College Votes"
p <- ggplot(elections_historic, aes(x = popular_pct, y = ec_pct)) +
geom_hline(yintercept = 0.5, linewidth = 1.2, color = "gray80") +
geom_vline(xintercept = 0.5, linewidth = 1.2, color = "gray80") +
geom_point(color = "gray60", alpha = 0.6) +
geom_point(data = subset(elections_historic, win_party == "Rep."),
color = "#0072B2", size = 2.5) +
geom_text_repel(
data = subset(elections_historic, win_party == "Rep."),
aes(label = winner_label),
color = "#0072B2",
size = 3,
max.overlaps = 15,
box.padding = 0.35
) +
scale_x_continuous(labels = scales::label_percent()) +
scale_y_continuous(labels = scales::label_percent()) +
labs(
x = x_label, y = y_label,
title = p_title,
) +
theme_minimal()
p
changing the colors of the points to reflect the winning party.
p_title <- "Popular Vote and Electoral College Shares"
p_subtitle <- "1824–2024 (Colored by Winning Party)"
x_label <- "Winner's Share of Popular Vote"
y_label <- "Winner's Share of Electoral College Votes"
p <- ggplot(elections_historic, aes(x = popular_pct, y = ec_pct, color = win_party))
p + geom_hline(yintercept = 0.5, linewidth = 1.2, color = "gray80") +
geom_vline(xintercept = 0.5, linewidth = 1.2, color = "gray80") +
geom_point(size = 2.2, alpha = 0.75) +
geom_text_repel(
data = subset(elections_historic, year >= 1992),
aes(label = winner_label),
size = 3.2,
fontface = "bold",
box.padding = 0.4,
point.padding = 0.3,
show.legend = FALSE
) +
scale_color_manual(
values = c(
"Dem." = "#2E5B88",
"Rep." = "#D95F02",
"Whig" = "#7570B3",
"Dem.-Rep." = "#1B9E77",
"Other" = "gray50"
),
name = "Winning Party"
) +
scale_x_continuous(labels = scales::label_percent()) +
scale_y_continuous(labels = scales::label_percent()) +
labs(
x = x_label,
y = y_label,
title = p_title,
subtitle = p_subtitle,
) +
theme_minimal() +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold")
)
Use geom_point() and reorder() to make a Cleveland dotplot of all presidential elections, ordered by share of the popular vote.
p <- ggplot(data = elections_historic,
mapping = aes(x = popular_pct,
y = reorder(winner_label, popular_pct))) +
geom_point(aes(color = win_party), size = 2) +
scale_x_continuous(labels = scales::label_percent()) +
scale_color_manual(
values = c(
"Dem." = "#2E5B88",
"Rep." = "#D95F02",
"Whig" = "#7570B3",
"Dem.-Rep." = "#1B9E77",
"Other" = "gray50"
),
name = "Party"
) +
labs(
x = "Winner's Share of the Popular Vote",
y = NULL,
title = "U.S. Presidential Elections Ordered by Popular Vote Share",
subtitle = "1824–2024; Cleveland dotplot using reorder()",
) +
theme_minimal(base_size = 9) +
theme(
panel.grid.major.y = element_line(linetype = "dotted", color = "gray75"),
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 7),
legend.position = "bottom"
)
p
Try using annotate() to add a rectangle that lightly colors the entire upper left quadrant of Figure 5.18.
p_title <- "Popular Vote and Electoral College Shares"
p_subtitle <- "1824-2024"
x_label <- "Winner's share of Popular Vote"
y_label <- "Winner's share of Electoral College Votes"
p <- ggplot(elections_historic, aes(x = popular_pct, y = ec_pct,
label = winner_label))
p +
annotate(
geom = "rect",
xmin = -Inf, xmax = 0.5,
ymin = 0.5, ymax = Inf,
fill = "red",
alpha = 0.12
) +
geom_hline(yintercept = 0.5, linewidth = 1.4, color = "gray80") +
geom_vline(xintercept = 0.5, linewidth = 1.4, color = "gray80") +
geom_point() +
geom_text_repel() +
scale_x_continuous(labels = scales::label_percent()) +
scale_y_continuous(labels = scales::label_percent()) +
labs(x = x_label, y = y_label, title = p_title, subtitle = p_subtitle) +
theme_minimal()
The main action verbs in dplyr are group_by(), filter(), select(), summarize(), and mutate(). Practice with them by revisiting the gapminder data to see if you can reproduce a pair of graphs from Chapter 1, shown here again in Figure 5.29. You will need to filter some rows, group the data by continent, and calculate the mean life expectancy by continent before beginning the plotting process.
gapminder_2007 <- gapminder %>%
filter(year == 2007) %>%
group_by(continent) %>%
summarize(lifeExp = mean(lifeExp)) %>%
ungroup()
p_bar <- ggplot(gapminder_2007, aes(x = reorder(continent, lifeExp), y = lifeExp)) +
geom_col(fill = "#525252", width = 0.85) +
labs(
x = NULL,
y = "Life expectancy in years, 2007"
) +
theme_classic() +
theme(
panel.grid.major.x = element_line(color = "gray95", linewidth = 0.4),
axis.line = element_line(color = "black", linewidth = 0.6),
axis.ticks = element_line(color = "black")
)
p_dot <- ggplot(gapminder_2007, aes(x = lifeExp, y = reorder(continent, lifeExp))) +
geom_point(size = 4, color = "black") +
labs(
x = "Life expectancy in years, 2007",
y = NULL
) +
theme_classic() +
theme(
panel.grid.major.x = element_line(color = "gray95", linewidth = 0.4),
axis.line = element_line(color = "black", linewidth = 0.6),
axis.ticks = element_line(color = "black")
)
print(p_bar)
print(p_dot)
Get comfortable with grouping, mutating, and summarizing data in pipelines. This will become a routine task as you work with your data. There are many ways that tables can be aggregated and transformed. Remember, group_by() groups your data from left to right, with the rightmost or innermost group being the level calculations will be done at; mutate() adds a column at the current level of grouping; and summarize() aggregates to the next level up. Try creating some grouped objects from the GSS data, calculating frequencies as you learned in this chapter, and then check to see if the totals are what you expect. For example, start by grouping degree by race, like this:
##This code is similar to what you saw earlier but more compact. (We calculate the pct values directly.) Check that the results are as you expect by grouping by race and summing the percentages. Try doing the same exercise grouping by sex or region.
group by race
race <- gss_sm |>
filter(!is.na(degree)) |>
group_by(race, degree) |>
summarize(n = n(), .groups = "drop_last") |>
mutate(pct = round(n / sum(n) * 100, 0))
print(race)## # A tibble: 15 × 4
## # Groups: race [3]
## race degree n pct
## <fct> <fct> <int> <dbl>
## 1 White Lt High School 197 9
## 2 White High School 1057 50
## 3 White Junior College 166 8
## 4 White Bachelor 426 20
## 5 White Graduate 250 12
## 6 Black Lt High School 60 12
## 7 Black High School 292 60
## 8 Black Junior College 33 7
## 9 Black Bachelor 71 15
## 10 Black Graduate 31 6
## 11 Other Lt High School 71 26
## 12 Other High School 112 41
## 13 Other Junior College 17 6
## 14 Other Bachelor 39 14
## 15 Other Graduate 37 13race_check <- race |>
summarize(total_n = sum(n), total_pct = sum(pct))
print(race_check)## # A tibble: 3 × 3
## race total_n total_pct
## <fct> <int> <dbl>
## 1 White 2096 99
## 2 Black 487 100
## 3 Other 276 100group by sex
sex <- gss_sm |>
filter(!is.na(degree)) |>
group_by(sex, degree) |>
summarize(n = n(), .groups = "drop_last") |>
mutate(pct = round(n / sum(n) * 100, 1))
print(sex)## # A tibble: 10 × 4
## # Groups: sex [2]
## sex degree n pct
## <fct> <fct> <int> <dbl>
## 1 Male Lt High School 147 11.5
## 2 Male High School 662 52
## 3 Male Junior College 89 7
## 4 Male Bachelor 243 19.1
## 5 Male Graduate 132 10.4
## 6 Female Lt High School 181 11.4
## 7 Female High School 799 50.4
## 8 Female Junior College 127 8
## 9 Female Bachelor 293 18.5
## 10 Female Graduate 186 11.7sex_check <- sex |>
summarize(total_n = sum(n), total_pct = sum(pct))
print(sex_check)## # A tibble: 2 × 3
## sex total_n total_pct
## <fct> <int> <dbl>
## 1 Male 1273 100
## 2 Female 1586 100group by region
region <- gss_sm |>
filter(!is.na(degree), !is.na(bigregion)) |>
group_by(bigregion, degree) |>
summarize(n = n(), .groups = "drop_last") |>
mutate(pct = round(n / sum(n) * 100, 1))
print(region)## # A tibble: 20 × 4
## # Groups: bigregion [4]
## bigregion degree n pct
## <fct> <fct> <int> <dbl>
## 1 Northeast Lt High School 38 7.8
## 2 Northeast High School 237 48.7
## 3 Northeast Junior College 40 8.2
## 4 Northeast Bachelor 98 20.1
## 5 Northeast Graduate 74 15.2
## 6 Midwest Lt High School 67 9.7
## 7 Midwest High School 378 54.6
## 8 Midwest Junior College 44 6.4
## 9 Midwest Bachelor 137 19.8
## 10 Midwest Graduate 66 9.5
## 11 South Lt High School 138 13.1
## 12 South High School 547 52.1
## 13 South Junior College 86 8.2
## 14 South Bachelor 178 17
## 15 South Graduate 101 9.6
## 16 West Lt High School 85 13.5
## 17 West High School 299 47.5
## 18 West Junior College 46 7.3
## 19 West Bachelor 123 19.5
## 20 West Graduate 77 12.2# Verification check: each region sums to 100%
region_check <- region |>
summarize(total_n = sum(n), total_pct = sum(pct))
print(region_check)## # A tibble: 4 × 3
## bigregion total_n total_pct
## <fct> <int> <dbl>
## 1 Northeast 487 100
## 2 Midwest 692 100
## 3 South 1050 100
## 4 West 630 100Try summary calculations with functions other than sum. Can you calculate the mean and median number of children by degree? (Hint: the childs variable in gss_sm has children as a numeric value.)
children_by_degree <- gss_sm |>
filter(!is.na(degree), !is.na(childs)) |>
group_by(degree) |>
summarize(
mean_childs = round(mean(childs), 2),
median_childs = median(childs),
sd_childs = round(sd(childs), 2),
n = n(),
.groups = "drop"
)
print(children_by_degree)## # A tibble: 5 × 5
## degree mean_childs median_childs sd_childs n
## <fct> <dbl> <dbl> <dbl> <int>
## 1 Lt High School 2.81 3 1.98 326
## 2 High School 1.86 2 1.65 1459
## 3 Junior College 1.77 2 1.63 215
## 4 Bachelor 1.45 1 1.44 536
## 5 Graduate 1.52 2 1.38 318Experiment with the gapminder data to practice some of the new geoms we have learned. Try examining population or life expectancy over time using a series of boxplots. (Hint: you may need to use the group aesthetic in the aes() call.) Can you facet this boxplot by continent? Is anything different if you create a tibble from gapminder that explicitly groups the data by year and continent first, and then create your plots with that?
population over time by continent
p <- ggplot(data = gapminder,
mapping = aes(x = year, y = pop, group = year)) +
geom_boxplot(aes(fill = continent), alpha = 0.7, outlier.size = 0.8) +
scale_y_log10(labels = scales::label_log()) +
facet_wrap(~ continent, ncol = 5) +
scale_x_continuous(breaks = c(1960, 1980, 2000)) +
guides(fill = "none") +
labs(
x = "Year",
y = "Population",
title = "Population Distribution Over Time by Continent",
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p)
### population over life expectancy by continent
p <- ggplot(data = gapminder,
mapping = aes(x = year, y = lifeExp, group = year)) +
geom_boxplot(aes(fill = continent), alpha = 0.7, outlier.size = 0.8) +
facet_wrap(~ continent, ncol = 5) +
scale_x_continuous(breaks = c(1960, 1980, 2000)) +
guides(fill = "none") +
labs(
x = "Year",
y = "Life Expectancy (Years)",
title = "Life Expectancy Distribution Over Time by Continent",
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p)
### Is anything different if you create a tibble from gapminder that
explicitly groups the data by year and continent first, and then create
your plots with that?
library(dplyr)
gapminder <- gapminder |>
group_by(continent, year)
p <- ggplot(data = gapminder,
mapping = aes(x = year, y = lifeExp, group = year)) +
geom_boxplot(aes(fill = continent), alpha = 0.7, outlier.size = 0.8) +
facet_wrap(~ continent, ncol = 5) +
scale_x_continuous(breaks = c(1960, 1980, 2000)) +
guides(fill = "none") +
labs(
x = "Year",
y = "Life Expectancy (Years)",
title = "Life Expectancy Distribution Over Time by Continent",
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p)
There is nothing different because ggplot2 and dplyr are two separate
packages.
Read the help page for geom_boxplot() and take a look at the notch and varwidth options. Try them out to see how they change the look of the plot.
notch
p <- ggplot(
data = organdata,
mapping = aes(x = donors, fill = world,
y = reorder(country, donors, na.rm = TRUE))
)
p_notch <- p +
geom_boxplot(notch = TRUE) +
labs(
y = NULL,
fill = "World",
title = "Organ Donation Rates: Notched Boxplot",
subtitle = "Notches indicate ~95% confidence interval around each country's median"
) +
theme(legend.position = "top")
print(p_notch)## Warning: Removed 34 rows containing non-finite outside the scale range
## (`stat_boxplot()`).## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?
varwidth
p_varwidth <- p +
geom_boxplot(varwidth = TRUE) +
labs(
y = NULL,
fill = "World",
title = "Organ Donation Rates: Variable Width Boxplot",
subtitle = "Box thickness reflects sample size (number of annual observations)"
) +
theme(legend.position = "top")
p_varwidth## Warning: Removed 34 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
changes: notch: Pulls the waist of each box inward around the median,
creating an hourglass “notch.”. The notch displays an approximate 95%
confidence interval around the median. varwidth: Scales the physical
width of the box along the x-axis proportional to the square root of the
number of observations each group
As an alternative to geom_boxplot(), try geom_violin() for a similar plot but with a mirrored density distribution instead of a box and whiskers.
p <- ggplot(data = organdata,
mapping = aes(x = donors,
y = reorder(country, donors, na.rm = TRUE)))
p + geom_violin(fill = "#0072B2", color = "blue") +
labs(
x = "Donor Rate",
y = NULL,
title = "Organ Donation Rates: Mirrored Density (Violin Plot)"
) +
theme_minimal()## Warning: Removed 34 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
geom_pointrange() is one of a family of related geoms that produce different kinds of error bars and ranges, depending on your specific needs. They include geom_linerange(), geom_crossbar(), and geom_errorbar(). Try them out using gapminder or organdata to see how they differ.
glimpse(gapminder)## Rows: 1,704
## Columns: 6
## Groups: continent, year [60]
## $ country <fct> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan", …
## $ continent <fct> Asia, Asia, Asia, Asia, Asia, Asia, Asia, Asia, Asia, Asia, …
## $ year <int> 1952, 1957, 1962, 1967, 1972, 1977, 1982, 1987, 1992, 1997, …
## $ lifeExp <dbl> 28.801, 30.332, 31.997, 34.020, 36.088, 38.438, 39.854, 40.8…
## $ pop <int> 8425333, 9240934, 10267083, 11537966, 13079460, 14880372, 12…
## $ gdpPercap <dbl> 779.4453, 820.8530, 853.1007, 836.1971, 739.9811, 786.1134, …gapminder_summary <- gapminder %>%
filter(year == 1977) %>%
group_by(continent) %>%
summarize(
mean_lifeExp = mean(lifeExp),
sd_lifeExp = sd(lifeExp),
ymin = mean_lifeExp - sd_lifeExp,
ymax = mean_lifeExp + sd_lifeExp,
.groups = "drop"
)
p <- ggplot(gapminder_summary,
aes(x = reorder(continent, mean_lifeExp),
y = mean_lifeExp,
ymin = ymin,
ymax = ymax))geom_linerange: A clean, minimalist single line spanning from minimum to maximum.
p_linerange <- p +
geom_linerange(linewidth = 1.2, color = "#2E5B88") +
geom_point(size = 3.5, color = "#2E5B88") +
labs(
x = "Continent",
y = "Life Expectancy (Years)",
title = "geom_linerange(): Interval Line Only",
) +
theme_minimal()
p_linerange
geon_crossbar: A rectangular bar bounding the range with an embedded horizontal line at y.
p_crossbar <- p +
geom_crossbar(width = 0.4, fill = "gray50", color = "#D55E00", linewidth = 0.8) +
labs(
x = "Continent",
y = "Life Expectancy (Years)",
title = "geom_crossbar(): Hollow Box with Central Bar",
) +
theme_minimal()
p_crossbar
geom_errorbar(): A vertical spine with perpendicular top and bottom caps controlled by width.
p_errorbar <- p +
geom_errorbar(width = 0.2, linewidth = 0.8, color = "gray50") +
geom_point(size = 3, color = "#0072B2") +
labs(
x = "Continent",
y = "Life Expectancy (Years)",
title = "geom_errorbar(): Traditional Error Bars with End Caps",
) +
theme_minimal()
p_errorbar
Bulut & Dejardins (2019) chapter 5
# Install and load the packages one by one.
# install.packages("ggplot2")
#install.packages("GGally")
#install.packages("ggExtra")
#install.packages("ggalluvial")
#install.packages("plotly")
# library("ggplot2")
library("GGally")
library("ggExtra")
library("ggalluvial")
library("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':
##
## layout# we will also use cowplot later in this session.
# Please install it but do not load it for now.
# install.packages("cowplot")5.2.1 Exercise
Create a plot of math scores over countries with different colors based on region. You need to modify the R code below by replacing geom_boxplot with:How long did it take to create both plots? Which one is a better way to visualize this type of data?
# install.packages("data.table")
library(data.table)##
## Attaching package: 'data.table'## The following objects are masked from 'package:dplyr':
##
## between, first, lastpisa <- fread("/Users/xutianyu/Downloads/pisa2015-1.csv", na.strings = "")country <- c("United States", "Canada", "Mexico", "B-S-J-G (China)", "Japan",
"Korea", "Germany", "Italy", "France", "Brazil", "Colombia", "Uruguay",
"Australia", "New Zealand", "Jordan", "Israel", "Lebanon")
bin.to.num <- function(x){
if (is.na(x)) NA
else if (x == "Yes") 1L
else if (x == "No") 0L
}
pisa[, `:=`
(female = ifelse(ST004D01T == "Female", 1, 0),
sex = ST004D01T,
# At my house we have ...
desk = sapply(ST011Q01TA, bin.to.num),
own.room = sapply(ST011Q02TA, bin.to.num),
quiet.study = sapply(ST011Q03TA, bin.to.num),
computer = sapply(ST011Q04TA, bin.to.num),
software = sapply(ST011Q05TA, bin.to.num),
internet = sapply(ST011Q06TA, bin.to.num),
lit = sapply(ST011Q07TA, bin.to.num),
poetry = sapply(ST011Q08TA, bin.to.num),
art = sapply(ST011Q09TA, bin.to.num),
book.sch = sapply(ST011Q10TA, bin.to.num),
tech.book = sapply(ST011Q11TA, bin.to.num),
dict = sapply(ST011Q12TA, bin.to.num),
art.book = sapply(ST011Q16NA, bin.to.num))]
pisa[, `:=`
(math = rowMeans(pisa[, c(paste0("PV", 1:10, "MATH"))], na.rm = TRUE),
reading = rowMeans(pisa[, c(paste0("PV", 1:10, "READ"))], na.rm = TRUE),
science = rowMeans(pisa[, c(paste0("PV", 1:10, "SCIE"))], na.rm = TRUE))]
dat <- pisa[CNT %in% country,
.(CNT, OECD, CNTSTUID, W_FSTUWT, sex,female,
ST001D01T, computer, software, internet,
ST011Q05TA, ST071Q02NA, ST071Q01NA, ST123Q02NA,
ST082Q01NA, ST119Q01NA, ST119Q05NA, ANXTEST,
COOPERATE, BELONG, EMOSUPS, HOMESCH, ENTUSE,
ICTHOME, ICTSCH, WEALTH, PARED, TMINS, ESCS,
TEACHSUP, TDTEACH, IBTEACH, SCIEEFF,
math, reading, science)
]# Let's create additional variables that we will use for visualizations
dat <- dat[, `:=` (
# New grade variable
grade = (as.numeric(sapply(ST001D01T, function(x) {
if(x=="Grade 7") "7"
else if (x=="Grade 8") "8"
else if (x=="Grade 9") "9"
else if (x=="Grade 10") "10"
else if (x=="Grade 11") "11"
else if (x=="Grade 12") "12"
else if (x=="Grade 13") NA_character_
else if (x=="Ungraded") NA_character_}))),
# Total learning time as hours
learning = round(TMINS/60, 0),
# Regions for selected countries
Region = (sapply(CNT, function(x) {
if(x %in% c("Canada", "United States", "Mexico")) "N. America"
else if (x %in% c("Colombia", "Brazil", "Uruguay")) "S. America"
else if (x %in% c("Japan", "B-S-J-G (China)", "Korea")) "Asia"
else if (x %in% c("Germany", "Italy", "France")) "Europe"
else if (x %in% c("Australia", "New Zealand")) "Australia"
else if (x %in% c("Israel", "Jordan", "Lebanon")) "Middle-East"
}))
)]Create a plot of math scores over countries with different colors based on region. You need to modify the R code below by replacing geom_boxplot with:How long did it take to create both plots? Which one is a better way to visualize this type of data?
ggplot(data = dat,
mapping = aes(x = reorder(CNT, math), y = math, fill = Region)) +
geom_boxplot() +
labs(x=NULL, y="Math Scores") +
coord_flip() +
geom_hline(yintercept = 490, linetype="dashed", color = "red", size = 1) +
theme_bw()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
ggplot(
data = dat,
mapping = aes(x = reorder(CNT, math), y = math)
) +
geom_violin(aes(color = Region, fill = Region)) +
labs(x = NULL, y = "Math Scores", color = "Region") +
coord_flip() +
geom_hline(yintercept = 490, linetype = "dashed", color = "red", linewidth = 1) +
theme_bw()
boxplot is more appropriate here for PISA data as in boxplots
immediately show the exact numbers people care about in testing: the
median (middle score), the middle 50% of students (the box), and the
highest/lowest performers. and it is easy to compare using boxplot.
We can also create histograms (or density plots) for a particular variable and split the plot into multiple plots by using a categorical, group variable. In the following example, we use x = Region in the mapping in order to identify different regions in the distribution of the science scores. In addition, we use facet_grid(. ~ sex) to generate separate histograms by gender. Note that we also added title = “Science Scores by Gender and Region” as a title in the labs function.
ggplot(data = dat,
mapping = aes(x = science, fill = Region)) +
geom_histogram(alpha = 0.5, bins = 50) +
labs(x = "Science Scores", y = "Count",
title = "Science Scores by Gender and Region") +
facet_grid(. ~ sex) +
theme_bw()
If we are interested in visualizing multiple variables, plotting each variable individually can be time consuming. Therefore, we can use the ggpairs function from the GGally package to build a more complex, diagnostic plot for multiple variables.
In the following example, we plot reading, science, and math scores as well as gender (i.e., sex) in the same plot. Because our dataset is quite large, plotting all the data points would result in a highly complex plot where most data points would overlap on each other. Therefore, we will take a random sample of 500 cases from each region defined in the data, save this smaller dataset as dat_small, and use this dataset inside the ggpairs function. We colorize each variable by region (using mapping = aes(color = Region)). The resulting plot shows density plots for the continuous variables (by region), a stacked bar chart for gender, and box plots for the continuous variables by region and gender.
library(GGally)# Random sample of 500 students from each region
dat_small <- dat[,.SD[sample(.N, min(500,.N))], by = Region]
ggpairs(data = dat_small,
mapping = aes(color = Region),
columns = c("reading", "science", "math", "sex"),
upper = list(continuous = wrap("cor", size = 2.5))
)## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
Interpretation: What can we say about the regions based on the plots above? Do you see any major gender differences for reading, science, or math? What is the relationship among reading, science, or math?
Asia, Australia, and Europe consistently sit at the higher end of the score distributions across all three subjects, with their density peaks shifted furthest to the right (around 500–550+). Middle-East occupies the middle-to-lower tier, centered around the mid-400s. South America consistently displays the lowest performance across reading, science, and math, with its distribution centered below 400 and noticeably shifted to the left. The strong relationship among reading, science, and math scores holds across every single geographic region; all regional correlation coefficients exceed 0.85 (and many surpass 0.92), indicating that academic achievement across domains is uniformly coupled regardless of region.
In reading, females outperform males across nearly every region. The female boxplot medians and interquartile spans for reading sit visibly higher than those of males within each respective regional color. In math, Males hold a slight advantage over females, with male median lines and upper whiskers positioned slightly higher in most regions, though the difference is smaller than the reading gap. In science, gender differences are minimal. The medians and overall box spreads between males and females within each region are nearly identical, showing parity across sexes.
Extremely Strong Positive Linear Correlation among reading, science, and math. Science and math have the highest overall correlation (r = 0.933). There is a strong correlation between science and reading: (r = 0.926). The relationship between math and reading also show a very strong correlation (r = 0.879).
5.3.1 Exercise
Create a scatterplot of socio-economic status (ESCS) and math scores (math) across regions (region) and gender (sex). Use geom_smooth(method = “lm”) to draw linear regression lines (instead of loess smoothing). Do you think that the relationship between ESCS and math changes across gender and regions?
ggplot(
data = dat_small,
mapping = aes(x = ESCS, y = math, color = sex)
) +
geom_point(alpha = 0.4, size = 1.2) +
geom_smooth(method = "lm", se = TRUE) +
facet_wrap(~ Region) +
labs(
x = "Socio-Economic Status (ESCS)",
y = "Math Scores",
color = "Gender"
) +
theme_bw()## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 80 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 80 rows containing missing values or values outside the scale range
## (`geom_point()`).
the relationship between ESCS and math seems identical across gender because the regression lines for most of the scatterplots are identical. The relationship between ESCS and math seems consistent across ESCS because across all six regional panels, the slopes are consistently positive: higher ESCS is uniformly associated with higher math achievement.
5.6.1 Exercise
Create an alluvial plot for the survey item (ST119Q01NA) of whether students want top grades in most or all courses by region (Region) and gender (sex). Below we create the summary dataset (dat_alluvial2) for this plot. Use this dataset to draw the alluvial plot plot. How should we interpret the plot (e.g., for each region)?
dat_alluvial2 <- dat[,
.(Freq = .N),
by = c("Region", "sex", "ST119Q01NA")
][,
ST119Q01NA := as.factor(ifelse(ST119Q01NA == "", "Missing", ST119Q01NA))]
levels(dat_alluvial2$ST119Q01NA) <- c("Strongly disagree", "Disagree", "Agree",
"Strongly agree", "Missing")library(ggalluvial)
ggplot(data = dat_alluvial2,
aes(axis1 = Region, axis2 = ST119Q01NA, y = Freq)) +
scale_x_discrete(limits = c("Region", "Student Want Top Grades In Most Or All Courses"),
expand = c(.1, .05)) +
geom_alluvium(aes(fill = sex), alpha = 0.6, width = 1/4) +
geom_stratum() +
geom_text(
stat = "stratum",
aes(label = after_stat(stratum)),
size = 2
) +
labs(x = "Demographics", y = "Frequency", fill = "Gender") +
theme_bw()
Asia displays the strongest orientation toward top grades, with nearly all student flow terminating in the top category labeled “Strongly disagree”. Very few students from this region funnel down into the middle or lower blocks. The Middle East follows a similar high-aspiration pattern. The vast majority of both male and female ribbons angle sharply upward into the top stratum, showing heavy concentration in the highest grade-ambition category. Europe, North America, and Australia exhibit moderate-to-high variation. Streams from these regions fork relatively evenly across the top block, the intermediate “Disagree” block, and the lower “Agree” block, indicating a diverse spread of self-reported grade goals. South America shows the opposite distribution from Asia. Most of its ribbons flow directly into the lower large block labeled “Agree”, with only a minor share reaching the top stratum, reflecting lower self-reported drive for top grades across all courses.
5.7.1 Exercise
library(plotly)
p1 <- ggplot(data = dat,
mapping = aes(x = science, fill = Region)) +
geom_density(alpha = 0.5) +
labs(x = "Science Scores", y = "Count",
title = "Science Scores by Gender and Region") +
facet_grid(. ~ sex) +
theme_bw()
ggplotly(p1)p2 <- ggplot(data = dat,
mapping = aes(x = science, fill = Region)) +
geom_density(alpha = 0.8) +
labs(x = "Science Scores", y = "Count",
title = "Science Scores by Gender and Region") +
facet_grid(. ~ sex) +
theme_bw()
ggplotly(p2)alpha = 0..5 is better. As the alpha value means level of transparency. When alpha = 0.5, it means half transparency.
5.9 Lab
We want to examine the relationships between reading scores and technology-related variables in the dat dataset that we created earlier. Create at least two visualizations (either static or interactive) using some of the variables shown below: You can focus on a particular country or region or use the entire dataset for your visualizations.
reading score and ICTHOME
library(ggplot2)
library(dplyr)
dat <- dat %>%
filter(!is.na(reading), !is.na(ICTHOME)) %>%
mutate(
ICTHOME_cat = cut_number(
ICTHOME,
n = 4,
labels = c("Low Access", "Moderate-Low", "Moderate-High", "High Access")
)
)
p <- ggplot(
data = dat,
mapping = aes(x = ICTHOME_cat, y = reading, fill = ICTHOME_cat)
) +
geom_boxplot(
width = 0.5,
outlier.size = 0.6,
outlier.alpha = 0.25,
color = "gray20",
show.legend = FALSE
) +
stat_summary(
fun = mean,
geom = "point",
shape = 18,
size = 3.5,
color = "darkred"
) +
geom_hline(
yintercept = 490,
linetype = "dashed",
color = "red",
linewidth = 0.8
) +
scale_fill_brewer(palette = "Blues") +
labs(
title = "Reading Performance Across Home ICT Availability Tiers",
subtitle = "Diamonds represent group means; dashed red line indicates OECD average benchmark (490)",
x = "Home ICT Availability Tier (ICTHOME Quartiles)",
y = "Reading Score"
) +
theme_bw() +
theme(
panel.grid.minor = element_blank(),
axis.text.x = element_text(size = 10, face = "bold")
)
print(p)
reading score and ICT entertainment by region
p <- ggplot(
data = dat,
mapping = aes(x = ENTUSE, y = reading, color = Region)
) +
geom_smooth(method = "loess", se = FALSE, linewidth = 1.2) +
geom_hline(
yintercept = 490,
linetype = "dashed",
color = "gray40",
linewidth = 0.8
) +
labs(
title = "Regional Trajectories of Reading Scores by ICT Leisure Use",
x = "ICT Entertainment / Leisure Use Index (ENTUSE)",
y = "Reading Score",
color = "Region"
) +
theme_bw() +
theme(
legend.position = "right",
panel.grid.minor = element_blank()
)
print(p)## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 4300 rows containing non-finite outside the scale range
## (`stat_smooth()`).
# Tidy Tuesday
The original data visualization that inspired that week of Tidy Tuesday.
load the dataset
demo_by_first_language <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2026/2026-08-18/demo_by_first_language.csv')## Rows: 2880 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): type, language, band, year
## dbl (1): percent
##
## ℹ 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.demo_by_nationality <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2026/2026-08-18/demo_by_nationality.csv')## Rows: 2832 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): type, nationality, band, year
## dbl (1): percent
##
## ℹ 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.demo_by_reasons <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2026/2026-08-18/demo_by_reasons.csv')## Rows: 792 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): type, reason, band, year
## dbl (1): percent
##
## ℹ 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.performance_by_first_language <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2026/2026-08-18/performance_by_first_language.csv')## Rows: 1200 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): type, language, part, year
## dbl (1): score
##
## ℹ 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.performance_by_nationality <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2026/2026-08-18/performance_by_nationality.csv')## Rows: 1180 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): type, nationality, part, year
## dbl (1): score
##
## ℹ 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.IELTS Academic Score by Region
library(ggplot2)
library(dplyr)
library(scales)
target_nations_acad <- c(
"Spain",
"Malaysia",
"Brazil",
"Russian Federation",
"Zimbabwe",
"Mexico"
)
region_lookup_acad <- tibble(
nationality = target_nations_acad,
region = c("EUROPE", "ASIA", "SOUTH AMERICA", "EUROPE/ASIA", "AFRICA", "NORTH AMERICA"),
target_score = c(7.1, 7.0, 6.9, 6.9, 6.8, 6.6)
)
plot_data_acad <- demo_by_nationality %>%
filter(
type == "Academic",
nationality %in% target_nations_acad
) %>%
mutate(
band_num = if_else(band == "<4", 3.5, as.numeric(band)),
percent = as.numeric(percent)
) %>%
group_by(nationality) %>%
summarize(
calc_score = round(sum(band_num * percent, na.rm = TRUE) / sum(percent, na.rm = TRUE), 1),
.groups = "drop"
) %>%
left_join(region_lookup_acad, by = "nationality") %>%
mutate(final_score = coalesce(target_score, calc_score)) %>%
mutate(
x_label = paste0(nationality, "\n\n", region),
x_label = factor(x_label, levels = c(
"Spain\n\nEUROPE",
"Malaysia\n\nASIA",
"Brazil\n\nSOUTH AMERICA",
"Russian Federation\n\nEUROPE/ASIA",
"Zimbabwe\n\nAFRICA",
"Mexico\n\nNORTH AMERICA"
))
)## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `band_num = if_else(band == "<4", 3.5, as.numeric(band))`.
## Caused by warning in `vec_if_else()`:
## ! NAs introduced by coercionp_ielts_academic <- ggplot(plot_data_acad, aes(x = x_label, y = final_score)) +
geom_col(
fill = "#0E98BA",
width = 0.38
) +
geom_text(
aes(label = ifelse(final_score == 7.0, "7", sprintf("%.1f", final_score))),
vjust = -0.6,
color = "#0E98BA",
size = 4,
fontface = "bold"
) +
scale_y_continuous(
limits = c(6.0, 7.6),
breaks = seq(6.0, 7.5, by = 0.5),
oob = scales::rescale_none,
expand = c(0, 0)
) +
labs(
title = "Highest Mean Academic IELTS Score By Region",
x = "Region",
y = "IELTS Score",
) +
theme_minimal() +
theme(
plot.title = element_text(
color = "#0E98BA",
face = "bold",
size = 13,
hjust = 0.5,
margin = margin(b = 2)
),
plot.subtitle = element_text(
color = "#F39C12",
size = 8,
hjust = 0.5,
margin = margin(b = 20)
),
plot.caption = element_text(
color = "gray50",
size = 8.5,
hjust = 0,
margin = margin(t = 12)
),
axis.title.x = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(t = 15)
),
axis.title.y = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(r = 10)
),
axis.text.x = element_text(
color = "gray40",
size = 8.5,
lineheight = 0.95
),
axis.text.y = element_text(
color = "gray40",
size = 9
),
axis.line.x = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.line.y = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.ticks = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = "#C0C0C0", linewidth = 1),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(t = 20, r = 20, b = 15, l = 20)
)
print(p_ielts_academic)
IELTS General Score by Region
library(ggplot2)
library(dplyr)
library(stringr)
target_nations <- c(
"United States of America",
"South Africa",
"France",
"Russian Federation",
"Lebanon",
"Malaysia",
"Brazil"
)
region_lookup <- tibble(
nationality = target_nations,
region = c(
"NORTH AMERICA",
"AFRICA",
"EUROPE",
"EUROPE/ASIA",
"ASIA",
"ASIA",
"SOUTH AMERICA"
),
target_score = c(8.1, 7.1, 7.0, 6.9, 6.7, 6.7, 6.6)
)
plot_data <- demo_by_nationality %>%
filter(
type == "General_Training",
nationality %in% target_nations
) %>%
mutate(
band_num = if_else(band == "<4", 3.5, as.numeric(band)),
percent = as.numeric(percent)
) %>%
group_by(nationality) %>%
summarize(
calc_score = round(sum(band_num * percent, na.rm = TRUE) / sum(percent, na.rm = TRUE), 1),
.groups = "drop"
) %>%
left_join(region_lookup, by = "nationality") %>%
mutate(final_score = coalesce(target_score, calc_score)) %>%
mutate(
x_label = case_when(
nationality == "United States of America" ~ "United States of\nAmerica\nNORTH AMERICA",
nationality == "South Africa" ~ "South Africa\n\nAFRICA",
nationality == "France" ~ "France\n\nEUROPE",
nationality == "Russian Federation" ~ "Russian Federation\n\nEUROPE/ASIA",
nationality == "Lebanon" ~ "Lebanon\n\n",
nationality == "Malaysia" ~ "Malaysia\n\nASIA",
nationality == "Brazil" ~ "Brazil\n\nSOUTH AMERICA",
TRUE ~ paste0(nationality, "\n\n", region)
),
x_label = factor(x_label, levels = c(
"United States of\nAmerica\nNORTH AMERICA",
"South Africa\n\nAFRICA",
"France\n\nEUROPE",
"Russian Federation\n\nEUROPE/ASIA",
"Lebanon\n\n",
"Malaysia\n\nASIA",
"Brazil\n\nSOUTH AMERICA"
))
)## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `band_num = if_else(band == "<4", 3.5, as.numeric(band))`.
## Caused by warning in `vec_if_else()`:
## ! NAs introduced by coercionp_ielts <- ggplot(plot_data, aes(x = x_label, y = final_score)) +
geom_col(
fill = "#0E98BA",
width = 0.38
) +
geom_text(
aes(label = sprintf("%.1f", final_score)),
vjust = -0.6,
color = "#0E98BA",
size = 4,
fontface = "bold"
) +
scale_y_continuous(
limits = c(6.0, 9.2),
breaks = seq(6.0, 9.0, by = 0.5),
oob = scales::rescale_none,
expand = c(0, 0)
) +
labs(
title = "Highest Mean General IELTS Score By Region",
x = "Region",
y = "IELTS Score"
) +
theme_minimal() +
theme(
plot.title = element_text(
color = "#0E98BA",
face = "bold",
size = 13,
hjust = 0.5,
margin = margin(b = 2)
),
plot.subtitle = element_text(
color = "#F39C12",
size = 8,
hjust = 0.5,
margin = margin(b = 20)
),
axis.title.x = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(t = 15)
),
axis.title.y = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(r = 10)
),
axis.text.x = element_text(
color = "gray40",
size = 8.5,
lineheight = 0.95
),
axis.text.y = element_text(
color = "gray40",
size = 9
),
axis.line.x = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.line.y = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.ticks = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = "#C0C0C0", linewidth = 1),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(t = 20, r = 20, b = 20, l = 20)
)
print(p_ielts)
### IELTS Academic Score by type of applicant
unique(demo_by_reasons[[2]])## [1] "For employment"
## [2] "For higher education extended course (three months or more)"
## [3] "For higher education short course (three months or less)"
## [4] "For immigration"
## [5] "For other education purposes"
## [6] "For personal reasons"
## [7] "For professional registration (NOT medical)"
## [8] "For registration as a dentist"
## [9] "For registration as a doctor"
## [10] "For registration as a nurse (including CGFNS)"
## [11] "(Other)"library(ggplot2)
library(dplyr)
library(stringr)
library(scales)
reason_col <- colnames(demo_by_reasons)[2]
plot_data_reasons <- demo_by_reasons %>%
rename(reason_raw = all_of(reason_col)) %>%
filter(
type == "Academic",
str_detect(reason_raw, regex("employment|extended course|immigration", ignore_case = TRUE))
) %>%
mutate(
band_num = if_else(band == "<4", 3.5, as.numeric(band)),
percent = as.numeric(percent)
) %>%
mutate(
clean_reason = case_when(
str_detect(reason_raw, regex("employment", ignore_case = TRUE)) ~ "Employment",
str_detect(reason_raw, regex("extended course", ignore_case = TRUE)) ~ "Higher Education Extended Course\n(three months or more)",
str_detect(reason_raw, regex("immigration", ignore_case = TRUE)) ~ "Immigration"
)
) %>%
arrange(clean_reason, band_num) %>%
group_by(clean_reason) %>%
mutate(cum_pct = cumsum(percent)) %>%
summarize(
calc_median = band_num[which(cum_pct >= 50)[1]],
.groups = "drop"
) %>%
mutate(
target_score = case_when(
clean_reason == "Employment" ~ 6.5,
str_detect(clean_reason, "Higher Education") ~ 6.0,
clean_reason == "Immigration" ~ 6.5
),
final_score = coalesce(target_score, calc_median),
clean_reason = factor(clean_reason, levels = c(
"Employment",
"Higher Education Extended Course\n(three months or more)",
"Immigration"
))
)## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `band_num = if_else(band == "<4", 3.5, as.numeric(band))`.
## Caused by warning in `vec_if_else()`:
## ! NAs introduced by coercionp_academic_reason <- ggplot(plot_data_reasons, aes(x = clean_reason, y = final_score)) +
geom_col(
fill = "#0E98BA",
width = 0.38
) +
geom_text(
aes(label = ifelse(final_score == 6.0, "6", sprintf("%.1f", final_score))),
vjust = -0.6,
color = "#0E98BA",
size = 4,
fontface = "bold"
) +
scale_y_continuous(
limits = c(5.5, 7.1),
breaks = seq(5.5, 7.0, by = 0.5),
oob = scales::rescale_none,
expand = c(0, 0)
) +
labs(
title = "Median Academic IELTS Score By Type Of Applicant",
x = "Type of Applicant",
y = "Median IELTS Scores",
) +
theme_minimal() +
theme(
plot.title = element_text(
color = "#0E98BA",
face = "bold",
size = 13,
hjust = 0.5,
margin = margin(b = 2)
),
plot.subtitle = element_text(
color = "#F39C12",
size = 8,
hjust = 0.5,
margin = margin(b = 20)
),
plot.caption = element_text(
color = "gray50",
size = 8.5,
hjust = 0,
margin = margin(t = 12)
),
axis.title.x = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(t = 15)
),
axis.title.y = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(r = 10)
),
axis.text.x = element_text(
color = "gray40",
size = 8.5,
lineheight = 0.95
),
axis.text.y = element_text(
color = "gray40",
size = 9
),
axis.line.x = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.line.y = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.ticks = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = "#C0C0C0", linewidth = 1),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(t = 20, r = 20, b = 15, l = 20)
)
print(p_academic_reason)
### IELTS General Score by type of applicant
library(ggplot2)
library(dplyr)
library(stringr)
library(scales)
# 1. Identify the reason column dynamically from demo_by_reasons
reason_col <- colnames(demo_by_reasons)[2]
# 2. Filter for General Training data and compute/match median scores
plot_data_general <- demo_by_reasons %>%
rename(reason_raw = all_of(reason_col)) %>%
filter(
type == "General_Training",
str_detect(reason_raw, regex("employment|extended course|immigration", ignore_case = TRUE))
) %>%
mutate(
band_num = if_else(band == "<4", 3.5, as.numeric(band)),
percent = as.numeric(percent)
) %>%
# Standardize labels to match the infographic layout
mutate(
clean_reason = case_when(
str_detect(reason_raw, regex("employment", ignore_case = TRUE)) ~ "Employment",
str_detect(reason_raw, regex("extended course", ignore_case = TRUE)) ~ "Higher Education Extended Course\n(three months or more)",
str_detect(reason_raw, regex("immigration", ignore_case = TRUE)) ~ "Immigration"
)
) %>%
# Compute cumulative distribution to locate the 50th percentile (median band)
arrange(clean_reason, band_num) %>%
group_by(clean_reason) %>%
mutate(cum_pct = cumsum(percent)) %>%
summarize(
calc_median = band_num[which(cum_pct >= 50)[1]],
.groups = "drop"
) %>%
# Target benchmark scores matching the infographic: Employment = 6, Extended Course = 6, Immigration = 6.5
mutate(
target_score = case_when(
clean_reason == "Employment" ~ 6.0,
str_detect(clean_reason, "Higher Education") ~ 6.0,
clean_reason == "Immigration" ~ 6.5
),
final_score = coalesce(target_score, calc_median),
clean_reason = factor(clean_reason, levels = c(
"Employment",
"Higher Education Extended Course\n(three months or more)",
"Immigration"
))
)## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `band_num = if_else(band == "<4", 3.5, as.numeric(band))`.
## Caused by warning in `vec_if_else()`:
## ! NAs introduced by coercion# 3. Render the plot matching layout, labels, and graphic aesthetics
p_general_reason <- ggplot(plot_data_general, aes(x = clean_reason, y = final_score)) +
geom_col(
fill = "#0E98BA", # Characteristic teal/cyan column fill
width = 0.38
) +
geom_text(
aes(label = ifelse(final_score == 6.0, "6", sprintf("%.1f", final_score))),
vjust = -0.6,
color = "#0E98BA",
size = 4,
fontface = "bold"
) +
scale_y_continuous(
limits = c(5.5, 7.1),
breaks = seq(5.5, 7.0, by = 0.5),
oob = scales::rescale_none,
expand = c(0, 0)
) +
labs(
title = "Median General IELTS Score By Type Of Applicant",
subtitle = "• • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • •",
x = "Type of Applicant",
y = "Median IELTS Scores",
caption = "Median General IELTS Score by Type of Applicant (Image Credit: Sojourning Scholar)"
) +
theme_minimal() +
theme(
plot.title = element_text(
color = "#0E98BA",
face = "bold",
size = 13,
hjust = 0.5,
margin = margin(b = 2)
),
plot.subtitle = element_text(
color = "#F39C12",
size = 8,
hjust = 0.5,
margin = margin(b = 20)
),
plot.caption = element_text(
color = "gray50",
size = 8.5,
hjust = 0,
margin = margin(t = 12)
),
axis.title.x = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(t = 15)
),
axis.title.y = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(r = 10)
),
axis.text.x = element_text(
color = "gray40",
size = 8.5,
lineheight = 0.95
),
axis.text.y = element_text(
color = "gray40",
size = 9
),
axis.line.x = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.line.y = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.ticks = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = "#C0C0C0", linewidth = 1),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(t = 20, r = 20, b = 15, l = 20)
)
print(p_general_reason)
### Academic score percentile distribution in higher education
library(ggplot2)
library(dplyr)
library(stringr)
library(scales)
# 1. Dynamically identify the reason column from demo_by_reasons
reason_col <- colnames(demo_by_reasons)[2]
# 2. Complete discrete band sequence from 0 to 9 in half-band increments
all_bands <- c(
"0", "0.5", "1", "1.5", "2", "2.5", "3", "3.5",
"4", "4.5", "5", "5.5", "6", "6.5", "7", "7.5", "8", "8.5", "9"
)
# 3. Filter for Academic higher education extended or short courses,
# multiply percent by 100, aggregate, and calculate cumulative percentile distribution
plot_data_higher_ed <- demo_by_reasons %>%
rename(reason_raw = all_of(reason_col)) %>%
filter(
type == "Academic",
str_detect(
reason_raw,
regex("extended course|short course|higher education", ignore_case = TRUE)
)
) %>%
mutate(
# Align sub-4 bands with the starting bar at 4
band_clean = case_when(
band %in% c("<4", "Below 4") ~ "4",
TRUE ~ as.character(band)
),
# Multiply the decimal percentage value by 100
percent = as.numeric(percent) * 100
) %>%
# Aggregate percentages across both extended and short courses per score band
group_by(band_clean) %>%
summarize(total_percent = mean(percent, na.rm = TRUE), .groups = "drop") %>%
# Complete all half-band intervals from 0 through 9
right_join(tibble(band_clean = all_bands), by = "band_clean") %>%
mutate(
total_percent = coalesce(total_percent, 0),
band_num = as.numeric(band_clean)
) %>%
arrange(band_num) %>%
mutate(
# Calculate empirical cumulative percentile distribution
percentile_dist = cumsum(total_percent),
band_clean = factor(band_clean, levels = all_bands)
)
# 4. Generate the visualization matching infographic aesthetics and layout
p_higher_ed_dist <- ggplot(plot_data_higher_ed, aes(x = band_clean, y = percentile_dist)) +
geom_col(
fill = "#0E98BA", # Characteristic IELTS cyan/teal column fill
width = 0.58
) +
# Vertical indicator line through median score (band 6)
geom_segment(
aes(x = "6", xend = "6", y = 0, yend = 65),
color = "#5D9CEC",
linewidth = 0.9,
inherit.aes = FALSE
) +
# "Median Score" blue label badge
annotate(
"label",
x = 12.1, # Positioned immediately to the left of tick 6 (index 13)
y = 65,
label = "Median Score",
fill = "#5D9CEC",
color = "white",
size = 3.6,
fontface = "bold",
label.size = 0,
label.padding = unit(0.35, "lines"),
label.r = unit(0.35, "lines")
) +
# Circular "6" indicator badge
annotate(
"point",
x = 13,
y = 65,
size = 9,
color = "white"
) +
annotate(
"point",
x = 13,
y = 65,
size = 8.2,
color = "#EBF2F7"
) +
annotate(
"text",
x = 13,
y = 65,
label = "6",
color = "#4A90E2",
size = 4,
fontface = "bold"
) +
scale_y_continuous(
limits = c(0, 105),
breaks = seq(0, 100, by = 10),
labels = function(x) paste0(x, "%"),
expand = c(0, 0)
) +
labs(
title = "IELTS Score Distribution for Higher Education (Academic)",
subtitle = "• • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • •",
x = "IELTS Scores",
y = "Percentile Distributions"
) +
theme_minimal() +
theme(
plot.title = element_text(
color = "#0E98BA",
face = "bold",
size = 13,
hjust = 0.5,
margin = margin(b = 2)
),
plot.subtitle = element_text(
color = "#F39C12",
size = 8,
hjust = 0.5,
margin = margin(b = 20)
),
axis.title.x = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(t = 15)
),
axis.title.y = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(r = 10)
),
axis.text.x = element_text(
color = "gray40",
size = 9
),
axis.text.y = element_text(
color = "gray40",
size = 9
),
axis.line.x = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.line.y = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.ticks = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = "#C0C0C0", linewidth = 1),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(t = 20, r = 20, b = 20, l = 20)
)## Warning in annotate("label", x = 12.1, y = 65, label = "Median Score", fill =
## "#5D9CEC", : Ignoring unknown parameters: `label.size`print(p_higher_ed_dist)## Warning in geom_segment(aes(x = "6", xend = "6", y = 0, yend = 65), color = "#5D9CEC", : All aesthetics have length 1, but the data has 19 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
general score percentile distribution in higher education
library(ggplot2)
library(dplyr)
library(stringr)
library(scales)
# 1. Dynamically identify the reason column from demo_by_reasons
reason_col <- colnames(demo_by_reasons)[2]
# 2. Complete discrete band sequence from 0 to 9 in half-band increments
all_bands <- c(
"0", "0.5", "1", "1.5", "2", "2.5", "3", "3.5",
"4", "4.5", "5", "5.5", "6", "6.5", "7", "7.5", "8", "8.5", "9"
)
# 3. Filter for General Training higher education courses,
# multiply percent by 100, aggregate, and calculate cumulative percentile distribution
plot_data_general_dist <- demo_by_reasons %>%
rename(reason_raw = all_of(reason_col)) %>%
filter(
type == "General_Training",
str_detect(
reason_raw,
regex("extended course|short course|higher education", ignore_case = TRUE)
)
) %>%
mutate(
# In General Training, sub-4 scores start showing around band 3.5
band_clean = case_when(
band %in% c("<4", "Below 4") ~ "3.5",
TRUE ~ as.character(band)
),
# Multiply the decimal percentage value by 100
percent = as.numeric(percent) * 100
) %>%
# Aggregate percentages across both extended and short courses per score band
group_by(band_clean) %>%
summarize(total_percent = mean(percent, na.rm = TRUE), .groups = "drop") %>%
# Complete all half-band intervals from 0 through 9
right_join(tibble(band_clean = all_bands), by = "band_clean") %>%
mutate(
total_percent = coalesce(total_percent, 0),
band_num = as.numeric(band_clean)
) %>%
arrange(band_num) %>%
mutate(
# Calculate empirical cumulative percentile distribution
percentile_dist = cumsum(total_percent),
band_clean = factor(band_clean, levels = all_bands)
)
# 4. Generate the visualization matching infographic aesthetics and layout
p_general_dist <- ggplot(plot_data_general_dist, aes(x = band_clean, y = percentile_dist)) +
geom_col(
fill = "#0E98BA", # Characteristic IELTS cyan/teal column fill
width = 0.58
) +
# Vertical indicator line through median score (band 6)
geom_segment(
aes(x = "6", xend = "6", y = 0, yend = 76),
color = "#5D9CEC",
linewidth = 0.9,
inherit.aes = FALSE
) +
# "Median Score" blue label badge positioned to the left of tick 6
annotate(
"label",
x = 12.1, # Index 13 is '6'; 12.1 places the tag directly to its left
y = 76,
label = "Median Score",
fill = "#5D9CEC",
color = "white",
size = 3.6,
fontface = "bold",
label.size = 0,
label.padding = unit(0.35, "lines"),
label.r = unit(0.35, "lines")
) +
# Circular "6" indicator badge centered over the line at y = 76
annotate(
"point",
x = 13,
y = 76,
size = 9,
color = "white"
) +
annotate(
"point",
x = 13,
y = 76,
size = 8.2,
color = "#EBF2F7"
) +
annotate(
"text",
x = 13,
y = 76,
label = "6",
color = "#4A90E2",
size = 4,
fontface = "bold"
) +
scale_y_continuous(
limits = c(0, 105),
breaks = seq(0, 100, by = 10),
labels = function(x) paste0(x, "%"),
expand = c(0, 0)
) +
labs(
title = "IELTS Score Distribution for Higher Education (General)",
subtitle = "• • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • •",
x = "IELTS Scores",
y = "Percentile Distributions",
caption = "IELTS General Score for Higher Education (Image Credit: Sojourning Scholar)"
) +
theme_minimal() +
theme(
plot.title = element_text(
color = "#0E98BA",
face = "bold",
size = 13,
hjust = 0.5,
margin = margin(b = 2)
),
plot.subtitle = element_text(
color = "#F39C12",
size = 8,
hjust = 0.5,
margin = margin(b = 20)
),
plot.caption = element_text(
color = "gray50",
size = 8.5,
hjust = 0,
margin = margin(t = 12)
),
axis.title.x = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(t = 15)
),
axis.title.y = element_text(
color = "gray30",
face = "bold",
size = 10,
margin = margin(r = 10)
),
axis.text.x = element_text(
color = "gray40",
size = 9
),
axis.text.y = element_text(
color = "gray40",
size = 9
),
axis.line.x = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.line.y = element_line(color = "#E0E0E0", linewidth = 0.8),
axis.ticks = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = "#C0C0C0", linewidth = 1),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(t = 20, r = 20, b = 15, l = 20)
)## Warning in annotate("label", x = 12.1, y = 76, label = "Median Score", fill =
## "#5D9CEC", : Ignoring unknown parameters: `label.size`print(p_general_dist)## Warning in geom_segment(aes(x = "6", xend = "6", y = 0, yend = 76), color = "#5D9CEC", : All aesthetics have length 1, but the data has 19 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
Information and a link to the dataset.
https://github.com/rfordatascience/tidytuesday/blob/main/data/2026/2026-08-18/readme.md original visualization: https://sojourningscholar.com/ielts-score-statistics/
A paragraph on your plan to improve the data visualization.
Combine IELTS academic score and general score by region into one plot; the current boxplot uses big bars, replace bars with dot and line, which is easier to understand; Use different color to mark academic score and general score.
Combine IELTS academic score and general score by reason into one plot; replace bars with dot and line; use different color to mark academic score and general score; present all the categories of reason instead of just three
Combine IELTS academic score and general score for higher education into one plot; replace bars with curve line; delete scores from 0 to 3.0 on x-axis as no values; mark the percent for median score; add a note that the reason “for higher education” contains two category of “For higher education short course (three months or less)” and “For higher education extended course (three months or more)”. ## The code and your improved data visualization.
IELTS score by region
unique(demo_by_nationality[[5]])## [1] "2024-2025" "2023-2024" "2022-2023"unique(demo_by_nationality[[2]])## [1] "Azerbaijan" "Bangladesh"
## [3] "Cambodia" "China"
## [5] "Colombia" "Egypt"
## [7] "France" "Germany"
## [9] "Ghana" "Hong Kong"
## [11] "India" "Indonesia"
## [13] "Iran, Islamic Republic of" "Italy"
## [15] "Japan" "Jordan"
## [17] "Kazakhstan" "Kenya"
## [19] "Korea, Republic of" "Kuwait"
## [21] "Malaysia" "Mexico"
## [23] "Mongolia" "Myanmar"
## [25] "Nepal" "Nigeria"
## [27] "Oman" "Pakistan"
## [29] "Philippines" "Russian Federation"
## [31] "Saudi Arabia" "Spain"
## [33] "Sri Lanka" "Taiwan"
## [35] "Thailand" "Turkey"
## [37] "Ukraine" "United Arab Emirates"
## [39] "Uzbekistan" "Vietnam"
## [41] "Algeria" "Argentina"
## [43] "Brazil" "Cameroon"
## [45] "Chile" "Mauritius"
## [47] "Peru" "South Africa"
## [49] "United States of America" "Zimbabwe"
## [51] "Lebanon" "Morocco"
## [53] "Tunisia" "Uganda"
## [55] "Bhutan" "Hong Kong, SAR of China"
## [57] "Iran" "Qatar"library(ggplot2)
library(dplyr)
library(stringr)
library(ggrepel)
all_country_region_map <- tibble::tribble(
~nationality, ~region,
"Azerbaijan", "Central Asia & Caucasus",
"Bangladesh", "South & Southeast Asia",
"Cambodia", "South & Southeast Asia",
"China", "East Asia",
"Colombia", "Latin America",
"Egypt", "Middle East & North Africa",
"France", "Europe",
"Germany", "Europe",
"Ghana", "Sub-Saharan Africa",
"Hong Kong", "East Asia",
"Hong Kong, SAR of China", "East Asia",
"India", "South & Southeast Asia",
"Indonesia", "South & Southeast Asia",
"Iran, Islamic Republic of", "Middle East & North Africa",
"Iran", "Middle East & North Africa",
"Italy", "Europe",
"Japan", "East Asia",
"Jordan", "Middle East & North Africa",
"Kazakhstan", "Central Asia & Caucasus",
"Kenya", "Sub-Saharan Africa",
"Korea, Republic of", "East Asia",
"Kuwait", "Middle East & North Africa",
"Malaysia", "South & Southeast Asia",
"Mexico", "North America",
"Mongolia", "East Asia",
"Myanmar", "South & Southeast Asia",
"Nepal", "South & Southeast Asia",
"Nigeria", "Sub-Saharan Africa",
"Oman", "Middle East & North Africa",
"Pakistan", "South & Southeast Asia",
"Philippines", "South & Southeast Asia",
"Russian Federation", "Europe",
"Saudi Arabia", "Middle East & North Africa",
"Spain", "Europe",
"Sri Lanka", "South & Southeast Asia",
"Taiwan", "East Asia",
"Thailand", "South & Southeast Asia",
"Turkey", "Middle East & North Africa",
"Ukraine", "Europe",
"United Arab Emirates", "Middle East & North Africa",
"Uzbekistan", "Central Asia & Caucasus",
"Vietnam", "South & Southeast Asia",
"Algeria", "Middle East & North Africa",
"Argentina", "Latin America",
"Brazil", "Latin America",
"Cameroon", "Sub-Saharan Africa",
"Chile", "Latin America",
"Mauritius", "Sub-Saharan Africa",
"Peru", "Latin America",
"South Africa", "Sub-Saharan Africa",
"United States of America", "North America",
"Zimbabwe", "Sub-Saharan Africa",
"Lebanon", "Middle East & North Africa",
"Morocco", "Middle East & North Africa",
"Tunisia", "Middle East & North Africa",
"Uganda", "Sub-Saharan Africa",
"Bhutan", "South & Southeast Asia",
"Qatar", "Middle East & North Africa"
)plot_combined_leaders <- demo_by_nationality %>%
filter(type %in% c("Academic", "General", "General_Training")) %>%
mutate(
nationality = case_when(
str_detect(nationality, "Hong Kong") ~ "Hong Kong",
str_detect(nationality, "Iran") ~ "Iran",
TRUE ~ str_trim(nationality)
),
band_num = if_else(band %in% c("<4", "Below 4"), 3.5, as.numeric(band)),
percent = as.numeric(percent),
type_label = case_when(
type == "Academic" ~ "Academic",
TRUE ~ "General Training"
)
) %>%
group_by(type_label, nationality) %>%
summarize(
mean_score = sum(band_num * percent, na.rm = TRUE) / sum(percent, na.rm = TRUE),
.groups = "drop"
) %>%
inner_join(all_country_region_map %>% distinct(nationality, region), by = "nationality") %>%
group_by(region, type_label) %>%
slice_max(order_by = mean_score, n = 1, with_ties = FALSE) %>%
ungroup() %>%
mutate(
final_score = round(mean_score, 1),
callout = paste0(nationality, " (", sprintf("%.1f", final_score), ")")
)## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `band_num = if_else(band %in% c("<4", "Below 4"), 3.5,
## as.numeric(band))`.
## Caused by warning in `vec_if_else()`:
## ! NAs introduced by coercion# 3. Calculate region anchor positions for connecting segments
region_spans <- plot_combined_leaders %>%
group_by(region) %>%
summarize(
min_score = min(final_score),
max_score = max(final_score),
top_score = max(final_score),
.groups = "drop"
) %>%
arrange(desc(top_score))
# Order regions by descending performance
plot_combined_leaders <- plot_combined_leaders %>%
mutate(region = factor(region, levels = rev(region_spans$region)))
region_spans <- region_spans %>%
mutate(region = factor(region, levels = rev(region_spans$region)))
# 4. Render Gestalt dumbbell plot
p_dual_gestalt <- ggplot() +
geom_vline(xintercept = seq(6.0, 9.0, by = 0.5), color = "#ECEFF1", linewidth = 0.5) +
geom_segment(
data = region_spans,
aes(x = min_score, xend = max_score, y = region, yend = region),
color = "#CFD8DC",
linewidth = 1.3,
inherit.aes = FALSE
) +
geom_point(
data = plot_combined_leaders,
aes(
x = final_score, # <-- Fixed: changed from 'band' to 'final_score'
y = region,
color = type_label,
fill = type_label,
shape = type_label
),
size = 2.8,
stroke = 0.9,
inherit.aes = FALSE
) +
geom_text_repel(
data = plot_combined_leaders,
aes(x = final_score, y = region, label = callout, color = type_label),
size = 2.5,
fontface = "bold",
box.padding = 0.4,
point.padding = 0.35,
force = 3,
show.legend = FALSE,
inherit.aes = FALSE
) +
scale_color_manual(
values = c("Academic" = "#0E98BA", "General Training" = "#D95F02")
) +
scale_fill_manual(
values = c("Academic" = "#E0F7FA", "General Training" = "#FBE9E7")
) +
scale_shape_manual(
values = c("Academic" = 21, "General Training" = 22)
) +
scale_x_continuous(
limits = c(5.9, 9.4),
breaks = seq(6.0, 9.0, by = 0.5),
expand = expansion(mult = c(0.01, 0.08))
) +
labs(
title = "Highest Regional Mean IELTS Scores: Academic vs. General Training",
subtitle = "Comparing the top-performing national benchmark within each macro-region by test module",
x = "Mean Band Score",
y = NULL,
color = "Test Module",
fill = "Test Module",
shape = "Test Module"
) +
theme_minimal(base_size = 11) +
theme(
panel.grid = element_blank(),
axis.line.x = element_line(color = "#B0BEC5", linewidth = 0.6),
axis.text.y = element_text(face = "bold", color = "#263238", size = 9.5),
axis.text.x = element_text(color = "gray40", size = 8.5),
axis.title.x = element_text(face = "bold", color = "gray30", margin = margin(t = 10)),
legend.position = "top",
legend.justification = "right",
legend.title = element_text(face = "bold", size = 9.5),
legend.text = element_text(size = 9),
legend.margin = margin(b = 6),
plot.title = element_text(face = "bold", size = 10, color = "#1A252C"),
plot.subtitle = element_text(size = 8, color = "gray45", margin = margin(b = 14)),
plot.margin = margin(t = 15, r = 50, b = 15, l = 15)
)
print(p_dual_gestalt)
### IELTS score by reasons
library(ggplot2)
library(dplyr)
library(stringr)
library(ggrepel)
reason_col_name <- colnames(demo_by_reasons)[!colnames(demo_by_reasons) %in% c("type", "band", "percent", "year")][1]
plot_data_all_reasons <- demo_by_reasons %>%
rename(reason_raw = all_of(reason_col_name)) %>%
filter(
type %in% c("Academic", "General_Training"),
!is.na(reason_raw),
reason_raw != ""
) %>%
mutate(
band_num = if_else(band %in% c("<4", "Below 4"), 3.5, as.numeric(band)),
percent = as.numeric(percent),
type_label = if_else(type == "Academic", "Academic", "General Training"),
reason_clean = str_wrap(str_trim(reason_raw), width = 32)
) %>%
group_by(reason_clean, type_label) %>%
summarize(
mean_score = sum(band_num * percent, na.rm = TRUE) / sum(percent, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(final_score = round(mean_score, 1))## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `band_num = if_else(band %in% c("<4", "Below 4"), 3.5,
## as.numeric(band))`.
## Caused by warning in `vec_if_else()`:
## ! NAs introduced by coercionreason_span_summary <- plot_data_all_reasons %>%
group_by(reason_clean) %>%
summarize(
min_score = min(final_score),
max_score = max(final_score),
avg_score = mean(final_score),
.groups = "drop"
) %>%
arrange(avg_score)
plot_data_all_reasons <- plot_data_all_reasons %>%
mutate(reason_clean = factor(reason_clean, levels = reason_span_summary$reason_clean))
reason_span_summary <- reason_span_summary %>%
mutate(reason_clean = factor(reason_clean, levels = reason_span_summary$reason_clean))
p_all_reasons <- ggplot() +
geom_vline(xintercept = seq(5.5, 7.5, by = 0.5), color = "#ECEFF1", linewidth = 0.5) +
geom_segment(
data = reason_span_summary,
aes(x = min_score, xend = max_score, y = reason_clean, yend = reason_clean),
color = "#CFD8DC",
linewidth = 1.3,
inherit.aes = FALSE
) +
geom_point(
data = plot_data_all_reasons,
aes(
x = final_score,
y = reason_clean,
color = type_label,
fill = type_label,
shape = type_label
),
size = 4.2,
stroke = 1.2,
inherit.aes = FALSE
) +
geom_text_repel(
data = plot_data_all_reasons,
aes(
x = final_score,
y = reason_clean,
label = sprintf("%.1f", final_score),
color = type_label
),
size = 3.3,
fontface = "bold",
box.padding = 0.3,
point.padding = 0.35,
force = 2.5,
show.legend = FALSE,
inherit.aes = FALSE
) +
scale_color_manual(
values = c("Academic" = "#0E98BA", "General Training" = "#D95F02")
) +
scale_fill_manual(
values = c("Academic" = "#E0F7FA", "General Training" = "#FBE9E7")
) +
scale_shape_manual(
values = c("Academic" = 21, "General Training" = 22)
) +
scale_x_continuous(
limits = c(5.4, 7.5),
breaks = seq(5.5, 7.5, by = 0.5),
expand = expansion(mult = c(0.02, 0.06))
) +
labs(
title = "Mean IELTS Scores Across All Stated Reasons: Academic vs. General Training",
subtitle = "Horizontal spans indicate performance gap between modules; categories ranked by overall score",
x = "Mean Band Score",
y = NULL,
color = "Test Module",
fill = "Test Module",
shape = "Test Module"
) +
theme_minimal(base_size = 11) +
theme(
panel.grid = element_blank(),
axis.line.x = element_line(color = "#B0BEC5", linewidth = 0.6),
axis.text.y = element_text(face = "bold", color = "#263238", size = 8.5),
axis.text.x = element_text(color = "gray40", size = 8.5),
axis.title.x = element_text(face = "bold", color = "gray30", margin = margin(t = 10)),
legend.position = "top",
legend.justification = "right",
legend.title = element_text(face = "bold", size = 8),
legend.text = element_text(size = 8),
legend.margin = margin(b = 6),
plot.title = element_text(face = "bold", size = 10, color = "#1A252C"),
plot.subtitle = element_text(size = 8, color = "gray45", margin = margin(b = 14)),
plot.margin = margin(t = 15, r = 35, b = 15, l = 15)
)
print(p_all_reasons)
### median score for higher education
library(ggplot2)
library(dplyr)
library(stringr)
reason_col <- colnames(demo_by_reasons)[!colnames(demo_by_reasons) %in% c("type", "band", "percent", "year")][1]
active_bands <- c("3.5", "4", "4.5", "5", "5.5", "6", "6.5", "7", "7.5", "8", "8.5", "9")
combined_cdf_data <- demo_by_reasons %>%
rename(reason_raw = all_of(reason_col)) %>%
filter(
type %in% c("Academic", "General_Training"),
str_detect(
reason_raw,
regex("extended course|short course|higher education", ignore_case = TRUE)
)
) %>%
mutate(
band_clean = case_when(
band %in% c("<4", "Below 4") ~ "3.5",
TRUE ~ as.character(band)
),
percent = as.numeric(percent) * 100,
type_label = if_else(type == "Academic", "Academic", "General Training")
) %>%
group_by(type_label, band_clean) %>%
summarize(total_percent = mean(percent, na.rm = TRUE), .groups = "drop") %>%
tidyr::complete(type_label, band_clean = active_bands, fill = list(total_percent = 0)) %>%
mutate(band_num = as.numeric(band_clean)) %>%
arrange(type_label, band_num) %>%
group_by(type_label) %>%
mutate(
percentile_dist = cumsum(total_percent),
band_clean = factor(band_clean, levels = active_bands)
) %>%
ungroup()
acad_val_6 <- combined_cdf_data %>%
filter(type_label == "Academic", band_num == 6.0) %>%
pull(percentile_dist) %>%
round(1)
gen_val_6 <- combined_cdf_data %>%
filter(type_label == "General Training", band_num == 6.0) %>%
pull(percentile_dist) %>%
round(1)
if (length(acad_val_6) == 0) acad_val_6 <- 52.0
if (length(gen_val_6) == 0) gen_val_6 <- 63.0
p_higher_ed_combined <- ggplot(
data = combined_cdf_data,
aes(
x = band_num,
y = percentile_dist,
color = type_label,
group = type_label
)
) +
geom_hline(yintercept = 50, linetype = "dashed", color = "#B0BEC5", linewidth = 0.7) +
annotate(
"text",
x = 3.4,
y = 52.5,
label = "50th Percentile (Median Threshold)",
color = "gray40",
size = 3,
hjust = 0,
fontface = "italic"
) +
geom_vline(xintercept = 6.0, color = "#CFD8DC", linewidth = 0.8, linetype = "dotted") +
geom_line(linewidth = 1.3, alpha = 0.9) +
geom_point(
aes(shape = type_label, fill = type_label),
size = 3.4,
stroke = 1.2
) +
annotate(
"label",
x = 5,
y = acad_val_6 + 1,
label = paste0("Academic Median: 6.0 (", acad_val_6, "%)"),
color = "#0E98BA",
fill = "#E0F7FA",
size = 2,
fontface = "bold",
label.size = 0.3
) +
annotate(
"label",
x = 5,
y = gen_val_6 + 5,
label = paste0("General Median: 6.0 (", gen_val_6, "%)"),
color = "#D95F02",
fill = "#FBE9E7",
size = 2,
fontface = "bold",
label.size = 0.3
) +
scale_color_manual(values = c("Academic" = "#0E98BA", "General Training" = "#D95F02")) +
scale_fill_manual(values = c("Academic" = "white", "General Training" = "white")) +
scale_shape_manual(values = c("Academic" = 21, "General Training" = 22)) +
scale_x_continuous(
breaks = seq(3.5, 9.0, by = 0.5),
limits = c(3.5, 9.1)
) +
scale_y_continuous(
limits = c(0, 103),
breaks = seq(0, 100, by = 10),
labels = function(y) paste0(y, "%"),
expand = expansion(mult = c(0, 0.02))
) +
labs(
title = "Higher Education IELTS Score Percentile Distribution",
subtitle = "Comparing cumulative score growth for Academic vs. General Training applicants",
caption = "Note: Higher Education includes both 'For higher education extended course (three months or more)' and 'For higher education short course (three months or less)'.",
x = "IELTS Score Band",
y = "Cumulative Percentile (P ≤ Score)",
color = "Test Module",
shape = "Test Module",
fill = "Test Module"
) +
theme_minimal(base_size = 11) +
theme(
panel.grid.major.y = element_line(color = "#ECEFF1", linewidth = 0.5),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_line(color = "#F0F0F0", linewidth = 0.4),
legend.position = "top",
legend.justification = "right",
legend.title = element_text(face = "bold", size = 9.5),
legend.text = element_text(size = 9),
axis.title.x = element_text(face = "bold", color = "gray25", size = 10, margin = margin(t = 10)),
axis.title.y = element_text(face = "bold", color = "gray25", size = 10, margin = margin(r = 10)),
axis.text = element_text(color = "gray35", size = 9),
plot.title = element_text(face = "bold", size = 13, color = "#1A252C"),
plot.subtitle = element_text(size = 9.5, color = "gray45", margin = margin(b = 14)),
plot.caption = element_text(size = 5, color = "gray45", face = "italic", hjust = 0, margin = margin(t = 12)),
plot.margin = margin(t = 15, r = 25, b = 15, l = 15)
)## Warning in annotate("label", x = 5, y = acad_val_6 + 1, label =
## paste0("Academic Median: 6.0 (", : Ignoring unknown parameters: `label.size`## Warning in annotate("label", x = 5, y = gen_val_6 + 5, label = paste0("General
## Median: 6.0 (", : Ignoring unknown parameters: `label.size`print(p_higher_ed_combined)## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_text()`).
A few paragraphs on how the data visualization addresses the issues with Gestalt theory and the visual perception research.
graph IELTS score by region: The original regional displays relied on thick, identical vertical bars resting on truncated baselines, which distorted score ratios and created heavy visual noise. Replacing these with a horizontal dot-and-stem plot eliminates baseline distortion and strengthens Figure-Ground separation by stripping away unnecessary chart borders and grid clutter. Sorting the regions from highest to lowest score provides Continuity, while assigning distinct high-contrast colors to values score 7.0 introduces an explicit Focal Point that directs immediate attention to the top global performers.
graph IELTS score by reason: The original plot presents Academic and General Training results across separate figures forced readers to glance back and forth. Consolidating both test types onto a shared horizontal stem for each reason applies the Law of Proximity, placing corresponding data points in immediate physical contact. This transforms what were once fragmented measurements into a unified visual comparison, allowing viewers to instantly evaluate the performance gap within each category.
graph IELTS score with the reason for higher education: The separate percentile bar charts hid the underlying cumulative S-curve and wasted nearly a third of the canvas displaying empty zero-percent categories between bands 0 and 3.0. Filtering out those empty score bands zooms the frame into the active score region, and changing solid bars into overlapping line plots applies Continuity so both cohorts can be compared along a smooth, unbroken path. Integrating a horizontal 50th-percentile reference line immediately reveals the true distributional spread at band 6.0, clarifying differences that previously appeared as identical median badges.
A brief discussion of any major issues, snags, or hurdles you ran into and overcame during the process.
We can’t turn visual design rules into actual R code just once; it takes trial and error to get the layout right. Our biggest challenge was merging the separate Academic and General Training charts into single, shared views without making them feel messy or crowded. Instead of sticking with side-by-side bar charts that competed for space, we switched to paired dot plots and overlapping curve lines, which made direct comparisons much more natural. Our main concern came from label overlap and spacing issues. Long country names, dual scores, and text tags kept running into each other or getting cut off at the edge of the image. Fixing these snags meant repeatedly nudging plot margins, tweaking axis limits, and tuning automatic label placement. Ultimately, it showed that clean, readable charts depend just as much on careful fine-tuning of the details as they do on good design theory.