R/team_2.R

In EBlagg/STAT585.Lab3.Group8.2019: This is for lab (Title Case)

#' This function creates a dataframe from a shapefile using Team 2's solution
#'
#' @param place.file The full file path to your shapefile data.
#' @param tolerance A number indicating the tolerance used to thin the shapefile.
#' @export
#' @importFrom  checkmate assertNumber assertCharacter
#' @importFrom  sf  read_sf st_as_sf
#' @importFrom  dplyr as_tibble select mutate row_number tibble %>% rename_all
#' @importFrom  tidyr unnest
#' @importFrom  purrr map
#' @return Returns a dataframe.
#' @examples
#' datapath <- system.file("extdata", "gadm36_AUS_shp/gadm36_AUS_1.shp", package = "STAT585.Lab3.Group8.2019")
#' australia <- team_2(place.file, tolerance = 0.01))


team_2 <- function(place.file, tolerance){
  checkmate::assertNumber(tolerance, lower = 0, upper = 1) # Check to see if tolerance is a single number
  checkmate::assertCharacter(place.file) # Assert that place.file is a character string
  unthinned.list <- read_sf(place.file) # unthinned list object, must thin
  thinned.list <-  maptools::thinnedSpatialPoly(as(unthinned.list, "Spatial"),
                                                tolerance = tolerance,
                                                minarea = 0.001,
                                                topologyPreserve = TRUE)

  reformed.object <- st_as_sf(thinned.list) # Now in usable thinned format
  # GENERIC CODE ENDS HERE NOW TEAM SPECIFIC CODE
  helper.group <- function(geo){
    geo %>% purrr::flatten() %>% purrr::flatten()-> dd
    countgrouprep <- purrr::flatten_int(map(dd, nrow))
    num_group <- length(countgrouprep)
    rep(1:num_group, time = countgrouprep)
  }
  helper.order <- function(geol){
    geol %>% purrr::flatten() -> d
    longlat <- do.call(rbind, d)
    order_num <- sum(purrr::flatten_int(map(d, nrow)))
    order <- seq(1:order_num)
    cbind(longlat, order)
  }
  res <- map(reformed.object$geometry, .f=helper.order)
  ress <- do.call(rbind, res)
  group <- helper.group(reformed.object$geometry)
  ress <- cbind(ress, group)
  colnames(ress) <- c("long", "lat", "order", "group")
  ress <- as.data.frame(ress)
  # Create generic code that can scrape additional info from shapefile
  # We note that the way this is coded we want the territory name associated with
  # Each row of the reformed.object list
  additionalinfor <- data.frame(country.name = reformed.object$NAME_0,
                                territory.name = reformed.object$NAME_1, group = seq(1:length(reformed.object$NAME_0)))
  ress <- dplyr::left_join(ress, additionalinfor, by = "group")
  # check that the output is a data frame
  checkmate::checkDataFrame(ress)
}