model-section.Rmd

---
title: "Model section"
output: 
  bookdown::pdf_document2:
    toc: false
    latex_engine: xelatex
    number_sections: false
    keep_tex: true
bibliography: bibliography.bib
header-includes:
  - \usepackage{subfig}
  - \usepackage{setspace}\onehalfspacing
  - \usepackage{amsmath}
  - \usepackage{amsfonts}
  - \usepackage{amsthm}
  - \usepackage{mitpress}
  - \newtheorem{prop}{Proposition}
  - \newtheorem{claim}{Claim}
editor_options: 
  chunk_output_type: console
---

```{r set-echo-off, include = FALSE}
knitr::opts_chunk$set(echo = FALSE)

#options(rgl.useNULL = TRUE)

invisible(loadNamespace("rootSolve"))
invisible(loadNamespace("rgl"))
library(ggplot2)
library(dplyr)

rgl::setupKnitr(
        autoprint = TRUE, 
        rgl.newwindow = FALSE, 
        rgl.closewindows = FALSE
      )
```

People in the marriage market have two characteristics: 
$x=\left( x_{1},x_{2}\right)$, drawn from a normal distribution 
\[
\mathcal{N}
\left( 
\begin{array}{c}
0 \\ 
0%
\end{array}%
,%
\begin{array}{cc}
s^{2} & \sigma \\ 
\sigma & S^{2}%
\end{array}%
\right).
\]
We interpret $x_1$ as a genetic measure, for example of genetic variants predicting
height, physical attractiveness, health or intelligence. $x_2$ is a measure of 
socio-economic status, such as income or wealth, or social status more generally
(we sometimes use "wealth" as a shorthand). The correlation between 
$x_1$ and $x_2$ is
\[
Corr = \frac{\sigma }{sS} < 1.
\]
People's attractiveness is given by
\[
i\left( x\right) =ax_{1}+\left( 1-a\right) x_{2}
\]
where $a \in [0, 1]$ is a parameter reflecting the relative importance of
genetics to wealth in the marriage market.[^a-interpretation] If $a = 0$,
marriage markets are highly inegalitarian, such that only SES matters. If $a =
1$, marriage markets are economically egalitarian and only genetics matter. We
expect realistic societies to fall between these extremes, with $0 < a < 1$.
Then, both genes and SES matter to attractiveness, and as a result,
social-genetic assortative mating (SGAM) takes place.[^not-direct]

[^not-direct]: This model does not assume that people match *directly* on 
genetics, which most observers agree would be unlikely. Instead we assume that
genetics may contribute to an attractive phenotype which is matched on.

Attractiveness $i$ is
distributed $N(0,\sigma_{I}^{2})$, where
\[
\sigma _{I}^{2}=a^{2}s^{2}+\left( 1-a\right) ^{2}S^{2}+2a\left( 1-a\right)\sigma.
\]

[^a-interpretation]: Note that since the variance of the shocks to $x_1$ and $x_2$
(see below) has been normalized to 1, $a$ also reflects this variance. That
is, a large variance of SES shocks (compared to genetic shocks) translates into 
$a$ being large. 

People form matches with transferable utility, where the surplus for a match
between $x$ and $y$ is $S(i(x), i(y))$ such that $\partial^{2}S/\partial
i\partial j > 0$, i.e. $S$ is supermodular. As a result there is positive
assortative mating on attractiveness: $x$ matches with $y$ only if they are at
the same quantile of attractiveness, i.e. if $i(x_{1},x_{2}) = i(y_{1},y_{2})$.
Within attractiveness quantiles, matching is random. This is the
SGAM mechanism.

We also consider random matching as a benchmark to compare against SGAM. Under
random matching, the distribution of couples' characteristics is normal with
mean 0 and covariance matrix
\[
\mathbb{C}\left( 
\begin{array}{c}
x_{1} \\ 
x_{2} \\ 
y_{1} \\ 
y_{2}%
\end{array}%
\right) =\allowbreak \left( 
\begin{array}{cccc}
s^{2} & \sigma & 0 & 0 \\ 
\sigma & S^{2} & 0 & 0 \\ 
0 & 0 & s^{2} & \sigma \\ 
0 & 0 & \sigma & S^{2}%
\end{array}%
\right). \allowbreak 
\]

Our first proposition shows that if SGAM is taking place, i.e. if $0 < a < 1$, then
there is a positive correlation between one partner's wealth and the other
partner's genetics.

\begin{proposition}\label{prop-couples-SGAM}
Under SGAM, the distribution of couples' characteristics is normal, with mean 0
and covariance matrix
\begin{equation}\label{cov-couples-SGAM}
\mathbb{C}\left( 
\begin{array}{c}
x_{1} \\ 
x_{2} \\ 
y_{1} \\ 
y_{2}%
\end{array}%
\right) =\allowbreak \left( 
\begin{array}{cccc}
s^{2} & \sigma  & A^{2} & AC \\ 
\sigma  & S^{2} & AC & C^{2} \\ 
A^{2} & AC & s^{2} & \sigma  \\ 
AC & C^{2} & \sigma  & S^{2}%
\end{array}%
\right) \allowbreak 
\end{equation}
where:
\begin{align*}
A &= \frac{as^{2}+\left( 1-a\right) \sigma }{\sqrt{a^{2}s^{2}+\left(
1-a\right) ^{2}S^{2}+2a\left( 1-a\right) \sigma }} &= \frac{as^{2}+\left( 1-a\right) \sigma }{\sigma_I}; \\
C &= \frac{a\sigma +\left( 1-a\right) S^{2}}{\sqrt{a^{2}s^{2}+\left(
1-a\right) ^{2}S^{2}+2a\left( 1-a\right) \sigma }} &= \frac{a\sigma +\left( 1-a\right) S^{2}}{\sigma_I}.
\end{align*}

In particular, the covariance between $x_2$ and $y_1$, $AC$, is positive if
either $x_1$ and $x_2$ are already correlated ($\sigma > 0$) or if they are
uncorrelated ($\sigma = 0$) and the attractiveness parameter $a$ is strictly
between 0 and 1.

\begin{proof}
See Appendix.
\end{proof}
\end{proposition}

We consider the distribution of couples' wealth. Under random matching this has 
mean $0$ and variance $2S^2$. Under SGAM, the variance is:
\[
V(x_{2}+y_{2}) = 2S^{2} + 2C^{2} \ge 2S^{2} 
\]
with strict inequality if $a < 1$ or $\sigma > 0$. The variance is decreasing in 
$a$ and equals $4S^2$ if $a = 0$. Thus, SGAM increases cross-sectional inequality, 
but less so than pure matching on wealth.


## Children

All couples have the same number of children. A child's characteristics are 
given by:
\begin{eqnarray}
x_{1}^{\prime } &=&\frac{\tau }{2}\left( x_{1}+y_{1}\right) +\varepsilon
\label{Chil} \\
x_{2}^{\prime } &=&\frac{\theta }{2}\left( x_{2}+y_{2}\right) +\eta 
\nonumber
\end{eqnarray}
where $x$ and $y$ are the child's parents, and $\varepsilon$ and $\eta$ are
independent normal random shocks with mean $0$ and variance $1$.

Parameter $\tau \approx 1$ reflects genetic inheritance. Under standard biological
assumptions $\tau = 1$ and characteristics show no regression to the mean. In our
model this leads the variance of $x_1$ to grow without limit over generations.
In reality, we expect $\tau < 1$ because very extreme characteristics are
selected against, a process known as stabilizing selection 
[@schmalhausen1949factors; @sanjak2018evidence].

Parameter $\theta \in [0, 1]$ reflects inheritance of SES. Unlike $\tau$ it may vary
between societies. $\theta$ is high when there is high intergenerational
transmission of SES. Thus, $\theta$ captures social and economic institutions 
that affect this intergenerational transmission, from taxation and
public education to hereditary nobility. If we interpret $x_2$ narrowly as 
wealth, $1 - \theta$ can be thought of as the rate of inheritance tax. 

For the time being, we assume that a person's genetic endowment has no impact on
their SES. Technically, thus, $x_{2}^\prime$ does not directly depend on
$x_{1}^\prime$. In a meritocratic society we would expect adult SES to partly depend
on genetics. We show that even absent meritocracy, correlations between $x_1^\prime$ and
$x_{2}^\prime$ can arise. In an extension below, we relax this assumption and allow
meritocracy.

We can now calculate the covariance matrix for 
$x^\prime = (x_{1}^{\prime }, x_{2}^{\prime })$ under SGAM as: 

\begin{eqnarray}
\mathbb{C} &=&\left( 
\begin{array}{cc}
1 & 0 \\ 
0 & 1%
\end{array}%
\right) +\left( 
\begin{array}{cccc}
\frac{\tau }{2} & 0 & \frac{\tau }{2} & 0 \\ 
0 & \frac{\theta }{2} & 0 & \frac{\theta }{2}%
\end{array}%
\right) \allowbreak \left( 
\begin{array}{cccc}
s^{2} & \sigma  & A^{2} & AC \\ 
\sigma  & S^{2} & AC & C^{2} \\ 
A^{2} & AC & s^{2} & \sigma  \\ 
AC & C^{2} & \sigma  & S^{2}%
\end{array}%
\right) \allowbreak \left( 
\begin{array}{cc}
\frac{1}{2}\tau  & 0 \\ 
0 & \frac{1}{2}\theta  \\ 
\frac{1}{2}\tau  & 0 \\ 
0 & \frac{1}{2}\theta 
\end{array}%
\right) \nonumber \\
&=&\left( 
\begin{array}{cc}
\frac{1}{2}A^{2}\tau ^{2}+\frac{1}{2}s^{2}\tau ^{2}+1 & \frac{1}{2}\theta
\sigma \tau +\frac{1}{2}AC\theta \tau  \\ 
\frac{1}{2}\theta \sigma \tau +\frac{1}{2}AC\theta \tau  & \frac{1}{2}%
C^{2}\theta ^{2}+\frac{1}{2}S^{2}\theta ^{2}+1%
\end{array}%
\right) \allowbreak \label{cov-children-SGAM}
\end{eqnarray}
\newline

We now explore two issues. First, under SGAM, genetic characteristics are no
longer exogenous; because of assortative matching, they are (partly) socially
determined. In particular, even if genetics and SES are uncorrelated among
parents, the expected genetic endowment of the child is positively related to
parental SES. Second, as a result, in the long run a correlation appears between
traits; that is, high SES people inherit genes that are attractive in marriage
markets.

Regarding point 1, we compute the expected genetic characteristic of the
child, conditional on parental wealth:
\[
\mathbb{E}\left[ \frac{\tau }{2}\left( x_{1}+y_{1}\right) +\varepsilon \mid
x_{2}=v,y_{2}=w\right] 
\]
Given the symmetry of the model, this conditional
expectation only depends on the parents' total wealth, i.e. $v+w$.

\begin{claim}\label{claim-E-children-RM}
Under random matching, the expected genetic endowment of the children is
proportional to the parents' SES and to the covariance between SES and genetics
for the parents. In particular, if $\sigma = 0$ (i.e. genetics and SES are
uncorrelated for the parents), then the expected genetic endowment of the
children does not depend on parental SES.
\end{claim}

\begin{claim}\label{claim-E-children-SGAM}
Under SGAM, if $\sigma = 0$ (i.e. genetics and
SES are uncorrelated for the parents), then the expected genetic endowment of
the children is linearly increasing in parental SES. The relationship
increases with the ratio of genetic variance to SES variance, is zero for 
$a = 0$ or $a = 1$, and is highest for intermediate values of $a$.
\end{claim}


Next, we study the correlation between children's traits 1 and 2 as a function
of $\sigma$, the covariance of parents' traits. We first consider the
general case, then concentrate on $\sigma = 0$, i.e. when traits are initially
uncorrelated.

\begin{claim}\label{claim-corr-children-RM}
Under random matching, the correlation between characteristics is smaller
for children than for parents. In particular, if genetics and SES are
uncorrelated for the parents, then they are uncorrelated for the children.
\end{claim}

\begin{claim}\label{claim-corr-children-SGAM}
Under SGAM, if genetics and SES are uncorrelated for the parents, then they
are positively correlated for the children so long as $0 < a < 1$. The 
correlation is increasing in $\theta$.
\end{claim}

Whether characteristics are more or less correlated for children than for
parents depends on whether the initial correlation between parents'
characteristics is larger or smaller than the asymptotic one, derived below.

Figure \ref{fig:pic-intuition} shows the intuition behind the model. Parents 
match on downward-sloping attractiveness isoquants given by $a x_1 + (1-a) x_2 = u$.
Their children are in between them on both dimensions. This compresses the
distribution along the attractiveness isoquants, which leads to a 
positive correlation between genetics and SES. The correlation between $x^\prime_1$
and $x^\prime_2$ is 0 when $a = 0$ or $a = 1$, because then spouses don't trade off
SES for genes. It is highest for intermediate values of $a$.

```{r pic-intuition, fig.subcap = c("Parents", "Children"), fig.cap = "Theory. The shaded area is the population distribution. Parents (solid circles) match along attractiveness isoquants (dotted lines). Children (hollow circles) are between them. As a result, the children's distribution is squeezed along attractiveness isoquants, and $x_1$ and $x_2$ become associated.", fig.ncol = 2, fig.width = 2.75, fig.height = 2.4, fig.align='center', echo = FALSE}
setup_plot <- function () {
  par(mar = rep(2.1, 4))
  plot.new()
  plot.window(c(-1.2, 1.2), c(-1.2, 1.2))
  arrows(x0 = -1.1, x1 = 1.1, y0 = -1.1, length = .1)
  arrows(y0 = -1.1, y1 = 1.1, x0 = -1.1, length = .1)
  text(-1.1, 1.2, expression(x[2]), cex = 0.75)
  text(1.2, -1.1, expression(x[1]), cex = 0.75)
}
draw_dist <- function (w) {
  if (! is.matrix(w)) w <- matrix(c(w, 0, 0, 1), nrow = 2)
  mygrey <- grey(.8, .03)
  for (rad in seq(0.2, 1, 0.1)) {
    v <- car::ellipse(c(0, 0), shape = w, radius = rad, add = TRUE, center.pch = NULL,
               fill = TRUE, col = mygrey, lwd = 0, segments = 241)
  }
  
  v
}
draw_dist_with_a <- function (width, shift) {
  setup_plot()  
  v <- draw_dist(width)
  nr_v <- nrow(v)
  
  rotation <- (-shift + seq_len(nr_v)) %% nr_v
  rotation[rotation == 0] <- nr_v
  
  v <- v[rotation, ]
  v_rev <- v[nr_v:1, ]
  
  ivls <- quantile(seq_len(nr_v/2), seq(0.2, 0.8, .2), type = 1)
  
  start_x <- v[ivls, 1]
  end_x   <- v_rev[ivls, 1]
  start_y <- v[ivls, 2]
  end_y <- v_rev[ivls, 2]
  
  segments(x0 = start_x, x1 = end_x, y0 = start_y, y1 = end_y, lty = 2)  
  
  ivls <- ivls[2:3]

  start_x <- mean(v[ivls, 1])
  end_x   <- mean(v_rev[ivls, 1])
  start_y <- mean(v[ivls, 2])
  end_y   <- mean(v_rev[ivls, 2])
  inset <- 0.15
  
  along <- function (tt) list(
    x = start_x + tt * (end_x - start_x),
    y = start_y + tt * (end_y - start_y)
  )
  
  end_inset <- 0.15
  starts <- along(c(inset, 1 - inset))
  ends   <- along(c(0.5 - end_inset, 0.5 + end_inset))
  pts <- along(c(inset/2, .5, .5, 1 - inset/2))
  pts$x[2] <- pts$x[2] - 0.05
  pts$x[2] <- pts$x[2] - 0.1
  pts$x[3] <- pts$x[3] + 0.01
  pts$x[3] <- pts$x[3] + 0.04
  arrows(x0 = starts$x, x1 = ends$x, y0 = starts$y, y1 = ends$y,
         length = 0.05)
  
  points(x = pts$x, y = pts$y, pch = c(19, 21, 21, 19), cex = 0.8)
}

draw_dist_with_a(.8, -30)
setup_plot()
invisible(draw_dist(matrix(c(1, .4, .4, .8), nrow = 2)))
```


These results show that SGAM can lead to a genes-SES gradient, i.e. a positive
correlation between genes and SES. Also, the strength of the genes-SES
correlation is affected by economic institutions, as captured in $\theta$.
When $\theta$ is high, the genes-SES correlation is high too. 

We now consider the asymptotic distribution of $x_1$ and $x_2$ when the matching 
process is repeated over many generations. As we would expect, our main results 
continue to hold.

\begin{proposition}\label{prop-asymptotics-RM}
Under random matching, the dynamics converges to a stationary distribution that 
is normal with mean zero and covariance matrix 
\[
\mathbb{C}\left(\begin{array}{cc}
x_1  \\
x_2
\end{array}
\right)
=
\left( 
\begin{array}{cc}
\frac{2}{2-\tau ^{2}} & 0 \\ 
0 & \frac{2}{2-\theta ^{2}}%
\end{array}%
\right) \allowbreak 
\]%
In particular, the traits are asymptotically uncorrelated and children's
expected genetic endowment is independent of parents' wealth.

\end{proposition}


\begin{proposition}\label{prop-asymptotics-SGAM}
Under SGAM, for $\theta <1$ and $\tau <1$, the dynamics converge to a stationary
distribution that is normal with mean zero and covariance matrix 
\[
\mathbb{C}\left(\begin{array}{cc}
x_1  \\
x_2
\end{array}
\right)
=
\left(
\begin{array}{cc}
\bar{s}^{2} & \bar{\sigma} \\ 
\bar{\sigma} & \bar{S}^{2}%
\end{array}%
\right) 
\]
Moreover, the asymptotic correlation between characteristics, 
$corr = \bar{\sigma}/\bar{s}\bar{S}$, is non-negative, positive for $0 < a < 1$, 
increasing in $\theta$ and increasing then decreasing in $a$. 
The coefficient of parents' wealth on children's genetics is also positive 
for $0 < a < 1$.

For $\theta = 1$, the dynamics diverge and $\bar{S}^{2}$ goes to $+\infty$; for 
$\tau = 1$, the dynamics diverges and $\bar{s}^{2}$ goes to $+\infty$.

\end{proposition}


```{r calc-compute-asymptotics}

# this is D in the proof of prop-asymptotics-SGAM in the appendix
D <- function (a, lambda, mu) {
  a^2 * lambda + (1-a)^2 + 2*a*(1-a)*mu
}

# this is A^2/S^2 in the proof 
Astar <- function (a, lambda, mu) {
  D <- D(a, lambda, mu)
  (a*lambda + (1-a)*mu)^2/D
}

# this is sqrt(Astar * Cstar) = AC/S^2
Bstar <- function (a, lambda, mu) {
  D <- D(a, lambda, mu)
  (a*lambda + (1-a)*mu)*(a*mu + (1-a))/D
}

# this is C^2/S^2 in the proof
Cstar <- function (a, lambda, mu) {
  D <- D(a, lambda, mu)
  (a*mu + (1-a))^2/D
}

# A zero of H is a fixed point of the invariant matrix at the
# start of the proof, rewritten in terms of lambda and mu
# where lambda = s^2/S^2, mu = sigma/S^2
# x is (lambda, mu)
# aa is a (renamed to avoid a partial match in rootSolve::multiroot)
H <- function (x, tau, aa, theta) {
  a <- aa
  lambda <- x[1]
  mu <- x[2]
  Astar <- Astar(a, lambda, mu)
  Bstar <- Bstar(a, lambda, mu)
  Cstar <- Cstar(a, lambda, mu)
  root1 <- tau^2/2 * (Astar + lambda) -
           theta^2/2 * (Cstar + 1) + 1 - lambda
  root2 <- theta*tau/2 * (mu + Bstar) - mu
  
  c(root1, root2)
}


heritability <- function (theta, a) {
  tau <- 0.95
  # find a zero of H
  res <- rootSolve::multiroot(H, start = c(0, 0), tau = tau, aa = a, theta = theta)
  root <- res$root
  # mu/sqrt(lambda) = sigma/Ss = correlation of x1 and x2
  corr <- root[2]/sqrt(root[1])
  
  return(corr^2)
}


# this calculates the equilibrium standard deviation of x_2 "wealth"
equilibrium_S <- function (theta, a) {
  tau <- 0.95
  # find a zero of H
  res <- rootSolve::multiroot(H, start = c(0, 0), tau = tau, 
                              aa = a, theta = theta)
  root <- res$root
  lambda <- root[1]
  mu <- root[2]
  
  # Cstar = C^2/S^2; this equation is at the end of the proof
  S_squared <- 1/(1 - theta^2/2 - theta^2 * Cstar(a, lambda, mu) / 2)
  
  S <- sqrt(S_squared)

  return(S)
}
```


```{r pic-asymptotic-corr, fig.align = "center", fig.cap = "Long-run correlation between genetics $x_1$ and SES $x_2$, by weight of genetics in spouse matching ($a$) and strength of inheritance of SES ($\\theta$). $\\tau$ = 0.95.", dpi = 300}

invisible(rgl::open3d(
              userMatrix = rgl::rotate3d(rgl::r3dDefaults$userMatrix, 
                                           angle = pi/5, x = 0, y = 0, 
                                           z = 1)
            ))
rgl::par3d(cex = 1.4)

rgl::plot3d(
             Vectorize(heritability),
             xlim  = c(0, 0.95),
             ylim  = c(0, 0.99), # 1 gives an error
             zlab  = "",
             xlab  = "θ", 
             col   = "darkgreen",
             front = "lines",
             lwd   = 3,
             n     = 40,
             box   = FALSE
           )
rgl::mtext3d("Heritability", "z-+", line = 6)

```


Figure \@ref(fig:pic-asymptotic-corr) plots the asymptotic squared correlation
between $x_1$ and $x_2$. In genetic terms, this is the heritability of SES. It is
maximized for intermediate levels of $a$. Note that both $\bar{S}^{2}$ and
$\bar{\sigma}$, as well as the correlation between characteristics and the
conditional expectation of genetics given wealth, are increasing in $\theta$.
Higher transmission of SES increases inequality of SES in equilibrium
(unsurprisingly), but also the heritability of SES.

## Extensions

We consider three extensions. First, the relative attractiveness of genes and 
SES might differ for men and women. Our basic result extends to this setup.

\begin{claim}\label{claim-men-women-different}
Suppose that men's and women's attractiveness is given by
\begin{align*}
i(x) &= ax_1 + (1-a)x_2, \\
j(y) &= by_1 + (1-b)y_2
\end{align*}
respectively, with $0\le a \le 1$, $0 \le b \le 1$. Then if $\sigma = 0$, children's 
characteristics $x^\prime_1$ and $x^\prime_2$ will be positively correlated 
unless $a = b = 0$ or $a = b = 1$. The correlation is increasing in $\theta$.

\end{claim}

Interestingly, the $x_1$-$x_2$ correlation is highest when $a$ and $b$ are most
different from each other. So gender differences in what counts as attractive
make the effects of SGAM stronger. Intuitively, if one sex only assorts on 
SES while the other sex only assorts on genetics, this induces a very reliable
correlation between genes and SES in couples, since (e.g.) every high-SES male 
is matched for sure with a high-genetics female.

Second, in modern meritocracies, people's adult SES depends not just 
on their parents' social status and on chance, but also on their own effort and
skills, which might be related to their genetics. So, let
\begin{align}
x^\prime_1 &= \tau \frac{x_{1} + y_{1}}{2} + \varepsilon   \nonumber \\
x^\prime_2 &= \gamma x^\prime_1 + \theta \frac{x_{2}+y_{2}}{2}+\eta \label{eqn-gamma}
\end{align}
where $\gamma > 0$ represents the effect of own genetics on own SES. $\gamma$
can be thought of as measuring meritocratic mobility, but alternatively as the
degree of overlap between genes that matter in marriage markets and in labour
markets. The basic result continues to hold, and also, $\gamma$ 
increases the correlation between genes and SES; a highly meritocratic
society may in the long run lead to a steep genes-SES gradient.

\begin{proposition}\label{prop-gamma}
Under SGAM and equation \eqref{eqn-gamma}, if genetics and SES are 
uncorrelated for the parents, then they
are positively correlated for the children so long as $0 < a < 1$ or
$\gamma > 0$. The correlation is increasing in $\gamma$. Also, so 
long as $\gamma > 0$ and either $0 < a < 1$ or $\sigma > 0$, the coefficient 
of parents' wealth on children's wealth exceeds $\theta$.
\end{proposition}

Figure \@ref(fig:pic-heritability-inequality) plots computed equilibrium values
of two interesting outcomes: economic inequality, i.e. the standard deviation of
$x_2$, and heritability of SES, i.e. the squared correlation between $x_1$ and $x_2$.
Meritocratic mobility $\gamma$, which opens a pathway from highly transmissible
genetics to SES, always increases both inequality and heritability 
[cf. @Rimfeld_2018]. The effect of $a$ is more complex. At low levels of 
meritocracy, increasing $a$ decreases inequality by reducing assortative mating 
by SES, and intermediate values of $a$ increase heritability by assorting
SES with genetics. As meritocratic mobility increases, it acts as a multiplier
for the effects of $a$ on both outcomes, and $a$ starts to increase both
heritability and inequality, for almost all values. Again, this is because 
$a$ increases assortation by highly transmissible genetics which in turn
affect SES. In particular, consider a broad social "modernization", in which
the direct transmission of SES and the role of SES in matching decrease, while
meritocratic mobility increases since careers become open to talents. If the 
decrease in $\theta$ does not outweigh the increase in $a$ and $\gamma$, both 
equilibrium heritability and inequality of SES may increase.


```{r calc-inequality-corr-gamma-theta}

# We compute equilibrium covariance by setting
# [s^2   sigma]
# [sigma S^2  ]
# equal to the children's covariance matrix in proposition prop-gamma


# These are equal to sigma_I, A and C as defined in the proof of Proposition 1
sigma_I <- function (s2, S2, sigma, a) {
  sqrt(a^2 * s2 + (1-a)^2 * S2 + 2*a*(1-a)*sigma)
}

A <- function (s2, S2, sigma, a) {
  sigma_I <- sigma_I(s2, S2, sigma, a)
  
  (a*s2 + (1-a)*sigma)/sigma_I
}

C <- function (s2, S2, sigma, a) {
  sigma_I <- sigma_I(s2, S2, sigma, a)
  
  (a*sigma + (1-a)*S2)/sigma_I
}

# When this function returns zero, the children's covariance matrix 
# equals the parents' covariance matrix.
# Using `aa` avoids a partial match in rootSolve::multiroot below
cov_matrix_changes <- function (x, aa, tau, theta, gamma) {
  a <- aa
  s2 <- x[1]
  S2 <- x[2]
  sigma <- x[3]
  
  A <- A(s2, S2, sigma, a)
  C <- C(s2, S2, sigma, a)
  
  kid_s2 <- tau^2/2 * (s2 + A^2) + 1
  
  kid_S2 <- gamma^2 * tau^2 / 2 * (s2 + A^2) + 
            gamma * tau * theta * (sigma + A*C) + 
            theta^2 / 2 * (S2 + C^2) + 
            1 + gamma^2
  
  kid_sigma <- gamma * tau^2 / 2 * (s2 + A^2) + 
               tau * theta / 2 * (sigma + A*C) + 
               gamma
  
  changes <- c(kid_s2 - s2, kid_S2 - S2, kid_sigma - sigma)
  return(changes)
}


eqm_covariance <- function (a, tau, theta, gamma) {
  x <- rootSolve::multiroot(cov_matrix_changes, 
                            start = c(s2 = 1, S2 = 1, sigma = 0),
                            aa = a, tau = tau, theta = theta, gamma = gamma)
  x$root
}


eqm_heritability <- function (a, tau, theta, gamma) {
  eqm_cov <- eqm_covariance(a, tau, theta, gamma)
  corr <- eqm_cov["sigma"] / sqrt(eqm_cov["s2"] * eqm_cov["S2"])
  corr^2
}


eqm_sd_x2 <- function (a, tau, theta, gamma) {
  eqm_cov <- eqm_covariance(a, tau, theta, gamma)
  sqrt(eqm_cov["S2"])
}

eqm_heritability <- Vectorize(eqm_heritability)
eqm_sd_x2 <- Vectorize(eqm_sd_x2)
```


```{r pic-heritability-inequality, fig.align = "center", fig.cap = "Equilibrium inequality (standard deviation of $x_2$) and heritability (squared correlation of $x_1$ and $x_2$) for different values of assortative mating $a$, meritocratic mobility $\\gamma$ and transmission of SES $\\theta$. $\\tau = 0.95$. The x axis is scaled differently between the left and right plots.", out.width = "100%"}

params <- expand.grid(
  a = 0:20/20, 
  theta = c(0.4, 0.7), 
  gamma = seq(0, 0.2, 0.05), 
  tau = 0.95
)

sd_x2 <- do.call(eqm_sd_x2, as.list(params))
heritability <- do.call(eqm_heritability, as.list(params))

params$sd_x2 <- sd_x2
params$heritability <- heritability

label_greek <- function (x) paste("theta", x)

params |>  
  mutate(
    Heritability = heritability,
    Inequality = sd_x2,
    gamma = factor(gamma)
  ) |> 
  arrange(a) |> 
  ggplot(aes(Inequality, Heritability, color = a, shape = gamma)) + 
  geom_point(size = 2) + 
  geom_path() + 
  facet_wrap(vars(theta), labeller = label_bquote(theta == .(theta)), 
             scales = "free_x") +
  scale_color_gradient2(midpoint = 0.5, mid = "grey70", transform = "reverse") +
  scale_x_continuous(limits = c(1, NA)) +
  theme_linedraw() +
  theme(
    panel.grid.minor = element_blank(),
    panel.grid.major = element_blank()
  ) +
  labs(
    shape = expression(gamma)
  )

```
Third, we consider non-normal distributions of $x_1$ and $x_2$, non-normal
shocks $\varepsilon$ and $\eta$, and non-linear attractiveness functions. Suppose
\begin{equation}\label{non-linear-f} 
i(x) = f(ax_1, (1-a)x_2) 
\end{equation}
with $f$ strictly increasing in both its arguments. Our sole condition on the
distribution of $x$ is that not everybody with attractiveness $i$ is both 
genetically and socially identical. In particular, this allows for discrete
distributions, like some kinds of social status for $x_2$, and monogenic or
oligogenic attractiveness phenotypes for $x_1$.

\begin{proposition}\label{prop-non-normal}
Let attractiveness be given by \eqref{non-linear-f}. Let $(x_1, x_2)$ have
any distribution such that a positive measure of the population has
$i(x) = i$ where the conditional distribution of $(x_1, x_2)$ given $i(x) = i$ is 
non-degenerate. Let $\eta$ and $\varepsilon$ be mean 0 and independent of
$x$ and each other. If genetics and SES are uncorrelated for the parents, then
the correlation among children is non-negative, and strictly positive if 
$0 < a < 1$.
\end{proposition}

Other extensions are possible. We assumed that all couples have the same number
of children. If fertility increased with $x_1$ or $x_2$, we would expect this to
reduce the variance of traits in the children's generation and possibly also
their covariance. Here, matching preferences, summarized by the $a$ parameter,
are exogenous; it would be natural to model $a$ as an equilibrium outcome.
For example, if parents care about their children's wealth, $a$ might decrease
in $\theta$ and increase in $\gamma$. Indeed, below we see suggestive evidence that
income is valued differently in Norwegian and British marriage markets.


## Discussion


The meanings of both social status, and "good genes" in the
marriage market, are likely to vary across societies. Social status could
encompass variables like social class or caste; ethnic identity in
"ranked" ethnic systems; or in modern societies, SES, including wealth, income
and occupation. Regarding genetics, standards of physical attractiveness, and
other genetically-influenced characteristics which make someone a "good match", 
vary across societies and over time. The central prediction of the model is that
whatever those characteristics, in the long run they will become correlated with
SES.

Recent empirical work shows high persistence of SES over time, in particular at
the top. @clark2023inheritance argues that this could be explained by unobserved 
genetic variation.
Proposition \ref{prop-gamma} shows that if genes affect own wealth directly,
under assortative mating, the regression coefficient of parents' wealth on own
wealth exceeds the "direct" coefficient $\theta$, because parents' wealth
correlates with parents' genetics and via that with own wealth.  Thus,
regressions of wealth on wealth may include the effect of unobserved genetic
variation. This may be a confound due to pre-existing gene-SES correlation (if
$\sigma > 0$). But under SGAM ($0 < a < 1$) it can also be a mediating
variable, since changes in someone's wealth may indeed affect the identity of 
their spouse, hence the genetics of their offspring, and from that their 
offspring's adult wealth.

The converse also holds: regressions of children's characteristics on their
genetics alone risk overestimating the effect of genetics, by confounding it
with the effects of correlated socio-economic status. Recent work in genetics
has shown this. Polygenic scores for educational attainment have smaller effects
in between-sibling regressions, where between-family variation in SES is
partialled out and where genetic variants are guaranteed to be randomly
allocated, than in regressions which pool the whole sample [@howe2022within].
Parents' genetic variants which are *not* passed on to children predict
children's characteristics, partly due to social stratification in the geneticists'
sense of non-random mating [@kong2018nature; @young2023estimation].

The model predicts variation in the effects of SGAM. In particular, in
"caste societies" where there is complete endogamy within social status
groups, there is no scope for SGAM, because marriage partners do not trade off
genetics for social status ($a = 0$). Also, the association between genes and
SES is increased by the institutional variable $\theta$, which captures
intergenerational persistence of SES. This implies that policy has long-run
effects on biosocial structure: reducing $\theta$ not only increases
intergenerational mobility, but reduces the correlation of genes with SES, and
hence the bias of what @harden2021genetic calls the "genetic lottery".
Conversely, reforms that increase meritocracy ($\gamma$, Proposition 
\ref{prop-gamma}) may strengthen the genes-SES gradient.