rm(list = ls())
library(terra) # Datos raster espaciales.
## terra 1.8.15
library(sf) # Datos vectoriales espaciales.
## Linking to GEOS 3.12.2, GDAL 3.9.3, PROJ 9.4.1; sf_use_s2() is TRUE
library(sp) # Datos espaciales vectoriales.
library(stars) # Datos raster multidimensionales.
## Cargando paquete requerido: abind
library(gstat) # Geoestadística, interpolación espacial.
library(automap) # Variogramas automáticos, kriging.
library(RColorBrewer) # Paletas de colores mapas.
library(leaflet) # Mapas interactivos web.
library(leafem) # Mapas interactivos web.
library(dplyr) # Para manipulación de datos
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:terra':
##
## intersect, union
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
ruta_absoluta <- "C:/Users/León Azul/Desktop/Trabajos Universidad Mateo/Geomática Básica 2024-2/Examen 2/Datos/"
list.files(path = ruta_absoluta, pattern = "*.gpkg")
## [1] "Municipios .gpkg" "Municipios .gpkg-shm"
## [3] "Municipios .gpkg-wal" "Municipios1.gpkg"
## [5] "NteSantander.gpkg" "soc_N_stder.gpkg"
## [7] "soc_N_stder_Raster.gpkg"
samples <- sf::st_read(paste0(ruta_absoluta, "soc_N_stder.gpkg"))
## Reading layer `soc_N_stder' from data source
## `C:\Users\León Azul\Desktop\Trabajos Universidad Mateo\Geomática Básica 2024-2\Examen 2\Datos\soc_N_stder.gpkg'
## using driver `GPKG'
## Simple feature collection with 1817 features and 1 field
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: -73.68057 ymin: 6.875437 xmax: -71.90203 ymax: 9.287609
## Geodetic CRS: +proj=longlat +datum=WGS84 +no_defs
munic <- sf::st_read(paste0(ruta_absoluta, "Municipios1.gpkg"))
## Reading layer `municipios___municipios_colombia' from data source
## `C:\Users\León Azul\Desktop\Trabajos Universidad Mateo\Geomática Básica 2024-2\Examen 2\Datos\Municipios1.gpkg'
## using driver `GPKG'
## Simple feature collection with 40 features and 4 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -73.63379 ymin: 6.872201 xmax: -72.04761 ymax: 9.290847
## Geodetic CRS: MAGNA-SIRGAS
summary(samples)
## soc geom
## Min. : 10.24 POINT :1817
## 1st Qu.: 24.15 epsg:NA : 0
## Median : 32.15 +proj=long...: 0
## Mean : 37.89
## 3rd Qu.: 49.13
## Max. :125.10
hist(samples$soc)
samples$soc = round(samples$soc,2)
pal <- colorNumeric(
c("#E1F5C4", "#EDE574", "#F9D423", "#FC913A", "#FF4E50"),
# colors depend on the count variable
domain = samples$soc,
)
#1. Identificar el SRC actual de munic:
sf::st_crs(munic)
## Coordinate Reference System:
## User input: MAGNA-SIRGAS
## wkt:
## GEOGCRS["MAGNA-SIRGAS",
## DATUM["Marco Geocentrico Nacional de Referencia",
## ELLIPSOID["GRS 1980",6378137,298.257222101,
## LENGTHUNIT["metre",1]]],
## PRIMEM["Greenwich",0,
## ANGLEUNIT["degree",0.0174532925199433]],
## CS[ellipsoidal,2],
## AXIS["geodetic latitude (Lat)",north,
## ORDER[1],
## ANGLEUNIT["degree",0.0174532925199433]],
## AXIS["geodetic longitude (Lon)",east,
## ORDER[2],
## ANGLEUNIT["degree",0.0174532925199433]],
## USAGE[
## SCOPE["Horizontal component of 3D system."],
## AREA["Colombia - onshore and offshore. Includes San Andres y Providencia, Malpelo Islands, Roncador Bank, Serrana Bank and Serranilla Bank."],
## BBOX[-4.23,-84.77,15.51,-66.87]],
## ID["EPSG",4686]]
#2. Transformar el SRC a WGS 84:
munic <- sf::st_transform(munic, crs = 4326)
leaflet() %>%
addPolygons(
data = munic,
color = "gray",
opacity = 1,
weight = 1,
fillOpacity = 0.2) %>%
addCircleMarkers(
data = samples,
radius= 1.5,
label = ~soc,
color = ~pal(soc),
fillOpacity = 1,
stroke = F
) %>%
addLegend(
data = samples,
pal = pal,
values = ~soc,
position = "bottomleft",
title = "SOC:",
opacity = 0.9) %>%
addProviderTiles("OpenStreetMap")
g1 = gstat(formula = soc ~ 1, data = samples)
(rrr <- terra::rast(xmin=-74.0, xmax=-72.0, ymin=6.5, ymax=9.5, nrows=370, ncols = 329, vals = 1, crs = "epsg:4326"))
## class : SpatRaster
## dimensions : 370, 329, 1 (nrow, ncol, nlyr)
## resolution : 0.006079027, 0.008108108 (x, y)
## extent : -74, -72, 6.5, 9.5 (xmin, xmax, ymin, ymax)
## coord. ref. : lon/lat WGS 84 (EPSG:4326)
## source(s) : memory
## name : lyr.1
## min value : 1
## max value : 1
stars.rrr <- stars::st_as_stars(rrr)
z1 = predict(g1, stars.rrr)
## [inverse distance weighted interpolation]
z1
## stars object with 2 dimensions and 2 attributes
## attribute(s):
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## var1.pred 10.98167 29.43436 32.83694 36.31694 42.34179 110.2783 0
## var1.var NA NA NA NaN NA NA 121730
## dimension(s):
## from to offset delta refsys x/y
## x 1 329 -74 0.006079 WGS 84 [x]
## y 1 370 9.5 -0.008108 WGS 84 [y]
a <- which(is.na(z1[[1]]))
z1[[1]][a] = 0.0
z1
## stars object with 2 dimensions and 2 attributes
## attribute(s):
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## var1.pred 10.98167 29.43436 32.83694 36.31694 42.34179 110.2783 0
## var1.var NA NA NA NaN NA NA 121730
## dimension(s):
## from to offset delta refsys x/y
## x 1 329 -74 0.006079 WGS 84 [x]
## y 1 370 9.5 -0.008108 WGS 84 [y]
names(z1) = "soc"
rango_z1 <- range(z1$soc)
paleta <- colorNumeric(palette = c("orange", "yellow", "cyan", "green"), domain = rango_z1, na.color = "transparent")
m <- leaflet() %>%
addTiles() %>%
leafem::addGeoRaster(
z1["soc"], # Seleccionar solo el atributo "soc"
opacity = 0.7,
colorOptions = colorOptions(palette = c("orange", "yellow", "cyan", "green"), domain = range(z1$soc)) # Ajustar el dominio de color
) %>%
addCircleMarkers(
data = samples,
radius = 1.5,
label = ~soc,
color = ~paleta(soc),
fillOpacity = 1,
stroke = FALSE
) %>%
addLegend(
data = samples,
pal = paleta,
values = ~soc,
position = "bottomright",
title = "SOC E IDW INTERPOLACIÓN [%]"
)
m
v_emp_ok = variogram(soc ~ 1, data=samples)
plot(v_emp_ok)
v_mod_ok = automap::autofitVariogram(soc ~ 1, as(samples, "Spatial"))
plot(v_mod_ok)
v_mod_ok$var_model
(rrr <- terra::rast(xmin=-74.0, xmax=-72.0, ymin=6.5, ymax=9.5, nrows=185, ncols = 164, vals = 1, crs = "epsg:4326"))
## class : SpatRaster
## dimensions : 185, 164, 1 (nrow, ncol, nlyr)
## resolution : 0.01219512, 0.01621622 (x, y)
## extent : -74, -72, 6.5, 9.5 (xmin, xmax, ymin, ymax)
## coord. ref. : lon/lat WGS 84 (EPSG:4326)
## source(s) : memory
## name : lyr.1
## min value : 1
## max value : 1
media_soc <- mean(samples$soc)
g2_simple <- gstat(formula = soc ~ 1, model = v_mod_ok$var_model, data = samples, beta = media_soc)
#z2_simple <- predict(g2_simple, stars.rrr)
paleta <- colorNumeric(palette = c("orange", "yellow", "cyan", "green"), domain = range(z1$soc), na.color = "transparent")
m <- leaflet() %>%
addTiles() %>%
leafem::addGeoRaster(
z1["soc"], # Seleccionar solo el atributo "soc"
opacity = 0.7,
colorOptions = colorOptions(palette = c("orange", "yellow", "cyan", "green"), domain = range(z1$soc)) # Ajustar el dominio de color
) %>%
addCircleMarkers(
data = samples,
radius = 1.5,
label = ~soc,
color = ~paleta(soc),
fillOpacity = 1,
stroke = FALSE
) %>%
addLegend(
data = samples,
pal = paleta,
values = ~soc,
position = "bottomright",
title = "OK SOC interpolation [%]"
)
## Warning in pal(c(r[1], cuts, r[2])): Some values were outside the color scale
## and will be treated as NA
## Warning in paleta(soc): Some values were outside the color scale and will be
## treated as NA
## Warning in paleta(soc): Some values were outside the color scale and will be
## treated as NA
m
colores <- colorOptions(palette = c("orange", "yellow", "cyan", "green"), domain = 10:100, na.color = "transparent")
m <- leaflet() %>%
addTiles() %>%
addGeoRaster(z1, colorOptions = colores, opacity = 0.8, group= "IDW") %>%
addGeoRaster(z1, colorOptions = colores, opacity = 0.8, group= "OK") %>%
# Add layers controls
addLayersControl(
overlayGroups = c("IDW", "OK"),
options = layersControlOptions(collapsed = FALSE)
) %>%
addLegend("bottomright", pal = paleta, values= z1$soc,
title = "Soil organic carbon [%]"
)
## Warning in write_stars.stars(x, dsn = fl): all but first attribute are ignored
## Warning in write_stars.stars(x, dsn = fl): all but first attribute are ignored
m