Modelo de crecimiento logístico y de Gompertz

Análisis Demográfico

Jacob Hernández

2020-09-30

growth_model <- function(training, date_col = "date", pop_col = "pop", 
                         type = c("log","gmp")){
  
  data <- as.data.frame(training)
  
  nr <- nrow(data)
  n <- nr %/% 3
   
  if (nr %% 3 == 1) {
    data <- data[-1,]
  } else if (nr %% 3  == 2) {
    data <- data[-c(1,nr),]
  }
  
  fd <- data[1, date_col]
  dd <- diff(data[1:2, date_col])
  
  if (type == "log") {
    s <- map_dbl(0:2, ~sum(1/data[1:n + .x*n, pop_col]))
  } else if (type == "gmp") {
    s <- map_dbl(0:2, ~sum(log(data[1:n + .x*n, pop_col])))
  }
  
  c <- ((s[3]-s[2])/(s[2]-s[1]))**(1/n)
  h <- (s[2]-s[1])*(c-1)/(c**n-1)**2
  k <- 1/n*(s[1]-(c**n-1)/(c-1)*h)
  
  if (type == "log") {
    function(date) 1/(k+h*c**((date-fd)/dd))
  } else if (type == "gmp") {
    function(date) exp(k+h*c**((date-fd)/dd))
  }
}

data <- tibble(
  t = seq(1950, 2000, 10),
  P = c(8.31,10.39, 12.66, 14.81, 17.17, 19.27)
)

mod1 <- growth_model(data, date_col = "t", pop_col = "P", type = "log")
mod2 <- growth_model(data, date_col = "t", pop_col = "P", type = "gmp")

projections <- data %>% 
  bind_rows(tibble(t = seq(2010, 2030, 10))) %>% 
  mutate(
    .plog = mod1(t), 
    .pgmp = mod2(t) 
  )