R/sample_treeline.R

In ElevDistr: Calculate the Distance to the Nearest Local Treeline

#' Compute the local treeline
#'
#' @description Calculate horizontal and vertical lines between two different classified points from the \code{df} input.
#' If used in the context of the treeline: when a point above the treeline (\code{TRUE}) and a point below the treeline
#' (\code{FALSE}) lie next to each other, the start and the end of the line is calculated and stored. This data point
#' collection represents the local treeline. It is highly recommended to use this function only in combination with
#' \code{generate_grid} and \code{classify_above_treeline}. The coordinates in the \code{df} can only be meaningfully processed
#' if they have the same order and structure as results from \code{generate_grid}.
#' @usage sample_treeline(df, lonLength, latLength, stepSize = 0.0025)
#' @param df Data frame generated by the function \code{classify_above_treeline} and therefore containing: longitude,
#' latitude (WGS 84), growing season temperature, growing season length, and a boolean. Longitude and latitude
#' must be of the data type "numeric" and finite. For the boolean \code{TRUE}, \code{FALSE} and
#' \code{NA} is allowed and nothing else.
#' @param lonLength Vector containing the length of the longitudinal sequence. One value, data type "numeric".
#' This information is part of the \code{generate_grid} output. One value, data type "numeric" and finite.
#' @param latLength Vector containing the length of the latitudinal sequence. One value, data type "numeric".
#' This information is part of the \code{generate_grid} output. One value, data type "numeric" and finite.
#' @param stepSize Step size for the square sampling (in degree). One value, data type "numeric". This \code{stepSize}
#' must be identical with the \code{stepSize} used in the function \code{generate_grid}. It is used to calculate the center
#' between two grid points. One value, data type "numeric" and finite.
#' @return A data frame containing line-shaped polygons. Each row containing: a identifier, a start latitude and longitude, a end latitude and longitude.
#' @author Livio Bätscher, Jurriaan M. de Vos
#' @examples
#' #Recommended usage
#' temp <- generate_grid(lon = 8.728898, lat = 46.93756, squareSize = 10, stepSize = 0.0025)
#'
#' gstURL <- paste0("https://os.zhdk.cloud.switch.ch/chelsav2/GLOBAL/",
#'                  "climatologies/1981-2010/bio/CHELSA_gst_1981-2010_V.2.1.tif")
#' gslURL <- paste0("https://os.zhdk.cloud.switch.ch/chelsav2/GLOBAL/",
#'                  "climatologies/1981-2010/bio/CHELSA_gsl_1981-2010_V.2.1.tif")
#' \donttest{
#' gst <- terra::rast(gstURL, vsi = TRUE)
#' gsl <- terra::rast(gslURL, vsi = TRUE)
#'
#' temp$df <- classify_above_treeline(coords = temp$df, gstRaster = gst, gslRaster = gsl)
#'
#' treeline <- sample_treeline(df = temp$df, lonLength = temp$lonLength,
#'                             latLength = temp$latLength, stepSize = 0.0025)
#' }
#' @export

sample_treeline <- function(df, lonLength, latLength, stepSize = 0.0025) {
  #Error handling
  if (!is.data.frame(df)) {stop("df must be a data frame")} else if (ncol(df) < 3) {stop("df needs to have at least three columns")} else if (sum(!is.finite(as.matrix(df[,1:2]))) != 0) {stop("df must contain only finite intagers in the 1st and 2nd column")}  else if (!is.logical(df[,(ncol(df))])) {stop("df[,(ncol(df))] must contain only logical constants")}
  if (length(lonLength) != 1) {stop("lonLength must be of length 1")} else if (!is.finite(lonLength)) {stop("lonLength must be numeric and finite")}
  if (length(latLength) != 1) {stop("latLength must be of length 1")} else if (!is.finite(latLength)) {stop("latLength must be numeric and finite")}
  if (length(stepSize) != 1) {stop("stepSize must be of length 1")} else if (!is.finite(stepSize)) {stop("stepSize must be numeric and finite")}

  #Change names to be sure that I can use them
  names(df)[1] <- "longitude"
  names(df)[2] <- "latitude"
  names(df)[length(df)] <- "aboveTreeline"

  #Create a empty polygon
  treeline <- data.frame("id" = NA, "lat1" = NA, "lon1" = NA, "lat2" = NA, "lon2" = NA)

  #First handle the latitude
  #Loop trough all the coordinates
  for (i in 1:nrow(df)) {
    #If we are at the final latitude do no comparison AND
    #If the values do not contain "NA" AND
    #If the different latitudes contain a different value
    if (((i %% latLength) != 0) &&
        (!is.na(df$aboveTreeline[i])) && (!is.na(df$aboveTreeline[(i+1)])) &&
        (df$aboveTreeline[i] != df$aboveTreeline[(i+1)])) {
      id = paste0("horizontal", i) #Create a line ID
      lat = df$latitude[i] + (0.5 * stepSize) #Get the latitude
      leftLon = df$longitude[i] - (0.5 * stepSize) #Get the left longitude
      rightLon = df$longitude[i] + (0.5 * stepSize) #Get the right longitude

      #Add the polygon corners to the list
      treeline <- rbind(treeline, c(id, lat, leftLon, lat, rightLon))
    }
  }

  #Now handle the longitude
  #Iterate through the latitudes
  for (i in 1:latLength) {
    #Iterate trough the longitude (-1)
    for (j in 0:(lonLength-2)) {
      #If the values do not contain "NA" AND
      #If the rows have different values
      if ((!is.na(df$aboveTreeline[i+latLength*j])) &&
          (!is.na(df$aboveTreeline[i+latLength*(j+1)])) &&
          (df$aboveTreeline[i+latLength*j] != df$aboveTreeline[i+latLength*(j+1)])) {
        id = paste0("vertical", i, j) #Create a line ID
        lon = df$longitude[i+latLength*j] + (0.5 * stepSize) #Get longitude
        bottomLat = df$latitude[i+latLength*j] - (0.5 * stepSize) #Get bottom latitude
        topLat = df$latitude[i+latLength*j] + (0.5 * stepSize) #Get top latitude

        #Add the polygon corners to the list
        treeline <- rbind(treeline, c(id, bottomLat, lon, topLat, lon))
      }
    }
  }

  treeline <- treeline[-1,] #Remove the first row

  #Adjust the value
  treeline$lat1 <- as.numeric(treeline$lat1)
  treeline$lon1 <- as.numeric(treeline$lon1)
  treeline$lat2 <- as.numeric(treeline$lat2)
  treeline$lon2 <- as.numeric(treeline$lon2)

  return(treeline) #Return the treeline data frame
}