diff --git a/Chapter_8.Rmd b/Chapter_8.Rmd new file mode 100644 index 0000000..b7f08f7 --- /dev/null +++ b/Chapter_8.Rmd @@ -0,0 +1,139 @@ +--- +title: "Chapter 8" +--- + +# Chapter 8 + +## Population size and highly skilled individuals + +We can use some theoretical distribution to represent the skills of people in a population +Using a gamma distribution here we create a scenario where most people are concentrated at lower skill levels, while a longer tail extends towards high skill. +The high-skill threshold is fixed, so increasing population size. +If people copu only the 2% most skliied individuals, then a bigger population wil mathematically increases the number of skilled individual +```{r skill-population-calculation} +population_sizes <- c(500, 1000) +skill_shape <- 2 +skill_scale <- 1.5 +high_skill_cutoff <- 6 + +high_skill_proportion <- pgamma( + high_skill_cutoff, + shape = skill_shape, + scale = skill_scale, + lower.tail = FALSE +) + +high_skill_counts <- round(population_sizes * high_skill_proportion) + +data.frame( + Population = population_sizes, + `High-skill proportion` = round(high_skill_proportion, 3), + `Expected high-skill individuals` = high_skill_counts, + check.names = FALSE +) +``` + +```{r skill-population-figure, fig.width=9, fig.height=4.5, fig.cap="The same skill distribution in two populations. The blue tail marks individuals above the high-skill threshold."} +skill_x <- seq( + 0, + qgamma(0.999, shape = skill_shape, scale = skill_scale), + length.out = 600 +) +tail_x <- skill_x[skill_x >= high_skill_cutoff] + +skill_density <- dgamma( + skill_x, + shape = skill_shape, + scale = skill_scale +) +tail_density <- dgamma( + tail_x, + shape = skill_shape, + scale = skill_scale +) +common_y_max <- max(population_sizes) * max(skill_density) * 1.18 + +line_cols <- c("#244A68", "#355E3B") +body_cols <- c("#DCE8F0", "#D4DFC8") +tail_cols <- c("#1769AA", "#3E713F") + +old_par <- par( + mfrow = c(1, 2), + mar = c(4.5, 4.5, 3, 1), + oma = c(0, 1.5, 0, 0) +) + +for (i in seq_along(population_sizes)) { + people_density <- population_sizes[i] * skill_density + high_skill_density <- population_sizes[i] * tail_density + + plot( + skill_x, + people_density, + type = "n", + xlim = range(skill_x), + ylim = c(0, common_y_max), + axes = FALSE,ylab="",xlab = "" + ) + + polygon( + c(min(skill_x), skill_x, max(skill_x)), + c(0, people_density, 0), + col = body_cols[i], + border = NA + ) + polygon( + c(high_skill_cutoff, tail_x, max(tail_x)), + c(0, high_skill_density, 0), + col = tail_cols[i], + border = NA + ) + lines(skill_x, people_density, lwd = 2.2, col = line_cols[i]) + abline(v = high_skill_cutoff, lty = 3, col = tail_cols[i]) + + axis( + 1, + at = c( + qgamma(0.1, shape = skill_shape, scale = skill_scale), + qgamma(0.93, shape = skill_shape, scale = skill_scale) + ), + labels = c("Low skill", "High skill"), + lwd = 0, + lwd.ticks = 1 + ) + axis(2, las = 1, lwd = 0, lwd.ticks = 1) + mtext("Skill level", side = 1, line = 2.5) + arrows( + min(skill_x), 0, + max(skill_x), 0, + length = 0.08, + lwd = 1.2, + xpd = NA + ) + arrows( + min(skill_x), 0, + min(skill_x), common_y_max, + length = 0.08, + lwd = 1.2, + xpd = NA + ) + + title(main = paste( + "Population:", + format(population_sizes[i], big.mark = ",") + )) + text( + high_skill_cutoff + 0.38 * (max(skill_x) - high_skill_cutoff), + people_density[which.max(skill_density)] * 0.62, + labels = paste( + format(high_skill_counts[i], big.mark = ","), + "high-skill\nindividuals" + ), + col = tail_cols[i], + font = 2 + ) +} + +mtext("Number of people", side = 2, outer = TRUE, line = 0.2) +par(old_par) +```