Merge pull request 'chapter-update' (#7) from chapter-update into main

Reviewed-on: #7

Chapter_7.Rmd

@@ -0,0 +1,375 @@
+# Chapter 7
+
+## 7.1.2.  Visualizing Transmission Pathways from Material Patterns
+
+
+## 7.2.1 Rogers' paradox
+
+Social learning can be individually advantageous without increasing the mean
+fitness of the population thus preventing the trait to be selected.  This is **Rogers' paradox** [@rogers1988]. Social learners avoid the cost of individual learning, but the information they copy must ultimately be produced by individual learners. If initialy this mean on average the population wil have a higher fitness htan individual learner alone (as the social learner don't pay the price of learning), the more social learner "invade", or the more individual learner "adopt" social learning, the less accurate (and thus lower fitness) the bheavior will be. As social learning becomes common, adaptive information becomes scarcer after the environment changes.
+The original result is illustrated in Rogers' Figure 1. Social learners have high fitness when rare, their fitness falls as they become common, and mean population fitness returns to the individual-learning baseline where the two strategies have equal fitness.
+
+```{r rogers-original, echo=FALSE, out.width="70%", fig.align="center", fig.cap="Rogers' original illustration of the paradox. Source: Rogers (1988), Figure 1."}
+knitr::include_graphics("images/chapter-7/roger-1988-fig1.png")
+```
+
+### A direct reproduction of Rogers' result
+
+In Rogers' figure, fitness is expressed relative to the constant fitness of individual learners, $W_I = 1$.  Social learners have twice that fitness when they are rare, but their fitness falls linearly as social learning becomes more frequent ; this models the fact that, the more social learner, the less likely accurate/usefull information qill be find.
+
+$$
+W_S(p) = 2(1-p).
+$$
+
+The population mean is the frequency-weighted fitness of the two strategies:
+
+$$
+\bar{W}(p) = (1-p)W_I + pW_S(p) = 1 + p - 2p^2.
+$$
+
+```{r rogers-direct-plot, fig.width=7.5, fig.height=5.2, fig.cap="A direct reproduction of the relationships in Rogers' original figure. The social- and individual-learning strategies have equal fitness at p = 0.5, where population mean fitness has returned to the individual-learning baseline."}
+proportion_social <- seq(0, 1, length.out = 101)
+rogers_individual_fitness <- rep(1, length(proportion_social))
+rogers_social_fitness <- 2 * (1 - proportion_social)
+rogers_population_fitness <-
+  (1 - proportion_social) * rogers_individual_fitness +
+  proportion_social * rogers_social_fitness
+
+plot(
+  proportion_social,
+  rogers_individual_fitness,
+  type = "l",
+  lwd = 3,
+  lty = 2,
+  col = "#BD573B",
+  ylim = c(0, 2.05),
+  xlab = "Proportion of social learners",
+  ylab = "Relative fitness",
+  las = 1
+)
+lines(
+  proportion_social,
+  rogers_social_fitness,
+  lwd = 3,
+  col = "#176B68"
+)
+lines(
+  proportion_social,
+  rogers_population_fitness,
+  lwd = 3,
+  col = "#D4962F"
+)
+points(0.5, 1, pch = 21, cex = 1.4, bg = "white")
+legend(
+  "topright",
+  legend = c("Individual learners", "Social learners", "Population mean"),
+  col = c("#BD573B", "#176B68", "#D4962F"),
+  lty = c(2, 1, 1),
+  lwd = 3,
+  bty = "n"
+)
+```
+
+The mean initially rises because social learning, who don't pay a price for learning, increases the overall fitness of the populaiton.  At $p = 0.5$, social and individual learners have equal fitness, but mean fitness is only back at the all-individual baseline. Changing the mixture of learning strategies has therefore not produced a lasting population-level benefit. In other word, there is no situation where having social . 
+By formalising this intuition, Roger opened the possibility to explore much omre than that
+
+### A simple model in which people copy one another
+
+Let's put Roger's intuition in a cultural evolution context: individual can choose to adopt one of the two strategies, by copying what other are doing in the population.
+
+In our model, individual learners always acquire the behaviour suited to the current environment, but pay a fitness cost. Social learners pay no cost and copy a randomly selected member of the previous generation. When the environment changes, previously copied behaviour is no longer adaptive.
+
+
+```{r rogers-simulation}
+set.seed(1988)
+
+population_size <- 2000
+generations <- 600
+burn_in <- 100
+social_proportions <- seq(0, 1, by = 0.05)
+
+# Parameters used in 02_testSocialLearn.Rmd.
+environment_update_probability <- 0.8
+sigma_selection <- 0.2
+sigma_individual <- 0.8
+sigma_social <- 4
+
+# This is the fitness equation used by evosolearn::fitness().
+individual_match_fitness <- exp(-1 / (2 * sigma_individual^2))
+social_match_fitness <- exp(-1 / (2 * sigma_social^2))
+social_mismatch_fitness <- exp(
+  -1 / (2 * sigma_selection^2) - 1 / (2 * sigma_social^2)
+)
+
+# The report first attempts an update with probability 0.8, then changes the
+# environment in half of those cases. Every population gets the same sequence.
+environment_changed <-
+  runif(generations) < environment_update_probability &
+  runif(generations) < 0.5
+
+fitness_results <- matrix(
+  NA_real_,
+  nrow = length(social_proportions),
+  ncol = 4,
+  dimnames = list(
+    NULL,
+    c("social_proportion", "individual", "social", "population")
+  )
+)
+
+for (i in seq_along(social_proportions)) {
+  proportion_social <- social_proportions[i]
+  number_social <- round(population_size * proportion_social)
+  number_individual <- population_size - number_social
+
+  # Initially everyone has behaviour suited to the environment.
+  correct_previous_generation <- population_size
+  individual_fitness <- social_fitness <- population_fitness <- numeric(generations)
+
+  for (generation in seq_len(generations)) {
+    probability_social_copy_is_correct <- if (environment_changed[generation]) {
+      0
+    } else {
+      correct_previous_generation / population_size
+    }
+
+    correct_social_learners <- if (number_social == 0) {
+      0
+    } else {
+      rbinom(1, number_social, probability_social_copy_is_correct)
+    }
+
+    individual_fitness[generation] <- individual_match_fitness
+    social_fitness[generation] <-
+      probability_social_copy_is_correct * social_match_fitness +
+      (1 - probability_social_copy_is_correct) * social_mismatch_fitness
+    population_fitness[generation] <- (
+      number_individual * individual_fitness[generation] +
+        correct_social_learners * social_match_fitness +
+        (number_social - correct_social_learners) * social_mismatch_fitness
+    ) / population_size
+
+    correct_previous_generation <-
+      number_individual + correct_social_learners
+  }
+
+  generations_to_measure <- (burn_in + 1):generations
+  fitness_results[i, ] <- c(
+    proportion_social,
+    mean(individual_fitness[generations_to_measure]),
+    mean(social_fitness[generations_to_measure]),
+    mean(population_fitness[generations_to_measure])
+  )
+}
+```
+
+```{r rogers-simulation-plot, fig.width=7.5, fig.height=5.2, fig.cap="A minimal reproduction of Rogers' paradox. Social learning is favoured when rare, but mean fitness at the strategy equilibrium is approximately the same as in a population of individual learners."}
+relative_fitness <- fitness_results
+relative_fitness[, c("individual", "social", "population")] <-
+  fitness_results[, c("individual", "social", "population")] /
+  fitness_results[, "individual"]
+
+strategy_equilibrium <- which.min(abs(
+  relative_fitness[, "social"] - relative_fitness[, "individual"]
+))
+equilibrium_proportion <-
+  relative_fitness[strategy_equilibrium, "social_proportion"]
+
+plot(
+  relative_fitness[, "social_proportion"],
+  relative_fitness[, "individual"],
+  type = "l",
+  lwd = 3,
+  lty = 2,
+  col = "#BD573B",
+  ylim = c(0, max(relative_fitness[, c("social", "population")]) * 1.08),
+  xlab = "Proportion of social learners",
+  ylab = "Relative fitness",
+  las = 1
+)
+lines(
+  relative_fitness[, "social_proportion"],
+  relative_fitness[, "social"],
+  lwd = 3,
+  col = "#176B68"
+)
+lines(
+  relative_fitness[, "social_proportion"],
+  relative_fitness[, "population"],
+  lwd = 3,
+  col = "#D4962F"
+)
+abline(v = equilibrium_proportion, lty = 3, col = "#5F6865")
+points(
+  equilibrium_proportion,
+  relative_fitness[strategy_equilibrium, "population"],
+  pch = 21,
+  cex = 1.4,
+  bg = "white",
+  col = "#24292F"
+)
+text(
+  equilibrium_proportion,
+  0.08,
+  labels = "strategy equilibrium",
+  pos = 4,
+  cex = 0.9,
+  col = "#45514E"
+)
+legend(
+  "topright",
+  legend = c("Individual learners", "Social learners", "Population mean"),
+  col = c("#BD573B", "#176B68", "#D4962F"),
+  lty = c(2, 1, 1),
+  lwd = 3,
+  bty = "n"
+)
+```
+
+### Temporal dynamics in a changing environment
+
+The frequency plots average over many generations and therefore hide the
+short-term process that produces the paradox. We can instead follow one
+population through time. Here its proportion of social learners is fixed at
+the estimated strategy equilibrium from the preceding simulation.
+
+```{r rogers-temporal-simulation}
+temporal_social_proportion <- equilibrium_proportion
+temporal_number_social <- round(
+  population_size * temporal_social_proportion
+)
+temporal_number_individual <-
+  population_size - temporal_number_social
+
+environment_state <- cumsum(environment_changed)
+correct_previous_generation <- population_size
+
+temporal_results <- matrix(
+  NA_real_,
+  nrow = generations,
+  ncol = 4,
+  dimnames = list(
+    NULL,
+    c("individual", "social", "population", "proportion_correct")
+  )
+)
+
+for (generation in seq_len(generations)) {
+  probability_social_copy_is_correct <- if (environment_changed[generation]) {
+    0
+  } else {
+    correct_previous_generation / population_size
+  }
+
+  correct_social_learners <- rbinom(
+    1,
+    temporal_number_social,
+    probability_social_copy_is_correct
+  )
+
+  temporal_results[generation, "individual"] <- individual_match_fitness
+  temporal_results[generation, "social"] <-
+    probability_social_copy_is_correct * social_match_fitness +
+    (1 - probability_social_copy_is_correct) * social_mismatch_fitness
+  temporal_results[generation, "population"] <- (
+    temporal_number_individual * individual_match_fitness +
+      correct_social_learners * social_match_fitness +
+      (temporal_number_social - correct_social_learners) *
+        social_mismatch_fitness
+  ) / population_size
+  temporal_results[generation, "proportion_correct"] <- (
+    temporal_number_individual + correct_social_learners
+  ) / population_size
+
+  correct_previous_generation <-
+    temporal_number_individual + correct_social_learners
+}
+```
+
+```{r rogers-temporal-plot, fig.width=8, fig.height=6.5, fig.cap="Temporal dynamics at the estimated strategy equilibrium. Environmental changes make inherited behaviour obsolete, sharply reducing social-learner fitness; individual learners then reintroduce adaptive information that can be copied in subsequent generations."}
+generations_to_show <- seq_len(120)
+change_generations <- which(environment_changed[generations_to_show])
+relative_temporal_fitness <-
+  temporal_results[, c("individual", "social", "population")] /
+  individual_match_fitness
+
+old_par <- par(
+  mfrow = c(2, 1),
+  mar = c(2, 4.5, 1, 1),
+  oma = c(3, 0, 0, 0)
+)
+
+plot(
+  generations_to_show,
+  environment_state[generations_to_show],
+  type = "s",
+  lwd = 2,
+  col = "#45514E",
+  xlab = "",
+  ylab = "Environment",
+  las = 1
+)
+points(
+  change_generations,
+  environment_state[change_generations],
+  pch = 16,
+  cex = 0.55,
+  col = "#BD573B"
+)
+
+plot(
+  generations_to_show,
+  relative_temporal_fitness[generations_to_show, "population"],
+  type = "n",
+  ylim = range(
+    0,
+    relative_temporal_fitness[generations_to_show, ],
+    finite = TRUE
+  ),
+  xlab = "",
+  ylab = "Relative fitness",
+  las = 1
+)
+abline(
+  v = change_generations,
+  col = adjustcolor("#BD573B", alpha.f = 0.16),
+  lwd = 0.7
+)
+lines(
+  generations_to_show,
+  relative_temporal_fitness[generations_to_show, "individual"],
+  lwd = 2.2,
+  lty = 2,
+  col = "#BD573B"
+)
+lines(
+  generations_to_show,
+  relative_temporal_fitness[generations_to_show, "social"],
+  lwd = 2.2,
+  col = "#176B68"
+)
+lines(
+  generations_to_show,
+  relative_temporal_fitness[generations_to_show, "population"],
+  lwd = 2.2,
+  col = "#D4962F"
+)
+legend(
+  "topright",
+  legend = c("Individual learners", "Social learners", "Population mean"),
+  col = c("#BD573B", "#176B68", "#D4962F"),
+  lty = c(2, 1, 1),
+  lwd = 2.2,
+  bty = "n",
+  cex = 0.9
+)
+mtext("Generation", side = 1, outer = TRUE, line = 1)
+
+par(old_par)
+```
+
+The social-learning strategy can spread while it performs better than costly individual learning. At the marked equilibrium, however, both strategies have approximately equal fitness and population mean fitness is close to the all-individual baseline. Social learning has spread, but it has not produced a corresponding increase in population fitness.
+
+### Reference
+
+Rogers, A. R. (1988). Does biology constrain culture? *American Anthropologist*, 90(4), 819--831.