Autores: John Mora and Michelle Solis

Asignatura: Geoestadistica

Introduccion

El agua subterranea de California proporciona aproximadamente del 30 al 46 por ciento del suministro total de agua del estado, dependiendo de los años húmedos y secos. [CAg] A medida que aumenta la demanda de agua para usos domésticos, agricolas e industriales, la gestión del agua subterranea se vuelve cada vez mas importante. Diversas medidas de manejo necesitan conocer el comportamiento espacial y temporal del agua subterránea. Se necesitan mapas precisos de la profundidad del agua subterránea para predecir la dirección del flujo de la red y para monitorear la recarga delagua subterránea. En una región dispersa de observacion de aguas subterraneas, como California, se pueden usar metodos geoestadisticos para determinar los valores de los puntos donde no se realizan mediciones Las mediciones se tomaron en el otoño de 2016, entre octubre y diciembre. De las 4.727 mediciones originales, se mantuvieron 4.028 mediciones con ubicaciones únicas. Además, 42 ubicaciones con una profundidad negativa para la medición del agua subterránea se excluyeron del kriging ya que indican que el nivel del agua subterránea está por encima de la superficie del suelo en esas ubicaciones

Variable de medicion DGBS

Profundidad a las aguas subterraneas y elevación de las aguas subterraneas.

La profundidad a las aguas subterraneas es la distancia vertical medida al agua en un pozo desde un punto de referencia. El DBGS es la profundidad a la que se encuentra el agua subterranea menos la distancia a la referencia apuntan a la superficie del suelo. A menudo el punto de referencia es el borde superior del revestimiento del pozo, que es comunmente sobre la superficie del suelo. La profundidad a las aguas subterráneas y el DBGS es comunmente expresado como un número positivo. El DBGS puede ser un número negativo si el nivel de agua en la cubierta de un pozo está por encima de la superficie del suelo.

Analisis Exploratorio

Se procede a realizar el grafico de las mediciones de DGBS, en el estado de California para observar como se distribuyen estas:

#Grafico California
ggplot(data =datos) +
  geom_point(mapping = aes(x = Latitude, y = Longitude, color =DGBS))

ggplot(california)+geom_sf()+
  geom_point(data=datos,mapping = aes(x = Longitude, y =Latitude , color =DGBS))

summary(datos$DGBS)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -447.82   25.11   56.20   98.49  126.65  854.80

Luego se realiza un histograma de log(DGBS) debido a que este podria aproximarse a una distribucion normal:

#Eliminamos los valores duplicados
proj4string(h20) = CRS("+proj=longlat")
h20  <- remove.duplicates(h20)

#Data para trabajar con log transformado
h20Edit <- h20 [ h20 $ DGBS > 1 , ]
#Histograma de log(DGBS) y DGBS
ggplot(datos, aes(x=log (DGBS))) + 
  geom_histogram(aes(y=..density..), colour="black",stat = "bin",na.rm = TRUE, fill="white")+
  geom_density(alpha=.2, fill="#FF6666")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Esta seria la grafica del DGBS sin log:

ggplot(datos, aes(x=DGBS)) + 
  geom_histogram(aes(y=..density..), colour="black", na.rm = TRUE,fill="white")+
  geom_density(alpha=.2, fill="#FF6666") 
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Variograma o Semivariograma

En geoestadistica, la correlacion espacial se modela ya sea por el variograma o la funcion de covarianza. Conociendo que el variograma es una herramienta que nos permite analizar el comportamiento espacial de una variable sobre un area definida obteniendo como resultado un variograma experimental que refleja la distancia maxima y la forma en que un punto tiene influencia sobre otro punto a diferentes distancias.

Se pretende hacer uso de esta herramienta para obtener un variograma experimental en los datos de profundidad de aguas subterraneas (DGBS), seguido de esto encontrar un modelo que se ajuste a este variograma y asi poder estimar un punto en especifico de profundidad con ayuda del metodo de kriging, el cual usa el modelo ajustado encontrado para definir un ponderador que sera aplicado a los puntos de profundidad de las aguas subterraneas (DGBS) y poder predecir puntos donde no se generan ubicaciones, es decir, puntos de profundidad.

Existen diferentes tipos de Variogramas:

show.vgms()

#Grafica de variograma empirico de los puntos de profundidad de aguas subterraneas (DGBS)
train_g_U<- gstat(id ="log _ dist" , formula=log(DGBS) ~1 + Latitude , data = h20Edit )
vg_U<- variogram(train_g_U)
plot(vg_U, main = "Semivariograma Empirico")

Aplicacion de modelos de Variogramas 

vExp <- fit.variogram(vg_U, vgm(model = "Exp"),fit.method = 2)
vGau <- fit.variogram(vg_U, vgm(model = "Gau"),fit.method = 2)
vSph <- fit.variogram(vg_U, vgm(model = "Sph"),fit.method = 2)
vMat <- fit.variogram(vg_U, vgm(model = "Mat", nugget = 1,kappa = 0.5),fit.method = 2)
vBes <- fit.variogram(vg_U,vgm("Bes"),fit.method = 2)
vSte <- fit.variogram(vg_U,vgm("Ste"),fit.method = 2)

d <- c("Exponencial"= plot ( vg_U , vExp),
       "Gaussiano"=plot ( vg_U , vGau),
       "Esferico "=plot ( vg_U , vSph),
       "Matern"=plot ( vg_U , vMat),
       "Stein's"= plot ( vg_U , vSte),
       "Bessel"= plot ( vg_U , vBes))
d

Comparacion del ajuste entre los modelos de variogramas

vExpLine=variogramLine(vExp,500)
vGauLine=variogramLine(vGau,500)
vSphLine=variogramLine(vSph,500)
vMatLine=variogramLine(vMat,500)
vSteLine=variogramLine(vSte,500)
vBesLine=variogramLine(vBes,500)
#Grafico de los diferentes modelos de variogramas
ggplot(mapping = aes(dist,gamma))+
  geom_point(data = vg_U)+
  geom_line(data = vExpLine,aes(color="Exponencial"))+
  geom_line(data = vGauLine,aes(color="Gaussiano"))+
  geom_line(data = vSphLine,aes(color="Esferico"))+
  geom_line(data = vMatLine,aes(color="Matern"))+
  geom_line(data = vSteLine,aes(color="Stein's"))+
  geom_line(data = vBesLine,aes(color="Bessel"))+
  scale_color_discrete("Modelo")+
  theme_classic()

#Ajuste usando variogramline con respecto a las distancias
vExpAjust=variogramLine(vExp,dist_vector = vg_U$dist)
vGauAjust=variogramLine(vGau,dist_vector = vg_U$dist)
vSphAjust=variogramLine(vSph,dist_vector = vg_U$dist)
vMatAjust=variogramLine(vMat,dist_vector = vg_U$dist)
vSteAjust=variogramLine(vSte,dist_vector = vg_U$dist)
vBesAjust=variogramLine(vBes,dist_vector = vg_U$dist)

Sumas cuadraticas ponderadas

with(vg_U, sum(np * (gamma / vExpAjust$gamma -1 )^2))  
## [1] 98057.37
with(vg_U, sum(np * (gamma / vGauAjust$gamma -1 )^2))  
## [1] 409751
with(vg_U, sum(np * (gamma / vSphAjust$gamma -1 )^2))  
## [1] 116063.3
with(vg_U, sum(np * (gamma / vMatAjust$gamma -1 )^2))  
## [1] 21836.71
with(vg_U, sum(np * (gamma / vSteAjust$gamma -1 )^2))  
## [1] 22168.55
with(vg_U, sum(np * (gamma / vBesAjust$gamma -1 )^2))  
## [1] 26073.68

Con respecto al calculo de las sumas cuadraticas ponderadas, el modelo de variograma que mejor se ajusta es el “Matern” con un valor de 21836.71, comparado con los demas modelos.

Aplicando Kriging ordinario

#Separacion de data para ajuste y prediccion
trainIndices <- sample (1: length ( h20Edit ) , length ( h20Edit ) / 4 ,replace = FALSE )
test <- h20Edit [ trainIndices , ]
train <- h20Edit [ - trainIndices , ]  

#Ordinary Kriging
OK <- krige ( id = " logDist " , formula = log ( DGBS ) ~ 1,train , newdata = test , model = vMat )
## [using ordinary kriging]
#Error cuadratico medio de OK
MSE_OK <- mean((log(test$DGBS)-OK$` logDist .pred`)^2)
MSE_OK
## [1] 0.477907

Grafico de prediccion

UK_df <- as( OK , "data.frame" )

UK_df$Prediccion=exp(UK_df$X.logDist..pred)
colnames(UK_df)=c("Longitude","Latitude","LogPred","LogVar","Prediccion")

ggplot(california)+geom_sf()+
  geom_point(data =UK_df,mapping = aes(x = Longitude, y =Latitude , color =Prediccion))

Intervalo de prediccion para un punto

prediccion_Punto=3.401065
exp(prediccion_Punto)+c(-1,1)*1.96*sqrt(MSE_OK)
## [1] 28.64106 31.35099

Referencias

#Randolph, B. C. (2017). Extending kriging methods to large datasets with applications to California groundwater data. UCLA. ProQuest #ID: Randolph_ucla_0031N_16109. Merritt ID: ark:/13030/m53f9k41. Retrieved from https://escholarship.org/uc/item/23d1w7vv
#Obtencion de la base de datos : https://sgma.water.ca.gov/webgis/?appid=SGMADataViewer#gwlevels

#California, G. d. (2013). Appendix E. California's Groundwater. Obtenido de California Department WATER RESOURCES: #https://water.ca.gov/-/media/DWR-Website/Web-Pages/Programs/Groundwater-Management/Data-and-Tools/Files/Statewide-Reports/California-G#roundwater-Update-2013/California-Groundwater-Update-2013---Appendix-E.pdf

#Vera, F. (8 de Julio de 2020). Youtube. Obtenido de Geoestadistica con R: https://www.youtube.com/watch?v=pHmbZAqU55I