EACompanion/Chapter_8.Rmd
2026-08-21 11:32:45 +01:00

141 lines
3.7 KiB
Text

---
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)
```
If the skill level is transmitted culturally from these skilled individual to the next generation, we can then add different type of social transmission process to then get prediction about on the spread (and retention) of skills within the population.