library(gstat)
library(sp)
library(sf)
library(stars)
library(terra)
library(tmap)
library(ggspatial)
library(ggplot2)
library(leaflet)
library(tidyverse)Geoestadistica
Taller 4: Interpolación espacial con Kriging
1 SETUP
1.1 Cargar Librerías
1.2 Cargamos los datos y los predictores para todos los meses
# Febrero
data_unida_feb <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/data_nuble_temp_con_predictores_feb.rds')
preds_feb <- rast('C:/Re6/Geoestadistica/Talleres/data/procesada/predictores_febrero.tif')
grilla <- preds_feb[[1]]
values(grilla) <- NA
set.seed(432)
preds_feb_st <- preds_feb |> st_as_stars() |> split('band')
# Julio
data_unida_jul <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/data_nuble_temp_con_predictores_jul.rds')
preds_jul <- rast('C:/Re6/Geoestadistica/Talleres/data/procesada/predictores_julio.tif')
grilla <- preds_jul[[1]]
values(grilla) <- NA
set.seed(432)
preds_jul_st <- preds_jul |> st_as_stars() |> split('band')
# Septiembre
data_unida_sept <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/data_nuble_temp_con_predictores_sept.rds')
preds_sept <- rast('C:/Re6/Geoestadistica/Talleres/data/procesada/predictores_septiembre.tif')
grilla <- preds_sept[[1]]
values(grilla) <- NA
set.seed(432)
preds_sept_st <- preds_sept |> st_as_stars() |> split('band')
# Noviembre
data_unida_nov <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/data_nuble_temp_con_predictores_nov.rds')
preds_nov <- rast('C:/Re6/Geoestadistica/Talleres/data/procesada/predictores_noviembre.tif')
grilla <- preds_nov[[1]]
values(grilla) <- NA
set.seed(432)
preds_nov_st <- preds_nov |> st_as_stars() |> split('band')2 kriging Ordinario
# Se utilizaron los variogramas realizados en el taller 3
fit_v_feb <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/var_feb_ajustado.rds')
fit_v_jul <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/var_jul_ajustado.rds')
fit_v_sept <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/var_sept_ajustado.rds')
fit_v_nov <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/var_nov_ajustado.rds')2.1 Febrero
2.1.1 Kriging Ordinario
krige_ord_feb <- krige(temp ~ 1, data_unida_feb, preds_feb_st, fit_v_feb)
options(scipen = 10)
krige_ord_rast_feb <- rast(krige_ord_feb)2.1.2 Validación Cruzada
krige_ord_feb_cross <- krige.cv(temp ~ 1, data_unida_feb, fit_v_feb, nfold=10)
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
ok_rmse_feb <- sqrt(sum(krige_ord_feb_cross$residual^2) / dim(krige_ord_feb_cross)[1])
(R2_ko_feb <- 1- sum(krige_ord_feb_cross$residual^2)/sum((krige_ord_feb_cross$observed-mean(krige_ord_feb_cross$observed))^2))
ok_MSE_feb <- ok_rmse_feb^2
ok_var_error_feb <- var(krige_ord_feb_cross$residual)# Mapas interactivos de Kfold, residuos y Z-score
tmap_mode('view')
krige_ord_feb_cross.sf <- st_as_sf(krige_ord_feb_cross)
st_crs(krige_ord_feb_cross.sf) <- 32719
krige_ord_feb_cross.sf$fold <- as.factor(krige_ord_feb_cross.sf$fold)
p1_feb_ok <- tm_shape(krige_ord_feb_cross.sf) +
tm_dots(col='fold', title= 'Kfold', style='cat')
p2_feb_ok <-tm_shape(krige_ord_feb_cross.sf) +
tm_dots(col='residual', title = 'Residuos')
p3_feb_ok <-tm_shape(krige_ord_feb_cross.sf) +
tm_dots(col='zscore', title = 'Z-Score')
p4_feb_ok <-tm_shape(krige_ord_feb_cross.sf) +
tm_dots(col='var1.var', title = 'Varianza')
tmap_arrange(p1_feb_ok, p2_feb_ok, p3_feb_ok, p4_feb_ok)2.2 Julio
2.2.1 Kriging Ordinario
krige_ord_jul <- krige(temp ~ 1, data_unida_jul, preds_jul_st, fit_v_jul)
options(scipen = 10)
krige_ord_rast_jul <- rast(krige_ord_jul)
plot(krige_ord_rast_jul)2.2.2 Validación Cruzada
krige_ord_jul_cross <- krige.cv(temp ~ 1, data_unida_jul, fit_v_jul, nfold=10)
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
ok_rmse_jul <- sqrt(sum(krige_ord_jul_cross$residual^2) / dim(krige_ord_jul_cross)[1])
(R2_ko_jul <- 1- sum(krige_ord_jul_cross$residual^2)/sum((krige_ord_jul_cross$observed-mean(krige_ord_jul_cross$observed))^2))
ok_MSE_jul <- ok_rmse_jul^2
ok_var_error_jul <- var(krige_ord_jul_cross$residual)# Mapas interactivos de Kfold, residuos y Z-score
tmap_mode('view')
krige_ord_jul_cross.sf <- st_as_sf(krige_ord_jul_cross)
st_crs(krige_ord_jul_cross.sf) <- 32719
krige_ord_jul_cross.sf$fold <- as.factor(krige_ord_jul_cross.sf$fold)
p1_jul_ok <- tm_shape(krige_ord_jul_cross.sf) +
tm_dots(col='fold', title= 'Kfold', style='cat')
p2_jul_ok <-tm_shape(krige_ord_jul_cross.sf) +
tm_dots(col='residual', title = 'Residuos')
p3_jul_ok <-tm_shape(krige_ord_jul_cross.sf) +
tm_dots(col='zscore', title = 'Z-Score')
p4_jul_ok <-tm_shape(krige_ord_jul_cross.sf) +
tm_dots(col='var1.var', title = 'Varianza')
tmap_arrange(p1_jul_ok, p2_jul_ok, p3_jul_ok, p4_jul_ok)2.3 Septiembre
2.3.1 Kriging Ordinario
krige_ord_sept <- krige(temp ~ 1, data_unida_sept, preds_sept_st, fit_v_sept)
options(scipen = 10)
krige_ord_rast_sept <- rast(krige_ord_sept)
plot(krige_ord_rast_sept)2.3.2 Validación Cruzada
krige_ord_sept_cross <- krige.cv(temp ~ 1, data_unida_sept, fit_v_sept, nfold=10)
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
ok_rmse_sept <- sqrt(sum(krige_ord_sept_cross$residual^2) / dim(krige_ord_sept_cross)[1])
(R2_ko_sept <- 1- sum(krige_ord_sept_cross$residual^2)/sum((krige_ord_sept_cross$observed-mean(krige_ord_sept_cross$observed))^2))
ok_MSE_sept <- ok_rmse_sept^2
ok_var_error_sept <- var(krige_ord_sept_cross$residual)# Mapas interactivos de Kfold, residuos y Z-score
krige_ord_sept_cross.sf <- st_as_sf(krige_ord_sept_cross)
st_crs(krige_ord_sept_cross.sf) <- 32719
krige_ord_sept_cross.sf$fold <- as.factor(krige_ord_sept_cross.sf$fold)
p1_sept_ok <- tm_shape(krige_ord_sept_cross.sf) +
tm_dots(col='fold', title= 'Kfold', style='cat')
p2_sept_ok <-tm_shape(krige_ord_sept_cross.sf) +
tm_dots(col='residual', title = 'Residuos')
p3_sept_ok <-tm_shape(krige_ord_sept_cross.sf) +
tm_dots(col='zscore', title = 'Z-Score')
p4_sept_ok <-tm_shape(krige_ord_sept_cross.sf) +
tm_dots(col='var1.var', title = 'Varianza')
tmap_arrange(p1_sept_ok, p2_sept_ok, p3_sept_ok, p4_sept_ok)2.4 Noviembre
2.4.1 Kriging Ordinario
krige_ord_nov <- krige(temp ~ 1, data_unida_nov, preds_nov_st, fit_v_nov)
options(scipen = 10)krige_ord_rast_nov <- rast(krige_ord_nov)
plot(krige_ord_rast_nov)2.4.2 Validación Cruzada
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
ok_rmse_nov <- sqrt(sum(krige_ord_nov_cross$residual^2) / dim(krige_ord_nov_cross)[1])
(R2_ko_nov <- 1- sum(krige_ord_nov_cross$residual^2)/sum((krige_ord_nov_cross$observed-mean(krige_ord_nov_cross$observed))^2))
ok_MSE_nov <- ok_rmse_nov^2
ok_var_error_nov <- var(krige_ord_nov_cross$residual)# Mapas interactivos de Kfold, residuos y Z-score
tmap_mode('view')
krige_ord_nov_cross.sf <- st_as_sf(krige_ord_nov_cross)
st_crs(krige_ord_nov_cross.sf) <- 32719
krige_ord_nov_cross.sf$fold <- as.factor(krige_ord_nov_cross.sf$fold)
p1_nov_ok <- tm_shape(krige_ord_nov_cross.sf) +
tm_dots(col='fold', title= 'Kfold', style='cat')
p2_nov_ok <-tm_shape(krige_ord_nov_cross.sf) +
tm_dots(col='residual', title = 'Residuos')
p3_nov_ok <-tm_shape(krige_ord_nov_cross.sf) +
tm_dots(col='zscore', title = 'Z-Score')
p4_nov_ok <-tm_shape(krige_ord_nov_cross.sf) +
tm_dots(col='var1.var', title = 'Varianza')
tmap_arrange(p1_nov_ok, p2_nov_ok, p3_nov_ok, p4_nov_ok)3 Regresion Kriging
3.1 Febrero
3.1.1 Carga de datos
#Cargamos el modelo de regresión lineal del taller 2 y el variograma del taller 3
fvar_r_feb <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/residual_var_febrero_ajustado.rds')
)3.1.2 Kriging usando el variograma residual
rk_feb <- krige(temp ~ dem, data_unida_feb, preds_feb_st, fvar_r_feb)
options(scipen = 10)
rk_rast_feb <- rast(rk_feb)
plot(rk_rast_feb)3.1.3 Validación cruzada
rk_feb_cross <- krige.cv(temp ~ dem, data_unida_feb, fvar_r_feb, nfold=10)
(R2_rk_feb <- 1- sum(rk_feb_cross$residual^2)/sum((rk_feb_cross$observed-mean(rk_feb_cross$observed))^2))
rk_MSE_feb <- rk_feb_cross^2
rk_var_error_feb <- var(rk_feb_cross$residual)# Mapas interactivos
tmap_mode('view')
rk_feb_cross.sf <- st_as_sf(rk_feb_cross)
st_crs(rk_feb_cross.sf) <- 32719
rk_feb_cross.sf$fold <- as.factor(
rk_feb_cross.sf$fold)
p1_feb_rk <- tm_shape(rk_feb_cross.sf) +
tm_dots(col='fold',style='cat')
p2_feb_rk <-tm_shape(rk_feb_cross.sf) +
tm_dots(col='residual')
p3_feb_rk <- tm_shape(rk_feb_cross.sf) +
tm_dots(col='zscore', title= 'Z-Score')
p4_feb_rk <- tm_shape(rk_feb_cross.sf) +
tm_dots(col='var1.var', title= 'Varianza')
tmap_arrange(p1_feb_rk, p2_feb_rk, p3_feb_rk, p4_feb_rk)3.2 Julio
3.2.1 Carga de datos
#Cargamos el modelo de regresión lineal del taller 2 y el variograma del taller 3
fvar_r_jul <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/residual_var_julio_ajustado.rds')3.2.2 Kriging usando el variograma residual
rk_jul <- krige(temp ~ dem, data_unida_jul, preds_jul_st, fvar_r_jul)
rk_jul <- rast(rk_jul)
plot(rk_jul)3.2.3 Validación cruzada
rk_jul_cross <- krige.cv(temp ~ dem, data_unida_jul, fvar_r_jul, nfold=10)
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
rk_rmse_jul <- sqrt(sum(rk_jul_cross$residual^2) / dim(rk_jul_cross)[1])
(R2_rk_jul <- 1- sum(rk_jul_cross$residual^2)/sum((rk_jul_cross$observed-mean(rk_jul_cross$observed))^2))
rk_MSE_jul <- rk_rmse_jul^2
rk_var_error_jul <- var(rk_jul_cross$residual)# Mapas interactivos
tmap_mode('view')
rk_jul_cross.sf <- st_as_sf(rk_jul_cross)
st_crs(rk_jul_cross.sf) <- 32719
rk_jul_cross.sf$fold <- as.factor(
rk_jul_cross.sf$fold)
p1_jul_rk <- tm_shape(rk_jul_cross.sf) +
tm_dots(col='fold',style='cat')
p2_jul_rk <-tm_shape(rk_jul_cross.sf) +
tm_dots(col='residual')
p3_jul_rk <- tm_shape(rk_jul_cross.sf) +
tm_dots(col='zscore', title= 'Z-Score')
p4_jul_rk <- tm_shape(rk_jul_cross.sf) +
tm_dots(col='var1.var', title= 'Varianza')
tmap_arrange(p1_jul_rk, p2_jul_rk, p3_jul_rk, p4_jul_rk)3.3 Septiembre
3.3.1 Carga de datos
#Cargamos el modelo de regresión lineal del taller 2 y el variograma del taller 3
fvar_r_sept <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/residual_var_septiembre_ajustado.rds')3.3.2 Kriging usando el variograma residual
rk_sept <- krige(temp ~ dem + dist_costa + ndvi_sept + lst_sept, data_unida_sept, preds_sept_st, fvar_r_sept)
options(scipen = 10)
rk_rast_sept <- rast(rk_sept)
plot(rk_rast_sept)3.3.3 Validación cruzada
rk_sept_cross <- krige.cv(temp ~ dem + dist_costa + ndvi_sept + lst_sept, data_unida_sept, fvar_r_sept, nfold=10)
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
rk_rmse_sept <- sqrt(sum(rk_sept_cross$residual^2) / dim(rk_sept_cross)[1])
(R2_rk_sept <- 1- sum(rk_sept_cross$residual^2)/sum((rk_sept_cross$observed-mean(rk_sept_cross$observed))^2))
rk_MSE_sept <- rk_rmse_sept^2
rk_var_error_sept <- var(rk_sept_cross$residual)# Mapas interactivos
tmap_mode('view')
rk_sept_cross.sf <- st_as_sf(rk_sept_cross)
st_crs(rk_sept_cross.sf) <- 32719
rk_sept_cross.sf$fold <- as.factor(
rk_sept_cross.sf$fold)
p1_sept_rk <- tm_shape(rk_sept_cross.sf) +
tm_dots(col='fold',style='cat')
p2_sept_rk <-tm_shape(rk_sept_cross.sf) +
tm_dots(col='residual')
p3_sept_rk <- tm_shape(rk_sept_cross.sf) +
tm_dots(col='zscore', title= 'Z-Score')
p4_sept_rk <- tm_shape(rk_sept_cross.sf) +
tm_dots(col='var1.var', title= 'Varianza')
tmap_arrange(p1_sept_rk, p2_sept_rk, p3_sept_rk, p4_sept_rk)3.4 Noviembre
3.4.1 Carga de datos
#Cargamos el modelo de regresión lineal del taller 2 y el variograma del taller 3
fvar_r_nov <- readRDS('C:/Re6/Geoestadistica/Talleres/data/procesada/residual_var_noviembre_ajustado.rds')3.4.2 Kriging usando el variograma residual
rk_nov <- krige(temp ~ dem + lst_nov, data_unida_nov, preds_nov_st, fvar_r_nov)
options(scipen = 10)
rk_rast_nov <- rast(rk_nov)
plot(rk_rast_nov)3.4.3 Validación cruzada
rk_nov_cross <- krige.cv(temp ~ dem + lst_nov, data_unida_nov, fvar_r_nov, nfold=10)
# Calculamos el RMSE, R-cuadrado, MSE y varianza del error
rk_rmse_nov <- sqrt(sum(rk_nov_cross$residual^2) / dim(rk_nov_cross)[1])
(R2_rk_nov <- 1- sum(rk_nov_cross$residual^2)/sum((rk_nov_cross$observed-mean(rk_nov_cross$observed))^2))
rk_MSE_nov <- rk_rmse_nov^2
rk_var_error_nov <- var(rk_nov_cross$residual)# Mapas interactivos
tmap_mode('view')
rk_nov_cross.sf <- st_as_sf(rk_nov_cross)
st_crs(rk_nov_cross.sf) <- 32719
rk_nov_cross.sf$fold <- as.factor(
rk_nov_cross.sf$fold)
p1_nov_rk <- tm_shape(rk_nov_cross.sf) +
tm_dots(col='fold',style='cat')
p2_nov_rk <-tm_shape(rk_nov_cross.sf) +
tm_dots(col='residual')
p3_nov_rk <- tm_shape(rk_nov_cross.sf) +
tm_dots(col='zscore', title= 'Z-Score')
p4_nov_rk <- tm_shape(rk_nov_cross.sf) +
tm_dots(col='var1.var', title= 'Varianza')
tmap_arrange(p1_nov_rk, p2_nov_rk, p3_nov_rk, p4_nov_rk)4 Comparación de tablas cruzadas entre los modelos de Kriging Ordinario y Regresion Kriging
4.1 Febrero
# Comparación de RMSE y Rcuadrado
library(gridExtra)
resultados_feb <- data.frame(
Mes = c("Febrero"),
RMSE_OK = c(ok_rmse_feb),
RMSE_RK= c(rk_rmse_feb),
r2_OK = c(R2_ko_feb),
r2_RK = c(R2_rk_feb)
)
results_long_feb <- pivot_longer(resultados_feb,
cols = -Mes,
names_to = c(".value", "Tipo"),
names_sep = "_")
g1_feb <- ggplot(results_long_feb, aes(x = Tipo, y = RMSE, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de RMSE para Febrero", y = "RMSE", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
g2_feb <- ggplot(results_long_feb, aes(x = Tipo, y = r2, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de R2 para Febrero", y = "R2", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
grid.arrange(g1_feb, g2_feb, nrow = 2)Al comparar los gráficos de RMSE y R² del kriging ordinario se puede afirmar que los resultados Kriging Ordinario fueron superiores.
El RMSE del kriging ordinario fue de 0.789, mientras que el kriging de regresión tuvo 1.149.
El R² del kriging ordinario fue 0.851 y el kriging de regresión fue de 0.683.
4.2 Julio
# Comparación de RMSE y Rcuadrado
library(gridExtra)
resultados_jul <- data.frame(
Mes = c("Julio"),
RMSE_OK = c(ok_rmse_jul),
RMSE_RK= c(rk_rmse_jul),
r2_OK = c(R2_ko_jul),
r2_RK = c(R2_rk_jul)
)
results_long_jul <- pivot_longer(resultados_jul,
cols = -Mes,
names_to = c(".value", "Tipo"),
names_sep = "_")
g1_jul <- ggplot(results_long_jul, aes(x = Tipo, y = RMSE, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de RMSE para Julio", y = "RMSE", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
g2_jul <- ggplot(results_long_jul, aes(x = Tipo, y = r2, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de R2 para Julio", y = "R2", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
grid.arrange(g1_jul, g2_jul, nrow = 2)Al comparar los gráficos de RMSE y R² del kriging ordinario se puede afirmar que los resultados Kriging Ordinario fueron levemente superiores.
El RMSE del kriging ordinario fue de 0.613, mientras que el kriging de regresión tuvo 0.855.
El R² del kriging ordinario fue 0.949 y el kriging de regresión fue de 0.901.
4.3 Septiembre
# Comparación de RMSE y Rcuadrado
library(gridExtra)
resultados_sept <- data.frame(
Mes = c("Septiembre"),
RMSE_OK = c(ok_rmse_sept),
RMSE_RK= c(rk_rmse_sept),
r2_OK = c(R2_ko_sept),
r2_RK = c(R2_rk_sept)
)
results_long_sept <- pivot_longer(resultados_sept,
cols = -Mes,
names_to = c(".value", "Tipo"),
names_sep = "_")
g1_sept <- ggplot(results_long_sept, aes(x = Tipo, y = RMSE, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de RMSE para Septiembre", y = "RMSE", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
g2_sept <- ggplot(results_long_sept, aes(x = Tipo, y = r2, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de R2 para Septiembre", y = "R2", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
grid.arrange(g1_sept, g2_sept, nrow = 2)Al comparar los gráficos de RMSE y R² del kriging ordinario se puede afirmar que los resultados Kriging Regresión fueron superiores.
El RMSE del kriging ordinario fue de 0.876, mientras que el kriging de regresión tuvo 0.489.
El R² del kriging ordinario fue 0.924 y el kriging de regresión fue de 0.976
4.4 Noviembre
# Comparación de RMSE y Rcuadrado
library(gridExtra)
resultados_nov <- data.frame(
Mes = c("Noviembre"),
RMSE_OK = c(ok_rmse_nov),
RMSE_RK= c(rk_rmse_nov),
r2_OK = c(R2_ko_nov),
r2_RK = c(R2_rk_nov)
)
results_long_nov <- pivot_longer(resultados_nov,
cols = -Mes,
names_to = c(".value", "Tipo"),
names_sep = "_")
g1_nov <- ggplot(results_long_nov, aes(x = Tipo, y = RMSE, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de RMSE para Noviembre", y = "RMSE", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
g2_nov <- ggplot(results_long_nov, aes(x = Tipo, y = r2, fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#3158ea", "#e9c231"), labels = c("OK" = "Kriging Ordinario", "RK" = "Kriging de Regresión")) +
labs(title = "Comparación de R2 para Noviembre", y = "R2", x = " ") +
coord_flip() + # Hacer el gráfico horizontal
theme_minimal()
grid.arrange(g1_nov, g2_nov, nrow = 2)Al comparar los gráficos de RMSE y R² del kriging ordinario se puede afirmar que los resultados Kriging Ordinario fueron levemente superiores.
El RMSE del kriging ordinario fue de 0.670, mientras que el kriging de regresión tuvo 0.802.
El R² del kriging ordinario fue 0.938 y el kriging de regresión fue de 0.911.
5 Discusión de los resultados
# Tabla Resumen
results_summary <- data.frame(
Método = c("Kriging Ordinario de Febrero",
"Kriging Ordinario de Julio",
"Kriging Ordinario de Septiembre",
"Kriging Ordinario de Noviembre",
"Kriging de Regresión de Febrero",
"Kriging de Regresión de Julio",
"Kriging de Regresión de Septiembre",
"Kriging de Regresión de Noviembre"),
RMSE = c(ok_rmse_feb,
ok_rmse_jul,
ok_rmse_sept,
ok_rmse_nov,
rk_rmse_feb,
rk_rmse_jul,
rk_rmse_sept,
rk_rmse_nov),
R2 = c(R2_ko_feb,
R2_ko_jul,
R2_ko_sept,
R2_ko_nov,
R2_rk_feb,
R2_rk_jul,
R2_rk_sept,
R2_rk_nov)
)
# Mostrar el cuadro resumen
library(knitr)
kable(results_summary, digits=3,align="c")| Método | RMSE | R2 |
|---|---|---|
| Kriging Ordinario de Febrero | 0.807 | 0.844 |
| Kriging Ordinario de Julio | 0.642 | 0.945 |
| Kriging Ordinario de Septiembre | 0.947 | 0.913 |
| Kriging Ordinario de Noviembre | 0.633 | 0.945 |
| Kriging de Regresión de Febrero | 1.112 | 0.704 |
| Kriging de Regresión de Julio | 0.804 | 0.914 |
| Kriging de Regresión de Septiembre | 0.703 | 0.969 |
| Kriging de Regresión de Noviembre | 0.729 | 0.927 |
A nivel general, casi todos modelos tuvieron un valor aceptable de RMSE y R². La exepción fue el kriging de regresión para el mes de febrero, que tuvo un RMSE de 1.292 y un R² de 0.599.
Todos los kriging de regresión mostraron mejoras en su valores de RMSE en relación a sus modelos de regresión lineal del taller 2.
Los resultados indican que el método de interpolación mediante el kriging ordinario fue superior en todos los meses, excepto Septiembre.
De esto se puede interpretar que las covariables no están, en la mayoría de los meses, no están ayudando a mejorar la predicción de temperatura.
Es posible que la selección de las variables predictoras no haya sido la más acertada. Talvez la elección difentes predictores hubiese ayudado a mejorar los modelos de regresión.
Puede ser que la autocorrelación espacial de los residuos no sea lo suficientemente significativa.