---
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.