Datos Geográficos y Espaciales
Análisis de datos del clima para una finca de aguacate
Guillén León
2025
Cargar la base de datos Aguacate
A continuación se cargan los datos y observa un total de 534 observaciones para 21 variables de estudio.
datosaguacate<- read_excel("C:/Users/ACER/Desktop/CienciaDatos/Analsis geografica/Unit 3/data.xlsx")
DT::datatable(datosaguacate,
extensions = 'FixedColumns',
rownames= FALSE,
options = list(
pageLength = 10,
language = list(url = '//cdn.datatables.net/plug-ins/1.10.11/i18n/Spanish.json'),
autoWidth = TRUE,
columnDefs =
list(list(width = '300px', targets = c(0,7))),
scrollX = TRUE,
escape = T)
)View(datosaguacate)Análisis Exploratorio
summary(datosaguacate)## id_arbol Latitude Longitude FORMATTED_DATE_TIME
## Min. : 1.0 Min. :2.392 Min. :-76.71 Length:534
## 1st Qu.:134.2 1st Qu.:2.393 1st Qu.:-76.71 Class :character
## Median :267.5 Median :2.393 Median :-76.71 Mode :character
## Mean :267.5 Mean :2.393 Mean :-76.71
## 3rd Qu.:400.8 3rd Qu.:2.393 3rd Qu.:-76.71
## Max. :534.0 Max. :2.394 Max. :-76.71
## Psychro_Wet_Bulb_Temperature Station_Pressure Relative_Humidity
## Min. :19.00 Min. :822.4 Min. :59.50
## 1st Qu.:20.80 1st Qu.:824.8 1st Qu.:67.33
## Median :21.50 Median :825.7 Median :71.25
## Mean :21.63 Mean :825.5 Mean :71.17
## 3rd Qu.:22.40 3rd Qu.:826.5 3rd Qu.:75.30
## Max. :24.90 Max. :827.4 Max. :91.60
## Crosswind Temperature Barometric_Pressure Headwind
## Min. :0.0000 Min. :22.20 Min. :822.4 Min. :-0.7000
## 1st Qu.:0.0000 1st Qu.:24.50 1st Qu.:824.7 1st Qu.: 0.0000
## Median :0.1000 Median :25.80 Median :825.7 Median : 0.1000
## Mean :0.1989 Mean :25.83 Mean :825.5 Mean : 0.1906
## 3rd Qu.:0.3750 3rd Qu.:27.18 3rd Qu.:826.5 3rd Qu.: 0.3750
## Max. :1.5000 Max. :29.70 Max. :827.4 Max. : 1.3000
## Direction_True Direction_Mag Wind_Speed Heat_Stress_Index
## Min. : 0.0 Min. : 0.0 Min. :0.0000 Min. :22.80
## 1st Qu.: 66.0 1st Qu.: 66.0 1st Qu.:0.0000 1st Qu.:25.20
## Median :287.5 Median :287.5 Median :0.4000 Median :27.20
## Mean :222.5 Mean :223.3 Mean :0.3315 Mean :27.40
## 3rd Qu.:311.8 3rd Qu.:312.0 3rd Qu.:0.5000 3rd Qu.:29.18
## Max. :359.0 Max. :359.0 Max. :1.8000 Max. :34.50
## Altitude Dew_Point Density_Altitude Wind_Chill
## Min. :1675 Min. :17.70 Min. :2.409 Min. :22.20
## 1st Qu.:1684 1st Qu.:19.40 1st Qu.:2.506 1st Qu.:24.50
## Median :1692 Median :20.00 Median :2.551 Median :25.80
## Mean :1693 Mean :20.16 Mean :2.556 Mean :25.79
## 3rd Qu.:1700 3rd Qu.:20.80 3rd Qu.:2.605 3rd Qu.:27.10
## Max. :1724 Max. :24.00 Max. :2.723 Max. :29.60
## Estado_Fenologico_Predominante Frutos_Afectados
## Min. :717.0 Min. :0.000000
## 1st Qu.:717.0 1st Qu.:0.000000
## Median :718.0 Median :0.000000
## Mean :717.8 Mean :0.005618
## 3rd Qu.:718.0 3rd Qu.:0.000000
## Max. :719.0 Max. :1.000000Mapas de la ubicación de los árboles en la finca.
Distribución de los puntos de coordenadas (latitud y longitud) de los árboles en la finca.
# Distribución de los puntos.
ggplot(data = datosaguacate, aes(x = Longitude, y = Latitude)) +
geom_point() +
labs(x = "Longitud", y = "Latitud", title = "Distribución de puntos de coordenadas")
# Distribución de los puntos de forma interactiva.
leaflet() %>%
addProviderTiles(provider = providers$Esri.WorldImagery) %>%
addCircleMarkers(
lng = datosaguacate$Longitude,
lat = datosaguacate$Latitude,
radius = 0.2,
color = "blue"
)Variable regionalizada de analisis.
La variable temperatura se utiliza como variable de estudio, y se oberva que la temperatura del terreno varia según la ubicación de los árboles, es decir, la temperatura varía en función de la ubicación geográfica.El histograma muestra la distribucion de la temperatura y el grafico de dispersion la relacion entre la latitud y temperatura.
Visualización de la distribución de la temperatura
ggplot(datosaguacate, aes(x = Temperature)) +
geom_histogram(binwidth = 1, fill = "red", color = "black") +
theme_minimal() +
labs(title = "Distribución de la Temperatura", x = "Temperatura", y = "Frecuencia")
Relación entre Latitud y Temperatura
ggplot(datosaguacate, aes(x = Latitude, y = Temperature)) +
geom_point(color = "red") +
theme_minimal() +
labs(title = "Relación entre Latitud y Temperatura", x = "Latitud", y = "Temperatura")
## Variable regionalizada.
dfaguacate <- as.geodata(datosaguacate, coords.col = 3:2, data.col = 9) # Variable regionalizada Temperatura
plot(dfaguacate)
# Distancias entre las coordenadas
summary(dist(dfaguacate$coords))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.712e-05 4.051e-04 6.408e-04 6.827e-04 9.178e-04 1.959e-03Variograma.
Al estudiar el variograma, identificamos patrones espaciales mediante la correlación entre los puntos. No obstante, la correlación es debil, pues en ciertos puntos la línea tiende a estabilizarse dentro de las bandas, indicando una menor variabilidad y, por lo tanto, una menor correlación entre los datos.
variograma <- variog(geodata = dfaguacate, uvec = seq(0,0.0009,0.00005), option = "bin")## variog: computing omnidirectional variogramdatos_env <- variog.mc.env(dfaguacate, obj.variog =variograma)## variog.env: generating 99 simulations by permutating data values
## variog.env: computing the empirical variogram for the 99 simulations
## variog.env: computing the envelopsplot(variograma, pch=16, envelop = datos_env)
## Ajuste Modelo. Se implementan 4 modelos teóricos:
• Modelo Exponencial.
• Modelo Esférico.
• Modelo Gaussiano.
• Modelo Matern.
Se analizan los 4 modelos juntos, y se realiza individualmente las graficas para cada modelo. También se realiza el análisis del MSE para determinar de forma estadística cual es el mejor modelo.
# Ajuste Modelo.
ini.vals <- expand.grid( seq(2,4,l=10), seq(0.0001,0.00025, l = 10))
modelo_mco_exp <- variofit(variograma, ini.vals, cov.model = "exponential")## 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 "3.11" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 3555.92876863577modelo_mco_gau <- variofit(variograma, ini.vals, cov.model = "gaussian") ## 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 "3.11" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 6633.5155506537modelo_mco_shp <- variofit(variograma, ini.vals, cov.model = "spherical")## 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 "3.11" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 6005.01775448873plot(variograma, pch=16, envelop = datos_env)
lines(modelo_mco_exp, col = "orange")
lines(modelo_mco_gau, col = "blue")
lines(modelo_mco_shp, col = "green")
legend(0.0007, 7, legend=c("Gausiano", "Exponencial", "Esferico"),
col=c("blue", "orange","green"), lty=1, cex=0.8)
plot(variograma, col ="orange")
lines(modelo_mco_exp, col = "orange")
plot(variograma, col ="blue")
lines(modelo_mco_gau, col = "blue")
plot(variograma, col ="green")
lines(modelo_mco_shp, col = "green")
# Imprimir resultados MSE por modelo
print(paste("MSE modelo Exponencial =", as.character(modelo_mco_exp$value)))## [1] "MSE modelo Exponencial = 3314.17633638709"print(paste("MSE modelo Gausiano =", as.character(modelo_mco_gau$value)))## [1] "MSE modelo Gausiano = 6339.97796271843"print(paste("MSE modelo Esferico =", as.character(modelo_mco_shp$value)))## [1] "MSE modelo Esferico = 5837.58927236167"Se puede observar que el valor de MSE del modelo exponencial es el que mejor se ajusta a los puntos del semivariograma muestral.
Interpolación.
rangos <- c(min(datosaguacate[,3]),
max(datosaguacate[,3]),
min(datosaguacate[,2]),
max(datosaguacate[,2]))Predicción Espacial Kriging
# Genera una cuadrícula espacial con 100 puntos a lo largo de la longitud y latitud
geodatos_grid <- expand.grid(lon = seq(rangos[1], rangos[2], length.out = 100),
lat = seq(rangos[3], rangos[4], length.out = 100))Visualiza la cuadrícula espacial y resultados de la interpolación.
plot(geodatos_grid)
# Traza los puntos de datos geográficos sobre la cuadrícula
points (datosaguacate[,3:2], col = "red")
# Realiza el Kriging con los datos de origen y la cuadrícula generada
geodatos_ko <- krige.conv(dfaguacate, loc = geodatos_grid,
krige = krige.control(nugget = 0, trend.d = "cte",
trend.l = "cte", cov.pars = c(sigmasq = 3.0186,
phi = 0.0001)))## krige.conv: model with constant mean
## krige.conv: Kriging performed using global neighbourhoodDesviación estándar de la predicción realizada mediante kriging.
# Visualiza la predicción Kriging
image(geodatos_ko, main = "kriging Predict", xlab = "East", ylab = "North")
contour(geodatos_ko, main = "kriging Predict", drawlabels = TRUE)
# Visualiza la desviación estándar de la predicción Kriging
image(geodatos_ko, main = "kriging StDv Predicted", val = sqrt(geodatos_ko$krige.var), xlab = "East", ylab = "North")
contour(geodatos_ko, main = "kriging StDv Predict", val = sqrt(geodatos_ko$krige.var), drawlabels = TRUE)
## Imagen raster.
Se crea una imagen raster a partir de las predicciones de kriging.
# Crear un raster de predicción y visualizarlo
pred <- cbind(geodatos_grid, geodatos_ko$predict)
temp_predict <- rasterFromXYZ(pred)
plot(temp_predict)
levelplot(temp_predict, par.settings = BuRdTheme)
# Crear un raster de error y visualizarlo
temp_error <- rasterFromXYZ(cbind(geodatos_grid, sqrt(geodatos_ko$krige.var)))
levelplot(temp_error, par.settings = BuRdTheme)
Validación cruzada
# Realizar validación cruzada y calcular el Error Absoluto Medio (MAE)
valida <- xvalid(geodata = dfaguacate, model = modelo_mco_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.7868143A partir de la validación cruzada se obtiene un error de predicción del modelo de 0.78 grados. Es decir, en promedio, las predicciones del modelo difieren en aproximadamente 0.78 grados de las observaciones reales, que es un dato alto y por tanto no es muy buena la capacidad predictiva del modelo.
Conclusiones - Análisis Geoestadístico
Distribución de la Temperatura: La temperatura varía entre 22.2 °C y 29.7 °C. La mayoría de las temperaturas se concentran alrededor de la mediana (25.8 °C). La distribución es ligeramente sesgada hacia temperaturas más altas.
Relación entre Latitud y Temperatura: No se observa una relación clara entre la latitud y la temperatura. La temperatura parece ser independiente de la latitud dentro del rango estudiado.
Autocorrelación Espacial - Semivariograma: Existe autocorrelación espacial en la temperatura a ciertas distancias. Los puntos más cercanos tienen temperaturas más similares, y esta similitud disminuye con la distancia.
Predicción Espacial: La predicción espacial muestra una variación suave y continua de la temperatura, identificando claramente las áreas con temperaturas más altas y más bajas.