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.

predict(modelol, nuevos_datos)

       1        2 
45.68988 58.78060 

library(readxl)
Problema1 <- read_excel("C:/Users/elean/OneDrive/Escritorio/Modelosb_III/Problemas_Modelos.xlsx", 
    sheet = "Problema1")
View(Problema1)

Problema1

Problema1 <- data.frame(
  Tiempo = c(40, 52),
  Altura = problema1
)

class(problema1)

problema1 <- Problema1
promedio <- mean(Problema1$Altura)

grafico1 <- ggplot(Problema1, aes(x = Tiempo, y = Altura)) +
  # Línea del promedio (azul cielo claro)
  geom_hline(yintercept = promedio, linetype = "dashed",
             color = "#7FA3C7", linewidth = 0.7) +
  annotate("text", x = max(Problema1$Tiempo), y = promedio,
           label = paste0("Promedio = ", round(promedio, 1), " cm"),
           hjust = 1, vjust = -0.6, color = "#A9C4E0", size = 4) +
  # Recta de tendencia con banda de confianza (amarillo luna)
  geom_smooth(method = "lm", color = "#F4D35E", fill = "#E9B44C",
              alpha = 0.3, linewidth = 1.2) +
  # Puntos rojizos
  geom_point(color = "#F28C28", fill = "#FFE066", shape = 21,
             size = 4, stroke = 1, alpha = 0.9) +
  labs(
    x = "Tiempo (días)",
    y = "Altura (cm)"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    # Fondo azul noche
    plot.background  = element_rect(fill = "#0B1F4B", color = NA),
    panel.background = element_rect(fill = "#10285E", color = NA),
    # Textos claros
    plot.title       = element_text(face = "bold", color = "#F4D35E"),
    plot.subtitle    = element_text(color = "#A9C4E0"),
    axis.title       = element_text(color = "#DCE6F2"),
    axis.text        = element_text(color = "#A9C4E0"),
    # Cuadrícula sutil azulada
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "#1E3A78")
  )

grafico1

mod_prob1 <- lm(Altura~ Tiempo, data = Problema1)
summary(mod_prob1)

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

predict(mod_prob1, nuevos_datos)

Respuesta

1 2 17.32667 17.32667

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.

library(growthrates)


datos <- data.frame(
  ano = 0:20,
  poblacion = c(
    12, 15, 24, 29, 43, 50, 69, 79, 101, 109,
    131, 136, 152, 154, 166, 165, 174, 171, 179, 174, 181
  )

)

==========================================

MODELO LOGÍSTICO

==========================================

modelo <- nls(
  poblacion ~ K / (1 + A * exp(-r * ano)),
  data = datos,
  start = list(K = 190, A = 15, r = 0.3)
)

==========================================

VER LOS RESULTADOS DEL MODELO

==========================================

summary(modelo)

==========================================

OBTENER LOS PARÁMETROS

==========================================

K <- coef(modelo)["K"]
A <- coef(modelo)["A"]
r <- coef(modelo)["r"]

K A r

==========================================

CREAR LA CURVA LOGÍSTICA

==========================================

ano_curva <- seq(0, 20, length.out = 200)

poblacion_curva <- K / (1 + A * exp(-r * ano_curva))

==========================================

GRÁFICA

==========================================

plot(
  datos$ano,
  datos$poblacion,
  pch = 19,
  xlab = "Muestreo",
  ylab = "Número de individuos",
  main = "Crecimiento poblacional de la lapa roja (Ara macao)",
  xlim = c(0, 20),
  ylim = c(0, K * 1.1)
)

Curva logística

lines(
  ano_curva,
  poblacion_curva,
  lwd = 3
)

Capacidad de carga

abline(
  h = K,
  lty = 2,
  lwd = 2
)

Leyenda

legend(
  "bottomright",
  legend = c(
    "Datos observados",
    "Modelo logístico",
    "Capacidad de carga (K)"
  ),
  pch = c(19, NA, NA),
  lty = c(NA, 1, 2),
  lwd = c(NA, 3, 2)
)

Respuesta

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

library(readxl)
Problema3 <- read_excel("C:/Users/elean/OneDrive/Escritorio/Modelosb_III/Problemas_Modelos.xlsx", 
    sheet = "Problema3")
View(Problema3)

Problema3

ggplot(Problema3, aes(x = Muestreo, y = Individuos)) +
  geom_line(color = "#2E8B57", linewidth = 1.2) +
  geom_point(color = "#1B4332", fill = "#B7E04A", shape = 21,
             size = 3, stroke = 0.8, alpha = 0.95) +
  theme_classic() +
  labs(x = "Año", y = "Individuos")

Problema3

tiempo <- Problema3$Muestreo
individuos <- Problema3$Individuos

library(growthrates)
library(ggplot2)

# 1. Ajuste del modelo logístico
ajuste <- fit_growthmodel(
  FUN   = grow_logistic,
  p     = c(y0 = 500, mumax = -0.3, K = 550),   # valores iniciales
  time  = Problema3$Muestreo,
  y     = Problema3$Individuos,
  lower = c(y0 = 1,    mumax = -3, K = 1),
  upper = c(y0 = 2000, mumax = 0,  K = 5000)
)

summary(ajuste)
p <- coef(ajuste)
p

# 2. Individuos en tiempos futuros
t_pred <- c(20, 40, 50)
N_pred <- grow_logistic(t_pred, p)[, "y"]
N_pred

# 3. Tiempo en que la población llega a un umbral de extinción
t_alcanza <- function(N, p) {
  with(as.list(p), log(N * (K - y0) / (y0 * (K - N))) / mumax)
}
t_alcanza(1, p)     # queda 1 individuo
t_alcanza(0.1, p)   # menos de 1 individuo (extinción práctica)

Respuesta

Según el modelo, en el año 20 quedarían aproximadamente [valor] individuos, en el año 40 [valor] y en el año 50 [valor].