Validación cruzada

Fundamnto teórico

La Validación Cruzada o k-fold Cross Validation consiste en tomar los datos originales y crear a partir de ellos dos conjuntos separados: un primer conjunto de entrenamiento (y prueba), y un segundo conjunto de validación.

Luego, el conjunto de entrenamiento se va a dividir en k subconjuntos y, al momento de realizar el entrenamiento, se va a tomar cada k subconjunto como conjunto de prueba del modelo, mientras que el resto de los datos se tomará como conjunto de entrenamiento.

Este proceso se repetirá k veces, y en cada iteración se seleccionará un conjunto de prueba diferente, mientras los datos restantes se emplearán, como se mencionó, como conjunto de entrenamiento. Una vez finalizadas las iteraciones, se calcula la precisión y el error para cada uno de los modelos producidos, y para obtener la precisión y el error final se calcula el promedio de los k modelos entrenados.

Una vez se cuenta con esta precisión promedio para un modelo, se puede repetir entonces el procedimiento del Cross Validation para todos los demás modelos de clasificación que se estén evaluando, y se seleccionará al final aquel que produzca el mejor valor de precisión y menor error promedio.

Entonces, puede utilizarse dicho modelo sobre el conjunto de validación generado en la primera parte, ya que, se supone, es este modelo el que mejor resultado en general ofreció durante la fase de entrenamiento (tomado de Pizarro, 2022).

#Validacion externa de los modelos

# librerias
library(raster)
## Loading required package: sp
library(readxl)

#. Carga de archivo CSV que contine puntos de validación
testing <- read_excel("~/Library/CloudStorage/OneDrive-Personal/Proyect Final Diplomado Tecnicas Mapeo Digital/Diplomado_LasHigueras/Perfiles/Perfiles.xlsx", sheet = "R")
names(testing)
##  [1] "ID_PUNTO" "POINT_X"  "POINT_Y"  "Nombre"   "Prof_cm"  "Esp_cm"  
##  [7] "Hsup"     "Hinf"     "Txt"      "Ac"       "Ar"       "Li"      
## [13] "MO"       "CO"       "pH"       "N"        "P"        "K"       
## [19] "Ca"       "Mg"       "Na"       "Al"       "CIC"      "CC"      
## [25] "CMP"      "DA"       "AD"       "AD_mm"
# Selección de columnas relevantes
testing <- testing[,c("POINT_X","POINT_Y","Li")]
testing
## # A tibble: 23 × 3
##    POINT_X  POINT_Y    Li
##      <dbl>    <dbl> <dbl>
##  1 521473. 6327936.  32.6
##  2 522043. 6328330.  13.5
##  3 522565. 6328661.  16.1
##  4 523676. 6328852.  29.9
##  5 524673. 6328981.  14  
##  6 524613. 6329897.  13.8
##  7 523802. 6329413.  22.4
##  8 521478. 6330634.  30.7
##  9 521727. 6329151.  10.5
## 10 523008. 6330045.  28.7
## # ℹ 13 more rows
# Conversión de datos a objeto espacial
library(sp)
coordinates(testing) <- ~ POINT_X + POINT_Y
proj4string(testing) <- CRS("+proj=utm +zone=21 +south +datum=WGS84 +units=m +no_defs")
plot(testing, main="Puntos de validación")

testingCoK <- testing 
# Carga de mapa raster .tif con las predicciones del modelo

var_UK<-raster("~/Library/CloudStorage/OneDrive-Personal/Proyect Final Diplomado Tecnicas Mapeo Digital/Diplomado_LasHigueras/Resultados raster/predicciones_krigingOrdinario_Li.tif")
par(mfrow=c(1,1))
plot(var_UK)

# Proyección del mapa raster
proj4string(var_UK) <- CRS("+proj=utm +zone=21 +south +datum=WGS84 +units=m +no_defs")
# Extracción de valores del raster en los puntos de validación
datos<-extract(x=var_UK,testingCoK,sp=TRUE)
testingCoK@data$var_UK<-datos@data$predicciones_krigingOrdinario_Li
mod_var_UK<- data.frame(obs=testingCoK@data$Li,mod=testingCoK@data$var_UK,model="UK")
modData<-rbind(mod_var_UK)
Validation <- modData
Validation$EE<-Validation[,1] - Validation[,2]

# calculo de parámetros estadísticos

ME<-mean(Validation[,4],na.rm=TRUE)
MAE<-mean(abs(Validation[,4]),na.rm=TRUE)
MSE<-mean(Validation[,4]^2,na.rm=TRUE)
RMSE<-sqrt(sum(Validation[,4]^2,na.rm=TRUE)/length(Validation[,4]))
AVE<-1-sum(Validation[,4]^2,na.rm=TRUE)/sum((Validation[,1]-mean(Validation[,1],na.rm=TRUE))^2,na.rm=TRUE)
par<-cbind(ME,MAE,MSE,RMSE,AVE)
par
##             ME      MAE      MSE     RMSE       AVE
## [1,] 0.6997874 2.220685 26.61237 5.158718 0.7348217
mod<- data.frame(obs=Validation[,1],mod=Validation[,2],model="qrf")
#install.packages("openair")
library(openair)
modsts<-modStats(mod,obs="obs",mod = "mod",type = "model")
modsts
## # A tibble: 1 × 12
##   model     n  FAC2     MB   MGE     NMB   NMGE  RMSE     r        P   COE   IOA
##   <fct> <int> <dbl>  <dbl> <dbl>   <dbl>  <dbl> <dbl> <dbl>    <dbl> <dbl> <dbl>
## 1 qrf      23     1 -0.700  2.22 -0.0255 0.0810  5.16 0.860  1.39e-7 0.729 0.865
parameters<-as.data.frame(cbind(par,modsts))
parameters<-parameters[,c(1:5,13,14,15,16)]
parameters
##          ME      MAE      MSE     RMSE       AVE   RMSE.1         r
## 1 0.6997874 2.220685 26.61237 5.158718 0.7348217 5.158718 0.8604789
##              P       COE
## 1 1.394109e-07 0.7294716
# Gráfico de dispersión de los valores observados vs. los valores del modelo
library(ggplot2)
ggplot(Validation, aes(x=obs, y=mod)) +
  geom_point(color="blue", size=2) +
  geom_abline(slope=1, intercept=0, color="red", linetype="dashed") +
  labs(title="Valores Observados vs. Valores del Modelo",
       x="Valores Observados",
       y="Valores del Modelo") +
  theme_minimal()