Merge pull request #235 from R4EPI/znk-gen-polygon

remove gen_polygon from msfdict

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: sitrep
 Title: Report templates and helper functions for EPI
-Version: 0.1.2
+Version: 0.1.3
 Authors@R: 
     c(person(given = "Dirk",
              family = "Schumacher",
@@ -93,6 +93,7 @@ Collate:
     'find_date_cause.R'
     'gen_eligible_interviewed.R'
     'gen_population.R'
+    'gen_polygon.R'
     'helpers.R'
     'inline_fun.R'
     'msf_dict_rename_helper.R'

NAMESPACE

@@ -61,14 +61,18 @@ importFrom(ggplot2,stat_density)
 importFrom(ggplot2,stat_function)
 importFrom(glue,glue)
 importFrom(msfdict,gen_data)
-importFrom(msfdict,gen_polygon)
 importFrom(msfdict,msf_dict)
 importFrom(msfdict,msf_dict_survey)
 importFrom(rlang,"!!")
 importFrom(rlang,".data")
 importFrom(rlang,":=")
 importFrom(rlang,sym)
 importFrom(scales,percent_format)
+importFrom(sf,st_intersection)
+importFrom(sf,st_make_grid)
+importFrom(sf,st_polygon)
+importFrom(sf,st_set_crs)
+importFrom(sf,st_sf)
 importFrom(srvyr,survey_mean)
 importFrom(srvyr,survey_total)
 importFrom(stats,setNames)
@@ -77,3 +81,4 @@ importFrom(tidyr,complete)
 importFrom(tidyr,gather)
 importFrom(tidyr,spread)
 importFrom(tidyr,unite)
+importFrom(utils,read.csv)

NEWS.md

@@ -1,3 +1,9 @@
+# sitrep 0.1.3
+
+* `gen_polygon()` has been moved back into this package as it did not really
+  belong in {msfdict}. Note that this should not affect the user experience.
+  (@zkamvar, #235)
+
 # sitrep 0.1.2
 
 * Import {msfdict}. The `msf_dict()`, `msf_dict_survey()`, `gen_data()` and

R/gen_polygon.R

@@ -0,0 +1,51 @@
+#' Fake spatial data as polygons
+#' This function returns a polygon which is split in to regions based on a
+#' supplied vector of names
+#' @param regions A string of names for each region to label the polygon with
+#' @importFrom sf st_polygon st_make_grid st_intersection st_sf st_set_crs
+#' @importFrom utils read.csv
+#' @references The coordinates used for the polygon are of Vienna, Austria.
+#' based off government data (see [metadata](https://www.data.gv.at/katalog/dataset/stadt-wien_bezirksgrenzenwien))
+#' @export
+gen_polygon <- function(regions) {
+
+  # get file path
+  path <- system.file("extdata", "coords.csv", package = "msfdict")
+
+  # read in coordinates as matrix
+  coords <- as.matrix(read.csv(path))
+  # change to list
+  coords <- list(coords)
+
+  # create a polygon from coordinates
+  original_poly <- sf::st_polygon(coords)
+
+  # define how many regions we want in our polygon
+  # high <- ceiling(length(regions) / 2)
+  high <- ceiling(sqrt(length(regions)))
+  # change polygon to grid (subdivisions as squares)
+  gridding <- sf::st_make_grid(original_poly, n = c(high, high),
+                               square = TRUE , what = "polygons")
+
+  # only keep grid parts inside original boundary
+  geometry <- sf::st_intersection(gridding, original_poly)
+
+  # check if regions is less that grid produces (for odd nums regions)
+  squares <- length(geometry) - length(regions)
+
+  # create labels for regions
+  labeling <- regions
+
+  # fix names for those with umatched regions
+  if (squares > 0) {
+    labeling <- c(regions, rep.int(NA, squares))
+  }
+
+  # polygon in to a list column which can be used as simple features for plot
+  output_poly <- sf::st_sf(tibble::tibble(name = labeling, geometry = geometry))
+
+  # Sets coordinate reference systwem to WGS84
+  output_poly <- sf::st_set_crs(output_poly, value = 4326)
+
+  output_poly
+}

R/msfdict_exports.R

@@ -7,7 +7,7 @@
 #' Functions re-expored from {msfdict}
 #'
 #' @seealso Dictionaries: [msfdict::msf_dict()], [msfdict::msf_dict_survey()]\cr
-#'   Generators: [msfdict::gen_data()], [msfdict::gen_polygon()]
+#'   Generator: [msfdict::gen_data()]
 #' @name msf_dict_survey
 #' @importFrom msfdict msf_dict_survey
 #' @export 
@@ -26,9 +26,3 @@
 #' @rdname msf_dict
 "gen_data"
 
-#' @name gen_polygon
-#' @importFrom msfdict gen_polygon
-#' @export
-#' @rdname msf_dict
-"gen_polygon"
-

tests/testthat/test-gen_polygon.R

@@ -0,0 +1,7 @@
+
+test_that("polygons can be generated", {
+
+  poly <- suppressWarnings(gen_polygon(LETTERS[1:4]))
+  expect_equal(dim(poly), c(4, 2))
+
+})