In ggcostoya/limon: Evolutionary Constraints among Thermal Performance Traits

knitr::opts_chunk$set(echo = TRUE)
devtools::load_all()

The goal of this vignette is to illustrate offspring is generated in any simulation run in this project. The explanation will be developed in steps together with an example case.

Principle

In the context of the simulations of this project, offspring is generated after reproduction is determined. As an example, for an individual generating a total of 5 offspring throughout a time-step a or a generation, the process presented below will be repeated 5 times independently.

Each offspring will be generated from the parents thermal-performance traits (TPTs) which we consider the only traits an individual is defined by and the main unit of inheritance. For the purpose of this vignette we will consider the generation of 1 offspring from an individual with this TPTs.

tpts <- tibble(tpt = c("topt", "tb", "skw", "ctmin", "ctmax", "pmax", "pmin"),
               value = c(30, 3, -1, 20, 35, 10, 0.1))

tpts

The steps presented next are part of the process behind the sim_offspring function of this package.

Mutations

Once the parent individual's TPTs are determined, the first step is to determine if these traits change. Change in the parents TPTs occurs through a process of mutation. In the context of this project, a mutation occuring on any of our simulations is a two-step process; first we determine in which TPTs mutations occur and then we determine the amount of change occuring as a consequence of a trait's mutation.

Where do mutations occur?

To determine where do mutations occur we follow a similar method than that to determine an individual's survival (see Simulate Survival and Reproduction vignette) and that is sampling from a binomial distribution of size one with a certain probability. In this case, the probability parameter of the binomial distribution is equivalent to the mutation rate, $\mu$ a parameter we can set in our simulations.

The outcome will be a vector of 1 or 0 of the same length as the original TPT vector indicating in which traits did mutation occur (1) and in which it didn't (0). Under realistic circumstances, $\mu$ should be an extremely low probability, in the order of 1e-10. However, for the purpose of explanation we will set mu = 0.25 since otherwise a mutation would be extremely unlikely.

where_mutation <- rbinom(nrow(tpts),1,0.25)
tpts <- tpts %>% mutate(where_mutation = where_mutation)
tpts

By how much do TPTs change due mutation?

Once we know which TPTs are mutating we then need to determine how they do so. The principle we follow is that a TPT cannot change to a completely different value but it can only change within a certain range to the original value. To accomplish this, we determine the amount of change due mutation by sampling from a normal distribution of mean = 0 and a particular sd. The sd of the sampling distribution is defined by the simulation parameter sdm which is equivalent to the percentage of the original TPT that will act as sd. For example, if we are considering topt = 30 and we set sdm = 0.05, the amount of change of topt after mutation will be sampled from a normal distribution of mean = 0 and sd = 30 * 0.05 = 1.5. Below we show the probability distribution of topt values after mutation considering the original TPT value; small changes are the most likely outcome. As an example, we sample a new value for a hypothetically mutating topt which we mark in red.

change_due_mutation <- rnorm(1, 0, 1.5)
change_due_mutation

topt_after_mutation <- 30 + change_due_mutation
topt_after_mutation

values <- seq(25,35,0.01) 
probability <- gaussian(values,0.25,30,1.5)
plot(values,probability, type = "l", lwd = 2, xlab = "Value of the TPT after mutation", ylab = "Probability of the TPT changing to corresponding value", col = "grey")
abline(v = 30, lty = 2, lwd = 2)
abline(v = topt_after_mutation, lwd = 2, col = "red")
legend(x = 32, y = 0.25, legend = c("Original topt", "topt after Mutation"), col = c("black", "red"), lty = c(2,1), cex = 0.8, box.lty = 0, lwd = 2)

Using the same process we can determine the amount of change in all mutating traits in the ongoing example of this vignette

# function to determine mutation amount
dcdm <- function(value,where_mutation,sdm){

  change_due_mutation <- rep(0,length(value))

  for(i in 1:length(change_due_mutation)){

    change_due_mutation[i] <- ifelse(where_mutation[i] == 1, rnorm(1, mean = 0, sd = abs(value[i]*sdm)), 0)

  }

  return(change_due_mutation)

}
# change due mutation 
change_due_mutation <- dcdm(value = tpts$value, where_mutation = tpts$where_mutation, sdm = 0.05)
#include everything on the existing tpts dataset
tpts <- tpts %>% mutate(change_due_mutation = change_due_mutation)
tpts

Genetic correlations between TPTs

As an extra feature in this project, and as an interesting addition from a biological perspective, we account for the existance of a Genetic Correlation's Matrix between TPTs (gmtx). A gmtx relates the changes of TPT values happening due mutation in other words, stablishes a set of rules determining the effect of a TPT's change on other traits. Within our simulations, a gmtx can be included when generating new offspring to induce genetic correlations between mutating TPTs. To illustrate how we apply this idea to these simulations we will use this matrix.

pop <- gen_pop_tpd(n = 5, tpts = tpts, samples = 5, error = 1)
pop_tpts <- get_pop_tpts(pop_tpd = pop, pmin = 0.1)
gmtx <- get_corr_matrix(pop_tpts)
gmtx

As easily as multiplying gmtx by the vector of change_due_mutation we obtained earlier, we can obtain another vector with the amount of change in a TPT due to genetic correlation (change_due_gmtx)

change_due_gmtx <- as.vector(tpts$change_due_mutation[1:6] %*% gmtx)
change_due_gmtx <- c(change_due_gmtx, 0)
tpts <- tpts %>% mutate(change_due_gmtx = change_due_gmtx)
tpts

Finally, change_due_gmtx will be the actual quantity we will add to the original parent's to determine the offspring's TPTs.

tpts <- tpts %>% mutate(new_value =  value + change_due_gmtx)
tpts

# prepare data for plot 
value <- c(tpts$value[1:6], tpts$new_value[1:6])
tpt <- c(tpts$tpt[1:6], tpts$tpt[1:6])
type <- c(rep("Parent",6),rep("Offspring",6))
plot_data <- tibble(value,tpt,type)
ggplot(plot_data, aes(fill = type, y = value, x = tpt)) +
  geom_bar(position = "dodge", stat = "identity") +
  xlab("Thermal-Performance Trait") + ylab("Value") +
  theme_classic() +
  theme(legend.position = "top", legend.title = element_blank())

Generate Offspring TPD

Lastly, using the offspring's new TPTs we can generate some TPD using the function gen_tpd as is explained on the Generate TPD vignette.

offspring_tpts <- tibble(tpt = tpts$tpt, value = tpts$new_value)
offspring_tpd <- gen_tpd(tpts = offspring_tpts, samples = 10, error = 1)
offspring_tpd

offspring_fit <- fit_tpd(offspring_tpd)
offspring_tpc <- gen_tpc(offspring_fit)
plot(offspring_tpd, pch = 19, cex = 1.25, xlab = "Temperature", ylab = "Performance", ylim = c(0,max(offspring_tpd$p,offspring_tpc$p, na.rm = T)))
lines(offspring_tpc, type = "l", col = "grey", lwd = 2)
lines(offspring_tpd, type = "p", pch = 19, cex = 1.25)