R/team_10.R

Defines functions team_10

Documented in team_10

#' This function creates a dataframe from a shapefile using Team 10'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 group_by
#' @importFrom  tidyr unnest
#' @importFrom  purrr map
#' @importFrom  jsonlite flatten
#' @return Returns a dataframe.
#' @examples
#' datapath <- system.file("extdata", "gadm36_AUS_shp/gadm36_AUS_1.shp", package = "STAT585.Lab3.Group8.2019")
#' australia <- team_10(datapath, tolerance = 0.01)
team_10<- function(file, tolerance){
  checkmate::assertNumber(tolerance, lower = 0, upper = 1) # Check to see if tolerance is a single number
  checkmate::assertCharacter(file) # Assert that place.file is a character string
  assertthat::assert_that(file.exists(file), msg = "File does not exist. Please enter a valid file name")
  unthinned.list <- read_sf(file) # unthinned list object, must thin
  thinned.list <-  maptools::thinnedSpatialPoly(as(unthinned.list, "Spatial"),
                                                tolerance = tolerance,
                                                minarea = 0.001,
                                                topologyPreserve = TRUE)
    shpbig <- read_sf(file)
    shp_st <- maptools::thinnedSpatialPoly(
      as(shpbig, "Spatial"), tolerance = tolerance,
      minarea = 0.001, topologyPreserve = TRUE)
    shp <- st_as_sf(shp_st)
    shpSmall <- shp %>% select(NAME_1, geometry) %>%
      group_by() %>%
      mutate(coord = geometry %>% map(.f = function(m) flatten(.x=m)),
             region = row_number()) %>%
      unnest
    st_geometry(shpSmall) <- NULL
    shpSmall <- shpSmall %>%
      mutate(coord = coord %>% map(.f = function(m) as_tibble(m)),
             group = row_number()) %>%
      unnest %>%
      setNames(c("name", "region","group", "long", "lat"))
    return(shpSmall)

  }
EBlagg/STAT585.Lab3.Group8.2019 documentation built on May 29, 2019, 1:20 p.m.