The von Bertanlanffy growth equation

a famously curved line

Andrew and Will true
07-12-2022

A classic equation for how things grow is the Von Bertanlanfyy growth equation:

\[ L_t = L_\infty(1 - e^{-k \Delta t}) \]

Here’s a simple plot:

m <- 300
k = 1/20
curve(m * (1 - exp(-k*x)), xlim = c(0, 100))
Simple plot of a fake tree's growth. It grows to a DBH of 300mm

(#fig:vb_plot)Simple plot of a fake tree’s growth. It grows to a DBH of 300mm

we could imagine lognormal variation in the measurement around this average.

random variation

how do we expect to make observations around this line? where does variation come from? consider just one individual tree. this tree has a max size and a growth rate, and that is fixed by the environment and genetics

ln_a <- function(log_mu, log_sigma){
 common_term <- log1p(exp(2 * (log_sigma - log_mu)))
 log_mu - common_term
}

ln_b <- function(log_mu, log_sigma){
  common_term <- log1p(exp(2 * (log_sigma - log_mu)))
  sqrt(common_term)
}

hist(rlnorm(100,
       ln_a(log(40), log(5)),
       ln_b(log(40), log(5))))


library(tidyverse)
true_Lm <- 200
true_k <- 1/20
tibble(t = 1:100,
       L = true_Lm*(1 - exp(-true_k*t)),
       log_L = log(L),
       y = rlnorm(length(t), 
                  ln_a(log_L, log(10)),
                  ln_b(log_L, log(10)))) |> 
  ggplot(aes(x = t, y = y)) + 
  geom_point() + 
  geom_point(aes(y = L), col = "red")  + 
  geom_segment(aes(xend = t, yend = L))

but then what happens as the growth rate varies between years? does it look the same or different?

n <- 100
# ks <- rexp(n = n, rate = 20)
ks <- rlnorm(n, ln_a(log(1/20), log(1/60)), ln_b(log(1/20), log(1/60)))
true_Lm <- 200
true_k <- 1/20
tibble(t = 1:n,
       L = true_Lm*(1 - exp(-ks*t)),
       log_L = log(L),
       y = rlnorm(length(t), 
                  ln_a(log_L, log(10)),
                  ln_b(log_L, log(10)))) |> 
  ggplot(aes(x = t, y = y)) + 
  geom_point() + 
  geom_point(aes(y = L), col = "red")  + 
  geom_segment(aes(xend = t, yend = L)) + 
  stat_function(fun = function(x) true_Lm*(1 - exp(-true_k*x)))

These two things look like they could be identifiable. The variation in k causes variation, but mostly for intermediate values while because of the variance-mean relationship, the highest observation variance is in the highest values

so I feel like some teeter-totter exists between the two quantities certainly the use of hierarchical effects with different species will help. pulling some of the species towards the mean.

n <- 100
# ks <- rexp(n = n, rate = 20)
ks <- rlnorm(70, ln_a(log(1/20), log(1/60)), ln_b(log(1/20), log(1/60)))
expand_grid(t = 1:100,
            k = ks) |> 
  mutate(
    L = true_Lm*(1 - exp(-k*t)),
    log_L = log(L)) |> 
  ggplot(aes(x = t, y = L, group = k)) + 
  geom_line()

modelling a growth increment

k as a function

as a function between its lower and upper bounds

logistic_LU <- function(L, U, x) {
  L + (U-L)*plogis(x)
}

curve(logistic_LU(2, 7, x), xlim = c(-3, 4))

now add this to the model

n <- 100
expand_grid(t = 1:100,
            k = logistic_LU(.01, .1, t - 15)) |> 
  mutate(
    L = true_Lm*(1 - exp(-k*t)),
    log_L = log(L)) |> 
  ggplot(aes(x = t, y = L, group = k)) + 
  geom_line()

or instead

n <- 100
tibble(t = seq(0, 100, by = .5),
            k = logistic_LU(.01, .1, .1*(t - 50))) |> 
  mutate(
    L = true_Lm*(1 - exp(-k*t))) |> 
  ggplot(aes(x = t, y = L)) + 
  geom_line()

So we have a rate that accelerates before a certain point in time, then declines again.

Its flexible enough to make a large family of curves.

Also need to think about how to model an increment, not an absolute difference like this

so if things grow according to this curve, then the relative increment (L2 - L1, divided by L1) works out to– the proportion you still have to grow? is that true?

n <- 100


one_curve <- tibble(t = 1:100,
       k = 1/22) |> 
  mutate(
    L = true_Lm*(1 - exp(-k*t)),
    log_L = log(L))

one_curve |> 
  ggplot(aes(x = t, y = L, group = k)) + 
  geom_line()
one_curve |> 
  mutate(inc = L - lag(L),
         rl = inc/lag(L)) |> 
  ggplot(aes(x = t, y = rl)) + geom_point()

I also think it is possible to, assuming that this relationship holds also for very small trees, to estimate the probability that they grow out of the small category and into the large one (ie to also use ingrow probability to measure growth rates)

one_curve |> ggplot(aes(x = t, y = L)) + geom_line()
one_curve |> 
  mutate(inc = L - lag(L),
         rl = inc/lag(L)) |> 
  ggplot(aes(x = t, y = inc)) + geom_point() + 
  coord_trans(y = "log")

this is ABSOLUTE time, which normally we will not have!

one_curve |> 
  mutate(inc = L - lag(L),
         rl = inc/lag(L)) |> 
  ggplot(aes(x = 1, y = inc)) + geom_point() + 
  coord_trans(y = "log")

not terribly useful! it coverse the whole range

could use that to infer a tree’s age from its growth rate, that is kind of neat.

one_curve |> 
  mutate(inc = L - lag(L),) |> 
  ggplot(aes(x = lag(L), y = inc)) + geom_point()

Why does this work?

\[ \begin{align} L(t) =& L_\infty(1 - e^{-kt}) \\ L(t_2) - L(t_1) =& L_\infty(1 - e^{-kt_2}) - L_\infty(1 - e^{-kt_1}) \\ L(t_1 + \Delta t) - L(t_1) =& L_\infty - L_\infty e^{-kt_1}e^{-k\Delta t} - L(t_1) \\ =& L_\infty - (L_\infty - L(t_1))e^{-k\Delta t} - L(t_1) \\ =& (L_\infty - L(t_1)) \times (1 - e^{-k\Delta t}) \end{align} \]

This means we get a straight line when we plot the growth increment as a function of size at the start of the interval.

\[ \begin{align} \text{increment} =& (L_\infty - L_t)(1 - e^{-k\Delta t}) \\ =& L_\infty (1 - e^{-k\Delta t}) - (1 - e^{-k\Delta t}) \times L_t \end{align} \]

Which is a straight line as long as \(k\) and \(\Delta t\) are fixed.

curve(log(true_Lm - 60) + log(1 - exp(-true_k * x)), xlim = c(0, 200))

Work with log increment though, it seems like that would be easier to think about and model.