Feel free to read this report on RPubs.

library(popbio)
library(ggplot2)

1. Transition Matrix (M) for our lab population (section B): 10%

Print Stage-based Transition Matrix (M) for our lab population.

#intial population numbers
N_t <- c(11563,221,625)
#fecundity value
Fl <- 0
Fp <- 0
Fa <- 10
#growing into next stage value
gl <-  (20/140)
gp <- 1
ga <- 0.25
#proportion
ll <- 1
lp <- N_t[2] / N_t[1]
la <- N_t[3] / N_t[1]
#probability of larvae survival
sl <- (Fa*la)/((gl/lp)+gl-1)
#finite growth rate
lambda <- (sl*gl)/lp
#probability of pupa and adult survival
sp <- lambda/((lp/la)+(1-ga))
sa <- sp
#life stage matrix values
Gl <- sl*gl
Gp <- sp*gp
Ga <- sa*sp
Pl <- sl*(1-gl)
Pp <- sp*(1-gp)
Pa <- sa*(1-ga)
#matrix
M <- matrix(c(Pl, Gl, 0, 0, Pp, Gp, Fa, 0, Pa), nrow = 3, ncol = 3)
M
##            [,1]      [,2]       [,3]
## [1,] 0.07001326 0.0000000 10.0000000
## [2,] 0.01166888 0.0000000  0.0000000
## [3,] 0.00000000 0.5532171  0.4149129

2. Dynamics of our lab population (section C1): 25%

a) List the Finite and Instantaneous per capita growth rates for our lab population, with units. What do those values mean about the dynamics of our population? (do they tell us the population is increasing, decreasing or stable)?

t <- 20
r <- log(lambda) / t

table <- matrix(c(lambda, r), ncol = 2)
colnames(table) <- c('Finite per capita growth rate', 'Instantaneous growth rate')
table <- as.table(table)
table
##   Finite per capita growth rate Instantaneous growth rate
## A                    0.61053043               -0.02467136

The finite per capita growth rate is a unitless value indicating the per-capita multiplication factor per time-step. This value can be considered unitless because population values are on both the numerator and denominator of equation:

\[\begin{align} λ = \frac{N_{t+1}}{N_{t}} \ \end{align}\]

The instantaneous growth rate is a unitless percentage indicating the population change over a very short period of time. It can be considered as the slope, with units as population over time.


b) Show your graph. Hopefully it matches your answer in (a); if not why not?

N_t1 <- M %*% N_t
N_t2 <- M %*% N_t1

nTimeSteps <- 72

N_projected <- matrix(0, nrow = nrow(M), ncol = nTimeSteps+1)

N_projected[ ,1] <- N_t

for(t in 2:(nTimeSteps+1)){
  N_projected[ ,t] <- M %*% N_projected[ ,t-1]
  }

plot(1,1,pch="",ylim=c(0,max(N_projected)),xlim=c(0,nTimeSteps+1),xlab="Time periods (20 days)",ylab="Abundance") # Set up plot

cols <- c("darkgoldenrod2", "palegreen4", "palevioletred") # Colours! Google "r colours" to find some options!

for(s in 1:ncol(M)){
   points(N_projected[s,],col=cols[s],type="l",lwd=2)
}
legend("topleft",col=cols,lwd=rep(2,ncol(M)),legend=paste("Stage ",seq(1:ncol(M))))

The population graph matches the finite and instantaneous growth rates. Finite per-capita growth rate is less than 1, and instantaneous growth rate is negative. We see a decline in population over time.


c) Discuss possible ecological reasons for this dynamics in our beetle culture.

Possible ecological reasons may be environmental or genetic. It is possible that the students who were growing the beetles did not provide adequate heat, resources, or space for the population to be maintained. Competition ultimately produced extinction. Contrarily, it is also possible the genomics of this beetle population repressed reproduction causing population decline over time.


d) How long would it take this population of beetles to double in size? to increase 5X in size? Include units.

t_2x <- log(2) / r  
t_5x <- log(5) / r

table2d <- matrix(c(t_2x, t_5x), ncol = 2)
colnames(table2d) <- c('Doubling', 'Five times')
table2d <- as.table(table2d)
table2d
##    Doubling Five times
## A -28.09522  -65.23508

These units are in ‘time periods (of 20 days)’. This population will decline, thus the negative values.


3. Dynamics of managed populations (section C2): 40%

a) Describe how you want to manage your population (and why).

I intend to change the sub-variables involved with fecundity and next-stage survival. It would be incorrect to directly change the probability of surviving and of growing into the next life stage (capital Gz) because Gz is dependent on the subvariables sl and gl. I believe a micro-viewpoint can hold more correlative power than a macro-viewpoint. In part b, I outline changes to these subvariables.


b) Describe two management plans. Mention how would you modify these parameters in practice.

1st Plan: In my first management plan, I increased adult fecundity (Fa) by two times. All other life table variables were kept constant. In practice, the first plan may involve treatment with a hormone involved in fertility.

2nd Plan: In my second management plan, I increased the probability of larvae growing into next stage (gl) by two times. I also increased the probability of larvae surviving into next stage (sl) by two times. Note that changing only one variable exclusively does not produce any population growth. This phenomenon may be because survival (sl) is dependent on next stage growth (gl) with the equation:

\[\begin{align} s_l &=& &\frac{F_a l_a}{\frac{g_l}{l_p} + g_l - 1}&.\\ \end{align}\]

In practice, the second plan may involve overexpressing or underexpressing genes involved in larvae survival and growth cycle checkpoints.


c) Results: 2 graphs with brief description of result from each graphs.

#Plan 1
#Where adult fecundity (Fa) is 2 times higher
#Fa*2 = 20

sl1 <- (20*la)/((gl/lp)+gl-1)

lambda1 <- (sl1*gl)/lp

sp1 <- lambda1/((lp/la)+(1-ga))
sa1 <- sp1

Gl1 <- sl1*gl
Gp1 <- sp1*gp
Ga1 <- sa1*sp1
Pl1 <- sl1*(1-gl)
Pp1 <- sp1*(1-gp)
Pa1 <- sa1*(1-ga)

M1 <- matrix(c(Pl1, Gl1, 0, 0, Pp1, Gp1, 20, 0, Pa1), nrow = 3, ncol = 3)

N_projected1 <- matrix(0, nrow = nrow(M1), ncol = nTimeSteps+1)

N_projected1[ ,1] <- N_t

for(t in 2:(nTimeSteps+1)){
  N_projected1[ ,t] <- M1 %*% N_projected1[ ,t-1]
  }

plot(1,1,pch="",ylim=c(0,max(N_projected1)),xlim=c(0,nTimeSteps+1),xlab="Time periods (20 days)",ylab="Abundance")

cols1 <- c("darkgoldenrod2", "palegreen4", "palevioletred")

for(s in 1:ncol(M1)){
   points(N_projected1[s,],col=cols1[s],type="l",lwd=2)
}
legend("topleft",col=cols1,lwd=rep(2,ncol(M1)),legend=paste("Stage ",seq(1:ncol(M1))))

t <- 20

r1 <- log(lambda1) / t
t_2x1 <- log(2) / r1
t_5x1 <- log(5) / r1

sprintf("1st Plan - r val: %f, x2 time: %e, x5 time %g", r1, t_2x1, t_5x1)
## [1] "1st Plan - r val: 0.009986, x2 time: 6.941188e+01, x5 time 161.169"

1st Plan: The simulation produced an instantaneous growth rate (r) of 0.0099 and a doubling time of 69.4 time periods (1388 days).


#Plan 2
#Where probability of larvae growing into next stage (gl) is 2 times higher
#gl*2 = 0.2857143
#sl*2 = 0.1633643

sl2 <- (Fa*la)/(((gl*2)/lp)+(gl*2)-1)

lambda2 <- ((sl2*2)*(gl*2))/lp

sp2 <- lambda2/((lp/la)+(1-ga))
sa2 <- sp2

Gl2 <- (sl2*2)*(gl*2)
Gp2 <- sp2*gp
Ga2 <- sa2*sp2
Pl2 <- (sl2*2)*(1-(gl*2))
Pp2 <- sp2*(1-gp)
Pa2 <- sa2*(1-ga)

M2 <- matrix(c(Pl2, Gl2, 0, 0, Pp2, Gp2, Fa, 0, Pa2), nrow = 3, ncol = 3)

N_projected2 <- matrix(0, nrow = nrow(M2), ncol = nTimeSteps+1)

N_projected2[ ,1] <- N_t

for(t in 2:(nTimeSteps+1)){
  N_projected2[ ,t] <- M2 %*% N_projected2[ ,t-1]
  }

plot(1,1,pch="",ylim=c(0,max(N_projected2)),xlim=c(0,nTimeSteps+1),xlab="Time periods (20 days)",ylab="Abundance")

cols2 <- c("darkgoldenrod2", "palegreen4", "palevioletred")

for(s in 1:ncol(M2)){
   points(N_projected2[s,],col=cols2[s],type="l",lwd=2)
}
legend("topleft",col=cols2,lwd=rep(2,ncol(M2)),legend=paste("Stage ",seq(1:ncol(M2))))

t <- 20

r2 <- log(lambda2) / t
t_2x2 <- log(2) / r2
t_5x2 <- log(5) / r2

sprintf("2nd Plan - r val: %f, x2 time: %e, x5 time %g", r2, t_2x2, t_5x2)
## [1] "2nd Plan - r val: 0.006344, x2 time: 1.092609e+02, x5 time 253.696"

2nd Plan: The simulation produced an instantaneous growth rate of 0.0063 and a doubling time of 109.26 time periods (2185 days).


d) Conclusion (in terms of your management plan).

1st Plan: The implications of this modification signify that increasing production of larvae will produce population growth without the need to alter biological variables in the stage structure. Reproduction can be directly targeted.

2nd Plan: The implications of my second modification signify that decoupling the probability of surviving and remaining in the same life stage (Pl) and the probability of surviving and entering the next life stage (Gl) is impossible. Any biological modification will undoubtedly change both values.


4. Stable Stage Structure (section C3): 15%

a) Graphs based on our lab population plus 2 managed populations that clearly demonstrate Lotka’s concept.

#original population

pro <- matrix(data = NA, nrow = 50, ncol = 3)

for(i in 0:50) {
  pro[i,1] <- (N_projected[1,i+1]/sum(N_projected[ ,i+1]))
  pro[i,2] <- (N_projected[2,i+1]/sum(N_projected[ ,i+1]))
  pro[i,3] <- (N_projected[3,i+1]/sum(N_projected[ ,i+1]))
}

colnames(pro) <- c("larN", "pupN/larN", "aduN/larN")

pro_df <- as.data.frame(pro)

ggplot(data = pro_df, aes(x = as.numeric(row.names(pro_df)))) +
  geom_line(aes(y = pro_df$larN, color = "red"), size = 1.3) +
  geom_line(aes(y = pro_df$`pupN/larN`, color = "yellow"), size = 1.3) +
  geom_line(aes(y = pro_df$`aduN/larN`, color = "green"), size = 1.3) +
  labs(x = "Time Periods (20 days)", y = "Proportion", title = "Proportion of Stage Structure for Original Model") +
  scale_color_identity(name = "Legend",
                       breaks = c("red", "yellow", "green"),
                       labels = c("Larvae", "Pupa", "Adult"),
                       guide = "legend") +
  theme_classic()

#start of plan 1

pro1 <- matrix(data = NA, nrow = 50, ncol = 3)

for(i in 0:50) {
  pro1[i,1] <- (N_projected1[1,i+1]/sum(N_projected1[ ,i+1]))
  pro1[i,2] <- (N_projected1[2,i+1]/sum(N_projected1[ ,i+1]))
  pro1[i,3] <- (N_projected1[3,i+1]/sum(N_projected1[ ,i+1]))
}


colnames(pro1) <- c("larN", "pupN/larN", "aduN/larN")

pro1_df <- as.data.frame(pro1)

ggplot(data = pro1_df, aes(x = as.numeric(row.names(pro1_df)))) +
  geom_line(aes(y = pro1_df$larN, color = "red"), size = 1.3) +
  geom_line(aes(y = pro1_df$`pupN/larN`, color = "yellow"), size = 1.3) +
  geom_line(aes(y = pro1_df$`aduN/larN`, color = "green"), size = 1.3) +
  labs(x = "Time Periods (20 days)", y = "Proportion", title = "Proportion of Stage Structure for First Modified Model") +
  scale_color_identity(name = "Legend",
                       breaks = c("red", "yellow", "green"),
                       labels = c("Larvae", "Pupa", "Adult"),
                       guide = "legend") +
  theme_classic()

#start of plan 2

pro2 <- matrix(data = NA, nrow = 50, ncol = 3)

for(i in 0:50) {
  pro2[i,1] <- (N_projected2[1,i+1]/sum(N_projected2[ ,i+1]))
  pro2[i,2] <- (N_projected2[2,i+1]/sum(N_projected2[ ,i+1]))
  pro2[i,3] <- (N_projected2[3,i+1]/sum(N_projected2[ ,i+1]))
}

colnames(pro2) <- c("larN", "pupN/larN", "aduN/larN")

pro2_df <- as.data.frame(pro2)

ggplot(data = pro2_df, aes(x = as.numeric(row.names(pro2_df)))) +
  geom_line(aes(y = pro2_df$larN, color = "red"), size = 1.3) +
  geom_line(aes(y = pro2_df$`pupN/larN`, color = "yellow"), size = 1.3) +
  geom_line(aes(y = pro2_df$`aduN/larN`, color = "green"), size = 1.3) +
  labs(x = "Time Periods (20 days)", y = "Proportion", title = "Proportion of Stage Structure for Second Modified Model") +
  scale_color_identity(name = "Legend",
                       breaks = c("red", "yellow", "green"),
                       labels = c("Larvae", "Pupa", "Adult"),
                       guide = "legend") +
  theme_classic()


b) Describe briefly the results from these graphs. Are the results similar/different?

Plots from the original population and my first management plan look similar. They all exhibited no slope change which indicates stable state has been reaches. However, my second management plan experience some proportion changes at the beginning, then stable state was reached. This proportion difference may be due to changes in the subvariables of next stage survival probability (sl) and next stage movement probability (gl). Without changing the survival values of the pupa or adult, the initial population proportion was unbalanced, resulting in the correction shown on the plot.


c) Conclusion: over the long run, do populations with constant vital rates reach a stable stage structure regardless of their initial abundances?

Yes, populations with constant vital rates reach stable stage structure regardless of initial abundance.

5. Code: 10%

Code with clear and concise comments. Code runs.