In this lab you will get the data that is in a file. The file is formatted as a comma-delimited txt file (a .csv file) that was saved in Microsoft Excel. Once you read the file it will be stored in an object called “finchbeaks”.

#make sure this rmd file is saved in the same location as Lab03_FinchData.csv
#setwd("") #C:/Users/levic/Desktop/Evolution
finchbeaks <-read.csv("Lab03_FinchData.csv")

If the first row of the file has names for each column (which it does), you want R to recognize those names and associate them with the appropriate numbers. You do this with the command “attach”. This makes your data frame searchable.

#attach data to make columns available
attach(finchbeaks)

#preview the data
head(finchbeaks)
##    Died Survived Mother Father Offspring NextGeneration
## 1  8.74    10.81  10.95  10.86      8.74          10.59
## 2 10.04     8.62  10.77   9.81     10.04          12.51
## 3  9.75    10.42  10.76   9.64      9.75          11.33
## 4  9.76    11.15  10.53  10.27      9.76          10.23
## 5  9.55    11.16  10.22   9.38      9.55           9.49
## 6  8.70    11.14  10.01   9.61      8.70          10.98

“Died” and “Survived” are all the birds that were sampled in 1977. “NextGeneration” are all the birds that were sampled in 1978, they are the offspring of the survivors “Mother” + “Father” are a subset of “Survived”, “Offspring” are a subset of NextGeneration“

Your file contains a number of columns of numbers, treated by R as vectors, some of which are longer than others. If a column is shorter than the longest, R inserts a NA as a place holder so that all vectors are the same length. Many of the functions in R cannot handle NAs, so you need to get rid of them. The vector Survived has a lot of NAs. Remove them by overwriting the old vector Survived with the command “na.omit()”. This will get rid of them. (Aside: sometimes NAs are very useful, just not in this case.)

Survived <- na.omit(Survived)

Objective 1: Estimate Selection (S)

The first objective is to construct a histogram of the beak size before and after selection. The data for before selection are in two columns so you need to make a new vector with the two columns combined. You do this by concatenating the survived and died vectors into one vector named “AllIndividuals” using the command “c(x1,x2)”.

AllIndividuals <- c(Died, Survived)

To visually summarize variation in a population you need to make a histogram. The command hist(x) will do this for you. If you store the data from hist(x) you can plot it with other histogram data. So we will do two hist functions or the two populations: before and after selection. We add vertical lines that indicate the average beak size for the individuals before and after selection to help show what the selection coefficient (S, a measure of the extent to which natural selection is acting to reduce the relative contribution of a given genotype to the next generation). Note the command na.rm=TRUE makes sure there are no NA values in the vector.

hist(AllIndividuals, col="blue",main="Beak Sizes Before And After Selection",
    xlab="Average Beak Size (mm)",ylab="Number of Individuals")

hist(Survived, col="magenta4", add=T)
legend("topright",legend=c("Before","After","Mean Before","Mean After"), 
       col = c("blue", "magenta4", "black","black"),
       lty = c(0, 0, 1,3), lwd = c(0, 0, 1,1),
       pch = c(22, 22, NA,NA),
       pt.bg = c("blue", "magenta4", NA,NA),
       pt.cex = 2)

#Calculate the mean before selection
MeanBeforeSelection <- mean(AllIndividuals,na.rm=TRUE)

#Calculate the mean after selection
MeanAfterSelection <- mean(Survived,na.rm=TRUE)

#Calculate S- Strength of Selection
S <- MeanAfterSelection - MeanBeforeSelection

#graph means as vertical lines using "abline()".
abline(v=MeanBeforeSelection, lwd=3)
abline(v=MeanAfterSelection, lwd=3,lty=3)

Question 1

Briefly describe the figure above. In your description include the average beak sizes before and after selection, and the estimate of S.

The aveage beak size before selection was 9.65mm and the average beak after selection was 10.09mm. The probability of selection or S is 0.44 which means the strength of selection is 44%. Based off this information as well as the graph it can be seen that beak size is acted upon by selection and a larger beak size is the preferred phenotype.

Objective 2: Visualize selection

Objective 2 asks you to construct a graph of survivorship as a function of beak size. The survivorship data is a 0 if the bird died and a 1 if the bird survived. We need to make a new vector that has zeros and ones depending on whether individuals lived or died and because our vector AllIndividuals is organized as all the individuals that died and then all individuals that survived we can simply count that number of individuals that died and put the same number of 0s in a vector and then count the number of individuals that lived and put the same number of 1s below the zeros. To make it easy we’ll do it in two steps: make two vectors, one with 0s and one with 1s and then we’ll put the two together. The command “rep(x,y)” makes a vector of x values that is of length y.

DiedInd <- rep(0,length(Died))
SurvInd <- rep(1,length(Survived))

#Put the zeros and ones into a single vector
Fitness <- c(DiedInd,SurvInd)

Now its simply a matter of plotting the trait values in FirstGen against fitness. We can estimate the probability of survival from these data using a logistic regression (slightly different from linear regression) and plot the predicted values. I don’t expect you to know this; however, it is worth spending some time researching logistic regression a little if you have an interest in this sort of thing (i.e. estimating probabilities).

First we will plot the data, then we run the logistic regression. The line estimates expected probability of survival as a function of beak size. The function “glm(formula = y ~ x, family=binomial(link=”logit“))” allows you to run a logistic regression (in case you are wondering). The function “predict” allows you to draw the expectation line. You are not expected to understand the mathematics, but you should be able to interpret the graph

plot(AllIndividuals, Fitness, ylab="Survivorship",
     xlab="Beak Length (mm)", main="Fitness of Finch Beaks")

fitness.model <- glm(formula = Fitness ~ AllIndividuals,
    family=binomial(link="logit"))
newdata <- predict(fitness.model, type="response")
expected.x <- sort(AllIndividuals)
expected.y <- sort(newdata)
lines(expected.x, expected.y, lwd=3)

Question 2

Provide a brief description of the figure above. What does the regression line communicate about survival and beak size? Do you think this is a relatively strong or weak relationship, and why?

In the graph above we see a correlation between beak size and survivorship. Beak size under 10mm has very little to no survivship whereas beak size 10mm and above have an increasing chance of survivng. The regression line shows that as beak size increases, survivorship increases. At 14mm survivship is about 50% (highest of all beak lengths). This is a moderately strong relastionship because we see a growth in survivorship as beak length increases. In other words, there is exponential chances of survivorship as beak length increases, seen very clearly between 10 and 14 mm.

Objective 3: Estimate heritability (H)

Objective 3 asks you to visualize the dependence of offspring trait values on the trait values of the midparent (average parent). You have a vector of values of the father and the mother and the offspring. First you need to make the midparent values vector. As I said, this is the average of the two parent vectors: Mother and Father.

#Construct a vector of the mid-parent values. 
MidParent <- (Mother + Father)/2

#Construct a plot showing the dependence of offspring values on the mid-parent value.
plot(MidParent, Offspring, main="Estimate of Heritability", 
     xlab="Midparent", ylab="Offspring")

#Perform a linear regression and get the slope and then draw the slope on the graph 
#using some pretty color. You need to get the value for 
#the slope of the line and the p value from the linear regression.

model <-lm(Offspring~MidParent) #linear model of Offspring explained by Midparent

#The slope of the line estimates heritability, H. This is stored in the model and 
#so is the p value. 


H <- summary(model)$coeff[2,1] #un-comment once you create model
p <- summary(model)$coeff[2,4] #un-comment once you create model


#Draw the regression line on the graph
abline(model, lwd=2, col="cyan") #un-comment once you create model

Question 3

Provide a brief description of the figure above. What are the estimated coefficients and what is the formal evidence to support or deny the claim that there is heritable variation for beak size in these finches?

The graph above shows the dependence of offspring trait values on the trait values of the midparent or average of the father and mother. In other words, this graph shows how heritable beak size is from parent to offspring. The intercept coefficient is 1.7630 when the midparent coefficient is 0.7663.

Objective 4: Visualize evolution (change between generations) (R)

This objective repeats what you have already done for the first objective only it uses different data. You need to write annotation and the code that accomplishes this objective

First two overlapping histograms and means. Compare all the 1977 birds with the 1978 birds (see line 33 above). Your histograms should include similar details to the ones made in Objective 1, including vertical lines for the average beak sizes.

hist(AllIndividuals, col="aquamarine",main="Beak Size of the Parent(1977) and Next(1988) Generations",
    xlab="Beak Size(mm)",ylab="Number of Individuals")

hist(Offspring, col="purple", add=T)
legend("topright",legend=c("Parent Generation 1977","Next Generation 1978","Mean 1977","Mean 1978"), 
       col = c("aquamarine", "purple", "black","black"),
       lty = c(0, 0, 1,3), lwd = c(0, 0, 1,1),
       pch = c(22, 22, NA,NA),
       pt.bg = c("aquamarine", "purple", NA,NA),
       pt.cex = 2)

#Calculate the mean of parent generation
MeanParentGeneration <- mean(AllIndividuals,na.rm=TRUE)

#Calculate the mean after selection
MeanNextGeneration <- mean(NextGeneration,na.rm=TRUE)

#Calculate S-Strength of Selection aka R-Response to Selectiom
RObserved <- MeanNextGeneration - MeanParentGeneration

#graph means as vertical lines using "abline()".
abline(v=MeanParentGeneration, lwd=3)
abline(v=MeanNextGeneration, lwd=3,lty=3)

Question 4

Briefly describe the figure above. In your description include the average beak sizes for each generation.

In the figure above, we see that beak size in the parent generation (1977) is more widely spread than that of the next generation (1978). In the parent generation beak size ranges between under 6mm to 14mm whereas, in the next generation beak size ranges between about 7mm and 11mm.The average beak size increased from 9.649521mm in the 1977 generation to 9.994028mm in the next generation.

Next you want to calculate the observed and expected amount of evolution (R)

#Caculate R Observed 
RObserved
## [1] 0.3445071
#See code below Parent and Next Generation histogram

#Calculate R Expected (R <- H*S)
RExpected<- H*S

Question 5

How agreeable are the expected and observed values of R? Is this surprising to you, why or why not? Report both R values in your response.

My R expected and R observed values are quite similar. R expected is 0.3343818 and R observed is 0.3445071. There is about a 0.01 difference between the expected and observed with observed being slightly higher than expected. This is not surprising because R expected is based on the the calcualted heritability and strength of selection from the parents. R expected is the theoretical value of response to selection for the offspring. Assuming the parent generation did reproduce the expected response to selection should be very similar to the observed response to selection.

Question 6

Provide a few sentences that describe what happened on the island that explains the intense selection (include an example for why so many birds died and why beak size changed); make sure to cite your sources.

“The association between beak size and diet is most obvious when comparing the species that have contrasting morphology, such as the insectivorous small warbler finches (about 8 grams [g]) and the granivorous large ground finch (about 30 g)”(Grant). On the island there was a severe drought that changed the food sources available to the finches. As a result, finches with beaks that couldn’t open and access the nutrition in the seeds died. This si what led to such a high percentage of death in the finches. Beak size changed in response to the change in food sources available. In other words, finches with beaks that allowed them to eat the new food source were the ones who survived and eventually reproduced. Since beak size is heritable, the next generation beak size was larger and less diverse than that of the previous generation. This allowed the new generation to be better adapated to the food source available.

Grant, Rosemary B., and Peter R. Grant. “What Darwin’s Finches Can Teach Us about the Evolutionary Origin and Regulation of Biodiversity.” BioScience Oxford Academic. Oxford University Press, 01 Oct. 2003. Web. 14 Feb. 2017. https://academic.oup.com/bioscience/article/53/10/965/254944/What-Darwin-s-Finches-Can-Teach-Us-about-the.