R Notebook

Resuelva las situaicones 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.

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ñao de las plantas en los días 40 y 52.

# nuevos_datos <- data.frame(Tiempo= c(40,52))

# predict(modelo, nuevos_datos)

Respuesta

library(ggplot2)
library(tidyverse)

datos <- data.frame(
  Tiempo = c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28),
  Altura = c(2.1, 4, 6.9, 8.2, 11.5, 12.4, 15.8, 16.1, 20.3, 20.9,
             24.6, 25.2, 29.1, 29.8, 33)
)

# Ver las primeras filas
head(datos)

# Resumen estadístico
summary(datos)

     Tiempo       Altura     
 Min.   : 0   Min.   : 2.10  
 1st Qu.: 7   1st Qu.: 9.85  
 Median :14   Median :16.10  
 Mean   :14   Mean   :17.33  
 3rd Qu.:21   3rd Qu.:24.90  
 Max.   :28   Max.   :33.00  

# Gráfica de dispersión con línea de tendencia
ggplot(datos, aes(x = Tiempo, y = Altura)) +
  geom_point(size = 3, color = "purple") +          # puntos
  geom_smooth(method = "lm", se = TRUE, color = "violet") + # línea de regresión
  labs(title = "Crecimiento de plántulas de frijol",
       x = "Tiempo (días)",
       y = "Altura promedio (cm)") +
  theme_minimal()

# Ajustar el modelo lineal: Altura ~ Tiempo
modelo <- lm(Altura ~ Tiempo, data = datos)

# Ver los resultados del modelo
summary(modelo)

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

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

Coefficients:
            Estimate Std. Error t value
(Intercept)  2.05417    0.36116   5.688
Tiempo       1.09089    0.02195  49.694
            Pr(>|t|)    
(Intercept) 7.44e-05 ***
Tiempo      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

# Crear un data.frame con los días a predecir
nuevos_dias <- data.frame(Tiempo = c(40, 52))

# Predecir la altura
prediccion <- predict(modelo, newdata = nuevos_dias)

# Ver el resultado
prediccion

       1        2 
45.68988 58.78060 

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.

Respuesta

# Crear la base de datos directamente en R
datos <- data.frame(
  Muestreo = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
               10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20),
  Individuos = c(12, 15, 24, 29, 43, 50, 69, 79, 101, 109,
                 131, 136, 152, 154, 166, 165, 174, 171, 179, 174, 181)
)

head(datos)

summary(datos)

    Muestreo    Individuos   
 Min.   : 0   Min.   : 12.0  
 1st Qu.: 5   1st Qu.: 50.0  
 Median :10   Median :131.0  
 Mean   :10   Mean   :110.2  
 3rd Qu.:15   3rd Qu.:166.0  
 Max.   :20   Max.   :181.0  

ggplot(datos, aes(x = Muestreo, y = Individuos)) +
  geom_point(size = 3, color = "pink") +
  labs(title = "Crecimiento poblacional de la lapa roja",
       x = "Año de muestreo",
       y = "Número de individuos") +
  theme_minimal()

# Ajustar el modelo logístico con los parámetros dados
modelo <- nls(Individuos ~ 550 / (1 + ((550 - N0) / N0) * exp(-(-0.3) * Muestreo)),
              data = datos,
              start = list(N0 = 480))

summary(modelo)

Formula: Individuos ~ 550/(1 + ((550 - N0)/N0) * exp(-(-0.3) * Muestreo))

Parameters:
   Estimate Std. Error t value Pr(>|t|)
N0    67.22      79.81   0.842     0.41

Residual standard error: 126.8 on 20 degrees of freedom

Number of iterations to convergence: 8 
Achieved convergence tolerance: 2.927e-06

# Parámetros dados
K <- 550
mu_max <- -0.3
N0 <- 482   # población inicial del censo

# Función logística
N <- function(t) {
  K / (1 + ((K - N0) / N0) * exp(-mu_max * t))
}

# Secuencia de años (hasta cuando la población llegue a 0)
años <- seq(0, 30, length.out = 300)
pred <- N(años)
curva <- data.frame(Muestreo = años, Individuos = pred)

ggplot(datos, aes(x = Muestreo, y = Individuos)) +
  geom_point(size = 3, color = "purple") +
  geom_line(data = curva, color = "blue", linewidth = 1) +
  labs(title = "Modelo logístico del declive del anfibio",
       x = "Año de muestreo",
       y = "Número de individuos") +
  theme_minimal()

# Probar varios años y ver cuándo llega a menos de 1
for (t in 0:40) {
  cat("Año", t, ":", round(N(t), 2), "individuos\n")
}

Año 0 : 482 individuos
Año 1 : 462.02 individuos
Año 2 : 437.53 individuos
Año 3 : 408.32 individuos
Año 4 : 374.56 individuos
Año 5 : 336.95 individuos
Año 6 : 296.74 individuos
Año 7 : 255.57 individuos
Año 8 : 215.25 individuos
Año 9 : 177.46 individuos
Año 10 : 143.47 individuos
Año 11 : 113.99 individuos
Año 12 : 89.24 individuos
Año 13 : 69.01 individuos
Año 14 : 52.84 individuos
Año 15 : 40.15 individuos
Año 16 : 30.32 individuos
Año 17 : 22.78 individuos
Año 18 : 17.06 individuos
Año 19 : 12.74 individuos
Año 20 : 9.5 individuos
Año 21 : 7.07 individuos
Año 22 : 5.25 individuos
Año 23 : 3.9 individuos
Año 24 : 2.9 individuos
Año 25 : 2.15 individuos
Año 26 : 1.59 individuos
Año 27 : 1.18 individuos
Año 28 : 0.88 individuos
Año 29 : 0.65 individuos
Año 30 : 0.48 individuos
Año 31 : 0.36 individuos
Año 32 : 0.26 individuos
Año 33 : 0.2 individuos
Año 34 : 0.14 individuos
Año 35 : 0.11 individuos
Año 36 : 0.08 individuos
Año 37 : 0.06 individuos
Año 38 : 0.04 individuos
Año 39 : 0.03 individuos
Año 40 : 0.02 individuos

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.

## Para predecir:

ajuste <- fit_growthmodel(
  FUN   = grow_logistic,
  p     = c(y0 = , mumax = , K = ),   # valores iniciales
  time  = tiempo,
  y     = individuos,
  lower = c(y0 = 1,    mumax = -3, K = 1),
  upper = c(y0 = 2000, mumax = 0,  K = 5000)
)

summary(ajuste)
coef(ajuste)


## Predicción de cuál será el número de individuos en un tiempo determinado

p <- coef(ajuste)
t_pred <- c(20,40,50)
N_pred <- grow_logistic(t_pred, p)[, "y"]

## Predicción de en qué momento la población va a ser 0

t_alcanza <- function(N, p) {
  with(as.list(p), log(N * (K - y0) / (y0 * (K - N))) / mumax)
}
t_alcanza(0.1, p)    # K/2 y 90 % de K

Respuesta

datos <- data.frame(
  Muestreo = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
  Individuos = c(482, 466, 456, 427, 404, 351, 314, 249, 203, 143, 109, 70, 51)
)

ggplot(datos, aes(x = Muestreo, y = Individuos)) +
  geom_point(size = 3, color = "purple") +
  labs(title = "Declive poblacional del anfibio endémico",
       x = "Año de muestreo",
       y = "Número de individuos") +
  theme_minimal()

# Parámetros dados
K <- 550
mu_max <- -0.3
N0 <- 482

# Función logística
N <- function(t) {
  K / (1 + ((K - N0) / N0) * exp(-mu_max * t))
}

años <- seq(0, 30, length.out = 300)
curva <- data.frame(Muestreo = años, Individuos = N(años))

ggplot(datos, aes(x = Muestreo, y = Individuos)) +
  geom_point(size = 3, color = "purple") +
  geom_line(data = curva, color = "blue", linewidth = 1) +
  labs(title = "Modelo logístico del declive del anfibio",
       x = "Año de muestreo",
       y = "Número de individuos") +
  theme_minimal()

# Ver la población año por año hasta que baje de 1 individuo
for (t in 0:40) {
  cat("Año", t, ":", round(N(t), 2), "individuos\n")
}

Año 0 : 482 individuos
Año 1 : 462.02 individuos
Año 2 : 437.53 individuos
Año 3 : 408.32 individuos
Año 4 : 374.56 individuos
Año 5 : 336.95 individuos
Año 6 : 296.74 individuos
Año 7 : 255.57 individuos
Año 8 : 215.25 individuos
Año 9 : 177.46 individuos
Año 10 : 143.47 individuos
Año 11 : 113.99 individuos
Año 12 : 89.24 individuos
Año 13 : 69.01 individuos
Año 14 : 52.84 individuos
Año 15 : 40.15 individuos
Año 16 : 30.32 individuos
Año 17 : 22.78 individuos
Año 18 : 17.06 individuos
Año 19 : 12.74 individuos
Año 20 : 9.5 individuos
Año 21 : 7.07 individuos
Año 22 : 5.25 individuos
Año 23 : 3.9 individuos
Año 24 : 2.9 individuos
Año 25 : 2.15 individuos
Año 26 : 1.59 individuos
Año 27 : 1.18 individuos
Año 28 : 0.88 individuos
Año 29 : 0.65 individuos
Año 30 : 0.48 individuos
Año 31 : 0.36 individuos
Año 32 : 0.26 individuos
Año 33 : 0.2 individuos
Año 34 : 0.14 individuos
Año 35 : 0.11 individuos
Año 36 : 0.08 individuos
Año 37 : 0.06 individuos
Año 38 : 0.04 individuos
Año 39 : 0.03 individuos
Año 40 : 0.02 individuos

Decisión: El monitoreo debe continuar hasta que la población llegue a cero (≈ año 20) para documentar la extinción. Después, enfocar esfuerzos en conservación ex situ (criaderos, biobancos) y mitigación de la quitridiomicosis y el cambio climático, ya que el modelo confirma que la población no se recuperará por sí sola.