R Notebook

Resuelva las situaciones que se le presentan a continuación. Para cada una de las situaciones deberán generar un gráfico en ggplot que acompañe a la resolución.

library(ggplot2)
library(readODS)
library(growthrates)

# Datos (el archivo .ods debe estar en la misma carpeta que este .Rmd)
d1 <- read_ods("Problemas_Modelos.ods", sheet = "Problema1")
d2 <- read_ods("Problemas_Modelos.ods", sheet = "Problema2")
d3 <- read_ods("Problemas_Modelos.ods", sheet = "Problema3")

# Tema para todos los gráficos
tema_pro <- theme_minimal(base_size = 14) +
  theme(
    panel.grid.minor = element_blank(),
    axis.title = element_text(face = "bold")
  )

# Función para saber en qué tiempo la población llega a N individuos
t_alcanza <- function(N, p) {
  with(as.list(p), log(N * (K - y0) / (y0 * (K - N))) / mumax)
}

Problema 1

En un laboratorio de botánica se sembraron plántulas de frijol (Phaseolus vulgaris) bajo condiciones controladas: luz constante, temperatura de 25 °C y riego regular. Cada 2 días se midió la altura de 10 plántulas y se registró el promedio. Su grupo debe estimar la tasa de crecimiento de las plántulas con un modelo lineal. Si ustedes tuvieran a cargo de laboratorio, qué decisiones tomarían para que el crecimiento sea mayor.

Ahora, con ese modelo, haga una predicción de cuál será el tamaño de las plantas en los días 40 y 52.

modelo <- lm(Altura ~ Tiempo, data = d1)
print(summary(modelo))

Call:
lm(formula = Altura ~ Tiempo, data = d1)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.22667 -0.59024  0.04583  0.68690  0.86440 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  2.05417    0.36116   5.688 7.44e-05 ***
Tiempo       1.09089    0.02195  49.694 3.25e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.7347 on 13 degrees of freedom
Multiple R-squared:  0.9948,    Adjusted R-squared:  0.9944 
F-statistic:  2469 on 1 and 13 DF,  p-value: 3.247e-16

nuevos_datos <- data.frame(Tiempo = c(40, 52))
nuevos_datos$Altura <- predict(modelo, nuevos_datos)
print(nuevos_datos)

  Tiempo   Altura
1     40 45.68988
2     52 58.78060

ggplot(d1, aes(Tiempo, Altura)) +
  geom_point(size = 3, color = "#2E7D32") +
  geom_smooth(method = "lm", fullrange = TRUE, color = "#1B5E20", fill = "#A5D6A7") +
  geom_point(data = nuevos_datos, size = 4, shape = 17, color = "#C62828") +
  scale_x_continuous(limits = c(0, 55)) +
  labs(x = "Tiempo (días)", y = "Altura promedio (cm)") +
  tema_pro

Respuesta

El modelo lineal establece que las plántulas de frijol crecen 1.09 cm por día. Con este modelo, la altura de las plantas es de 45.7 cm en el día 40 y de 58.8 cm en el día 52 (triángulos rojos en el gráfico).

Como encargada del laboratorio, tomaría las siguientes decisiones para aumentar el crecimiento: optimizar la cantidad y la duración de la luz, mejorar el sustrato y la fertilización, ajustar el volumen de riego y evaluar temperaturas cercanas a 25 °C. Cada factor se prueba en un experimento controlado, cambiando una sola variable a la vez y comparando las tasas de crecimiento.

El modelo lineal no incorpora un límite de crecimiento, mientras que las plantas reales dejan de crecer al alcanzar su altura máxima. Por eso, la predicción del día 52 sobrestima la altura real.

Problema 2

La lapa roja o guacamaya roja (Ara macao) fue casi eliminada de buena parte del Pacífico de Costa Rica por la pérdida de bosque y la captura de polluelos. Gracias a programas de conservación y reintroducción, algunas poblaciones se han recuperado.

Imaginen que un programa de conservación liberó un grupo pequeño de lapas rojas en un bosque protegido del Pacífico central y las censó cada año durante 20 años. Ustedes deben ajustar un modelo logístico a los datos y estimar los parámetros que describen el crecimiento de esta población. Como tomadores de decisión, especifiquen cuándo deberá de terminar el monitoreo ecológico, según el comportamiento poblacional.

ajuste2 <- fit_growthmodel(
  FUN   = grow_logistic,
  p     = c(y0 = 12, mumax = 0.5, K = 190),
  time  = d2$Muestreo,
  y     = d2$Individuos,
  lower = c(y0 = 1, mumax = 0, K = 1),
  upper = c(y0 = 100, mumax = 3, K = 2000)
)
print(summary(ajuste2))

Parameters:
      Estimate Std. Error t value Pr(>|t|)    
y0     12.0260     0.8352   14.40 2.55e-11 ***
mumax   0.3501     0.0106   33.04  < 2e-16 ***
K     180.4668     1.6627  108.54  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.025 on 18 degrees of freedom

Parameter correlation:
           y0   mumax       K
y0     1.0000 -0.9287  0.4966
mumax -0.9287  1.0000 -0.6723
K      0.4966 -0.6723  1.0000

p2 <- coef(ajuste2)
print(p2)

         y0       mumax           K 
 12.0260449   0.3501131 180.4667880 

curva2 <- as.data.frame(grow_logistic(seq(0, 20, 0.1), p2))

ggplot() +
  geom_point(data = d2, aes(Muestreo, Individuos), size = 3, color = "#C62828") +
  geom_line(data = curva2, aes(time, y), linewidth = 1.2, color = "#1565C0") +
  geom_hline(yintercept = p2["K"], linetype = "dashed", color = "grey40") +
  labs(x = "Año de muestreo", y = "Individuos") +
  tema_pro

# Año en que se alcanza 50 %, 90 % y 95 % de K
print(t_alcanza(0.5 * p2["K"], p2))

       K 
7.539018 

print(t_alcanza(0.9 * p2["K"], p2))

       K 
13.81477 

print(t_alcanza(0.95 * p2["K"], p2))

       K 
15.94898 

Respuesta

El modelo logístico ajustado a los censos de lapa roja tiene una población inicial (y0) de 12 lapas, una tasa de crecimiento (mumax) de 0.35 por año y una capacidad de carga (K) de 180 individuos (línea punteada en el gráfico). Los tres parámetros son altamente significativos (p < 0.001) y el error residual es bajo, por lo que el modelo describe correctamente el comportamiento de la población.

La población crece lentamente al inicio, se acelera hasta llegar a la mitad de K (90 lapas) en el año 7.5 y luego se desacelera hasta estabilizarse. Alcanza el 90 % de K en el año 13.8 y el 95 % en el año 15.9.

El monitoreo ecológico debe terminar en el año 16, cuando la población está en su capacidad de carga y su crecimiento es nulo. Después de esa fecha se mantiene un monitoreo espaciado, cada 3 a 5 años, para detectar amenazas como la pérdida de bosque y la captura de polluelos.

Problema 3

En los bosques nubosos de la cordillera de Tilarán, un anfibio endémico (especie ficticia, inspirada en lo ocurrido con el sapo dorado de Monteverde) mantenía una población estable de unos 500 individuos. A partir de cierto momento, la llegada de un hongo patógeno (quitridiomicosis) y el aumento de la temperatura hicieron que las muertes superaran a los nacimientos. Un equipo de biólogos censó la población cada año durante 12 años. (mumax = -0.3, K = 550)

Ustedes deben ajustar un modelo logístico con tasa de crecimiento y usarlo para predecir cuándo desaparecerá la población.

ajuste <- fit_growthmodel(
  FUN   = grow_logistic,
  p     = c(y0 = 480, mumax = -0.3, K = 550),
  time  = d3$Muestreo,
  y     = d3$Individuos,
  lower = c(y0 = 1,    mumax = -3, K = 1),
  upper = c(y0 = 2000, mumax = 0,  K = 5000)
)

print(summary(ajuste))

Parameters:
       Estimate Std. Error t value Pr(>|t|)    
y0    480.12202    3.08418  155.67  < 2e-16 ***
mumax  -0.44727    0.01071  -41.76 1.49e-12 ***
K     500.60471    4.79604  104.38  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 4.775 on 10 degrees of freedom

Parameter correlation:
          y0  mumax      K
y0    1.0000 0.5489 0.9490
mumax 0.5489 1.0000 0.7768
K     0.9490 0.7768 1.0000

p3 <- coef(ajuste)
print(p3)

        y0      mumax          K 
480.122018  -0.447271 500.604706 

# Número de individuos en los años 20, 40 y 50
t_pred <- c(20, 40, 50)
N_pred <- grow_logistic(t_pred, p3)[, "y"]
print(data.frame(Anio = t_pred, Individuos = N_pred))

  Anio   Individuos
1   20 1.524714e+00
2   40 1.993271e-04
3   50 2.275587e-06

# Año en que queda menos de 1 individuo
print(t_alcanza(1, p3))

[1] 20.94542

curva3 <- as.data.frame(grow_logistic(seq(0, 30, 0.1), p3))

ggplot() +
  geom_point(data = d3, aes(Muestreo, Individuos), size = 3, color = "#C62828") +
  geom_line(data = curva3, aes(time, y), linewidth = 1.2, color = "#1565C0") +
  labs(x = "Año de muestreo", y = "Individuos") +
  tema_pro

Respuesta

El modelo logístico con tasa negativa ajusta los censos con una población inicial (y0) de 480 individuos, una tasa de crecimiento (mumax) de -0.45 por año, es decir, una disminución de 45 % anual, y una capacidad de carga (K) de 500 individuos.

El modelo predice 1.5 individuos en el año 20 y una población de 0 en los años 40 y 50. La población baja de un individuo en el año 21, y ese es el momento en que desaparece.

Con el hongo patógeno y el aumento de temperatura, la población se extingue en 21 años desde el inicio de los censos. Las acciones de conservación deben ejecutarse antes de ese plazo.