R/create_spatialVector.R

In CAPLTER/capemlGIS: CAP LTER package for generating EML spatialVector and spatialRaster metadata

#' @title Construct a spatial file of type KML and create metadata of type
#'  spatial vector (deprecated: use create_vector or create_vector_shape)
#'
#' @description create_spatialVector generates a EML entity of type
#'   spatialVector
#'
#' @details create_spatialVector creates a EML spatialVector object from a
#'  spatial data object (shapefile, kml) that is read into the R environment.
#'  The function reads the attributes and classes contained within a supporting
#'  yaml file generated from the capeml::write_attributes function -
#'  create_spatialVector will look for a file in the working directory with a
#'  name of type spatialEntityName_attrs.yaml. Because all attributes written to
#'  a kml (the output of create_spatialVector are of type character, factors are
#'  not considered in this workflow). Note that this functionality is predicated
#'  on the existence of a file containing metadata about the attributes, that
#'  that file is in the working directory, and that the file matches the name of
#'  the spatial data entity precisely. In addition to generating a EML entity of
#'  type spatialVector, create_spatialVector writes the spatial entity in the R
#'  environment to file as type kml. Unless projectNaming is set to false, the
#'  output file is renamed with the file with project id + base file name + file
#'  extension (kml in this case).
#'
#' @note create_spatialVector will look for a package number (packageNum) in
#'  config.yaml; this parameter is not passed to the function and it must exist.
#' @note create_spatialVector currently accepts an argument for a base url path
#'  to which the new file name will be appended so as to be a web-resolvable
#'  file; the package defaults to a URL specific to the CAP LTER.
#' @note Because file name metadata is incorporated into the kml generated from
#'  the sf::st_write function, including the md5 hash of the object in the file
#'  name sensu other products generated by capeml* packages is not feasible for
#'  spatialVector objects.
#' @note All vector objects are transformed to epsg 4326 (WGS 1984)
#'
#' @param svname
#'  (character) The unquoted name of the spatial data object in the R
#'  environment.
#' @param description
#'  (character) Description of the vector resource.
#' @param geoDescription
#'  (character) A textual description of the geographic study area of the
#'  vector. This parameter allows the user to overwrite the
#'  geographicDesciption value provided in the project config.yaml.
#' @param baseURL
#'  (character) The base path of the web-accessible location of the data file;
#'  the name of the resulting file will be passed to the base path to generate
#'  a web-resolvable file path. This parameter is required with the default set
#'  to the CAP LTER file path
#' @param projectNaming
#'  (logical) Logical indicating if the vector file (or parent directory if
#'  zipFiles == TRUE) should be renamed per the style used by the CAP LTER
#'  (default) with the project id + base file name + md5sum + file extension.
#'  The passed file or directory name will be used if this parameter is set to
#'  FALSE.
#'
#' @import EML
#' @import sf
#' @importFrom dplyr mutate select_if
#' @importFrom yaml yaml.load_file
#' @importFrom utils write.csv read.csv
#' @importFrom tidyr unnest_wider unnest_longer
#' @importFrom tools md5sum
#'
#' @return EML spatialVector object is returned. Additionally, the spatial data
#'  entity is written to file as type kml, and renamed with the project id +
#'  base file name + file extension (kml in this case).
#'

create_spatialVector <- function(
  svname,
  description,
  geoDescription,
  baseURL = "https://data.gios.asu.edu/datasets/cap/",
  projectNaming = TRUE
  ) {

  # deprecation ---------------------------------------------------------------

  .Deprecated(
    new = "create_vector or create_vector_shape",
    package="capemlGIS",
    old = as.character(sys.call(sys.parent()))[1L]
  )

  stop()


  # required parameters -----------------------------------------------------

  # do not proceed if a description is not provided
  if (missing("description")) {

    stop("please provide a description for this vector")

  }


  # object names ------------------------------------------------------------

  # add kml extension and project id to object name if projectNaming == TRUE
  namestr <- deparse(substitute(svname))

  if (projectNaming == TRUE) {

    # if using project naming, add project-name specific elements to
    # spatialRaster entity

    # retrieve package number from config.yaml
    if (!file.exists("config.yaml")) {

      stop("config.yaml not found")

    }

    packageNum <- yaml::yaml.load_file("config.yaml")$packageNum

    fname <- paste0(packageNum, "_", namestr, ".kml")

  } else {

    fname <- paste0(namestr, ".kml")

  }


  # ensure epsg4326 ---------------------------------------------------------
  svname <- st_transform(svname, crs = 4326)


  # geographic coverage -----------------------------------------------------

  if (missing("geoDescription")) {

    # retrieve geographic description from config.yaml
    if (!file.exists("config.yaml")) {

      stop("could not locate geographic description, config.yaml not found")

    }

    geoDesc <- yaml::yaml.load_file("config.yaml")$geographicCoverage$geographicDescription

    if (is.na(geoDesc) | is.null(geoDesc) | geoDesc == "") {

      warning("geographic description provided in config.yaml is empty")

    }

  } else {

    geoDesc <- geoDescription

  }

  spatialCoverage <- EML::set_coverage(
    geographicDescription = geoDesc,
    west = st_bbox(svname)[["xmin"]],
    east = st_bbox(svname)[["xmax"]],
    north = st_bbox(svname)[["ymax"]],
    south = st_bbox(svname)[["ymin"]]
  )


  # write to kml ------------------------------------------------------------

  sf::st_write(
    obj = svname,
    dsn = fname,
    driver = "kml",
    delete_layer = TRUE,
    delete_dsn = TRUE
  )


  # attributes --------------------------------------------------------------

  # load attributes from yaml or csv (default to yaml)
  if (file.exists(paste0(namestr, "_attrs.yaml"))) {

    attrs <- yaml::yaml.load_file(paste0(namestr, "_attrs.yaml"))
    attrs <- yaml::yaml.load(attrs)
    attrs <- tibble::enframe(attrs) |>
      tidyr::unnest_wider(value)

    attrs <- subset(attrs, select = -name)

  } else if (!file.exists(paste0(namestr, "_attrs.yaml")) && file.exists(paste0(namestr, "_attrs.csv"))) {

    attrs <- utils::read.csv(paste0(namestr, "_attrs.csv"))

  } else {

    stop(paste0("attributes file: ", namestr, "_attrs.yaml ", "not found in ", getwd()))

  }

  # column classes to vector (req'd by set_attributes)
  classes <- attrs$columnClasses

  # copy attributeDefinition to defintion as appropriate; remove col classes
  # from attrs (req'd by set_attributes); remove empty columns (real targets
  # here are maximum and minimum, which can throw an error for data without any numeric
  # cols)

  # helper function to remove missing columns
  not_all_na <- function(x) {
    !all(is.na(x))
  }

  attrs <- attrs |>
    dplyr::mutate(
      definition = dplyr::case_when(
        grepl("character", columnClasses) & ((is.na(definition) | definition == "")) ~ attributeDefinition,
        TRUE ~ definition
      )
    )

  attrs <- subset(attrs, select = -columnClasses)

  attrs <- attrs |>
    dplyr::select_if(not_all_na)

attr_list <- EML::set_attributes(attributes = attrs, col_classes = classes)


# set physical ------------------------------------------------------------

# distribution
fileDistribution <- EML::eml$distribution(
  EML::eml$online(url = paste0(baseURL, fname))
)

# data format
fileDataFormat <- EML::eml$dataFormat(
  externallyDefinedFormat = EML::eml$externallyDefinedFormat(
    formatName = "Google Earth Keyhole Markup Language (KML)")
)

# file size
fileSize <- EML::eml$size(unit = "byte")
fileSize$size <- deparse(file.size(fname))

# authentication
fileAuthentication <- EML::eml$authentication(method = "MD5")
fileAuthentication$authentication <- md5sum(fname)

# construct physical
spatialVectorPhysical <- EML::eml$physical(
  objectName = fname,
  authentication = fileAuthentication,
  size = fileSize,
  dataFormat = fileDataFormat,
  distribution = fileDistribution
)


# create spatialVector entity ---------------------------------------------

newSV <- EML::eml$spatialVector(
  entityName = fname,
  entityDescription = description,
  physical = spatialVectorPhysical,
  coverage = spatialCoverage,
  attributeList = attr_list,
  geometricObjectCount = nrow(svname),
  id = fname
)


# add geometry type -------------------------------------------------------

sfGeometry <- attr(svname$geometry, "class")[[1]]

if (grepl("polygon", sfGeometry, ignore.case = TRUE)) {

  objectGeometry <- "Polygon"

} else if (grepl("point", sfGeometry, ignore.case = TRUE)) {

  objectGeometry <- "Point"

} else if (grepl("linestring", sfGeometry, ignore.case = TRUE)) {

  objectGeometry <- "LineString"

} else {

  stop(paste0("undetermined geometry: ", attr(svname$geometry, "class")[[1]]))

}

newSV$geometry <- objectGeometry


# add spatial reference  --------------------------------------------------

epsg4326 <- EML::eml$spatialReference(
  horizCoordSysName = "GCS_WGS_1984"
)

newSV$spatialReference <- epsg4326

# closing message ---------------------------------------------------------

message("spatialVector created")

# return spatial vector object --------------------------------------------

return(newSV)

} # close create_spatialVector