Diffusion of adaptations via social learning

Part I: the Legacy-Adaptive and Legacy-Adaptive-Legacy contagion models

Dr. Matthew A. Turner, PhD

2025-01-15

Legacy-adaptive (LA) model

Recall the discrete recursion formula for the legacy-adaptive model is

\[ A_{t+1} = A_t + \alpha A_t (1 - \frac{A}{N}) \]

Coding the legacy-adaptive model

In the code below, note we use tmax for \(T\) because T is a built-in variable name that stands for logical TRUE.

Code

la_recursion <- function(N, A0, alpha, tmax) {
  A_return <- numeric(N+1)  # Create output time series vector.
  # Set current A_t to be A_0
  At <- A0
  A_return[1] <- At
  # Iterate 
  for (t in 1:tmax) {
    # Anext is code for A_{t+1}
    Anext <- At + (alpha * At * (1 - (At/N)))
    A_return[t+1] <- Anext
    At <- Anext
  }
  return (A_return)
}

Analyzing the legacy-adaptive model

Let’s compare the LA model output for two values of the adoption rate, \(\alpha=0.2,0.8.\)

Code

N <- 100
A0 <- 5
alpha_low <- 0.05
tmax <- 200
tvec <- 0:tmax
Avec_low_alpha <- la_recursion(N, A0, alpha_low, tmax)

alpha_high <- 0.8
Avec_high_alpha <- la_recursion(N, A0, alpha_high, tmax)

adopt_tbl <- tibble(timestep = rep(tvec, 2), 
                    alpha = 
                      as_factor(c(rep(alpha_low, length(tvec)), 
                                  rep(alpha_high, length(tvec)))),
                    A = c(Avec_low_alpha, Avec_high_alpha))

ggplot(adopt_tbl, aes(x=timestep, y=A, color=alpha)) +
  geom_line() + theme_classic()

Legacy-adaptive-legacy (LAL) model

Need to subtract the fraction of those doing \(A\) who regress to do \(L\) with probability \(\delta\).

\[ A_{t+1} = A_t + \alpha A_t (1 - \frac{A_t}{N}) - \delta A_t \]

Formal analysis of the LAL model

First, consider what happens at \(t\approx0\) to calculate \(R_0\) for adoption which tells us whether an adaptation will spread at all (Smaldino MSB p. 100, section 4.5.2)
Second, calculate the equilibrium as \(t\to\infty\), denoted \(A_\infty\). This can be thought of as the average number of people doing an adaptive behavior (Smaldino MSB p. 95-99 section 4.5)

A first real-world network: the Medicis in 1400 Florence

Code

data("florentine_m")
# Delete Pucci family (isolated)
florentine_m <- delete_vertices(florentine_m, which(degree(florentine_m) == 0))

# plot the graph
set.seed(111)
plot(florentine_m,
  vertex.label.cex = .9,
  vertex.size = 20,
  vertex.label.color = "black",
  vertex.color = "white",
  vertex.frame.color = "gray"
)

Figure 1: Florentine marriage network where edges represent marriages between families (node labels).