library(readxl)
library(geoR)
## --------------------------------------------------------------
## Analysis of Geostatistical Data
## For an Introduction to geoR go to http://www.leg.ufpr.br/geoR
## geoR version 1.8-1 (built on 2020-02-08) is now loaded
## --------------------------------------------------------------
library(raster)
## Loading required package: sp
library(ggplot2)
library(leaflet)
geo_datos =read_excel("~/Desktop/geo_datos.xlsx")
geo_datos
## # A tibble: 394 x 7
## id_arbol Latitude Longitude `Relative Humidity` Temperature `Wind Speed`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 2.38 -76.6 61.2 22.9 0
## 2 2 2.38 -76.6 62.3 23.8 0
## 3 3 2.38 -76.6 62.6 22.6 0.4
## 4 4 2.38 -76.6 61.3 22.3 0.6
## 5 5 2.38 -76.6 61.9 22.7 0.8
## 6 6 2.38 -76.6 65.7 23.1 0.4
## 7 7 2.38 -76.6 67 21 0.5
## 8 8 2.38 -76.6 65.8 21.6 0.4
## 9 9 2.38 -76.6 66.6 21.4 0
## 10 10 2.38 -76.6 66.3 20.8 0.7
## # … with 384 more rows, and 1 more variable: Altitude <dbl>
Se observa que los datos contienen información sobre las localizaciones de los sitios donde se tomaron datos de clima como temperatura, humedad relativa entre otras.
leaflet() %>% addTiles() %>% addCircleMarkers(lng = geo_datos$Longitude,lat = geo_datos$Latitude,radius = 0.2,color = "black")
# leaflet() %>% addTiles() %>% addCircleMarkers(lng = geo_datos$Longitude,lat = geo_datos$Latitude,radius = 0.2,color = "black",clusterOptions = markerClusterOptions())
Se observa que la finca se encuentra en la zona rural del municipio de Popayan y su distribucción espacial es bastante regular.
Como primer paso realizamos la creación de la variable regionalizada:
geo_temp=as.geodata(geo_datos,coords.col = 3:2,data.col = 5)
plot(geo_temp)
summary(dist(geo_datos[,3:2]))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.302e-05 4.017e-04 6.544e-04 7.038e-04 9.703e-04 1.912e-03
variograma=variog(geo_temp,option = "bin",uvec=seq(0,0.0009703,9.703e-05))
## variog: computing omnidirectional variogram
plot(variograma)
variograma_mc=variog.mc.env(geo_temp,obj=variograma)
## variog.env: generating 99 simulations by permutating data values
## variog.env: computing the empirical variogram for the 99 simulations
## variog.env: computing the envelops
lines(variograma_mc)
Se observa en el semivariograma una autocorrelación espacial muy fuerte indicando que las mediciones cercanas, presentan temperaturas similares en contraste con las distantes.
Ahora vamos a realizar el ajuste del modelo teorico:
##Ajuste del Modelo de Semivarianza
ini.vals = expand.grid(seq(8,12,l=10), seq(6e-04,8e-04,l=10))
plot(variograma)
model_mco_exp=variofit(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 "12" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 174964.991544732
model_mco_gaus=variofit(variograma, ini=ini.vals, cov.model="gaussian", wei="npair", min="optim",nugget = 0)
## 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 "12" "0" "0" "0.5"
## status "est" "est" "est" "fix"
## loss value: 130506.318494236
model_mco_spe=variofit(variograma, ini=ini.vals, cov.model="spheric",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 "10.22" "0" "0" "0.5"
## status "est" "est" "fix" "fix"
## loss value: 107137.155200497
lines(model_mco_exp,col="blue")
lines(model_mco_gaus,col="red")
lines(model_mco_spe,col="purple")
Podemos observar tanto graficamente como por el valor de SCE que el modelo gaussiano es el que mejor se ajusta a los puntos del semivariograma muestral.
Ahora vamos a realizar la interpolación (predicción espacial)
max(geo_datos[,3])
## [1] -76.61254
##Predicción Espacial Kriging
geodatos_grid=expand.grid( lon=seq(-76.61415,-76.61254,l=100),lat=seq(2.380799 ,2.382694 ,l=100))
plot(geodatos_grid)
points(geo_datos[,3:2],col="red")
geodatos_ko=krige.conv(geo_temp, loc=geodatos_grid,
krige= krige.control(nugget=0,trend.d="cte",
trend.l="cte",cov.pars=c(sigmasq=12.7080, phi=0.0007 )))
## krige.conv: model with constant mean
## krige.conv: Kriging performed using global neighbourhood
par(mfrow=c(1,2))
image(geodatos_ko, main="kriging Predict", xlab="East", ylab="North")
contour(geodatos_ko,main="kriging Predict", add=TRUE, drawlabels=TRUE)
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), add=TRUE, drawlabels=TRUE)
Ahora vamos a tranformar la imagen en raster:
require(rasterVis)
## Loading required package: rasterVis
## Loading required package: terra
## terra version 1.1.4
## Loading required package: lattice
## Loading required package: latticeExtra
##
## Attaching package: 'latticeExtra'
## The following object is masked from 'package:ggplot2':
##
## layer
pred=cbind(geodatos_grid,geodatos_ko$predict)
temp_predict=rasterFromXYZ(cbind(geodatos_grid,geodatos_ko$predict))
plot(temp_predict)
levelplot(temp_predict,par.settings =BuRdTheme)
temp_error=rasterFromXYZ(cbind(geodatos_grid,sqrt(geodatos_ko$krige.var)))
levelplot(temp_error,par.settings =BuRdTheme)
por ultimo vamos a cortar los raster con el shape de la finca:
finca=shapefile("~/Desktop/Fresno_area.shp")
plot(temp_predict)
plot(finca,add=T)
temp_predict_finca=mask(temp_predict,finca)
plot(temp_predict_finca)
plot(finca,add=T)