For this activity you are going to take on the role of a bird. Each year you choose one bird to follow, with a particular beak size.
Three charts are shown below, all scaled on the x axis showing beak depth. The top one shows the other birds on the island and what beak depth each of them has. The middle one shows the expected number of chicks a bird with a particular beak depth will fledge, and the bottom one shows the chance that a bird with a given beak depth survives the winter.
Based on how rainy it is, and on the beak size of the birds, you are going to have a different number of expected chicks that successfully fledge — and you and your chicks are going to have a different chance of surviving winter. The chance of surviving winter for your beak is shown. The chance for your chicks is not; they should be similar to you if heritability is high.
Your goal is to play through ten years and produce 21 chicks by the end. So you need more than two chicks to survive each winter to win this round. As you go, look at the expected number of chicks and the chance of surviving winter, and use your number for your chosen bird as the baseline for your chicks. Try to get your expected number of survivors above two if at all possible.
If your expected number of chicks is 3, and your chance of surviving the winter is 50%, that means you should expect 1.5 chicks to make it through the winter. 1.5 is less than 2 — so your expectation there should not be that you are going to get more than two. Some years you won't be able to. Some years are hard.
What beak size you choose is up to you, but how well you do is contingent on how much it rained. So you can do everything perfectly and still not quite win. It may take you a few tries, but if you are paying close attention you should be able to get it. Play through the ten years as many times as you can, and think carefully about what you are doing: try to work out, mentally or with a calculator, the best beak shape for each individual year as the conditions change.
| year | drought? | flock's average beak (change) | beak you picked | chicks born | survived to spring | bird survived? |
|---|---|---|---|---|---|---|
| no years played yet | ||||||
The data here is modelled on the Grants' long-term study of finches in the Galápagos. We are going to combine the birth-death modelling you did in Lesson 6 with what you just played with in Part A — except that now a trait, passed down from bird to bird, mediates the whole thing.
We are going to start with a simple birth-death model using a single static rate, as before. And, as before, it won't fit very well. Get the predicted line relatively close to the observed data points and lock in the model.
Then we are going to continue to use the birth and death rates, but now you control how much the rain increases the amount of seeds, how much each bird eats, and in particular how much the rain influences the soft seeds. Likewise, down in the model, we are going to add a parameter that lets beak depth influence how well a bird can utilise the hard seeds.
Beak depth is costly. It is energetically expensive to grow a big, heavy beak, and a beak that is big and heavy is only useful in years where there are a lot of hard seeds.
As you play around, you will notice that in addition to the birth-death model, as we add beak depth in, we are simultaneously fitting the average beak depth. Pay attention to your error shown at the bottom, and try to get that error into the green. What you need to do is get a model that explains the beak shape and the population size at the same time — so you are optimising for two different values.
Heritability of beak is going to be an important component now. Heritability just refers to how predictable the offspring are from the parents.
| seed left over each generation | 0.30 soft, 0.70 hard |
| what one bird eats in a year | 1.00, soft first |
| beak that starts opening a hard seed | 8.6 mm, fully able by 9.8 |
| what a deep beak costs to carry | 0.10 per mm above 8 mm |
| the most a bird's chance of dying goes | 0.95 |
| spread of beak depth between birds | 0.85 mm |
d <- read.csv("data/clean/island.csv")mostChicks <- 1.0bestSurvival <- 0.70leastDying <- 1 - bestSurvivalseedsPerMm <- 3.0seedsPerBird <- 0.300softBoost <- 0.20inherited <- 0.00for (t in 1:20) { # with no seed in the model, nobody is ever short of food born <- mostChicks died <- leastDying # rain makes seed, and what nobody ate is still there made <- seedsPerMm*d$rain[t] soft <- 0.30*soft + 0.5*made hard <- 0.70*hard + 0.5*made # and rain sets WHAT KIND: a wet year is proportionally softer pHard <- pmin(1, 1 - softBoost*d$rain[t]/100) made <- seedsPerMm*d$rain[t] soft <- 0.30*soft + (1-pHard)*made hard <- 0.70*hard + pHard *made food <- pmin(1, (soft + hard)/n) # shared out evenly: no beak yet # everyone fills up on soft first -- that much is shared evenly fromSoft <- pmin(1, soft/n) # only a deep enough beak tops up on the larder reach <- pmin(1, pmax(0, (beak - 8.6)/1.2)) fromHard <- pmin(1 - fromSoft, reach*hard/sum(reach)) food <- fromSoft + fromHard # and a deep beak is dearer to carry, at the SAME food cost <- pmax(0.15, pmin(1, 1 - 0.10*(beak - 8))) born <- mostChicks*food/(seedsPerBird + food) died <- leastDying + (0.95-leastDying)/(1 + food/seedsPerBird) born <- mostChicks*food/(seedsPerBird + food) * cost died <- leastDying + (0.95-leastDying)/(1 + food/seedsPerBird) surv <- (1 - died) * cost # the parents are done; next year is the chicks beak <- mean(beak) + inherited*(parent - mean(beak)) + noise}
Hopefully we now understand the model. We are going to use it to do what a model should do, which is project into the future.
The classic way to do this is with what are called training data and testing data. We have been looking at the first twenty generations — that is the training data — but there is data going forward that the model has never seen. That is the testing data, and it stays hidden until you commit.
So what you are going to do is take the exact parameters from Part B, and see how the model projects the finches to change going into the next ten generations. You have a chance to adjust the model a little more here before you lock it in. Then we see how well it actually works.
Once you have locked in, you are going to select which generation has the largest miss and which is the closest hit between your model and the observed data. Look for the places where your points are furthest from your projected line — the red line — and where they are the closest. You do this on the future data, the part you could not see into when you fitted.
Once you have done that, adjust the sliders to reduce your error, and get the model as close to the empirical data for the full thirty-generation run as you can. Bear in mind that both the top plot, average beak depth, and the bottom plot, finch population, need to be accounted for as you are modelling. We want to be able to predict both the number of birds and what happens to their changing beak size.
seedsPerMm <- 3.0seedsPerBird <- 0.300softBoost <- 0.20inherited <- 0.50# rain makes both kinds; a wet year makes proportionally more softpHard <- pmin(1, 1 - softBoost*rain/100)soft <- 0.30*soft + (1-pHard)*seedsPerMm*rainhard <- 0.70*hard + pHard *seedsPerMm*rain# soft first, shared evenly; the larder only for a beak that reaches itfromSoft <- pmin(1, soft/n)reach <- pmin(1, pmax(0, (beak - 8.6)/1.2))food <- fromSoft + pmin(1-fromSoft, reach*hard/sum(reach))cost <- pmax(0.15, pmin(1, 1 - 0.10*(beak - 8)))born <- mostChicks*food/(seedsPerBird + food) * costdied <- leastDying + (0.95-leastDying)/(1 + food/seedsPerBird)# mostChicks and leastDying are the two you fitted in Stage B:# mostChicks = 1.0 leastDying = 0.30mean(abs(model[21:30] - record[21:30]))
So far, we fit the model to observed data, projected forward, and then observed more data to test it. However, in the second exercise the underlying conditions remained the same.
Circumstances can also change.
For this period, we're going to look at the last fifteen or so generations on this island of the recorded information from the Grants. What they saw is that partway through their study, a new species of bird arrived on the island. That new species had a distinct beak shape, and its arrival didn't change the number of seeds and didn't change the way plants grew — but it did change the value of having a beak of a particular shape, by changing the structure of competition.
So we're again going to run our model, projected forward, this time knowing that there was a massive change with the addition of a newcomer. See how our projections erred, and adjust our model to account for this.
newcomers <- 0 # a standing flock -- given, not fithard <- pmax(2, hard - newcomers*1.0) # they eat their fill off the larder first# nothing else in the model changes. not one number.mean(abs(model[31:45] - record[31:45]))
| What you drew | Parameters | Fitted, 1–20 | Run forward, 21–30 | The newcomer, 31–45 |
|---|
# the whole lesson, as a tablescore <- function(m, rec, i) mean(abs(m[i] - rec[i]))fitted <- 1:20; forward <- 21:30; newcomer <- 31:45data.frame( drew = c("Part B: fitted on the drought years alone", "Part C: refitted with the wet years in view", "Part D: the same six numbers, and a newcomer"), np = c(6, 6, 6) # six, all three times -- only the structure changed)