Example from lecture

The lab exercise will present you with some new data on genotypes before and after selection and ask you both to estimate relative viabilities and to answer some questions about them. To illustrate how to do the analysis, I’ll use the data we covered in lecture.

First, we load the “before selection” and “after selection data into variables I creatively named before and after.

before <- c(41, 82, 27)
after <- c(57, 169, 29)

Now that we have the data loaded, we can use the function relative() in the code block below to estimate and report the fitnesses. By setting print = TRUE the results are automatically reported for us.

relative <- function(before, after, print = FALSE) {
  x_a <- after/sum(after)
  x_z <- before/sum(before)
  w_11 <- (x_a[1]/x_a[2])*(x_z[2]/x_z[1])
  w_22 <- (x_a[3]/x_a[2])*(x_z[2]/x_z[3])
  if (print) {
    result <- sprintf("Viability    %0.2f    %0.2f    %0.2f", w_11, 1, w_22)
    cat("Genotype     A1A1    A1A2    A2A2\n", result, "\n", sep = "")
  }
  return(list(w_11 = w_11, w_22 = w_22))
}

fitnesses <- relative(before, after, print = TRUE)
Genotype     A1A1    A1A2    A2A2
Viability    0.67    1.00    0.52

That’s great, but you’ve heard me harp on how important it is to get some sense of how reliable our estimates are. We know that the relative fitness of A1A2 is 1, because we’re calculating the fitness of the other genotypes relative to it. We’ll get approximate 95 percent confidence intervals by bootstrapping our samples, recalculating the fitnesses for each sample, and summarizing the result. That sounds pretty complicated, but the R code to do it isn’t too bad. By default, this code will construct 5000 bootstrap samples. Here it is:

construct_sample <- function(x) {
  k <- c(rep(1, x[1]), rep(2, x[2]), rep(3, x[3]))
  k_new <- sample(k, size = length(k), replace = TRUE)
  x_new <- c(length(k_new[k_new == 1]), length(k_new[k_new == 2]), length(k_new[k_new == 3]))
  return(x_new)
}

bootstrap_relative <- function(before, after, qtile = 0.05, n_sample = 5000) {
  w_11 <- numeric(n_sample)
  w_22 <- numeric(n_sample)
  for (i in 1:n_sample) {
    adult <- construct_sample(after)
    zygote <- construct_sample(before)
    fitnesses <- relative(zygote, adult)
    w_11[i] <- fitnesses$w_11
    w_22[i] <- fitnesses$w_22
  }
  header <- sprintf("Fitness   %4.1f%%  %4.1f%%\n", 100*qtile/2, 100*(1 - qtile/2))
  qtiles <- quantile(w_11, c(qtile/2, 1 - qtile/2))
  row_1 <- sprintf("w_11      %0.2f   %0.2f\n", qtiles[1], qtiles[2])
  qtiles <- quantile(w_22, c(qtile/2, 1 - qtile/2))
  row_2 <- sprintf("w_22      %0.2f   %0.2f\n", qtiles[1], qtiles[2])
  cat(header, row_1, row_2)
}

bootstrap_relative(before, after)
Fitness    2.5%  97.5%
 w_11      0.42   1.09
 w_22      0.28   0.95

As you can see, the 95 percent confidence interval for w_11 includes values larger than 1, meaning that at this level of confidence we can’t exclude the possibility that A1A1 has a greater viability than A1A2. In contrast, we are quite confident that A2A2 is less viable than A1A2. If we examine results using the 80 percent confidence intervals, we would conclude that A1A1 is less viable than A1A2.

bootstrap_relative(before, after, 0.2)
Fitness   10.0%  90.0%
 w_11      0.49   0.92
 w_22      0.35   0.77

I interpret these results as follows:

  1. Our best estimate is that both homozygotes have lower viabilities than the heterozygote.
  2. We are quite confident that A2A2 has a lower viability than the heterozygote, but we have only low confidence that A1A1 has lower viability than the heterozygote.
  3. On balance it appears that there is heterozygote advantage, and we would expect both alleles to persist in the population. But our confidence is low. There is a reasonable chance that there is directional selection for the A1 allele, which would lead to fixation on A1.

Lab exercise

Yoshiko Tobari and Ken-Ichi Kojima (Genetics 57:179-188; 1967) studied the evolutionary dynamics of an inversion polymorphism on chromosome 2 of Drosophila ananassae in a population cage. Through the standard sort of tricky genetic manipulations that Drosophila geneticists do, they derived two lines that were homozygous for each chromosome type. They then started different population cages with differing numbers of flies homozygous for each chromosomal arrangement. Specifically,

Population AA AB BB
1 100 0 900
2 900 0 100

After one generation of reproduction in the cage they took a sample of adults and obtained the following “genotype” counts:1

Population AA AB BB
1 19 125 156
2 206 87 7

Assume that newly formed zygotes in the generation from which the adult sample was taken are found in Hardy-Weinberg proportions with chromosome frequencies equal to those in the base populations2. Using these data answer the following questions:

  1. What are the fitnesses of AA and BB relative to AB in each population, and what are the 95% credible limits on those fitnesses?

  2. How likely is it that there is heterozygote advantage in either population?

  3. Are the relative fitnesses of the genotypes the same or different in the two populations?

  4. Given your answers to (1) & (2) and assuming that those fitnesses are the only evolutionary force acting, what do you predict about the equilibrium compositon of Drosophila ananassae populations. Will they be polymorphic? monomorphic for A? monomorphic for B? or will the result depend on initial frequencies? Be sure to explain your answer because (a) if you look up the original paper you will see the result and (b) the pattern of selection happening here is different from anything we’ve discussed in class.


  1. As usual, I’m treating a chromosome inversion type. I’ve also simplified these data a bit. The counts combine results from two replicate populations of each population configuration.↩︎

  2. In other words, the frequency of A in Population 1 is 100/1000 = 0.1.↩︎

LS0tCnRpdGxlOiAiRXN0aW1hdGluZyByZWxhdGl2ZSB2aWFiaWxpdGllcyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyMgRXhhbXBsZSBmcm9tIGxlY3R1cmUKClRoZSBsYWIgZXhlcmNpc2Ugd2lsbCBwcmVzZW50IHlvdSB3aXRoIHNvbWUgbmV3IGRhdGEgb24gZ2Vub3R5cGVzIGJlZm9yZSBhbmQgYWZ0ZXIgc2VsZWN0aW9uIGFuZCBhc2sgeW91IGJvdGggdG8gZXN0aW1hdGUgcmVsYXRpdmUgdmlhYmlsaXRpZXMgYW5kIHRvIGFuc3dlciBzb21lIHF1ZXN0aW9ucyBhYm91dCB0aGVtLiBUbyBpbGx1c3RyYXRlIGhvdyB0byBkbyB0aGUgYW5hbHlzaXMsIEknbGwgdXNlIHRoZSBkYXRhIHdlIGNvdmVyZWQgaW4gbGVjdHVyZS4KCkZpcnN0LCB3ZSBsb2FkIHRoZSAiYmVmb3JlIHNlbGVjdGlvbiIgYW5kICJhZnRlciBzZWxlY3Rpb24gZGF0YSBpbnRvIHZhcmlhYmxlcyBJIGNyZWF0aXZlbHkgbmFtZWQgYGJlZm9yZWAgYW5kIGBhZnRlcmAuCgpgYGB7cn0KYmVmb3JlIDwtIGMoNDEsIDgyLCAyNykKYWZ0ZXIgPC0gYyg1NywgMTY5LCAyOSkKYGBgCgpOb3cgdGhhdCB3ZSBoYXZlIHRoZSBkYXRhIGxvYWRlZCwgd2UgY2FuIHVzZSB0aGUgZnVuY3Rpb24gYHJlbGF0aXZlKClgIGluIHRoZSBjb2RlIGJsb2NrIGJlbG93IHRvIGVzdGltYXRlIGFuZCByZXBvcnQgdGhlIGZpdG5lc3Nlcy4gQnkgc2V0dGluZyBgcHJpbnQgPSBUUlVFYCB0aGUgcmVzdWx0cyBhcmUgYXV0b21hdGljYWxseSByZXBvcnRlZCBmb3IgdXMuIAoKYGBge3J9CnJlbGF0aXZlIDwtIGZ1bmN0aW9uKGJlZm9yZSwgYWZ0ZXIsIHByaW50ID0gRkFMU0UpIHsKICB4X2EgPC0gYWZ0ZXIvc3VtKGFmdGVyKQogIHhfeiA8LSBiZWZvcmUvc3VtKGJlZm9yZSkKICB3XzExIDwtICh4X2FbMV0veF9hWzJdKSooeF96WzJdL3hfelsxXSkKICB3XzIyIDwtICh4X2FbM10veF9hWzJdKSooeF96WzJdL3hfelszXSkKICBpZiAocHJpbnQpIHsKICAgIHJlc3VsdCA8LSBzcHJpbnRmKCJWaWFiaWxpdHkgICAgJTAuMmYgICAgJTAuMmYgICAgJTAuMmYiLCB3XzExLCAxLCB3XzIyKQogICAgY2F0KCJHZW5vdHlwZSAgICAgQTFBMSAgICBBMUEyICAgIEEyQTJcbiIsIHJlc3VsdCwgIlxuIiwgc2VwID0gIiIpCiAgfQogIHJldHVybihsaXN0KHdfMTEgPSB3XzExLCB3XzIyID0gd18yMikpCn0KCmZpdG5lc3NlcyA8LSByZWxhdGl2ZShiZWZvcmUsIGFmdGVyLCBwcmludCA9IFRSVUUpCmBgYAoKVGhhdCdzIGdyZWF0LCBidXQgeW91J3ZlIGhlYXJkIG1lIGhhcnAgb24gaG93IGltcG9ydGFudCBpdCBpcyB0byBnZXQgc29tZSBzZW5zZSBvZiBob3cgcmVsaWFibGUgb3VyIGVzdGltYXRlcyBhcmUuIFdlIGtub3cgdGhhdCB0aGUgcmVsYXRpdmUgZml0bmVzcyBvZiBgQTFBMmAgaXMgMSwgYmVjYXVzZSB3ZSdyZSBjYWxjdWxhdGluZyB0aGUgZml0bmVzcyBvZiB0aGUgb3RoZXIgZ2Vub3R5cGVzIHJlbGF0aXZlIHRvIGl0LiBXZSdsbCBnZXQgYXBwcm94aW1hdGUgOTUgcGVyY2VudCBjb25maWRlbmNlIGludGVydmFscyBieSBib290c3RyYXBwaW5nIG91ciBzYW1wbGVzLCByZWNhbGN1bGF0aW5nIHRoZSBmaXRuZXNzZXMgZm9yIGVhY2ggc2FtcGxlLCBhbmQgc3VtbWFyaXppbmcgdGhlIHJlc3VsdC4gVGhhdCBzb3VuZHMgcHJldHR5IGNvbXBsaWNhdGVkLCBidXQgdGhlIGBSYCBjb2RlIHRvIGRvIGl0IGlzbid0IHRvbyBiYWQuIEJ5IGRlZmF1bHQsIHRoaXMgY29kZSB3aWxsIGNvbnN0cnVjdCA1MDAwIGJvb3RzdHJhcCBzYW1wbGVzLiBIZXJlIGl0IGlzOgoKYGBge3J9CmNvbnN0cnVjdF9zYW1wbGUgPC0gZnVuY3Rpb24oeCkgewogIGsgPC0gYyhyZXAoMSwgeFsxXSksIHJlcCgyLCB4WzJdKSwgcmVwKDMsIHhbM10pKQogIGtfbmV3IDwtIHNhbXBsZShrLCBzaXplID0gbGVuZ3RoKGspLCByZXBsYWNlID0gVFJVRSkKICB4X25ldyA8LSBjKGxlbmd0aChrX25ld1trX25ldyA9PSAxXSksIGxlbmd0aChrX25ld1trX25ldyA9PSAyXSksIGxlbmd0aChrX25ld1trX25ldyA9PSAzXSkpCiAgcmV0dXJuKHhfbmV3KQp9Cgpib290c3RyYXBfcmVsYXRpdmUgPC0gZnVuY3Rpb24oYmVmb3JlLCBhZnRlciwgcXRpbGUgPSAwLjA1LCBuX3NhbXBsZSA9IDUwMDApIHsKICB3XzExIDwtIG51bWVyaWMobl9zYW1wbGUpCiAgd18yMiA8LSBudW1lcmljKG5fc2FtcGxlKQogIGZvciAoaSBpbiAxOm5fc2FtcGxlKSB7CiAgICBhZHVsdCA8LSBjb25zdHJ1Y3Rfc2FtcGxlKGFmdGVyKQogICAgenlnb3RlIDwtIGNvbnN0cnVjdF9zYW1wbGUoYmVmb3JlKQogICAgZml0bmVzc2VzIDwtIHJlbGF0aXZlKHp5Z290ZSwgYWR1bHQpCiAgICB3XzExW2ldIDwtIGZpdG5lc3NlcyR3XzExCiAgICB3XzIyW2ldIDwtIGZpdG5lc3NlcyR3XzIyCiAgfQogIGhlYWRlciA8LSBzcHJpbnRmKCJGaXRuZXNzICAgJTQuMWYlJSAgJTQuMWYlJVxuIiwgMTAwKnF0aWxlLzIsIDEwMCooMSAtIHF0aWxlLzIpKQogIHF0aWxlcyA8LSBxdWFudGlsZSh3XzExLCBjKHF0aWxlLzIsIDEgLSBxdGlsZS8yKSkKICByb3dfMSA8LSBzcHJpbnRmKCJ3XzExICAgICAgJTAuMmYgICAlMC4yZlxuIiwgcXRpbGVzWzFdLCBxdGlsZXNbMl0pCiAgcXRpbGVzIDwtIHF1YW50aWxlKHdfMjIsIGMocXRpbGUvMiwgMSAtIHF0aWxlLzIpKQogIHJvd18yIDwtIHNwcmludGYoIndfMjIgICAgICAlMC4yZiAgICUwLjJmXG4iLCBxdGlsZXNbMV0sIHF0aWxlc1syXSkKICBjYXQoaGVhZGVyLCByb3dfMSwgcm93XzIpCn0KCmJvb3RzdHJhcF9yZWxhdGl2ZShiZWZvcmUsIGFmdGVyKQpgYGAKCkFzIHlvdSBjYW4gc2VlLCB0aGUgOTUgcGVyY2VudCBjb25maWRlbmNlIGludGVydmFsIGZvciBgd18xMWAgaW5jbHVkZXMgdmFsdWVzIGxhcmdlciB0aGFuIDEsIG1lYW5pbmcgdGhhdCBhdCB0aGlzIGxldmVsIG9mIGNvbmZpZGVuY2Ugd2UgY2FuJ3QgZXhjbHVkZSB0aGUgcG9zc2liaWxpdHkgdGhhdCBBMUExIGhhcyBhIGdyZWF0ZXIgdmlhYmlsaXR5IHRoYW4gQTFBMi4gSW4gY29udHJhc3QsIHdlIGFyZSBxdWl0ZSBjb25maWRlbnQgdGhhdCBBMkEyIGlzIGxlc3MgdmlhYmxlIHRoYW4gQTFBMi4gSWYgd2UgZXhhbWluZSByZXN1bHRzIHVzaW5nIHRoZSA4MCBwZXJjZW50IGNvbmZpZGVuY2UgaW50ZXJ2YWxzLCB3ZSB3b3VsZCBjb25jbHVkZSB0aGF0IEExQTEgaXMgbGVzcyB2aWFibGUgdGhhbiBBMUEyLiAgCgpgYGB7cn0KYm9vdHN0cmFwX3JlbGF0aXZlKGJlZm9yZSwgYWZ0ZXIsIDAuMikKYGBgCgpJIGludGVycHJldCB0aGVzZSByZXN1bHRzIGFzIGZvbGxvd3M6CgoxLiBPdXIgYmVzdCBlc3RpbWF0ZSBpcyB0aGF0IGJvdGggaG9tb3p5Z290ZXMgaGF2ZSBsb3dlciB2aWFiaWxpdGllcyB0aGFuIHRoZSBoZXRlcm96eWdvdGUuCjIuIFdlIGFyZSBxdWl0ZSBjb25maWRlbnQgdGhhdCBBMkEyIGhhcyBhIGxvd2VyIHZpYWJpbGl0eSB0aGFuIHRoZSBoZXRlcm96eWdvdGUsIGJ1dCB3ZSBoYXZlIG9ubHkgbG93IGNvbmZpZGVuY2UgdGhhdCBBMUExIGhhcyBsb3dlciB2aWFiaWxpdHkgdGhhbiB0aGUgaGV0ZXJvenlnb3RlLgozLiBPbiBiYWxhbmNlIGl0IGFwcGVhcnMgdGhhdCB0aGVyZSBpcyBoZXRlcm96eWdvdGUgYWR2YW50YWdlLCBhbmQgd2Ugd291bGQgZXhwZWN0IGJvdGggYWxsZWxlcyB0byBwZXJzaXN0IGluIHRoZSBwb3B1bGF0aW9uLiBCdXQgb3VyIGNvbmZpZGVuY2UgaXMgbG93LiBUaGVyZSBpcyBhIHJlYXNvbmFibGUgY2hhbmNlIHRoYXQgdGhlcmUgaXMgZGlyZWN0aW9uYWwgc2VsZWN0aW9uIGZvciB0aGUgQTEgYWxsZWxlLCB3aGljaCB3b3VsZCBsZWFkIHRvIGZpeGF0aW9uIG9uIEExLgoKIyMgTGFiIGV4ZXJjaXNlCgpZb3NoaWtvIFRvYmFyaSBhbmQgS2VuLUljaGkgS29qaW1hIChHZW5ldGljcyA1NzoxNzktMTg4OyAxOTY3KSBzdHVkaWVkIHRoZSBldm9sdXRpb25hcnkgZHluYW1pY3Mgb2YgYW4gaW52ZXJzaW9uIHBvbHltb3JwaGlzbSBvbiBjaHJvbW9zb21lIDIgb2YgX0Ryb3NvcGhpbGEgYW5hbmFzc2FlXyBpbiBhIHBvcHVsYXRpb24gY2FnZS4gVGhyb3VnaCB0aGUgc3RhbmRhcmQgc29ydCBvZiB0cmlja3kgZ2VuZXRpYyBtYW5pcHVsYXRpb25zIHRoYXQgX0Ryb3NvcGhpbGFfIGdlbmV0aWNpc3RzIGRvLCB0aGV5IGRlcml2ZWQgdHdvIGxpbmVzIHRoYXQgd2VyZSBob21venlnb3VzIGZvciBlYWNoIGNocm9tb3NvbWUgdHlwZS4gVGhleSB0aGVuIHN0YXJ0ZWQgZGlmZmVyZW50IHBvcHVsYXRpb24gY2FnZXMgd2l0aCBkaWZmZXJpbmcgbnVtYmVycyBvZiBmbGllcyBob21venlnb3VzIGZvciBlYWNoIGNocm9tb3NvbWFsIGFycmFuZ2VtZW50LiBTcGVjaWZpY2FsbHksCgoKfCBQb3B1bGF0aW9uIHwgIEFBIHwgIEFCIHwgIEJCIHwKfCAtLS06ICAgICAgIHw6LS0tOnw6LS0tOnw6LS0tOnwKfCAxICAgICAgICAgIHwgMTAwIHwgICAwIHwgOTAwIHwKfCAyICAgICAgICAgIHwgOTAwIHwgICAwIHwgMTAwIHwKCkFmdGVyIG9uZSBnZW5lcmF0aW9uIG9mIHJlcHJvZHVjdGlvbiBpbiB0aGUgY2FnZSB0aGV5IHRvb2sgYSBzYW1wbGUgb2YgYWR1bHRzIGFuZCBvYnRhaW5lZCB0aGUgZm9sbG93aW5nIOKAnGdlbm90eXBl4oCdIGNvdW50czpeW0FzIHVzdWFsLCBJ4oCZbSB0cmVhdGluZyBhIGNocm9tb3NvbWUgaW52ZXJzaW9uIHR5cGUuIEnigJl2ZSBhbHNvIHNpbXBsaWZpZWQgdGhlc2UgZGF0YSBhIGJpdC4gVGhlIGNvdW50cyBjb21iaW5lIHJlc3VsdHMgZnJvbSB0d28gcmVwbGljYXRlIHBvcHVsYXRpb25zIG9mIGVhY2ggcG9wdWxhdGlvbiBjb25maWd1cmF0aW9uLl0KCnwgUG9wdWxhdGlvbiB8ICBBQSB8ICBBQiB8ICBCQiB8CnwgLS0tOiAgICAgICB8Oi0tLTp8Oi0tLTp8Oi0tLTp8CnwgMSAgICAgICAgICB8IDE5ICB8IDEyNSB8IDE1NiB8CnwgMiAgICAgICAgICB8MjA2ICB8ICA4NyB8ICAgIDd8CgpBc3N1bWUgdGhhdCBuZXdseSBmb3JtZWQgenlnb3RlcyBpbiB0aGUgZ2VuZXJhdGlvbiBmcm9tIHdoaWNoIHRoZSBhZHVsdCBzYW1wbGUgd2FzIHRha2VuIGFyZSBmb3VuZCBpbiBIYXJkeS1XZWluYmVyZyBwcm9wb3J0aW9ucyB3aXRoIGNocm9tb3NvbWUgZnJlcXVlbmNpZXMgZXF1YWwgdG8gdGhvc2UgaW4gdGhlIGJhc2UgcG9wdWxhdGlvbnNeW0luIG90aGVyIHdvcmRzLCB0aGUgZnJlcXVlbmN5IG9mIEEgaW4gUG9wdWxhdGlvbiAxIGlzIDEwMC8xMDAwID0gMC4xLl0uIFVzaW5nIHRoZXNlIGRhdGEgYW5zd2VyIHRoZSBmb2xsb3dpbmcgcXVlc3Rpb25zOgoKMS4gV2hhdCBhcmUgdGhlIGZpdG5lc3NlcyBvZiBBQSBhbmQgQkIgcmVsYXRpdmUgdG8gQUIgaW4gZWFjaCBwb3B1bGF0aW9uLCBhbmQgd2hhdCBhcmUgdGhlIDk1JSBjcmVkaWJsZSBsaW1pdHMgb24gdGhvc2UgZml0bmVzc2VzPwoKMi4gSG93IGxpa2VseSBpcyBpdCB0aGF0IHRoZXJlIGlzIGhldGVyb3p5Z290ZSBhZHZhbnRhZ2UgaW4gZWl0aGVyIHBvcHVsYXRpb24/CgozLiBBcmUgdGhlIHJlbGF0aXZlIGZpdG5lc3NlcyBvZiB0aGUgZ2Vub3R5cGVzIHRoZSBzYW1lIG9yIGRpZmZlcmVudCBpbiB0aGUgdHdvIHBvcHVsYXRpb25zPwoKNC4gR2l2ZW4geW91ciBhbnN3ZXJzIHRvICgxKSAmICgyKSBhbmQgYXNzdW1pbmcgdGhhdCB0aG9zZSBmaXRuZXNzZXMgYXJlIHRoZSBvbmx5IGV2b2x1dGlvbmFyeSBmb3JjZSBhY3RpbmcsIHdoYXQgZG8geW91IHByZWRpY3QgYWJvdXQgdGhlIGVxdWlsaWJyaXVtIGNvbXBvc2l0b24gb2YgX0Ryb3NvcGhpbGEgYW5hbmFzc2FlXyBwb3B1bGF0aW9ucy4gV2lsbCB0aGV5IGJlIHBvbHltb3JwaGljPyBtb25vbW9ycGhpYyBmb3IgQT8gbW9ub21vcnBoaWMgZm9yIEI/IG9yIHdpbGwgdGhlIHJlc3VsdCBkZXBlbmQgb24gaW5pdGlhbCBmcmVxdWVuY2llcz8gQmUgc3VyZSB0byBleHBsYWluIHlvdXIgYW5zd2VyIGJlY2F1c2UgKGEpIGlmIHlvdSBsb29rIHVwIHRoZSBvcmlnaW5hbCBwYXBlciB5b3Ugd2lsbCBzZWUgdGhlIHJlc3VsdCBhbmQgKGIpIHRoZSBwYXR0ZXJuIG9mIHNlbGVjdGlvbiBoYXBwZW5pbmcgaGVyZSBpcyBkaWZmZXJlbnQgZnJvbSBhbnl0aGluZyB3ZeKAmXZlIGRpc2N1c3NlZCBpbiBjbGFzcy4=