Actividad 3. Análisis Geoespacial de cultivo de Aguacate
Andrea Riaño
2024-06-05
Cultivo de Aguacate
Los datos corresponden a las mediciones que se han hecho en árboles de producción de aguacate en una finca ubicada en el departamento del Cauca. Cada árbol tiene un identificador, adicionalmente estan Georeferenciados con la variable latitud y longitud.
La base de datos esta compuesta por Variables climaticas como:
Humedad relativa
Vientos
Temperatura
Altura
1. Análisis exploratorio
Para el caso de estudio nos cetraremos en el analisis de la variable Temperatura y se tendra como fecha de referencia 01-10-2020.
Data$fecha <- as.Date(Data$FORMATTED_DATE_TIME, format = "%d/%m/%Y")
Data_20 <- filter(Data, fecha == "2020-10-01")
tabla <- (head(Data_20,5))
tabla %>%
kbl() %>%
kable_paper("hover",
full_width = F)| id_arbol | Latitude | Longitude | FORMATTED_DATE_TIME | Psychro_Wet_Bulb_Temperature | Station_Pressure | Relative_Humidity | Crosswind | Temperature | Barometric_Pressure | Headwind | Direction_True | Direction_Mag | Wind_Speed | Heat_Stress_Index | Altitude | Dew_Point | Density_Altitude | Wind_Chill | Estado_Fenologico_Predominante | Frutos_Afectados | fecha |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 2.393549 | -76.71124 | 01/10/2020 10:11:12 a, m, | 22.0 | 825.1 | 85.2 | 0.0 | 23.9 | 825.2 | 0.0 | 313 | 312 | 0.0 | 25.3 | 1696 | 21.3 | 2.504 | 23.9 | 717 | 0 | 2020-10-01 |
| 2 | 2.393573 | -76.71120 | 01/10/2020 10:11:12 a, m, | 21.4 | 825.3 | 84.0 | 0.0 | 23.5 | 825.2 | 0.0 | 317 | 317 | 0.0 | 24.8 | 1696 | 20.7 | 2.485 | 23.5 | 717 | 0 | 2020-10-01 |
| 3 | 2.393541 | -76.71113 | 01/10/2020 10:11:12 a, m, | 21.8 | 825.5 | 79.6 | 0.2 | 24.5 | 825.5 | 0.4 | 338 | 337 | 0.5 | 25.7 | 1694 | 20.8 | 2.518 | 24.5 | 717 | 0 | 2020-10-01 |
| 4 | 2.393503 | -76.71119 | 01/10/2020 10:11:12 a, m, | 22.8 | 825.4 | 77.6 | 0.4 | 25.9 | 825.4 | 0.2 | 299 | 299 | 0.5 | 28.1 | 1694 | 21.7 | 2.572 | 25.9 | 717 | 0 | 2020-10-01 |
| 5 | 2.393486 | -76.71121 | 01/10/2020 10:11:12 a, m, | 22.6 | 825.2 | 76.5 | 0.0 | 26.0 | 825.2 | 0.0 | 265 | 264 | 0.0 | 28.0 | 1696 | 21.5 | 2.575 | 25.9 | 717 | 0 | 2020-10-01 |
Localización de los aborles
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = Data_20$Longitude, lat = Data_20$Latitude, radius = 0.2, color = "#7FFF00") %>%
addControl(html = "<h1>Arboles de Aguacates</h1>", position = "topright")Comportamiento de la temperatura.
Temp=as.geodata(Data_20,coords.col = 3:2,data.col = 9)
plot(Temp)
Como se puede observar en las gráficas, hay zonas donde la temperatura aumenta significativamente. Este incremento puede influir en el cultivo de los aguacates, ya que las condiciones óptimas de temperatura son cruciales para su desarrollo. El rango de temperatura registrado en la finca se encuentra entre 22 y 30 grados Celsius, lo cual es un dato importante para considerar en la planificación y gestión del cultivo. Temperaturas fuera de este rango podrían afectar la calidad y la producción de los aguacates.
# Convertir los datos a un objeto sf
Data_20_sf <- st_as_sf(Data_20, coords = c("Longitude", "Latitude"), crs = 4326, remove = FALSE)
ggplot(Data_20_sf) +
geom_point(aes(x = Longitude, y = Latitude, color = Temperature), size = 2) +
scale_color_viridis_c() +
labs(title = "Temperatura del cutivo de Aguacate",
x = "Longitud",
y = "Latitud",
color = "Temperatura") +
theme_minimal() 
Las zonas exteriores de la finca tiene las temperaturas más altas.
2. Autocorrelacion espacial con el semivariograma
dist_summary_df <- summary(dist(Data_20[,3:2]))
tabla1<- as.data.frame(as.matrix(dist_summary_df))
tabla1 %>%
kbl(caption = "Distancias entre Coordenadas") %>%
kable_paper("hover", full_width = F)| V1 | |
|---|---|
| Min. | 0.0000171 |
| 1st Qu. | 0.0004051 |
| Median | 0.0006408 |
| Mean | 0.0006827 |
| 3rd Qu. | 0.0009178 |
| Max. | 0.0019591 |
Estos valores indican que la mayoría de las distancias entre los puntos de medición son pequeñas, con una media de 0.0006827. Sin embargo, hay algunas distancias más grandes, reflejadas en el máximo de 0.0019591. Estas distancias deben considerarse al analizar la variabilidad de la temperatura y su impacto en el cultivo de aguacates.
s_variograma = variog(Temp, option = "bin", uvec = seq(0.0004051, 0.0009178, length.out = 20))## variog: computing omnidirectional variogramvariograma_temp <- variog.mc.env(Temp, obj.variog = s_variograma, nsim = 99)## variog.env: generating 99 simulations by permutating data values
## variog.env: computing the empirical variogram for the 99 simulations
## variog.env: computing the envelops# Definir los rangos de los ejes
x_range <- c(0.0003, 0.0009)
y_range <- c(2, 5)
# Graficar con los rangos de los ejes modificados
plot(s_variograma, main = "Semivariograma con Entorno de Monte Carlo", xlim = x_range, ylim = y_range)
lines(variograma_temp, col = "#EE6AA7", lty = 3)
Al observar la forma aplanada y constante indica que la variabilidad entre puntos no cambia mucho con la distancia, sugiriendo que los datos tienen una estructura espacial muy homogénea.
3. Identificar el mejor modelo teórico
ajuste del modelo exponencial al semivariograma
# Crear una matriz de valores iniciales para el ajuste
ini.vals <- expand.grid(seq(1, 15, length = 10), seq(6e-04, 8e-05, length = 10))
#modelo exponencial al semivariograma
model_exp <- variofit(s_variograma, ini = ini.vals, cov.model = "exponential", wei = "npair", min = "optim")## variofit: covariance model used is exponential
## variofit: weights used: npairs
## variofit: minimisation function used: optim
## variofit: searching for best initial value ... selected values:
## sigmasq phi tausq kappa
## initial.value "4.11" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 3048.82004527524Ajuste del modelo gaussiano al semivariograma
# Ajustar el modelo gaussiano al semivariograma
model_gaus <- variofit(s_variograma, ini = ini.vals, cov.model = "gaussian", wei = "npair", min = "optim")## variofit: covariance model used is gaussian
## variofit: weights used: npairs
## variofit: minimisation function used: optim
## variofit: searching for best initial value ... selected values:
## sigmasq phi tausq kappa
## initial.value "4.11" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 19656.4857281378Ajuste del modelo esférico al semivariograma
model_sph <- variofit(s_variograma, ini = ini.vals, cov.model = "spherical", fix.nug = TRUE, wei = "npair", min = "optim")## variofit: covariance model used is spherical
## variofit: weights used: npairs
## variofit: minimisation function used: optim
## variofit: searching for best initial value ... selected values:
## sigmasq phi tausq kappa
## initial.value "2.56" "0" "0" "0.5"
## status "est" "est" "fix" "fix"
## loss value: 30516.1655726669plot(s_variograma, main = "Semivariograma con Modelos Ajustados")
lines(model_exp, col = "#EEA9B8")
lines(model_gaus, col = "#836FFF")
lines(model_sph, col = "#54FF9F")
# Agregar leyenda
legend("bottomright", legend = c("Modelo Exponencial", "Modelo Gaussiano", "Modelo Esférico"),
col = c("#EEA9B8", "#836FFF", "#54FF9F"), lty = 1, cex = 0.6)
Después de comparar los modelos, se observa que el modelo exponencial es el que mejor se ajusta a los datos. Por lo tanto, se ha seleccionado este modelo para realizar las predicciones.
4. Prediccion espacial con la metodologia Kriging, gererar la imagen de la prediccion espacial
min(Data_20[,3])## [1] -76.7118##Predicción Espacial Kriging
geodatos_grid=expand.grid( lon=seq(-76.71022,-76.7118,l=80),lat=seq(2.392101 ,2.393634 ,l=80))
plot(geodatos_grid)
points(Data_20[,3:2],col="red")
# Realizar la predicción con los mismos parámetros
prediccion <- krige.conv(Temp, loc = geodatos_grid,
krige = krige.control(nugget = 0.5, trend.d = "cte",trend.l = "cte",cov.pars = c(sigmasq = 4.11, phi = 0)))## krige.conv: model with constant mean
## krige.conv: Kriging performed using global neighbourhoodimage(prediccion, main="kriging Predict", xlab="East", ylab="North")
Toda la predicción es constante, una posible explicación radica en la asunción de una variabilidad espacial constante en todas las direcciones y distancias, respaldada por un modelo de variograma que muestra una estructura de correlación homogénea en los datos. Además, el modelo de variograma y los parámetros de ajuste del kriging se calibraron de manera óptima para adaptarse a un patrón constante, todas las predicciones podrían converger hacia un valor uniforme.
pred=cbind(geodatos_grid,prediccion$predict)
temp_predict=rasterFromXYZ(cbind(geodatos_grid,prediccion$predict))
plot(temp_predict)
5. Validación Cruzada
valida=xvalid(geodata = Temp,model = model_exp)## xvalid: number of data locations = 534
## xvalid: number of validation locations = 534
## xvalid: performing cross-validation at location ... 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, 531, 532, 533, 534,
## xvalid: end of cross-validationMAE=mean(abs(valida$error))
MAE## [1] 0.7867482MAE de aproximadamente 0.7867482 indica que, en promedio, las predicciones del modelo se desvían de los valores observados por alrededor de 0.7867482 grados.
La predicción, a pesar de ser constante, el modelo muestra un MAE pequeño, posiblemente debido a la estabilidad en los datos de temperatura.