inst/doc/sampling.R

In rassta: Raster-Based Spatial Stratification Algorithms

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----data, fig.show = 'hold', fig.height = 2.5, fig.width = 2.8, message = FALSE, warning = FALSE, error = TRUE----
# Compressed folder with files from rassta’s installation folder
wasoil <- system.file("exdat/wasoil.zip", package = "rassta")
# Directory for temporary files
o <- tempdir()
# Copy compressed folder to directory for temporary files
file.copy(from = wasoil, to = o)
# Extract files to subfolder
d <- paste(o, "/rassta", sep = "")
unzip(paste(o, "/wasoil.zip", sep = ""), exdir = d)

## ----sim, message = FALSE, warning = FALSE, error = TRUE----------------------
# Load rassta and terra packages
library(rassta)
library(terra)
# Single-layer SpatRaster of stratification units
su <- rast(paste(d, "/su.tif", sep = ""))
# Multi-layer SpatRaster with spatial signatures of classification units
clim.sig <- rast(list.files(d, pattern = "climate_", full.names = TRUE)) # For climatic units
mat.sig <- rast(list.files(d, pattern = "material_", full.names = TRUE)) # For material units
terr.sig <- rast(list.files(d, pattern = "terrain_", full.names = TRUE)) # For terrain units
# Landscape similarity to stratification units
su.ls <- similarity(su.rast = su, sig.rast = c(clim.sig, mat.sig, terr.sig),
                    su.code = list(climate = c(1, 1),
                                   material = c(2, 2),
                                   terrain = c(3, 3)
                                   )
                  )

## ----obs, message = FALSE, warning = FALSE, error = TRUE----------------------
# SpatVector with SOC observations for stratification units
socobs <- vect(paste(d, "/soc.shp", sep = ""))
# Representative SOC observation for each stratification unit
su.obs <- observation(su.rast = su, obs = socobs, col.id = 1, col.resp = 2,
                      method = "mls", ls.rast = su.ls$landsim
                      )
# Information about sample and representative SOC observations
socobs
su.obs$su_repobs.sp

## ----dist, fig.show = 'hold', fig.height = 4, fig.width = 7, message = FALSE, warning = FALSE, error = TRUE----
# Set graphics arrangement
par(mfrow = c(1,2))
# Plot stratification units and response observations
plot(su, type = "classes", col = hcl.colors(56, "spectral"), legend = FALSE,
     mar = c(3, 2, 3, 1.5), main = paste("Soil Organic Carbon Observations"),
     fun = function() c(points(socobs, pch = 21, bg = rgb(0,1,0,1)),
                        points(su.obs$su_repobs.sp, pch = 21, bg = rgb(0,0,1,1))
                      )
    )
# Set new graphics arrangement
par(mar = c(2, 1.5, 1.5, 1.5))
# Plot histogram of soil organic carbon values from all observations
hist(socobs$soc, 4, col = rgb(0,1,0,0.8), main = "Soil Organic Carbon (%)", xlab = "")
# Plot histogram of soil organic carbon values from representative observations
hist(su.obs$su_repobs.sp$soc, 4, add = T, col = rgb(0,0,1,0.9))
# Add legend
legend("topright", legend = c("Sample", "Representative Observations"),
       col = c(rgb(0,1,0,0.8), rgb(0,0,1,0.9)), pch = 20, bty = "n", pt.cex = 2,
       cex = 0.6, text.col = "black", horiz = F, inset = c(0, 0.05)
      )

## ----locs, message = FALSE, warning = FALSE, error = TRUE---------------------
# Representative sampling location and its buffer area for each stratification unit
su.samp <- locations(ls.rast = su.ls$landsim, su.rast = su, method = "buffer")
# Information about representative sampling locations and corresponding buffer areas
su.samp$locations
su.samp$buffers

## ----spat, fig.show = 'hold', fig.height = 4, fig.width = 7, message = FALSE, warning = FALSE, error = TRUE----
# Set graphics arrangement
par(mfrow = c(1,2))
# Plot stratification units, representative sampling locations and buffer areas
plot(su, type = "classes", col = hcl.colors(56, "spectral"), legend = FALSE,
     mar = c(3, 2, 3, 1.5), main = "Representative Sampling Locations",
     fun = function() c(polys(su.samp$buffers, col = rgb(0,1,0,0.5)),
                        points(su.samp$locations, pch = 21, col = "black",
                               bg = rgb(0,1,0,1)
                              )
                      )
    )
# Set new graphics arrangement
par(mar = c(2, 1.5, 1.5, 1.5))
# Plot histogram of landscape similarity values at sampling locations
hist(su.samp$locations$land_sim, 4, main = "Landscape Similarity")

## ----clean, message = FALSE, warning = FALSE, error = TRUE--------------------
unlink(c(paste(o, "/wasoil.zip", sep = ""), d), recursive = TRUE)