Imagine you are trying to predict whether some particular person has some particular trait. What the trait is does not matter. It could be a genetic disease, it could be a preference for a particular song, it could be a dialect or a way of speaking. It could be anything. What matters, for the purposes of predicting it, is how heritable the trait is.
The mechanism of heritability can be important for deciding what kind of evolutionary model you use. A model of direct genetic inheritance will be a different model from indirect genetic and non-genetic models of inheritance. But at the core, the first thing you have to establish is whether the trait is heritable at all, because if the trait is not heritable you need a non-evolutionary model.
So for this exercise, we can look at a scenario where, say, 72% of people whose parents have a trait share that trait. 72% of people whose parents have the disease also have the disease. 72% of people whose parents like a song also like that song. That tells us something, but what exactly it tells us is a little unclear. Just knowing that 72% of people whose parents like a song also like that song is, on its own, meaningless without a base rate to compare it to. That is what we are going to explore below.
p1 <- 0.72 # parents have itp2 <- 0.72 # parents do notparent <- rep(c(1, 0), each = 100)child <- rbinom(200, 1, ifelse(parent == 1, p1, p2))# what knowing the parent moves your answer byp1 - p2# the same move, as a correlationr <- cor(parent, child); r# and what that correlation is worth about one person1 - sqrt(1 - r^2)
When we are interested in predicting changes in the frequency of something over time, whether or not that thing is passed from parents to offspring is a crucial aspect for predicting. And we call that heritability.
The mechanism of heritability can be important for refining our model and our predictions. But if it is not heritable, we are not going to be using an evolutionary model. Likewise, no matter what the mechanism of heritability is, an evolutionary model will work. How we measure heritability is older than our knowledge of DNA, and is largely unconnected. Plenty of things that do not use DNA at all evolve. DNA is not in any way, shape or form required for it. Even in scenarios where DNA plays a role, it does not always play the role students might expect.
For this exercise we are going to look at limbs. There is essentially zero heritable variation for limb count in human populations. So even though limb count itself is genetic, variation in limb count is not heritable directly, genetically.
That said, other things can be heritable. If I tell you somebody's parent had black lung because they were a coal miner, the probability that their child has black lung is extremely high. Not because the parent passes black lung on directly, but because the probability somebody becomes a coal miner is a lot higher if their parent was a coal miner, and the probability someone gets black lung is a lot higher if they are a coal miner. So you are not inheriting black lung directly. However, the frequency of black lung within a given population is something that evolves, because the propensity itself is a heritable trait. Not perfectly heritable — but as we saw above, perfect heritability is not a thing we will ever get.
In this you are going to explore a pathway by which a heritable latency can influence a phenotype.
acc <- 0.00 # chance a given limb is lostrisk <- 0.00 # how much of the risk is passed onn <- 1200zp <- rnorm(n) # the parent's own riskzc <- risk*zp + sqrt(1-risk^2)*rnorm(n) # inherited from itpr <- function(z) { p <- plogis(qlogis(acc) + 4.2*z) p * acc / mean(p) # hold the marginal rate}par_limbs <- 4 - rbinom(n, 2, pr(zp))kid_limbs <- 4 - rbinom(n, 2, pr(zc))var(rep(4, n)) # the genetic variation: zero, alwayscor(par_limbs, kid_limbs)
A lot of birds choose their mates based on the song that they sing, and a lot of birds learn the song from their fathers. Males will often sing a song that sounds like their father's, and females will often prefer a song that sounds like the song her father sang.
The song is learned, but it also drives mating success and mate identity in a lot of birds without any genetic connection — without any genetic driver of the song itself.
We are going to explore an example of this system, where you are going to look at the correlation in song between an offspring and the parent that raised it, and between an offspring and the parent it came from, based on whether the eggs were swapped at laying.
cp <- 0.00 # learningegg <- 0.00 # genetic basis for the songn <- 600G <- rnorm(n) # the father's heritable song value# the song he actually singsdad <- egg*G + sqrt(1-egg^2)*rnorm(n)tutor <- if (swap) dad[sample(n)] else dadve <- max(0.05, 1 - (cp^2 + egg^2 + 2*cp*egg^2))chick <- cp*tutor + egg*G + sqrt(ve)*rnorm(n)cor(chick, dad) # the biological fathercor(chick, tutor) # the adopted father
Francis Galton was Charles Darwin's cousin, and a horrible racist who ended up inventing the term eugenics. He wanted to prove, at least to himself, that being related to people of stature indicated something about an individual's quality. He spent a large fraction of his life trying to study the question of heritability.
He was working in 1885. There was absolutely no indication of how heritability worked, and in fact he did a lot of things incorrectly. It would be basically 50 years before DNA was nailed down as the molecule of inheritance. His work, despite its misguided factual basis and rather horrible motivations, was nonetheless very successful at its job of finding a way to measure heritability.
We are going to explore his data. 205 families who all had their heights measured, which lets us plot 934 grown children against their parents. Set the heritability, and then find how much of a child's height the heritability does not reach.
g <- read.csv("data/clean/galton_families.csv")g$kid <- g$childHeight * ifelse(g$gender == "female", 1.08, 1)g$mp <- g$midparentHeighth2 <- 0.00 # the heritability of heightpred <- mean(g$kid) + h2 * (g$mp - mean(g$mp))sqrt(mean((g$kid - pred)^2)) # how far off your line issd_other <- 0.50 # the other factors, in inches# what the band holds inside one strip of parentscol <- g$mp >= 68.0 & g$mp < 69.5mean(abs(g$kid[col] - pred[col]) <= sd_other)# the numbers the line hands back on its ownfit <- lm(kid ~ mp, data = g)coef(fit)[2] # the heritabilitysd(resid(fit)) # the other factors you just foundsd(g$kid) # and the spread with no parents at all# a different number off the same fitsummary(fit)$r.squared # the share the heritability accounts forcor(g$mp, g$kid)