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.

#####Paquetes#####
library(ggplot2)
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, union
library(readxl)
P1 <- read_excel("Problemas_Modelos.xlsx", 
    sheet = "Problema1")
View(P1)

ggplot(P1, aes(x = Tiempo, y = Altura)) + 
  geom_point(color = "#00FFFF", fill = "#FF00FF", shape = 21, size = 4, stroke = 1.5) + 
  labs(x = "Tiempo", y = "Altura") + 
  theme_minimal() +
  theme(
    panel.background = element_rect(fill = "#0A0A1A"),
    plot.background  = element_rect(fill = "#0A0A1A", color = NA),
    panel.grid.major = element_line(color = "#39FF14", linewidth = 0.3, linetype = "dotted"),
    panel.grid.minor = element_blank(),
    axis.title       = element_text(color = "#00FFFF", face = "bold"),
    axis.text        = element_text(color = "#FF00FF")
  )

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.78060

Respuesta

En el día 40 el tamaño de las plantas tuvo una predicción de 45.6, mientras que en el día 52 fue una predicción de 58.7. Para aumentar o mejorar su crecimiento se puede utilizar diferentes métodos como fertilizar las plántulas, abonarlas o tenerlas en condiciones óptimas dependiendo de las condiciones de cada una.

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(readxl)
P2 <- read_excel("Problemas_Modelos.xlsx", 
    sheet = "Problema2")
View(P2)

library(growthrates)
## Cargando paquete requerido: lattice
## Cargando paquete requerido: deSolve
ggplot(P2, aes(x = Muestreo, y = Individuos)) + 
  geom_point(color = "#2B003F", fill = "#FF7518", shape = 21, size = 4, stroke = 1.5) + 
  labs(x = "Muestreo", y = "Individuos") + 
  theme_minimal() +
  theme(
    panel.background = element_rect(fill = "#1A1A1A"),
    plot.background  = element_rect(fill = "#1A1A1A", color = NA),
    panel.grid.major = element_line(color = "#5B2A86", linewidth = 0.4),
    panel.grid.minor = element_blank(),
    axis.title       = element_text(color = "#FF7518", face = "bold"),
    axis.text        = element_text(color = "#B388EB")
  )

tiempo <- seq(0, 20, length = 20)

y <- grow_logistic(tiempo, parms = c( y0 = 12, mumax = 0.35, K = 200))[,"y" ]

plot(tiempo, y, type = "l")

Respuesta

La población inicial es de 12, con un crecimiento 0.35 y una capacidad de carga (k) de 200, indicando que tiene 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(readxl)
P3 <- read_excel("Problemas_Modelos.xlsx", 
    sheet = "Problema3")
View(P3)

ggplot(P3, aes(x = Muestreo, y = Individuos)) + 
  geom_point(color = "#FFD166", size = 9, alpha = 0.15) +
  geom_point(color = "#FF4D9D", size = 6.5, alpha = 0.3) +
  geom_point(aes(fill = Individuos), color = "#FFD166", shape = 21, size = 4, stroke = 1.3) + 
  scale_fill_gradient(low = "#00C9A7", high = "#FF2E88", guide = "none") +
  labs(title = "Individuos por Muestreo", x = "Muestreo", y = "Individuos") + 
  theme_minimal() +
  theme(
    plot.title       = element_text(color = "#FFD166", face = "bold.italic", hjust = 0.5, size = 18),
    panel.background = element_rect(fill = "#2A0A3D"),
    plot.background  = element_rect(fill = "#1B0629", color = NA),
    panel.grid.major = element_line(color = "#7B2D8E", linewidth = 0.3, linetype = "longdash"),
    panel.grid.minor = element_blank(),
    axis.title       = element_text(color = "#00E5C0", face = "bold", size = 12),
    axis.text        = element_text(color = "#FFB347")
  )

tiempo <- seq(0, 13, length = 600)

y <- grow_logistic(tiempo, parms = c( y0 = 480, mumax = -0.3, K = 550))[,"y" ]

plot(tiempo, y, type = "l")

## Para predecir:

tiempo <- P3$Muestreo
individuos <- P3$Individuos

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

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
coef(ajuste)
##         y0      mumax          K 
## 480.122018  -0.447271 500.604706
## 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] 26.09752

Respuesta

Para el año 40 la población estará en 0