add gama distribution skill exemple
This commit is contained in:
parent
cbbce66fe4
commit
20236097ee
1 changed files with 139 additions and 0 deletions
139
Chapter_8.Rmd
Normal file
139
Chapter_8.Rmd
Normal file
|
|
@ -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)
|
||||||
|
```
|
||||||
Loading…
Reference in a new issue