Practica Crecimiento
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.
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.6.1library(readxl)## Warning: package 'readxl' was built under R version 4.6.1P1 <- read_excel("Problemas_Modelos.xlsx",
sheet = "Problema1")
View(P1)ggplot(P1, aes(x = Tiempo, y = Altura)) +
geom_point(color = "#003366", fill = "blue", shape = 21, size = 4, stroke = 1.2) +
labs(x = "Tiempo", y = "Altura") +
theme_minimal() +
theme(
panel.background = element_rect(fill = "#E0F4FF"),
plot.background = element_rect(fill = "#E0F4FF", color = NA),
panel.grid.major = element_line(color = "#7FC8F8", linewidth = 0.4),
panel.grid.minor = element_blank(),
axis.title = element_text(color = "#003366", face = "bold"),
axis.text = element_text(color = "#00264D")
)
modelo_P1 <- lm(Altura~Tiempo, data = P1)
summary(modelo_P1)##
## Call:
## lm(formula = Altura ~ Tiempo, data = 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 nuevos_datos <- data.frame(Tiempo= c(40,52))
predict(modelo_P1, nuevos_datos)## 1 2
## 45.68988 58.78060Respuesta
Se predice que el tamaño delas plantulas en el dia 40 es de 45.68, y en el dia 52 tendra un tamaño de 58.78.Yo como lider de laboratorio usaria avono para aumentar el crecimiento.
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(dplyr)
library(ggplot2)
library(growthrates)## Warning: package 'growthrates' was built under R version 4.6.1## Cargando paquete requerido: lattice## Cargando paquete requerido: deSolve## Warning: package 'deSolve' was built under R version 4.6.1library(readxl)
P2 <- read_excel("Problemas_Modelos.xlsx",
sheet = "Problema2")
View(P2)ggplot(P2, aes(x = Muestreo, y = Individuos)) +
geom_point(color = "#003366", fill = "blue", shape = 21, size = 4, stroke = 1.2) +
labs(x = "Muestreo", y = "Individuos") +
theme_minimal() +
theme(
panel.background = element_rect(fill = "#E0F4FF"),
plot.background = element_rect(fill = "#E0F4FF", color = NA),
panel.grid.major = element_line(color = "#7FC8F8", linewidth = 0.4),
panel.grid.minor = element_blank(),
axis.title = element_text(color = "#003366", face = "bold"),
axis.text = element_text(color = "#00264D")
)
library(growthrates)
tiempo <- seq(0, 12, length = 20)
y <- grow_logistic(tiempo, parms = c( y0 = 12, mumax= 0.35, K = 200))[,"y" ]
plot(tiempo, y, type = "l")
Respuesta
La poblacion tiene una poblacion inical de 12, un crecimiento de 0.35 y una capacidad de carga de 200, lo que indica un crecimiento poblacional.
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.
library(dplyr)
library(ggplot2)
library(growthrates)library(readxl)
P3 <- read_excel("Problemas_Modelos.xlsx",
sheet = "Problema3")
View(P3)ggplot(P3, aes(x = Muestreo, y = Individuos)) +
geom_point(color = "#003366", fill = "blue", shape = 21, size = 4, stroke = 1.2) +
labs(x = "Muestreo", y = "Individuos") +
theme_minimal() +
theme(
panel.background = element_rect(fill = "#E0F4FF"),
plot.background = element_rect(fill = "#E0F4FF", color = NA),
panel.grid.major = element_line(color = "#7FC8F8", linewidth = 0.4),
panel.grid.minor = element_blank(),
axis.title = element_text(color = "#003366", face = "bold"),
axis.text = element_text(color = "#00264D")
)
tiempo <- seq(0, 13, length = 600)
y <- grow_logistic(tiempo, parms = c( y0 = 482, mumax= -0.3, K = 550))[,"y" ]
plot(tiempo, y, type = "l")
tiempo <- P3$Muestreo
individuos <-P3$Individuos## Para predecir:
ajuste <- fit_growthmodel(
FUN = grow_logistic,
p = c(y0 = 480 , mumax = -0.3, K = 550), # valores iniciales
time = tiempo,
y = individuos,
lower = c(y0 = 0, mumax = -0.3, K = 1),
upper = c(y0 = 2000, mumax = 0, K = 5000)
)
summary(ajuste)##
## Parameters:
## Estimate Std. Error t value Pr(>|t|)
## y0 509.4169 17.6687 28.832 5.87e-11 ***
## mumax -0.3000 0.0425 -7.059 3.46e-05 ***
## K 601.7137 60.2172 9.992 1.60e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 23.92 on 10 degrees of freedom
##
## Parameter correlation:
## y0 mumax K
## y0 1.0000 0.5423 0.8415
## mumax 0.5423 1.0000 0.8970
## K 0.8415 0.8970 1.0000coef(ajuste)## y0 mumax K
## 509.4169 -0.3000 601.7137## 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## [1] 34.70153Respuesta
La población va a desaparecer funcionalmente alrededor del año 28–36, y el monitoreo ecológico debería concluir en ese rango, confirmando primero que la población ya no es viable o detectable.