#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.
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.
#Procedimiento
library(readxl)
library(ggplot2)
library(growthrates)
## Loading required package: lattice
## Loading required package: deSolve
#Guardar cada hoja en una variable diferente
datos_p1 <- read_excel("Problemas_Modelos.xlsx", sheet = "Problema1")
datos_p2 <- read_excel("Problemas_Modelos.xlsx", sheet = "Problema2")
datos_p3 <- read_excel("Problemas_Modelos.xlsx", sheet = "Problema3")
#Ajustar el modelo lineal
modelo1 <- lm(Altura ~ Tiempo, data = datos_p1)
summary(modelo1)
##
## Call:
## lm(formula = Altura ~ Tiempo, data = datos_p1)
##
## 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
#Predicciones para los días 40 y 52
nuevos_datos <- data.frame(Tiempo = c(40, 52))
predicciones <- predict(modelo1, nuevos_datos)
#Mostrar resultados de predicción
data.frame(
Dia = c(40, 52),
Altura_Predicha_cm = predicciones)
#Graficar con ggplot
ggplot(datos_p1, aes(x = Tiempo, y = Altura)) +
geom_point(color = "pink", size = 3) +
geom_smooth(method = "lm", color = "orange", se = TRUE) +
labs(
x = "Tiempo (Días)",
y = "Altura Promedio (cm)"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
#Respuesta #Se muestra un crecimiento exponencial, que indica que la
alineación de los puntos a lo largo del tiempo, muestran que las
condiciones del laboratorio mantienen un estado fisiológico estable para
las plantas. Por lo tanto, para mantener esta estabilidad se tomarán las
siguientes medidas: 1. Fertilizar las plantas para un adecuado
crecimiento y desarrollo foliar; 2. Monitorear la temperatura y humedad
para evitar el estrés hídrico.
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.
#Procedimiento
#Ajustar el tiempo
tiempo <- seq(1,20 , length = 100)
#Modelo logístico
y <- grow_logistic(tiempo, parms = c( y0 = 12, mumax = 0.7, K = 200)) [,"y"]
sim <- data.frame(tiempo = tiempo, y = y)
#Graficar
ggplot(sim, aes(x = tiempo, y = y)) +
geom_line(color = "orange", linewidth = 1.2) +
geom_point(color = "pink", size = 2.5) +
geom_hline(
yintercept = 200,
linetype = "dashed",
color = "gray40"
) +
labs(
x = "Tiempo (años)",
y = "Número de individuos"
) +
theme_minimal()
#Respuesta #Se debería seguir con el monitoreo ya que la curva aún se
encuentra en crecimiento. El monitoreo debería seguir activo hasta que
la población llegue a los 200 individuos, esto debido a la capacidad de
carga. Al llegar a la capacidad de carga, no se debería cancelar por
completo el monitoreo, sino tener una vigilancia periódica para la
detección de amenazas como la caza o las enfermedades.
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.
#Procedimiento
#Cargar librería
library(growthrates)
#Ajuste del modelo logístico con tasa de crecimiento negativa
ajuste <- fit_growthmodel(
FUN = grow_logistic,
p = c(y0 = 480, mumax = -0.3, K = 550), # valores iniciales aproximados
time = datos_p3$Muestreo,
y = datos_p3$Individuos,
lower = c(y0 = 1, mumax = -3, K = 1),
upper = c(y0 = 2000, mumax = 0, K = 5000))
#Mostrar resumen del ajuste
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
p <- coef(ajuste)
#Función para predecir el momento en que la población alcanza N individuos
t_alcanza <- function(N, p) {
with(as.list(p), log(N * (K - y0) / (y0 * (K - N))) / mumax)}
#Tiempo estimado para llegar a 0.1 individuos (extinción funcional)
tiempo_extincion <- t_alcanza(0.1, p)
cat("La población colapsará casi por completo en aprox.", round(tiempo_extincion, 2), "años.\n")
## La población colapsará casi por completo en aprox. 26.1 años.
#Gráfico con ggplot
ggplot(datos_p3, aes(x = Muestreo, y = Individuos)) +
geom_point(color = "orange", size = 3) +
geom_line(aes(y = predict(ajuste)[, "y"]), color = "pink", linewidth = 1) +
geom_vline(xintercept = tiempo_extincion, linetype = "dashed", color = "black") +
labs(
x = "Tiempo (Años de monitoreo)",
y = "Número de Individuos"
) +
theme_minimal()
#Respuesta #La curva decreciente muestra que la población se dirige
hacia 0. Donde en el año 12 la población desaparecerá por completo.